From 37cab202462390a01c736d3eeb360a1c2dc0caf2 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 18:13:23 +0000 Subject: [PATCH 01/18] Import Conway refinement for omnific integers with source attribution and complete production scope --- LeanPool.lean | 773 +++++ LeanPool/ConwayRefinement.lean | 699 ++++ .../ConwayRefinement/CombinatorialGames.lean | 13 + .../CombinatorialGames/Game.lean | 16 + .../CombinatorialGames/Game/Basic.lean | 354 ++ .../CombinatorialGames/Game/Birthday.lean | 419 +++ .../CombinatorialGames/Game/Classes.lean | 524 +++ .../CombinatorialGames/Game/Functor.lean | 86 + .../CombinatorialGames/Game/IGame.lean | 1301 +++++++ .../CombinatorialGames/Game/Ordinal.lean | 259 ++ .../CombinatorialGames/Game/Player.lean | 181 + .../CombinatorialGames/Game/Special.lean | 233 ++ .../CombinatorialGames/Mathlib.lean | 10 + .../CombinatorialGames/Mathlib/Dyadic.lean | 360 ++ .../CombinatorialGames/Mathlib/Small.lean | 67 + .../CombinatorialGames/NatOrdinal.lean | 10 + .../CombinatorialGames/NatOrdinal/Basic.lean | 418 +++ .../CombinatorialGames/NatOrdinal/Pow.lean | 200 ++ .../CombinatorialGames/Surreal.lean | 18 + .../CombinatorialGames/Surreal/Basic.lean | 320 ++ .../CombinatorialGames/Surreal/Birthday.lean | 9 + .../Surreal/Birthday/Basic.lean | 156 + .../CombinatorialGames/Surreal/Division.lean | 530 +++ .../CombinatorialGames/Surreal/Dyadic.lean | 650 ++++ .../Surreal/HahnSeries.lean | 9 + .../Surreal/HahnSeries/Basic.lean | 534 +++ .../CombinatorialGames/Surreal/Leading.lean | 310 ++ .../Surreal/Multiplication.lean | 641 ++++ .../CombinatorialGames/Surreal/Ordinal.lean | 78 + .../CombinatorialGames/Surreal/Pow.lean | 861 +++++ .../CombinatorialGames/Surreal/Real.lean | 737 ++++ .../CombinatorialGames/Tactic.lean | 12 + .../Tactic/AddInstances.lean | 41 + .../CombinatorialGames/Tactic/GameCmp.lean | 74 + .../Tactic/OrdinalAlias.lean | 206 ++ .../CombinatorialGames/Tactic/Register.lean | 18 + .../ConwayRefinement/ConwayRefinement.lean | 17 + .../ConwayRefinement/Algebra.lean | 19 + .../ConwayRefinement/Algebra/DirectSum.lean | 18 + .../Algebra/DirectSum/GermChainRule.lean | 153 + .../DirectSum/GermFinitePartIdeal.lean | 294 ++ .../Algebra/DirectSum/GermPolynomial.lean | 550 +++ .../Algebra/DirectSum/GermSuccessorStep.lean | 596 ++++ .../Algebra/DirectSum/GermSyzygy.lean | 388 +++ .../DirectSum/HomogeneousDivisibility.lean | 84 + .../Algebra/DirectSum/HomogeneousPrime.lean | 171 + .../Algebra/DirectSum/InternalGrading.lean | 119 + .../Algebra/DirectSum/LeadingGrade.lean | 229 ++ .../Algebra/DirectSum/TrailingGrade.lean | 191 ++ .../Algebra/Divisibility.lean | 14 + .../Divisibility/DenominatorIdeal.lean | 171 + .../Algebra/Divisibility/MaximalDivisor.lean | 97 + .../Algebra/Divisibility/PrimalPreimage.lean | 802 +++++ .../Algebra/Divisibility/PrimalProduct.lean | 32 + .../Algebra/Divisibility/Refinement.lean | 221 ++ .../Algebra/Divisibility/Tests.lean | 9 + .../Divisibility/Tests/Refinement.lean | 44 + .../Algebra/GeometricIntegrality.lean | 213 ++ .../ConwayRefinement/Algebra/GradedRing.lean | 13 + .../Algebra/GradedRing/Extension.lean | 279 ++ .../GradedRing/FinitePartSubstitution.lean | 105 + .../Algebra/GradedRing/HomogeneousSpan.lean | 123 + .../GradedRing/HomogeneousZeroDivisors.lean | 35 + .../Algebra/GradedRing/OrdinalGenerators.lean | 613 ++++ .../Algebra/LoweringDerivation.lean | 15 + .../LoweringDerivation/BaseChange.lean | 351 ++ .../LoweringDerivation/Correction.lean | 584 ++++ .../LoweringDerivation/FilteredModule.lean | 521 +++ .../Algebra/LoweringDerivation/Grading.lean | 322 ++ .../LoweringDerivation/IdealGEGraded.lean | 386 +++ .../Algebra/LoweringDerivation/Mu.lean | 529 +++ .../LoweringDerivation/Polynomial.lean | 218 ++ .../Algebra/MonoidAlgebra.lean | 10 + .../MonoidAlgebra/LatticeFunctional.lean | 115 + .../MonoidAlgebra/SingleZeroFactors.lean | 135 + .../Algebra/MvPolynomial.lean | 24 + .../Algebra/MvPolynomial/BaseChange.lean | 130 + .../Algebra/MvPolynomial/Components.lean | 115 + .../Algebra/MvPolynomial/ComponentsSpan.lean | 109 + .../Algebra/MvPolynomial/Expansion.lean | 262 ++ .../MvPolynomial/FinitePartDecomposition.lean | 126 + .../MvPolynomial/FinitePartErasure.lean | 200 ++ .../Algebra/MvPolynomial/FinitePartVars.lean | 112 + .../Algebra/MvPolynomial/GCDMonoid.lean | 189 + .../LimitOrdinalContradiction.lean | 625 ++++ .../Algebra/MvPolynomial/MapWeight.lean | 46 + .../MvPolynomial/OrdinalDerivation.lean | 414 +++ .../MvPolynomial/OrdinalExpansion.lean | 124 + .../Algebra/MvPolynomial/RemainderBound.lean | 156 + .../Algebra/MvPolynomial/Syzygy.lean | 203 ++ .../Algebra/MvPolynomial/TermDegree.lean | 148 + .../MvPolynomial/WeightedTotalDegree.lean | 177 + .../ConwayRefinement/Algebra/Order.lean | 12 + .../Algebra/Order/ArchimedeanBall.lean | 52 + .../Algebra/Order/ArchimedeanQuotient.lean | 263 ++ .../Algebra/Order/ConvexQuotient.lean | 185 + .../Algebra/Order/Module.lean | 11 + .../Module/ArchimedeanBallSplitting.lean | 165 + .../Order/Module/ConvexQuotientSplitting.lean | 171 + .../Algebra/Order/Module/Tests.lean | 9 + .../Tests/ArchimedeanBallSplitting.lean | 58 + .../ConwayRefinement/Algebra/Ring.lean | 9 + .../ConwayRefinement/Algebra/Ring/Hom.lean | 9 + .../Algebra/Ring/Hom/OfInjectiveComp.lean | 52 + .../ConwayRefinement/Algebra/Tests.lean | 9 + .../Algebra/Tests/GeometricIntegrality.lean | 65 + .../ConwayRefinement/Algebra/Valuation.lean | 30 + .../AssociatedGradedDivisibility.lean | 268 ++ .../Valuation/AssociatedGradedValuation.lean | 136 + .../Algebra/Valuation/BasisOver.lean | 687 ++++ .../Valuation/DegreeAssociatedGraded.lean | 496 +++ .../DegreeAssociatedGradedDomain.lean | 200 ++ .../Valuation/DegreeAssociatedGradedMap.lean | 291 ++ .../DegreeAssociatedGradedQuotient.lean | 348 ++ .../Algebra/Valuation/DegreeInitialForm.lean | 198 ++ .../Algebra/Valuation/DegreeOver.lean | 251 ++ .../DegreePrincipalInitialIdeal.lean | 200 ++ .../Valuation/DegreeRepresentatives.lean | 251 ++ .../Algebra/Valuation/DegreeScalar.lean | 102 + .../Algebra/Valuation/DegreeSum.lean | 159 + .../Valuation/DegreeWeightedPolynomial.lean | 239 ++ .../Algebra/Valuation/FiltrationDegree.lean | 255 ++ .../Algebra/Valuation/MaxAddDegree.lean | 209 ++ .../Algebra/Valuation/OfValuation.lean | 67 + .../Algebra/Valuation/QuotientDegree.lean | 213 ++ .../Algebra/Valuation/RV.lean | 400 +++ .../Algebra/Valuation/Residue.lean | 180 + .../Algebra/Valuation/ResidueMathlib.lean | 74 + .../Algebra/Valuation/Tests.lean | 17 + .../Valuation/Tests/AssociatedGraded.lean | 193 ++ .../Tests/AssociatedGradedValuation.lean | 113 + .../Tests/DegreeAssociatedGraded.lean | 63 + .../Tests/DegreeAssociatedGradedQuotient.lean | 156 + .../Valuation/Tests/FiltrationDegree.lean | 78 + .../Algebra/Valuation/Tests/Fixtures.lean | 11 + .../Fixtures/PolynomialAssociatedGraded.lean | 45 + .../Tests/Fixtures/PolynomialDegree.lean | 48 + .../Fixtures/PolynomialQuotientDegree.lean | 74 + .../Valuation/Tests/QuotientDegree.lean | 58 + .../Algebra/Valuation/Tests/RV.lean | 119 + .../Algebra/Valuation/Tests/Residue.lean | 176 + .../ConwayRefinement/Blueprint.lean | 214 ++ .../ConwayRefinement/Data.lean | 9 + .../ConwayRefinement/Data/Multiset.lean | 10 + .../Data/Multiset/SelectionComplexity.lean | 405 +++ .../ConwayRefinement/Data/Multiset/Tests.lean | 9 + .../Multiset/Tests/SelectionComplexity.lean | 105 + .../ConwayRefinement/Examples.lean | 9 + .../Examples/OmnificInteger.lean | 13 + .../OmnificInteger/DegreeTwoNormalForm.lean | 175 + .../OmnificInteger/DegreeTwoPrime.lean | 237 ++ .../OmnificInteger/OneRowNormalForm.lean | 121 + .../Examples/OmnificInteger/OneRowPrime.lean | 169 + .../OmnificInteger/ZFCDegreeTwoPrime.lean | 77 + .../ConwayRefinement/FieldTheory.lean | 12 + .../LatticeFactorCoefficients.lean | 127 + .../LaurentFactorCoefficients.lean | 174 + .../FieldTheory/MonicFactorCoefficients.lean | 86 + .../FieldTheory/RelativeAlgebraicClosure.lean | 68 + .../ConwayRefinement/HahnSeries.lean | 71 + .../HahnSeries/ArchimedeanSplitting.lean | 63 + .../HahnSeries/CardinalTruncation.lean | 320 ++ .../CardinalTruncationDomainEmbedding.lean | 363 ++ .../CardinalTruncationDomainEquiv.lean | 135 + .../CardinalTruncationIrreducible.lean | 95 + .../HahnSeries/CardinalTruncationResidue.lean | 248 ++ .../ConwayRefinement/HahnSeries/CharZero.lean | 34 + .../HahnSeries/CoefficientMap.lean | 86 + .../HahnSeries/ConvexFactorSupport.lean | 94 + .../HahnSeries/ConvexQuotientSplitting.lean | 716 ++++ .../ConwayRefinement/HahnSeries/Degree.lean | 12 + .../Degree/PrincipalMultiplicativity.lean | 54 + .../HahnSeries/Degree/Statements.lean | 11 + .../HahnSeries/Degree/Statements/Degree.lean | 75 + .../Degree/Statements/DegreeResidue.lean | 59 + .../Degree/Statements/DegreeValuation.lean | 40 + .../SupportSupremumMultiplicativity.lean | 168 + .../HahnSeries/Degree/Tests.lean | 9 + .../SupportSupremumMultiplicativity.lean | 121 + .../HahnSeries/DegreeTermCount.lean | 91 + .../HahnSeries/DegreeValuation.lean | 105 + .../ConwayRefinement/HahnSeries/Domain.lean | 90 + .../HahnSeries/DomainEmbedding.lean | 185 + .../HahnSeries/DomainEquiv.lean | 97 + .../HahnSeries/DomainOrderType.lean | 86 + .../HahnSeries/EPrimitive.lean | 332 ++ .../HahnSeries/FactorCoefficients.lean | 99 + .../HahnSeries/Factorization.lean | 34 + .../Factorization/AlmostIrreducible.lean | 187 + .../AlmostIrreducibleFactorization.lean | 132 + .../HahnSeries/Factorization/DegreeTwo.lean | 14 + .../Factorization/DegreeTwo/DegreeTwo.lean | 267 ++ .../DegreeTwo/DegreeTwoExample.lean | 773 +++++ .../DegreeTwo/Factorization.lean | 143 + .../FactorizationClassification.lean | 320 ++ .../TranslatedSpanFactorization.lean | 442 +++ .../DegreeTwo/TranslatedTruncationSpan.lean | 132 + .../FiniteSupportFactorUniqueness.lean | 280 ++ .../HahnSeries/Factorization/GermLike.lean | 339 ++ .../Factorization/GradedDivisibility.lean | 222 ++ .../Factorization/InfiniteSupport.lean | 298 ++ .../Factorization/MaximalFinite.lean | 597 ++++ .../MaximalFiniteMultiplicativity.lean | 105 + .../Factorization/NormalizedHPart.lean | 173 + .../NormalizedHPartMultiplicativity.lean | 111 + .../Factorization/NormalizedHPartSeries.lean | 83 + .../NormalizedMaximalFinite.lean | 252 ++ .../NormalizedSeriesMaximalFinite.lean | 267 ++ .../HahnSeries/Factorization/PreSchreier.lean | 67 + .../Factorization/PrincipalMaximalFinite.lean | 195 ++ .../PrincipalSubringLocalization.lean | 69 + .../PrincipalSubringPrimality.lean | 91 + .../Factorization/RVGradedMaximalFinite.lean | 79 + .../Factorization/RVMaximalFinite.lean | 575 ++++ .../HahnSeries/Factorization/Random.lean | 23 + .../Random/ClassIrreducible.lean | 94 + .../Random/CoefficientRandom.lean | 179 + .../Random/GradedIrreducible.lean | 507 +++ .../Random/HereditaryIndependence.lean | 174 + .../Random/IndependenceWindow.lean | 154 + .../Factorization/Random/MainTheorem.lean | 99 + .../Random/NonPrincipalIrreducible.lean | 266 ++ .../Random/NormalFormBlocks.lean | 323 ++ .../Random/PrincipalIrreducible.lean | 100 + .../Factorization/Random/Random.lean | 150 + .../Factorization/Random/RandomBlocks.lean | 325 ++ .../Factorization/Random/ReducibleSpan.lean | 313 ++ .../Factorization/Random/SuccessorStep.lean | 491 +++ .../Factorization/Random/SupportRandom.lean | 176 + .../Random/TruncationIndependence.lean | 167 + .../Factorization/SeriesMaximalFinite.lean | 382 +++ .../SeriesMaximalMultiplicativity.lean | 412 +++ .../Factorization/SeriesPrimality.lean | 87 + .../HahnSeries/Factorization/Statements.lean | 19 + .../Statements/Factorization.lean | 82 + .../FiniteSupportFactorUniqueness.lean | 56 + .../MaximalFiniteMultiplicativity.lean | 72 + .../MaximalFiniteSupportDivisor.lean | 204 ++ .../PrincipalDivisibilityReflection.lean | 47 + .../Statements/PrincipalMaximalDivisor.lean | 65 + .../PrincipalScalarRedistribution.lean | 63 + .../Statements/PrincipalSubringFraction.lean | 50 + .../Statements/PrincipalSubringPrimality.lean | 72 + .../SeriesMaximalFiniteSupportDivisor.lean | 156 + .../Statements/SeriesPrimality.lean | 89 + .../HahnSeries/Factorization/Tests.lean | 20 + .../Tests/AlmostIrreducible.lean | 82 + .../Tests/AlmostIrreducibleFactorization.lean | 68 + .../Factorization/Tests/DegreeTwo.lean | 11 + .../FactorizationClassification.lean | 48 + .../TranslatedSpanFactorization.lean | 50 + .../DegreeTwo/TranslatedTruncationSpan.lean | 62 + .../Tests/GermLikeFactorization.lean | 61 + .../Tests/GradedDivisibility.lean | 302 ++ .../Tests/InfiniteSupportFactorization.lean | 88 + .../Tests/MaximalFiniteSupportDivisor.lean | 295 ++ .../Factorization/Tests/NormalizedHPart.lean | 96 + .../NormalizedHPartMultiplicativity.lean | 98 + .../PrincipalMaximalFiniteSupportDivisor.lean | 246 ++ .../Factorization/Tests/SectionSixFour.lean | 105 + .../SeriesMaximalFiniteSupportDivisor.lean | 319 ++ .../HahnSeries/FiniteSupport.lean | 340 ++ .../FiniteSupportConstantTermOne.lean | 70 + .../HahnSeries/FiniteSupportGCDProof.lean | 220 ++ .../FiniteSupportMonoidAlgebra.lean | 133 + .../FiniteSupportNormalization.lean | 329 ++ .../FiniteSupportNormalizedGCD.lean | 84 + .../HahnSeries/FiniteSupportResidue.lean | 127 + .../FiniteSupportScalarExtension.lean | 456 +++ .../HahnSeries/FiniteSupportScalarTensor.lean | 73 + .../HahnSeries/FiniteSupportUnit.lean | 98 + .../ConwayRefinement/HahnSeries/Germ.lean | 9 + .../Germ/AlgebraicIndependence.lean | 49 + .../Germ/AlgebraicIndependence/Additive.lean | 204 ++ .../AlgebraicIndependence.lean | 326 ++ .../Germ/AlgebraicIndependence/Boundary.lean | 99 + .../AlgebraicIndependence/Cancellation.lean | 304 ++ .../CantorBendixsonRankLevels.lean | 198 ++ .../CantorBendixsonValue.lean | 173 + .../CantorBendixsonValueMultiplicativity.lean | 300 ++ .../CofactorInduction.lean | 2077 +++++++++++ .../AlgebraicIndependence/Convolution.lean | 216 ++ .../AlgebraicIndependence/Derivation.lean | 274 ++ .../DerivationIdeal.lean | 335 ++ .../AlgebraicIndependence/DerivationSet.lean | 122 + .../AlgebraicIndependence/Derivative.lean | 441 +++ .../Germ/AlgebraicIndependence/Germ.lean | 110 + .../GlobalCofactors.lean | 158 + .../Germ/AlgebraicIndependence/Graded.lean | 120 + .../LeadingCoefficient.lean | 244 ++ .../Germ/AlgebraicIndependence/Leibniz.lean | 246 ++ .../AlgebraicIndependence/LiftFamily.lean | 207 ++ .../Germ/AlgebraicIndependence/Lifts.lean | 393 +++ .../LimitOrdinalEvaluation.lean | 302 ++ .../LimitOrdinalRelationAtCutoff.lean | 494 +++ .../AlgebraicIndependence/LinearMaximal.lean | 218 ++ .../LowerTruncationDegree.lean | 959 ++++++ .../AlgebraicIndependence/Multiplication.lean | 187 + .../AlgebraicIndependence/Obligations.lean | 131 + .../OrderedIntervalCantorBendixson.lean | 193 ++ .../PartialDerivativeIndices.lean | 352 ++ .../PartialDerivativesAtLimitOrdinal.lean | 365 ++ .../Germ/AlgebraicIndependence/Power.lean | 270 ++ .../PrincipalSeries.lean | 84 + .../Germ/AlgebraicIndependence/Scalar.lean | 376 ++ ...calarLeadingCoefficientAtLimitOrdinal.lean | 238 ++ .../SeparatedPieceCantorBendixson.lean | 274 ++ .../SuccessorLeibniz.lean | 198 ++ .../SyzygyIntegration.lean | 210 ++ .../TranslatedTruncationInterpolation.lean | 530 +++ ...anslatedTruncationInterpolationOnSets.lean | 197 ++ .../AlgebraicIndependence/Truncation.lean | 274 ++ .../TruncationExpansion.lean | 633 ++++ .../TruncationPolynomial.lean | 1230 +++++++ .../HahnSeries/IntegerPart.lean | 31 + .../HahnSeries/IntegerPart/Assumptions.lean | 117 + .../CardinalFiniteClassReduction.lean | 154 + .../CardinalIntegerPartSplitting.lean | 433 +++ .../CardinalPrimalityTransfer.lean | 144 + .../IntegerPart/CardinalProposition922.lean | 588 ++++ .../IntegerPart/CardinalSplitting.lean | 282 ++ .../IntegerPart/ClassTruncation.lean | 269 ++ .../IntegerPart/FiniteClassPrimality.lean | 283 ++ .../IntegerPart/FiniteClassReduction.lean | 218 ++ .../IntegerPart/IntegerPartSplitting.lean | 328 ++ .../IntegerPart/IrreducibilityTransfer.lean | 196 ++ .../IntegerPart/LimitTailPrimality.lean | 255 ++ .../IntegerPart/PrimalityTransfer.lean | 339 ++ .../HahnSeries/IntegerPart/Reduced.lean | 51 + .../IntegerPart/ReducedCharacterization.lean | 192 ++ .../IntegerPart/ReducedDivisibility.lean | 115 + .../IntegerPart/ReducedPrimality.lean | 93 + .../HahnSeries/IntegerPart/Reduction.lean | 564 +++ .../HahnSeries/IntegerPart/Refinement.lean | 18 + .../Refinement/CardinalGermRefinement.lean | 330 ++ .../CardinalTruncationClosedClass.lean | 353 ++ .../ClosedClassRefinementTransport.lean | 398 +++ .../Refinement/CompleteGermRefinement.lean | 86 + .../ConvexRestrictionFactorization.lean | 349 ++ .../Refinement/FiniteGermError.lean | 337 ++ .../Refinement/LimitTailRefinement.lean | 286 ++ .../Refinement/SupportClassFactorization.lean | 125 + .../Refinement/SupportClassRefinement.lean | 360 ++ .../TruncationIntegerPartFractionField.lean | 296 ++ .../IntegerPart/SplitTruncation.lean | 130 + .../HahnSeries/IntegerPart/Tests.lean | 23 + .../IntegerPart/Tests/Assumptions.lean | 92 + .../HahnSeries/IntegerPart/Tests/Basic.lean | 90 + .../Tests/CardinalPrimalityTransfer.lean | 60 + .../Tests/CardinalProposition922.lean | 74 + .../IntegerPart/Tests/ClassTruncation.lean | 64 + .../Tests/FiniteClassReduction.lean | 80 + .../Tests/IntegerPartSplitting.lean | 53 + .../IntegerPart/Tests/PrimalityTransfer.lean | 85 + .../HahnSeries/IntegerPart/Tests/Reduced.lean | 79 + .../Tests/ReducedCharacterization.lean | 96 + .../Tests/ReducedDivisibility.lean | 46 + .../IntegerPart/Tests/Reduction.lean | 85 + .../IntegerPart/Tests/SplitTruncation.lean | 77 + .../Tests/TruncationDivisibility.lean | 54 + .../Tests/TruncationPrimality.lean | 32 + .../IntegerPart/TruncationDivisibility.lean | 218 ++ .../IntegerPart/TruncationPrimality.lean | 164 + .../ConwayRefinement/HahnSeries/Iterate.lean | 171 + .../HahnSeries/IterateOrderType.lean | 64 + .../HahnSeries/LimitTailQuotient.lean | 145 + .../ConwayRefinement/HahnSeries/Monomial.lean | 173 + .../HahnSeries/Multiplicativity.lean | 572 ++++ .../ConwayRefinement/HahnSeries/Negative.lean | 256 ++ .../HahnSeries/NegativeMonomialIdeal.lean | 147 + .../HahnSeries/Nonpositive.lean | 152 + .../HahnSeries/NonpositiveCoefficientMap.lean | 105 + .../HahnSeries/NonpositiveDomainEquiv.lean | 96 + .../HahnSeries/NormalForm.lean | 499 +++ .../HahnSeries/OrderType.lean | 552 +++ .../HahnSeries/OrderedIntervalSum.lean | 85 + .../HahnSeries/OrdinalValue.lean | 59 + .../OrdinalValue/AlgebraicIndependence.lean | 48 + .../AlgebraicIndependence/BaseChange.lean | 415 +++ .../CantorBendixsonGrading.lean | 184 + .../CantorBendixsonRank.lean | 222 ++ .../CantorBendixsonRepresentatives.lean | 121 + .../CombinedCofactors.lean | 233 ++ .../AlgebraicIndependence/DerivAt.lean | 293 ++ .../DerivAtInjective.lean | 317 ++ .../DerivationIdeal.lean | 256 ++ .../IdealFromTruncations.lean | 280 ++ .../InductionOverDegrees.lean | 228 ++ .../LeadingCoefficient.lean | 645 ++++ .../AlgebraicIndependence/Lifts.lean | 615 ++++ .../LimitOrdinalRelationAtCutoff.lean | 386 +++ .../AlgebraicIndependence/LinearMaximal.lean | 178 + .../AlgebraicIndependence/LowDegreeParts.lean | 409 +++ .../LoweringDerivation.lean | 306 ++ .../AlgebraicIndependence/OmegaSupport.lean | 424 +++ .../OrdinalValueCutoffs.lean | 379 ++ .../PartialDerivativeIndices.lean | 377 ++ .../AlgebraicIndependence/Partials.lean | 415 +++ .../AlgebraicIndependence/Pieces.lean | 245 ++ .../AlgebraicIndependence/Polynomiality.lean | 113 + .../PrincipalGraded.lean | 831 +++++ .../PrincipalIdealGE.lean | 69 + .../PrincipalRepresentatives.lean | 260 ++ .../ProductCondition.lean | 181 + .../ProductTruncation.lean | 88 + .../AlgebraicIndependence/ProductValues.lean | 128 + .../AlgebraicIndependence/RealPartials.lean | 227 ++ .../SeriesTruncations.lean | 136 + .../AlgebraicIndependence/Shift.lean | 126 + .../SuccessorLeibniz.lean | 205 ++ .../SuccessorSupportBound.lean | 338 ++ .../SumAlongCutoffs.lean | 377 ++ .../SupportLoweringPieces.lean | 437 +++ .../AlgebraicIndependence/Syzygy.lean | 251 ++ .../TruncationExpansion.lean | 589 ++++ .../TruncationPolynomial.lean | 463 +++ .../TruncationsIdeal.lean | 162 + .../UnboundedTruncations.lean | 260 ++ .../OrdinalValue/CoefficientMap.lean | 38 + .../OrdinalValue/ComplexityDecrease.lean | 248 ++ .../HahnSeries/OrdinalValue/Convolution.lean | 179 + .../OrdinalValue/ConvolutionList.lean | 146 + .../OrdinalValue/ConvolutionRemainder.lean | 202 ++ .../OrdinalValue/CriticalPoint.lean | 234 ++ .../OrdinalValue/CriticalPointExistence.lean | 250 ++ .../OrdinalValue/FormalExpression.lean | 237 ++ .../HahnSeries/OrdinalValue/Germ.lean | 226 ++ .../HahnSeries/OrdinalValue/GermDegree.lean | 44 + .../HahnSeries/OrdinalValue/GermValueCut.lean | 111 + .../OrdinalValue/Irreducibility.lean | 336 ++ .../OrdinalValue/LeibnizRemainder.lean | 192 ++ .../HahnSeries/OrdinalValue/MainLemma.lean | 209 ++ .../HahnSeries/OrdinalValue/OneRow.lean | 262 ++ .../OrderTypeMultiplicativity.lean | 214 ++ .../HahnSeries/OrdinalValue/OrdinalValue.lean | 422 +++ .../OrdinalValue/OrdinalValueConstantMul.lean | 139 + .../OrdinalValue/OrdinalValueDegree.lean | 329 ++ .../OrdinalValueFinalSegment.lean | 305 ++ .../OrdinalValue/OrdinalValueImage.lean | 215 ++ .../OrdinalValueSubmultiplicative.lean | 142 + .../OrdinalValue/OrdinalValueSupport.lean | 85 + .../OrdinalValue/OrdinalValueValuation.lean | 70 + .../OrdinalValue/PowerRemainder.lean | 376 ++ .../OrdinalValue/PrincipalComponent.lean | 461 +++ .../PrincipalComponentDegree.lean | 784 +++++ .../PrincipalComponentTensor.lean | 779 +++++ .../OrdinalValue/PrincipalSubring.lean | 492 +++ .../PrincipalSubringFiniteSupport.lean | 239 ++ .../PrincipalSubringFraction.lean | 228 ++ .../PrincipalSubringFractionAlgebraic.lean | 850 +++++ .../PrincipalSubringLocalization.lean | 411 +++ .../PrincipalSubringMonoidAlgebra.lean | 191 ++ ...cipalSubringScalarRedistributionProof.lean | 231 ++ .../OrdinalValue/PrincipalSubringTensor.lean | 378 ++ .../OrdinalValue/PrincipalValue.lean | 360 ++ .../OrdinalValue/PurePowerRemainder.lean | 88 + .../OrdinalValue/ResidualPoint.lean | 125 + .../OrdinalValue/ResidualPointCofinality.lean | 421 +++ .../OrdinalValue/ResidualPointOrderType.lean | 650 ++++ .../OrdinalValue/ResidualPointSupport.lean | 191 ++ .../OrdinalValue/ResidualPointTail.lean | 95 + .../OrdinalValue/ResidualPointValue.lean | 60 + .../ResidualPointWellOrdered.lean | 51 + .../OrdinalValue/StableInterval.lean | 250 ++ .../HahnSeries/OrdinalValue/Statements.lean | 12 + .../OrdinalValue/Statements/MainLemma.lean | 237 ++ .../Statements/OrdinalValueDegree.lean | 49 + .../OrdinalValue/Statements/ProductValue.lean | 263 ++ .../Statements/ResidualPoint.lean | 117 + .../HahnSeries/OrdinalValue/Tests.lean | 27 + .../Tests/AlgebraicIndependence.lean | 17 + .../AlgebraicIndependence/BaseChange.lean | 193 ++ .../CutoffConvolution.lean | 120 + .../Tests/AlgebraicIndependence/DerivAt.lean | 109 + .../FinitePowerFamily.lean | 81 + .../LoweringDerivation.lean | 64 + .../OmegaOmegaBoundary.lean | 62 + .../PrincipalGraded.lean | 213 ++ .../PrincipalIdealGE.lean | 131 + .../SuccessorLeibniz.lean | 169 + .../Tests/BerarducciPrimitives.lean | 133 + .../Tests/ComplexityDecrease.lean | 54 + .../OrdinalValue/Tests/Convolution.lean | 55 + .../OrdinalValue/Tests/ConvolutionList.lean | 50 + .../Tests/ConvolutionRemainder.lean | 42 + .../OrdinalValue/Tests/CriticalPoint.lean | 111 + .../Tests/OrdinalValueFinalSegment.lean | 120 + .../Tests/OrdinalValueSubmultiplicative.lean | 109 + .../Tests/PrincipalComponent.lean | 165 + .../Tests/PrincipalComponentDegree.lean | 126 + .../Tests/PrincipalComponentTensor.lean | 138 + .../OrdinalValue/Tests/PrincipalSubring.lean | 206 ++ .../Tests/PrincipalSubringFiniteSupport.lean | 238 ++ .../Tests/PrincipalSubringFraction.lean | 166 + .../Tests/PrincipalSubringTensor.lean | 157 + .../OrdinalValue/Tests/PrincipalValue.lean | 105 + .../OrdinalValue/Tests/ResidualPoint.lean | 176 + .../OrdinalValue/Tests/SectionSixThree.lean | 183 + .../HahnSeries/OrdinalValue/Truncation.lean | 228 ++ .../OrdinalValue/TruncationDrop.lean | 169 + .../HahnSeries/PolynomialAlgebra.lean | 14 + .../PolynomialAlgebra/CompleteGerm.lean | 141 + .../CompleteGermOfCauchyComplete.lean | 83 + .../PolynomialAlgebra/InitialForms.lean | 119 + .../PolynomialPresentation.lean | 352 ++ .../PolynomialAlgebra/PolynomialRing.lean | 427 +++ .../HahnSeries/PolynomialAlgebra/Tests.lean | 10 + .../PolynomialAlgebra/Tests/GCDMonoid.lean | 44 + .../Tests/PolynomialRing.lean | 85 + .../HahnSeries/Primality.lean | 15 + .../HahnSeries/Primality/Consequences.lean | 227 ++ .../HahnSeries/Primality/DegreeOne.lean | 116 + .../HahnSeries/Primality/GCDMonoid.lean | 74 + .../Primality/OrdinalValueQuotient.lean | 250 ++ .../HahnSeries/Primality/Primality.lean | 84 + .../HahnSeries/Primality/Random.lean | 156 + .../SupportOrderTypeFactorization.lean | 85 + .../HahnSeries/PrincipalAddition.lean | 340 ++ .../HahnSeries/RealSupportSupremum.lean | 118 + .../HahnSeries/SeparatedPieceSum.lean | 171 + .../HahnSeries/SeparatedSupport.lean | 150 + .../HahnSeries/SourceStatements.lean | 31 + .../HahnSeries/SubgroupAlgebra.lean | 158 + .../HahnSeries/SubgroupGCD.lean | 161 + .../HahnSeries/SubgroupSupport.lean | 143 + .../HahnSeries/SupportArchimedeanClasses.lean | 196 ++ .../HahnSeries/SupportSupremum.lean | 226 ++ .../ConwayRefinement/HahnSeries/Tests.lean | 24 + .../Tests/ArchimedeanSplitting.lean | 40 + .../HahnSeries/Tests/CardinalTruncation.lean | 54 + .../HahnSeries/Tests/FiniteSupportGCD.lean | 108 + .../Tests/FiniteSupportResidue.lean | 129 + .../Tests/FiniteSupportScalarExtension.lean | 198 ++ .../HahnSeries/Tests/Fixtures.lean | 9 + .../Tests/Fixtures/ApproachZero.lean | 168 + .../HahnSeries/Tests/Iterate.lean | 43 + .../HahnSeries/Tests/Multiplicativity.lean | 165 + .../Tests/NegativePresentation.lean | 84 + .../Tests/NonpositiveDomainEquiv.lean | 57 + .../HahnSeries/Tests/NormalForm.lean | 180 + .../HahnSeries/Tests/OrderTypeDegree.lean | 358 ++ .../HahnSeries/Tests/PrincipalAddition.lean | 122 + .../HahnSeries/Tests/Truncation.lean | 265 ++ .../Tests/TruncationIntegerPartPrimal.lean | 58 + .../HahnSeries/Tests/WeakNormalForm.lean | 225 ++ .../HahnSeries/Translation.lean | 192 ++ .../HahnSeries/Truncation.lean | 196 ++ .../TruncationIntegerPartPrimal.lean | 169 + .../HahnSeries/WeakNormalForm.lean | 232 ++ .../ConwayRefinement/LinearAlgebra.lean | 12 + .../AlgebraicIndependentDet.lean | 80 + .../LinearAlgebra/FiniteSpanRelation.lean | 47 + .../LinearAlgebra/IndicatorFinsupp.lean | 97 + .../LinearAlgebra/TensorProduct.lean | 10 + .../LinearAlgebra/TensorProduct/Content.lean | 330 ++ .../TensorProduct/SubalgebraBasis.lean | 112 + .../ConwayRefinement/Order.lean | 11 + .../ConwayRefinement/Order/Archimedean.lean | 54 + .../Order/DifferenceAvoidance.lean | 66 + .../ConwayRefinement/Order/Filter.lean | 11 + .../Order/Filter/FunAtZeroMinus.lean | 382 +++ .../Filter/FunAtZeroMinus/Pointwise.lean | 114 + .../ConwayRefinement/Order/Filter/Germ.lean | 9 + .../Order/Filter/Germ/LinearMap.lean | 194 ++ .../ConwayRefinement/Order/Filter/Tests.lean | 9 + .../Order/Filter/Tests/FunAtZeroMinus.lean | 108 + .../ConwayRefinement/RingTheory.lean | 10 + .../RingTheory/LaurentTower.lean | 81 + .../RingTheory/LocalizationUFM.lean | 123 + .../ConwayRefinement/SetTheory.lean | 11 + .../SetTheory/FinitePWOUnion.lean | 41 + .../ConwayRefinement/SetTheory/Ordinal.lean | 30 + .../Ordinal/AdditivelyPrincipal.lean | 426 +++ .../SetTheory/Ordinal/AlgebraicOrder.lean | 345 ++ .../SetTheory/Ordinal/CantorBendixson.lean | 257 ++ .../SetTheory/Ordinal/CantorTermCount.lean | 148 + .../SetTheory/Ordinal/Degree.lean | 335 ++ .../SetTheory/Ordinal/FinitePart.lean | 353 ++ .../Ordinal/GeneralFactorization.lean | 85 + .../Ordinal/IncreasingSequenceUnion.lean | 298 ++ .../SetTheory/Ordinal/LeastTerm.lean | 445 +++ .../SetTheory/Ordinal/LeastTermSup.lean | 142 + .../Ordinal/MultiplicativelyPrincipal.lean | 610 ++++ .../SetTheory/Ordinal/NaturalOrder.lean | 27 + .../Ordinal/NaturalPowerFactorization.lean | 140 + .../SetTheory/Ordinal/NaturalPrincipal.lean | 135 + .../SetTheory/Ordinal/OrderedUnion.lean | 164 + .../SetTheory/Ordinal/PairBounds.lean | 434 +++ .../SetTheory/Ordinal/Separation.lean | 277 ++ .../SetTheory/Ordinal/SetOrderType.lean | 613 ++++ .../SetTheory/Ordinal/Split.lean | 322 ++ .../Ordinal/SuccessorFactorization.lean | 180 + .../SetTheory/Ordinal/Sumset.lean | 334 ++ .../SetTheory/Ordinal/Tests.lean | 16 + .../Ordinal/Tests/GeneralFactorization.lean | 63 + .../Ordinal/Tests/NaturalPrincipal.lean | 72 + .../SetTheory/Ordinal/Tests/OrderedUnion.lean | 69 + .../Ordinal/Tests/OrdinalFactors.lean | 186 + .../Ordinal/Tests/OrdinalFinitePart.lean | 134 + .../Tests/OrdinalSuccessorFactorization.lean | 133 + .../SetTheory/Ordinal/Tests/SetOrderType.lean | 101 + .../SetTheory/Ordinal/Tests/Sumset.lean | 279 ++ .../ConwayRefinement/SetTheory/ZFC.lean | 11 + .../ConwayRefinement/SetTheory/ZFC/Game.lean | 211 ++ .../SetTheory/ZFC/GameOperations.lean | 303 ++ .../ConwayRefinement/SetTheory/ZFC/Tests.lean | 10 + .../SetTheory/ZFC/Tests/Game.lean | 57 + .../SetTheory/ZFC/Tests/GameOperations.lean | 60 + .../ConwayRefinement/Standalone.lean | 10 + .../Standalone/CombinatorialGames.lean | 14 + .../CombinatorialGames/ConwayRefinement.lean | 57 + .../ConwayRefinementProof.lean | 47 + .../CombinatorialGames/Examples.lean | 20 + .../Examples/DegreeTwoPrime.lean | 93 + .../Examples/DegreeTwoPrimeProof.lean | 143 + .../Examples/FiniteDegreeFamily.lean | 38 + .../Examples/FiniteDegreeFamilyProof.lean | 25 + .../Examples/OmegaOmegaBoundary.lean | 53 + .../Examples/OmegaOmegaBoundaryProof.lean | 28 + .../Examples/OmegaRoots.lean | 55 + .../Examples/OmegaRootsProof.lean | 40 + .../Examples/OmnificFactorization.lean | 81 + .../Examples/OmnificFactorizationProof.lean | 51 + .../Examples/OneRowPrime.lean | 64 + .../Examples/OneRowPrimeProof.lean | 95 + .../PrincipalRVAlgebraicIndependence.lean | 159 + ...PrincipalRVAlgebraicIndependenceProof.lean | 28 + .../CombinatorialGames/Support.lean | 19 + .../Support/ConwayNormalForm.lean | 186 + .../Support/ConwayRefinementConsequences.lean | 37 + .../Support/DegreeTwoExample.lean | 221 ++ .../Support/FinitePowerFamily.lean | 622 ++++ .../Support/FinitePowerFamilyProof.lean | 28 + .../Support/OmegaOmegaBoundary.lean | 516 +++ .../Support/OmnificFactorizationProof.lean | 67 + .../Support/OmnificFiniteDegree.lean | 66 + .../Support/OmnificIntegers.lean | 266 ++ .../Support/OneRowExample.lean | 142 + ...PrincipalRVAlgebraicIndependenceProof.lean | 376 ++ .../ConwayRefinement/Standalone/Mathlib.lean | 22 + .../Standalone/Mathlib/CompleteHahnGerm.lean | 96 + .../Mathlib/CompleteHahnGermProof.lean | 39 + .../Standalone/Mathlib/Examples.lean | 14 + .../Mathlib/Examples/DegreeTwoPrime.lean | 62 + .../Mathlib/Examples/DegreeTwoPrimeProof.lean | 76 + .../HahnIntegerPartRefinementCriterion.lean | 116 + ...hnIntegerPartRefinementCriterionProof.lean | 28 + .../Examples/NegativeMonomialRoots.lean | 55 + .../Examples/NegativeMonomialRootsProof.lean | 80 + .../Mathlib/GermPolynomialRing.lean | 104 + .../Mathlib/GermPolynomialRingProof.lean | 35 + .../Mathlib/HahnIntegerPartRefinement.lean | 65 + .../HahnIntegerPartRefinementProof.lean | 27 + .../Standalone/Mathlib/HahnSeriesGCD.lean | 78 + .../Mathlib/HahnSeriesGCDProof.lean | 51 + .../Mathlib/HahnSeriesPolynomialRing.lean | 76 + .../HahnSeriesPolynomialRingProof.lean | 24 + .../Mathlib/InlineConwayRefinement.lean | 269 ++ .../Mathlib/InlineConwayRefinementProof.lean | 22 + .../Standalone/Mathlib/Support.lean | 23 + .../Mathlib/Support/ArchimedeanQuotient.lean | 267 ++ .../Support/CompleteHahnGermProof.lean | 95 + .../Mathlib/Support/ConvexQuotient.lean | 185 + .../Support/ConvexQuotientSplitting.lean | 177 + .../Mathlib/Support/ConwayRefinement.lean | 55 + .../Support/ConwayRefinementProof.lean | 33 + .../Support/GermPolynomialRingProof.lean | 84 + .../HahnIntegerPartRefinementProof.lean | 943 +++++ .../Support/HahnLimitTailQuotient.lean | 149 + .../Mathlib/Support/HahnSeriesGCDProof.lean | 89 + .../HahnSeriesPolynomialRingProof.lean | 67 + .../Support/InlineConwayRefinementProof.lean | 1242 +++++++ .../Mathlib/Support/InlineSurreal.lean | 3040 +++++++++++++++++ .../Mathlib/Support/OrderedAddGroup.lean | 67 + .../Mathlib/Support/SeriesConsequences.lean | 50 + .../ConwayRefinement/Surreal.lean | 20 + .../Surreal/ArchimedeanAssumptions.lean | 430 +++ .../ConwayRefinement/Surreal/Cardinal.lean | 37 + .../ConwayRefinement/Surreal/CutFilling.lean | 125 + .../ConwayRefinement/Surreal/HahnSeries.lean | 24 + .../HahnSeries/CardinalIntegerPart.lean | 297 ++ .../Surreal/HahnSeries/Degree.lean | 82 + .../Surreal/HahnSeries/DegreeTransfer.lean | 99 + .../Surreal/HahnSeries/Full.lean | 245 ++ .../Surreal/HahnSeries/IntegerPart.lean | 159 + .../Surreal/HahnSeries/Multiplication.lean | 123 + .../Surreal/HahnSeries/NormalForm.lean | 1189 +++++++ .../Surreal/HahnSeries/NormalFormAdd.lean | 393 +++ .../Surreal/HahnSeries/NormalFormBasic.lean | 259 ++ .../Surreal/HahnSeries/NormalFormMul.lean | 1251 +++++++ .../HahnSeries/NormalFormRecursion.lean | 504 +++ .../Surreal/HahnSeries/NormalFormSupport.lean | 158 + .../Surreal/HahnSeries/RealLeadingSplit.lean | 531 +++ .../Surreal/HahnSeries/SignedFull.lean | 167 + .../Surreal/HahnSeries/Tests.lean | 15 + .../HahnSeries/Tests/CardinalIntegerPart.lean | 82 + .../HahnSeries/Tests/DegreeTransfer.lean | 64 + .../Surreal/HahnSeries/Tests/Full.lean | 59 + .../HahnSeries/Tests/Multiplication.lean | 47 + .../Surreal/HahnSeries/Tests/NormalForm.lean | 59 + .../HahnSeries/Tests/NormalFormAdd.lean | 48 + .../HahnSeries/Tests/NormalFormMul.lean | 137 + .../Surreal/HahnSeries/Transfer.lean | 217 ++ .../Surreal/OmnificInteger.lean | 15 + .../Surreal/OmnificInteger/Basic.lean | 325 ++ .../Surreal/OmnificInteger/NormalForm.lean | 139 + .../Surreal/OmnificInteger/Ordinal.lean | 71 + .../Surreal/OmnificInteger/Primality.lean | 13 + .../Primality/FiniteClasses.lean | 186 + .../Primality/IrreducibleOmnificIntegers.lean | 427 +++ .../Primality/OmnificIntegers.lean | 119 + .../Primality/OrdinaryIntegers.lean | 103 + .../Surreal/OmnificInteger/Primality/ZFC.lean | 85 + .../Surreal/OmnificInteger/Refinement.lean | 9 + .../Refinement/ConwayRefinement.lean | 116 + .../OmnificInteger/RefinementConjecture.lean | 41 + .../Surreal/OmnificInteger/Tests.lean | 14 + .../Surreal/OmnificInteger/Tests/Basic.lean | 91 + .../Tests/ConwayRefinement.lean | 58 + .../Tests/DegreeTwoOzPrime.lean | 56 + .../OmnificInteger/Tests/FiniteClasses.lean | 37 + .../OmnificInteger/Tests/NormalForm.lean | 83 + .../Surreal/OmnificInteger/Tests/ZFC.lean | 105 + .../Surreal/RationalTailQuotient.lean | 322 ++ .../Surreal/RealArchimedeanStratum.lean | 183 + .../ConwayRefinement/Surreal/RealModule.lean | 46 + .../ConwayRefinement/Surreal/Round.lean | 241 ++ .../Surreal/SmallDiscrete.lean | 73 + .../ConwayRefinement/Surreal/Tests.lean | 10 + .../Surreal/Tests/ArchimedeanAssumptions.lean | 89 + .../Surreal/Tests/RealModule.lean | 34 + .../ConwayRefinement/Surreal/ZFC.lean | 18 + .../ConwayRefinement/Surreal/ZFC/Basic.lean | 215 ++ .../ConwayRefinement/Surreal/ZFC/Cuts.lean | 214 ++ .../Surreal/ZFC/Identification.lean | 58 + .../Surreal/ZFC/NormalForm.lean | 186 + .../Surreal/ZFC/OmnificCodes.lean | 181 + .../Surreal/ZFC/OmnificInteger.lean | 140 + .../Surreal/ZFC/Properness.lean | 216 ++ .../ConwayRefinement/Surreal/ZFC/Reduced.lean | 99 + .../Surreal/ZFC/Refinement.lean | 42 + .../ConwayRefinement/Surreal/ZFC/Tests.lean | 12 + .../Surreal/ZFC/Tests/Cuts.lean | 103 + .../Surreal/ZFC/Tests/Identification.lean | 65 + .../Surreal/ZFC/Tests/NormalForm.lean | 152 + .../Surreal/ZFC/Tests/Properness.lean | 91 + .../ConwayRefinement/Tests.lean | 10 + .../ConwayRefinement/Tests/SourceIndex.lean | 1214 +++++++ .../ConwayRefinement/Tests/UpstreamReuse.lean | 131 + .../ConwayRefinement/Topology.lean | 14 + .../Topology/CantorBendixson.lean | 190 ++ .../Topology/CantorBendixsonProduct.lean | 56 + .../Topology/CantorBendixsonRank.lean | 144 + .../CantorBendixsonReconstruction.lean | 507 +++ .../ConwayRefinement/Topology/Order.lean | 22 + .../Topology/Order/ArchimedeanBallBase.lean | 218 ++ .../Order/CantorBendixsonAddition.lean | 113 + .../Order/CantorBendixsonConvexCover.lean | 271 ++ .../Topology/Order/ClosedPWO.lean | 466 +++ .../Topology/Order/CoinitialComplete.lean | 238 ++ .../Topology/Order/LeftNeighborhood.lean | 38 + .../Topology/Order/OrderedAddGroup.lean | 65 + .../Topology/Order/OrderedIntervalFamily.lean | 104 + .../Topology/Order/PWOAddition.lean | 211 ++ .../Topology/Order/PWOAdditionFiber.lean | 77 + .../Topology/Order/PWOSumset.lean | 246 ++ .../Topology/Order/SeparatedPieceFamily.lean | 193 ++ .../Topology/Order/SmallClosedSubspace.lean | 227 ++ .../Topology/Order/Tests.lean | 10 + .../Tests/CantorBendixsonConvexCover.lean | 235 ++ .../Topology/Order/Tests/PWOAddition.lean | 1035 ++++++ .../ConwayRefinement/Topology/Tests.lean | 9 + .../Topology/Tests/CantorBendixson.lean | 183 + LeanPool/ConwayRefinement/Solution.lean | 27 + LeanPool/projects.yml | 29 + 775 files changed, 154206 insertions(+) create mode 100644 LeanPool/ConwayRefinement.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Game.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Game/Basic.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Game/Functor.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Game/Ordinal.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Game/Player.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Game/Special.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Mathlib.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Mathlib/Dyadic.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Mathlib/Small.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/NatOrdinal.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/NatOrdinal/Basic.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/NatOrdinal/Pow.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Surreal.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Basic.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Birthday.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Birthday/Basic.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Division.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Dyadic.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries/Basic.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Leading.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Ordinal.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Pow.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Real.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Tactic.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Tactic/AddInstances.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Tactic/GameCmp.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Tactic/OrdinalAlias.lean create mode 100644 LeanPool/ConwayRefinement/CombinatorialGames/Tactic/Register.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermChainRule.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermFinitePartIdeal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermPolynomial.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSyzygy.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/HomogeneousDivisibility.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/HomogeneousPrime.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/InternalGrading.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/LeadingGrade.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/TrailingGrade.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/DenominatorIdeal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/MaximalDivisor.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/PrimalPreimage.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/PrimalProduct.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Refinement.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Tests/Refinement.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GeometricIntegrality.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/Extension.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/FinitePartSubstitution.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/HomogeneousSpan.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/HomogeneousZeroDivisors.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/OrdinalGenerators.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/BaseChange.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Correction.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/FilteredModule.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Grading.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/IdealGEGraded.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Mu.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Polynomial.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MonoidAlgebra.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MonoidAlgebra/LatticeFunctional.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MonoidAlgebra/SingleZeroFactors.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/BaseChange.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Components.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/ComponentsSpan.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Expansion.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartDecomposition.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartErasure.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartVars.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/GCDMonoid.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/LimitOrdinalContradiction.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/MapWeight.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/OrdinalDerivation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/OrdinalExpansion.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/RemainderBound.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Syzygy.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/TermDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/WeightedTotalDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/ArchimedeanBall.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/ArchimedeanQuotient.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/ConvexQuotient.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/ArchimedeanBallSplitting.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/ConvexQuotientSplitting.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/Tests/ArchimedeanBallSplitting.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring/Hom.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring/Hom/OfInjectiveComp.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Tests/GeometricIntegrality.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/AssociatedGradedDivisibility.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/AssociatedGradedValuation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/BasisOver.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGraded.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedDomain.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedMap.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedQuotient.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeInitialForm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeOver.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreePrincipalInitialIdeal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeRepresentatives.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeScalar.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeSum.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeWeightedPolynomial.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/FiltrationDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/MaxAddDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/OfValuation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/QuotientDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/RV.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Residue.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/ResidueMathlib.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGraded.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGradedValuation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/DegreeAssociatedGraded.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/DegreeAssociatedGradedQuotient.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/FiltrationDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures/PolynomialAssociatedGraded.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures/PolynomialDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures/PolynomialQuotientDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/QuotientDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/RV.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Residue.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Blueprint.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Data.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/SelectionComplexity.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/Tests/SelectionComplexity.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Examples.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/DegreeTwoNormalForm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/DegreeTwoPrime.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowNormalForm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowPrime.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/ZFCDegreeTwoPrime.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LatticeFactorCoefficients.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LaurentFactorCoefficients.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/MonicFactorCoefficients.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/RelativeAlgebraicClosure.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ArchimedeanSplitting.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEmbedding.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEquiv.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationIrreducible.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationResidue.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CharZero.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CoefficientMap.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ConvexFactorSupport.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ConvexQuotientSplitting.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/PrincipalMultiplicativity.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/Degree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/DegreeResidue.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/DegreeValuation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/SupportSupremumMultiplicativity.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Tests/SupportSupremumMultiplicativity.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DegreeTermCount.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DegreeValuation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Domain.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainEmbedding.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainEquiv.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainOrderType.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/EPrimitive.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FactorCoefficients.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/AlmostIrreducible.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/AlmostIrreducibleFactorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwo.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwoExample.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/Factorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/FactorizationClassification.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/TranslatedSpanFactorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/TranslatedTruncationSpan.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/FiniteSupportFactorUniqueness.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/GermLike.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/GradedDivisibility.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/InfiniteSupport.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFinite.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFiniteMultiplicativity.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedHPart.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedHPartMultiplicativity.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedHPartSeries.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedMaximalFinite.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedSeriesMaximalFinite.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PreSchreier.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PrincipalMaximalFinite.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PrincipalSubringLocalization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PrincipalSubringPrimality.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/RVGradedMaximalFinite.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/RVMaximalFinite.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/ClassIrreducible.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/CoefficientRandom.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/GradedIrreducible.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/HereditaryIndependence.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/IndependenceWindow.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/MainTheorem.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/NonPrincipalIrreducible.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/NormalFormBlocks.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/PrincipalIrreducible.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/Random.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/RandomBlocks.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/ReducibleSpan.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/SuccessorStep.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/SupportRandom.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/TruncationIndependence.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesMaximalFinite.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesMaximalMultiplicativity.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesPrimality.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/Factorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/FiniteSupportFactorUniqueness.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/MaximalFiniteMultiplicativity.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/MaximalFiniteSupportDivisor.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalDivisibilityReflection.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalMaximalDivisor.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalScalarRedistribution.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalSubringFraction.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalSubringPrimality.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/SeriesMaximalFiniteSupportDivisor.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/SeriesPrimality.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/AlmostIrreducible.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/AlmostIrreducibleFactorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo/FactorizationClassification.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo/TranslatedSpanFactorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo/TranslatedTruncationSpan.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/GermLikeFactorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/GradedDivisibility.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/InfiniteSupportFactorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/MaximalFiniteSupportDivisor.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPart.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPartMultiplicativity.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/PrincipalMaximalFiniteSupportDivisor.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/SectionSixFour.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/SeriesMaximalFiniteSupportDivisor.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupport.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportConstantTermOne.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportGCDProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportMonoidAlgebra.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalizedGCD.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportResidue.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportScalarExtension.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportScalarTensor.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportUnit.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Additive.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/AlgebraicIndependence.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Boundary.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Cancellation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonRankLevels.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonValue.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonValueMultiplicativity.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CofactorInduction.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Convolution.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Derivation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationIdeal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationSet.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Derivative.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Germ.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/GlobalCofactors.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Graded.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LeadingCoefficient.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Leibniz.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LiftFamily.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Lifts.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalEvaluation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LinearMaximal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LowerTruncationDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Multiplication.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Obligations.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/OrderedIntervalCantorBendixson.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativeIndices.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativesAtLimitOrdinal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Power.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PrincipalSeries.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Scalar.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/ScalarLeadingCoefficientAtLimitOrdinal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SeparatedPieceCantorBendixson.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SuccessorLeibniz.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SyzygyIntegration.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolationOnSets.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Truncation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationExpansion.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationPolynomial.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Assumptions.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalFiniteClassReduction.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalIntegerPartSplitting.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalPrimalityTransfer.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalProposition922.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalSplitting.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ClassTruncation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassPrimality.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassReduction.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/IntegerPartSplitting.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/IrreducibilityTransfer.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/LimitTailPrimality.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/PrimalityTransfer.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Reduced.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ReducedCharacterization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ReducedDivisibility.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ReducedPrimality.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Reduction.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CardinalGermRefinement.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CardinalTruncationClosedClass.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/ClosedClassRefinementTransport.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CompleteGermRefinement.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/ConvexRestrictionFactorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/FiniteGermError.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/LimitTailRefinement.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassFactorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassRefinement.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/TruncationIntegerPartFractionField.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/SplitTruncation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Assumptions.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Basic.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/CardinalPrimalityTransfer.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/CardinalProposition922.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ClassTruncation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/FiniteClassReduction.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/IntegerPartSplitting.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/PrimalityTransfer.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Reduced.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ReducedCharacterization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ReducedDivisibility.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Reduction.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/SplitTruncation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/TruncationDivisibility.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/TruncationPrimality.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/TruncationDivisibility.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/TruncationPrimality.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Iterate.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IterateOrderType.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/LimitTailQuotient.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Monomial.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Multiplicativity.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Negative.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NegativeMonomialIdeal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Nonpositive.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NonpositiveCoefficientMap.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NonpositiveDomainEquiv.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NormalForm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrderType.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrderedIntervalSum.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/BaseChange.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CantorBendixsonGrading.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CantorBendixsonRank.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CantorBendixsonRepresentatives.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CombinedCofactors.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivAt.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivAtInjective.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivationIdeal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/IdealFromTruncations.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/InductionOverDegrees.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LeadingCoefficient.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Lifts.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LinearMaximal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LowDegreeParts.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LoweringDerivation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/OmegaSupport.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/OrdinalValueCutoffs.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PartialDerivativeIndices.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Partials.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Pieces.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Polynomiality.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalGraded.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalIdealGE.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalRepresentatives.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductCondition.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductTruncation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductValues.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/RealPartials.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SeriesTruncations.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Shift.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SuccessorLeibniz.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SuccessorSupportBound.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SumAlongCutoffs.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SupportLoweringPieces.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Syzygy.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationExpansion.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationPolynomial.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationsIdeal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/UnboundedTruncations.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CoefficientMap.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ComplexityDecrease.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Convolution.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ConvolutionList.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ConvolutionRemainder.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPoint.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPointExistence.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/FormalExpression.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Germ.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/GermDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/GermValueCut.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Irreducibility.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/LeibnizRemainder.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/MainLemma.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OneRow.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrderTypeMultiplicativity.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValue.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueConstantMul.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueFinalSegment.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueImage.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueSubmultiplicative.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueSupport.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueValuation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PowerRemainder.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponent.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentTensor.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubring.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFiniteSupport.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFraction.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFractionAlgebraic.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringLocalization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringMonoidAlgebra.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringScalarRedistributionProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringTensor.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalValue.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PurePowerRemainder.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPoint.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointCofinality.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointOrderType.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointSupport.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointTail.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointValue.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointWellOrdered.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/StableInterval.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/MainLemma.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/OrdinalValueDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ProductValue.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ResidualPoint.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/BaseChange.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/CutoffConvolution.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/DerivAt.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/FinitePowerFamily.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/LoweringDerivation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/OmegaOmegaBoundary.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/PrincipalGraded.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/PrincipalIdealGE.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/SuccessorLeibniz.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/BerarducciPrimitives.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ComplexityDecrease.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/Convolution.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ConvolutionList.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ConvolutionRemainder.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/CriticalPoint.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/OrdinalValueFinalSegment.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/OrdinalValueSubmultiplicative.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponent.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponentDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponentTensor.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubring.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFiniteSupport.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFraction.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringTensor.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalValue.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ResidualPoint.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/SectionSixThree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Truncation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/TruncationDrop.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/CompleteGerm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/CompleteGermOfCauchyComplete.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/InitialForms.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialPresentation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialRing.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests/GCDMonoid.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests/PolynomialRing.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Consequences.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/DegreeOne.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/GCDMonoid.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/OrdinalValueQuotient.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Primality.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Random.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/SupportOrderTypeFactorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PrincipalAddition.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/RealSupportSupremum.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SeparatedPieceSum.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SeparatedSupport.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SourceStatements.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupAlgebra.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupGCD.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupSupport.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SupportArchimedeanClasses.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SupportSupremum.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/ArchimedeanSplitting.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/CardinalTruncation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportGCD.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportResidue.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportScalarExtension.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Fixtures.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Fixtures/ApproachZero.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Iterate.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Multiplicativity.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NegativePresentation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NonpositiveDomainEquiv.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NormalForm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/OrderTypeDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/PrincipalAddition.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Truncation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/TruncationIntegerPartPrimal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/WeakNormalForm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Translation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Truncation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/TruncationIntegerPartPrimal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/WeakNormalForm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/AlgebraicIndependentDet.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/FiniteSpanRelation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/IndicatorFinsupp.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/Content.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/SubalgebraBasis.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Order.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Order/Archimedean.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Order/DifferenceAvoidance.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/FunAtZeroMinus.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/FunAtZeroMinus/Pointwise.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ/LinearMap.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Tests/FunAtZeroMinus.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/RingTheory.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/RingTheory/LaurentTower.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/RingTheory/LocalizationUFM.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/FinitePWOUnion.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/AdditivelyPrincipal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/AlgebraicOrder.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorBendixson.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorTermCount.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Degree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/FinitePart.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/GeneralFactorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/IncreasingSequenceUnion.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/LeastTerm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/LeastTermSup.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/MultiplicativelyPrincipal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/NaturalOrder.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/NaturalPowerFactorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/NaturalPrincipal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/OrderedUnion.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/PairBounds.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Separation.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/SetOrderType.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Split.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/SuccessorFactorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Sumset.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/GeneralFactorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/NaturalPrincipal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/OrderedUnion.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/OrdinalFactors.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/OrdinalFinitePart.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/OrdinalSuccessorFactorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/SetOrderType.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/Sumset.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Game.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/GameOperations.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Tests/Game.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Tests/GameOperations.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/ConwayRefinement.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/ConwayRefinementProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/DegreeTwoPrime.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/DegreeTwoPrimeProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/FiniteDegreeFamily.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/FiniteDegreeFamilyProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmegaOmegaBoundary.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmegaOmegaBoundaryProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmegaRoots.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmegaRootsProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmnificFactorization.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmnificFactorizationProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OneRowPrime.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OneRowPrimeProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/PrincipalRVAlgebraicIndependence.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/PrincipalRVAlgebraicIndependenceProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/ConwayNormalForm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/ConwayRefinementConsequences.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/DegreeTwoExample.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamily.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamilyProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmegaOmegaBoundary.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmnificFactorizationProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmnificFiniteDegree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmnificIntegers.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OneRowExample.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/PrincipalRVAlgebraicIndependenceProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/CompleteHahnGerm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/CompleteHahnGermProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/DegreeTwoPrime.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/DegreeTwoPrimeProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/HahnIntegerPartRefinementCriterion.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/HahnIntegerPartRefinementCriterionProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/NegativeMonomialRoots.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/NegativeMonomialRootsProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/GermPolynomialRing.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/GermPolynomialRingProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnIntegerPartRefinement.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnIntegerPartRefinementProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesGCD.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesGCDProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesPolynomialRing.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesPolynomialRingProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/InlineConwayRefinement.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/InlineConwayRefinementProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ArchimedeanQuotient.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/CompleteHahnGermProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConvexQuotient.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConvexQuotientSplitting.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConwayRefinement.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConwayRefinementProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/GermPolynomialRingProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnIntegerPartRefinementProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnLimitTailQuotient.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesGCDProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesPolynomialRingProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/OrderedAddGroup.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/SeriesConsequences.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ArchimedeanAssumptions.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Cardinal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/CutFilling.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/CardinalIntegerPart.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Degree.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/DegreeTransfer.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Full.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/IntegerPart.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Multiplication.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalForm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormAdd.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormBasic.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormMul.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormRecursion.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormSupport.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/RealLeadingSplit.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/SignedFull.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/CardinalIntegerPart.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/DegreeTransfer.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/Full.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/Multiplication.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/NormalForm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/NormalFormAdd.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/NormalFormMul.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Transfer.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Basic.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/NormalForm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Ordinal.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/FiniteClasses.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/IrreducibleOmnificIntegers.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/OmnificIntegers.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/OrdinaryIntegers.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/ZFC.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Refinement.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Refinement/ConwayRefinement.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/RefinementConjecture.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/Basic.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/ConwayRefinement.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/DegreeTwoOzPrime.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/FiniteClasses.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/NormalForm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/ZFC.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/RationalTailQuotient.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/RealArchimedeanStratum.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/RealModule.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Round.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/SmallDiscrete.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Tests/ArchimedeanAssumptions.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Tests/RealModule.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Basic.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Cuts.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Identification.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/NormalForm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/OmnificCodes.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/OmnificInteger.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Properness.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Reduced.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Refinement.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/Cuts.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/Identification.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/NormalForm.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/Properness.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Tests/SourceIndex.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Tests/UpstreamReuse.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixson.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonProduct.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonRank.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonReconstruction.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ArchimedeanBallBase.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CantorBendixsonAddition.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CantorBendixsonConvexCover.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ClosedPWO.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CoinitialComplete.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/LeftNeighborhood.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/OrderedAddGroup.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/OrderedIntervalFamily.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOAddition.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOAdditionFiber.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOSumset.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SeparatedPieceFamily.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SmallClosedSubspace.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/CantorBendixsonConvexCover.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/PWOAddition.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Tests.lean create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Topology/Tests/CantorBendixson.lean create mode 100644 LeanPool/ConwayRefinement/Solution.lean diff --git a/LeanPool.lean b/LeanPool.lean index 50fa6e5b30..756afe4725 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -866,6 +866,779 @@ import LeanPool.ConnesRigidity.Paper.Section6.QuotientModuleTransport import LeanPool.ConnesRigidity.Paper.Section7 import LeanPool.ConnesRigidity.Paper.Section7.TheoremACompletion import LeanPool.ConnesRigidity.Porting.CoreTransfer +import LeanPool.ConwayRefinement +import LeanPool.ConwayRefinement.CombinatorialGames +import LeanPool.ConwayRefinement.CombinatorialGames.Game +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Basic +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Birthday +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Classes +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Functor +import LeanPool.ConwayRefinement.CombinatorialGames.Game.IGame +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Ordinal +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Player +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Special +import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib +import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Dyadic +import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Small +import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal +import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Basic +import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Basic +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Birthday +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Birthday.Basic +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Division +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Dyadic +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Leading +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Multiplication +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Ordinal +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Pow +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Real +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.AddInstances +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.GameCmp +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.OrdinalAlias +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.Register +import LeanPool.ConwayRefinement.ConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermChainRule +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermFinitePartIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermPolynomial +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSuccessorStep +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSyzygy +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.InternalGrading +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.LeadingGrade +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.TrailingGrade +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.DenominatorIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.MaximalDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalProduct +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Tests.Refinement +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GeometricIntegrality +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.Extension +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.FinitePartSubstitution +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousZeroDivisors +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.OrdinalGenerators +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.BaseChange +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Correction +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.FilteredModule +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Grading +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.IdealGEGraded +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Mu +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Polynomial +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.LatticeFunctional +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.SingleZeroFactors +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.BaseChange +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Components +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Expansion +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartDecomposition +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartErasure +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartVars +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.GCDMonoid +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.LimitOrdinalContradiction +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.MapWeight +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalDerivation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalExpansion +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.RemainderBound +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Syzygy +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.TermDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.WeightedTotalDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanBall +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ConvexQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ArchimedeanBallSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ConvexQuotientSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.Tests.ArchimedeanBallSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring.Hom +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring.Hom.OfInjectiveComp +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Tests.GeometricIntegrality +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedValuation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.BasisOver +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGraded +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedMap +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeOver +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreePrincipalInitialIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeRepresentatives +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeScalar +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeSum +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeWeightedPolynomial +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.FiltrationDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.MaxAddDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.OfValuation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.QuotientDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.RV +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Residue +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.ResidueMathlib +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.AssociatedGraded +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.AssociatedGradedValuation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.DegreeAssociatedGraded +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.DegreeAssociatedGradedQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.FiltrationDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialAssociatedGraded +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialQuotientDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.QuotientDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.RV +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Residue +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +import LeanPool.ConwayRefinement.ConwayRefinement.Data +import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset +import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.SelectionComplexity +import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.Tests.SelectionComplexity +import LeanPool.ConwayRefinement.ConwayRefinement.Examples +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoNormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowNormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.ZFCDegreeTwoPrime +import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory +import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LatticeFactorCoefficients +import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LaurentFactorCoefficients +import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.MonicFactorCoefficients +import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.RelativeAlgebraicClosure +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ArchimedeanSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEmbedding +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEquiv +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationResidue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CharZero +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CoefficientMap +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexFactorSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexQuotientSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.PrincipalMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeResidue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeValuation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.SupportSupremumMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Tests.SupportSupremumMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeTermCount +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeValuation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Domain +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEmbedding +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEquiv +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.EPrimitive +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FactorCoefficients +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducibleFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwo +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwoExample +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.Factorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.FactorizationClassification +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedSpanFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedTruncationSpan +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.FiniteSupportFactorUniqueness +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GermLike +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GradedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.InfiniteSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFiniteMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPart +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartSeries +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PreSchreier +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringLocalization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVGradedMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ClassIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.CoefficientRandom +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.GradedIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.HereditaryIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.IndependenceWindow +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.MainTheorem +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NonPrincipalIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NormalFormBlocks +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.PrincipalIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.Random +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.RandomBlocks +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ReducibleSpan +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SuccessorStep +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SupportRandom +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.TruncationIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.Factorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.FiniteSupportFactorUniqueness +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteSupportDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalDivisibilityReflection +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalMaximalDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalScalarRedistribution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringFraction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesMaximalFiniteSupportDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducibleFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.FactorizationClassification +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedSpanFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedTruncationSpan +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GermLikeFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GradedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.InfiniteSupportFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.MaximalFiniteSupportDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPart +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPartMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.PrincipalMaximalFiniteSupportDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SectionSixFour +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SeriesMaximalFiniteSupportDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportConstantTermOne +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportMonoidAlgebra +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalizedGCD +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportResidue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarExtension +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Additive +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.AlgebraicIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Boundary +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Cancellation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonRankLevels +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValueMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CofactorInduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Convolution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationSet +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Germ +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.GlobalCofactors +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Graded +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LeadingCoefficient +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Leibniz +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LiftFamily +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Lifts +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalEvaluation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalRelationAtCutoff +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LinearMaximal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LowerTruncationDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Multiplication +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Obligations +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.OrderedIntervalCantorBendixson +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativeIndices +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativesAtLimitOrdinal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Power +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PrincipalSeries +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Scalar +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.ScalarLeadingCoefficientAtLimitOrdinal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SeparatedPieceCantorBendixson +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SuccessorLeibniz +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SyzygyIntegration +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolationOnSets +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Truncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationExpansion +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationPolynomial +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Assumptions +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalFiniteClassReduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalIntegerPartSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalPrimalityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalProposition922 +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ClassTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassReduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IntegerPartSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IrreducibilityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.LimitTailPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.PrimalityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduced +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedCharacterization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalGermRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalTruncationClosedClass +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ClosedClassRefinementTransport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CompleteGermRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ConvexRestrictionFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.FiniteGermError +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.LimitTailRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.TruncationIntegerPartFractionField +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.SplitTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Assumptions +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Basic +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalPrimalityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalProposition922 +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ClassTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.FiniteClassReduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.IntegerPartSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.PrimalityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduced +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ReducedCharacterization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ReducedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.SplitTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.TruncationDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.TruncationPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Iterate +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IterateOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.LimitTailQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Monomial +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Multiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Negative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NegativeMonomialIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveCoefficientMap +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveDomainEquiv +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderedIntervalSum +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.BaseChange +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonGrading +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRank +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRepresentatives +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CombinedCofactors +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAt +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAtInjective +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivationIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.IdealFromTruncations +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.InductionOverDegrees +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LeadingCoefficient +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Lifts +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LimitOrdinalRelationAtCutoff +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LinearMaximal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LowDegreeParts +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LoweringDerivation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OmegaSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OrdinalValueCutoffs +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PartialDerivativeIndices +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Partials +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Pieces +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Polynomiality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalGraded +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalIdealGE +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductCondition +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductValues +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.RealPartials +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SeriesTruncations +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Shift +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorLeibniz +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorSupportBound +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SumAlongCutoffs +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SupportLoweringPieces +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Syzygy +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationExpansion +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationPolynomial +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationsIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.UnboundedTruncations +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CoefficientMap +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ComplexityDecrease +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionList +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPoint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPointExistence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.FormalExpression +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermValueCut +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Irreducibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.LeibnizRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.MainLemma +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OneRow +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrderTypeMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueConstantMul +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSubmultiplicative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueValuation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PowerRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponent +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubring +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFraction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFractionAlgebraic +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringLocalization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringMonoidAlgebra +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringScalarRedistributionProof +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PurePowerRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPoint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointCofinality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointTail +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointWellOrdered +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.MainLemma +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.OrdinalValueDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ResidualPoint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.BaseChange +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.CutoffConvolution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.DerivAt +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.FinitePowerFamily +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.LoweringDerivation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.OmegaOmegaBoundary +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.PrincipalGraded +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.PrincipalIdealGE +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.SuccessorLeibniz +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.BerarducciPrimitives +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ComplexityDecrease +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.Convolution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ConvolutionList +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ConvolutionRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.CriticalPoint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueSubmultiplicative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponent +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponentDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponentTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubring +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFiniteSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFraction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ResidualPoint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.SectionSixThree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.TruncationDrop +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.CompleteGerm +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.CompleteGermOfCauchyComplete +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.InitialForms +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialPresentation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialRing +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests.GCDMonoid +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests.PolynomialRing +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Consequences +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.DegreeOne +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.GCDMonoid +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.OrdinalValueQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Primality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Random +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.SupportOrderTypeFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.RealSupportSupremum +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedPieceSum +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SourceStatements +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupAlgebra +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupGCD +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportArchimedeanClasses +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportSupremum +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.ArchimedeanSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.CardinalTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportGCD +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportResidue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportScalarExtension +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Iterate +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Multiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NegativePresentation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NonpositiveDomainEquiv +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.OrderTypeDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.PrincipalAddition +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Truncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.TruncationIntegerPartPrimal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.WeakNormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Translation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Truncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.TruncationIntegerPartPrimal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.WeakNormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.AlgebraicIndependentDet +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.FiniteSpanRelation +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.IndicatorFinsupp +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.Content +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.SubalgebraBasis +import LeanPool.ConwayRefinement.ConwayRefinement.Order +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Archimedean +import LeanPool.ConwayRefinement.ConwayRefinement.Order.DifferenceAvoidance +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus.Pointwise +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Germ +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Germ.LinearMap +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Tests.FunAtZeroMinus +import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory +import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LaurentTower +import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LocalizationUFM +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.FinitePWOUnion +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AlgebraicOrder +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorBendixson +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorTermCount +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.GeneralFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.IncreasingSequenceUnion +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTerm +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTermSup +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.MultiplicativelyPrincipal +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalOrder +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPowerFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPrincipal +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.OrderedUnion +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.PairBounds +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Separation +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Split +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SuccessorFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Sumset +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.GeneralFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.NaturalPrincipal +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrderedUnion +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalFactors +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalFinitePart +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalSuccessorFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.SetOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.Sumset +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Game +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.GameOperations +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests.Game +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests.GameOperations +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrimeProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamily +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamilyProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundary +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundaryProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRoots +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRootsProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorizationProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrimeProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependenceProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayNormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayRefinementConsequences +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.DegreeTwoExample +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamily +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamilyProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmegaOmegaBoundary +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFactorizationProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFiniteDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificIntegers +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OneRowExample +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.PrincipalRVAlgebraicIndependenceProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGerm +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGermProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrimeProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterion +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterionProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRoots +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRootsProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRing +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRingProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCD +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRing +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRingProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ArchimedeanQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.CompleteHahnGermProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotientSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.GermPolynomialRingProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnIntegerPartRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnLimitTailQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesPolynomialRingProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineConwayRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineSurreal +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.OrderedAddGroup +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.SeriesConsequences +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ArchimedeanAssumptions +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Cardinal +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.CutFilling +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.CardinalIntegerPart +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.DegreeTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Full +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.IntegerPart +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Multiplication +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormAdd +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormBasic +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormMul +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormRecursion +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormSupport +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.RealLeadingSplit +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.SignedFull +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.CardinalIntegerPart +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.DegreeTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.Full +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.Multiplication +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalFormAdd +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalFormMul +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Transfer +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Basic +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Ordinal +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.FiniteClasses +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.IrreducibleOmnificIntegers +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OmnificIntegers +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OrdinaryIntegers +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.ZFC +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Refinement +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Refinement.ConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.RefinementConjecture +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.Basic +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.ConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.DegreeTwoOzPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.FiniteClasses +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.ZFC +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RationalTailQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealArchimedeanStratum +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealModule +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Round +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.SmallDiscrete +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.ArchimedeanAssumptions +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.RealModule +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Basic +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Cuts +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Identification +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificCodes +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificInteger +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Properness +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Reduced +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Refinement +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Cuts +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Identification +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Properness +import LeanPool.ConwayRefinement.ConwayRefinement.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.Tests.SourceIndex +import LeanPool.ConwayRefinement.ConwayRefinement.Tests.UpstreamReuse +import LeanPool.ConwayRefinement.ConwayRefinement.Topology +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixson +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonProduct +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonRank +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonReconstruction +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ArchimedeanBallBase +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonAddition +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonConvexCover +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ClosedPWO +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CoinitialComplete +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedAddGroup +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedIntervalFamily +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAddition +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAdditionFiber +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOSumset +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SeparatedPieceFamily +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SmallClosedSubspace +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests.CantorBendixsonConvexCover +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests.PWOAddition +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Tests.CantorBendixson +import LeanPool.ConwayRefinement.Solution import LeanPool.CramerWold import LeanPool.CriticalPortraits import LeanPool.CriticalPortraits.Census diff --git a/LeanPool/ConwayRefinement.lean b/LeanPool/ConwayRefinement.lean new file mode 100644 index 0000000000..1799953321 --- /dev/null +++ b/LeanPool/ConwayRefinement.lean @@ -0,0 +1,699 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Basic +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Birthday +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Classes +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Functor +import LeanPool.ConwayRefinement.CombinatorialGames.Game.IGame +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Ordinal +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Player +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Special +import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Dyadic +import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Small +import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Basic +import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Basic +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Birthday.Basic +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Division +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Dyadic +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Leading +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Multiplication +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Ordinal +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Pow +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Real +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.AddInstances +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.GameCmp +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.OrdinalAlias +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.Register +import LeanPool.ConwayRefinement.ConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermChainRule +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermFinitePartIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermPolynomial +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSuccessorStep +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSyzygy +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.InternalGrading +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.LeadingGrade +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.TrailingGrade +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.DenominatorIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.MaximalDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalProduct +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Tests.Refinement +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GeometricIntegrality +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.Extension +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.FinitePartSubstitution +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousZeroDivisors +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.OrdinalGenerators +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.BaseChange +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Correction +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.FilteredModule +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Grading +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.IdealGEGraded +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Mu +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Polynomial +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.LatticeFunctional +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.SingleZeroFactors +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.BaseChange +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Components +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Expansion +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartDecomposition +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartErasure +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartVars +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.GCDMonoid +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.LimitOrdinalContradiction +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.MapWeight +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalDerivation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalExpansion +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.RemainderBound +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Syzygy +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.TermDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.WeightedTotalDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanBall +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ConvexQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ArchimedeanBallSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ConvexQuotientSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.Tests.ArchimedeanBallSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring.Hom.OfInjectiveComp +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Tests.GeometricIntegrality +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedValuation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.BasisOver +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGraded +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedMap +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeOver +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreePrincipalInitialIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeRepresentatives +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeScalar +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeSum +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeWeightedPolynomial +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.FiltrationDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.MaxAddDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.OfValuation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.QuotientDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.RV +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Residue +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.ResidueMathlib +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.AssociatedGraded +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.AssociatedGradedValuation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.DegreeAssociatedGraded +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.DegreeAssociatedGradedQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.FiltrationDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialAssociatedGraded +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialQuotientDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.QuotientDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.RV +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Residue +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.SelectionComplexity +import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.Tests.SelectionComplexity +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoNormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowNormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.ZFCDegreeTwoPrime +import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LatticeFactorCoefficients +import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LaurentFactorCoefficients +import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.MonicFactorCoefficients +import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.RelativeAlgebraicClosure +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ArchimedeanSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEmbedding +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEquiv +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationResidue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CharZero +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CoefficientMap +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexFactorSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexQuotientSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.PrincipalMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeResidue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeValuation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.SupportSupremumMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Tests.SupportSupremumMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeTermCount +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeValuation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Domain +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEmbedding +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEquiv +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.EPrimitive +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FactorCoefficients +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducibleFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwo +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwoExample +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.Factorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.FactorizationClassification +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedSpanFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedTruncationSpan +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.FiniteSupportFactorUniqueness +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GermLike +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GradedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.InfiniteSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFiniteMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPart +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartSeries +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PreSchreier +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringLocalization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVGradedMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ClassIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.CoefficientRandom +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.GradedIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.HereditaryIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.IndependenceWindow +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.MainTheorem +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NonPrincipalIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NormalFormBlocks +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.PrincipalIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.Random +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.RandomBlocks +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ReducibleSpan +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SuccessorStep +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SupportRandom +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.TruncationIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.Factorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.FiniteSupportFactorUniqueness +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteSupportDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalDivisibilityReflection +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalMaximalDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalScalarRedistribution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringFraction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesMaximalFiniteSupportDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducibleFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.FactorizationClassification +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedSpanFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedTruncationSpan +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GermLikeFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GradedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.InfiniteSupportFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.MaximalFiniteSupportDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPart +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPartMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.PrincipalMaximalFiniteSupportDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SectionSixFour +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SeriesMaximalFiniteSupportDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportConstantTermOne +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportMonoidAlgebra +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalizedGCD +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportResidue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarExtension +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Additive +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.AlgebraicIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Boundary +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Cancellation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonRankLevels +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValueMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CofactorInduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Convolution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationSet +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Germ +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.GlobalCofactors +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Graded +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LeadingCoefficient +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Leibniz +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LiftFamily +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Lifts +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalEvaluation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalRelationAtCutoff +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LinearMaximal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LowerTruncationDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Multiplication +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Obligations +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.OrderedIntervalCantorBendixson +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativeIndices +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativesAtLimitOrdinal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Power +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PrincipalSeries +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Scalar +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.ScalarLeadingCoefficientAtLimitOrdinal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SeparatedPieceCantorBendixson +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SuccessorLeibniz +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SyzygyIntegration +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolationOnSets +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Truncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationExpansion +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationPolynomial +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Assumptions +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalFiniteClassReduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalIntegerPartSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalPrimalityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalProposition922 +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ClassTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassReduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IntegerPartSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IrreducibilityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.LimitTailPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.PrimalityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduced +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedCharacterization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalGermRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalTruncationClosedClass +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ClosedClassRefinementTransport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CompleteGermRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ConvexRestrictionFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.FiniteGermError +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.LimitTailRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.TruncationIntegerPartFractionField +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.SplitTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Assumptions +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Basic +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalPrimalityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalProposition922 +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ClassTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.FiniteClassReduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.IntegerPartSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.PrimalityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduced +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ReducedCharacterization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ReducedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.SplitTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.TruncationDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.TruncationPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Iterate +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IterateOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.LimitTailQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Monomial +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Multiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Negative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NegativeMonomialIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveCoefficientMap +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveDomainEquiv +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderedIntervalSum +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.BaseChange +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonGrading +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRank +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRepresentatives +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CombinedCofactors +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAt +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAtInjective +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivationIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.IdealFromTruncations +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.InductionOverDegrees +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LeadingCoefficient +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Lifts +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LimitOrdinalRelationAtCutoff +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LinearMaximal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LowDegreeParts +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LoweringDerivation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OmegaSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OrdinalValueCutoffs +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PartialDerivativeIndices +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Partials +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Pieces +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Polynomiality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalGraded +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalIdealGE +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductCondition +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductValues +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.RealPartials +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SeriesTruncations +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Shift +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorLeibniz +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorSupportBound +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SumAlongCutoffs +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SupportLoweringPieces +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Syzygy +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationExpansion +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationPolynomial +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationsIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.UnboundedTruncations +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CoefficientMap +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ComplexityDecrease +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionList +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPoint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPointExistence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.FormalExpression +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermValueCut +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Irreducibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.LeibnizRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.MainLemma +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OneRow +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrderTypeMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueConstantMul +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSubmultiplicative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueValuation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PowerRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponent +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubring +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFraction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFractionAlgebraic +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringLocalization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringMonoidAlgebra +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringScalarRedistributionProof +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PurePowerRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPoint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointCofinality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointTail +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointWellOrdered +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.MainLemma +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.OrdinalValueDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ResidualPoint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.BaseChange +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.CutoffConvolution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.DerivAt +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.FinitePowerFamily +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.LoweringDerivation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.OmegaOmegaBoundary +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.PrincipalGraded +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.PrincipalIdealGE +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.SuccessorLeibniz +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.BerarducciPrimitives +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ComplexityDecrease +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.Convolution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ConvolutionList +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ConvolutionRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.CriticalPoint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueSubmultiplicative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponent +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponentDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponentTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubring +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFiniteSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFraction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ResidualPoint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.SectionSixThree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.TruncationDrop +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.CompleteGerm +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.CompleteGermOfCauchyComplete +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.InitialForms +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialPresentation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialRing +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests.GCDMonoid +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests.PolynomialRing +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Consequences +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.DegreeOne +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.GCDMonoid +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.OrdinalValueQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Primality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Random +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.SupportOrderTypeFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.RealSupportSupremum +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedPieceSum +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SourceStatements +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupAlgebra +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupGCD +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportArchimedeanClasses +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportSupremum +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.ArchimedeanSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.CardinalTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportGCD +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportResidue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportScalarExtension +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Iterate +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Multiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NegativePresentation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NonpositiveDomainEquiv +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.OrderTypeDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.PrincipalAddition +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Truncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.TruncationIntegerPartPrimal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.WeakNormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Translation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Truncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.TruncationIntegerPartPrimal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.WeakNormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.AlgebraicIndependentDet +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.FiniteSpanRelation +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.IndicatorFinsupp +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.Content +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.SubalgebraBasis +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Archimedean +import LeanPool.ConwayRefinement.ConwayRefinement.Order.DifferenceAvoidance +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus.Pointwise +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Germ.LinearMap +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Tests.FunAtZeroMinus +import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LaurentTower +import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LocalizationUFM +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.FinitePWOUnion +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AlgebraicOrder +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorBendixson +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorTermCount +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.GeneralFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.IncreasingSequenceUnion +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTerm +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTermSup +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.MultiplicativelyPrincipal +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalOrder +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPowerFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPrincipal +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.OrderedUnion +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.PairBounds +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Separation +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Split +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SuccessorFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Sumset +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.GeneralFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.NaturalPrincipal +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrderedUnion +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalFactors +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalFinitePart +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalSuccessorFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.SetOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.Sumset +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Game +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.GameOperations +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests.Game +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests.GameOperations +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrimeProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamily +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamilyProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundary +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundaryProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRoots +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRootsProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorizationProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrimeProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependenceProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayNormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayRefinementConsequences +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.DegreeTwoExample +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamily +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamilyProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmegaOmegaBoundary +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFactorizationProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFiniteDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificIntegers +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OneRowExample +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.PrincipalRVAlgebraicIndependenceProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGerm +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGermProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrimeProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterion +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterionProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRoots +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRootsProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRing +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRingProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCD +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRing +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRingProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ArchimedeanQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.CompleteHahnGermProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotientSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.GermPolynomialRingProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnIntegerPartRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnLimitTailQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesPolynomialRingProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineConwayRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineSurreal +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.OrderedAddGroup +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.SeriesConsequences +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ArchimedeanAssumptions +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Cardinal +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.CutFilling +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.CardinalIntegerPart +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.DegreeTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Full +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.IntegerPart +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Multiplication +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormAdd +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormBasic +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormMul +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormRecursion +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormSupport +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.RealLeadingSplit +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.SignedFull +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.CardinalIntegerPart +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.DegreeTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.Full +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.Multiplication +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalFormAdd +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalFormMul +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Transfer +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Basic +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Ordinal +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.FiniteClasses +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.IrreducibleOmnificIntegers +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OmnificIntegers +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OrdinaryIntegers +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.ZFC +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Refinement.ConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.RefinementConjecture +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.Basic +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.ConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.DegreeTwoOzPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.FiniteClasses +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.ZFC +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RationalTailQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealArchimedeanStratum +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealModule +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Round +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.SmallDiscrete +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.ArchimedeanAssumptions +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.RealModule +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Basic +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Cuts +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Identification +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificCodes +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificInteger +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Properness +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Reduced +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Refinement +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Cuts +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Identification +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Properness +import LeanPool.ConwayRefinement.ConwayRefinement.Tests.SourceIndex +import LeanPool.ConwayRefinement.ConwayRefinement.Tests.UpstreamReuse +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixson +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonProduct +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonRank +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonReconstruction +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ArchimedeanBallBase +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonAddition +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonConvexCover +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ClosedPWO +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CoinitialComplete +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedAddGroup +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedIntervalFamily +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAddition +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAdditionFiber +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOSumset +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SeparatedPieceFamily +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SmallClosedSubspace +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests.CantorBendixsonConvexCover +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests.PWOAddition +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Tests.CantorBendixson +import LeanPool.ConwayRefinement.Solution + +/-! +# Conway refinement for omnific integers + +Source: url:https://github.com/gaearon/conway-refinement +Authors: Dan Abramov +Status: verified +Main declarations: `ConwayRefinement.Palomar.conwayRefinement` +Tags: surreal-numbers, ordered-algebra, factorization +MSC: 06A05, 13F25 +-/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames.lean b/LeanPool/ConwayRefinement/CombinatorialGames.lean new file mode 100644 index 0000000000..386260f59d --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.CombinatorialGames.Game +import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib +import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game.lean new file mode 100644 index 0000000000..feb0a4e801 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game.lean @@ -0,0 +1,16 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Basic +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Birthday +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Classes +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Functor +import LeanPool.ConwayRefinement.CombinatorialGames.Game.IGame +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Ordinal +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Player +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Special + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Basic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Basic.lean new file mode 100644 index 0000000000..c63448407c --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Basic.lean @@ -0,0 +1,354 @@ +/- +Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios, Reid Barton, Mario Carneiro, Isabel Longbottom, Kim Morrison, +Apurva Nakade, Yuyang Zhao +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Classes +public import Mathlib.Algebra.CharZero.Defs +public import Mathlib.Algebra.Order.Monoid.Defs + +import Mathlib.Algebra.Order.Ring.Cast +import Mathlib.Tactic.Abel + +/-! +# Combinatorial games + +In this file we construct the quotient of games `IGame` under equivalence, and prove that it forms +an `OrderedAddCommGroup`. We take advantage of this structure to prove two particularly tedious +theorems on `IGame`, namely `IGame.mul_add_equiv` and `IGame.mul_assoc_equiv`. + +It might be tempting to write `mk (x * y)` as `mk x * mk y`, but the latter is not well-defined, as +there exist `x₁ ≈ x₂` and `y₁ ≈ y₂` with `x₁ * y₁ ≉ x₂ * y₂`. See +`CombinatorialGames.Counterexamples.Multiplication` for a proof. +-/ + +universe u + +@[expose] public noncomputable section + +open IGame Set Pointwise + +/-- Games up to equivalence. + +If `x` and `y` are combinatorial games (`IGame`), we say that `x ≈ y` when both `x ≤ y` and `y ≤ x`. +Broadly, this means neither player has a preference in playing either game, as a component of a +larger game. This is the standard meaning of `x = y` in the literature, though it is not a strict +equality, e.g. `{0, 1 | 0}` and `{1 | 0}` are equivalent, but not identical as the former has an +extra move for Left. + +In particular, note that a `Game` has no well-defined notion of left and right options. This means +you should prefer `IGame` when analyzing specific games. -/ +def Game : Type (u + 1) := + Antisymmetrization IGame (· ≤ ·) + +namespace Game + +/-- The quotient map from `IGame` into `Game`. -/ +def mk (x : IGame) : Game := Quotient.mk _ x +theorem mk_eq_mk {x y : IGame} : mk x = mk y ↔ x ≈ y := Quotient.eq + +alias ⟨_, mk_eq⟩ := mk_eq_mk + +@[cases_eliminator] +theorem ind {motive : Game → Prop} (mk : ∀ y, motive (mk y)) (x : Game) : motive x := + Quotient.ind mk x + +/-- Choose an element of the equivalence class using the axiom of choice. -/ +@[no_expose] def out (x : Game) : IGame := Quotient.out x +@[simp] theorem out_eq (x : Game) : mk x.out = x := Quotient.out_eq x + +theorem mk_out_equiv (x : IGame) : (mk x).out ≈ x := Quotient.mk_out (s := AntisymmRel.setoid ..) x +theorem equiv_mk_out (x : IGame) : x ≈ (mk x).out := (mk_out_equiv x).symm + +/-- Construct a `Game` from its left and right sets. + +Note that although this function is well-defined, this function isn't injective, nor do equivalence +classes in `Game` have a canonical representative. -/ +instance : OfSets Game.{u} fun _ ↦ True where + ofSets st _ := mk !{fun p ↦ out '' (st p)} + +theorem mk_ofSets' (st : Player → Set IGame.{u}) [Small.{u} (st left)] [Small.{u} (st right)] : + mk !{st} = !{fun p ↦ mk '' st p} := by + refine mk_eq <| IGame.equiv_of_exists ?_ ?_ ?_ ?_ <;> + simpa using fun a ha ↦ ⟨a, ha, equiv_mk_out a⟩ + +@[simp] +theorem mk_ofSets (s t : Set IGame.{u}) [Small.{u} s] [Small.{u} t] : + mk !{s | t} = !{mk '' s | mk '' t} := by + rw [mk_ofSets'] + simp_rw [Player.apply_cases] + +private theorem ofSets_cases (s t : Set Game.{u}) [Small.{u} s] [Small.{u} t] : + !{s | t} = mk !{out '' s | out '' t} := by + simp [mk_ofSets, image_image] + +instance : Zero Game := ⟨mk 0⟩ +instance : One Game := ⟨mk 1⟩ +instance : Add Game := ⟨Quotient.map₂ _ @add_congr⟩ +instance : Neg Game := ⟨Quotient.map _ @neg_congr⟩ +instance : PartialOrder Game := inferInstanceAs (PartialOrder (Antisymmetrization ..)) +instance : Inhabited Game := ⟨0⟩ + +instance : AddCommGroupWithOne Game where + zero_add := by rintro ⟨x⟩; exact congr(mk $(zero_add _)) + add_zero := by rintro ⟨x⟩; exact congr(mk $(add_zero _)) + add_comm := by rintro ⟨x⟩ ⟨y⟩; exact congr(mk $(add_comm _ _)) + add_assoc := by rintro ⟨x⟩ ⟨y⟩ ⟨z⟩; exact congr(mk $(add_assoc _ _ _)) + neg_add_cancel := by rintro ⟨a⟩; exact mk_eq (neg_add_equiv _) + nsmul := nsmulRec + zsmul := zsmulRec + +instance : IsOrderedAddMonoid Game where + add_le_add_left := by rintro ⟨a⟩ ⟨b⟩ h ⟨c⟩; exact add_le_add_left (α := IGame) h _ + +instance : RatCast Game where + ratCast q := mk q + +@[simp] theorem mk_zero : mk 0 = 0 := rfl +@[simp] theorem mk_one : mk 1 = 1 := rfl +@[simp] theorem mk_add (x y : IGame) : mk (x + y) = mk x + mk y := rfl +@[simp] theorem mk_neg (x : IGame) : mk (-x) = -mk x := rfl +@[simp] theorem mk_sub (x y : IGame) : mk (x - y) = mk x - mk y := rfl + +theorem mk_mulOption (x y a b : IGame) : + mk (mulOption x y a b) = mk (a * y) + mk (x * b) - mk (a * b) := + rfl + +@[simp] theorem mk_le_mk {x y : IGame} : mk x ≤ mk y ↔ x ≤ y := .rfl +@[simp] theorem mk_lt_mk {x y : IGame} : mk x < mk y ↔ x < y := .rfl +@[simp] theorem mk_fuzzy_mk {x y : IGame} : mk x ‖ mk y ↔ x ‖ y := .rfl + +@[simp, norm_cast] +theorem mk_natCast : ∀ n : ℕ, mk n = n + | 0 => rfl + | n + 1 => by rw [Nat.cast_add, Nat.cast_add, mk_add, mk_natCast]; rfl + +@[simp, norm_cast] +theorem mk_intCast (n : ℤ) : mk n = n := by + cases n <;> simp + +@[simp, norm_cast] theorem mk_ratCast (q : ℚ) : mk q = q := rfl +@[simp, norm_cast] theorem ratCast_neg (q : ℚ) : ((-q : ℚ) : Game) = -q := by simp [← mk_ratCast] + +theorem zero_def : (0 : Game) = !{fun _ ↦ ∅} := by apply (mk_ofSets' ..).trans; simp +theorem one_def : (1 : Game) = !{{0} | ∅} := by apply (mk_ofSets ..).trans; simp + +instance : ZeroLEOneClass Game where + zero_le_one := zero_le_one (α := IGame) + +instance : NeZero (1 : Game) where + out := by apply ne_of_gt; exact IGame.zero_lt_one + +instance : Nontrivial Game := ⟨_, _, zero_ne_one⟩ +instance : CharZero Game := AddMonoidWithOne.toCharZero + +theorem mk_mul_add (x y z : IGame) : mk (x * (y + z)) = mk (x * y) + mk (x * z) := by + rw [← mk_add, add_eq' (x * y), mul_eq'] + simp only [moves_add, moves_mul, prod_union, union_assoc, image_image, image_union, mk_ofSets'] + congr! 2 + ext p + nth_rewrite 2 [union_left_comm] + congrm _ ∈ ?_ ∪ (?_ ∪ (?_ ∪ ?_)) + all_goals + ext + simp only [mulOption, mk_sub, mk_add, mem_image, mem_prod, and_assoc, Prod.exists, + exists_and_left, exists_exists_and_eq_and] + iterate 2 (congr! 2; rw [and_congr_right_iff]; intros) + congr! 1 + rw [mk_mul_add, mk_mul_add, mk_mul_add] + abel +termination_by (x, y, z) +decreasing_by igame_wf + +theorem mk_mul_sub (x y z : IGame) : mk (x * (y - z)) = mk (x * y) - mk (x * z) := by + simpa [sub_eq_add_neg] using mk_mul_add x y (-z) + +theorem mk_add_mul (x y z : IGame) : mk ((x + y) * z) = mk (x * z) + mk (y * z) := by + rw [mul_comm, mk_mul_add, mul_comm, mul_comm z] + +theorem mk_sub_mul (x y z : IGame) : mk ((x - y) * z) = mk (x * z) - mk (y * z) := by + simpa [sub_eq_add_neg] using mk_add_mul x (-y) z + +theorem mk_mul_assoc (x y z : IGame) : mk (x * y * z) = mk (x * (y * z)) := by + induction x using IGame.ofSetsRecOn generalizing y z with | ofSets xL xR ihxl ihxr + induction y using IGame.ofSetsRecOn generalizing z with | ofSets yL yR ihyl ihyr + induction z using IGame.ofSetsRecOn with | ofSets zL zR ihzl ihzr + simp_rw [ofSets_mul_ofSets, mk_ofSets, Set.image_union, Set.image_image, mk_mulOption, + ← Set.image_union, ← ofSets_mul_ofSets, + Set.prod_image_left, Set.prod_image_right, Set.union_prod, Set.prod_union, + ← Equiv.prod_assoc_image, ← Set.image_union, Set.image_image, Equiv.prodAssoc_apply] + have e1 : (xL ×ˢ yL) ×ˢ zL ∪ (xR ×ˢ yR) ×ˢ zL ∪ ((xL ×ˢ yR) ×ˢ zR ∪ (xR ×ˢ yL) ×ˢ zR) = + (xL ×ˢ yL) ×ˢ zL ∪ (xL ×ˢ yR) ×ˢ zR ∪ ((xR ×ˢ yL) ×ˢ zR ∪ (xR ×ˢ yR) ×ˢ zL) := by + ac_rfl + have e2 : (xL ×ˢ yL) ×ˢ zR ∪ (xR ×ˢ yR) ×ˢ zR ∪ ((xL ×ˢ yR) ×ˢ zL ∪ (xR ×ˢ yL) ×ˢ zL) = + (xL ×ˢ yL) ×ˢ zR ∪ (xL ×ˢ yR) ×ˢ zL ∪ ((xR ×ˢ yL) ×ˢ zL ∪ (xR ×ˢ yR) ×ˢ zR) := by + ac_rfl + simp only [e1, e2] + congrm !{?_ | ?_} <;> + · refine Set.image_congr fun ⟨⟨x, y⟩, z⟩ hxyz => ?_ + obtain ⟨hx, hy, hz⟩ : (x ∈ xL ∨ x ∈ xR) ∧ (y ∈ yL ∨ y ∈ yR) ∧ (z ∈ zL ∨ z ∈ zR) := by + simp only [mem_union, mem_prod] at hxyz + tauto + simp only [mulOption, mk_sub_mul, mk_add_mul, mk_mul_sub, mk_mul_add, + hx.elim (ihxl x) (ihxr x), hy.elim (ihyl y) (ihyr y), hz.elim (ihzl z) (ihzr z)] + abel + +theorem lf_ofSets_of_mem_left {s t : Set Game.{u}} [Small.{u} s] [Small.{u} t] {x : Game.{u}} + (h : x ∈ s) : x ⧏ !{s | t} := by + rw [ofSets_cases] + have : x.out ∈ !{out '' s | out '' t}ᴸ := by simpa using mem_image_of_mem _ h + simpa [← mk_le_mk] using left_lf this + +theorem ofSets_lf_of_mem_right {s t : Set Game.{u}} [Small.{u} s] [Small.{u} t] {x : Game.{u}} + (h : x ∈ t) : !{s | t} ⧏ x := by + rw [ofSets_cases] + have : x.out ∈ !{out '' s | out '' t}ᴿ := by simpa using mem_image_of_mem _ h + simpa [← mk_le_mk] using lf_right this + +end Game + +namespace IGame + +protected theorem sub_le_iff_le_add {x y z : IGame} : x - z ≤ y ↔ x ≤ y + z := + @sub_le_iff_le_add Game _ _ _ (.mk x) (.mk y) (.mk z) + +protected theorem le_sub_iff_add_le {x y z : IGame} : x ≤ z - y ↔ x + y ≤ z := + @le_sub_iff_add_le Game _ _ _ (.mk x) (.mk y) (.mk z) + +protected theorem sub_lt_iff_lt_add {x y z : IGame} : x - z < y ↔ x < y + z := + @sub_lt_iff_lt_add Game _ _ _ (.mk x) (.mk y) (.mk z) + +protected theorem lt_sub_iff_add_lt {x y z : IGame} : x < z - y ↔ x + y < z := + @lt_sub_iff_add_lt Game _ _ _ (.mk x) (.mk y) (.mk z) + +protected theorem sub_nonneg {x y : IGame} : 0 ≤ x - y ↔ y ≤ x := + @sub_nonneg Game _ _ _ (.mk x) (.mk y) + +protected theorem sub_nonpos {x y : IGame} : x - y ≤ 0 ↔ x ≤ y := + @sub_nonpos Game _ _ _ (.mk x) (.mk y) + +protected theorem sub_pos {x y : IGame} : 0 < x - y ↔ y < x := + @sub_pos Game _ _ _ (.mk x) (.mk y) + +protected theorem sub_neg {x y : IGame} : x - y < 0 ↔ x < y := + @sub_neg Game _ _ _ (.mk x) (.mk y) + +theorem mul_add_equiv (x y z : IGame) : x * (y + z) ≈ x * y + x * z := + Game.mk_eq_mk.1 (Game.mk_mul_add x y z) + +theorem mul_sub_equiv (x y z : IGame) : x * (y - z) ≈ x * y - x * z := + Game.mk_eq_mk.1 (Game.mk_mul_sub x y z) + +theorem add_mul_equiv (x y z : IGame) : (x + y) * z ≈ x * z + y * z := + Game.mk_eq_mk.1 (Game.mk_add_mul x y z) + +theorem sub_mul_equiv (x y z : IGame) : (x - y) * z ≈ x * z - y * z := + Game.mk_eq_mk.1 (Game.mk_sub_mul x y z) + +theorem mul_assoc_equiv (x y z : IGame) : x * y * z ≈ x * (y * z) := + Game.mk_eq_mk.1 (Game.mk_mul_assoc x y z) + +@[simp, norm_cast] +theorem natCast_le {m n : ℕ} : (m : IGame) ≤ n ↔ m ≤ n := by + simp [← Game.mk_le_mk] + +@[simp, norm_cast] +theorem natCast_lt {m n : ℕ} : (m : IGame) < n ↔ m < n := by + simp [← Game.mk_lt_mk] + +@[simp] +theorem natCast_nonneg (n : ℕ) : 0 ≤ (n : IGame) := + natCast_le.2 n.zero_le + +theorem natCast_strictMono : StrictMono ((↑) : ℕ → IGame) := + fun _ _ h ↦ natCast_lt.2 h + +instance : CharZero IGame where + cast_injective := natCast_strictMono.injective + +@[simp, norm_cast] +theorem natCast_equiv {m n : ℕ} : (m : IGame) ≈ n ↔ m = n := by + simp [AntisymmRel, le_antisymm_iff] + +@[simp, norm_cast] +theorem intCast_le {m n : ℤ} : (m : IGame) ≤ n ↔ m ≤ n := by + simp [← Game.mk_le_mk] + +@[simp, norm_cast] +theorem intCast_lt {m n : ℤ} : (m : IGame) < n ↔ m < n := by + simp [← Game.mk_lt_mk] + +theorem intCast_strictMono : StrictMono ((↑) : ℤ → IGame) := + fun _ _ h ↦ intCast_lt.2 h + +@[simp, norm_cast] +theorem intCast_inj {m n : ℤ} : (m : IGame) = n ↔ m = n := + intCast_strictMono.injective.eq_iff + +@[simp, norm_cast] +theorem intCast_equiv {m n : ℤ} : (m : IGame) ≈ n ↔ m = n := by + simp [AntisymmRel, le_antisymm_iff] + +theorem intCast_add_equiv (m n : ℤ) : ((m + n : ℤ) : IGame) ≈ m + n := by + simp [← Game.mk_eq_mk] + +theorem intCast_sub_equiv (m n : ℤ) : ((m - n : ℤ) : IGame) ≈ m - n := by + simp [← Game.mk_eq_mk] + +@[simp, norm_cast] +theorem zero_lt_intCast {n : ℤ} : 0 < (n : IGame) ↔ 0 < n := by + simpa using intCast_lt (m := 0) + +@[simp, norm_cast] +theorem intCast_lt_zero {n : ℤ} : (n : IGame) < 0 ↔ n < 0 := by + simpa using intCast_lt (n := 0) + +@[simp, norm_cast] +theorem zero_le_intCast {n : ℤ} : 0 ≤ (n : IGame) ↔ 0 ≤ n := by + simpa using intCast_le (m := 0) + +@[simp, norm_cast] +theorem intCast_le_zero {n : ℤ} : (n : IGame) ≤ 0 ↔ n ≤ 0 := by + simpa using intCast_le (n := 0) + +namespace Impartial +variable (x y : IGame) [hx : Impartial x] [hy : Impartial y] + +@[simp] +theorem neg_mk : -Game.mk x = Game.mk x := + Game.mk_eq (equiv_neg x).symm + +@[simp] +theorem sub_mk (x : Game) : x - Game.mk y = x + Game.mk y := by + rw [sub_eq_add_neg, neg_mk] + +@[simp] +theorem mk_add_self : Game.mk x + Game.mk x = 0 := by + rw [add_eq_zero_iff_neg_eq, neg_mk] + +-- TODO: move these four lemmas earlier: + +theorem add_self_equiv (x : IGame) [Impartial x] : x + x ≈ 0 := + Game.mk_eq_mk.1 (mk_add_self x) + +variable {x y} + +omit hx in +/-- This lemma doesn't require `x` to be impartial. -/ +theorem equiv_iff_add_equiv_zero : x ≈ y ↔ x + y ≈ 0 := by + rw [← Game.mk_eq_mk, ← Game.mk_eq_mk, Game.mk_add, Game.mk_zero, add_eq_zero_iff_eq_neg, neg_mk] + +omit hy in +/-- This lemma doesn't require `y` to be impartial. -/ +theorem equiv_iff_add_equiv_zero' : x ≈ y ↔ x + y ≈ 0 := by + rw [antisymmRel_comm, add_comm, equiv_iff_add_equiv_zero] + +theorem fuzzy_iff_add_fuzzy_zero : x ‖ y ↔ x + y ‖ 0 := by + simpa using (@equiv_iff_add_equiv_zero x y).not + +end Impartial +end IGame +end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean new file mode 100644 index 0000000000..a9045da147 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean @@ -0,0 +1,419 @@ +/- +Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Ordinal +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Special + +import Mathlib.Algebra.Order.Group.OrderIso +import Mathlib.Data.Fintype.Order +import Mathlib.Data.Set.Finite.Lattice + +/-! +# Birthdays of games + +There are two related but distinct notions of a birthday within combinatorial game theory. One is +the birthday of an `IGame`, which represents the "step" at which it is constructed. We define it +recursively as the least ordinal larger than the birthdays of its left and right options. On the +other hand, the birthday of a `Game` is the smallest birthday among all `IGame`s that quotient to +it. + +The birthday of an `IGame` can be understood as representing the depth of its game tree. Meanwhile, +the birthday of a `Game` more closely matches Conway's original description. The lemma +`Game.birthday_eq_iGameBirthday` links both definitions together. +-/ + +universe u + +open NatOrdinal Order Set + +/-! ### Stuff for Mathlib -/ + +theorem ciSup_eq_bot {α : Type*} {ι : Sort*} [ConditionallyCompleteLinearOrderBot α] {f : ι → α} + (hf : BddAbove (range f)) : ⨆ i, f i = ⊥ ↔ ∀ i, f i = ⊥ := by + simpa using ciSup_le_iff' hf (a := ⊥) + +/-! ### `IGame` birthday -/ + +public noncomputable section + +namespace IGame + +/-- The birthday of an `IGame` is inductively defined as the least strict upper bound of the +birthdays of its options. It may be thought as the "step" in which a certain game is constructed. -/ +def birthday (x : IGame.{u}) : NatOrdinal.{u} := + ⨆ p, ⨆ y : x.moves p, succ (birthday y) +termination_by x +decreasing_by igame_wf + +theorem lt_birthday_iff {x : IGame} {o : NatOrdinal} : o < x.birthday ↔ + ∃ p y, y ∈ x.moves p ∧ o ≤ y.birthday := by + rw [birthday] + simp [NatOrdinal.lt_iSup_iff] + +theorem birthday_le_iff {x : IGame} {o : NatOrdinal} : x.birthday ≤ o ↔ + ∀ p, ∀ y ∈ x.moves p, y.birthday < o := by + simpa using lt_birthday_iff.not + +theorem birthday_eq_max (x : IGame) : birthday x = + max (⨆ y : xᴸ, succ y.1.birthday) (⨆ y : xᴿ, succ y.1.birthday) := by + apply eq_of_forall_lt_iff + simp [lt_birthday_iff, NatOrdinal.lt_iSup_iff] + +@[aesop apply unsafe] +theorem birthday_lt_of_mem_moves {p : Player} {x y : IGame} (hy : y ∈ x.moves p) : + y.birthday < x.birthday := + lt_birthday_iff.2 ⟨p, y, hy, le_rfl⟩ + +theorem birthday_lt_of_subposition {x y : IGame} (hy : Subposition y x) : + y.birthday < x.birthday := by + induction x using moveRecOn with | ind x ih + obtain ⟨p, z, hz, hy⟩ := subposition_iff_exists.1 hy + obtain rfl | hy := wsubposition_iff_eq_or_subposition.1 hy + · exact birthday_lt_of_mem_moves hz + · exact (ih p z hz hy).trans (birthday_lt_of_mem_moves hz) + +theorem birthday_ofSets (s t : Set IGame.{u}) [Small.{u} s] [Small.{u} t] : + birthday !{s | t} = max (sSup (succ ∘ birthday '' s)) (sSup (succ ∘ birthday '' t)) := by + rw [birthday_eq_max, leftMoves_ofSets, rightMoves_ofSets] + simp [iSup, image_eq_range] + +theorem birthday_ofSets_const (s : Set IGame.{u}) [Small.{u} s] : + birthday !{fun _ ↦ s} = sSup (succ ∘ birthday '' s) := by + rw [ofSets_eq_ofSets_cases, birthday_ofSets, max_self] + +@[simp] +theorem birthday_eq_zero {x : IGame} : birthday x = 0 ↔ x = 0 := by + rw [birthday] + simp [iSup_eq_zero_iff, IGame.ext_iff, eq_empty_iff_forall_notMem] + +@[simp] theorem birthday_zero : birthday 0 = 0 := by simp +@[simp] theorem birthday_one : birthday 1 = 1 := by rw [one_def, birthday_ofSets]; simp +@[simp] theorem birthday_star : birthday ⋆ = 1 := by rw [star, birthday_ofSets_const]; simp + +@[simp] +theorem birthday_half : birthday ½ = 2 := by + rw [half, birthday_ofSets] + simpa using one_add_one_eq_two + +@[simp] +theorem birthday_up : birthday ↑ = 2 := by + rw [up, birthday_ofSets] + simpa using one_add_one_eq_two + +@[simp] +theorem birthday_down : birthday ↓ = 2 := by + rw [down, birthday_ofSets] + simpa using one_add_one_eq_two + +@[simp] +theorem birthday_neg (x : IGame) : (-x).birthday = x.birthday := by + refine eq_of_forall_lt_iff fun y ↦ ?_ + simp_rw [lt_birthday_iff, exists_moves_neg, Player.exists] + rw [or_comm] + congr! 3 + all_goals + dsimp; rw [and_congr_right] + intro h + rw [birthday_neg] +termination_by x +decreasing_by igame_wf + +@[simp] +theorem birthday_toIGame (o : NatOrdinal) : o.toIGame.birthday = o := by + rw [toIGame_def, birthday_ofSets, image_empty, csSup_empty, max_bot_right, image_image] + conv_rhs => rw [← iSup_succ o, iSup] + simp_rw [Function.comp_apply, ← image_eq_range] + congr! + rw [birthday_toIGame] +termination_by o + +theorem le_toIGame_birthday (x : IGame) : x ≤ x.birthday.toIGame := by + rw [le_iff_forall_lf] + refine ⟨fun y hy ↦ ((le_toIGame_birthday y).trans_lt ?_).not_ge, ?_⟩ + · simpa using birthday_lt_of_mem_moves hy + · simp +termination_by x +decreasing_by igame_wf + +theorem neg_toIGame_birthday_le (x : IGame) : -x.birthday.toIGame ≤ x := by + simpa [IGame.neg_le] using le_toIGame_birthday (-x) + +/-- A game without right options is equivalent to an ordinal. -/ +theorem equiv_ordinal_of_right_eq_empty {x : IGame} (hx : xᴿ = ∅) : + ∃ o : NatOrdinal, x ≈ o := by + obtain ⟨o, ho, ho'⟩ := wellFounded_lt.has_min {o : NatOrdinal | x ≤ o} ⟨_, x.le_toIGame_birthday⟩ + use o + apply equiv_of_forall_lf + · exact fun a ha ha' ↦ left_lf ha <| ho.trans ha' + · simp [hx] + · rw [forall_leftMoves_toIGame] + exact fun a ha ha' ↦ ho' _ ha' ha + · simp + +/-- A game without left options is equivalent to the negative of an ordinal. -/ +theorem equiv_neg_ordinal_of_left_eq_empty {x : IGame} (hx : xᴸ = ∅) : + ∃ o : NatOrdinal, x ≈ -o := by + simpa [hx, ← IGame.neg_equiv] using equiv_ordinal_of_right_eq_empty (x := -x) + +@[simp] +theorem birthday_add (x y : IGame) : (x + y).birthday = x.birthday + y.birthday := by + refine eq_of_forall_lt_iff fun o ↦ ?_ + simp_rw [lt_add_iff, lt_birthday_iff, Player.exists, exists_moves_add, + or_and_right, exists_or, or_or_or_comm] + congr! 2 + all_goals + constructor + · rintro ⟨z, hz, hz'⟩ + refine ⟨_, ⟨z, hz, le_rfl⟩, ?_⟩ + rwa [← birthday_add] + · rintro ⟨a, ⟨⟨z, hz, hz'⟩, ha⟩⟩ + use z, hz + rw [birthday_add] + apply ha.trans + first | exact add_le_add_left hz' _ | exact add_le_add_right hz' _ +termination_by (x, y) +decreasing_by igame_wf + +@[simp] +theorem birthday_sub (x y : IGame) : (x - y).birthday = x.birthday + y.birthday := by + simp [sub_eq_add_neg] + +@[simp, norm_cast] +theorem birthday_natCast : ∀ n : ℕ, birthday n = n + | 0 => birthday_zero + | n + 1 => by simp_rw [Nat.cast_add_one, birthday_add, birthday_natCast, birthday_one] + +@[simp] +theorem birthday_ofNat (n : ℕ) [n.AtLeastTwo] : birthday ofNat(n) = n := + birthday_natCast n + +@[simp] +theorem birthday_tiny (x : IGame) : (⧾x).birthday = x.birthday + 2 := by + simp [tiny, Order.succ_eq_add_one, birthday_ofSets, ← one_add_one_eq_two, ← add_assoc] + +@[simp] +theorem birthday_miny (x : IGame) : (⧿x).birthday = x.birthday + 2 := by + rw [← neg_tiny, birthday_neg, birthday_tiny] + +/-- Games with a bounded birthday form a small set. -/ +instance small_setOf_birthday_lt (o : NatOrdinal.{u}) : Small.{u} {x | birthday x < o} := by + induction o using SuccOrder.prelimitRecOn with + | succ o _ ih => + apply small_subset + (s := range fun s : Set {x | birthday x < o} × Set {x | birthday x < o} ↦ + (!{s.1 | ↑s.2} : IGame)) + refine fun x hx ↦ ⟨((↑) ⁻¹' xᴸ, (↑) ⁻¹' xᴿ), ?_⟩ + simp_rw [lt_succ_iff, birthday_le_iff] at hx + ext p; cases p <;> simp_all + | isSuccPrelimit o ho ih => + convert @small_biUnion _ _ (Iio o) _ (fun i _ => {x : IGame.{u} | x.birthday < i}) ih + ext x + simpa using ho.lt_iff_exists_lt + +/-- Games with a bounded birthday form a small set. -/ +instance small_setOf_birthday_le (o : NatOrdinal.{u}) : Small.{u} {x | birthday x ≤ o} := by + convert small_setOf_birthday_lt (succ o) using 1 + simp + +/-- A variant of `small_setOf_birthday_le` in simp-normal form -/ +instance small_subtype_birthday_le (o : NatOrdinal.{u}) : Small.{u} {x // birthday x ≤ o} := + small_setOf_birthday_le o + +/-- A variant of `small_setOf_birthday_lt` in simp-normal form -/ +instance small_subtype_birthday_lt (o : NatOrdinal.{u}) : Small.{u} {x // birthday x < o} := + small_setOf_birthday_lt o + +/-! #### Short games -/ + +/-- The finset of all games with birthday ≤ n. -/ +noncomputable def birthdayFinset : ℕ → Finset IGame.{u} + | 0 => {0} + | n + 1 => ((birthdayFinset n).powerset ×ˢ (birthdayFinset n).powerset).map + ⟨fun a => !{a.1 | a.2}, fun a b hab => by aesop⟩ + +theorem mem_birthdayFinset_succ {x : IGame} {n : ℕ} : x ∈ birthdayFinset (n + 1) ↔ + ∃ l r, (l ⊆ birthdayFinset n ∧ r ⊆ birthdayFinset n) ∧ !{l | r} = x := by + simp [birthdayFinset] + +@[simp] theorem birthdayFinset_zero : birthdayFinset 0 = {0} := (rfl) + +theorem birthdayFinset_one : + birthdayFinset 1 = ⟨[0, 1, -1, ⋆], by aesop (add simp [IGame.ext_iff])⟩ := by + ext + rw [mem_birthdayFinset_succ] + aesop (add simp [IGame.ext_iff]) + +@[simp] +theorem card_birthdayFinset (n : ℕ) : + (birthdayFinset.{u} (n + 1)).card = 4 ^ (birthdayFinset.{u} n).card := by + rw [birthdayFinset, Finset.card_map, Finset.card_product, Finset.card_powerset, ← mul_pow] + rfl + +theorem mem_birthdayFinset_of_mem_moves {p : Player} {x y : IGame} + {n : ℕ} (hnx : x ∈ birthdayFinset (n + 1)) (hy : y ∈ x.moves p) : y ∈ birthdayFinset n := by + rw [mem_birthdayFinset_succ] at hnx + aesop + +@[simp] +theorem mem_birthdayFinset {x : IGame} {n : ℕ} : x ∈ birthdayFinset n ↔ x.birthday ≤ n := by + induction n generalizing x with + | zero => simp + | succ n IH => + simp_rw [mem_birthdayFinset_succ, birthday_le_iff, Finset.subset_iff, Nat.cast_add_one, + ← succ_eq_add_one, lt_succ_iff, IH] + constructor + · aesop + · intro p + have hx (p) : x.moves p ⊆ birthdayFinset n := by cases p <;> simp_all [subset_def] + classical have (p : Player) := Set.fintypeSubset _ (hx p) + use xᴸ.toFinset, xᴿ.toFinset + aesop + +theorem strictMono_birthdayFinset : StrictMono birthdayFinset := by + refine strictMono_nat_of_lt_succ fun n ↦ ⟨fun y hy ↦ ?_, fun h ↦ ?_⟩ + · rw [SetLike.mem_coe, mem_birthdayFinset] at * + apply hy.trans + simp + · have := Finset.card_le_card h + rw [card_birthdayFinset] at this + exact (Nat.lt_pow_self (Nat.one_lt_succ_succ 2)).not_ge this + +theorem short_iff_birthday_finite {x : IGame} : x.Short ↔ x.birthday < of .omega0 := by + refine ⟨fun h ↦ ?_, ?_⟩ + · have (p : Player) (y : x.moves p) : ∃ n : ℕ, birthday y = n := by + rw [← NatOrdinal.lt_omega0, ← short_iff_birthday_finite] + exact .of_mem_moves y.2 + choose f hf using this + obtain ⟨n, hn⟩ := (finite_iUnion fun p => finite_range (f p)).exists_le + apply lt_of_le_of_lt _ (NatOrdinal.natCast_lt_omega0 (n + 1)) + rw [birthday_le_iff, Nat.cast_add_one, ← succ_eq_add_one] + aesop + · rw [NatOrdinal.lt_omega0, short_iff_finite_setOf_subposition] + intro ⟨n, hn⟩ + apply (birthdayFinset n).finite_toSet.subset fun y hy ↦ ?_ + simpa using (birthday_lt_of_subposition hy).le.trans_eq hn +termination_by x +decreasing_by igame_wf + +theorem Short.birthday_lt_omega0 (x : IGame) [Short x] : birthday x < of .omega0 := + short_iff_birthday_finite.1 ‹_› + +end IGame + +/-! ### `Game` birthday -/ + +namespace Game + +/-- The birthday of a game is defined as the least birthday among all pre-games that define it. -/ +noncomputable def birthday (x : Game.{u}) : NatOrdinal.{u} := + sInf (IGame.birthday '' (mk ⁻¹' {x})) + +theorem birthday_eq_iGameBirthday (x : Game) : + ∃ y : IGame, Game.mk y = x ∧ y.birthday = birthday x := by + refine csInf_mem (image_nonempty.2 ?_) + exact ⟨_, x.out_eq⟩ + +theorem birthday_mk_le (x : IGame) : birthday (mk x) ≤ x.birthday := + csInf_le' ⟨x, rfl, rfl⟩ + +theorem le_birthday_iff {x : Game} {o : NatOrdinal} : + o ≤ x.birthday ↔ ∀ y, mk y = x → o ≤ y.birthday := + ⟨fun hx y hy => hx.trans (hy ▸ (birthday_mk_le y)), + fun h => (birthday_eq_iGameBirthday x).elim fun y hy => (h y hy.1).trans_eq hy.2⟩ + +@[simp] +theorem birthday_zero : birthday 0 = 0 := by + simpa using birthday_mk_le 0 + +@[simp] +theorem birthday_eq_zero {x : Game} : birthday x = 0 ↔ x = 0 := by + obtain ⟨_, _, _⟩ := birthday_eq_iGameBirthday x + refine ⟨fun _ ↦ ?_, ?_⟩ <;> simp_all + +private theorem birthday_neg_le (x : Game) : (-x).birthday ≤ x.birthday := by + obtain ⟨y, hy, hy'⟩ := birthday_eq_iGameBirthday x + rw [← hy', ← hy] + apply (birthday_mk_le _).trans + rw [IGame.birthday_neg] + +@[simp] +theorem birthday_neg (x : Game) : (-x).birthday = x.birthday := by + apply (birthday_neg_le x).antisymm + simpa using birthday_neg_le (-x) + +theorem le_toGame_birthday (x : Game) : x ≤ x.birthday.toGame := by + obtain ⟨y, hy, hy'⟩ := birthday_eq_iGameBirthday x + rw [← hy', ← hy] + exact y.le_toIGame_birthday + +theorem neg_toGame_birthday_le (x : Game) : -x.birthday.toGame ≤ x := by + simpa [neg_le] using le_toGame_birthday (-x) + +@[simp] +theorem birthday_toGame (o : NatOrdinal) : birthday o.toGame = o := by + apply le_antisymm + · simpa using birthday_mk_le o.toIGame + · simpa using o.toGame.le_toGame_birthday + +@[simp, norm_cast] +theorem birthday_natCast (n : ℕ) : birthday n = n := by + simpa using birthday_toGame n + +@[simp] +theorem birthday_ofNat (n : ℕ) [n.AtLeastTwo] : birthday ofNat(n) = n := + birthday_natCast n + +@[simp] +theorem birthday_one : birthday 1 = 1 := by + simpa using birthday_natCast 1 + +@[simp] +theorem birthday_star : birthday (Game.mk ⋆) = 1 := by + apply le_antisymm + · simpa using birthday_mk_le ⋆ + · rw [one_le_iff_ne_zero, birthday_eq_zero.ne] + exact IncompRel.ne (r := (· ≤ ·)) IGame.star_fuzzy_zero + +theorem birthday_ofSets_le {s t : Set Game.{u}} [Small.{u} s] [Small.{u} t] : + birthday !{s | t} ≤ max (sSup (succ ∘ birthday '' s)) (sSup (succ ∘ birthday '' t)) := by + choose f hf using birthday_eq_iGameBirthday + trans !{f '' s | f '' t}.birthday + · convert birthday_mk_le !{f '' s | f '' t} using 2 + simp_rw [mk_ofSets, image_image] + aesop + · simp_rw [IGame.birthday_ofSets, image_comp] + congr! <;> aesop + +theorem birthday_add_le (x y : Game) : (x + y).birthday ≤ x.birthday + y.birthday := by + obtain ⟨a, ha, ha'⟩ := birthday_eq_iGameBirthday x + obtain ⟨b, hb, hb'⟩ := birthday_eq_iGameBirthday y + rw [← ha', ← hb', ← ha, ← hb, ← IGame.birthday_add] + exact birthday_mk_le _ + +theorem birthday_sub_le (x y : Game) : (x - y).birthday ≤ x.birthday + y.birthday := by + simpa [sub_eq_add_neg] using birthday_add_le x (-y) + +/-- Games with a bounded birthday form a small set. -/ +instance small_setOf_birthday_le (o : NatOrdinal.{u}) : Small.{u} {x | birthday x ≤ o} := by + refine small_subset (s := mk '' {x | IGame.birthday x ≤ o}) fun x hx ↦ ?_ + obtain ⟨y, rfl, hy⟩ := birthday_eq_iGameBirthday x + exact mem_image_of_mem mk (hy.trans_le hx) + +/-- Games with a bounded birthday form a small set. -/ +instance small_setOf_birthday_lt (o : NatOrdinal.{u}) : Small.{u} {x | birthday x < o} := + small_subset (s := {x | birthday x ≤ o}) <| setOf_subset_setOf.2 fun _ => le_of_lt + +/-- A variant of `small_setOf_birthday_le` in simp-normal form -/ +instance small_subtype_birthday_le (o : NatOrdinal.{u}) : Small.{u} {x // birthday x ≤ o} := + small_setOf_birthday_le o + +/-- A variant of `small_setOf_birthday_lt` in simp-normal form -/ +instance small_subtype_birthday_lt (o : NatOrdinal.{u}) : Small.{u} {x // birthday x < o} := + small_setOf_birthday_lt o + +end Game +end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean new file mode 100644 index 0000000000..92b5145539 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean @@ -0,0 +1,524 @@ +/- +Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios, Kim Morrison, Fox Thomson +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.IGame +public meta import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.AddInstances + +import Mathlib.Data.Finite.Prod +import Mathlib.Data.Set.Finite.Lattice + +/-! +# Classes of games + +This file collects multiple basic classes of games, so as to make them available on most files. We +develop their theory elsewhere. + +## Dicotic games + +A game is dicotic when every non-zero subposition has both left and right moves. The Lawnmower +theorem (proven in `CombinatorialGames.Game.Small`) shows that every dicotic game is small. + +## Impartial games + +We define an impartial game as one where every subposition is equivalent to its negative. This is a +weaker definition than that found in the literature (which requires equality, rather than +equivalence), but this is still strong enough to prove the Sprague--Grundy theorem, as well as +closure under the basic arithmetic operations of multiplication and division. + +## Numeric games + +A game is `Numeric` if all the Left options are strictly smaller than all the Right options, and all +those options are themselves numeric. In terms of combinatorial games, the numeric games have +"frozen"; you can only make your position worse by playing, and Left is some definite "number" of +moves ahead (or behind) Right. + +## Short games + +A combinatorial game is `Short` if it has only finitely many subpositions. In particular, this means +there is a finite set of moves at every point. + +We historically defined `Short x` as data, which we then used to enable some degree of computation +on combinatorial games. This functionality is now implemented through the `game_cmp` tactic instead. +-/ + +universe u + +@[expose] public section + +namespace IGame + +/-! ### Dicotic games -/ + +/-- A game `x` is dicotic if both players can move from every nonempty subposition of `x`. -/ +@[mk_iff dicotic_def'] +class inductive Dicotic : IGame → Prop where + | mk {x : IGame} : (xᴸ = ∅ ↔ xᴿ = ∅) → (∀ p, ∀ y ∈ x.moves p, Dicotic y) → Dicotic x + +theorem dicotic_def {x : IGame} : Dicotic x ↔ (xᴸ = ∅ ↔ xᴿ = ∅) ∧ ∀ p, ∀ l ∈ x.moves p, Dicotic l := + dicotic_def' x + +namespace Dicotic +variable {x y z : IGame} + +theorem eq_zero_iff [hx : Dicotic x] : x = 0 ↔ ∃ p, x.moves p = ∅ := by + rw [dicotic_def] at hx + simp_all [Player.exists, IGame.ext_iff] + +theorem ne_zero_iff [Dicotic x] : x ≠ 0 ↔ ∀ p, x.moves p ≠ ∅ := by + simpa using eq_zero_iff.not + +theorem moves_eq_empty_iff [hx : Dicotic x] : ∀ p q, x.moves p = ∅ ↔ x.moves q = ∅ := + Player.const_of_left_eq_right' (dicotic_def.1 hx).1 + +protected theorem of_mem_moves {p : Player} [hx : Dicotic x] (h : y ∈ x.moves p) : Dicotic y := + (dicotic_def.1 hx).2 p y h + +/-- `dicotic` eagerly adds all possible `Dicotic` hypotheses. -/ +elab "dicotic" : tactic => + addInstances <| .mk [`IGame.Dicotic.of_mem_moves] + +@[simp] +protected instance zero : Dicotic 0 := by + apply mk <;> simp + +protected instance neg (x) [Dicotic x] : Dicotic (-x) := by + apply mk + · simp [moves_eq_empty_iff .left .right] + · simp_rw [moves_neg, Set.mem_neg] + intro p y hy + dicotic + rw [← neg_neg y] + exact .neg _ +termination_by x +decreasing_by igame_wf + +@[simp] +theorem neg_iff {x : IGame} : Dicotic (-x) ↔ Dicotic x := + ⟨fun _ ↦ by simpa using Dicotic.neg (-x), fun _ ↦ .neg x⟩ + +end Dicotic + +/-! ### Impartial games -/ + +/-- An impartial game is one that's equivalent to its negative, such that each left and right move +is also impartial. + +Note that this is a slightly more general definition than the one that's usually in the literature, +as we don't require `x = -x`. Despite this, the Sprague-Grundy theorem still holds: see +`IGame.equiv_nim_grundyValue`. + +In such a game, both players have the same payoffs at any subposition. -/ +@[mk_iff impartial_def'] +class inductive Impartial : IGame → Prop where + | mk {x : IGame} : -x ≈ x → (∀ p, ∀ y ∈ x.moves p, Impartial y) → Impartial x + +theorem impartial_def {x : IGame} : x.Impartial ↔ -x ≈ x ∧ ∀ p, ∀ y ∈ x.moves p, Impartial y := + impartial_def' x + +namespace Impartial +variable (x y : IGame) [hx : Impartial x] [hy : Impartial y] + +@[simp] theorem neg_equiv : -x ≈ x := (impartial_def.1 hx).1 +@[simp] theorem equiv_neg : x ≈ -x := (neg_equiv _).symm + +omit hx in +theorem sub_equiv : x - y ≈ x + y := add_congr_right (neg_equiv y) + +@[aesop unsafe 50% apply] +protected theorem of_mem_moves {p} {x y : IGame} [h : Impartial x] : + y ∈ x.moves p → Impartial y := + (impartial_def.1 h).2 p y + +/-- `impartial` eagerly adds all possible `Impartial` hypotheses. -/ +elab "impartial" : tactic => + addInstances <| .mk [`IGame.Impartial.of_mem_moves] + +@[simp] protected instance zero : Impartial 0 := by rw [impartial_def]; simp + +protected instance neg (x : IGame) [Impartial x] : Impartial (-x) := by + apply mk + · simp + · simp_rw [moves_neg, Set.mem_neg] + intro p y hy + impartial + rw [← neg_neg y] + exact .neg _ +termination_by x +decreasing_by igame_wf + +protected instance add (x y : IGame) [Impartial x] [Impartial y] : Impartial (x + y) := by + apply mk + · rw [neg_add] + exact add_congr (neg_equiv x) (neg_equiv y) + · simp_rw [forall_moves_add] + intro p + constructor + all_goals intro z hz; impartial; exact .add .. +termination_by (x, y) +decreasing_by igame_wf + +protected instance sub (x y : IGame) [Impartial x] [Impartial y] : Impartial (x - y) := + .add x (-y) + +/-- The product instance is proven in `Game.Impartial.Grundy`. -/ +theorem le_comm {x y} [Impartial x] [Impartial y] : x ≤ y ↔ y ≤ x := by + rw [← IGame.neg_le_neg_iff, (neg_equiv y).le_congr (neg_equiv x)] + +@[simp] +theorem not_lt : ¬x < y := by + apply (lt_asymm · ?_) + rwa [← IGame.neg_lt_neg_iff, (neg_equiv x).lt_congr (neg_equiv y)] + +/-- By setting `y = 0`, we find that in an impartial game, either the first player always wins, or +the second player always wins. -/ +theorem equiv_or_fuzzy : x ≈ y ∨ x ‖ y := by + obtain (h | h | h | h) := lt_or_antisymmRel_or_gt_or_incompRel x y + · cases not_lt x y h + · exact .inl h + · cases not_lt y x h + · exact .inr h + +variable {x y} + +@[simp] +theorem not_equiv_iff : ¬ x ≈ y ↔ x ‖ y := + ⟨(equiv_or_fuzzy x y).resolve_left, IncompRel.not_antisymmRel⟩ + +@[simp] +theorem not_fuzzy_iff : ¬ x ‖ y ↔ x ≈ y := + not_iff_comm.1 not_equiv_iff + +@[simp] +theorem le_iff_equiv : x ≤ y ↔ x ≈ y := + ⟨fun h ↦ ⟨h, le_comm.1 h⟩, And.left⟩ + +theorem ge_iff_equiv : y ≤ x ↔ x ≈ y := + ⟨fun h ↦ ⟨le_comm.2 h, h⟩, And.right⟩ + +theorem lf_iff_fuzzy : x ⧏ y ↔ x ‖ y := by simp [comm] +theorem gf_iff_fuzzy : y ⧏ x ↔ x ‖ y := by simp + +theorem fuzzy_of_mem_moves {y : IGame} {p : Player} (hy : y ∈ x.moves p) : y ‖ x := by + have := hx.of_mem_moves hy + cases p with + | left => symm; simpa using left_lf hy + | right => simpa using lf_right hy + +private theorem equiv_iff_forall_fuzzy' : + x ≈ y ↔ (∀ z ∈ xᴸ, z ‖ y) ∧ (∀ z ∈ yᴿ, x ‖ z) := by + rw [← le_iff_equiv, le_iff_forall_lf] + congr! with z hz z hz + all_goals impartial; simp [incompRel_comm] + +theorem equiv_iff_forall_fuzzy (p : Player) : + x ≈ y ↔ (∀ z ∈ x.moves p, z ‖ y) ∧ (∀ z ∈ y.moves (-p), x ‖ z) := by + cases p with + | left => exact equiv_iff_forall_fuzzy' + | right => + rw [antisymmRel_comm, equiv_iff_forall_fuzzy', and_comm] + simp_rw [incompRel_comm] + rfl + +theorem fuzzy_iff_exists_equiv (p : Player) : + x ‖ y ↔ (∃ z ∈ x.moves p, z ≈ y) ∨ (∃ z ∈ y.moves (-p), x ≈ z) := by + rw [← not_equiv_iff, equiv_iff_forall_fuzzy p, not_and_or] + simp_rw [not_forall, ← exists_prop] + congr! with _ h _ h + all_goals impartial; exact not_fuzzy_iff + +theorem equiv_zero (p : Player) : x ≈ 0 ↔ ∀ y ∈ x.moves p, y ‖ 0 := by + rw [equiv_iff_forall_fuzzy p]; simp + +theorem fuzzy_zero (p : Player) : x ‖ 0 ↔ ∃ y ∈ x.moves p, y ≈ 0 := by + rw [fuzzy_iff_exists_equiv p]; simp + +/-- A **strategy stealing** argument. If there's a move in `x`, such that any immediate move could +have also been reached in the first turn, then `x` is won by the first player. -/ +theorem fuzzy_zero_of_forall_exists {p : Player} {y} (hy : y ∈ x.moves p) + (H : ∀ z ∈ y.moves p, ∃ w ∈ x.moves p, z ≈ w) : x ‖ 0 := by + apply (equiv_or_fuzzy _ _).resolve_left fun hx ↦ ?_ + impartial + rw [equiv_zero] at hx + obtain ⟨z, hz, hz'⟩ := (fuzzy_zero _).1 (hx y hy) + obtain ⟨w, hw, hw'⟩ := H z hz + exact (hx w hw).not_antisymmRel (hw'.symm.trans hz') + +end Impartial + +/-! ### Numeric games -/ + +/-- A game `!{s | t}` is numeric if everything in `s` is less than everything in `t`, and all the +elements of these sets are also numeric. + +The `Surreal` numbers are built as the quotient of numeric games under equivalence. -/ +@[mk_iff numeric_def'] +class inductive Numeric : IGame → Prop where + | mk {x : IGame} : (∀ y ∈ xᴸ, ∀ z ∈ xᴿ, y < z) → (∀ p, ∀ y ∈ x.moves p, Numeric y) → Numeric x + +theorem numeric_def {x : IGame} : Numeric x ↔ + (∀ y ∈ xᴸ, ∀ z ∈ xᴿ, y < z) ∧ (∀ p, ∀ y ∈ x.moves p, Numeric y) := + numeric_def' x + +namespace Numeric +variable {x y z : IGame} + +theorem left_lt_right [h : Numeric x] (hy : y ∈ xᴸ) (hz : z ∈ xᴿ) : y < z := + (numeric_def.1 h).1 y hy z hz + +protected theorem of_mem_moves {p : Player} [h : Numeric x] (hy : y ∈ x.moves p) : Numeric y := + (numeric_def.1 h).2 p y hy + +/-- `numeric` eagerly adds all possible `Numeric` hypotheses. -/ +elab "numeric" : tactic => + addInstances <| .mk [`IGame.Numeric.of_mem_moves] + +protected theorem subposition [Numeric x] (h : Subposition y x) : Numeric y := by + induction x using IGame.moveRecOn generalizing ‹x.Numeric› with | ind x ih + obtain ⟨p, z, hz, hy⟩ := subposition_iff_exists.1 h + obtain rfl | hy := wsubposition_iff_eq_or_subposition.1 hy + · exact .of_mem_moves hz + · exact @ih p z hz (.of_mem_moves hz) hy + +@[simp] +protected instance zero : Numeric 0 := by + rw [numeric_def]; simp + +@[simp] +protected instance one : Numeric 1 := by + rw [numeric_def]; simp + +protected instance subtype (x : Subtype Numeric) : Numeric x.1 := x.2 +protected instance moves {x : IGame} [Numeric x] {p : Player} (y : x.moves p) : Numeric y := + .of_mem_moves y.2 + +protected theorem le_of_not_le {x y : IGame} [Numeric x] [Numeric y] : ¬ x ≤ y → y ≤ x := by + rw [lf_iff_exists_le, le_iff_forall_lf] + rintro (⟨z, hz, h⟩ | ⟨z, hz, h⟩) <;> constructor <;> intro a ha h' + · numeric + exact left_lf_of_le h' hz (Numeric.le_of_not_le (left_lf_of_le h ha)) + · exact (left_lt_right hz ha).not_ge (h'.trans h) + · exact (left_lt_right ha hz).not_ge (h.trans h') + · numeric + exact lf_right_of_le h' hz (Numeric.le_of_not_le (lf_right_of_le h ha)) +termination_by x +decreasing_by igame_wf + +protected theorem le_total (x y : IGame) [Numeric x] [Numeric y] : x ≤ y ∨ y ≤ x := by + rw [or_iff_not_imp_left] + exact Numeric.le_of_not_le + +protected theorem lt_of_not_ge [Numeric x] [Numeric y] (h : ¬ x ≤ y) : y < x := + (Numeric.le_of_not_le h).lt_of_not_ge h + +@[simp] +protected theorem not_le [Numeric x] [Numeric y] : ¬ x ≤ y ↔ y < x := + ⟨Numeric.lt_of_not_ge, not_le_of_gt⟩ + +@[simp] +protected theorem not_lt [Numeric x] [Numeric y] : ¬ x < y ↔ y ≤ x := + not_iff_comm.1 Numeric.not_le + +protected theorem le_or_gt (x y : IGame) [Numeric x] [Numeric y] : x ≤ y ∨ y < x := by + rw [← Numeric.not_le] + exact em _ + +protected theorem lt_or_ge (x y : IGame) [Numeric x] [Numeric y] : x < y ∨ y ≤ x := by + rw [← Numeric.not_lt] + exact em _ + +theorem not_fuzzy (x y : IGame) [Numeric x] [Numeric y] : ¬ x ‖ y := by + simpa [not_incompRel_iff_symmGen, Relation.SymmGen] using Numeric.le_total x y + +theorem lt_or_equiv_or_gt (x y : IGame) [Numeric x] [Numeric y] : x < y ∨ x ≈ y ∨ y < x := by + simp_rw [← Numeric.not_le]; tauto + +/-- To prove a game is numeric, it suffices to show the left options are less or fuzzy +to the right options. -/ +theorem mk_of_lf (h₁ : ∀ y ∈ xᴸ, ∀ z ∈ xᴿ, y ⧏ z) (h₂ : ∀ p, ∀ y ∈ x.moves p, Numeric y) : + Numeric x := + mk (fun y hy z hz ↦ (@Numeric.not_le z y (h₂ _ z hz) (h₂ _ y hy)).1 (h₁ y hy z hz)) h₂ + +theorem le_iff_forall_lt [Numeric x] [Numeric y] : + x ≤ y ↔ (∀ z ∈ xᴸ, z < y) ∧ (∀ z ∈ yᴿ, x < z) := by + rw [le_iff_forall_lf] + congr! with z hz z hz <;> numeric <;> rw [Numeric.not_le] + +theorem lt_iff_exists_le [Numeric x] [Numeric y] : + x < y ↔ (∃ z ∈ yᴸ, x ≤ z) ∨ (∃ z ∈ xᴿ, z ≤ y) := by + rw [← Numeric.not_le, lf_iff_exists_le] + +theorem left_lt [Numeric x] (h : y ∈ xᴸ) : y < x := by + numeric; simpa using left_lf h + +theorem lt_right [Numeric x] (h : y ∈ xᴿ) : x < y := by + numeric; simpa using lf_right h + +protected instance neg (x : IGame) [Numeric x] : Numeric (-x) := by + refine mk (fun y hy z hz ↦ ?_) ?_ + · rw [← IGame.neg_lt_neg_iff] + apply @left_lt_right x <;> simp_all + · simp_rw [forall_moves_neg] + intro p y hy + numeric + simpa using Numeric.neg y +termination_by x +decreasing_by igame_wf + +@[simp] +theorem neg_iff {x : IGame} : Numeric (-x) ↔ Numeric x := + ⟨fun _ ↦ by simpa using Numeric.neg (-x), fun _ ↦ Numeric.neg x⟩ + +protected instance add (x y : IGame) [Numeric x] [Numeric y] : Numeric (x + y) := by + apply mk <;> simp only [moves_add, Set.mem_union, Set.mem_image] + · rintro _ (⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩) _ (⟨b, hb, rfl⟩ | ⟨b, hb, rfl⟩) + any_goals simpa using left_lt_right ha hb + all_goals + trans (x + y) + · simpa using left_lt ha + · simpa using lt_right hb + · rintro p _ (⟨z, hz, rfl⟩ | ⟨z, hz, rfl⟩) + all_goals numeric; exact Numeric.add .. +termination_by (x, y) +decreasing_by igame_wf + +protected instance sub (x y : IGame) [Numeric x] [Numeric y] : Numeric (x - y) := + inferInstanceAs (Numeric (x + -y)) + +protected instance natCast : ∀ n : ℕ, Numeric n + | 0 => inferInstanceAs (Numeric 0) + | n + 1 => have := Numeric.natCast n; inferInstanceAs (Numeric (n + 1)) + +protected instance ofNat (n : ℕ) [n.AtLeastTwo] : Numeric ofNat(n) := + inferInstanceAs (Numeric n) + +protected instance intCast : ∀ n : ℤ, Numeric n + | .ofNat n => inferInstanceAs (Numeric n) + | .negSucc n => inferInstanceAs (Numeric (-(n + 1))) + +end Numeric + +/-! ### Short games -/ + +/-- A short game is one with finitely many subpositions. That is, the left and right sets are +finite, and all of the games in them are short as well. -/ +@[mk_iff short_def'] +class inductive Short : IGame → Prop where + | mk' (x : IGame) : (∀ p, (x.moves p).Finite) → (∀ p, ∀ y ∈ x.moves p, Short y) → Short x + +theorem short_def {x : IGame} : Short x ↔ ∀ p, (x.moves p).Finite ∧ ∀ y ∈ x.moves p, Short y := by + rw [short_def', ← forall_and] + +alias ⟨_, Short.mk⟩ := short_def + +namespace Short +variable {x y : IGame} + +theorem finite_moves (p : Player) (x : IGame) [h : Short x] : (x.moves p).Finite := + (short_def.1 h p).1 + +instance (p : Player) (x : IGame) [Short x] : Finite (x.moves p) := + (Short.finite_moves _ x).to_subtype + +protected theorem of_mem_moves [h : Short x] {p} (hy : y ∈ x.moves p) : Short y := + (short_def.1 h p).2 y hy + +/-- `short` eagerly adds all possible `Short` hypotheses. -/ +elab "short" : tactic => + addInstances <| .mk [`IGame.Short.of_mem_moves] + +protected theorem subposition {x : IGame} [Short x] (h : Subposition y x) : Short y := by + induction x using IGame.moveRecOn generalizing ‹x.Short› with | ind x ih + obtain ⟨p, z, hz, hy⟩ := subposition_iff_exists.1 h + obtain rfl | hy := wsubposition_iff_eq_or_subposition.1 hy + · exact .of_mem_moves hz + · exact @ih p z hz (.of_mem_moves hz) hy + +theorem finite_setOf_subposition (x : IGame) [Short x] : {y | Subposition y x}.Finite := by + induction x using IGame.moveRecOn generalizing ‹x.Short› with | ind x ih + convert Set.finite_iUnion fun p => (finite_moves p x).biUnion fun y hy ↦ + (@ih p y hy (.of_mem_moves hy)).insert y + ext + rw [Set.mem_setOf, subposition_iff_exists] + simp [wsubposition_iff_eq_or_subposition] + +instance (x : IGame) [Short x] : Finite {y // Subposition y x} := + (Short.finite_setOf_subposition x).to_subtype + +theorem _root_.IGame.short_iff_finite_setOf_subposition {x : IGame} : + Short x ↔ {y | Subposition y x}.Finite := by + refine ⟨@finite_setOf_subposition x, fun h ↦ mk fun p ↦ ⟨?_, ?_⟩⟩ + on_goal 1 => refine h.subset fun y hy ↦ ?_ + on_goal 2 => refine fun y hy ↦ short_iff_finite_setOf_subposition.2 <| h.subset fun z hz ↦ ?_ + all_goals igame_wf +termination_by x +decreasing_by igame_wf + +@[simp] +protected instance zero : Short 0 := by + rw [short_def]; simp + +@[simp] +protected instance one : Short 1 := by + rw [short_def]; simp + +protected instance neg (x : IGame) [Short x] : Short (-x) := by + refine mk fun p ↦ ⟨?_, ?_⟩ + · simpa [← Set.image_neg_eq_neg] using (finite_moves _ x).image _ + · rw [forall_moves_neg] + intro y hy + simpa using (Short.of_mem_moves hy).neg +termination_by x +decreasing_by igame_wf + +@[simp] +theorem neg_iff {x : IGame} : Short (-x) ↔ Short x := + ⟨fun _ ↦ by simpa using Short.neg (-x), fun _ ↦ Short.neg x⟩ + +protected instance add (x y : IGame) [Short x] [Short y] : Short (x + y) := by + refine mk fun p ↦ ⟨?_, ?_⟩ + · simpa using ⟨(finite_moves _ x).image _, (finite_moves _ y).image _⟩ + · rw [forall_moves_add] + constructor + all_goals intro z hz; short; exact Short.add .. +termination_by (x, y) +decreasing_by igame_wf + +protected instance sub (x y : IGame) [Short x] [Short y] : Short (x - y) := + .add .. + +protected instance natCast : ∀ n : ℕ, Short n + | 0 => inferInstanceAs (Short 0) + | n + 1 => have := Short.natCast n; inferInstanceAs (Short (n + 1)) + +protected instance ofNat (n : ℕ) [n.AtLeastTwo] : Short ofNat(n) := + inferInstanceAs (Short n) + +protected instance intCast : ∀ n : ℤ, Short n + | .ofNat n => inferInstanceAs (Short n) + | .negSucc n => inferInstanceAs (Short (-(n + 1))) + +protected instance mul (x y : IGame) [Short x] [Short y] : Short (x * y) := by + refine mk fun p ↦ ⟨?_, ?_⟩ + · simpa [Set.image_union] using + ⟨(finite_moves _ x).image2 _ (finite_moves _ y), + (finite_moves _ x).image2 _ (finite_moves _ y)⟩ + · rw [forall_moves_mul] + intro p' a ha b hb + replace ha := Short.of_mem_moves ha + replace hb := Short.of_mem_moves hb + have := Short.mul a y; have := Short.mul x b; have := Short.mul a b + rw [mulOption] + infer_instance +termination_by (x, y) +decreasing_by igame_wf + +protected instance mulOption (x y a b : IGame) [Short x] [Short y] [Short a] [Short b] : + Short (mulOption x y a b) := + .sub .. + +end Short +end IGame diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Functor.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Functor.lean new file mode 100644 index 0000000000..80d09b34f4 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Functor.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2025 Aaron Liu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aaron Liu, Violeta Hernández Palacios, Yuyang Zhao +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Player +public import Mathlib.Data.QPF.Univariate.Basic + +import Mathlib.Logic.Small.Set + +/-! +# Game functor + +The type of games `IGame` is an inductive type, with a single constructor `ofSets` taking in two +small sets of games (one for each player) and outputting a new game. This suggests the definition: + +``` +inductive IGame : Type (u + 1) + | ofSets (st : Player → Set IGame) [∀ p, Small.{u} (st p)] : IGame.{u} +``` + +However, the kernel does not accept this, as `Set IGame = IGame → Prop` contains a non-positive +occurence of `IGame` (see [counterexamples.org](https://counterexamples.org/strict-positivity.html) +for an explanation of what this is and why it's disallowed). We can get around this technical +limitation using the machinery of `QPF`s (quotients of polynomial functors). We define a functor +`GameFunctor` by + +``` +def GameFunctor (α : Type (u + 1)) : Type (u + 1) := + {st : Player → Set α // Small.{u} (st left) ∧ Small.{u} (st right)} +``` + +We can prove that this is a `QPF`, which then allows us to build its initial algebra through +`QPF.Fix`, which is exactly the inductive type `IGame`. As a bonus, we're able to describe the +coinductive type of loopy games `LGame` as the final coalgebra `QPF.Cofix` of the exact same +functor. +-/ + +universe u + +@[expose] public section + +/-! ### Game Functor -/ + +/-- The functor from a type into the subtype of small pairs of sets in that type. + +This is the quotient of a polynomial functor. The type `IGame` of well-founded games is defined as +the initial algebra of that `QPF`, while the type `LGame` of loopy games is defined as its final +coalgebra. + +In other words, `IGame` and `LGame` have the following descriptions (which don't work verbatim due +to various Lean limitations): + +``` +inductive IGame : Type (u + 1) + | ofSets (st : Player → Set IGame) [∀ p, Small.{u} (st p)] : IGame.{u} + +coinductive LGame : Type (u + 1) + | ofSets (st : Player → Set IGame) [∀ p, Small.{u} (st p)] : LGame.{u} +``` +-/ +def GameFunctor (α : Type (u + 1)) : Type (u + 1) := + {s : Player → Set α // ∀ p, Small.{u} (s p)} + +namespace GameFunctor + +@[ext] theorem ext {α : Type (u + 1)} {x y : GameFunctor α} : x.1 = y.1 → x = y := Subtype.ext + +instance {α : Type (u + 1)} (x : GameFunctor α) (p : Player) : Small.{u} (x.1 p) := x.2 p + +instance : Functor GameFunctor where + map f s := ⟨(f '' s.1 ·), fun _ ↦ by infer_instance⟩ + +theorem map_def {α β} (f : α → β) (s : GameFunctor α) : + f <$> s = ⟨(f '' s.1 ·), fun _ ↦ by infer_instance⟩ := + rfl +noncomputable instance : QPF GameFunctor where + P := ⟨Player → Type u, fun x ↦ Σ p, PLift (x p)⟩ + abs x := ⟨fun p ↦ Set.range (x.2 ∘ .mk p ∘ PLift.up), fun _ ↦ by infer_instance⟩ + repr x := ⟨fun p ↦ Shrink (x.1 p), Sigma.rec (fun _ y ↦ ((equivShrink _).symm y.1).1)⟩ + abs_repr x := by ext; simp [← (equivShrink _).exists_congr_right] + abs_map f := by intro ⟨x, f⟩; ext; simp [PFunctor.map, map_def] + +end GameFunctor diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean new file mode 100644 index 0000000000..242f7a9fe5 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean @@ -0,0 +1,1301 @@ +/- +Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios, Reid Barton, Mario Carneiro, Isabel Longbottom, Kim Morrison, +Yuyang Zhao +-/ +module + +public import Batteries.Classes.RatCast +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Player +public meta import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.Register +public import Mathlib.Algebra.Group.Pointwise.Set.Small +public import Mathlib.Algebra.Order.ZeroLEOne +public import Mathlib.Order.Comparable + +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Functor +import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Small +import Mathlib.Lean.PrettyPrinter.Delaborator +import Mathlib.Logic.Hydra +import Mathlib.Order.GameAdd + +/-! +# Combinatorial (pre-)games + +The basic theory of combinatorial games, following Conway's book `On Numbers and Games`. + +In ZFC, games are built inductively out of two other sets of games, representing the options for two +players Left and Right. In Lean, we instead define the type of games `IGame` as arising from two +`Small` sets of games, with notation `!{s | t}`. A `u`-small type `α : Type v` +is one that is equivalent to some `β : Type u`, and the distinction between small and large types in +a given universe closely mimics the ZFC distinction between sets and proper classes. + +This definition requires some amount of setup, since Lean's inductive types aren't powerful enough +to express this on their own. See the docstring on `GameFunctor` for more information. + +We are also interested in further quotients of `IGame`. The quotient of games under equivalence +`x ≈ y ↔ x ≤ y ∧ y ≤ x`, which in the literature is often what is meant by a "combinatorial game", +is defined as `Game` in `CombinatorialGames.Game.Basic`. The surreal numbers `Surreal` are defined +as a quotient (of a subtype) of games in `CombinatorialGames.Surreal.Basic`. + +## Conway induction + +Most constructions within game theory, and as such, many proofs within it, are done by structural +induction. Structural induction on games is sometimes called "Conway induction". + +The most straightforward way to employ Conway induction is by using the termination checker, with +the auxiliary `igame_wf` tactic. This uses `solve_by_elim` to search the context for proofs of the +form `y ∈ xᴸ` or `y ∈ xᴿ`, which prove termination. Alternatively, you can use +the explicit recursion principles `IGame.ofSetsRecOn` or `IGame.moveRecOn`. + +## Order properties + +Pregames have both a `≤` and a `<` relation, satisfying the properties of a `Preorder`. The relation +`0 < x` means that `x` can always be won by Left, while `0 ≤ x` means that `x` can be won by Left as +the second player. Likewise, `x < 0` means that `x` can always be won by Right, while `x ≤ 0` means +that `x` can be won by Right as the second player. + +Note that we don't actually prove these characterizations. Indeed, in Conway's setup, combinatorial +game theory can be done entirely without the concept of a strategy. For instance, `IGame.zero_le` +implies that if `0 ≤ x`, then any move by Right satisfies `¬ x ≤ 0`, and `IGame.zero_lf` implies +that if `¬ x ≤ 0`, then some move by Left satisfies `0 ≤ x`. The strategy is thus already encoded +within these game relations. + +For convenience, we define notation `x ⧏ y` (pronounced "less or fuzzy") for `¬ y ≤ x`, notation +`x ‖ y` for `¬ x ≤ y ∧ ¬ y ≤ x`, and notation `x ≈ y` for `x ≤ y ∧ y ≤ x`. + +You can prove most (simple) inequalities on concrete games through the `game_cmp` tactic, which +repeatedly unfolds the definition of `≤` and applies `simp` until it solves the goal. + +## Algebraic structures + +Most of the usual arithmetic operations can be defined for games. Addition is defined for +`x = !{s₁ | t₁}` and `y = !{s₂ | t₂}` by `x + y = !{s₁ + y, x + s₂ | t₁ + y, x + t₂}`. Negation is +defined by `-!{s | t} = !{-t | -s}`. + +The order structures interact in the expected way with arithmetic. In particular, `Game` is an +`OrderedAddCommGroup`. Meanwhile, `IGame` satisfies the slightly weaker axioms of a +`SubtractionCommMonoid`, since the equation `x - x = 0` is only true up to equivalence. +-/ + +theorem Relation.transGen_iff_exists {α : Type*} {r : α → α → Prop} {x y : α} : + Relation.TransGen r x y ↔ ∃ z, r z y ∧ (x = z ∨ TransGen r x z) := by + rw [transGen_iff] + simp [and_or_left, exists_or, and_comm] + +universe u + +open Set Pointwise + +-- Computations can be performed through the `game_cmp` tactic. +public noncomputable section + +/-! ### Game moves -/ + +/-- Well-founded games up to identity. + +`IGame` uses the set-theoretic notion of equality on games, meaning that two `IGame`s are equal +exactly when their left and right sets of options are. + +This is not the same equivalence as used broadly in combinatorial game theory literature, as a game +like `{0, 1 | 0}` is not *identical* to `{1 | 0}`, despite being equivalent. However, many theorems +can be proven over the 'identical' equivalence relation, and the literature may occasionally +specifically use the 'identical' equivalence relation for this reason. The quotient `Game` of games +up to equality is defined in `CombinatorialGames.Game.Basic`. + +More precisely, `IGame` is the inductive type for the single constructor + +``` + | ofSets (s t : Set IGame.{u}) [Small.{u} s] [Small.{u} t] : IGame.{u} +``` + +(though for technical reasons it's not literally defined as such). A consequence of this is that +there is no infinite line of play. See `LGame` for a definition of loopy games. -/ +def IGame : Type (u + 1) := + QPF.Fix GameFunctor + +namespace IGame +export Player (left right) + +/-- Construct an `IGame` from its left and right sets. + +This function is regrettably noncomputable. Among other issues, sets simply do not carry data in +Lean. To perform computations on `IGame` we can instead make use of the `game_cmp` tactic. -/ +@[no_expose] +instance : OfSets IGame fun _ ↦ True where + ofSets st _ := QPF.Fix.mk ⟨st, by rintro (_ | _) <;> assumption⟩ + +/-- The set of moves of the game. -/ +def moves (p : Player) (x : IGame.{u}) : Set IGame.{u} := x.dest.1 p + +/-- The set of left moves of the game. -/ +scoped notation:max x:max "ᴸ" => moves left x + +/-- The set of right moves of the game. -/ +scoped notation:max x:max "ᴿ" => moves right x + +instance (p : Player) (x : IGame.{u}) : Small.{u} (x.moves p) := x.dest.2 p + +@[simp, game_cmp] +theorem moves_ofSets (p) (st : Player → Set IGame) [Small.{u} (st left)] [Small.{u} (st right)] : + !{st}.moves p = st p := by + dsimp [ofSets]; ext; rw [moves, QPF.Fix.dest_mk] + +@[simp] +theorem ofSets_moves (x : IGame) : !{x.moves} = x := x.mk_dest + +@[game_cmp] +theorem leftMoves_ofSets (s t : Set IGame) [Small.{u} s] [Small.{u} t] : !{s | t}ᴸ = s := + moves_ofSets .. + +@[game_cmp] +theorem rightMoves_ofSets (s t : Set IGame) [Small.{u} s] [Small.{u} t] : !{s | t}ᴿ = t := + moves_ofSets .. + +@[simp] +theorem ofSets_leftMoves_rightMoves (x : IGame) : !{xᴸ | xᴿ} = x := by + convert x.ofSets_moves with p + cases p <;> rfl + +/-- Two `IGame`s are equal when their move sets are. + +For the weaker but more common notion of equivalence where `x = y` if `x ≤ y` and `y ≤ x`, +use `Game`. -/ +@[ext] +theorem ext {x y : IGame.{u}} (h : ∀ p, x.moves p = y.moves p) : + x = y := by + rw [← ofSets_moves x, ← ofSets_moves y] + simp_rw [funext h] + +@[simp] +theorem ofSets_inj' {st₁ st₂ : Player → Set IGame} + [Small (st₁ left)] [Small (st₁ right)] [Small (st₂ left)] [Small (st₂ right)] : + !{st₁} = !{st₂} ↔ st₁ = st₂ := by + simp_rw [IGame.ext_iff, moves_ofSets, funext_iff] + +theorem ofSets_inj {s₁ s₂ t₁ t₂ : Set IGame} [Small s₁] [Small s₂] [Small t₁] [Small t₂] : + !{s₁ | t₁} = !{s₂ | t₂} ↔ s₁ = s₂ ∧ t₁ = t₂ := by + simp + +/-- A (proper) subposition is any game reachable a nonempty sequence of +(not necessarily alternating) left and right moves. -/ +def Subposition : IGame → IGame → Prop := + Relation.TransGen fun x y => x ∈ ⋃ p, y.moves p + +@[aesop unsafe apply 50%] +theorem Subposition.of_mem_moves {p} {x y : IGame} (h : x ∈ y.moves p) : Subposition x y := + Relation.TransGen.single (Set.mem_iUnion_of_mem p h) + +theorem Subposition.trans {x y z : IGame} (h₁ : Subposition x y) (h₂ : Subposition y z) : + Subposition x z := + Relation.TransGen.trans h₁ h₂ + +instance : IsTrans _ Subposition := inferInstanceAs (IsTrans _ (Relation.TransGen _)) + +/-- The set of games reachable from a given game is small. -/ +instance small_setOf_subposition (x : IGame.{u}) : Small.{u} {y | Subposition y x} := + small_transGen' _ x + +/-- A variant of `small_setOf_subposition` in simp-normal form -/ +instance small_subtype_subposition (x : IGame.{u}) : Small.{u} {y // Subposition y x} := + small_transGen' _ x + +theorem subposition_wf : WellFounded Subposition := by + refine ⟨fun x => Acc.transGen ?_⟩ + apply QPF.Fix.ind + unfold moves + rintro _ ⟨⟨st, hst⟩, rfl⟩ + constructor + rintro y hy + rw [QPF.Fix.dest_mk, mem_iUnion] at hy + obtain ⟨_, ⟨_, h⟩, _, rfl⟩ := hy + exact h + +-- We make no use of `IGame`'s definition from a `QPF` after this point. +attribute [irreducible] IGame + +instance : IsWellFounded _ Subposition := ⟨subposition_wf⟩ +instance : WellFoundedRelation IGame := ⟨Subposition, instIsWellFoundedSubposition.wf⟩ + +theorem Subposition.irrefl (x : IGame) : ¬Subposition x x := _root_.irrefl x + +theorem self_notMem_moves (p : Player) (x : IGame) : x ∉ x.moves p := + fun hx ↦ Subposition.irrefl x (.of_mem_moves hx) + +/-- `WSubposition x y` means that `x` is reachable from `y` by a sequence of moves. +It is the non-strict version of `Subposition`. -/ +def WSubposition (x y : IGame) : Prop := x = y ∨ Subposition x y + +theorem wsubposition_iff_eq_or_subposition {x y : IGame} : + WSubposition x y ↔ x = y ∨ Subposition x y := .rfl + +theorem subposition_iff_exists {x y : IGame} : Subposition x y ↔ + ∃ p, ∃ z ∈ y.moves p, WSubposition x z := by + unfold WSubposition Subposition + rw [Relation.transGen_iff_exists] + simp_rw [mem_iUnion, ← exists_and_right, and_or_left] + exact exists_comm + +/-- The set of games reachable from a given game is small. -/ +instance small_setOf_wsubposition (x : IGame.{u}) : Small.{u} {y | WSubposition y x} := + small_insert x {y | Subposition y x} + +/-- A variant of `small_setOf_wsubposition` in simp-normal form -/ +instance small_subtype_wsubposition (x : IGame.{u}) : Small.{u} {y // WSubposition y x} := + small_insert x {y | Subposition y x} + +@[simp, refl] theorem WSubposition.refl (x : IGame) : WSubposition x x := .inl rfl +theorem WSubposition.rfl {x : IGame} : WSubposition x x := .refl x +theorem wsubposition_of_eq {x y : IGame} (hxy : x = y) : WSubposition x y := hxy ▸ .rfl + +theorem wsubposition_of_subposition {x y : IGame} (h : Subposition x y) : + WSubposition x y := .inr h + +alias Subposition.wsubposition := wsubposition_of_subposition + +theorem subposition_of_wsubposition_of_subposition {x y z : IGame} + (hxy : WSubposition x y) (hyz : Subposition y z) : Subposition x z := by + obtain rfl | hxy := hxy + · exact hyz + · exact hxy.trans hyz + +theorem subposition_of_subposition_of_wsubposition {x y z : IGame} + (hxy : Subposition x y) (hyz : WSubposition y z) : Subposition x z := by + obtain rfl | hyz := hyz + · exact hxy + · exact hxy.trans hyz + +alias WSubposition.trans_subposition := subposition_of_wsubposition_of_subposition +alias Subposition.trans_wsubposition' := subposition_of_wsubposition_of_subposition +alias Subposition.trans_wsubposition := subposition_of_subposition_of_wsubposition +alias WSubposition.trans_subposition' := subposition_of_subposition_of_wsubposition + +@[trans] theorem wsubposition_trans {x y z : IGame} + (hxy : WSubposition x y) (hyz : WSubposition y z) : WSubposition x z := by + obtain rfl | hyz := hyz + · exact hxy + · exact (hxy.trans_subposition hyz).wsubposition + +alias WSubposition.trans := wsubposition_trans + +instance : Trans Subposition Subposition Subposition := ⟨Subposition.trans⟩ +instance : Trans WSubposition Subposition Subposition := ⟨WSubposition.trans_subposition⟩ +instance : Trans Subposition WSubposition Subposition := ⟨Subposition.trans_wsubposition⟩ +instance : Trans WSubposition WSubposition WSubposition := ⟨WSubposition.trans⟩ + +theorem not_subposition_of_wsubposition {x y : IGame} (hxy : WSubposition x y) : + ¬Subposition y x := fun hyx => Subposition.irrefl x (hxy.trans_subposition hyx) + +theorem not_wsubposition_of_subposition {x y : IGame} (hxy : Subposition x y) : + ¬WSubposition y x := fun hyx => Subposition.irrefl x (hxy.trans_wsubposition hyx) + +alias WSubposition.not_subposition := not_subposition_of_wsubposition +alias Subposition.not_wsubposition := not_wsubposition_of_subposition + +theorem wsubposition_antisymm {x y : IGame} + (hxy : WSubposition x y) (hyx : WSubposition y x) : x = y := + hxy.resolve_right fun h => Subposition.irrefl x (h.trans_wsubposition hyx) + +alias WSubposition.antisymm := wsubposition_antisymm + +theorem wsubposition_antisymm_iff {x y : IGame} : x = y ↔ WSubposition x y ∧ WSubposition y x := + ⟨fun h => h ▸ ⟨.rfl, .rfl⟩, fun h => h.1.antisymm h.2⟩ + +theorem subposition_of_wsubposition_of_ne {x y : IGame} (hw : WSubposition x y) (hne : x ≠ y) : + Subposition x y := hw.resolve_left hne + +theorem subposition_of_wsubposition_not_wsubposition {x y : IGame} + (hxy : WSubposition x y) (hyx : ¬WSubposition y x) : Subposition x y := + hxy.resolve_left fun h => hyx (wsubposition_of_eq h.symm) + +theorem subposition_iff_wsubposition_not_wsubposition {x y : IGame} : + Subposition x y ↔ WSubposition x y ∧ ¬WSubposition y x := + ⟨fun hxy => ⟨hxy.wsubposition, hxy.not_wsubposition⟩, + fun h => subposition_of_wsubposition_not_wsubposition h.1 h.2⟩ + +theorem WSubposition.of_mem_moves {p : Player} {x y : IGame} (hxy : x ∈ y.moves p) : + WSubposition x y := (Subposition.of_mem_moves hxy).wsubposition + +/-- **Conway recursion**: build data for a game by recursively building it on its +left and right sets. You rarely need to use this explicitly, as the termination checker will handle +things for you. + +See `ofSetsRecOn` for an alternate form. -/ +@[elab_as_elim] +def moveRecOn {motive : IGame → Sort*} (x) + (ind : Π x, (Π p, Π y ∈ x.moves p, motive y) → motive x) : + motive x := + subposition_wf.recursion x fun x IH ↦ ind x (fun _ _ h ↦ IH _ (.of_mem_moves h)) + +theorem moveRecOn_eq {motive : IGame → Sort*} (x) + (ind : Π x, (Π p, Π y ∈ x.moves p, motive y) → motive x) : + moveRecOn x ind = ind x (fun _ y _ ↦ moveRecOn y ind) := + subposition_wf.fix_eq .. + +/-- **Conway recursion**: build data for a game by recursively building it on its +left and right sets. You rarely need to use this explicitly, as the termination checker will handle +things for you. + +See `moveRecOn` for an alternate form. -/ +@[elab_as_elim] +def ofSetsRecOn {motive : IGame.{u} → Sort*} (x) + (ofSets : Π (s t : Set IGame) [Small s] [Small t], + (Π x ∈ s, motive x) → (Π x ∈ t, motive x) → motive !{s | t}) : + motive x := + cast (by simp) <| moveRecOn (motive := fun x ↦ motive !{xᴸ | xᴿ}) x + fun x IH ↦ ofSets _ _ + (fun y hy ↦ cast (by simp) (IH left y hy)) (fun y hy ↦ cast (by simp) (IH right y hy)) + +@[simp] +theorem ofSetsRecOn_ofSets {motive : IGame.{u} → Sort*} + (s t : Set IGame) [Small.{u} s] [Small.{u} t] + (ofSets : Π (s t : Set IGame) [Small s] [Small t], + (Π x ∈ s, motive x) → (Π x ∈ t, motive x) → motive !{s | t}) : + ofSetsRecOn !{s | t} ofSets = + ofSets _ _ (fun y _ ↦ ofSetsRecOn y ofSets) (fun y _ ↦ ofSetsRecOn y ofSets) := by + rw [ofSetsRecOn, cast_eq_iff_heq, moveRecOn_eq] + simp_rw [ofSetsRecOn] + congr! <;> simp_all + +/-- Discharges proof obligations of the form `⊢ Subposition ..` arising in termination proofs +of definitions using well-founded recursion on `IGame`. -/ +macro "igame_wf" config:Lean.Parser.Tactic.optConfig : tactic => + `(tactic| all_goals solve_by_elim $config + [Prod.Lex.left, Prod.Lex.right, PSigma.Lex.left, PSigma.Lex.right, + Subposition.of_mem_moves, Subposition.trans, Subtype.prop] ) + +/-! ### Basic games -/ + +/-- The game `0 = !{∅ | ∅}`. -/ +instance : Zero IGame := ⟨!{fun _ ↦ ∅}⟩ + +theorem zero_def : (0 : IGame) = !{fun _ ↦ ∅} := rfl + +@[simp, game_cmp] theorem moves_zero (p : Player) : moves p 0 = ∅ := moves_ofSets .. + +instance : Inhabited IGame := ⟨0⟩ + +/-- The game `1 = !{{0} | ∅}`. -/ +instance : One IGame := ⟨!{{0} | ∅}⟩ + +theorem one_def : (1 : IGame) = !{{0} | ∅} := rfl + +@[simp, game_cmp] theorem leftMoves_one : 1ᴸ = {0} := leftMoves_ofSets .. +@[simp, game_cmp] theorem rightMoves_one : 1ᴿ = ∅ := rightMoves_ofSets .. + +/-! ### Order relations -/ + +/-- The less or equal relation on games. + +If `0 ≤ x`, then Left can win `x` as the second player. `x ≤ y` means that `0 ≤ y - x`. -/ +@[no_expose] +instance : LE IGame where + le := Sym2.GameAdd.recursion subposition_wf fun x y le ↦ + (∀ z (h : z ∈ xᴸ), ¬le y z (Sym2.GameAdd.snd_fst (.of_mem_moves h))) ∧ + (∀ z (h : z ∈ yᴿ), ¬le z x (Sym2.GameAdd.fst_snd (.of_mem_moves h))) + +/-- The less or fuzzy relation on games. `x ⧏ y` is notation for `¬ y ≤ x`. + +If `0 ⧏ x`, then Left can win `x` as the first player. `x ⧏ y` means that `0 ⧏ y - x`. -/ +notation:50 x:50 " ⧏ " y:50 => ¬ y ≤ x +recommended_spelling "lf" for "⧏" in [«term_⧏_»] + +/-- Definition of `x ≤ y` on games, in terms of `⧏`. -/ +theorem le_iff_forall_lf {x y : IGame} : + x ≤ y ↔ (∀ z ∈ xᴸ, z ⧏ y) ∧ (∀ z ∈ yᴿ, x ⧏ z) := + propext_iff.1 <| Sym2.GameAdd.recursion_eq .. + +/-- Definition of `x ⧏ y` on games, in terms of `≤`. -/ +theorem lf_iff_exists_le {x y : IGame} : + x ⧏ y ↔ (∃ z ∈ yᴸ, x ≤ z) ∨ (∃ z ∈ xᴿ, z ≤ y) := by + simpa [not_and_or, -not_and] using le_iff_forall_lf.not + +/-- The definition of `0 ≤ x` on games, in terms of `0 ⧏`. -/ +theorem zero_le {x : IGame} : 0 ≤ x ↔ ∀ y ∈ xᴿ, 0 ⧏ y := by + rw [le_iff_forall_lf]; simp + +/-- The definition of `x ≤ 0` on games, in terms of `⧏ 0`. -/ +theorem le_zero {x : IGame} : x ≤ 0 ↔ ∀ y ∈ xᴸ, y ⧏ 0 := by + rw [le_iff_forall_lf]; simp + +/-- The definition of `0 ⧏ x` on games, in terms of `0 ≤`. -/ +theorem zero_lf {x : IGame} : 0 ⧏ x ↔ ∃ y ∈ xᴸ, 0 ≤ y := by + rw [lf_iff_exists_le]; simp + +/-- The definition of `x ⧏ 0` on games, in terms of `≤ 0`. -/ +theorem lf_zero {x : IGame} : x ⧏ 0 ↔ ∃ y ∈ xᴿ, y ≤ 0 := by + rw [lf_iff_exists_le]; simp + +/-- The definition of `x ≤ y` on games, in terms of `≤` two moves later. + +Note that it's often more convenient to use `le_iff_forall_lf`, which only unfolds the definition by +one step. -/ +theorem le_def {x y : IGame} : x ≤ y ↔ + (∀ a ∈ xᴸ, (∃ b ∈ yᴸ, a ≤ b) ∨ (∃ b ∈ aᴿ, b ≤ y)) ∧ + (∀ a ∈ yᴿ, (∃ b ∈ aᴸ, x ≤ b) ∨ (∃ b ∈ xᴿ, b ≤ a)) := by + rw [le_iff_forall_lf] + congr! 2 <;> rw [lf_iff_exists_le] + +/-- The definition of `x ⧏ y` on games, in terms of `⧏` two moves later. + +Note that it's often more convenient to use `lf_iff_exists_le`, which only unfolds the definition by +one step. -/ +theorem lf_def {x y : IGame} : x ⧏ y ↔ + (∃ a ∈ yᴸ, (∀ b ∈ xᴸ, b ⧏ a) ∧ (∀ b ∈ aᴿ, x ⧏ b)) ∨ + (∃ a ∈ xᴿ, (∀ b ∈ aᴸ, b ⧏ y) ∧ (∀ b ∈ yᴿ, a ⧏ b)) := by + rw [lf_iff_exists_le] + congr! <;> rw [le_iff_forall_lf] + +theorem left_lf_of_le {x y z : IGame} (h : x ≤ y) (h' : z ∈ xᴸ) : z ⧏ y := + (le_iff_forall_lf.1 h).1 z h' + +theorem lf_right_of_le {x y z : IGame} (h : x ≤ y) (h' : z ∈ yᴿ) : x ⧏ z := + (le_iff_forall_lf.1 h).2 z h' + +theorem lf_of_le_left {x y z : IGame} (h : x ≤ z) (h' : z ∈ yᴸ) : x ⧏ y := + lf_iff_exists_le.2 <| Or.inl ⟨z, h', h⟩ + +theorem lf_of_right_le {x y z : IGame} (h : z ≤ y) (h' : z ∈ xᴿ) : x ⧏ y := + lf_iff_exists_le.2 <| Or.inr ⟨z, h', h⟩ + +private theorem le_rfl' {x : IGame} : x ≤ x := by + rw [le_iff_forall_lf] + constructor <;> intro y hy + exacts [lf_of_le_left le_rfl' hy, lf_of_right_le le_rfl' hy] +termination_by x +decreasing_by igame_wf + +private theorem le_trans' {x y z : IGame} (h₁ : x ≤ y) (h₂ : y ≤ z) : x ≤ z := by + rw [le_iff_forall_lf] + constructor <;> intro a ha h₃ + exacts [left_lf_of_le h₁ ha (le_trans' h₂ h₃), lf_right_of_le h₂ ha (le_trans' h₃ h₁)] +termination_by subposition_wf.cutExpand.wrap {x, y, z} +decreasing_by + on_goal 1 => convert! Relation.cutExpand_add_single {y, z} (Subposition.of_mem_moves ha) + on_goal 2 => convert Relation.cutExpand_single_add (Subposition.of_mem_moves ha) {x, y} + all_goals simp [← Multiset.singleton_add, add_comm, add_assoc, WellFounded.wrap] + +instance : Preorder IGame where + le_refl _ := private le_rfl' + le_trans x y z := private le_trans' + +theorem left_lf {x y : IGame} (h : y ∈ xᴸ) : y ⧏ x := + lf_of_le_left le_rfl h + +theorem lf_right {x y : IGame} (h : y ∈ xᴿ) : x ⧏ y := + lf_of_right_le le_rfl h + +theorem le_of_forall_moves_right_lf {x y : IGame} + (hx : ∀ z ∈ yᴿ, x ⧏ z) (hl : ∀ z ∈ xᴸ, ∃ w ∈ yᴸ, z ≤ w) : x ≤ y := by + refine le_iff_forall_lf.2 ⟨fun z hz ↦ ?_, hx⟩ + obtain ⟨w, hw, hw'⟩ := hl z hz + exact mt hw'.trans' (left_lf hw) + +theorem le_of_forall_moves_left_lf {x y : IGame} + (hx : ∀ z ∈ yᴸ, z ⧏ x) (hr : ∀ z ∈ xᴿ, ∃ w ∈ yᴿ, w ≤ z) : y ≤ x := by + refine le_iff_forall_lf.2 ⟨hx, fun z hz ↦ ?_⟩ + obtain ⟨w, hw, hw'⟩ := hr z hz + exact mt hw'.trans (lf_right hw) + +/-- The equivalence relation `x ≈ y` means that `x ≤ y` and `y ≤ x`. This is notation for +`AntisymmRel (⬝ ≤ ⬝) x y`. -/ +infix:50 " ≈ " => AntisymmRel (· ≤ ·) +recommended_spelling "equiv" for "≈" in [«term_≈_»] + +/-- The "fuzzy" relation `x ‖ y` means that `x ⧏ y` and `y ⧏ x`. This is notation for +`IncompRel (⬝ ≤ ⬝) x y`. -/ +notation:50 x:50 " ‖ " y:50 => IncompRel (· ≤ ·) x y +recommended_spelling "fuzzy" for "‖" in [«term_‖_»] + +open Lean PrettyPrinter Delaborator SubExpr Qq in +/-- Delaborates `AntisymmRel (· ≤ ·) x y` into `x ≈ y`. -/ +@[delab app.AntisymmRel] +meta def delabEquiv : Delab := do + try + let_expr f@AntisymmRel α r _ _ := ← getExpr | failure + have u := f.constLevels![0]! + have α : Q(Type u) := α + have r : Q($α → $α → Prop) := r + let le ← synthInstanceQ q(LE $α) + _ ← assertDefEqQ q(($le).le) q($r) + let x ← withNaryArg 2 delab + let y ← withNaryArg 3 delab + let stx : Term ← do + let info ← Lean.MonadRef.mkInfoFromRefPos + pure { + raw := Lean.Syntax.node3 info ``IGame.«term_≈_» x.raw (Lean.Syntax.atom info "≈") y.raw + } + annotateGoToSyntaxDef stx + catch _ => failure -- fail over to the default delaborator + +open Lean PrettyPrinter Delaborator SubExpr Qq in +/-- Delaborates `IncompRel (· ≤ ·) x y` into `x ‖ y`. -/ +@[delab app.IncompRel] +meta def delabFuzzy : Delab := do + try + let_expr f@IncompRel α r _ _ := ← getExpr | failure + have u := f.constLevels![0]! + have α : Q(Type u) := α + have r : Q($α → $α → Prop) := r + let le ← synthInstanceQ q(LE $α) + _ ← assertDefEqQ q(($le).le) q($r) + let x ← withNaryArg 2 delab + let y ← withNaryArg 3 delab + let stx : Term ← do + let info ← Lean.MonadRef.mkInfoFromRefPos + pure { + raw := Lean.Syntax.node3 info ``IGame.«term_‖_» x.raw (Lean.Syntax.atom info "‖") y.raw + } + annotateGoToSyntaxDef stx + catch _ => failure -- fail over to the default delaborator + +theorem equiv_of_forall_lf {x y : IGame} + (hl₁ : ∀ a ∈ xᴸ, a ⧏ y) (hr₁ : ∀ a ∈ xᴿ, y ⧏ a) + (hl₂ : ∀ b ∈ yᴸ, b ⧏ x) (hr₂ : ∀ b ∈ yᴿ, x ⧏ b) : x ≈ y := by + constructor <;> refine le_iff_forall_lf.2 ⟨?_, ?_⟩ <;> assumption + +theorem equiv_of_exists_le {x y : IGame} + (hl₁ : ∀ a ∈ xᴸ, ∃ b ∈ yᴸ, a ≤ b) (hr₁ : ∀ a ∈ xᴿ, ∃ b ∈ yᴿ, b ≤ a) + (hl₂ : ∀ b ∈ yᴸ, ∃ a ∈ xᴸ, b ≤ a) (hr₂ : ∀ b ∈ yᴿ, ∃ a ∈ xᴿ, a ≤ b) : x ≈ y := by + apply equiv_of_forall_lf <;> simp +contextual [hl₁, hl₂, hr₁, hr₂, lf_iff_exists_le] + +theorem equiv_of_exists {x y : IGame} + (hl₁ : ∀ a ∈ xᴸ, ∃ b ∈ yᴸ, a ≈ b) (hr₁ : ∀ a ∈ xᴿ, ∃ b ∈ yᴿ, a ≈ b) + (hl₂ : ∀ b ∈ yᴸ, ∃ a ∈ xᴸ, a ≈ b) (hr₂ : ∀ b ∈ yᴿ, ∃ a ∈ xᴿ, a ≈ b) : x ≈ y := by + apply equiv_of_exists_le <;> grind [AntisymmRel] + +@[simp] +protected theorem zero_lt_one : (0 : IGame) < 1 := by + rw [lt_iff_le_not_ge, le_iff_forall_lf, le_iff_forall_lf] + simp + +instance : ZeroLEOneClass IGame where + zero_le_one := IGame.zero_lt_one.le + +/-! ### Negation -/ + +private def neg' (x : IGame) : IGame := + !{range fun y : xᴿ ↦ neg' y.1 | range fun y : xᴸ ↦ neg' y.1} +termination_by x +decreasing_by igame_wf + +#adaptation_note /-- noncomputable is now needed -/ in +/-- The negative of a game is defined by `-!{s | t} = !{-t | -s}`. -/ +@[no_expose] +noncomputable instance : Neg IGame where + neg := neg' + +private theorem neg_ofSets'' (s t : Set IGame) [Small s] [Small t] : + -!{s | t} = !{Neg.neg '' t | Neg.neg '' s} := by + change neg' _ = _ + rw [neg'] + simp [Neg.neg, Set.ext_iff] + +instance : InvolutiveNeg IGame where + neg_neg x := by + refine ofSetsRecOn x ?_ + aesop (add simp [neg_ofSets'']) + +@[simp] +theorem neg_ofSets (s t : Set IGame) [Small s] [Small t] : -!{s | t} = !{-t | -s} := by + simp_rw [neg_ofSets'', Set.image_neg_eq_neg] + +theorem neg_ofSets' (st : Player → Set IGame) [Small (st left)] [Small (st right)] : + -!{st} = !{fun p ↦ -st (-p)} := by + rw [ofSets_eq_ofSets_cases, ofSets_eq_ofSets_cases fun _ ↦ -_, neg_ofSets] + rfl + +@[simp] +theorem neg_ofSets_const (s : Set IGame) [Small s] : + -!{fun _ ↦ s} = !{fun _ ↦ -s} := by + simp [neg_ofSets'] + +instance : NegZeroClass IGame where + neg_zero := by simp [zero_def] + +theorem neg_eq (x : IGame) : -x = !{-xᴿ | -xᴸ} := by + rw [← neg_ofSets, ofSets_leftMoves_rightMoves] + +theorem neg_eq' (x : IGame) : -x = !{fun p ↦ -x.moves (-p)} := by + rw [neg_eq, ofSets_eq_ofSets_cases (fun _ ↦ -_)]; rfl + +@[simp] +theorem moves_neg (p : Player) (x : IGame) : + (-x).moves p = -x.moves (-p) := by + rw [neg_eq', moves_ofSets] + +@[game_cmp] +theorem forall_moves_neg {P : IGame → Prop} {p : Player} {x : IGame} : + (∀ y ∈ (-x).moves p, P y) ↔ (∀ y ∈ x.moves (-p), P (-y)) := by + simp + +@[game_cmp] +theorem exists_moves_neg {P : IGame → Prop} {p : Player} {x : IGame} : + (∃ y ∈ (-x).moves p, P y) ↔ (∃ y ∈ x.moves (-p), P (-y)) := by + simp + +@[simp] +protected theorem neg_le_neg_iff {x y : IGame} : -x ≤ -y ↔ y ≤ x := by + induction x, y using Sym2.GameAdd.recursion subposition_wf with | _ x y IH + rw [le_iff_forall_lf, le_iff_forall_lf, and_comm, forall_moves_neg, forall_moves_neg] + dsimp + congr! 3 with z hz z hz + · rw [IH _ _ (Sym2.GameAdd.fst_snd (.of_mem_moves hz))] + · rw [IH _ _ (Sym2.GameAdd.snd_fst (.of_mem_moves hz))] + +protected theorem neg_le {x y : IGame} : -x ≤ y ↔ -y ≤ x := by + simpa using @IGame.neg_le_neg_iff x (-y) +protected theorem le_neg {x y : IGame} : x ≤ -y ↔ y ≤ -x := by + simpa using @IGame.neg_le_neg_iff (-x) y + +@[simp] +protected theorem neg_lt_neg_iff {x y : IGame} : -x < -y ↔ y < x := by + simp [lt_iff_le_not_ge] + +protected theorem neg_lt {x y : IGame} : -x < y ↔ -y < x := by + simpa using @IGame.neg_lt_neg_iff x (-y) +protected theorem lt_neg {x y : IGame} : x < -y ↔ y < -x := by + simpa using @IGame.neg_lt_neg_iff (-x) y + +@[simp] +theorem neg_equiv_neg_iff {x y : IGame} : -x ≈ -y ↔ x ≈ y := by + simp [AntisymmRel, and_comm] + +theorem neg_equiv {x y : IGame} : -x ≈ y ↔ x ≈ -y := by + simpa using @neg_equiv_neg_iff x (-y) + +alias ⟨_, neg_congr⟩ := neg_equiv_neg_iff + +@[simp] +theorem neg_fuzzy_neg_iff {x y : IGame} : -x ‖ -y ↔ x ‖ y := by + simp [IncompRel, and_comm] + +theorem neg_fuzzy {x y : IGame} : -x ‖ y ↔ x ‖ -y := by + simpa using @neg_fuzzy_neg_iff x (-y) + +@[simp] theorem neg_le_zero {x : IGame} : -x ≤ 0 ↔ 0 ≤ x := by simpa using @IGame.neg_le x 0 +@[simp] theorem zero_le_neg {x : IGame} : 0 ≤ -x ↔ x ≤ 0 := by simpa using @IGame.le_neg 0 x +@[simp] theorem neg_lt_zero {x : IGame} : -x < 0 ↔ 0 < x := by simpa using @IGame.neg_lt x 0 +@[simp] theorem zero_lt_neg {x : IGame} : 0 < -x ↔ x < 0 := by simpa using @IGame.lt_neg 0 x + +@[simp] theorem neg_equiv_zero {x : IGame} : -x ≈ 0 ↔ x ≈ 0 := by + simpa using @IGame.neg_equiv_neg_iff x 0 +@[simp] theorem zero_equiv_neg {x : IGame} : 0 ≈ -x ↔ 0 ≈ x := by + simpa using @IGame.neg_equiv_neg_iff 0 x + +@[simp] theorem neg_fuzzy_zero {x : IGame} : -x ‖ 0 ↔ x ‖ 0 := by + simpa using @IGame.neg_fuzzy_neg_iff x 0 +@[simp] theorem zero_fuzzy_neg {x : IGame} : 0 ‖ -x ↔ 0 ‖ x := by + simpa using @IGame.neg_fuzzy_neg_iff 0 x + +/-! ### Addition and subtraction -/ + +private def add' (x y : IGame) : IGame := + !{(range fun z : xᴸ ↦ add' z y) ∪ (range fun z : yᴸ ↦ add' x z) | + (range fun z : xᴿ ↦ add' z y) ∪ (range fun z : yᴿ ↦ add' x z)} +termination_by (x, y) +decreasing_by igame_wf + +#adaptation_note /-- noncomputable is now needed -/ in +/-- The sum of `x = !{s₁ | t₁}` and `y = !{s₂ | t₂}` is `!{s₁ + y, x + s₂ | t₁ + y, x + t₂}`. -/ +@[no_expose] +noncomputable instance : Add IGame where + add := add' + +theorem add_eq (x y : IGame) : x + y = + !{(· + y) '' xᴸ ∪ (x + ·) '' yᴸ | (· + y) '' xᴿ ∪ (x + ·) '' yᴿ} := by + change add' _ _ = _ + rw [add'] + simp [HAdd.hAdd, Add.add, Set.ext_iff] + +theorem add_eq' (x y : IGame) : x + y = + !{fun p ↦ (· + y) '' x.moves p ∪ (x + ·) '' y.moves p} := by + rw [add_eq, ofSets_eq_ofSets_cases (fun _ ↦ _ ∪ _)] + +theorem ofSets_add_ofSets + (s₁ t₁ s₂ t₂ : Set IGame) [Small s₁] [Small t₁] [Small s₂] [Small t₂] : + !{s₁ | t₁} + !{s₂ | t₂} = + !{(· + !{s₂ | t₂}) '' s₁ ∪ (!{s₁ | t₁} + ·) '' s₂ | + (· + !{s₂ | t₂}) '' t₁ ∪ (!{s₁ | t₁} + ·) '' t₂} := by + rw [add_eq] + simp + +theorem ofSets_add_ofSets' (st₁ st₂ : Player → Set IGame) + [Small (st₁ left)] [Small (st₂ left)] [Small (st₁ right)] [Small (st₂ right)] : + !{st₁} + !{st₂} = + !{fun p ↦ (· + !{st₂}) '' st₁ p ∪ (!{st₁} + ·) '' st₂ p} := by + rw [ofSets_eq_ofSets_cases, ofSets_eq_ofSets_cases st₂, ofSets_eq_ofSets_cases (fun _ ↦ _ ∪ _), + ofSets_add_ofSets] + +@[simp] +theorem moves_add (p : Player) (x y : IGame) : + (x + y).moves p = (· + y) '' x.moves p ∪ (x + ·) '' y.moves p := by + rw [add_eq', moves_ofSets] + +theorem add_left_mem_moves_add {p : Player} {x y : IGame} (h : x ∈ y.moves p) (z : IGame) : + z + x ∈ (z + y).moves p := by + rw [moves_add]; right; use x + +theorem add_right_mem_moves_add {p : Player} {x y : IGame} (h : x ∈ y.moves p) (z : IGame) : + x + z ∈ (y + z).moves p := by + rw [moves_add]; left; use x + +@[game_cmp] +theorem forall_moves_add {p : Player} {P : IGame → Prop} {x y : IGame} : + (∀ a ∈ (x + y).moves p, P a) ↔ + (∀ a ∈ x.moves p, P (a + y)) ∧ (∀ b ∈ y.moves p, P (x + b)) := by + aesop + +@[game_cmp] +theorem exists_moves_add {p : Player} {P : IGame → Prop} {x y : IGame} : + (∃ a ∈ (x + y).moves p, P a) ↔ + (∃ a ∈ x.moves p, P (a + y)) ∨ (∃ b ∈ y.moves p, P (x + b)) := by + aesop + +@[simp] +theorem add_eq_zero_iff {x y : IGame} : x + y = 0 ↔ x = 0 ∧ y = 0 := by + constructor <;> simp_all [IGame.ext_iff] + +private theorem add_zero' (x : IGame) : x + 0 = x := by + refine moveRecOn x ?_ + aesop + +private theorem add_comm' (x y : IGame) : x + y = y + x := by + ext + simp only [moves_add, mem_union, mem_image, or_comm] + congr! 3 <;> + · refine and_congr_right_iff.2 fun h ↦ ?_ + rw [add_comm'] +termination_by (x, y) +decreasing_by igame_wf + +private theorem add_assoc' (x y z : IGame) : x + y + z = x + (y + z) := by + ext1 + simp only [moves_add, image_union, image_image, union_assoc] + refine congrArg₂ _ ?_ (congrArg₂ _ ?_ ?_) <;> + · ext + congr! 2 + rw [add_assoc'] +termination_by (x, y, z) +decreasing_by igame_wf + +instance : AddCommMonoid IGame where + add_zero := private add_zero' + zero_add _ := private add_comm' .. ▸ add_zero' _ + add_comm := private add_comm' + add_assoc := private add_assoc' + nsmul := nsmulRec + +/-- The subtraction of `x` and `y` is defined as `x + (-y)`. -/ +instance : SubNegMonoid IGame where + zsmul := zsmulRec + +@[simp] +theorem moves_sub (p : Player) (x y : IGame) : + (x - y).moves p = (· - y) '' x.moves p ∪ (x + ·) '' (-y.moves (-p)) := by + simp [sub_eq_add_neg] + +theorem sub_left_mem_moves_sub {p : Player} {x y : IGame} (h : x ∈ y.moves p) (z : IGame) : + z - x ∈ (z - y).moves (-p) := by + apply add_left_mem_moves_add; simpa + +theorem sub_left_mem_moves_sub_neg {p : Player} {x y : IGame} (h : x ∈ y.moves (-p)) (z : IGame) : + z - x ∈ (z - y).moves p := by + apply add_left_mem_moves_add; simpa + +theorem sub_right_mem_moves_sub {p : Player} {x y : IGame} (h : x ∈ y.moves p) (z : IGame) : + x - z ∈ (y - z).moves p := + add_right_mem_moves_add h _ + +private theorem neg_add' (x y : IGame) : -(x + y) = -x + -y := by + ext + simp only [moves_neg, moves_add, union_neg, mem_union, mem_neg, mem_image, exists_neg_mem] + congr! 3 <;> + · refine and_congr_right_iff.2 fun _ ↦ ?_ + rw [← neg_inj, neg_add', neg_neg] +termination_by (x, y) +decreasing_by igame_wf + +instance : SubtractionCommMonoid IGame where + neg_neg := neg_neg + neg_add_rev x y := by rw [neg_add', add_comm] + neg_eq_of_add := by simp + add_comm := add_comm + +private theorem sub_self_le (x : IGame) : x - x ≤ 0 := by + rw [le_zero, moves_sub] + rintro _ (⟨y, hy, rfl⟩ | ⟨y, hy, rfl⟩) + · exact lf_of_right_le (sub_self_le y) (sub_left_mem_moves_sub hy y) + · apply lf_of_right_le (sub_self_le (-y)) + rw [mem_neg] at hy + rw [sub_neg_eq_add] + exact add_right_mem_moves_add hy _ +termination_by x +decreasing_by igame_wf + +/-- The sum of a game and its negative is equivalent, though not necessarily identical to zero. -/ +theorem sub_self_equiv (x : IGame) : x - x ≈ 0 := by + rw [AntisymmRel, ← neg_le_zero, neg_sub, and_self] + exact sub_self_le x + +/-- The sum of a game and its negative is equivalent, though not necessarily identical to zero. -/ +theorem neg_add_equiv (x : IGame) : -x + x ≈ 0 := by + simpa [add_comm, sub_eq_add_neg] using sub_self_equiv x + +private theorem add_le_add_left' {x y : IGame} (h : x ≤ y) (z : IGame) : z + x ≤ z + y := by + rw [le_iff_forall_lf, moves_add, moves_add] + refine ⟨?_, ?_⟩ <;> rintro a (⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩) + · exact lf_of_le_left (add_le_add_left' h a) (add_right_mem_moves_add ha y) + · obtain (⟨b, hb, hb'⟩ | ⟨b, hb, hb'⟩) := lf_iff_exists_le.1 (left_lf_of_le h ha) + · exact lf_of_le_left (add_le_add_left' hb' z) (add_left_mem_moves_add hb z) + · exact lf_of_right_le (add_le_add_left' hb' z) (add_left_mem_moves_add hb z) + · exact lf_of_right_le (add_le_add_left' h a) (add_right_mem_moves_add ha x) + · obtain (⟨b, hb, hb'⟩ | ⟨b, hb, hb'⟩) := lf_iff_exists_le.1 (lf_right_of_le h ha) + · exact lf_of_le_left (add_le_add_left' hb' z) (add_left_mem_moves_add hb z) + · exact lf_of_right_le (add_le_add_left' hb' z) (add_left_mem_moves_add hb z) +termination_by (x, y, z) +decreasing_by igame_wf (maxDepth := 8) + +private theorem add_le_add_right' {x y : IGame} (h : x ≤ y) (z : IGame) : x + z ≤ y + z := by + simpa [add_comm] using add_le_add_left' h z + +instance : AddLeftMono IGame := ⟨fun x _ _ h ↦ add_le_add_left' h x⟩ +instance : AddRightMono IGame := ⟨fun x _ _ h ↦ add_le_add_right' h x⟩ + +instance : AddLeftReflectLE IGame where + le_of_add_le_add_left {x y} z h := by + rw [← zero_add y, ← zero_add z] + apply (add_le_add_left (neg_add_equiv x).ge y).trans + rw [add_assoc] + apply (add_le_add_right h (-x)).trans + rw [← add_assoc] + exact add_le_add_left (neg_add_equiv x).le z + +instance : AddRightReflectLE IGame := + addRightReflectLE_of_addLeftReflectLE _ + +instance : AddLeftStrictMono IGame where + elim x y z h := by + apply lt_of_le_not_ge (add_le_add_right h.le x) + contrapose! h + exact (le_of_add_le_add_left h).not_gt + +instance : AddRightStrictMono IGame := + addRightStrictMono_of_addLeftStrictMono _ + +-- TODO: [AddLeftMono α] [AddLeftReflectLE α] → AddLeftReflectLT α +instance : AddLeftReflectLT IGame where + elim _ := by simp [lt_iff_le_not_ge] + +instance : AddRightReflectLT IGame := + addRightReflectLT_of_addLeftReflectLT _ + +-- TODO: add the general versions of this to Mathlib + +theorem add_congr {a b : IGame} (h₁ : a ≈ b) {c d : IGame} (h₂ : c ≈ d) : a + c ≈ b + d := + ⟨add_le_add h₁.1 h₂.1, add_le_add h₁.2 h₂.2⟩ + +theorem add_congr_left {a b c : IGame} (h : a ≈ b) : a + c ≈ b + c := + add_congr h .rfl + +theorem add_congr_right {a b c : IGame} (h : a ≈ b) : c + a ≈ c + b := + add_congr .rfl h + +@[simp] +theorem add_fuzzy_add_iff_left {a b c : IGame} : a + b ‖ a + c ↔ b ‖ c := by + simp [IncompRel] + +@[simp] +theorem add_fuzzy_add_iff_right {a b c : IGame} : b + a ‖ c + a ↔ b ‖ c := by + simp [IncompRel] + +theorem sub_congr {a b : IGame} (h₁ : a ≈ b) {c d : IGame} (h₂ : c ≈ d) : a - c ≈ b - d := + add_congr h₁ (neg_congr h₂) + +theorem sub_congr_left {a b c : IGame} (h : a ≈ b) : a - c ≈ b - c := + sub_congr h .rfl + +theorem sub_congr_right {a b c : IGame} (h : a ≈ b) : c - a ≈ c - b := + sub_congr .rfl h + +/-- We define the `NatCast` instance as `↑0 = 0` and `↑(n + 1) = !{{↑n} | ∅}`. + +Note that this is equivalent, but not identical, to the more common definition `↑n = !{Iio n | ∅}`. +For that, use `NatOrdinal.toIGame`. -/ +instance : AddCommMonoidWithOne IGame where + +/-- This version of the theorem is more convenient for the `game_cmp` tactic. -/ +@[game_cmp] +theorem leftMoves_natCast_succ' : ∀ n : ℕ, n.succᴸ = {(n : IGame)} + | 0 => by simp + | n + 1 => by + rw [Nat.cast_succ, moves_add, leftMoves_natCast_succ'] + simp + +@[simp 1100] -- This should trigger before `leftMoves_add`. +theorem leftMoves_natCast_succ (n : ℕ) : (n + 1)ᴸ = {(n : IGame)} := + leftMoves_natCast_succ' n + +@[simp 1100, game_cmp] -- This should trigger before `rightMoves_add`. +theorem rightMoves_natCast : ∀ n : ℕ, nᴿ = ∅ + | 0 => by simp + | n + 1 => by + rw [Nat.cast_succ, moves_add, rightMoves_natCast] + simp + +@[simp 1100, game_cmp] +theorem leftMoves_ofNat (n : ℕ) [n.AtLeastTwo] : ofNat(n)ᴸ = {((n - 1 : ℕ) : IGame)} := by + change nᴸ = _ + rw [← Nat.succ_pred (NeZero.out (n := n)), leftMoves_natCast_succ'] + simp + +@[simp 1100, game_cmp] +theorem rightMoves_ofNat (n : ℕ) [n.AtLeastTwo] : ofNat(n)ᴿ = ∅ := + rightMoves_natCast n + +theorem natCast_succ_eq (n : ℕ) : (n + 1 : IGame) = !{{(n : IGame)} | ∅} := by + ext p; cases p <;> simp + +/-- Every left option of a natural number is equal to a smaller natural number. -/ +theorem eq_natCast_of_mem_leftMoves_natCast {n : ℕ} {x : IGame} (hx : x ∈ nᴸ) : + ∃ m : ℕ, m < n ∧ m = x := by + cases n with + | zero => simp at hx + | succ n => + use n + simp_all + +instance : IntCast IGame where + intCast + | .ofNat n => n + | .negSucc n => -(n + 1) + +@[simp, game_cmp, norm_cast] theorem intCast_nat (n : ℕ) : ((n : ℤ) : IGame) = n := rfl +@[simp, game_cmp] theorem intCast_ofNat (n : ℕ) : ((ofNat(n) : ℤ) : IGame) = n := rfl +@[simp] theorem intCast_negSucc (n : ℕ) : (Int.negSucc n : IGame) = -(n + 1) := rfl + +@[game_cmp, norm_cast] theorem intCast_zero : ((0 : ℤ) : IGame) = 0 := rfl +@[game_cmp, norm_cast] theorem intCast_one : ((1 : ℤ) : IGame) = 1 := by simp + +@[simp, game_cmp, norm_cast] +theorem intCast_neg (n : ℤ) : ((-n : ℤ) : IGame) = -(n : IGame) := by + cases n with + | ofNat n => + cases n with + | zero => simp + | succ n => rfl + | negSucc n => exact (neg_neg _).symm + +theorem eq_sub_one_of_mem_leftMoves_intCast {n : ℤ} {x : IGame} (hx : x ∈ nᴸ) : + x = (n - 1 : ℤ) := by + obtain ⟨n, rfl | rfl⟩ := n.eq_nat_or_neg + · cases n + · simp at hx + · rw [intCast_nat] at hx + simp_all + · simp at hx + +theorem eq_add_one_of_mem_rightMoves_intCast {n : ℤ} {x : IGame} (hx : x ∈ nᴿ) : + x = (n + 1 : ℤ) := by + have : -x ∈ (-n : ℤ)ᴸ := by simpa + rw [← neg_inj] + simpa [← IGame.intCast_neg, add_comm, sub_eq_add_neg] using + eq_sub_one_of_mem_leftMoves_intCast this + +/-- Every left option of an integer is equal to a smaller integer. -/ +theorem eq_intCast_of_mem_leftMoves_intCast {n : ℤ} {x : IGame} (hx : x ∈ nᴸ) : + ∃ m : ℤ, m < n ∧ m = x := by + use n - 1 + simp [eq_sub_one_of_mem_leftMoves_intCast hx] + +/-- Every right option of an integer is equal to a larger integer. -/ +theorem eq_intCast_of_mem_rightMoves_intCast {n : ℤ} {x : IGame} (hx : x ∈ nᴿ) : + ∃ m : ℤ, n < m ∧ m = x := by + use n + 1 + simp [eq_add_one_of_mem_rightMoves_intCast hx] + +/-! ### Multiplication -/ + +-- TODO: upstream +attribute [aesop apply unsafe 50%] Prod.Lex.left Prod.Lex.right + +private def mul' (x y : IGame) : IGame := + !{(range fun a : (xᴸ ×ˢ yᴸ ∪ xᴿ ×ˢ yᴿ :) ↦ + mul' a.1.1 y + mul' x a.1.2 - mul' a.1.1 a.1.2) | + (range fun a : (xᴸ ×ˢ yᴿ ∪ xᴿ ×ˢ yᴸ :) ↦ + mul' a.1.1 y + mul' x a.1.2 - mul' a.1.1 a.1.2)} +termination_by (x, y) +decreasing_by all_goals aesop + +#adaptation_note /-- noncomputable is now needed -/ in +/-- The product of `x = !{s₁ | t₁}` and `y = !{s₂ | t₂}` is +`!{a₁ * y + x * b₁ - a₁ * b₁ | a₂ * y + x * b₂ - a₂ * b₂}`, where `(a₁, b₁) ∈ s₁ ×ˢ s₂ ∪ t₁ ×ˢ t₂` +and `(a₂, b₂) ∈ s₁ ×ˢ t₂ ∪ t₁ ×ˢ s₂`. + +Using `IGame.mulOption`, this can alternatively be written as +`x * y = !{mulOption x y a₁ b₁ | mulOption x y a₂ b₂}`. -/ +@[no_expose] +noncomputable instance : Mul IGame where + mul := mul' + +/-- The general option of `x * y` looks like `a * y + x * b - a * b`, for `a` and `b` options of +`x` and `y`, respectively. -/ +@[pp_nodot, game_cmp, expose] +def mulOption (x y a b : IGame) : IGame := + a * y + x * b - a * b + +theorem mul_eq (x y : IGame) : x * y = + !{(fun a ↦ mulOption x y a.1 a.2) '' (xᴸ ×ˢ yᴸ ∪ xᴿ ×ˢ yᴿ) | + (fun a ↦ mulOption x y a.1 a.2) '' (xᴸ ×ˢ yᴿ ∪ xᴿ ×ˢ yᴸ)} := by + change mul' _ _ = _ + rw [mul'] + simp [mulOption, HMul.hMul, Mul.mul, Set.ext_iff] + +theorem mul_eq' (x y : IGame) : x * y = + !{fun p ↦ (fun a ↦ mulOption x y a.1 a.2) '' + (xᴸ ×ˢ y.moves p ∪ xᴿ ×ˢ y.moves (-p))} := by + rw [mul_eq, ofSets_eq_ofSets_cases (fun _ ↦ _ '' _)]; rfl + +theorem ofSets_mul_ofSets (s₁ t₁ s₂ t₂ : Set IGame) [Small s₁] [Small t₁] [Small s₂] [Small t₂] : + !{s₁ | t₁} * !{s₂ | t₂} = + !{(fun a ↦ mulOption !{s₁ | t₁} !{s₂ | t₂} a.1 a.2) '' (s₁ ×ˢ s₂ ∪ t₁ ×ˢ t₂) | + (fun a ↦ mulOption !{s₁ | t₁} !{s₂ | t₂} a.1 a.2) '' (s₁ ×ˢ t₂ ∪ t₁ ×ˢ s₂)} := by + rw [mul_eq] + simp + +@[simp] +theorem moves_mul (p : Player) (x y : IGame) : + (x * y).moves p = (fun a ↦ mulOption x y a.1 a.2) '' + (xᴸ ×ˢ y.moves p ∪ xᴿ ×ˢ y.moves (-p)) := by + rw [mul_eq', moves_ofSets] + +@[simp] +theorem moves_mulOption (p : Player) (x y a b : IGame) : + (mulOption x y a b).moves p = (a * y + x * b - a * b).moves p := + rfl + +theorem mulOption_mem_moves_mul {px py : Player} {x y a b : IGame} + (h₁ : a ∈ x.moves px) (h₂ : b ∈ y.moves py) : mulOption x y a b ∈ (x * y).moves (px * py) := by + rw [moves_mul]; use (a, b); cases px <;> cases py <;> simp_all + +@[game_cmp] +theorem forall_moves_mul {p : Player} {P : IGame → Prop} {x y : IGame} : + (∀ a ∈ (x * y).moves p, P a) ↔ + (∀ p', ∀ a ∈ x.moves p', ∀ b ∈ y.moves (p' * p), P (mulOption x y a b)) := by + aesop + +@[game_cmp] +theorem exists_moves_mul {p : Player} {P : IGame → Prop} {x y : IGame} : + (∃ a ∈ (x * y).moves p, P a) ↔ + (∃ p', ∃ a ∈ x.moves p', ∃ b ∈ y.moves (p' * p), P (mulOption x y a b)) := by + aesop + +private theorem zero_mul' (x : IGame) : 0 * x = 0 := by + ext p; cases p <;> simp + +private theorem one_mul' (x : IGame) : 1 * x = x := by + refine moveRecOn x ?_ + aesop (add simp [mulOption, and_assoc, zero_mul']) + +private theorem mul_comm' (x y : IGame) : x * y = y * x := by + ext p + simp only [moves_mul, mem_image, mem_prod, mem_union, Prod.exists] + cases p; all_goals + dsimp + simp only [and_comm, or_comm] + rw [exists_comm] + congr! 4 with b a + rw [and_congr_left_iff] + rintro (⟨_, _⟩ | ⟨_, _⟩) <;> + rw [mulOption, mulOption, mul_comm' x, mul_comm' _ y, add_comm, mul_comm' a b] +termination_by (x, y) +decreasing_by igame_wf + +instance : CommMagma IGame where + mul_comm := private mul_comm' + +instance : MulZeroClass IGame where + zero_mul := private zero_mul' + mul_zero x := private mul_comm' .. ▸ zero_mul' x + +instance : MulZeroOneClass IGame where + one_mul := private one_mul' + mul_one x := private mul_comm' .. ▸ one_mul' x + +theorem mulOption_comm (x y a b : IGame) : mulOption x y a b = mulOption y x b a := by + simp [mulOption, add_comm, mul_comm] + +private theorem neg_mul' (x y : IGame) : -x * y = -(x * y) := by + ext + simp only [moves_mul, moves_neg, mem_image, mem_union, mem_prod, mem_neg, Prod.exists] + rw [← (Equiv.neg _).exists_congr_right] + dsimp only [Player.neg_left, Player.neg_right] + simp only [Equiv.neg_apply, neg_neg, mulOption, or_comm] + congr! 4 + rw [and_congr_right_iff] + rintro (⟨_, _⟩ | ⟨_, _⟩) + all_goals + rw [← neg_inj, neg_mul', neg_mul', neg_mul'] + simp [sub_eq_add_neg, add_comm] +termination_by (x, y) +decreasing_by igame_wf + +instance : HasDistribNeg IGame where + neg_mul := private neg_mul' + mul_neg _ _ := by rw [mul_comm, neg_mul', mul_comm] + +theorem mulOption_neg_left (x y a b : IGame) : mulOption (-x) y a b = -mulOption x y (-a) b := by + simp [mulOption, sub_eq_neg_add, add_comm] + +theorem mulOption_neg_right (x y a b : IGame) : mulOption x (-y) a b = -mulOption x y a (-b) := by + simp [mulOption, sub_eq_neg_add, add_comm] + +theorem mulOption_neg (x y a b : IGame) : mulOption (-x) (-y) a b = mulOption x y (-a) (-b) := by + simp [mulOption, sub_eq_neg_add, add_comm] + +@[simp] +theorem mulOption_zero_left (x y a : IGame) : mulOption x y 0 a = x * a := by + simp [mulOption] + +@[simp] +theorem mulOption_zero_right (x y a : IGame) : mulOption x y a 0 = a * y := by + simp [mulOption] + +/-! Distributivity and associativity only hold up to equivalence; we prove this in +`CombinatorialGames.Game.Basic`. -/ + +/-! ### Division -/ + +/-- An auxiliary inductive type to enumerate the options of `IGame.inv`. -/ +private inductive InvTy (lr : Player → Type u) : Player → Type u + | zero : InvTy lr left + | mk (p₁ p₂) : (lr (-(p₁ * p₂))) → InvTy lr p₁ → InvTy lr p₂ + +private def InvTy.val' {x : IGame} + (IH : ∀ p, Shrink {y ∈ x.moves p | 0 < y} → IGame) (b : Player) : + InvTy (fun p ↦ Shrink {y ∈ x.moves p | 0 < y}) b → IGame + | zero => 0 + | mk _ _ i j => (1 + ((equivShrink _).symm i - x) * val' IH _ j) * IH _ i + +private def inv' (x : IGame.{u}) : IGame.{u} := + let IH (p) : Shrink {y ∈ x.moves p | 0 < y} → IGame := + fun x ↦ inv' (Subtype.val <| (equivShrink _).symm x) + !{.range (InvTy.val' IH left) | .range (InvTy.val' IH right)} +termination_by x +decreasing_by exact .of_mem_moves ((equivShrink _).symm x).2.1 + +private abbrev InvTy.val (x : IGame) (b : Player) + (i : InvTy (fun p ↦ Shrink {y ∈ x.moves p | 0 < y}) b) : IGame := + i.val' (fun _ ↦ inv' ∘ Subtype.val ∘ (equivShrink _).symm) b + +/-- The inverse of a positive game `x = !{s | t}` is `!{s' | t'}`, where `s'` and `t'` are the +smallest sets such that `0 ∈ s'`, and such that `(1 + (z - x) * a) / z, (1 + (y - x) * b) / y ∈ s'` +and `(1 + (y - x) * a) / y, (1 + (z - x) * b) / z ∈ t'` for `y ∈ s` positive, `z ∈ t`, `a ∈ s'`, and +`b ∈ t'`. + +If `x` is negative, we define `x⁻¹ = -(-x)⁻¹`. For any other game, we set `x⁻¹ = 0`. + +If `x` is a non-zero numeric game, then `x * x⁻¹ ≈ 1`. The value of this function on any non-numeric +game should be treated as a junk value. -/ +@[no_expose] +instance : Inv IGame where + inv x := by classical exact if 0 < x then inv' x else if x < 0 then -inv' (-x) else 0 + +instance : Div IGame where + div x y := x * y⁻¹ + +open Classical in +private theorem inv_eq'' {x : IGame} : + x⁻¹ = if 0 < x then inv' x else if x < 0 then -inv' (-x) else 0 := + rfl + +private theorem inv_eq {x : IGame.{u}} (hx : 0 < x) : + x⁻¹ = !{.range (InvTy.val x left) | .range (InvTy.val x right)} := by + rw [inv_eq'', if_pos hx, inv'] + rfl + +private theorem inv_eq' {x : IGame.{u}} (hx : 0 < x) : + x⁻¹ = !{fun p ↦ .range (InvTy.val x p)} := by + rw [inv_eq hx, ofSets_eq_ofSets_cases fun _ ↦ range _] + +protected theorem div_eq_mul_inv (x y : IGame) : x / y = x * y⁻¹ := rfl + +theorem inv_of_equiv_zero {x : IGame} (h : x ≈ 0) : x⁻¹ = 0 := by + simp [inv_eq'', h.not_lt, h.not_gt] + +@[simp] protected theorem inv_zero : (0 : IGame)⁻¹ = 0 := inv_of_equiv_zero .rfl +@[simp] protected theorem zero_div (x : IGame) : 0 / x = 0 := zero_mul _ +@[simp] protected theorem neg_div (x y : IGame) : -x / y = -(x / y) := neg_mul .. + +@[simp] +protected theorem inv_neg (x : IGame) : (-x)⁻¹ = -x⁻¹ := by + rw [inv_eq'', inv_eq''] + obtain h | h | h | h := lt_or_antisymmRel_or_gt_or_incompRel x 0 + repeat + simp [h, h.asymm] + simp [h.not_lt, h.not_gt] + +/-- The general option of `x⁻¹` looks like `(1 + (y - x) * a) / y`, for `y` an option of `x`, and +`a` some other "earlier" option of `x⁻¹`. -/ +@[pp_nodot, expose] +def invOption (x y a : IGame) : IGame := + (1 + (y - x) * a) / y + +private theorem invOption_eq {x y a : IGame} (hy : 0 < y) : + invOption x y a = (1 + (y - x) * a) * inv' y := by + rw [invOption, IGame.div_eq_mul_inv, inv_eq'', if_pos hy] + +theorem zero_mem_leftMoves_inv {x : IGame} (hx : 0 < x) : 0 ∈ x⁻¹ᴸ := by + rw [inv_eq hx, leftMoves_ofSets] + exact ⟨InvTy.zero, rfl⟩ + +theorem inv_nonneg {x : IGame} (hx : 0 < x) : 0 ⧏ x⁻¹ := + left_lf (zero_mem_leftMoves_inv hx) +theorem invOption_mem_moves_inv {x y a : IGame} {p₁ p₂} (hx : 0 < x) (hy : 0 < y) + (hyx : y ∈ x.moves (-(p₁ * p₂))) (ha : a ∈ x⁻¹.moves p₁) : + invOption x y a ∈ x⁻¹.moves p₂ := by + rw [inv_eq' hx, moves_ofSets] at * + obtain ⟨i, rfl⟩ := ha + use InvTy.mk _ _ (equivShrink _ ⟨_, (by simpa [mul_left_comm p₂]), hy⟩) i + simp [InvTy.val, InvTy.val', invOption_eq hy] + +private theorem invRec' {x : IGame.{u}} (hx : 0 < x) + {P : ∀ p, ∀ y ∈ x⁻¹.moves p, Prop} + (zero : P left 0 (zero_mem_leftMoves_inv hx)) + (mk : ∀ p₁ p₂, ∀ y (hy : 0 < y) (hyx : y ∈ x.moves (-(p₁ * p₂))), ∀ a (ha : a ∈ x⁻¹.moves p₁), + P p₁ a ha → P p₂ _ (invOption_eq hy ▸ invOption_mem_moves_inv hx hy hyx ha)) : + (∀ p y (hy : y ∈ x⁻¹.moves p), P p y hy) := by + suffices ∀ p : Player, ∀ i, P p (InvTy.val x p i) (by cases p <;> simp [inv_eq hx]) by + intro p y hy + rw [inv_eq' hx, moves_ofSets] at hy + obtain ⟨i, rfl⟩ := hy + simpa using this p i + intro b i + induction i + · simpa + · apply mk + · exact ((equivShrink {y ∈ _ | 0 < y}).symm _).2.2 + · exact ((equivShrink {y ∈ _ | 0 < y}).symm _).2.1 + · assumption + +/-- An induction principle on left and right moves of `x⁻¹`. -/ +theorem invRec {x : IGame} (hx : 0 < x) + {P : ∀ p, ∀ y ∈ x⁻¹.moves p, Prop} + (zero : P left 0 (zero_mem_leftMoves_inv hx)) + (mk : ∀ p₁ p₂, ∀ y (hy : 0 < y) (hyx : y ∈ x.moves (-(p₁ * p₂))), ∀ a (ha : a ∈ x⁻¹.moves p₁), + P p₁ a ha → P p₂ _ (invOption_mem_moves_inv hx hy hyx ha)) : + (∀ p y (hy : y ∈ x⁻¹.moves p), P p y hy) := by + apply invRec' hx zero + convert mk using 8 with _ _ _ ha + simp_rw [invOption_eq ha] + +instance : RatCast IGame where + ratCast q := q.num / q.den + +theorem ratCast_def (q : ℚ) : (q : IGame) = q.num / q.den := rfl + +@[simp] theorem ratCast_zero : ((0 : ℚ) : IGame) = 0 := by simp [ratCast_def] +@[simp] theorem ratCast_neg (q : ℚ) : ((-q : ℚ) : IGame) = -(q : IGame) := by simp [ratCast_def] + +end IGame +end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Ordinal.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Ordinal.lean new file mode 100644 index 0000000000..c794ffa84c --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Ordinal.lean @@ -0,0 +1,259 @@ +/- +Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Basic +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Basic +public import Mathlib.Algebra.Order.Hom.Monoid + +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.GameCmp +import Mathlib.Algebra.Order.Hom.Monoid +import Mathlib.Data.Set.Finite.Lattice + +/-! +# Ordinals as games + +We define the canonical map `NatOrdinal → IGame`, where every ordinal is mapped to the game whose +left set consists of all previous ordinals. We make use of the type alias `NatOrdinal` rather than +`Ordinal`, as this map also preserves addition, and in the case of surreals, multiplication. The map +to surreals is defined in `CombinatorialGames.Surreal.Ordinal`. + +We also prove some properties about `NatCast`, which is related to the previous construction by +`toIGame (↑n) ≈ ↑n`. + +# Main declarations + +- `NatOrdinal.toIGame`: The canonical map between `NatOrdinal` and `IGame`. +- `NatOrdinal.toGame`: The canonical map between `NatOrdinal` and `Game`. +-/ + +universe u + +open Set IGame + +@[expose] public noncomputable section + +/-! ### Lemmas to upstream -/ + +@[simp] +theorem OrderEmbedding.antisymmRel_iff_antisymmRel {α β : Type*} [Preorder α] [Preorder β] + {a b : α} (f : α ↪o β) : f a ≈ f b ↔ a ≈ b := by + simp [AntisymmRel] + +theorem OrderEmbedding.antisymmRel_iff_eq {α β : Type*} [Preorder α] [PartialOrder β] + {a b : α} (f : α ↪o β) : f a ≈ f b ↔ a = b := by + simp + +namespace NatOrdinal + +/-! ### `NatOrdinal` to `IGame` -/ + +/-- We make this private until we can build the `OrderEmbedding`. -/ +private def toIGame' (o : NatOrdinal.{u}) : IGame.{u} := + !{.range fun (⟨x, _⟩ : Iio o) ↦ toIGame' x | ∅} +termination_by o + +private theorem toIGame'_def (o : NatOrdinal) : o.toIGame' = !{toIGame' '' Iio o | ∅} := by + rw [toIGame']; simp [image_eq_range] + +private theorem leftMoves_toIGame' (o : NatOrdinal) : o.toIGame'ᴸ = toIGame' '' Iio o := by + rw [toIGame'_def]; exact leftMoves_ofSets .. + +private theorem rightMoves_toIGame' (o : NatOrdinal) : o.toIGame'ᴿ = ∅ := by + rw [toIGame'_def]; exact rightMoves_ofSets .. + +private theorem toIGame'_strictMono : StrictMono toIGame' := by + refine fun a b h ↦ lt_of_le_not_ge ?_ (left_lf ?_) + · rw [le_iff_forall_lf] + simpa [leftMoves_toIGame', rightMoves_toIGame'] using + fun c hc ↦ (toIGame'_strictMono (hc.trans h)).not_ge + · rw [leftMoves_toIGame'] + exact ⟨a, h, rfl⟩ +termination_by a => a + +/-- The canonical map from `NatOrdinal` to `IGame`, sending `o` to `{Iio o | ∅}`. -/ +@[no_expose] +def toIGame : NatOrdinal.{u} ↪o IGame.{u} := + .ofStrictMono NatOrdinal.toIGame' toIGame'_strictMono + +instance : Coe NatOrdinal IGame where + coe x := toIGame x + +theorem toIGame_def (o : NatOrdinal) : o.toIGame = !{toIGame '' Iio o | ∅} := + toIGame'_def o + +@[simp] +theorem leftMoves_toIGame (o : NatOrdinal) : o.toIGameᴸ = toIGame '' Iio o := + leftMoves_toIGame' o + +@[simp, game_cmp] +theorem rightMoves_toIGame (o : NatOrdinal) : o.toIGameᴿ = ∅ := + rightMoves_toIGame' o + +theorem forall_leftMoves_toIGame {P : IGame → Prop} {o : NatOrdinal} : + (∀ x ∈ (toIGame o)ᴸ, P x) ↔ ∀ a < o, P (toIGame a) := by + simp + +theorem exists_leftMoves_toIGame {P : IGame → Prop} {o : NatOrdinal} : + (∃ x ∈ (toIGame o)ᴸ, P x) ↔ ∃ a < o, P (toIGame a) := by + simp + +@[game_cmp] +theorem forall_leftMoves_toIGame_natCast {P : IGame → Prop} {n : ℕ} : + (∀ x ∈ (toIGame n)ᴸ, P x) ↔ ∀ m < n, P (toIGame m) := by + simp + +@[game_cmp] +theorem exists_leftMoves_toIGame_natCast {P : IGame → Prop} {n : ℕ} : + (∃ x ∈ (toIGame n)ᴸ, P x) ↔ (∃ m < n, P (toIGame m)) := by + simp + +@[game_cmp] +theorem forall_leftMoves_toIGame_ofNat {P : IGame → Prop} {n : ℕ} [n.AtLeastTwo] : + (∀ x ∈ (toIGame ofNat(n))ᴸ, P x) ↔ ∀ m < n, P (toIGame m) := + forall_leftMoves_toIGame_natCast + +@[game_cmp] +theorem exists_leftMoves_toIGame_ofNat {P : IGame → Prop} {n : ℕ} [n.AtLeastTwo] : + (∃ x ∈ (toIGame ofNat(n))ᴸ, P x) ↔ ∃ m < n, P (toIGame m) := + exists_leftMoves_toIGame_natCast + +theorem mem_leftMoves_toIGame_of_lt {a b : NatOrdinal} (h : a < b) : + a.toIGame ∈ b.toIGameᴸ := by + simpa + +@[simp, game_cmp] theorem toIGame_zero : toIGame 0 = 0 := by ext p; cases p <;> simp +@[simp, game_cmp] theorem toIGame_one : toIGame 1 = 1 := by ext p; cases p <;> simp + +@[simp] +theorem not_toIGame_fuzzy (a b : NatOrdinal) : ¬ toIGame a ‖ toIGame b := by + simpa [IncompRel] using le_of_lt + +@[simp] +theorem toIGame_nonneg (a : NatOrdinal) : 0 ≤ a.toIGame := by + simpa using toIGame.monotone zero_le + +/-! ### `NatOrdinal` to `Game` -/ + +/-- Converts an ordinal into the corresponding game. -/ +noncomputable def toGame : NatOrdinal.{u} ↪o Game.{u} := + .ofStrictMono (fun o ↦ .mk o.toIGame) fun _ _ h ↦ toIGame.strictMono h + +instance : Coe NatOrdinal Game where + coe x := toGame x + +@[simp] theorem _root_.Game.mk_natOrdinal_toIGame (o : NatOrdinal) : .mk o.toIGame = o.toGame := rfl + +theorem toGame_def (o : NatOrdinal) : o.toGame = !{toGame '' Iio o | ∅} := by + rw [← Game.mk_natOrdinal_toIGame, toIGame_def] + simp [image_image] + +@[simp] theorem toGame_zero : toGame 0 = 0 := by simp [← Game.mk_natOrdinal_toIGame] +@[simp] theorem toGame_one : toGame 1 = 1 := by simp [← Game.mk_natOrdinal_toIGame] + +@[simp] +theorem not_toGame_fuzzy (a b : NatOrdinal) : ¬ toGame a ‖ toGame b := + not_toIGame_fuzzy a b + +@[simp] +theorem toGame_nonneg (a : NatOrdinal) : 0 ≤ a.toGame := + toIGame_nonneg a + +/-- The natural addition of ordinals corresponds to their sum as games. -/ +theorem toIGame_add (a b : NatOrdinal) : (a + b).toIGame ≈ a.toIGame + b.toIGame := by + rw [AntisymmRel, le_iff_forall_lf, le_iff_forall_lf] + simp only [game_cmp, leftMoves_toIGame, lt_add_iff] + refine ⟨?_, ⟨fun _ ↦ ?_, fun _ ↦ ?_⟩⟩ + · rintro c (⟨d, _, hd⟩ | ⟨d, _, hd⟩) + all_goals + · rw [← toIGame.le_iff_le] at hd + apply (hd.trans_lt _).not_ge + grw [toIGame_add] + simpa + all_goals + grw [← toIGame_add] + simp +termination_by (a, b) + +@[simp] +theorem toGame_add (a b : NatOrdinal) : (a + b).toGame = a.toGame + b.toGame := + Game.mk_eq (toIGame_add a b) + +/-- The natural multiplication of ordinals corresponds to their product as games. -/ +theorem toIGame_mul (a b : NatOrdinal) : (a * b).toIGame ≈ a.toIGame * b.toIGame := by + rw [AntisymmRel, le_iff_forall_lf, le_iff_forall_lf] + simp only [game_cmp, leftMoves_toIGame, lt_mul_iff, mulOption] + refine ⟨fun e c hc d hd he ↦ ?_, fun c hc d hd ↦ ?_⟩ + · grw [← toIGame.le_iff_le, toIGame_add, toIGame_add] at he + rw [← add_le_add_iff_right (toIGame (c * d))] + apply mt he.trans' + grw [toIGame_mul, toIGame_mul, toIGame_mul, ← IGame.le_sub_iff_add_le] + exact left_lf <| mulOption_mem_moves_mul + (mem_leftMoves_toIGame_of_lt hc) (mem_leftMoves_toIGame_of_lt hd) + · grw [← sub_eq_add_neg, IGame.le_sub_iff_add_le, ← toIGame_mul, ← toIGame_mul, ← toIGame_mul, + ← toIGame_add, ← toIGame_add, toIGame.le_iff_le, not_le] + exact mul_add_lt hc hd +termination_by (a, b) + +@[simp] +theorem toGame_mul (a b : NatOrdinal) : (a * b).toGame = .mk (a.toIGame * b.toIGame) := + Game.mk_eq (toIGame_mul a b) + +/-- `NatOrdinal.toGame` as an `OrderAddMonoidHom`. -/ +@[simps] +def toGameAddHom : NatOrdinal →+o Game where + toFun := toGame + map_zero' := toGame_zero + map_add' := toGame_add + monotone' := toGame.monotone + +/-! ### `NatCast` properties -/ + +@[simp] +theorem toGame_natCast : ∀ n : ℕ, toGame n = n := + map_natCast' toGameAddHom toGame_one + +/-- Note that the equality doesn't hold, as e.g. `↑2 = {1 | }`, while `toIGame 2 = {0, 1 | }`. -/ +theorem toIGame_natCast_equiv (n : ℕ) : toIGame n ≈ n := + Game.mk_eq_mk.1 (by simp) + +end NatOrdinal + +namespace IGame +open NatOrdinal + +theorem Short.exists_lt_natCast (x : IGame) [Short x] : ∃ n : ℕ, x < n := by + have (y : xᴸ) : ∃ n : ℕ, y.1 < n := by + have := Short.of_mem_moves y.2 + exact Short.exists_lt_natCast y + choose f hf using this + obtain ⟨n, hn⟩ := (finite_range f).bddAbove + refine ⟨n + 1, lt_of_le_of_lt ?_ (IGame.natCast_lt.2 (Nat.lt_succ_self _))⟩ + rw [le_iff_forall_lf] + simpa using fun y hy ↦ ((hf ⟨y, hy⟩).trans_le (mod_cast hn ⟨⟨y, hy⟩, rfl⟩)).not_ge +termination_by x +decreasing_by igame_wf + +theorem Short.exists_neg_natCast_lt (x : IGame) [Short x] : ∃ n : ℕ, -n < x := by + obtain ⟨n, hn⟩ := exists_lt_natCast (-x) + use n + rwa [IGame.neg_lt] + +local notation "ω" => toIGame (NatOrdinal.of Ordinal.omega0) + +theorem Short.lt_omega0 (x : IGame) [Short x] : x < ω := by + obtain ⟨n, hn⟩ := exists_lt_natCast x + apply hn.trans + grw [← toIGame_natCast_equiv n] + rw [toIGame.lt_iff_lt, ← NatOrdinal.of_natCast n] + exact Ordinal.natCast_lt_omega0 n + +theorem Short.neg_omega0_lt (x : IGame) [Short x] : -ω < x := by + rw [IGame.neg_lt] + exact lt_omega0 _ + +end IGame +end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Player.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Player.lean new file mode 100644 index 0000000000..108cfa3a69 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Player.lean @@ -0,0 +1,181 @@ +/- +Copyright (c) 2025 Yuyang Zhao. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuyang Zhao +-/ +module + +public import Mathlib.Algebra.Ring.Defs +public import Mathlib.Data.Fintype.Defs +public import Mathlib.Logic.Small.Defs + +import Mathlib.Tactic.DeriveFintype + +/-! +# Type of players + +This file implements the two-element type of players (`Left`, `Right`), alongside other basic +notational machinery to be used within game theory. +-/ + +@[expose] public section + +universe u + +/-! ### Players -/ + +/-- Either the Left or Right player. -/ +@[aesop safe cases, grind cases] +inductive Player where + /-- The Left player. -/ + | left : Player + /-- The Right player. -/ + | right : Player +deriving DecidableEq, Fintype, Inhabited + +namespace Player + +/-- Specify a function `Player → α` from its two outputs. -/ +@[simp] +abbrev cases {α : Sort*} (l r : α) : Player → α + | left => l + | right => r + +lemma apply_cases {α β : Sort*} (f : α → β) (l r : α) (p : Player) : + f (cases l r p) = cases (f l) (f r) p := by + cases p <;> rfl + +@[simp] +theorem cases_inj {α : Sort*} {l₁ r₁ l₂ r₂ : α} : + cases l₁ r₁ = cases l₂ r₂ ↔ l₁ = l₂ ∧ r₁ = r₂ := + ⟨fun h ↦ ⟨congr($h left), congr($h right)⟩, fun ⟨hl, hr⟩ ↦ hl ▸ hr ▸ rfl⟩ + +theorem const_of_left_eq_right {α : Sort*} {f : Player → α} (hf : f left = f right) : + ∀ p q, f p = f q + | left, left | right, right => rfl + | left, right => hf + | right, left => hf.symm + +theorem const_of_left_eq_right' {f : Player → Prop} (hf : f left ↔ f right) (p q) : f p ↔ f q := + (const_of_left_eq_right hf.eq ..).to_iff + +@[simp] +protected lemma «forall» {p : Player → Prop} : + (∀ x, p x) ↔ p left ∧ p right := + ⟨fun h ↦ ⟨h left, h right⟩, fun ⟨hl, hr⟩ ↦ fun | left => hl | right => hr⟩ + +@[simp] +protected lemma «exists» {p : Player → Prop} : + (∃ x, p x) ↔ p left ∨ p right := + ⟨fun | ⟨left, h⟩ => .inl h | ⟨right, h⟩ => .inr h, fun | .inl h | .inr h => ⟨_, h⟩⟩ + +instance : Neg Player where + neg := cases right left + +@[simp, grind =] lemma neg_left : -left = right := rfl +@[simp, grind =] lemma neg_right : -right = left := rfl +@[simp] theorem eq_neg : ∀ {p q : Player}, p = -q ↔ p ≠ q := by decide +@[simp] theorem neg_eq : ∀ {p q : Player}, -p = q ↔ p ≠ q := by decide +theorem ne_neg : ∀ {p q : Player}, p ≠ -q ↔ p = q := by decide +theorem neg_ne : ∀ {p q : Player}, -p ≠ q ↔ p = q := by decide +theorem neg_ne_self : ∀ (p : Player), -p ≠ p := by decide +theorem self_ne_neg : ∀ (p : Player), p ≠ -p := by decide + +instance : InvolutiveNeg Player where + neg_neg := by decide + +/-- +The multiplication of `Player`s is used to state the lemmas about the multiplication of +combinatorial games, such as `IGame.mulOption_mem_moves_mul`. +-/ +instance : Mul Player where mul + | left, p => p + | right, p => -p + +@[simp, grind =] lemma left_mul (p : Player) : left * p = p := rfl +@[simp, grind =] lemma right_mul (p : Player) : right * p = -p := rfl +@[simp, grind =] lemma mul_left : ∀ p, p * left = p := by decide +@[simp, grind =] lemma mul_right : ∀ p, p * right = -p := by decide +@[simp, grind =] lemma mul_self : ∀ p, p * p = left := by decide + +instance : HasDistribNeg Player where + neg_mul := by decide + mul_neg := by decide + +instance : CommGroup Player where + one := left + inv := id + mul_assoc := by decide + mul_comm := by decide + one_mul := by decide + mul_one := by decide + inv_mul_cancel := by decide + +@[simp, grind =] lemma one_eq_left : 1 = left := rfl +@[simp, grind =] lemma inv_eq_self (p : Player) : p⁻¹ = p := rfl + +end Player + +open Player + +/-! ### OfSets -/ + +/-- +Type class for the `ofSets` operation. +Used to implement the `!{st}` and `!{s | t}` syntax. +-/ +class OfSets (α : Type (u + 1)) (Valid : outParam ((Player → Set α) → Prop)) where + /-- Construct a combinatorial game from its left and right sets. -/ + ofSets (st : Player → Set α) (h : Valid st) [Small.{u} (st left)] [Small.{u} (st right)] : α +export OfSets (ofSets) + +@[inherit_doc OfSets.ofSets] +macro "!{" st:term "}'" h:term:max : term => `(OfSets.ofSets $st $h) + +@[inherit_doc OfSets.ofSets] +macro "!{" s:term " | " t:term "}'" h:term:max : term => `(!{Player.cases $s $t}'$h) + +/-- A tactic which attempts to automatically solve goals which appear on `OfSets`. -/ +macro "of_sets_tactic" : tactic => + `(tactic| first + | done + | trivial + | assumption + | aesop + | fail "failed to prove sets are valid, try to use `!{st}'h` notation instead, \ +where `h` is a proof that sets are valid" + ) + +@[inherit_doc OfSets.ofSets] +macro:max "!{" st:term "}" : term => `(!{$st}'(by of_sets_tactic)) + +@[inherit_doc OfSets.ofSets] +macro:max "!{" s:term " | " t:term "}" : term => `(!{$s | $t}'(by of_sets_tactic)) + +recommended_spelling "ofSets" for "!{st}'h" in [ofSets, «term!{_}'_»] +recommended_spelling "ofSets" for "!{s | t}'h" in [ofSets, «term!{_|_}'_»] +recommended_spelling "ofSets" for "!{st}" in [ofSets, «term!{_}»] +recommended_spelling "ofSets" for "!{s | t}" in [ofSets, «term!{_|_}»] + +open Lean PrettyPrinter Delaborator SubExpr in +/-- Delaborates `ofSets (Player.cases s t)` to `!{s | t}` and `ofSets st` to `!{st}`. -/ +@[app_delab OfSets.ofSets] +meta def delabOfSets : Delab := do + let e ← getExpr + guard <| e.isAppOfArity' ``OfSets.ofSets 7 + withNaryArg 3 do + let e ← getExpr + if e.isAppOfArity' ``Player.cases 3 then + let s ← withNaryArg 1 delab + let t ← withNaryArg 2 delab + `(!{$s | $t}) + else + let st ← delab + `(!{$st}) + +theorem ofSets_eq_ofSets_cases {α} {Valid : (Player → Set α) → Prop} [OfSets α Valid] + (st : Player → Set α) (h : Valid st) [Small (st left)] [Small (st right)] : + !{st} = !{st left | st right}'(by convert h; aesop) := by + congr; ext1 p; cases p <;> rfl + +end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Special.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Special.lean new file mode 100644 index 0000000000..08e22a947a --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Special.lean @@ -0,0 +1,233 @@ +/- +Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios, Tristan Figueroa Reid +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Classes + +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.GameCmp +import Mathlib.Data.Set.Finite.Basic + +/-! +# Special games + +This file defines some simple yet notable combinatorial games: + +* `⋆ = {0 | 0}` +* `½ = {0 | 1}` +* `↑ = {0 | ⋆}` +* `↓ = {⋆ | 0}`. +-/ + +universe u + +@[expose] public noncomputable section + +namespace IGame + +/-! ### Star -/ + +/-- The game `⋆ = {0 | 0}`, which is fuzzy with zero. -/ +def star : IGame := + !{fun _ ↦ {0}} + +@[inherit_doc] notation "⋆" => star +recommended_spelling "star" for "⋆" in [«term⋆»] + +@[simp, game_cmp] theorem moves_star (p : Player) : moves p ⋆ = {0} := moves_ofSets .. + +theorem zero_lf_star : 0 ⧏ ⋆ := by rw [zero_lf]; simp +theorem star_lf_zero : ⋆ ⧏ 0 := by rw [lf_zero]; simp + +theorem star_fuzzy_zero : ⋆ ‖ 0 := ⟨zero_lf_star, star_lf_zero⟩ +theorem zero_fuzzy_star : 0 ‖ ⋆ := ⟨star_lf_zero, zero_lf_star⟩ + +@[simp] theorem not_star_equiv_zero : ¬⋆ ≈ 0 := star_fuzzy_zero.not_antisymmRel +@[simp] theorem not_zero_equiv_star : ¬0 ≈ ⋆ := zero_fuzzy_star.not_antisymmRel + +@[simp, game_cmp] theorem neg_star : -⋆ = ⋆ := by simp [star] + +@[simp] theorem star_mul_star : ⋆ * ⋆ = ⋆ := by ext p; cases p <;> simp [mulOption] + +@[simp] protected instance Dicotic.star : Dicotic ⋆ := by rw [dicotic_def]; simp +protected instance Impartial.star : Impartial ⋆ := by rw [impartial_def]; simp +@[simp] protected instance Short.star : Short ⋆ := by rw [short_def]; simp + +/-! ### Half -/ + +/-- The game `½ = {0 | 1}`, which we prove satisfies `½ + ½ = 1`. -/ +def half : IGame := + !{{0} | {1}} + +@[inherit_doc] notation "½" => half +recommended_spelling "half" for "½" in [«term½»] + +@[simp, game_cmp] theorem leftMoves_half : ½ᴸ = {0} := leftMoves_ofSets .. +@[simp, game_cmp] theorem rightMoves_half : ½ᴿ = {1} := rightMoves_ofSets .. + +theorem zero_lt_half : 0 < ½ := by game_cmp +theorem half_lt_one : ½ < 1 := by game_cmp +theorem half_add_half_equiv_one : ½ + ½ ≈ 1 := by game_cmp + +@[simp] protected instance Numeric.half : Numeric ½ := by rw [numeric_def]; simp +protected instance Short.half : Short ½ := by rw [short_def]; simp + +/-! ### Up and down -/ + +/-- The game `↑ = {0 | ⋆}`. -/ +def up : IGame := + !{{0} | {⋆}} + +@[inherit_doc] notation "↑" => up +recommended_spelling "up" for "↑" in [«term↑»] + +@[simp, game_cmp] theorem leftMoves_up : ↑ᴸ = {0} := leftMoves_ofSets .. +@[simp, game_cmp] theorem rightMoves_up : ↑ᴿ = {⋆} := rightMoves_ofSets .. + +@[simp] theorem up_pos : 0 < ↑ := by game_cmp +theorem up_fuzzy_star : ↑ ‖ ⋆ := by game_cmp +theorem star_fuzzy_up : ⋆ ‖ ↑ := up_fuzzy_star.symm + +protected instance Dicotic.up : Dicotic ↑ := by rw [dicotic_def]; simp +protected instance Short.up : Short ↑ := by rw [short_def]; simp + +/-- The game `↓ = {⋆ | 0}`. -/ +def down : IGame := + !{{⋆} | {0}} + +@[inherit_doc] notation "↓" => down +recommended_spelling "down" for "↓" in [«term↓»] + +@[simp, game_cmp] theorem leftMoves_down : ↓ᴸ = {⋆} := leftMoves_ofSets .. +@[simp, game_cmp] theorem rightMoves_down : ↓ᴿ = {0} := rightMoves_ofSets .. + +@[simp, game_cmp] theorem neg_down : -↓ = ↑ := by simp [up, down] +@[simp, game_cmp] theorem neg_up : -↑ = ↓ := by simp [up, down] + +@[simp] theorem down_neg : ↓ < 0 := by game_cmp +theorem down_fuzzy_star : ↓ ‖ ⋆ := by game_cmp +theorem star_fuzzy_down : ⋆ ‖ ↓ := down_fuzzy_star.symm + +protected instance Dicotic.down : Dicotic ↓ := by rw [dicotic_def]; simp +protected instance Short.down : Short ↓ := by rw [short_def]; simp + +/-! ### Tiny and miny -/ + +/-- A tiny game `⧾x` is defined as `{0 | {0 | -x}}`, and is amongst the smallest of the +infinitesimals. -/ +def tiny (x : IGame) : IGame := + !{{0} | {!{{0} | {-x}}}} + +@[inherit_doc] prefix:75 "⧾" => tiny +recommended_spelling "tiny" for "⧾" in [«term⧾_»] + +@[simp, game_cmp] +theorem leftMoves_tiny (x : IGame) : (⧾x)ᴸ = {0} := + leftMoves_ofSets .. + +@[simp, game_cmp] +theorem rightMoves_tiny (x : IGame) : (⧾x)ᴿ = {!{{0} | {-x}}} := + rightMoves_ofSets .. + +@[simp] +theorem dicotic_tiny_iff {x : IGame} : Dicotic (⧾x) ↔ Dicotic x := by + trans Dicotic !{{0} | {-x}} + all_goals + rw [dicotic_def] + simp + +instance (x : IGame) [Dicotic x] : Dicotic (⧾x) := by rwa [dicotic_tiny_iff] + +@[simp] +theorem short_tiny_iff {x : IGame} : Short (⧾x) ↔ Short x := by + trans Short !{{0} | {-x}} + all_goals + rw [short_def] + simp + +instance (x : IGame) [Short x] : Short (⧾x) := by rwa [short_tiny_iff] + +/-- A miny game `⧿x` is defined as `{{x | 0} | 0}`. -/ +def miny (x : IGame) : IGame := + !{{!{{x} | {0}}} | {0}} + +@[inherit_doc] prefix:75 "⧿" => miny +recommended_spelling "miny" for "⧿" in [«term⧿_»] + +@[simp, game_cmp] +theorem leftMoves_miny (x : IGame) : (⧿x)ᴸ = {!{{x} | {0}}} := + leftMoves_ofSets .. + +@[simp, game_cmp] +theorem rightMoves_miny (x : IGame) : (⧿x)ᴿ = {0} := + rightMoves_ofSets .. + +@[simp, game_cmp] +theorem neg_tiny (x : IGame) : -(⧾x) = ⧿x := by + simp [miny, tiny] + +@[simp, game_cmp] +theorem neg_miny (x : IGame) : -(⧿x) = ⧾x := by + simp [miny, tiny] + +@[simp] +theorem dicotic_miny_iff {x : IGame} : Dicotic (⧿x) ↔ Dicotic x := by + rw [← neg_tiny, Dicotic.neg_iff]; simp + +instance (x : IGame) [Dicotic x] : Dicotic (⧿x) := by + rwa [dicotic_miny_iff] + +@[simp] +theorem short_miny_iff {x : IGame} : Short (⧿x) ↔ Short x := by + rw [← neg_tiny, Short.neg_iff]; simp + +instance (x : IGame) [Short x] : Short (⧿x) := by + rwa [short_miny_iff] + +@[simp, game_cmp] theorem tiny_pos (x : IGame) : 0 < ⧾x := by game_cmp +@[simp, game_cmp] theorem miny_neg (x : IGame) : ⧿x < 0 := by game_cmp + +/-! ### Switches -/ + +/-- A **switch** `±x` is defined as `{x | -x}`: switches are their own confusion interval! -/ +def switch (x : IGame) : IGame := + !{{x} | {-x}} + +@[inherit_doc] prefix:75 "±" => switch +recommended_spelling "switch" for "±" in [«term±_»] + +@[simp, game_cmp] +theorem leftMoves_switch (x : IGame) : (±x)ᴸ = {x} := + leftMoves_ofSets .. + +@[simp, game_cmp] +theorem rightMoves_switch (x : IGame) : (±x)ᴿ = {-x} := + rightMoves_ofSets .. + +@[simp] +theorem neg_switch (x : IGame) : -±x = ±x := by + rw [switch, neg_ofSets] + simp [Set.neg_singleton] + +@[simp] +theorem switch_zero : ±0 = ⋆ := by + ext p; cases p <;> simp + +@[simp] +theorem dicotic_switch_iff {x : IGame} : Dicotic (±x) ↔ Dicotic x := by + rw [dicotic_def]; simp + +instance (x : IGame) [Dicotic x] : Dicotic (±x) := by + rwa [dicotic_switch_iff] + +@[simp] +theorem short_switch_iff {x : IGame} : Short (±x) ↔ Short x := by + rw [short_def]; simp + +instance (x : IGame) [Short x] : Short (±x) := by + rwa [short_switch_iff] + +end IGame +end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib.lean new file mode 100644 index 0000000000..3d34cf8ed6 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Dyadic +import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Small + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib/Dyadic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib/Dyadic.lean new file mode 100644 index 0000000000..b4778b795a --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib/Dyadic.lean @@ -0,0 +1,360 @@ +/- +Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import Mathlib.Algebra.Order.Field.Basic +public import Mathlib.Algebra.Order.Ring.Defs +public import Mathlib.Analysis.Normed.Field.Lemmas +public import Mathlib.Data.Nat.Log + +/-! +# Dyadic numbers + +A dyadic (rational) number is a rational number whose denominator is a power of two. We provide +the `CommRing` structure, as well as proving some auxiliary theorems on them. +-/ + +@[expose] public section + +/-! ### For Mathlib -/ + +theorem le_of_le_of_lt_of_lt {α β : Type*} [PartialOrder α] [Preorder β] {x y : α} + {f : α → β} (h : x < y → f x < f y) (hxy : x ≤ y) : f x ≤ f y := by + obtain rfl | h' := hxy.eq_or_lt + · rfl + · exact (h h').le + +theorem Nat.pow_log_eq_self_iff {b n : ℕ} (hb : b ≠ 0) : + b ^ Nat.log b n = n ↔ n ∈ Set.range (b ^ ·) := by + constructor + · aesop + · rintro ⟨n, rfl⟩ + rw [← Nat.one_le_iff_ne_zero, le_iff_eq_or_lt] at hb + obtain rfl | hb := hb + · simp + · rw [Nat.log_pow hb] + +theorem pos_of_mem_powers {n : ℕ} (h : n ∈ Submonoid.powers 2) : 0 < n := by + obtain ⟨n, rfl⟩ := h + exact pow_pos (Nat.succ_pos 1) n + +theorem ne_zero_of_mem_powers {n : ℕ} (h : n ∈ Submonoid.powers 2) : n ≠ 0 := + (pos_of_mem_powers h).ne' + +theorem dvd_iff_le_of_mem_powers {m n : ℕ} + (hm : m ∈ Submonoid.powers 2) (hn : n ∈ Submonoid.powers 2) : m ∣ n ↔ m ≤ n := by + obtain ⟨m, rfl⟩ := hm + obtain ⟨n, rfl⟩ := hn + simp_all [pow_dvd_pow_iff, pow_le_pow_iff_right₀] + +namespace Dyadic + +attribute [coe] toRat + +instance : Coe Dyadic Rat where + coe := toRat + +@[norm_cast] alias coe_le_coe := toRat_le_toRat_iff +@[norm_cast] alias coe_lt_coe := toRat_lt_toRat_iff +@[norm_cast] alias coe_inj := toRat_inj + +/-- Numerator of a dyadic number. -/ +abbrev num (x : Dyadic) : ℤ := x.toRat.num +/-- Denominator of a dyadic number. -/ +abbrev den (x : Dyadic) : ℕ := x.toRat.den + +theorem den_ne_zero (x : Dyadic) : x.den ≠ 0 := Rat.den_ne_zero x +theorem den_pos (x : Dyadic) : 0 < x.den := Rat.den_pos x +theorem one_le_den (x : Dyadic) : 1 ≤ x.den := x.den_pos +theorem den_mem_powers (x : Dyadic) : x.den ∈ Submonoid.powers 2 := by + fun_cases toRat x with + | case1 -- zero + | case3 => exact one_mem _ -- integer + | case2 => apply pow_mem; exact Submonoid.mem_powers 2 -- dyadic rational + +@[simp] +theorem den_le_one_iff_eq_one {x : Dyadic} : x.den ≤ 1 ↔ x.den = 1 := by + simp_rw [Nat.le_one_iff_eq_zero_or_eq_one, x.den_ne_zero, false_or] + +@[simp] +theorem one_lt_den_iff_ne_one {x : Dyadic} : 1 < x.den ↔ x.den ≠ 1 := by + simp [← den_le_one_iff_eq_one] + +theorem den_ne_one_of_den_lt {x y : Dyadic} (h : x.den < y.den) : y.den ≠ 1 := by + simpa using (one_le_den x).trans_lt h + +@[ext] theorem ext {x y : Dyadic} (h : (x : ℚ) = y) : x = y := toRat_inj.1 h + +@[norm_cast] alias coe_natCast := toRat_natCast +@[simp, norm_cast] theorem num_natCast (n : ℕ) : (n : Dyadic).num = n := + congrArg Rat.num (toRat_natCast n) +@[simp, norm_cast] theorem den_natCast (n : ℕ) : (n : Dyadic).den = 1 := + congrArg Rat.den (toRat_natCast n) + +@[simp] theorem coe_ofNat (n : ℕ) : (ofNat(n) : Dyadic).toRat = n := + toRat_natCast n +@[simp] theorem num_ofNat (n : ℕ) : (ofNat(n) : Dyadic).num = n := + num_natCast n +@[simp] theorem den_ofNat (n : ℕ) : (ofNat(n) : Dyadic).den = 1 := + den_natCast n + +@[simp] theorem natCast_lt_coe {x : ℕ} {y : Dyadic} : x < y.toRat ↔ x < y := by norm_cast +@[simp] theorem natCast_le_coe {x : ℕ} {y : Dyadic} : x ≤ y.toRat ↔ x ≤ y := by norm_cast +@[simp] theorem coe_lt_natCast {x : Dyadic} {y : ℕ} : x.toRat < y ↔ x < y := by norm_cast +@[simp] theorem coe_le_natCast {x : Dyadic} {y : ℕ} : x.toRat ≤ y ↔ x ≤ y := by norm_cast + +@[simp, norm_cast] theorem coe_eq_natCast {x : Dyadic} {y : ℕ} : x.toRat = y ↔ x = y := by + rw [← toRat_natCast, toRat_inj] +@[simp, norm_cast] theorem natCast_eq_coe {x : ℕ} {y : Dyadic} : x = y.toRat ↔ x = y := by + rw [← toRat_natCast, toRat_inj] + +@[norm_cast] alias coe_intCast := toRat_intCast +@[simp, norm_cast] theorem num_intCast (n : ℤ) : (n : Dyadic).num = n := + congrArg Rat.num (coe_intCast n) +@[simp, norm_cast] theorem den_intCast (n : ℤ) : (n : Dyadic).den = 1 := + congrArg Rat.den (coe_intCast n) + +@[simp] theorem intCast_lt_coe {x : ℤ} {y : Dyadic} : x < y.toRat ↔ x < y := by norm_cast +@[simp] theorem intCast_le_coe {x : ℤ} {y : Dyadic} : x ≤ y.toRat ↔ x ≤ y := by norm_cast +@[simp] theorem coe_lt_intCast {x : Dyadic} {y : ℤ} : x.toRat < y ↔ x < y := by norm_cast +@[simp] theorem coe_le_intCast {x : Dyadic} {y : ℤ} : x.toRat ≤ y ↔ x ≤ y := by norm_cast +@[simp] theorem coe_eq_intCast {x : Dyadic} {y : ℤ} : x.toRat = y ↔ x = y := by norm_cast +@[simp] theorem intCast_eq_coe {x : ℤ} {y : Dyadic} : x = y.toRat ↔ x = y := by norm_cast + +instance : Inhabited Dyadic := ⟨0⟩ + +@[simp, norm_cast] theorem coe_zero : (0 : Dyadic).toRat = 0 := rfl +@[simp] theorem num_zero : (0 : Dyadic).num = 0 := rfl +@[simp] theorem den_zero : (0 : Dyadic).den = 1 := rfl + +@[simp] theorem zero_lt_coe {x : Dyadic} : 0 < x.toRat ↔ 0 < x := by norm_cast +@[simp] theorem zero_le_coe {x : Dyadic} : 0 ≤ x.toRat ↔ 0 ≤ x := by norm_cast +@[simp] theorem coe_lt_zero {x : Dyadic} : x.toRat < 0 ↔ x < 0 := by norm_cast +@[simp] theorem coe_le_zero {x : Dyadic} : x.toRat ≤ 0 ↔ x ≤ 0 := by norm_cast +alias coe_eq_zero := toRat_eq_zero_iff +@[simp] theorem zero_eq_coe {x : Dyadic} : 0 = x.toRat ↔ 0 = x := by norm_cast + +@[simp, norm_cast] theorem coe_one : (1 : Dyadic).toRat = 1 := rfl +@[simp] theorem num_one : (1 : Dyadic).num = 1 := rfl +@[simp] theorem den_one : (1 : Dyadic).den = 1 := rfl + +@[simp] theorem one_lt_coe {x : Dyadic} : 1 < x.toRat ↔ 1 < x := by norm_cast +@[simp] theorem one_le_coe {x : Dyadic} : 1 ≤ x.toRat ↔ 1 ≤ x := by norm_cast +@[simp] theorem coe_lt_one {x : Dyadic} : x.toRat < 1 ↔ x < 1 := by norm_cast +@[simp] theorem coe_le_one {x : Dyadic} : x.toRat ≤ 1 ↔ x ≤ 1 := by norm_cast +@[simp] theorem coe_eq_one {x : Dyadic} : x.toRat = 1 ↔ x = 1 := by norm_cast +@[simp] theorem one_eq_coe {x : Dyadic} : 1 = x.toRat ↔ 1 = x := by norm_cast + +instance : Nontrivial Dyadic where + exists_pair_ne := ⟨0, 1, by decide⟩ + +@[simp] theorem num_neg (x : Dyadic) : (-x).num = -x.num := congrArg Rat.num (toRat_neg x) +@[simp] theorem den_neg (x : Dyadic) : (-x).den = x.den := (congrArg Rat.den (toRat_neg x) :) + +@[norm_cast] alias coe_neg := toRat_neg +@[norm_cast] alias coe_add := toRat_add +@[norm_cast] alias coe_sub := toRat_sub +@[norm_cast] alias coe_mul := toRat_mul +@[norm_cast] alias coe_pow := toRat_pow + +instance : SMul Nat Dyadic where + smul x y := x * y + +@[norm_cast] theorem coe_nsmul (x : ℕ) (y : Dyadic) : (x • y).toRat = x • y.toRat := + (coe_mul x y).trans (by simp) + +instance : SMul Int Dyadic where + smul x y := x * y + +@[norm_cast] theorem coe_zsmul (x : ℤ) (y : Dyadic) : (x • y).toRat = x • y.toRat := + (coe_mul x y).trans (by simp) + +/-- The dyadic number ½. -/ +def half : Dyadic := (1 : Dyadic) >>> 1 + +@[simp, norm_cast] theorem coe_half : half.toRat = 2⁻¹ := (Rat.inv_def 2).symm +@[simp] theorem num_half : half.num = 1 := rfl +@[simp] theorem num_den : half.den = 2 := rfl + +/-- Constructor for the fraction `m / n`. -/ +protected def mkRat (m : ℤ) {n : ℕ} (h : n ∈ Submonoid.powers 2) : Dyadic := + ofIntWithPrec m (Submonoid.log ⟨n, h⟩) + +@[simp, norm_cast] +theorem coe_mkRat (m : ℤ) {n : ℕ} (h : n ∈ Submonoid.powers 2) : + (Dyadic.mkRat m h).toRat = mkRat m n := by + rw [Dyadic.mkRat, toRat_ofIntWithPrec_eq_mul_two_pow, zpow_neg, + ← Nat.cast_two, zpow_natCast, ← Nat.cast_pow, ← Submonoid.pow_coe, + Submonoid.pow_log_eq_self, Rat.mkRat_eq_div, div_eq_mul_inv] + +@[simp] theorem mkRat_self (x : Dyadic) : Dyadic.mkRat x.num x.den_mem_powers = x := by ext; simp + +@[simp] +theorem mkRat_one (m : ℤ) (h : 1 ∈ Submonoid.powers 2) : Dyadic.mkRat m h = m := by + ext; simp [Rat.mkRat_one] + +@[simp] +theorem mkRat_lt_mkRat {m n : ℤ} {k : ℕ} (h₁ h₂ : k ∈ Submonoid.powers 2) : + Dyadic.mkRat m h₁ < Dyadic.mkRat n h₂ ↔ m < n := by + have hk : 0 < (k : ℚ) := by + rw [Rat.natCast_pos, Nat.pos_iff_ne_zero] + obtain ⟨n, rfl⟩ := h₁ + simp + rw [← coe_lt_coe] + simp [Rat.mkRat_eq_div, div_lt_div_iff_of_pos_right hk] + +instance : LinearOrder Dyadic where + le_refl := Dyadic.le_refl + le_trans := @Dyadic.le_trans + le_antisymm := @Dyadic.le_antisymm + le_total := Dyadic.le_total + lt_iff_le_not_ge := Std.LawfulOrderLT.lt_iff + toDecidableLE := Dyadic.instDecidableLE + toDecidableLT := Dyadic.instDecidableLT + toDecidableEq := instDecidableEqDyadic + +@[simp] +theorem mkRat_le_mkRat {m n : ℤ} {k : ℕ} (h₁ h₂ : k ∈ Submonoid.powers 2) : + Dyadic.mkRat m h₁ ≤ Dyadic.mkRat n h₂ ↔ m ≤ n := + le_iff_le_iff_lt_iff_lt.2 (mkRat_lt_mkRat h₁ h₂) + +theorem mkRat_add_mkRat_self {m n : ℤ} {k : ℕ} (h₁ h₂ : k ∈ Submonoid.powers 2) : + Dyadic.mkRat m h₁ + Dyadic.mkRat n h₂ = .mkRat (m + n) h₁ := by + ext; simp [Rat.mkRat_eq_div, add_div] + +instance : CommRing Dyadic where + add_assoc := add_assoc + zero_add := Dyadic.zero_add + add_zero := Dyadic.add_zero + add_comm := add_comm + mul_comm := mul_comm + left_distrib := mul_add + right_distrib := add_mul + zero_mul := Dyadic.zero_mul + mul_zero := Dyadic.mul_zero + mul_assoc := mul_assoc + one_mul := one_mul + mul_one := mul_one + neg_add_cancel := neg_add_cancel + sub_eq_add_neg _ _ := rfl + natCast_succ _ := by + rw [← coe_inj, coe_natCast, Rat.natCast_add, coe_add, coe_natCast] + rfl + intCast_negSucc _ := by + rw [← coe_inj, coe_intCast, coe_neg, coe_natCast, ← Int.cast_natCast, + ← Rat.intCast_neg, Int.neg_ofNat_succ] + nsmul n x := n • x + nsmul_zero x := by ext; simp [coe_nsmul] + nsmul_succ n x := by ext; simp [add_one_mul, coe_nsmul] + zsmul n x := n • x + zsmul_zero' x := by ext; simp [coe_zsmul] + zsmul_succ' n x := by ext; simp [add_one_mul, coe_zsmul] + zsmul_neg' n x := by + change _ * _ = -(_ * _) + rw [← neg_mul, ← coe_inj, coe_mul, coe_mul, coe_intCast, coe_neg, coe_intCast, + ← Rat.intCast_neg, Int.neg_ofNat_succ] + npow n x := x ^ n + npow_zero x := by ext; simp + npow_succ n x := by ext; simp [pow_succ] + +instance : IsStrictOrderedRing Dyadic where + add_le_add_left := by simp [← toRat_le_toRat_iff] + le_of_add_le_add_left := by simp [← toRat_le_toRat_iff] + mul_lt_mul_of_pos_left x hx y z h := by + rw [← coe_lt_coe] at hx h ⊢ + rw [coe_mul, coe_mul] + rw [coe_zero] at hx + exact mul_lt_mul_of_pos_left h hx + mul_lt_mul_of_pos_right x hx y z h := by + rw [← coe_lt_coe] at hx h ⊢ + rw [coe_mul, coe_mul] + rw [coe_zero] at hx + exact mul_lt_mul_of_pos_right h hx + zero_le_one := by decide + +instance : DenselyOrdered Dyadic where + dense x y h := by + use half * (x + y) + simp_rw [← coe_lt_coe] at * + constructor + · simpa [inv_mul_eq_div] using left_lt_add_div_two.2 h + · simpa [inv_mul_eq_div] using add_div_two_lt_right.2 h + +instance : Archimedean Dyadic where + arch x y h := by + rw [← coe_lt_coe, coe_zero] at h + obtain ⟨n, hn⟩ := exists_lt_nsmul h x.toRat + refine ⟨n, ?_⟩ + rw [← coe_le_coe, nsmul_eq_mul, coe_mul, coe_natCast, ← nsmul_eq_mul] + exact hn.le + +theorem even_den {x : Dyadic} (hx : x.den ≠ 1) : Even x.den := by + obtain ⟨n, hn⟩ := x.den_mem_powers + rw [← hn] + cases n + · simp_all + · rw [even_iff_two_dvd] + exact dvd_mul_left .. + +theorem odd_num {x : Dyadic} (hx : x.den ≠ 1) : Odd x.num := by + rw [← Int.not_even_iff_odd] + have hd := even_den hx + rw [even_iff_two_dvd] at * + rw [← Int.natAbs_dvd_natAbs] + exact (Nat.not_coprime_of_dvd_of_dvd one_lt_two · hd x.toRat.reduced) + +theorem intCast_num_eq_self_of_den_eq_one {x : Dyadic} (hx : x.den = 1) : x.num = x := by + ext + rw [coe_intCast] + exact Rat.coe_int_num_of_den_eq_one hx + +theorem den_mkRat_le (x : ℤ) {n : ℕ} (hn : n ≠ 0) : (mkRat x n).den ≤ n := by + rw [← Rat.normalize_eq_mkRat hn, Rat.normalize_eq hn] + exact Nat.div_le_self n _ + +theorem den_mkRat_lt {x : Dyadic} {n : ℤ} (hn : 2 ∣ n) (hd : x.den ≠ 1) : + (mkRat n x.den).den < x.den := by + rw [← Rat.normalize_eq_mkRat x.den_ne_zero, Rat.normalize_eq] + apply Nat.div_lt_self x.den_pos + apply Nat.le_of_dvd (Nat.gcd_pos_of_pos_right _ x.den_pos) (Nat.dvd_gcd _ (even_den hd).two_dvd) + rwa [← Int.natAbs_dvd_natAbs] at hn + +theorem den_add_self_lt {x : Dyadic} (hx : x.den ≠ 1) : (x + x).den < x.den := by + suffices x + x = Dyadic.mkRat (2 * x.num) x.den_mem_powers by + rw [this, den, Dyadic.coe_mkRat] + exact den_mkRat_lt (Int.dvd_mul_right 2 x.num) hx + ext + simp [Rat.mkRat_eq_div, Rat.num_div_den, mul_div_assoc, ← two_mul] + +theorem eq_mkRat_of_den_le {x : Dyadic} {n : ℕ} (h : x.den ≤ n) (hn : n ∈ Submonoid.powers 2) : + ∃ m, x = .mkRat m hn := by + use x.num * (n / x.den) + ext + rw [← x.mkRat_self, coe_mkRat, coe_mkRat, + Rat.mkRat_eq_iff x.den_ne_zero (ne_zero_of_mem_powers hn), mkRat_self, Int.mul_assoc] + congr + exact (Nat.div_mul_cancel ((dvd_iff_le_of_mem_powers x.den_mem_powers hn).2 h)).symm + +instance : CanLift Dyadic Int Int.cast (·.den = 1) where + prf x hx := ⟨x.num, Dyadic.ext (coe_intCast x.num ▸ x.toRat.den_eq_one_iff.mp hx)⟩ + +theorem den_add_le_den_right {x y : Dyadic} (h : x.den ≤ y.den) : (x + y).den ≤ y.den := by + obtain ⟨n, hn⟩ := eq_mkRat_of_den_le h y.den_mem_powers + conv_lhs => rw [← y.mkRat_self, hn, mkRat_add_mkRat_self] + rw [den, Dyadic.coe_mkRat] + exact den_mkRat_le _ y.den_ne_zero + +/-- Coercion as a `RingHom`. -/ +@[simps] +def coeRingHom : Dyadic →+* ℚ where + toFun := Dyadic.toRat + map_zero' := rfl + map_one' := rfl + map_add' := coe_add + map_mul' := coe_mul + +end Dyadic +end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib/Small.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib/Small.lean new file mode 100644 index 0000000000..851817ef32 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib/Small.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import Mathlib.Logic.Small.Defs + +import Mathlib.Logic.Small.Set +import Mathlib.Logic.Relation +import Mathlib.Order.SetNotation + +/-! +# Tree with small sets of branches is small +-/ + +universe u + +public section + +open Set + +variable {α : Type*} (r : α → α → Prop) [H : ∀ x, Small.{u} {y // r x y}] + +private def level (x : α) : ℕ → Set α + | 0 => {x} + | n + 1 => ⋃₀ ((fun x ↦ {y | r x y}) '' level x n) + +private theorem small_level (x : α) : ∀ n, Small.{u} (level r x n) + | 0 => small_single _ + | n + 1 => by + refine @small_sUnion _ _ ?_ ?_ + · have := small_level x n + exact small_image .. + · simp_all + +private theorem small_sUnion_level (x : α) : Small.{u} (⋃₀ range (level r x)) := by + refine @small_sUnion _ _ ?_ ?_ + · exact small_range .. + · simp [small_level] + +instance small_transGen (x : α) : Small.{u} {y // Relation.TransGen r x y} := by + refine @small_subset _ _ _ (fun y hy ↦ ?_) (small_sUnion_level r x) + simp_rw [mem_sUnion, mem_range, exists_exists_eq_and] + induction hy with + | single => + use 1 + simpa [level] + | tail hy hr IH => + obtain ⟨n, hn⟩ := IH + use n + 1 + simpa [level] using ⟨_, hn, hr⟩ + +instance small_transGen' [∀ x, Small.{u} {y // r y x}] (x : α) : + Small.{u} {y // Relation.TransGen r y x} := by + simp_rw [← Relation.transGen_swap (r := r)] + infer_instance + +instance small_reflTransGen (x : α) : Small.{u} {y // Relation.ReflTransGen r x y} := by + simp_rw [Relation.reflTransGen_iff_eq_or_transGen] + exact @small_insert _ _ _ (small_transGen ..) + +instance small_reflTransGen' [∀ x, Small.{u} {y // r y x}] (x : α) : + Small.{u} {y // Relation.ReflTransGen r y x} := by + simp_rw [← Relation.reflTransGen_swap (r := r)] + infer_instance diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/NatOrdinal.lean b/LeanPool/ConwayRefinement/CombinatorialGames/NatOrdinal.lean new file mode 100644 index 0000000000..c8221aafa9 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/NatOrdinal.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Basic +import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/NatOrdinal/Basic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/NatOrdinal/Basic.lean new file mode 100644 index 0000000000..b39d1dc80f --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/NatOrdinal/Basic.lean @@ -0,0 +1,418 @@ +/- +Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import Mathlib.SetTheory.Ordinal.Family + +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.OrdinalAlias +import Mathlib.Tactic.Abel + +/-! +# Natural operations on ordinals + +The goal of this file is to define natural addition and multiplication on ordinals, also known as +the Hessenberg sum and product, and provide a basic API. The natural addition of two ordinals +`a + b` is recursively defined as the least ordinal greater than `a' + b` and `a + b'` for `a' < a` +and `b' < b`. The natural multiplication `a * b` is likewise recursively defined as the least +ordinal such that `a * b + a' * b'` is greater than `a' * b + a * b'` for any `a' < a` and +`b' < b`. + +These operations give the ordinals a `CommSemiring` + `IsStrictOrderedRing` structure. To make the +best use of it, we define them on a type alias `NatOrdinal`. + +An equivalent characterization explains the relevance of these operations to game theory: they are +the restrictions of surreal addition and multiplication to the ordinals. + +## Implementation notes + +To reduce API duplication, we opt not to implement operations on `NatOrdinal` on `Ordinal`. The +order isomorphisms `NatOrdinal.of` and `NatOrdinal.val` allow us to cast between them whenever +needed. + +For similar reasons, most results about ordinals and games are written using `NatOrdinal` rather +than `Ordinal` (except when `Nimber` would make more sense). +-/ + +universe u v + +open Order Set + +public noncomputable section + +/-! ### Basic casts between `Ordinal` and `NatOrdinal` -/ + +ordinal_alias! + /-- A type synonym for ordinals with natural addition and multiplication. -/ NatOrdinal + +namespace NatOrdinal + +variable {a b c d a' b' c' : NatOrdinal.{u}} + +/-! ### Natural addition -/ + +private def add (a b : NatOrdinal.{u}) : NatOrdinal.{u} := + max (⨆ x : Iio a, succ (add x.1 b)) (⨆ x : Iio b, succ (add a x.1)) +termination_by (a, b) +decreasing_by all_goals cases x; decreasing_tactic + +#adaptation_note /-- noncomputable is now needed -/ in +/-- Natural addition on ordinals `a + b`, also known as the Hessenberg sum, is recursively defined +as the least ordinal greater than `a' + b` and `a + b'` for all `a' < a` and `b' < b`. In contrast +to normal ordinal addition, it is commutative. + +Natural addition can equivalently be characterized as the ordinal resulting from adding up +corresponding coefficients in the Cantor normal forms of `a` and `b`. -/ +@[no_expose] noncomputable instance : Add NatOrdinal := ⟨add⟩ + +theorem add_def (a b : NatOrdinal) : + a + b = max (⨆ x : Iio a, succ (x.1 + b)) (⨆ x : Iio b, succ (a + x.1)) := by + change add .. = _ + rw [add] + rfl + +theorem lt_add_iff : a < b + c ↔ (∃ b' < b, a ≤ b' + c) ∨ ∃ c' < c, a ≤ b + c' := by + rw [add_def] + simp [NatOrdinal.lt_iSup_iff] + +theorem add_le_iff : b + c ≤ a ↔ (∀ b' < b, b' + c < a) ∧ ∀ c' < c, b + c' < a := by + rw [← not_lt, lt_add_iff] + simp + +instance : AddLeftStrictMono NatOrdinal where + elim _a _b _c h := lt_add_iff.2 (.inr ⟨_, h, le_rfl⟩) + +instance : AddRightStrictMono NatOrdinal where + elim _a _b _c h := lt_add_iff.2 (.inl ⟨_, h, le_rfl⟩) + +instance : AddLeftMono NatOrdinal := + addLeftMono_of_addLeftStrictMono _ + +instance : AddRightMono NatOrdinal := + addRightMono_of_addRightStrictMono _ + +private theorem add_comm' (a b : NatOrdinal) : a + b = b + a := by + rw [add_def, add_def, max_comm] + congr with x <;> cases x <;> exact congrArg _ (add_comm' ..) +termination_by (a, b) + +private theorem add_zero' (a : NatOrdinal) : a + 0 = a := by + rw [add_def, ciSup_of_empty fun _ : Iio 0 ↦ _, max_bot_right] + convert iSup_succ a with x + cases x + exact add_zero' _ +termination_by a + +private theorem iSup_add_of_monotone (f : NatOrdinal.{u} → NatOrdinal.{u}) (h : Monotone f) : + ⨆ x : Iio (a + b), f x = max (⨆ a' : Iio a, f (a'.1 + b)) (⨆ b' : Iio b, f (a + b'.1)) := by + apply (max_le _ _).antisymm' + · rw [iSup_le_iff] + rintro ⟨i, hi⟩ + obtain ⟨x, hx, hi⟩ | ⟨x, hx, hi⟩ := lt_add_iff.1 hi + · exact le_max_of_le_left ((h hi).trans <| le_iSup (fun x : Iio a ↦ _) ⟨x, hx⟩) + · exact le_max_of_le_right ((h hi).trans <| le_iSup (fun x : Iio b ↦ _) ⟨x, hx⟩) + all_goals + refine csSup_le_csSup' (bddAbove_of_small _) fun _ ↦ ?_ + aesop + +private theorem add_assoc' (a b c : NatOrdinal) : a + b + c = a + (b + c) := by + rw [add_def, add_def a (b + c)] + rw [iSup_add_of_monotone (fun _ ↦ succ _) (succ_mono.comp add_right_mono), + iSup_add_of_monotone (fun _ ↦ succ _) (succ_mono.comp add_left_mono), max_assoc] + congr with x <;> cases x <;> exact congrArg _ (add_assoc' ..) +termination_by (a, b, c) + +instance : AddCommMonoid NatOrdinal where + add_zero := private add_zero' + zero_add x := by rw [add_comm', add_zero'] + add_comm := private add_comm' + add_assoc := private add_assoc' + nsmul := nsmulRec + +instance : IsOrderedCancelAddMonoid NatOrdinal where + add_le_add_left _ _ := add_le_add_left + le_of_add_le_add_left a b c h := by + by_contra! h' + exact h.not_gt (add_lt_add_right h' a) + +theorem le_add_left : a ≤ b + a := by simp +theorem le_add_right : a ≤ a + b := by simp + +@[simp] +theorem add_eq_zero_iff : a + b = 0 ↔ a = 0 ∧ b = 0 := by + refine ⟨fun h ↦ ?_, ?_⟩ + · repeat rw [← le_zero_iff] + exact ⟨le_add_right.trans_eq h, le_add_left.trans_eq h⟩ + · simp +contextual + +private theorem succ_eq_add_one' (a : NatOrdinal) : succ a = a + 1 := by + rw [add_def, ciSup_unique (s := fun _ : Iio 1 ↦ _), Iio_one_default_eq, add_zero, + eq_comm, max_eq_right_iff, iSup_le_iff] + rintro ⟨i, hi⟩ + rwa [← succ_eq_add_one', succ_le_succ_iff, succ_le_iff] +termination_by a + +instance : SuccAddOrder NatOrdinal := ⟨by exact succ_eq_add_one'⟩ + +@[simp] theorem of_add_one (a : Ordinal) : of (a + 1) = of a + 1 := succ_eq_add_one _ +@[simp] theorem val_add_one (a : NatOrdinal) : val (a + 1) = val a + 1 := (succ_eq_add_one a).symm + +instance : AddMonoidWithOne NatOrdinal where + natCast n := of n + natCast_succ n := by simp + +@[simp] theorem of_natCast (n : ℕ) : of n = n := rfl +@[simp] theorem val_natCast (n : ℕ) : val n = n := rfl + +@[simp] +theorem natCast_image_Iio (n : ℕ) : Nat.cast '' Iio n = Iio (n : NatOrdinal) := + Ordinal.natCast_image_Iio n + +@[simp] +theorem forall_lt_natCast {P : NatOrdinal → Prop} {n : ℕ} : (∀ a < ↑n, P a) ↔ ∀ a < n, P a := by + change (∀ a ∈ Iio _, _) ↔ ∀ a ∈ Iio _, _ + simp [← natCast_image_Iio] + +@[simp] +theorem exists_lt_natCast {P : NatOrdinal → Prop} {n : ℕ} : (∃ a < ↑n, P a) ↔ ∃ a < n, P a := by + change (∃ a ∈ Iio _, _) ↔ ∃ a ∈ Iio _, _ + simp [← natCast_image_Iio] + +theorem lt_omega0 {o : NatOrdinal} : o < of .omega0 ↔ ∃ n : ℕ, o = n := + Ordinal.lt_omega0 + +theorem natCast_lt_omega0 (n : ℕ) : n < of .omega0 := + Ordinal.natCast_lt_omega0 n + +instance : CharZero NatOrdinal where + cast_injective m n h := by + apply_fun val at h + simpa using h + +@[simp] +theorem of_add_natCast (a : Ordinal) (n : ℕ) : of (a + n) = of a + n := by + induction n with + | zero => simp + | succ n IH => simp [← add_assoc, IH] + +@[simp] +theorem val_add_natCast (a : NatOrdinal) (n : ℕ) : val (a + n) = val a + n := + (of_add_natCast _ n).symm + +/-- A version of `oadd_le_add` stated in terms of `Ordinal`. -/ +theorem oadd_le_add' (a b : Ordinal) : a + b ≤ val (of a + of b) := by + induction b using Ordinal.limitRecOn with + | zero => simp + | add_one c IH => simpa [← add_assoc] using add_le_add_left IH 1 + | limit c hc IH => + rw [(Ordinal.isNormal_add_right a).apply_of_isSuccLimit hc, Ordinal.iSup_le_iff] + rintro ⟨i, hi⟩ + exact (IH i hi).trans (add_le_add_right hi.le (of a)) + +theorem oadd_le_add (a b : NatOrdinal) : of (a.val + b.val) ≤ a + b := + oadd_le_add' .. + +/-! ### Natural multiplication -/ + +private def mul (a b : NatOrdinal.{u}) : NatOrdinal.{u} := + sInf {c | ∀ a' < a, ∀ b' < b, mul a' b + mul a b' < c + mul a' b'} +termination_by (a, b) + +#adaptation_note /-- noncomputable is now needed -/ in +/-- Natural multiplication on ordinals `a * b`, also known as the Hessenberg product, is recursively +defined as the least ordinal such that `a * b + a' * b'` is greater than `a' * b + a * b'` for all +`a' < a` and `b < b'`. In contrast to normal ordinal multiplication, it is commutative and +distributive (over natural addition). + +Natural multiplication can equivalently be characterized as the ordinal resulting from multiplying +the Cantor normal forms of `a` and `b` as if they were polynomials in `ω`. Addition of exponents is +done via natural addition. -/ +@[no_expose] noncomputable instance : Mul NatOrdinal := ⟨mul⟩ + +theorem mul_def (a b : NatOrdinal) : + a * b = sInf {c | ∀ a' < a, ∀ b' < b, a' * b + a * b' < c + a' * b'} := by + change mul .. = _ + rw [mul] + rfl + +/-- The set in the definition of `mul` is nonempty. -/ +private theorem mul_nonempty (a b : NatOrdinal.{u}) : + {c : NatOrdinal.{u} | ∀ a' < a, ∀ b' < b, a' * b + a * b' < c + a' * b'}.Nonempty := by + obtain ⟨c, hc⟩ : BddAbove ((fun x ↦ x.1 * b + a * x.2) '' Set.Iio a ×ˢ Set.Iio b) := + bddAbove_of_small _ + exact ⟨_, fun x hx y hy ↦ + (lt_succ_of_le <| hc <| Set.mem_image_of_mem _ <| Set.mk_mem_prod hx hy).trans_le le_add_right⟩ + +theorem mul_add_lt (ha : a' < a) (hb : b' < b) : a' * b + a * b' < a * b + a' * b' := by + rw [mul_def a b] + exact csInf_mem (mul_nonempty a b) a' ha b' hb + +theorem mul_add_le (ha : a' ≤ a) (hb : b' ≤ b) : a' * b + a * b' ≤ a * b + a' * b' := by + obtain rfl | ha := ha.eq_or_lt; · rfl + obtain rfl | hb := hb.eq_or_lt; · rw [add_comm] + exact (mul_add_lt ha hb).le + +theorem lt_mul_iff : c < a * b ↔ ∃ a' < a, ∃ b' < b, c + a' * b' ≤ a' * b + a * b' := by + refine ⟨fun h ↦ ?_, fun ⟨a', ha, b', hb, h⟩ ↦ ?_⟩ + · rw [mul_def] at h + simpa using notMem_of_lt_csInf h ⟨0, fun _ _ => bot_le⟩ + · rw [← add_lt_add_iff_right] + exact h.trans_lt (mul_add_lt ha hb) + +theorem mul_le_iff : a * b ≤ c ↔ ∀ a' < a, ∀ b' < b, a' * b + a * b' < c + a' * b' := by + simpa using lt_mul_iff.not + +private theorem mul_comm' (a b : NatOrdinal) : a * b = b * a := by + rw [mul_def, mul_def] + congr with x; constructor <;> intro H c hc d hd + · rw [add_comm, ← mul_comm', ← mul_comm' a, ← mul_comm' d] + exact H _ hd _ hc + · rw [add_comm, mul_comm', mul_comm' c, mul_comm' c] + exact H _ hd _ hc +termination_by (a, b) + +instance : CommMagma NatOrdinal where + mul_comm := private mul_comm' + +private theorem mul_zero' (a : NatOrdinal) : a * 0 = 0 := by + rw [← le_zero_iff, mul_le_iff] + simp + +instance : MulZeroClass NatOrdinal where + mul_zero := private mul_zero' + zero_mul a := by rw [mul_comm', mul_zero'] + +private theorem mul_one' (a : NatOrdinal) : a * 1 = a := by + rw [mul_def] + convert csInf_Ici + ext b + refine ⟨fun H ↦ le_of_forall_lt (a := a) fun c hc ↦ ?_, fun ha c hc ↦ ?_⟩ + · simpa [mul_one' c] using H c hc + · simpa [mul_one' c] using hc.trans_le ha +termination_by a + +instance : MulZeroOneClass NatOrdinal where + mul_one := private mul_one' + one_mul a := by rw [mul_comm', mul_one'] + +instance : PosMulStrictMono NatOrdinal where + mul_lt_mul_of_pos_left a ha b c h := lt_mul_iff.2 ⟨0, ha, b, h, by simp⟩ + +instance : MulPosStrictMono NatOrdinal where + mul_lt_mul_of_pos_right a ha b c h := lt_mul_iff.2 ⟨b, h, 0, ha, by simp⟩ + +instance : MulLeftMono NatOrdinal where + elim a b c h := by + obtain rfl | h₁ := h.eq_or_lt; · simp + obtain rfl | h₂ := eq_zero_or_pos a; · simp + exact (mul_lt_mul_of_pos_left h₁ h₂).le + +instance : MulRightMono NatOrdinal where + elim a b c h := by convert mul_le_mul_right h a using 1 <;> exact mul_comm .. + +private theorem mul_add (a b c : NatOrdinal) : a * (b + c) = a * b + a * c := by + refine le_antisymm (mul_le_iff.2 fun a' ha d hd => ?_) + (add_le_iff.2 ⟨fun d hd => ?_, fun d hd => ?_⟩) + · rw [mul_add] + rcases lt_add_iff.1 hd with (⟨b', hb, hd⟩ | ⟨c', hc, hd⟩) + · have := add_lt_add_of_lt_of_le (mul_add_lt ha hb) (mul_add_le ha.le hd) + rw [mul_add, mul_add] at this + grind + · have := add_lt_add_of_le_of_lt (mul_add_le ha.le hd) (mul_add_lt ha hc) + rw [mul_add, mul_add] at this + grind + · rcases lt_mul_iff.1 hd with ⟨a', ha, b', hb, hd⟩ + have := add_lt_add_of_le_of_lt hd (mul_add_lt ha (add_lt_add_left hb c)) + rw [mul_add, mul_add, mul_add a'] at this + grind + · rcases lt_mul_iff.1 hd with ⟨a', ha, c', hc, hd⟩ + have := add_lt_add_of_lt_of_le (mul_add_lt ha (add_lt_add_right hc b)) hd + rw [mul_add, mul_add, mul_add a'] at this + grind +termination_by (a, b, c) + +instance : Distrib NatOrdinal where + left_distrib := private mul_add + right_distrib a b c := by rw [mul_comm, mul_add, mul_comm, mul_comm c] + +theorem mul_add_lt₃ (ha : a' < a) (hb : b' < b) (hc : c' < c) : + a' * b * c + a * b' * c + a * b * c' + a' * b' * c' < + a * b * c + a' * b' * c + a' * b * c' + a * b' * c' := by + simpa only [add_mul, ← add_assoc] using mul_add_lt (mul_add_lt ha hb) hc + +theorem mul_add_le₃ {a' b' c' : NatOrdinal} (ha : a' ≤ a) (hb : b' ≤ b) (hc : c' ≤ c) : + a' * b * c + a * b' * c + a * b * c' + a' * b' * c' ≤ + a * b * c + a' * b' * c + a' * b * c' + a * b' * c' := by + simpa only [add_mul, ← add_assoc] using mul_add_le (mul_add_le ha hb) hc + +private theorem mul_add_lt₃' {a' b' c' : NatOrdinal} (ha : a' < a) (hb : b' < b) (hc : c' < c) : + a' * (b * c) + a * (b' * c) + a * (b * c') + a' * (b' * c') < + a * (b * c) + a' * (b' * c) + a' * (b * c') + a * (b' * c') := by + simp only [mul_comm _ (_ * _)] + convert mul_add_lt₃ hb hc ha using 1 <;> abel_nf + +theorem lt_mul_iff₃ : d < a * b * c ↔ ∃ a' < a, ∃ b' < b, ∃ c' < c, + d + a' * b' * c + a' * b * c' + a * b' * c' ≤ + a' * b * c + a * b' * c + a * b * c' + a' * b' * c' := by + refine ⟨fun h ↦ ?_, fun ⟨a', ha, b', hb, c', hc, h⟩ ↦ ?_⟩ + · rcases lt_mul_iff.1 h with ⟨e, he, c', hc, H₁⟩ + rcases lt_mul_iff.1 he with ⟨a', ha, b', hb, H₂⟩ + refine ⟨a', ha, b', hb, c', hc, ?_⟩ + have := add_le_add H₁ (mul_add_le H₂ hc.le) + simp only [add_mul, add_assoc] at this + rw [add_left_comm, add_left_comm d, add_left_comm, add_le_add_iff_left, + add_left_comm (a * b' * c), add_left_comm (a' * b * c), add_left_comm (a * b * c'), + add_le_add_iff_left, add_left_comm (a * b * c'), add_left_comm (a * b * c')] at this + simpa only [add_assoc] + · have := h.trans_lt (mul_add_lt₃ ha hb hc) + repeat rw [add_lt_add_iff_right] at this + assumption + +theorem mul_le_iff₃ : a * b * c ≤ d ↔ ∀ a' < a, ∀ b' < b, ∀ c' < c, + a' * b * c + a * b' * c + a * b * c' + a' * b' * c' < + d + a' * b' * c + a' * b * c' + a * b' * c' := by + simpa using lt_mul_iff₃.not + +private theorem mul_le_iff₃' : a * (b * c) ≤ d ↔ ∀ a' < a, ∀ b' < b, ∀ c' < c, + a' * (b * c) + a * (b' * c) + a * (b * c') + a' * (b' * c') < + d + a' * (b' * c) + a' * (b * c') + a * (b' * c') := by + simp only [mul_comm _ (_ * _), mul_le_iff₃] + constructor <;> intro h a' ha b' hb c' hc + · convert h b' hb c' hc a' ha using 1 <;> abel_nf + · convert h c' hc a' ha b' hb using 1 <;> abel_nf + +private theorem mul_assoc (a b c : NatOrdinal) : a * b * c = a * (b * c) := by + apply le_antisymm + · rw [mul_le_iff₃] + intro a' ha b' hb c' hc + repeat rw [mul_assoc] + exact mul_add_lt₃' ha hb hc + · rw [mul_le_iff₃'] + intro a' ha b' hb c' hc + repeat rw [← mul_assoc] + exact mul_add_lt₃ ha hb hc +termination_by (a, b, c) + +instance : CommSemiring NatOrdinal where + mul_assoc := private mul_assoc + +instance : IsStrictOrderedRing NatOrdinal where + +/-- A version of `omul_le_mul` stated in terms of `Ordinal`. -/ +theorem omul_le_mul' (a b : Ordinal) : a * b ≤ val (of a * of b) := by + induction b using Ordinal.limitRecOn with + | zero => simp + | add_one c IH => simpa [mul_add_one] using (add_left_mono IH).trans (oadd_le_add' ..) + | limit c hc IH => + obtain rfl | ha := eq_zero_or_pos a + · simp + · rw [(Ordinal.isNormal_mul_right ha).apply_of_isSuccLimit hc, Ordinal.iSup_le_iff] + rintro ⟨i, hi⟩ + exact (IH i hi).trans (mul_le_mul_right hi.le (of a)) + +theorem omul_le_mul (a b : NatOrdinal) : of (a.val * b.val) ≤ a * b := + omul_le_mul' .. + +end NatOrdinal diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/NatOrdinal/Pow.lean b/LeanPool/ConwayRefinement/CombinatorialGames/NatOrdinal/Pow.lean new file mode 100644 index 0000000000..48515aed5c --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/NatOrdinal/Pow.lean @@ -0,0 +1,200 @@ +/- +Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Basic +public import Mathlib.SetTheory.Ordinal.Exponential + +/-! +# Natural operations on `ω ^ x` + +This file characterizes natural operations on powers of `ω`. In particular, we show: + +- If `y < ω^ x`, then `ω^ x * n + y = of (ω ^ x.val * n + y.val)`. +- `ω^ (x + y) = ω^ x * ω^ y`. + +These two results imply the validity of an algorithm to evaluate natural addition and +multiplication: write down the base `ω` Cantor Normal Forms of both ordinals, and add/multiply them +as polynomials. + +## Implementation notes + +Surreal exponentiation is not closed on the ordinals. Because of this, we opt against defining a +`Pow` instance on `NatOrdinal`. Instead, we implement our own custom typeclass `Wpow`, giving us +notation `ω^ x` for `of (ω ^ x.val)`. This typeclass will get reused for `IGame` and `Surreal` in +`CombinatorialGames.Surreal.Pow`. +-/ + +@[expose] public section + +open Ordinal + +theorem Ordinal.lt_mul_add_one {x y z : Ordinal} : x < y * (z + 1) ↔ ∃ w < y, x ≤ y * z + w := by + obtain rfl | hy := eq_or_ne y 0 + · simp + · rw [mul_add_one, lt_add_iff hy] + +/-- A typeclass for the the `ω^` notation. -/ +class Wpow (α : Type*) where + /-- The `ω`-map, i.e. base `ω` exponentiation. -/ + wpow : α → α + +@[inherit_doc] prefix:75 "ω^ " => Wpow.wpow +recommended_spelling "wpow" for "ω^" in [«termω^_»] + +namespace NatOrdinal +variable {x y z : NatOrdinal} + +noncomputable instance : Wpow NatOrdinal where + wpow x := of (ω ^ x.val) + +theorem wpow_def (x : NatOrdinal) : ω^ x = of (ω ^ x.val) := rfl +@[simp] theorem of_omega0_opow (x : Ordinal) : of (ω ^ x) = ω^ of x := rfl +@[simp] theorem val_wpow (x : NatOrdinal) : (ω^ x).val = ω ^ x.val := rfl + +@[simp] theorem wpow_zero : ω^ (0 : NatOrdinal) = 1 := by simp [wpow_def] +@[simp] theorem wpow_pos (x : NatOrdinal) : 0 < ω^ x := opow_pos _ omega0_pos +@[simp] theorem wpow_ne_zero (x : NatOrdinal) : ω^ x ≠ 0 := (wpow_pos x).ne' + +theorem isNormal_wpow : Order.IsNormal (ω^ · : NatOrdinal → NatOrdinal) := + Ordinal.isNormal_opow one_lt_omega0 + +@[simp] theorem wpow_lt_wpow : ω^ x < ω^ y ↔ x < y := isNormal_wpow.strictMono.lt_iff_lt +@[simp] theorem wpow_le_wpow : ω^ x ≤ ω^ y ↔ x ≤ y := isNormal_wpow.strictMono.le_iff_le +@[simp] theorem wpow_inj : ω^ x = ω^ y ↔ x = y := isNormal_wpow.strictMono.injective.eq_iff + +private theorem wpow_mul_natCast_add_of_lt_aux {x y : NatOrdinal} (hy : y < ω^ x) (n : ℕ) : + (∀ z < ω^ x, z + y < ω^ x) ∧ ω^ x * n + y = of (ω ^ x.val * n + y.val) := by + obtain rfl | hx := eq_or_ne x 0 + · simp_all + have H : ∀ z < ω^ x, z + y < ω^ x := by + intro z hz + have hm := max_lt hy hz + rw [wpow_def, ← val_lt_iff, lt_omega0_opow (b := x.val) hx] at hm + obtain ⟨a, ha, n, hn⟩ := hm + have hyz (n) := (wpow_mul_natCast_add_of_lt_aux (wpow_pos (of a)) n).2 + simp_rw [val_zero, add_zero, ← val_eq_iff, val_of] at hyz + rw [← hyz] at hn + calc + z + y ≤ max y z + max y z := add_le_add (le_max_right ..) (le_max_left ..) + _ < ω^ of a * n + ω^ of a * n := add_lt_add hn hn + _ < _ := by + rw [← mul_add, ← Nat.cast_add, ← val.lt_iff_lt, hyz, val_wpow] + exact opow_mul_lt_opow (natCast_lt_omega0 _) ha + refine ⟨H, le_antisymm ?_ ?_⟩ + · refine add_le_iff.2 ⟨?_, ?_⟩ <;> intro z hz + · match n with + | 0 => simp at hz + | 1 => + simp_rw [Nat.cast_one, mul_one] at * + apply (H z hz).trans_le + rw [wpow_def, of.le_iff_le] + exact le_self_add .. + | n + 1 + 1 => + rw [Nat.cast_add_one, mul_add_one] at hz + obtain ⟨a, ha, hz⟩ : ∃ a < ω^ x, z ≤ ω^ x * ↑(n + 1) + a := by + obtain (⟨a, ha, hz⟩ | h) := lt_add_iff.1 hz + · have hxn := (wpow_mul_natCast_add_of_lt_aux (wpow_pos x) (n + 1)).2 + simp_rw [val_zero, add_zero] at hxn + rw [hxn, ← val_lt_iff, Nat.cast_add_one, lt_mul_add_one] at ha + obtain ⟨b, (hb : of b < ω^ x), hbw⟩ := ha + rw [val_le_iff, ← val_of b, ← (wpow_mul_natCast_add_of_lt_aux hb n).2] at hbw + refine ⟨_, hb, hz.trans <| (add_le_add_left hbw _).trans ?_⟩ + rw [add_comm, ← add_assoc, ← mul_one_add, add_comm 1, ← Nat.cast_add_one] + · exact h + have ha' := H a ha + apply (add_le_add_left hz _).trans_lt + rw [add_assoc, (wpow_mul_natCast_add_of_lt_aux ha' _).2, of.lt_iff_lt] + apply (le_self_add ..).trans_lt' + rw [Nat.cast_add_one (n + 1), mul_add] + simpa + · rw [(wpow_mul_natCast_add_of_lt_aux (hz.trans hy) n).2] + simpa + · exact (oadd_le_add ..).trans (add_le_add_left (omul_le_mul ..) _) +termination_by (x, n, y) + +theorem add_lt_wpow (hx : x < ω^ z) (hy : y < ω^ z) : x + y < ω^ z := + (wpow_mul_natCast_add_of_lt_aux hy 0).1 x hx + +/-- See `wpow_mul_natCast_add_of_lt` for a stronger version. -/ +theorem wpow_mul_natCast_add_of_lt' (hy : y < ω^ x) (n : ℕ) : + ω^ x * n + y = of (ω ^ x.val * n + y.val) := + (wpow_mul_natCast_add_of_lt_aux hy n).2 + +/-- See `wpow_add_of_lt` for a stronger version. -/ +theorem wpow_add_of_lt' (hy : y < ω^ x) : ω^ x + y = of (ω ^ x.val + y.val) := by + simpa using wpow_mul_natCast_add_of_lt' hy 1 + +theorem wpow_mul_natCast (x : NatOrdinal) (n : ℕ) : ω^ x * n = of (ω ^ x.val * n) := by + simpa using wpow_mul_natCast_add_of_lt' (wpow_pos _) n + +theorem wpow_mul_natCast_lt (h : x < y) (n : ℕ) : ω^ x * n < ω^ y := by + rw [wpow_mul_natCast] + exact opow_mul_lt_opow (natCast_lt_omega0 n) h + +theorem lt_wpow_iff (hx : x ≠ 0) : y < ω^ x ↔ ∃ z < x, ∃ n : ℕ, y < ω^ z * n := by + rw [wpow_def, ← val_lt_iff, lt_omega0_opow] + · simp_rw [wpow_mul_natCast] + rfl + · assumption + +theorem wpow_le_iff (hx : x ≠ 0) : ω^ x ≤ y ↔ ∀ z < x, ∀ n : ℕ, ω^ z * n ≤ y := by + rw [← not_lt, lt_wpow_iff hx] + simp + +theorem lt_wpow_add_one_iff : y < ω^ (x + 1) ↔ ∃ n : ℕ, y < ω^ x * n := by + rw [wpow_def, ← val_lt_iff, val_add_one, ← Order.succ_eq_add_one, lt_omega0_opow_succ] + simp_rw [wpow_mul_natCast] + rfl + +theorem wpow_add_one_le_iff : ω^ (x + 1) ≤ y ↔ ∀ n : ℕ, ω^ x * n ≤ y := by + rw [← not_lt, lt_wpow_add_one_iff] + simp + +theorem wpow_mul_natCast_add_of_lt (hy : y < ω^ (x + 1)) (n : ℕ) : + ω^ x * n + y = of (ω ^ x.val * n + y.val) := by + obtain ⟨z, hz, m, rfl⟩ : ∃ z < ω^ x, ∃ m : ℕ, y = ω^ x * m + z := by + rw [wpow_def, ← val_lt_iff, val_add_one, opow_add, opow_one, Ordinal.lt_mul_iff_div_lt] at hy + · obtain ⟨m, hm⟩ := Ordinal.lt_omega0.1 hy + have hx : of (y.val % ω ^ x.val) < ω^ x := mod_lt _ (wpow_ne_zero _) + use of (y.val % ω ^ x.val), hx, m + rw [wpow_mul_natCast_add_of_lt' hx, ← hm] + exact (div_add_mod ..).symm + · exact wpow_ne_zero _ + simp_rw [← add_assoc, wpow_mul_natCast_add_of_lt' hz, val_of, ← add_assoc, ← mul_add, + ← Nat.cast_add, wpow_mul_natCast_add_of_lt' hz] + +theorem wpow_add_of_lt (hy : y < ω^ (x + 1)) : ω^ x + y = of (ω ^ x.val + y.val) := by + simpa using wpow_mul_natCast_add_of_lt hy 1 + +theorem wpow_add_wpow (h : x ≤ y) : ω^ y + ω^ x = of (ω ^ y.val + ω ^ x.val) := by + rw [wpow_add_of_lt, val_wpow] + simpa using Order.lt_succ_of_le h + +theorem wpow_add (x y : NatOrdinal) : ω^ (x + y) = ω^ x * ω^ y := by + obtain rfl | hx := eq_or_ne x 0; · simp + obtain rfl | hy := eq_or_ne y 0; · simp + have h : x + y ≠ 0 := by simp_all + apply le_antisymm + · simp_rw [wpow_le_iff h, lt_add_iff] + rintro z (⟨a, ha, hz⟩ | ⟨a, ha, hz⟩) n <;> apply (mul_le_mul_left (wpow_le_wpow.2 hz) _).trans + · rw [wpow_add, mul_comm, ← mul_assoc, mul_comm _ (ω^ a)] + exact mul_le_mul_left (wpow_mul_natCast_lt ha n).le _ + · rw [wpow_add, mul_assoc] + exact mul_le_mul_right (wpow_mul_natCast_lt ha n).le _ + · simp_rw [mul_le_iff, lt_wpow_iff hx, lt_wpow_iff hy] + rintro z ⟨a, ha, n, hz⟩ w ⟨b, hb, m, hw⟩ + apply (add_lt_wpow _ _).trans_le (le_add_right ..) + · apply (mul_le_mul_left hz.le _).trans_lt + rw [← mul_comm, ← mul_assoc, mul_comm (ω^ y), ← wpow_add] + exact wpow_mul_natCast_lt (add_lt_add_left ha y) n + · apply (mul_le_mul_right hw.le _).trans_lt + rw [← mul_assoc, ← wpow_add] + exact wpow_mul_natCast_lt (add_lt_add_right hb x) m +termination_by (x, y) + +end NatOrdinal +end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal.lean new file mode 100644 index 0000000000..da7d50f0b9 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal.lean @@ -0,0 +1,18 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Basic +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Birthday +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Division +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Dyadic +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Leading +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Multiplication +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Ordinal +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Pow +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Real + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Basic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Basic.lean new file mode 100644 index 0000000000..395ee522a2 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Basic.lean @@ -0,0 +1,320 @@ +/- +Copyright (c) 2019 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro, Kim Morrison, Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Birthday + +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.AddInstances +import Mathlib.Data.Int.Cast.Lemmas + +/-! +# Surreal numbers + +The basic theory of surreal numbers, built on top of the theory of combinatorial (pre-)games. A +surreal number is defined as an equivalence class of numeric games. + +Surreal numbers inherit the relations `≤` and `<` from games, and these relations satisfy the axioms +of a linear order. In fact, the surreals form a complete ordered field, containing a copy of the +reals, and much else besides! + +## Algebraic operations + +In this file, we show that the surreals form a linear ordered commutative group. + +In `CombinatorialGames.Surreal.Multiplication`, we define multiplication and show that the surreals +form a linear ordered commutative ring. In `CombinatorialGames.Surreal.Division` we further show the +surreals are a field. +-/ + +universe u + +@[expose] public noncomputable section + +/-! ### Simplicity theorem -/ + +namespace IGame + +/-- `x` fits within `y` when `z ⧏ x` for every `z ∈ yᴸ`, and `x ⧏ z` for every +`z ∈ yᴿ`. + +The simplicity theorem states that if a game fits a numeric game, but none of its options do, then +the games are equivalent. In particular, a numeric game is equivalent to the game of the least +birthday that fits in it -/ +def Fits (x y : IGame) : Prop := + (∀ z ∈ yᴸ, z ⧏ x) ∧ (∀ z ∈ yᴿ, x ⧏ z) + +theorem fits_of_equiv {x y : IGame} (h : x ≈ y) : Fits x y := + ⟨fun _ hz ↦ mt h.ge.trans (left_lf hz), fun _ hz ↦ mt h.le.trans' (lf_right hz) ⟩ + +alias AntisymmRel.Fits := fits_of_equiv + +theorem Fits.refl (x : IGame) : x.Fits x := + fits_of_equiv .rfl + +instance : Std.Refl Fits where + refl := Fits.refl + +theorem Fits.antisymm {x y : IGame} (h₁ : Fits x y) (h₂ : Fits y x) : x ≈ y := by + rw [AntisymmRel, le_iff_forall_lf, le_iff_forall_lf] + exact ⟨⟨h₂.1, h₁.2⟩, ⟨h₁.1, h₂.2⟩⟩ + +@[simp] +theorem fits_neg_iff {x y : IGame} : Fits (-x) (-y) ↔ Fits x y := by + simp [Fits, and_comm] + +alias ⟨_, Fits.neg⟩ := fits_neg_iff + +theorem not_fits_iff {x y : IGame} : + ¬ Fits x y ↔ (∃ z ∈ yᴸ, x ≤ z) ∨ (∃ z ∈ yᴿ, z ≤ x) := by + rw [Fits, not_and_or]; simp + +theorem Fits.congr {x y z : IGame} (h : x ≈ y) (hx : x.Fits z) : y.Fits z := by + constructor <;> intro w hw <;> grw [← h] + exacts [hx.1 w hw, hx.2 w hw] + +theorem fits_congr {x y z : IGame} (h : x ≈ y) : x.Fits z ↔ y.Fits z := + ⟨.congr h, .congr h.symm⟩ + +/-- A variant of the **simplicity theorem** with hypotheses that are easier to show. -/ +theorem Fits.equiv_of_forall_moves {x y : IGame} (hx : x.Fits y) + (hl : ∀ z ∈ xᴸ, ∃ w ∈ yᴸ, z ≤ w) (hr : ∀ z ∈ xᴿ, ∃ w ∈ yᴿ, w ≤ z) : x ≈ y := + ⟨le_of_forall_moves_right_lf hx.2 hl, le_of_forall_moves_left_lf hx.1 hr⟩ + +/-- A variant of the **simplicity theorem**: if a numeric game `x` fits within a game `y`, but none +of its options do, then `x ≈ y`. + +Note that under most circumstances, `Fits.equiv_of_forall_moves` is easier to use. -/ +theorem Fits.equiv_of_forall_not_fits {x y : IGame} [Numeric x] (hx : x.Fits y) + (h : ∀ p, ∀ z ∈ x.moves p, ¬ z.Fits y) : x ≈ y := by + simp_rw [not_fits_iff] at h + apply hx.equiv_of_forall_moves + · refine fun z hz ↦ (h _ z hz).resolve_right ?_ + rintro ⟨w, hw, hwz⟩ + exact hx.2 w hw <| hwz.trans (Numeric.left_lt hz).le + · refine fun z hz ↦ (h _ z hz).resolve_left ?_ + rintro ⟨w, hw, hwz⟩ + exact hx.1 w hw <| (Numeric.lt_right hz).le.trans hwz + +/-- A variant of the **simplicity theorem**: if `x` is the numeric game with the least birthday that +fits within `y`, then `x ≈ y`. -/ +theorem Fits.equiv_of_forall_birthday_le {x y : IGame} [Numeric x] (hx : x.Fits y) + (H : ∀ z, Numeric z → z.Fits y → x.birthday ≤ z.birthday) : x ≈ y := + hx.equiv_of_forall_not_fits + fun _ z hz h ↦ (birthday_lt_of_mem_moves hz).not_ge <| H z (.of_mem_moves hz) h + +/-- A specialization of the simplicity theorem to `0`. -/ +@[simp] +theorem fits_zero_iff_equiv {x : IGame} : Fits 0 x ↔ x ≈ 0 := + ⟨fun hx ↦ (hx.equiv_of_forall_not_fits <| by simp).symm, fun h ↦ fits_of_equiv h.symm⟩ + +/-- A specialization of the simplicity theorem to `1`. -/ +theorem equiv_one_of_fits {x : IGame} (hx : Fits 1 x) (h : ¬ x ≈ 0) : x ≈ 1 := by + apply (hx.equiv_of_forall_not_fits _).symm + simpa + +end IGame + +/-! ### Surreal numbers -/ + +open IGame + +/-- The type of surreal numbers. These are the numeric games quotiented by the antisymmetrization +relation `x ≈ y ↔ x ≤ y ∧ y ≤ x`. In the quotient, the order becomes a total order. -/ +def Surreal : Type (u + 1) := + Antisymmetrization (Subtype Numeric) (· ≤ ·) + +namespace Surreal + +/-- The quotient map from the subtype of numeric `IGame`s into `Game`. -/ +def mk (x : IGame) [h : Numeric x] : Surreal := Quotient.mk _ ⟨x, h⟩ +theorem mk_eq_mk {x y : IGame} [Numeric x] [Numeric y] : mk x = mk y ↔ x ≈ y := Quotient.eq + +alias ⟨_, mk_eq⟩ := mk_eq_mk + +@[cases_eliminator] +theorem ind {motive : Surreal → Prop} (mk : ∀ y [Numeric y], motive (mk y)) (x : Surreal) : + motive x := Quotient.ind (fun h ↦ @mk _ h.2) x + +/-- Choose an element of the equivalence class using the axiom of choice. -/ +@[no_expose] def out (x : Surreal) : IGame := (Quotient.out x).1 +@[simp] instance (x : Surreal) : Numeric x.out := (Quotient.out x).2 +@[simp] theorem out_eq (x : Surreal) : mk x.out = x := Quotient.out_eq x + +theorem mk_out_equiv (x : IGame) [h : Numeric x] : (mk x).out ≈ x := + Quotient.mk_out (s := AntisymmRel.setoid (Subtype _) (· ≤ ·)) ⟨x, h⟩ + +theorem equiv_mk_out (x : IGame) [Numeric x] : x ≈ (mk x).out := + (mk_out_equiv x).symm + +instance : Zero Surreal := ⟨mk 0⟩ +instance : One Surreal := ⟨mk 1⟩ +instance : Inhabited Surreal := ⟨0⟩ + +instance : Add Surreal where + add := Quotient.map₂ (fun a b ↦ ⟨a.1 + b.1, inferInstance⟩) fun _ _ h₁ _ _ h₂ ↦ add_congr h₁ h₂ + +instance : Neg Surreal where + neg := Quotient.map (fun a ↦ ⟨-a.1, inferInstance⟩) fun _ _ ↦ neg_congr + +instance : PartialOrder Surreal := + inferInstanceAs (PartialOrder (Antisymmetrization ..)) + +instance : LinearOrder Surreal where + le_total := by rintro ⟨x⟩ ⟨y⟩; exact Numeric.le_total x y + toDecidableLE := Classical.decRel _ + +instance : AddCommGroup Surreal where + zero_add := by rintro ⟨x⟩; change mk (0 + x) = mk x; simp_rw [zero_add] + add_zero := by rintro ⟨x⟩; change mk (x + 0) = mk x; simp_rw [add_zero] + add_comm := by rintro ⟨x⟩ ⟨y⟩; change mk (x + y) = mk (y + x); simp_rw [add_comm] + add_assoc := by rintro ⟨x⟩ ⟨y⟩ ⟨z⟩; change mk (x + y + z) = mk (x + (y + z)); simp_rw [add_assoc] + neg_add_cancel := by rintro ⟨a⟩; exact mk_eq (neg_add_equiv _) + nsmul := nsmulRec + zsmul := zsmulRec + +instance : AddGroupWithOne Surreal where + +instance : IsOrderedAddMonoid Surreal where + add_le_add_left := by rintro ⟨a⟩ ⟨b⟩ h ⟨c⟩; exact add_le_add_left (α := IGame) h _ + +@[simp] theorem mk_zero : mk 0 = 0 := rfl +@[simp] theorem mk_one : mk 1 = 1 := rfl +@[simp] theorem mk_add (x y : IGame) [Numeric x] [Numeric y] : mk (x + y) = mk x + mk y := rfl +@[simp] theorem mk_neg (x : IGame) [Numeric x] : mk (-x) = -mk x := rfl +@[simp] theorem mk_sub (x y : IGame) [Numeric x] [Numeric y] : mk (x - y) = mk x - mk y := rfl + +@[simp] theorem mk_le_mk {x y : IGame} [Numeric x] [Numeric y] : mk x ≤ mk y ↔ x ≤ y := Iff.rfl +@[simp] theorem mk_lt_mk {x y : IGame} [Numeric x] [Numeric y] : mk x < mk y ↔ x < y := Iff.rfl + +@[simp] +theorem mk_natCast : ∀ n : ℕ, mk n = n + | 0 => rfl + | n + 1 => by simp_rw [Nat.cast_add_one, mk_add, mk_one, mk_natCast n] + +@[simp] +theorem mk_intCast (n : ℤ) : mk n = n := by + cases n <;> simp + +instance : ZeroLEOneClass Surreal where + zero_le_one := zero_le_one (α := IGame) + +instance : NeZero (1 : Surreal) where + out := by apply ne_of_gt; exact IGame.zero_lt_one + +instance : Nontrivial Surreal := + ⟨_, _, zero_ne_one⟩ + +/-- Casts a `Surreal` number into a `Game`. -/ +def toGame : Surreal ↪o Game where + toFun := Quotient.lift (fun x ↦ .mk x) fun _ _ ↦ Game.mk_eq + inj' x y := by + cases x; cases y; + change Game.mk _ = Game.mk _ → _ + simp [Game.mk_eq_mk, mk_eq_mk] + map_rel_iff' := by rintro ⟨_⟩ ⟨_⟩; rfl + +@[simp] theorem toGame_mk (x : IGame) [Numeric x] : toGame (mk x) = .mk x := rfl +@[simp] theorem toGame_zero : toGame 0 = 0 := rfl +@[simp] theorem toGame_one : toGame 1 = 1 := rfl + +@[simp] +theorem gameMk_out (x : Surreal) : Game.mk x.out = x.toGame := by + conv_rhs => rw [← out_eq x, toGame_mk] + +theorem toGame_le_iff {a b : Surreal} : toGame a ≤ toGame b ↔ a ≤ b := by simp +theorem toGame_lt_iff {a b : Surreal} : toGame a < toGame b ↔ a < b := by simp +theorem toGame_inj {a b : Surreal} : toGame a = toGame b ↔ a = b := by simp + +/-- `Surreal.toGame` as an `OrderAddMonoidHom` -/ +@[simps] +def toGameAddHom : Surreal →+o Game where + toFun := toGame + map_zero' := rfl + map_add' := by rintro ⟨_⟩ ⟨_⟩; rfl + monotone' := toGame.monotone + +@[simp] +theorem toGame_add (x y : Surreal) : toGame (x + y) = toGame x + toGame y := + toGameAddHom.map_add x y + +@[simp] +theorem toGame_neg (x : Surreal) : toGame (-x) = -toGame x := + toGameAddHom.map_neg x + +@[simp] +theorem toGame_sub (x y : Surreal) : toGame (x - y) = toGame x - toGame y := + toGameAddHom.map_sub x y + +@[simp] theorem toGame_natCast (n : ℕ) : toGame n = n := map_natCast' toGameAddHom rfl n +@[simp] theorem toGame_intCast (n : ℤ) : toGame n = n := map_intCast' toGameAddHom rfl n + +/-- Construct a `Surreal` from its left and right sets, and a proof that all elements from the left +set are less than all the elements of the right set. + +Note that although this function is well-defined, this function isn't injective, nor do equivalence +classes in Surreal have a canonical representative. (Note however that every short numeric game has +a unique "canonical" form!) -/ +instance : OfSets Surreal.{u} (fun st ↦ ∀ x ∈ st left, ∀ y ∈ st right, x < y) where + ofSets st H _ _ := by + refine @mk !{fun p ↦ out '' st p} (.mk ?_ (by simp)) + rw [moves_ofSets, moves_ofSets] + rintro - ⟨x, hx, rfl⟩ - ⟨y, hy, rfl⟩ + rw [← Surreal.mk_lt_mk, out_eq, out_eq] + exact H x hx y hy + +theorem toGame_ofSets' (st : Player → Set Surreal.{u}) [Small.{u} (st left)] [Small.{u} (st right)] + {H : ∀ x ∈ st left, ∀ y ∈ st right, x < y} : + toGame !{st} = !{fun p ↦ toGame '' st p} := by + change toGame (@mk _ (_)) = _ + simp_rw [toGame_mk, Game.mk_ofSets', Set.image_image, gameMk_out] + +@[simp] +theorem toGame_ofSets (s t : Set Surreal.{u}) [Small.{u} s] [Small.{u} t] + {H : ∀ x ∈ s, ∀ y ∈ t, x < y} : + toGame !{s | t} = !{toGame '' s | toGame '' t} := by + rw [toGame_ofSets'] + congr; aesop + +theorem mk_ofSets' {st : Player → Set IGame.{u}} + [Small.{u} (st left)] [Small.{u} (st right)] {H : Numeric !{st}} : + mk !{st} = + !{fun p ↦ .range fun x : st p ↦ mk x (h := H.of_mem_moves (p := p) (by simp))}' + (by have := @H.left_lt_right; aesop) := by + change _ = @mk _ (_) + simp_rw [← toGame_inj, toGame_mk, Game.mk_ofSets'] + congr; aesop + +theorem mk_ofSets {s t : Set IGame.{u}} [Small.{u} s] [Small.{u} t] {H : Numeric !{s | t}} : + mk !{s | t} = + !{.range fun x : s ↦ mk x (h := H.of_mem_moves (p := left) (by simp)) | + .range fun x : t ↦ mk x (h := H.of_mem_moves (p := right) (by simp))}' + (by have := @H.left_lt_right; aesop) := by + rw [mk_ofSets'] + congr!; aesop + +@[aesop apply unsafe] +theorem lt_ofSets_of_mem_left {s t : Set Surreal.{u}} [Small.{u} s] [Small.{u} t] + {H : ∀ x ∈ s, ∀ y ∈ t, x < y} {x : Surreal} (hx : x ∈ s) : + x < !{s | t} := by + rw [lt_iff_not_ge, ← toGame_le_iff, toGame_ofSets] + exact Game.lf_ofSets_of_mem_left (Set.mem_image_of_mem _ hx) + +@[aesop apply unsafe] +theorem ofSets_lt_of_mem_right {s t : Set Surreal.{u}} [Small.{u} s] [Small.{u} t] + {H : ∀ x ∈ s, ∀ y ∈ t, x < y} {x : Surreal} (hx : x ∈ t) : + !{s | t} < x := by + rw [lt_iff_not_ge, ← toGame_le_iff, toGame_ofSets] + exact Game.ofSets_lf_of_mem_right (Set.mem_image_of_mem _ hx) + +theorem zero_def : (0 : Surreal) = !{fun _ ↦ ∅} := by apply (mk_ofSets' ..).trans; congr!; simp +theorem one_def : (1 : Surreal) = !{{0} | ∅} := by apply (mk_ofSets ..).trans; congr! <;> aesop + +instance : DenselyOrdered Surreal where + dense a b hab := ⟨!{{a} | {b}}, + lt_ofSets_of_mem_left (Set.mem_singleton a), ofSets_lt_of_mem_right (Set.mem_singleton b)⟩ + +end Surreal +end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Birthday.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Birthday.lean new file mode 100644 index 0000000000..652bcfe4f9 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Birthday.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Birthday.Basic + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Birthday/Basic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Birthday/Basic.lean new file mode 100644 index 0000000000..337515b694 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Birthday/Basic.lean @@ -0,0 +1,156 @@ +/- +Copyright (c) 2025 Aaron Liu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aaron Liu +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Birthday +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Ordinal + +import Mathlib.Algebra.Order.Group.OrderIso + +/-! +# Birthday of a surreal number + +TODO: write a better docstring +-/ + +universe u + +public noncomputable section + +namespace Surreal +open IGame NatOrdinal Order Set + +/-- The birthday of a surreal number is defined as the least birthday +among all *numeric* pre-games that define it. + +The numeric condition can be removed, see `Surreal.birthday_toGame`. -/ +def birthday (x : Surreal.{u}) : NatOrdinal.{u} := + sInf (IGame.birthday '' {c | ∃ _ : Numeric c, mk c = x}) + +theorem birthday_eq_iGameBirthday (x : Surreal) : + ∃ (y : IGame) (_ : Numeric y), mk y = x ∧ y.birthday = birthday x := by + simp_rw [exists_and_right] + refine csInf_mem (image_nonempty.2 ?_) + exact ⟨_, _, x.out_eq⟩ + +theorem birthday_mk_le (x : IGame) [Numeric x] : birthday (mk x) ≤ x.birthday := + csInf_le' ⟨x, ⟨_, rfl⟩, rfl⟩ + +@[simp] +theorem birthday_zero : birthday 0 = 0 := by + simpa using birthday_mk_le 0 + +@[simp] +theorem birthday_eq_zero {x : Surreal} : birthday x = 0 ↔ x = 0 := by + obtain ⟨_, _, _, _⟩ := birthday_eq_iGameBirthday x + refine ⟨fun _ ↦ ?_, ?_⟩ <;> simp_all + +private theorem birthday_neg_le (x : Surreal) : (-x).birthday ≤ x.birthday := by + obtain ⟨y, _, rfl, hy⟩ := birthday_eq_iGameBirthday x + rw [← hy, ← IGame.birthday_neg] + exact birthday_mk_le _ + +@[simp] +theorem birthday_neg (x : Surreal) : (-x).birthday = x.birthday := by + apply (birthday_neg_le x).antisymm + simpa using birthday_neg_le (-x) + +theorem le_toSurreal_birthday (x : Surreal) : x ≤ x.birthday.toSurreal := by + obtain ⟨y, _, rfl, hy⟩ := birthday_eq_iGameBirthday x + rw [← hy] + exact y.le_toIGame_birthday + +theorem neg_toSurreal_birthday_le (x : Surreal) : -x.birthday.toSurreal ≤ x := by + simpa [neg_le] using le_toSurreal_birthday (-x) + +@[simp] +theorem birthday_toSurreal (o : NatOrdinal) : birthday o.toSurreal = o := by + apply le_antisymm + · simpa using birthday_mk_le o.toIGame + · simpa using o.toSurreal.le_toSurreal_birthday + +@[simp, norm_cast] +theorem birthday_natCast (n : ℕ) : birthday n = n := by + simpa using birthday_toSurreal n + +@[simp] +theorem birthday_ofNat (n : ℕ) [n.AtLeastTwo] : birthday ofNat(n) = n := + birthday_natCast n + +@[simp] +theorem birthday_one : birthday 1 = 1 := by + simpa using birthday_natCast 1 + +theorem birthday_ofSets_le {s t : Set Surreal.{u}} + [Small.{u} s] [Small.{u} t] {H : ∀ x ∈ s, ∀ y ∈ t, x < y} : + !{s | t}.birthday ≤ max (sSup (succ ∘ birthday '' s)) (sSup (succ ∘ birthday '' t)) := by + choose f hf using birthday_eq_iGameBirthday + have : Numeric !{f '' s | f '' t} := by + rw [numeric_def] + simp_rw [moves_ofSets] + refine ⟨?_, ?_⟩ + · rintro _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ + obtain ⟨a, hx', _⟩ := hf x + obtain ⟨b, hy', _⟩ := hf y + rw [← mk_lt_mk, hx', hy'] + exact H x hx y hy + rintro (_ | _) _ ⟨y, hy, rfl⟩ + all_goals + obtain ⟨hy, _, _⟩ := hf y + exact hy + have : !{s | t} = mk !{f '' s | f '' t} := by + rw [← toGame_inj, toGame_ofSets, toGame_mk, Game.mk_ofSets] + simp_rw [image_image] + congr! with a ha a ha + all_goals + · obtain ⟨_, ha', _⟩ := hf a + rw [← toGame_mk, toGame_inj, ha'] + rw [this] + apply (birthday_mk_le _).trans + simp_rw [IGame.birthday_ofSets, image_comp] + congr! <;> aesop + +theorem birthday_add_le (x y : Surreal) : (x + y).birthday ≤ x.birthday + y.birthday := by + obtain ⟨a, _, ha, ha'⟩ := birthday_eq_iGameBirthday x + obtain ⟨b, _, hb, hb'⟩ := birthday_eq_iGameBirthday y + rw [← ha', ← hb', ← ha, ← hb, ← IGame.birthday_add] + exact birthday_mk_le _ + +theorem birthday_sub_le (x y : Surreal) : (x - y).birthday ≤ x.birthday + y.birthday := by + simpa [sub_eq_add_neg] using birthday_add_le x (-y) + +/- This is currently an open problem, see https://mathoverflow.net/a/476829/147705. -/ +proof_wanted birthday_mul_le (x y : Surreal) : (x * y).birthday ≤ x.birthday * y.birthday + +/-- The birthday of a surreal number is at least the birthday of the corresponding game. -/ +theorem birthday_toGame_le (x : Surreal) : x.toGame.birthday ≤ x.birthday := by + obtain ⟨c, _, rfl, h⟩ := birthday_eq_iGameBirthday x + rw [← h, toGame_mk] + exact Game.birthday_mk_le c + +/-- Surreals with a bounded birthday form a small set. -/ +instance small_setOf_birthday_le (o : NatOrdinal.{u}) : Small.{u} {x | birthday x ≤ o} := by + have h₁ : {x | birthday x ≤ o} ⊆ toGame ⁻¹' {x | x.birthday ≤ o} := by + intro x hx + exact x.birthday_toGame_le.trans hx + have h₂ := Set.restrictPreimage_injective {x | x.birthday ≤ o} toGame.injective + have : Small.{u} (toGame ⁻¹' {x | x.birthday ≤ o}) := small_of_injective h₂ + exact small_subset h₁ + +/-- Surreals with a bounded birthday form a small set. -/ +instance small_setOf_birthday_lt (o : NatOrdinal.{u}) : Small.{u} {x | birthday x < o} := by + refine small_subset (?_ : {x : Surreal | x.birthday < o} ⊆ {x : Surreal | x.birthday ≤ o}) + simp +contextual [le_of_lt] + +/-- A variant of `small_setOf_birthday_le` in simp-normal form -/ +instance small_subtype_birthday_le (o : NatOrdinal.{u}) : Small.{u} {x // birthday x ≤ o} := + small_setOf_birthday_le o + +/-- A variant of `small_setOf_birthday_lt` in simp-normal form -/ +instance small_subtype_birthday_lt (o : NatOrdinal.{u}) : Small.{u} {x // birthday x < o} := + small_setOf_birthday_lt o + +end Surreal diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Division.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Division.lean new file mode 100644 index 0000000000..e275840273 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Division.lean @@ -0,0 +1,530 @@ +/- +Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios, Theodore Hwa +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Multiplication +public import Mathlib.Algebra.Field.Defs +public import Mathlib.Algebra.Order.Ring.Unbundled.Rat + +import Mathlib.Algebra.Order.Field.Basic +import Mathlib.Data.Rat.Cast.Order +import Mathlib.Tactic.Abel +import Mathlib.Tactic.Ring + +/-! +# Surreal division + +In this file, we prove that if `x` is a positive numeric game, then `x⁻¹` (defined in +`Mathlib.SetTheory.Game.IGame`) is a number and is a multiplicative inverse for `x`. We use that +to define the field structure on `Surreal`. + +This is Theorem 1.10 in ONAG, and we follow the broad strokes of the proof. We prove +by simultaneous induction that if `x` is positive and numeric, then (ii) `x⁻¹` is numeric, and (iv) +`x * x⁻¹ ≈ 1`. We do this by showing the inductive hypothesis implies that (i) `x * y < 1` for +`y ∈ x⁻¹ᴸ` and `1 < x * y` for `y ∈ x⁻¹ᴿ`, and that (iv) `y < 1` for +`y ∈ (x * x⁻¹)ᴸ` and `1 < y` for `y ∈ (x * x⁻¹ᴿ)`. + +An important difference is that Conway assumes that `x` has no negative left options, while we don't +make use of this assumption. This is because our definition of the inverse is tweaked to ensure that +only positive left options of `x` generate the options for `x⁻¹`. To make sure the induction checks +out, we require two small extra arithmetic lemmas `mulOption_le` and `le_mulOption`. + +Once we have defined the inverse for positive `x`, it is extended in the obvious way to negative +numbers. +-/ + +universe u + +open IGame + +instance {x y : IGame} [Numeric x] [Numeric y⁻¹] : Numeric (x / y) := .mul .. + +instance {x y a : IGame} [Numeric x] [Numeric y] [Numeric y⁻¹] [Numeric a] : + Numeric (invOption x y a) := + .mul .. + +theorem inv_pos' {x : IGame} [Numeric x⁻¹] (hx : 0 < x) : 0 < x⁻¹ := + Numeric.left_lt (zero_mem_leftMoves_inv hx) + +theorem mk_div' (x y : IGame) [Numeric x] [Numeric y⁻¹] : + Surreal.mk (x / y) = Surreal.mk x * Surreal.mk y⁻¹ := + rfl + +/-! ### Arithmetic lemmas -/ + +lemma one_neg_mul_invOption (x : IGame) {y : IGame} (hy : y * y⁻¹ ≈ 1) (a : IGame) + [Numeric x] [Numeric y] [Numeric y⁻¹] [Numeric a] : + 1 - x * invOption x y a ≈ (1 - x * a) * (y - x) / y := by + rw [← Surreal.mk_eq_mk] at * + dsimp [invOption, mk_div'] at * + simp only [one_mul, sub_eq_add_neg, add_mul, hy] + ring + +lemma mulOption_self_inv (x : IGame) {y : IGame} (hy : y * y⁻¹ ≈ 1) (a : IGame) + [Numeric x] [Numeric x⁻¹] [Numeric y] [Numeric y⁻¹] [Numeric a] : + mulOption x x⁻¹ y a ≈ 1 + (x⁻¹ - invOption x y a) * y := by + rw [mul_comm] at hy + rw [← Surreal.mk_eq_mk] at * + dsimp [mulOption, invOption, mk_div'] at * + simp only [sub_eq_add_neg, add_mul, neg_mul, mul_assoc, hy] + ring + +lemma mulOption_le (x y : IGame) {a b : IGame} [Numeric y] [Numeric a] [Numeric b] + (ha : a ≤ 0) (hb : b ≤ y) : mulOption x y a b ≤ x * b := by + rw [mulOption, ← Game.mk_le_mk] + dsimp + have : Game.mk (a * y) - Game.mk (a * b) ≤ 0 := by + rw [← Game.mk_mul_sub] + apply Numeric.mul_nonpos_of_nonpos_of_nonneg ha + rwa [IGame.sub_nonneg] + rw [← add_le_add_iff_left (Game.mk (x * b))] at this + convert this using 1 <;> abel + +theorem le_mulOption (x y : IGame) {a b : IGame} [Numeric y] [Numeric a] [Numeric b] + (ha : a ≤ 0) (hb : y ≤ b) : x * b ≤ mulOption x y a b := by + rw [mulOption, ← Game.mk_le_mk] + dsimp + have : 0 ≤ Game.mk (a * y) - Game.mk (a * b) := by + rw [← Game.mk_mul_sub] + apply Numeric.mul_nonneg_of_nonpos_of_nonpos ha + rwa [IGame.sub_nonpos] + rw [← add_le_add_iff_left (Game.mk (x * b))] at this + convert this using 1 <;> abel + +/-! ### Inductive proof -/ + +lemma numeric_option_inv {x : IGame} [Numeric x] (hx : 0 < x) + (hl : ∀ y ∈ xᴸ, 0 < y → Numeric y⁻¹) (hr : ∀ y ∈ xᴿ, Numeric y⁻¹) : + (∀ p, ∀ y ∈ x⁻¹.moves p, Numeric y) := by + refine invRec hx Numeric.zero fun p₁ p₂ y hy hyx _ _ _ ↦ ?_ + numeric + cases p₁ <;> cases p₂ + all_goals + first + | have := hl _ hyx hy + | have := hr _ hyx + infer_instance + +lemma mul_inv_option_mem {x : IGame} [Numeric x] (hx : 0 < x) + (hl : ∀ y ∈ xᴸ, 0 < y → Numeric y⁻¹) (hr : ∀ y ∈ xᴿ, Numeric y⁻¹) + (hl' : ∀ y ∈ xᴸ, 0 < y → y * y⁻¹ ≈ 1) (hr' : ∀ y ∈ xᴿ, y * y⁻¹ ≈ 1) : + (∀ y ∈ x⁻¹ᴸ, x * y < 1) ∧ (∀ y ∈ x⁻¹ᴿ, 1 < x * y) := by + suffices ∀ p y, y ∈ x⁻¹.moves p → p.cases (x * y < 1) (1 < x * y) by + exact ⟨this left, this right⟩ + apply invRec (P := fun p y hy ↦ p.cases (x * y < 1) (1 < x * y)) hx + · simp + rintro (_ | _) (_ | _) y hy hyx a ha h <;> dsimp + · numeric + have := hr y hyx + have := numeric_option_inv hx hl hr left a ha + rw [← IGame.sub_pos] + grw [one_neg_mul_invOption x (hr' y hyx) a] + apply Numeric.mul_pos (Numeric.mul_pos _ _) (inv_pos' hy) + · rwa [IGame.sub_pos] + · rw [IGame.sub_pos] + exact Numeric.lt_right hyx + · numeric + have := hl y hyx hy + have := numeric_option_inv hx hl hr left a ha + rw [← IGame.sub_neg] + grw [one_neg_mul_invOption x (hl' y hyx hy) a] + apply Numeric.mul_neg_of_neg_of_pos (Numeric.mul_neg_of_pos_of_neg _ _) (inv_pos' hy) + · rwa [IGame.sub_pos] + · rw [IGame.sub_neg] + exact Numeric.left_lt hyx + · numeric + have := hl y hyx hy + have := numeric_option_inv hx hl hr right a ha + rw [← IGame.sub_pos] + grw [one_neg_mul_invOption x (hl' y hyx hy) a] + apply Numeric.mul_pos (Numeric.mul_pos_of_neg_of_neg _ _) (inv_pos' hy) + · rwa [IGame.sub_neg] + · rw [IGame.sub_neg] + exact Numeric.left_lt hyx + · numeric + have := hr y hyx + have := numeric_option_inv hx hl hr right a ha + rw [← IGame.sub_neg] + grw [one_neg_mul_invOption x (hr' y hyx) a] + apply Numeric.mul_neg_of_neg_of_pos (Numeric.mul_neg_of_neg_of_pos _ _) (inv_pos' hy) + · rwa [IGame.sub_neg] + · rw [IGame.sub_pos] + exact Numeric.lt_right hyx + +lemma numeric_inv {x : IGame} [Numeric x] (hx : 0 < x) + (hl : ∀ y ∈ xᴸ, 0 < y → Numeric y⁻¹) (hr : ∀ y ∈ xᴿ, Numeric y⁻¹) + (hl' : ∀ y ∈ xᴸ, 0 < y → y * y⁻¹ ≈ 1) (hr' : ∀ y ∈ xᴿ, y * y⁻¹ ≈ 1) : + Numeric x⁻¹ := by + obtain ⟨Hl, Hr⟩ := mul_inv_option_mem hx hl hr hl' hr' + have H' := numeric_option_inv hx hl hr + refine Numeric.mk (fun y hy z hz ↦ ?_) H' + have := H' _ y hy + have := H' _ z hz + exact (Numeric.mul_lt_mul_iff_right hx).1 <| (Hl y hy).trans (Hr z hz) + +lemma option_mul_inv_lt {x : IGame} [Numeric x] (hx : 0 < x) + (hl : ∀ y ∈ xᴸ, 0 < y → Numeric y⁻¹) (hr : ∀ y ∈ xᴿ, Numeric y⁻¹) + (hl' : ∀ y ∈ xᴸ, 0 < y → y * y⁻¹ ≈ 1) (hr' : ∀ y ∈ xᴿ, y * y⁻¹ ≈ 1) : + (∀ y ∈ (x * x⁻¹)ᴸ, y < 1) ∧ (∀ y ∈ (x * x⁻¹)ᴿ, 1 < y) := by + have := numeric_inv hx hl hr hl' hr' + obtain H := numeric_option_inv hx hl hr + rw [forall_moves_mul, forall_moves_mul] + refine ⟨?_, ?_⟩ <;> rintro (_ | _) + all_goals + intro y hyx a ha + numeric + have := H _ a ha + try (have := hr y hyx; have hy := hx.trans (Numeric.lt_right hyx)) + · obtain hy | hy := Numeric.lt_or_ge 0 y + · have := hl y hyx hy + grw [mulOption_self_inv x (hl' y hyx hy) a] + rw [add_comm, ← IGame.lt_sub_iff_add_lt] + grw [IGame.sub_self_equiv] + apply Numeric.mul_neg_of_neg_of_pos _ hy + rw [IGame.sub_neg] + exact Numeric.lt_right (invOption_mem_moves_inv (p₁ := left) hx hy hyx ha) + · apply (mulOption_le _ _ hy (Numeric.left_lt ha).le).trans_lt + exact (mul_inv_option_mem hx hl hr hl' hr').1 a ha + · grw [mulOption_self_inv x (hr' y hyx) a] + rw [add_comm, ← IGame.lt_sub_iff_add_lt] + grw [IGame.sub_self_equiv] + apply Numeric.mul_neg_of_neg_of_pos _ hy + rw [IGame.sub_neg] + exact Numeric.lt_right (invOption_mem_moves_inv (p₁ := right) hx hy hyx ha) + · obtain hy | hy := Numeric.lt_or_ge 0 y + · have := hl y hyx hy + grw [mulOption_self_inv x (hl' y hyx hy) a] + rw [add_comm, ← IGame.sub_lt_iff_lt_add] + grw [IGame.sub_self_equiv] + apply Numeric.mul_pos _ hy + rw [IGame.sub_pos] + apply Numeric.left_lt (invOption_mem_moves_inv (p₁ := right) hx hy hyx ha) + · apply ((mul_inv_option_mem hx hl hr hl' hr').2 a ha).trans_le + exact le_mulOption _ _ hy (Numeric.lt_right ha).le + · grw [mulOption_self_inv x (hr' y hyx) a] + rw [add_comm, ← IGame.sub_lt_iff_lt_add] + grw [IGame.sub_self_equiv] + apply Numeric.mul_pos _ hy + rw [IGame.sub_pos] + exact Numeric.left_lt (invOption_mem_moves_inv (p₁ := left) hx hy hyx ha) + +lemma mul_inv_self {x : IGame} [Numeric x] (hx : 0 < x) + (hl : ∀ y ∈ xᴸ, 0 < y → Numeric y⁻¹) (hr : ∀ y ∈ xᴿ, Numeric y⁻¹) + (hl' : ∀ y ∈ xᴸ, 0 < y → y * y⁻¹ ≈ 1) (hr' : ∀ y ∈ xᴿ, y * y⁻¹ ≈ 1) : + x * x⁻¹ ≈ 1 := by + obtain ⟨Hl, Hr⟩ := option_mul_inv_lt hx hl hr hl' hr' + have := numeric_inv hx hl hr hl' hr' + apply equiv_one_of_fits ⟨fun z hz ↦ (Hl z hz).not_ge, fun z hz ↦ (Hr z hz).not_ge⟩ + rw [Numeric.mul_equiv_zero, not_or] + exact ⟨hx.not_antisymmRel_symm, (inv_pos' hx).not_antisymmRel_symm⟩ + +theorem main {x : IGame} [Numeric x] (hx : 0 < x) : Numeric x⁻¹ ∧ x * x⁻¹ ≈ 1 := by + have IHl : ∀ y ∈ xᴸ, 0 < y → Numeric y⁻¹ ∧ y * y⁻¹ ≈ 1 := + fun y hy hy' ↦ have := Numeric.of_mem_moves hy; main hy' + have IHr : ∀ y ∈ xᴿ, Numeric y⁻¹ ∧ y * y⁻¹ ≈ 1 := + fun y hy ↦ have := Numeric.of_mem_moves hy; main (hx.trans (Numeric.lt_right hy)) + have hl := fun y hy hy' ↦ (IHl y hy hy').1 + have hr := fun y hy ↦ (IHr y hy).1 + have hl' := fun y hy hy' ↦ (IHl y hy hy').2 + have hr' := fun y hy ↦ (IHr y hy).2 + exact ⟨numeric_inv hx hl hr hl' hr', mul_inv_self hx hl hr hl' hr'⟩ +termination_by x +decreasing_by igame_wf + +/-! ### Instances and corollaries -/ + +public section + +namespace IGame.Numeric + +protected instance inv (x : IGame) [Numeric x] : Numeric x⁻¹ := by + obtain h | h | h := Numeric.lt_or_equiv_or_gt x 0 + · rw [← IGame.zero_lt_neg] at h + simpa using (main h).1 + · simp [inv_of_equiv_zero h] + · exact (main h).1 + +protected instance div (x y : IGame) [Numeric x] [Numeric y] : Numeric (x / y) := .mul .. +protected instance ratCast (q : ℚ) : Numeric q := .div .. + +protected instance invOption (x y a : IGame) [Numeric x] [Numeric y] [Numeric a] : + Numeric (invOption x y a) := + .div .. + +protected theorem mul_inv_cancel {x : IGame} [Numeric x] (hx : ¬ x ≈ 0) : x * x⁻¹ ≈ 1 := by + obtain h | h | h := Numeric.lt_or_equiv_or_gt x 0 + · rw [← IGame.zero_lt_neg] at h + simpa using (main h).2 + · contradiction + · exact (main h).2 + +protected theorem inv_mul_cancel {x : IGame} [Numeric x] (hx : ¬ x ≈ 0) : x⁻¹ * x ≈ 1 := by + rw [mul_comm] + exact Numeric.mul_inv_cancel hx + +theorem inv_congr {x y : IGame} [Numeric x] [Numeric y] (he : x ≈ y) : x⁻¹ ≈ y⁻¹ := by + by_cases hy : y ≈ 0 + · rw [inv_of_equiv_zero hy, inv_of_equiv_zero (he.trans hy)] + · have hx := (hy <| he.symm.trans ·) + have := (Numeric.mul_inv_cancel hx).trans (Numeric.mul_inv_cancel hy).symm + rw [← (Numeric.mul_congr_left he).antisymmRel_congr_right] at this + exact Numeric.mul_left_cancel hx this + +theorem div_congr_left {x₁ x₂ y : IGame} [Numeric x₁] [Numeric x₂] [Numeric y] (he : x₁ ≈ x₂) : + x₁ / y ≈ x₂ / y := + mul_congr_left he + +theorem div_congr_right {x y₁ y₂ : IGame} [Numeric x] [Numeric y₁] [Numeric y₂] (he : y₁ ≈ y₂) : + x / y₁ ≈ x / y₂ := + mul_congr_right (inv_congr he) + +theorem div_congr {x₁ x₂ y₁ y₂ : IGame} [Numeric x₁] [Numeric x₂] [Numeric y₁] [Numeric y₂] + (hx : x₁ ≈ x₂) (hy : y₁ ≈ y₂) : x₁ / y₁ ≈ x₂ / y₂ := + (div_congr_left hx).trans (div_congr_right hy) + +end IGame.Numeric + +namespace Surreal + +noncomputable instance : Field Surreal where + inv := Quotient.map (fun x ↦ ⟨x⁻¹, by infer_instance⟩) fun _ _ ↦ Numeric.inv_congr + mul_inv_cancel := by rintro ⟨a⟩ h; exact mk_eq (Numeric.mul_inv_cancel (mk_eq_mk.not.1 h)) + inv_zero := by change mk 0⁻¹ = _; simp + qsmul := _ + nnqsmul := _ + +@[simp] theorem mk_inv (x : IGame) [Numeric x] : mk x⁻¹ = (mk x)⁻¹ := rfl +@[simp] theorem mk_div (x y : IGame) [Numeric x] [Numeric y] : mk (x / y) = mk x / mk y := rfl + +@[simp] +theorem mk_ratCast (q : ℚ) : mk q = q := by + conv_rhs => rw [← q.num_div_den] + simp [ratCast_def] + +@[simp] +theorem toGame_ratCast (q : ℚ) : toGame q = q := by + rw [← mk_ratCast, toGame_mk, Game.mk_ratCast] + +end Surreal + +namespace IGame +namespace Numeric + +@[simp] +protected theorem inv_pos {x : IGame} [Numeric x] : 0 < x⁻¹ ↔ 0 < x := by + simp [← Surreal.mk_lt_mk] + +@[simp] +protected theorem inv_neg {x : IGame} [Numeric x] : x⁻¹ < 0 ↔ x < 0 := by + simp [← Surreal.mk_lt_mk] + +@[simp] +protected theorem inv_nonneg {x : IGame} [Numeric x] : 0 ≤ x⁻¹ ↔ 0 ≤ x := by + simp [← Surreal.mk_le_mk] + +@[simp] +protected theorem inv_nonpos {x : IGame} [Numeric x] : x⁻¹ ≤ 0 ↔ x ≤ 0 := by + simp [← Surreal.mk_le_mk] + +theorem inv_equiv_of_mul_eq_one {x y : IGame} [Numeric x] [Numeric y] + (he : x * y ≈ 1) : x⁻¹ ≈ y := by + rw [← Surreal.mk_eq_mk] at * + exact inv_eq_of_mul_eq_one_right (a := Surreal.mk x) he + +theorem equiv_inv_of_mul_eq_one {x y : IGame} [Numeric x] [Numeric y] + (he : x * y ≈ 1) : x ≈ y⁻¹ := + (Numeric.inv_equiv_of_mul_eq_one (mul_comm x y ▸ he)).symm + +protected theorem lt_div_iff {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] (hz : 0 < z) : + x < y / z ↔ x * z < y := by + simp_all [← Surreal.mk_lt_mk, lt_div_iff₀] + +protected theorem lt_div_iff' {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] (hz : 0 < z) : + x < y / z ↔ z * x < y := by + simp_all [← Surreal.mk_lt_mk, lt_div_iff₀'] + +protected theorem div_lt_iff {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] (hy : 0 < y) : + x / y < z ↔ x < z * y := by + simp_all [← Surreal.mk_lt_mk, div_lt_iff₀] + +protected theorem div_lt_iff' {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] (hz : 0 < y) : + x / y < z ↔ x < y * z := by + simp_all [← Surreal.mk_lt_mk, div_lt_iff₀'] + +protected theorem lt_div_iff_of_neg {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hz : z < 0) : x < y / z ↔ y < x * z := by + simp_all [← Surreal.mk_lt_mk, lt_div_iff_of_neg] + +protected theorem div_lt_iff_of_neg {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hy : y < 0) : x / y < z ↔ z * y < x := by + simp_all [← Surreal.mk_lt_mk, div_lt_iff_of_neg] + +end Numeric + +@[simp, norm_cast] +theorem ratCast_le {m n : ℚ} : (m : IGame) ≤ n ↔ m ≤ n := by + simp [← Surreal.mk_le_mk] + +@[simp, norm_cast] +theorem ratCast_lt {m n : ℚ} : (m : IGame) < n ↔ m < n := by + simp [← Surreal.mk_lt_mk] + +theorem ratCast_strictMono : StrictMono ((↑) : ℚ → IGame) := + fun _ _ h ↦ ratCast_lt.2 h + +@[simp, norm_cast] +theorem ratCast_inj {m n : ℚ} : (m : IGame) = n ↔ m = n := + ratCast_strictMono.injective.eq_iff + +@[simp, norm_cast] +theorem ratCast_equiv {m n : ℚ} : (m : IGame) ≈ n ↔ m = n := by + simp [AntisymmRel, le_antisymm_iff] + +theorem ratCast_natCast_equiv (n : ℕ) : ((n : ℚ) : IGame) ≈ n := by + simp [← Surreal.mk_eq_mk] + +theorem ratCast_intCast_equiv (n : ℤ) : ((n : ℚ) : IGame) ≈ n := by + simp [← Surreal.mk_eq_mk] + +theorem ratCast_add_equiv (m n : ℚ) : ((m + n : ℚ) : IGame) ≈ m + n := by + simp [← Surreal.mk_eq_mk] + +theorem ratCast_sub_equiv (m n : ℚ) : ((m - n : ℚ) : IGame) ≈ m - n := by + simp [← Surreal.mk_eq_mk] + +theorem ratCast_mul_equiv (m n : ℚ) : ((m * n : ℚ) : IGame) ≈ m * n := by + simp [← Surreal.mk_eq_mk] + +theorem ratCast_inv_equiv (m : ℚ) : ((m⁻¹ : ℚ) : IGame) ≈ m⁻¹ := by + simp [← Surreal.mk_eq_mk] + +theorem ratCast_div_equiv (m n : ℚ) : ((m / n : ℚ) : IGame) ≈ m / n := by + simp [← Surreal.mk_eq_mk] + +@[simp, norm_cast] +theorem zero_lt_ratCast {q : ℚ} : 0 < (q : IGame) ↔ 0 < q := by + simpa using ratCast_lt (m := 0) + +@[simp, norm_cast] +theorem ratCast_lt_zero {q : ℚ} : (q : IGame) < 0 ↔ q < 0 := by + simpa using ratCast_lt (n := 0) + +@[simp, norm_cast] +theorem zero_le_ratCast {q : ℚ} : 0 ≤ (q : IGame) ↔ 0 ≤ q := by + simpa using ratCast_le (m := 0) + +@[simp, norm_cast] +theorem ratCast_le_zero {q : ℚ} : (q : IGame) ≤ 0 ↔ q ≤ 0 := by + simpa using ratCast_le (n := 0) + +private theorem equiv_ratCast_of_mem_move_inv_natCast {n : ℕ} : + (∀ p, ∀ x ∈ moves.{u} p n⁻¹, ∃ q : ℚ, x ≈ q) := by + cases n with + | zero => simp + | succ n => + refine invRec (mod_cast n.succ_pos) ⟨0, by simp⟩ ?_ + rintro (_ | _) (_ | _) <;> try (· simp) + all_goals + dsimp + simp_rw [Nat.cast_add, Nat.cast_one, leftMoves_natCast_succ, forall_exists_index] + rintro _ hn rfl x hx q hq + use (1 + -q) / n + numeric + simp_all [invOption, ← Surreal.mk_eq_mk] + +private theorem equiv_ratCast_of_mem_move_ratCast {q : ℚ} : + (∀ x ∈ (q : IGame.{u})ᴸ, ∃ r : ℚ, x ≈ r) ∧ (∀ x ∈ (q : IGame.{u})ᴿ, ∃ r : ℚ, x ≈ r) := by + constructor + all_goals + rw [ratCast_def] + simp only [IGame.div_eq_mul_inv, forall_moves_mul, forall_moves_mul] + obtain ⟨m, n, hn, _⟩ := q + rintro (_ | _) + all_goals + · intro x hx y hy + first | + obtain ⟨k, _, rfl⟩ := eq_intCast_of_mem_leftMoves_intCast hx | + obtain ⟨k, _, rfl⟩ := eq_intCast_of_mem_rightMoves_intCast hx + obtain ⟨q, hq⟩ := equiv_ratCast_of_mem_move_inv_natCast _ _ hy + use k * (n : ℚ)⁻¹ + m * q - k * q + numeric + simp_all [mulOption, ← Surreal.mk_eq_mk] + +/-- Every left option of a rational number is equivalent to a smaller rational number. -/ +theorem equiv_ratCast_of_mem_leftMoves_ratCast {q : ℚ} {x : IGame} (hx : x ∈ qᴸ) : + ∃ r : ℚ, r < q ∧ x ≈ r := by + obtain ⟨r, hr⟩ := equiv_ratCast_of_mem_move_ratCast.1 x hx + refine ⟨r, ?_, hr⟩ + rw [← ratCast_lt] + grw [← hr] + simpa using Numeric.left_lt hx + +/-- Every right option of a rational number is equivalent to a larger rational number. -/ +theorem equiv_ratCast_of_mem_rightMoves_ratCast {q : ℚ} {x : IGame} (hx : x ∈ qᴿ) : + ∃ r : ℚ, q < r ∧ x ≈ r := by + obtain ⟨r, hr⟩ := equiv_ratCast_of_mem_move_ratCast.2 x hx + refine ⟨r, ?_, hr⟩ + rw [← ratCast_lt] + grw [← hr] + simpa using Numeric.lt_right hx + +@[simp] +theorem mk_half : Surreal.mk ½ = 2⁻¹ := by + rw [← mul_left_inj' two_ne_zero, mul_two, inv_mul_cancel₀ two_ne_zero] + exact Surreal.mk_eq half_add_half_equiv_one + +end IGame + +namespace Game + +@[simp, norm_cast] +theorem ratCast_le {m n : ℚ} : (m : Game) ≤ n ↔ m ≤ n := + IGame.ratCast_le + +@[simp, norm_cast] +theorem ratCast_lt {m n : ℚ} : (m : Game) < n ↔ m < n := + IGame.ratCast_lt + +theorem ratCast_strictMono : StrictMono ((↑) : ℚ → Game) := + fun _ _ h ↦ ratCast_lt.2 h + +@[simp, norm_cast] +theorem ratCast_inj {m n : ℚ} : (m : Game) = n ↔ m = n := + ratCast_strictMono.injective.eq_iff + +@[simp, norm_cast] +theorem ratCast_natCast (n : ℕ) : ((n : ℚ) : Game) = n := by + simpa using Game.mk_eq (IGame.ratCast_natCast_equiv n) + +@[simp, norm_cast] +theorem ratCast_intCast (n : ℤ) : ((n : ℚ) : Game) = n := by + simpa using Game.mk_eq (IGame.ratCast_intCast_equiv n) + +@[simp, norm_cast] +theorem ratCast_add (m n : ℚ) : ((m + n : ℚ) : Game) = m + n := + Game.mk_eq (IGame.ratCast_add_equiv m n) + +@[simp, norm_cast] +theorem ratCast_sub (m n : ℚ) : ((m - n : ℚ) : Game) = m - n := + Game.mk_eq (IGame.ratCast_sub_equiv m n) + +@[simp, norm_cast] +theorem zero_lt_ratCast {q : ℚ} : 0 < (q : Game) ↔ 0 < q := + IGame.zero_lt_ratCast + +@[simp, norm_cast] +theorem ratCast_lt_zero {q : ℚ} : (q : Game) < 0 ↔ q < 0 := + IGame.ratCast_lt_zero + +@[simp, norm_cast] +theorem zero_le_ratCast {q : ℚ} : 0 ≤ (q : Game) ↔ 0 ≤ q := + IGame.zero_le_ratCast + +@[simp, norm_cast] +theorem ratCast_le_zero {q : ℚ} : (q : Game) ≤ 0 ↔ q ≤ 0 := + IGame.ratCast_le_zero + +end Game diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Dyadic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Dyadic.lean new file mode 100644 index 0000000000..28f466679e --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Dyadic.lean @@ -0,0 +1,650 @@ +/- +Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Classes +public import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Dyadic +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Division + +import Mathlib.Data.Finset.DenselyOrdered + +/-! +# Dyadic games + +A combinatorial game that is both `Short` and `Numeric` is called dyadic. We show that the dyadic +games are in correspondence with the `Dyadic` rationals, in the sense that there exists a map +`Dyadic.toIGame` such that: + +- `Dyadic.toIGame x` is always a dyadic game. +- For any dyadic game `y`, there exists `x` with `Dyadic.toIGame x ≈ y`. +- The game `Dyadic.toGame x` is equivalent to the `RatCast` of `x`. + +## Future projects + +Since dyadic rationals are easy to do computations with, there are some projects we could pursue in +the future: + +- Define the birthday of a dyadic number computably, prove that `x.birthday = x.toIGame.birthday`. +- Define the simplest dyadic number between two others computably, use that to define + `IGame.toDyadic`. +-/ + +universe u +open IGame + +@[expose] public section + +namespace Dyadic + +/-! ### Upper and lower dyadic fractions -/ + +/-- For a dyadic number `m / n`, returns `(m - 1) / n`. -/ +def lower (x : Dyadic) : Dyadic := + .mkRat (x.num - 1) x.den_mem_powers + +/-- For a dyadic number `m / n`, returns `(m + 1) / n`. -/ +def upper (x : Dyadic) : Dyadic := + .mkRat (x.num + 1) x.den_mem_powers + +theorem den_lower_lt {x : Dyadic} (h : x.den ≠ 1) : (lower x).den < x.den := by + rw [den, lower, coe_mkRat] + exact den_mkRat_lt ((odd_num h).sub_odd odd_one).two_dvd h + +theorem den_upper_lt {x : Dyadic} (h : x.den ≠ 1) : (upper x).den < x.den := by + rw [den, upper, coe_mkRat] + exact den_mkRat_lt ((odd_num h).add_odd odd_one).two_dvd h + +/-- An auxiliary tactic for inducting on the denominator of a `Dyadic`. -/ +macro "dyadic_wf" : tactic => + `(tactic| all_goals first | solve_by_elim + [Prod.Lex.left, Prod.Lex.right, den_lower_lt, den_upper_lt] | decreasing_tactic) + +@[simp] +theorem lower_neg (x : Dyadic) : lower (-x) = -upper x := by + unfold lower upper + ext + simp [Rat.neg_mkRat, ← sub_eq_neg_add] + +@[simp] +theorem upper_neg (x : Dyadic) : upper (-x) = -lower x := by + unfold lower upper + ext + simp [Rat.neg_mkRat, ← sub_eq_neg_add] + +theorem le_lower_of_lt {x y : Dyadic} (hd : x.den ≤ y.den) (h : x < y) : x ≤ y.lower := by + obtain ⟨m, rfl⟩ := eq_mkRat_of_den_le hd y.den_mem_powers + conv_rhs at h => rw [← y.mkRat_self] + rw [mkRat_lt_mkRat] at h + rwa [lower, mkRat_le_mkRat, Int.le_sub_one_iff] + +theorem upper_le_of_lt {x y : Dyadic} (hd : y.den ≤ x.den) (h : x < y) : x.upper ≤ y := by + have hd' : (-y).den ≤ (-x).den := by simpa using hd + simpa using le_lower_of_lt hd' (neg_lt_neg h) + +theorem lower_eq_of_den_eq_one {x : Dyadic} (h : x.den = 1) : lower x = x.num - 1 := by + simp [lower, h] + +theorem upper_eq_of_den_eq_one {x : Dyadic} (h : x.den = 1) : upper x = x.num + 1 := by + simp [upper, h] + +@[simp] +theorem lower_lt (x : Dyadic) : lower x < x := by + conv_rhs => rw [← x.mkRat_self] + rw [lower, mkRat_lt_mkRat] + exact sub_one_lt x.num + +@[simp] +theorem lt_upper (x : Dyadic) : x < upper x := by + simpa using lower_lt (-x) + +theorem lower_lt_upper (x : Dyadic) : lower x < upper x := + (lower_lt x).trans (lt_upper x) + +theorem coe_lower (x : Dyadic) : lower x = x - (x.den : ℚ)⁻¹ := by + simp [lower, Rat.mkRat_eq_div, sub_div, Rat.num_div_den] + +theorem coe_upper (x : Dyadic) : upper x = x + (x.den : ℚ)⁻¹ := by + simp [upper, Rat.mkRat_eq_div, add_div, Rat.num_div_den] + +theorem lower_add_le_of_den_le {x y : Dyadic} (h : x.den ≤ y.den) : + lower (x + y) ≤ x + lower y := by + rw [← Dyadic.coe_le_coe] + suffices (y.den : ℚ)⁻¹ ≤ ((x + y).den : ℚ)⁻¹ by simpa [coe_lower, Rat.add_assoc, sub_eq_add_neg] + rw [inv_le_inv₀ (mod_cast y.den_pos) (mod_cast den_pos _)] + exact_mod_cast den_add_le_den_right h + +theorem lower_add_le_of_den_ge {x y : Dyadic} (h : y.den ≤ x.den) : + lower (x + y) ≤ lower x + y := by + simpa [add_comm] using lower_add_le_of_den_le h + +theorem le_upper_add_of_den_le {x y : Dyadic} (h : x.den ≤ y.den) : + x + upper y ≤ upper (x + y) := by + simpa only [← neg_add, lower_neg, neg_le_neg_iff] using + @lower_add_le_of_den_le (-x) (-y) (by simpa using h) + +theorem le_upper_add_of_den_ge {x y : Dyadic} (h : y.den ≤ x.den) : + upper x + y ≤ upper (x + y) := by + simpa [add_comm] using le_upper_add_of_den_le h + +/-! ### Dyadic numbers to games -/ + +/-- Converts a dyadic rational into an `IGame`. This map is defined so that: + +* If `x : ℤ`, then `toIGame x = ↑x`. +* Otherwise, if `x = m / n` with `n` even, then `toIGame x = !{(m - 1) / n | (m + 1) / n}`. Note + that both options will have smaller denominators. -/ +@[coe] +noncomputable def toIGame (x : Dyadic) : IGame := + if _ : x.den = 1 then x.num else !{{toIGame (lower x)} | {toIGame (upper x)}} +termination_by x.den +decreasing_by dyadic_wf + +noncomputable instance : Coe Dyadic IGame := ⟨toIGame⟩ + +theorem toIGame_of_den_eq_one {x : Dyadic} (hx : x.den = 1) : (x : IGame) = x.num := by + rw [toIGame, dif_pos hx] + +@[simp] theorem toIGame_intCast (n : ℤ) : ((n : Dyadic) : IGame) = n := by + simpa using toIGame_of_den_eq_one (Dyadic.den_intCast n) +@[simp] theorem toIGame_natCast (n : ℕ) : ((n : Dyadic) : IGame) = n := toIGame_intCast n + +@[simp] theorem toIGame_zero : ((0 : Dyadic) : IGame) = 0 := toIGame_natCast 0 +@[simp] theorem toIGame_one : ((1 : Dyadic) : IGame) = 1 := by simpa using toIGame_natCast 1 + +theorem toIGame_of_den_ne_one {x : Dyadic} (hx : x.den ≠ 1) : + x = !{{(lower x : IGame)} | {(upper x : IGame)}} := + by rw [toIGame, dif_neg hx] + +@[simp] +theorem toIGame_half : half = ½ := by + rw [toIGame_of_den_ne_one (by decide)] + suffices uh : upper half = 1 by + rw [show lower half = 0 from rfl, uh]; ext p; cases p <;> simp + rw [← Dyadic.coe_inj, upper, Dyadic.coe_mkRat] + rfl + +@[simp] +theorem toIGame_neg (x : Dyadic) : (-x : Dyadic) = -(x : IGame) := by + unfold toIGame + rw [den_neg] + split_ifs with h + · simp + · simpa using ⟨toIGame_neg _, toIGame_neg _⟩ +termination_by x.den +decreasing_by dyadic_wf + +theorem eq_lower_of_mem_leftMoves_toIGame {x : Dyadic} {y : IGame} (h : y ∈ xᴸ) : + y = lower x := by + by_cases hx : x.den = 1 + · rw [toIGame_of_den_eq_one hx] at h + rw [lower_eq_of_den_eq_one hx, eq_sub_one_of_mem_leftMoves_intCast h, + ← Int.cast_one (R := Dyadic), ← Int.cast_sub, toIGame_intCast] + · simpa [toIGame_of_den_ne_one hx] using h + +theorem eq_upper_of_mem_rightMoves_toIGame {x : Dyadic} {y : IGame} (h : y ∈ xᴿ) : + y = upper x := by + have : -y ∈ (-x : Dyadic)ᴸ := by simpa + simpa using eq_lower_of_mem_leftMoves_toIGame this + +/-- A dyadic number `x` is always equivalent to `!{lower x | upper x}`, though this may not +necessarily be the canonical form. -/ +theorem toIGame_equiv_lower_upper (x : Dyadic) : + (x : IGame) ≈ !{{(lower x : IGame)} | {(upper x : IGame)}} := by + rw [toIGame] + split_ifs with h + · unfold lower upper + simp only [h, mkRat_one, toIGame_intCast] + apply Fits.equiv_of_forall_moves + · simp [Fits] + · intro m hm + obtain ⟨m, hm', rfl⟩ := eq_sub_one_of_mem_leftMoves_intCast hm + simp + · intro m hm + obtain ⟨m, hm', rfl⟩ := eq_add_one_of_mem_rightMoves_intCast hm + simp + · rfl + +instance _root_.IGame.Short.dyadic (x : Dyadic) : Short x := by + rw [toIGame] + split_ifs with h + · exact .intCast _ + · rw [short_def] + simpa using ⟨.dyadic _, .dyadic _⟩ +termination_by x.den +decreasing_by dyadic_wf + +private theorem numeric_lower (x : Dyadic) [hx : Numeric (x : IGame.{u})] : + Numeric (lower x : IGame.{u}) := by + by_cases h : x.den = 1 + · rw [lower_eq_of_den_eq_one h, ← Int.cast_one, ← Int.cast_sub, toIGame_intCast] + infer_instance + · apply hx.of_mem_moves (p := left) + simp [toIGame_of_den_ne_one h] + +private theorem numeric_upper (x : Dyadic) [hx : Numeric (x : IGame.{u})] : + Numeric (toIGame.{u} (upper x)) := by + have : Numeric (-x : Dyadic) := by simpa + simpa using numeric_lower (-x) + +private theorem lower_lt_aux (x : Dyadic) [hx : Numeric (x : IGame.{u})] : + (lower x : IGame.{u}) < x := by + by_cases h : x.den = 1 + · rw [lower_eq_of_den_eq_one h, ← Int.cast_one, ← Int.cast_sub, toIGame_intCast, + toIGame_of_den_eq_one h] + simp + · apply hx.left_lt + simp [toIGame_of_den_ne_one h] + +private theorem lt_upper_aux (x : Dyadic) [hx : Numeric (x : IGame.{u})] : + x < (upper x : IGame.{u}) := by + have : Numeric (-x : Dyadic) := by simpa + simpa using lower_lt_aux (-x) + +private theorem toIGame_lt_toIGame_aux {x y : Dyadic} + [Numeric (x : IGame.{u})] [Numeric (toIGame.{u} y)] (h : x < y) : (x : IGame.{u}) < y := by + by_cases H : x.den = 1 ∧ y.den = 1 + · rwa [toIGame_of_den_eq_one H.1, toIGame_of_den_eq_one H.2, intCast_lt, + ← Int.cast_lt (R := Dyadic), intCast_num_eq_self_of_den_eq_one H.1, + intCast_num_eq_self_of_den_eq_one H.2] + · obtain hd | hd := le_total x.den y.den + · have := numeric_lower y + have hy := lower_lt_aux y + by_cases hy' : y.den = 1 + · rw [hy', den_le_one_iff_eq_one] at hd + exact (H ⟨hd, hy'⟩).elim + · exact (le_of_le_of_lt_of_lt toIGame_lt_toIGame_aux (le_lower_of_lt hd h)).trans_lt hy + · have := numeric_upper x + have hx := lt_upper_aux x + by_cases hx' : x.den = 1 + · rw [hx', den_le_one_iff_eq_one] at hd + exact (H ⟨hx', hd⟩).elim + · exact hx.trans_le (le_of_le_of_lt_of_lt toIGame_lt_toIGame_aux (upper_le_of_lt hd h)) +termination_by (x.den, y.den) +decreasing_by dyadic_wf + +instance _root_.IGame.Numeric.dyadic (x : Dyadic) : Numeric x := by + by_cases h : x.den = 1 + · rw [toIGame_of_den_eq_one h] + infer_instance + · rw [numeric_def, toIGame_of_den_ne_one h] + have := IGame.Numeric.dyadic (lower x) + have := IGame.Numeric.dyadic (upper x) + have := toIGame_lt_toIGame_aux (lower_lt_upper x) + simp_all +termination_by x.den +decreasing_by dyadic_wf + +/-- `Dyadic.toIGame` as an `OrderEmbedding`. -/ +@[simps!] +noncomputable def toIGameEmbedding : Dyadic ↪o IGame := + .ofStrictMono toIGame fun _ _ ↦ by exact toIGame_lt_toIGame_aux + +@[simp, norm_cast] +theorem toIGame_le_toIGame {x y : Dyadic} : (x : IGame) ≤ y ↔ x ≤ y := + toIGameEmbedding.le_iff_le + +@[simp, norm_cast] +theorem toIGame_lt_toIGame {x y : Dyadic} : (x : IGame) < y ↔ x < y := + toIGameEmbedding.lt_iff_lt + +@[simp, norm_cast] +theorem toIGame_equiv_toIGame {x y : Dyadic} : (x : IGame) ≈ y ↔ x = y := by + simp [AntisymmRel, le_antisymm_iff] + +@[simp, norm_cast] +theorem toIGame_inj {x y : Dyadic} : (x : IGame) = y ↔ x = y := + toIGameEmbedding.inj + +theorem toIGame_add_equiv (x y : Dyadic) : ((x + y : Dyadic) : IGame.{u}) ≈ x + y := by + by_cases H : x.den = 1 ∧ y.den = 1 + · rw [← intCast_num_eq_self_of_den_eq_one H.1, ← intCast_num_eq_self_of_den_eq_one H.2] + simpa [← Int.cast_add] using intCast_add_equiv .. + apply Fits.equiv_of_forall_moves ?_ (fun z hz ↦ ?_) (fun z hz ↦ ?_) + · rw [Fits, forall_moves_add, forall_moves_add] + refine ⟨⟨?_, ?_⟩, ⟨?_, ?_⟩⟩ + all_goals + intro z hz + first + | obtain rfl := eq_lower_of_mem_leftMoves_toIGame hz + | obtain rfl := eq_upper_of_mem_rightMoves_toIGame hz + grw [← toIGame_add_equiv] + simp + · obtain rfl := eq_lower_of_mem_leftMoves_toIGame hz + obtain h | h := le_or_gt x.den y.den + · by_cases hy : y.den = 1; · simp_all + use x + lower y + have hy := toIGame_of_den_ne_one hy + have : (lower y : IGame) ∈ yᴸ := by rw [hy]; simp + rw [← (toIGame_add_equiv ..).le_congr_right, hy] + simpa using lower_add_le_of_den_le h + · use lower x + y + have hx := toIGame_of_den_ne_one (den_ne_one_of_den_lt h) + have : (lower x : IGame) ∈ xᴸ := by rw [hx]; simp + rw [← (toIGame_add_equiv ..).le_congr_right, hx] + simpa using lower_add_le_of_den_ge h.le + · obtain rfl := eq_upper_of_mem_rightMoves_toIGame hz + obtain h | h := le_or_gt x.den y.den + · by_cases hy : y.den = 1; · simp_all + use x + upper y + have hy := toIGame_of_den_ne_one hy + have : (upper y : IGame) ∈ yᴿ := by rw [hy]; simp + grw [← (toIGame_add_equiv ..).le_congr_left, hy] + simpa using le_upper_add_of_den_le h + · use upper x + y + have hx := toIGame_of_den_ne_one (den_ne_one_of_den_lt h) + have : (upper x : IGame) ∈ xᴿ := by rw [hx]; simp + rw [← (toIGame_add_equiv ..).le_congr_left, hx] + simpa using le_upper_add_of_den_ge h.le +termination_by ((x : IGame.{u}), (y : IGame.{u})) +decreasing_by igame_wf + +theorem toIGame_sub_equiv (x y : Dyadic) : ((x - y : Dyadic) : IGame) ≈ x - y := by + simpa [sub_eq_add_neg] using toIGame_add_equiv x (-y) + +theorem toIGame_equiv (x : Dyadic) : (x : IGame) ≈ (x : ℚ) := by + by_cases h : x.den = 1 + · rw [toIGame_of_den_eq_one h, ← (ratCast_intCast_equiv _).antisymmRel_congr_left, + Rat.coe_int_num_of_den_eq_one h] + · have := den_add_self_lt h + have := (toIGame_add_equiv x x).symm.trans (toIGame_equiv (x + x)) + simp_all [← Surreal.mk_eq_mk, ← two_mul] +termination_by x.den + +@[simp] +theorem _root_.Game.mk_dyadic (x : Dyadic) : Game.mk x = x := + Game.mk_eq x.toIGame_equiv + +@[simp] +theorem _root_.Surreal.mk_dyadic (x : Dyadic) : Surreal.mk x = x := by + simpa using Surreal.mk_eq x.toIGame_equiv + +theorem toIGame_mul_equiv (x y : Dyadic) : ((x * y : Dyadic) : IGame) ≈ x * y := by + simp [← Surreal.mk_eq_mk] + +/-! ### Simp lemmas -/ + +/-! #### ℚ -/ + +@[simp, norm_cast] +theorem toIGame_lt_ratCast {x : Dyadic} {y : ℚ} : (x : IGame) < y ↔ x < y := by + simp [(toIGame_equiv x).lt_congr_left] +@[simp, norm_cast] +theorem toIGame_le_ratCast {x : Dyadic} {y : ℚ} : (x : IGame) ≤ y ↔ x ≤ y := by + simp [(toIGame_equiv x).le_congr_left] + +@[simp, norm_cast] +theorem ratCast_lt_toIGame {x : ℚ} {y : Dyadic} : (x : IGame) < y ↔ x < y := by + simp [(toIGame_equiv y).lt_congr_right] +@[simp, norm_cast] +theorem ratCast_le_toIGame {x : ℚ} {y : Dyadic} : (x : IGame) ≤ y ↔ x ≤ y := by + simp [(toIGame_equiv y).le_congr_right] + +@[simp, norm_cast] +theorem toIGame_equiv_ratCast {x : Dyadic} {y : ℚ} : (x : IGame) ≈ y ↔ x = y := by + simp [AntisymmRel, le_antisymm_iff] +@[simp, norm_cast] +theorem ratCast_equiv_toIGame {x : ℚ} {y : Dyadic} : (x : IGame) ≈ y ↔ x = y := by + simp [AntisymmRel, le_antisymm_iff] + +/-! #### ℤ -/ + +@[simp, norm_cast] +theorem toIGame_lt_intCast {x : Dyadic} {y : ℤ} : (x : IGame) < y ↔ x < y := by + simp [← (ratCast_intCast_equiv y).lt_congr_right] +@[simp, norm_cast] +theorem toIGame_le_intCast {x : Dyadic} {y : ℤ} : (x : IGame) ≤ y ↔ x ≤ y := by + simp [← (ratCast_intCast_equiv y).le_congr_right] + +@[simp, norm_cast] +theorem intCast_lt_toIGame {x : ℤ} {y : Dyadic} : (x : IGame) < y ↔ x < y := by + simp [← (ratCast_intCast_equiv x).lt_congr_left] +@[simp, norm_cast] +theorem intCast_le_toIGame {x : ℤ} {y : Dyadic} : (x : IGame) ≤ y ↔ x ≤ y := by + simp [← (ratCast_intCast_equiv x).le_congr_left] + +@[simp, norm_cast] +theorem toIGame_equiv_intCast {x : Dyadic} {y : ℤ} : (x : IGame) ≈ y ↔ x = y := by + simp [AntisymmRel, le_antisymm_iff] +@[simp, norm_cast] +theorem intCast_equiv_toIGame {x : ℤ} {y : Dyadic} : (x : IGame) ≈ y ↔ x = y := by + simp [AntisymmRel, le_antisymm_iff] + +@[simp, norm_cast] +theorem toIGame_eq_intCast {x : Dyadic} {y : ℤ} : (x : IGame) = y ↔ x = y := + ⟨fun h ↦ toIGame_equiv_intCast.1 h.antisymmRel, by simp_all⟩ +@[simp, norm_cast] +theorem intCast_eq_toIGame {x : ℤ} {y : Dyadic} : (x : IGame) = y ↔ x = y := by + simp [eq_comm] + +/-! #### ℕ -/ + +@[simp, norm_cast] +theorem toIGame_lt_natCast {x : Dyadic} {y : ℕ} : (x : IGame) < y ↔ x < y := + toIGame_lt_intCast (y := y) +@[simp, norm_cast] +theorem toIGame_le_natCast {x : Dyadic} {y : ℕ} : (x : IGame) ≤ y ↔ x ≤ y := + toIGame_le_intCast (y := y) + +@[simp, norm_cast] +theorem natCast_lt_toIGame {x : ℕ} {y : Dyadic} : (x : IGame) < y ↔ x < y := + intCast_lt_toIGame (x := x) +@[simp, norm_cast] +theorem natCast_le_toIGame {x : ℕ} {y : Dyadic} : (x : IGame) ≤ y ↔ x ≤ y := + intCast_le_toIGame (x := x) + +@[simp, norm_cast] +theorem toIGame_equiv_natCast {x : Dyadic} {y : ℕ} : (x : IGame) ≈ y ↔ x = y := + toIGame_equiv_intCast (y := y) +@[simp, norm_cast] +theorem natCast_equiv_toIGame {x : ℕ} {y : Dyadic} : (x : IGame) ≈ y ↔ x = y := + intCast_equiv_toIGame (x := x) + +@[simp, norm_cast] +theorem toIGame_eq_natCast {x : Dyadic} {y : ℕ} : (x : IGame) = y ↔ x = y := + toIGame_eq_intCast (y := y) +@[simp, norm_cast] +theorem natCast_eq_toIGame {x : ℕ} {y : Dyadic} : (x : IGame) = y ↔ x = y := + intCast_eq_toIGame (x := x) + +/-! #### 0 -/ + +@[simp, norm_cast] +theorem toIGame_lt_zero {x : Dyadic} : (x : IGame) < 0 ↔ x < 0 := + toIGame_lt_natCast (y := 0) +@[simp, norm_cast] +theorem toIGame_le_zero {x : Dyadic} : (x : IGame) ≤ 0 ↔ x ≤ 0 := + toIGame_le_natCast (y := 0) + +@[simp, norm_cast] +theorem zero_lt_toIGame {x : Dyadic} : 0 < (x : IGame) ↔ 0 < x := + natCast_lt_toIGame (x := 0) +@[simp, norm_cast] +theorem zero_le_toIGame {x : Dyadic} : 0 ≤ (x : IGame) ↔ 0 ≤ x := + natCast_le_toIGame (x := 0) + +@[simp, norm_cast] +theorem toIGame_equiv_zero {x : Dyadic} : (x : IGame) ≈ 0 ↔ x = 0 := + toIGame_equiv_natCast (y := 0) +@[simp, norm_cast] +theorem zero_equiv_toIGame {x : Dyadic} : 0 ≈ (x : IGame) ↔ 0 = x := + natCast_equiv_toIGame (x := 0) + +@[simp, norm_cast] +theorem toIGame_eq_zero {x : Dyadic} : (x : IGame) = 0 ↔ x = 0 := + toIGame_eq_natCast (y := 0) +@[simp, norm_cast] +theorem zero_eq_toIGame {x : Dyadic} : 0 = (x : IGame) ↔ 0 = x := + natCast_eq_toIGame (x := 0) + +/-! #### 1 -/ + +@[simp, norm_cast] +theorem toIGame_lt_one {x : Dyadic} : (x : IGame) < 1 ↔ x < 1 := by + simpa using toIGame_lt_natCast (y := 1) +@[simp, norm_cast] +theorem toIGame_le_one {x : Dyadic} : (x : IGame) ≤ 1 ↔ x ≤ 1 := by + simpa using toIGame_le_natCast (y := 1) + +@[simp, norm_cast] +theorem one_lt_toIGame {x : Dyadic} : 1 < (x : IGame) ↔ 1 < x := by + simpa using natCast_lt_toIGame (x := 1) +@[simp, norm_cast] +theorem one_le_toIGame {x : Dyadic} : 1 ≤ (x : IGame) ↔ 1 ≤ x := by + simpa using natCast_le_toIGame (x := 1) + +@[simp, norm_cast] +theorem toIGame_equiv_one {x : Dyadic} : (x : IGame) ≈ 1 ↔ x = 1 := by + simpa using toIGame_equiv_natCast (y := 1) +@[simp, norm_cast] +theorem one_equiv_toIGame {x : Dyadic} : 1 ≈ (x : IGame) ↔ 1 = x := by + simpa using natCast_equiv_toIGame (x := 1) + +@[simp, norm_cast] +theorem toIGame_eq_one {x : Dyadic} : (x : IGame) = 1 ↔ x = 1 := by + simpa using toIGame_eq_natCast (y := 1) +@[simp, norm_cast] +theorem one_eq_toIGame {x : Dyadic} : 1 = (x : IGame) ↔ 1 = x := by + simpa using natCast_eq_toIGame (x := 1) + +end Dyadic + +/-! ### Dyadic games as numbers -/ + +namespace IGame + +private theorem equiv_dyadic (x : IGame) [Short x] [Numeric x] : ∃ y : Dyadic, x ≈ y.toIGame := by + have H₁ (y : xᴸ) : ∃ z : Dyadic, y.1 ≈ z.toIGame := by + have := Numeric.of_mem_moves y.2 + have := Short.of_mem_moves y.2 + exact IGame.equiv_dyadic _ + have H₂ (y : xᴿ) : ∃ z : Dyadic, y.1 ≈ z.toIGame := by + have := Numeric.of_mem_moves y.2 + have := Short.of_mem_moves y.2 + exact IGame.equiv_dyadic _ + choose f hf using H₁ + choose g hg using H₂ + obtain ⟨y, hy₁, hy₂⟩ := by + refine (Set.finite_range f).exists_between' (Set.finite_range g) (fun x hx y hy ↦ ?_) + obtain ⟨a, rfl⟩ := hx + obtain ⟨b, rfl⟩ := hy + rw [← Dyadic.toIGame_lt_toIGame] + grw [← hf, ← hg] + exact Numeric.left_lt_right a.2 b.2 + have : ∃ y, Fits (Dyadic.toIGame y) x := by + use y + constructor <;> intro z hz + · have := hy₁ _ (Set.mem_range_self ⟨z, hz⟩) + rw [← Dyadic.toIGame_lt_toIGame] at this + grw [← hf] at this + exact this.not_ge + · have := hy₂ _ (Set.mem_range_self ⟨z, hz⟩) + rw [← Dyadic.toIGame_lt_toIGame] at this + grw [← hg] at this + exact this.not_ge + obtain ⟨z, H⟩ := exists_minimalFor_of_wellFoundedLT _ (birthday ∘ Dyadic.toIGame) this + use z + refine (Fits.equiv_of_forall_not_fits H.1 fun p _ hz' hz ↦ ?_).symm + cases p + · obtain rfl := Dyadic.eq_lower_of_mem_leftMoves_toIGame hz' + have hz' := birthday_lt_of_mem_moves hz' + exact (H.2 hz hz'.le).not_gt hz' + · obtain rfl := Dyadic.eq_upper_of_mem_rightMoves_toIGame hz' + have hz' := birthday_lt_of_mem_moves hz' + exact (H.2 hz hz'.le).not_gt hz' +termination_by x +decreasing_by igame_wf + +/-- Any dyadic game (meaning a game that is `Short` and `Numeric`) is equivalent to a `Dyadic` +rational number. + +TODO: it should be possible to compute this value explicitly, given the finsets of `Dyadic` +rationals corresponding to the left and right moves. -/ +@[no_expose] +noncomputable def toDyadic (x : IGame) [Short x] [Numeric x] : Dyadic := + Classical.choose x.equiv_dyadic + +@[simp] +theorem equiv_toIGame_toDyadic (x : IGame) [Short x] [Numeric x] : x ≈ x.toDyadic := + Classical.choose_spec x.equiv_dyadic + +@[simp] +theorem toIGame_toDyadic_equiv (x : IGame) [Short x] [Numeric x] : (x.toDyadic : IGame) ≈ x := + (equiv_toIGame_toDyadic x).symm + +@[simp] +theorem _root_.Game.ratCast_toDyadic (x : IGame) [Short x] [Numeric x] : + x.toDyadic = Game.mk x := by + simpa using Game.mk_eq (toIGame_toDyadic_equiv x) + +@[simp] +theorem _root_.Surreal.ratCast_toDyadic (x : IGame) [Short x] [Numeric x] : + x.toDyadic = Surreal.mk x := by + simpa using Surreal.mk_eq (toIGame_toDyadic_equiv x) + +theorem equiv_toIGame_iff_toDyadic_eq {x : IGame} [Short x] [Numeric x] {y : Dyadic} : + x ≈ y ↔ x.toDyadic = y := by + constructor + · intro h + simpa using (equiv_toIGame_toDyadic x).symm.trans h + · rintro rfl + exact equiv_toIGame_toDyadic x + +theorem toIGame_equiv_iff_eq_toDyadic {x : IGame} [Short x] [Numeric x] {y : Dyadic} : + (y : IGame) ≈ x ↔ y = x.toDyadic := by + rw [antisymmRel_comm, eq_comm, equiv_toIGame_iff_toDyadic_eq] + +@[simp] +theorem toDyadic_toIGame (x : Dyadic) : toDyadic x = x := by + simp [← equiv_toIGame_iff_toDyadic_eq] + +@[simp] +theorem toDyadic_zero : toDyadic 0 = 0 := by + simp [← equiv_toIGame_iff_toDyadic_eq] + +@[simp] +theorem toDyadic_one : toDyadic 1 = 1 := by + simp [← equiv_toIGame_iff_toDyadic_eq] + +@[simp] +theorem toDyadic_half : toDyadic ½ = .half := by + simp [← equiv_toIGame_iff_toDyadic_eq] + +@[simp] +theorem toDyadic_natCast (n : ℕ) : toDyadic n = n := by + simp [← equiv_toIGame_iff_toDyadic_eq] + +@[simp] +theorem toDyadic_ofNat (n : ℕ) [n.AtLeastTwo] : toDyadic ofNat(n) = n := + toDyadic_natCast n + +@[simp] +theorem toDyadic_intCast (n : ℤ) : toDyadic n = n := by + simp [← equiv_toIGame_iff_toDyadic_eq] + +@[simp] +theorem toDyadic_neg (x : IGame) [Short x] [Numeric x] : toDyadic (-x) = -toDyadic x := by + simp [← equiv_toIGame_iff_toDyadic_eq] + +@[simp] +theorem toDyadic_add (x y : IGame) [Short x] [Numeric x] [Short y] [Numeric y] : + toDyadic (x + y) = toDyadic x + toDyadic y := by + rw [← equiv_toIGame_iff_toDyadic_eq, ← Surreal.mk_eq_mk] + simp + +@[simp] +theorem toDyadic_sub (x y : IGame) [Short x] [Numeric x] [Short y] [Numeric y] : + toDyadic (x - y) = toDyadic x - toDyadic y := by + rw [← equiv_toIGame_iff_toDyadic_eq, ← Surreal.mk_eq_mk] + simp + +@[simp] +theorem toDyadic_mul (x y : IGame) [Short x] [Numeric x] [Short y] [Numeric y] : + toDyadic (x * y) = toDyadic x * toDyadic y := by + rw [← equiv_toIGame_iff_toDyadic_eq, ← Surreal.mk_eq_mk] + simp + +end IGame +end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries.lean new file mode 100644 index 0000000000..dab72adaff --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries/Basic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries/Basic.lean new file mode 100644 index 0000000000..2333ff6215 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries/Basic.lean @@ -0,0 +1,534 @@ +/- +Copyright (c) 2026 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Pow +public import Mathlib.Order.Shrink +public import Mathlib.RingTheory.HahnSeries.Lex + +import Mathlib.Algebra.Field.Subfield.Basic +import Mathlib.Algebra.Ring.Subring.Order +import Mathlib.RingTheory.HahnSeries.Cardinal + +/-! +# Surreal Hahn series + +Hahn series are a generalization of power series and Puiseux series. A Hahn series `R⟦Γ⟧` is defined +as a function `Γ → R` whose support is well-founded. This condition is sufficient to define addition +and multiplication as with polynomials, so that under suitable conditions, `R⟦Γ⟧` has the structure +of an ordered field. + +The aphorism goes that surreals are real Hahn series over themselves. However, there are a few +technicalities. Hahn series are conventionally defined so that the support has well-founded `<`, +whereas for surreals it's more natural to assume well-founded `>`. Moreover, the Hahn series that +correspond to surreals must have a `Small` support. Because of this, we often prefer to identify +these surreal Hahn series with ordinal-indexed sequences of surreal exponents and their +coefficients. + +This file provides the translation layer between Hahn series as they're implemented in Mathlib, and +the Hahn series relevant to surreal numbers, by defining the type `SurrealHahnSeries` for the +latter. +-/ + +universe u + +public noncomputable section + +/-! ### For Mathlib -/ + +attribute [aesop simp] Pi.single_apply + +theorem Set.IsWF.to_subtype {α : Type*} [LT α] {s : Set α} (h : IsWF s) : WellFoundedLT s := ⟨h⟩ + +/-- This is like `RelIso.cast` with better def-eqs. -/ +def RelIso.subrel {α : Type*} (r : α → α → Prop) {p q : α → Prop} (H : ∀ x, p x ↔ q x) : + Subrel r p ≃r Subrel r q where + map_rel_iff' := .rfl + __ := Equiv.subtypeEquiv (Equiv.refl _) H + +private def toLexRingEquiv {R : Type*} [Ring R] : R ≃+* Lex R where + toFun := toLex + invFun := ofLex + map_add' _ _ := rfl + map_mul' _ _ := rfl + +open Order Set + +/-! ### Basic defs and instances -/ + +/-- `SurrealHahnSeries` as a subfield. -/ +private def surrealHahnSeriesSubfield : Subfield (Lex <| HahnSeries Surrealᵒᵈ ℝ) := + have : Fact (_ < _) := ⟨Cardinal.aleph0_lt_univ.{u, u}⟩ + (HahnSeries.cardSuppLTSubfield Surrealᵒᵈ ℝ .univ).comap toLexRingEquiv.toRingHom + +/-- The type of `u`-small Hahn series over `Surrealᵒᵈ`, endowed with the lexicographic ordering. We +will show that this type is isomorphic as an ordered field to the surreals themselves. -/ +def SurrealHahnSeries : Type (u + 1) := + surrealHahnSeriesSubfield + +namespace SurrealHahnSeries + +@[no_expose] +instance : Field SurrealHahnSeries := + inferInstanceAs (Field surrealHahnSeriesSubfield) + +@[no_expose] +instance : LinearOrder SurrealHahnSeries := + inferInstanceAs (LinearOrder surrealHahnSeriesSubfield) + +instance : IsStrictOrderedRing SurrealHahnSeries := + inferInstanceAs (IsStrictOrderedRing surrealHahnSeriesSubfield) + +open Cardinal in +/-- A constructor for `SurrealHahnSeries` which hides various implementation details. -/ +def mk (f : Surreal.{u} → ℝ) (small : Small.{u} (Function.support f)) + (wf : (Function.support f).WellFoundedOn (· > ·)) : SurrealHahnSeries where + val := toLex ⟨f ∘ OrderDual.ofDual, IsWF.isPWO wf⟩ + property := by rwa [small_iff_lift_mk_lt_univ, lift_id, univ_umax.{u, u}] at small + +/-! #### `coeff` -/ + +/-- Returns the coefficient for `X ^ i`. -/ +def coeff (x : SurrealHahnSeries) (i : Surreal) : ℝ := + x.1.coeff <| OrderDual.toDual i + +@[simp, grind =] theorem coeff_mk (f small wf) : coeff (mk f small wf) = f := (rfl) +@[simp, grind =] theorem coeff_zero : coeff 0 = 0 := (rfl) + +@[simp, grind =] +theorem coeff_neg (x : SurrealHahnSeries) : (-x).coeff = -x.coeff := (rfl) + +@[simp, grind =] +theorem coeff_add (x y : SurrealHahnSeries) : (x + y).coeff = x.coeff + y.coeff := (rfl) + +@[simp, grind =] +theorem coeff_sub (x y : SurrealHahnSeries) : (x - y).coeff = x.coeff - y.coeff := (rfl) + +theorem coeff_add_apply (x y : SurrealHahnSeries) (i : Surreal) : + (x + y).coeff i = x.coeff i + y.coeff i := (rfl) + +theorem coeff_sub_apply (x y : SurrealHahnSeries) (i : Surreal) : + (x - y).coeff i = x.coeff i - y.coeff i := (rfl) + +@[ext] +theorem ext {x y : SurrealHahnSeries} (h : x.coeff = y.coeff) : x = y := + Subtype.ext <| HahnSeries.ext h + +/-! #### `support` -/ + +/-- The support of the Hahn series. -/ +@[expose] +def support (x : SurrealHahnSeries) : Set Surreal := + Function.support x.coeff + +@[simp] +theorem support_coeff (x : SurrealHahnSeries) : Function.support x.coeff = x.support := (rfl) + +@[simp] +theorem support_mk (f small wf) : support (mk f small wf) = Function.support f := (rfl) + +@[simp, grind =] +theorem mem_support_iff {x : SurrealHahnSeries} {i : Surreal} : i ∈ x.support ↔ x.coeff i ≠ 0 := + .rfl + +@[simp] +theorem support_eq_empty {x : SurrealHahnSeries} : support x = ∅ ↔ x = 0 := by + aesop (add simp [Set.eq_empty_iff_forall_notMem]) + +@[simp] +theorem support_zero : support 0 = ∅ := + support_eq_empty.2 rfl + +theorem support_add_subset {x y : SurrealHahnSeries} : (x + y).support ⊆ x.support ∪ y.support := + Function.support_add .. + +theorem wellFoundedOn_support (x : SurrealHahnSeries) : x.support.WellFoundedOn (· > ·) := + x.1.isWF_support + +instance (x : SurrealHahnSeries) : WellFoundedGT x.support := + x.1.isWF_support.to_subtype + +instance (x : SurrealHahnSeries) : + IsWellOrder x.support (Subrel (· > ·) (· ∈ x.support)) := + inferInstanceAs (IsWellOrder x.support (· > ·)) + +instance small_support (x : SurrealHahnSeries.{u}) : Small.{u} x.support := by + rw [Cardinal.small_iff_lift_mk_lt_univ, Cardinal.lift_id] + exact lt_of_lt_of_eq x.2 Cardinal.univ_umax.symm + +@[simp] +theorem mk_coeff (x : SurrealHahnSeries) : mk x.coeff x.small_support x.wellFoundedOn_support = x := + (rfl) + +theorem lt_def {x y : SurrealHahnSeries} : x < y ↔ toColex x.coeff < toColex y.coeff := .rfl +theorem le_def {x y : SurrealHahnSeries} : x ≤ y ↔ toColex x.coeff ≤ toColex y.coeff := .rfl + +/-! #### `single` -/ + +/-- The Hahn series with a single entry. -/ +def single (x : Surreal) (r : ℝ) : SurrealHahnSeries := + mk (Pi.single x r) (small_subset Pi.support_single_subset) + (WellFoundedOn.subset wellFoundedOn_singleton Pi.support_single_subset) + +@[aesop simp] +theorem coeff_single (x : Surreal) (r : ℝ) : (single x r).coeff = Pi.single x r := (rfl) + +@[simp, grind =] +theorem coeff_single_self (x : Surreal) (r : ℝ) : (single x r).coeff x = r := by + aesop + +@[grind =] +theorem coeff_single_of_ne {x y : Surreal} (h : x ≠ y) (r : ℝ) : (single x r).coeff y = 0 := by + aesop + +@[simp] +theorem single_zero (x : Surreal) : single x 0 = 0 := by + aesop + +theorem support_single_subset {x : Surreal} {r : ℝ} : support (single x r) ⊆ {x} := by + aesop + +/-! #### `trunc` -/ + +/-- Zeroes out any terms of the Hahn series less than or equal to `i`. -/ +def trunc (x : SurrealHahnSeries) (i : Surreal) : SurrealHahnSeries := + let g j := if i < j then x.coeff j else 0 + have hg : Function.support g ⊆ x.support := by simp [g] + mk _ (small_subset hg) (WellFoundedOn.subset x.wellFoundedOn_support hg) + +@[aesop simp] +theorem coeff_trunc (x : SurrealHahnSeries) (i : Surreal) : + (x.trunc i).coeff = fun j ↦ if i < j then x.coeff j else 0 := + (rfl) + +@[simp, grind =] +theorem support_trunc (x : SurrealHahnSeries) (i : Surreal) : + (x.trunc i).support = x.support ∩ Ioi i := by + aesop + +theorem support_trunc_subset (x : SurrealHahnSeries) (i : Surreal) : + (x.trunc i).support ⊆ x.support := by + simp + +theorem support_trunc_anti {x : SurrealHahnSeries} : Antitone fun i ↦ (trunc x i).support := + fun _ _ _ _ ↦ by aesop (add safe tactic (by order)) + +@[simp] +theorem coeff_trunc_of_lt {x : SurrealHahnSeries} {i j : Surreal} (h : i < j) : + (x.trunc i).coeff j = x.coeff j := + if_pos h + +@[simp] +theorem coeff_trunc_of_le {x : SurrealHahnSeries} {i j : Surreal} (h : j ≤ i) : + (x.trunc i).coeff j = 0 := + if_neg h.not_gt + +theorem coeff_trunc_eq_zero {x : SurrealHahnSeries} {i j : Surreal} (h : x.coeff i = 0) : + (x.trunc j).coeff i = 0 := by + aesop + +theorem coeff_trunc_of_mem {x : SurrealHahnSeries} {i j : Surreal} (h : j ∈ (x.trunc i).support) : + (x.trunc i).coeff j = x.coeff j := by + aesop + +@[simp] +theorem trunc_add (x y : SurrealHahnSeries) (i : Surreal) : + (x + y).trunc i = x.trunc i + y.trunc i := by + aesop + +@[simp] +theorem trunc_sub (x y : SurrealHahnSeries) (i : Surreal) : + (x - y).trunc i = x.trunc i - y.trunc i := by + aesop + +@[simp] +theorem trunc_single_of_le {i j : Surreal} {r : ℝ} (h : i ≤ j) : + (single i r).trunc j = 0 := by + aesop (add safe tactic (by order)) + +@[simp] +theorem trunc_single_of_lt {i j : Surreal} {r : ℝ} (h : j < i) : + (single i r).trunc j = single i r := by + aesop (add safe tactic (by order)) + +@[simp] +theorem trunc_trunc (x : SurrealHahnSeries) (i j : Surreal) : + (x.trunc i).trunc j = x.trunc (max i j) := by + ext k + obtain hi | hi := lt_or_ge i k + · obtain hj | hj := lt_or_ge j k + · rw [coeff_trunc_of_lt hj, coeff_trunc_of_lt hi, coeff_trunc_of_lt (max_lt hi hj)] + · rw [coeff_trunc_of_le hj, coeff_trunc_of_le (le_max_of_le_right hj)] + · rw [coeff_trunc_eq_zero (coeff_trunc_of_le hi), coeff_trunc_of_le (le_max_of_le_left hi)] + +theorem trunc_eq_self_iff {x : SurrealHahnSeries} {i : Surreal} : + x.trunc i = x ↔ ∀ j ∈ x.support, i < j := by + refine ⟨fun hx j hj ↦ ?_, fun _ ↦ ?_⟩ + · by_contra! hi + apply_fun (coeff · j) at hx + rw [coeff_trunc_of_le hi] at hx + exact hj hx.symm + · ext j + by_cases j ∈ x.support <;> aesop + +alias ⟨_, trunc_eq_self⟩ := trunc_eq_self_iff + +theorem trunc_eq_trunc {x : SurrealHahnSeries} {i j : Surreal} (h : i ≤ j) + (H : ∀ k, i < k → k ≤ j → x.coeff k = 0) : x.trunc i = x.trunc j := by + ext k + obtain hi | hi := le_or_gt k i + · rw [coeff_trunc_of_le hi, coeff_trunc_of_le (hi.trans h)] + · rw [coeff_trunc_of_lt hi] + obtain hj | hj := lt_or_ge j k + · rw [coeff_trunc_of_lt hj] + · rw [coeff_trunc_of_le hj] + exact H _ hi hj + +theorem trunc_add_single {x : SurrealHahnSeries} {i : Surreal} (hi : i ∈ lowerBounds x.support) : + x.trunc i + single i (x.coeff i) = x := by + ext j + have := @hi j + aesop (add simp [le_iff_lt_or_eq']) + +/-! ### Indexing the support by ordinals -/ + +open Ordinal + +local instance (x : SurrealHahnSeries.{u}) : IsWellOrder (Shrink.{u} x.support) (· > ·) := + (orderIsoShrink x.support).dual.symm.toRelIsoLT.toRelEmbedding.isWellOrder + +/-! #### `length` -/ + +/-- The length of a surreal Hahn series is the order type of its support. -/ +def length (x : SurrealHahnSeries.{u}) : Ordinal.{u} := + type (α := Shrink.{u} x.support) (· > ·) + +@[simp] +theorem type_support (x : SurrealHahnSeries.{u}) : + type (α := x.support) (· > ·) = lift.{u + 1} x.length := + ((orderIsoShrink x.support).dual.toRelIsoLT.trans + (RelIso.preimage Equiv.ulift _).symm).ordinalType_congr + +@[simp] +theorem length_eq_zero {x : SurrealHahnSeries} : length x = 0 ↔ x = 0 := by + rw [← lift_inj, ← type_support, lift_zero, type_eq_zero_iff_isEmpty] + aesop + +@[simp] +theorem length_zero : length 0 = 0 := + length_eq_zero.2 rfl + +theorem length_mono {x y : SurrealHahnSeries} (h : x.support ⊆ y.support) : + x.length ≤ y.length := by + rw [← lift_le, ← type_support, ← type_support] + exact (Subrel.inclusionEmbedding (· > ·) h).ordinal_type_le + +/-! #### `exp` -/ + +/-- Returns the `i`-th largest exponent with a non-zero coefficient. + +This is registered as a `RelIso` between `Iio x.length` and `x.support`, so that `x.exp.symm` can be +used to return the index of an element in the support. -/ +def exp (x : SurrealHahnSeries) : (· < · : Iio x.length → _ → _) ≃r (· > · : x.support → _ → _) := + (Ordinal.enum _).trans (orderIsoShrink x.support).dual.toRelIsoLT.symm + +@[simp] +theorem symm_exp_lt {x : SurrealHahnSeries} (i) : x.exp.symm i < x.length := + (x.exp.symm i).2 + +theorem exp_strictAnti {x : SurrealHahnSeries} : StrictAnti x.exp := + fun _ _ ↦ x.exp.map_rel_iff'.2 + +theorem exp_anti {x : SurrealHahnSeries} : Antitone x.exp := + x.exp_strictAnti.antitone + +@[simp] +theorem exp_lt_exp_iff {x : SurrealHahnSeries} {i j : Iio x.length} : + x.exp i < x.exp j ↔ j < i := + x.exp_strictAnti.lt_iff_gt + +@[simp] +theorem exp_le_exp_iff {x : SurrealHahnSeries} {i j : Iio x.length} : + x.exp i ≤ x.exp j ↔ j ≤ i := + x.exp_strictAnti.le_iff_ge + +@[simp] +theorem symm_exp_lt_symm_exp_iff {x : SurrealHahnSeries} {i j : x.support} : + x.exp.symm i < x.exp.symm j ↔ j < i := by + simp [← exp_lt_exp_iff] + +@[simp] +theorem symm_exp_le_symm_exp_iff {x : SurrealHahnSeries} {i j : x.support} : + x.exp.symm i ≤ x.exp.symm j ↔ j ≤ i := by + simp [← exp_le_exp_iff] + +theorem eq_exp_of_mem_support {x : SurrealHahnSeries} {i : Surreal} (h : i ∈ x.support) : + ∃ j, x.exp j = i := by + use x.exp.symm ⟨i, h⟩ + simp + +/-- This lemma is useful for rewriting. -/ +theorem exp_congr {x y : SurrealHahnSeries} (h : x = y) (i : Iio x.length) : + (x.exp i).1 = (y.exp ⟨i.1, h ▸ i.2⟩).1 := by + congr! + +@[simp] +theorem typein_support {x : SurrealHahnSeries.{u}} (i : x.support) : + typein (· > ·) i = lift.{u + 1} (x.exp.symm i) := by + unfold exp length + rw [typein, RelEmbedding.ofMonotone_coe, ← lift_id'.{u, u + 1} (type _)] + apply RelIso.ordinal_lift_type_eq + use Equiv.subtypeEquiv (equivShrink _) (fun a ↦ (orderIsoShrink _).toRelIsoLT.map_rel_iff.symm) + simp + +/-! #### `coeffIdx` -/ + +/-- Returns the coefficient which corresponds to the `i`-th largest exponent, or `0` if no such +coefficient exists. -/ +def coeffIdx (x : SurrealHahnSeries) (i : Ordinal) : ℝ := + if h : i < x.length then x.coeff (x.exp ⟨i, h⟩) else 0 + +theorem coeffIdx_of_lt {x : SurrealHahnSeries} {i : Ordinal} (h : i < x.length) : + x.coeffIdx i = x.coeff (x.exp ⟨i, h⟩) := by + rw [coeffIdx, dif_pos] + +theorem coeffIdx_of_le {x : SurrealHahnSeries} {i : Ordinal} (h : x.length ≤ i) : + x.coeffIdx i = 0 := by + rw [coeffIdx, dif_neg h.not_gt] + +@[simp] +theorem coeffIdx_zero : coeffIdx 0 = 0 := by + ext j; simp [coeffIdx] + +@[simp] +theorem coeff_exp (x : SurrealHahnSeries) (i) : x.coeff (x.exp i) = x.coeffIdx i := + (coeffIdx_of_lt _).symm + +@[simp] +theorem coeffIdx_symm_exp (x : SurrealHahnSeries) (i) : x.coeffIdx (x.exp.symm i) = x.coeff i := by + rw [coeffIdx_of_lt (by simp)] + simp + +@[simp] +theorem coeffIdx_eq_zero_iff {x : SurrealHahnSeries} {i : Ordinal} : + x.coeffIdx i = 0 ↔ x.length ≤ i where + mp h := by + contrapose! h + rw [coeffIdx_of_lt h] + exact (x.exp _).2 + mpr := coeffIdx_of_le + +/-! #### `truncIdx` -/ + +/-- Truncates the series at the `i`-th largest exponent, or returns it unchanged if no such +coefficient exists. -/ +def truncIdx (x : SurrealHahnSeries) (i : Ordinal.{u}) : SurrealHahnSeries := + if h : i < x.length then x.trunc (x.exp ⟨i, h⟩) else x + +@[aesop simp] +theorem support_truncIdx (x : SurrealHahnSeries) (i : Ordinal) : + (truncIdx x i).support = + if hi : i < x.length then x.support ∩ Ioi (x.exp ⟨i, hi⟩) else x.support := by + unfold truncIdx + aesop + +theorem truncIdx_of_lt {x : SurrealHahnSeries} {i : Ordinal} (h : i < x.length) : + x.truncIdx i = x.trunc (x.exp ⟨i, h⟩) := by + rw [truncIdx, dif_pos] + +theorem truncIdx_of_le {x : SurrealHahnSeries} {i : Ordinal} (h : x.length ≤ i) : + x.truncIdx i = x := by + rw [truncIdx, dif_neg h.not_gt] + +@[simp] +theorem truncIdx_zero : truncIdx 0 = 0 := by + ext j; simp [truncIdx] + +@[simp, grind =] +theorem trunc_exp (x : SurrealHahnSeries) (i) : x.trunc (x.exp i) = x.truncIdx i := + (truncIdx_of_lt _).symm + +@[simp] +theorem truncIdx_symm_exp (x : SurrealHahnSeries) (i) : x.truncIdx (x.exp.symm i) = x.trunc i := by + rw [truncIdx_of_lt (by simp)] + simp + +theorem support_truncIdx_ssubset {x : SurrealHahnSeries} {i : Ordinal} (h : i < x.length) : + support (truncIdx x i) ⊂ support x := by + rw [truncIdx_of_lt h] + refine ⟨support_trunc_subset .., ?_⟩ + rw [not_subset] + use x.exp ⟨i, h⟩ + aesop + +theorem support_truncIdx_subset (x : SurrealHahnSeries) (i : Ordinal) : + support (truncIdx x i) ⊆ support x := by + obtain h | h := lt_or_ge i x.length + · exact (support_truncIdx_ssubset h).le + · rw [truncIdx_of_le h] + +@[simp, grind =] +theorem length_truncIdx (x : SurrealHahnSeries) (i : Ordinal) : + (x.truncIdx i).length = min i x.length := by + obtain hi | hi := lt_or_ge i x.length + · rw [← lift_inj, ← type_support] + trans type (Subrel (· > · : x.support → _) (· > x.exp ⟨i, hi⟩)) + · apply ((RelIso.subrel (q := fun y ↦ ∃ h : y ∈ x.support, ⟨y, h⟩ ∈ Ioi (x.exp ⟨i, hi⟩)) + (· > ·) _).trans _).ordinalType_congr + · rw [truncIdx_of_lt hi, support_trunc] + aesop + · use (Equiv.subtypeSubtypeEquivSubtypeExists ..).symm + aesop + · simpa using hi.le + · rw [truncIdx_of_le hi, min_eq_right hi] + +theorem length_trunc_lt {x : SurrealHahnSeries} {i : Surreal} (h : i ∈ x.support) : + (x.trunc i).length < x.length := by + obtain ⟨⟨i, hi⟩, rfl⟩ := eq_exp_of_mem_support h + rwa [trunc_exp, length_truncIdx, min_eq_left hi.le] + +theorem truncIdx_ne {x : SurrealHahnSeries} {i : Ordinal} (h : i < x.length) : + x.truncIdx i ≠ x := by + apply_fun length + simpa + +theorem coeff_truncIdx_of_mem {x : SurrealHahnSeries} {i : Ordinal} {j k : Surreal} + (hjk : j ≤ k) (h : j ∈ (x.truncIdx i).support) : (x.truncIdx i).coeff k = x.coeff k := by + obtain hi | hi := lt_or_ge i x.length + · by_cases hk : k ∈ (x.truncIdx i).support + · rw [truncIdx_of_lt hi, coeff_trunc_of_mem] + rwa [trunc_exp] + · rw [mem_support_iff, not_ne_iff] at hk + rw [hk, eq_comm] + rwa [truncIdx_of_lt hi, coeff_trunc_of_lt] at hk + apply hjk.trans_lt' + aesop + · rw [truncIdx_of_le hi] + +theorem trunc_truncIdx_of_mem {x : SurrealHahnSeries} {i : Ordinal} {a b : Surreal} + (hab : a ≤ b) (ha : a ∈ (x.truncIdx i).support) : (x.truncIdx i).trunc b = x.trunc b := by + ext k + obtain h | h := lt_or_ge b k + · rw [coeff_trunc_of_lt h, coeff_trunc_of_lt h, coeff_truncIdx_of_mem (hab.trans h.le) ha] + · rw [coeff_trunc_of_le h, coeff_trunc_of_le h] + +/-! #### `term` -/ + +/-- Returns the `i`-th largest term of the sum, or `0` if it doesn't exist. -/ +def term (x : SurrealHahnSeries) (i : Ordinal) : Surreal := + if hi : i < x.length then x.coeffIdx i * ω^ (x.exp ⟨i, hi⟩).1 else 0 + +theorem term_of_lt {x : SurrealHahnSeries} {i : Ordinal} (hi : i < x.length) : + x.term i = x.coeffIdx i * ω^ (x.exp ⟨i, hi⟩).1 := + dif_pos hi + +@[simp] +theorem term_eq_zero {x : SurrealHahnSeries} {i : Ordinal} : x.term i = 0 ↔ x.length ≤ i := by + simp [term, ← not_le] + +alias ⟨_, term_of_le⟩ := term_eq_zero + +end SurrealHahnSeries diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Leading.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Leading.lean new file mode 100644 index 0000000000..60cb51f27e --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Leading.lean @@ -0,0 +1,310 @@ +/- +Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Pow +public import Mathlib.Algebra.Order.Ring.StandardPart + +/-! +# Leading term and coefficient + +We define `Surreal.leadingCoeff` and `Surreal.leadingTerm` for the leading coefficient/term of a +surreal's Hahn series. + +We don't yet prove this characterization; rather, these functions are a key ingredient in defining +the map from surreals into Hahn series. +-/ + +@[expose] public noncomputable section +namespace Surreal + +open ArchimedeanClass + +/-! ### Leading coefficient -/ + +/-- The leading coefficient of a surreal's Hahn series. -/ +def leadingCoeff (x : Surreal) : ℝ := + stdPart (x / ω^ x.wlog) + +@[simp] +theorem leadingCoeff_realCast (r : ℝ) : leadingCoeff r = r := by + rw [leadingCoeff, wlog_realCast, wpow_zero, div_one] + exact stdPart_map_real Real.toSurrealRingHom r + +@[simp] +theorem leadingCoeff_ratCast (q : ℚ) : leadingCoeff q = q := + mod_cast leadingCoeff_realCast q + +@[simp] +theorem leadingCoeff_intCast (n : ℤ) : leadingCoeff n = n := + mod_cast leadingCoeff_realCast n + +@[simp] +theorem leadingCoeff_natCast (n : ℕ) : leadingCoeff n = n := + mod_cast leadingCoeff_realCast n + +@[simp] +theorem leadingCoeff_zero : leadingCoeff 0 = 0 := + mod_cast leadingCoeff_natCast 0 + +@[simp] +theorem leadingCoeff_one : leadingCoeff 1 = 1 := + mod_cast leadingCoeff_natCast 1 + +@[simp] +theorem leadingCoeff_neg (x : Surreal) : leadingCoeff (-x) = -leadingCoeff x := by + simp [leadingCoeff, neg_div] + +@[simp] +theorem leadingCoeff_mul (x y : Surreal) : + leadingCoeff (x * y) = leadingCoeff x * leadingCoeff y := by + unfold leadingCoeff + by_cases hx : x = 0; · simp [hx] + by_cases hy : y = 0; · simp [hy] + rw [wlog_mul hx hy, wpow_add, ← stdPart_mul, mul_div_mul_comm] + all_goals + rw [archimedeanClassMk_div_wpow_wlog, + LinearOrderedAddCommGroupWithTop.sub_self_eq_zero_of_ne_top] + simpa + +@[simp] +theorem leadingCoeff_inv (x : Surreal) : leadingCoeff x⁻¹ = (leadingCoeff x)⁻¹ := by + obtain rfl | hx := eq_or_ne x 0; · simp + apply eq_inv_of_mul_eq_one_left + rw [← leadingCoeff_mul, inv_mul_cancel₀ hx, leadingCoeff_one] + +@[simp] +theorem leadingCoeff_div (x y : Surreal) : + leadingCoeff (x / y) = leadingCoeff x / leadingCoeff y := by + simp [div_eq_mul_inv] + +@[simp] +theorem leadingCoeff_wpow (x : Surreal) : leadingCoeff (ω^ x) = 1 := by + simp [leadingCoeff] + +@[simp] +theorem leadingCoeff_eq_zero {x : Surreal} : leadingCoeff x = 0 ↔ x = 0 := by + simp [leadingCoeff] + +private theorem leadingCoeff_nonneg {x : Surreal} (h : 0 ≤ x) : 0 ≤ leadingCoeff x := + stdPart_nonneg <| div_nonneg h (wpow_nonneg _) + +private theorem leadingCoeff_nonpos {x : Surreal} (h : x ≤ 0) : leadingCoeff x ≤ 0 := + stdPart_nonpos <| div_nonpos_of_nonpos_of_nonneg h (wpow_nonneg _) + +@[simp] +theorem leadingCoeff_nonneg_iff {x : Surreal} : 0 ≤ leadingCoeff x ↔ 0 ≤ x := by + refine ⟨?_, leadingCoeff_nonneg⟩ + contrapose! + refine fun h ↦ (leadingCoeff_nonpos h.le).lt_of_ne ?_ + rw [ne_eq, leadingCoeff_eq_zero] + exact h.ne + +@[simp] +theorem leadingCoeff_nonpos_iff {x : Surreal} : leadingCoeff x ≤ 0 ↔ x ≤ 0 := by + simpa using leadingCoeff_nonneg_iff (x := -x) + +@[simp] +theorem leadingCoeff_pos_iff {x : Surreal} : 0 < leadingCoeff x ↔ 0 < x := by + simp [← not_le] + +@[simp] +theorem leadingCoeff_neg_iff {x : Surreal} : leadingCoeff x < 0 ↔ x < 0 := by + simp [← not_le] + +theorem leadingCoeff_monotoneOn (x : Surreal) : MonotoneOn leadingCoeff (wlog ⁻¹' {x}) := by + rintro y rfl z (hw : wlog _ = _) h + obtain rfl | hy := eq_or_ne y 0; · simpa + obtain rfl | hz := eq_or_ne z 0; · simpa + · rw [leadingCoeff, leadingCoeff, hw] + apply stdPart_monotoneOn + · simp + · rw [← hw]; simp + · simpa [div_eq_mul_inv] + +private theorem stdPart_eq' {x y : Surreal} {r : ℝ} + (hL : ∀ s < r, s * ω^ y ≤ x) (hR : ∀ s > r, x ≤ s * ω^ y) : stdPart (x / ω^ y) = r := by + apply stdPart_eq Real.toSurrealRingHom <;> intro s hs + · rw [le_div_iff₀ (wpow_pos _)] + exact hL s hs + · rw [div_le_iff₀ (wpow_pos _)] + exact hR s hs + +theorem wlog_eq {x y : Surreal} {r : ℝ} (hr : r ≠ 0) + (hL : ∀ s < r, s * ω^ y ≤ x) (hR : ∀ s > r, x ≤ s * ω^ y) : x.wlog = y := by + apply wlog_eq_of_wpow_veq + rw [veq_def, eq_comm, ← LinearOrderedAddCommGroupWithTop.sub_eq_zero (by simp), + ← ArchimedeanClass.mk_div, ← stdPart_eq_zero.ne_left] + exact (stdPart_eq' hL hR).trans_ne hr + +theorem leadingCoeff_eq {x y : Surreal} {r : ℝ} (hr : r ≠ 0) + (hL : ∀ s < r, s * ω^ y ≤ x) (hR : ∀ s > r, x ≤ s * ω^ y) : leadingCoeff x = r := by + rw [leadingCoeff, wlog_eq hr hL hR, stdPart_eq' hL hR] + +theorem leadingCoeff_add_eq_left {x y : Surreal} (h : y <ᵥ x) : + leadingCoeff (x + y) = leadingCoeff x := by + rw [leadingCoeff, leadingCoeff, add_div, wlog_add_eq_left h, stdPart_add_eq_left] + rw [ArchimedeanClass.mk_div, LinearOrderedAddCommGroupWithTop.sub_pos] + left + rwa [veq_def.1 (wpow_wlog_veq h.ne_zero), ← vlt_def] + +theorem leadingCoeff_add_eq_right {x y : Surreal} (h : y <ᵥ x) : + leadingCoeff (y + x) = leadingCoeff x := by + rw [add_comm, leadingCoeff_add_eq_left h] + +theorem leadingCoeff_sub_eq_left {x y : Surreal} : y <ᵥ x → + leadingCoeff (x - y) = leadingCoeff x := by + simpa [sub_eq_add_neg] using @leadingCoeff_add_eq_left x (-y) + +theorem leadingCoeff_sub_eq_right {x y : Surreal} : y <ᵥ x → + leadingCoeff (y - x) = -leadingCoeff x := by + simpa [sub_eq_add_neg] using @leadingCoeff_add_eq_right (-x) y + +/-! ### Leading term -/ + +/-- The leading term of a surreal's Hahn series. -/ +def leadingTerm (x : Surreal) : Surreal := + x.leadingCoeff * ω^ x.wlog + +@[simp] +theorem leadingTerm_realCast (r : ℝ) : leadingTerm r = r := by + simp [leadingTerm] + +@[simp] +theorem leadingTerm_ratCast (q : ℚ) : leadingTerm q = q := + mod_cast leadingTerm_realCast q + +@[simp] +theorem leadingTerm_intCast (n : ℤ) : leadingTerm n = n := + mod_cast leadingTerm_realCast n + +@[simp] +theorem leadingTerm_natCast (n : ℕ) : leadingTerm n = n := + mod_cast leadingTerm_realCast n + +@[simp] +theorem leadingTerm_zero : leadingTerm 0 = 0 := + mod_cast leadingTerm_natCast 0 + +@[simp] +theorem leadingTerm_one : leadingTerm 1 = 1 := + mod_cast leadingTerm_natCast 1 + +@[simp] +theorem leadingTerm_neg (x : Surreal) : leadingTerm (-x) = -leadingTerm x := by + simp [leadingTerm] + +@[simp] +theorem leadingTerm_mul (x y : Surreal) : leadingTerm (x * y) = leadingTerm x * leadingTerm y := by + obtain rfl | hx := eq_or_ne x 0; · simp + obtain rfl | hy := eq_or_ne y 0; · simp + simp [leadingTerm, wlog_mul hx hy, mul_mul_mul_comm] + +@[simp] +theorem leadingTerm_inv (x : Surreal) : leadingTerm x⁻¹ = (leadingTerm x)⁻¹ := by + obtain rfl | hx := eq_or_ne x 0; · simp + apply eq_inv_of_mul_eq_one_left + rw [← leadingTerm_mul, inv_mul_cancel₀ hx, leadingTerm_one] + +@[simp] +theorem leadingTerm_div (x y : Surreal) : leadingTerm (x / y) = leadingTerm x / leadingTerm y := by + simp [div_eq_mul_inv] + +@[simp] +theorem leadingTerm_wpow (x : Surreal) : leadingTerm (ω^ x) = ω^ x := by + simp [leadingTerm] + +@[simp] +theorem leadingTerm_eq_zero {x : Surreal} : leadingTerm x = 0 ↔ x = 0 := by + simp [leadingTerm] + +@[simp] +theorem leadingTerm_nonneg_iff {x : Surreal} : 0 ≤ leadingTerm x ↔ 0 ≤ x := by + simp [leadingTerm] + +@[simp] +theorem leadingTerm_nonpos_iff {x : Surreal} : leadingTerm x ≤ 0 ↔ x ≤ 0 := by + simp [leadingTerm, mul_nonpos_iff] + +@[simp] +theorem leadingTerm_pos_iff {x : Surreal} : 0 < leadingTerm x ↔ 0 < x := by + simp [← not_le] + +@[simp] +theorem leadingTerm_neg_iff {x : Surreal} : leadingTerm x < 0 ↔ x < 0 := by + simp [← not_le] + +theorem mk_lt_mk_sub_leadingTerm {x : Surreal} (hx : x ≠ 0) : + ArchimedeanClass.mk x < .mk (x - x.leadingTerm) := by + rw [← LinearOrderedAddCommGroupWithTop.sub_lt_sub_iff_left_of_ne_top + (a := .mk <| ω^ x.wlog) (by simp)] + simp_rw [← ArchimedeanClass.mk_div, sub_div, mk_div_wpow_wlog_of_ne_zero hx] + convert mk_sub_stdPart_pos Real.toSurrealRingHom _ + · simp [leadingTerm, leadingCoeff] + · rw [mk_div_wpow_wlog_of_ne_zero hx] + +@[simp] +theorem mk_leadingTerm (x : Surreal) : ArchimedeanClass.mk x.leadingTerm = .mk x := by + obtain rfl | hx := eq_or_ne x 0; · simp + simpa using mk_sub_eq_mk_left (mk_lt_mk_sub_leadingTerm hx) + +theorem leadingTerm_veq (x : Surreal) : x.leadingTerm =ᵥ x := + veq_def.2 (mk_leadingTerm x) + +@[simp] +theorem wlog_leadingTerm (x : Surreal) : x.leadingTerm.wlog = x.wlog := + wlog_congr x.leadingTerm_veq + +@[simp] +theorem leadingCoeff_leadingTerm (x : Surreal) : x.leadingTerm.leadingCoeff = x.leadingCoeff := by + simp [leadingTerm] + +@[simp] +theorem leadingTerm_leadingTerm (x : Surreal) : x.leadingTerm.leadingTerm = x.leadingTerm := by + apply (leadingTerm_mul ..).trans + simp [leadingTerm] + +private theorem leadingTerm_mono' {x y : Surreal} (hx : 0 ≤ x) (h : x ≤ y) : + x.leadingTerm ≤ y.leadingTerm := by + have hy := hx.trans h + obtain hxy | hxy := (mk_antitoneOn hx hy h).eq_or_lt + · have hxy' := wlog_congr (veq_def.2 hxy) + unfold leadingTerm + rw [hxy', mul_le_mul_iff_left₀ (wpow_pos _), Real.toSurreal_le_iff] + exact leadingCoeff_monotoneOn _ rfl hxy' h + · apply (lt_of_mk_lt_mk_of_nonneg ..).le <;> simpa + +theorem leadingTerm_mono : Monotone leadingTerm := by + intro x y h + obtain hx | hx := le_total 0 x + · exact leadingTerm_mono' hx h + · obtain hy | hy := le_total 0 y + · exact (leadingTerm_nonpos_iff.2 hx).trans (leadingTerm_nonneg_iff.2 hy) + · rw [← neg_le_neg_iff, ← leadingTerm_neg, ← leadingTerm_neg] + apply leadingTerm_mono' <;> simpa + +theorem leadingTerm_eq {x y : Surreal} {r : ℝ} (hr : r ≠ 0) + (hL : ∀ s < r, s * ω^ y ≤ x) (hR : ∀ s > r, x ≤ s * ω^ y) : leadingTerm x = r * ω^ y := by + rw [leadingTerm, leadingCoeff_eq hr hL hR, wlog_eq hr hL hR] + +theorem leadingTerm_add_eq_left {x y : Surreal} (h : y <ᵥ x) : + leadingTerm (x + y) = leadingTerm x := by + rw [leadingTerm, leadingTerm, leadingCoeff_add_eq_left h, wlog_add_eq_left h] + +theorem leadingTerm_add_eq_right {x y : Surreal} (h : y <ᵥ x) : + leadingTerm (y + x) = leadingTerm x := by + rw [add_comm, leadingTerm_add_eq_left h] + +theorem leadingTerm_sub_eq_left {x y : Surreal} : y <ᵥ x → + leadingTerm (x - y) = leadingTerm x := by + simpa [sub_eq_add_neg] using @leadingTerm_add_eq_left x (-y) + +theorem leadingTerm_sub_eq_right {x y : Surreal} : y <ᵥ x → + leadingTerm (y - x) = -leadingTerm x := by + simpa [sub_eq_add_neg] using @leadingTerm_add_eq_right (-x) y + +end Surreal +end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean new file mode 100644 index 0000000000..4f4425500e --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean @@ -0,0 +1,641 @@ +/- +Copyright (c) 2024 Theodore Hwa. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro, Kim Morrison, Violeta Hernández Palacios, Junyan Xu, Theodore Hwa +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Basic + +import Mathlib.Logic.Hydra +import Mathlib.Tactic.Abel + +/-! +# Surreal multiplication + +In this file, we show that multiplication of surreal numbers is well-defined, and thus the surreal +numbers form a linear ordered commutative ring. This is Theorem 8 in [Conway2001], or Theorem 3.8 in +[SchleicherStoll]. + +An inductive argument proves the following three main theorems: + +* P1: being numeric is closed under multiplication, +* P2: multiplying a numeric pregame by equivalent numeric pregames results in equivalent pregames, +* P3: the product of two positive numeric pregames is positive (`mul_pos`). + +P1 allows us to define multiplication as an operation on numeric pregames, P2 says that this is +well-defined as an operation on the quotient by `IGame.Equiv`, namely the surreal numbers, and P3 is +an axiom that needs to be satisfied for the surreals to be a `OrderedRing`. + +We follow the proof in [SchleicherStoll], except that we use the well-foundedness of the hydra +relation `CutExpand` on `Multiset IGame` instead of the argument based on a depth function in the +paper. As in said argument, P3 is proven by proxy of an auxiliary P4, which states that for +`x₁ < x₂` and `y`, then `x₁ * y + x₂ * a < x₁ * a + x₂ * y` when `a ∈ yᴸ`, and +`x₁ * b + x₂ * y < x₁ * y + x₂ * b` when `b ∈ yᴿ`. + +## Reducing casework + +This argument is very casework heavy in a way that's difficult to automate. For instance, in P1, we +have to prove four different inequalities of the form +`a ∈ (x * y)ᴸ → b ∈ (x * y)ᴿ → a < b`, and depending on what form the options of +`x * y` take, we have to apply different instantiations of the inductive hypothesis. + +To greatly simplify things, we work uniquely in terms of left options, which we achieve by rewriting +`a ∈ xᴿ` as `-a ∈ (-x)ᴸ`. We then show that our distinct lemmas and inductive +hypotheses are invariant under the appropriate sign changes. In the P1 example, this makes it so +that one case (`mulOption_lt_of_lt`) is enough to conclude the others (`mulOption_lt`), and the same +goes for the other parts of the proof. + +Note also that we express all inequalities in terms of `Game` instead of `IGame`; this allows us to +make use of `abel` and all of the theorems on `OrderedAddCommGroup`. +-/ + +universe u + +open Game IGame Relation WellFounded + +/-- A characterization of left moves of `x * y` in terms only of left moves. -/ +lemma forall_leftMoves_mul' {P : IGame → Prop} {x y : IGame} : + (∀ a ∈ (x * y)ᴸ, P a) ↔ + (∀ a ∈ xᴸ, ∀ b ∈ yᴸ, P (mulOption x y a b)) ∧ + (∀ a ∈ (-x)ᴸ, ∀ b ∈ (-y)ᴸ, P (mulOption (-x) (-y) a b)) := by + rw [forall_moves_mul] + simp [mulOption_neg] + +/-- A characterization of right moves of `x * y` in terms only of left moves. -/ +lemma forall_rightMoves_mul' {P : IGame → Prop} {x y : IGame} : + (∀ a ∈ (x * y)ᴿ, P a) ↔ + (∀ a ∈ xᴸ, ∀ b ∈ (-y)ᴸ, P (-mulOption x (-y) a b)) ∧ + (∀ a ∈ (-x)ᴸ, ∀ b ∈ yᴸ, P (-mulOption (-x) y a b)) := by + rw [forall_moves_mul] + simp [mulOption_neg_right, mulOption_neg_left] + +/-! ### Predicates P1 – P4 -/ + +/-- `P1 x y a b c d` means that `mulOption x y a b < mulOption x y c d`. This is the general form +of the statements needed to prove that `x * y` is numeric. -/ +def P1 (x y a b c d : IGame) := Game.mk (mulOption x y a b) < Game.mk (mulOption x y c d) + +/-- `P2 x₁ x₂ y` states that if `x₁ ≈ x₂`, then `x₁ * y ≈ x₂ * y`. The RHS is stated in terms of +`Game.mk` for rewriting convenience. -/ +def P2 (x₁ x₂ y : IGame) := x₁ ≈ x₂ → Game.mk (x₁ * y) = Game.mk (x₂ * y) + +/-- `P3 x₁ x₂ y₁ y₂` states that `x₁ * y₂ + x₂ * y₁ < x₁ * y₁ + x₂ * y₂`. Using distributivity, this +is equivalent to `(x₁ - x₂) * (y₁ - y₂) > 0`. -/ +def P3 (x₁ x₂ y₁ y₂ : IGame) := + Game.mk (x₁ * y₂) + Game.mk (x₂ * y₁) < Game.mk (x₁ * y₁) + Game.mk (x₂ * y₂) + +/-- `P4 x₁ x₂ y` states that if `x₁ < x₂`, then `P3 x₁ x₂ a y` when `a ∈ yᴸ`, and +`P3 x₁ x₂ b y` when `b ∈ yᴿ`. + +Note that we instead write this second part as `P3 x₁ x₂ b (-y)` when `b ∈ (-y)ᴸ`. See the +module docstring for an explanation. -/ +def P4 (x₁ x₂ y : IGame) := + x₁ < x₂ → (∀ a ∈ yᴸ, P3 x₁ x₂ a y) ∧ (∀ b ∈ (-y)ᴸ, P3 x₁ x₂ b (-y)) + +/-- The conjunction of `P2` and `P4`. Both statements have the same amount of arguments and satisfy +similar symmetry properties, so we can slightly simplify the argument by merging them. -/ +def P24 (x₁ x₂ y : IGame) : Prop := P2 x₁ x₂ y ∧ P4 x₁ x₂ y + +variable {x x₁ x₂ x₃ x' y y₁ y₂ y₃ y' a b c d : IGame.{u}} + +/-! #### Symmetry properties of P1 – P4 -/ + +lemma P3_comm : P3 x₁ x₂ y₁ y₂ ↔ P3 y₁ y₂ x₁ x₂ := by + simp [P3, add_comm, mul_comm] + +lemma P3.trans (h₁ : P3 x₁ x₂ y₁ y₂) (h₂ : P3 x₂ x₃ y₁ y₂) : P3 x₁ x₃ y₁ y₂ := by + rw [P3, ← add_lt_add_iff_left (Game.mk (x₂ * y₁) + Game.mk (x₂ * y₂))] + convert add_lt_add h₁ h₂ using 1 <;> abel + +lemma P3_neg : P3 (-x₂) (-x₁) y₁ y₂ ↔ P3 x₁ x₂ y₁ y₂ := by + simp_rw [P3, neg_mul, Game.mk_neg] + rw [← _root_.neg_lt_neg_iff] + abel_nf + +lemma P2_neg_left : P2 (-x₂) (-x₁) y ↔ P2 x₁ x₂ y := by + simp [P2, AntisymmRel, eq_comm] + +lemma P2_neg_right : P2 x₁ x₂ (-y) ↔ P2 x₁ x₂ y := by + simp [P2] + +lemma P4_neg_left : P4 (-x₂) (-x₁) y ↔P4 x₁ x₂ y := by + simp_rw [P4, IGame.neg_lt_neg_iff, P3_neg] + +lemma P4_neg_right : P4 x₁ x₂ (-y) ↔ P4 x₁ x₂ y := by + rw [P4, P4, neg_neg, and_comm] + +lemma P24_neg_left : P24 (-x₂) (-x₁) y ↔ P24 x₁ x₂ y := by rw [P24, P24, P2_neg_left, P4_neg_left] +lemma P24_neg_right : P24 x₁ x₂ (-y) ↔ P24 x₁ x₂ y := by rw [P24, P24, P2_neg_right, P4_neg_right] + +/-! ### Inductive setup -/ + +/-- The type of lists of arguments for `P1`, `P2`, and `P4`. -/ +inductive Args : Type (u + 1) + | P1 (x y : IGame.{u}) : Args + | P24 (x₁ x₂ y : IGame.{u}) : Args + +/-- The multiset associated to a list of arguments. -/ +def Args.toMultiset : Args → Multiset IGame + | (Args.P1 x y) => {x, y} + | (Args.P24 x₁ x₂ y) => {x₁, x₂, y} + +@[simp] lemma Args.toMultiset_P1 {x y} : (Args.P1 x y).toMultiset = {x, y} := rfl +@[simp] lemma Args.toMultiset_P24 {x₁ x₂ y} : (Args.P24 x₁ x₂ y).toMultiset = {x₁, x₂, y} := rfl + +/-- A list of arguments is numeric if all the arguments are. -/ +def Args.Numeric (a : Args) := ∀ x ∈ a.toMultiset, x.Numeric + +lemma Args.numeric_P1 {x y} : (Args.P1 x y).Numeric ↔ x.Numeric ∧ y.Numeric := by + simp [Args.Numeric, Args.toMultiset] + +lemma Args.numeric_P24 {x₁ x₂ y} : + (Args.P24 x₁ x₂ y).Numeric ↔ x₁.Numeric ∧ x₂.Numeric ∧ y.Numeric := by + simp [Args.Numeric, Args.toMultiset] + +/-- The well-founded relation specifying when a list of game arguments is considered simpler than +another: `ArgsRel a₁ a₂` is true if `a₁`, considered as a multiset, can be obtained from `a₂` by +repeatedly removing a game from `a₂` and adding back one or two options of the game. + +See also `WellFounded.CutExpand`. -/ +def ArgsRel := InvImage (TransGen <| CutExpand fun x y => ∃ p, x ∈ y.moves p) Args.toMultiset + +/-- `ArgsRel` is well-founded. -/ +lemma argsRel_wf : WellFounded ArgsRel := + InvImage.wf _ (Subrelation.wf (fun h => h.elim fun _ => Subposition.of_mem_moves) + subposition_wf).cutExpand.transGen +instance : IsWellFounded _ ArgsRel := ⟨argsRel_wf⟩ + +/-- The property that all arguments are numeric is leftward-closed under `ArgsRel`. -/ +lemma ArgsRel.numeric_closed {a' a} : ArgsRel a' a → a.Numeric → a'.Numeric := + TransGen.closed' <| @cutExpand_closed _ _ + ⟨fun _ h => (h.elim fun _ => Subposition.of_mem_moves).irrefl⟩ _ fun h h' ↦ + h'.subposition (h.elim fun _ => Subposition.of_mem_moves) + +/-- The statement that we will show by induction for all `Numeric` args, using the well-founded +relation `ArgsRel`. + +The inductive hypothesis in the proof will be `∀ a', ArgsRel a' a → P124 a`. -/ +def P124 : Args → Prop + | (Args.P1 x y) => Numeric (x * y) + | (Args.P24 x₁ x₂ y) => P24 x₁ x₂ y + +/-! ### P1 follows from the inductive hypothesis -/ + +lemma numeric_move_mul_of_IH {p : Player} (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) + (h : x' ∈ x.moves p) : (x' * y).Numeric := + IH (Args.P1 x' y) (TransGen.single <| cutExpand_pair_left ⟨p, h⟩) + +lemma numeric_mul_move_of_IH {p : Player} (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) + (h : y' ∈ y.moves p) : (x * y').Numeric := + IH (Args.P1 x y') (TransGen.single <| cutExpand_pair_right ⟨p, h⟩) + +lemma numeric_move_mul_move_of_IH {p q : Player} (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) + (hx : x' ∈ x.moves p) (hy : y' ∈ y.moves q) : (x' * y').Numeric := + IH (Args.P1 x' y') + ((TransGen.single (cutExpand_pair_right ⟨q, hy⟩)).tail (cutExpand_pair_left ⟨p, hx⟩)) + +/-- A specialization of the inductive hypothesis used to prove `P1`. -/ +def IH1 (x y : IGame) : Prop := + ∀ ⦃p q x₁ x₂ y'⦄, x₁ ∈ x.moves p → x₂ ∈ x.moves q → (y' = y ∨ ∃ u, y' ∈ y.moves u) → P24 x₁ x₂ y' + +/-- `IH1 x y` follows from the inductive hypothesis for `P1 x y`. -/ +lemma IH1_of_IH (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) : IH1 x y := by + rintro p q x₁ x₂ y' h₁ h₂ (rfl | hy) <;> apply IH (.P24 ..) + on_goal 2 => refine .tail ?_ (cutExpand_pair_right hy) + all_goals exact .single (cutExpand_double_left ⟨p, h₁⟩ ⟨q, h₂⟩) + +/-- `IH1 y x` follows from the inductive hypothesis for `P1 x y`. -/ +lemma IH1_swap_of_IH (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) : IH1 y x := IH1_of_IH <| by + simpa [-Multiset.insert_eq_cons, ArgsRel, InvImage, Multiset.pair_comm] using IH + +lemma IH1_neg_left : IH1 x y → IH1 (-x) y := by + intro h p q x₁ x₂ y' h₁ h₂ hy + rw [moves_neg] at h₁ h₂ + exact P24_neg_left.1 (h h₂ h₁ hy) + +lemma IH1_neg_right : IH1 x y → IH1 x (-y) := by + intro h p q x₁ x₂ y' h₁ h₂ hy + rw [← P24_neg_right] + apply h h₁ h₂ + simpa [neg_eq_iff_eq_neg, or_comm] using hy + +lemma P1_of_equiv (he : x₁ ≈ x₃) (h₁ : P2 x₁ x₃ y₁) (h₃ : P2 x₁ x₃ y₃) (h3 : P3 x₁ x₂ y₂ y₃) : + P1 x₂ y₁ x₁ y₂ x₃ y₃ := by + rw [P1, mk_mulOption, mk_mulOption, ← h₁ he, ← h₃ he, sub_lt_sub_iff] + convert add_lt_add_left h3 (.mk (x₁ * y₁)) using 1 <;> abel + +lemma P1_of_P3 (h₁ : P3 x₃ x₂ y₂ y₃) (h₂ : P3 x₁ x₃ y₂ y₁) : P1 x₂ y₁ x₁ y₂ x₃ y₃ := by + rw [P1, mk_mulOption, mk_mulOption, sub_lt_sub_iff, ← add_lt_add_iff_left (.mk (x₃ * y₂))] + convert add_lt_add h₁ h₂ using 1 <;> abel + +lemma P3_of_IH1 [Numeric y] (ihyx : IH1 y x) + (ha : a ∈ xᴸ) (hb : b ∈ yᴸ) (hd : d ∈ (-y)ᴸ) : P3 a x b (-d) := by + rw [P3_comm] + rw [moves_neg] at hd + refine ((ihyx hb hd (.inl rfl)).2 ?_).1 a ha + exact Numeric.left_lt_right hb hd + +lemma P24_of_IH1 (ihxy : IH1 x y) (ha : a ∈ xᴸ) (hb : b ∈ xᴸ) : P24 a b y := + ihxy ha hb (Or.inl rfl) + +lemma mulOption_lt_iff_P1 : + Game.mk (mulOption x y a b) < -Game.mk (mulOption x (-y) c d) ↔ P1 x y a b c (-d) := by + simp [P1, mulOption, sub_eq_add_neg, add_comm] + +lemma mulOption_lt_of_lt [Numeric y] (ihxy : IH1 x y) (ihyx : IH1 y x) {a b c d} (h : a < c) + (ha : a ∈ xᴸ) (hb : b ∈ yᴸ) (hc : c ∈ xᴸ) (hd : d ∈ (-y)ᴸ) : + Game.mk (mulOption x y a b) < -Game.mk (mulOption x (-y) c d) := by + rw [mulOption_lt_iff_P1] + exact P1_of_P3 (P3_of_IH1 ihyx hc hb hd) <| ((P24_of_IH1 ihxy ha hc).2 h).1 b hb + +lemma mulOption_lt [Numeric x] [Numeric y] (ihxy : IH1 x y) (ihyx : IH1 y x) {a b c d} + (ha : a ∈ xᴸ) (hb : b ∈ yᴸ) (hc : c ∈ xᴸ) (hd : d ∈ (-y)ᴸ) : + Game.mk (mulOption x y a b) < -Game.mk (mulOption x (-y) c d) := by + numeric + obtain (h | h | h) := Numeric.lt_or_equiv_or_gt a c + · exact mulOption_lt_of_lt ihxy ihyx h ha hb hc hd + · exact mulOption_lt_iff_P1.2 (P1_of_equiv h (P24_of_IH1 ihxy ha hc).1 + (ihxy ha hc <| .inr ⟨right, by simpa using hd⟩).1 <| P3_of_IH1 ihyx ha hb hd) + · rw [← neg_neg y] at hb + simpa [lt_neg] using mulOption_lt_of_lt (IH1_neg_right ihxy) (IH1_neg_left ihyx) h hc hd ha hb + +/-- `P1` follows from the induction hypothesis. -/ +lemma P1_of_IH (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) [Numeric x] [Numeric y] : + (x * y).Numeric := by + have ihxy := IH1_of_IH IH + have ihyx := IH1_swap_of_IH IH + have ihxyn := IH1_neg_left (IH1_neg_right ihxy) + have ihyxn := IH1_neg_left (IH1_neg_right ihyx) + refine .mk ?_ ?_ + · simp_rw [forall_leftMoves_mul', forall_rightMoves_mul'] + constructor <;> intro a ha b hb <;> constructor <;> intro c hc d hd + · exact mulOption_lt ihxy ihyx ha hb hc hd + · simpa [mulOption_comm, ← mk_lt_mk] using mulOption_lt ihyx ihxy hb ha hd hc + · rw [← neg_neg x] at hc + simpa [mulOption_comm, ← mk_lt_mk] using mulOption_lt ihyxn ihxyn hb ha hd hc + · rw [← neg_neg y] at hd + simpa [← mk_lt_mk] using mulOption_lt ihxyn ihyxn ha hb hc hd + · intro p + simp only [moves_mul, moves_mul, mulOption, Set.mem_image, Prod.exists, + forall_exists_index, and_imp] + rintro _ a b (⟨ha, hb⟩ | ⟨ha, hb⟩) rfl + all_goals + have := numeric_move_mul_of_IH IH ha + have := numeric_mul_move_of_IH IH hb + have := numeric_move_mul_move_of_IH IH ha hb + infer_instance + +/-! ### P2 follows from the inductive hypothesis -/ + +lemma numeric_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : + (x₁ * y).Numeric ∧ (x₂ * y).Numeric := by + constructor <;> refine IH (.P1 ..) (.single ?_) + · exact (cutExpand_add_right {y}).2 <| (cutExpand_add_left {x₁}).2 cutExpand_zero + · exact (cutExpand_add_right {x₂, y}).2 cutExpand_zero + +/-- A specialization of the inductive hypothesis used to prove `P2` and `P4`. -/ +def IH24 (x₁ x₂ y : IGame) : Prop := + ∀ ⦃p z⦄, + (z ∈ x₁.moves p → P24 z x₂ y) ∧ + (z ∈ x₂.moves p → P24 x₁ z y) ∧ + (z ∈ y.moves p → P24 x₁ x₂ z) + +/-- A specialization of the induction hypothesis used to prove `P4`. -/ +def IH4 (x₁ x₂ y : IGame) : Prop := + ∀ ⦃p q z w⦄, w ∈ y.moves p → (z ∈ x₁.moves q → P2 z x₂ w) ∧ (z ∈ x₂.moves q → P2 x₁ z w) + +/-- `IH24 x₁ x₂ y` follows from the inductive hypothesis for `P24 x₁ x₂ y`. -/ +lemma IH24_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : IH24 x₁ x₂ y := by + rw [IH24] + refine fun p z ↦ ⟨?_, ?_, ?_⟩ <;> refine fun h ↦ IH (.P24 ..) (.single ?_) + · exact (cutExpand_add_right {y}).2 (cutExpand_pair_left ⟨p, h⟩) + · exact (cutExpand_add_left {x₁}).2 (cutExpand_pair_left ⟨p, h⟩) + · exact (cutExpand_add_left {x₁}).2 (cutExpand_pair_right ⟨p, h⟩) + +/-- `IH24 x₂ x₁ y` follows from the inductive hypothesis for `P24 x₁ x₂ y`. -/ +lemma IH24_swap_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : IH24 x₂ x₁ y := by + apply IH24_of_IH + convert IH using 2 + dsimp [ArgsRel, InvImage, Multiset.insert_eq_cons, ← Multiset.singleton_add] + abel_nf + +/-- `IH4 x₁ x₂ y` follows from the inductive hypothesis for `P24 x₁ x₂ y`. -/ +lemma IH4_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : IH4 x₁ x₂ y := by + refine fun p q a b h ↦ ⟨?_, ?_⟩ <;> + refine fun h' ↦ (IH (.P24 ..) <| (TransGen.single ?_).tail <| + (cutExpand_add_left {x₁}).2 <| cutExpand_pair_right ⟨p, h⟩).1 + · exact (cutExpand_add_right {b}).2 <| cutExpand_pair_left ⟨q, h'⟩ + · exact (cutExpand_add_right {b}).2 <| cutExpand_pair_right ⟨q, h'⟩ + +lemma IH24_neg : IH24 x₁ x₂ y → IH24 (-x₂) (-x₁) y ∧ IH24 x₁ x₂ (-y) := by + simp_rw [IH24, P24_neg_right, moves_neg] + refine fun h ↦ ⟨fun p z ↦ ⟨?_, ?_, ?_⟩, + fun p z ↦ ⟨(@h p z).1, (@h p z).2.1, P24_neg_right.1 ∘ (@h (-p) (-z)).2.2⟩⟩ + all_goals + rw [← P24_neg_left] + simp only [neg_neg] + · exact (@h (-p) (-z)).2.1 + · exact (@h (-p) (-z)).1 + · exact (@h p z).2.2 + +lemma IH4_neg : IH4 x₁ x₂ y → IH4 (-x₂) (-x₁) y ∧ IH4 x₁ x₂ (-y) := by + simp_rw [IH4, moves_neg, Set.mem_neg] + refine fun h ↦ ⟨fun p q z w h' ↦ ?_, fun p q z w h' ↦ ?_⟩ + · convert (h h').symm using 2 <;> rw [← P2_neg_left, neg_neg] + · convert h h' using 2 <;> rw [P2_neg_right] + +lemma mulOption_lt_mul_of_equiv [Numeric x₁] (h : IH24 x₁ x₂ y) (he : x₁ ≈ x₂) + (hi : a ∈ x₁ᴸ) (hj : b ∈ yᴸ) : + Game.mk (mulOption x₁ y a b) < Game.mk (x₂ * y) := by + convert sub_lt_iff_lt_add'.2 (((h.1 hi).2 _).1 b hj) using 1 + · rw [← (h.2.2 hj).1 he] + rfl + · grw [← he] + exact Numeric.left_lt hi + +lemma mul_right_le_of_equiv [Numeric x₁] [Numeric x₂] + (ih₁₂ : IH24 x₁ x₂ y) (ih₂₁ : IH24 x₂ x₁ y) (he : x₁ ≈ x₂) : x₁ * y ≤ x₂ * y := by + have he' := neg_equiv_neg_iff.2 he + rw [IGame.le_iff_forall_lf] + simp_rw [← Game.mk_le_mk] + constructor + · rw [forall_leftMoves_mul'] + constructor <;> intro a ha b hb + · exact (mulOption_lt_mul_of_equiv ih₁₂ he ha hb).not_ge + · simpa using (mulOption_lt_mul_of_equiv (IH24_neg <| (IH24_neg ih₂₁).1).2 he' ha hb).not_ge + · rw [forall_rightMoves_mul'] + constructor <;> intro a ha b hb + · simpa [neg_le] using (mulOption_lt_mul_of_equiv (IH24_neg ih₂₁).2 he.symm ha hb).not_ge + · simpa [neg_le] using (mulOption_lt_mul_of_equiv (IH24_neg ih₁₂).1 he'.symm ha hb).not_ge + +/-- `P2` follows from the induction hypothesis. -/ +lemma P2_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) [Numeric x₁] [Numeric x₂] + (he : x₁ ≈ x₂) : x₁ * y ≈ x₂ * y := + ⟨mul_right_le_of_equiv (IH24_of_IH IH) (IH24_swap_of_IH IH) he, + mul_right_le_of_equiv (IH24_swap_of_IH IH) (IH24_of_IH IH) he.symm⟩ + +/-! ### P4 follows from the inductive hypothesis -/ + +lemma mulOption_lt_mul_iff_P3 : mulOption x y a b < x * y ↔ P3 a x b y := + @sub_lt_iff_lt_add' Game _ _ _ (.mk _) (.mk _) (.mk _) + +/-- A specialization of the induction hypothesis used to prove `P3`. -/ +def IH3 (x₁ x' x₂ y₁ y₂ : IGame) : Prop := + P2 x₁ x' y₁ ∧ P2 x₁ x' y₂ ∧ P3 x' x₂ y₁ y₂ ∧ (x₁ < x' → P3 x₁ x' y₁ y₂) + +/-- `IH3` follows from the induction hypothesis for `P24 x₁ x₂ y`. -/ +lemma IH3_of_IH (ih24 : IH24 x₁ x₂ y) (ih4 : IH4 x₁ x₂ y) + (hi : a ∈ x₂ᴸ) (hb : b ∈ yᴸ) (hl : mulOption x₂ y a b < x₂ * y) : + IH3 x₁ a x₂ b y := + have h24 := ih24.2.1 hi + ⟨(ih4 hb).2 hi, h24.1, + mulOption_lt_mul_iff_P3.1 hl, fun l ↦ (h24.2 l).1 b hb⟩ + +lemma P3_of_le_left {y₁ y₂} (i) (h : IH3 x₁ i x₂ y₁ y₂) (hl : x₁ ≤ i) : P3 x₁ x₂ y₁ y₂ := by + obtain (hl | he) := le_iff_lt_or_antisymmRel.1 hl + · exact (h.2.2.2 hl).trans h.2.2.1 + · rw [P3, h.1 he, h.2.1 he] + exact h.2.2.1 + +/-- P3 follows from `IH3`, so P4 (with `y₁` a left option of `y₂`) follows from the induction +hypothesis. -/ +lemma P3_of_IH3 {y₁ y₂} (h : ∀ i ∈ x₂ᴸ, IH3 x₁ i x₂ y₁ y₂) + (hs : ∀ i ∈ (-x₁)ᴸ, IH3 (-x₂) i (-x₁) y₁ y₂) (hl : x₁ < x₂) : P3 x₁ x₂ y₁ y₂ := by + obtain (⟨i, hi, hi'⟩ | ⟨i, hi, hi'⟩) := lf_iff_exists_le.1 hl.not_ge + · exact P3_of_le_left i (h i hi) hi' + · refine P3_neg.1 <| P3_of_le_left _ (hs (-i) ?_) ?_ <;> simpa + +/-- `P4` follows from the induction hypothesis. -/ +lemma P4_of_IH (IH : ∀ a, ArgsRel a (.P24 x₁ x₂ y) → P124 a) : P4 x₁ x₂ y := by + have h₁₂ := IH24_of_IH IH + have h4 := IH4_of_IH IH + obtain ⟨h₁₂x, h₁₂y⟩ := IH24_neg h₁₂ + obtain ⟨h4x, h4y⟩ := IH4_neg h4 + have := (IH24_neg h₁₂y).1 + have := (IH4_neg h4y).1 + obtain ⟨hn₁, hn₂⟩ := numeric_of_IH IH + have : (-x₁ * y).Numeric := by simpa + have : (-x₁ * -y).Numeric := by simpa + have : (x₂ * -y).Numeric := by simpa + refine fun hl ↦ ⟨?_, ?_⟩ <;> + refine fun a ha ↦ P3_of_IH3 ?_ ?_ hl <;> + intro b hb <;> + apply IH3_of_IH + assumption' + all_goals + exact Numeric.left_lt (mulOption_mem_moves_mul hb ha) + +/-- We tie everything together to complete the induction. -/ +theorem main (a : Args) : a.Numeric → P124 a := by + apply argsRel_wf.induction a + intro a IH ha + replace ih : ∀ a', ArgsRel a' a → P124 a' := fun a' hr ↦ IH a' hr (hr.numeric_closed ha) + cases a with + | P1 x y => + obtain ⟨_, _⟩ := Args.numeric_P1.1 ha + exact P1_of_IH ih + | P24 x₁ x₂ y => + obtain ⟨_, _, _⟩ := Args.numeric_P24.1 ha + constructor + · exact (Game.mk_eq <| P2_of_IH ih ·) + · exact P4_of_IH ih + +lemma main_P24 (x₁ x₂ y : IGame) [hx₁ : Numeric x₁] [hx₂ : Numeric x₂] [hy : Numeric y] : + P24 x₁ x₂ y := + main _ <| Args.numeric_P24.mpr ⟨hx₁, hx₂, hy⟩ + +/-- One additional inductive argument proves `P3`. -/ +lemma P3_of_lt_of_lt {x₁ x₂ y₁ y₂} [Numeric x₁] [Numeric x₂] [Numeric y₁] [Numeric y₂] + (hx : x₁ < x₂) (hy : y₁ < y₂) : P3 x₁ x₂ y₁ y₂ := by + refine P3_of_IH3 ?_ ?_ hx + all_goals + intro i hi + numeric + refine ⟨(main_P24 ..).1, (main_P24 ..).1, P3_comm.2 ?_, fun h ↦ ?_⟩ + · exact ((main_P24 y₁ y₂ x₂).2 hy).1 _ hi + · exact P3_of_lt_of_lt h hy + · exact ((main_P24 y₁ y₂ x₁).2 hy).2 _ hi + · rw [IGame.neg_lt] at h + rw [← P3_neg, neg_neg] + exact P3_of_lt_of_lt h hy +termination_by (x₁, x₂) +decreasing_by all_goals (try rw [moves_neg] at *); igame_wf + +/-! ### Instances and corollaries -/ + +public section + +namespace IGame.Numeric + +variable {x x₁ x₂ y y₁ y₂ : IGame} + +instance mul (x y : IGame) [hx : Numeric x] [hy : Numeric y] : Numeric (x * y) := + main _ <| Args.numeric_P1.mpr ⟨hx, hy⟩ + +protected instance mulOption (x y a b : IGame) [Numeric x] [Numeric y] [Numeric a] [Numeric b] : + Numeric (mulOption x y a b) := + .sub .. + +theorem mul_congr_left [Numeric x₁] [Numeric x₂] [Numeric y] (he : x₁ ≈ x₂) : x₁ * y ≈ x₂ * y := + Game.mk_eq_mk.1 ((main_P24 ..).1 he) + +theorem mul_congr_right [Numeric x] [Numeric y₁] [Numeric y₂] (he : y₁ ≈ y₂) : x * y₁ ≈ x * y₂ := by + rw [mul_comm, mul_comm x]; exact Numeric.mul_congr_left he + +theorem mul_congr [Numeric x₁] [Numeric x₂] [Numeric y₁] [Numeric y₂] + (hx : x₁ ≈ x₂) (hy : y₁ ≈ y₂) : x₁ * y₁ ≈ x₂ * y₂ := + (mul_congr_left hx).trans (mul_congr_right hy) + +protected theorem mul_pos [Numeric x₁] [Numeric x₂] (h₁ : 0 < x₁) (h₂ : 0 < x₂) : 0 < x₁ * x₂ := by + simpa [P3, ← mk_lt_mk] using P3_of_lt_of_lt h₁ h₂ + +end IGame.Numeric + +namespace Surreal + +noncomputable instance : CommRing Surreal where + mul := Quotient.map₂ (fun a b ↦ ⟨a.1 * b.1, inferInstance⟩) fun _ _ h _ _ ↦ Numeric.mul_congr h + zero_mul := by rintro ⟨x⟩; change mk (0 * x) = mk 0; simp_rw [zero_mul] + mul_zero := by rintro ⟨x⟩; change mk (x * 0) = mk 0; simp_rw [mul_zero] + one_mul := by rintro ⟨x⟩; change mk (1 * x) = mk x; simp_rw [one_mul] + mul_one := by rintro ⟨x⟩; change mk (x * 1) = mk x; simp_rw [mul_one] + left_distrib := by rintro ⟨x⟩ ⟨y⟩ ⟨z⟩; exact mk_eq (mul_add_equiv ..) + right_distrib := by rintro ⟨x⟩ ⟨y⟩ ⟨z⟩; exact mk_eq (add_mul_equiv ..) + mul_comm := by rintro ⟨x⟩ ⟨y⟩; change mk (x * y) = mk (y * x); simp_rw [mul_comm] + mul_assoc := by rintro ⟨x⟩ ⟨y⟩ ⟨z⟩; exact mk_eq (mul_assoc_equiv ..) + +instance : IsStrictOrderedRing Surreal := + .of_mul_pos (by rintro ⟨x⟩ ⟨y⟩; exact Numeric.mul_pos) + +@[simp] +theorem mk_mul (x y : IGame) [Numeric x] [Numeric y] : + Surreal.mk (x * y) = Surreal.mk x * Surreal.mk y := + rfl + +end Surreal + +namespace IGame.Numeric + +protected theorem mul_neg_of_pos_of_neg {x y : IGame} [Numeric x] [Numeric y] + (hx : 0 < x) (hy : y < 0) : x * y < 0 := + @mul_neg_of_pos_of_neg Surreal _ (.mk x) (.mk y) _ _ hx hy + +protected theorem mul_neg_of_neg_of_pos {x y : IGame} [Numeric x] [Numeric y] + (hx : x < 0) (hy : 0 < y) : x * y < 0 := + @mul_neg_of_neg_of_pos Surreal _ (.mk x) (.mk y) _ _ hx hy + +protected theorem mul_pos_of_neg_of_neg {x y : IGame} [Numeric x] [Numeric y] + (hx : x < 0) (hy : y < 0) : 0 < x * y := + @mul_pos_of_neg_of_neg Surreal _ _ _ _ _ _ (.mk x) (.mk y) hx hy + +protected theorem mul_nonneg {x y : IGame} [Numeric x] [Numeric y] + (hx : 0 ≤ x) (hy : 0 ≤ y) : 0 ≤ x * y := + @mul_nonneg Surreal _ (.mk x) (.mk y) _ _ hx hy + +protected theorem mul_nonpos_of_nonneg_of_nonpos {x y : IGame} [Numeric x] [Numeric y] + (hx : 0 ≤ x) (hy : y ≤ 0) : x * y ≤ 0 := + @mul_nonpos_of_nonneg_of_nonpos Surreal _ (.mk x) (.mk y) _ _ hx hy + +protected theorem mul_nonpos_of_nonpos_of_nonneg {x y : IGame} [Numeric x] [Numeric y] + (hx : x ≤ 0) (hy : 0 ≤ y) : x * y ≤ 0 := + @mul_nonpos_of_nonpos_of_nonneg Surreal _ (.mk x) (.mk y) _ _ hx hy + +protected theorem mul_nonneg_of_nonpos_of_nonpos {x y : IGame} [Numeric x] [Numeric y] + (hx : x ≤ 0) (hy : y ≤ 0) : 0 ≤ x * y := + @mul_nonneg_of_nonpos_of_nonpos Surreal _ _ (.mk x) (.mk y) _ _ _ _ hx hy + +protected theorem mul_left_cancel {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hx : ¬ x ≈ 0) (h : x * y ≈ x * z) : y ≈ z := by + rw [← Surreal.mk_eq_mk] at * + exact mul_left_cancel₀ hx h + +protected theorem mul_right_cancel {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hx : ¬ x ≈ 0) (h : y * x ≈ z * x) : y ≈ z := by + rw [← Surreal.mk_eq_mk] at * + exact mul_right_cancel₀ hx h + +@[simp] +protected theorem mul_le_mul_iff_left {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hx : 0 < x) : y * x ≤ z * x ↔ y ≤ z := + mul_le_mul_iff_left₀ (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hx + +@[simp] +protected theorem mul_le_mul_iff_right {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hx : 0 < x) : x * y ≤ x * z ↔ y ≤ z := + mul_le_mul_iff_right₀ (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hx + +@[simp] +protected theorem mul_lt_mul_iff_left {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hx : 0 < x) : y * x < z * x ↔ y < z := + mul_lt_mul_iff_left₀ (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hx + +@[simp] +protected theorem mul_lt_mul_iff_right {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hx : 0 < x) : x * y < x * z ↔ y < z := + mul_lt_mul_iff_right₀ (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hx + +@[simp] +protected theorem mul_le_mul_left_of_neg {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hz : z < 0) : z * x ≤ z * y ↔ y ≤ x := + mul_le_mul_left_of_neg (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hz + +@[simp] +protected theorem mul_le_mul_right_of_neg {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hz : z < 0) : x * z ≤ y * z ↔ y ≤ x := + mul_le_mul_right_of_neg (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hz + +@[simp] +protected theorem mul_lt_mul_left_of_neg {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hz : z < 0) : z * x < z * y ↔ y < x := + mul_lt_mul_left_of_neg (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hz + +@[simp] +protected theorem mul_lt_mul_right_of_neg {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hz : z < 0) : x * z < y * z ↔ y < x := + mul_lt_mul_right_of_neg (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hz + +protected theorem mul_le_mul {a b c d : IGame} [Numeric a] [Numeric b] [Numeric c] [Numeric d] : + a ≤ b → c ≤ d → 0 ≤ c → 0 ≤ b → a * c ≤ b * d := + mul_le_mul (a := Surreal.mk a) (b := Surreal.mk b) (c := Surreal.mk c) (d := Surreal.mk d) + +protected theorem mul_lt_mul {a b c d : IGame} [Numeric a] [Numeric b] [Numeric c] [Numeric d] : + a < b → c ≤ d → 0 < c → 0 ≤ b → a * c < b * d := + mul_lt_mul (a := Surreal.mk a) (b := Surreal.mk b) (c := Surreal.mk c) (d := Surreal.mk d) + +@[simp] +protected theorem mul_pos_iff_of_pos_left {a b : IGame} [Numeric a] [Numeric b] : + 0 < a → (0 < a * b ↔ 0 < b) := + mul_pos_iff_of_pos_left (a := Surreal.mk a) (b := Surreal.mk b) + +@[simp] +protected theorem mul_pos_iff_of_pos_right {a b : IGame} [Numeric a] [Numeric b] : + 0 < b → (0 < a * b ↔ 0 < a) := + mul_pos_iff_of_pos_right (a := Surreal.mk a) (b := Surreal.mk b) + +theorem mul_equiv_zero {x y : IGame} [Numeric x] [Numeric y] : x * y ≈ 0 ↔ x ≈ 0 ∨ y ≈ 0 := by + repeat rw [← Surreal.mk_eq_mk] + exact @mul_eq_zero Surreal _ _ (.mk x) (.mk y) + +theorem mulOption_congr₁ {x₁ x₂ y a b : IGame} + [Numeric x₁] [Numeric x₂] [Numeric y] [Numeric a] [Numeric b] (he : x₁ ≈ x₂) : + mulOption x₁ y a b ≈ mulOption x₂ y a b := by + simp_all [← Surreal.mk_eq_mk, mulOption] + +theorem mulOption_congr₂ {x y₁ y₂ a b : IGame} + [Numeric x] [Numeric y₁] [Numeric y₂] [Numeric a] [Numeric b] (he : y₁ ≈ y₂) : + mulOption x y₁ a b ≈ mulOption x y₂ a b := by + simp_all [← Surreal.mk_eq_mk, mulOption] + +theorem mulOption_congr₃ {x y a₁ a₂ b : IGame} + [Numeric x] [Numeric y] [Numeric a₁] [Numeric a₂] [Numeric b] (he : a₁ ≈ a₂) : + mulOption x y a₁ b ≈ mulOption x y a₂ b := by + simp_all [← Surreal.mk_eq_mk, mulOption] + +theorem mulOption_congr₄ {x y a b₁ b₂ : IGame} + [Numeric x] [Numeric y] [Numeric a] [Numeric b₁] [Numeric b₂] (he : b₁ ≈ b₂) : + mulOption x y a b₁ ≈ mulOption x y a b₂ := by + simp_all [← Surreal.mk_eq_mk, mulOption] + +end IGame.Numeric +end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Ordinal.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Ordinal.lean new file mode 100644 index 0000000000..076f304f69 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Ordinal.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Ordinal +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Multiplication +public import Mathlib.Algebra.Order.Hom.Ring + +/-! +# Ordinals as surreals + +We define the canonical map `NatOrdinal → Surreal` in terms of the map `NatOrdinal.toIGame`. +-/ + +open IGame Set Surreal + +@[expose] public noncomputable section + +/-- Ordinal games are numeric. -/ +instance IGame.Numeric.toIGame (o : NatOrdinal) : Numeric o.toIGame := by + rw [numeric_def] + simpa using fun a ha ↦ IGame.Numeric.toIGame a +termination_by o + +namespace NatOrdinal + +/-- Converts an ordinal into the corresponding surreal. -/ +def toSurreal : NatOrdinal ↪o Surreal := + .ofStrictMono (fun o ↦ .mk o.toIGame) fun _ _ h ↦ toIGame.strictMono h + +instance : Coe NatOrdinal Surreal where + coe x := toSurreal x + +@[simp] +theorem _root_.Surreal.mk_natOrdinal_toIGame (o : NatOrdinal) : .mk o.toIGame = o.toSurreal := + rfl + +@[simp] +theorem _root_.Surreal.toGame_toSurreal (o : NatOrdinal) : o.toSurreal.toGame = o.toGame := + rfl + +theorem toSurreal_def (o : NatOrdinal) : o.toSurreal = !{toSurreal '' Iio o | ∅} := by + simp_rw [← Surreal.mk_natOrdinal_toIGame, toIGame_def o, Surreal.mk_ofSets] + congr! <;> aesop + +@[simp] theorem toSurreal_zero : toSurreal 0 = 0 := by simp [← Surreal.mk_natOrdinal_toIGame] +@[simp] theorem toSurreal_one : toSurreal 1 = 1 := by simp [← Surreal.mk_natOrdinal_toIGame] + +theorem toSurreal_nonneg (a : NatOrdinal) : 0 ≤ a.toGame := + toIGame_nonneg a + +@[simp] +theorem toSurreal_add (a b : NatOrdinal) : (a + b).toSurreal = a.toSurreal + b.toSurreal := + mk_eq (toIGame_add a b) + +@[simp] +theorem toSurreal_mul (a b : NatOrdinal) : (a * b).toSurreal = a.toSurreal * b.toSurreal := + mk_eq (toIGame_mul a b) + +/-- `NatOrdinal.toGame` as an `OrderRingHom`. -/ +@[simps] +def toSurrealRingHom : NatOrdinal →+*o Surreal where + toFun := toSurreal + map_zero' := toSurreal_zero + map_one' := toSurreal_one + map_add' := toSurreal_add + map_mul' := toSurreal_mul + monotone' := toSurreal.monotone + +@[simp] +theorem toSurreal_natCast : ∀ n : ℕ, toSurreal n = n := + map_natCast' toSurrealRingHom toSurreal_one + +end NatOrdinal +end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Pow.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Pow.lean new file mode 100644 index 0000000000..7cc01df2a1 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Pow.lean @@ -0,0 +1,861 @@ +/- +Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Ordinal +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Real +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow +public import Mathlib.Algebra.Order.Ring.Archimedean +public import Mathlib.RingTheory.Valuation.ValuativeRel.Basic + +/-! +# Surreal exponentiation + +We define here the ω-map on games and on surreal numbers, representing exponentials with base `ω`. + +Among other things, we prove that every non-zero surreal number is commensurate to some unique +`ω^ x`. We express this using `ArchimedeanClass`. There's two important things to note: + +- The definition of `ArchimedeanClass` involves absolute values, such that e.g. + `-ω` is commensurate to `ω`. +- The order in `ArchimedeanClass` is defined so that the equivalence class of `0` is the **largest** + equivalence class, rather than the smallest. + +## Todo + +- Define the normal form of a surreal number. +-/ + +universe u + +open Set + +public section + +/-! ## For Mathlib -/ + +-- TODO: upstream +theorem Set.image2_eq_range {α β γ : Type*} (f : α → β → γ) (s : Set α) (t : Set β) : + Set.image2 f s t = Set.range (fun x : s × t ↦ f x.1 x.2) := by + aesop + +namespace ArchimedeanClass + +theorem mk_le_mk_iff_dyadic {x y : Surreal} : + mk x ≤ mk y ↔ ∃ q : Dyadic, 0 < q ∧ q * |y| ≤ |x| := by + convert! mk_le_mk_iff_denselyOrdered ((Rat.castHom _).comp Dyadic.coeRingHom) (x := x) ?_ + · simp + · exact Rat.cast_strictMono.comp fun x y ↦ Dyadic.coe_lt_coe.mpr + +end ArchimedeanClass + +/-! ### ω-map on `IGame` -/ + +noncomputable section +namespace IGame + +/-- The ω-map on games, which is defined so that `ω^ !{s | t} = {0, r * ω^ a | r * ω^ b}` for +`a ∈ s`, `b ∈ t`, and `r` ranging over positive dyadic rationals. + +The standard definition in the literature instead has `r` ranging over positive reals, +but this makes no difference as to the equivalence class of the games. -/ +private def wpow (x : IGame.{u}) : IGame.{u} := + !{insert 0 (range (fun y : Ioi (0 : Dyadic) × xᴸ ↦ y.1 * wpow y.2)) | + range (fun y : Ioi (0 : Dyadic) × xᴿ ↦ y.1 * wpow y.2)} +termination_by x +decreasing_by igame_wf + +#adaptation_note /-- noncomputable is now needed -/ in +@[no_expose] +noncomputable instance : Wpow IGame where + wpow := wpow + +theorem wpow_def (x : IGame.{u}) : ω^ x = + !{insert 0 (image2 (fun r y ↦ ↑r * ω^ (y : IGame)) (Ioi (0 : Dyadic)) xᴸ) | + image2 (fun r y ↦ ↑r * ω^ y) (Ioi (0 : Dyadic)) xᴿ} := by + change wpow _ = _ + rw [wpow] + simp_rw [Set.image2_eq_range] + rfl + +theorem leftMoves_wpow (x : IGame) : (ω^ x)ᴸ = + insert 0 (image2 (fun r y ↦ ↑r * ω^ (y : IGame)) (Ioi (0 : Dyadic)) xᴸ) := by + rw [wpow_def, leftMoves_ofSets, Set.image2_eq_range] + +theorem rightMoves_wpow (x : IGame) : (ω^ x)ᴿ = + image2 (fun r y ↦ ↑r * ω^ (y : IGame)) (Ioi (0 : Dyadic)) xᴿ := by + rw [wpow_def, rightMoves_ofSets, Set.image2_eq_range] + +@[simp] +theorem forall_leftMoves_wpow {x : IGame} {P : IGame → Prop} : (∀ y ∈ (ω^ x)ᴸ, P y) ↔ + P 0 ∧ ∀ r : Dyadic, 0 < r → ∀ y ∈ xᴸ, P (r * ω^ y) := by + rw [leftMoves_wpow, forall_mem_insert, forall_mem_image2] + rfl + +@[simp] +theorem forall_rightMoves_wpow {x : IGame} {P : IGame → Prop} : (∀ y ∈ (ω^ x)ᴿ, P y) ↔ + ∀ r : Dyadic, 0 < r → ∀ y ∈ xᴿ, P (r * ω^ y) := by + rw [rightMoves_wpow] + exact forall_mem_image2 + +@[simp] +theorem exists_leftMoves_wpow {x : IGame} {P : IGame → Prop} : (∃ y ∈ (ω^ x)ᴸ, P y) ↔ + P 0 ∨ ∃ r : Dyadic, 0 < r ∧ ∃ y ∈ xᴸ, P (r * ω^ y) := by + rw [leftMoves_wpow, exists_mem_insert, exists_mem_image2] + rfl + +@[simp] +theorem exists_rightMoves_wpow {x : IGame} {P : IGame → Prop} : (∃ y ∈ (ω^ x)ᴿ, P y) ↔ + ∃ r : Dyadic, 0 < r ∧ ∃ y ∈ xᴿ, P (r * ω^ y) := by + rw [rightMoves_wpow] + exact exists_mem_image2 + +@[simp] +theorem zero_mem_leftMoves_wpow (x : IGame) : 0 ∈ (ω^ x)ᴸ := by + simp [leftMoves_wpow] + +theorem mul_wpow_mem_leftMoves_wpow {x y : IGame} {r : Dyadic} (hr : 0 ≤ r) + (hy : y ∈ xᴸ) : r * ω^ y ∈ (ω^ x)ᴸ := by + obtain rfl | hr := hr.eq_or_lt + · simp + · rw [leftMoves_wpow] + apply mem_insert_of_mem + use r, hr, y + +theorem mul_wpow_mem_rightMoves_wpow {x y : IGame} {r : Dyadic} (hr : 0 < r) + (hy : y ∈ xᴿ) : r * ω^ y ∈ (ω^ x)ᴿ := by + rw [rightMoves_wpow] + use r, hr, y + +theorem natCast_mul_wpow_mem_leftMoves_wpow {x y : IGame} (n : ℕ) (hy : y ∈ xᴸ) : + n * ω^ y ∈ (ω^ x)ᴸ := by + simpa using mul_wpow_mem_leftMoves_wpow n.cast_nonneg hy + +theorem natCast_mul_wpow_mem_rightMoves_wpow {x y : IGame} {n : ℕ} (hn : 0 < n) + (hy : y ∈ xᴿ) : n * ω^ y ∈ (ω^ x)ᴿ := by + simpa using mul_wpow_mem_rightMoves_wpow (n.cast_pos.2 hn) hy + +theorem wpow_mem_leftMoves_wpow {x y : IGame} (hy : y ∈ xᴸ) : + ω^ y ∈ (ω^ x)ᴸ := by + simpa using natCast_mul_wpow_mem_leftMoves_wpow 1 hy + +theorem wpow_mem_rightMoves_wpow {x y : IGame} (hy : y ∈ xᴿ) : + ω^ y ∈ (ω^ x)ᴿ := by + simpa using natCast_mul_wpow_mem_rightMoves_wpow one_pos hy + +theorem zero_lf_wpow (x : IGame) : 0 ⧏ ω^ x := + left_lf (zero_mem_leftMoves_wpow x) + +private theorem wpow_pos' (x : IGame) [Numeric (ω^ x)] : 0 < ω^ x := by + simpa using zero_lf_wpow x + +@[simp] +theorem wpow_zero : ω^ (0 : IGame) = 1 := by + ext p; cases p <;> simp [leftMoves_wpow, rightMoves_wpow] + +namespace Numeric + +variable {x y z w : IGame} [Numeric x] [Numeric y] [Numeric z] [Numeric w] + +private theorem wpow_strictMono_aux {x y : IGame} [Numeric x] [Numeric y] + [Numeric (ω^ x)] [Numeric (ω^ y)] : + (x < y → ∀ {r : ℝ}, 0 < r → r * ω^ x < ω^ y) ∧ (x ≤ y → ω^ x ≤ ω^ y) := by + refine ⟨fun hxy r hr ↦ ?_, fun hxy ↦ ?_⟩ + · obtain (⟨z, hz, hxz⟩ | ⟨z, hz, hzy⟩) := lf_iff_exists_le.1 hxy.not_ge + · have := wpow_mem_leftMoves_wpow hz + numeric + apply ((Numeric.mul_le_mul_iff_right (mod_cast hr)).2 (wpow_strictMono_aux.2 hxz)).trans_lt + obtain ⟨n, hn⟩ := exists_nat_gt r + exact ((Numeric.mul_lt_mul_iff_left (wpow_pos' z)).2 (mod_cast hn)).trans + (Numeric.left_lt (natCast_mul_wpow_mem_leftMoves_wpow n hz)) + · have := wpow_mem_rightMoves_wpow hz + numeric + apply (wpow_strictMono_aux.2 hzy).trans_lt' + rw [← Numeric.lt_div_iff' (mod_cast hr), IGame.div_eq_mul_inv, mul_comm] + grw [← Numeric.mul_congr_left r.toIGame_inv_equiv] + obtain ⟨q, hq, hq'⟩ := exists_dyadic_btwn (inv_pos.2 hr) + apply (Numeric.lt_right (mul_wpow_mem_rightMoves_wpow (mod_cast hq) hz)).trans + rw [Numeric.mul_lt_mul_iff_left (wpow_pos' z)] + simpa + · rw [le_iff_forall_lf, forall_leftMoves_wpow, forall_rightMoves_wpow] + refine ⟨⟨zero_lf_wpow _, ?_⟩, ?_⟩ <;> intro r hr z hz + · have := wpow_mem_leftMoves_wpow hz + numeric + grw [← Numeric.mul_congr_left (Real.toIGame_dyadic_equiv r)] + exact (wpow_strictMono_aux.1 ((Numeric.left_lt hz).trans_le hxy) (mod_cast hr)).not_ge + · have := wpow_mem_rightMoves_wpow hz + numeric + have hr' : 0 < (r : ℝ)⁻¹ := by simpa + rw [← Surreal.mk_le_mk, Surreal.mk_mul, ← le_div_iff₀' (by simpa), div_eq_inv_mul] + simpa [← Surreal.mk_lt_mk] using + wpow_strictMono_aux.1 (hxy.trans_lt (Numeric.lt_right hz)) hr' +termination_by (x, y) +decreasing_by igame_wf + +protected instance wpow (x : IGame) [Numeric x] : Numeric (ω^ x) := by + rw [numeric_def] + simp_rw [Player.forall, forall_leftMoves_wpow, forall_rightMoves_wpow] + refine ⟨⟨fun r hr y hy ↦ ?_, fun r hr y hy s hs z hz ↦ ?_⟩, + ⟨.zero, fun r hr y hy ↦ ?_⟩, fun r hr y hy ↦ ?_⟩ + all_goals numeric; have := Numeric.wpow y + · exact Numeric.mul_pos (mod_cast hr) (wpow_pos' y) + · have := Numeric.wpow z + rw [← Numeric.div_lt_iff' (mod_cast hs), ← Surreal.mk_lt_mk] + dsimp + simp_rw [div_eq_inv_mul, ← mul_assoc, Surreal.mk_dyadic, + ← Real.toSurreal_ratCast, ← Real.toSurreal_inv, ← Real.toSurreal_mul] + apply wpow_strictMono_aux.1 (Numeric.left_lt_right hy hz) (mul_pos ..) <;> simpa + all_goals infer_instance +termination_by x +decreasing_by igame_wf + +@[simp] theorem wpow_pos (x : IGame) [Numeric x] : 0 < ω^ x := wpow_pos' x +@[simp] theorem wpow_nonneg (x : IGame) [Numeric x] : 0 ≤ ω^ x := (wpow_pos x).le + +theorem mul_wpow_lt_wpow (r : ℝ) (h : x < y) : r * ω^ x < ω^ y := by + obtain hr | hr := le_or_gt r 0 + · apply (Numeric.mul_nonpos_of_nonpos_of_nonneg _ (wpow_nonneg x)).trans_lt (wpow_pos y) + exact Real.toIGame_le_zero.mpr hr + · exact wpow_strictMono_aux.1 h hr + +/-- A version of `mul_wpow_lt_wpow` stated using dyadic rationals. -/ +theorem mul_wpow_lt_wpow' (r : Dyadic) (h : x < y) : r * ω^ x < ω^ y := by + simpa [← Surreal.mk_lt_mk] using mul_wpow_lt_wpow r h + +theorem wpow_lt_mul_wpow {r : ℝ} (hr : 0 < r) (h : x < y) : ω^ x < r * ω^ y := by + rw [← Numeric.div_lt_iff' (mod_cast hr), IGame.div_eq_mul_inv, mul_comm] + simpa [← Surreal.mk_lt_mk] using mul_wpow_lt_wpow (r⁻¹) h + +/-- A version of `wpow_lt_mul_wpow` stated using dyadic rationals. -/ +theorem wpow_lt_mul_wpow' {r : Dyadic} (hr : 0 < r) (h : x < y) : ω^ x < r * ω^ y := by + have hr : (0 : ℝ) < r := by simpa + simpa [← Surreal.mk_lt_mk] using wpow_lt_mul_wpow hr h + +theorem mul_wpow_lt_mul_wpow (r : ℝ) {s : ℝ} (hs : 0 < s) (h : x < y) : r * ω^ x < s * ω^ y := by + rw [← Numeric.div_lt_iff' (mod_cast hs), ← Surreal.mk_lt_mk] + dsimp + rw [div_eq_mul_inv, mul_comm, ← mul_assoc, ← Real.toSurreal_inv, ← Real.toSurreal_mul] + exact mul_wpow_lt_wpow _ h + +/-- A version of `mul_wpow_lt_mul_wpow` stated using dyadic rationals. -/ +theorem mul_wpow_lt_mul_wpow' (r : Dyadic) {s : Dyadic} (hs : 0 < s) (h : x < y) : + r * ω^ x < s * ω^ y := by + have hs : (0 : ℝ) < s := by simpa + simpa [← Surreal.mk_lt_mk] using mul_wpow_lt_mul_wpow r hs h + +theorem mul_wpow_add_mul_wpow_lt_mul_wpow (r s : ℝ) {t : ℝ} (ht : 0 < t) + (hx : x < z) (hy : y < z) : r * ω^ x + s * ω^ y < t * ω^ z := by + have h : 0 < t / 2 := by simpa + apply (add_lt_add (mul_wpow_lt_mul_wpow r h hx) (mul_wpow_lt_mul_wpow s h hy)).trans_le + simp [← Surreal.mk_le_mk, ← add_mul] + +/-- A version of `mul_wpow_add_mul_wpow_lt_mul_wpow` stated using dyadic rationals. -/ +theorem mul_wpow_add_mul_wpow_lt_mul_wpow' (r s : Dyadic) {t : Dyadic} (ht : 0 < t) + (hx : x < z) (hy : y < z) : r * ω^ x + s * ω^ y < t * ω^ z := by + have ht : (0 : ℝ) < t := by simpa + simpa [← Surreal.mk_lt_mk] using mul_wpow_add_mul_wpow_lt_mul_wpow r s ht hx hy + +theorem mul_wpow_lt_mul_wpow_add_mul_wpow (r : ℝ) {s t : ℝ} (hs : 0 < s) (ht : 0 < t) + (hx : x < y) (hy : x < z) : r * ω^ x < s * ω^ y + t * ω^ z := by + apply (add_lt_add (mul_wpow_lt_mul_wpow (r/2) hs hx) (mul_wpow_lt_mul_wpow (r/2) ht hy)).trans_le' + simp [← Surreal.mk_le_mk, ← add_mul] + +/-- A version of `mul_wpow_lt_mul_wpow_add_mul_wpow` stated using dyadic rationals. -/ +theorem mul_wpow_lt_mul_wpow_add_mul_wpow' (r : Dyadic) {s t : Dyadic} (hs : 0 < s) (ht : 0 < t) + (hx : x < y) (hy : x < z) : r * ω^ x < s * ω^ y + t * ω^ z := by + have hs : (0 : ℝ) < s := by simpa + have ht : (0 : ℝ) < t := by simpa + simpa [← Surreal.mk_lt_mk] using mul_wpow_lt_mul_wpow_add_mul_wpow r hs ht hx hy + +@[simp] +theorem wpow_lt_wpow : ω^ x < ω^ y ↔ x < y := by + constructor + · contrapose + repeat rw [Numeric.not_lt] + exact wpow_strictMono_aux.2 + · simpa using mul_wpow_lt_wpow' 1 + +@[simp] +theorem wpow_le_wpow : ω^ x ≤ ω^ y ↔ x ≤ y := by + rw [← Numeric.not_lt, wpow_lt_wpow, Numeric.not_lt] + +theorem wpow_congr (h : x ≈ y) : ω^ x ≈ ω^ y := by + simpa [AntisymmRel] using h + +private theorem mulOption_lt_wpow {r s : Dyadic} (hr : 0 < r) (hs : 0 < s) + (h₁ : x < z) (h₂ : y < w) (IH₁ : ω^ (x + w) ≈ ω^ x * ω^ w) + (IH₂ : ω^ (z + y) ≈ ω^ z * ω^ y) (IH₃ : ω^ (z + w) ≈ ω^ z * ω^ w) : + mulOption (ω^ x) (ω^ y) (r * ω^ z) (s * ω^ w) < ω^ (x + y) := by + apply IGame.sub_lt_iff_lt_add.2 + have H : r * ω^ (z + y) + s * ω^ (x + w) < ω^ (x + y) + ↑(r * s) * ω^ (z + w) := by + apply (mul_wpow_add_mul_wpow_lt_mul_wpow' ..).trans (lt_add_of_pos_left ..) <;> simp_all + rw [← Surreal.mk_lt_mk, ← Surreal.mk_eq_mk] at * + convert H using 1 <;> simp_all <;> ring_nf + +private theorem mulOption_lt_wpow' {r s : Dyadic} (hr : 0 < r) (hs : 0 < s) + (h₁ : z < x) (h₂ : w < y) (IH₁ : ω^ (x + w) ≈ ω^ x * ω^ w) + (IH₂ : ω^ (z + y) ≈ ω^ z * ω^ y) (IH₃ : ω^ (z + w) ≈ ω^ z * ω^ w) : + mulOption (ω^ x) (ω^ y) (r * ω^ z) (s * ω^ w) < ω^ (x + y) := by + apply IGame.sub_lt_iff_lt_add.2 + have H : r * ω^ (z + y) + s * ω^ (x + w) < (1 : Dyadic) * ω^ (x + y) + (r * s) * ω^ (z + w) := by + apply (mul_wpow_add_mul_wpow_lt_mul_wpow' ..).trans (lt_add_of_pos_right ..) <;> simp_all + rw [← Surreal.mk_lt_mk, ← Surreal.mk_eq_mk] at * + convert H using 1 <;> simp_all <;> ring_nf + +private theorem wpow_lt_mulOption {r s : Dyadic} (hr : 0 < r) (hs : 0 < s) + (h₁ : x < z) (h₂ : w < y) (IH₁ : ω^ (z + y) ≈ ω^ z * ω^ y) (IH₂ : ω^ (z + w) ≈ ω^ z * ω^ w) : + ω^(x + y) < mulOption (ω^ x) (ω^ y) (r * ω^ z) (s * ω^ w) := by + apply IGame.lt_sub_iff_add_lt.2 + have H : (1 : Dyadic) * ω^ (x + y) + ↑(r * s) * ω^ (z + w) + < r * ω^ (z + y) + s * ω^ x * ω^ w := by + apply (mul_wpow_add_mul_wpow_lt_mul_wpow' ..).trans (lt_add_of_pos_right ..) <;> simp_all + rw [← Surreal.mk_lt_mk, ← Surreal.mk_eq_mk] at * + convert H using 1 <;> simp_all <;> ring_nf + +theorem wpow_add_equiv (x y : IGame) [Numeric x] [Numeric y] : ω^ (x + y) ≈ ω^ x * ω^ y := by + rw [AntisymmRel, le_iff_forall_lf, le_iff_forall_lf] + simp only [forall_leftMoves_wpow, forall_rightMoves_wpow, forall_and, + forall_moves_add, forall_moves_mul, Player.forall, + Player.left_mul, Player.right_mul, Player.neg_left, Player.neg_right] + repeat any_goals constructor + on_goal 1 => exact (Numeric.mul_pos (wpow_pos _) (wpow_pos _)).not_ge + on_goal 7 => simp + all_goals intro r hr z hz + any_goals intro s hs w hw + all_goals numeric; apply not_le_of_gt + · grw [mul_congr_right (wpow_add_equiv ..), ← mul_assoc_equiv] + rw [Numeric.mul_lt_mul_iff_left (wpow_pos _)] + exact mul_wpow_lt_wpow' r (Numeric.left_lt hz) + · grw [mul_congr_right (wpow_add_equiv ..), mul_comm (r : IGame), mul_assoc_equiv] + rw [Numeric.mul_lt_mul_iff_right (wpow_pos _), mul_comm] + exact mul_wpow_lt_wpow' r (Numeric.left_lt hz) + · rw [mulOption_zero_left, mul_comm (r : IGame)] + grw [← mul_assoc_equiv, mul_comm, ← mul_congr_right (wpow_add_equiv ..)] + exact wpow_lt_mul_wpow' hr (add_right_strictMono (Numeric.lt_right hz)) + · rw [mulOption_comm, add_comm] + apply wpow_lt_mulOption hs hr (Numeric.lt_right hw) (Numeric.left_lt hz) <;> + rw [add_comm, mul_comm] <;> exact wpow_add_equiv .. + · rw [mulOption_zero_right] + grw [mul_assoc_equiv, ← mul_congr_right (wpow_add_equiv ..)] + exact wpow_lt_mul_wpow' hr (add_left_strictMono (Numeric.lt_right hz)) + · exact wpow_lt_mulOption hr hs (Numeric.lt_right hz) (Numeric.left_lt hw) + (wpow_add_equiv ..) (wpow_add_equiv ..) + · rw [mulOption_zero_right] + grw [mul_assoc_equiv, ← mul_congr_right (wpow_add_equiv ..)] + exact mul_wpow_lt_wpow' r (add_left_strictMono (Numeric.left_lt hz)) + · rw [mulOption_zero_left, mul_comm] + grw [mul_assoc_equiv, mul_comm (ω^ z), ← mul_congr_right (wpow_add_equiv ..)] + exact mul_wpow_lt_wpow' _ (add_right_strictMono (Numeric.left_lt hz)) + · exact mulOption_lt_wpow' hr hs (Numeric.left_lt hz) (Numeric.left_lt hw) + (wpow_add_equiv ..) (wpow_add_equiv ..) (wpow_add_equiv ..) + · exact mulOption_lt_wpow hr hs (Numeric.lt_right hz) (Numeric.lt_right hw) + (wpow_add_equiv ..) (wpow_add_equiv ..) (wpow_add_equiv ..) + · grw [mul_congr_right (wpow_add_equiv ..), ← mul_assoc_equiv] + rw [Numeric.mul_lt_mul_iff_left (wpow_pos _)] + exact wpow_lt_mul_wpow' hr (Numeric.lt_right hz) + · grw [mul_congr_right (wpow_add_equiv ..), mul_comm (r : IGame), mul_assoc_equiv] + rw [Numeric.mul_lt_mul_iff_right (wpow_pos _), mul_comm] + exact wpow_lt_mul_wpow' hr (Numeric.lt_right hz) +termination_by (x, y) +decreasing_by igame_wf + +theorem wpow_neg_equiv (x : IGame) [Numeric x] : ω^ -x ≈ (ω^ x)⁻¹ := by + apply equiv_inv_of_mul_eq_one ((wpow_add_equiv ..).symm.trans _) + rw [← wpow_zero] + exact wpow_congr (neg_add_equiv x) + +theorem wpow_sub_equiv (x y : IGame) [Numeric x] [Numeric y] : ω^ (x - y) ≈ ω^ x / ω^ y := + (wpow_add_equiv ..).trans (mul_congr_right (wpow_neg_equiv _)) + +end Numeric + +open NatOrdinal in +theorem toIGame_wpow_equiv (x : NatOrdinal) : (ω^ x).toIGame ≈ ω^ x.toIGame := by + have H {y} (h : y < x) (n : ℕ) : toIGame (ω^ y * n) ≈ ω^ y.toIGame * n := + (toIGame_mul ..).trans <| Numeric.mul_congr (toIGame_wpow_equiv y) (toIGame_natCast_equiv n) + obtain rfl | hx := eq_or_ne x 0; · simp + constructor <;> refine le_iff_forall_lf.2 ⟨?_, ?_⟩ + · simp_rw [forall_leftMoves_toIGame, lt_wpow_iff hx] + intro z ⟨y, hy, n, hz⟩ + apply ((toIGame.strictMono hz).trans_le _).not_ge + grw [H hy n] + rw [mul_comm] + simpa using (Numeric.mul_wpow_lt_wpow' n (toIGame.strictMono hy)).le + · simp + · simp_rw [forall_leftMoves_wpow, forall_leftMoves_toIGame] + constructor + · rw [← toIGame_zero, toIGame.le_iff_le] + simp + · intro r hr y hy + obtain ⟨n, hn⟩ := exists_nat_gt r + rw [mul_comm] + apply ((toIGame.strictMono <| wpow_mul_natCast_lt hy n).trans' _).not_ge + grw [H hy n] + rw [Numeric.mul_lt_mul_iff_right] + · exact_mod_cast hn + · exact Numeric.wpow_pos _ + · simp +termination_by x + +end IGame + +/-! ### ω-pow on `Surreal` -/ + +namespace Surreal +open IGame + +variable {x y : Surreal} + +instance : Wpow Surreal where + wpow := Quotient.lift (fun x ↦ mk (ω^ x)) fun _ _ h ↦ mk_eq (Numeric.wpow_congr h) + +@[simp] +theorem mk_wpow (x : IGame) [Numeric x] : mk (ω^ x) = ω^ (mk x) := + rfl + +@[simp] +theorem wpow_zero : ω^ (0 : Surreal) = 1 := + mk_eq IGame.wpow_zero.antisymmRel + +@[simp] +theorem wpow_pos : ∀ x : Surreal, 0 < ω^ x := by + rintro ⟨x, _⟩ + exact Numeric.wpow_pos x + +@[simp] +theorem wpow_nonneg (x : Surreal) : 0 ≤ ω^ x := + (wpow_pos x).le + +@[simp] +theorem wpow_ne_zero (x : Surreal) : ω^ x ≠ 0 := + (wpow_pos x).ne' + +@[simp] +theorem wpow_abs (x : Surreal) : |ω^ x| = ω^ x := + abs_of_pos (wpow_pos x) + +theorem strictMono_wpow : StrictMono (ω^ · : Surreal → _) := by + rintro ⟨x, _⟩ ⟨y, _⟩ + exact Numeric.wpow_lt_wpow.2 + +@[simp] +theorem wpow_lt_wpow : ω^ x < ω^ y ↔ x < y := + strictMono_wpow.lt_iff_lt + +@[simp] +theorem wpow_le_wpow : ω^ x ≤ ω^ y ↔ x ≤ y := + strictMono_wpow.le_iff_le + +@[simp] +theorem wpow_inj : ω^ x = ω^ y ↔ x = y := + strictMono_wpow.injective.eq_iff + +@[simp] +theorem wpow_add : ∀ x y : Surreal, ω^ (x + y) = ω^ x * ω^ y := by + rintro ⟨x, _⟩ ⟨y, _⟩ + exact mk_eq (Numeric.wpow_add_equiv x y) + +@[simp] +theorem wpow_neg : ∀ x : Surreal, ω^ -x = (ω^ x)⁻¹ := by + rintro ⟨x, _⟩ + exact mk_eq (Numeric.wpow_neg_equiv x) + +@[simp] +theorem wpow_sub : ∀ x y : Surreal, ω^ (x - y) = ω^ x / ω^ y := by + rintro ⟨x, _⟩ ⟨y, _⟩ + exact mk_eq (Numeric.wpow_sub_equiv x y) + +theorem mul_wpow_lt_wpow (r : ℝ) (h : x < y) : r * ω^ x < ω^ y := by + cases x; cases y; exact IGame.Numeric.mul_wpow_lt_wpow r h + +theorem wpow_lt_mul_wpow {r : ℝ} (hr : 0 < r) (h : x < y) : ω^ x < r * ω^ y := by + cases x; cases y; exact IGame.Numeric.wpow_lt_mul_wpow hr h + +theorem mul_wpow_lt_mul_wpow (r : ℝ) {s : ℝ} (hs : 0 < s) (h : x < y) : r * ω^ x < s * ω^ y := by + cases x; cases y; exact IGame.Numeric.mul_wpow_lt_mul_wpow r hs h + +/-! ### Archimedean classes -/ + +open ArchimedeanClass + +@[simp] +theorem mk_realCast {r : ℝ} (hr : r ≠ 0) : ArchimedeanClass.mk (r : Surreal) = 0 := + mk_map_of_archimedean' Real.toSurrealRingHom hr + +/-- We define a `ValuativeRel` instance on `Surreal` which is compatible with +`ArchimedeanClass.addValuation`. In particular, you can write `x =ᵥ y` to mean that `x` is +commensurate with `y`. -/ +instance : ValuativeRel Surreal := + .ofValuation (ArchimedeanClass.addValuation _) + +instance : (ArchimedeanClass.addValuation Surreal).Compatible where + vle_iff_le _ _ := .rfl + +theorem vle_def {x y : Surreal} : x ≤ᵥ y ↔ ArchimedeanClass.mk y ≤ .mk x := + .rfl + +theorem vlt_def {x y : Surreal} : x <ᵥ y ↔ ArchimedeanClass.mk y < .mk x := + (ArchimedeanClass.addValuation _).vlt_iff_lt + +theorem veq_def {x y : Surreal} : x =ᵥ y ↔ ArchimedeanClass.mk x = .mk y := + (ArchimedeanClass.addValuation _).veq_iff_eq + +@[simp] theorem neg_veq {x y : Surreal} : -x =ᵥ y ↔ x =ᵥ y := by simp [veq_def] +@[simp] theorem veq_neg {x y : Surreal} : x =ᵥ -y ↔ x =ᵥ y := by simp [veq_def] +@[simp] theorem vle_neg {x y : Surreal} : x ≤ᵥ -y ↔ x ≤ᵥ y := by simp [vle_def] +@[simp] theorem neg_vle {x y : Surreal} : -x ≤ᵥ y ↔ x ≤ᵥ y := by simp [vle_def] +@[simp] theorem vlt_neg {x y : Surreal} : x <ᵥ -y ↔ x <ᵥ y := by simp [vlt_def] +@[simp] theorem neg_vlt {x y : Surreal} : -x <ᵥ y ↔ x <ᵥ y := by simp [vlt_def] + +theorem archimedeanClassMk_wpow_strictAnti : + StrictAnti fun x : Surreal ↦ ArchimedeanClass.mk (ω^ x) := by + refine fun x y h ↦ (mk_antitoneOn (wpow_nonneg _) (wpow_nonneg _) + (wpow_le_wpow.2 h.le)).lt_of_not_ge fun ⟨n, hn⟩ ↦ hn.not_gt ?_ + simpa using mul_wpow_lt_wpow n h + +@[simp] +theorem wpow_vlt_wpow_iff : ω^ x <ᵥ ω^ y ↔ x < y := + vlt_def.trans archimedeanClassMk_wpow_strictAnti.lt_iff_gt + +@[simp] +theorem wpow_vle_wpow_iff : ω^ x ≤ᵥ ω^ y ↔ x ≤ y := + vle_def.trans archimedeanClassMk_wpow_strictAnti.le_iff_ge + +/-- `ω^ x` and `ω^ y` are commensurate iff `x = y`. -/ +@[simp] +theorem wpow_veq_wpow_iff : ω^ x =ᵥ ω^ y ↔ x = y := + veq_def.trans archimedeanClassMk_wpow_strictAnti.injective.eq_iff + +private theorem mk_lt_mk_of_ne {x : IGame} [Numeric x] (h : 0 < x) + (Hl : ∀ y (h : y ∈ xᴸ), 0 < y → have := Numeric.of_mem_moves h; + ArchimedeanClass.mk (mk y) ≠ .mk (mk x)) : + ∀ y (h : y ∈ xᴸ), 0 < y → have := Numeric.of_mem_moves h; + ArchimedeanClass.mk (mk x) < .mk (mk y) := + fun y hy hy' ↦ lt_of_le_of_ne' (mk_antitoneOn hy'.le h.le (Numeric.left_lt hy).le) (Hl y hy hy') + +private theorem mk_lt_mk_of_ne' {x : IGame} [Numeric x] (h : 0 < x) + (Hr : ∀ y (h : y ∈ xᴿ), have := Numeric.of_mem_moves h; + ArchimedeanClass.mk (mk y) ≠ .mk (mk x)) : + ∀ y (h : y ∈ xᴿ), have := Numeric.of_mem_moves h; + ArchimedeanClass.mk (mk y) < .mk (mk x) := + fun y hy ↦ have hy' := (Numeric.lt_right hy); + lt_of_le_of_ne (mk_antitoneOn h.le (h.trans hy').le hy'.le) (Hr y hy) + +local instance (x : IGame) [Numeric x] (y : (xᴸ ∩ Ioi 0 :)) : Numeric y := + .of_mem_moves y.2.1 + +private theorem numeric_of_forall_mk_ne_mk' {x : IGame} [Numeric x] (h : 0 < x) + {f : (xᴸ ∩ Ioi 0 :) → Subtype Numeric.{u}} {g : xᴿ → Subtype Numeric.{u}} + (hf : ∀ y, ArchimedeanClass.mk (ω^ (mk (f y).1)) = .mk (mk y.1)) + (hg : ∀ y, ArchimedeanClass.mk (ω^ (mk (g y).1)) = .mk (mk y.1)) + (Hl : ∀ y (h : y ∈ xᴸ), 0 < y → have := Numeric.of_mem_moves h; + ArchimedeanClass.mk (mk y) ≠ .mk (mk x)) + (Hr : ∀ y (h : y ∈ xᴿ), have := Numeric.of_mem_moves h; + ArchimedeanClass.mk (mk y) ≠ .mk (mk x)) : + Numeric !{range (Subtype.val ∘ f) | range (Subtype.val ∘ g)} := by + apply Numeric.mk + · simp_rw [leftMoves_ofSets, rightMoves_ofSets] + rintro _ ⟨a, rfl⟩ _ ⟨b, rfl⟩ + simp_rw [Function.comp_apply, ← mk_lt_mk, ← wpow_vlt_wpow_iff, vlt_def, hf, hg] + exact (mk_lt_mk_of_ne' h Hr _ b.2).trans (mk_lt_mk_of_ne h Hl _ a.2.1 a.2.2) + · aesop (add simp [Subtype.prop]) + +private theorem wpow_equiv_of_forall_mk_ne_mk' {x : IGame.{u}} [Numeric x] (h : 0 < x) + {f : (xᴸ ∩ Ioi 0 :) → Subtype Numeric.{u}} {g : xᴿ → Subtype Numeric.{u}} + (hf : ∀ y, ArchimedeanClass.mk (ω^ (mk (f y).1)) = .mk (mk y.1)) + (hg : ∀ y, ArchimedeanClass.mk (ω^ (mk (g y).1)) = .mk (mk y.1)) + (Hl : ∀ y (h : y ∈ xᴸ), 0 < y → have := Numeric.of_mem_moves h; + ArchimedeanClass.mk (mk y) ≠ .mk (mk x)) + (Hr : ∀ y (h : y ∈ xᴿ), have := Numeric.of_mem_moves h; + ArchimedeanClass.mk (mk y) ≠ .mk (mk x)) : + ω^ !{range (Subtype.val ∘ f) | range (Subtype.val ∘ g)} ≈ x := by + have Hl' := mk_lt_mk_of_ne h Hl + have Hr' := mk_lt_mk_of_ne' h Hr + have := numeric_of_forall_mk_ne_mk' h hf hg Hl Hr + apply (Fits.equiv_of_forall_moves ..).symm + · constructor + · simp_rw [forall_leftMoves_wpow, leftMoves_ofSets, forall_mem_range, + Function.comp_apply, ← Surreal.mk_le_mk] + refine ⟨h.not_ge, fun r hr y ↦ (lt_of_mk_lt_mk_of_nonneg ?_ h.le).not_ge⟩ + simpa [hr.ne', hf] using Hl' _ y.2.1 y.2.2 + · simp_rw [forall_rightMoves_wpow, rightMoves_ofSets, forall_mem_range, + Function.comp_apply, ← Surreal.mk_le_mk] + refine fun r hr y ↦ (lt_of_mk_lt_mk_of_nonneg ?_ ?_).not_ge + · simpa [hr.ne', hg] using Hr' _ y.2 + · simpa using hr.le + all_goals + intro y hy + numeric + simp only [exists_rightMoves_wpow, exists_leftMoves_wpow] + · refine or_iff_not_imp_left.2 fun hy' ↦ ?_ + rw [Numeric.not_le] at hy' + obtain ⟨(_ | n), hn⟩ := (hf ⟨y, hy, hy'⟩).le + · apply (hy'.not_antisymmRel_symm _).elim + simpa [← mk_eq_mk] using hn + · refine ⟨n + 1, mod_cast n.succ_pos, ?_⟩ + simp_rw [leftMoves_ofSets, exists_range_iff, Function.comp_apply, ← Surreal.mk_le_mk] + use ⟨y, hy, hy'⟩ + convert ←hn + · exact abs_of_pos hy' + · simp + · obtain ⟨r, hr, hr'⟩ := mk_le_mk_iff_dyadic.1 (hg ⟨y, hy⟩).ge + refine ⟨r, hr, ?_⟩ + simp_rw [rightMoves_ofSets, exists_range_iff, Function.comp_apply, ← Surreal.mk_le_mk] + use ⟨y, hy⟩ + convert ←hr' using 1 + · simp + · exact abs_of_pos <| h.trans (Numeric.lt_right hy) + +private theorem exists_mk_wpow_eq {x : IGame.{u}} [Numeric x] (h : 0 < x) : + ∃ y : Subtype Numeric, ArchimedeanClass.mk (ω^ mk y) = .mk (mk x) := by + have IHl (y : (xᴸ ∩ Ioi 0 :)) : + ∃ z : Subtype Numeric, ArchimedeanClass.mk (ω^ mk z) = .mk (mk y) := + have := y.2.1; exists_mk_wpow_eq y.2.2 + have IHr (y : xᴿ) : + ∃ z : Subtype Numeric, ArchimedeanClass.mk (ω^ mk z) = .mk (mk y) := + exists_mk_wpow_eq (h.trans (Numeric.lt_right y.2)) + choose f hf using IHl + choose g hg using IHr + by_contra! H + have Hf (y : IGame) (h : y ∈ xᴸ) (hy : 0 < y) : + have := Numeric.of_mem_moves h; ArchimedeanClass.mk (mk y) ≠ ArchimedeanClass.mk (mk x) := by + dsimp + rw [← hf ⟨y, h, hy⟩] + exact H _ + have Hg (y : IGame) (h : y ∈ xᴿ) : + have := Numeric.of_mem_moves h; ArchimedeanClass.mk (mk y) ≠ ArchimedeanClass.mk (mk x) := by + dsimp + rw [← hg ⟨y, h⟩] + exact H _ + have := numeric_of_forall_mk_ne_mk' h hf hg Hf Hg + apply H ⟨_, this⟩ + congr + rw [← mk_wpow, mk_eq_mk] + exact wpow_equiv_of_forall_mk_ne_mk' h hf hg Hf Hg +termination_by x +decreasing_by igame_wf + +/-- Every non-zero surreal is commensurate to some `ω^ x`. -/ +theorem exists_wpow_veq (h : x ≠ 0) : ∃ y, ω^ y =ᵥ x := by + simp_rw [veq_def] + obtain h | h := h.lt_or_gt <;> cases x + · obtain ⟨⟨y, _⟩, hy⟩ := exists_mk_wpow_eq (IGame.zero_lt_neg.2 h) + use .mk y + simpa using hy + · obtain ⟨⟨y, _⟩, hy⟩ := exists_mk_wpow_eq h + exact ⟨_, hy⟩ + +/-! ### ω-logarithm -/ + +/-- The ω-logarithm of a positive surreal `x` is the unique surreal `y` such that `x` is +commensurate with `ω^ y`. + +As with `Real.log`, we set junk values `wlog 0 = 0` and `wlog (-x) = wlog x`. -/ +def wlog (x : Surreal) : Surreal := + if h : x = 0 then 0 else Classical.choose (exists_wpow_veq h) + +/-- Returns an arbitrary representative for `Surreal.wlog`. -/ +def _root_.IGame.wlog (x : IGame) : IGame := by + classical exact if _ : Numeric x then (Surreal.mk x).wlog.out else 0 + +instance _root_.IGame.Numeric.wlog (x : IGame) : Numeric x.wlog := by + rw [IGame.wlog] + split_ifs <;> infer_instance + +@[simp] +theorem mk_wlog (x : IGame) [h : Numeric x] : mk x.wlog = (mk x).wlog := by + simp_rw [IGame.wlog, dif_pos h, Surreal.out_eq] + +@[simp] +theorem wlog_zero : wlog 0 = 0 := + dif_pos rfl + +theorem wpow_wlog_veq (h : x ≠ 0) : ω^ wlog x =ᵥ x := by + rw [wlog, dif_neg h] + exact Classical.choose_spec (exists_wpow_veq h) + +@[simp] +theorem archimedeanClassMk_wpow_wlog (h : x ≠ 0) : ArchimedeanClass.mk (ω^ x.wlog) = .mk x := + veq_def.1 (wpow_wlog_veq h) + +theorem wlog_eq_of_wpow_veq (h : ω^ y =ᵥ x) : wlog x = y := by + obtain rfl | hx := eq_or_ne x 0 + · simp at h + · grw [← wpow_wlog_veq hx, wpow_veq_wpow_iff] at h + rwa [eq_comm] at h + +@[simp] +theorem wlog_eq_iff (h : x ≠ 0) : wlog x = y ↔ ω^ y =ᵥ x := + ⟨fun hy ↦ hy ▸ wpow_wlog_veq h, wlog_eq_of_wpow_veq⟩ + +theorem wlog_congr (h : x =ᵥ y) : wlog x = wlog y := by + obtain rfl | hy := eq_or_ne y 0; · simp_all + apply wlog_eq_of_wpow_veq + grw [wpow_wlog_veq hy] + rwa [ValuativeRel.veq_comm] + +@[simp] +theorem wlog_wpow (x : Surreal) : wlog (ω^ x) = x := by + simp + +@[simp] +theorem wlog_neg (x : Surreal) : wlog (-x) = wlog x := by + obtain rfl | hx := eq_or_ne x 0 + · simp + · apply wlog_eq_of_wpow_veq + simpa using wpow_wlog_veq hx + +@[simp] +theorem wlog_abs (x : Surreal) : wlog |x| = wlog x := + abs_by_cases (wlog · = _) rfl (wlog_neg _) + +theorem wlog_surjective : Function.Surjective wlog := + fun _ ↦ ⟨_, wlog_wpow _⟩ + +theorem wlog_monotoneOn : MonotoneOn wlog (Ioi 0) := by + intro a ha b hb h + grw [← wpow_vle_wpow_iff, wpow_wlog_veq ha.ne', wpow_wlog_veq hb.ne'] + apply mk_antitoneOn ha.le hb.le h + +theorem wlog_antitoneOn : AntitoneOn wlog (Iio 0) := by + intro a ha b hb h + rw [← neg_le_neg_iff] at h + convert wlog_monotoneOn _ _ h using 1 <;> simp_all + +theorem wlog_add_eq_left {x y : Surreal} (h : y <ᵥ x) : wlog (x + y) = wlog x := by + apply wlog_congr + rw [veq_def, mk_add_eq_mk_left (vlt_def.1 h)] + +theorem wlog_add_eq_right {x y : Surreal} (h : y <ᵥ x) : wlog (y + x) = wlog x := by + rw [add_comm, wlog_add_eq_left h] + +theorem wlog_sub_eq_left {x y : Surreal} : y <ᵥ x → wlog (x - y) = wlog x := by + simpa [sub_eq_add_neg] using @wlog_add_eq_left x (-y) + +theorem wlog_sub_eq_right {x y : Surreal} : y <ᵥ x → wlog (y - x) = wlog x := by + simpa [sub_eq_add_neg] using @wlog_add_eq_right (-x) y + +theorem wlog_le_wlog_iff (hx : x ≠ 0) (hy : y ≠ 0) : wlog x ≤ wlog y ↔ x ≤ᵥ y := by + rw [← wpow_vle_wpow_iff] + -- TODO: why does `grw` not work on the iff? + constructor + · intro h + grw [wpow_wlog_veq hx, wpow_wlog_veq hy] at h + exact h + · intro h + grw [wpow_wlog_veq hx, wpow_wlog_veq hy] + exact h + +theorem wlog_le_wlog_of_vle (hx : x ≠ 0) (h : x ≤ᵥ y) : wlog x ≤ wlog y := by + obtain rfl | hy := eq_or_ne y 0; · simp_all + rwa [wlog_le_wlog_iff hx hy] + +theorem wlog_lt_wlog_iff (hx : x ≠ 0) (hy : y ≠ 0) : wlog x < wlog y ↔ x <ᵥ y := by + rw [← not_le, wlog_le_wlog_iff hy hx, ValuativeRel.not_vle] + +theorem wlog_lt_wlog_of_vlt (hx : x ≠ 0) (h : x <ᵥ y) : wlog x < wlog y := by + obtain rfl | hy := eq_or_ne y 0; · simp at h + rwa [wlog_lt_wlog_iff hx hy] + +@[simp] +theorem wlog_mul {x y : Surreal} (hx : x ≠ 0) (hy : y ≠ 0) : wlog (x * y) = wlog x + wlog y := by + apply wlog_eq_of_wpow_veq + rw [wpow_add] + apply ValuativeRel.mul_veq_mul <;> exact wpow_wlog_veq ‹_› + +@[simp] +theorem wlog_realCast (r : ℝ) : wlog r = 0 := by + obtain rfl | hr := eq_or_ne r 0 + · simp + · rw [wlog_eq_iff (mod_cast hr), veq_def, mk_realCast hr, wpow_zero, ArchimedeanClass.mk_one] + +@[simp] theorem wlog_ratCast (q : ℚ) : wlog q = 0 := by simpa using wlog_realCast q +@[simp] theorem wlog_intCast (n : ℤ) : wlog n = 0 := by simpa using wlog_realCast n +@[simp] theorem wlog_natCast (n : ℕ) : wlog n = 0 := by simpa using wlog_realCast n +@[simp] theorem wlog_one : wlog 1 = 0 := mod_cast wlog_natCast 1 + +@[simp] +theorem wlog_inv (x : Surreal) : x⁻¹.wlog = -x.wlog := by + obtain rfl | hx := eq_or_ne x 0; · simp + rw [← add_eq_zero_iff_eq_neg, ← wlog_mul (inv_ne_zero hx) hx, inv_mul_cancel₀ hx, wlog_one] + +@[simp] +theorem wlog_pow (x : Surreal) (n : ℕ) : wlog (x ^ n) = n * wlog x := by + obtain rfl | hx := eq_or_ne x 0 + · cases n <;> simp + · induction n with + | zero => simp + | succ n IH => rw [pow_succ, wlog_mul (pow_ne_zero n hx) hx, IH, Nat.cast_add_one, add_one_mul] + +@[simp] +theorem wlog_zpow (x : Surreal) (n : ℤ) : wlog (x ^ n) = n * wlog x := by + obtain ⟨n, rfl | rfl⟩ := n.eq_nat_or_neg <;> simp + +@[simp high] -- This should fire before `ArchimedeanClass.mk_div` +theorem archimedeanClassMk_div_wpow_wlog (x : Surreal) : + ArchimedeanClass.mk (x / ω^ x.wlog) = .mk x - .mk x := by + obtain rfl | hx := eq_or_ne x 0 <;> simp_all + +theorem mk_div_wpow_wlog_of_ne_zero {x : Surreal} (hx : x ≠ 0) : + ArchimedeanClass.mk (x / ω^ x.wlog) = 0 := by + rw [archimedeanClassMk_div_wpow_wlog, LinearOrderedAddCommGroupWithTop.sub_self_eq_zero_of_ne_top] + simpa + +private theorem ofSets_wlog_eq {x : IGame} [Numeric x] : + !{IGame.wlog '' {y ∈ xᴸ | 0 < y} | IGame.wlog '' xᴿ} = + !{range (Subtype.val ∘ fun x : (xᴸ ∩ Ioi 0 :) ↦ ⟨_, Numeric.wlog x⟩) | + range (Subtype.val ∘ fun x : xᴿ ↦ ⟨_, Numeric.wlog x⟩)} := by + congr! <;> exact image_eq_range .. + +private theorem mk_wpow_wlog_left {x : IGame} [Numeric x] : + ∀ y : (xᴸ ∩ Ioi 0 :), ArchimedeanClass.mk (ω^ mk y.1.wlog) = .mk (mk y) := by + intro ⟨y, hy, hy'⟩ + numeric + rw [mk_wlog, ← veq_def] + exact wpow_wlog_veq hy'.ne' + +private theorem mk_wpow_wlog_right {x : IGame} [Numeric x] (h : 0 < x) : + ∀ y : xᴿ, ArchimedeanClass.mk (ω^ mk y.1.wlog) = .mk (mk y) := by + intro ⟨y, hy⟩ + numeric + rw [mk_wlog, ← veq_def] + apply wpow_wlog_veq + simpa [← mk_eq_mk] using (h.trans (Numeric.lt_right hy)).not_antisymmRel_symm + +theorem numeric_of_forall_mk_ne_mk {x : IGame} [Numeric x] (h : 0 < x) + (Hl : ∀ y (hy : y ∈ xᴸ), 0 < y → + ArchimedeanClass.mk (@mk y (Numeric.of_mem_moves hy)) ≠ .mk (mk x)) + (Hr : ∀ y (hy : y ∈ xᴿ), + ArchimedeanClass.mk (@mk y (Numeric.of_mem_moves hy)) ≠ .mk (mk x)) : + Numeric !{IGame.wlog '' {y ∈ xᴸ | 0 < y} | IGame.wlog '' xᴿ} := by + rw [ofSets_wlog_eq] + exact numeric_of_forall_mk_ne_mk' h mk_wpow_wlog_left (mk_wpow_wlog_right h) Hl Hr + +theorem wpow_equiv_of_forall_mk_ne_mk {x : IGame} [Numeric x] (h : 0 < x) + (Hl : ∀ y (hy : y ∈ xᴸ), 0 < y → + ArchimedeanClass.mk (@mk y (Numeric.of_mem_moves hy)) ≠ .mk (mk x)) + (Hr : ∀ y (hy : y ∈ xᴿ), + ArchimedeanClass.mk (@mk y (Numeric.of_mem_moves hy)) ≠ .mk (mk x)) : + ω^ !{IGame.wlog '' {y ∈ xᴸ | 0 < y} | IGame.wlog '' xᴿ} ≈ x := by + rw [ofSets_wlog_eq] + exact wpow_equiv_of_forall_mk_ne_mk' h mk_wpow_wlog_left (mk_wpow_wlog_right h) Hl Hr + +/-- A game not commensurate with its positive options is a power of `ω`. -/ +theorem mem_range_wpow_of_forall_mk_ne_mk {x : IGame} [Numeric x] (h : 0 < x) + (Hl : ∀ y (hy : y ∈ xᴸ), 0 < y → + ArchimedeanClass.mk (@mk y (Numeric.of_mem_moves hy)) ≠ .mk (mk x)) + (Hr : ∀ y (hy : y ∈ xᴿ), + ArchimedeanClass.mk (@mk y (Numeric.of_mem_moves hy)) ≠ .mk (mk x)) : + mk x ∈ range (ω^ ·) := by + have hn := numeric_of_forall_mk_ne_mk h Hl Hr + exact ⟨@mk _ hn, mk_eq (wpow_equiv_of_forall_mk_ne_mk h Hl Hr)⟩ + +@[simp] +theorem toSurreal_wpow (x : NatOrdinal) : (ω^ x).toSurreal = ω^ x.toSurreal := + Surreal.mk_eq (toIGame_wpow_equiv x) + +end Surreal +end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Real.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Real.lean new file mode 100644 index 0000000000..95f0a872b8 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Real.lean @@ -0,0 +1,737 @@ +/- +Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Dyadic +public import Mathlib.Algebra.Order.Archimedean.Defs +public import Mathlib.Algebra.Order.Hom.Ring + +/-! +# Real numbers as games + +We define the function `Real.toIGame`, casting a real number to its Dedekind cut, and prove that +it's an order embedding. We then define the `Game` and `Surreal` versions of this map, and prove +that they are ring and field homomorphisms respectively. + +## TODO + +Prove that every real number has birthday at most `ω`. +-/ + +universe u + +open IGame + +@[expose] public noncomputable section + +theorem exists_dyadic_btwn {K : Type*} [Field K] [LinearOrder K] [IsStrictOrderedRing K] + [Archimedean K] {x y : K} (h : x < y) : ∃ q : Dyadic, x < q.toRat ∧ q.toRat < y := by + obtain ⟨n, nh⟩ := exists_nat_gt (y - x)⁻¹ + have := nh.trans (Nat.cast_lt.2 Nat.lt_two_pow_self) + obtain ⟨z, hz, hz'⟩ := exists_div_btwn h (nh.trans (Nat.cast_lt.2 Nat.lt_two_pow_self)) + use .mkRat z ⟨n, rfl⟩ + simp_all [Rat.mkRat_eq_div] + +namespace Real + +/-! ### `ℝ` to `IGame` -/ + +/-- The canonical map from `ℝ` to `IGame`, sending a real number to its Dedekind cut of dyadic +rationals. -/ +@[coe, match_pattern] def toIGame (x : ℝ) : IGame.{u} := + !{(↑) '' {q : Dyadic | q.toRat < x} | (↑) '' {q : Dyadic | x < q.toRat}} + +instance : Coe ℝ IGame := ⟨toIGame⟩ + +instance Numeric.toIGame (x : ℝ) : Numeric x := by + rw [Real.toIGame] + apply Numeric.mk + · simp only [leftMoves_ofSets, rightMoves_ofSets, Set.forall_mem_image, Set.mem_setOf] + intro x hx y hy + simpa using hx.trans hy + · aesop (add simp [Numeric.dyadic]) + +@[simp] +theorem leftMoves_toIGame (x : ℝ) : xᴸ = (↑) '' {q : Dyadic | q.toRat < x} := + leftMoves_ofSets .. + +@[simp] +theorem rightMoves_toIGame (x : ℝ) : xᴿ = (↑) '' {q : Dyadic | x < q.toRat} := + rightMoves_ofSets .. + +theorem forall_leftMoves_toIGame {P : IGame → Prop} {x : ℝ} : + (∀ y ∈ xᴸ, P y) ↔ ∀ q : Dyadic, q.toRat < x → P q := by + aesop + +theorem exists_leftMoves_toIGame {P : IGame → Prop} {x : ℝ} : + (∃ y ∈ xᴸ, P y) ↔ ∃ q : Dyadic, q.toRat < x ∧ P q := by + aesop + +theorem forall_rightMoves_toIGame {P : IGame → Prop} {x : ℝ} : + (∀ y ∈ xᴿ, P y) ↔ ∀ q : Dyadic, x < q.toRat → P q := by + aesop + +theorem exists_rightMoves_toIGame {P : IGame → Prop} {x : ℝ} : + (∃ y ∈ xᴿ, P y) ↔ ∃ q : Dyadic, x < q.toRat ∧ P q := by + aesop + +theorem mem_leftMoves_toIGame_of_lt {q : Dyadic} {x : ℝ} (h : q.toRat < x) : + (q : IGame) ∈ xᴸ := by + simpa + +theorem mem_rightMoves_toIGame_of_lt {q : Dyadic} {x : ℝ} (h : x < q.toRat) : + (q : IGame) ∈ xᴿ := by + simpa + +/-- `Real.toIGame` as an `OrderEmbedding`. -/ +@[simps!] +def toIGameEmbedding : ℝ ↪o IGame := by + refine .ofStrictMono toIGame fun x y h ↦ ?_ + obtain ⟨q, hx, hy⟩ := exists_dyadic_btwn h + trans (q : IGame) + · apply Numeric.lt_right + simpa [toIGame] + · apply Numeric.left_lt + simpa [toIGame] + +@[simp, norm_cast] +theorem toIGame_le_iff {x y : ℝ} : (x : IGame) ≤ y ↔ x ≤ y := + toIGameEmbedding.le_iff_le + +@[simp, norm_cast] +theorem toIGame_lt_iff {x y : ℝ} : (x : IGame) < y ↔ x < y := + toIGameEmbedding.lt_iff_lt + +@[simp, norm_cast] +theorem toIGame_equiv_iff {x y : ℝ} : (x : IGame) ≈ y ↔ x = y := by + simp [AntisymmRel, le_antisymm_iff] + +@[simp, norm_cast] +theorem toIGame_inj {x y : ℝ} : (x : IGame) = y ↔ x = y := + toIGameEmbedding.inj + +@[simp, norm_cast] +theorem toIGame_neg (x : ℝ) : toIGame (-x) = -toIGame x := by + simp_rw [toIGame, neg_ofSets, ofSets_inj, + ← Set.image_neg_of_apply_neg_eq_neg (fun _ _ ↦ Dyadic.toIGame_neg _)] + aesop (add simp [lt_neg, neg_lt]) + +theorem toIGame_ratCast_equiv (q : ℚ) : toIGame q ≈ q := by + rw [AntisymmRel, le_iff_forall_lf, le_iff_forall_lf] + refine ⟨⟨?_, fun x hx ↦ ?_⟩, ⟨fun x hx ↦ ?_, ?_⟩⟩ + · aesop + · obtain ⟨r, hr, hr'⟩ := equiv_ratCast_of_mem_rightMoves_ratCast hx + obtain ⟨s, hs, hs'⟩ := exists_dyadic_btwn hr + rw [← IGame.ratCast_lt] at hs' + grw [← hr'] at hs' + apply lf_of_right_le (z := s) + · rw [Rat.cast_eq_id, id] at hs' + grw [← s.toIGame_equiv] at hs' + exact hs'.le + · simpa + · obtain ⟨r, hr, hr'⟩ := equiv_ratCast_of_mem_leftMoves_ratCast hx + obtain ⟨s, hs, hs'⟩ := exists_dyadic_btwn hr + rw [← IGame.ratCast_lt] at hs + grw [← hr'] at hs + apply lf_of_le_left (z := s) + · rw [Rat.cast_eq_id, id] at hs + grw [← s.toIGame_equiv] at hs + exact hs.le + · simpa + · aesop + +theorem toIGame_dyadic_equiv (q : Dyadic) : toIGame q.toRat ≈ q := by + rw [q.toIGame_equiv.antisymmRel_congr_right] + exact toIGame_ratCast_equiv _ + +theorem toIGame_natCast_equiv (n : ℕ) : toIGame n ≈ n := by + rw [← Rat.cast_natCast] + simpa using toIGame_dyadic_equiv n + +theorem toIGame_intCast_equiv (n : ℤ) : toIGame n ≈ n := by + rw [← Rat.cast_intCast] + simpa using toIGame_dyadic_equiv n + +theorem toIGame_zero_equiv : toIGame 0 ≈ 0 := by simpa using toIGame_natCast_equiv 0 +theorem toIGame_one_equiv : toIGame 1 ≈ 1 := by simpa using toIGame_natCast_equiv 1 + +@[simp, norm_cast] +theorem ratCast_lt_toIGame {q : ℚ} {x : ℝ} : q < (x : IGame) ↔ q < x := by + rw [← (toIGame_ratCast_equiv q).lt_congr_left, toIGame_lt_iff] +@[simp, norm_cast] +theorem toIGame_lt_ratCast {q : ℚ} {x : ℝ} : (x : IGame) < q ↔ x < q := by + rw [← (toIGame_ratCast_equiv q).lt_congr_right, toIGame_lt_iff] + +@[simp, norm_cast] +theorem ratCast_le_toIGame {q : ℚ} {x : ℝ} : q ≤ (x : IGame) ↔ q ≤ x := by + simp [← not_lt, ← Numeric.not_lt] +@[simp, norm_cast] +theorem toIGame_le_ratCast {q : ℚ} {x : ℝ} : (x : IGame) ≤ q ↔ x ≤ q := by + simp [← not_lt, ← Numeric.not_lt] + +@[simp, norm_cast] +theorem ratCast_equiv_toIGame {q : ℚ} {x : ℝ} : (q : IGame) ≈ (x : IGame) ↔ q = x := by + simp [AntisymmRel, le_antisymm_iff] +@[simp, norm_cast] +theorem toIGame_equiv_ratCast {q : ℚ} {x : ℝ} : (x : IGame) ≈ q ↔ x = q := by + simp [AntisymmRel, le_antisymm_iff] + +theorem toIGame_add_ratCast_equiv (x : ℝ) (q : ℚ) : toIGame (x + q) ≈ x + q := by + rw [AntisymmRel, le_iff_forall_lf, le_iff_forall_lf, forall_moves_add, forall_moves_add] + simp_rw [forall_leftMoves_toIGame, forall_rightMoves_toIGame, Numeric.not_le] + refine ⟨⟨fun r hr ↦ ?_, ⟨fun r hr ↦ ?_, ?_⟩⟩, ⟨⟨fun r hr ↦ ?_, ?_⟩, fun r hr ↦ ?_⟩⟩ + · grw [r.toIGame_equiv] + rw [← IGame.sub_lt_iff_lt_add] + grw [← IGame.ratCast_sub_equiv] + simpa [sub_lt_iff_lt_add] + · grw [r.toIGame_equiv, ← IGame.ratCast_add_equiv] + simpa + · intro y hy + obtain ⟨r, hr, hy⟩ := equiv_ratCast_of_mem_rightMoves_ratCast hy + grw [hy] + rw [← ratCast_lt, ← add_lt_add_iff_left x] at hr + obtain ⟨s, hs, hs'⟩ := exists_rat_btwn hr + apply (lt_trans (b := (s : IGame)) _ _).not_ge + · simpa + · rw [← IGame.sub_lt_iff_lt_add] + grw [← IGame.ratCast_sub_equiv] + simpa [sub_lt_iff_lt_add] + · grw [r.toIGame_equiv, ← IGame.ratCast_add_equiv] + simpa + · intro y hy + obtain ⟨r, hr, hy⟩ := equiv_ratCast_of_mem_leftMoves_ratCast hy + grw [hy] + rw [← ratCast_lt, ← add_lt_add_iff_left x] at hr + obtain ⟨s, hs, hs'⟩ := exists_rat_btwn hr + apply (lt_trans (b := (s : IGame)) _ _).not_ge + · rw [← IGame.lt_sub_iff_add_lt] + grw [← IGame.ratCast_sub_equiv] + simpa [lt_sub_iff_add_lt] + · simpa + · grw [r.toIGame_equiv] + rw [← IGame.lt_sub_iff_add_lt] + grw [← IGame.ratCast_sub_equiv] + simpa [lt_sub_iff_add_lt] + +theorem toIGame_ratCast_add_equiv (q : ℚ) (x : ℝ) : toIGame (q + x) ≈ q + x := by + simpa [add_comm] using toIGame_add_ratCast_equiv x q + +theorem toIGame_add_dyadic_equiv (x : ℝ) (q : Dyadic) : toIGame (x + q.toRat) ≈ x + q := + (toIGame_add_ratCast_equiv _ _).trans (add_congr_right q.toIGame_equiv.symm) + +theorem toIGame_dyadic_add_equiv (q : Dyadic) (x : ℝ) : toIGame (q.toRat + x) ≈ q + x := by + simpa [add_comm] using toIGame_add_dyadic_equiv x q + +theorem toIGame_add_equiv (x y : ℝ) : toIGame (x + y) ≈ x + y := by + rw [AntisymmRel, le_iff_forall_lf, le_iff_forall_lf, forall_moves_add, forall_moves_add] + simp_rw [forall_leftMoves_toIGame, forall_rightMoves_toIGame, Numeric.not_le] + refine ⟨⟨?_, ⟨?_, ?_⟩⟩, ⟨⟨?_, ?_⟩, ?_⟩⟩ <;> intro q hq + · rw [← sub_lt_iff_lt_add] at hq + obtain ⟨r, hr, hr'⟩ := exists_rat_btwn hq + rw [sub_lt_comm] at hr + obtain ⟨s, hs, hs'⟩ := exists_rat_btwn hr + trans r + s + · rw [add_comm, q.toIGame_equiv.lt_congr_left, ← IGame.sub_lt_iff_lt_add, + ← (ratCast_sub_equiv ..).lt_congr_left] + simp_all [← Rat.cast_sub] + · apply add_lt_add <;> simpa + on_goal 5 => + rw [← lt_sub_iff_add_lt] at hq + obtain ⟨r, hr, hr'⟩ := exists_rat_btwn hq + rw [lt_sub_comm] at hr' + obtain ⟨s, hs, hs'⟩ := exists_rat_btwn hr' + trans r + s + · apply add_lt_add <;> simpa + · grw [q.toIGame_equiv] + rw [add_comm, ← IGame.lt_sub_iff_add_lt] + grw [← ratCast_sub_equiv] + simp_all [← Rat.cast_sub] + all_goals + first | grw [← toIGame_dyadic_add_equiv] | grw [← toIGame_add_dyadic_equiv] + simpa + +theorem toIGame_sub_ratCast_equiv (x : ℝ) (q : ℚ) : toIGame (x - q) ≈ x - q := by + simpa [sub_eq_add_neg] using toIGame_add_ratCast_equiv x (-q) + +theorem toIGame_ratCast_sub_equiv (q : ℚ) (x : ℝ) : toIGame (q - x) ≈ q - x := by + simpa [sub_eq_add_neg] using toIGame_ratCast_add_equiv q (-x) + +theorem toIGame_sub_dyadic_equiv (x : ℝ) (q : Dyadic) : toIGame (x - q.toRat) ≈ x - q := by + simpa [sub_eq_add_neg] using toIGame_add_dyadic_equiv x (-q) + +theorem toIGame_dyadic_sub_equiv (q : Dyadic) (x : ℝ) : toIGame (q.toRat - x) ≈ q - x := by + simpa [sub_eq_add_neg] using toIGame_dyadic_add_equiv q (-x) + +theorem toIGame_sub_equiv (x y : ℝ) : toIGame (x - y) ≈ x - y := by + simpa [sub_eq_add_neg] using toIGame_add_equiv x (-y) + +/-! ### `ℝ` to `Game` -/ + +/-- The canonical map from `ℝ` to `Game`, sending a real number to its Dedekind cut. -/ +@[coe, match_pattern] def toGame (x : ℝ) : Game := .mk x + +instance : Coe ℝ Game := ⟨toGame⟩ + +@[simp] theorem _root_.Game.mk_real_toIGame (x : ℝ) : .mk x.toIGame = x.toGame := rfl + +theorem toGame_def (x : ℝ) : + toGame x = !{(fun q => q.toRat) '' {q : Dyadic | q.toRat < x} | + (fun q => q.toRat) '' {q : Dyadic | x < q.toRat}} := by + rw [← Game.mk_real_toIGame, toIGame] + simp [Set.image_image] + +/-- `Real.toGame` as an `OrderEmbedding`. -/ +@[simps!] +def toGameEmbedding : ℝ ↪o Game := + .ofStrictMono toGame fun _ _ h ↦ toIGameEmbedding.strictMono h + +@[simp, norm_cast] +theorem toGame_le_iff {x y : ℝ} : (x : Game) ≤ y ↔ x ≤ y := + toGameEmbedding.le_iff_le + +@[simp, norm_cast] +theorem toGame_lt_iff {x y : ℝ} : (x : Game) < y ↔ x < y := + toGameEmbedding.lt_iff_lt + +@[norm_cast] +theorem toGame_equiv_iff {x y : ℝ} : (x : Game) ≈ y ↔ x = y := by + simp [AntisymmRel, le_antisymm_iff] + +@[simp, norm_cast] +theorem toGame_inj {x y : ℝ} : (x : Game) = y ↔ x = y := + toGameEmbedding.inj + +@[simp, norm_cast] +theorem toGame_ratCast (q : ℚ) : toGame q = q := Game.mk_eq (toIGame_ratCast_equiv q) + +@[simp, norm_cast] +theorem toGame_natCast (n : ℕ) : toGame n = n := by simpa using toGame_ratCast n + +@[simp, norm_cast] +theorem toGame_intCast (n : ℤ) : toGame n = n := by simpa using toGame_ratCast n + +@[simp] theorem toGame_zero : toGame 0 = 0 := by simpa using toGame_natCast 0 +@[simp] theorem toGame_one : toGame 1 = 1 := by simpa using toGame_natCast 1 + +@[simp] +theorem toGame_add (x y : ℝ) : toGame (x + y) = toGame x + toGame y := by + simpa using Game.mk_eq (toIGame_add_equiv x y) + +@[simp] +theorem toGame_sub (x y : ℝ) : toGame (x - y) = toGame x - toGame y := by + simpa using Game.mk_eq (toIGame_sub_equiv x y) + +/-- `Real.toGame` as an `OrderAddMonoidHom`. -/ +@[simps] +def toGameAddHom : ℝ →+o Game where + toFun := toGame + map_zero' := toGame_zero + map_add' := toGame_add + monotone' := toGameEmbedding.monotone + +/-! ### `ℝ` to `Surreal` -/ + +/-- The canonical map from `ℝ` to `Surreal`, sending a real number to its Dedekind cut. -/ +@[coe, match_pattern] def toSurreal (x : ℝ) : Surreal := .mk x + +instance : Coe ℝ Surreal := ⟨toSurreal⟩ + +@[simp] theorem _root_.Surreal.mk_real_toIGame (x : ℝ) : .mk x.toIGame = x.toSurreal := rfl + +private theorem toSurreal_def_aux {x : ℝ} : + ∀ y ∈ ((fun q => q.toRat) '' {q : Dyadic | q.toRat < x} : Set Surreal), + ∀ z ∈ (fun q => q.toRat) '' {q : Dyadic | x < q.toRat}, y < z := by + rintro - ⟨q, hq, rfl⟩ - ⟨r, hr, rfl⟩ + dsimp at * + exact_mod_cast hq.trans hr + +@[simp] theorem toGame_toSurreal (x : ℝ) : x.toSurreal.toGame = x.toGame := rfl + +theorem toSurreal_def (x : ℝ) : toSurreal x = + !{(fun q => q.toRat) '' {q : Dyadic | q.toRat < x} | + ((fun q => q.toRat) '' {q : Dyadic | x < q.toRat})}'(by exact toSurreal_def_aux) := by + rw [← Surreal.toGame_inj, toGame_toSurreal, Surreal.toGame_ofSets, toGame_def] + congr! <;> aesop + +/-- `Real.toSurreal` as an `OrderEmbedding`. -/ +@[simps!] +def toSurrealEmbedding : ℝ ↪o Surreal := + .ofStrictMono toSurreal fun _ _ h ↦ toIGameEmbedding.strictMono h + +@[simp, norm_cast] +theorem toSurreal_le_iff {x y : ℝ} : (x : Surreal) ≤ y ↔ x ≤ y := + toSurrealEmbedding.le_iff_le + +@[simp, norm_cast] +theorem toSurreal_lt_iff {x y : ℝ} : (x : Surreal) < y ↔ x < y := + toSurrealEmbedding.lt_iff_lt + +@[norm_cast] +theorem toSurreal_equiv_iff {x y : ℝ} : (x : Surreal) ≈ y ↔ x = y := by + simp [AntisymmRel, le_antisymm_iff] + +@[simp, norm_cast] +theorem toSurreal_inj {x y : ℝ} : (x : Surreal) = y ↔ x = y := + toSurrealEmbedding.inj + +@[simp, norm_cast] +theorem toSurreal_ratCast (q : ℚ) : toSurreal q = q := by + simpa using Surreal.mk_eq (toIGame_ratCast_equiv q) + +@[simp, norm_cast] theorem toSurreal_natCast (n : ℕ) : toSurreal n = n := by + simpa using toSurreal_ratCast n +@[simp] theorem toSurreal_ofNat (n : ℕ) [n.AtLeastTwo] : toSurreal ofNat(n) = n := + toSurreal_natCast n +@[simp, norm_cast] theorem toSurreal_intCast (n : ℤ) : toSurreal n = n := by + simpa using toSurreal_ratCast n + +@[simp, norm_cast] theorem toSurreal_zero : toSurreal 0 = 0 := by simpa using toSurreal_natCast 0 +@[simp, norm_cast] theorem toSurreal_one : toSurreal 1 = 1 := by simpa using toSurreal_natCast 1 + +@[simp] theorem toSurreal_eq_zero_iff {x : ℝ} : (x : Surreal) = 0 ↔ x = 0 := by norm_cast +@[simp] theorem zero_eq_toSurreal_iff {x : ℝ} : 0 = (x : Surreal) ↔ 0 = x := by norm_cast + +@[simp] theorem toSurreal_eq_one_iff {x : ℝ} : (x : Surreal) = 1 ↔ x = 1 := by norm_cast +@[simp] theorem one_eq_toSurreal_iff {x : ℝ} : 1 = (x : Surreal) ↔ 1 = x := by norm_cast + +@[simp] theorem toSurreal_nonneg_iff {x : ℝ} : 0 ≤ (x : Surreal) ↔ 0 ≤ x := by norm_cast +@[simp] theorem toSurreal_nonpos_iff {x : ℝ} : (x : Surreal) ≤ 0 ↔ x ≤ 0 := by norm_cast + +@[simp] theorem toSurreal_pos_iff {x : ℝ} : 0 < (x : Surreal) ↔ 0 < x := by norm_cast +@[simp] theorem toSurreal_neg_iff {x : ℝ} : (x : Surreal) < 0 ↔ x < 0 := by norm_cast + +@[simp] +theorem toSurreal_neg (x : ℝ) : toSurreal (-x) = -toSurreal x := + Surreal.mk_eq (toIGame_neg _).antisymmRel + +@[simp] +theorem toSurreal_add (x y : ℝ) : toSurreal (x + y) = x + y := + Surreal.mk_eq (toIGame_add_equiv x y) + +@[simp] +theorem toSurreal_sub (x y : ℝ) : toSurreal (x - y) = x - y := + Surreal.mk_eq (toIGame_sub_equiv x y) + +@[simp] +theorem toSurreal_max (x y : ℝ) : max x y = max (toSurreal x) (toSurreal y) := by + have := le_total x y + aesop + +@[simp] +theorem toSurreal_min (x y : ℝ) : min x y = min (toSurreal x) (toSurreal y) := by + have := le_total x y + aesop + +@[simp, norm_cast] +theorem toSurreal_abs (x : ℝ) : |x| = |toSurreal x| := by + simp [abs] + +/-! For convenience, we deal with multiplication after defining `Real.toSurreal`. -/ + +private theorem exists_rat_mul_btwn {a b x : ℝ} (h : a * x < b) : + ∃ q : ℚ, a * x ≤ q * x ∧ q * x < b := by + obtain hx | rfl | hx := lt_trichotomy x 0 + · rw [← div_lt_iff_of_neg hx] at h + obtain ⟨q, hq, hq'⟩ := exists_rat_btwn h + use q, mul_le_mul_of_nonpos_right hq'.le hx.le + rwa [← div_lt_iff_of_neg hx] + · use 0 + simp_all + · rw [← lt_div_iff₀ hx] at h + obtain ⟨q, hq, hq'⟩ := exists_rat_btwn h + use q, mul_le_mul_of_nonneg_right hq.le hx.le + rwa [← lt_div_iff₀ hx] + +private theorem exists_rat_mul_btwn' {a b x : ℝ} (h : a < b * x) : + ∃ q : ℚ, a < q * x ∧ q * x ≤ b * x := by + have : -b * x < -a := by simpa + obtain ⟨q, hq, hq'⟩ := exists_rat_mul_btwn this + use -q + simp_all [lt_neg, neg_le] + +private theorem toIGame_mul_le_mul {x : ℝ} {q r : ℚ} (h : x * r ≤ q * r) : + toIGame x * r ≤ q * r := by + obtain hr | rfl | hr := lt_trichotomy r 0 <;> simp_all + +private theorem toIGame_mul_le_mul' {x : ℝ} {q r : ℚ} (h : q * r ≤ x * r) : + q * r ≤ toIGame x * r := by + obtain hr | rfl | hr := lt_trichotomy r 0 <;> simp_all + +private theorem mulOption_lt_toIGame {x : ℝ} {q r s : ℚ} (h : x * s < x * q - r * q + r * s) : + mulOption (toIGame x) q r s < toIGame.{u} (x * q) := by + obtain ⟨t, ht, ht'⟩ := exists_rat_mul_btwn h + apply lt_of_le_of_lt (b := ((r * q + t * s - r * s :) : IGame)) + · have := toIGame_mul_le_mul.{u} ht + simp_all [mulOption, ← Surreal.mk_le_mk] + · rw [← sub_lt_iff_lt_add, lt_sub_iff_add_lt] at ht' + convert ht' + simp only [ratCast_lt_toIGame, Rat.cast_sub, Rat.cast_add, Rat.cast_mul] + abel_nf + +private theorem toIGame_lt_mulOption {x : ℝ} {q r s : ℚ} (h : x * q - r * q + r * s < x * s) : + toIGame.{u} (x * q) < mulOption (toIGame x) q r s := by + obtain ⟨t, ht, ht'⟩ := exists_rat_mul_btwn' h + apply lt_of_lt_of_le (b := ((r * q + t * s - r * s :) : IGame)) + · rw [← lt_sub_iff_add_lt, sub_lt_iff_lt_add] at ht + convert ht + simp only [toIGame_lt_ratCast, Rat.cast_sub, Rat.cast_add, Rat.cast_mul] + abel_nf + · have := toIGame_mul_le_mul'.{u} ht' + simp_all [mulOption, ← Surreal.mk_le_mk] + +theorem toIGame_mul_ratCast_equiv (x : ℝ) (q : ℚ) : (x * q).toIGame ≈ x * q := by + rw [AntisymmRel, le_iff_forall_lf, le_iff_forall_lf, forall_moves_mul, forall_moves_mul, + Player.forall, Player.forall] + simp_rw [forall_leftMoves_toIGame, forall_rightMoves_toIGame, Numeric.not_le] + refine ⟨⟨fun r h ↦ ?_, ⟨?_, ?_⟩⟩, ⟨⟨?_, ?_⟩, fun r h ↦ ?_⟩⟩ + any_goals intro r hr y hy; numeric + · grw [r.toIGame_equiv] + obtain hq | rfl | hq := lt_trichotomy q 0 + · rw [← lt_div_iff_of_neg (mod_cast hq)] at h + rw [← Numeric.lt_div_iff_of_neg (by simpa)] + grw [← ratCast_div_equiv] + simpa + · simp_all + · rw [← div_lt_iff₀ (mod_cast hq)] at h + rw [← Numeric.div_lt_iff (by simpa)] + grw [← ratCast_div_equiv] + simpa + · obtain ⟨s, hs, hy⟩ := equiv_ratCast_of_mem_rightMoves_ratCast hy + grw [Numeric.mulOption_congr₃ r.toIGame_equiv, Numeric.mulOption_congr₄ hy] + apply (toIGame_lt_mulOption _).not_ge + have : 0 < (x - r.toRat) * (s - q) := by apply mul_pos <;> simpa [sub_pos] + simp_all [sub_mul, mul_sub, lt_sub_iff_add_lt] + · obtain ⟨s, hs, hy⟩ := equiv_ratCast_of_mem_leftMoves_ratCast hy + grw [Numeric.mulOption_congr₃ r.toIGame_equiv, Numeric.mulOption_congr₄ hy] + apply (toIGame_lt_mulOption _).not_ge + have : 0 < (x - r.toRat) * (s - q) := by apply mul_pos_of_neg_of_neg <;> simpa [sub_pos] + simp_all [sub_mul, mul_sub, lt_sub_iff_add_lt] + · obtain ⟨s, hs, hy⟩ := equiv_ratCast_of_mem_leftMoves_ratCast hy + grw [Numeric.mulOption_congr₃ r.toIGame_equiv, Numeric.mulOption_congr₄ hy] + apply (mulOption_lt_toIGame _).not_ge + have : 0 < (x - r.toRat) * (q - s) := by apply mul_pos <;> simpa [sub_pos] + simp_all [sub_mul, mul_sub, sub_lt_iff_lt_add] + · obtain ⟨s, hs, hy⟩ := equiv_ratCast_of_mem_rightMoves_ratCast hy + grw [Numeric.mulOption_congr₃ r.toIGame_equiv, Numeric.mulOption_congr₄ hy] + apply (mulOption_lt_toIGame _).not_ge + have : 0 < (x - r.toRat) * (q - s) := by apply mul_pos_of_neg_of_neg <;> simpa [sub_pos] + simp_all [sub_mul, mul_sub, sub_lt_iff_lt_add] + · rw [r.toIGame_equiv.lt_congr_right] + obtain hq | rfl | hq := lt_trichotomy q 0 + · rw [← div_lt_iff_of_neg (mod_cast hq)] at h + rw [← Numeric.div_lt_iff_of_neg (by simpa)] + grw [← ratCast_div_equiv] + simpa + · simp_all + · rw [← lt_div_iff₀ (mod_cast hq)] at h + rw [← Numeric.lt_div_iff (by simpa)] + grw [← ratCast_div_equiv] + simpa + +theorem toIGame_ratCast_mul_equiv (q : ℚ) (x : ℝ) : (q * x).toIGame ≈ q * x := by + simpa [mul_comm] using toIGame_mul_ratCast_equiv x q + +private theorem dyadic_lt_mul_toIGame' {x y : ℝ} {q : Dyadic} + (hx : 0 < x) (hy : 0 < y) (h : q.toRat < x * y) : (q : IGame) < x * y := by + rw [← div_lt_iff₀ hy] at h + obtain ⟨r, hr, hr'⟩ := exists_rat_btwn (max_lt h hx) + obtain ⟨hr, hr₀⟩ := max_lt_iff.1 hr + rw [div_lt_comm₀ hy hr₀] at hr + obtain ⟨s, hs, hs'⟩ := exists_rat_btwn (max_lt hr hy) + trans r * s + · grw [mul_comm, q.toIGame_equiv, ← IGame.Numeric.div_lt_iff, ← ratCast_div_equiv] <;> + simp_all [← Rat.cast_div] + · simp_rw [← Surreal.mk_lt_mk] + dsimp + apply mul_lt_mul _ (le_of_lt _) _ (le_of_lt _) <;> + simp_all [← toSurreal_zero, ← toSurreal_ratCast] + +private theorem mul_toIGame_lt_dyadic' {x y : ℝ} {q : Dyadic} + (hx : 0 < x) (hy : 0 < y) (h : x * y < q.toRat) : x * y < (q : IGame) := by + rw [← lt_div_iff₀ hy] at h + obtain ⟨r, hr, hr'⟩ := exists_rat_btwn h + have hr₀ := hx.trans hr + rw [lt_div_comm₀ hr₀ hy] at hr' + obtain ⟨s, hs, hs'⟩ := exists_rat_btwn hr' + trans r * s + · simp_rw [← Surreal.mk_lt_mk] + dsimp + apply mul_lt_mul _ (le_of_lt _) _ (le_of_lt _) <;> + simp_all [← toSurreal_zero, ← toSurreal_ratCast] + · grw [mul_comm, q.toIGame_equiv, ← IGame.Numeric.lt_div_iff, ← ratCast_div_equiv] <;> + simp_all [← Rat.cast_div] + +private theorem dyadic_lt_mul_toIGame {x y : ℝ} (q : Dyadic) (h : q.toRat < x * y) : + (q : IGame.{u}) < x * y := by + obtain hx | rfl | hx := lt_trichotomy x 0 + · obtain hy | rfl | hy := lt_trichotomy y 0 + · have := @dyadic_lt_mul_toIGame'.{u} (-x) (-y) q + simp_all + · grw [Numeric.mul_congr_right toIGame_zero_equiv] + simp_all + · have := @mul_toIGame_lt_dyadic'.{u} (-x) y (-q) + simp_all + · grw [Numeric.mul_congr_left toIGame_zero_equiv] + simp_all + · obtain hy | rfl | hy := lt_trichotomy y 0 + · have := @mul_toIGame_lt_dyadic'.{u} x (-y) (-q) + simp_all + · grw [Numeric.mul_congr_right toIGame_zero_equiv] + simp_all + · exact dyadic_lt_mul_toIGame' hx hy h + +private theorem mul_toIGame_lt_dyadic {x y : ℝ} (q : Dyadic) (h : x * y < q.toRat) : + x * y < (q : IGame.{u}) := by + have := @dyadic_lt_mul_toIGame.{u} (-x) y (-q) + simp_all + +private theorem toSurreal_mul_ratCast (x : ℝ) (q : ℚ) : toSurreal (x * q) = x * q := by + simpa using Surreal.mk_eq (toIGame_mul_ratCast_equiv x q) + +private theorem mulOption_toIGame_equiv {x y : ℝ} {q r : Dyadic} : + mulOption (toIGame x) (toIGame y) q r ≈ + toIGame (q.toRat * y + x * r.toRat - q.toRat * r.toRat) := by + simp [← Surreal.mk_eq_mk, mulOption, mul_comm, toSurreal_mul_ratCast] + +theorem toIGame_mul_equiv (x y : ℝ) : (x * y).toIGame ≈ x * y := by + rw [AntisymmRel, le_iff_forall_lf, le_iff_forall_lf, forall_moves_mul, forall_moves_mul, + Player.forall, Player.forall] + dsimp + simp_rw [forall_leftMoves_toIGame, forall_rightMoves_toIGame, Numeric.not_le] + refine ⟨⟨dyadic_lt_mul_toIGame, ⟨?_, ?_⟩⟩, ⟨⟨?_, ?_⟩, mul_toIGame_lt_dyadic⟩⟩ <;> + (intro q hq r hr; grw [mulOption_toIGame_equiv]; rw [toIGame_lt_iff]) + · have : 0 < (x - q.toRat) * (r.toRat - y) := by apply mul_pos <;> simpa [sub_pos] + simp_all [sub_mul, mul_sub, sub_lt_iff_lt_add', add_sub_assoc] + · have : 0 < (x - q.toRat) * (r.toRat - y) := by apply mul_pos_of_neg_of_neg <;> simpa [sub_pos] + simp_all [sub_mul, mul_sub, sub_lt_iff_lt_add', add_sub_assoc] + · have : 0 < (x - q.toRat) * (y - r.toRat) := by apply mul_pos <;> simpa [sub_pos] + simp_all [sub_mul, mul_sub, lt_sub_iff_add_lt', add_sub_assoc] + · have : 0 < (x - q.toRat) * (y - r.toRat) := by apply mul_pos_of_neg_of_neg <;> simpa [sub_pos] + simp_all [sub_mul, mul_sub, lt_sub_iff_add_lt', add_sub_assoc] + +@[simp, norm_cast] +theorem toSurreal_mul (x y : ℝ) : (x * y).toSurreal = x * y := + Surreal.mk_eq (toIGame_mul_equiv x y) + +/-- `Real.toSurreal` as an `OrderRingHom`. -/ +@[simps] +def toSurrealRingHom : ℝ →+*o Surreal where + toFun := toSurreal + map_zero' := toSurreal_zero + map_one' := toSurreal_one + map_add' := toSurreal_add + map_mul' := toSurreal_mul + monotone' := toSurrealEmbedding.monotone + +@[simp, norm_cast] +theorem toSurreal_inv (x : ℝ) : x⁻¹.toSurreal = x.toSurreal⁻¹ := + map_inv₀ toSurrealRingHom x + +@[simp, norm_cast] +theorem toSurreal_div (x y : ℝ) : (x / y).toSurreal = x / y := + map_div₀ toSurrealRingHom x y + +theorem toIGame_inv_equiv (x : ℝ) : x⁻¹.toIGame ≈ x.toIGame⁻¹ := by + simp [← Surreal.mk_eq_mk] + +theorem toIGame_div_equiv (x y : ℝ) : (x / y).toIGame ≈ x / y := by + simp [← Surreal.mk_eq_mk] + +/-! ### Simp lemmas -/ + +/-! #### Dyadic -/ + +@[simp, norm_cast] +theorem dyadic_lt_toIGame {q : Dyadic} {x : ℝ} : q < (x : IGame) ↔ q.toRat < x := by + rw [← (toIGame_dyadic_equiv q).lt_congr_left, toIGame_lt_iff] +@[simp, norm_cast] +theorem toIGame_lt_dyadic {q : Dyadic} {x : ℝ} : (x : IGame) < q ↔ x < q.toRat := by + rw [← (toIGame_dyadic_equiv q).lt_congr_right, toIGame_lt_iff] + +@[simp, norm_cast] +theorem dyadic_le_toIGame {q : Dyadic} {x : ℝ} : q ≤ (x : IGame) ↔ q.toRat ≤ x := by + simp [← not_lt, ← Numeric.not_lt] +@[simp, norm_cast] +theorem toIGame_le_dyadic {q : Dyadic} {x : ℝ} : (x : IGame) ≤ q ↔ x ≤ q.toRat := by + simp [← not_lt, ← Numeric.not_lt] + +@[simp, norm_cast] +theorem dyadic_equiv_toIGame {q : Dyadic} {x : ℝ} : (q : IGame) ≈ x ↔ q.toRat = x := by + simp [AntisymmRel, le_antisymm_iff] +@[simp, norm_cast] +theorem toIGame_equiv_dyadic {q : Dyadic} {x : ℝ} : (x : IGame) ≈ q ↔ x = q.toRat := by + simp [AntisymmRel, le_antisymm_iff] + +/-! #### ℤ -/ + +@[simp, norm_cast] +theorem toIGame_lt_intCast {x : ℝ} {y : ℤ} : (x : IGame) < y ↔ x < y := by + simp [← (ratCast_intCast_equiv y).lt_congr_right] +@[simp, norm_cast] +theorem toIGame_le_intCast {x : ℝ} {y : ℤ} : (x : IGame) ≤ y ↔ x ≤ y := by + simp [← (ratCast_intCast_equiv y).le_congr_right] + +@[simp, norm_cast] +theorem intCast_lt_toIGame {x : ℤ} {y : ℝ} : (x : IGame) < y ↔ x < y := by + simp [← (ratCast_intCast_equiv x).lt_congr_left] +@[simp, norm_cast] +theorem intCast_le_toIGame {x : ℤ} {y : ℝ} : (x : IGame) ≤ y ↔ x ≤ y := by + simp [← (ratCast_intCast_equiv x).le_congr_left] + +@[simp, norm_cast] +theorem toIGame_equiv_intCast {x : ℝ} {y : ℤ} : (x : IGame) ≈ y ↔ x = y := by + simp [AntisymmRel, le_antisymm_iff] +@[simp, norm_cast] +theorem intCast_equiv_toIGame {x : ℤ} {y : ℝ} : (x : IGame) ≈ y ↔ x = y := by + simp [AntisymmRel, le_antisymm_iff] + +/-! #### ℕ -/ + +@[simp, norm_cast] +theorem toIGame_lt_natCast {x : ℝ} {y : ℕ} : (x : IGame) < y ↔ x < y := + toIGame_lt_intCast (y := y) +@[simp, norm_cast] +theorem toIGame_le_natCast {x : ℝ} {y : ℕ} : (x : IGame) ≤ y ↔ x ≤ y := + toIGame_le_intCast (y := y) + +@[simp, norm_cast] +theorem natCast_lt_toIGame {x : ℕ} {y : ℝ} : (x : IGame) < y ↔ x < y := + intCast_lt_toIGame (x := x) +@[simp, norm_cast] +theorem natCast_le_toIGame {x : ℕ} {y : ℝ} : (x : IGame) ≤ y ↔ x ≤ y := + intCast_le_toIGame (x := x) + +@[simp, norm_cast] +theorem toIGame_equiv_natCast {x : ℝ} {y : ℕ} : (x : IGame) ≈ y ↔ x = y := + toIGame_equiv_intCast (y := y) +@[simp, norm_cast] +theorem natCast_equiv_toIGame {x : ℕ} {y : ℝ} : (x : IGame) ≈ y ↔ x = y := + intCast_equiv_toIGame (x := x) + +/-! #### 0 -/ + +@[simp] theorem toIGame_lt_zero {x : ℝ} : (x : IGame) < 0 ↔ x < 0 := by norm_cast +@[simp] theorem toIGame_le_zero {x : ℝ} : (x : IGame) ≤ 0 ↔ x ≤ 0 := by norm_cast + +@[simp] theorem zero_lt_toIGame {x : ℝ} : 0 < (x : IGame) ↔ 0 < x := by norm_cast +@[simp] theorem zero_le_toIGame {x : ℝ} : 0 ≤ (x : IGame) ↔ 0 ≤ x := by norm_cast + +@[simp] theorem toIGame_equiv_zero {x : ℝ} : (x : IGame) ≈ 0 ↔ x = 0 := by norm_cast +@[simp] theorem zero_equiv_toIGame {x : ℝ} : 0 ≈ (x : IGame) ↔ 0 = x := by norm_cast + +/-! #### 1 -/ + +@[simp] theorem toIGame_lt_one {x : ℝ} : (x : IGame) < 1 ↔ x < 1 := by norm_cast +@[simp] theorem toIGame_le_one {x : ℝ} : (x : IGame) ≤ 1 ↔ x ≤ 1 := by norm_cast + +@[simp] theorem one_lt_toIGame {x : ℝ} : 1 < (x : IGame) ↔ 1 < x := by norm_cast +@[simp] theorem one_le_toIGame {x : ℝ} : 1 ≤ (x : IGame) ↔ 1 ≤ x := by norm_cast + +@[simp] theorem toIGame_equiv_one {x : ℝ} : (x : IGame) ≈ 1 ↔ x = 1 := by norm_cast +@[simp] theorem one_equiv_toIGame {x : ℝ} : 1 ≈ (x : IGame) ↔ 1 = x := by norm_cast + +end Real +end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Tactic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Tactic.lean new file mode 100644 index 0000000000..439185d26e --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Tactic.lean @@ -0,0 +1,12 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.AddInstances +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.GameCmp +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.OrdinalAlias +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.Register + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/AddInstances.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/AddInstances.lean new file mode 100644 index 0000000000..b6f8912456 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/AddInstances.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2025 Aaron Liu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aaron Liu, František Silváši +-/ +module + +public meta import Lean.Elab.Tactic.Basic +public meta import Lean.Meta.Tactic.Assert + +/-! +# Eagerly add instances + +Many definitions in game theory are hereditary. For instance, all options of a `Numeric` game are +`Numeric`, all options of an `Impartial` game are `Impartial`, etc. + +The definition `addInstances` provides a tactic which will eagerly apply all passed functions to all +of the hypotheses, creating new ones in the process. The intended usage of this is to, for instance, +apply `Numeric.of_mem_moves` to all hypotheses, and thus build all possible `Numeric` instances. +-/ + +open Lean Meta Elab Tactic + +meta def instances (constants : Array Name) (goal : MVarId) : MetaM (Option MVarId) := + goal.withContext do + let mut goal := goal + for h in ← getLCtx do + if h.isImplementationDetail then continue + ⟨_, goal⟩ ← goal.assertHypotheses =<< constants.filterMapM fun c => do + let hc ← try mkAppM c #[h.toExpr] catch _ => return none + return some { + userName := ← mkFreshUserName `inst + type := ← inferType hc + value := hc + } + return goal + +/-- A tactic that eagerly adds instances by applying the functions in `constants` to every +hypothesis. -/ +public meta def addInstances (constants : Array Name) : TacticM Unit := + liftMetaTactic1 (instances constants) diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/GameCmp.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/GameCmp.lean new file mode 100644 index 0000000000..19df73a7e6 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/GameCmp.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.IGame + +meta import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.Register + +/-! +# Tactic for game inequalities + +This file defines the `game_cmp` tactic, capable of proving inequalities between games. See its +docstring for more info. + +Tests for the tactic are found in the `CombinatorialGames.Test` file. +-/ + +/-- Proves simple inequalities on concrete games. + +This tactic works by repeatedly unfolding the definition of `≤` and applying `simp` lemmas tagged +with `game_cmp` until the goal is solved. It is effective on any game whose moves can be +"enumerated" by `simp`, in the sense that a quantifier over its moves can be written in a +quantifier-less way. For instance, `∀ y ∈ leftMoves !{{0, 1} | {2, 3}}, P y` can be simplified into +`P 0 ∧ P 1`. + +## Which lemmas to tag + +Lemmas which are safe to tag with `game_cmp` are the following: + +* Lemmas of the form `(∀ y ∈ leftMoves (f x), P y) ↔ _` and analogous, as long as any quantifiers + in the simplified form are over left or right moves of simpler games. +* Lemmas of the form `leftMoves (f x) = _` and analogous, as long as the simplified set is of the + form `{x₁, x₂, …}`, listing out all elements explicitly. +* Lemmas which directly replace games by other simpler games. + +Tagging any other lemmas might lead to `simp` failing to eliminate all quantifiers, and getting +stuck in a goal that it can't solve. +-/ +macro "game_cmp" : tactic => + `(tactic| { + try simp only [lt_iff_le_not_ge, ge_iff_le, gt_iff_lt, AntisymmRel, Relation.SymmGen, IncompRel] + repeat + rw [IGame.le_iff_forall_lf] + simp only [game_cmp]}) + +/-! ### Extra tagged lemmas -/ + +public section + +variable {α : Type*} {P : α → Prop} + +attribute [game_cmp] Set.forall_mem_empty +@[game_cmp] theorem Set.exists_mem_empty : (∃ x ∈ (∅ : Set α), P x) ↔ False := by simp + +@[game_cmp] theorem Set.forall_singleton {x : α} : (∀ y ∈ ({x} : Set α), P y) ↔ P x := by simp +@[game_cmp] theorem Set.exists_singleton {x : α} : (∃ y ∈ ({x} : Set α), P y) ↔ P x := by simp + +@[game_cmp] theorem forall_lt_zero {P : ℕ → Prop} : (∀ n < 0, P n) ↔ True := by simp +@[game_cmp] theorem exists_lt_zero {P : ℕ → Prop} : (∃ n < 0, P n) ↔ False := by simp +@[game_cmp] theorem forall_lt_one {P : ℕ → Prop} : (∀ n < 1, P n) ↔ P 0 := by simp +@[game_cmp] theorem exists_lt_one {P : ℕ → Prop} : (∃ n < 1, P n) ↔ P 0 := by simp + +attribute [game_cmp] le_rfl + zero_add add_zero zero_mul mul_zero one_mul mul_one neg_zero sub_eq_add_neg + Nat.cast_zero Nat.cast_one Nat.forall_lt_succ_left Nat.exists_lt_succ_left + not_not not_true not_false_eq_true not_forall true_and and_true false_and and_false + false_implies implies_true forall_const and_imp forall_exists_index + Player.neg_left Player.neg_right Player.left_mul Player.right_mul Player.forall Player.exists + Set.forall_mem_image Set.exists_mem_image Set.forall_mem_insert Set.exists_mem_insert Set.mem_Iio + +end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/OrdinalAlias.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/OrdinalAlias.lean new file mode 100644 index 0000000000..eb9e65f7b6 --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/OrdinalAlias.lean @@ -0,0 +1,206 @@ +/- +Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import Mathlib.SetTheory.Ordinal.Family + +/-! +# Declare type aliases of `Ordinal` + +This repository contains two type aliases of `Ordinal`, each preserving the order structure but with +distinct arithmetic defined on it, namely `NatOrdinal` and `Nimber`. We define a `ordinal_alias!` +macro which contains all the boilerplate required to set up these types. This also ensures that the +API between both stays consistent. +-/ + +open Lean + +/-! ### Auxiliary defs -/ + +/-- Doc-comment allowing antiquotation. -/ +meta def mkDocComment (s : String) : TSyntax `Lean.Parser.Command.docComment := + .mk <| mkNode ``Parser.Command.docComment #[mkAtom "/--", mkAtom (s ++ "-/")] + +/-- `Alias.of` -/ +meta def mkOf (Alias : TSyntax `ident) : TSyntax `ident := + .mk <| mkIdent (Alias.getId ++ `of) + +/-- `Alias.val` -/ +meta def mkVal (Alias : TSyntax `ident) : TSyntax `ident := + .mk <| mkIdent (Alias.getId ++ `val) + +/-! ### Macros -/ + +/-- Declare a type alias of either `Ordinal` or `Nat`, preserving the order structure. -/ +macro "alias!" doc:docComment Alias:ident Source:ident : command => `( +@[expose] public section + +$doc:docComment +def $Alias : Type _ := + $Source deriving Zero, One, Nontrivial, Inhabited, WellFoundedRelation + +namespace $Alias +universe u + +instance : PartialOrder $Alias := inferInstanceAs (PartialOrder $Source) +instance : SuccOrder $Alias := inferInstanceAs (SuccOrder $Source) +instance : OrderBot $Alias := inferInstanceAs (OrderBot $Source) +instance : NoMaxOrder $Alias := inferInstanceAs (NoMaxOrder $Source) +instance : IsBotZeroClass $Alias := inferInstanceAs (IsBotZeroClass $Source) +instance : NeZero (1 : $Alias) := inferInstanceAs (NeZero (1 : $Source)) +instance : WellFoundedLT $Alias := inferInstanceAs (WellFoundedLT $Source) +noncomputable instance : ConditionallyCompleteLinearOrderBot $Alias := + inferInstanceAs (ConditionallyCompleteLinearOrderBot $Source) + +theorem $(mkIdent `lt_wf) : @WellFounded $Alias (· < ·) := wellFounded_lt + +$(mkDocComment s!" The identity function between `{Source.getId}` and `{Alias.getId}`."):docComment +@[match_pattern] +def $(mkIdent `of) : $Source ≃o $Alias := .refl _ + +$(mkDocComment s!" The identity function between `{Alias.getId}` and `{Source.getId}`."):docComment +@[match_pattern] +def $(mkIdent `val) : $Alias ≃o $Source := .refl _ + +@[simp] theorem $(mkIdent `of_symm) : .symm $(mkOf Alias) = $(mkVal Alias) := rfl +@[simp] theorem $(mkIdent `val_symm) : .symm $(mkVal Alias) = $(mkOf Alias) := rfl + +@[simp] theorem $(mkIdent `of_val) (a) : $(mkOf Alias) ($(mkVal Alias) a) = a := rfl +@[simp] theorem $(mkIdent `val_of) (a) : $(mkVal Alias) ($(mkOf Alias) a) = a := rfl + +theorem $(mkIdent `val_le_iff) {a b} : $(mkVal Alias) a ≤ b ↔ a ≤ $(mkOf Alias) b := .rfl +theorem $(mkIdent `val_lt_iff) {a b} : $(mkVal Alias) a < b ↔ a < $(mkOf Alias) b := .rfl +theorem $(mkIdent `val_eq_iff) {a b} : $(mkVal Alias) a = b ↔ a = $(mkOf Alias) b := .rfl + +theorem $(mkIdent `of_le_iff) {a b} : $(mkOf Alias) a ≤ b ↔ a ≤ $(mkVal Alias) b := .rfl +theorem $(mkIdent `of_lt_iff) {a b} : $(mkOf Alias) a < b ↔ a < $(mkVal Alias) b := .rfl +theorem $(mkIdent `of_eq_iff) {a b} : $(mkOf Alias) a = b ↔ a = $(mkVal Alias) b := .rfl + +@[simp] theorem $(mkIdent `bot_eq_zero) : (⊥ : $Alias) = 0 := rfl +@[simp] theorem $(mkIdent `bot_eq_zero_withTop) : (⊥ : WithTop $Alias) = 0 := rfl + +@[simp] theorem $(mkIdent `of_zero) : $(mkOf Alias) 0 = 0 := rfl +@[simp] theorem $(mkIdent `val_zero) : $(mkVal Alias) 0 = 0 := rfl + +@[simp] theorem $(mkIdent `of_one) : $(mkOf Alias) 1 = 1 := rfl +@[simp] theorem $(mkIdent `val_one) : $(mkVal Alias) 1 = 1 := rfl + +@[simp] theorem $(mkIdent `of_eq_zero) {a} : $(mkOf Alias) a = 0 ↔ a = 0 := .rfl +@[simp] theorem $(mkIdent `val_eq_zero) {a} : $(mkVal Alias) a = 0 ↔ a = 0 := .rfl +theorem $(mkIdent `of_ne_zero) {a} : $(mkOf Alias) a ≠ 0 ↔ a ≠ 0 := .rfl +theorem $(mkIdent `val_ne_zero) {a} : $(mkVal Alias) a ≠ 0 ↔ a ≠ 0 := .rfl + +@[simp] theorem $(mkIdent `of_eq_one) {a} : $(mkOf Alias) a = 1 ↔ a = 1 := .rfl +@[simp] theorem $(mkIdent `val_eq_one) {a} : $(mkVal Alias) a = 1 ↔ a = 1 := .rfl +theorem $(mkIdent `of_ne_one) {a} : $(mkOf Alias) a ≠ 1 ↔ a ≠ 1 := .rfl +theorem $(mkIdent `val_ne_one) {a} : $(mkVal Alias) a ≠ 1 ↔ a ≠ 1 := .rfl +@[simp] theorem $(mkIdent `of_le_one) {a} : $(mkOf Alias) a ≤ 1 ↔ a ≤ 1 := .rfl +@[simp] theorem $(mkIdent `val_le_one) {a} : $(mkVal Alias) a ≤ 1 ↔ a ≤ 1 := .rfl +theorem $(mkIdent `one_le_of) {a} : 1 ≤ $(mkOf Alias) a ↔ 1 ≤ a := .rfl +@[simp] theorem $(mkIdent `one_le_val) {a} : 1 ≤ $(mkVal Alias) a ↔ 1 ≤ a := .rfl +theorem $(mkIdent `of_lt_one) {a} : $(mkOf Alias) a < 1 ↔ a < 1 := .rfl +theorem $(mkIdent `val_lt_one) {a} : $(mkVal Alias) a < 1 ↔ a < 1 := .rfl +@[simp] theorem $(mkIdent `one_lt_of) {a} : 1 < $(mkOf Alias) a ↔ 1 < a := .rfl +@[simp] theorem $(mkIdent `one_lt_val) {a} : 1 < $(mkVal Alias) a ↔ 1 < a := .rfl + +theorem $(mkIdent `succ_def) (a : $Alias) : Order.succ a = $(mkOf Alias) ($(mkVal Alias) a + 1) := + rfl + +@[simp] +theorem $(mkIdent `succ_of) (a : $Source) : Order.succ ($(mkOf Alias) a) = $(mkOf Alias) (a + 1) := + rfl + +theorem $(mkIdent `succ_ne_zero) (a : $Alias) : Order.succ a ≠ 0 := Order.succ_ne_bot a + +$(mkDocComment s!" A recursor for `{Alias.getId}`. Use as `cases x`. "):docComment +@[elab_as_elim, cases_eliminator, induction_eliminator] +protected def $(mkIdent `ind) {motive : $Alias → Sort*} + ($(mkIdent `of) : ∀ a, motive ($(mkOf Alias) a)) (a) : motive a := + $(mkIdent `of) ($(mkVal Alias) a) + +$(mkDocComment s!" Well-founded induction for `{Alias.getId}`. "):docComment +theorem $(mkIdent `induction) {p : $Alias → Prop} : ∀ i (_ : ∀ j, (∀ k, k < j → p k) → p j), p i := + WellFoundedLT.induction + +end $Alias +end +) + +/-- Declare a type alias of `Ordinal`, preserving the order structure. -/ +macro "ordinal_alias!" doc:docComment Alias:ident : command => `( + +alias! $doc $Alias Ordinal + +@[expose] public section +namespace $Alias +universe u + +instance : Uncountable $Alias := Ordinal.uncountable + +theorem $(mkIdent `lt_one_iff) {a : $Alias} : a < 1 ↔ a = 0 := + Order.lt_one_iff (α := Ordinal) +theorem $(mkIdent `le_one_iff) {a : $Alias} : a ≤ 1 ↔ a = 0 ∨ a = 1 := + Order.le_one_iff (α := Ordinal) + +@[simp] +theorem $(mkIdent `one_le_iff_ne_zero) {a : $Alias} : 1 ≤ a ↔ a ≠ 0 := + Order.one_le_iff_ne_zero (α := Ordinal) + +theorem $(mkIdent `succ_zero) : Order.succ (0 : $Alias) = 1 := zero_add (1 : Ordinal) + +theorem $(mkIdent `Iio_zero) : Set.Iio (0 : $Alias) = ∅ := Set.Iio_bot (α := Ordinal) +theorem $(mkIdent `Iio_one) : Set.Iio (1 : $Alias) = {0} := Order.Iio_one (α := Ordinal) + +theorem $(mkIdent `eq_natCast_of_le_natCast) {a : $Alias} {b : ℕ} (h : a ≤ $(mkOf Alias) b) : + ∃ c : ℕ, a = $(mkOf Alias) c := + Ordinal.eq_natCast_of_le_natCast h + +instance (a : $Alias.{u}) : Small.{u} (Set.Iio a) := Ordinal.small_Iio a +instance (a : $Alias.{u}) : Small.{u} (Set.Iic a) := Ordinal.small_Iic a +instance (a b : $Alias.{u}) : Small.{u} (Set.Ico a b) := Ordinal.small_Ico a b +instance (a b : $Alias.{u}) : Small.{u} (Set.Icc a b) := Ordinal.small_Icc a b +instance (a b : $Alias.{u}) : Small.{u} (Set.Ioo a b) := Ordinal.small_Ioo a b +instance (a b : $Alias.{u}) : Small.{u} (Set.Ioc a b) := Ordinal.small_Ioc a b + +instance : IsEmpty (Set.Iio (0 : $Alias)) := Set.isEmpty_Iio_zero (α := Ordinal) +instance : Unique (Set.Iio (1 : $Alias)) := Ordinal.uniqueIioOne + +@[simp] +theorem $(mkIdent `Iio_one_default_eq) : + (default : Set.Iio (1 : $Alias)) = ⟨0, zero_lt_one' $Alias⟩ := + rfl + +theorem $(mkIdent `bddAbove_iff_small) {s : Set $Alias.{u}} : BddAbove s ↔ Small.{u} s := + Ordinal.bddAbove_iff_small + +theorem $(mkIdent `bddAbove_of_small) (s : Set $Alias.{u}) [hs : Small.{u} s] : BddAbove s := + @Ordinal.bddAbove_of_small s hs + +theorem $(mkIdent `not_bddAbove_compl_of_small) (s : Set $Alias.{u}) [hs : Small.{u} s] : + ¬BddAbove sᶜ := + @Ordinal.not_bddAbove_compl_of_small s hs + +theorem $(mkIdent `le_iSup) {ι : Type*} (f : ι → $Alias.{u}) [Small.{u} ι] (i : ι) : f i ≤ iSup f := + Ordinal.le_iSup f i + +theorem $(mkIdent `iSup_le_iff) {ι : Type*} {f : ι → $Alias.{u}} {a : $Alias.{u}} [Small.{u} ι] : + ⨆ i, f i ≤ a ↔ ∀ i, f i ≤ a := + Ordinal.iSup_le_iff + +theorem $(mkIdent `lt_iSup_iff) {ι : Type*} [Small.{u} ι] (f : ι → $Alias.{u}) {x} : + x < ⨆ i, f i ↔ ∃ i, x < f i := + Ordinal.lt_iSup_iff + +theorem $(mkIdent `iSup_eq_zero_iff) {ι : Type*} [Small.{u} ι] {f : ι → $Alias.{u}} : + ⨆ i, f i = 0 ↔ ∀ i, f i = 0 := + Ordinal.iSup_eq_zero_iff + +end $Alias +end + +-- TODO: how do we name this correctly? +-- theorem not_small_nimber : ¬ Small.{u} $Alias.{max u v} := not_small_ordinal +) diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/Register.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/Register.lean new file mode 100644 index 0000000000..dbc4be836f --- /dev/null +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/Register.lean @@ -0,0 +1,18 @@ +/- +Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import Mathlib.Init +public meta import Lean.LabelAttribute -- TODO: `registerLabelAttr` should be marked `meta` +import Lean.Meta.Tactic.Simp.Attr + +/-! +We register a `simp` attribute for the `game_cmp` tactic. This needs to be done in a separate file +to where the tactic is defined. +-/ + +/-- Simp attribute for lemmas used in `game_cmp`. -/ +register_simp_attr game_cmp diff --git a/LeanPool/ConwayRefinement/ConwayRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement.lean new file mode 100644 index 0000000000..1af0423494 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement.lean @@ -0,0 +1,17 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +/-! +# ConwayRefinement + +Intentionally empty. The lakefile's `globs = ["ConwayRefinement.*"]` is authoritative for what is +built and audited: `lake build` builds every module under `ConwayRefinement/` directly, and the +audits enumerate the source tree, so nothing depends on this root re-exporting the library. No +module imports it, and a change to the library never needs to touch this file. + +Start at `ConwayRefinement/Standalone/`, or read the README. +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra.lean new file mode 100644 index 0000000000..b700cffa90 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra.lean @@ -0,0 +1,19 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GeometricIntegrality +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum.lean new file mode 100644 index 0000000000..aea2f28149 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum.lean @@ -0,0 +1,18 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermChainRule +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermFinitePartIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermPolynomial +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSuccessorStep +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSyzygy +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.InternalGrading +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.LeadingGrade +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.TrailingGrade + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermChainRule.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermChainRule.lean new file mode 100644 index 0000000000..c6c6b7a0a3 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermChainRule.lean @@ -0,0 +1,153 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.OrdinalGenerators +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermPolynomial +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalDerivation + +/-! +# The chain rule for ordinal-graded filter-germ lowering derivations + +This file isolates the successor-degree chain rule from the real-line filter used by the +principal-subring development. +-/ + +universe u v w z q + +open Filter GermPolynomial MvPolynomial + +public noncomputable section + +namespace OrdinalGraded + +variable {K : Type u} {R : Type v} {T : Type q} +variable [Field K] [CommRing R] [Algebra K R] +variable {l : Filter T} +variable (A : NatOrdinal.{z} → Submodule K R) [GradedAlgebra A] +variable {ι : Type w} {wt : ι → NatOrdinal.{z}} {x : ι → R} + +/-- Polynomial representatives of the derivatives of homogeneous coordinates. -/ +structure DerivativeRep (wt : ι → NatOrdinal.{z}) (x : ι → R) + (Δ : Derivation K R (Germ l R)) (g : ι → T → MvPolynomial ι K) : Prop where + /-- In successor degree, the representative has the preceding degree. -/ + homogeneous : ∀ i t, 0 < (wt i).constantCoeff → + IsWeightedHomogeneous wt (g i t) ((wt i).removeNat 1) + /-- When the degree is zero or a limit ordinal, the representative is zero. -/ + eq_zero : ∀ i t, (wt i).constantCoeff = 0 → g i t = 0 + /-- Evaluation of the representatives gives the derivative germ. -/ + map_coordinate : ∀ i, Δ (x i) = ((fun t ↦ aeval x (g i t)) : Germ l R) + +namespace IsMinimalSystem + +variable {A} (hx : OrdinalGraded.IsMinimalSystem A wt x) +variable {Δ : Derivation K R (Germ l R)} (hΔ : GermPolynomial.IsLoweringDerivation A Δ) +include hx hΔ + +omit [GradedAlgebra A] in +/-- Derivative representatives exist for every ordinal minimal system. -/ +theorem exists_derivativeRep (h0 : GradeZeroScalars A) : + ∃ g : ι → T → MvPolynomial ι K, DerivativeRep wt x Δ g := by + classical + have hrep : ∀ i, ∃ g : T → MvPolynomial ι K, + (0 < (wt i).constantCoeff → + ∀ t, IsWeightedHomogeneous wt (g t) ((wt i).removeNat 1)) ∧ + ((wt i).constantCoeff = 0 → ∀ t, g t = 0) ∧ + Δ (x i) = ((fun t ↦ aeval x (g t)) : Germ l R) := by + intro i + by_cases hi : 0 < (wt i).constantCoeff + · obtain ⟨f, hf, hfΔ⟩ := exists_rep_of_mem_germSubmodule _ + (GermPolynomial.IsLoweringDerivation.mem_lower hΔ hi (hx.mem i)) + have hpoly : ∀ t, ∃ p : MvPolynomial ι K, + IsWeightedHomogeneous wt p ((wt i).removeNat 1) ∧ aeval x p = f t := fun t ↦ + OrdinalGraded.IsMinimalSystem.exists_aeval_eq hx h0 _ (f t) (hf t) + choose g hg hgf using hpoly + refine ⟨g, fun _ t ↦ hg t, fun hzero ↦ absurd hzero hi.ne', ?_⟩ + rw [hfΔ] + congr 1 + funext t + exact (hgf t).symm + · refine ⟨fun _ ↦ 0, fun hpos ↦ absurd hpos hi, fun _ _ ↦ rfl, ?_⟩ + rw [GermPolynomial.IsLoweringDerivation.eq_zero hΔ + (Nat.eq_zero_of_not_pos hi) (hx.mem i)] + simp only [map_zero] + rfl + choose g hg hg0 hgΔ using hrep + exact ⟨g, fun i t hi ↦ hg i hi t, fun i t hi ↦ hg0 i hi t, hgΔ⟩ + +end IsMinimalSystem + +namespace DerivativeRep + +variable {A : NatOrdinal.{z} → Submodule K R} +variable [GradedAlgebra A] +variable {Δ : Derivation K R (Germ l R)} +variable {g : ι → T → MvPolynomial ι K} +variable (hg : DerivativeRep (l := l) wt x Δ g) +variable (hΔ : GermPolynomial.IsLoweringDerivation A Δ) +include hg hΔ + +/-- The chain rule for evaluation along homogeneous coordinates. -/ +theorem map_aeval (F : MvPolynomial ι K) : + Δ (aeval x F) = + ((fun t ↦ aeval x (mkDerivation K (fun i ↦ g i t) F)) : Germ l R) := + GermPolynomial.IsHomogeneousCoordinates.map_aeval hΔ g hg.map_coordinate F + +omit hΔ in +/-- Pointwise polynomial derivation lowers every successor degree by one. -/ +theorem mkDerivation_isWeightedHomogeneous (t : T) {F : MvPolynomial ι K} + {δ : NatOrdinal.{z}} (hF : IsWeightedHomogeneous wt F δ) : + IsWeightedHomogeneous wt (mkDerivation K (fun i ↦ g i t) F) (δ.removeNat 1) := + mkDerivation_isWeightedHomogeneous_removeNat wt _ (fun i hi ↦ hg.homogeneous i t hi) + (fun i hi ↦ hg.eq_zero i t hi) hF + +omit hΔ in +/-- A variable occurring in a derivative representative has lower weight than its source. -/ +theorem wt_lt_of_pderiv_ne_zero {i j : ι} {t : T} + (h : pderiv j (g i t) ≠ 0) : + wt j < wt i := by + by_cases hi : 0 < (wt i).constantCoeff + · have hj : j ∈ (g i t).vars := by + by_contra hj + exact h (pderiv_eq_zero_of_notMem_vars hj) + refine ((hg.homogeneous i t hi).wt_le_of_mem_vars wt hj).trans_lt ?_ + have hsucc := NatOrdinal.removeNat_add_natCast (a := wt i) (n := 1) hi + rw [Nat.cast_one] at hsucc + exact lt_of_lt_of_eq (lt_add_one _) hsucc + · exact absurd (by rw [hg.eq_zero i t (Nat.eq_zero_of_not_pos hi), map_zero]) h + +/-- The pointwise derivative of a homogeneous relation of successor degree vanishes eventually. -/ +theorem eventually_mkDerivation_eq_zero {δ : NatOrdinal.{z}} + (hinj : ∀ β < δ, InjectiveAt K wt x β) (hδ : 0 < δ.constantCoeff) + {F : MvPolynomial ι K} (hF : IsWeightedHomogeneous wt F δ) (hF0 : aeval x F = 0) : + ∀ᶠ t in l, mkDerivation K (fun i ↦ g i t) F = 0 := by + have h := hg.map_aeval hΔ F + rw [hF0, map_zero, eq_comm] at h + change ((fun t ↦ aeval x (mkDerivation K (fun i ↦ g i t) F)) : Germ l R) = + ((fun _ : T ↦ (0 : R)) : Germ l R) at h + rw [Germ.coe_eq] at h + have hlt : δ.removeNat 1 < δ := by + have hsucc := NatOrdinal.removeNat_add_natCast (a := δ) (n := 1) hδ + rw [Nat.cast_one] at hsucc + exact lt_of_lt_of_eq (lt_add_one _) hsucc + exact h.mono fun t ht ↦ + (injectiveAt_iff _).mp (hinj _ hlt) _ (hg.mkDerivation_isWeightedHomogeneous t hF) ht + +/-- Differentiating the eventually vanishing pointwise derivative of a relation. -/ +theorem eventually_mkDerivation_pderiv_eq {δ : NatOrdinal.{z}} + (hinj : ∀ β < δ, InjectiveAt K wt x β) (hδ : 0 < δ.constantCoeff) + {F : MvPolynomial ι K} (hF : IsWeightedHomogeneous wt F δ) (hF0 : aeval x F = 0) + (j : ι) : + ∀ᶠ t in l, mkDerivation K (fun i ↦ g i t) (pderiv j F) = + -mkDerivation K (fun i ↦ pderiv j (g i t)) F := by + filter_upwards [hg.eventually_mkDerivation_eq_zero hΔ hinj hδ hF hF0] with t ht + have h := pderiv_mkDerivation (fun i ↦ g i t) j F + rw [ht, map_zero] at h + exact (neg_eq_of_add_eq_zero_right h.symm).symm + +end DerivativeRep + +end OrdinalGraded diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermFinitePartIdeal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermFinitePartIdeal.lean new file mode 100644 index 0000000000..3e5e713c87 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermFinitePartIdeal.lean @@ -0,0 +1,294 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermChainRule +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartVars + +/-! +# The ideal of the partial derivatives carrying the finite part, for germ derivations + +Let `F` be a relation of degree `δ` whose finite part is `n ≥ 1`, under evaluation injective in +every degree below `δ`. The variables of `F` whose own degree has finite part `n` generate an ideal + +`I = (∂F/∂X_B : X_B carries the finite part)`, + +and the claim is that every partial derivative of `F` at a variable of successor degree lies in `I`. + +This file carries the inductive step of that claim from the real line to an arbitrary filter. The +argument is unchanged: the chain rule expresses the derivative of `(∂F/∂X_j)(x)` through the +partial derivatives at variables of strictly larger degree, which lie in `I` by hypothesis, so the +derivative germ takes values in the evaluated ideal; ideal membership from the derivative pulls +`(∂F/∂X_j)(x)` into that ideal; and injectivity below `δ` lifts the resulting relation back to a +polynomial identity. + +The one input not available from the abstract lowering-derivation interface is the passage from a +derivative germ with values in an ideal to membership of the class itself. That is an integration +statement, proved separately in each setting, so it is taken here as the hypothesis +`HasIdealIntegration`. +-/ + +universe u v w z q + +open Filter GermPolynomial MvPolynomial OrdinalGraded + +public noncomputable section + +namespace OrdinalGraded + +variable {K : Type u} {R : Type v} {T : Type q} +variable [Field K] [CommRing R] [Algebra K R] +variable {l : Filter T} +variable (A : NatOrdinal.{z} → Submodule K R) [GradedAlgebra A] +variable {ι : Type w} {wt : ι → NatOrdinal.{z}} {x : ι → R} + +namespace DerivativeRep + +variable {A} +variable {Δ : Derivation K R (Germ l R)} +variable {g : ι → T → MvPolynomial ι K} +variable (hx : OrdinalGraded.IsMinimalSystem A wt x) +variable (hg : DerivativeRep (l := l) wt x Δ g) +variable (hΔ : GermPolynomial.IsLoweringDerivation A Δ) +include hx hg hΔ + +omit [GradedAlgebra A] hx hg hΔ in +/-- Evaluation carries the ideal of the partial derivatives into the ideal generated by their +values. -/ +theorem aeval_mem_span_of_mem_span {δ : NatOrdinal.{z}} {F : MvPolynomial ι K} + {q : ↥(varsOfFinitePart wt F δ) → R} (hqdef : ∀ t, q t = aeval x (pderiv (t : ι) F)) + {G : MvPolynomial ι K} + (hG : G ∈ Ideal.span ((fun t ↦ pderiv t F) '' (varsOfFinitePart wt F δ : Set ι))) : + aeval x G ∈ Ideal.span (Set.range q) := by + have hmap := Ideal.mem_map_of_mem (aeval x : MvPolynomial ι K →ₐ[K] R).toRingHom hG + rw [Ideal.map_span, Set.image_image, Set.image_eq_range] at hmap + simp only [AlgHom.toRingHom_eq_coe, RingHom.coe_coe] at hmap + have hq_eq : q = fun t : ↥(varsOfFinitePart wt F δ) ↦ aeval x (pderiv (t : ι) F) := + funext hqdef + rw [hq_eq] + exact hmap + +omit [GradedAlgebra A] hx hΔ in +/-- The chain-rule representative of the derivative takes values in the evaluated ideal. -/ +theorem mem_span_of_mkDerivation {δ : NatOrdinal.{z}} {F : MvPolynomial ι K} {j : ι} + {q : ↥(varsOfFinitePart wt F δ) → R} (hqdef : ∀ t, q t = aeval x (pderiv (t : ι) F)) + (ih : ∀ i ∈ F.vars, 0 < (wt i).constantCoeff → wt j < wt i → + pderiv i F ∈ Ideal.span ((fun t ↦ pderiv t F) '' (varsOfFinitePart wt F δ : Set ι))) + {t : T} + (ht : mkDerivation K (fun i ↦ g i t) (pderiv j F) = + -mkDerivation K (fun i ↦ pderiv j (g i t)) F) : + aeval x (mkDerivation K (fun i ↦ g i t) (pderiv j F)) ∈ Ideal.span (Set.range q) := by + rw [ht, map_neg, mkDerivation_eq_sum (fun i ↦ pderiv j (g i t)) (S := F.vars) fun _ h ↦ h, + map_sum] + refine (Ideal.neg_mem_iff _).mpr (Ideal.sum_mem _ fun i hi ↦ ?_) + rw [map_mul] + by_cases hz : pderiv j (g i t) = 0 + · rw [hz, map_zero, zero_mul] + exact Ideal.zero_mem _ + · obtain hlt := hg.wt_lt_of_pderiv_ne_zero hz + have his : 0 < (wt i).constantCoeff := by + by_contra hc0 + exact hz (by rw [hg.eq_zero i t (Nat.eq_zero_of_not_pos hc0), map_zero]) + exact Ideal.mul_mem_left _ _ + (aeval_mem_span_of_mem_span hqdef (ih i hi his hlt)) + +omit [GradedAlgebra A] hg hΔ in +/-- A homogeneous value of the decomposition is the evaluation of a homogeneous polynomial, and is +zero when its degree does not precede the target degree in the algebraic order. -/ +theorem exists_polynomial_of_mem (h0 : GradeZeroScalars A) {lamt beta : NatOrdinal.{z}} + {ut : R} (hu : ∀ b, b + lamt = beta → ut ∈ A b) (hu0 : (¬ ∃ b, b + lamt = beta) → ut = 0) : + ∃ U : MvPolynomial ι K, (∀ b, b + lamt = beta → IsWeightedHomogeneous wt U b) ∧ + ((¬ ∃ b, b + lamt = beta) → U = 0) ∧ aeval x U = ut := by + by_cases h : ∃ b, b + lamt = beta + · obtain ⟨b, hb⟩ := h + obtain ⟨U, hU, hUu⟩ := hx.exists_aeval_eq h0 b ut (hu b hb) + refine ⟨U, fun b' hb' ↦ ?_, fun h' ↦ absurd ⟨b, hb⟩ h', hUu⟩ + rwa [add_right_cancel (hb'.trans hb.symm)] + · exact ⟨0, fun b hb ↦ absurd ⟨b, hb⟩ h, fun _ ↦ rfl, by rw [map_zero, hu0 h]⟩ + +open Classical in +/-- **The inductive step.** If `∂F/∂X_i` lies in the ideal generated by the partial derivatives at +the variables carrying the finite part, for every variable `i` of `F` of successor degree with +`wt j < wt i`, then so does `∂F/∂X_j`. -/ +theorem pderiv_mem_span_varsOfFinitePart_of_forall_lt + (h0 : GradeZeroScalars A) + (hint : ∀ {ι' : Type w} [Finite ι'] {q : ι' → R} {c : ι' → NatOrdinal.{z}}, + (∀ j, q j ∈ A (c j)) → (∀ j, (c j).constantCoeff = 0) → + ∀ {b : NatOrdinal.{z}}, 0 < b.constantCoeff → ∀ {y : R}, y ∈ A b → + ∀ {f : T → R}, (∀ t, f t ∈ Ideal.span (Set.range q)) → + Δ y = (f : Germ l R) → y ∈ Ideal.span (Set.range q)) + {δ : NatOrdinal.{z}} (hinj : ∀ β < δ, InjectiveAt K wt x β) (hδ : 0 < δ.constantCoeff) + {F : MvPolynomial ι K} (hF : IsWeightedHomogeneous wt F δ) (hF0 : aeval x F = 0) + {j : ι} (hj : j ∈ F.vars) + (ih : ∀ i ∈ F.vars, 0 < (wt i).constantCoeff → wt j < wt i → + pderiv i F ∈ Ideal.span ((fun t ↦ pderiv t F) '' (varsOfFinitePart wt F δ : Set ι))) : + pderiv j F ∈ Ideal.span ((fun t ↦ pderiv t F) '' (varsOfFinitePart wt F δ : Set ι)) := by + classical + by_cases htop : (wt j).constantCoeff = δ.constantCoeff + · exact Ideal.subset_span ⟨j, mem_varsOfFinitePart_iff.mpr ⟨hj, htop⟩, rfl⟩ + -- the evaluated partial derivatives at the variables carrying the finite part + obtain ⟨lam, hlam⟩ : ∃ lam : ↥(varsOfFinitePart wt F δ) → NatOrdinal.{z}, + ∀ t, lam t + wt t = δ := + ⟨_, fun t ↦ (exists_add_wt_eq_of_mem_vars hF (mem_varsOfFinitePart_iff.mp t.2).1).choose_spec⟩ + obtain ⟨q, hqdef⟩ : ∃ q : ↥(varsOfFinitePart wt F δ) → R, + ∀ t, q t = aeval x (pderiv (t : ι) F) := ⟨_, fun _ ↦ rfl⟩ + have hq : ∀ t, q t ∈ A (lam t) := fun t ↦ by + rw [hqdef] + exact aeval_mem_of_forall_mem hx.mem (isWeightedHomogeneous_pderiv_of_add_wt_eq hF (hlam t)) + have hc : ∀ t, (lam t).constantCoeff = 0 := fun t ↦ + NatOrdinal.constantCoeff_eq_zero_of_add_eq (mem_varsOfFinitePart_iff.mp t.2).2 (hlam t) + -- the degree of `∂F/∂X_j`: a successor below `δ` + obtain ⟨β, hβ⟩ := exists_add_wt_eq_of_mem_vars hF hj + have hΘ : IsWeightedHomogeneous wt (pderiv j F) β := isWeightedHomogeneous_pderiv wt hF j hβ + have hβpos : 0 < β.constantCoeff := by + have h1 := congrArg NatOrdinal.constantCoeff hβ + rw [NatOrdinal.constantCoeff_add] at h1 + obtain h2 := constantCoeff_wt_le_of_mem_vars hF hj + omega + have hβlt : β < δ := by + rw [← hβ] + exact lt_add_of_pos_right β (pos_iff_ne_zero.mpr (hx.ne_zero j)) + have hΘmem : aeval x (pderiv j F) ∈ A β := aeval_mem_of_forall_mem hx.mem hΘ + -- the chain rule holds on a set of the filter; cut the representative down to it + obtain ⟨s, hs, hsdef⟩ : ∃ s : Set T, s ∈ l ∧ ∀ t ∈ s, + mkDerivation K (fun i ↦ g i t) (pderiv j F) = + -mkDerivation K (fun i ↦ pderiv j (g i t)) F := + ⟨_, hg.eventually_mkDerivation_pderiv_eq hΔ hinj hδ hF hF0 j, fun _ h ↦ h⟩ + obtain ⟨f, hfmem, hfeq⟩ : ∃ f : T → R, (∀ t, f t ∈ Ideal.span (Set.range q)) ∧ + ∀ t ∈ s, f t = aeval x (mkDerivation K (fun i ↦ g i t) (pderiv j F)) := by + refine ⟨fun t ↦ if ht : t ∈ s then + aeval x (mkDerivation K (fun i ↦ g i t) (pderiv j F)) else 0, fun t ↦ ?_, + fun t ht ↦ dif_pos ht⟩ + beta_reduce + by_cases ht : t ∈ s + · rw [dif_pos ht] + exact mem_span_of_mkDerivation hg hqdef ih (hsdef t ht) + · rw [dif_neg ht] + exact Ideal.zero_mem _ + have hΔf : Δ (aeval x (pderiv j F)) = (f : Germ l R) := by + rw [hg.map_aeval hΔ] + refine Germ.coe_eq.mpr ?_ + filter_upwards [hs] with t ht + exact (hfeq t ht).symm + -- ideal membership from the derivative, then decompose homogeneously + obtain hmem := hint (ι' := ↥(varsOfFinitePart wt F δ)) (q := q) (c := lam) hq hc + (b := β) hβpos (y := aeval x (pderiv j F)) hΘmem (f := f) hfmem hΔf + obtain ⟨u, hu, hu0, hsum⟩ := exists_eq_sum_mul_of_mem_span (𝒜 := A) hq hΘmem hmem + obtain ⟨U, hU, hU0, hUu⟩ : ∃ U : ↥(varsOfFinitePart wt F δ) → MvPolynomial ι K, + (∀ t β', β' + lam t = β → IsWeightedHomogeneous wt (U t) β') ∧ + (∀ t, (¬ ∃ β', β' + lam t = β) → U t = 0) ∧ ∀ t, aeval x (U t) = u t := by + choose U hU hU0 hUu using fun t ↦ + exists_polynomial_of_mem hx h0 (hu t) (hu0 t) + exact ⟨U, hU, hU0, hUu⟩ + -- the difference is a relation of degree `β < δ`, hence zero + have hsum' : IsWeightedHomogeneous wt + (∑ t : ↥(varsOfFinitePart wt F δ), pderiv (t : ι) F * U t) β := by + refine IsWeightedHomogeneous.sum _ _ _ fun t _ ↦ ?_ + by_cases h : ∃ β', β' + lam t = β + · obtain ⟨β', hβ'⟩ := h + obtain hmul := (isWeightedHomogeneous_pderiv_of_add_wt_eq hF (hlam t)).mul (hU t β' hβ') + rwa [add_comm, hβ'] at hmul + · rw [hU0 t h, mul_zero] + exact isWeightedHomogeneous_zero K wt β + have hG : IsWeightedHomogeneous wt + (pderiv j F - ∑ t : ↥(varsOfFinitePart wt F δ), pderiv (t : ι) F * U t) β := + (mem_weightedHomogeneousSubmodule K wt β _).mp + (sub_mem ((mem_weightedHomogeneousSubmodule K wt β _).mpr hΘ) + ((mem_weightedHomogeneousSubmodule K wt β _).mpr hsum')) + have hG0 : + aeval x (pderiv j F - ∑ t : ↥(varsOfFinitePart wt F δ), pderiv (t : ι) F * U t) = 0 := by + rw [map_sub, map_sum, hsum, sub_eq_zero] + exact Finset.sum_congr rfl fun t _ ↦ by rw [map_mul, hUu, hqdef] + obtain hzero := (injectiveAt_iff _).mp (hinj β hβlt) _ hG hG0 + rw [sub_eq_zero] at hzero + rw [hzero] + exact Ideal.sum_mem _ fun t _ ↦ Ideal.mul_mem_right _ _ (Ideal.subset_span ⟨t, t.2, rfl⟩) + +open Classical in +/-- Under evaluation injective below `δ`, every partial derivative of a relation at a variable of +successor degree lies in the ideal generated by the partial derivatives at the variables carrying +the finite part. + +The induction is downward through the variables of successor degree: a variable with none above it +is handled by the step directly, and otherwise the variables above it are strictly fewer. -/ +theorem pderiv_mem_span_varsOfFinitePart + (h0 : GradeZeroScalars A) + (hint : ∀ {ι' : Type w} [Finite ι'] {q : ι' → R} {c : ι' → NatOrdinal.{z}}, + (∀ j, q j ∈ A (c j)) → (∀ j, (c j).constantCoeff = 0) → + ∀ {b : NatOrdinal.{z}}, 0 < b.constantCoeff → ∀ {y : R}, y ∈ A b → + ∀ {f : T → R}, (∀ t, f t ∈ Ideal.span (Set.range q)) → + Δ y = (f : Germ l R) → y ∈ Ideal.span (Set.range q)) + {δ : NatOrdinal.{z}} (hinj : ∀ β < δ, InjectiveAt K wt x β) (hδ : 0 < δ.constantCoeff) + {F : MvPolynomial ι K} (hF : IsWeightedHomogeneous wt F δ) (hF0 : aeval x F = 0) + {j : ι} (hj : j ∈ F.vars) (hjs : 0 < (wt j).constantCoeff) : + pderiv j F ∈ Ideal.span ((fun t ↦ pderiv t F) '' (varsOfFinitePart wt F δ : Set ι)) := by + classical + set S : Finset ι := F.vars.filter fun i ↦ 0 < (wt i).constantCoeff with hSdef + suffices h : ∀ n : ℕ, ∀ j ∈ S, (S.filter fun i ↦ wt j < wt i).card ≤ n → + pderiv j F ∈ Ideal.span ((fun t ↦ pderiv t F) '' (varsOfFinitePart wt F δ : Set ι)) from + h _ j (Finset.mem_filter.mpr ⟨hj, hjs⟩) le_rfl + intro n + induction n with + | zero => + intro j hj hcard + rw [Nat.le_zero, Finset.card_eq_zero, Finset.filter_eq_empty_iff] at hcard + refine pderiv_mem_span_varsOfFinitePart_of_forall_lt hx hg hΔ h0 hint hinj hδ hF hF0 + (Finset.mem_filter.mp hj).1 fun i hi his hlt ↦ ?_ + exact absurd hlt (hcard (Finset.mem_filter.mpr ⟨hi, his⟩)) + | succ n ihn => + intro j hj hcard + refine pderiv_mem_span_varsOfFinitePart_of_forall_lt hx hg hΔ h0 hint hinj hδ hF hF0 + (Finset.mem_filter.mp hj).1 fun i hi his hlt ↦ ?_ + refine ihn i (Finset.mem_filter.mpr ⟨hi, his⟩) ?_ + have hsub : (S.filter fun t ↦ wt i < wt t) ⊂ S.filter fun t ↦ wt j < wt t := by + rw [Finset.ssubset_def] + refine ⟨fun t ht ↦ ?_, fun hcon ↦ ?_⟩ + · rw [Finset.mem_filter] at ht ⊢ + exact ⟨ht.1, hlt.trans ht.2⟩ + · have hmem := hcon (Finset.mem_filter.mpr ⟨Finset.mem_filter.mpr ⟨hi, his⟩, hlt⟩) + exact lt_irrefl _ (Finset.mem_filter.mp hmem).2 + have hcards := Finset.card_lt_card hsub + omega + +open Classical in +/-- **The relation lies in the ideal of its own partial derivatives.** In characteristic zero, +Euler's identity writes the relation as a combination of the partial derivatives at its variables, +each of which lies in the ideal, and the finite part of the degree is an invertible scalar. -/ +theorem mem_span_varsOfFinitePart [CharZero K] + (h0 : GradeZeroScalars A) + (hint : ∀ {ι' : Type w} [Finite ι'] {q : ι' → R} {c : ι' → NatOrdinal.{z}}, + (∀ j, q j ∈ A (c j)) → (∀ j, (c j).constantCoeff = 0) → + ∀ {b : NatOrdinal.{z}}, 0 < b.constantCoeff → ∀ {y : R}, y ∈ A b → + ∀ {f : T → R}, (∀ t, f t ∈ Ideal.span (Set.range q)) → + Δ y = (f : Germ l R) → y ∈ Ideal.span (Set.range q)) + {δ : NatOrdinal.{z}} (hinj : ∀ β < δ, InjectiveAt K wt x β) (hδ : 0 < δ.constantCoeff) + {F : MvPolynomial ι K} (hF : IsWeightedHomogeneous wt F δ) (hF0 : aeval x F = 0) : + F ∈ Ideal.span ((fun t ↦ pderiv t F) '' (varsOfFinitePart wt F δ : Set ι)) := by + classical + -- naming the ideal keeps the final rewrite of `F` from reaching inside it + set I : Ideal (MvPolynomial ι K) := + Ideal.span ((fun t ↦ pderiv t F) '' (varsOfFinitePart wt F δ : Set ι)) with hIdef + have heuler := hF.sum_constantCoeff_X_mul_pderiv wt (S := F.vars) fun _ h ↦ h + have hk : δ.constantCoeff • F ∈ I := by + rw [← heuler] + refine Ideal.sum_mem _ fun i hi ↦ ?_ + by_cases hpos : 0 < (wt i).constantCoeff + · exact nsmul_mem (Ideal.mul_mem_left _ _ + (pderiv_mem_span_varsOfFinitePart hx hg hΔ h0 hint hinj hδ hF hF0 hi hpos)) _ + · rw [Nat.eq_zero_of_not_pos hpos, zero_smul] + exact zero_mem _ + have hk0 : (δ.constantCoeff : K) ≠ 0 := Nat.cast_ne_zero.mpr hδ.ne' + have hsmul : F = (δ.constantCoeff : K)⁻¹ • (δ.constantCoeff • F) := by + rw [← Nat.cast_smul_eq_nsmul K, smul_smul, inv_mul_cancel₀ hk0, one_smul] + rw [hsmul] + exact I.smul_of_tower_mem _ hk + +end DerivativeRep + +end OrdinalGraded + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermPolynomial.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermPolynomial.lean new file mode 100644 index 0000000000..fc3027adc1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermPolynomial.lean @@ -0,0 +1,550 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Expansion +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Germ.LinearMap +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.InternalGrading +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Mu +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.OrdinalGenerators +public import Mathlib.RingTheory.Derivation.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.WeightedTotalDegree + +/-! +# Finite-degree polynomiality for filter-germ lowering derivations + +Let `A` be an ordinal-graded algebra over a field `K`, and choose positive homogeneous generators +whose images form a basis modulo the decomposable part in each finite degree. Suppose that `A` +has a derivation into filter germs which lowers successor degrees by one, vanishes on degrees that +are limit ordinals, +and is injective on every homogeneous component of successor degree. Then those generators are +algebraically independent. + +The proof represents the derivatives of the generators by homogeneous polynomials. The chain rule +sends a least-degree homogeneous relation to the joint kernel of the resulting pointwise +derivations. Comparing the two highest powers of a variable reduces that kernel calculation to +independence modulo decomposables. This is the finite-degree algebraic-independence argument; the +choice of filter and the universe of the grading play no role. +-/ + +universe u v w z q + +open scoped DirectSum +open Filter MvPolynomial + +public noncomputable section + +namespace GermPolynomial + +export LoweringDerivation (GradeZeroScalars gradeZeroScalars_iff) + +variable {K : Type u} {R : Type v} {T : Type q} +variable [Field K] [CommRing R] [Algebra K R] +variable {l : Filter T} +variable (A : NatOrdinal.{z} → Submodule K R) [GradedAlgebra A] + +/-- Germs whose values eventually lie in a submodule. -/ +def germSubmodule (W : Submodule K R) : Submodule K (Germ l R) := + LinearMap.range (Germ.mapLinear W.subtype) + +/-- Membership in the germ submodule is eventual pointwise membership. -/ +theorem mem_germSubmodule_iff (W : Submodule K R) (f : Germ l R) : + f ∈ germSubmodule (l := l) W ↔ Germ.LiftPred (· ∈ W) f := by + classical + constructor + · rintro ⟨g, rfl⟩ + induction g using Germ.inductionOn with + | h g => + rw [Germ.mapLinear_coe, Germ.liftPred_coe] + exact Filter.Eventually.of_forall fun x ↦ (g x).property + · intro hf + induction f using Germ.inductionOn with + | h f => + rw [Germ.liftPred_coe] at hf + let g : T → W := fun x ↦ if hx : f x ∈ W then ⟨f x, hx⟩ else 0 + refine ⟨(g : Germ l W), ?_⟩ + rw [Germ.mapLinear_coe, Germ.coe_eq] + exact hf.mono fun x hx ↦ by simp [g, hx] + +/-- A germ eventually valued in a submodule has an everywhere-valued representative. -/ +theorem exists_rep_of_mem_germSubmodule (W : Submodule K R) {f : Germ l R} + (hf : f ∈ germSubmodule (l := l) W) : + ∃ g : T → R, (∀ x, g x ∈ W) ∧ f = (g : Germ l R) := by + classical + rw [mem_germSubmodule_iff] at hf + induction f using Germ.inductionOn with + | h f => + rw [Germ.liftPred_coe] at hf + let g : T → R := fun x ↦ if hx : f x ∈ W then f x else 0 + refine ⟨g, fun x ↦ by + by_cases hx : f x ∈ W + · simp [g, hx] + · simp [g, hx], ?_⟩ + rw [Germ.coe_eq] + exact hf.mono fun x hx ↦ by simp [g, hx] + +/-- A derivation valued in germs which lowers every successor degree by one. -/ +structure IsLoweringDerivation (Δ : Derivation K R (Germ l R)) : Prop where + mem_lower : ∀ {α : NatOrdinal.{z}}, 0 < α.constantCoeff → ∀ {x : R}, x ∈ A α → + Δ x ∈ germSubmodule (l := l) (A (α.removeNat 1)) + eq_zero : ∀ {α : NatOrdinal.{z}}, α.constantCoeff = 0 → ∀ {x : R}, x ∈ A α → Δ x = 0 + injective : ∀ {α : NatOrdinal.{z}}, 0 < α.constantCoeff → ∀ {x : R}, + x ∈ A α → Δ x = 0 → x = 0 + +namespace IsLoweringDerivation + +variable {A} {Δ : Derivation K R (Germ l R)} (hΔ : IsLoweringDerivation (l := l) A Δ) + +theorem natCast_removeNat_one (j : ℕ) (hj : 1 ≤ j) : + (j : NatOrdinal.{z}).removeNat 1 = ((j - 1 : ℕ) : NatOrdinal.{z}) := by + have hcoeff : 1 ≤ (j : NatOrdinal.{z}).constantCoeff := by + rwa [NatOrdinal.constantCoeff_natCast] + symm + apply (NatOrdinal.eq_removeNat_iff_add_natCast_eq hcoeff).mpr + rw [← Nat.cast_add, Nat.sub_add_cancel hj] + +theorem natCast_constantCoeff_pos (j : ℕ) (hj : 1 ≤ j) : + 0 < (j : NatOrdinal.{z}).constantCoeff := by + rw [NatOrdinal.constantCoeff_natCast] + exact hj + +include hΔ + +omit [GradedAlgebra A] in +theorem mem_lower_natCast {j : ℕ} (hj : 1 ≤ j) {x : R} + (hx : x ∈ A (j : NatOrdinal.{z})) : + Δ x ∈ germSubmodule (l := l) (A ((j - 1 : ℕ) : NatOrdinal.{z})) := by + rw [← natCast_removeNat_one j hj] + exact IsLoweringDerivation.mem_lower hΔ (natCast_constantCoeff_pos j hj) hx + +end IsLoweringDerivation + +/-- The Leibniz rule with the factors embedded as constant germs. -/ +theorem derivation_leibniz (Δ : Derivation K R (Germ l R)) (x y : R) : + Δ (x * y) = Δ x * (y : Germ l R) + (x : Germ l R) * Δ y := by + rw [Δ.leibniz] + change (x : Germ l R) * Δ y + (y : Germ l R) * Δ x = _ + ac_rfl + + +/-! ### Decomposables -/ + +/-- The decomposables `(A_{<ω})₊² ∩ A_n = ∑_{i+k=n, i,k ≥ 1} A_i A_k` in finite degree `n`. -/ +def decomposable (n : ℕ) : Submodule K R := + ⨆ (i : ℕ) (j : ℕ) (_ : 1 ≤ i) (_ : 1 ≤ j) (_ : i + j = n), + A (i : NatOrdinal.{z}) * A (j : NatOrdinal.{z}) + +omit [GradedAlgebra A] in +theorem decomposable_le {n : ℕ} {N : Submodule K R} + (h : ∀ i j : ℕ, 1 ≤ i → 1 ≤ j → i + j = n → + A (i : NatOrdinal.{z}) * A (j : NatOrdinal.{z}) ≤ N) : + decomposable A n ≤ N := + iSup_le fun i ↦ iSup_le fun j ↦ iSup_le fun hi ↦ iSup_le fun hj ↦ iSup_le fun hij ↦ + h i j hi hj hij + +omit [GradedAlgebra A] in +theorem mul_mem_decomposable {i j : ℕ} (hi : 1 ≤ i) (hj : 1 ≤ j) {a b : R} + (ha : a ∈ A (i : NatOrdinal.{z})) (hb : b ∈ A (j : NatOrdinal.{z})) : + a * b ∈ decomposable A (i + j) := + Submodule.mem_iSup_of_mem i (Submodule.mem_iSup_of_mem j (Submodule.mem_iSup_of_mem hi + (Submodule.mem_iSup_of_mem hj (Submodule.mem_iSup_of_mem rfl (Submodule.mul_mem_mul ha hb))))) + +omit [GradedAlgebra A] in +/-- At a finite ordinal degree, ordinal decomposables are the ordinary finite-degree +decomposables. -/ +theorem decomposableAt_natCast (n : ℕ) : + OrdinalGraded.decomposableAt A (n : NatOrdinal.{z}) = decomposable A n := by + apply le_antisymm + · refine OrdinalGraded.decomposableAt_le A fun i j hi hj hij ↦ ?_ + have hi_lt : i < NatOrdinal.of Ordinal.omega0 := + (le_add_of_nonneg_right (zero_le : 0 ≤ j)).trans_lt + (hij.le.trans_lt (NatOrdinal.natCast_lt_omega0 n)) + have hj_lt : j < NatOrdinal.of Ordinal.omega0 := + (le_add_of_nonneg_left (zero_le : 0 ≤ i)).trans_lt + (hij.le.trans_lt (NatOrdinal.natCast_lt_omega0 n)) + obtain ⟨i, rfl⟩ := NatOrdinal.lt_omega0.mp hi_lt + obtain ⟨j, rfl⟩ := NatOrdinal.lt_omega0.mp hj_lt + rw [← Nat.cast_add] at hij + have hij' : i + j = n := Nat.cast_injective hij + have hi' : 1 ≤ i := Nat.one_le_iff_ne_zero.mpr (Nat.cast_ne_zero.mp hi) + have hj' : 1 ≤ j := Nat.one_le_iff_ne_zero.mpr (Nat.cast_ne_zero.mp hj) + exact fun _ h ↦ Submodule.mem_iSup_of_mem i (Submodule.mem_iSup_of_mem j + (Submodule.mem_iSup_of_mem hi' (Submodule.mem_iSup_of_mem hj' + (Submodule.mem_iSup_of_mem hij' h)))) + · refine decomposable_le A fun i j hi hj hij ↦ ?_ + have hi' : (i : NatOrdinal.{z}) ≠ 0 := Nat.cast_ne_zero.mpr (Nat.ne_of_gt hi) + have hj' : (j : NatOrdinal.{z}) ≠ 0 := Nat.cast_ne_zero.mpr (Nat.ne_of_gt hj) + refine Submodule.mul_le.mpr fun a ha b hb ↦ ?_ + simpa [← hij] using OrdinalGraded.mul_mem_decomposableAt A hi' hj' ha hb + +/-! ### Homogeneous generators of `A_{<ω}` -/ + +variable {ι : Type w} (wt : ι → ℕ) (x : ι → R) + +/-- A family of homogeneous generators of `A_{<ω}`: `x i ∈ A_{wt i}` with `wt i ≥ 1`, the `x i` of +degree `n` linearly independent modulo the decomposables `(A_{<ω})₊² ∩ A_n`, and every element of +`A_n` a polynomial in the `x i` homogeneous of degree `n` for the grading `deg X_i = wt i` +(Mathlib's `IsWeightedHomogeneous wt`). The paper's minimal systems `𝓑` are exactly such families, +and these two properties are all its proofs use. -/ +structure IsHomogeneousCoordinates : Prop where + one_le : ∀ i, 1 ≤ wt i + mem : ∀ i, x i ∈ A (wt i : NatOrdinal.{z}) + independent : ∀ (n : ℕ) (c : ι →₀ K), (∀ i ∈ c.support, wt i = n) → + Finsupp.linearCombination K x c ∈ decomposable A n → c = 0 + surj : ∀ (n : ℕ), ∀ y ∈ A (n : NatOrdinal.{z}), + ∃ F : MvPolynomial ι K, IsWeightedHomogeneous wt F n ∧ aeval x F = y + +variable {A wt x} + +/-- Evaluation of a polynomial homogeneous of degree `n` (for `deg X_i = wt i`) at homogeneous +elements `x i ∈ A_{wt i}` lands in `A_n`. -/ +theorem aeval_mem_of_forall_mem (hmem : ∀ i, x i ∈ A (wt i : NatOrdinal.{z})) + {F : MvPolynomial ι K} {n : ℕ} (hF : IsWeightedHomogeneous wt F n) : + aeval x F ∈ A (n : NatOrdinal.{z}) := + OrdinalGraded.aeval_mem_of_forall_mem hmem + ((isWeightedHomogeneous_natCast_comp_iff wt).mpr hF) + +/-- Evaluation at homogeneous `x i ∈ A_{wt i}` is graded: the degree-`n` component of `F(x)` is +the evaluation of the degree-`n` component of `F`. -/ +theorem decompose_aeval (hmem : ∀ i, x i ∈ A (wt i : NatOrdinal.{z})) (F : MvPolynomial ι K) + (n : ℕ) : + (DirectSum.decompose A (aeval x F) (n : NatOrdinal.{z}) : R) = + aeval x (weightedHomogeneousComponent wt n F) := by + rw [OrdinalGraded.decompose_aeval hmem F (n : NatOrdinal.{z}), + weightedHomogeneousComponent_natCast_comp] + +/-- Homogeneous generators from a generation hypothesis by arbitrary polynomials: the homogeneous +component of the right degree still evaluates to a given homogeneous element. -/ +theorem IsHomogeneousCoordinates.of_surjective (one_le : ∀ i, 1 ≤ wt i) + (hmem : ∀ i, x i ∈ A (wt i : NatOrdinal.{z})) + (independent : ∀ (n : ℕ) (c : ι →₀ K), (∀ i ∈ c.support, wt i = n) → + Finsupp.linearCombination K x c ∈ decomposable A n → c = 0) + (surj : ∀ (n : ℕ), ∀ y ∈ A (n : NatOrdinal.{z}), ∃ F : MvPolynomial ι K, aeval x F = y) : + IsHomogeneousCoordinates A wt x where + one_le := one_le + mem := hmem + independent := independent + surj n y hy := by + obtain ⟨F, hF⟩ := surj n y hy + refine ⟨weightedHomogeneousComponent wt n F, + weightedHomogeneousComponent_isWeightedHomogeneous (w := wt) (n := n) (φ := F), ?_⟩ + rw [← decompose_aeval hmem, hF, DirectSum.decompose_of_mem_same A hy] + +variable (A wt x) in +/-- The paper's minimal system of homogeneous generators of `A_{<ω}`: a family `x i ∈ A_{wt i}` of +homogeneous elements of positive degree `wt i ≥ 1` whose image in `(A_{<ω})₊/(A_{<ω})₊²` is an +`K`-basis; equivalently, for each `n ≥ 1` the `x i` of degree `n` form a basis of a complement of +`(A_{<ω})₊² ∩ A_n = ∑_{i+k=n, i,k ≥ 1} A_i A_k` in `A_n` — they are linearly independent modulo +`(A_{<ω})₊² ∩ A_n` and span `A_n` modulo it. -/ +structure IsMinimalSystem : Prop where + /-- Every generator has positive degree. -/ + one_le : ∀ i, 1 ≤ wt i + /-- `x i` is homogeneous of degree `wt i`. -/ + mem : ∀ i, x i ∈ A (wt i : NatOrdinal.{z}) + /-- The generators of degree `n` are linearly independent modulo `(A_{<ω})₊² ∩ A_n`. -/ + independent : ∀ (n : ℕ) (c : ι →₀ K), (∀ i ∈ c.support, wt i = n) → + Finsupp.linearCombination K x c ∈ decomposable A n → c = 0 + /-- The generators of degree `n` span `A_n` modulo `(A_{<ω})₊² ∩ A_n`, for `n ≥ 1`. -/ + spans : ∀ n : ℕ, 1 ≤ n → ∀ y ∈ A (n : NatOrdinal.{z}), ∃ c : ι →₀ K, + (∀ i ∈ c.support, wt i = n) ∧ y - Finsupp.linearCombination K x c ∈ decomposable A n + +/-- A minimal system generates `A_{<ω}`: evaluation is onto each `A_n`, by induction on `n`, using +`A_0 = K` in degree zero. -/ +theorem IsMinimalSystem.isHomogeneousCoordinates (h0 : GradeZeroScalars A) + (hx : IsMinimalSystem A wt x) : + IsHomogeneousCoordinates A wt x := by + refine IsHomogeneousCoordinates.of_surjective hx.one_le hx.mem hx.independent ?_ + intro n + induction n using Nat.strong_induction_on with + | _ n ih => + intro y hy + rcases Nat.eq_zero_or_pos n with rfl | hn + · obtain ⟨e, rfl⟩ := (gradeZeroScalars_iff A).mp h0 y (by rwa [Nat.cast_zero] at hy) + exact ⟨C e, aeval_C x e⟩ + · obtain ⟨c, -, hc⟩ := hx.spans n hn y hy + have hD : decomposable A n ≤ + Subalgebra.toSubmodule (aeval x : MvPolynomial ι K →ₐ[K] R).range := by + refine decomposable_le A fun i j hi hj hij ↦ Submodule.mul_le.mpr fun a ha b hb ↦ ?_ + obtain ⟨F, hF⟩ := ih i (by omega) a ha + obtain ⟨G, hG⟩ := ih j (by omega) b hb + exact (Subalgebra.mem_toSubmodule _).mpr ((AlgHom.mem_range _).mpr + ⟨F * G, by rw [map_mul, hF, hG]⟩) + obtain ⟨G, hG⟩ := (AlgHom.mem_range _).mp ((Subalgebra.mem_toSubmodule _).mp (hD hc)) + have hlc : aeval x (Finsupp.linearCombination K (X : ι → MvPolynomial ι K) c) = + Finsupp.linearCombination K x c := by + rw [← AlgHom.toLinearMap_apply, Finsupp.apply_linearCombination] + congr 2 + funext i + exact aeval_X x i + exact ⟨G + Finsupp.linearCombination K (X : ι → MvPolynomial ι K) c, + by rw [map_add, hG, hlc, sub_add_cancel]⟩ + +/-- A polynomial homogeneous of degree `n ≥ 1` evaluates at homogeneous generators of positive +degrees to its linear part in the degree-`n` variables plus an element of `(A_{<ω})₊² ∩ A_n`; the +linear coefficients are read off the polynomial. -/ +theorem exists_linear_part (hwt : ∀ i, 1 ≤ wt i) (hmem : ∀ i, x i ∈ A (wt i : NatOrdinal.{z})) + {F : MvPolynomial ι K} {n : ℕ} (hn : 1 ≤ n) (hF : IsWeightedHomogeneous wt F n) : + ∃ c : ι →₀ K, (∀ i ∈ c.support, wt i = n) ∧ + aeval x F - Finsupp.linearCombination K x c ∈ decomposable A n ∧ + ∀ i, c i = coeff (Finsupp.single i 1) F := by + obtain ⟨c, hcwt, hc, hcoeff⟩ := OrdinalGraded.exists_linear_part + (fun i ↦ Nat.cast_ne_zero.mpr (Nat.one_le_iff_ne_zero.mp (hwt i))) hmem + (Nat.cast_ne_zero.mpr (Nat.one_le_iff_ne_zero.mp hn)) + ((isWeightedHomogeneous_natCast_comp_iff wt).mpr hF) + refine ⟨c, fun i hi ↦ Nat.cast_injective (hcwt i hi), ?_, hcoeff⟩ + rwa [decomposableAt_natCast] at hc + +namespace IsHomogeneousCoordinates + +variable (hx : IsHomogeneousCoordinates A wt x) +include hx + +/-- Evaluation of a polynomial homogeneous of degree `n` lands in `A_n`. -/ +theorem aeval_mem {F : MvPolynomial ι K} {n : ℕ} (hF : IsWeightedHomogeneous wt F n) : + aeval x F ∈ A (n : NatOrdinal.{z}) := + aeval_mem_of_forall_mem hx.mem hF + +/-! ### The chain rule for `∂` -/ + +variable {Δ : Derivation K R (Germ l R)} (hΔ : IsLoweringDerivation A Δ) +include hΔ + +omit hx in +theorem map_algebraMap (e : K) : Δ (algebraMap K R e) = 0 := + hΔ.eq_zero (by rw [NatOrdinal.constantCoeff_zero]) (SetLike.algebraMap_mem_graded A e) + +omit hx in +/-- The chain rule: if `∂(x i)` is represented by `γ ↦ (g i γ)(x)`, then `∂(F(x))` is represented +by `γ ↦ (∂_γ F)(x)`, where `∂_γ = ∑ g i γ ∂/∂X_i` (Lean `mkDerivation K (fun i ↦ g i γ)`). -/ +theorem map_aeval (g : ι → T → MvPolynomial ι K) + (hg : ∀ i, Δ (x i) = ((fun γ ↦ aeval x (g i γ)) : Germ l R)) (F : MvPolynomial ι K) : + Δ (aeval x F) = ((fun γ ↦ aeval x (mkDerivation K (fun i ↦ g i γ) F)) : Germ l R) := by + induction F using MvPolynomial.induction_on with + | C e => + rw [aeval_C, map_algebraMap hΔ] + have : ∀ γ, aeval x (mkDerivation K (fun i ↦ g i γ) (C e)) = 0 := fun γ ↦ by + rw [← MvPolynomial.algebraMap_eq, Derivation.map_algebraMap, map_zero] + simp only [this] + rfl + | add p q hp hq => + rw [map_add, map_add, hp, hq] + simp only [map_add] + rfl + | mul_X p i hp => + rw [map_mul, aeval_X, derivation_leibniz, hp, hg i] + have : ∀ γ, aeval x (mkDerivation K (fun i ↦ g i γ) (p * X i)) = + aeval x (mkDerivation K (fun i ↦ g i γ) p) * x i + aeval x p * aeval x (g i γ) := fun γ ↦ by + rw [Derivation.leibniz, smul_eq_mul, smul_eq_mul, mkDerivation_X, map_add, map_mul, map_mul, + aeval_X, add_comm, mul_comm (x i)] + simp only [this] + rfl + +omit [GradedAlgebra A] in +/-- Polynomial representatives of `∂(x i)`, the paper's `G_B(γ)`: polynomials `g i γ` homogeneous +of degree `wt i - 1` with `γ ↦ (g i γ)(x)` representing `∂(x i)`. -/ +theorem exists_lifts : ∃ g : ι → T → MvPolynomial ι K, + (∀ i γ, IsWeightedHomogeneous wt (g i γ) (wt i - 1)) ∧ + ∀ i, Δ (x i) = ((fun γ ↦ aeval x (g i γ)) : Germ l R) := by + have hrep : ∀ i, ∃ f : T → R, (∀ γ, f γ ∈ A ((wt i - 1 : ℕ) : NatOrdinal.{z})) ∧ + Δ (x i) = (f : Germ l R) := fun i ↦ + exists_rep_of_mem_germSubmodule _ (hΔ.mem_lower_natCast (hx.one_le i) (hx.mem i)) + choose f hf hfΔ using hrep + choose g hg hgf using fun i γ ↦ hx.surj (wt i - 1) (f i γ) (hf i γ) + refine ⟨g, hg, fun i ↦ ?_⟩ + rw [hfΔ i] + congr 1 + funext γ + exact (hgf i γ).symm + +end IsHomogeneousCoordinates + +/-! ### The kernel of the pointwise derivations -/ + +variable {Δ : Derivation K R (Germ l R)} + +omit [GradedAlgebra A] in +/-- Polynomials homogeneous of degree zero (for `deg X_i = wt i ≥ 1`) are constants. -/ +theorem eq_C_of_isWeightedHomogeneous_zero (hwt : ∀ i, 1 ≤ wt i) {p : MvPolynomial ι K} + (hp : IsWeightedHomogeneous wt p 0) : p = C (coeff 0 p) := + OrdinalGraded.eq_C_of_isWeightedHomogeneous_zero (wt := fun i ↦ (wt i : NatOrdinal.{0})) + (fun i ↦ Nat.cast_ne_zero.mpr (Nat.one_le_iff_ne_zero.mp (hwt i))) + ((isWeightedHomogeneous_natCast_comp_iff (M := NatOrdinal.{0}) wt).mpr hp) + +/-- The joint-kernel lemma: no non-zero polynomial homogeneous of positive degree satisfies +`∂_γ F = 0` for all `γ < 0` sufficiently close to `0`, for homogeneous generators of positive +degrees independent modulo the decomposables. Induction on the degree: write a putative kernel +element `F = ∑ c_d X₀^d` in a variable `X₀` of maximal degree and compare the coefficients of +`X₀^D` and `X₀^(D-1)` in `∂_γ F`. The leading coefficient `c_D` is a kernel element of smaller +degree, hence a scalar `a`, and the next coefficient combines with `D·a·X₀` into a polynomial `h` +homogeneous of degree `deg X₀` with `∂(h(x)) = 0`; injectivity of `∂` and independence modulo the +decomposables force `D a = 0`. -/ +theorem eq_zero_of_eventually_mkDerivation_eq_zero [CharZero K] (hwt : ∀ i, 1 ≤ wt i) + (hmem : ∀ i, x i ∈ A (wt i : NatOrdinal.{z})) + (hind : ∀ (n : ℕ) (c : ι →₀ K), (∀ i ∈ c.support, wt i = n) → + Finsupp.linearCombination K x c ∈ decomposable A n → c = 0) + (hΔ : IsLoweringDerivation A Δ) (g : ι → T → MvPolynomial ι K) + (hghom : ∀ i γ, IsWeightedHomogeneous wt (g i γ) (wt i - 1)) + (hg : ∀ i, Δ (x i) = ((fun γ ↦ aeval x (g i γ)) : Germ l R)) (w : ℕ) : + ∀ F : MvPolynomial ι K, 1 ≤ w → IsWeightedHomogeneous wt F w → + (∀ᶠ γ in l, mkDerivation K (fun i ↦ g i γ) F = 0) → F = 0 := by + classical + induction w using Nat.strong_induction_on with + | _ w ih => + intro F hw hF hD + by_contra hF0 + -- a variable `X x₀` of maximal degree `wt x₀`; `F` has positive degree `D` in `X x₀` + have hvars : F.vars.Nonempty := by + rw [Finset.nonempty_iff_ne_empty, Ne, vars_eq_empty_iff_eq_C] + intro hC + exact hF0 (by rw [hC, hF.coeff_eq_zero 0 (by rw [map_zero]; omega), map_zero]) + obtain ⟨x₀, hx₀, hmax⟩ := F.vars.exists_max_image wt hvars + have hn1 : 1 ≤ wt x₀ := hwt x₀ + set D := F.degreeOf x₀ with hDdef + have hD1 : 1 ≤ D := Nat.one_le_iff_ne_zero.mpr (mem_vars_iff_degreeOf_ne_zero.mp hx₀) + -- write `F = ∑ c_d (X x₀)^d` + set c : ℕ → MvPolynomial ι K := fun d ↦ xCoeff x₀ d F with hc + have hexp : F = ∑ d ∈ Finset.range (D + 1), c d * X x₀ ^ d := (sum_xCoeff_mul_X_pow x₀ F).symm + have hcD : c D ≠ 0 := xCoeff_degreeOf_ne_zero x₀ hF0 + have hcD1 : c (D + 1) = 0 := xCoeff_eq_zero_of_degreeOf_lt x₀ (Nat.lt_succ_self D) + have hchom : ∀ d, IsWeightedHomogeneous wt (c d) (w - d * wt x₀) := fun d ↦ + xCoeff_isWeightedHomogeneous wt x₀ hF d + have hcsupp : ∀ d, c d ∈ supported K {x₀}ᶜ := fun d ↦ xCoeff_mem_supported x₀ d F + have hgsupp : ∀ γ, g x₀ γ ∈ supported K {x₀}ᶜ := fun γ ↦ + (hghom x₀ γ).mem_supported_of_lt wt (by omega) + have hDsupp : ∀ γ d, mkDerivation K (fun i ↦ g i γ) (c d) ∈ supported K {x₀}ᶜ := fun γ d ↦ + mkDerivation_mem_supported wt hwt _ (fun i ↦ hghom i γ) (hcsupp d) fun i hi ↦ + hmax i (vars_xCoeff_subset x₀ d F hi) + -- `∂_γ F = ∑_d (∂_γ c_d + (d + 1) c_(d+1) g_(x₀)) (X x₀)^d`; compare coefficients + set q : T → ℕ → MvPolynomial ι K := fun γ d ↦ mkDerivation K (fun i ↦ g i γ) (c d) + + ((d + 1 : ℕ) : MvPolynomial ι K) * (c (d + 1) * g x₀ γ) with hq + have hqsupp : ∀ γ d, q γ d ∈ supported K {x₀}ᶜ := fun γ d ↦ + add_mem (hDsupp γ d) (mul_mem (Subalgebra.natCast_mem _ _) (mul_mem (hcsupp _) (hgsupp γ))) + have hDexp : ∀ γ, mkDerivation K (fun i ↦ g i γ) F = + ∑ d ∈ Finset.range (D + 1), q γ d * X x₀ ^ d := by + intro γ + have hterm : ∀ d, mkDerivation K (fun i ↦ g i γ) (c d * X x₀ ^ d) = + mkDerivation K (fun i ↦ g i γ) (c d) * X x₀ ^ d + + (d : MvPolynomial ι K) * (c d * g x₀ γ) * X x₀ ^ (d - 1) := fun d ↦ by + rw [Derivation.leibniz, Derivation.leibniz_pow, mkDerivation_X] + simp only [smul_eq_mul, nsmul_eq_mul] + ring + conv_lhs => rw [hexp, map_sum, Finset.sum_congr rfl fun d _ ↦ hterm d, Finset.sum_add_distrib] + simp only [hq, add_mul] + rw [Finset.sum_add_distrib] + congr 1 + rw [Finset.sum_range_succ', Finset.sum_range_succ] + simp only [Nat.cast_zero, zero_mul, add_zero, hcD1, mul_zero, Nat.add_sub_cancel] + have hcoeff : ∀ γ, mkDerivation K (fun i ↦ g i γ) F = 0 → ∀ d ≤ D, q γ d = 0 := by + intro γ hγ d hd + have := xCoeff_sum_mul_X_pow x₀ (Finset.range (D + 1)) (q := q γ) (fun d _ ↦ hqsupp γ d) d + rwa [← hDexp γ, hγ, map_zero, if_pos (Finset.mem_range.mpr (by omega)), eq_comm] at this + -- the coefficient of `(X x₀)^D`: `∂_γ c_D = 0`, so `c_D` is a non-zero scalar `a` + have hcD0 : ∀ᶠ γ in l, mkDerivation K (fun i ↦ g i γ) (c D) = 0 := + hD.mono fun γ hγ ↦ by simpa [hq, hcD1] using hcoeff γ hγ D le_rfl + have hwD : w = D * wt x₀ := by + by_contra hne + have hle := le_of_xCoeff_ne_zero wt x₀ hF hcD + have hpos : 0 < D * wt x₀ := Nat.mul_pos hD1 hn1 + exact hcD (ih _ (by omega) (c D) (by omega) (hchom D) hcD0) + have hw0 : w - D * wt x₀ = 0 := by omega + set a := coeff 0 (c D) with ha + have hcDa : c D = C a := eq_C_of_isWeightedHomogeneous_zero hwt (hw0 ▸ hchom D) + have ha0 : a ≠ 0 := fun h ↦ hcD (by rw [hcDa, h, map_zero]) + -- the coefficient of `(X x₀)^(D-1)`: `h := c_(D-1) + D a X x₀` has degree `wt x₀`, `∂_γ h = 0` + set h : MvPolynomial ι K := c (D - 1) + C ((D : K) * a) * X x₀ with hh + have hhhom : IsWeightedHomogeneous wt h (wt x₀) := by + refine IsWeightedHomogeneous.add ?_ ?_ + · have := hchom (D - 1) + have hw' : w - (D - 1) * wt x₀ = wt x₀ := by + rw [hwD] + have : D * wt x₀ = (D - 1) * wt x₀ + wt x₀ := by + conv_lhs => rw [← Nat.sub_add_cancel hD1] + ring + omega + rwa [hw'] at this + · have := (isWeightedHomogeneous_C wt ((D : K) * a)).mul (isWeightedHomogeneous_X K wt x₀) + rwa [zero_add] at this + have hDh : ∀ γ, mkDerivation K (fun i ↦ g i γ) h = q γ (D - 1) := by + intro γ + rw [hh, hq] + simp only [Nat.sub_add_cancel hD1, hcDa] + rw [map_add, ← smul_eq_C_mul, Derivation.map_smul, mkDerivation_X, smul_eq_C_mul, map_mul, + map_natCast] + ring + have hh0 : ∀ᶠ γ in l, mkDerivation K (fun i ↦ g i γ) h = 0 := + hD.mono fun γ hγ ↦ by rw [hDh]; exact hcoeff γ hγ (D - 1) (Nat.sub_le D 1) + -- `∂(h(x)) = 0`, hence `h(x) = 0`, and the linear part of `h` in the variables of degree + -- `wt x₀` vanishes: `D a = 0` + have hΔh : Δ (aeval x h) = 0 := by + rw [IsHomogeneousCoordinates.map_aeval hΔ g hg h] + change _ = ((fun _ ↦ (0 : R) : T → R) : Germ l R) + rw [Filter.Germ.coe_eq] + exact hh0.mono fun γ hγ ↦ by + change aeval x (mkDerivation K (fun i ↦ g i γ) h) = 0 + rw [hγ, map_zero] + have haeval : aeval x h = 0 := + hΔ.injective (IsLoweringDerivation.natCast_constantCoeff_pos (wt x₀) hn1) + (aeval_mem_of_forall_mem hmem hhhom) hΔh + obtain ⟨cf, hcfw, hcf, hcfcoeff⟩ := exists_linear_part hwt hmem hn1 hhhom + rw [haeval, zero_sub, neg_mem_iff] at hcf + have hcx := hcfcoeff x₀ + rw [hind (wt x₀) cf hcfw hcf, Finsupp.coe_zero, Pi.zero_apply, hh, coeff_add, hc, coeff_xCoeff, + if_neg (by simp), zero_add, C_mul_X_eq_monomial, coeff_monomial, if_pos rfl] at hcx + exact ha0 ((mul_eq_zero.mp hcx.symm).resolve_left (Nat.cast_ne_zero.mpr (by omega))) + +/-! ### Algebraic independence -/ + +namespace IsHomogeneousCoordinates + +variable [CharZero K] (hx : IsHomogeneousCoordinates A wt x) (hΔ : IsLoweringDerivation A Δ) +include hx hΔ + +/-- No non-zero polynomial homogeneous of degree `w` vanishes at the generators: induction on +`w`; by the chain rule, a relation of degree `w` has as `∂`-derivative a family of relations of +degree `w - 1`, which vanish by induction, so the relation lies in the joint kernel and +vanishes. -/ +theorem eq_zero_of_aeval_eq_zero_of_isWeightedHomogeneous [Nontrivial R] (w : ℕ) : + ∀ F : MvPolynomial ι K, IsWeightedHomogeneous wt F w → aeval x F = 0 → F = 0 := by + classical + obtain ⟨g, hghom, hg⟩ := hx.exists_lifts hΔ + induction w using Nat.strong_induction_on with + | _ w ih => + intro F hF hF0 + rcases Nat.eq_zero_or_pos w with rfl | hw + · rw [eq_C_of_isWeightedHomogeneous_zero hx.one_le hF] at hF0 ⊢ + rw [aeval_C] at hF0 + rw [(algebraMap K R).injective (hF0.trans (map_zero _).symm), map_zero] + · refine eq_zero_of_eventually_mkDerivation_eq_zero hx.one_le hx.mem hx.independent hΔ g hghom + hg w F hw hF ?_ + have h1 := map_aeval hΔ g hg F + rw [hF0, map_zero] at h1 + change ((fun _ ↦ (0 : R) : T → R) : Germ l R) = _ at h1 + rw [Filter.Germ.coe_eq] at h1 + refine h1.mono fun γ hγ ↦ ?_ + exact ih (w - 1) (by omega) _ (mkDerivation_isWeightedHomogeneous wt _ (fun i ↦ hghom i γ) + hx.one_le hF) hγ.symm + +/-- The homogeneous generators are algebraically independent: evaluation `K[X_B : B ∈ 𝓑] → A` +is injective. -/ +theorem aeval_injective [Nontrivial R] : + Function.Injective (aeval x : MvPolynomial ι K →ₐ[K] R) := by + apply OrdinalGraded.aeval_injective_of_forall_injectiveAt hx.mem + intro β + rw [OrdinalGraded.injectiveAt_iff] + intro F hF hF0 + by_cases hzero : F = 0 + · exact hzero + obtain ⟨n, hn⟩ := hF.exists_degree_eq_natCast hzero + subst β + exact hx.eq_zero_of_aeval_eq_zero_of_isWeightedHomogeneous hΔ n F + ((isWeightedHomogeneous_natCast_comp_iff wt).mp hF) hF0 + +end IsHomogeneousCoordinates + + +end GermPolynomial diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean new file mode 100644 index 0000000000..a0573239f9 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean @@ -0,0 +1,596 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermFinitePartIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.FinitePartSubstitution +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSyzygy +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Syzygy + +/-! +# The successor step over an arbitrary filter + +Evaluation at a minimal system of homogeneous generators is injective in a degree whose finite part +is at least one, given that it is injective in every smaller degree. + +The argument is by contradiction. A nonzero relation of that degree lies in the ideal generated by +its partial derivatives at the variables carrying the finite part; choosing a minimal generating +subset of those derivatives and writing the relation against it produces an evaluated syzygy, which +the syzygy induction places in the span of the derivation-annihilated syzygies. Every entry of that +syzygy then evaluates into the square of the ideal of positive degree, and so does the linear part +of the corresponding cofactor — contradicting the independence of the generators modulo that square. + +The two inputs not supplied by the abstract interface are the integration statements: ideal +membership from a derivative germ, and prescribed values on a set carrying a derivative +representative. Both are proved by their own construction in each setting. +-/ + +universe u v w z q + +open Filter GermPolynomial MvPolynomial OrdinalGraded DirectSum + +public noncomputable section + +namespace OrdinalGraded + +variable {K : Type u} {R : Type v} {T : Type q} +variable [Field K] [CommRing R] [Algebra K R] +variable {l : Filter T} +variable {A : NatOrdinal.{z} → Submodule K R} [GradedAlgebra A] +variable {ι : Type w} {wt : ι → NatOrdinal.{z}} {x : ι → R} +variable {Δ : Derivation K R (Germ l R)} +variable (hx : OrdinalGraded.IsMinimalSystem A wt x) +variable (hΔ : GermPolynomial.IsLoweringDerivation A Δ) +include hx hΔ + +open Classical in +/-- **The successor step.** Evaluation is injective in a degree of positive finite part when it is +injective in every smaller degree. -/ +theorem injectiveAt_of_forall_lt [CharZero K] (hgz : GradeZeroScalars A) + (hint : ∀ {ι' : Type w} [Finite ι'] {q : ι' → R} {c : ι' → NatOrdinal.{z}}, + (∀ j, q j ∈ A (c j)) → (∀ j, (c j).constantCoeff = 0) → + ∀ {b : NatOrdinal.{z}}, 0 < b.constantCoeff → ∀ {y : R}, y ∈ A b → + ∀ {f : T → R}, (∀ t, f t ∈ Ideal.span (Set.range q)) → + Δ y = (f : Germ l R) → y ∈ Ideal.span (Set.range q)) + (hsyzint : ∀ {B' : Type w} [Fintype B'] (lam' : B' → NatOrdinal.{z}), + HasSyzygyIntegration A Δ lam' (T := T)) + {δ : NatOrdinal.{z}} (hδ : 0 < δ.constantCoeff) + (hinj : ∀ β < δ, InjectiveAt K wt x β) : InjectiveAt K wt x δ := by + classical + rw [injectiveAt_iff] + intro F hF hF0 + obtain ⟨grep, hg⟩ := OrdinalGraded.IsMinimalSystem.exists_derivativeRep hx hΔ hgz + have hδ0 : δ ≠ 0 := by + rintro rfl + rw [NatOrdinal.constantCoeff_zero] at hδ + exact lt_irrefl _ hδ + obtain ⟨T, hT⟩ : ∃ T : Finset ι, T = varsOfFinitePart wt F δ := ⟨_, rfl⟩ + obtain ⟨c, hc⟩ : ∃ c : ι → MvPolynomial ι K, ∀ t, c t = pderiv t F := ⟨_, fun _ ↦ rfl⟩ + have hcfun : (fun t ↦ pderiv t F) = c := funext fun t ↦ (hc t).symm + have hFI : F ∈ Ideal.span (c '' (T : Set ι)) := by + rw [hT, ← hcfun] + exact DerivativeRep.mem_span_varsOfFinitePart hx hg hΔ hgz hint hinj hδ hF hF0 + -- a minimal generating subset `B ⊆ T` + obtain ⟨B, hBmem, hBmin⟩ := Finset.exists_min_image + (T.powerset.filter fun S : Finset ι ↦ + Ideal.span (c '' (S : Set ι)) = Ideal.span (c '' (T : Set ι))) + Finset.card ⟨T, Finset.mem_filter.mpr ⟨Finset.mem_powerset_self T, rfl⟩⟩ + rw [Finset.mem_filter, Finset.mem_powerset] at hBmem + obtain ⟨hBT, hBspan⟩ := hBmem + rcases B.eq_empty_or_nonempty with hBe | hBne + · -- no generators: `F ∈ (0)` + rw [hBe, Finset.coe_empty, Set.image_empty, Ideal.span_empty] at hBspan + rw [← hBspan] at hFI + exact (Ideal.mem_bot).mp hFI + exfalso + -- the variables of finite part `n` and the partial derivatives at them + have hmemT : ∀ t ∈ T, t ∈ F.vars ∧ (wt t).constantCoeff = δ.constantCoeff := fun t ht ↦ + mem_varsOfFinitePart_iff.mp (hT ▸ ht) + have hlam : ∀ t ∈ T, ∃ β, β + wt t = δ := fun t ht ↦ + exists_add_wt_eq_of_mem_vars hF (hmemT t ht).1 + choose! lam hlam using hlam + have hlamc : ∀ t ∈ T, (lam t).constantCoeff = 0 := fun t ht ↦ + NatOrdinal.constantCoeff_eq_zero_of_add_eq (hmemT t ht).2 (hlam t ht) + have hchom : ∀ t ∈ T, IsWeightedHomogeneous wt (c t) (lam t) := fun t ht ↦ by + rw [hc] + exact isWeightedHomogeneous_pderiv_of_add_wt_eq hF (hlam t ht) + have hcvars : ∀ t ∈ T, ∀ i ∈ (c t).vars, (wt i).constantCoeff = 0 := fun t ht i hi ↦ + constantCoeff_wt_eq_zero_of_mem_vars (hchom t ht) (hlamc t ht) hi + have hlamlt : ∀ t ∈ T, lam t < δ := fun t ht ↦ by + rw [← hlam t ht] + exact lt_add_of_pos_right _ (pos_iff_ne_zero.mpr (hx.ne_zero t)) + -- minimality: no `c_b` lies in the ideal of the others + have hBmin' : ∀ b ∈ B, c b ∉ Ideal.span (c '' ((B.erase b : Finset ι) : Set ι)) := by + intro b hb hmem + have hspan' : Ideal.span (c '' ((B.erase b : Finset ι) : Set ι)) = + Ideal.span (c '' (T : Set ι)) := by + refine le_antisymm ?_ ?_ + · rw [← hBspan] + exact Ideal.span_mono (Set.image_mono (Finset.coe_subset.mpr (Finset.erase_subset b B))) + · rw [← hBspan, Ideal.span_le] + rintro _ ⟨t, ht, rfl⟩ + by_cases htb : t = b + · subst htb + exact hmem + · exact Ideal.subset_span ⟨t, Finset.mem_erase.mpr ⟨htb, ht⟩, rfl⟩ + have := hBmin (B.erase b) (Finset.mem_filter.mpr + ⟨Finset.mem_powerset.mpr ((Finset.erase_subset b B).trans hBT), hspan'⟩) + rw [Finset.card_erase_of_mem hb] at this + have hpos : 0 < B.card := Finset.card_pos.mpr hBne + omega + -- `F = ∑_t c_t (X_t + V_t)` + obtain ⟨V, hV, hFV⟩ := exists_eq_sum_pderiv_mul_X_add_of_mem_span hδ hF + (DerivativeRep.mem_span_varsOfFinitePart hx hg hΔ hgz hint hinj hδ hF hF0) + rw [← hT] at hV hFV + simp only [← hc] at hFV + -- homogeneous coefficients `c_t = ∑_b c_b a_{tb}` + have hct : ∀ t ∈ T, c t ∈ Ideal.span (Set.range fun b : ↥B ↦ c b) := fun t ht ↦ by + have h1 : c t ∈ Ideal.span (c '' (B : Set ι)) := by + rw [hBspan] + exact Ideal.subset_span ⟨t, ht, rfl⟩ + refine Ideal.span_mono ?_ h1 + rintro _ ⟨t', ht', rfl⟩ + exact ⟨⟨t', ht'⟩, rfl⟩ + have hdec : ∀ t ∈ T, ∃ a : ↥B → MvPolynomial ι K, + (∀ b : ↥B, ∀ β, β + lam b = lam t → IsWeightedHomogeneous wt (a b) β) ∧ + (∀ b : ↥B, (¬ ∃ β, β + lam b = lam t) → a b = 0) ∧ c t = ∑ b : ↥B, c b * a b := by + intro t ht + letI := weightedGradedAlgebra K wt + obtain ⟨a, ha, ha0, hsum⟩ := exists_eq_sum_mul_of_mem_span + (𝒜 := weightedHomogeneousSubmodule K wt) (q := fun b : ↥B ↦ c b) (c := fun b : ↥B ↦ lam b) + (fun b ↦ (mem_weightedHomogeneousSubmodule _ _ _ _).mpr (hchom b (hBT b.2))) + ((mem_weightedHomogeneousSubmodule _ _ _ _).mpr (hchom t ht)) (hct t ht) + exact ⟨a, fun b β hβ ↦ (mem_weightedHomogeneousSubmodule _ _ _ _).mp (ha b β hβ), ha0, hsum⟩ + choose! a ha ha0 hsum using hdec + -- Kronecker coefficients for `t ∈ B` + obtain ⟨a', ha'⟩ : ∃ a' : ι → ↥B → MvPolynomial ι K, + ∀ t b, a' t b = if t ∈ B then (if (b : ι) = t then 1 else 0) else a t b := + ⟨_, fun _ _ ↦ rfl⟩ + have ha'hom : ∀ t ∈ T, ∀ b : ↥B, ∀ β, β + lam b = lam t → + IsWeightedHomogeneous wt (a' t b) β := by + intro t ht b β hβ + rw [ha'] + split_ifs with htB hbt + · have h0 : β = 0 := by + rw [hbt] at hβ + exact add_right_cancel (hβ.trans (zero_add _).symm) + rw [h0] + exact isWeightedHomogeneous_one K wt + · exact isWeightedHomogeneous_zero K wt β + · exact ha t ht b β hβ + have ha'0 : ∀ t ∈ T, ∀ b : ↥B, (¬ ∃ β, β + lam b = lam t) → a' t b = 0 := by + intro t ht b hn + rw [ha'] + split_ifs with htB hbt + · exact absurd ⟨0, by rw [hbt, zero_add]⟩ hn + · rfl + · exact ha0 t ht b hn + have hsum' : ∀ t ∈ T, c t = ∑ b : ↥B, c b * a' t b := by + intro t ht + by_cases htB : t ∈ B + · rw [Finset.sum_eq_single ⟨t, htB⟩] + · rw [ha', if_pos htB, if_pos rfl, mul_one] + · intro b _ hb + rw [ha', if_pos htB, if_neg fun h ↦ hb (Subtype.ext h), mul_zero] + · intro h + exact absurd (Finset.mem_univ _) h + · rw [hsum t ht] + exact Finset.sum_congr rfl fun b _ ↦ by rw [ha', if_neg htB] + -- `F = ∑_b c_b W_b` + obtain ⟨W, hW⟩ : ∃ W : ↥B → MvPolynomial ι K, ∀ b, W b = ∑ t ∈ T, a' t b * (X t + V t) := + ⟨_, fun _ ↦ rfl⟩ + have hFW : F = ∑ b : ↥B, c b * W b := by + conv_lhs => rw [hFV] + simp only [hW, Finset.mul_sum] + rw [Finset.sum_comm] + refine Finset.sum_congr rfl fun t ht ↦ ?_ + rw [hsum' t ht, Finset.sum_mul] + exact Finset.sum_congr rfl fun b _ ↦ by ring + -- the evaluated syzygy, homogeneous of degree `δ` + obtain ⟨u, hu'⟩ : ∃ u : ↥B → R, ∀ b, u b = aeval x (W b) := ⟨_, fun _ ↦ rfl⟩ + have hsyz : ∑ b : ↥B, aeval x (c b) * u b = 0 := by + simp only [hu'] + rw [← hF0] + conv_rhs => rw [hFW] + rw [map_sum] + exact Finset.sum_congr rfl fun b _ ↦ (map_mul _ _ _).symm + have hWhom : ∀ b : ↥B, IsWeightedHomogeneous wt (W b) (wt b) := by + intro b + rw [hW] + refine IsWeightedHomogeneous.sum _ _ _ fun t ht ↦ ?_ + by_cases h : ∃ β, β + lam b = lam t + · obtain ⟨β, hβ⟩ := h + have hXV : IsWeightedHomogeneous wt (X t + V t) (wt t) := + (isWeightedHomogeneous_X K wt t).add (hV t ht).1 + have hdeg : β + wt t = wt b := by + apply add_right_cancel (b := lam b) + rw [add_right_comm, hβ, hlam t ht, add_comm, hlam b (hBT b.2)] + rw [← hdeg] + exact (ha'hom t ht b β hβ).mul hXV + · rw [ha'0 t ht b h, zero_mul] + exact isWeightedHomogeneous_zero K wt _ + have hu : IsHomogeneousTuple A (fun b : ↥B ↦ lam b) u δ := by + rw [isHomogeneousTuple_iff] + intro b + have hwl : wt b + lam b = δ := by rw [add_comm]; exact hlam b (hBT b.2) + refine ⟨fun β hβ ↦ ?_, fun h ↦ absurd ⟨wt b, hwl⟩ h⟩ + have hβ' : β = wt b := add_right_cancel (hβ.trans hwl.symm) + rw [hβ', hu'] + exact aeval_mem_of_forall_mem hx.mem (hWhom b) + -- the variables of the `c_t`, all with degree `0` or a limit ordinal, and the polynomial syzygies + -- of `(c_b)` + set Λ : Set ι := ↑(T.biUnion fun t ↦ (c t).vars) with hΛdef + have hΛ : ∀ i ∈ Λ, (wt i).constantCoeff = 0 := by + intro i hi + obtain ⟨t, ht, hit⟩ := Finset.mem_biUnion.mp (Finset.mem_coe.mp hi) + exact hcvars t ht i hit + have hcΛ : ∀ b : ↥B, c b ∈ supported K Λ := fun b ↦ mem_supported.mpr fun i hi ↦ + Finset.mem_coe.mpr (Finset.mem_biUnion.mpr ⟨b, hBT b.2, hi⟩) + obtain ⟨L, hL, hLspan⟩ := exists_finset_syzygy_span_supported Λ (fun b : ↥B ↦ c b) hcΛ + -- evaluations of the generators and their homogeneous components + obtain ⟨ev, hev⟩ : ∃ ev : (↥B → MvPolynomial ι K) → (↥B → R), + ∀ σ b, ev σ b = aeval x (σ b) := ⟨fun σ b ↦ aeval x (σ b), fun _ _ ↦ rfl⟩ + obtain ⟨comp, hcomp⟩ : ∃ comp : (↥B → R) → NatOrdinal → (↥B → R), + ∀ w e b, comp w e b = if h : ∃ β, β + lam b = e then + (decompose (A) (w b) (Classical.choose h) : R) else 0 := + ⟨fun w e b ↦ if h : ∃ β, β + lam b = e then + (decompose (A) (w b) (Classical.choose h) : R) else 0, + fun _ _ _ ↦ rfl⟩ + have hcomp_hom : ∀ w e, IsHomogeneousTuple A (fun b : ↥B ↦ lam b) (comp w e) e := by + intro w e + rw [isHomogeneousTuple_iff] + intro b + refine ⟨fun β hβ ↦ ?_, fun h ↦ ?_⟩ + · have h : ∃ β, β + lam b = e := ⟨β, hβ⟩ + have hch : ∀ h' : ∃ β, β + lam b = e, Classical.choose h' = β := fun h' ↦ + add_right_cancel ((Classical.choose_spec h').trans hβ.symm) + rw [hcomp, dif_pos h, hch] + exact (decompose (A) (w b) β).2 + · rw [hcomp, dif_neg h] + have hcomp_syz : ∀ σ ∈ L, ∀ e, ∑ b : ↥B, aeval x (c b) * comp (ev σ) e b = 0 := by + intro σ hσ e + have h1 : ∀ b : ↥B, aeval x (c b) * comp (ev σ) e b = + GradedRing.proj (A) e (aeval x (c b) * aeval x (σ b)) := by + intro b + rw [GradedRing.proj_apply, coe_decompose_mul_of_left_mem (𝒜 := A) + (aeval_mem_of_forall_mem hx.mem (hchom b (hBT b.2))) (aeval x (σ b)) e, hcomp, hev] + by_cases h : ∃ β, β + lam b = e + · rw [dif_pos h, dif_pos h] + · rw [dif_neg h, dif_neg h, mul_zero] + have h2 : ∑ b : ↥B, aeval x (c b) * aeval x (σ b) = 0 := by + have := congrArg (aeval x) (hL σ hσ).2 + rw [map_sum, map_zero] at this + simpa only [map_mul] using this + rw [Finset.sum_congr rfl fun b _ ↦ h1 b, ← map_sum, h2, map_zero] + have hcomp_lim : ∀ σ ∈ L, ∀ e (b : ↥B) β, comp (ev σ) e b ∈ A β → + comp (ev σ) e b ≠ 0 → β.constantCoeff = 0 := by + intro σ hσ e b β hmem hne + by_contra hβ + apply hne + by_cases h : ∃ β', β' + lam b = e + · rw [hcomp, hev, dif_pos h] at hmem hne ⊢ + -- a nonzero element of `P_β` and of `P_{β'}` forces `β = β'` + have hβ' : β = Classical.choose h := by + by_contra hne' + have h0 := decompose_of_mem_ne (A) hmem hne' + rw [decompose_of_mem_same (A) + (decompose (A) (aeval x (σ b)) (Classical.choose h)).2] at h0 + exact hne h0 + rw [hβ'] at hβ + rw [decompose_aeval hx.mem, weightedHomogeneousComponent_eq_zero_of_forall_vars + (fun i hi ↦ hΛ i (mem_supported.mp ((hL σ hσ).1 b) hi)) hβ, map_zero] + · rw [hcomp, dif_neg h] at hne + exact absurd rfl hne + -- the degrees occurring, and the sum of the components + set E : Finset NatOrdinal := L.biUnion fun σ ↦ Finset.univ.biUnion fun b : ↥B ↦ + (decompose (A) (ev σ b)).support.image (· + lam b) with hEdef + have hev_sum : ∀ σ ∈ L, ev σ = ∑ e ∈ E, comp (ev σ) e := by + intro σ hσ + funext b + rw [Finset.sum_apply] + have himg : (decompose (A) (ev σ b)).support.image (· + lam b) ⊆ E := by + intro e he + rw [hEdef] + exact Finset.mem_biUnion.mpr ⟨σ, hσ, Finset.mem_biUnion.mpr ⟨b, Finset.mem_univ b, he⟩⟩ + rw [← Finset.sum_subset himg, Finset.sum_image fun β₁ _ β₂ _ h ↦ add_right_cancel h] + · conv_lhs => rw [← sum_support_decompose (A) (ev σ b)] + refine Finset.sum_congr rfl fun β _ ↦ ?_ + have h : ∃ β', β' + lam b = β + lam b := ⟨β, rfl⟩ + have hch : ∀ h' : ∃ β', β' + lam b = β + lam b, Classical.choose h' = β := fun h' ↦ + add_right_cancel (Classical.choose_spec h') + rw [hcomp, dif_pos h, hch] + · intro e _ he + rw [hcomp] + split_ifs with h + · have hnot : Classical.choose h ∉ (decompose (A) (ev σ b)).support := + fun hmem ↦ he (Finset.mem_image.mpr ⟨_, hmem, Classical.choose_spec h⟩) + rw [DFinsupp.notMem_support_iff.mp hnot] + rfl + · rfl + -- the finite set `𝒯` of homogeneous ∂-annihilated syzygies + set TP : Finset (↥B → R) := (L ×ˢ E).image fun p ↦ comp (ev p.1) p.2 with hTPdef + set eT : (↥B → R) → NatOrdinal := fun w ↦ + if h : ∃ e, IsHomogeneousTuple A (fun b : ↥B ↦ lam b) w e then Classical.choose h else 0 + with heTdef + have hTPmem : ∀ w ∈ TP, ∃ σ ∈ L, ∃ e, w = comp (ev σ) e := by + intro w hw + obtain ⟨⟨σ, e⟩, hp, rfl⟩ := Finset.mem_image.mp hw + exact ⟨σ, (Finset.mem_product.mp hp).1, e, rfl⟩ + have hTPhom : ∀ w ∈ TP, IsHomogeneousTuple A (fun b : ↥B ↦ lam b) w (eT w) := by + intro w hw + obtain ⟨σ, _, e, rfl⟩ := hTPmem w hw + have h : ∃ e', IsHomogeneousTuple A (fun b : ↥B ↦ lam b) (comp (ev σ) e) e' := + ⟨e, hcomp_hom _ _⟩ + have heT : eT (comp (ev σ) e) = Classical.choose h := by + simp only [heTdef] + rw [dif_pos h] + rw [heT] + exact Classical.choose_spec h + have hTPlim : ∀ w ∈ TP, ∀ (b : ↥B) β, w b ∈ A β → w b ≠ 0 → + β.constantCoeff = 0 := by + intro w hw b β hmem hne + obtain ⟨σ, hσ, e, rfl⟩ := hTPmem w hw + exact hcomp_lim σ hσ e b β hmem hne + have hTPd : ∀ w ∈ TP, ∀ b, Δ (w b) = 0 := by + intro w hw b + by_cases h0 : w b = 0 + · rw [h0, map_zero] + · have hhom := (isHomogeneousTuple_iff.mp (hTPhom w hw)) b + have hex : ∃ β, β + lam b = eT w := by + by_contra hn + exact h0 (hhom.2 hn) + obtain ⟨β, hβ⟩ := hex + exact hΔ.eq_zero + (hTPlim w hw b β (hhom.1 β hβ) h0) (hhom.1 β hβ) + have hTPsyz : ∀ w ∈ TP, ∑ b : ↥B, aeval x (c b) * w b = 0 := by + intro w hw + obtain ⟨σ, hσ, e, rfl⟩ := hTPmem w hw + exact hcomp_syz σ hσ e + -- the hypothesis in the degrees below `δ`: evaluation injective below `δ` + have hbase : ∀ d < δ, d.constantCoeff = 0 → ∀ u' : ↥B → R, + IsHomogeneousTuple A (fun b : ↥B ↦ lam b) u' d → ∑ b : ↥B, aeval x (c b) * u' b = 0 → + u' ∈ Submodule.span (R) (TP : Set (↥B → R)) := by + intro d hd _ u' hu' hsyz' + -- polynomial representatives of the entries + have hU : ∀ b : ↥B, ∃ U : MvPolynomial ι K, + (∀ β, β + lam b = d → IsWeightedHomogeneous wt U β) ∧ + ((¬ ∃ β, β + lam b = d) → U = 0) ∧ aeval x U = u' b := by + intro b + have hhom := (isHomogeneousTuple_iff.mp hu') b + by_cases h : ∃ β, β + lam b = d + · obtain ⟨β, hβ⟩ := h + obtain ⟨U, hUhom, hUu⟩ := hx.exists_aeval_eq hgz β + (u' b) (hhom.1 β hβ) + refine ⟨U, fun β' hβ' ↦ ?_, fun hn ↦ absurd ⟨β, hβ⟩ hn, hUu⟩ + rwa [add_right_cancel (hβ'.trans hβ.symm)] + · exact ⟨0, fun β hβ ↦ absurd ⟨β, hβ⟩ h, fun _ ↦ rfl, by rw [map_zero, hhom.2 h]⟩ + choose U hUhom hU0 hUu using hU + -- `∑ c_b U_b` is a relation of degree `d < δ`, hence zero + have hG : IsWeightedHomogeneous wt (∑ b : ↥B, c b * U b) d := by + refine IsWeightedHomogeneous.sum _ _ _ fun b _ ↦ ?_ + by_cases h : ∃ β, β + lam b = d + · obtain ⟨β, hβ⟩ := h + have := (hchom b (hBT b.2)).mul (hUhom b β hβ) + rwa [add_comm, hβ] at this + · rw [hU0 b h, mul_zero] + exact isWeightedHomogeneous_zero K wt d + have hG0 : aeval x (∑ b : ↥B, c b * U b) = 0 := by + rw [map_sum, ← hsyz'] + exact Finset.sum_congr rfl fun b _ ↦ by rw [map_mul, hUu] + have hGz := (injectiveAt_iff _).mp (hinj d hd) _ hG hG0 + -- so `U` is a polynomial syzygy, a combination of the generators + obtain ⟨r, _, hr⟩ := Submodule.mem_span_finset.mp (hLspan U hGz) + have hu'eq : u' = ∑ σ ∈ L, aeval x (r σ) • ev σ := by + funext b + rw [Finset.sum_apply] + have hrb := congrFun hr b + rw [Finset.sum_apply] at hrb + simp only [Pi.smul_apply, smul_eq_mul] at hrb ⊢ + rw [← hUu b, ← hrb, map_sum] + exact Finset.sum_congr rfl fun σ _ ↦ by rw [map_mul, hev] + rw [hu'eq] + refine Submodule.sum_mem _ fun σ hσ ↦ Submodule.smul_mem _ _ ?_ + rw [hev_sum σ hσ] + exact Submodule.sum_mem _ fun e he ↦ Submodule.subset_span + (Finset.mem_image.mpr ⟨(σ, e), Finset.mem_product.mpr ⟨hσ, he⟩, rfl⟩) + -- the induction on syzygies + have huN := mem_span_of_isHomogeneousTuple_of_sum_eq_zero (c := fun b : ↥B ↦ aeval x (c b)) + (lam := fun b : ↥B ↦ lam b) hΔ (fun b ↦ aeval_mem_of_forall_mem hx.mem (hchom b (hBT b.2))) + (fun b ↦ hlamc b (hBT b.2)) (hsyzint (fun b : ↥B ↦ lam b)) TP eT hTPhom hTPd hδ hbase + δ le_rfl u hu hsyz + obtain ⟨a₂, ha₂, hu_eq⟩ := exists_eq_sum_smul_of_mem_span hTPhom hu huN + -- every `u_b` lies in `(P̂_+)² ∩ P_{deg b}` + have hudec : ∀ b : ↥B, u b ∈ decomposableAt (A) (wt b) := by + intro b + have hub := congrFun hu_eq b + rw [Finset.sum_apply] at hub + simp only [Pi.smul_apply, smul_eq_mul] at hub + rw [hub] + refine sum_mem fun w hw ↦ ?_ + by_cases hwb : w b = 0 + · rw [hwb, mul_zero] + exact zero_mem _ + by_cases ha0 : a₂ w = 0 + · rw [ha0, zero_mul] + exact zero_mem _ + have hhom := (isHomogeneousTuple_iff.mp (hTPhom w hw)) b + obtain ⟨β, hβ⟩ : ∃ β, β + lam b = eT w := by + by_contra hn + exact hwb (hhom.2 hn) + have hwβ : w b ∈ A β := hhom.1 β hβ + obtain ⟨ρ, hρ⟩ : ∃ ρ, ρ + eT w = δ := by + by_contra hn + exact ha0 ((ha₂ w hw).2 hn) + have haρ : a₂ w ∈ A ρ := (ha₂ w hw).1 ρ hρ + have hρβ : ρ + β = wt b := by + apply add_right_cancel (b := lam b) + rw [add_assoc, hβ, hρ, add_comm] + exact (hlam b (hBT b.2)).symm + -- `ρ ≠ 0`: its finite part is that of `δ`, `n ≥ 1` + have hβc : β.constantCoeff = 0 := hTPlim w hw b β hwβ hwb + have hρ0 : ρ ≠ 0 := by + intro h0 + have h1 := congrArg NatOrdinal.constantCoeff hρ + rw [NatOrdinal.constantCoeff_add, ← hβ, NatOrdinal.constantCoeff_add, hβc, + hlamc b (hBT b.2), h0, NatOrdinal.constantCoeff_zero] at h1 + omega + -- `β ≠ 0`: a scalar entry would put `c_b` in the ideal of the other `c_{b'}` + have hβ0 : β ≠ 0 := by + intro h0 + rw [h0, zero_add] at hβ + rw [h0] at hwβ + obtain ⟨κ, hκ⟩ := (gradeZeroScalars_iff A).mp hgz (w b) hwβ + have hκ0 : κ ≠ 0 := by + rintro rfl + exact hwb (by rw [hκ, map_zero]) + have hP : ∀ b' : ↥B, ∃ P : MvPolynomial ι K, + (∀ β', β' + lam b' = lam b → IsWeightedHomogeneous wt P β') ∧ + ((¬ ∃ β', β' + lam b' = lam b) → P = 0) ∧ aeval x P = w b' := by + intro b' + have hhom' := (isHomogeneousTuple_iff.mp (hTPhom w hw)) b' + rw [← hβ] at hhom' + by_cases h : ∃ β', β' + lam b' = lam b + · obtain ⟨β', hβ'⟩ := h + obtain ⟨P, hPhom, hPw⟩ := hx.exists_aeval_eq hgz β' + (w b') (hhom'.1 β' hβ') + refine ⟨P, fun β'' hβ'' ↦ ?_, fun hn ↦ absurd ⟨β', hβ'⟩ hn, hPw⟩ + rwa [add_right_cancel (hβ''.trans hβ'.symm)] + · exact ⟨0, fun β' hβ' ↦ absurd ⟨β', hβ'⟩ h, fun _ ↦ rfl, by rw [map_zero, hhom'.2 h]⟩ + choose P hPhom hP0 hPw using hP + -- the relation `κ c_b + ∑_{b' ≠ b} c_{b'} P_{b'}` of degree `lam b < δ` + have hG'hom : IsWeightedHomogeneous wt + (C κ * c b + ∑ b' ∈ Finset.univ.erase b, c b' * P b') (lam b) := by + refine ((hchom b (hBT b.2)).C_mul κ).add (IsWeightedHomogeneous.sum _ _ _ fun b' _ ↦ ?_) + by_cases h : ∃ β', β' + lam b' = lam b + · obtain ⟨β', hβ'⟩ := h + have := (hchom b' (hBT b'.2)).mul (hPhom b' β' hβ') + rwa [add_comm, hβ'] at this + · rw [hP0 b' h, mul_zero] + exact isWeightedHomogeneous_zero K wt _ + have hG'0 : aeval x (C κ * c b + ∑ b' ∈ Finset.univ.erase b, c b' * P b') = 0 := by + have hsyzw := hTPsyz w hw + rw [← Finset.add_sum_erase _ _ (Finset.mem_univ b), hκ] at hsyzw + rw [map_add, map_mul, map_sum, ← algebraMap_eq, AlgHom.commutes, Algebra.commutes, + Finset.sum_congr rfl fun b' _ ↦ by rw [map_mul, hPw]] + exact hsyzw + have hG'z := (injectiveAt_iff _).mp (hinj (lam b) (hlamlt b (hBT b.2))) _ hG'hom hG'0 + have h2 : C κ * c b = -∑ b' ∈ Finset.univ.erase b, c b' * P b' := + eq_neg_of_add_eq_zero_left hG'z + have h3 : c b = C κ⁻¹ * (C κ * c b) := by + rw [← mul_assoc, ← C_mul, inv_mul_cancel₀ hκ0, C_1, one_mul] + refine hBmin' b b.2 ?_ + rw [h3, h2] + refine Ideal.mul_mem_left _ _ ((Ideal.neg_mem_iff _).mpr (Ideal.sum_mem _ fun b' hb' ↦ ?_)) + refine Ideal.mul_mem_right _ _ (Ideal.subset_span ⟨b', ?_, rfl⟩) + exact Finset.mem_coe.mpr (Finset.mem_erase.mpr + ⟨fun h ↦ (Finset.mem_erase.mp hb').1 (Subtype.ext h), b'.2⟩) + rw [← hρβ] + exact mul_mem_decomposableAt (A) hρ0 hβ0 haρ hwβ + -- the linear part `ℓ_b` of `W_b` then lies in `(P̂_+)² ∩ P_{deg b}`, contradicting the linear + -- independence of the generators modulo `(P̂_+)² ∩ P_{deg b}` + obtain ⟨b₀, hb₀⟩ := hBne + obtain ⟨b, hb⟩ : ∃ b : ↥B, (b : ι) = b₀ := ⟨⟨b₀, hb₀⟩, rfl⟩ + obtain ⟨κ', hκ'⟩ : ∃ κ' : ι → K, ∀ t, κ' t = coeff 0 (a' t b) := ⟨_, fun _ ↦ rfl⟩ + obtain ⟨ℓ, hℓ⟩ : ∃ ℓ : MvPolynomial ι K, ℓ = ∑ t ∈ T, C (κ' t) * X t := ⟨_, rfl⟩ + have hdiff : aeval x (W b) - aeval x ℓ ∈ decomposableAt (A) (wt b) := by + rw [hW, hℓ, map_sum, map_sum, ← Finset.sum_sub_distrib] + refine sum_mem fun t ht ↦ ?_ + rw [map_mul, map_mul, map_add, aeval_X, ← algebraMap_eq, AlgHom.commutes] + have hVt : aeval x (V t) ∈ decomposableAt (A) (wt t) := by + refine aeval_mem_decomposableAt_of_mem_supported hx.mem hx.ne_zero ?_ (hV t ht).1 ?_ + · rw [(hmemT t ht).2] + exact hδ + · rw [(hmemT t ht).2] + exact (hV t ht).2 + by_cases h : ∃ β, β + lam b = lam t + · obtain ⟨β, hβ⟩ := h + have hahom := ha'hom t ht b β hβ + have hdeg : β + wt t = wt b := by + apply add_right_cancel (b := lam b) + rw [add_right_comm, hβ, hlam t ht, add_comm, hlam b (hBT b.2)] + by_cases hβ0 : β = 0 + · -- a scalar coefficient: the difference is `κ' t • V_t(𝓑)` + subst hβ0 + have hC : a' t b = C (κ' t) := by + rw [hκ'] + exact eq_C_of_isWeightedHomogeneous_zero hx.ne_zero hahom + rw [zero_add] at hdeg + rw [hC] + rw [← algebraMap_eq] + rw [AlgHom.commutes] + rw [mul_add] + rw [add_sub_cancel_left] + rw [mul_comm] + rw [← hdeg] + have := mul_mem_decomposableAt_of_mem_decomposableAt hVt + (SetLike.algebraMap_mem_graded (A) (κ' t)) + rwa [add_zero] at this + · have hκ0 : κ' t = 0 := by + rw [hκ'] + exact coeff_zero_eq_zero_of_isWeightedHomogeneous hahom hβ0 + rw [hκ0, map_zero, zero_mul, sub_zero, mul_add, ← hdeg] + refine add_mem (mul_mem_decomposableAt (A) hβ0 (hx.ne_zero t) + (aeval_mem_of_forall_mem hx.mem hahom) (hx.mem t)) ?_ + rw [mul_comm, add_comm] + exact mul_mem_decomposableAt_of_mem_decomposableAt hVt + (aeval_mem_of_forall_mem hx.mem hahom) + · have hκ0 : κ' t = 0 := by + rw [hκ', ha'0 t ht b h, coeff_zero] + rw [ha'0 t ht b h, hκ0] + simp only [map_zero, zero_mul, sub_zero] + exact zero_mem _ + have hℓmem : aeval x ℓ ∈ decomposableAt (A) (wt b) := by + have hub : u b ∈ decomposableAt (A) (wt b) := hudec b + rw [hu'] at hub + have := sub_mem hub hdiff + rwa [sub_sub_cancel] at this + -- `ℓ(𝓑)` is a linear combination of the generators of degree `wt b` with coefficient `1` on + -- `x_b` + obtain ⟨f, hf⟩ : ∃ f : ι →₀ K, f = ∑ t ∈ T, Finsupp.single t (κ' t) := ⟨_, rfl⟩ + have hfapply : ∀ i, f i = if i ∈ T then κ' i else 0 := by + intro i + rw [hf, Finsupp.finsetSum_apply] + simp only [Finsupp.single_apply] + exact Finset.sum_ite_eq' T i κ' + have hℓeq : Finsupp.linearCombination K x f = aeval x ℓ := by + rw [hf, map_sum, hℓ, map_sum] + exact Finset.sum_congr rfl fun t _ ↦ by + rw [Finsupp.linearCombination_single, map_mul, aeval_X, ← algebraMap_eq, AlgHom.commutes, + Algebra.smul_def] + have hfsupp : ∀ i ∈ f.support, wt i = wt b := by + intro i hi + rw [Finsupp.mem_support_iff, hfapply] at hi + split_ifs at hi with hiT + · by_cases h : ∃ β, β + lam b = lam i + · obtain ⟨β, hβ⟩ := h + have hahom := ha'hom i hiT b β hβ + by_cases hβ0 : β = 0 + · subst hβ0 + rw [zero_add] at hβ + have := (hlam i hiT).trans (hlam b (hBT b.2)).symm + rw [hβ] at this + exact add_left_cancel this + · refine absurd ?_ hi + rw [hκ'] + exact coeff_zero_eq_zero_of_isWeightedHomogeneous hahom hβ0 + · refine absurd ?_ hi + rw [hκ', ha'0 i hiT b h, coeff_zero] + · exact absurd rfl hi + have hfmem : Finsupp.linearCombination K x f ∈ decomposableAt (A) (wt b) := by + rw [hℓeq] + exact hℓmem + have hf0 := hx.independent (wt b) f hfsupp hfmem + have hfb := congrArg (fun g : ι →₀ K ↦ g b₀) hf0 + simp only [Finsupp.coe_zero, Pi.zero_apply] at hfb + rw [hfapply, if_pos (hBT hb₀)] at hfb + have hκ1 : κ' b₀ = 1 := by + rw [hκ', ha' b₀ b, if_pos hb₀, if_pos hb, coeff_zero_one] + rw [hκ1] at hfb + exact one_ne_zero hfb + +end OrdinalGraded + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSyzygy.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSyzygy.lean new file mode 100644 index 0000000000..1e1fb972d4 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSyzygy.lean @@ -0,0 +1,388 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.OrdinalGenerators +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermPolynomial + +/-! +# Homogeneous tuples over an ordinal-graded algebra + +A tuple `u` indexed by `B` is homogeneous of degree `d` relative to degrees `λ_b` when `u_b` +sits in degree `β` for the `β` with `β ⊕ λ_b = d`, and vanishes when +`λ_b \not\preccurlyeq d` in the +algebraic order. + +The one substantial statement here is that a homogeneous tuple lying in the span of finitely many +homogeneous tuples has homogeneous coefficients: take the graded component of each coefficient at +the degree forced by the equation. That is bookkeeping about the grading, with nothing about +derivations or about where the entries live, and both the real-exponent development and the +Cantor–Bendixson germ argument uses it. + +The ordinal degrees may lie in any universe. +-/ + +universe u v w z + +open DirectSum + +public noncomputable section + +namespace OrdinalGraded + +variable {K : Type u} {R : Type v} [Field K] [CommRing R] [Algebra K R] +variable {A : NatOrdinal.{z} → Submodule K R} [GradedAlgebra A] +variable {B : Type w} + +variable (A) in +/-- A tuple `u` is homogeneous of degree `d` relative to the degrees `λ_b`: `u_b` sits in degree +`β` for the `β` with `β + λ_b = d`, and is zero when `λ_b` does not precede `d` in the +algebraic order. -/ +def IsHomogeneousTuple (lam : B → NatOrdinal.{z}) (u : B → R) (d : NatOrdinal.{z}) : Prop := + ∀ b, (∀ β, β + lam b = d → u b ∈ A β) ∧ ((¬ ∃ β, β + lam b = d) → u b = 0) + +omit [GradedAlgebra A] in +theorem isHomogeneousTuple_iff {lam : B → NatOrdinal.{z}} {u : B → R} {d : NatOrdinal.{z}} : + IsHomogeneousTuple A lam u d ↔ + ∀ b, (∀ β, β + lam b = d → u b ∈ A β) ∧ + ((¬ ∃ β, β + lam b = d) → u b = 0) := + Iff.rfl + +omit [GradedAlgebra A] in +theorem isHomogeneousTuple_zero (lam : B → NatOrdinal.{z}) (d : NatOrdinal.{z}) : + IsHomogeneousTuple A lam (0 : B → R) d := + fun _ ↦ ⟨fun _ _ ↦ zero_mem _, fun _ ↦ rfl⟩ + +omit [GradedAlgebra A] in +theorem IsHomogeneousTuple.mem {lam : B → NatOrdinal.{z}} {u : B → R} {d : NatOrdinal.{z}} + (hu : IsHomogeneousTuple A lam u d) {b : B} {β : NatOrdinal.{z}} (hβ : β + lam b = d) : + u b ∈ A β := + (hu b).1 β hβ + +omit [GradedAlgebra A] in +theorem IsHomogeneousTuple.eq_zero {lam : B → NatOrdinal.{z}} {u : B → R} {d : NatOrdinal.{z}} + (hu : IsHomogeneousTuple A lam u d) {b : B} (h : ¬ ∃ β, β + lam b = d) : u b = 0 := + (hu b).2 h + +/-- **Homogeneous coefficients along homogeneous generators.** A homogeneous tuple `w` of degree +`d` in the span of a finite set `T` of homogeneous tuples is `∑ a_τ • τ` with each `a_τ` +homogeneous of the degree forced by the equation, and zero when there is none. -/ +theorem exists_eq_sum_smul_of_mem_span {lam : B → NatOrdinal.{z}} {T : Finset (B → R)} + {eT : (B → R) → NatOrdinal.{z}} (hT : ∀ τ ∈ T, IsHomogeneousTuple A lam τ (eT τ)) + {w : B → R} {d : NatOrdinal.{z}} (hw : IsHomogeneousTuple A lam w d) + (hwN : w ∈ Submodule.span R (T : Set (B → R))) : + ∃ a : (B → R) → R, + (∀ τ ∈ T, (∀ ρ, ρ + eT τ = d → a τ ∈ A ρ) ∧ + ((¬ ∃ ρ, ρ + eT τ = d) → a τ = 0)) ∧ + w = ∑ τ ∈ T, a τ • τ := by + classical + obtain ⟨r, _, hr⟩ := Submodule.mem_span_finset.mp hwN + refine ⟨fun τ ↦ if h : ∃ ρ, ρ + eT τ = d then + (decompose A (r τ) (Classical.choose h) : R) else 0, + fun τ _ ↦ ⟨fun ρ hρ ↦ ?_, fun h ↦ dif_neg h⟩, ?_⟩ + · have h : ∃ ρ, ρ + eT τ = d := ⟨ρ, hρ⟩ + have hρ' : ∀ h' : ∃ ρ, ρ + eT τ = d, Classical.choose h' = ρ := fun h' ↦ + add_right_cancel ((Classical.choose_spec h').trans hρ.symm) + beta_reduce + rw [dif_pos h, hρ'] + exact (decompose A (r τ) ρ).2 + · funext b + rw [Finset.sum_apply] + simp only [Pi.smul_apply, smul_eq_mul] + by_cases hb : ∃ β, β + lam b = d + · obtain ⟨β, hβ⟩ := hb + -- take the degree-`β` component of `w b = ∑ r τ * τ b` + have hwb : w b = (decompose A (w b) β : R) := (decompose_of_mem_same _ (hw.mem hβ)).symm + rw [hwb, ← hr, Finset.sum_apply] + simp only [Pi.smul_apply, smul_eq_mul] + rw [← GradedRing.proj_apply, map_sum] + refine Finset.sum_congr rfl fun τ hτ ↦ ?_ + rw [GradedRing.proj_apply] + by_cases hτb : ∃ β', β' + lam b = eT τ + · obtain ⟨β', hβ'⟩ := hτb + have hmem : τ b ∈ A β' := (hT τ hτ).mem hβ' + rw [mul_comm, OrdinalGraded.coe_decompose_mul_of_left_mem hmem (r τ) β] + -- `ρ + β' = β` exactly when `ρ + e_τ = d` + have hiff : (∃ ρ, ρ + β' = β) ↔ ∃ ρ, ρ + eT τ = d := by + constructor + · rintro ⟨ρ, hρ⟩ + exact ⟨ρ, by rw [← hβ', ← add_assoc, hρ, hβ]⟩ + · rintro ⟨ρ, hρ⟩ + refine ⟨ρ, add_right_cancel (b := lam b) ?_⟩ + rw [add_assoc, hβ', hρ, hβ] + by_cases h1 : ∃ ρ, ρ + β' = β + · have h2 : ∃ ρ, ρ + eT τ = d := hiff.mp h1 + have hch : Classical.choose h1 = Classical.choose h2 := by + refine add_right_cancel (b := β') ?_ + rw [Classical.choose_spec h1] + refine add_right_cancel (b := lam b) ?_ + rw [add_assoc, hβ', Classical.choose_spec h2, hβ] + rw [dif_pos h1, dif_pos h2, hch, mul_comm] + · have h2 : ¬ ∃ ρ, ρ + eT τ = d := fun h ↦ h1 (hiff.mpr h) + rw [dif_neg h1, dif_neg h2, zero_mul] + · rw [(hT τ hτ).eq_zero hτb, mul_zero, ← GradedRing.proj_apply, map_zero, mul_zero] + · -- no degree is forced: both sides vanish + rw [hw.eq_zero hb] + symm + refine Finset.sum_eq_zero fun τ hτ ↦ ?_ + by_cases hτb : ∃ β', β' + lam b = eT τ + · obtain ⟨β', hβ'⟩ := hτb + have h2 : ¬ ∃ ρ, ρ + eT τ = d := fun ⟨ρ, hρ⟩ ↦ + hb ⟨ρ + β', by rw [add_assoc, hβ', hρ]⟩ + beta_reduce + rw [dif_neg h2, zero_mul] + · rw [(hT τ hτ).eq_zero hτb, mul_zero] + +section Induction + +variable {T : Type*} {l : Filter T} {Δ : Derivation K R (Filter.Germ l R)} +variable {B : Type w} [Fintype B] {c : B → R} {lam : B → NatOrdinal.{z}} + +open Filter + +/-- The germ of a pointwise finite sum is the sum of the germs. -/ +theorem germ_coe_sum {ι' : Type*} (s : Finset ι') (f : ι' → T → R) : + ((fun t ↦ ∑ i ∈ s, f i t : T → R) : Germ l R) = + ∑ i ∈ s, ((f i : T → R) : Germ l R) := by + have hfun : (fun t ↦ ∑ i ∈ s, f i t : T → R) = ∑ i ∈ s, f i := by + ext t + simp only [Finset.sum_apply] + rw [hfun] + exact map_sum (Filter.Germ.coeRingHom l) f s + +variable (A Δ lam) in +/-- What the successor induction needs from the setting. A homogeneous tuple of successor degree +has a derivative representative supported on some set, homogeneous one degree lower; and values +prescribed homogeneously on that set are themselves derivatives, vanishing off it. + +Over the real line this is the `ω`-sequence of cutoffs together with the image theorem for +derivatives; for the Cantor–Bendixson construction it is an exact-rank set together with the +theorem integrating prescribed homogeneous classes on that set. Both are proved by their own +construction, so this remains a hypothesis of the abstract theorem. + +What the Cantor–Bendixson instance supplies. The set here is shared by every entry of the tuple, +while a derivative representative is supported on the exact-rank level of its own series, so the +candidate is the union of those levels. The integration theorem requires a discrete set, and a +union of discrete sets is not discrete in general—but it is near zero, which is the only place the +germs detect. Past its own cutoff a level stays away from the points it misses, finitely many +cutoffs have a largest, and above that the union is discrete +(`exists_isDiscrete_iUnion_rankLevelSet`). The integration construction then runs over it +(`exists_prescribed_components_on_set_of_isDiscrete`), and the representatives may be cut off +below the common bound without changing their germs. -/ +def HasSyzygyIntegration : Prop := + ∀ {d : NatOrdinal.{z}}, 0 < d.constantCoeff → ∀ {u : B → R}, + IsHomogeneousTuple A lam u d → + ∃ (S : Set T) (D : B → T → R), + (∀ b, Δ (u b) = ((D b : T → R) : Germ l R)) ∧ + (∀ t, IsHomogeneousTuple A lam (fun b ↦ D b t) (d.removeNat 1)) ∧ + (∀ b, ∀ t ∉ S, D b t = 0) ∧ + ∀ {ρ : NatOrdinal.{z}} (a : T → R), (∀ t, a t ∈ A ρ) → + ∃ s : R, s ∈ A (ρ + 1) ∧ ∃ G : T → R, Δ s = (G : Germ l R) ∧ + (∀ t ∈ S, G t = a t) ∧ (∀ t ∉ S, G t = 0) + +omit [GradedAlgebra A] [Fintype B] in +/-- Characterization of the successor syzygy-integration interface. -/ +theorem hasSyzygyIntegration_iff : HasSyzygyIntegration A Δ lam (T := T) ↔ + ∀ {d : NatOrdinal.{z}}, 0 < d.constantCoeff → ∀ {u : B → R}, + IsHomogeneousTuple A lam u d → + ∃ (S : Set T) (D : B → T → R), + (∀ b, Δ (u b) = ((D b : T → R) : Germ l R)) ∧ + (∀ t, IsHomogeneousTuple A lam (fun b ↦ D b t) (d.removeNat 1)) ∧ + (∀ b, ∀ t ∉ S, D b t = 0) ∧ + ∀ {ρ : NatOrdinal.{z}} (a : T → R), (∀ t, a t ∈ A ρ) → + ∃ s : R, s ∈ A (ρ + 1) ∧ ∃ G : T → R, Δ s = (G : Germ l R) ∧ + (∀ t ∈ S, G t = a t) ∧ (∀ t ∉ S, G t = 0) := + Iff.rfl + +/-- **The induction on syzygies.** Let the `c_b` be homogeneous of degrees that are zero or limits, +let `T` be a finite set of homogeneous syzygies of `(c_b)` annihilated by the derivation, and `N` +the submodule it spans. If every homogeneous syzygy of degree below `δ` with finite part zero lies +in `N`, then every homogeneous syzygy of degree at most `δ` lies in `N`. + +The induction is on the finite part of the degree. A syzygy of successor degree has a derivative +representative that is again a syzygy one degree lower, hence in `N`; decomposing it along the +generators and integrating the coefficients produces a candidate whose difference from the original +has zero derivative, so injectivity in successor degree finishes. -/ +theorem mem_span_of_isHomogeneousTuple_of_sum_eq_zero + (hΔ : GermPolynomial.IsLoweringDerivation A Δ) + (hc : ∀ b, c b ∈ A (lam b)) (hlam : ∀ b, (lam b).constantCoeff = 0) + (hint : HasSyzygyIntegration A Δ lam (T := T)) + (T' : Finset (B → R)) (eT : (B → R) → NatOrdinal.{z}) + (hT : ∀ τ ∈ T', IsHomogeneousTuple A lam τ (eT τ)) + (hTd : ∀ τ ∈ T', ∀ b, Δ (τ b) = 0) + {δ : NatOrdinal.{z}} (hδ : 0 < δ.constantCoeff) + (hbase : ∀ d < δ, d.constantCoeff = 0 → ∀ u : B → R, IsHomogeneousTuple A lam u d → + ∑ b, c b * u b = 0 → u ∈ Submodule.span R (T' : Set (B → R))) : + ∀ d ≤ δ, ∀ u : B → R, IsHomogeneousTuple A lam u d → ∑ b, c b * u b = 0 → + u ∈ Submodule.span R (T' : Set (B → R)) := by + classical + suffices h : ∀ n : ℕ, ∀ d, d.constantCoeff = n → d ≤ δ → ∀ u : B → R, + IsHomogeneousTuple A lam u d → ∑ b, c b * u b = 0 → + u ∈ Submodule.span R (T' : Set (B → R)) from + fun d hd u hu hsyz ↦ h _ d rfl hd u hu hsyz + intro n + induction n with + | zero => + intro d hd hdδ u hu hsyz + refine hbase d (lt_of_le_of_ne hdδ fun h ↦ ?_) hd u hu hsyz + rw [h] at hd + omega + | succ n ih => + intro d hd hdδ u hu hsyz + have hdpos : 0 < d.constantCoeff := by rw [hd]; omega + obtain ⟨d', hd'def⟩ : ∃ d', d' = d.removeNat 1 := ⟨_, rfl⟩ + have hd'1 : d' + 1 = d := by + have hstep := NatOrdinal.removeNat_add_natCast (a := d) (n := 1) hdpos + rw [Nat.cast_one] at hstep + rw [hd'def] + exact hstep + have hd'c : d'.constantCoeff = n := by + rw [hd'def, NatOrdinal.constantCoeff_removeNat, hd] + omega + have hd'lt : d' < δ := lt_of_lt_of_le (lt_of_lt_of_eq (lt_add_one d') hd'1) hdδ + -- the derivative representative and its prescription set + obtain ⟨S, D, hD, hDhom, hDoff, hintS⟩ := hint hdpos hu + -- the derivative tuple is a syzygy on a set of the filter + have hDsyz : ∀ᶠ t in l, ∑ b, c b * D b t = 0 := by + have hzero := congrArg Δ hsyz + rw [map_zero, map_sum] at hzero + have hterm : ∀ b, Δ (c b * u b) = ((fun t ↦ c b * D b t : T → R) : Germ l R) := by + intro b + rw [GermPolynomial.derivation_leibniz, hΔ.eq_zero (hlam b) (hc b), + zero_mul, zero_add, hD] + rfl + simp only [hterm] at hzero + have hsum : ((fun t ↦ ∑ b, c b * D b t : T → R) : Germ l R) = + ((fun _ ↦ (0 : R) : T → R) : Germ l R) := by + rw [germ_coe_sum] + exact hzero + exact Germ.coe_eq.mp hsum + obtain ⟨V, hV, hVsub⟩ := eventually_iff_exists_mem.mp hDsyz + -- cut the representative down to that set, so its values lie in the span everywhere + obtain ⟨W, hWon, hWoff⟩ : ∃ W : T → B → R, (∀ t ∈ V, W t = fun b ↦ D b t) ∧ + ∀ t ∉ V, W t = 0 := + ⟨fun t ↦ if t ∈ V then (fun b ↦ D b t) else 0, + fun t ht ↦ if_pos ht, fun t ht ↦ if_neg ht⟩ + have hWhom : ∀ t, IsHomogeneousTuple A lam (W t) d' := fun t ↦ by + by_cases ht : t ∈ V + · rw [hWon t ht, hd'def] + exact hDhom t + · rw [hWoff t ht] + exact isHomogeneousTuple_zero lam d' + have hWN : ∀ t, W t ∈ Submodule.span R (T' : Set (B → R)) := fun t ↦ by + by_cases ht : t ∈ V + · rw [hWon t ht] + refine ih d' hd'c hd'lt.le _ ?_ (hVsub t ht) + rw [hd'def] + exact hDhom t + · rw [hWoff t ht] + exact zero_mem _ + obtain ⟨a, ha, hasum⟩ : ∃ a : T → (B → R) → R, + (∀ t, ∀ τ ∈ T', (∀ ρ, ρ + eT τ = d' → a t τ ∈ A ρ) ∧ + ((¬ ∃ ρ, ρ + eT τ = d') → a t τ = 0)) ∧ + ∀ t, W t = ∑ τ ∈ T', a t τ • τ := by + choose a ha hasum using fun t ↦ exists_eq_sum_smul_of_mem_span hT (hWhom t) (hWN t) + exact ⟨a, ha, hasum⟩ + -- integrate each coefficient family + obtain ⟨s, hs, hs0, G, hG, hGon, hGoff⟩ : ∃ s : (B → R) → R, + (∀ τ ∈ T', ∀ ρ, ρ + eT τ = d' → s τ ∈ A (ρ + 1)) ∧ + (∀ τ ∈ T', (¬ ∃ ρ, ρ + eT τ = d') → s τ = 0) ∧ + ∃ G : (B → R) → T → R, + (∀ τ ∈ T', Δ (s τ) = ((G τ : T → R) : Germ l R)) ∧ + (∀ τ ∈ T', ∀ t ∈ S, G τ t = a t τ) ∧ + (∀ τ ∈ T', ∀ t ∉ S, G τ t = 0) := by + have hone : ∀ τ ∈ T', ∃ sτ : R, (∀ ρ, ρ + eT τ = d' → sτ ∈ A (ρ + 1)) ∧ + ((¬ ∃ ρ, ρ + eT τ = d') → sτ = 0) ∧ + ∃ Gτ : T → R, Δ sτ = ((Gτ : T → R) : Germ l R) ∧ + (∀ t ∈ S, Gτ t = a t τ) ∧ (∀ t ∉ S, Gτ t = 0) := by + intro τ hτ + by_cases hρ : ∃ ρ, ρ + eT τ = d' + · obtain ⟨ρ, hρ⟩ := hρ + obtain ⟨sτ, hsτ, Gτ, hGτ, hGon', hGoff'⟩ := + hintS (ρ := ρ) (fun t ↦ a t τ) (fun t ↦ (ha t τ hτ).1 ρ hρ) + refine ⟨sτ, fun ρ' hρ' ↦ ?_, fun hn ↦ absurd ⟨ρ, hρ⟩ hn, Gτ, hGτ, + hGon', hGoff'⟩ + rwa [add_right_cancel (hρ'.trans hρ.symm)] + · exact ⟨0, fun ρ hρ' ↦ absurd ⟨ρ, hρ'⟩ hρ, fun _ ↦ rfl, fun _ ↦ 0, + by rw [map_zero]; rfl, fun t _ ↦ ((ha t τ hτ).2 hρ).symm, fun _ _ ↦ rfl⟩ + choose! sf hsf hsf0 Gf hGf hGon' hGoff' using hone + exact ⟨sf, hsf, hsf0, Gf, hGf, hGon', hGoff'⟩ + -- the difference has zero derivative in every entry, hence vanishes + have hy : ∀ b, u b - ∑ τ ∈ T', s τ * τ b = 0 := by + intro b + by_cases hb : ∃ β, β + lam b = d + · obtain ⟨β, hβ⟩ := hb + have hβpos : 0 < β.constantCoeff := by + have hc1 := congrArg NatOrdinal.constantCoeff hβ + rw [NatOrdinal.constantCoeff_add, hlam b, add_zero, hd] at hc1 + omega + have hβ' : β.removeNat 1 + lam b = d' := by + have hstep := NatOrdinal.removeNat_add_right β (lam b) hβpos + rw [hβ, ← hd'def] at hstep + exact hstep.symm + have hβ1 : β.removeNat 1 + 1 = β := by + have hstep := NatOrdinal.removeNat_add_natCast (a := β) (n := 1) hβpos + rwa [Nat.cast_one] at hstep + have hmem : u b - ∑ τ ∈ T', s τ * τ b ∈ A β := by + refine sub_mem (hu.mem hβ) (sum_mem fun τ hτ ↦ ?_) + by_cases hτb : ∃ β', β' + lam b = eT τ + · obtain ⟨β', hβ'b⟩ := hτb + by_cases hρ : ∃ ρ, ρ + eT τ = d' + · obtain ⟨ρ, hρ⟩ := hρ + have h1 : ρ + β' = β.removeNat 1 := + add_right_cancel (b := lam b) (by rw [add_assoc, hβ'b, hρ, hβ']) + have h2 : (ρ + 1) + β' = β := by rw [add_right_comm, h1, hβ1] + rw [← h2] + exact SetLike.mul_mem_graded (hs τ hτ ρ hρ) ((hT τ hτ).mem hβ'b) + · rw [hs0 τ hτ hρ, zero_mul] + exact zero_mem _ + · rw [(hT τ hτ).eq_zero hτb, mul_zero] + exact zero_mem _ + refine hΔ.injective hβpos hmem ?_ + have hΔs : Δ (∑ τ ∈ T', s τ * τ b) = + ((fun t ↦ ∑ τ ∈ T', G τ t * τ b : T → R) : Germ l R) := by + rw [map_sum] + have hterm : ∀ τ ∈ T', Δ (s τ * τ b) = + ((fun t ↦ G τ t * τ b : T → R) : Germ l R) := by + intro τ hτ + rw [GermPolynomial.derivation_leibniz, hTd τ hτ b, mul_zero, add_zero, hG τ hτ] + rfl + rw [Finset.sum_congr rfl hterm, germ_coe_sum] + rw [map_sub, hD, hΔs, ← Germ.coe_sub] + refine Germ.coe_eq.mpr ?_ + filter_upwards [hV] with t ht + simp only [Pi.sub_apply] + by_cases hSt : t ∈ S + · have hdec := congrFun (hasum t) b + rw [hWon t ht, Finset.sum_apply] at hdec + simp only [Pi.smul_apply, smul_eq_mul] at hdec + rw [hdec, sub_eq_zero] + exact Finset.sum_congr rfl fun τ hτ ↦ by rw [hGon τ hτ t hSt] + · rw [hDoff b t hSt, Finset.sum_eq_zero fun τ hτ ↦ by + rw [hGoff τ hτ t hSt, zero_mul], sub_zero] + · rw [hu.eq_zero hb, Finset.sum_eq_zero, sub_zero] + intro τ hτ + by_cases hτb : ∃ β', β' + lam b = eT τ + · obtain ⟨β', hβ'b⟩ := hτb + have hρ : ¬ ∃ ρ, ρ + eT τ = d' := fun ⟨ρ, hρ⟩ ↦ hb ⟨ρ + β' + 1, by + calc ρ + β' + 1 + lam b = ρ + (β' + lam b) + 1 := by abel + _ = d := by rw [hβ'b, hρ, hd'1]⟩ + rw [hs0 τ hτ hρ, zero_mul] + · rw [(hT τ hτ).eq_zero hτb, mul_zero] + have hueq : u = ∑ τ ∈ T', s τ • τ := by + funext b + rw [Finset.sum_apply] + simp only [Pi.smul_apply, smul_eq_mul] + exact sub_eq_zero.mp (hy b) + rw [hueq] + exact Submodule.sum_mem _ fun τ hτ ↦ Submodule.smul_mem _ _ (Submodule.subset_span hτ) + +end Induction + +end OrdinalGraded + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/HomogeneousDivisibility.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/HomogeneousDivisibility.lean new file mode 100644 index 0000000000..00dace4d95 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/HomogeneousDivisibility.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.DirectSum.Ring + +import Mathlib.Algebra.BigOperators.Ring.Finset +import Mathlib.Algebra.GroupWithZero.Divisibility + +/-! +# Divisibility by homogeneous elements in graded direct sums + +Multiplication by an element supported in grade `i` shifts every component by `i`. When addition +of grades is left-cancellative, this identifies the component at `i + j` with the product of the +homogeneous element and the component at `j`. Consequently, a homogeneous element divides a +graded sum if and only if it divides every homogeneous component. +-/ + +universe u v + +public noncomputable section + +open scoped DirectSum + +namespace DirectSum + +variable {ι : Type u} (A : ι → Type v) + [DecidableEq ι] [AddCommMonoid ι] [IsLeftCancelAdd ι] + [∀ i, AddCommMonoid (A i)] [DirectSum.GSemiring A] + +theorem of_mul_apply_add {i : ι} (a : A i) (x : DirectSum ι A) (j : ι) : + (DirectSum.of A i a * x) (i + j) = + GradedMonoid.GMul.mul a (x j) := by + induction x using DirectSum.induction_on with + | zero => + rw [mul_zero] + exact (DirectSum.GNonUnitalNonAssocSemiring.mul_zero (A := A) a).symm + | of k b => + by_cases hkj : k = j + · subst k + rw [DirectSum.of_mul_of, DirectSum.of_eq_same, DirectSum.of_eq_same] + · rw [DirectSum.of_mul_of] + rw [DirectSum.of_eq_of_ne k j b (Ne.symm hkj)] + rw [DirectSum.GNonUnitalNonAssocSemiring.mul_zero] + rw [DirectSum.of_eq_of_ne] + exact fun h ↦ hkj (add_left_cancel h).symm + | add x y hx hy => + rw [mul_add, add_apply, add_apply, hx, hy] + exact (DirectSum.GNonUnitalNonAssocSemiring.mul_add (A := A) a (x j) (y j)).symm + +omit [IsLeftCancelAdd ι] in +theorem of_mul_apply_eq_zero_of_not_exists {i k : ι} (a : A i) + (x : DirectSum ι A) (h : ¬∃ j, i + j = k) : + (DirectSum.of A i a * x) k = 0 := by + induction x using DirectSum.induction_on with + | zero => simp + | of j b => + rw [DirectSum.of_mul_of] + rw [DirectSum.of_eq_of_ne] + exact fun hij ↦ h ⟨j, hij.symm⟩ + | add x y hx hy => + rw [mul_add, add_apply, hx, hy, add_zero] + +/-- A homogeneous element divides a graded sum if and only if it divides every component. -/ +theorem of_dvd_iff_dvd_components {i : ι} (a : A i) (x : DirectSum ι A) : + DirectSum.of A i a ∣ x ↔ + ∀ k, DirectSum.of A i a ∣ DirectSum.of A k (x k) := by + classical + constructor + · rintro ⟨y, rfl⟩ k + by_cases h : ∃ j, i + j = k + · obtain ⟨j, rfl⟩ := h + refine ⟨DirectSum.of A j (y j), ?_⟩ + rw [DirectSum.of_mul_of, of_mul_apply_add] + · rw [of_mul_apply_eq_zero_of_not_exists A a y h, map_zero] + exact dvd_zero _ + · intro h + rw [← DirectSum.sum_support_of x] + exact Finset.dvd_sum fun k _ ↦ h k + +end DirectSum diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/HomogeneousPrime.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/HomogeneousPrime.lean new file mode 100644 index 0000000000..9dd2b1b5e1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/HomogeneousPrime.lean @@ -0,0 +1,171 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.LeadingGrade + +import Mathlib.Tactic.Abel +import Mathlib.Algebra.Ring.Divisibility.Basic +public import Mathlib.Algebra.Prime.Defs + +/-! +# Primality of a homogeneous element from its homogeneous divisibility property + +In a graded direct sum whose homogeneous components multiply without cancellation, a +homogeneous element dividing one of the two factors of every homogeneous product it divides +does so for every product it divides. The induction is on the total number of nonzero +components, so it is uniform in the grading monoid and in the grade of the divisor. +-/ + +open scoped DirectSum + +universe u v + +public noncomputable section + +namespace DirectSum + +variable {ι : Type u} (A : ι → Type v) + [LinearOrder ι] [AddCommMonoid ι] [IsOrderedCancelAddMonoid ι] + [∀ i, AddCommGroup (A i)] [DirectSum.GCommRing A] + +open scoped Classical in +omit [IsOrderedCancelAddMonoid ι] in +private theorem card_support_sub_lt {x : DirectSum ι A} {m : ι} (hm : x m ≠ 0) : + (DFinsupp.support (x - DirectSum.of A m (x m))).card < + (DFinsupp.support x).card := by + classical + refine Finset.card_lt_card ⟨fun j hj ↦ ?_, fun hsub ↦ ?_⟩ + · rw [DFinsupp.mem_support_iff] at hj ⊢ + intro hzero + apply hj + by_cases hjm : j = m + · subst j + simp [DirectSum.sub_apply] + · simp [DirectSum.sub_apply, DirectSum.of_apply, Ne.symm hjm, hzero] + · have hmem := hsub (DFinsupp.mem_support_iff.mpr hm) + rw [DFinsupp.mem_support_iff] at hmem + exact hmem (by simp [DirectSum.sub_apply]) + +theorem dvd_or_dvd_of_homogeneous_dvd_or_dvd + {i : ι} (a : A i) + (hhom : ∀ (j k : ι) (b : A j) (c : A k), + DirectSum.of A i a ∣ DirectSum.of A j b * DirectSum.of A k c → + DirectSum.of A i a ∣ DirectSum.of A j b ∨ + DirectSum.of A i a ∣ DirectSum.of A k c) + (x y : DirectSum ι A) (hdvd : DirectSum.of A i a ∣ x * y) : + DirectSum.of A i a ∣ x ∨ DirectSum.of A i a ∣ y := by + classical + generalize hcard : (DFinsupp.support x).card + (DFinsupp.support y).card = n + induction n using Nat.strong_induction_on generalizing x y with + | _ n ih => + by_cases hx : x = 0 + · exact Or.inl (hx ▸ ⟨0, (mul_zero _).symm⟩) + by_cases hy : y = 0 + · exact Or.inr (hy ▸ ⟨0, (mul_zero _).symm⟩) + obtain ⟨m, hmlead, hmne⟩ := exists_grade_eq_leadingGrade A hx + obtain ⟨p, hplead, hpne⟩ := exists_grade_eq_leadingGrade A hy + have htop : (x * y) (m + p) = GradedMonoid.GMul.mul (x m) (y p) := + mul_apply_add_eq_of_leadingGrade_eq A hmlead hplead + have hsplit : DirectSum.of A i a ∣ + DirectSum.of A m (x m) * DirectSum.of A p (y p) := by + have hcomp := (of_dvd_iff_dvd_components A a (x * y)).mp hdvd (m + p) + rwa [htop, ← DirectSum.of_mul_of] at hcomp + rcases hhom m p (x m) (y p) hsplit with hxm | hyp + · have hrest : DirectSum.of A i a ∣ (x - DirectSum.of A m (x m)) * y := by + rw [sub_mul] + exact dvd_sub hdvd (dvd_mul_of_dvd_left hxm y) + have hlt : (DFinsupp.support (x - DirectSum.of A m (x m))).card + + (DFinsupp.support y).card < n := by + rw [← hcard] + exact Nat.add_lt_add_right (card_support_sub_lt A hmne) _ + rcases ih _ hlt _ _ hrest rfl with hrec | hrec + · refine Or.inl ?_ + have hx' : x = (x - DirectSum.of A m (x m)) + DirectSum.of A m (x m) := by abel + rw [hx'] + exact dvd_add hrec hxm + · exact Or.inr hrec + · have hrest : DirectSum.of A i a ∣ x * (y - DirectSum.of A p (y p)) := by + rw [mul_sub] + exact dvd_sub hdvd (dvd_mul_of_dvd_right hyp x) + have hlt : (DFinsupp.support x).card + + (DFinsupp.support (y - DirectSum.of A p (y p))).card < n := by + rw [← hcard] + exact Nat.add_lt_add_left (card_support_sub_lt A hpne) _ + rcases ih _ hlt _ _ hrest rfl with hrec | hrec + · exact Or.inl hrec + · refine Or.inr ?_ + have hy' : y = (y - DirectSum.of A p (y p)) + DirectSum.of A p (y p) := by abel + rw [hy'] + exact dvd_add hrec hyp + +theorem prime_of_homogeneous_dvd_or_dvd + {i : ι} (a : A i) + (hne : DirectSum.of A i a ≠ 0) + (hunit : ¬ IsUnit (DirectSum.of A i a)) + (hhom : ∀ (j k : ι) (b : A j) (c : A k), + DirectSum.of A i a ∣ DirectSum.of A j b * DirectSum.of A k c → + DirectSum.of A i a ∣ DirectSum.of A j b ∨ + DirectSum.of A i a ∣ DirectSum.of A k c) : + Prime (DirectSum.of A i a) := + ⟨hne, hunit, fun x y hdvd ↦ + dvd_or_dvd_of_homogeneous_dvd_or_dvd A a hhom x y hdvd⟩ + +theorem irreducible_of_homogeneous_of_grade_not_split {i : ι} (a : A i) + (hmulne : ∀ {j k : ι} (u : A j) (v : A k), u ≠ 0 → v ≠ 0 → + GradedMonoid.GMul.mul u v ≠ 0) + (hbot : ∀ j : ι, 0 ≤ j) + (hunitZero : ∀ u : A 0, u ≠ 0 → IsUnit (DirectSum.of A 0 u)) + (hsplit : ∀ j k : ι, j + k = i → j = 0 ∨ k = 0) + (hne : DirectSum.of A i a ≠ 0) + (hunit : ¬ IsUnit (DirectSum.of A i a)) : + Irreducible (DirectSum.of A i a) := by + classical + have ha : a ≠ 0 := by + intro h + exact hne (by rw [h, map_zero]) + refine ⟨hunit, fun x y hxy ↦ ?_⟩ + have hx0 : x ≠ 0 := by + intro h + rw [h, zero_mul] at hxy + exact hne hxy + have hy0 : y ≠ 0 := by + intro h + rw [h, mul_zero] at hxy + exact hne hxy + obtain ⟨m, hm, hxm⟩ := exists_grade_eq_leadingGrade A hx0 + obtain ⟨n, hn, hyn⟩ := exists_grade_eq_leadingGrade A hy0 + have hlead : leadingGrade A x + leadingGrade A y = ((i : ι) : WithBot ι) := by + rw [← leadingGrade_mul A hmulne x y, ← hxy, leadingGrade_of A ha] + rw [hm, hn, ← WithBot.coe_add, WithBot.coe_eq_coe] at hlead + have key : ∀ z : DirectSum ι A, z ≠ 0 → leadingGrade A z = ((0 : ι) : WithBot ι) → + IsUnit z := by + intro z hz hlz + have hconc : z = DirectSum.of A 0 (z 0) := by + refine DFinsupp.ext fun j ↦ ?_ + by_cases hj : j = 0 + · subst hj + simp + · have hzj : z j = 0 := by + by_contra hjne + have hle := grade_le_leadingGrade A hjne + rw [hlz, WithBot.coe_le_coe] at hle + exact hj (le_antisymm hle (hbot j)) + rw [hzj, DirectSum.of_apply, dif_neg (Ne.symm hj)] + have hz0 : z 0 ≠ 0 := by + intro h + apply hz + rw [hconc, h, map_zero] + rw [hconc] + exact hunitZero _ hz0 + rcases hsplit m n hlead with hm0 | hn0 + · exact Or.inl (key x hx0 (by rw [hm, hm0])) + · exact Or.inr (key y hy0 (by rw [hn, hn0])) + +end DirectSum + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/InternalGrading.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/InternalGrading.lean new file mode 100644 index 0000000000..37dcc9d6ef --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/InternalGrading.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.DirectSum.Algebra +public import Mathlib.RingTheory.GradedAlgebra.Basic + +/-! +# The internal grading of an external graded algebra + +An external graded algebra `⨁ i, A i` is internally graded by the ranges of the canonical +inclusions `lof i : A i → ⨁ i, A i`. This file records the submodules `rangeLof R A i` and the +resulting `GradedAlgebra` instance, so that results stated for internally graded algebras apply +to direct sums. +-/ + +universe u v w + +open scoped DirectSum + +public noncomputable section + +namespace DirectSum + +variable (R : Type u) {ι : Type v} (A : ι → Type w) +variable [CommSemiring R] [DecidableEq ι] [AddMonoid ι] +variable [∀ i, AddCommMonoid (A i)] [∀ i, Module R (A i)] [GSemiring A] [GAlgebra R A] + +/-- The grade-`i` part of an external direct sum: the range of the inclusion of `A i`. -/ +def rangeLof (i : ι) : Submodule R (⨁ i, A i) := + LinearMap.range (lof R ι A i) + +omit [AddMonoid ι] [GSemiring A] [GAlgebra R A] in +theorem rangeLof_eq_range (i : ι) : rangeLof R A i = LinearMap.range (lof R ι A i) := (rfl) + +omit [AddMonoid ι] [GSemiring A] [GAlgebra R A] in +theorem lof_mem_rangeLof (i : ι) (a : A i) : lof R ι A i a ∈ rangeLof R A i := + ⟨a, rfl⟩ + +omit [AddMonoid ι] [GSemiring A] [GAlgebra R A] in +theorem of_mem_rangeLof (i : ι) (a : A i) : of A i a ∈ rangeLof R A i := + ⟨a, rfl⟩ + +omit [AddMonoid ι] [GSemiring A] [GAlgebra R A] in +theorem mem_rangeLof_iff (i : ι) (x : ⨁ i, A i) : + x ∈ rangeLof R A i ↔ ∃ a : A i, lof R ι A i a = x := + Iff.rfl + +instance instRangeLofGradedMonoid : SetLike.GradedMonoid (rangeLof R A) where + one_mem := ⟨GradedMonoid.GOne.one, (one_def A).symm⟩ + mul_mem i j x y hx hy := by + obtain ⟨a, rfl⟩ := hx + obtain ⟨b, rfl⟩ := hy + exact ⟨GradedMonoid.GMul.mul a b, by + rw [lof_eq_of, lof_eq_of, lof_eq_of, of_mul_of]⟩ + +/-- The componentwise equivalence `A i ≃ rangeLof R A i`. -/ +def rangeLofEquiv (i : ι) : A i ≃ₗ[R] rangeLof R A i := + LinearEquiv.ofInjective (lof R ι A i) (of_injective i) + +/-- The decomposition of an external direct sum along its internal grading. -/ +def rangeLofDecompose : (⨁ i, A i) →ₗ[R] ⨁ i, rangeLof R A i := + toModule R ι _ fun i ↦ (lof R ι (fun i ↦ rangeLof R A i) i).comp (rangeLofEquiv R A i).toLinearMap + +omit [AddMonoid ι] [GSemiring A] [GAlgebra R A] in +theorem rangeLofDecompose_lof (i : ι) (a : A i) : + rangeLofDecompose R A (lof R ι A i a) = + lof R ι (fun i ↦ rangeLof R A i) i (rangeLofEquiv R A i a) := by + rw [rangeLofDecompose, toModule_lof, LinearMap.comp_apply, LinearEquiv.coe_coe] + +omit [GAlgebra R A] in +theorem coeLinearMap_rangeLofDecompose (x : ⨁ i, A i) : + coeLinearMap (rangeLof R A) (rangeLofDecompose R A x) = x := by + induction x using DirectSum.induction_on with + | zero => rw [map_zero, map_zero] + | of i a => + rw [← lof_eq_of R, rangeLofDecompose_lof, coeLinearMap_lof] + rfl + | add x y hx hy => rw [map_add, map_add, hx, hy] + +omit [GAlgebra R A] in +theorem rangeLofDecompose_coeLinearMap (x : ⨁ i, rangeLof R A i) : + rangeLofDecompose R A (coeLinearMap (rangeLof R A) x) = x := by + induction x using DirectSum.induction_on with + | zero => rw [map_zero, map_zero] + | of i a => + obtain ⟨b, rfl⟩ := (rangeLofEquiv R A i).surjective a + rw [← lof_eq_of R, coeLinearMap_lof] + change rangeLofDecompose R A (lof R ι A i b) = _ + rw [rangeLofDecompose_lof] + | add x y hx hy => rw [map_add, map_add, hx, hy] + +omit [GAlgebra R A] in +theorem rangeLof_isInternal : IsInternal (rangeLof R A) := + Function.bijective_iff_has_inverse.mpr ⟨rangeLofDecompose R A, + rangeLofDecompose_coeLinearMap R A, coeLinearMap_rangeLofDecompose R A⟩ + +/-- The internal graded-algebra structure on an external direct sum. -/ +instance instRangeLofGradedAlgebra : GradedAlgebra (rangeLof R A) := + (rangeLof_isInternal R A).gradedAlgebra + +/-- The decomposition of the internal grading recovers the components. -/ +theorem coe_decompose_rangeLof (x : ⨁ i, A i) (i : ι) : + ((DirectSum.decompose (rangeLof R A) x i : rangeLof R A i) : ⨁ i, A i) = + lof R ι A i (x i) := by + classical + conv_lhs => rw [← DirectSum.sum_support_of x] + rw [DirectSum.decompose_sum, DirectSum.sum_apply, Submodule.coe_sum, Finset.sum_eq_single i] + · rw [DirectSum.decompose_of_mem_same _ (of_mem_rangeLof R A i (x i)), lof_eq_of] + · intro j _ hji + rw [DirectSum.decompose_of_mem_ne _ (of_mem_rangeLof R A j (x j)) hji] + · intro hi + rw [DFinsupp.notMem_support_iff.mp hi, map_zero, DirectSum.decompose_zero] + rfl + +end DirectSum diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/LeadingGrade.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/LeadingGrade.lean new file mode 100644 index 0000000000..24be417e8c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/LeadingGrade.lean @@ -0,0 +1,229 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.DirectSum.Ring +public import Mathlib.Algebra.Order.Monoid.Unbundled.WithTop +public import Mathlib.Data.Finset.Max + +/-! +# Leading grades in graded direct sums + +The leading grade of a finitely supported graded sum is the largest grade at which its component +is nonzero, with value bottom at zero. It satisfies the max-form addition inequality. + +For a graded ring whose nonzero homogeneous elements have nonzero product, leading grade is +multiplicative. The proof isolates the unique contribution at the sum of the two leading grades; +all other pairs of support indices have strictly smaller sum. +-/ + +universe u v + +public noncomputable section + +open scoped DirectSum + +namespace DirectSum + +section Additive + +variable {ι : Type u} (A : ι → Type v) + [LinearOrder ι] [∀ i, AddCommMonoid (A i)] + +/-- The largest grade at which a graded direct-sum element has nonzero component. -/ +def leadingGrade (x : DirectSum ι A) : WithBot ι := by + classical + exact x.support.max + +@[simp] +theorem leadingGrade_zero : leadingGrade A 0 = ⊥ := by + classical + simp [leadingGrade] + +theorem leadingGrade_of {i : ι} {a : A i} (ha : a ≠ 0) : + leadingGrade A (DirectSum.of A i a) = i := by + classical + rw [leadingGrade, DirectSum.support_of i a ha, Finset.max_singleton] + +@[simp] +theorem leadingGrade_eq_bot_iff (x : DirectSum ι A) : + leadingGrade A x = ⊥ ↔ x = 0 := by + classical + simp only [leadingGrade, Finset.max_eq_bot, DFinsupp.support_eq_empty] + rfl + +theorem grade_le_leadingGrade {x : DirectSum ι A} {i : ι} (hi : x i ≠ 0) : + (i : WithBot ι) ≤ leadingGrade A x := by + classical + exact Finset.le_max (DFinsupp.mem_support_iff.mpr hi) + +theorem leadingGrade_eq_coe_iff (x : DirectSum ι A) (m : ι) : + leadingGrade A x = (m : WithBot ι) ↔ + x m ≠ 0 ∧ ∀ i, x i ≠ 0 → i ≤ m := by + classical + constructor + · intro h + have hm : m ∈ x.support := Finset.mem_of_max h + refine ⟨DFinsupp.mem_support_iff.mp hm, ?_⟩ + intro i hi + exact Finset.le_max_of_eq (DFinsupp.mem_support_iff.mpr hi) h + · rintro ⟨hm, hmax⟩ + apply le_antisymm + · rw [leadingGrade] + apply Finset.max_le + intro i hi + exact WithBot.coe_le_coe.mpr (hmax i (DFinsupp.mem_support_iff.mp hi)) + · exact Finset.le_max (DFinsupp.mem_support_iff.mpr hm) + +theorem leadingGrade_add_le_max (x y : DirectSum ι A) : + leadingGrade A (x + y) ≤ max (leadingGrade A x) (leadingGrade A y) := by + classical + rw [leadingGrade, leadingGrade, leadingGrade, ← Finset.max_union] + exact Finset.max_mono DFinsupp.support_add + +theorem exists_grade_eq_leadingGrade {x : DirectSum ι A} (hx : x ≠ 0) : + ∃ m : ι, leadingGrade A x = m ∧ x m ≠ 0 := by + classical + have hs : x.support.Nonempty := by + rw [Finset.nonempty_iff_ne_empty] + intro hs + apply hx + apply DirectSum.ext + intro i + apply DFinsupp.notMem_support_iff.mp + rw [hs] + simp + obtain ⟨m, hm⟩ := Finset.max_of_nonempty hs + exact ⟨m, hm, DFinsupp.mem_support_iff.mp (Finset.mem_of_max hm)⟩ + +end Additive + +section Group + +variable {ι : Type u} (A : ι → Type v) + [LinearOrder ι] [∀ i, AddCommGroup (A i)] + +@[simp] +theorem leadingGrade_neg (x : DirectSum ι A) : leadingGrade A (-x) = leadingGrade A x := by + have hsupp : ∀ i, (-x) i ≠ 0 ↔ x i ≠ 0 := fun i ↦ by + rw [← zero_sub, DirectSum.sub_apply, DirectSum.zero_apply, zero_sub] + exact neg_ne_zero + apply le_antisymm + · by_cases h : -x = 0 + · rw [h, leadingGrade_zero] + exact bot_le + obtain ⟨m, hm, hxm⟩ := exists_grade_eq_leadingGrade A h + rw [hm] + exact grade_le_leadingGrade A ((hsupp m).mp hxm) + · by_cases h : x = 0 + · rw [h, leadingGrade_zero] + exact bot_le + obtain ⟨m, hm, hxm⟩ := exists_grade_eq_leadingGrade A h + rw [hm] + exact grade_le_leadingGrade A ((hsupp m).mpr hxm) + +end Group + +section Multiplicative + +variable {ι : Type u} (A : ι → Type v) + [LinearOrder ι] [AddCommMonoid ι] [IsOrderedCancelAddMonoid ι] + [∀ i, AddCommMonoid (A i)] [DirectSum.GSemiring A] + +omit [IsOrderedCancelAddMonoid ι] in +theorem exists_grades_of_mul_apply_ne_zero {x y : DirectSum ι A} {k : ι} + (hk : (x * y) k ≠ 0) : + ∃ i j, x i ≠ 0 ∧ y j ≠ 0 ∧ i + j = k := by + classical + rw [DirectSum.mul_eq_sum_support_ghas_mul, DirectSum.sum_apply] at hk + obtain ⟨ij, hij, hterm⟩ := Finset.exists_ne_zero_of_sum_ne_zero hk + refine ⟨ij.1, ij.2, ?_, ?_, ?_⟩ + · exact DFinsupp.mem_support_iff.mp (Finset.mem_product.mp hij).1 + · exact DFinsupp.mem_support_iff.mp (Finset.mem_product.mp hij).2 + · by_contra hgrade + rw [DirectSum.of_eq_of_ne _ _ _ (Ne.symm hgrade)] at hterm + exact hterm rfl + +theorem leadingGrade_mul_le (x y : DirectSum ι A) : + leadingGrade A (x * y) ≤ leadingGrade A x + leadingGrade A y := by + classical + rw [leadingGrade] + apply Finset.max_le + intro k hk + obtain ⟨i, j, hi, hj, rfl⟩ := + exists_grades_of_mul_apply_ne_zero A (DFinsupp.mem_support_iff.mp hk) + rw [WithBot.coe_add] + exact add_le_add (grade_le_leadingGrade A hi) (grade_le_leadingGrade A hj) + +theorem mul_apply_add_eq_of_leadingGrade_eq {x y : DirectSum ι A} {m n : ι} + (hm : leadingGrade A x = m) (hn : leadingGrade A y = n) : + (x * y) (m + n) = GradedMonoid.GMul.mul (x m) (y n) := by + classical + rw [DirectSum.mul_eq_sum_support_ghas_mul, DirectSum.sum_apply] + let term : ι × ι → A (m + n) := fun ij ↦ + (DirectSum.of A (ij.1 + ij.2) + (GradedMonoid.GMul.mul (x ij.1) (y ij.2))) (m + n) + change (∑ ij ∈ x.support ×ˢ y.support, term ij) = _ + rw [Finset.sum_eq_single (f := term) (m, n)] + · simp [term] + · intro ij hij hne + by_cases hgrade : ij.1 + ij.2 = m + n + · exfalso + apply hne + apply Prod.ext + · change ij.1 = m + apply le_antisymm + · exact Finset.le_max_of_eq (Finset.mem_product.mp hij).1 hm + · apply le_of_not_gt + intro hmi + have hjn : ij.2 ≤ n := + Finset.le_max_of_eq (Finset.mem_product.mp hij).2 hn + exact (add_lt_add_of_lt_of_le hmi hjn).ne hgrade + · change ij.2 = n + apply le_antisymm + · exact Finset.le_max_of_eq (Finset.mem_product.mp hij).2 hn + · apply le_of_not_gt + intro hnj + have him : ij.1 ≤ m := + Finset.le_max_of_eq (Finset.mem_product.mp hij).1 hm + exact (add_lt_add_of_le_of_lt him hnj).ne hgrade + · simp [term, DirectSum.of_eq_of_ne _ _ _ (Ne.symm hgrade)] + · intro hnotmem + simp only [Finset.mem_product, not_and_or] at hnotmem + rcases hnotmem with hmnot | hnnot + · dsimp [term] + rw [DFinsupp.notMem_support_iff.mp hmnot] + rw [DirectSum.GNonUnitalNonAssocSemiring.zero_mul (A := A)] + simp + · dsimp [term] + rw [DFinsupp.notMem_support_iff.mp hnnot] + rw [DirectSum.GNonUnitalNonAssocSemiring.mul_zero (A := A)] + simp + +/-- Leading grade is multiplicative when nonzero homogeneous products remain nonzero. -/ +theorem leadingGrade_mul + (hmul : ∀ {i j} (a : A i) (b : A j), a ≠ 0 → b ≠ 0 → + GradedMonoid.GMul.mul a b ≠ 0) + (x y : DirectSum ι A) : + leadingGrade A (x * y) = leadingGrade A x + leadingGrade A y := by + by_cases hx : x = 0 + · subst x + simp [leadingGrade_zero] + by_cases hy : y = 0 + · subst y + simp [leadingGrade_zero] + obtain ⟨m, hm, hxm⟩ := exists_grade_eq_leadingGrade A hx + obtain ⟨n, hn, hyn⟩ := exists_grade_eq_leadingGrade A hy + apply le_antisymm + · exact leadingGrade_mul_le A x y + · rw [hm, hn, ← WithBot.coe_add] + apply grade_le_leadingGrade A + rw [mul_apply_add_eq_of_leadingGrade_eq A hm hn] + exact hmul (x m) (y n) hxm hyn + +end Multiplicative + +end DirectSum diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/TrailingGrade.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/TrailingGrade.lean new file mode 100644 index 0000000000..9317bdcb45 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/TrailingGrade.lean @@ -0,0 +1,191 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.DirectSum.Ring +public import Mathlib.Algebra.Order.Monoid.Unbundled.WithTop +public import Mathlib.Data.Finset.Max + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.LeadingGrade + +/-! +# Trailing grades in graded direct sums + +The trailing grade of a finitely supported graded sum is the smallest grade at which its component +is nonzero, with value top at zero. It satisfies the min-form addition inequality. + +For a graded ring whose nonzero homogeneous elements have nonzero product, trailing grade is +multiplicative. The proof isolates the unique contribution at the sum of the two trailing grades. +This is the minimum-grade counterpart of `DirectSum.leadingGrade`. +-/ + +universe u v + +public noncomputable section + +open scoped DirectSum + +namespace DirectSum + +section Additive + +variable {ι : Type u} (A : ι → Type v) + [LinearOrder ι] [∀ i, AddCommMonoid (A i)] + +/-- The smallest grade at which a graded direct-sum element has nonzero component. -/ +def trailingGrade (x : DirectSum ι A) : WithTop ι := by + classical + exact x.support.min + +@[simp] +theorem trailingGrade_zero : trailingGrade A 0 = ⊤ := by + classical + simp [trailingGrade] + +theorem trailingGrade_of {i : ι} {a : A i} (ha : a ≠ 0) : + trailingGrade A (DirectSum.of A i a) = i := by + classical + rw [trailingGrade, DirectSum.support_of i a ha, Finset.min_singleton] + +@[simp] +theorem trailingGrade_eq_top_iff (x : DirectSum ι A) : + trailingGrade A x = ⊤ ↔ x = 0 := by + classical + simp only [trailingGrade, Finset.min_eq_top, DFinsupp.support_eq_empty] + rfl + +theorem trailingGrade_le_grade {x : DirectSum ι A} {i : ι} (hi : x i ≠ 0) : + trailingGrade A x ≤ (i : WithTop ι) := by + classical + exact Finset.min_le (DFinsupp.mem_support_iff.mpr hi) + +theorem trailingGrade_eq_coe_iff (x : DirectSum ι A) (m : ι) : + trailingGrade A x = (m : WithTop ι) ↔ + x m ≠ 0 ∧ ∀ i, x i ≠ 0 → m ≤ i := by + classical + constructor + · intro h + have hm : m ∈ x.support := Finset.mem_of_min h + refine ⟨DFinsupp.mem_support_iff.mp hm, ?_⟩ + intro i hi + exact Finset.min_le_of_eq (DFinsupp.mem_support_iff.mpr hi) h + · rintro ⟨hm, hmin⟩ + apply le_antisymm + · exact Finset.min_le (DFinsupp.mem_support_iff.mpr hm) + · rw [trailingGrade] + apply Finset.le_min + intro i hi + exact WithTop.coe_le_coe.mpr (hmin i (DFinsupp.mem_support_iff.mp hi)) + +theorem min_le_trailingGrade_add (x y : DirectSum ι A) : + min (trailingGrade A x) (trailingGrade A y) ≤ trailingGrade A (x + y) := by + classical + rw [trailingGrade, trailingGrade, trailingGrade, ← Finset.min_union] + exact Finset.min_mono DFinsupp.support_add + +theorem exists_grade_eq_trailingGrade {x : DirectSum ι A} (hx : x ≠ 0) : + ∃ m : ι, trailingGrade A x = m ∧ x m ≠ 0 := by + classical + have hs : x.support.Nonempty := by + rw [Finset.nonempty_iff_ne_empty] + intro hs + apply hx + apply DirectSum.ext + intro i + apply DFinsupp.notMem_support_iff.mp + rw [hs] + simp + obtain ⟨m, hm⟩ := Finset.min_of_nonempty hs + exact ⟨m, hm, DFinsupp.mem_support_iff.mp (Finset.mem_of_min hm)⟩ + +end Additive + +section Multiplicative + +variable {ι : Type u} (A : ι → Type v) + [LinearOrder ι] [AddCommMonoid ι] [IsOrderedCancelAddMonoid ι] + [∀ i, AddCommMonoid (A i)] [DirectSum.GSemiring A] + +theorem le_trailingGrade_mul (x y : DirectSum ι A) : + trailingGrade A x + trailingGrade A y ≤ trailingGrade A (x * y) := by + classical + rw [trailingGrade] + apply Finset.le_min + intro k hk + obtain ⟨i, j, hi, hj, rfl⟩ := + exists_grades_of_mul_apply_ne_zero A (DFinsupp.mem_support_iff.mp hk) + rw [WithTop.coe_add] + exact add_le_add (trailingGrade_le_grade A hi) (trailingGrade_le_grade A hj) + +theorem mul_apply_add_eq_of_trailingGrade_eq {x y : DirectSum ι A} {m n : ι} + (hm : trailingGrade A x = m) (hn : trailingGrade A y = n) : + (x * y) (m + n) = GradedMonoid.GMul.mul (x m) (y n) := by + classical + rw [DirectSum.mul_eq_sum_support_ghas_mul, DirectSum.sum_apply] + let term : ι × ι → A (m + n) := fun ij ↦ + (DirectSum.of A (ij.1 + ij.2) + (GradedMonoid.GMul.mul (x ij.1) (y ij.2))) (m + n) + change (∑ ij ∈ x.support ×ˢ y.support, term ij) = _ + rw [Finset.sum_eq_single (f := term) (m, n)] + · simp [term] + · intro ij hij hne + by_cases hgrade : ij.1 + ij.2 = m + n + · exfalso + apply hne + apply Prod.ext + · change ij.1 = m + apply le_antisymm + · apply le_of_not_gt + intro hmi + have hnj : n ≤ ij.2 := + Finset.min_le_of_eq (Finset.mem_product.mp hij).2 hn + exact (add_lt_add_of_lt_of_le hmi hnj).ne hgrade.symm + · exact Finset.min_le_of_eq (Finset.mem_product.mp hij).1 hm + · change ij.2 = n + apply le_antisymm + · apply le_of_not_gt + intro hni + have hmi : m ≤ ij.1 := + Finset.min_le_of_eq (Finset.mem_product.mp hij).1 hm + exact (add_lt_add_of_le_of_lt hmi hni).ne hgrade.symm + · exact Finset.min_le_of_eq (Finset.mem_product.mp hij).2 hn + · simp [term, DirectSum.of_eq_of_ne _ _ _ (Ne.symm hgrade)] + · intro hnotmem + simp only [Finset.mem_product, not_and_or] at hnotmem + rcases hnotmem with hmnot | hnnot + · dsimp [term] + rw [DFinsupp.notMem_support_iff.mp hmnot] + rw [DirectSum.GNonUnitalNonAssocSemiring.zero_mul (A := A)] + simp + · dsimp [term] + rw [DFinsupp.notMem_support_iff.mp hnnot] + rw [DirectSum.GNonUnitalNonAssocSemiring.mul_zero (A := A)] + simp + +/-- Trailing grade is multiplicative when nonzero homogeneous products remain nonzero. -/ +theorem trailingGrade_mul + (hmul : ∀ {i j} (a : A i) (b : A j), a ≠ 0 → b ≠ 0 → + GradedMonoid.GMul.mul a b ≠ 0) + (x y : DirectSum ι A) : + trailingGrade A (x * y) = trailingGrade A x + trailingGrade A y := by + by_cases hx : x = 0 + · subst x + simp [trailingGrade_zero] + by_cases hy : y = 0 + · subst y + simp [trailingGrade_zero] + obtain ⟨m, hm, hxm⟩ := exists_grade_eq_trailingGrade A hx + obtain ⟨n, hn, hyn⟩ := exists_grade_eq_trailingGrade A hy + apply le_antisymm + · rw [hm, hn, ← WithTop.coe_add] + apply trailingGrade_le_grade A + rw [mul_apply_add_eq_of_trailingGrade_eq A hm hn] + exact hmul (x m) (y n) hxm hyn + · exact le_trailingGrade_mul A x y + +end Multiplicative + +end DirectSum diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility.lean new file mode 100644 index 0000000000..4cd29d99f7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility.lean @@ -0,0 +1,14 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.DenominatorIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.MaximalDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalProduct +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Tests + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/DenominatorIdeal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/DenominatorIdeal.lean new file mode 100644 index 0000000000..6879eab0e2 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/DenominatorIdeal.lean @@ -0,0 +1,171 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement +public import Mathlib.Algebra.Ring.Subring.Basic +public import Mathlib.RingTheory.Ideal.Defs + +import Mathlib.Tactic.FieldSimp +import Mathlib.Tactic.Ring + +/-! +# Denominator ideals and four-factor refinement + +For a subring `R` of a field and a field element `ξ`, the denominator ideal + +`I_ξ(R) = {x ∈ R | ξ * x ∈ R}` + +packages the possible denominators for `ξ`. Given two nonzero elements `x, y ∈ I_ξ(R)`, their +tautological rank-one equality + +`x * (ξ * y) = y * (ξ * x)` + +has a four-factor refinement in `R` exactly when `x` and `y` have a common divisor which still +belongs to `I_ξ(R)`. Consequently, a subring of a field has four-factor refinement exactly when +every pair in every denominator ideal has such a common divisor. This is the binary form of the +denominator-ideal criterion used by Zafrullah to characterize pre-Schreier domains. +-/ + +universe u + +public section + +namespace Subring + +variable {K : Type u} [Field K] + +/-- The elements of a subring whose product with `ξ` still lies in the subring. -/ +def denominatorIdeal (R : Subring K) (ξ : K) : Ideal R where + carrier := {x | ξ * (x : K) ∈ R} + zero_mem' := by simp + add_mem' {x y} hx hy := by + simpa [mul_add] using R.add_mem hx hy + smul_mem' c x hx := by + simpa [mul_assoc, mul_left_comm, mul_comm] using R.mul_mem c.2 hx + +@[simp] +theorem mem_denominatorIdeal_iff (R : Subring K) (ξ : K) (x : R) : + x ∈ denominatorIdeal R ξ ↔ ξ * (x : K) ∈ R := + Iff.rfl + +/-- Multiplication by the fraction defining a denominator ideal, with codomain restricted back to +the subring. -/ +def denominatorNumerator (R : Subring K) (ξ : K) (x : denominatorIdeal R ξ) : R := + ⟨ξ * (x : R), x.2⟩ + +@[simp] +theorem coe_denominatorNumerator (R : Subring K) (ξ : K) + (x : denominatorIdeal R ξ) : + (denominatorNumerator R ξ x : K) = ξ * (x : R) := + (rfl) + +/-- Two nonzero elements of a denominator ideal have a nonzero common divisor in that ideal +exactly when their associated rank-one equality has a four-factor refinement in the subring. -/ +theorem exists_common_divisor_denominatorIdeal_iff_exists_fourFactorRefinement + (R : Subring K) (ξ : K) (x y : denominatorIdeal R ξ) (hx : (x : R) ≠ 0) : + (∃ s : denominatorIdeal R ξ, + (s : R) ∣ (x : R) ∧ (s : R) ∣ (y : R)) ↔ + ∃ e f g h : R, + (x : R) = e * f ∧ denominatorNumerator R ξ y = g * h ∧ + (y : R) = e * g ∧ denominatorNumerator R ξ x = f * h := by + constructor + · rintro ⟨s, ⟨f, hxf⟩, ⟨g, hyg⟩⟩ + let h : R := denominatorNumerator R ξ s + refine ⟨s, f, g, h, hxf, ?_, hyg, ?_⟩ + · apply Subtype.ext + change ξ * (y : R) = (g : K) * (h : K) + rw [hyg] + change ξ * ((s : K) * g) = (g : K) * (ξ * s) + ring + · apply Subtype.ext + change ξ * (x : R) = (f : K) * (h : K) + rw [hxf] + change ξ * ((s : K) * f) = (f : K) * (ξ * s) + ring + · rintro ⟨e, f, g, h, hxf, _, hyg, hxh⟩ + have hf0 : (f : K) ≠ 0 := by + intro hf + apply hx + rw [hxf] + apply Subtype.ext + simp [hf] + have hxfK : (x : K) = (e : K) * f := congrArg Subtype.val hxf + have hxhK : ξ * (x : K) = (f : K) * h := congrArg Subtype.val hxh + have hξe : ξ * (e : K) = (h : K) := by + apply mul_right_cancel₀ hf0 + calc + (ξ * (e : K)) * f = ξ * ((e : K) * f) := by ring + _ = ξ * (x : K) := by rw [hxfK] + _ = (f : K) * h := hxhK + _ = (h : K) * f := by ring + let s : denominatorIdeal R ξ := + ⟨e, (mem_denominatorIdeal_iff R ξ e).2 (by rw [hξe]; exact h.2)⟩ + exact ⟨s, ⟨f, hxf⟩, ⟨g, hyg⟩⟩ + +/-- A subring of a field has four-factor refinement exactly when every pair in every denominator +ideal has a common divisor belonging to that denominator ideal. -/ +theorem hasFourFactorRefinement_iff_forall_denominatorIdeal_exists_common_divisor + (R : Subring K) : + HasFourFactorRefinement R ↔ + ∀ (ξ : K) (x y : denominatorIdeal R ξ), + ∃ s : denominatorIdeal R ξ, (s : R) ∣ (x : R) ∧ (s : R) ∣ (y : R) := by + constructor + · intro hR ξ x y + by_cases hx : (x : R) = 0 + · refine ⟨y, ⟨0, by simp [hx]⟩, ⟨1, by simp⟩⟩ + · apply + (exists_common_divisor_denominatorIdeal_iff_exists_fourFactorRefinement R ξ x y hx).2 + apply hR.refine + apply Subtype.ext + change (x : K) * (ξ * (y : R)) = (y : K) * (ξ * (x : R)) + ring + · intro h + apply hasFourFactorRefinement_def.mpr + intro a b c d habcd + by_cases hb : b = 0 + · subst b + have hcd : c * d = 0 := by simpa using habcd.symm + rcases eq_zero_or_eq_zero_of_mul_eq_zero hcd with hc | hd + · subst c + exact ⟨a, 1, 0, d, by simp⟩ + · subst d + exact ⟨1, a, c, 0, by simp⟩ + · have hbK : (b : K) ≠ 0 := fun h0 ↦ hb (Subtype.ext h0) + let ξ : K := (d : K) / b + have hξb : ξ * (b : K) = d := by + dsimp [ξ] + field_simp + have habcdK : (a : K) * b = (c : K) * d := congrArg Subtype.val habcd + have hξc : ξ * (c : K) = a := by + dsimp [ξ] + field_simp + simpa [mul_comm] using habcdK.symm + let x : denominatorIdeal R ξ := + ⟨b, (mem_denominatorIdeal_iff R ξ b).2 (by rw [hξb]; exact d.2)⟩ + let y : denominatorIdeal R ξ := + ⟨c, (mem_denominatorIdeal_iff R ξ c).2 (by rw [hξc]; exact a.2)⟩ + obtain ⟨s, hsx, hsy⟩ := h ξ x y + obtain ⟨e, f, g, k, hxef, hykg, hyeg, hxhk⟩ := + (exists_common_divisor_denominatorIdeal_iff_exists_fourFactorRefinement + R ξ x y (by exact hb)).1 ⟨s, hsx, hsy⟩ + have hnumx : denominatorNumerator R ξ x = d := by + apply Subtype.ext + exact hξb + have hnumy : denominatorNumerator R ξ y = a := by + apply Subtype.ext + exact hξc + refine ⟨g, k, e, f, ?_, hxef, ?_, ?_⟩ + · calc + a = denominatorNumerator R ξ y := hnumy.symm + _ = g * k := hykg + · simpa [mul_comm] using hyeg + · calc + d = denominatorNumerator R ξ x := hnumx.symm + _ = f * k := hxhk + _ = k * f := mul_comm _ _ + +end Subring diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/MaximalDivisor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/MaximalDivisor.lean new file mode 100644 index 0000000000..7c11f79e88 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/MaximalDivisor.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.GroupWithZero.Associated + +/-! +# Maximal divisors along a multiplicative map + +For a multiplicative map `f : D →* R`, an associate class `a : Associates D` is the maximal +divisor of `x : R` coming from `D` when `f q ∣ x` holds exactly for the elements `q : D` whose +associate classes divide `a`. + +The definition is invariant under multiplication by units in `D`. It supplies the common +divisibility interface later used for both the associated graded ring and the Hahn-series ring in +LM24. +-/ + +universe u v + +public section + +/-- `a` records exactly the divisors of `x` that arise through `f`. -/ +def IsMaximalDivisorAlong + {D : Type u} {R : Type v} + [CommMonoidWithZero D] + [CommMonoidWithZero R] + (f : D →* R) (x : R) (a : Associates D) : Prop := + ∀ q : D, Associates.mk q ≤ a ↔ f q ∣ x + +/-- The defining divisibility characterization of a maximal divisor along a map. -/ +theorem isMaximalDivisorAlong_iff + {D : Type u} {R : Type v} + [CommMonoidWithZero D] [IsCancelMulZero D] + [CommMonoidWithZero R] + (f : D →* R) (x : R) (a : Associates D) : + IsMaximalDivisorAlong f x a ↔ + ∀ q : D, Associates.mk q ≤ a ↔ f q ∣ x := + Iff.rfl + +namespace IsMaximalDivisorAlong + +variable {D : Type u} {R : Type v} +variable [CommMonoidWithZero D] [IsCancelMulZero D] +variable [CommMonoidWithZero R] +variable {f : D →* R} {x y : R} {a b c : Associates D} + +/-- Zero has zero as its maximal divisor class along every multiplicative map. -/ +theorem zero (f : D →* R) : IsMaximalDivisorAlong f 0 0 := by + rw [isMaximalDivisorAlong_iff] + intro q + constructor + · intro _ + exact dvd_zero _ + · intro _ + change Associates.mk q ≤ Associates.mk 0 + exact Associates.mk_le_mk_of_dvd (dvd_zero q) + +/-- The maximal-divisor property determines at most one associate class. -/ +theorem eq (ha : IsMaximalDivisorAlong f x a) + (hb : IsMaximalDivisorAlong f x b) : a = b := by + induction a using Quotient.inductionOn with + | _ p => + induction b using Quotient.inductionOn with + | _ q => + apply le_antisymm + · exact (hb p).2 ((ha p).1 le_rfl) + · exact (ha q).2 ((hb q).1 le_rfl) + +omit [IsCancelMulZero D] in +/-- Every representative of the maximal associate class divides the target after applying `f`. +-/ +theorem map_dvd_of_mk_eq (ha : IsMaximalDivisorAlong f x a) + {p : D} (hp : Associates.mk p = a) : f p ∣ x := by + exact (ha p).1 hp.le + +omit [IsCancelMulZero D] in +/-- Maximal divisor classes are supermultiplicative: the product of maximal divisors of two +elements divides every maximal divisor of their product. -/ +theorem mul_le (ha : IsMaximalDivisorAlong f x a) + (hb : IsMaximalDivisorAlong f y b) + (hc : IsMaximalDivisorAlong f (x * y) c) : a * b ≤ c := by + induction a using Quotient.inductionOn with + | _ p => + induction b using Quotient.inductionOn with + | _ q => + apply (hc (p * q)).2 + obtain ⟨x', hx⟩ := (ha p).1 le_rfl + obtain ⟨y', hy⟩ := (hb q).1 le_rfl + refine ⟨x' * y', ?_⟩ + rw [map_mul, hx, hy] + ac_rfl + +end IsMaximalDivisorAlong diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/PrimalPreimage.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/PrimalPreimage.lean new file mode 100644 index 0000000000..07a0ccf19e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/PrimalPreimage.lean @@ -0,0 +1,802 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement +public import Mathlib.Algebra.Algebra.Subalgebra.Basic +public import Mathlib.Algebra.Ring.Subring.Basic +public import Mathlib.Algebra.Field.Subfield.Basic +public import Mathlib.Algebra.GroupWithZero.Divisibility +import Mathlib.Tactic.Ring +import Mathlib.Tactic.FieldSimp +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Primality in a ring cut out by a residue condition + +Let `L` be a field, `A` a commutative `L`-algebra that is a domain, and `π : A →ₐ[L] L` a +retraction of the structure map. For a subring `S ⊆ L`, the elements of `A` whose residue under +`π` lies in `S` form a subring `π ⁻¹ S`. This file decides when an element of that subring is +primal in it, in terms of primality of its residue in `S` and primality of the element in `A`. + +The application is `𝐙 + 𝐊((𝐆^{<0}))`, which is exactly the preimage of `𝐙` under the +coefficient-at-zero map on `𝐊((𝐆^{≤0}))`; that map is a ring hom because `x + y = 0` with +`x, y ≤ 0` forces `x = y = 0`. + +The statement is LM24, Lemma 9.2.1, and the proof follows theirs with two repairs the printed +argument needs. It concludes `e = f * g` from `b * e = b * (f * g)`, which requires cancellation, +so `A` is assumed to be a domain and `b = 0` is treated separately. And both left-to-right +directions invoke primality in `π ⁻¹ S` at a product whose quotient need not have residue in `S`: +at `π b ≠ 0` the residue can be `1 / π b`, and at `π b = 0` it can be any element of `Frac S`. In +each case a scalar is cleared before primality is invoked and undone afterwards. The rescaling +parameter `η` must also be chosen nonzero, in `L` for the first case and in `Frac S` for the +second. +-/ + +universe u v + +public section + +variable {L A : Type*} [Field L] [CommRing A] [Algebra L A] + +/-- Primality is invariant under a ring equivalence. -/ +theorem RingEquiv.isPrimal_iff {B : Type*} [CommRing B] + (e : A ≃+* B) (a : A) : IsPrimal (e a) ↔ IsPrimal a := by + constructor + · intro h b c hdvd + have hdvd' : e a ∣ e b * e c := by simpa using e.map_dvd hdvd + obtain ⟨a₁, a₂, h₁, h₂, ha⟩ := h hdvd' + refine ⟨e.symm a₁, e.symm a₂, ?_, ?_, ?_⟩ + · simpa using e.symm.map_dvd h₁ + · simpa using e.symm.map_dvd h₂ + · apply e.injective + simp [ha] + · intro h b c hdvd + have hdvd' : a ∣ e.symm b * e.symm c := by simpa using e.symm.map_dvd hdvd + obtain ⟨a₁, a₂, h₁, h₂, ha⟩ := h hdvd' + refine ⟨e a₁, e a₂, ?_, ?_, ?_⟩ + · simpa using e.map_dvd h₁ + · simpa using e.map_dvd h₂ + · simp [ha] + +namespace Subring + +/-- `π ⁻¹ S`, as a subring of `A`. -/ +abbrev residueSubring (π : A →ₐ[L] L) (S : Subring L) : Subring A := S.comap (π : A →+* L) + +/-- `Frac S`, realised as a subring of the ambient field `L`. -/ +abbrev fracSubring (S : Subring L) : Subring L := (Subfield.closure (S : Set L)).toSubring + +variable {π : A →ₐ[L] L} {S : Subring L} + +theorem mem_residueSubring {b : A} : b ∈ residueSubring π S ↔ π b ∈ S := (Iff.rfl) + +theorem le_fracSubring : S ≤ fracSubring S := fun _ hx ↦ Subfield.subset_closure hx + +theorem residueSubring_le_fracSubring : residueSubring π S ≤ residueSubring π (fracSubring S) := + fun _ hx ↦ le_fracSubring hx + +/-- Every element of `Frac S` has a denominator in `S`. -/ +theorem exists_den {x : L} (hx : x ∈ fracSubring S) : + ∃ s ∈ S, s ≠ 0 ∧ s * x ∈ S := by + obtain ⟨y, hy, z, hz, rfl⟩ := Subfield.mem_closure_iff.mp hx + rw [Subring.closure_eq] at hy hz + rcases eq_or_ne z 0 with rfl | hz0 + · exact ⟨1, S.one_mem, one_ne_zero, by simp⟩ + · exact ⟨z, hz, hz0, by rw [mul_div_cancel₀ _ hz0]; exact hy⟩ + +theorem inv_mem_fracSubring {x : L} (hx : x ∈ fracSubring S) : x⁻¹ ∈ fracSubring S := + Subfield.inv_mem _ hx + +/-- Divisibility inside `π ⁻¹ S`, unfolded to the ambient algebra. -/ +theorem dvd_residueSubring_iff {x y : residueSubring π S} : + x ∣ y ↔ ∃ z : A, π z ∈ S ∧ (y : A) = x * z := by + constructor + · rintro ⟨z, rfl⟩; exact ⟨z, z.2, rfl⟩ + · rintro ⟨z, hz, h⟩; exact ⟨⟨z, hz⟩, Subtype.ext h⟩ + +/-! ### Normalising a factor so that its residue is `0` or `1` -/ + +open scoped Classical in +/-- The scalar used to normalise `c`; always nonzero. -/ +noncomputable def scale (π : A →ₐ[L] L) (c : A) : L := if π c = 0 then 1 else π c + +theorem scale_ne_zero (π : A →ₐ[L] L) (c : A) : scale π c ≠ 0 := by + unfold scale; split <;> simp_all + +open scoped Classical in +theorem mem_scale_frac (π : A →ₐ[L] L) {c : A} (hc : π c ∈ fracSubring S) : + scale π c ∈ fracSubring S := by + unfold scale; split + · exact (fracSubring S).one_mem + · exact hc + +/-- `c` with its residue normalised to `0` or `1`. -/ +noncomputable def nrm (π : A →ₐ[L] L) (c : A) : A := c * algebraMap L A (scale π c)⁻¹ + +open scoped Classical in +theorem pi_nrm (π : A →ₐ[L] L) (c : A) : π (nrm π c) = if π c = 0 then 0 else 1 := by + unfold nrm scale + rw [map_mul, π.commutes] + split <;> simp_all + +open scoped Classical in +theorem pi_nrm_mem (π : A →ₐ[L] L) (c : A) : π (nrm π c) ∈ S := by + rw [pi_nrm]; split + · exact S.zero_mem + · exact S.one_mem + +theorem nrm_mul_scale (π : A →ₐ[L] L) (c : A) : + nrm π c * algebraMap L A (scale π c) = c := by + unfold nrm + rw [mul_assoc, ← map_mul, inv_mul_cancel₀ (scale_ne_zero π c), map_one, mul_one] + + + +/-! ### The residue map on `π ⁻¹ S` -/ + +/-- `π` restricted to `π ⁻¹ S`, as a ring map onto `S`. -/ +def residueHom (π : A →ₐ[L] L) (S : Subring L) : residueSubring π S →+* S where + toFun x := ⟨π x, x.2⟩ + map_one' := Subtype.ext (map_one π) + map_mul' _ _ := Subtype.ext (map_mul π _ _) + map_zero' := Subtype.ext (map_zero π) + map_add' _ _ := Subtype.ext (map_add π _ _) + +@[simp] theorem coe_residueHom (x : residueSubring π S) : ((residueHom π S x : S) : L) = π x := + (rfl) + +/-! ### Lemma 9.2.1, case `π b ≠ 0` -/ + +variable [IsDomain A] + +/-- Suppose `p` is nonzero, has image zero under `π`, and cannot be factored into two elements +whose images are both zero. If `p` is primal in `π ⁻¹ S`, then `L` is the fraction field of +`S`. -/ +@[blueprint "lem:primal-zero-residue-fraction-field" + (phase := "Algebraic and ordinal preliminaries") + (title := "A primal zero-residue element forces the fraction-field condition") + (statement := /-- + Let $L$ be a field, let $A$ be a domain and an $L$-algebra, and let + $\pi:A\to L$ be an $L$-algebra retraction. Let $S\subseteq L$ be a + subring. Suppose that $p\in A$ is nonzero, $\pi(p)=0$, and every + factorisation $p=ab$ has $\pi(a)\ne0$ or $\pi(b)\ne0$. If $p$ is + primal in $\pi^{-1}(S)$, then $L$ is the fraction field of $S$. + -/) + (proof := /-- + Fix $x\in L^\times$. In $\pi^{-1}(S)$, primality of $p$ applied to + \[ + (xp)(x^{-1}p)=p^2 + \] + gives a factorisation $p=p_1p_2$ with $p_1\mid xp$ and + $p_2\mid x^{-1}p$. At least one of $\pi(p_1)$ and $\pi(p_2)$ is + nonzero. Cancelling $p$ from the corresponding divisibility equation + expresses $x$ as a quotient of two nonzero residues of elements of + $\pi^{-1}(S)$. Both residues lie in $S$, so $x\in\operatorname{Frac}(S)$. + The case $x=0$ is immediate. + -/)] +theorem fracSubring_eq_top_of_isPrimal_of_residue_eq_zero + {p : A} (hpπ : π p = 0) (hp0 : p ≠ 0) + (hfactor : ∀ a b : A, p = a * b → π a ≠ 0 ∨ π b ≠ 0) + (hp : IsPrimal (⟨p, by simp [hpπ]⟩ : residueSubring π S)) : + fracSubring S = ⊤ := by + apply top_unique + intro x _ + rcases eq_or_ne x 0 with rfl | hx + · exact (fracSubring S).zero_mem + let P : residueSubring π S := ⟨p, by simp [hpπ]⟩ + let C : residueSubring π S := + ⟨algebraMap L A x * p, by + rw [mem_residueSubring, map_mul, AlgHom.commutes, hpπ, mul_zero] + exact S.zero_mem⟩ + let D : residueSubring π S := + ⟨algebraMap L A x⁻¹ * p, by + rw [mem_residueSubring, map_mul, AlgHom.commutes, hpπ, mul_zero] + exact S.zero_mem⟩ + have hdiv : P ∣ C * D := by + refine ⟨P, Subtype.ext ?_⟩ + change algebraMap L A x * p * (algebraMap L A x⁻¹ * p) = p * p + rw [show algebraMap L A x * p * (algebraMap L A x⁻¹ * p) = + algebraMap L A (x * x⁻¹) * (p * p) by rw [map_mul]; ring, + mul_inv_cancel₀ hx, map_one, one_mul] + obtain ⟨p₁, p₂, hp₁, hp₂, hprod⟩ := hp hdiv + have hprodA : p = (p₁ : A) * p₂ := congrArg Subtype.val hprod + rcases hfactor p₁ p₂ hprodA with hp₁res | hp₂res + · obtain ⟨q, hq⟩ := hp₂ + have hDA : algebraMap L A x⁻¹ * p = (p₂ : A) * q := congrArg Subtype.val hq + have hcancel : p * (algebraMap L A x⁻¹ * (p₁ : A)) = p * (q : A) := by + calc + p * (algebraMap L A x⁻¹ * (p₁ : A)) = + (p₁ : A) * (algebraMap L A x⁻¹ * p) := by ring + _ = (p₁ : A) * ((p₂ : A) * q) := by rw [hDA] + _ = p * q := by rw [hprodA]; ring + have hscalar : algebraMap L A x⁻¹ * (p₁ : A) = q := + mul_left_cancel₀ hp0 hcancel + have hres : x⁻¹ * π (p₁ : A) = π (q : A) := by + simpa using congrArg π hscalar + have hqres : π (q : A) ≠ 0 := by + rw [← hres] + exact mul_ne_zero (inv_ne_zero hx) hp₁res + have hratio : x = π (p₁ : A) * (π (q : A))⁻¹ := by rw [← hres]; field_simp + rw [hratio] + exact (fracSubring S).mul_mem (le_fracSubring p₁.2) + (inv_mem_fracSubring (le_fracSubring q.2)) + · obtain ⟨q, hq⟩ := hp₁ + have hCA : algebraMap L A x * p = (p₁ : A) * q := congrArg Subtype.val hq + have hcancel : p * (algebraMap L A x * (p₂ : A)) = p * (q : A) := by + calc + p * (algebraMap L A x * (p₂ : A)) = + (p₂ : A) * (algebraMap L A x * p) := by ring + _ = (p₂ : A) * ((p₁ : A) * q) := by rw [hCA] + _ = p * q := by rw [hprodA]; ring + have hscalar : algebraMap L A x * (p₂ : A) = q := + mul_left_cancel₀ hp0 hcancel + have hres : x * π (p₂ : A) = π (q : A) := by + simpa using congrArg π hscalar + have hratio : x = π (q : A) * (π (p₂ : A))⁻¹ := by rw [← hres]; field_simp + rw [hratio] + exact (fracSubring S).mul_mem (le_fracSubring q.2) + (inv_mem_fracSubring (le_fracSubring p₂.2)) + +/-- Suppose `p` maps to an irreducible element under `φ`, and every element whose image under +`φ` is a unit has nonzero image under `π`. If `p` has image zero under `π` and is primal in +`π ⁻¹ S`, then `L` is the fraction field of `S`. -/ +theorem fracSubring_eq_top_of_isPrimal_of_irreducible_map + {B : Type*} [CommRing B] (phi : A →+* B) {p : A} + (hpπ : π p = 0) (hpIrr : Irreducible (phi p)) + (hunit : ∀ a : A, IsUnit (phi a) → π a ≠ 0) + (hp : IsPrimal (⟨p, by simp [hpπ]⟩ : residueSubring π S)) : + fracSubring S = ⊤ := by + apply fracSubring_eq_top_of_isPrimal_of_residue_eq_zero hpπ + (fun hp0 ↦ hpIrr.ne_zero (by simp [hp0])) + · intro a b hab + have hmap : phi p = phi a * phi b := by simpa only [map_mul] using congrArg phi hab + rcases hpIrr.isUnit_or_isUnit hmap with ha | hb + · exact Or.inl (hunit a ha) + · exact Or.inr (hunit b hb) + · exact hp + +omit [IsDomain A] in +/-- Forward, first half: the residue of a primal element is primal in `S`. -/ +theorem isPrimal_residue_of_isPrimal {b : A} (hb : π b ∈ S) + (h : IsPrimal (⟨b, hb⟩ : residueSubring π S)) (hb0 : π b ≠ 0) : + IsPrimal (⟨π b, hb⟩ : S) := by + rintro ⟨c, hc⟩ ⟨d, hd⟩ ⟨⟨e, he⟩, hcd⟩ + have hcd' : c * d = π b * e := congrArg Subtype.val hcd + have hce : c * d * (π b)⁻¹ = e := by rw [hcd']; field_simp + set b' : A := b * algebraMap L A (π b)⁻¹ with hb' + have hpb' : π b' = 1 := by simp [hb', mul_inv_cancel₀ hb0] + have hmem1 : π (algebraMap L A c) ∈ S := by simpa using hc + have hmem2 : π (algebraMap L A d * b') ∈ S := by simpa [hpb'] using hd + have hmem3 : π (algebraMap L A e) ∈ S := by simpa using he + have key : (⟨b, hb⟩ : residueSubring π S) + ∣ ⟨algebraMap L A c, hmem1⟩ * ⟨algebraMap L A d * b', hmem2⟩ := by + refine ⟨⟨algebraMap L A e, hmem3⟩, Subtype.ext ?_⟩ + change algebraMap L A c * (algebraMap L A d * b') = b * algebraMap L A e + calc algebraMap L A c * (algebraMap L A d * b') + = algebraMap L A (c * d * (π b)⁻¹) * b := by rw [hb', map_mul, map_mul]; ring + _ = b * algebraMap L A e := by rw [hce]; ring + obtain ⟨b₁, b₂, h₁, h₂, hprod⟩ := h key + refine ⟨residueHom π S b₁, residueHom π S b₂, ?_, ?_, ?_⟩ + · simpa [residueHom, Subtype.ext_iff] using map_dvd (residueHom π S) h₁ + · simpa [residueHom, Subtype.ext_iff, hpb'] using map_dvd (residueHom π S) h₂ + · simpa [residueHom, Subtype.ext_iff] using congrArg (residueHom π S) hprod + +omit [IsDomain A] in +/-- Forward, second half: a primal element of `π ⁻¹ S` is primal in the ambient algebra. + +This is where the printed proof invokes primality in `π ⁻¹ S` at a product whose quotient can +have residue `1 / π b ∉ S`. Scaling one normalised factor by `π b` first repairs it. -/ +theorem isPrimal_of_isPrimal_residueSubring {b : A} (hb : π b ∈ S) + (h : IsPrimal (⟨b, hb⟩ : residueSubring π S)) (hb0 : π b ≠ 0) : + IsPrimal b := by + intro c d ⟨e, hcd⟩ + set σ : L := scale π c * scale π d with hσ + have hσ0 : σ ≠ 0 := mul_ne_zero (scale_ne_zero π c) (scale_ne_zero π d) + -- normalise both factors, then scale the first by `π b` + have hc : nrm π c * algebraMap L A (scale π c) = c := nrm_mul_scale π c + have hd : nrm π d * algebraMap L A (scale π d) = d := nrm_mul_scale π d + have hsplit : nrm π c * nrm π d = b * (e * algebraMap L A σ⁻¹) := by + have : (nrm π c * nrm π d) * algebraMap L A σ = c * d := by + rw [hσ, map_mul] + calc (nrm π c * nrm π d) + * (algebraMap L A (scale π c) * algebraMap L A (scale π d)) + = (nrm π c * algebraMap L A (scale π c)) + * (nrm π d * algebraMap L A (scale π d)) := by ring + _ = c * d := by rw [hc, hd] + calc nrm π c * nrm π d = (nrm π c * nrm π d) * algebraMap L A σ * algebraMap L A σ⁻¹ := by + rw [mul_assoc, ← map_mul, mul_inv_cancel₀ hσ0, map_one, mul_one] + _ = b * (e * algebraMap L A σ⁻¹) := by rw [this, hcd]; ring + set w : A := e * algebraMap L A (σ⁻¹ * π b) with hw + have hres : π w = π (nrm π c) * π (nrm π d) := by + have h2 := congrArg π hsplit + simp only [map_mul, AlgHom.commutes, Algebra.algebraMap_self, RingHom.id_apply] at h2 + rw [hw] + simp only [map_mul, AlgHom.commutes, Algebra.algebraMap_self, RingHom.id_apply] + rw [h2]; ring + have hmemc : π (nrm π c * algebraMap L A (π b)) ∈ S := by + rw [map_mul] + exact S.mul_mem (pi_nrm_mem π c) (by simpa using hb) + have hmemd : π (nrm π d) ∈ S := pi_nrm_mem π d + have hmemw : π w ∈ S := by rw [hres]; exact S.mul_mem (pi_nrm_mem π c) (pi_nrm_mem π d) + have key : (⟨b, hb⟩ : residueSubring π S) + ∣ ⟨nrm π c * algebraMap L A (π b), hmemc⟩ * ⟨nrm π d, hmemd⟩ := by + refine ⟨⟨w, hmemw⟩, Subtype.ext ?_⟩ + change nrm π c * algebraMap L A (π b) * nrm π d = b * w + calc nrm π c * algebraMap L A (π b) * nrm π d + = (nrm π c * nrm π d) * algebraMap L A (π b) := by ring + _ = (b * (e * algebraMap L A σ⁻¹)) * algebraMap L A (π b) := by rw [hsplit] + _ = b * (e * algebraMap L A (σ⁻¹ * π b)) := by rw [map_mul]; ring + _ = b * w := by rw [hw] + obtain ⟨b₁, b₂, h₁, h₂, hprod⟩ := h key + refine ⟨(b₁ : A), (b₂ : A), ?_, ?_, ?_⟩ + · obtain ⟨u, hu⟩ := h₁ + refine ⟨(u : A) * algebraMap L A (scale π c * (π b)⁻¹), ?_⟩ + have hu' : nrm π c * algebraMap L A (π b) = (b₁ : A) * u := congrArg Subtype.val hu + calc c = nrm π c * algebraMap L A (scale π c) := hc.symm + _ = (nrm π c * algebraMap L A (π b)) * algebraMap L A (scale π c * (π b)⁻¹) := by + rw [map_mul] + calc nrm π c * algebraMap L A (scale π c) + = nrm π c * algebraMap L A (scale π c) * algebraMap L A (π b * (π b)⁻¹) := by + rw [mul_inv_cancel₀ hb0, map_one, mul_one] + _ = nrm π c * algebraMap L A (π b) + * (algebraMap L A (scale π c) * algebraMap L A (π b)⁻¹) := by + rw [map_mul]; ring + _ = (b₁ : A) * ((u : A) * algebraMap L A (scale π c * (π b)⁻¹)) := by rw [hu']; ring + · obtain ⟨u, hu⟩ := h₂ + refine ⟨(u : A) * algebraMap L A (scale π d), ?_⟩ + have hu' : nrm π d = (b₂ : A) * u := congrArg Subtype.val hu + calc d = nrm π d * algebraMap L A (scale π d) := hd.symm + _ = (b₂ : A) * ((u : A) * algebraMap L A (scale π d)) := by rw [hu']; ring + · exact congrArg Subtype.val hprod + +/-- Converse, case `π b ≠ 0`: primal residue plus primal in the ambient algebra gives primal +in `π ⁻¹ S`. The rescaling parameter `η` must be a nonzero element of `L`; it need not lie in +`S`. -/ +theorem isPrimal_residueSubring_of_isPrimal {b : A} (hb : π b ∈ S) (hb0 : π b ≠ 0) + (hS : IsPrimal (⟨π b, hb⟩ : S)) (hA : IsPrimal b) : + IsPrimal (⟨b, hb⟩ : residueSubring π S) := by + have hbne : b ≠ 0 := fun h ↦ hb0 (by rw [h, map_zero]) + rintro c d ⟨e, hcde⟩ + have hcd : (c : A) * d = b * e := congrArg Subtype.val hcde + obtain ⟨b₁, b₂, ⟨f, hf⟩, ⟨g, hg⟩, hprod⟩ := hA (Dvd.intro _ hcd.symm) + -- cancellation, available because `A` is a domain and `b ≠ 0` + have hefg : (e : A) = f * g := by + have : b * (e : A) = b * (f * g) := by rw [← hcd, hf, hg, hprod]; ring + exact mul_left_cancel₀ hbne this + have hpb : π b = π b₁ * π b₂ := by rw [hprod, map_mul] + have hb₁0 : π b₁ ≠ 0 := fun h ↦ hb0 (by rw [hpb, h, zero_mul]) + have hb₂0 : π b₂ ≠ 0 := fun h ↦ hb0 (by rw [hpb, h, mul_zero]) + -- factor the residue in `S` + have hdvdS : (⟨π b, hb⟩ : S) ∣ (⟨π c, c.2⟩ : S) * ⟨π d, d.2⟩ := by + refine ⟨⟨π e, e.2⟩, Subtype.ext ?_⟩ + change π c * π d = π b * π e + rw [← map_mul, ← map_mul, hcd] + obtain ⟨⟨b₁', hb₁'⟩, ⟨b₂', hb₂'⟩, ⟨⟨s, hs⟩, hsc⟩, ⟨⟨u, hu⟩, huc⟩, hprod'⟩ := hS hdvdS + have hbb : π b = b₁' * b₂' := congrArg Subtype.val hprod' + have hcs : π c = b₁' * s := congrArg Subtype.val hsc + have hdu : π d = b₂' * u := congrArg Subtype.val huc + have hb₁'0 : b₁' ≠ 0 := fun h ↦ hb0 (by rw [hbb, h, zero_mul]) + have hb₂'0 : b₂' ≠ 0 := fun h ↦ hb0 (by rw [hbb, h, mul_zero]) + set η : L := π b₁ * b₁'⁻¹ with hη + have hη0 : η ≠ 0 := mul_ne_zero hb₁0 (inv_ne_zero hb₁'0) + -- the four rescaled factors and their residues + have e₁ : π (b₁ * algebraMap L A η⁻¹) = b₁' := by + simp only [map_mul, AlgHom.commutes, Algebra.algebraMap_self, RingHom.id_apply, hη] + field_simp + have e₂ : π (b₂ * algebraMap L A η) = b₂' := by + simp only [map_mul, AlgHom.commutes, Algebra.algebraMap_self, RingHom.id_apply, hη] + have : π b₂ * (π b₁ * b₁'⁻¹) = (π b₁ * π b₂) * b₁'⁻¹ := by ring + rw [this, ← hpb, hbb]; field_simp + have e₃ : π (f * algebraMap L A η) = s := by + have hpc : π c = π b₁ * π f := by rw [hf, map_mul] + simp only [map_mul, AlgHom.commutes, Algebra.algebraMap_self, RingHom.id_apply, hη] + have : π f * (π b₁ * b₁'⁻¹) = (π b₁ * π f) * b₁'⁻¹ := by ring + rw [this, ← hpc, hcs]; field_simp + have hηinv : η⁻¹ = b₁' * (π b₁)⁻¹ := by rw [hη]; field_simp + have e₄ : π (g * algebraMap L A η⁻¹) = u := by + have hpd : π b₂ * π g = π d := by rw [hg, map_mul] + simp only [map_mul, AlgHom.commutes, Algebra.algebraMap_self, RingHom.id_apply, hηinv] + apply mul_right_cancel₀ (mul_ne_zero hb₁0 hb₂0) + have h5 : π g * (b₁' * (π b₁)⁻¹) * (π b₁ * π b₂) = (π b₂ * π g) * b₁' := by + field_simp + rw [h5, hpd, hdu, show u * (π b₁ * π b₂) = u * π b by rw [hpb], hbb] + ring + refine ⟨⟨b₁ * algebraMap L A η⁻¹, mem_residueSubring.mpr (by rw [e₁]; exact hb₁')⟩, + ⟨b₂ * algebraMap L A η, mem_residueSubring.mpr (by rw [e₂]; exact hb₂')⟩, ?_, ?_, ?_⟩ + · exact ⟨⟨f * algebraMap L A η, mem_residueSubring.mpr (by rw [e₃]; exact hs)⟩, Subtype.ext (by + change (c : A) = b₁ * algebraMap L A η⁻¹ * (f * algebraMap L A η) + rw [hf, show b₁ * algebraMap L A η⁻¹ * (f * algebraMap L A η) + = b₁ * f * (algebraMap L A η⁻¹ * algebraMap L A η) by ring, ← map_mul, + inv_mul_cancel₀ hη0, map_one, mul_one])⟩ + · exact ⟨⟨g * algebraMap L A η⁻¹, mem_residueSubring.mpr (by rw [e₄]; exact hu)⟩, Subtype.ext (by + change (d : A) = b₂ * algebraMap L A η * (g * algebraMap L A η⁻¹) + rw [hg, show b₂ * algebraMap L A η * (g * algebraMap L A η⁻¹) + = b₂ * g * (algebraMap L A η * algebraMap L A η⁻¹) by ring, ← map_mul, + mul_inv_cancel₀ hη0, map_one, mul_one])⟩ + · refine Subtype.ext ?_ + change b = b₁ * algebraMap L A η⁻¹ * (b₂ * algebraMap L A η) + rw [hprod, show b₁ * algebraMap L A η⁻¹ * (b₂ * algebraMap L A η) + = b₁ * b₂ * (algebraMap L A η⁻¹ * algebraMap L A η) by ring, ← map_mul, + inv_mul_cancel₀ hη0, map_one, mul_one] + +/-! ### Lemma 9.2.1, case `π b = 0` -/ + +omit [IsDomain A] in +/-- Forward, case `π b = 0`. The printed proof invokes primality in `π ⁻¹ S` at a product whose +quotient can have residue anywhere in `Frac S`; clearing a denominator first repairs it. Since a +normalised residue is `0` or `1`, the denominator may be attached to either factor. -/ +theorem isPrimal_fracSubring_of_isPrimal_residueSubring {b : A} (hb : π b ∈ S) + (h : IsPrimal (⟨b, hb⟩ : residueSubring π S)) : + IsPrimal (⟨b, le_fracSubring hb⟩ : residueSubring π (fracSubring S)) := by + rintro c d ⟨e, hcde⟩ + have hcd : (c : A) * d = b * e := congrArg Subtype.val hcde + set σ : L := scale π c * scale π d with hσ + have hσ0 : σ ≠ 0 := mul_ne_zero (scale_ne_zero π (c : A)) (scale_ne_zero π (d : A)) + have hc : nrm π (c : A) * algebraMap L A (scale π (c : A)) = (c : A) := nrm_mul_scale π _ + have hd : nrm π (d : A) * algebraMap L A (scale π (d : A)) = (d : A) := nrm_mul_scale π _ + have hsplit : nrm π (c : A) * nrm π (d : A) = b * ((e : A) * algebraMap L A σ⁻¹) := by + have h1 : (nrm π (c : A) * nrm π (d : A)) * algebraMap L A σ = (c : A) * d := by + rw [hσ, map_mul] + calc (nrm π (c : A) * nrm π (d : A)) + * (algebraMap L A (scale π (c : A)) * algebraMap L A (scale π (d : A))) + = (nrm π (c : A) * algebraMap L A (scale π (c : A))) + * (nrm π (d : A) * algebraMap L A (scale π (d : A))) := by ring + _ = (c : A) * d := by rw [hc, hd] + calc nrm π (c : A) * nrm π (d : A) + = (nrm π (c : A) * nrm π (d : A)) * algebraMap L A σ * algebraMap L A σ⁻¹ := by + rw [mul_assoc, ← map_mul, mul_inv_cancel₀ hσ0, map_one, mul_one] + _ = b * ((e : A) * algebraMap L A σ⁻¹) := by rw [h1, hcd]; ring + -- the quotient's residue lies in `Frac S`; clear its denominator + set w : A := (e : A) * algebraMap L A σ⁻¹ with hw + have hwF : π w ∈ fracSubring S := by + rw [hw, map_mul, AlgHom.commutes] + exact (fracSubring S).mul_mem e.2 + (inv_mem_fracSubring (mul_mem (mem_scale_frac π c.2) (mem_scale_frac π d.2))) + obtain ⟨s, hs, hs0, hsw⟩ := exists_den hwF + have hmemc : π (nrm π (c : A) * algebraMap L A s) ∈ S := by + rw [map_mul, AlgHom.commutes] + exact S.mul_mem (pi_nrm_mem π _) hs + have hmemd : π (nrm π (d : A)) ∈ S := pi_nrm_mem π _ + have hmemw : π (w * algebraMap L A s) ∈ S := by + rw [map_mul, AlgHom.commutes, mul_comm]; exact hsw + have key : (⟨b, hb⟩ : residueSubring π S) + ∣ ⟨nrm π (c : A) * algebraMap L A s, hmemc⟩ * ⟨nrm π (d : A), hmemd⟩ := by + refine ⟨⟨w * algebraMap L A s, hmemw⟩, Subtype.ext ?_⟩ + change nrm π (c : A) * algebraMap L A s * nrm π (d : A) = b * (w * algebraMap L A s) + calc nrm π (c : A) * algebraMap L A s * nrm π (d : A) + = (nrm π (c : A) * nrm π (d : A)) * algebraMap L A s := by ring + _ = (b * w) * algebraMap L A s := by rw [hsplit, hw] + _ = b * (w * algebraMap L A s) := by ring + obtain ⟨b₁, b₂, ⟨v, hv⟩, ⟨u, hu⟩, hprod⟩ := h key + have hv' : nrm π (c : A) * algebraMap L A s = (b₁ : A) * v := congrArg Subtype.val hv + have hu' : nrm π (d : A) = (b₂ : A) * u := congrArg Subtype.val hu + refine ⟨⟨(b₁ : A), le_fracSubring b₁.2⟩, ⟨(b₂ : A), le_fracSubring b₂.2⟩, ?_, ?_, ?_⟩ + · refine ⟨⟨(v : A) * algebraMap L A (s⁻¹ * scale π (c : A)), ?_⟩, Subtype.ext ?_⟩ + · rw [mem_residueSubring, map_mul, AlgHom.commutes] + exact (fracSubring S).mul_mem (le_fracSubring v.2) + ((fracSubring S).mul_mem + (inv_mem_fracSubring (le_fracSubring hs)) (mem_scale_frac π c.2)) + · change (c : A) = (b₁ : A) * ((v : A) * algebraMap L A (s⁻¹ * scale π (c : A))) + have hs' : algebraMap L A s * algebraMap L A s⁻¹ = 1 := by + rw [← map_mul, mul_inv_cancel₀ hs0, map_one] + calc (c : A) = nrm π (c : A) * algebraMap L A (scale π (c : A)) := hc.symm + _ = (nrm π (c : A) * algebraMap L A s) + * (algebraMap L A s⁻¹ * algebraMap L A (scale π (c : A))) := by + rw [show nrm π (c : A) * algebraMap L A s + * (algebraMap L A s⁻¹ * algebraMap L A (scale π (c : A))) + = nrm π (c : A) * algebraMap L A (scale π (c : A)) + * (algebraMap L A s * algebraMap L A s⁻¹) by ring, hs', mul_one] + _ = (b₁ : A) * ((v : A) * algebraMap L A (s⁻¹ * scale π (c : A))) := by + rw [hv', map_mul]; ring + · refine ⟨⟨(u : A) * algebraMap L A (scale π (d : A)), ?_⟩, Subtype.ext ?_⟩ + · rw [mem_residueSubring, map_mul, AlgHom.commutes] + exact (fracSubring S).mul_mem (le_fracSubring u.2) (mem_scale_frac π d.2) + · change (d : A) = (b₂ : A) * ((u : A) * algebraMap L A (scale π (d : A))) + calc (d : A) = nrm π (d : A) * algebraMap L A (scale π (d : A)) := hd.symm + _ = (b₂ : A) * ((u : A) * algebraMap L A (scale π (d : A))) := by rw [hu']; ring + · refine Subtype.ext ?_ + change b = (b₁ : A) * (b₂ : A) + simpa using congrArg Subtype.val hprod + +omit [IsDomain A] in +/-- The rescaling step of the converse at `π b = 0`, in the orientation where the first factor +has zero residue. The paper takes this orientation "without loss of generality"; isolating it +lets both orientations be discharged by the same argument. Here `η` must be a nonzero element +of `Frac S`. -/ +private theorem eta_rescale {b c d e : A} (hb : π b ∈ S) (hc : π c ∈ S) (hd : π d ∈ S) + (he : π e ∈ S) {b₁ b₂ f g : A} + (hb₂F : π b₂ ∈ fracSubring S) (hfF : π f ∈ fracSubring S) + (hprod : b = b₁ * b₂) (hcf : c = b₁ * f) (hdg : d = b₂ * g) (hefg : e = f * g) + (h₁0 : π b₁ = 0) : + ∃ B₁ B₂ : residueSubring π S, B₁ ∣ (⟨c, hc⟩ : residueSubring π S) ∧ + B₂ ∣ (⟨d, hd⟩ : residueSubring π S) ∧ (⟨b, hb⟩ : residueSubring π S) = B₁ * B₂ := by + obtain ⟨η, hη0, hηb₂, hηf, hηg⟩ : + ∃ η : L, η ≠ 0 ∧ η * π b₂ ∈ S ∧ η * π f ∈ S ∧ π g * η⁻¹ ∈ S := by + rcases eq_or_ne (π g) 0 with hg0 | hg0 + · obtain ⟨s₁, hs₁, hs₁0, hs₁b⟩ := exists_den hb₂F + obtain ⟨s₂, hs₂, hs₂0, hs₂f⟩ := exists_den hfF + refine ⟨s₁ * s₂, mul_ne_zero hs₁0 hs₂0, ?_, ?_, ?_⟩ + · rw [show s₁ * s₂ * π b₂ = s₂ * (s₁ * π b₂) by ring]; exact S.mul_mem hs₂ hs₁b + · rw [show s₁ * s₂ * π f = s₁ * (s₂ * π f) by ring]; exact S.mul_mem hs₁ hs₂f + · rw [hg0, zero_mul]; exact S.zero_mem + · refine ⟨π g, hg0, ?_, ?_, ?_⟩ + · rw [mul_comm, ← map_mul, ← hdg]; exact hd + · rw [mul_comm, ← map_mul, ← hefg]; exact he + · rw [mul_inv_cancel₀ hg0]; exact S.one_mem + have hinv : algebraMap L A η⁻¹ * algebraMap L A η = 1 := by + rw [← map_mul, inv_mul_cancel₀ hη0, map_one] + have hinv' : algebraMap L A η * algebraMap L A η⁻¹ = 1 := by rw [mul_comm]; exact hinv + refine ⟨⟨b₁ * algebraMap L A η⁻¹, ?_⟩, ⟨b₂ * algebraMap L A η, ?_⟩, ?_, ?_, ?_⟩ + · rw [mem_residueSubring, map_mul, AlgHom.commutes, h₁0, zero_mul]; exact S.zero_mem + · rw [mem_residueSubring, map_mul, AlgHom.commutes, mul_comm]; exact hηb₂ + · refine ⟨⟨f * algebraMap L A η, ?_⟩, Subtype.ext ?_⟩ + · rw [mem_residueSubring, map_mul, AlgHom.commutes, mul_comm]; exact hηf + · change c = b₁ * algebraMap L A η⁻¹ * (f * algebraMap L A η) + rw [hcf, show b₁ * algebraMap L A η⁻¹ * (f * algebraMap L A η) + = b₁ * f * (algebraMap L A η⁻¹ * algebraMap L A η) by ring, hinv, mul_one] + · refine ⟨⟨g * algebraMap L A η⁻¹, ?_⟩, Subtype.ext ?_⟩ + · rw [mem_residueSubring, map_mul, AlgHom.commutes]; exact hηg + · change d = b₂ * algebraMap L A η * (g * algebraMap L A η⁻¹) + rw [hdg, show b₂ * algebraMap L A η * (g * algebraMap L A η⁻¹) + = b₂ * g * (algebraMap L A η * algebraMap L A η⁻¹) by ring, hinv', mul_one] + · refine Subtype.ext ?_ + change b = b₁ * algebraMap L A η⁻¹ * (b₂ * algebraMap L A η) + rw [hprod, show b₁ * algebraMap L A η⁻¹ * (b₂ * algebraMap L A η) + = b₁ * b₂ * (algebraMap L A η⁻¹ * algebraMap L A η) by ring, hinv, mul_one] + +/-- Converse, case `π b = 0`. -/ +theorem isPrimal_residueSubring_of_isPrimal_pre_fracSubring {b : A} (hb : π b ∈ S) (hb0 : π b = 0) + (h : IsPrimal (⟨b, le_fracSubring hb⟩ : residueSubring π (fracSubring S))) : + IsPrimal (⟨b, hb⟩ : residueSubring π S) := by + rcases eq_or_ne b 0 with rfl | hbne + · have hz : (⟨(0 : A), hb⟩ : residueSubring π S) = 0 := rfl + rw [hz]; exact isPrimal_zero + rintro c d ⟨e, hcde⟩ + have hcd : (c : A) * d = b * e := congrArg Subtype.val hcde + have hdvdF : (⟨b, le_fracSubring hb⟩ : residueSubring π (fracSubring S)) + ∣ ⟨(c : A), le_fracSubring c.2⟩ * ⟨(d : A), le_fracSubring d.2⟩ := + ⟨⟨(e : A), le_fracSubring e.2⟩, Subtype.ext hcd⟩ + obtain ⟨b₁, b₂, ⟨f, hf⟩, ⟨g, hg⟩, hprod⟩ := h hdvdF + have hprod' : b = (b₁ : A) * b₂ := congrArg Subtype.val hprod + have hcf : (c : A) = (b₁ : A) * f := congrArg Subtype.val hf + have hdg : (d : A) = (b₂ : A) * g := congrArg Subtype.val hg + have hefg : (e : A) = (f : A) * g := by + have h6 : b * (e : A) = b * ((f : A) * g) := by rw [← hcd, hcf, hdg, hprod']; ring + exact mul_left_cancel₀ hbne h6 + have hzero : π (b₁ : A) = 0 ∨ π (b₂ : A) = 0 := + mul_eq_zero.mp (by rw [← map_mul, ← hprod']; exact hb0) + rcases hzero with h1 | h2 + · exact eta_rescale hb c.2 d.2 e.2 b₂.2 f.2 hprod' hcf hdg hefg h1 + · obtain ⟨B₁, B₂, hd1, hd2, hp⟩ := + eta_rescale hb d.2 c.2 e.2 b₁.2 g.2 (by rw [hprod']; ring) hdg hcf + (by rw [hefg]; ring) h2 + exact ⟨B₂, B₁, hd2, hd1, by rw [hp]; ring⟩ + +/-! ### Lemma 9.2.1 -/ + +/-- LM24, Lemma 9.2.1, with the repairs its errata require: `A` must be a domain, and the two +left-to-right steps must clear a denominator before primality in `π ⁻¹ S` is invoked. -/ +theorem isPrimal_residueSubring_iff {b : A} (hb : π b ∈ S) : + IsPrimal (⟨b, hb⟩ : residueSubring π S) ↔ + (π b ≠ 0 ∧ IsPrimal (⟨π b, hb⟩ : S) ∧ IsPrimal b) ∨ + (π b = 0 ∧ IsPrimal (⟨b, le_fracSubring hb⟩ : residueSubring π (fracSubring S))) := by + rcases eq_or_ne (π b) 0 with h0 | h0 + · simp only [h0, ne_eq, not_true_eq_false, false_and, false_or, true_and] + exact ⟨isPrimal_fracSubring_of_isPrimal_residueSubring hb, + isPrimal_residueSubring_of_isPrimal_pre_fracSubring hb h0⟩ + · constructor + · exact fun h ↦ Or.inl + ⟨h0, isPrimal_residue_of_isPrimal hb h h0, isPrimal_of_isPrimal_residueSubring hb h h0⟩ + · rintro (⟨-, hS, hA⟩ | ⟨h, -⟩) + · exact isPrimal_residueSubring_of_isPrimal hb h0 hS hA + · exact absurd h h0 + +omit [IsDomain A] in +/-- An exact ambient four-factor refinement whose first input has nonzero residue can be +rescaled into the residue subring, provided that residue is primal. Only this one ambient +refinement and this one primal residue are required. -/ +theorem exists_refinement_residueSubring_of_ambient_of_residue_ne_zero + {a b c d : residueSubring π S} + (haS : IsPrimal (⟨π (a : A), a.2⟩ : S)) (haπ : π (a : A) ≠ 0) + (habcd : a * b = c * d) + {e f g h : A} + (ha : (a : A) = e * f) (hb : (b : A) = g * h) + (hc : (c : A) = e * g) (hd : (d : A) = f * h) : + ∃ E F G H : residueSubring π S, + a = E * F ∧ b = G * H ∧ c = E * G ∧ d = F * H := by + have habcdS : + (⟨π (a : A), a.2⟩ : S) * ⟨π (b : A), b.2⟩ = + ⟨π (c : A), c.2⟩ * ⟨π (d : A), d.2⟩ := by + apply Subtype.ext + change π (a : A) * π (b : A) = π (c : A) * π (d : A) + rw [← map_mul, ← map_mul] + exact congrArg π (congrArg Subtype.val habcd) + have haS0 : (⟨π (a : A), a.2⟩ : S) ≠ 0 := by + intro hzero + apply haπ + exact congrArg Subtype.val hzero + obtain ⟨e₀, f₀, g₀, h₀, ha₀, hb₀, hc₀, hd₀⟩ := + exists_fourFactorRefinement_of_isPrimal haS0 haS habcdS + have ha₀' : π (a : A) = (e₀ : L) * f₀ := congrArg Subtype.val ha₀ + have hc₀' : π (c : A) = (e₀ : L) * g₀ := congrArg Subtype.val hc₀ + have hd₀' : π (d : A) = (f₀ : L) * h₀ := congrArg Subtype.val hd₀ + have he0 : π e ≠ 0 := by + intro he + apply haπ + rw [ha, map_mul, he, zero_mul] + have hf0 : π f ≠ 0 := by + intro hf + apply haπ + rw [ha, map_mul, hf, mul_zero] + have he₀0 : (e₀ : L) ≠ 0 := by + intro he₀ + apply haπ + rw [ha₀', he₀, zero_mul] + have hf₀0 : (f₀ : L) ≠ 0 := by + intro hf₀ + apply haπ + rw [ha₀', hf₀, mul_zero] + let η : L := π e * (e₀ : L)⁻¹ + have hη0 : η ≠ 0 := mul_ne_zero he0 (inv_ne_zero he₀0) + have hE : π (e * algebraMap L A η⁻¹) = e₀ := by + simp only [map_mul, AlgHom.commutes, Algebra.algebraMap_self, RingHom.id_apply] + dsimp only [η] + field_simp + have hF : π (f * algebraMap L A η) = f₀ := by + simp only [map_mul, AlgHom.commutes, Algebra.algebraMap_self, RingHom.id_apply] + dsimp only [η] + have hae : π (a : A) = π e * π f := by rw [ha, map_mul] + calc + π f * (π e * (e₀ : L)⁻¹) = (π e * π f) * (e₀ : L)⁻¹ := by ring + _ = π (a : A) * (e₀ : L)⁻¹ := by rw [hae] + _ = (e₀ : L) * f₀ * (e₀ : L)⁻¹ := by rw [ha₀'] + _ = f₀ := by field_simp + have hG : π (g * algebraMap L A η) = g₀ := by + simp only [map_mul, AlgHom.commutes, Algebra.algebraMap_self, RingHom.id_apply] + dsimp only [η] + have hce : π (c : A) = π e * π g := by rw [hc, map_mul] + rw [show π g * (π e * (e₀ : L)⁻¹) = (π e * π g) * (e₀ : L)⁻¹ by ring, + ← hce, hc₀'] + field_simp + have hH : π (h * algebraMap L A η⁻¹) = h₀ := by + simp only [map_mul, AlgHom.commutes, Algebra.algebraMap_self, RingHom.id_apply] + have hFscalar : π f * η = (f₀ : L) := by simpa using hF + have hdh : π (d : A) = π f * π h := by rw [hd, map_mul] + apply mul_left_cancel₀ hf₀0 + calc + (f₀ : L) * (π h * η⁻¹) = (π f * η) * (π h * η⁻¹) := by rw [hFscalar] + _ = π f * π h := by field_simp + _ = π (d : A) := hdh.symm + _ = (f₀ : L) * h₀ := hd₀' + refine ⟨⟨e * algebraMap L A η⁻¹, mem_residueSubring.mpr (by rw [hE]; exact e₀.2)⟩, + ⟨f * algebraMap L A η, mem_residueSubring.mpr (by rw [hF]; exact f₀.2)⟩, + ⟨g * algebraMap L A η, mem_residueSubring.mpr (by rw [hG]; exact g₀.2)⟩, + ⟨h * algebraMap L A η⁻¹, mem_residueSubring.mpr (by rw [hH]; exact h₀.2)⟩, + ?_, ?_, ?_, ?_⟩ + all_goals + apply Subtype.ext + simp only [Subring.coe_mul] + · rw [ha] + rw [show (e * algebraMap L A η⁻¹) * (f * algebraMap L A η) = + e * f * (algebraMap L A η⁻¹ * algebraMap L A η) by ring, + ← map_mul, inv_mul_cancel₀ hη0, map_one, mul_one] + · rw [hb] + rw [show (g * algebraMap L A η) * (h * algebraMap L A η⁻¹) = + g * h * (algebraMap L A η * algebraMap L A η⁻¹) by ring, + ← map_mul, mul_inv_cancel₀ hη0, map_one, mul_one] + · rw [hc] + rw [show (e * algebraMap L A η⁻¹) * (g * algebraMap L A η) = + e * g * (algebraMap L A η⁻¹ * algebraMap L A η) by ring, + ← map_mul, inv_mul_cancel₀ hη0, map_one, mul_one] + · rw [hd] + rw [show (f * algebraMap L A η) * (h * algebraMap L A η⁻¹) = + f * h * (algebraMap L A η * algebraMap L A η⁻¹) by ring, + ← map_mul, mul_inv_cancel₀ hη0, map_one, mul_one] + +/-- A nonzero exact ambient four-factor refinement can be rescaled into the residue subring when +the first residue is primal and that subring generates the coefficient field. This is the +equation-local form needed after an exact germ refinement; no global refinement property of the +residue ring is assumed. -/ +theorem exists_refinement_residueSubring_of_ambient + {a b c d : residueSubring π S} + (haS : IsPrimal (⟨π (a : A), a.2⟩ : S)) (hfrac : fracSubring S = ⊤) + (ha0 : a ≠ 0) (habcd : a * b = c * d) + {e f g h : A} + (ha : (a : A) = e * f) (hb : (b : A) = g * h) + (hc : (c : A) = e * g) (hd : (d : A) = f * h) : + ∃ E F G H : residueSubring π S, + a = E * F ∧ b = G * H ∧ c = E * G ∧ d = F * H := by + by_cases haπ : π (a : A) = 0 + · have haA0 : (a : A) ≠ 0 := fun h ↦ ha0 (Subtype.ext h) + have hef0 : π e = 0 ∨ π f = 0 := by + apply mul_eq_zero.mp + rw [← map_mul, ← ha] + exact haπ + rcases hef0 with he0 | hf0 + · obtain ⟨E, F, hEc, hFd, haEF⟩ := eta_rescale a.2 c.2 d.2 b.2 + (by rw [hfrac]; exact Subring.mem_top _) + (by rw [hfrac]; exact Subring.mem_top _) + ha hc hd hb he0 + obtain ⟨G, hcEG⟩ := hEc + obtain ⟨H, hdFH⟩ := hFd + refine ⟨E, F, G, H, haEF, ?_, hcEG, hdFH⟩ + apply Subtype.ext + apply mul_left_cancel₀ haA0 + change (a : A) * (b : A) = (a : A) * ((G : A) * H) + have habcd' := congrArg Subtype.val habcd + have hcEG' := congrArg Subtype.val hcEG + have hdFH' := congrArg Subtype.val hdFH + have haEF' := congrArg Subtype.val haEF + simp only [Subring.coe_mul] at habcd' hcEG' hdFH' haEF' + rw [habcd', hcEG', hdFH', haEF'] + ring + · obtain ⟨F, E, hFd, hEc, haFE⟩ := eta_rescale a.2 d.2 c.2 b.2 + (by rw [hfrac]; exact Subring.mem_top _) + (by rw [hfrac]; exact Subring.mem_top _) + (by rw [ha]; ring) hd hc (by rw [hb]; ring) hf0 + obtain ⟨H, hdFH⟩ := hFd + obtain ⟨G, hcEG⟩ := hEc + refine ⟨E, F, G, H, ?_, ?_, hcEG, hdFH⟩ + · exact haFE.trans (mul_comm F E) + · apply Subtype.ext + apply mul_left_cancel₀ haA0 + change (a : A) * (b : A) = (a : A) * ((G : A) * H) + have habcd' := congrArg Subtype.val habcd + have hcEG' := congrArg Subtype.val hcEG + have hdFH' := congrArg Subtype.val hdFH + have haFE' := congrArg Subtype.val haFE + simp only [Subring.coe_mul] at habcd' hcEG' hdFH' haFE' + rw [habcd', hcEG', hdFH', haFE'] + ring + · exact exists_refinement_residueSubring_of_ambient_of_residue_ne_zero + haS haπ habcd ha hb hc hd + +/-- A nonzero element of a residue subring is primal when its residue is primal, the coefficient +subring generates the whole coefficient field, and the element is primal in the ambient algebra. +This equation-local form avoids assuming refinement for every ambient element. -/ +theorem isPrimal_residueSubring_of_isPrimal_ambient + {b : residueSubring π S} (hb0 : b ≠ 0) + (hbS : IsPrimal (⟨π (b : A), b.2⟩ : S)) (hfrac : fracSubring S = ⊤) + (hbA : IsPrimal (b : A)) : IsPrimal b := by + intro c d hdvd + obtain ⟨q, hq⟩ := hdvd + have hprod : b * q = c * d := hq.symm + obtain ⟨e, f, g, h, hb, hq, hc, hd⟩ := + exists_fourFactorRefinement_of_isPrimal + (fun hzero ↦ hb0 (Subtype.ext hzero)) hbA (congrArg Subtype.val hprod) + obtain ⟨E, F, G, H, hb', -, hc', hd'⟩ := + exists_refinement_residueSubring_of_ambient hbS hfrac hb0 hprod hb hq hc hd + exact ⟨E, F, ⟨G, hc'⟩, ⟨H, hd'⟩, hb'⟩ + +/-- Four-factor refinement ascends from the ambient algebra and the residue subring when the +residue subring generates the whole coefficient field. The zero-residue branch uses ambient +refinement after identifying the enlarged residue pullback with the ambient algebra. -/ +theorem hasFourFactorRefinement_residueSubring + (hA : HasFourFactorRefinement A) (hS : HasFourFactorRefinement S) + (hfrac : fracSubring S = ⊤) : + HasFourFactorRefinement (residueSubring π S) := by + rw [hasFourFactorRefinement_iff_forall_isPrimal] + intro b + rw [isPrimal_residueSubring_iff b.2] + by_cases hb : π b = 0 + · right + refine ⟨hb, ?_⟩ + let b' : residueSubring π (fracSubring S) := ⟨b, le_fracSubring b.2⟩ + let e : residueSubring π (fracSubring S) ≃+* A := { + toFun x := x + invFun x := ⟨x, by rw [mem_residueSubring, hfrac]; exact Subring.mem_top _⟩ + left_inv _ := rfl + right_inv _ := rfl + map_mul' _ _ := rfl + map_add' _ _ := rfl } + apply (e.isPrimal_iff b').mp + change IsPrimal (b : A) + exact hA.isPrimal (b : A) + · left + exact ⟨hb, hS.isPrimal _, hA.isPrimal b⟩ + +end Subring diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/PrimalProduct.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/PrimalProduct.lean new file mode 100644 index 0000000000..8de122ed78 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/PrimalProduct.lean @@ -0,0 +1,32 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.GroupWithZero.Divisibility +public import Mathlib.Algebra.BigOperators.Group.List.Basic + +/-! +# Finite products of primal elements + +Mathlib records that a unit is primal and that the product of two primal elements of a +cancellative commutative monoid with zero is primal. This file iterates the binary statement to +finite products indexed by a list. +-/ + +universe u + +public section + +/-- A product of primal elements over a list is primal. -/ +theorem isPrimal_list_prod {M : Type u} [CommMonoidWithZero M] [IsCancelMulZero M] + {l : List M} (hl : ∀ c ∈ l, IsPrimal c) : IsPrimal l.prod := by + induction l with + | nil => simpa using isUnit_one.isPrimal + | cons c cs ih => + rw [List.prod_cons] + exact (hl c List.mem_cons_self).mul (ih fun d hd ↦ hl d (List.mem_cons_of_mem c hd)) + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Refinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Refinement.lean new file mode 100644 index 0000000000..f89e2331d0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Refinement.lean @@ -0,0 +1,221 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.Divisibility.Basic +public import Mathlib.Algebra.GroupWithZero.Defs +public import Mathlib.Algebra.Ring.Divisibility.Basic +public import Mathlib.Algebra.Ring.Subring.Basic + +/-! +# Four-factor refinement + +This file defines the binary four-factor refinement property for a commutative monoid and relates +it to Mathlib's predicates `IsPrimal` and `DecompositionMonoid`. This is the algebraic form of +Conway's refinement conjecture in *On Numbers and Games*, page 46, and in LM24, +Conjecture 1.1.1(2). + +The equivalence itself is Cohn, Theorem 2.2, in its four-factor case. Cohn shows that an +integrally closed domain is Schreier — every element primal — exactly when any two factorisations +of an element admit a common refinement, and the forward direction of his proof is the four-factor +argument reproduced below. The name "primal" is his; "pre-Schreier", for the same condition +without integral closure, is Zafrullah's. What follows drops the domain and integral-closure +hypotheses and keeps the binary case, which is what the refinement conjecture needs. + +For commutative monoids with zero, cancellation away from zero is needed only in the reverse +implication from primality to four-factor refinement. The zero case uses the absence of zero +divisors supplied by `IsCancelMulZero`. These generic equivalences do not assert that the omnific +integers satisfy either equivalent property; that specialization remains Conway's refinement +conjecture. +-/ + +universe u + +public section + +/-- A commutative monoid has four-factor refinement if every equality `a * b = c * d` admits +elements `e`, `f`, `g`, and `h` such that +`a = e * f`, `b = g * h`, `c = e * g`, and `d = f * h`. -/ +def HasFourFactorRefinement (R : Type u) [CommMonoid R] : Prop := + ∀ a b c d : R, a * b = c * d → + ∃ e f g h : R, a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h + +/-- The defining condition for four-factor refinement. -/ +theorem hasFourFactorRefinement_def {R : Type u} [CommMonoid R] : + HasFourFactorRefinement R ↔ + ∀ a b c d : R, a * b = c * d → + ∃ e f g h : R, a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h := + (Iff.rfl) + +namespace HasFourFactorRefinement + +variable {R : Type u} [CommMonoid R] + +/-- Four-factor refinement is preserved by a multiplicative equivalence. -/ +theorem map_mulEquiv {S : Type*} [CommMonoid S] + (hR : HasFourFactorRefinement R) (e : R ≃* S) : HasFourFactorRefinement S := by + rw [hasFourFactorRefinement_def] + intro a b c d habcd + have hsource : e.symm a * e.symm b = e.symm c * e.symm d := by + simpa only [map_mul] using congrArg e.symm habcd + obtain ⟨f, g, h, i, haf, hbg, hch, hdi⟩ := hR _ _ _ _ hsource + exact ⟨e f, e g, e h, e i, + by simpa only [map_mul, e.apply_symm_apply] using congrArg e haf, + by simpa only [map_mul, e.apply_symm_apply] using congrArg e hbg, + by simpa only [map_mul, e.apply_symm_apply] using congrArg e hch, + by simpa only [map_mul, e.apply_symm_apply] using congrArg e hdi⟩ + +/-- Obtain four refinement factors from an equality of two products. -/ +theorem refine (hR : HasFourFactorRefinement R) {a b c d : R} (h : a * b = c * d) : + ∃ e f g h : R, a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h := + hasFourFactorRefinement_def.mp hR a b c d h + +/-- Every element of a commutative monoid with four-factor refinement is primal. -/ +theorem isPrimal (hR : HasFourFactorRefinement R) (a : R) : IsPrimal a := by + intro b c hadvd + obtain ⟨q, hq⟩ := hadvd + obtain ⟨e, f, g, h, ha, _, hb, hc⟩ := hR.refine hq.symm + exact ⟨e, f, ⟨g, hb⟩, ⟨h, hc⟩, ha⟩ + +/-- A commutative monoid with four-factor refinement is a decomposition monoid. -/ +theorem decompositionMonoid (hR : HasFourFactorRefinement R) : DecompositionMonoid R := + ⟨hR.isPrimal⟩ + +end HasFourFactorRefinement + +/-- Multiplicatively equivalent commutative monoids have four-factor refinement simultaneously. -/ +theorem MulEquiv.hasFourFactorRefinement_iff + {R : Type u} {S : Type*} [CommMonoid R] [CommMonoid S] (e : R ≃* S) : + HasFourFactorRefinement R ↔ HasFourFactorRefinement S := + ⟨fun h ↦ h.map_mulEquiv e, fun h ↦ h.map_mulEquiv e.symm⟩ + +section CancelMulZero + +variable {R : Type u} [CommMonoidWithZero R] [IsCancelMulZero R] + +/-- A product equality with one nonzero primal factor has a four-factor refinement. -/ +theorem exists_fourFactorRefinement_of_isPrimal + {a b c d : R} (ha0 : a ≠ 0) (ha : IsPrimal a) (habcd : a * b = c * d) : + ∃ e f g h : R, a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h := by + have hadvd : a ∣ c * d := ⟨b, habcd.symm⟩ + obtain ⟨e, f, hec, hfd, haef⟩ := ha hadvd + obtain ⟨g, hcg⟩ := hec + obtain ⟨h, hdh⟩ := hfd + refine ⟨e, f, g, h, haef, ?_, hcg, hdh⟩ + apply mul_left_cancel₀ ha0 + calc + a * b = c * d := habcd + _ = (e * g) * (f * h) := by rw [hcg, hdh] + _ = (e * f) * (g * h) := by ac_rfl + _ = a * (g * h) := by rw [← haef] + +/-- Splice an equation-local refinement of one factor with primality of the complementary factor. +If `a = t * w`, the retained factor `t` has been split as `e * f` with `e ∣ c` and `f ∣ d`, +and `w` is primal, then the original divisibility `a ∣ c * d` has a primal refinement. -/ +theorem exists_primalRefinement_of_factor_refinement + {a b c d t w e f : R} (ha0 : a ≠ 0) (hab : a * b = c * d) + (hatw : a = t * w) (htef : t = e * f) (hec : e ∣ c) (hfd : f ∣ d) + (hw : IsPrimal w) : + ∃ a₁ a₂, a₁ ∣ c ∧ a₂ ∣ d ∧ a = a₁ * a₂ := by + obtain ⟨g, hcg⟩ := hec + obtain ⟨h, hdh⟩ := hfd + have ht0 : t ≠ 0 := fun ht ↦ ha0 (by rw [hatw, ht, zero_mul]) + have hwdiv : w ∣ g * h := by + refine ⟨b, ?_⟩ + apply mul_left_cancel₀ ht0 + calc + t * (g * h) = (e * f) * (g * h) := by rw [htef] + _ = (e * g) * (f * h) := by ac_rfl + _ = c * d := by rw [← hcg, ← hdh] + _ = a * b := hab.symm + _ = t * (w * b) := by rw [hatw]; ac_rfl + obtain ⟨w₁, w₂, ⟨u, hgu⟩, ⟨v, hhv⟩, hww⟩ := hw hwdiv + refine ⟨e * w₁, f * w₂, ⟨u, ?_⟩, ⟨v, ?_⟩, ?_⟩ + · rw [hcg, hgu] + ac_rfl + · rw [hdh, hhv] + ac_rfl + · rw [hatw, htef, hww] + ac_rfl + +/-- A commutative decomposition monoid with cancellation away from zero has four-factor +refinement. -/ +theorem hasFourFactorRefinement_of_decompositionMonoid [DecompositionMonoid R] : + HasFourFactorRefinement R := by + intro a b c d hab + by_cases ha : a = 0 + · subst a + have hcd : c * d = 0 := by simpa using hab.symm + rcases eq_zero_or_eq_zero_of_mul_eq_zero hcd with rfl | rfl + · exact ⟨0, d, b, 1, by simp⟩ + · exact ⟨c, 0, 1, b, by simp⟩ + · have hadvd : a ∣ c * d := ⟨b, hab.symm⟩ + obtain ⟨e, f, hec, hfd, haef⟩ := DecompositionMonoid.primal a hadvd + obtain ⟨g, hcg⟩ := hec + obtain ⟨h, hdh⟩ := hfd + refine ⟨e, f, g, h, haef, ?_, hcg, hdh⟩ + apply mul_left_cancel₀ ha + calc + a * b = c * d := hab + _ = (e * g) * (f * h) := by rw [hcg, hdh] + _ = (e * f) * (g * h) := by ac_rfl + _ = a * (g * h) := by rw [← haef] + +/-- Four-factor refinement is equivalent to primality of every element. -/ +theorem hasFourFactorRefinement_iff_forall_isPrimal : + HasFourFactorRefinement R ↔ ∀ a : R, IsPrimal a := by + constructor + · exact fun hR a ↦ hR.isPrimal a + · intro h + letI : DecompositionMonoid R := ⟨h⟩ + exact hasFourFactorRefinement_of_decompositionMonoid + +/-- Four-factor refinement is equivalent to the decomposition-monoid property. -/ +theorem hasFourFactorRefinement_iff_decompositionMonoid : + HasFourFactorRefinement R ↔ DecompositionMonoid R := by + rw [hasFourFactorRefinement_iff_forall_isPrimal, decompositionMonoid_iff] + +end CancelMulZero + +namespace Subring + +variable {R : Type u} [CommRing R] + +/-- Four-factor refinement in a subring is equivalent to ambient refinement with all four +factors retained in the subring. -/ +theorem hasFourFactorRefinement_iff (S : Subring R) : + HasFourFactorRefinement S ↔ + ∀ a b c d : R, a ∈ S → b ∈ S → c ∈ S → d ∈ S → a * b = c * d → + ∃ e f g h : R, + e ∈ S ∧ f ∈ S ∧ g ∈ S ∧ h ∈ S ∧ + a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h := by + constructor + · intro hS a b c d ha hb hc hd habcd + obtain ⟨e, f, g, h, hA, hB, hC, hD⟩ := + hS.refine (a := ⟨a, ha⟩) (b := ⟨b, hb⟩) (c := ⟨c, hc⟩) (d := ⟨d, hd⟩) + (Subtype.ext habcd) + exact ⟨e, f, g, h, e.2, f.2, g.2, h.2, + congrArg Subtype.val hA, congrArg Subtype.val hB, + congrArg Subtype.val hC, congrArg Subtype.val hD⟩ + · intro hS a b c d habcd + obtain ⟨e, f, g, h, he, hf, hg, hh, hA, hB, hC, hD⟩ := + hS a b c d a.2 b.2 c.2 d.2 (congrArg Subtype.val habcd) + exact ⟨⟨e, he⟩, ⟨f, hf⟩, ⟨g, hg⟩, ⟨h, hh⟩, + Subtype.ext hA, Subtype.ext hB, Subtype.ext hC, Subtype.ext hD⟩ + +/-- A decomposition subring refines every ambient product equality whose four entries lie in +the subring. -/ +theorem exists_fourFactorRefinement_of_decompositionMonoid + (S : Subring R) [IsDomain S] [DecompositionMonoid S] + {a b c d : R} (ha : a ∈ S) (hb : b ∈ S) (hc : c ∈ S) (hd : d ∈ S) + (habcd : a * b = c * d) : + ∃ e f g h : R, + e ∈ S ∧ f ∈ S ∧ g ∈ S ∧ h ∈ S ∧ + a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h := by + exact (hasFourFactorRefinement_iff S).mp + hasFourFactorRefinement_of_decompositionMonoid a b c d ha hb hc hd habcd + +end Subring diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Tests.lean new file mode 100644 index 0000000000..5169061911 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Tests.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Tests.Refinement + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Tests/Refinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Tests/Refinement.lean new file mode 100644 index 0000000000..0288326e7d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Tests/Refinement.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement + +import Mathlib.Algebra.GCDMonoid.Nat +import Mathlib.Tactic.NormNum + +/-! +# Tests for four-factor refinement + +The natural numbers provide nonzero and zero examples of the public refinement interface. +-/ + +public section + +namespace Tests + +/-- The natural numbers give a four-factor refinement model with `0 ≠ 1` and nonunit elements. -/ +theorem nat_hasFourFactorRefinement : HasFourFactorRefinement ℕ := + hasFourFactorRefinement_of_decompositionMonoid + +theorem nat_hasFourFactorRefinement_iff_decompositionMonoid : + HasFourFactorRefinement ℕ ↔ DecompositionMonoid ℕ := + hasFourFactorRefinement_iff_decompositionMonoid + +/-- The equality `6 * 35 = 10 * 21` has the refinement `(2, 3, 5, 7)`. -/ +theorem nat_six_thirty_five_ten_twenty_one_refinement : + ∃ e f g h : ℕ, 6 = e * f ∧ 35 = g * h ∧ 10 = e * g ∧ 21 = f * h := + ⟨2, 3, 5, 7, by norm_num⟩ + +theorem nat_zero_left_refinement (b d : ℕ) : + ∃ e f g h : ℕ, 0 = e * f ∧ b = g * h ∧ 0 = e * g ∧ d = f * h := + nat_hasFourFactorRefinement.refine (by simp) + +theorem nat_zero_right_refinement (b c : ℕ) : + ∃ e f g h : ℕ, 0 = e * f ∧ b = g * h ∧ c = e * g ∧ 0 = f * h := + nat_hasFourFactorRefinement.refine (by simp) + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GeometricIntegrality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GeometricIntegrality.lean new file mode 100644 index 0000000000..9c2e0b3f64 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GeometricIntegrality.lean @@ -0,0 +1,213 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.MvPolynomial.Eval +public import Mathlib.RingTheory.Ideal.Quotient.Defs +public import Mathlib.RingTheory.Ideal.Span +public import Mathlib.RingTheory.TensorProduct.Basic + +import Mathlib.LinearAlgebra.Basis.VectorSpace +import Mathlib.Algebra.Field.ULift +import Mathlib.Algebra.Ring.Hom.InjSurj +import Mathlib.RingTheory.Flat.Basic +import Mathlib.RingTheory.Ideal.Quotient.Basic +import Mathlib.RingTheory.Ideal.Quotient.Operations +import Mathlib.RingTheory.Localization.FractionRing +import Mathlib.RingTheory.Polynomial.UniqueFactorization +import Mathlib.RingTheory.TensorProduct.MvPolynomial +import Mathlib.RingTheory.TensorProduct.Quotient + +/-! +# Geometrically integral algebras + +A commutative algebra over a field is geometrically integral when its scalar extension to every +field in the ambient universe is a domain. This algebraic formulation is the one used by the +filtered-substitution argument: an irreducible polynomial over the base field remains prime after +extending its coefficients to a geometrically integral algebra. + +The proof embeds the scalar extension by the irreducible polynomial's quotient domain into the +scalar extension by its fraction field. Polynomial and quotient tensor equivalences then identify +that tensor product with the required polynomial quotient. + +The definition quantifies over the fields of the universe `max u v` of `B ⊗[k] L`. A `Prop` +cannot quantify over universes, and the universe-free characterization, that `B ⊗[k] k̄` is a +domain for an algebraic closure `k̄`, is a theorem of descent that is not in Mathlib; the +scheme-theoretic `AlgebraicGeometry.GeometricallyIntegral` is likewise fixed to one universe. For +the paper's quotient `P̂/I`, the statement in every universe is proved separately, by putting a +lowering derivation on `E ⊗_K P̂` rather than from this definition. +-/ + +open scoped TensorProduct + +universe u v w + +namespace Algebra + +public noncomputable section + +attribute [local instance 1100] Module.Free.of_divisionRing Module.Flat.of_free + +/-- A commutative algebra is geometrically integral when every scalar extension to a field in the +ambient universe is a domain. -/ +def IsGeometricallyIntegral (k : Type u) (B : Type v) + [Field k] [CommRing B] [Algebra k B] : Prop := + ∀ (K : Type (max u v)) [Field K] [Algebra k K], IsDomain (B ⊗[k] K) + +/-- A geometrically integral algebra is a domain. -/ +theorem IsGeometricallyIntegral.isDomain + {k : Type u} [Field k] {B : Type v} [CommRing B] [Algebra k B] + (hB : IsGeometricallyIntegral k B) : IsDomain B := by + haveI : IsDomain (B ⊗[k] ULift.{max u v} k) := + hB (ULift.{max u v} k) + let e : (B ⊗[k] ULift.{max u v} k) ≃ₐ[k] (B ⊗[k] k) := + Algebra.TensorProduct.congr AlgEquiv.refl ULift.algEquiv + haveI : IsDomain (B ⊗[k] k) := e.symm.toMulEquiv.isDomain _ + exact (Algebra.TensorProduct.rid k k B).symm.toMulEquiv.isDomain _ + +section BaseChange + +/-- Geometric integrality transports along an algebra equivalence. -/ +theorem IsGeometricallyIntegral.of_algEquiv {k : Type u} [Field k] {A B : Type v} + [CommRing A] [Algebra k A] [CommRing B] [Algebra k B] + (hA : IsGeometricallyIntegral k A) (e : A ≃ₐ[k] B) : + IsGeometricallyIntegral k B := fun M _ _ ↦ by + haveI : IsDomain (A ⊗[k] M) := hA M + exact (Algebra.TensorProduct.congr e + (AlgEquiv.refl (R := k) (A₁ := M))).symm.toMulEquiv.isDomain _ + +end BaseChange + +variable {k : Type u} {σ : Type (max u v)} {B : Type v} + [Field k] [CommRing B] [Algebra k B] + +/-- The defining field-extension criterion for geometric integrality. -/ +theorem isGeometricallyIntegral_iff : + IsGeometricallyIntegral k B ↔ + ∀ (K : Type (max u v)) [Field K] [Algebra k K], IsDomain (B ⊗[k] K) := + Iff.rfl + +/-- An algebra over a field whose tensor products with the fields of some universe are domains +remains a domain after tensoring with any domain of that universe: the tensor product embeds, by +flatness, into the tensor product with the fraction field. -/ +theorem isDomain_tensor_of_isDomain_of_forall_field {k : Type u} [Field k] {B : Type v} + [CommRing B] [Algebra k B] + (hB : ∀ (L : Type w) [Field L] [Algebra k L], IsDomain (B ⊗[k] L)) + (D : Type w) [CommRing D] [IsDomain D] [Algebra k D] : IsDomain (B ⊗[k] D) := by + let L := FractionRing D + letI : Algebra k L := Algebra.ofModule + (fun r x y ↦ smul_mul_assoc r x y) + (fun r x y ↦ mul_smul_comm r x y) + letI : IsScalarTower k D L := inferInstance + letI : IsDomain (B ⊗[k] L) := hB L + let ι : D →ₐ[k] L := (IsScalarTower.toAlgHom k D L).restrictScalars k + let Φ : B ⊗[k] D →ₐ[k] B ⊗[k] L := + Algebra.TensorProduct.map (AlgHom.id k B) ι + have hι : Function.Injective ι := IsFractionRing.injective D L + have hΦ : Function.Injective Φ := by + have h := TensorProduct.map_injective_of_flat_flat + (LinearMap.id (R := k) (M := B)) + ((IsScalarTower.toAlgHom k D L).restrictScalars k).toLinearMap + Function.injective_id hι + change Function.Injective Φ.toLinearMap + dsimp only [Φ] + rw [Algebra.TensorProduct.toLinearMap_map, + TensorProduct.AlgebraTensorModule.map_eq] + exact h + exact hΦ.isDomain Φ.toRingHom + +/-- A geometrically integral algebra remains a domain after tensoring with any domain of the +ambient universe over the base field. -/ +theorem IsGeometricallyIntegral.isDomain_tensor_of_isDomain + (hB : IsGeometricallyIntegral k B) (D : Type (max u v)) [CommRing D] [IsDomain D] + [Algebra k D] : IsDomain (B ⊗[k] D) := + isDomain_tensor_of_isDomain_of_forall_field (fun L _ _ ↦ hB L) D + +/-- An irreducible polynomial over the base field generates a prime ideal after extending +coefficients to a geometrically integral algebra. -/ +theorem IsGeometricallyIntegral.isDomain_mvPolynomial_quotient_span_map + (hB : IsGeometricallyIntegral k B) {F : MvPolynomial σ k} + (hF : Irreducible F) : + IsDomain + (MvPolynomial σ B ⧸ + Ideal.span {MvPolynomial.map (algebraMap k B) F}) := by + let I : Ideal (MvPolynomial σ k) := Ideal.span {F} + have hFPrime : Prime F := + UniqueFactorizationMonoid.irreducible_iff_prime.mp hF + have hIPrime : I.IsPrime := by + exact (Ideal.span_singleton_prime hFPrime.ne_zero).mpr hFPrime + letI : I.IsPrime := hIPrime + let D := MvPolynomial σ k ⧸ I + letI : IsDomain (B ⊗[k] D) := hB.isDomain_tensor_of_isDomain D + let ePoly : B ⊗[k] MvPolynomial σ k ≃ₐ[B] MvPolynomial σ B := + MvPolynomial.algebraTensorAlgEquiv k B + let rightInclusion : MvPolynomial σ k →ₐ[k] B ⊗[k] MvPolynomial σ k := + Algebra.TensorProduct.includeRight + let J : Ideal (B ⊗[k] MvPolynomial σ k) := I.map rightInclusion + let eQuot := + Algebra.TensorProduct.tensorQuotientEquiv + (R := k) B (MvPolynomial σ k) B I + have hIdeal : + Ideal.map ePoly.toRingEquiv J = + Ideal.span {MvPolynomial.map (algebraMap k B) F} := by + dsimp only [J, I] + change Ideal.map ePoly.toRingEquiv.toRingHom + (Ideal.map rightInclusion.toRingHom (Ideal.span {F})) = _ + rw [Ideal.map_map rightInclusion.toRingHom ePoly.toRingEquiv.toRingHom] + rw [Ideal.map_span, Set.image_singleton] + congr 2 + change ePoly (rightInclusion F) = MvPolynomial.map (algebraMap k B) F + simp [rightInclusion, ePoly] + letI : IsDomain + ((B ⊗[k] MvPolynomial σ k) ⧸ J) := + eQuot.symm.toMulEquiv.isDomain + let eMap : + (B ⊗[k] MvPolynomial σ k) ⧸ J ≃+* + MvPolynomial σ B ⧸ Ideal.span {MvPolynomial.map (algebraMap k B) F} := + Ideal.quotientEquiv _ _ ePoly.toRingEquiv hIdeal.symm + exact eMap.symm.toMulEquiv.isDomain + +private def quotientSpanEquivOfEq {A C : Type*} [CommRing A] [CommRing C] + (e : A ≃+* C) {x : A} {y : C} (hxy : e x = y) : + A ⧸ Ideal.span {x} ≃+* C ⧸ Ideal.span {y} := + Ideal.quotientEquiv (Ideal.span {x}) (Ideal.span {y}) e <| by + rw [Ideal.map_span, Set.image_singleton] + change Ideal.span {y} = Ideal.span {e x} + rw [hxy] + +/-- The irreducible base-change quotient is a domain for a finite variable type, independently +of the universes of the base field and coefficient algebra. -/ +theorem IsGeometricallyIntegral.isDomain_fin_mvPolynomial_quotient_span_map + (hB : IsGeometricallyIntegral k B) {n : ℕ} {F : MvPolynomial (Fin n) k} + (hF : Irreducible F) : + IsDomain + (MvPolynomial (Fin n) B ⧸ + Ideal.span {MvPolynomial.map (algebraMap k B) F}) := by + let τ := ULift.{max u v, 0} (Fin n) + let liftEquiv : Fin n ≃ τ := Equiv.ulift.symm + let F' : MvPolynomial τ k := MvPolynomial.renameEquiv k liftEquiv F + have hF' : Irreducible F' := by + exact hF.map (MvPolynomial.renameEquiv k liftEquiv).toMulEquiv + letI : IsDomain + (MvPolynomial τ B ⧸ + Ideal.span {MvPolynomial.map (algebraMap k B) F'}) := + hB.isDomain_mvPolynomial_quotient_span_map hF' + let e : MvPolynomial (Fin n) B ≃+* MvPolynomial τ B := + (MvPolynomial.renameEquiv B liftEquiv).toRingEquiv + have hmap : + e (MvPolynomial.map (algebraMap k B) F) = + MvPolynomial.map (algebraMap k B) F' := by + change MvPolynomial.rename liftEquiv + (MvPolynomial.map (algebraMap k B) F) = + MvPolynomial.map (algebraMap k B) + (MvPolynomial.rename liftEquiv F) + exact MvPolynomial.map_rename (algebraMap k B) liftEquiv F |>.symm + let eQuot := quotientSpanEquivOfEq e hmap + exact eQuot.isDomain _ + +end + +end Algebra diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing.lean new file mode 100644 index 0000000000..980f61f774 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.Extension +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.FinitePartSubstitution +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousZeroDivisors +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.OrdinalGenerators + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/Extension.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/Extension.lean new file mode 100644 index 0000000000..87cf30d15b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/Extension.lean @@ -0,0 +1,279 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.OrdinalGenerators +public import Mathlib.LinearAlgebra.Basis.VectorSpace + +/-! +# Extending a degreewise independent family to a minimal system + +Let `(A_β)` be a family of subspaces of a commutative algebra over a field `E`, and put +`D_β = ∑_{i ⊕ j = β, i, j ≠ 0} A_i A_j` (Lean `decomposableAt 𝒜 β`). A family +`x i ∈ A_{wt i}` of positive weights whose members of each weight `β` are linearly independent +modulo `D_β` extends to a minimal system relative to `(A_β)`: in each nonzero weight, extend the +given classes to a basis of `A_β / (A_β ∩ D_β)` and lift the new basis vectors to `A_β`. +-/ + +universe u v w o + +open MvPolynomial Module + +public noncomputable section + +namespace OrdinalGraded + +variable {E : Type u} {R : Type v} [Field E] [CommRing R] [Algebra E R] +variable (𝒜 : NatOrdinal.{o} → Submodule E R) [GradedAlgebra 𝒜] +variable {ι : Type w} {wt : ι → NatOrdinal.{o}} {x : ι → R} + +omit [GradedAlgebra 𝒜] in +/-- **Extension to a minimal system.** Elements `x i ∈ A_{wt i}` of positive weight, linearly +independent in each weight `β` modulo `decomposableAt 𝒜 β`, are part of a minimal system +relative to `𝒜`: there are `wt'`, `x'` with `IsMinimalSystem 𝒜 wt' x'` and an injection `e` +satisfying `wt' (e i) = wt i` and `x' (e i) = x i`. -/ +@[blueprint "lem:extend-to-minimal-system" + (phase := "Algebraic and ordinal preliminaries") + (title := "Extension of a degreewise independent family") + (statement := /-- + Let $E$ be a field, let $R$ be a commutative $E$-algebra, and let + $(A_\alpha)_{\alpha\in\mathbf{On}}$ be a family of $E$-subspaces of $R$. + Put + \[ + D_\beta=\sum_{\substack{i\oplus j=\beta\\i,j\ne0}}A_iA_j. + \] + Suppose $w_i\ne0$, $x_i\in A_{w_i}$, and every finitely supported + combination $\sum_i c_ix_i$ with all $w_i=\beta$ belongs to $D_\beta$ + only when every $c_i$ is zero. Then there are a family $(x'_j)_{j\in I'}$, + weights $w'_j$, and an injection $e:I\to I'$ such that + $w'_j\ne0$, $x'_j\in A_{w'_j}$, $w'_{e(i)}=w_i$, and + $x'_{e(i)}=x_i$. Moreover, the $x'_j$ of weight $\beta$ are independent + modulo $D_\beta$ for every $\beta$ and span $A_\beta$ modulo $D_\beta$ + whenever $\beta\ne0$. + -/) + (proof := /-- + For every $\beta$, pass to $A_\beta/(A_\beta\cap D_\beta)$. Extend the + prescribed independent classes to a basis and choose lifts in $A_\beta$ for + the added basis vectors. The union over all nonzero + weights contains the original family and its classes give the required + independence and spanning properties weight by weight. + -/)] +theorem exists_isMinimalSystem_extension (hwt : ∀ i, wt i ≠ 0) (hmem : ∀ i, x i ∈ 𝒜 (wt i)) + (hind : ∀ (β : NatOrdinal) (c : ι →₀ E), (∀ i ∈ c.support, wt i = β) → + Finsupp.linearCombination E x c ∈ decomposableAt 𝒜 β → c = 0) : + ∃ (ι' : Type (max v w (o + 1))) (wt' : ι' → NatOrdinal.{o}) (x' : ι' → R) (e : ι → ι'), + Function.Injective e ∧ (∀ i, wt' (e i) = wt i) ∧ (∀ i, x' (e i) = x i) ∧ + IsMinimalSystem 𝒜 wt' x' := by + classical + -- the quotients `A_β / ((A_+)² ∩ A_β)` + let D : ∀ β : NatOrdinal, Submodule E (𝒜 β) := fun β ↦ (decomposableAt 𝒜 β).comap (𝒜 β).subtype + let mkV : ∀ β : NatOrdinal, (𝒜 β) →ₗ[E] ((𝒜 β) ⧸ D β) := fun β ↦ (D β).mkQ + have hmk : ∀ β (z : 𝒜 β), mkV β z = 0 ↔ (z : R) ∈ decomposableAt 𝒜 β := fun β z ↦ by + change Submodule.Quotient.mk z = 0 ↔ _ + rw [Submodule.Quotient.mk_eq_zero] + exact Iff.rfl + -- the classes of the given generators of degree `β` + have hmemβ : ∀ β (i : {i // wt i = β}), x i.1 ∈ 𝒜 β := fun β i ↦ by + have h := hmem i.1 + rwa [i.2] at h + let xs : ∀ β : NatOrdinal, {i // wt i = β} → (𝒜 β) ⧸ D β := fun β i ↦ mkV β ⟨x i.1, hmemβ β i⟩ + -- they are linearly independent + have hli : ∀ β, LinearIndependent E (xs β) := by + intro β + rw [linearIndependent_iff'] + intro s g hsum i hi + set c : ι →₀ E := ∑ j ∈ s, Finsupp.single j.1 (g j) with hcdef + have hcval : ∀ j ∈ s, c j.1 = g j := by + intro j hj + rw [hcdef, Finsupp.finsetSum_apply, Finset.sum_eq_single j] + · rw [Finsupp.single_eq_same] + · intro j' _ hj' + rw [Finsupp.single_apply, if_neg] + exact fun h ↦ hj' (Subtype.ext h) + · intro h; exact absurd hj h + have hcsupp : ∀ j ∈ c.support, wt j = β := by + intro j hj + obtain ⟨j', -, hjj'⟩ := Finset.mem_biUnion.mp (Finsupp.support_finsetSum hj) + have := Finsupp.support_single_subset hjj' + rw [Finset.mem_singleton] at this + rw [this]; exact j'.2 + have hlc : Finsupp.linearCombination E x c = ∑ j ∈ s, g j • x j.1 := by + rw [hcdef, map_sum] + exact Finset.sum_congr rfl fun j _ ↦ Finsupp.linearCombination_single _ _ _ + have hmem' : Finsupp.linearCombination E x c ∈ decomposableAt 𝒜 β := by + rw [hlc] + have h0 : mkV β (∑ j ∈ s, g j • (⟨x j.1, hmemβ β j⟩ : 𝒜 β)) = 0 := by + rw [map_sum] + simpa only [map_smul] using hsum + rw [hmk] at h0 + simpa only [Submodule.coe_sum, Submodule.coe_smul] using h0 + have hc0 := hind β c hcsupp hmem' + rw [← hcval i hi, hc0, Finsupp.zero_apply] + have hinjxs : ∀ β, Function.Injective (xs β) := fun β ↦ (hli β).injective + -- the basis extending the classes + let S : ∀ β : NatOrdinal, Set ((𝒜 β) ⧸ D β) := fun β ↦ Set.range (xs β) + have hS : ∀ β, LinearIndepOn E id (S β) := + fun β ↦ (linearIndepOn_id_range_iff (hinjxs β)).mpr (hli β) + let bas : ∀ β : NatOrdinal, Basis ((hS β).extend (Set.subset_univ _)) E ((𝒜 β) ⧸ D β) := + fun β ↦ Basis.extend (hS β) + -- the new generators: lifts of the basis vectors outside `S β` + let J : NatOrdinal → Type v := fun β ↦ + {q : (hS β).extend (Set.subset_univ _) // (q : (𝒜 β) ⧸ D β) ∉ S β} + have hlift : ∀ β (q : J β), ∃ r : 𝒜 β, mkV β r = q.1.1 := + fun β q ↦ Submodule.Quotient.mk_surjective (D β) q.1.1 + choose lift hlift using hlift + -- the extended system + let wt' : ι ⊕ (Σ β : {β : NatOrdinal // β ≠ 0}, J β.1) → NatOrdinal := + Sum.elim wt fun p ↦ p.1.1 + let x' : ι ⊕ (Σ β : {β : NatOrdinal // β ≠ 0}, J β.1) → R := + Sum.elim x fun p ↦ (lift p.1.1 p.2 : R) + have hmem' : ∀ j, x' j ∈ 𝒜 (wt' j) := by + rintro (i | ⟨β, q⟩) + · exact hmem i + · exact (lift β.1 q).2 + refine ⟨_, wt', x', Sum.inl, Sum.inl_injective, fun i ↦ rfl, fun i ↦ rfl, ?_⟩ + refine { ne_zero := ?_, mem := hmem', independent := ?_, spans := ?_ } + · rintro (i | ⟨β, q⟩) + · exact hwt i + · exact β.2 + · -- independence + intro β c hc hdec + -- the classes of the generators of degree `β` + have hmemβ' : ∀ j : {j // wt' j = β}, x' j.1 ∈ 𝒜 β := fun j ↦ by + have h := hmem' j.1 + rwa [j.2] at h + let ψ : {j // wt' j = β} → (𝒜 β) ⧸ D β := fun j ↦ mkV β ⟨x' j.1, hmemβ' j⟩ + have hψinl : ∀ (i : ι) (h : wt' (Sum.inl i) = β), ψ ⟨Sum.inl i, h⟩ = xs β ⟨i, h⟩ := + fun i h ↦ rfl + have hψinr : ∀ (β' : {β : NatOrdinal // β ≠ 0}) (q : J β'.1) (h : wt' (Sum.inr ⟨β', q⟩) = β), + ψ ⟨Sum.inr ⟨β', q⟩, h⟩ = h ▸ q.1.1 := by + rintro β' q h + change β'.1 = β at h + subst h + exact hlift β'.1 q + have hψS : ∀ j, ψ j ∈ (hS β).extend (Set.subset_univ _) := by + rintro ⟨(i | ⟨β', q⟩), hj⟩ + · rw [hψinl] + exact (hS β).subset_extend (Set.subset_univ _) ⟨⟨i, hj⟩, rfl⟩ + · rw [hψinr] + change β'.1 = β at hj + subst hj + exact q.1.2 + have hψinj : Function.Injective ψ := by + rintro ⟨(i | ⟨β', q⟩), hj⟩ ⟨(i' | ⟨β'', q'⟩), hj'⟩ heq + · rw [hψinl, hψinl] at heq + have := hinjxs β heq + exact Subtype.ext (congrArg Sum.inl (congrArg Subtype.val this)) + · rw [hψinl, hψinr] at heq + change β''.1 = β at hj' + subst hj' + exact absurd ⟨⟨i, hj⟩, heq⟩ q'.2 + · rw [hψinr, hψinl] at heq + change β'.1 = β at hj + subst hj + exact absurd ⟨⟨i', hj'⟩, heq.symm⟩ q.2 + · rw [hψinr, hψinr] at heq + change β'.1 = β at hj + change β''.1 = β at hj' + obtain ⟨β', hβ'⟩ := β' + obtain ⟨β'', hβ''⟩ := β'' + change β' = β at hj + change β'' = β at hj' + subst hj hj' + have hq : q = q' := Subtype.ext (Subtype.ext heq) + subst hq + rfl + have hψli : LinearIndependent E ψ := by + have : ψ = fun j ↦ bas β ⟨ψ j, hψS j⟩ := by + funext j + exact (Basis.extend_apply_self (hS β) ⟨ψ j, hψS j⟩).symm + rw [this] + exact (bas β).linearIndependent.comp _ fun j j' h ↦ hψinj (congrArg Subtype.val h) + -- the combination is zero in the quotient + have hZ : Finsupp.linearCombination E x' c ∈ 𝒜 β := by + rw [Finsupp.linearCombination_apply, Finsupp.sum] + refine Submodule.sum_mem _ fun j hj ↦ Submodule.smul_mem _ _ ?_ + rw [← hc j hj]; exact hmem' j + have hsum : ∑ j ∈ c.support.attach, c j.1 • ψ ⟨j.1, hc j.1 j.2⟩ = 0 := by + have h1 : (⟨Finsupp.linearCombination E x' c, hZ⟩ : 𝒜 β) = + ∑ j ∈ c.support.attach, c j.1 • ⟨x' j.1, hmemβ' ⟨j.1, hc j.1 j.2⟩⟩ := by + apply Subtype.ext + rw [Submodule.coe_sum] + change Finsupp.linearCombination E x' c = ∑ j ∈ c.support.attach, c j.1 • x' j.1 + rw [Finset.sum_attach c.support fun j ↦ c j • x' j, Finsupp.linearCombination_apply, + Finsupp.sum] + have h2 := (hmk β ⟨_, hZ⟩).mpr hdec + rw [h1, map_sum] at h2 + simpa only [map_smul] using h2 + have hall := linearIndependent_iff'.mp hψli + (c.support.attach.map ⟨fun j ↦ (⟨j.1, hc j.1 j.2⟩ : {j // wt' j = β}), + fun a b h ↦ Subtype.ext (by simpa using h)⟩) (fun t ↦ c t.1) (by + rw [Finset.sum_map] + exact hsum) + ext j + by_cases hj : j ∈ c.support + · exact hall ⟨j, hc j hj⟩ (Finset.mem_map.mpr ⟨⟨j, hj⟩, Finset.mem_attach _ _, rfl⟩) + · exact Finsupp.notMem_support_iff.mp hj + · -- spans + intro β hβ y hy + obtain ⟨l, hl⟩ : ∃ l, l = (bas β).repr (mkV β ⟨y, hy⟩) := ⟨_, rfl⟩ + let g : (hS β).extend (Set.subset_univ _) → ι ⊕ (Σ β : {β : NatOrdinal // β ≠ 0}, J β.1) := + fun q ↦ if h : (q : (𝒜 β) ⧸ D β) ∈ S β then Sum.inl (Classical.choose (Set.mem_range.mp h)).1 + else Sum.inr ⟨⟨β, hβ⟩, ⟨q, h⟩⟩ + have hg : ∀ q, wt' (g q) = β ∧ ∀ hq, mkV β ⟨x' (g q), hq⟩ = (q : (𝒜 β) ⧸ D β) := by + intro q + by_cases h : (q : (𝒜 β) ⧸ D β) ∈ S β + · have hspec := Classical.choose_spec (Set.mem_range.mp h) + have hq : g q = Sum.inl (Classical.choose (Set.mem_range.mp h)).1 := dif_pos h + refine ⟨by rw [hq]; exact (Classical.choose (Set.mem_range.mp h)).2, fun hq' ↦ ?_⟩ + rw [← hspec] + exact congrArg (mkV β) (Subtype.ext (by change x' (g q) = _; rw [hq]; rfl)) + · have hq : g q = Sum.inr ⟨⟨β, hβ⟩, ⟨q, h⟩⟩ := dif_neg h + refine ⟨by rw [hq]; rfl, fun hq' ↦ ?_⟩ + rw [← hlift β ⟨q, h⟩] + exact congrArg (mkV β) (Subtype.ext (by change x' (g q) = _; rw [hq]; rfl)) + have hmemg : ∀ q, x' (g q) ∈ 𝒜 β := fun q ↦ by + have h := hmem' (g q) + rwa [(hg q).1] at h + refine ⟨Finsupp.mapDomain g l, fun j hj ↦ ?_, ?_⟩ + · obtain ⟨q, -, hq⟩ := Finset.mem_image.mp (Finsupp.mapDomain_support hj) + rw [← hq] + exact (hg q).1 + · have hlc : Finsupp.linearCombination E x' (Finsupp.mapDomain g l) ∈ 𝒜 β := by + rw [Finsupp.linearCombination_mapDomain, Finsupp.linearCombination_apply, Finsupp.sum] + exact Submodule.sum_mem _ fun q _ ↦ Submodule.smul_mem _ _ (hmemg q) + rw [← hmk β ⟨y - Finsupp.linearCombination E x' (Finsupp.mapDomain g l), sub_mem hy hlc⟩] + have h1 : (⟨y - Finsupp.linearCombination E x' (Finsupp.mapDomain g l), + sub_mem hy hlc⟩ : 𝒜 β) = ⟨y, hy⟩ - ⟨_, hlc⟩ := rfl + rw [h1, map_sub, sub_eq_zero] + have h2 : (⟨Finsupp.linearCombination E x' (Finsupp.mapDomain g l), hlc⟩ : 𝒜 β) = + ∑ q ∈ l.support, l q • ⟨x' (g q), hmemg q⟩ := by + apply Subtype.ext + rw [Submodule.coe_sum] + change Finsupp.linearCombination E x' (Finsupp.mapDomain g l) = + ∑ q ∈ l.support, l q • x' (g q) + rw [Finsupp.linearCombination_mapDomain, Finsupp.linearCombination_apply, Finsupp.sum] + rfl + rw [h2, map_sum] + simp only [map_smul] + conv_lhs => rw [← (bas β).linearCombination_repr (mkV β ⟨y, hy⟩), ← hl, + Finsupp.linearCombination_apply, Finsupp.sum] + exact Finset.sum_congr rfl fun q _ ↦ by rw [Basis.extend_apply_self, (hg q).2] + +omit [GradedAlgebra 𝒜] in +/-- Every ordinal-graded algebra has a minimal system of homogeneous generators: extend the empty +family. -/ +theorem exists_isMinimalSystem : + ∃ (ι' : Type (max v (o + 1))) (wt' : ι' → NatOrdinal.{o}) (x' : ι' → R), + IsMinimalSystem 𝒜 wt' x' := by + obtain ⟨ι', wt', x', -, -, -, -, hmin⟩ := exists_isMinimalSystem_extension 𝒜 + (wt := (Empty.elim : Empty → NatOrdinal.{o})) (x := (Empty.elim : Empty → R)) + (fun i ↦ i.elim) (fun i ↦ i.elim) (fun _ c _ _ ↦ Finsupp.ext fun i ↦ i.elim) + exact ⟨ι', wt', x', hmin⟩ + +end OrdinalGraded diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/FinitePartSubstitution.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/FinitePartSubstitution.lean new file mode 100644 index 0000000000..0886d5e3ac --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/FinitePartSubstitution.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.OrdinalGenerators +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartDecomposition + + +/-! +# Values of the cofactors in the successor step + +The successor step writes a relation as `F = ∑_t (∂F/∂X_t)(X_t + V_t)` with each `V_t` homogeneous +of degree `wt t` and free of the variables carrying the finite part. What it then needs is that +each `V_t` evaluates into the square of the ideal of positive degree. + +The reason is that a monomial of degree `wt t` free of those variables cannot be a single variable: +if it were, that variable would carry the whole finite part, which the freeness forbids. So every +monomial splits into two factors of nonzero degree, and their product is decomposable. + +Only two properties of the generators are used, that each sits in its own degree and that no degree +is zero, so they are taken directly rather than through a minimal-system structure. +-/ + +universe u v w z + +open scoped NatOrdinal + +open MvPolynomial + +public noncomputable section + +namespace OrdinalGraded + +variable {K : Type u} {R : Type v} [Field K] [CommRing R] [Algebra K R] +variable {A : NatOrdinal.{z} → Submodule K R} [GradedAlgebra A] +variable {ι : Type w} {wt : ι → NatOrdinal.{z}} {x : ι → R} + +/-- Multiplying a decomposable element by a homogeneous one keeps it decomposable, at the sum of +the degrees. -/ +theorem mul_mem_decomposableAt_of_mem_decomposableAt {g β : NatOrdinal.{z}} {z y : R} + (hz : z ∈ decomposableAt A g) (hy : y ∈ A β) : z * y ∈ decomposableAt A (g + β) := by + have hle : decomposableAt A g ≤ + (decomposableAt A (g + β)).comap (LinearMap.mulRight K y) := by + refine decomposableAt_le A fun i j hi hj hij ↦ ?_ + rw [Submodule.mul_le] + intro a ha b hb + rw [Submodule.mem_comap, LinearMap.mulRight_apply, mul_assoc] + have hjβ : j + β ≠ 0 := fun h ↦ hj (le_antisymm (h ▸ NatOrdinal.le_add_right) zero_le) + rw [← hij, add_assoc] + exact mul_mem_decomposableAt A hi hjβ ha (SetLike.mul_mem_graded hb hy) + exact hle hz + +/-- **A cofactor evaluates into the square of the ideal of positive degree.** A homogeneous +polynomial of degree `g` with finite part `n ≥ 1`, free of the variables carrying that finite part, +has no monomial equal to a single variable, so each of its monomials splits into two factors of +nonzero degree. -/ +theorem aeval_mem_decomposableAt_of_mem_supported + (hmem : ∀ i, x i ∈ A (wt i)) (hne : ∀ i, wt i ≠ 0) + {V : MvPolynomial ι K} {g : NatOrdinal.{z}} + (hg : 0 < g.constantCoeff) (hV : IsWeightedHomogeneous wt V g) + (hsupp : V ∈ supported K {i | (wt i).constantCoeff ≠ g.constantCoeff}) : + aeval x V ∈ decomposableAt A g := by + classical + rw [V.as_sum, map_sum] + refine sum_mem fun d hd ↦ ?_ + have hwd : Finsupp.weight wt d = g := hV (mem_support_iff.mp hd) + -- the monomial has a variable `i` not carrying the finite part, and is not `X_i` alone + have hdne : d ≠ 0 := by + rintro rfl + rw [map_zero] at hwd + rw [← hwd, NatOrdinal.constantCoeff_zero] at hg + exact lt_irrefl _ hg + obtain ⟨i, hi⟩ := Finsupp.support_nonempty_iff.mpr hdne + have hik : (wt i).constantCoeff ≠ g.constantCoeff := + (mem_supported.mp hsupp) ((mem_vars_iff_mem_support i).mpr ⟨d, hd, hi⟩) + obtain ⟨d', hd'def⟩ : ∃ d', d' = d - Finsupp.single i 1 := ⟨_, rfl⟩ + have hsplit : Finsupp.weight wt d' + wt i = g := by + rw [hd'def, Finsupp.weight_sub_single_add (w := wt) (Finsupp.mem_support_iff.mp hi), hwd] + have hd'ne : d' ≠ 0 := by + intro h0 + rw [h0, map_zero, zero_add] at hsplit + exact hik (by rw [hsplit]) + obtain ⟨j, hj⟩ := Finsupp.support_nonempty_iff.mpr hd'ne + have hwd' : Finsupp.weight wt d' ≠ 0 := fun h ↦ by + have hle := Finsupp.le_weight_of_mem_support wt d' hj + rw [h] at hle + exact hne j (le_antisymm hle zero_le) + -- `X^d = X^{d'} * X_i` + have hmono : monomial d (coeff d V) = C (coeff d V) * (monomial d' 1 * X i) := by + rw [X, monomial_mul, mul_one, C_mul_monomial, mul_one, hd'def, + Finsupp.sub_add_single_one_cancel (Finsupp.mem_support_iff.mp hi)] + rw [hmono, map_mul, map_mul, ← algebraMap_eq, AlgHom.commutes, Algebra.algebraMap_eq_smul_one, + smul_mul_assoc, one_mul] + refine Submodule.smul_mem _ _ ?_ + have h1 : aeval x (monomial d' (1 : K)) ∈ A (Finsupp.weight wt d') := + aeval_mem_of_forall_mem hmem (isWeightedHomogeneous_monomial wt d' 1 rfl) + rw [aeval_X, ← hsplit] + exact mul_mem_decomposableAt A hwd' (hne i) h1 (hmem i) + +end OrdinalGraded + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/HomogeneousSpan.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/HomogeneousSpan.lean new file mode 100644 index 0000000000..613337ae6f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/HomogeneousSpan.lean @@ -0,0 +1,123 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Mu +public import Mathlib.LinearAlgebra.Finsupp.LinearCombination + +/-! +# Homogeneous components of the ideal generated by homogeneous elements + +Let `A` (Lean `R`) be an algebra graded by `NatOrdinal` and `q j ∈ A_{c j}` finitely many +homogeneous elements of degrees `c j`. The degree-`α` component of `(q j) r` is `(q j) r_β` for +the unique `β` with `β ⊕ c j = α`, that is `β = α ⊖ c j` when `c j ≼ α` in the algebraic order, +and `0` otherwise (the natural sum is cancellative, so `β` is unique when it exists, but unlike the +case of `ℕ` it need not exist: `β ⊕ 1 = ω` has no solution). Consequently a homogeneous element of +degree `α` of the ideal `(q j)` is `∑_j (q j) (u j)` with `u j ∈ A_{α ⊖ c j}` when `c j ≼ α`, +and `u j = 0` otherwise. +-/ + +universe u v w + +open DirectSum + +public noncomputable section + +namespace OrdinalGraded + +variable {E : Type u} {R : Type v} [Field E] [CommRing R] [Algebra E R] +variable {𝒜 : NatOrdinal → Submodule E R} [GradedAlgebra 𝒜] + +open Classical in +/-- The degree-`α` component of `q * r` for `q ∈ 𝒜 c`: `q * r_β` if `β ⊕ c = α`, and `0` if +`c` does not precede `α` in the algebraic order. -/ +theorem coe_decompose_mul_of_left_mem {q : R} {c : NatOrdinal} (hq : q ∈ 𝒜 c) (r : R) + (α : NatOrdinal) : + (decompose 𝒜 (q * r) α : R) = + if h : ∃ β, β + c = α then q * (decompose 𝒜 r (Classical.choose h) : R) else 0 := by + split_ifs with h + · obtain ⟨β₀, hβ₀⟩ : ∃ β₀, Classical.choose h = β₀ := ⟨_, rfl⟩ + have hβ : β₀ + c = α := hβ₀ ▸ Classical.choose_spec h + rw [hβ₀] + subst hβ + -- expand `r` into its components: only `q * r_β₀` has degree `β₀ + c` + rw [← GradedRing.proj_apply] + conv_lhs => rw [← sum_support_decompose 𝒜 r, Finset.mul_sum, map_sum] + have hmem : ∀ β, q * (decompose 𝒜 r β : R) ∈ 𝒜 (c + β) := fun β ↦ + SetLike.mul_mem_graded hq (decompose 𝒜 r β).2 + rw [Finset.sum_eq_single β₀] + · rw [GradedRing.proj_apply, add_comm] + exact decompose_of_mem_same 𝒜 (hmem β₀) + · intro β _ hβ + rw [GradedRing.proj_apply] + exact decompose_of_mem_ne 𝒜 (hmem β) fun heq ↦ + hβ (add_left_cancel (heq.trans (add_comm _ _))) + · intro hnot + rw [DFinsupp.notMem_support_iff.mp hnot, Submodule.coe_zero, mul_zero, map_zero] + · -- expand `r` into its components: every `q * r_β` has degree `c + β ≠ α` + rw [← GradedRing.proj_apply] + conv_lhs => rw [← sum_support_decompose 𝒜 r, Finset.mul_sum, map_sum] + refine Finset.sum_eq_zero fun β _ ↦ ?_ + have hmem : q * (decompose 𝒜 r β : R) ∈ 𝒜 (c + β) := + SetLike.mul_mem_graded hq (decompose 𝒜 r β).2 + rw [GradedRing.proj_apply] + exact decompose_of_mem_ne 𝒜 hmem fun heq ↦ h ⟨β, by rw [add_comm]; exact heq⟩ + +/-- **The homogeneous components of an element of the ideal generated by homogeneous elements.** +If `q j ∈ 𝒜 (c j)` and `x` lies in the ideal `(q j)`, then the degree-`α` component of `x` is +`∑_j (q j) (u j)` with `u j ∈ 𝒜 β` for the `β` with `β ⊕ c j = α`, and `u j = 0` if `c j` is not a +below `α` in the algebraic order. -/ +theorem exists_decompose_eq_sum_mul_of_mem_span {ι : Type w} [Fintype ι] {q : ι → R} + {c : ι → NatOrdinal} (hq : ∀ j, q j ∈ 𝒜 (c j)) {x : R} (hxI : x ∈ Ideal.span (Set.range q)) + (α : NatOrdinal) : + ∃ u : ι → R, (∀ j, ∀ β, β + c j = α → u j ∈ 𝒜 β) ∧ (∀ j, (¬ ∃ β, β + c j = α) → u j = 0) ∧ + (decompose 𝒜 x α : R) = ∑ j, q j * u j := by + classical + obtain ⟨r, hr⟩ := (Submodule.mem_span_range_iff_exists_fun R).mp hxI + have hr' : ∑ j, q j * r j = x := by + rw [← hr] + exact Finset.sum_congr rfl fun j _ ↦ by rw [smul_eq_mul, mul_comm] + refine ⟨fun j ↦ if h : ∃ β, β + c j = α then (decompose 𝒜 (r j) (Classical.choose h) : R) else 0, + fun j β hβ ↦ ?_, fun j h ↦ dif_neg h, ?_⟩ + · have h : ∃ β, β + c j = α := ⟨β, hβ⟩ + have hβ' : ∀ h' : ∃ β, β + c j = α, Classical.choose h' = β := fun h' ↦ + add_right_cancel ((Classical.choose_spec h').trans hβ.symm) + beta_reduce + rw [dif_pos h, hβ'] + exact (decompose 𝒜 (r j) β).2 + · calc (decompose 𝒜 x α : R) = GradedRing.proj 𝒜 α (∑ j, q j * r j) := by + rw [GradedRing.proj_apply, hr'] + _ = ∑ j, GradedRing.proj 𝒜 α (q j * r j) := map_sum _ _ _ + _ = _ := Finset.sum_congr rfl fun j _ ↦ by + rw [GradedRing.proj_apply, coe_decompose_mul_of_left_mem (hq j) (r j) α, mul_dite, + mul_zero] + +/-- **Homogeneous elements of the ideal generated by homogeneous elements.** If `q j ∈ 𝒜 (c j)` +and `x ∈ 𝒜 α` lies in the ideal `(q j)`, then `x = ∑_j (q j) (u j)`, where `u j ∈ 𝒜 β` +whenever `β ⊕ c j = α`, and `u j = 0` if no such `β` exists. -/ +@[blueprint "lem:homogeneous-element-of-generated-ideal" + (phase := "Algebraic and ordinal preliminaries") + (title := "Homogeneous decomposition in a finitely generated graded ideal") + (statement := /-- + For a finite family of homogeneous elements $Q_j\in A_{c_j}$, if + $x\in A_\alpha$ lies in the ideal generated by the $Q_j$, then there are + $u_j$ such that $x=\sum_jQ_ju_j$, where $u_j\in A_\beta$ whenever + $\beta\oplus c_j=\alpha$, and $u_j=0$ if no such $\beta$ exists. + -/) + (proof := /-- + Apply the componentwise ideal representation and use $x_\alpha=x$. + -/)] +theorem exists_eq_sum_mul_of_mem_span {ι : Type w} [Fintype ι] {q : ι → R} {c : ι → NatOrdinal} + (hq : ∀ j, q j ∈ 𝒜 (c j)) {x : R} {α : NatOrdinal} (hx : x ∈ 𝒜 α) + (hxI : x ∈ Ideal.span (Set.range q)) : + ∃ u : ι → R, (∀ j, ∀ β, β + c j = α → u j ∈ 𝒜 β) ∧ (∀ j, (¬ ∃ β, β + c j = α) → u j = 0) ∧ + x = ∑ j, q j * u j := by + obtain ⟨u, hu, hu0, hsum⟩ := exists_decompose_eq_sum_mul_of_mem_span hq hxI α + exact ⟨u, hu, hu0, by rw [← hsum, decompose_of_mem_same 𝒜 hx]⟩ + +end OrdinalGraded diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/HomogeneousZeroDivisors.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/HomogeneousZeroDivisors.lean new file mode 100644 index 0000000000..620f31da59 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/HomogeneousZeroDivisors.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.RingTheory.GradedAlgebra.Radical + +/-! +# Graded rings without homogeneous zero divisors + +A commutative ring graded by a linearly ordered cancellative monoid in which the product of two +nonzero homogeneous elements is nonzero is a domain: the zero ideal is homogeneous, and a +homogeneous ideal which is prime on homogeneous elements is prime +(`Ideal.IsHomogeneous.isPrime_of_homogeneous_mem_or_mem`). +-/ + +public section + +variable {ι σ A : Type*} [CommRing A] [AddCommMonoid ι] [LinearOrder ι] + [IsOrderedCancelAddMonoid ι] [SetLike σ A] [AddSubmonoidClass σ A] + +/-- A graded ring in which a product of homogeneous elements vanishes only if one factor does is +a domain. -/ +theorem GradedRing.isDomain_of_homogeneous_eq_zero_or_eq_zero (𝒜 : ι → σ) [GradedRing 𝒜] + [Nontrivial A] + (h : ∀ {x y : A}, SetLike.IsHomogeneousElem 𝒜 x → SetLike.IsHomogeneousElem 𝒜 y → + x * y = 0 → x = 0 ∨ y = 0) : IsDomain A := + have : (⊥ : Ideal A).IsPrime := + (Ideal.IsHomogeneous.bot 𝒜).isPrime_of_homogeneous_mem_or_mem bot_ne_top fun hx hy hxy ↦ by + simpa only [Ideal.mem_bot] using h hx hy (Ideal.mem_bot.mp hxy) + IsDomain.of_bot_isPrime A + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/OrdinalGenerators.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/OrdinalGenerators.lean new file mode 100644 index 0000000000..b0f8da8ee5 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/OrdinalGenerators.lean @@ -0,0 +1,613 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Mu +public import Mathlib.Algebra.MvPolynomial.Eval +public import Mathlib.RingTheory.MvPolynomial.WeightedHomogeneous +public import Mathlib.Algebra.MvPolynomial.Variables + +/-! +# Homogeneous generators of an ordinal-graded algebra + +Let `A` (Lean `R`) be a commutative algebra over a field `E` graded by `NatOrdinal` (the ordinals +under the natural sum `⊕`), so that `A_i A_j ⊆ A_{i ⊕ j}`. Let `A_+ := ⨁_{β ≠ 0} A_β` be the ideal +of elements of positive degree; its square meets `A_β` in +`(A_+)² ∩ A_β = ∑_{i ⊕ j = β, i, j ≠ 0} A_i A_j` (the decomposable elements of degree `β`; Lean +`decomposableAt 𝒜 β`). A *minimal system of homogeneous generators* is a family of homogeneous +elements `x i ∈ A_{wt i}` of positive degree whose members of each degree `β` are linearly +independent modulo `(A_+)² ∩ A_β` and span `A_β` modulo it — a basis of a complement of +`(A_+)² ∩ A_β` in `A_β` for every `β ≠ 0`. Evaluation `E[X_i] → A`, `X_i ↦ x i`, is then graded +for the degrees `deg X_i = wt i` (Mathlib's `IsWeightedHomogeneous wt`) and surjective, by +well-founded induction on the degree. Whether it is injective is the question whether `A` is a +polynomial algebra on the generators; this file only names the homogeneous pieces of that question, +`InjectiveAt β` (evaluation is injective in degree `β`), and shows that they assemble into the +injectivity of evaluation. The finite-degree theory of +`ConwayRefinement.Algebra.LoweringDerivation` is the case of degrees in `ℕ`. +-/ + +universe u v w o + +open LoweringDerivation MvPolynomial + +public noncomputable section + +namespace OrdinalGraded + +variable {E : Type u} {R : Type v} [Field E] [CommRing R] [Algebra E R] +variable (𝒜 : NatOrdinal.{o} → Submodule E R) [GradedAlgebra 𝒜] + +/-! ### The square of the ideal of positive degree -/ + +/-- `(A_+)² ∩ A_β = ∑_{i ⊕ j = β, i, j ≠ 0} A_i A_j`, the square of the ideal of positive degree +in degree `β`. -/ +def decomposableAt (β : NatOrdinal.{o}) : Submodule E R := + ⨆ (i : NatOrdinal.{o}) (j : NatOrdinal.{o}) (_ : i ≠ 0) (_ : j ≠ 0) (_ : i + j = β), 𝒜 i * 𝒜 j + +omit [GradedAlgebra 𝒜] in +theorem decomposableAt_le {β : NatOrdinal.{o}} {N : Submodule E R} + (h : ∀ i j : NatOrdinal.{o}, i ≠ 0 → j ≠ 0 → i + j = β → 𝒜 i * 𝒜 j ≤ N) : + decomposableAt 𝒜 β ≤ N := + iSup_le fun i ↦ iSup_le fun j ↦ iSup_le fun hi ↦ iSup_le fun hj ↦ iSup_le fun hij ↦ + h i j hi hj hij + +omit [GradedAlgebra 𝒜] in +theorem mul_mem_decomposableAt {i j : NatOrdinal.{o}} (hi : i ≠ 0) (hj : j ≠ 0) {a b : R} + (ha : a ∈ 𝒜 i) (hb : b ∈ 𝒜 j) : a * b ∈ decomposableAt 𝒜 (i + j) := + Submodule.mem_iSup_of_mem i (Submodule.mem_iSup_of_mem j (Submodule.mem_iSup_of_mem hi + (Submodule.mem_iSup_of_mem hj (Submodule.mem_iSup_of_mem rfl (Submodule.mul_mem_mul ha hb))))) + +/-- `(A_+)² ∩ A_β` lies in `A_β`. -/ +theorem decomposableAt_le_degree (β : NatOrdinal.{o}) : decomposableAt 𝒜 β ≤ 𝒜 β := + decomposableAt_le 𝒜 fun i j _ _ hij ↦ by + rw [← hij] + exact Submodule.mul_le.mpr fun a ha b hb ↦ SetLike.mul_mem_graded ha hb + +/-! ### Minimal systems of homogeneous generators -/ + +variable {ι : Type w} (wt : ι → NatOrdinal.{o}) (x : ι → R) + +/-- A minimal system of homogeneous generators of an ordinal-graded algebra: homogeneous elements +`x i ∈ A_{wt i}` of positive degree whose members of degree `β` are linearly independent modulo +`(A_+)² ∩ A_β = ∑_{i ⊕ j = β, i, j ≠ 0} A_i A_j` and span `A_β` modulo it, for every `β ≠ 0`. -/ +structure IsMinimalSystem : Prop where + /-- Every generator has positive degree. -/ + ne_zero : ∀ i, wt i ≠ 0 + /-- `x i` is homogeneous of degree `wt i`. -/ + mem : ∀ i, x i ∈ 𝒜 (wt i) + /-- The generators of degree `β` are linearly independent modulo `(A_+)² ∩ A_β`. -/ + independent : ∀ (β : NatOrdinal.{o}) (c : ι →₀ E), (∀ i ∈ c.support, wt i = β) → + Finsupp.linearCombination E x c ∈ decomposableAt 𝒜 β → c = 0 + /-- The generators of degree `β` span `A_β` modulo `(A_+)² ∩ A_β`, for `β ≠ 0`. -/ + spans : ∀ β : NatOrdinal.{o}, β ≠ 0 → ∀ y ∈ 𝒜 β, ∃ c : ι →₀ E, + (∀ i ∈ c.support, wt i = β) ∧ y - Finsupp.linearCombination E x c ∈ decomposableAt 𝒜 β + +variable {𝒜 wt x} + +/-! ### Graded evaluation -/ + +/-- Evaluation of a polynomial homogeneous of degree `β` (for `deg X_i = wt i`) at homogeneous +elements `x i ∈ A_{wt i}` lands in `A_β`. -/ +theorem aeval_mem_of_forall_mem (hmem : ∀ i, x i ∈ 𝒜 (wt i)) {F : MvPolynomial ι E} + {β : NatOrdinal.{o}} (hF : IsWeightedHomogeneous wt F β) : aeval x F ∈ 𝒜 β := by + induction hF using IsWeightedHomogeneous.induction_on with + | zero => rw [map_zero]; exact zero_mem _ + | add p q hp hq ihp ihq => rw [map_add]; exact add_mem ihp ihq + | monomial d r hr => + rw [aeval_monomial, ← hr, Finsupp.weight_apply, Finsupp.sum, Finsupp.prod] + have h1 : ∏ i ∈ d.support, x i ^ d i ∈ 𝒜 (∑ i ∈ d.support, d i • wt i) := + SetLike.prod_mem_graded 𝒜 (fun i ↦ d i • wt i) (fun i ↦ x i ^ d i) + fun i _ ↦ SetLike.pow_mem_graded _ (hmem i) + have h2 := SetLike.mul_mem_graded (SetLike.algebraMap_mem_graded 𝒜 r) h1 + rwa [zero_add] at h2 + +/-- Evaluation at homogeneous `x i ∈ A_{wt i}` is graded: the degree-`β` component of `F(x)` is +the evaluation of the degree-`β` component of `F`. -/ +theorem decompose_aeval (hmem : ∀ i, x i ∈ 𝒜 (wt i)) (F : MvPolynomial ι E) (β : NatOrdinal.{o}) : + (DirectSum.decompose 𝒜 (aeval x F) β : R) = + aeval x (weightedHomogeneousComponent wt β F) := by + classical + have hmem' : ∀ m : NatOrdinal.{o}, aeval x (weightedHomogeneousComponent wt m F) ∈ 𝒜 m := + fun m ↦ aeval_mem_of_forall_mem hmem + (weightedHomogeneousComponent_isWeightedHomogeneous (w := wt) (n := m) (φ := F)) + conv_lhs => rw [← sum_weightedHomogeneousComponent wt F, + finsum_eq_sum _ (weightedHomogeneousComponent_finsupp F), map_sum, DirectSum.decompose_sum, + DirectSum.sum_apply, Submodule.coe_sum] + rw [Finset.sum_eq_single β (fun m _ hne ↦ DirectSum.decompose_of_mem_ne 𝒜 (hmem' m) hne) + fun hn ↦ ?_, DirectSum.decompose_of_mem_same 𝒜 (hmem' β)] + rw [Set.Finite.mem_toFinset, Function.mem_support, not_not] at hn + rw [hn, map_zero, DirectSum.decompose_zero, DirectSum.zero_apply, Submodule.coe_zero] + +/-- A linear combination of the generators is the evaluation of the same combination of the +variables. -/ +theorem aeval_linearCombination_X (c : ι →₀ E) : + aeval x (Finsupp.linearCombination E (X : ι → MvPolynomial ι E) c) = + Finsupp.linearCombination E x c := by + rw [← AlgHom.toLinearMap_apply, Finsupp.apply_linearCombination] + congr 2 + funext i + exact aeval_X x i + +/-- A linear combination of variables of degree `β` is homogeneous of degree `β`. -/ +theorem isWeightedHomogeneous_linearCombination_X {β : NatOrdinal.{o}} (c : ι →₀ E) + (hc : ∀ i ∈ c.support, wt i = β) : + IsWeightedHomogeneous wt (Finsupp.linearCombination E (X : ι → MvPolynomial ι E) c) β := by + rw [Finsupp.linearCombination_apply, Finsupp.sum] + refine IsWeightedHomogeneous.sum _ _ _ fun i hi ↦ ?_ + rw [smul_eq_C_mul] + have := (isWeightedHomogeneous_C wt (c i)).mul (isWeightedHomogeneous_X E wt i) + rwa [zero_add, hc i hi] at this + +/-! ### Generation -/ + +namespace IsMinimalSystem + +variable (hx : IsMinimalSystem 𝒜 wt x) +include hx + +omit hx [GradedAlgebra 𝒜] in +private theorem map_decomposableAt + {S : Type*} [CommRing S] [Algebra E S] + {ℬ : NatOrdinal.{o} → Submodule E S} + (e : R ≃ₐ[E] S) (hgrade : ∀ (n : NatOrdinal.{o}) (r : R), r ∈ 𝒜 n ↔ e r ∈ ℬ n) + {n : NatOrdinal.{o}} {r : R} (hr : r ∈ decomposableAt 𝒜 n) : + e r ∈ decomposableAt ℬ n := by + apply (decomposableAt_le 𝒜 fun i j hi hj hij ↦ ?_ : + decomposableAt 𝒜 n ≤ (decomposableAt ℬ n).comap e.toLinearMap) hr + apply Submodule.mul_le.mpr + intro a ha b hb + change e (a * b) ∈ decomposableAt ℬ n + rw [show e (a * b) = e a * e b from map_mul e a b, ← hij] + exact mul_mem_decomposableAt ℬ hi hj (hgrade i a |>.mp ha) (hgrade j b |>.mp hb) + +omit hx [GradedAlgebra 𝒜] in +private theorem symm_mem_decomposableAt + {S : Type*} [CommRing S] [Algebra E S] + {ℬ : NatOrdinal.{o} → Submodule E S} + (e : R ≃ₐ[E] S) (hgrade : ∀ (n : NatOrdinal.{o}) (r : R), r ∈ 𝒜 n ↔ e r ∈ ℬ n) + {n : NatOrdinal.{o}} {s : S} (hs : s ∈ decomposableAt ℬ n) : + e.symm s ∈ decomposableAt 𝒜 n := by + apply (decomposableAt_le ℬ fun i j hi hj hij ↦ ?_ : + decomposableAt ℬ n ≤ (decomposableAt 𝒜 n).comap e.symm.toLinearMap) hs + apply Submodule.mul_le.mpr + intro a ha b hb + change e.symm (a * b) ∈ decomposableAt 𝒜 n + rw [show e.symm (a * b) = e.symm a * e.symm b from map_mul e.symm a b, ← hij] + exact mul_mem_decomposableAt 𝒜 hi hj + ((hgrade i (e.symm a)).mpr (by simpa)) ((hgrade j (e.symm b)).mpr (by simpa)) + +omit [GradedAlgebra 𝒜] in +/-- An algebra equivalence preserving every homogeneous component carries minimal systems to +minimal systems. -/ +theorem map_algEquiv + {S : Type*} [CommRing S] [Algebra E S] + {ℬ : NatOrdinal.{o} → Submodule E S} [GradedAlgebra ℬ] + (e : R ≃ₐ[E] S) (hgrade : ∀ (n : NatOrdinal.{o}) (r : R), r ∈ 𝒜 n ↔ e r ∈ ℬ n) : + IsMinimalSystem ℬ wt (fun i ↦ e (x i)) where + ne_zero := hx.ne_zero + mem i := (hgrade (wt i) (x i)).mp (hx.mem i) + independent β c hc hmem := by + apply hx.independent β c hc + have hlc : e (Finsupp.linearCombination E x c) = + Finsupp.linearCombination E (fun i ↦ e (x i)) c := by + rw [Finsupp.linearCombination_apply, Finsupp.linearCombination_apply, + Finsupp.sum, Finsupp.sum, map_sum] + apply Finset.sum_congr rfl + intro i _ + exact map_smul e (c i) (x i) + have hmem' : e (Finsupp.linearCombination E x c) ∈ decomposableAt ℬ β := by + rw [hlc] + exact hmem + simpa only [AlgEquiv.symm_apply_apply] using + symm_mem_decomposableAt e hgrade hmem' + spans β hβ y hy := by + obtain ⟨c, hc, hmem⟩ := hx.spans β hβ (e.symm y) + ((hgrade β (e.symm y)).mpr (by simpa)) + refine ⟨c, hc, ?_⟩ + have hlc : e (Finsupp.linearCombination E x c) = + Finsupp.linearCombination E (fun i ↦ e (x i)) c := by + rw [Finsupp.linearCombination_apply, Finsupp.linearCombination_apply, + Finsupp.sum, Finsupp.sum, map_sum] + apply Finset.sum_congr rfl + intro i _ + exact map_smul e (c i) (x i) + have hmem' := map_decomposableAt e hgrade hmem + simpa only [map_sub, AlgEquiv.apply_symm_apply, hlc] using hmem' + +omit [GradedAlgebra 𝒜] in +/-- No generator of a minimal system is zero: zero lies in `(A_+)² ∩ A_β`. -/ +theorem apply_ne_zero (i : ι) : x i ≠ 0 := by + intro h0 + have h := hx.independent (wt i) (Finsupp.single i 1) (fun j hj ↦ by + rw [((Finsupp.mem_support_single j i 1).mp hj).1]) (by + rw [Finsupp.linearCombination_single, one_smul, h0] + exact zero_mem _) + exact one_ne_zero (Finsupp.single_eq_zero.mp h) + +/-- Evaluation of a polynomial homogeneous of degree `β` lands in `A_β`. -/ +theorem aeval_mem {F : MvPolynomial ι E} {β : NatOrdinal.{o}} (hF : IsWeightedHomogeneous wt F β) : + aeval x F ∈ 𝒜 β := + aeval_mem_of_forall_mem hx.mem hF + +omit [GradedAlgebra 𝒜] in +/-- Every element of `A_β` is the evaluation of a weighted-homogeneous polynomial of weight `β` +at a minimal system relative to the family `𝒜`. -/ +@[blueprint "lem:generate" + (phase := "Algebraic and ordinal preliminaries") + (title := "Weighted-homogeneous polynomial representatives") + (statement := /-- + Let $E$ be a field, let $R$ be a commutative $E$-algebra, and let + $(A_\alpha)_{\alpha\in\mathbf{On}}$ be a family of $E$-subspaces of $R$. + Put + \[ + D_\beta=\sum_{\substack{i\oplus j=\beta\\i,j\ne0}}A_iA_j. + \] + Let $(x_i,w_i)$ have positive weights, with $x_i\in A_{w_i}$. Suppose the + $x_i$ of weight $\beta$ are independent modulo $D_\beta$ for every + $\beta$ and span $A_\beta$ modulo $D_\beta$ whenever $\beta\ne0$. + If every element of $A_0$ is a scalar from $E$, then every $y\in A_\beta$ + equals $F(x)$ for some $F\in E[X_i:i\in I]$ weighted-homogeneous of + weight $\beta$. + -/) + (proof := /-- + Proceed by well-founded induction on $\beta$. At weight zero the hypothesis + makes $y$ a constant polynomial value. At positive weight, write $y$ modulo + $D_\beta$ as a linear combination of the weight-$\beta$ generators. Every + product defining $D_\beta$ has two positive weights strictly below $\beta$, + so induction represents both factors by weighted-homogeneous polynomials. + Adding their products to the linear combination gives the required polynomial. + -/)] +theorem exists_aeval_eq (h0 : GradeZeroScalars 𝒜) (β : NatOrdinal.{o}) : + ∀ y ∈ 𝒜 β, ∃ F : MvPolynomial ι E, IsWeightedHomogeneous wt F β ∧ aeval x F = y := by + induction β using WellFoundedLT.induction with + | _ β ih => + intro y hy + rcases eq_or_ne β 0 with rfl | hβ + · obtain ⟨e, rfl⟩ := (gradeZeroScalars_iff 𝒜).mp h0 y hy + exact ⟨C e, isWeightedHomogeneous_C wt e, aeval_C x e⟩ + · obtain ⟨c, hcw, hc⟩ := hx.spans β hβ y hy + -- the elements of degree `β` that are values of homogeneous polynomials form a submodule + -- containing `(A_+)² ∩ A_β` + let N : Submodule E R := + { carrier := {z | ∃ F : MvPolynomial ι E, IsWeightedHomogeneous wt F β ∧ aeval x F = z} + zero_mem' := ⟨0, isWeightedHomogeneous_zero E wt β, map_zero _⟩ + add_mem' := fun ⟨F, hF, hFz⟩ ⟨G, hG, hGz⟩ ↦ + ⟨F + G, hF.add hG, by rw [map_add, hFz, hGz]⟩ + smul_mem' := fun e _ ⟨F, hF, hFz⟩ ↦ + ⟨C e * F, by simpa using (isWeightedHomogeneous_C wt e).mul hF, + by rw [map_mul, aeval_C, hFz, Algebra.smul_def]⟩ } + have hD : decomposableAt 𝒜 β ≤ N := by + refine decomposableAt_le 𝒜 fun i j hi hj hij ↦ Submodule.mul_le.mpr fun a ha b hb ↦ ?_ + have hi' : i < β := hij ▸ lt_add_of_pos_right i (pos_iff_ne_zero.mpr hj) + have hj' : j < β := hij ▸ lt_add_of_pos_left j (pos_iff_ne_zero.mpr hi) + obtain ⟨F, hF, hFa⟩ := ih i hi' a ha + obtain ⟨G, hG, hGb⟩ := ih j hj' b hb + exact ⟨F * G, hij ▸ hF.mul hG, by rw [map_mul, hFa, hGb]⟩ + obtain ⟨G, hG, hGz⟩ := hD hc + refine ⟨G + Finsupp.linearCombination E (X : ι → MvPolynomial ι E) c, + hG.add (isWeightedHomogeneous_linearCombination_X c hcw), ?_⟩ + rw [map_add, hGz, aeval_linearCombination_X, sub_add_cancel] + +/-- Evaluation is surjective. -/ +theorem aeval_surjective (h0 : GradeZeroScalars 𝒜) : + Function.Surjective (aeval x : MvPolynomial ι E →ₐ[E] R) := by + intro y + induction y using DirectSum.Decomposition.inductionOn 𝒜 with + | zero => exact ⟨0, map_zero _⟩ + | homogeneous z => + obtain ⟨F, -, hF⟩ := hx.exists_aeval_eq h0 _ z.1 z.2 + exact ⟨F, hF⟩ + | add y z hy hz => + obtain ⟨F, rfl⟩ := hy + obtain ⟨G, rfl⟩ := hz + exact ⟨F + G, map_add _ _ _⟩ + +end IsMinimalSystem + +/-! ### Homogeneous polynomials of degree zero -/ + +omit [GradedAlgebra 𝒜] in +/-- For degrees `wt i ≠ 0`, a polynomial homogeneous of degree zero is a constant. -/ +theorem eq_C_of_isWeightedHomogeneous_zero (hwt : ∀ i, wt i ≠ 0) {p : MvPolynomial ι E} + (hp : IsWeightedHomogeneous wt p 0) : p = C (coeff 0 p) := by + classical + ext m + rw [coeff_C] + split_ifs with hm + · rw [hm] + · by_contra h + have hw := hp h + obtain ⟨i, hi⟩ := Finsupp.support_nonempty_iff.mpr (fun h ↦ hm h.symm) + have hi' : m i ≠ 0 := Finsupp.mem_support_iff.mp hi + rw [Finsupp.weight_apply, Finsupp.sum, + Finset.sum_eq_zero_iff_of_nonneg fun _ _ ↦ bot_le] at hw + have h1 : wt i ≤ m i • wt i := by + simpa using nsmul_le_nsmul_left (bot_le : (0 : NatOrdinal.{o}) ≤ wt i) + (Nat.one_le_iff_ne_zero.mpr hi') + exact hwt i (le_antisymm (h1.trans_eq (hw i hi)) bot_le) + +/-! ### Injectivity degree by degree -/ + +variable (E wt x) in +/-- Evaluation is injective in degree `β`: `F = 0` is the only polynomial homogeneous of degree `β` +with `F(x) = 0`. -/ +def InjectiveAt (β : NatOrdinal.{o}) : Prop := + ∀ F : MvPolynomial ι E, IsWeightedHomogeneous wt F β → + (aeval x : MvPolynomial ι E →ₐ[E] R) F = 0 → F = 0 + +omit [GradedAlgebra 𝒜] in +theorem injectiveAt_iff (β : NatOrdinal.{o}) : + InjectiveAt E wt x β ↔ + ∀ F : MvPolynomial ι E, IsWeightedHomogeneous wt F β → + (aeval x : MvPolynomial ι E →ₐ[E] R) F = 0 → F = 0 := + Iff.rfl + +omit [GradedAlgebra 𝒜] in +/-- In degree zero evaluation is injective: a homogeneous polynomial of degree zero is a scalar. -/ +theorem injectiveAt_zero [Nontrivial R] (hwt : ∀ i, wt i ≠ 0) : InjectiveAt E wt x 0 := by + intro F hF hF0 + rw [eq_C_of_isWeightedHomogeneous_zero hwt hF] at hF0 ⊢ + rw [aeval_C] at hF0 + rw [(algebraMap E R).injective (hF0.trans (map_zero _).symm), map_zero] + +omit [GradedAlgebra 𝒜] in +/-- Injectivity in every ordinal degree follows from the zero, successor, and limit cases. -/ +theorem injectiveAt_of_zero_successor_limit + (hzero : InjectiveAt E wt x 0) + (hsuccessor : ∀ α : NatOrdinal.{o}, α.constantCoeff ≠ 0 → + (∀ β < α, InjectiveAt E wt x β) → InjectiveAt E wt x α) + (hlimit : ∀ α : NatOrdinal.{o}, α ≠ 0 → α.constantCoeff = 0 → + (∀ β < α, InjectiveAt E wt x β) → InjectiveAt E wt x α) : + ∀ α, InjectiveAt E wt x α := by + intro α + induction α using WellFoundedLT.induction with + | _ α ih => + rcases eq_or_ne α 0 with rfl | hα + · exact hzero + · by_cases hcc : α.constantCoeff = 0 + · exact hlimit α hα hcc ih + · exact hsuccessor α hcc ih + +/-- Injectivity in every degree gives injectivity of evaluation. -/ +theorem aeval_injective_of_forall_injectiveAt (hmem : ∀ i, x i ∈ 𝒜 (wt i)) + (h : ∀ β, InjectiveAt E wt x β) : + Function.Injective (aeval x : MvPolynomial ι E →ₐ[E] R) := by + classical + rw [injective_iff_map_eq_zero] + intro F hF + have hcomp : ∀ m : NatOrdinal.{o}, aeval x (weightedHomogeneousComponent wt m F) = 0 := fun m ↦ by + rw [← decompose_aeval hmem, hF, DirectSum.decompose_zero, DirectSum.zero_apply, + Submodule.coe_zero] + conv_lhs => rw [← sum_weightedHomogeneousComponent wt F, + finsum_eq_sum _ (weightedHomogeneousComponent_finsupp F)] + exact Finset.sum_eq_zero fun m _ ↦ h m _ + (weightedHomogeneousComponent_isWeightedHomogeneous (w := wt) (n := m) (φ := F)) (hcomp m) + +/-! ### The linear part of a homogeneous polynomial -/ + +/-- A polynomial homogeneous of degree `β ≠ 0` evaluates at homogeneous generators of positive +degree to its linear part in the degree-`β` variables plus an element of `(A_+)² ∩ A_β`; the +linear coefficients are read off the polynomial. -/ +@[blueprint "lem:homogeneous-polynomial-linear-term" + (phase := "Algebraic and ordinal preliminaries") + (title := "Linear part of a weighted-homogeneous polynomial") + (statement := /-- + Let $E$ be a field and let $A=\bigoplus_{\alpha\in\mathbf{On}}A_\alpha$ + be a commutative $E$-algebra graded by the ordinals in a fixed universe, + with multiplication graded by Hessenberg sum. Let $(x_i)_{i\in I}$ satisfy + $x_i\in A_{w(i)}$ with $w(i)\neq0$. If + $F\in E[X_i:i\in I]$ is weighted-homogeneous of degree $\beta\neq0$, then + \[ + F(x)\equiv\sum_{w(i)=\beta}c_i x_i \bmod (A_+)^2\cap A_\beta, + \] + where $c_i$ is the coefficient of $X_i$ in $F$. + -/) + (proof := /-- + It suffices to inspect one monomial. A monomial $cX_i$ of degree $\beta$ + contributes its linear term, while every other nonconstant monomial factors + into two positive-degree monomials and therefore evaluates into + $(A_+)^2\cap A_\beta$. + -/)] +theorem exists_linear_part (hwt : ∀ i, wt i ≠ 0) (hmem : ∀ i, x i ∈ 𝒜 (wt i)) + {F : MvPolynomial ι E} {β : NatOrdinal.{o}} (hβ : β ≠ 0) (hF : IsWeightedHomogeneous wt F β) : + ∃ c : ι →₀ E, (∀ i ∈ c.support, wt i = β) ∧ + aeval x F - Finsupp.linearCombination E x c ∈ decomposableAt 𝒜 β ∧ + ∀ i, c i = coeff (Finsupp.single i 1) F := by + classical + induction hF using IsWeightedHomogeneous.induction_on with + | zero => exact ⟨0, by simp, by simp, fun i ↦ by simp⟩ + | add p q hp hq ihp ihq => + obtain ⟨c, hcw, hc, hcoeff⟩ := ihp + obtain ⟨c', hcw', hc', hcoeff'⟩ := ihq + refine ⟨c + c', fun i hi ↦ ?_, ?_, fun i ↦ by + rw [Finsupp.add_apply, hcoeff, hcoeff', coeff_add]⟩ + · rcases Finset.mem_union.mp (Finsupp.support_add hi) with h | h + · exact hcw i h + · exact hcw' i h + · rw [map_add, map_add] + have := add_mem hc hc' + convert this using 1 + abel + | monomial d r hr => + by_cases hd : ∃ i, d = Finsupp.single i 1 + · obtain ⟨i, rfl⟩ := hd + refine ⟨Finsupp.single i r, fun j hj ↦ ?_, ?_, fun j ↦ ?_⟩ + · rw [Finsupp.mem_support_iff, Finsupp.single_apply] at hj + split_ifs at hj with h + · subst h + rw [Finsupp.weight_single, one_smul] at hr + exact hr + · exact absurd rfl hj + · have hprod : (Finsupp.single i 1).prod (fun j k ↦ x j ^ k) = x i := by + simp + rw [Finsupp.linearCombination_single, aeval_monomial, hprod, Algebra.smul_def, sub_self] + exact zero_mem _ + · rw [Finsupp.single_apply, coeff_monomial] + by_cases h : i = j + · subst h; simp + · rw [if_neg h, if_neg] + intro h' + exact h (Finsupp.single_left_injective one_ne_zero h') + · push Not at hd + refine ⟨0, by simp, ?_, fun j ↦ by rw [Finsupp.coe_zero, Pi.zero_apply, coeff_monomial, + if_neg (hd j)]⟩ + rw [map_zero, sub_zero] + -- `d` has at least two factors: split off one variable + have hd0 : d ≠ 0 := by + rintro rfl + rw [map_zero] at hr + exact hβ hr.symm + obtain ⟨i, hi⟩ := Finsupp.support_nonempty_iff.mpr hd0 + have hi' : d i ≠ 0 := Finsupp.mem_support_iff.mp hi + set d' := d - Finsupp.single i 1 with hd' + have hdd' : d = Finsupp.single i 1 + d' := by + rw [hd', add_comm, tsub_add_cancel_of_le] + intro y + rw [Finsupp.single_apply] + split_ifs with hy + · subst hy; exact Nat.pos_of_ne_zero hi' + · exact Nat.zero_le _ + have hd'0 : d' ≠ 0 := by + intro h + rw [h, add_zero] at hdd' + exact hd i hdd' + have hw' : Finsupp.weight wt d' + wt i = β := by + rw [← hr, hdd', map_add, Finsupp.weight_single, one_smul, add_comm] + have hw'1 : Finsupp.weight wt d' ≠ 0 := by + obtain ⟨j, hj⟩ := Finsupp.support_nonempty_iff.mpr hd'0 + have hj' := Finsupp.mem_support_iff.mp hj + intro h0 + rw [Finsupp.weight_apply, Finsupp.sum, + Finset.sum_eq_zero_iff_of_nonneg fun _ _ ↦ bot_le] at h0 + have h1 : wt j ≤ d' j • wt j := by + simpa using nsmul_le_nsmul_left (bot_le : (0 : NatOrdinal.{o}) ≤ wt j) + (Nat.one_le_iff_ne_zero.mpr hj') + exact hwt j (le_antisymm (h1.trans_eq (h0 j hj)) bot_le) + have hmono : monomial d r = X i * monomial d' r := by + rw [hdd', add_comm, monomial_add_single, pow_one, mul_comm] + rw [hmono, map_mul, aeval_X, ← hw', add_comm] + exact mul_mem_decomposableAt 𝒜 (hwt i) hw'1 (hmem i) + (aeval_mem_of_forall_mem hmem (isWeightedHomogeneous_monomial wt d' r rfl)) + +/-! ### Monomials of degree zero -/ + +omit [GradedAlgebra 𝒜] in +/-- For degrees `wt i ≠ 0`, only the constant monomial has degree zero. -/ +theorem eq_zero_of_weight_eq_zero (hwt : ∀ i, wt i ≠ 0) {d : ι →₀ ℕ} + (hd : Finsupp.weight wt d = 0) : d = 0 := by + by_contra hne + obtain ⟨i, hi⟩ := Finsupp.support_nonempty_iff.mpr hne + have hi' : d i ≠ 0 := Finsupp.mem_support_iff.mp hi + rw [Finsupp.weight_apply, Finsupp.sum, Finset.sum_eq_zero_iff_of_nonneg fun _ _ ↦ bot_le] at hd + have h1 : wt i ≤ d i • wt i := by + simpa using nsmul_le_nsmul_left (bot_le : (0 : NatOrdinal.{o}) ≤ wt i) + (Nat.one_le_iff_ne_zero.mpr hi') + exact hwt i (le_antisymm (h1.trans_eq (hd i hi)) bot_le) + +/-! ### Relations have no linear part and only variables of smaller degree -/ + +namespace IsMinimalSystem + +variable (hx : IsMinimalSystem 𝒜 wt x) +include hx + +/-- A homogeneous relation `F(x) = 0` of degree `β ≠ 0` has no linear monomial: its linear part is +a combination of the generators of degree `β` lying in `(A_+)² ∩ A_β`. -/ +@[blueprint "lem:minimal-generators-relation-has-no-linear-term" + (phase := "Algebraic and ordinal preliminaries") + (title := "Vanishing of the linear part of a homogeneous relation") + (statement := /-- + If $(x_i)_{i\in I}$ is a minimal system of homogeneous generators and the + weighted-homogeneous polynomial $F$ of nonzero degree $\beta$ satisfies + $F(x)=0$, then the coefficient of every linear monomial $X_i$ in $F$ is + zero. + -/) + (proof := /-- + \ref{lem:homogeneous-polynomial-linear-term} places the linear + combination of the degree-$\beta$ generators in + $(A_+)^2\cap A_\beta$. Their defining independence modulo this subspace + kills every coefficient. + -/)] +theorem coeff_single_eq_zero_of_aeval_eq_zero + {F : MvPolynomial ι E} {β : NatOrdinal.{o}} (hβ : β ≠ 0) + (hF : IsWeightedHomogeneous wt F β) (h0 : aeval x F = 0) (i : ι) : + coeff (Finsupp.single i 1) F = 0 := by + obtain ⟨c, hcw, hc, hcoeff⟩ := exists_linear_part hx.ne_zero hx.mem hβ hF + rw [h0, zero_sub, neg_mem_iff] at hc + have := hx.independent β c hcw hc + rw [← hcoeff, this, Finsupp.coe_zero, Pi.zero_apply] + +/-- Every variable of a homogeneous relation `F(x) = 0` of degree `β ≠ 0` has degree below `β`. -/ +@[blueprint "lem:variables-of-homogeneous-relation-have-smaller-degree" + (phase := "Algebraic and ordinal preliminaries") + (title := "Weights of variables in a homogeneous relation") + (statement := /-- + Every variable occurring in a nonzero-degree weighted-homogeneous relation + among a minimal system $(x_i)_{i\in I}$ of homogeneous generators has + weight strictly below the degree of the relation. + -/) + (proof := /-- + Weighted homogeneity gives $w(i)\le\beta$. Equality would make the monomial + containing $X_i$ linear, contradicting + \ref{lem:minimal-generators-relation-has-no-linear-term}. + -/)] +theorem wt_lt_of_mem_vars_of_aeval_eq_zero {F : MvPolynomial ι E} {β : NatOrdinal.{o}} (hβ : β ≠ 0) + (hF : IsWeightedHomogeneous wt F β) (h0 : aeval x F = 0) {i : ι} (hi : i ∈ F.vars) : + wt i < β := by + classical + obtain ⟨d, hd, hdi⟩ := (mem_vars_iff_mem_support i).mp hi + have hdi' : d i ≠ 0 := Finsupp.mem_support_iff.mp hdi + have hdw : Finsupp.weight wt d = β := hF (mem_support_iff.mp hd) + -- split off the variable `i` + set d' := d - Finsupp.single i (d i) with hd' + have hdd' : d = Finsupp.single i (d i) + d' := by + rw [hd', add_comm, tsub_add_cancel_of_le] + intro y + rw [Finsupp.single_apply] + split_ifs with hy + · subst hy; exact le_rfl + · exact Nat.zero_le _ + have hd'i : d' i = 0 := by rw [hd', Finsupp.tsub_apply, Finsupp.single_eq_same, Nat.sub_self] + have hsplit : d i • wt i + Finsupp.weight wt d' = β := by + rw [← hdw] + conv_rhs => rw [hdd'] + rw [map_add, Finsupp.weight_single] + have hle : wt i ≤ β := by + rw [← hsplit] + calc wt i ≤ d i • wt i := by + simpa using nsmul_le_nsmul_left (bot_le : (0 : NatOrdinal.{o}) ≤ wt i) + (Nat.one_le_iff_ne_zero.mpr hdi') + _ ≤ _ := NatOrdinal.le_add_right + refine lt_of_le_of_ne hle fun heq ↦ ?_ + -- `wt i = β` forces `d = single i 1`, a linear monomial + rw [heq] at hsplit + have hd'0 : Finsupp.weight wt d' = 0 := by + by_contra hne + have : β < d i • β + Finsupp.weight wt d' := by + calc β ≤ d i • β := by + simpa using nsmul_le_nsmul_left (bot_le : (0 : NatOrdinal.{o}) ≤ β) + (Nat.one_le_iff_ne_zero.mpr hdi') + _ < d i • β + Finsupp.weight wt d' := lt_add_of_pos_right _ (pos_iff_ne_zero.mpr hne) + exact this.ne hsplit.symm + have hd'zero : d' = 0 := eq_zero_of_weight_eq_zero hx.ne_zero hd'0 + rw [hd'0, add_zero] at hsplit + have hdi1 : d i = 1 := by + by_contra hne + have h2 : 2 ≤ d i := by omega + have : β < d i • β := by + calc β < β + β := lt_add_of_pos_right _ (pos_iff_ne_zero.mpr hβ) + _ = 2 • β := (two_nsmul β).symm + _ ≤ d i • β := nsmul_le_nsmul_left bot_le h2 + exact this.ne hsplit.symm + have hdsingle : d = Finsupp.single i 1 := by rw [hdd', hd'zero, add_zero, hdi1] + have := hx.coeff_single_eq_zero_of_aeval_eq_zero hβ hF h0 i + rw [← hdsingle] at this + exact mem_support_iff.mp hd this + +end IsMinimalSystem + +end OrdinalGraded diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation.lean new file mode 100644 index 0000000000..cf6de6ea4a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation.lean @@ -0,0 +1,15 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.BaseChange +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Correction +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.FilteredModule +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Grading +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.IdealGEGraded +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Mu +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Polynomial + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/BaseChange.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/BaseChange.lean new file mode 100644 index 0000000000..cce4ceee99 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/BaseChange.lean @@ -0,0 +1,351 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Correction +public import Mathlib.RingTheory.GradedAlgebra.TensorProduct +public import Mathlib.RingTheory.TensorProduct.Quotient + +import Mathlib.RingTheory.Flat.Basic +import Mathlib.Algebra.Module.Torsion.Field +import Mathlib.LinearAlgebra.Basis.VectorSpace +import Mathlib.Algebra.CharP.Algebra + +/-! +# Extension of the coefficient field + +Let `A` (Lean `R`) be a `NatOrdinal`-graded algebra over a field `K` with grading `𝒜` and a +lowering derivation `∂` (Lean `Δ`), and let `E / K` be a field extension. The `E`-algebra +`E ⊗_K A` is graded by the base-changed submodules `E ⊗_K A_α`, and the composite + +`∂_E = θ ∘ (1 ⊗ ∂) : E ⊗ A → E ⊗ Fun_{0⁻}(A) → Fun_{0⁻}(E ⊗ A)`, + +where `θ` is the pointwise tensor map, is again a lowering derivation: the Leibniz rule extends +bilinearly, and injectivity on `E ⊗_K A_{α+1}` follows from the injectivity of `θ`, `E` being +flat over `K`. Degree zero is still the scalars, and `(E ⊗_K A)/I = E ⊗_K (A/I)`. Consequently, +whenever `E ⊗_K A` is a domain, so is `E ⊗_K (A/I)`. +-/ + +universe u u' v + +open scoped DirectSum TensorProduct +open Filter Topology + +public noncomputable section + +namespace LoweringDerivation + +variable {K : Type u} {E : Type u'} {R : Type v} [Field K] [Field E] [Algebra K E] +variable [CommRing R] [Algebra K R] + +/-! ### Functions at `0⁻` with values in a tensor product -/ + +section TensorFunAtZeroMinus + +variable (K E R) + +/-- The pointwise tensor map `e ⊗ g ↦ (γ ↦ e ⊗ g(γ))`. -/ +def tensorFunAtZeroMinusLeft (e : E) : FunAtZeroMinus R →ₗ[K] FunAtZeroMinus (E ⊗[K] R) := + Filter.Germ.mapLinear (TensorProduct.mk K E R e) + +theorem tensorFunAtZeroMinusLeft_coe (e : E) (f : ℝ → R) : + tensorFunAtZeroMinusLeft K E R e (f : FunAtZeroMinus R) = + ((fun γ ↦ e ⊗ₜ[K] f γ : ℝ → E ⊗[K] R) : FunAtZeroMinus (E ⊗[K] R)) := by + rw [tensorFunAtZeroMinusLeft, Filter.Germ.mapLinear_coe] + rfl + +/-- The canonical map `θ : E ⊗ Fun_{0⁻}(A) → Fun_{0⁻}(E ⊗ A)`. -/ +def tensorFunAtZeroMinus : E ⊗[K] FunAtZeroMinus R →ₗ[E] FunAtZeroMinus (E ⊗[K] R) := + TensorProduct.AlgebraTensorModule.lift + { toFun := tensorFunAtZeroMinusLeft K E R + map_add' := fun e e' ↦ LinearMap.ext fun g ↦ by + induction g using Filter.Germ.inductionOn with + | _ f => + rw [LinearMap.add_apply, tensorFunAtZeroMinusLeft_coe, tensorFunAtZeroMinusLeft_coe, + tensorFunAtZeroMinusLeft_coe] + change _ = ((fun γ ↦ e ⊗ₜ[K] f γ + e' ⊗ₜ[K] f γ : ℝ → E ⊗[K] R) : + FunAtZeroMinus (E ⊗[K] R)) + congr 1 + funext γ + rw [TensorProduct.add_tmul] + map_smul' := fun c e ↦ LinearMap.ext fun g ↦ by + induction g using Filter.Germ.inductionOn with + | _ f => + rw [RingHom.id_apply, LinearMap.smul_apply, tensorFunAtZeroMinusLeft_coe, + tensorFunAtZeroMinusLeft_coe] + change _ = ((fun γ ↦ c • (e ⊗ₜ[K] f γ) : ℝ → E ⊗[K] R) : FunAtZeroMinus (E ⊗[K] R)) + congr 1 } + +theorem tensorFunAtZeroMinus_tmul (e : E) (g : FunAtZeroMinus R) : + tensorFunAtZeroMinus K E R (e ⊗ₜ[K] g) = tensorFunAtZeroMinusLeft K E R e g := by + rw [tensorFunAtZeroMinus, TensorProduct.AlgebraTensorModule.lift_tmul] + rfl + +theorem tensorFunAtZeroMinus_tmul_coe (e : E) (f : ℝ → R) : + tensorFunAtZeroMinus K E R (e ⊗ₜ[K] (f : FunAtZeroMinus R)) = + ((fun γ ↦ e ⊗ₜ[K] f γ : ℝ → E ⊗[K] R) : FunAtZeroMinus (E ⊗[K] R)) := by + rw [tensorFunAtZeroMinus_tmul, tensorFunAtZeroMinusLeft_coe] + +theorem tensorFunAtZeroMinusLeft_mul_const (e e' : E) (g : FunAtZeroMinus R) (b : R) : + tensorFunAtZeroMinusLeft K E R e g * ((e' ⊗ₜ[K] b : E ⊗[K] R) : FunAtZeroMinus (E ⊗[K] R)) = + tensorFunAtZeroMinusLeft K E R (e * e') (g * (b : FunAtZeroMinus R)) := by + induction g using Filter.Germ.inductionOn with + | _ f => + rw [tensorFunAtZeroMinusLeft_coe] + change _ = + tensorFunAtZeroMinusLeft K E R (e * e') ((fun γ ↦ f γ * b : ℝ → R) : FunAtZeroMinus R) + rw [tensorFunAtZeroMinusLeft_coe] + change ((fun γ ↦ e ⊗ₜ[K] f γ * e' ⊗ₜ[K] b : ℝ → E ⊗[K] R) : FunAtZeroMinus (E ⊗[K] R)) = _ + congr 1 + funext γ + rw [Algebra.TensorProduct.tmul_mul_tmul] + +theorem const_mul_tensorFunAtZeroMinusLeft (e e' : E) (a : R) (g : FunAtZeroMinus R) : + ((e ⊗ₜ[K] a : E ⊗[K] R) : FunAtZeroMinus (E ⊗[K] R)) * tensorFunAtZeroMinusLeft K E R e' g = + tensorFunAtZeroMinusLeft K E R (e * e') ((a : FunAtZeroMinus R) * g) := by + induction g using Filter.Germ.inductionOn with + | _ f => + rw [tensorFunAtZeroMinusLeft_coe] + change _ = + tensorFunAtZeroMinusLeft K E R (e * e') ((fun γ ↦ a * f γ : ℝ → R) : FunAtZeroMinus R) + rw [tensorFunAtZeroMinusLeft_coe] + change ((fun γ ↦ e ⊗ₜ[K] a * e' ⊗ₜ[K] f γ : ℝ → E ⊗[K] R) : FunAtZeroMinus (E ⊗[K] R)) = _ + congr 1 + funext γ + rw [Algebra.TensorProduct.tmul_mul_tmul] + +end TensorFunAtZeroMinus + +/-! ### The base-changed derivation -/ + +variable (E) in +/-- The base change `∂_E = θ ∘ (1 ⊗ ∂)` of a derivation with values in functions at `0⁻`. -/ +def baseChangeDerivation (Δ : R →ₗ[K] FunAtZeroMinus R) : + E ⊗[K] R →ₗ[E] FunAtZeroMinus (E ⊗[K] R) := + (tensorFunAtZeroMinus K E R).comp (Δ.baseChange E) + +theorem baseChangeDerivation_tmul (Δ : R →ₗ[K] FunAtZeroMinus R) (e : E) (x : R) : + baseChangeDerivation E Δ (e ⊗ₜ[K] x) = tensorFunAtZeroMinusLeft K E R e (Δ x) := by + rw [baseChangeDerivation, LinearMap.comp_apply, LinearMap.baseChange_tmul, + tensorFunAtZeroMinus_tmul] + +variable {𝒜 : NatOrdinal → Submodule K R} [GradedAlgebra 𝒜] + +/-- The base change of the grading: `E ⊗_K A_α`. -/ +abbrev baseChangeGrading (E : Type u') [Field E] [Algebra K E] (𝒜 : NatOrdinal → Submodule K R) : + NatOrdinal → Submodule E (E ⊗[K] R) := + fun α ↦ (𝒜 α).baseChange E + +omit [GradedAlgebra 𝒜] in +theorem gradeZeroScalars_baseChange (h0 : GradeZeroScalars 𝒜) : + GradeZeroScalars (baseChangeGrading E 𝒜) := by + rw [gradeZeroScalars_iff] at h0 ⊢ + intro x hx + obtain ⟨x', rfl⟩ := hx + induction x' using TensorProduct.induction_on with + | zero => exact ⟨0, by rw [map_zero, map_zero]⟩ + | tmul e a => + obtain ⟨k, hk⟩ := h0 a a.2 + refine ⟨k • e, ?_⟩ + rw [LinearMap.baseChange_tmul, Submodule.subtype_apply, hk, + Algebra.TensorProduct.algebraMap_apply, Algebra.algebraMap_eq_smul_one, + TensorProduct.tmul_smul, TensorProduct.smul_tmul', Algebra.algebraMap_self_apply] + | add x y hx hy => + obtain ⟨k, hk⟩ := hx + obtain ⟨k', hk'⟩ := hy + exact ⟨k + k', by rw [map_add, hk, hk', map_add]⟩ + +namespace IsLoweringDerivation + +variable {Δ : R →ₗ[K] FunAtZeroMinus R} (hΔ : IsLoweringDerivation 𝒜 Δ) +include hΔ + +omit [GradedAlgebra 𝒜] in +theorem baseChangeDerivation_mul (x y : E ⊗[K] R) : + baseChangeDerivation E Δ (x * y) = + baseChangeDerivation E Δ x * (y : FunAtZeroMinus _) + + (x : FunAtZeroMinus _) * baseChangeDerivation E Δ y := by + have hconst_add : ∀ u v : E ⊗[K] R, ((u + v : E ⊗[K] R) : FunAtZeroMinus (E ⊗[K] R)) = + (u : FunAtZeroMinus (E ⊗[K] R)) + (v : FunAtZeroMinus (E ⊗[K] R)) := fun _ _ ↦ rfl + have hconst_zero : ((0 : E ⊗[K] R) : FunAtZeroMinus (E ⊗[K] R)) = 0 := rfl + induction x using TensorProduct.induction_on with + | zero => rw [zero_mul, map_zero, zero_mul, hconst_zero, zero_mul, add_zero] + | tmul e a => + induction y using TensorProduct.induction_on with + | zero => rw [mul_zero, map_zero, mul_zero, hconst_zero, mul_zero, add_zero] + | tmul e' b => + rw [Algebra.TensorProduct.tmul_mul_tmul, baseChangeDerivation_tmul, baseChangeDerivation_tmul, + baseChangeDerivation_tmul, hΔ.map_mul, map_add, tensorFunAtZeroMinusLeft_mul_const, + const_mul_tensorFunAtZeroMinusLeft] + | add y z hy hz => + rw [mul_add, map_add, hy, hz, map_add, hconst_add, mul_add, mul_add] + abel + | add x z hx hz => + rw [add_mul, map_add, hx, hz, map_add, hconst_add, add_mul, add_mul] + abel + +omit hΔ [GradedAlgebra 𝒜] in +/-- Membership statements for `∂_E` reduce to pure tensors `e ⊗ a` with `a ∈ A_α`. -/ +theorem baseChange_induction {α : NatOrdinal} (P : Submodule E (FunAtZeroMinus (E ⊗[K] R))) + (h : ∀ (e : E) (a : R), a ∈ 𝒜 α → baseChangeDerivation E Δ (e ⊗ₜ[K] a) ∈ P) + {x : E ⊗[K] R} (hx : x ∈ (𝒜 α).baseChange E) : baseChangeDerivation E Δ x ∈ P := by + obtain ⟨x', rfl⟩ := hx + induction x' using TensorProduct.induction_on with + | zero => rw [map_zero, map_zero]; exact P.zero_mem + | tmul e a => + rw [LinearMap.baseChange_tmul, Submodule.subtype_apply] + exact h e a a.2 + | add x y hx hy => + rw [map_add, map_add] + exact P.add_mem hx hy + +omit [GradedAlgebra 𝒜] in +theorem baseChangeDerivation_mem_lower {α : NatOrdinal} (hα : 0 < α.constantCoeff) {x : E ⊗[K] R} + (hx : x ∈ (𝒜 α).baseChange E) : + baseChangeDerivation E Δ x ∈ funAtZeroMinusSubmodule ((𝒜 (α.removeNat 1)).baseChange E) := by + refine baseChange_induction _ (fun e a ha ↦ ?_) hx + obtain ⟨f, hf, hfeq⟩ := exists_coe_eq_of_mem_funAtZeroMinusSubmodule _ (hΔ.mem_lower hα ha) + rw [baseChangeDerivation_tmul, hfeq, tensorFunAtZeroMinusLeft_coe, + coe_mem_funAtZeroMinusSubmodule_iff] + exact Eventually.of_forall fun γ ↦ Submodule.tmul_mem_baseChange_of_mem e (hf γ) + +omit [GradedAlgebra 𝒜] in +theorem baseChangeDerivation_eq_zero {α : NatOrdinal} (hα : α.constantCoeff = 0) {x : E ⊗[K] R} + (hx : x ∈ (𝒜 α).baseChange E) : baseChangeDerivation E Δ x = 0 := by + have := baseChange_induction (Δ := Δ) (⊥ : Submodule E (FunAtZeroMinus (E ⊗[K] R))) + (fun e a ha ↦ by rw [baseChangeDerivation_tmul, hΔ.eq_zero hα ha, map_zero]; exact rfl) hx + exact (Submodule.mem_bot E).mp this + +/-- `∂` on `A_α`, `α` a successor, as a map into functions at `0⁻` with values in the degree one +below (Lean `𝒜 (α.removeNat 1)`). -/ +def derivLinearAt {α : NatOrdinal} (hα : 0 < α.constantCoeff) : + 𝒜 α →ₗ[K] FunAtZeroMinus (𝒜 (α.removeNat 1)) := + (funAtZeroMinusSubmoduleEquiv (𝒜 (α.removeNat 1))).symm.toLinearMap.comp + ((Δ.comp (𝒜 α).subtype).codRestrict _ fun a ↦ hΔ.mem_lower hα a.2) + +omit [GradedAlgebra 𝒜] in +theorem funAtZeroMinusSubmoduleMap_derivLinearAt {α : NatOrdinal} (hα : 0 < α.constantCoeff) + (a : 𝒜 α) : + funAtZeroMinusSubmoduleMap _ (hΔ.derivLinearAt hα a) = Δ a := by + rw [derivLinearAt, LinearMap.comp_apply, LinearEquiv.coe_coe, + ← coe_funAtZeroMinusSubmoduleEquiv_apply, LinearEquiv.apply_symm_apply] + rfl + +omit [GradedAlgebra 𝒜] in +theorem derivLinearAt_injective {α : NatOrdinal} (hα : 0 < α.constantCoeff) : + Function.Injective (hΔ.derivLinearAt hα) := by + intro a a' h + apply Subtype.ext + refine sub_eq_zero.mp (hΔ.injective hα ((𝒜 α).sub_mem a.2 a'.2) ?_) + rw [map_sub, ← hΔ.funAtZeroMinusSubmoduleMap_derivLinearAt hα, + ← hΔ.funAtZeroMinusSubmoduleMap_derivLinearAt hα, + h, sub_self] + +/-- The embedding `A_{α'} ⊗ E → E ⊗ A`, `α'` the degree one below `α`. -/ +def lowerGradeTensorEmbedding (α : NatOrdinal) : 𝒜 (α.removeNat 1) ⊗[K] E →ₗ[K] E ⊗[K] R := + ((𝒜 (α.removeNat 1)).subtype.baseChange E).restrictScalars K ∘ₗ + (TensorProduct.comm K (𝒜 (α.removeNat 1)) E).toLinearMap + +omit hΔ [GradedAlgebra 𝒜] in +theorem lowerGradeTensorEmbedding_injective (α : NatOrdinal) : + Function.Injective (lowerGradeTensorEmbedding (𝒜 := 𝒜) (E := E) α) := by + have h1 : Function.Injective ((𝒜 (α.removeNat 1)).subtype.baseChange E) := by + rw [LinearMap.baseChange_eq_ltensor] + exact Module.Flat.lTensor_preserves_injective_linearMap _ (Submodule.injective_subtype _) + intro x y h + exact (TensorProduct.comm K _ E).injective (h1 h) + +omit [GradedAlgebra 𝒜] in +theorem baseChangeDerivation_baseChange {α : NatOrdinal} (hα : 0 < α.constantCoeff) + (x : 𝒜 α ⊗[K] E) : + baseChangeDerivation E Δ ((𝒜 α).subtype.baseChange E (TensorProduct.comm K _ _ x)) = + Filter.Germ.mapLinear (lowerGradeTensorEmbedding α) + (funAtZeroMinusTensorId (hΔ.derivLinearAt hα) x) := by + induction x using TensorProduct.induction_on with + | zero => rw [map_zero, map_zero, map_zero, map_zero, map_zero] + | tmul a e => + obtain ⟨f, hf⟩ : ∃ f : ℝ → 𝒜 (α.removeNat 1), hΔ.derivLinearAt hα a = (f : FunAtZeroMinus _) := + ⟨Quotient.out _, (Quotient.out_eq _).symm⟩ + rw [TensorProduct.comm_tmul, LinearMap.baseChange_tmul, baseChangeDerivation_tmul, + funAtZeroMinusTensorId_tmul_of_eq_coe _ _ _ _ hf, Filter.Germ.mapLinear_coe] + have hΔa : Δ a = ((fun γ ↦ (f γ : R)) : FunAtZeroMinus R) := by + rw [← hΔ.funAtZeroMinusSubmoduleMap_derivLinearAt hα, hf, funAtZeroMinusSubmoduleMap_coe] + rw [Submodule.subtype_apply, hΔa, tensorFunAtZeroMinusLeft_coe] + rfl + | add x y hx hy => rw [map_add, map_add, map_add, hx, hy, map_add, map_add] + +omit [GradedAlgebra 𝒜] in +theorem baseChangeDerivation_injective {α : NatOrdinal} (hα : 0 < α.constantCoeff) {x : E ⊗[K] R} + (hx : x ∈ (𝒜 α).baseChange E) (h : baseChangeDerivation E Δ x = 0) : x = 0 := by + obtain ⟨x', rfl⟩ := hx + obtain ⟨x'', rfl⟩ := (TensorProduct.comm K (𝒜 α) E).surjective x' + rw [hΔ.baseChangeDerivation_baseChange hα] at h + have h1 := Filter.Germ.mapLinear_injective _ + (lowerGradeTensorEmbedding_injective (𝒜 := 𝒜) (E := E) α) + (by rw [h, map_zero] : Filter.Germ.mapLinear (lowerGradeTensorEmbedding α) + (funAtZeroMinusTensorId (hΔ.derivLinearAt hα) x'') = Filter.Germ.mapLinear _ 0) + have h2 : x'' = 0 := funAtZeroMinusTensorId_injective_of_injective _ + (hΔ.derivLinearAt_injective hα) (by rw [h1, map_zero]) + rw [h2, map_zero, map_zero] + +omit [GradedAlgebra 𝒜] in +/-- The base change of a lowering derivation is a lowering derivation for the base-changed +grading. -/ +theorem baseChange : + IsLoweringDerivation (baseChangeGrading E 𝒜) (baseChangeDerivation E Δ) where + map_mul := hΔ.baseChangeDerivation_mul + mem_lower hα _ hx := hΔ.baseChangeDerivation_mem_lower hα hx + eq_zero hα _ hx := hΔ.baseChangeDerivation_eq_zero hα hx + injective hα _ hx h := hΔ.baseChangeDerivation_injective hα hx h + +end IsLoweringDerivation + +/-! ### The quotient of the base change -/ + +variable (E 𝒜) + +omit [GradedAlgebra 𝒜] in +theorem fibreIdeal_baseChange : + fibreIdeal (baseChangeGrading E 𝒜) = + (fibreIdeal 𝒜).map (Algebra.TensorProduct.includeRight : R →ₐ[K] E ⊗[K] R) := by + rw [fibreIdeal, fibreIdeal, idealGE_eq_span, idealGE_eq_span] + refine le_antisymm (Ideal.span_le.mpr ?_) (Ideal.map_le_iff_le_comap.mpr (Ideal.span_le.mpr ?_)) + · intro x hx + obtain ⟨e, hje, x', rfl⟩ := (mem_idealGEGenerators_iff _ 1 x).mp hx + clear hx + induction x' using TensorProduct.induction_on with + | zero => rw [map_zero]; exact zero_mem _ + | tmul c a => + rw [LinearMap.baseChange_tmul, Submodule.subtype_apply, + show c ⊗ₜ[K] (a : R) = (c ⊗ₜ[K] (1 : R)) * + (Algebra.TensorProduct.includeRight (R := K) (A := E) (a : R)) by + rw [Algebra.TensorProduct.includeRight_apply, Algebra.TensorProduct.tmul_mul_tmul, + mul_one, one_mul]] + exact Ideal.mul_mem_left _ _ (Ideal.mem_map_of_mem _ + (Ideal.subset_span ((mem_idealGEGenerators_iff 𝒜 1 _).mpr ⟨e, hje, a.2⟩))) + | add x y hx hy => rw [map_add]; exact add_mem hx hy + · intro a ha + obtain ⟨e, hje, hae⟩ := (mem_idealGEGenerators_iff 𝒜 1 a).mp ha + refine Ideal.subset_span ((mem_idealGEGenerators_iff _ 1 _).mpr ⟨e, hje, ?_⟩) + rw [Algebra.TensorProduct.includeRight_apply] + exact Submodule.tmul_mem_baseChange_of_mem 1 hae + +/-- `(E ⊗_K A)/I = E ⊗_K (A/I)`: the quotient of the base change is the base change of the +quotient. -/ +def fibreBaseChangeEquiv : E ⊗[K] Fibre 𝒜 ≃ₐ[E] Fibre (baseChangeGrading E 𝒜) := + (Algebra.TensorProduct.tensorQuotientEquiv (R := K) E R E (fibreIdeal 𝒜)).trans + (Ideal.quotientEquivAlgOfEq E (fibreIdeal_baseChange E 𝒜).symm) + +/-- If `E ⊗_K A` is a domain, so is `E ⊗_K (A/I)`: the base change is again a graded domain over +`E` with a lowering derivation, and its quotient is `E ⊗_K (A/I)`. -/ +theorem isDomain_tensor_fibre [CharZero K] [IsDomain (E ⊗[K] R)] (h0 : GradeZeroScalars 𝒜) + {Δ : R →ₗ[K] FunAtZeroMinus R} (hΔ : IsLoweringDerivation 𝒜 Δ) : + IsDomain (E ⊗[K] Fibre 𝒜) := + haveI : CharZero E := charZero_of_injective_algebraMap (algebraMap K E).injective + haveI := hΔ.baseChange.fibre_isDomain (gradeZeroScalars_baseChange (E := E) h0) + (fibreBaseChangeEquiv E 𝒜).toMulEquiv.isDomain _ + +end LoweringDerivation diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Correction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Correction.lean new file mode 100644 index 0000000000..c434d27f1f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Correction.lean @@ -0,0 +1,584 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Mu + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousZeroDivisors +import Mathlib.Algebra.Module.Torsion.Field +import Mathlib.LinearAlgebra.Basis.VectorSpace +import Mathlib.RingTheory.Flat.Basic +import Mathlib.Tactic.LinearCombination + +/-! +# The correction argument: `A/I` is a domain + +Let `A` (Lean `R`) be a `NatOrdinal`-graded domain over a field `E` of characteristic zero with +`A_0 = E` and a lowering derivation `∂` (Lean `Δ`). This file proves that non-zero homogeneous +`ρ, τ ∈ A/I` (the paper's `B, C`) satisfy `ρ^s τ ≠ 0`, hence that `A/I` is a domain. + +The proof is a lexicographic induction on `(n, n', s)`, `n, n'` the finite parts of the degrees +`α, β` of `ρ, τ`. Supposing `ρ^(r+1) τ = 0`, one builds homogeneous lifts `x, y` of `ρ, τ` with +`x^(r+1) y ∈ I_{≥j+1}` and `∂x, ∂y ∈ Fun_{0⁻}(I_{≥j})` for `j = 0, …, N`, where `N` is the +smaller of the positive finite parts among `n, n'`. The *correction step* passes from stage `j` +to stage `j + 1`: the Leibniz rule, read through `μ_j` as an identity between tensors, + +`(∂ ⊗ 1) ν_{j+1}(x^(r+1) y) = (1 ⊗ m)(ν_j(∂x), ν_j(∂y))`, `m(a, b) = (r+1) ρ^r τ a + ρ^(r+1) b` + +(`ν_j(H)` the tensor with `μ_j(ν_j(H)) = H + I_{≥j+1}`), together with the injectivity of +`θ : V ⊗ Fun_{0⁻}(W) → Fun_{0⁻}(V ⊗ W)` and the injectivity of `m` (which is where the induction +hypothesis enters), produces homogeneous corrections `G ∈ I_{≥j+1} ∩ A_α`, `G' ∈ I_{≥j+1} ∩ A_β` +with `(x - G)^(r+1) (y - G') ∈ I_{≥j+2}` and `∂(x - G), ∂(y - G') ∈ Fun_{0⁻}(I_{≥j+1})`. At +stage `N` the derivative of one lift is a function with values in `I_{≥N} ∩ A_{α'}`, `α'` the +degree one below `α`, which vanishes, against the injectivity of `∂` on `A_α`. +-/ + +universe u v + +open scoped DirectSum TensorProduct +open Filter Topology + +public noncomputable section + +namespace LoweringDerivation + +variable {E : Type u} {R : Type v} [Field E] [CommRing R] [Algebra E R] +variable {𝒜 : NatOrdinal → Submodule E R} [GradedAlgebra 𝒜] +variable {Δ : R →ₗ[E] FunAtZeroMinus R} (hΔ : IsLoweringDerivation 𝒜 Δ) + +/-! ### Endpoint spaces -/ + +omit [GradedAlgebra 𝒜] in +theorem lTensor_subtype_lTensor_inclusion {M : Type*} [AddCommGroup M] [Module E M] + {W W' : Submodule E M} (h : W ≤ W') {U : Type*} [AddCommGroup U] [Module E U] + (T : U ⊗[E] W) : + W'.subtype.lTensor U ((Submodule.inclusion h).lTensor U T) = W.subtype.lTensor U T := by + rw [← LinearMap.comp_apply, ← LinearMap.lTensor_comp, Submodule.subtype_comp_inclusion] + +section Endpoint + +variable (𝒜) + +/-- The paper's `V_α`: for `α = λ + n` with `n > 0`, the degree-`(λ + (n-j-1))` part of `A/I` +(Lean `fibreGrade 𝒜 (α.removeNat (j + 1))`), and `0` when `n = 0`. -/ +def endpointSpace (j : ℕ) (α : NatOrdinal) : Submodule E (Fibre 𝒜) := + if 0 < α.constantCoeff then fibreGrade 𝒜 (α.removeNat (j + 1)) else ⊥ + +omit [GradedAlgebra 𝒜] in +theorem endpointSpace_of_pos {j : ℕ} {α : NatOrdinal} (hα : 0 < α.constantCoeff) : + endpointSpace 𝒜 j α = fibreGrade 𝒜 (α.removeNat (j + 1)) := if_pos hα + +omit [GradedAlgebra 𝒜] in +theorem endpointSpace_of_eq_zero {j : ℕ} {α : NatOrdinal} (hα : α.constantCoeff = 0) : + endpointSpace 𝒜 j α = ⊥ := if_neg (by omega) + +omit [GradedAlgebra 𝒜] in +theorem endpointSpace_le (j : ℕ) (α : NatOrdinal) : + endpointSpace 𝒜 j α ≤ fibreGrade 𝒜 (α.removeNat (j + 1)) := by + by_cases hα : 0 < α.constantCoeff + · rw [endpointSpace_of_pos 𝒜 hα] + · rw [endpointSpace_of_eq_zero 𝒜 (by omega)] + exact bot_le + +omit [GradedAlgebra 𝒜] in +theorem subtype_endpointSpace_of_eq_zero {j : ℕ} {α : NatOrdinal} (hα : α.constantCoeff = 0) : + (endpointSpace 𝒜 j α).subtype = 0 := by + ext ⟨x, hx⟩ + rw [endpointSpace_of_eq_zero 𝒜 hα] at hx + simpa using hx + +/-- Homogeneous lifting into `V_α`: a tensor in `A_{j+1} ⊗ V_α` is the class modulo `I_{≥j+2}` of a +homogeneous element of `I_{≥j+1} ∩ A_α`. -/ +theorem exists_homogeneous_mu_eq_endpoint {j : ℕ} {α : NatOrdinal} + (hj : 0 < α.constantCoeff → j + 1 ≤ α.constantCoeff) + (T : 𝒜 ((j + 1 : ℕ) : NatOrdinal) ⊗[E] endpointSpace 𝒜 j α) : + ∃ G ∈ 𝒜 α, G ∈ idealGE 𝒜 (j + 1) ∧ + mu 𝒜 (j + 1) ((endpointSpace 𝒜 j α).subtype.lTensor _ T) = + (Submodule.Quotient.mk G : R ⧸ idealGE 𝒜 (j + 1 + 1)) := by + by_cases hα : 0 < α.constantCoeff + · obtain ⟨G, hGα, hGW, hG⟩ := exists_homogeneous_mu_eq 𝒜 (hj hα) + ((Submodule.inclusion (endpointSpace_le 𝒜 j α)).lTensor _ T) + refine ⟨G, hGα, hGW, ?_⟩ + rw [← hG, lTensor_subtype_lTensor_inclusion] + · refine ⟨0, zero_mem _, zero_mem _, ?_⟩ + rw [subtype_endpointSpace_of_eq_zero 𝒜 (by omega), LinearMap.lTensor_zero, LinearMap.zero_apply, + map_zero, Submodule.Quotient.mk_zero] + +end Endpoint + +namespace IsLoweringDerivation +include hΔ + +/-- For `x ∈ A_α` with `∂x ∈ Fun_{0⁻}(I_{≥j})`, the classes of `∂x` modulo `I_{≥j+1}` have +pointwise representatives in `A_j ⊗ V_α`: the paper's tensor `ν_j(∂x)`. -/ +theorem exists_rep_endpoint {j : ℕ} {α : NatOrdinal} + (hj : 0 < α.constantCoeff → j + 1 ≤ α.constantCoeff) {x : R} (hx : x ∈ 𝒜 α) + (hΔx : Δ x ∈ funAtZeroMinusIdeal E (idealGE 𝒜 j)) : + ∃ f : ℝ → R, Δ x = (f : FunAtZeroMinus R) ∧ ∀ γ, + ∃ T : 𝒜 (j : NatOrdinal) ⊗[E] endpointSpace 𝒜 j α, + mu 𝒜 j ((endpointSpace 𝒜 j α).subtype.lTensor _ T) = + (Submodule.Quotient.mk (f γ) : R ⧸ idealGE 𝒜 (j + 1)) := by + by_cases hα : 0 < α.constantCoeff + · have hpred := hΔ.mem_lower hα hx + obtain ⟨f, hf, hfeq⟩ := exists_coe_eq_of_mem_funAtZeroMinusSubmodule _ + (mem_funAtZeroMinusSubmodule_inf _ _ hpred hΔx) + refine ⟨f, hfeq, fun γ ↦ ?_⟩ + obtain ⟨hf1, hf2⟩ := Submodule.mem_inf.mp (hf γ) + have hη : (α.removeNat 1).removeNat j = α.removeNat (j + 1) := by + have := NatOrdinal.removeNat_one_removeNat_pred (delta := α) (j := j + 1) + (Nat.le_add_left 1 j) (hj hα) + rwa [Nat.add_sub_cancel] at this + obtain ⟨T, hT⟩ := exists_mu_lTensor_eq 𝒜 hf1 hf2 + have hle : fibreGrade 𝒜 ((α.removeNat 1).removeNat j) ≤ endpointSpace 𝒜 j α := by + rw [hη, endpointSpace_of_pos 𝒜 hα] + refine ⟨(Submodule.inclusion hle).lTensor _ T, ?_⟩ + rw [lTensor_subtype_lTensor_inclusion, hT] + · refine ⟨fun _ ↦ 0, ?_, fun γ ↦ ⟨0, by simp⟩⟩ + rw [hΔ.eq_zero (by omega) hx] + rfl + +end IsLoweringDerivation + +/-! ### The correction map -/ + +section CorrectionMap + +variable (𝒜) + +/-- The paper's map `m : V_α ⊕ V_β → A/I`, `(a, b) ↦ z a + w b`. -/ +def correctionMap (j : ℕ) (α β : NatOrdinal) (z w : Fibre 𝒜) : + endpointSpace 𝒜 j α × endpointSpace 𝒜 j β →ₗ[E] Fibre 𝒜 := + (LinearMap.mulLeft E z).comp ((endpointSpace 𝒜 j α).subtype.comp (LinearMap.fst E _ _)) + + (LinearMap.mulLeft E w).comp ((endpointSpace 𝒜 j β).subtype.comp (LinearMap.snd E _ _)) + +omit [GradedAlgebra 𝒜] in +theorem correctionMap_apply (j : ℕ) (α β : NatOrdinal) (z w : Fibre 𝒜) + (p : endpointSpace 𝒜 j α × endpointSpace 𝒜 j β) : + correctionMap 𝒜 j α β z w p = z * p.1 + w * p.2 := (rfl) + +omit [GradedAlgebra 𝒜] in +theorem correctionMap_comp_inl (j : ℕ) (α β : NatOrdinal) (z w : Fibre 𝒜) : + (correctionMap 𝒜 j α β z w).comp (LinearMap.inl E _ _) = + (LinearMap.mulLeft E z).comp (endpointSpace 𝒜 j α).subtype := by + ext a + simp [correctionMap_apply] + +omit [GradedAlgebra 𝒜] in +theorem correctionMap_comp_inr (j : ℕ) (α β : NatOrdinal) (z w : Fibre 𝒜) : + (correctionMap 𝒜 j α β z w).comp (LinearMap.inr E _ _) = + (LinearMap.mulLeft E w).comp (endpointSpace 𝒜 j β).subtype := by + ext b + simp [correctionMap_apply] + +omit [GradedAlgebra 𝒜] in +theorem lTensor_fst_lTensor_inl_add_lTensor_inr {U A B : Type*} [AddCommGroup U] [Module E U] + [AddCommGroup A] [Module E A] [AddCommGroup B] [Module E B] (a : U ⊗[E] A) (b : U ⊗[E] B) : + (LinearMap.fst E A B).lTensor U + ((LinearMap.inl E A B).lTensor U a + (LinearMap.inr E A B).lTensor U b) = a := by + rw [map_add, ← LinearMap.comp_apply (LinearMap.lTensor _ _), ← LinearMap.lTensor_comp, + LinearMap.fst_comp_inl, LinearMap.lTensor_id, LinearMap.id_apply, + ← LinearMap.comp_apply (LinearMap.lTensor _ _) (LinearMap.lTensor _ _), + ← LinearMap.lTensor_comp, LinearMap.fst_comp_inr, LinearMap.lTensor_zero, + LinearMap.zero_apply, add_zero] + +omit [GradedAlgebra 𝒜] in +theorem lTensor_snd_lTensor_inl_add_lTensor_inr {U A B : Type*} [AddCommGroup U] [Module E U] + [AddCommGroup A] [Module E A] [AddCommGroup B] [Module E B] (a : U ⊗[E] A) (b : U ⊗[E] B) : + (LinearMap.snd E A B).lTensor U + ((LinearMap.inl E A B).lTensor U a + (LinearMap.inr E A B).lTensor U b) = b := by + rw [map_add, ← LinearMap.comp_apply (LinearMap.lTensor _ _), ← LinearMap.lTensor_comp, + LinearMap.snd_comp_inl, LinearMap.lTensor_zero, LinearMap.zero_apply, zero_add, + ← LinearMap.comp_apply (LinearMap.lTensor _ _) (LinearMap.lTensor _ _), + ← LinearMap.lTensor_comp, LinearMap.snd_comp_inr, LinearMap.lTensor_id, LinearMap.id_apply] + +end CorrectionMap + +namespace IsLoweringDerivation +include hΔ + +/-- The Leibniz rule as an identity between tensors, +`(∂ ⊗ 1) ν_{j+1}(x^(r+1) y) = (1 ⊗ m)(ν_j(∂x), ν_j(∂y))` with `m(a, b) = (r+1) ρ^r τ a + ρ^(r+1) b`, +together with representatives: `∂ ⊗ 1` applied to a tensor `T` with +`μ_{j+1}(T) = x^(r+1) y + I_{≥j+2}` is represented by the pointwise images under `1 ⊗ m` of +tensors `t γ` whose two components are classes of representatives `f`, `g` of `∂x` and `∂y`. -/ +theorem exists_rep_coordinate_identity (h0 : GradeZeroScalars 𝒜) {j : ℕ} {α β : NatOrdinal} + (hjα : 0 < α.constantCoeff → j + 1 ≤ α.constantCoeff) + (hjβ : 0 < β.constantCoeff → j + 1 ≤ β.constantCoeff) + {x y : R} (hx : x ∈ 𝒜 α) (hy : y ∈ 𝒜 β) (r : ℕ) + (hΔx : Δ x ∈ funAtZeroMinusIdeal E (idealGE 𝒜 j)) + (hΔy : Δ y ∈ funAtZeroMinusIdeal E (idealGE 𝒜 j)) + {T : 𝒜 ((j + 1 : ℕ) : NatOrdinal) ⊗[E] Fibre 𝒜} + (hT : mu 𝒜 (j + 1) T = Submodule.Quotient.mk (x ^ (r + 1) * y)) : + ∃ (f g : ℝ → R) + (t : ℝ → 𝒜 (j : NatOrdinal) ⊗[E] (endpointSpace 𝒜 j α × endpointSpace 𝒜 j β)), + Δ x = (f : FunAtZeroMinus R) ∧ Δ y = (g : FunAtZeroMinus R) ∧ + (∀ γ, mu 𝒜 j ((endpointSpace 𝒜 j α).subtype.lTensor _ + ((LinearMap.fst E _ _).lTensor _ (t γ))) = Submodule.Quotient.mk (f γ)) ∧ + (∀ γ, mu 𝒜 j ((endpointSpace 𝒜 j β).subtype.lTensor _ + ((LinearMap.snd E _ _).lTensor _ (t γ))) = Submodule.Quotient.mk (g γ)) ∧ + funAtZeroMinusTensorId (hΔ.derivLinear j) T = + Filter.Germ.mapLinear ((correctionMap 𝒜 j α β + (fibreMap 𝒜 ((r + 1) • (x ^ r * y))) (fibreMap 𝒜 (x ^ (r + 1)))).lTensor _) + (t : FunAtZeroMinus _) := by + obtain ⟨f, hf, hfT⟩ := hΔ.exists_rep_endpoint hjα hx hΔx + obtain ⟨g, hg, hgT⟩ := hΔ.exists_rep_endpoint hjβ hy hΔy + choose tf htf using hfT + choose tg htg using hgT + set m := correctionMap 𝒜 j α β (fibreMap 𝒜 ((r + 1) • (x ^ r * y))) (fibreMap 𝒜 (x ^ (r + 1))) + with hm + refine ⟨f, g, fun γ ↦ (LinearMap.inl E _ _).lTensor _ (tf γ) + + (LinearMap.inr E _ _).lTensor _ (tg γ), hf, hg, fun γ ↦ ?_, fun γ ↦ ?_, ?_⟩ + · rw [lTensor_fst_lTensor_inl_add_lTensor_inr, htf] + · rw [lTensor_snd_lTensor_inl_add_lTensor_inr, htg] + · apply Filter.Germ.mapLinear_injective (mu 𝒜 j) (mu_injective hΔ h0 j) + rw [hΔ.mapLinear_mu_funAtZeroMinusTensorId j hT, Filter.Germ.mapLinear_comp, + Filter.Germ.mapLinear_coe] + have hΔH : Δ (x ^ (r + 1) * y) = + ((fun γ ↦ ((r + 1) • (x ^ r * f γ)) * y + x ^ (r + 1) * g γ : ℝ → R) : + FunAtZeroMinus R) := by + rw [hΔ.map_mul, hΔ.map_pow_succ, hf, hg] + rfl + rw [hΔH, mapLinear_idealGEQuot_coe] + congr 1 + funext γ + simp only [Function.comp_apply, LinearMap.comp_apply, map_add] + rw [← LinearMap.comp_apply (LinearMap.lTensor _ m), ← LinearMap.lTensor_comp, hm, + correctionMap_comp_inl, + ← LinearMap.comp_apply (LinearMap.lTensor _ (correctionMap _ _ _ _ _ _)), + ← LinearMap.lTensor_comp, correctionMap_comp_inr, LinearMap.lTensor_comp, + LinearMap.lTensor_comp, LinearMap.comp_apply, LinearMap.comp_apply, mu_lTensor_mulLeft, + mu_lTensor_mulLeft, htf, htg] + change Ideal.Quotient.mk _ _ = Ideal.Quotient.mk _ (f γ) * Ideal.Quotient.mk _ _ + + Ideal.Quotient.mk _ (g γ) * Ideal.Quotient.mk _ _ + rw [← RingHom.map_mul, ← RingHom.map_mul, ← RingHom.map_add] + congr 1 + simp only [nsmul_eq_mul] + ring + +/-- The Leibniz rule as an identity between tensors, +`(∂ ⊗ 1) ν_{j+1}(x^(r+1) y) = (1 ⊗ m)(ν_j(∂x), ν_j(∂y))`: `∂ ⊗ 1` applied to a tensor `T` with +`μ_{j+1}(T) = x^(r+1) y + I_{≥j+2}` is the image under `1 ⊗ m` of a function at `0⁻` with values +in `A_j ⊗ (V_α ⊕ V_β)`. -/ +theorem exists_coordinate_identity (h0 : GradeZeroScalars 𝒜) {j : ℕ} {α β : NatOrdinal} + (hjα : 0 < α.constantCoeff → j + 1 ≤ α.constantCoeff) + (hjβ : 0 < β.constantCoeff → j + 1 ≤ β.constantCoeff) + {x y : R} (hx : x ∈ 𝒜 α) (hy : y ∈ 𝒜 β) (r : ℕ) + (hΔx : Δ x ∈ funAtZeroMinusIdeal E (idealGE 𝒜 j)) + (hΔy : Δ y ∈ funAtZeroMinusIdeal E (idealGE 𝒜 j)) + {T : 𝒜 ((j + 1 : ℕ) : NatOrdinal) ⊗[E] Fibre 𝒜} + (hT : mu 𝒜 (j + 1) T = Submodule.Quotient.mk (x ^ (r + 1) * y)) : + ∃ t : ℝ → 𝒜 (j : NatOrdinal) ⊗[E] (endpointSpace 𝒜 j α × endpointSpace 𝒜 j β), + funAtZeroMinusTensorId (hΔ.derivLinear j) T = + Filter.Germ.mapLinear ((correctionMap 𝒜 j α β + (fibreMap 𝒜 ((r + 1) • (x ^ r * y))) (fibreMap 𝒜 (x ^ (r + 1)))).lTensor _) + (t : FunAtZeroMinus _) := + let ⟨_, _, t, _, _, _, _, hid⟩ := + hΔ.exists_rep_coordinate_identity h0 hjα hjβ hx hy r hΔx hΔy hT + ⟨t, hid⟩ + +end IsLoweringDerivation + +/-! ### The correction step -/ + +omit [Field E] [CommRing R] [Algebra E R] [GradedAlgebra 𝒜] in +/-- The algebra behind the correction: if `x^(r+1) y ≡ (r+1) g x^r y + h x^(r+1)` and the +corrections `g, h` multiply to zero, then `(x - g)^(r+1) (y - h) = 0`. -/ +theorem pow_sub_mul_sub_eq_zero {Q : Type*} [CommRing Q] (x y g h : Q) (r : ℕ) + (hgg : g * g = 0) (hgh : g * h = 0) + (hcong : x ^ (r + 1) * y = g * ((r + 1) * (x ^ r * y)) + h * x ^ (r + 1)) : + (x - g) ^ (r + 1) * (y - h) = 0 := by + have hpow : ∀ n : ℕ, (x - g) ^ (n + 1) = x ^ (n + 1) - (n + 1) * (x ^ n * g) := by + intro n + induction n with + | zero => ring + | succ n ih => + rw [pow_succ, ih] + push_cast + linear_combination ((n : Q) + 1) * x ^ n * hgg + linear_combination (y - h) * hpow r + hcong + (r + 1) * x ^ r * hgh + +omit [GradedAlgebra 𝒜] in +theorem lTensor_inl_fst_add_lTensor_inr_snd {U A B : Type*} [AddCommGroup U] [Module E U] + [AddCommGroup A] [Module E A] [AddCommGroup B] [Module E B] (t : U ⊗[E] (A × B)) : + (LinearMap.inl E A B).lTensor U ((LinearMap.fst E A B).lTensor U t) + + (LinearMap.inr E A B).lTensor U ((LinearMap.snd E A B).lTensor U t) = t := by + rw [← LinearMap.comp_apply, ← LinearMap.lTensor_comp, ← LinearMap.comp_apply, + ← LinearMap.lTensor_comp, ← LinearMap.add_apply, ← LinearMap.lTensor_add] + have : (LinearMap.inl E A B).comp (LinearMap.fst E A B) + + (LinearMap.inr E A B).comp (LinearMap.snd E A B) = LinearMap.id := by + ext <;> simp + rw [this, LinearMap.lTensor_id, LinearMap.id_apply] + +namespace IsLoweringDerivation + +variable (Δ) in +/-- Stage `j` of the correction argument: homogeneous lifts `x, y` of `ρ, τ` with +`x^(r+1) y ∈ I_{≥j+1}` and `∂x, ∂y ∈ Fun_{0⁻}(I_{≥j})`. -/ +structure Stage (ρ τ : Fibre 𝒜) (α β : NatOrdinal) (r j : ℕ) (x y : R) : Prop where + mem_left : x ∈ 𝒜 α + mem_right : y ∈ 𝒜 β + map_left : fibreMap 𝒜 x = ρ + map_right : fibreMap 𝒜 y = τ + prod_mem : x ^ (r + 1) * y ∈ idealGE 𝒜 (j + 1) + deriv_left : Δ x ∈ funAtZeroMinusIdeal E (idealGE 𝒜 j) + deriv_right : Δ y ∈ funAtZeroMinusIdeal E (idealGE 𝒜 j) + +include hΔ + +omit hΔ [GradedAlgebra 𝒜] in +theorem Stage.correctionMap_eq {ρ τ : Fibre 𝒜} {α β : NatOrdinal} {r j : ℕ} {x y : R} + (hs : Stage Δ ρ τ α β r j x y) : + correctionMap 𝒜 j α β (fibreMap 𝒜 ((r + 1) • (x ^ r * y))) (fibreMap 𝒜 (x ^ (r + 1))) = + correctionMap 𝒜 j α β ((r + 1) • (ρ ^ r * τ)) (ρ ^ (r + 1)) := by + rw [map_nsmul, _root_.map_mul, map_pow, map_pow, hs.map_left, hs.map_right] + +/-- The correction step: stage `j` data can be corrected to stage `j + 1` data, provided the +map `m : V_α ⊕ V_β → A/I` is injective. -/ +theorem Stage.exists_succ (h0 : GradeZeroScalars 𝒜) {ρ τ : Fibre 𝒜} {α β : NatOrdinal} + {r j : ℕ} (hjα : 0 < α.constantCoeff → j + 1 ≤ α.constantCoeff) + (hjβ : 0 < β.constantCoeff → j + 1 ≤ β.constantCoeff) + (hinj : Function.Injective (correctionMap 𝒜 j α β ((r + 1) • (ρ ^ r * τ)) (ρ ^ (r + 1)))) + {x y : R} (hs : Stage Δ ρ τ α β r j x y) : + ∃ x' y', Stage Δ ρ τ α β r (j + 1) x' y' := by + classical + -- the class of `x^(r+1) y` and the tensor form of the Leibniz rule + obtain ⟨T, hT⟩ := exists_mu_eq 𝒜 hs.prod_mem + obtain ⟨t, hid⟩ := hΔ.exists_coordinate_identity h0 hjα hjβ hs.mem_left hs.mem_right r + hs.deriv_left hs.deriv_right hT + set m := correctionMap 𝒜 j α β (fibreMap 𝒜 ((r + 1) • (x ^ r * y))) (fibreMap 𝒜 (x ^ (r + 1))) + with hm + have hminj : Function.Injective m := by rw [hm, hs.correctionMap_eq]; exact hinj + obtain ⟨T', hT'⟩ := exists_eq_lTensor_of_funAtZeroMinusTensorId_eq _ + (hΔ.derivLinear_injective j) m T _ hid + -- homogeneous lifts of the two components + obtain ⟨G, hGα, hGW, hG⟩ := exists_homogeneous_mu_eq_endpoint 𝒜 hjα + ((LinearMap.fst E _ _).lTensor _ T') + obtain ⟨G', hG'β, hG'W, hG'⟩ := exists_homogeneous_mu_eq_endpoint 𝒜 hjβ + ((LinearMap.snd E _ _).lTensor _ T') + -- the congruence `x^(r+1) y ≡ G (r+1) x^r y + G' x^(r+1)` modulo `I_{≥j+2}` + have hcong : (Submodule.Quotient.mk (x ^ (r + 1) * y) : R ⧸ idealGE 𝒜 (j + 1 + 1)) = + Submodule.Quotient.mk (G * ((r + 1) • (x ^ r * y)) + G' * x ^ (r + 1)) := by + rw [← hT, hT', ← lTensor_inl_fst_add_lTensor_inr_snd T', map_add, map_add, + ← LinearMap.comp_apply (LinearMap.lTensor _ m), ← LinearMap.lTensor_comp, hm, + correctionMap_comp_inl, + ← LinearMap.comp_apply (LinearMap.lTensor _ (correctionMap _ _ _ _ _ _)), + ← LinearMap.lTensor_comp, correctionMap_comp_inr, LinearMap.lTensor_comp, + LinearMap.lTensor_comp, LinearMap.comp_apply, LinearMap.comp_apply, mu_lTensor_mulLeft, + mu_lTensor_mulLeft, hG, hG'] + change Ideal.Quotient.mk _ G * Ideal.Quotient.mk _ _ + Ideal.Quotient.mk _ G' * + Ideal.Quotient.mk _ _ = Ideal.Quotient.mk _ _ + rw [← RingHom.map_mul, ← RingHom.map_mul, ← RingHom.map_add] + -- the corrected lifts + have hGG : G * G ∈ idealGE 𝒜 (j + 1 + 1) := + idealGE_antitone 𝒜 (by omega) (mul_mem_idealGE 𝒜 hGW hGW) + have hGG' : G * G' ∈ idealGE 𝒜 (j + 1 + 1) := + idealGE_antitone 𝒜 (by omega) (mul_mem_idealGE 𝒜 hGW hG'W) + have hprod : (x - G) ^ (r + 1) * (y - G') ∈ idealGE 𝒜 (j + 1 + 1) := by + rw [← Ideal.Quotient.eq_zero_iff_mem, RingHom.map_mul, RingHom.map_pow, RingHom.map_sub, + RingHom.map_sub] + refine pow_sub_mul_sub_eq_zero _ _ _ _ r ?_ ?_ ?_ + · rw [← RingHom.map_mul, Ideal.Quotient.eq_zero_iff_mem]; exact hGG + · rw [← RingHom.map_mul, Ideal.Quotient.eq_zero_iff_mem]; exact hGG' + · have h := hcong + simp only [nsmul_eq_mul] at h + change Ideal.Quotient.mk _ _ = Ideal.Quotient.mk _ _ at h + simp only [RingHom.map_add, RingHom.map_mul, RingHom.map_pow, map_natCast] at h + push_cast at h ⊢ + exact h + have hW1 : idealGE 𝒜 (j + 1) ≤ fibreIdeal 𝒜 := idealGE_antitone 𝒜 (by omega) + have hs' : Stage Δ ρ τ α β r j (x - G) (y - G') := + { mem_left := sub_mem hs.mem_left hGα + mem_right := sub_mem hs.mem_right hG'β + map_left := by rw [map_sub, hs.map_left, (fibreMap_eq_zero_iff 𝒜 G).mpr (hW1 hGW), sub_zero] + map_right := by + rw [map_sub, hs.map_right, (fibreMap_eq_zero_iff 𝒜 G').mpr (hW1 hG'W), sub_zero] + prod_mem := idealGE_antitone 𝒜 (by omega) hprod + deriv_left := by + rw [map_sub] + refine sub_mem hs.deriv_left ?_ + have := hΔ.map_mem_funAtZeroMinusIdeal_idealGE (j := j + 1) (by omega) hGW + rwa [Nat.add_sub_cancel] at this + deriv_right := by + rw [map_sub] + refine sub_mem hs.deriv_right ?_ + have := hΔ.map_mem_funAtZeroMinusIdeal_idealGE (j := j + 1) (by omega) hG'W + rwa [Nat.add_sub_cancel] at this } + -- the tensor identity for the corrected lifts has zero left side + have hT0 : mu 𝒜 (j + 1) (0 : 𝒜 ((j + 1 : ℕ) : NatOrdinal) ⊗[E] Fibre 𝒜) = + Submodule.Quotient.mk ((x - G) ^ (r + 1) * (y - G')) := by + rw [map_zero, eq_comm, Submodule.Quotient.mk_eq_zero] + exact hprod + obtain ⟨f', g', t', hf', hg', htf', htg', hid'⟩ := hΔ.exists_rep_coordinate_identity h0 hjα + hjβ hs'.mem_left hs'.mem_right r hs'.deriv_left hs'.deriv_right hT0 + rw [map_zero, hs'.correctionMap_eq] at hid' + have ht' : ∀ᶠ γ in 𝓝[<] (0 : ℝ), t' γ = 0 := by + have hinj' := Module.Flat.lTensor_preserves_injective_linearMap + (M := 𝒜 (j : NatOrdinal)) _ hinj + have h := Filter.Germ.mapLinear_injective _ hinj' (by rw [← hid', map_zero] : + Filter.Germ.mapLinear _ (t' : FunAtZeroMinus _) = Filter.Germ.mapLinear _ 0) + exact Filter.Germ.coe_eq.mp h + refine ⟨x - G, y - G', { hs' with prod_mem := hprod, deriv_left := ?_, deriv_right := ?_ }⟩ + · rw [hf', coe_mem_funAtZeroMinusIdeal_iff] + refine ht'.mono fun γ hγ ↦ ?_ + rw [← Submodule.Quotient.mk_eq_zero, ← htf' γ, hγ, map_zero, map_zero, map_zero] + · rw [hg', coe_mem_funAtZeroMinusIdeal_iff] + refine ht'.mono fun γ hγ ↦ ?_ + rw [← Submodule.Quotient.mk_eq_zero, ← htg' γ, hγ, map_zero, map_zero, map_zero] + +/-! ### Homogeneous nonvanishing -/ + +omit hΔ in +theorem mem_funAtZeroMinusIdeal_idealGE_zero (g : FunAtZeroMinus R) : + g ∈ funAtZeroMinusIdeal E (idealGE 𝒜 0) := by + induction g using Filter.Germ.inductionOn with + | _ f => + rw [coe_mem_funAtZeroMinusIdeal_iff, idealGE_zero] + exact Eventually.of_forall fun _ ↦ Submodule.mem_top + +omit hΔ in +/-- A function at `0⁻` with values in `I_{≥N} ∩ A_η` vanishes when `N` exceeds the finite part of +`η`. -/ +theorem eq_zero_of_mem_funAtZeroMinusIdeal_of_mem_funAtZeroMinusSubmodule {N : ℕ} {η : NatOrdinal} + {g : FunAtZeroMinus R} + (hg : g ∈ funAtZeroMinusIdeal E (idealGE 𝒜 N)) (hgη : g ∈ funAtZeroMinusSubmodule (𝒜 η)) + (hη : η.constantCoeff < N) : g = 0 := by + obtain ⟨f, hf, rfl⟩ := exists_coe_eq_of_mem_funAtZeroMinusSubmodule _ + (mem_funAtZeroMinusSubmodule_inf _ _ hgη hg) + have : f = fun _ ↦ 0 := funext fun γ ↦ by + obtain ⟨h1, h2⟩ := Submodule.mem_inf.mp (hf γ) + exact eq_zero_of_mem_idealGE_of_constantCoeff_lt 𝒜 h1 h2 hη + rw [this] + rfl + +omit hΔ in +theorem nsmul_eq_zero_iff_of_charZero [CharZero E] {V : Type*} [AddCommGroup V] [Module E V] + (n : ℕ) (v : V) : (n + 1) • v = 0 ↔ v = 0 := by + rw [← Nat.cast_smul_eq_nsmul E, smul_eq_zero] + simp [Nat.cast_add_one_ne_zero] + +/-- Homogeneous non-vanishing in `A/I`: `ρ^s τ ≠ 0` for non-zero homogeneous `ρ, τ ∈ A/I`. The +proof is a lexicographic induction on `(n, n', s)`, `n, n'` the finite parts of the degrees of +`ρ, τ` (Lean `α.constantCoeff`, `β.constantCoeff`). -/ +theorem pow_mul_ne_zero [IsDomain R] [CharZero E] (h0 : GradeZeroScalars 𝒜) (A B s : ℕ) : + ∀ {α β : NatOrdinal}, α.constantCoeff = A → β.constantCoeff = B → + ∀ {ρ τ : Fibre 𝒜}, ρ ∈ fibreGrade 𝒜 α → τ ∈ fibreGrade 𝒜 β → ρ ≠ 0 → τ ≠ 0 → + ρ ^ s * τ ≠ 0 := by + induction A using Nat.strong_induction_on generalizing B s with + | _ A ihA => + induction B using Nat.strong_induction_on generalizing s with + | _ B ihB => + induction s with + | zero => + intro α β hA hB ρ τ hρ hτ hρ0 hτ0 + simpa using hτ0 + | succ r ihs => + intro α β hA hB ρ τ hρ hτ hρ0 hτ0 hcontra + have hz : ρ ^ r * τ ≠ 0 := ihs hA hB hρ hτ hρ0 hτ0 + have hzmem : ρ ^ r * τ ∈ fibreGrade 𝒜 (r • α + β) := + mul_mem_fibreGrade 𝒜 (pow_mem_fibreGrade 𝒜 hρ r) hτ + -- (i): multiplication by `ρ^r τ` is injective on `(A/I)_{α'}` for `α'` of smaller finite part + have hi : ∀ j : ℕ, 0 < A → ∀ a ∈ fibreGrade 𝒜 (α.removeNat (j + 1)), + ρ ^ r * τ * a = 0 → a = 0 := by + intro j hA0 a ha h + by_contra ha0 + refine ihA (A - (j + 1)) (by omega) (r • α + β).constantCoeff 1 + (by rw [NatOrdinal.constantCoeff_removeNat, hA]) rfl ha hzmem ha0 hz ?_ + rw [pow_one, mul_comm] + exact h + -- (ii): multiplication by `ρ^(r+2)` is injective on `(A/I)_{β'}` for `β'` of smaller finite part + have hii : ∀ j : ℕ, 0 < B → ∀ b ∈ fibreGrade 𝒜 (β.removeNat (j + 1)), + ρ ^ (r + 2) * b = 0 → b = 0 := by + intro j hB0 b hb h + by_contra hb0 + exact ihB (B - (j + 1)) (by omega) (r + 2) hA + (by rw [NatOrdinal.constantCoeff_removeNat, hB]) hρ hb hρ0 hb0 h + -- injectivity of the correction map at every stage + have hinj : ∀ j : ℕ, + Function.Injective (correctionMap 𝒜 j α β ((r + 1) • (ρ ^ r * τ)) (ρ ^ (r + 1))) := by + intro j + rw [injective_iff_map_eq_zero] + rintro ⟨a, b⟩ hab + rw [correctionMap_apply] at hab + have hb : (b : Fibre 𝒜) = 0 := by + have h1 := congrArg (ρ * ·) hab + simp only [mul_add, mul_zero, smul_mul_assoc, mul_smul_comm] at h1 + have h2 : ρ * (ρ ^ r * τ * a) = 0 := by + rw [← mul_assoc, ← mul_assoc, ← pow_succ', hcontra, zero_mul] + rw [h2, nsmul_zero, zero_add, ← mul_assoc, ← pow_succ'] at h1 + by_cases hB0 : 0 < B + · exact hii j hB0 b ((endpointSpace_le 𝒜 j β) b.2) h1 + · exact (Submodule.mem_bot E).mp ((endpointSpace_of_eq_zero 𝒜 (by omega)).le b.2) + rw [hb, mul_zero, add_zero, smul_mul_assoc, nsmul_eq_zero_iff_of_charZero (E := E)] at hab + have ha : (a : Fibre 𝒜) = 0 := by + by_cases hA0 : 0 < A + · exact hi j hA0 a ((endpointSpace_le 𝒜 j α) a.2) hab + · exact (Submodule.mem_bot E).mp ((endpointSpace_of_eq_zero 𝒜 (by omega)).le a.2) + exact Prod.ext (Subtype.ext ha) (Subtype.ext hb) + -- lifts + obtain ⟨x, hx, hxρ⟩ := exists_mem_of_mem_fibreGrade 𝒜 hρ + obtain ⟨y, hy, hyτ⟩ := exists_mem_of_mem_fibreGrade 𝒜 hτ + have hx0 : x ≠ 0 := fun h ↦ hρ0 (by rw [← hxρ, h, map_zero]) + have hy0 : y ≠ 0 := fun h ↦ hτ0 (by rw [← hyτ, h, map_zero]) + have hprod : x ^ (r + 1) * y ∈ idealGE 𝒜 1 := by + rw [← fibreMap_eq_zero_iff, _root_.map_mul, map_pow, hxρ, hyτ] + exact hcontra + have hprodmem : x ^ (r + 1) * y ∈ 𝒜 ((r + 1) • α + β) := + SetLike.mul_mem_graded (SetLike.pow_mem_graded _ hx) hy + by_cases hAB : A = 0 ∧ B = 0 + · -- both finite parts are zero + refine mul_ne_zero (pow_ne_zero _ hx0) hy0 + (eq_zero_of_mem_idealGE_of_constantCoeff_lt 𝒜 hprodmem hprod ?_) + rw [NatOrdinal.constantCoeff_add, NatOrdinal.constantCoeff_nsmul, hA, hB, hAB.1, hAB.2] + simp + -- the positive minimum `N` of the non-zero finite parts among `n, n'` + obtain ⟨N, hNpos, hNA, hNB, hN⟩ : ∃ N : ℕ, 0 < N ∧ (0 < A → N ≤ A) ∧ (0 < B → N ≤ B) ∧ + ((N = A ∧ 0 < A) ∨ (N = B ∧ 0 < B)) := by + by_cases hA0 : 0 < A + · by_cases hB0 : 0 < B + · by_cases hle : A ≤ B + · exact ⟨A, hA0, fun _ ↦ le_rfl, fun _ ↦ hle, Or.inl ⟨rfl, hA0⟩⟩ + · exact ⟨B, hB0, fun _ ↦ by omega, fun _ ↦ le_rfl, Or.inr ⟨rfl, hB0⟩⟩ + · exact ⟨A, hA0, fun _ ↦ le_rfl, fun h ↦ absurd h hB0, Or.inl ⟨rfl, hA0⟩⟩ + · have hB0 : 0 < B := by omega + exact ⟨B, hB0, fun h ↦ absurd h hA0, fun _ ↦ le_rfl, Or.inr ⟨rfl, hB0⟩⟩ + -- the stages + have hstage : ∀ j ≤ N, ∃ x' y', Stage Δ ρ τ α β r j x' y' := by + intro j + induction j with + | zero => + intro _ + exact ⟨x, y, ⟨hx, hy, hxρ, hyτ, hprod, mem_funAtZeroMinusIdeal_idealGE_zero _, + mem_funAtZeroMinusIdeal_idealGE_zero _⟩⟩ + | succ j ih => + intro hj + obtain ⟨x', y', hs⟩ := ih (by omega) + exact hs.exists_succ hΔ h0 (fun hA0 ↦ by have := hNA (hA ▸ hA0); omega) + (fun hB0 ↦ by have := hNB (hB ▸ hB0); omega) (hinj j) + -- termination + obtain ⟨x', y', hs⟩ := hstage N le_rfl + rcases hN with ⟨rfl, hA0⟩ | ⟨rfl, hB0⟩ + · have hpred := hΔ.mem_lower (by omega) hs.mem_left + have hΔ0 : Δ x' = 0 := eq_zero_of_mem_funAtZeroMinusIdeal_of_mem_funAtZeroMinusSubmodule + hs.deriv_left hpred (by rw [NatOrdinal.constantCoeff_removeNat]; omega) + have := hΔ.injective (by omega) hs.mem_left hΔ0 + exact hρ0 (by rw [← hs.map_left, this, map_zero]) + · have hpred := hΔ.mem_lower (by omega) hs.mem_right + have hΔ0 : Δ y' = 0 := eq_zero_of_mem_funAtZeroMinusIdeal_of_mem_funAtZeroMinusSubmodule + hs.deriv_right hpred (by rw [NatOrdinal.constantCoeff_removeNat]; omega) + have := hΔ.injective (by omega) hs.mem_right hΔ0 + exact hτ0 (by rw [← hs.map_right, this, map_zero]) + +/-- `A/I` is a domain: it is graded by the `(A/I)_β`, and by homogeneous non-vanishing it has no +homogeneous zero divisors. -/ +theorem fibre_isDomain [IsDomain R] [CharZero E] (h0 : GradeZeroScalars 𝒜) : + IsDomain (Fibre 𝒜) := + GradedRing.isDomain_of_homogeneous_eq_zero_or_eq_zero (fibreGrade 𝒜) fun ⟨_, hρ⟩ ⟨_, hτ⟩ h ↦ + or_iff_not_imp_left.mpr fun hρ0 ↦ by_contra fun hτ0 ↦ + hΔ.pow_mul_ne_zero h0 _ _ 1 rfl rfl hρ hτ hρ0 hτ0 (by rwa [pow_one]) + +end IsLoweringDerivation + +end LoweringDerivation diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/FilteredModule.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/FilteredModule.lean new file mode 100644 index 0000000000..2f587444be --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/FilteredModule.lean @@ -0,0 +1,521 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Mu +public import Mathlib.LinearAlgebra.Basis.VectorSpace +public import Mathlib.LinearAlgebra.TensorProduct.Tower + +import Mathlib.LinearAlgebra.TensorProduct.Finiteness +import Mathlib.RingTheory.TensorProduct.Free +import Mathlib.Algebra.BigOperators.Group.Finset.Preimage + +/-! +# Freeness over the finite-degree part + +Let `A` (Lean `R`) be a `NatOrdinal`-graded algebra over a field `E` with a lowering derivation +`∂` (Lean `Δ`), and let `A_{<ω} = ⨁_{n < ω} A_n` be its finite-degree part. For a graded +`E`-linear section `s : A/I → A` of the quotient map `π`, the `A_{<ω}`-linear map + +`μ_s : A_{<ω} ⊗_E A/I → A`, `B ⊗ C ↦ B s(C)`, + +is bijective and carries `(A_{<ω})_{≥j} ⊗_E A/I` onto `I_{≥j}` for every `j`: + +* injectivity: writing a kernel element as a sum of pieces in the `A_n ⊗ A/I`, the piece of least + degree `d` gives a relation in the kernel of `μ_d`, which is injective; +* surjectivity onto `I_{≥j}`: a homogeneous element of `I_{≥j}` is, modulo `I_{≥j+1}`, the image + of a tensor in `A_j ⊗ A/I`, and `I_{≥j} ∩ A_δ = 0` once `j` exceeds the finite part of `δ`. + +In particular `A` is a free `A_{<ω}`-module. A homogeneous `E`-basis `𝓒` of `A/I` (through the +grading of `A/I`) with homogeneous lifts `s(C)` of its vectors determines such a graded section, +and the lifts `s(C)`, `C ∈ 𝓒`, form the basis of `A` over `A_{<ω}` corresponding under `μ_s` to +the basis `1 ⊗ C` of `A_{<ω} ⊗_E A/I`. +-/ + +universe u v + +open scoped DirectSum TensorProduct + +public noncomputable section + +namespace LoweringDerivation + +variable {E : Type u} {R : Type v} [Field E] [CommRing R] [Algebra E R] +variable (𝒜 : NatOrdinal → Submodule E R) [GradedAlgebra 𝒜] + +/-! ### The finite-degree part `A_{<ω}` -/ + +/-- The submodule `⨁_{n < ω} A_n` spanned by the finite degrees. -/ +def finiteDegreeSubmodule : Submodule E R := ⨆ n : ℕ, 𝒜 (n : NatOrdinal) + +omit [GradedAlgebra 𝒜] in +theorem mem_finiteDegreeSubmodule_of_mem {n : ℕ} {x : R} (hx : x ∈ 𝒜 (n : NatOrdinal)) : + x ∈ finiteDegreeSubmodule 𝒜 := + Submodule.mem_iSup_of_mem n hx + +omit [GradedAlgebra 𝒜] in +theorem finiteDegreeSubmodule_induction {p : (x : R) → x ∈ finiteDegreeSubmodule 𝒜 → Prop} + (mem : ∀ (n : ℕ) (x) (hx : x ∈ 𝒜 (n : NatOrdinal)), p x (mem_finiteDegreeSubmodule_of_mem 𝒜 hx)) + (zero : p 0 (zero_mem _)) + (add : ∀ x y hx hy, p x hx → p y hy → p (x + y) (add_mem hx hy)) + {x : R} (hx : x ∈ finiteDegreeSubmodule 𝒜) : p x hx := + Submodule.iSup_induction' (motive := p) _ mem zero add hx + +/-- Membership in `⨁_{n < ω} A_n`: every non-zero homogeneous component has finite degree. -/ +theorem mem_finiteDegreeSubmodule_iff (x : R) : + x ∈ finiteDegreeSubmodule 𝒜 ↔ + ∀ α, (DirectSum.decompose 𝒜 x α : R) ≠ 0 → ∃ n : ℕ, α = n := by + constructor + · intro hx + refine finiteDegreeSubmodule_induction 𝒜 (p := fun x _ ↦ ∀ α, + (DirectSum.decompose 𝒜 x α : R) ≠ 0 → ∃ n : ℕ, α = n) ?_ ?_ ?_ hx + · intro n y hy α hα + by_contra hne + exact hα (DirectSum.decompose_of_mem_ne 𝒜 hy fun h ↦ hne ⟨n, h.symm⟩) + · intro α hα + exact absurd (by rw [DirectSum.decompose_zero]; rfl) hα + · intro y z _ _ hy hz α hα + by_contra hne + apply hα + rw [DirectSum.decompose_add, DirectSum.add_apply, Submodule.coe_add] + have h1 : (DirectSum.decompose 𝒜 y α : R) = 0 := by + by_contra h; exact hne (hy α h) + have h2 : (DirectSum.decompose 𝒜 z α : R) = 0 := by + by_contra h; exact hne (hz α h) + rw [h1, h2, add_zero] + · intro hx + classical + rw [← DirectSum.sum_support_decompose 𝒜 x] + refine Submodule.sum_mem _ fun α hα ↦ ?_ + obtain ⟨n, rfl⟩ := hx α (by + intro h + exact (DFinsupp.mem_support_iff.mp hα) (Subtype.ext h)) + exact mem_finiteDegreeSubmodule_of_mem 𝒜 (DirectSum.decompose 𝒜 x (n : NatOrdinal)).2 + +/-- The finite-degree part `A_{<ω} = ⨁_{n < ω} A_n`, a subalgebra of `A` since `m ⊕ n = m + n` for +finite `m, n`. -/ +def finiteDegreePart : Subalgebra E R where + carrier := finiteDegreeSubmodule 𝒜 + add_mem' := add_mem + zero_mem' := zero_mem _ + algebraMap_mem' r := mem_finiteDegreeSubmodule_of_mem 𝒜 (n := 0) (by + rw [Nat.cast_zero] + exact SetLike.algebraMap_mem_graded 𝒜 r) + mul_mem' {x y} hx hy := by + refine finiteDegreeSubmodule_induction 𝒜 (p := fun x _ ↦ x * y ∈ finiteDegreeSubmodule 𝒜) + ?_ ?_ ?_ hx + · intro m a ha + refine finiteDegreeSubmodule_induction 𝒜 (p := fun y _ ↦ a * y ∈ finiteDegreeSubmodule 𝒜) + ?_ ?_ ?_ hy + · intro n b hb + exact mem_finiteDegreeSubmodule_of_mem 𝒜 (n := m + n) + (by rw [Nat.cast_add]; exact SetLike.mul_mem_graded ha hb) + · rw [mul_zero]; exact zero_mem _ + · intro b c _ _ hb hc + rw [mul_add]; exact add_mem hb hc + · rw [zero_mul]; exact zero_mem _ + · intro a b _ _ ha hb + rw [add_mul]; exact add_mem ha hb + +theorem mem_finiteDegreePart_iff (x : R) : + x ∈ finiteDegreePart 𝒜 ↔ x ∈ finiteDegreeSubmodule 𝒜 := Iff.rfl + +theorem mem_finiteDegreePart_of_mem {n : ℕ} {x : R} (hx : x ∈ 𝒜 (n : NatOrdinal)) : + x ∈ finiteDegreePart 𝒜 := + mem_finiteDegreeSubmodule_of_mem 𝒜 hx + +/-- The degree-`n` component of an element of `A_{<ω}`. -/ +def finiteDegreeComponent (n : ℕ) (a : finiteDegreePart 𝒜) : 𝒜 (n : NatOrdinal) := + DirectSum.decompose 𝒜 (a : R) (n : NatOrdinal) + +theorem coe_finiteDegreeComponent (n : ℕ) (a : finiteDegreePart 𝒜) : + (finiteDegreeComponent 𝒜 n a : R) = DirectSum.decompose 𝒜 (a : R) (n : NatOrdinal) := (rfl) + +theorem finiteDegreeComponent_add (n : ℕ) (a b : finiteDegreePart 𝒜) : + finiteDegreeComponent 𝒜 n (a + b) = + finiteDegreeComponent 𝒜 n a + finiteDegreeComponent 𝒜 n b := by + simp only [finiteDegreeComponent, Subalgebra.coe_add, DirectSum.decompose_add, + DirectSum.add_apply] + +theorem finiteDegreeComponent_mem_idealGE (n : ℕ) (a : finiteDegreePart 𝒜) : + (finiteDegreeComponent 𝒜 n a : R) ∈ idealGE 𝒜 n := + mem_idealGE_of_mem 𝒜 le_rfl (finiteDegreeComponent 𝒜 n a).2 + +/-- The finite degrees at which an element of `A_{<ω}` has a non-zero component. -/ +def finiteDegreeSupport (a : finiteDegreePart 𝒜) : Finset ℕ := by + classical + exact (DirectSum.decompose 𝒜 (a : R)).support.preimage Nat.cast + (Nat.cast_injective.injOn) + +theorem mem_finiteDegreeSupport_iff (a : finiteDegreePart 𝒜) (n : ℕ) : + n ∈ finiteDegreeSupport 𝒜 a ↔ finiteDegreeComponent 𝒜 n a ≠ 0 := by + classical + rw [finiteDegreeSupport, Finset.mem_preimage, DFinsupp.mem_support_iff] + rfl + +/-- An element of `A_{<ω}` is the sum of its homogeneous components. -/ +theorem sum_finiteDegreeComponent (a : finiteDegreePart 𝒜) : + ∑ n ∈ finiteDegreeSupport 𝒜 a, (finiteDegreeComponent 𝒜 n a : R) = a := by + classical + conv_rhs => rw [← DirectSum.sum_support_decompose 𝒜 (a : R)] + rw [finiteDegreeSupport] + refine Finset.sum_preimage (Nat.cast : ℕ → NatOrdinal) _ _ + (fun α ↦ (DirectSum.decompose 𝒜 (a : R) α : R)) ?_ + intro α hα hnot + exfalso + obtain ⟨n, rfl⟩ := (mem_finiteDegreeSubmodule_iff 𝒜 a).mp a.2 α + (fun h ↦ (DFinsupp.mem_support_iff.mp hα) (Subtype.ext h)) + exact hnot ⟨n, rfl⟩ + +theorem sum_finiteDegreeComponent_of_subset (a : finiteDegreePart 𝒜) {t : Finset ℕ} + (ht : finiteDegreeSupport 𝒜 a ⊆ t) : + ∑ n ∈ t, (finiteDegreeComponent 𝒜 n a : R) = a := by + rw [← sum_finiteDegreeComponent 𝒜 a] + symm + refine Finset.sum_subset ht fun n _ hn ↦ ?_ + rw [mem_finiteDegreeSupport_iff, not_not] at hn + rw [hn, Submodule.coe_zero] + +theorem eq_zero_of_finiteDegreeComponent_eq_zero {a : finiteDegreePart 𝒜} + (h : ∀ n, finiteDegreeComponent 𝒜 n a = 0) : a = 0 := by + apply Subtype.ext + rw [← sum_finiteDegreeComponent 𝒜 a] + simp [h] + +theorem finiteDegreeComponent_eq_self {n : ℕ} (a : finiteDegreePart 𝒜) + (ha : (a : R) ∈ 𝒜 (n : NatOrdinal)) : (finiteDegreeComponent 𝒜 n a : R) = a := + DirectSum.decompose_of_mem_same 𝒜 ha + +theorem finiteDegreeComponent_eq_zero_of_ne {m n : ℕ} (a : finiteDegreePart 𝒜) + (ha : (a : R) ∈ 𝒜 (m : NatOrdinal)) (h : m ≠ n) : (finiteDegreeComponent 𝒜 n a : R) = 0 := + DirectSum.decompose_of_mem_ne 𝒜 ha (by exact_mod_cast h) + +/-- The inclusion `A_j → A_{<ω}`. -/ +def natInclusion (j : ℕ) : 𝒜 (j : NatOrdinal) →ₗ[E] finiteDegreePart 𝒜 where + toFun a := ⟨a, mem_finiteDegreePart_of_mem 𝒜 a.2⟩ + map_add' _ _ := rfl + map_smul' _ _ := rfl + +theorem coe_natInclusion (j : ℕ) (a : 𝒜 (j : NatOrdinal)) : + (natInclusion 𝒜 j a : R) = a := (rfl) + +/-- An element of `A_{<ω}` is the sum of its homogeneous components, in `A_{<ω}`. -/ +theorem sum_natInclusion_finiteDegreeComponent (a : finiteDegreePart 𝒜) {t : Finset ℕ} + (ht : finiteDegreeSupport 𝒜 a ⊆ t) : + ∑ n ∈ t, natInclusion 𝒜 n (finiteDegreeComponent 𝒜 n a) = a := by + apply Subtype.ext + rw [AddSubmonoidClass.coe_finsetSum] + simp only [coe_natInclusion] + exact sum_finiteDegreeComponent_of_subset 𝒜 a ht + +/-! ### A homogeneous basis `𝓒` of `A/I` and its homogeneous lifts -/ + +/-- The index type of the chosen homogeneous basis `𝓒` of `A/I`: a degree `β` together with a +basis index of `(A/I)_β`. -/ +abbrev QuotientBasisIndex := + Σ β : NatOrdinal, Module.Basis.ofVectorSpaceIndex E (fibreGrade 𝒜 β) + +/-- The degree of a basis index. -/ +abbrev quotientBasisDegree (i : QuotientBasisIndex 𝒜) : NatOrdinal := i.1 + +/-- A chosen homogeneous `E`-basis `𝓒` of `A/I`. -/ +def fibreBasis : Module.Basis (QuotientBasisIndex 𝒜) E (Fibre 𝒜) := + (fibreGrade_isInternal 𝒜).collectedBasis fun β ↦ Module.Basis.ofVectorSpace E (fibreGrade 𝒜 β) + +theorem fibreBasis_mem (i : QuotientBasisIndex 𝒜) : + fibreBasis 𝒜 i ∈ fibreGrade 𝒜 (quotientBasisDegree 𝒜 i) := + (fibreGrade_isInternal 𝒜).collectedBasis_mem _ i + +/-- The expansion in `𝓒` of a homogeneous element of `A/I` involves only basis vectors of its +degree. -/ +theorem fibreBasis_repr_eq_zero {β : NatOrdinal} {c : Fibre 𝒜} (hc : c ∈ fibreGrade 𝒜 β) + (i : QuotientBasisIndex 𝒜) (hi : quotientBasisDegree 𝒜 i ≠ β) : (fibreBasis 𝒜).repr c i = 0 := + (fibreGrade_isInternal 𝒜).collectedBasis_repr_of_mem_ne _ (Ne.symm hi) hc + +/-- A chosen homogeneous lift `s(C) ∈ A` of each basis vector `C ∈ 𝓒`. -/ +def quotientBasisLift (i : QuotientBasisIndex 𝒜) : R := + (exists_mem_of_mem_fibreGrade 𝒜 (fibreBasis_mem 𝒜 i)).choose + +theorem quotientBasisLift_mem (i : QuotientBasisIndex 𝒜) : quotientBasisLift 𝒜 i ∈ 𝒜 + (quotientBasisDegree 𝒜 i) := + (exists_mem_of_mem_fibreGrade 𝒜 (fibreBasis_mem 𝒜 i)).choose_spec.1 + +theorem fibreMap_quotientBasisLift (i : QuotientBasisIndex 𝒜) : fibreMap 𝒜 (quotientBasisLift 𝒜 i) = + fibreBasis 𝒜 i := + (exists_mem_of_mem_fibreGrade 𝒜 (fibreBasis_mem 𝒜 i)).choose_spec.2 + +theorem quotientBasisLift_ne_zero (i : QuotientBasisIndex 𝒜) : quotientBasisLift 𝒜 i ≠ 0 := fun h ↦ + (fibreBasis 𝒜).ne_zero i (by rw [← fibreMap_quotientBasisLift, h, map_zero]) + +/-- The graded `E`-linear section `s : A/I → A` of `π` sending each `C ∈ 𝓒` to its chosen lift +`s(C)`. -/ +def fibreSection : Fibre 𝒜 →ₗ[E] R := (fibreBasis 𝒜).constr E (quotientBasisLift 𝒜) + +theorem fibreSection_basis (i : QuotientBasisIndex 𝒜) : + fibreSection 𝒜 (fibreBasis 𝒜 i) = quotientBasisLift 𝒜 i := + (fibreBasis 𝒜).constr_basis E _ i + +theorem fibreMap_fibreSection (c : Fibre 𝒜) : fibreMap 𝒜 (fibreSection 𝒜 c) = c := by + have h : (fibreMap 𝒜).toLinearMap ∘ₗ fibreSection 𝒜 = LinearMap.id := + (fibreBasis 𝒜).ext fun i ↦ by + rw [LinearMap.comp_apply, fibreSection_basis, AlgHom.toLinearMap_apply, + fibreMap_quotientBasisLift, + LinearMap.id_apply] + exact LinearMap.congr_fun h c + +/-- The section `s` is graded: `s((A/I)_β) ⊆ A_β`. -/ +theorem fibreSection_mem {β : NatOrdinal} {c : Fibre 𝒜} (hc : c ∈ fibreGrade 𝒜 β) : + fibreSection 𝒜 c ∈ 𝒜 β := by + rw [fibreSection, Module.Basis.constr_apply, Finsupp.sum] + refine Submodule.sum_mem _ fun i hi ↦ Submodule.smul_mem _ _ ?_ + have hgrade : quotientBasisDegree 𝒜 i = β := by + by_contra hne + exact (Finsupp.mem_support_iff.mp hi) (fibreBasis_repr_eq_zero 𝒜 hc i hne) + rw [← hgrade] + exact quotientBasisLift_mem 𝒜 i + +/-! ### The filtered `A_{<ω}`-module `A` -/ + +/-- A graded `E`-linear section `s : A/I → A` of the quotient map `π`: `π ∘ s = id` and `s` +carries `(A/I)_β` into `A_β`. -/ +structure IsGradedFibreSection (s : Fibre 𝒜 →ₗ[E] R) : Prop where + /-- `π ∘ s = id`. -/ + fibreMap_apply : ∀ c, fibreMap 𝒜 (s c) = c + /-- `s` is graded. -/ + mem : ∀ {β : NatOrdinal} {c : Fibre 𝒜}, c ∈ fibreGrade 𝒜 β → s c ∈ 𝒜 β + +/-- The chosen section `fibreSection` is a graded section of `π`. -/ +theorem fibreSection_isGradedFibreSection : IsGradedFibreSection 𝒜 (fibreSection 𝒜) where + fibreMap_apply := fibreMap_fibreSection 𝒜 + mem := fibreSection_mem 𝒜 + +/-- The paper's `μ_s : A_{<ω} ⊗_E A/I → A`, `B ⊗ C ↦ B s(C)`, as an `A_{<ω}`-linear map. -/ +def muOfSection (s : Fibre 𝒜 →ₗ[E] R) : + finiteDegreePart 𝒜 ⊗[E] Fibre 𝒜 →ₗ[finiteDegreePart 𝒜] R := + TensorProduct.AlgebraTensorModule.lift + (LinearMap.toSpanSingleton (finiteDegreePart 𝒜) (Fibre 𝒜 →ₗ[E] R) s) + +theorem muOfSection_tmul (s : Fibre 𝒜 →ₗ[E] R) (a : finiteDegreePart 𝒜) (c : Fibre 𝒜) : + muOfSection 𝒜 s (a ⊗ₜ[E] c) = (a : R) * s c := by + rw [muOfSection, TensorProduct.AlgebraTensorModule.lift_tmul, + LinearMap.toSpanSingleton_apply, LinearMap.smul_apply, Subalgebra.smul_def, smul_eq_mul] + +/-- The restriction of `μ_s` to `A_j ⊗ A/I`, `B ⊗ C ↦ B s(C)`. -/ +def gradeSectionMul (s : Fibre 𝒜 →ₗ[E] R) (j : ℕ) : 𝒜 (j : NatOrdinal) ⊗[E] Fibre 𝒜 →ₗ[E] R := + TensorProduct.lift ((LinearMap.mul E R).compl₁₂ (𝒜 (j : NatOrdinal)).subtype s) + +omit [GradedAlgebra 𝒜] in +theorem gradeSectionMul_tmul (s : Fibre 𝒜 →ₗ[E] R) (j : ℕ) (a : 𝒜 (j : NatOrdinal)) + (c : Fibre 𝒜) : gradeSectionMul 𝒜 s j (a ⊗ₜ[E] c) = (a : R) * s c := by + rw [gradeSectionMul, TensorProduct.lift.tmul] + rfl + +theorem muOfSection_rTensor_natInclusion (s : Fibre 𝒜 →ₗ[E] R) (j : ℕ) + (T : 𝒜 (j : NatOrdinal) ⊗[E] Fibre 𝒜) : + muOfSection 𝒜 s ((natInclusion 𝒜 j).rTensor _ T) = gradeSectionMul 𝒜 s j T := by + induction T with + | zero => rw [map_zero, map_zero, map_zero] + | tmul a c => + rw [LinearMap.rTensor_tmul, muOfSection_tmul, gradeSectionMul_tmul, coe_natInclusion] + | add x y hx hy => rw [map_add, map_add, hx, hy, map_add] + +omit [GradedAlgebra 𝒜] in +theorem gradeSectionMul_mem_idealGE (s : Fibre 𝒜 →ₗ[E] R) (j : ℕ) + (T : 𝒜 (j : NatOrdinal) ⊗[E] Fibre 𝒜) : gradeSectionMul 𝒜 s j T ∈ idealGE 𝒜 j := by + induction T with + | zero => rw [map_zero]; exact zero_mem _ + | tmul a c => + rw [gradeSectionMul_tmul] + exact Ideal.mul_mem_right _ _ (mem_idealGE_of_mem 𝒜 le_rfl a.2) + | add x y hx hy => rw [map_add]; exact add_mem hx hy + +/-- For a section `s` of `π`, `μ_s(T)` represents `μ_j(T)`: its class modulo `I_{≥j+1}` is +`μ_j(T)`. -/ +theorem mk_gradeSectionMul {s : Fibre 𝒜 →ₗ[E] R} (hs : IsGradedFibreSection 𝒜 s) (j : ℕ) + (T : 𝒜 (j : NatOrdinal) ⊗[E] Fibre 𝒜) : + (Submodule.Quotient.mk (gradeSectionMul 𝒜 s j T) : R ⧸ idealGE 𝒜 (j + 1)) = + mu 𝒜 j T := by + induction T with + | zero => rw [map_zero, map_zero, Submodule.Quotient.mk_zero] + | tmul a c => + rw [gradeSectionMul_tmul, ← hs.fibreMap_apply c, mu_tmul, hs.fibreMap_apply] + | add x y hx hy => rw [map_add, map_add, Submodule.Quotient.mk_add, hx, hy] + +/-- For a graded section, `μ_s` carries `A_j ⊗ (A/I)_β` into `A_{j ⊕ β}`. -/ +theorem gradeSectionMul_lTensor_mem {s : Fibre 𝒜 →ₗ[E] R} (hs : IsGradedFibreSection 𝒜 s) + (j : ℕ) (β : NatOrdinal) (T : 𝒜 (j : NatOrdinal) ⊗[E] fibreGrade 𝒜 β) : + gradeSectionMul 𝒜 s j ((fibreGrade 𝒜 β).subtype.lTensor _ T) ∈ 𝒜 ((j : NatOrdinal) + β) := by + induction T with + | zero => rw [map_zero, map_zero]; exact zero_mem _ + | tmul a c => + rw [LinearMap.lTensor_tmul, gradeSectionMul_tmul, Submodule.subtype_apply] + exact SetLike.mul_mem_graded a.2 (hs.mem c.2) + | add x y hx hy => rw [map_add, map_add]; exact add_mem hx hy + +/-- The submodule `(A_{<ω})_{≥j} ⊗_E A/I = ∑_{n ≥ j} A_n ⊗ A/I` of `A_{<ω} ⊗_E A/I`. -/ +def tensorIdealGEFiltration (j : ℕ) : Submodule E (finiteDegreePart 𝒜 ⊗[E] Fibre 𝒜) := + ⨆ (e : ℕ) (_ : j ≤ e), LinearMap.range ((natInclusion 𝒜 e).rTensor (Fibre 𝒜)) + +theorem rTensor_natInclusion_mem_tensorIdealGEFiltration {j e : ℕ} (hje : j ≤ e) + (T : 𝒜 (e : NatOrdinal) ⊗[E] Fibre 𝒜) : + (natInclusion 𝒜 e).rTensor _ T ∈ tensorIdealGEFiltration 𝒜 j := + Submodule.mem_iSup_of_mem e (Submodule.mem_iSup_of_mem hje ⟨T, rfl⟩) + +theorem tensorIdealGEFiltration_antitone {i j : ℕ} (hij : i ≤ j) : + tensorIdealGEFiltration 𝒜 j ≤ tensorIdealGEFiltration 𝒜 i := + iSup₂_le fun e hje ↦ le_iSup₂_of_le e (hij.trans hje) le_rfl + +/-- `μ_s` carries `(A_{<ω})_{≥j} ⊗_E A/I` into `I_{≥j}`. -/ +theorem muOfSection_mem_idealGE (s : Fibre 𝒜 →ₗ[E] R) {j : ℕ} + {u : finiteDegreePart 𝒜 ⊗[E] Fibre 𝒜} (hu : u ∈ tensorIdealGEFiltration 𝒜 j) : + muOfSection 𝒜 s u ∈ idealGE 𝒜 j := by + have hle : tensorIdealGEFiltration 𝒜 j ≤ + ((idealGE 𝒜 j).restrictScalars E).comap ((muOfSection 𝒜 s).restrictScalars E) := by + refine iSup₂_le fun e hje ↦ ?_ + rintro _ ⟨T, rfl⟩ + rw [Submodule.mem_comap, LinearMap.restrictScalars_apply, Submodule.restrictScalars_mem, + muOfSection_rTensor_natInclusion] + exact idealGE_antitone 𝒜 hje (gradeSectionMul_mem_idealGE 𝒜 s e T) + exact hle hu + +/-- Every homogeneous element of `I_{≥j}` lies in `μ_s((A_{<ω})_{≥j} ⊗_E A/I)`: descending +induction on `j`, using the surjectivity of `μ_j` and the vanishing `I_{≥j} ∩ A_δ = 0` for `j` +beyond the finite part of `δ`. -/ +theorem mem_map_tensorIdealGEFiltration_of_mem_idealGE {s : Fibre 𝒜 →ₗ[E] R} + (hs : IsGradedFibreSection 𝒜 s) {δ : NatOrdinal} (d : ℕ) : + ∀ j : ℕ, δ.constantCoeff + 1 ≤ j + d → ∀ H ∈ 𝒜 δ, H ∈ idealGE 𝒜 j → + H ∈ (tensorIdealGEFiltration 𝒜 j).map ((muOfSection 𝒜 s).restrictScalars E) := by + induction d with + | zero => + intro j hj H hHδ hH + rw [eq_zero_of_mem_idealGE_of_constantCoeff_lt 𝒜 hHδ hH (by omega)] + exact zero_mem _ + | succ d ih => + intro j hj H hHδ hH + by_cases hjδ : δ.constantCoeff < j + · rw [eq_zero_of_mem_idealGE_of_constantCoeff_lt 𝒜 hHδ hH hjδ] + exact zero_mem _ + obtain ⟨T, hT⟩ := exists_mu_lTensor_eq 𝒜 hHδ hH + set G := gradeSectionMul 𝒜 s j ((fibreGrade 𝒜 (δ.removeNat j)).subtype.lTensor _ T) with hG + have hsum : (j : NatOrdinal) + δ.removeNat j = δ := by + rw [add_comm] + exact NatOrdinal.removeNat_add_natCast (by omega) + have hGδ : G ∈ 𝒜 δ := hsum ▸ gradeSectionMul_lTensor_mem 𝒜 hs j _ T + have hdiff : H - G ∈ idealGE 𝒜 (j + 1) := by + rw [← mk_gradeSectionMul 𝒜 hs] at hT + exact (Submodule.Quotient.eq _).mp hT.symm + have h1 := ih (j + 1) (by omega) _ (sub_mem hHδ hGδ) hdiff + have h2 : G ∈ (tensorIdealGEFiltration 𝒜 j).map ((muOfSection 𝒜 s).restrictScalars E) := + ⟨_, rTensor_natInclusion_mem_tensorIdealGEFiltration 𝒜 le_rfl _, + by rw [LinearMap.restrictScalars_apply, muOfSection_rTensor_natInclusion]⟩ + have h1' := Submodule.map_mono (tensorIdealGEFiltration_antitone 𝒜 (Nat.le_succ j)) h1 + simpa using add_mem h1' h2 + +/-- `μ_s` carries `(A_{<ω})_{≥j} ⊗_E A/I` onto `I_{≥j}`. -/ +theorem map_tensorIdealGEFiltration {s : Fibre 𝒜 →ₗ[E] R} (hs : IsGradedFibreSection 𝒜 s) + (j : ℕ) : + (tensorIdealGEFiltration 𝒜 j).map ((muOfSection 𝒜 s).restrictScalars E) = + (idealGE 𝒜 j).restrictScalars E := by + classical + apply le_antisymm + · rintro _ ⟨u, hu, rfl⟩ + rw [LinearMap.restrictScalars_apply, Submodule.restrictScalars_mem] + exact muOfSection_mem_idealGE 𝒜 s hu + · intro H hH + rw [Submodule.restrictScalars_mem] at hH + rw [← DirectSum.sum_support_decompose 𝒜 H] + refine Submodule.sum_mem _ fun δ _ ↦ ?_ + exact mem_map_tensorIdealGEFiltration_of_mem_idealGE 𝒜 hs (δ.constantCoeff + 1) j + (by omega) _ (DirectSum.decompose 𝒜 H δ).2 (idealGE_isHomogeneous 𝒜 j δ hH) + +/-- Every tensor in `A_{<ω} ⊗_E A/I` is a finite sum of pieces `(ι_n ⊗ 1) t_n` with +`t_n ∈ A_n ⊗ A/I`, `ι_n : A_n → A_{<ω}` the inclusion. -/ +theorem exists_eq_sum_rTensor_natInclusion (u : finiteDegreePart 𝒜 ⊗[E] Fibre 𝒜) : + ∃ (N : Finset ℕ) (t : ∀ n : ℕ, 𝒜 (n : NatOrdinal) ⊗[E] Fibre 𝒜), + u = ∑ n ∈ N, (natInclusion 𝒜 n).rTensor _ (t n) := by + classical + obtain ⟨P, rfl⟩ := TensorProduct.exists_finset u + refine ⟨P.biUnion fun p ↦ finiteDegreeSupport 𝒜 p.1, + fun n ↦ ∑ p ∈ P, finiteDegreeComponent 𝒜 n p.1 ⊗ₜ[E] p.2, + ?_⟩ + have : ∀ p ∈ P, p.1 ⊗ₜ[E] p.2 = ∑ n ∈ P.biUnion fun p ↦ finiteDegreeSupport 𝒜 p.1, + natInclusion 𝒜 n (finiteDegreeComponent 𝒜 n p.1) ⊗ₜ[E] p.2 := fun p hp ↦ by + rw [← TensorProduct.sum_tmul, sum_natInclusion_finiteDegreeComponent 𝒜 p.1 + fun n hn ↦ Finset.mem_biUnion.mpr ⟨p, hp, hn⟩] + rw [Finset.sum_congr rfl this, Finset.sum_comm] + exact Finset.sum_congr rfl fun n _ ↦ by simp only [map_sum, LinearMap.rTensor_tmul] + +/-- `μ_s` is injective: in a kernel element, the piece of least finite degree `d` gives a +relation in the kernel of `μ_d`. -/ +theorem muOfSection_injective (h0 : GradeZeroScalars 𝒜) {Δ : R →ₗ[E] FunAtZeroMinus R} + (hΔ : IsLoweringDerivation 𝒜 Δ) {s : Fibre 𝒜 →ₗ[E] R} (hs : IsGradedFibreSection 𝒜 s) : + Function.Injective (muOfSection 𝒜 s) := by + classical + rw [injective_iff_map_eq_zero] + intro u hu + obtain ⟨N, t, rfl⟩ := exists_eq_sum_rTensor_natInclusion 𝒜 u + by_contra hne + -- a least finite degree `d` with a non-zero piece + have hex : ∃ n ∈ N, t n ≠ 0 := by + by_contra hall + push Not at hall + exact hne (Finset.sum_eq_zero fun n hn ↦ by rw [hall n hn, map_zero]) + obtain ⟨d, hdN, hdmin⟩ := (N.filter fun n ↦ t n ≠ 0).exists_min_image id + (by obtain ⟨n, hn, hn'⟩ := hex; exact ⟨n, Finset.mem_filter.mpr ⟨hn, hn'⟩⟩) + simp only [id, Finset.mem_filter] at hdmin + obtain ⟨hdN', hd0⟩ := Finset.mem_filter.mp hdN + -- the remaining pieces lie in `I_{≥d+1}` + have hrest : ∑ n ∈ N.erase d, gradeSectionMul 𝒜 s n (t n) ∈ idealGE 𝒜 (d + 1) := by + refine Submodule.sum_mem _ fun n hn ↦ ?_ + by_cases hn0 : t n = 0 + · rw [hn0, map_zero]; exact zero_mem _ + · have hdn : d < n := lt_of_le_of_ne (hdmin n ⟨Finset.mem_of_mem_erase hn, hn0⟩) + (Finset.ne_of_mem_erase hn).symm + exact idealGE_antitone 𝒜 hdn (gradeSectionMul_mem_idealGE 𝒜 s n (t n)) + have hlead : gradeSectionMul 𝒜 s d (t d) ∈ idealGE 𝒜 (d + 1) := by + have hsum : ∑ n ∈ N, gradeSectionMul 𝒜 s n (t n) = 0 := by + rw [← hu, map_sum] + exact Finset.sum_congr rfl fun n _ ↦ (muOfSection_rTensor_natInclusion 𝒜 s n _).symm + rw [← Finset.add_sum_erase N _ hdN'] at hsum + rw [eq_neg_of_add_eq_zero_left hsum] + exact neg_mem hrest + have hchar : mu 𝒜 d (t d) = 0 := by + rw [← mk_gradeSectionMul 𝒜 hs, Submodule.Quotient.mk_eq_zero] + exact hlead + exact hd0 ((injective_iff_map_eq_zero _).mp (hΔ.mu_injective h0 d) _ hchar) + +/-- `μ_s` is bijective for every graded section `s` of `π`. -/ +theorem muOfSection_bijective (h0 : GradeZeroScalars 𝒜) {Δ : R →ₗ[E] FunAtZeroMinus R} + (hΔ : IsLoweringDerivation 𝒜 Δ) {s : Fibre 𝒜 →ₗ[E] R} (hs : IsGradedFibreSection 𝒜 s) : + Function.Bijective (muOfSection 𝒜 s) := by + refine ⟨muOfSection_injective 𝒜 h0 hΔ hs, fun y ↦ ?_⟩ + have hy : y ∈ (idealGE 𝒜 0).restrictScalars E := by + rw [Submodule.restrictScalars_mem, idealGE_zero] + exact Submodule.mem_top + rw [← map_tensorIdealGEFiltration 𝒜 hs 0] at hy + obtain ⟨u, -, hu⟩ := hy + exact ⟨u, hu⟩ + +/-! ### The basis of `A` over `A_{<ω}` -/ + +/-- The chosen homogeneous lifts `s(C)`, `C ∈ 𝓒`, form a basis of `A` over `A_{<ω}`: the image +under `μ_s`, for the section `s = fibreSection`, of the basis `1 ⊗ C` of `A_{<ω} ⊗_E A/I` over +`A_{<ω}`. -/ +def basisOverFiniteDegreePart (h0 : GradeZeroScalars 𝒜) {Δ : R →ₗ[E] FunAtZeroMinus R} + (hΔ : IsLoweringDerivation 𝒜 Δ) : + Module.Basis (QuotientBasisIndex 𝒜) (finiteDegreePart 𝒜) R := + (Algebra.TensorProduct.basis (finiteDegreePart 𝒜) (fibreBasis 𝒜)).map + (LinearEquiv.ofBijective (muOfSection 𝒜 (fibreSection 𝒜)) + (muOfSection_bijective 𝒜 h0 hΔ (fibreSection_isGradedFibreSection 𝒜))) + +theorem basisOverFiniteDegreePart_apply (h0 : GradeZeroScalars 𝒜) {Δ : R →ₗ[E] FunAtZeroMinus R} + (hΔ : IsLoweringDerivation 𝒜 Δ) (i : QuotientBasisIndex 𝒜) : + basisOverFiniteDegreePart 𝒜 h0 hΔ i = quotientBasisLift 𝒜 i := by + rw [basisOverFiniteDegreePart, Module.Basis.map_apply, Algebra.TensorProduct.basis_apply, + LinearEquiv.ofBijective_apply, muOfSection_tmul, OneMemClass.coe_one, one_mul, + fibreSection_basis] + +end LoweringDerivation diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Grading.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Grading.lean new file mode 100644 index 0000000000..90656fbe07 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Grading.lean @@ -0,0 +1,322 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart +public import Mathlib.RingTheory.GradedAlgebra.Basic +public import Mathlib.RingTheory.GradedAlgebra.Homogeneous.Ideal +public import Mathlib.RingTheory.Ideal.Quotient.Operations + +import Mathlib.LinearAlgebra.DFinsupp + +/-! +# Graded algebras over countable ordinals: the ideals `I_{≥j}` and the quotient `A/I` + +Let `A` (Lean `R`) be a commutative algebra over a field `E`, graded by the natural numbers' +ordinal extension `NatOrdinal` with its natural sum `⊕` (Lean `+`). The paper's setting has +`A_0 = E`; this file uses only the grading. For `j ∈ ℕ`, the ideal `I_{≥j}` is generated by the +homogeneous elements of finite degree at least `j`, + +`I_{≥j} = ∑_{j ≤ n < ω} A_n A`, + +with `I_{≥0} = A` and `I_{≥i} I_{≥j} ⊆ I_{≥i+j}`; the `I_{≥j}` are homogeneous and decreasing. +Every homogeneous element of `I_{≥j}` is a finite sum of products `B C` with `B ∈ A_e`, `e ≥ j` +finite, and `C` homogeneous of complementary degree, so `I_{≥j} ∩ A_δ = 0` as soon as `j` exceeds +the finite part of `δ` (the constant Cantor coefficient, Lean `δ.constantCoeff`). The quotient +`A/I`, `I = I_{≥1}`, inherits the grading: the images `(A/I)_β = π(A_β)` form an internal direct +sum decomposition of `A/I`, making it a graded `E`-algebra. + +The paper writes `A/I` (in the application, `P̂/I`) and calls it the quotient; its one use of +the word "fibre" is "`P̂/I ≅ P̂ ⊗_{P̂_{<ω}} K`, the fibre of `P̂` over the quotient map +`P̂_{<ω} → P̂_{<ω}/(P̂_{<ω})₊ = K`". "Fibre" is this Lean's noun for it: `Fibre 𝒜` is `A/I`, +`fibreIdeal 𝒜` is `I`, `fibreMap 𝒜` is `π`, and `fibreGrade 𝒜 β` is `(A/I)_β`. +-/ + +universe u v + +open scoped DirectSum + +public noncomputable section + +namespace LoweringDerivation + +variable {E : Type u} {R : Type v} [Field E] [CommRing R] [Algebra E R] +variable (𝒜 : NatOrdinal → Submodule E R) [GradedAlgebra 𝒜] + +/-! ### The ideals `I_{≥j}` -/ + +/-- The generators of `I_{≥j}`: the homogeneous elements of finite degree at least `j`. -/ +def idealGEGenerators (j : ℕ) : Set R := + ⋃ e : ℕ, ⋃ (_ : j ≤ e), (𝒜 (e : NatOrdinal) : Set R) + +/-- The ideal `I_{≥j} = ∑_{j ≤ n < ω} A_n A` generated by the homogeneous elements of finite degree +at least `j`. -/ +def idealGE (j : ℕ) : Ideal R := + Ideal.span (idealGEGenerators 𝒜 j) + +omit [GradedAlgebra 𝒜] in +theorem idealGE_eq_span (j : ℕ) : idealGE 𝒜 j = Ideal.span (idealGEGenerators 𝒜 j) := (rfl) + +omit [GradedAlgebra 𝒜] in +theorem mem_idealGEGenerators_iff (j : ℕ) (x : R) : + x ∈ idealGEGenerators 𝒜 j ↔ ∃ e : ℕ, j ≤ e ∧ x ∈ 𝒜 (e : NatOrdinal) := by + simp [idealGEGenerators] + +omit [GradedAlgebra 𝒜] in +theorem mem_idealGE_of_mem {j e : ℕ} (hje : j ≤ e) {x : R} + (hx : x ∈ 𝒜 (e : NatOrdinal)) : + x ∈ idealGE 𝒜 j := + Ideal.subset_span ((mem_idealGEGenerators_iff 𝒜 j x).mpr ⟨e, hje, hx⟩) + +omit [GradedAlgebra 𝒜] in +theorem idealGE_antitone {i j : ℕ} (hij : i ≤ j) : + idealGE 𝒜 j ≤ idealGE 𝒜 i := + Ideal.span_mono fun x hx ↦ by + obtain ⟨e, hje, hxe⟩ := (mem_idealGEGenerators_iff 𝒜 j x).mp hx + exact (mem_idealGEGenerators_iff 𝒜 i x).mpr ⟨e, hij.trans hje, hxe⟩ + +theorem idealGE_zero : idealGE 𝒜 0 = ⊤ := + (Ideal.eq_top_iff_one _).mpr (mem_idealGE_of_mem 𝒜 (e := 0) le_rfl + (by simpa using SetLike.one_mem_graded 𝒜)) + +theorem idealGE_mul_le (i j : ℕ) : + idealGE 𝒜 i * idealGE 𝒜 j ≤ idealGE 𝒜 (i + j) := by + rw [idealGE, idealGE, Ideal.span_mul_span] + refine Ideal.span_le.mpr ?_ + rintro _ ⟨x, hx, y, hy, rfl⟩ + obtain ⟨e, hie, hxe⟩ := (mem_idealGEGenerators_iff 𝒜 i x).mp hx + obtain ⟨e', hje', hye'⟩ := (mem_idealGEGenerators_iff 𝒜 j y).mp hy + refine Ideal.subset_span ((mem_idealGEGenerators_iff 𝒜 (i + j) (x * y)).mpr + ⟨e + e', Nat.add_le_add hie hje', ?_⟩) + rw [Nat.cast_add] + exact SetLike.mul_mem_graded hxe hye' + +theorem mul_mem_idealGE {i j : ℕ} {x y : R} (hx : x ∈ idealGE 𝒜 i) + (hy : y ∈ idealGE 𝒜 j) : x * y ∈ idealGE 𝒜 (i + j) := + idealGE_mul_le 𝒜 i j (Ideal.mul_mem_mul hx hy) + +theorem idealGE_isHomogeneous (j : ℕ) : (idealGE 𝒜 j).IsHomogeneous 𝒜 := + Ideal.homogeneous_span 𝒜 _ fun x hx ↦ by + obtain ⟨e, -, hxe⟩ := (mem_idealGEGenerators_iff 𝒜 j x).mp hx + exact ⟨(e : NatOrdinal), hxe⟩ + +/-! ### Homogeneous presentations and the vanishing `I_{≥j} ∩ A_δ = 0` -/ + +/-- The degree-`δ` component of a product `r * g` with `g` homogeneous of degree `e` is +`r_β * g` when `β ⊕ e = δ`. -/ +theorem decompose_mul_of_right_mem_eq {r g : R} {e β δ : NatOrdinal} (hg : g ∈ 𝒜 e) + (hβ : β + e = δ) : + (DirectSum.decompose 𝒜 (r * g) δ : R) = (DirectSum.decompose 𝒜 r β : R) * g := by + rw [DirectSum.decompose_mul, DirectSum.decompose_of_mem 𝒜 hg] + exact DirectSum.coe_mul_of_apply_aux 𝒜 _ _ fun x ↦ + ⟨fun hx ↦ add_right_cancel (hx.trans hβ.symm), fun hx ↦ hx ▸ hβ⟩ + +/-- The degree-`δ` component of `r * g`, with `g` homogeneous of degree `e`, vanishes when no +degree `β` satisfies `β ⊕ e = δ`. -/ +theorem decompose_mul_of_right_mem_eq_zero {r g : R} {e δ : NatOrdinal} (hg : g ∈ 𝒜 e) + (h : ∀ β, β + e ≠ δ) : (DirectSum.decompose 𝒜 (r * g) δ : R) = 0 := by + classical + rw [DirectSum.decompose_mul, DirectSum.decompose_of_mem 𝒜 hg, + DirectSum.coe_mul_apply_eq_dfinsuppSum, DFinsupp.sum_comm] + refine (DFinsupp.sum_single_index ?_).trans (DFinsupp.sum_eq_zero fun β ↦ if_neg (h β)) + simp + +/-- The degree-`δ` component of an element of the span of homogeneous generators is a finite sum +of products `r_k * g_k`, with `g_k` a generator, of degree `e g_k`, and `r_k` a homogeneous +component, of degree `β_k` with `β_k ⊕ e g_k = δ`, of the coefficient of `g_k`. -/ +theorem exists_decompose_eq_sum_of_mem_span {S : Set R} (e : S → NatOrdinal) + (hS : ∀ g : S, (g : R) ∈ 𝒜 (e g)) {x : R} (hx : x ∈ Ideal.span S) (δ : NatOrdinal) : + ∃ (κ : Type) (_ : Fintype κ) (g : κ → S) (r : κ → R) (β : κ → NatOrdinal), + (∀ k, r k ∈ 𝒜 (β k)) ∧ (∀ k, β k + e (g k) = δ) ∧ + (DirectSum.decompose 𝒜 x δ : R) = ∑ k, r k * g k := by + classical + obtain ⟨n, c, g, hsum⟩ := Submodule.mem_span_set'.mp hx + let κ := {i : Fin n // ∃ β, β + e (g i) = δ} + choose β hβ using fun k : κ ↦ k.2 + refine ⟨κ, inferInstance, fun k ↦ g k.1, fun k ↦ (DirectSum.decompose 𝒜 (c k.1) (β k) : R), β, + fun k ↦ (DirectSum.decompose 𝒜 (c k.1) (β k)).2, hβ, ?_⟩ + let β' : Fin n → NatOrdinal := fun i ↦ + if hP : ∃ β, β + e (g i) = δ then β ⟨i, hP⟩ else 0 + have hterm : ∀ i : Fin n, (DirectSum.decompose 𝒜 (c i • (g i : R)) δ : R) = + if ∃ β, β + e (g i) = δ then (DirectSum.decompose 𝒜 (c i) (β' i) : R) * g i else 0 := by + intro i + rw [smul_eq_mul] + split_ifs with hP + · rw [show β' i = β ⟨i, hP⟩ from dif_pos hP] + exact decompose_mul_of_right_mem_eq 𝒜 (hS (g i)) (hβ ⟨i, hP⟩) + · exact decompose_mul_of_right_mem_eq_zero 𝒜 (hS (g i)) fun β hβ ↦ hP ⟨β, hβ⟩ + rw [← hsum, DirectSum.decompose_sum, DirectSum.sum_apply, Submodule.coe_sum, + Finset.sum_congr rfl fun i _ ↦ hterm i, ← Finset.sum_filter, + Finset.sum_subtype (Finset.univ.filter fun i : Fin n ↦ ∃ β, β + e (g i) = δ) + (p := fun i : Fin n ↦ ∃ β, β + e (g i) = δ) (fun i ↦ by simp)] + exact Finset.sum_congr rfl fun k _ ↦ by rw [show β' k.1 = β k from dif_pos k.2] + +/-- A homogeneous element of `I_{≥j} ∩ A_δ` is a finite sum of products `a * b` with `a ∈ A_e`, +`e ≥ j` finite, and `b` homogeneous of a degree `β` with `e ⊕ β = δ`. -/ +theorem exists_homogeneous_presentation {j : ℕ} {δ : NatOrdinal} {x : R} (hxδ : x ∈ 𝒜 δ) + (hx : x ∈ idealGE 𝒜 j) : + ∃ (κ : Type) (_ : Fintype κ) (e : κ → ℕ) (a b : κ → R) (β : κ → NatOrdinal), + (∀ k, j ≤ e k) ∧ (∀ k, a k ∈ 𝒜 (e k : NatOrdinal)) ∧ + (∀ k, b k ∈ 𝒜 (β k)) ∧ (∀ k, (e k : NatOrdinal) + β k = δ) ∧ + x = ∑ k, a k * b k := by + choose e hje hge using fun g : idealGEGenerators 𝒜 j ↦ (mem_idealGEGenerators_iff 𝒜 j g).mp g.2 + obtain ⟨κ, _, g, r, β, hr, hβ, hx'⟩ := exists_decompose_eq_sum_of_mem_span 𝒜 + (fun g ↦ (e g : NatOrdinal)) hge (by rwa [idealGE_eq_span] at hx) δ + refine ⟨κ, inferInstance, fun k ↦ e (g k), fun k ↦ g k, r, β, fun k ↦ hje (g k), + fun k ↦ hge (g k), hr, fun k ↦ by rw [add_comm]; exact hβ k, ?_⟩ + rw [← DirectSum.decompose_of_mem_same 𝒜 hxδ, hx'] + exact Finset.sum_congr rfl fun k _ ↦ mul_comm _ _ + +/-- `I_{≥j} ∩ A_δ = 0` once `j` exceeds the finite part of `δ` (its constant Cantor +coefficient): for `δ = λ + n` with `n < j`, no product `B C` with `B ∈ A_e`, `e ≥ j` finite, has +degree `δ`. -/ +theorem eq_zero_of_mem_idealGE_of_constantCoeff_lt {j : ℕ} {δ : NatOrdinal} {x : R} + (hxδ : x ∈ 𝒜 δ) (hx : x ∈ idealGE 𝒜 j) (hj : δ.constantCoeff < j) : x = 0 := by + obtain ⟨κ, _, e, a, b, β, hje, -, -, heβ, rfl⟩ := + exists_homogeneous_presentation 𝒜 hxδ hx + refine Finset.sum_eq_zero fun k _ ↦ (absurd ?_ (not_lt.mpr (hje k))) + have h := congrArg NatOrdinal.constantCoeff (heβ k) + rw [NatOrdinal.constantCoeff_add, NatOrdinal.constantCoeff_natCast] at h + omega + +/-! ### The quotient `A/I` and its grading -/ + +/-- The ideal `I = I_{≥1}` generated by the elements of positive finite degree. -/ +abbrev fibreIdeal : Ideal R := idealGE 𝒜 1 + +/-- The quotient `A/I`, `I = I_{≥1}`; for `A = P̂` the paper's `P̂/I`. -/ +abbrev Fibre : Type v := R ⧸ fibreIdeal 𝒜 + +/-- The quotient map `π : A → A/I`. -/ +abbrev fibreMap : R →ₐ[E] Fibre 𝒜 := Ideal.Quotient.mkₐ E (fibreIdeal 𝒜) + +omit [GradedAlgebra 𝒜] in +theorem fibreMap_surjective : Function.Surjective (fibreMap 𝒜) := + Ideal.Quotient.mkₐ_surjective E _ + +omit [GradedAlgebra 𝒜] in +theorem fibreMap_eq_zero_iff (x : R) : fibreMap 𝒜 x = 0 ↔ x ∈ fibreIdeal 𝒜 := + Ideal.Quotient.eq_zero_iff_mem + +/-- The degree-`β` part `(A/I)_β = π(A_β)` of the quotient. -/ +def fibreGrade (β : NatOrdinal) : Submodule E (Fibre 𝒜) := + (𝒜 β).map (fibreMap 𝒜).toLinearMap + +omit [GradedAlgebra 𝒜] in +theorem fibreMap_mem_fibreGrade {β : NatOrdinal} {x : R} (hx : x ∈ 𝒜 β) : + fibreMap 𝒜 x ∈ fibreGrade 𝒜 β := + ⟨x, hx, rfl⟩ + +omit [GradedAlgebra 𝒜] in +theorem exists_mem_of_mem_fibreGrade {β : NatOrdinal} {c : Fibre 𝒜} + (hc : c ∈ fibreGrade 𝒜 β) : + ∃ x ∈ 𝒜 β, fibreMap 𝒜 x = c := + hc + +omit [GradedAlgebra 𝒜] in +/-- `(A/I)_n = 0` for `1 ≤ n < ω`: the positive finite degrees vanish in `A/I`. -/ +theorem fibreGrade_natCast_eq_bot {n : ℕ} (hn : 1 ≤ n) : fibreGrade 𝒜 (n : NatOrdinal) = ⊥ := by + rw [eq_bot_iff] + rintro c ⟨x, hx, rfl⟩ + rw [Submodule.mem_bot, AlgHom.toLinearMap_apply, fibreMap_eq_zero_iff] + exact mem_idealGE_of_mem 𝒜 hn hx + +theorem fibreGrade_mul_le (α β : NatOrdinal) : + fibreGrade 𝒜 α * fibreGrade 𝒜 β ≤ fibreGrade 𝒜 (α + β) := by + rw [fibreGrade, fibreGrade, fibreGrade] + refine Submodule.mul_le.mpr ?_ + rintro _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ + exact ⟨x * y, SetLike.mul_mem_graded hx hy, map_mul (fibreMap 𝒜) x y⟩ + +theorem mul_mem_fibreGrade {α β : NatOrdinal} {c d : Fibre 𝒜} (hc : c ∈ fibreGrade 𝒜 α) + (hd : d ∈ fibreGrade 𝒜 β) : c * d ∈ fibreGrade 𝒜 (α + β) := + fibreGrade_mul_le 𝒜 α β (Submodule.mul_mem_mul hc hd) + +theorem pow_mem_fibreGrade {α : NatOrdinal} {c : Fibre 𝒜} (hc : c ∈ fibreGrade 𝒜 α) + (n : ℕ) : + c ^ n ∈ fibreGrade 𝒜 (n • α) := by + induction n with + | zero => + rw [pow_zero, zero_smul] + exact fibreMap_mem_fibreGrade 𝒜 (SetLike.one_mem_graded 𝒜) + | succ n ih => + rw [pow_succ, succ_nsmul] + exact mul_mem_fibreGrade 𝒜 ih hc + +/-- `I ∩ A_0 = 0`. -/ +theorem fibreIdeal_inf_grade_zero : (fibreIdeal 𝒜).restrictScalars E ⊓ 𝒜 0 = ⊥ := by + rw [eq_bot_iff] + intro y hy + obtain ⟨hyW, hyδ⟩ := Submodule.mem_inf.mp hy + rw [Submodule.restrictScalars_mem] at hyW + rw [Submodule.mem_bot] + exact eq_zero_of_mem_idealGE_of_constantCoeff_lt 𝒜 hyδ hyW + (by rw [NatOrdinal.constantCoeff_zero]; exact Nat.one_pos) + +/-- `A/I ≠ 0`: `1 ∉ I`. -/ +theorem one_notMem_fibreIdeal [Nontrivial R] : (1 : R) ∉ fibreIdeal 𝒜 := fun h ↦ + one_ne_zero ((Submodule.mem_bot E).mp ((fibreIdeal_inf_grade_zero 𝒜).le + (Submodule.mem_inf.mpr ⟨(Submodule.restrictScalars_mem E _ _).mpr h, + SetLike.one_mem_graded 𝒜⟩))) + +instance [Nontrivial R] : Nontrivial (Fibre 𝒜) := + Ideal.Quotient.nontrivial_iff.mpr fun h ↦ one_notMem_fibreIdeal 𝒜 (h ▸ Submodule.mem_top) + +/-- `I` is homogeneous: the homogeneous components of an element of `I` lie in `I`. -/ +theorem decompose_mem_fibreIdeal {x : R} (hx : x ∈ fibreIdeal 𝒜) (δ : NatOrdinal) : + (DirectSum.decompose 𝒜 x δ : R) ∈ fibreIdeal 𝒜 := + idealGE_isHomogeneous 𝒜 1 δ hx + +/-! ### `A/I` is internally graded -/ + +/-- The `(A/I)_β` form an internal direct sum decomposition of `A/I`. -/ +theorem fibreGrade_isInternal : DirectSum.IsInternal (fibreGrade 𝒜) := by + classical + refine DirectSum.isInternal_submodule_of_iSupIndep_of_iSup_eq_top ?_ ?_ + · refine iSupIndep_of_dfinsupp_lsum_injective _ ?_ + rw [injective_iff_map_eq_zero] + intro v hv + choose x hx hxv using fun α ↦ exists_mem_of_mem_fibreGrade 𝒜 (v α).2 + -- the sum of the lifts lies in `I`, hence so does each homogeneous component + have hsum : ∑ α ∈ v.support, x α ∈ fibreIdeal 𝒜 := by + rw [← fibreMap_eq_zero_iff, map_sum] + simp only [hxv] + rw [← hv, DFinsupp.lsum_apply_apply, DFinsupp.sumAddHom_apply] + rfl + ext α + by_cases hα : α ∈ v.support + · have hcomp : (DirectSum.decompose 𝒜 (∑ β ∈ v.support, x β) α : R) = x α := by + rw [DirectSum.decompose_sum, DirectSum.sum_apply, Submodule.coe_sum, + Finset.sum_eq_single α] + · exact DirectSum.decompose_of_mem_same 𝒜 (hx α) + · intro β _ hβ + exact DirectSum.decompose_of_mem_ne 𝒜 (hx β) hβ + · intro h; exact absurd hα h + have : fibreMap 𝒜 (x α) = 0 := by + rw [fibreMap_eq_zero_iff, ← hcomp] + exact decompose_mem_fibreIdeal 𝒜 hsum α + rw [hxv] at this + rw [DFinsupp.zero_apply, Submodule.coe_zero] + exact this + · rw [DFinsupp.notMem_support_iff.mp hα] + rfl + · rw [eq_top_iff] + intro c _ + obtain ⟨x, rfl⟩ := fibreMap_surjective 𝒜 c + rw [← DirectSum.sum_support_decompose 𝒜 x, map_sum] + exact Submodule.sum_mem _ fun α _ ↦ Submodule.mem_iSup_of_mem α + (fibreMap_mem_fibreGrade 𝒜 (DirectSum.decompose 𝒜 x α).2) + +instance : SetLike.GradedMonoid (fibreGrade 𝒜) where + one_mem := by + rw [← map_one (fibreMap 𝒜)] + exact fibreMap_mem_fibreGrade 𝒜 (SetLike.one_mem_graded 𝒜) + mul_mem _ _ _ _ hc hd := mul_mem_fibreGrade 𝒜 hc hd + +/-- `A/I` is a graded `E`-algebra, graded by the `(A/I)_β = π(A_β)`. -/ +instance : GradedAlgebra (fibreGrade 𝒜) := { (fibreGrade_isInternal 𝒜).chooseDecomposition with } + +end LoweringDerivation diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/IdealGEGraded.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/IdealGEGraded.lean new file mode 100644 index 0000000000..a9e7698dd8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/IdealGEGraded.lean @@ -0,0 +1,386 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.FilteredModule +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.FiltrationDegree +public import Mathlib.RingTheory.TensorProduct.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.BasisOver + +/-! +# The associated graded ring `gr_{I_•} A` + +The ideals `I_{≥j}` of a `NatOrdinal`-graded algebra `A` (Lean `R`) with a lowering derivation +form a decreasing multiplicative filtration which is separated, so it defines a max-additive +degree valued in `ℕᵒᵈ` and an associated graded ring `gr_{I_•} A = ⨁_j I_{≥j}/I_{≥j+1}`. The +finite-degree part `A_{<ω}` maps to `gr_{I_•} A` by sending a homogeneous element of degree +`j < ω` to its class in `I_{≥j}/I_{≥j+1}`, and the quotient `A/I` is the degree-zero part +`I_{≥0}/I_{≥1}`. Multiplication induces an isomorphism of `E`-algebras + +`A_{<ω} ⊗_E A/I ≃ gr_{I_•} A` + +whose degree-`j` component is `μ_j`: surjectivity is the surjectivity of the `μ_j`, and +injectivity follows from their injectivity by reading off the components of the image of a tensor +written as a sum of pieces in the `A_j ⊗ A/I`. +-/ + +universe u v + +open scoped DirectSum TensorProduct + +public noncomputable section + +namespace LoweringDerivation + +variable {E : Type u} {R : Type v} [Field E] [CommRing R] [Algebra E R] +variable (𝒜 : NatOrdinal → Submodule E R) [GradedAlgebra 𝒜] + +/-! ### The degree attached to the filtration `I_{≥•}` -/ + +/-- The filtration `I_{≥•}` is separated, `⋂_j I_{≥j} = 0`: a non-zero element leaves `I_{≥j}` +once `j` exceeds the finite parts of its degrees. -/ +theorem idealGE_isSeparatedFiltration : IsSeparatedFiltration (idealGE 𝒜) where + antitone _ _ h := idealGE_antitone 𝒜 h + top := idealGE_zero 𝒜 + mul_le := idealGE_mul_le 𝒜 + exists_not_mem {x} hx := by + classical + refine ⟨(DirectSum.decompose 𝒜 x).support.sup (fun δ ↦ δ.constantCoeff) + 1, fun hmem ↦ ?_⟩ + apply hx + rw [← DirectSum.sum_support_decompose 𝒜 x] + refine Finset.sum_eq_zero fun δ hδ ↦ ?_ + refine eq_zero_of_mem_idealGE_of_constantCoeff_lt 𝒜 (DirectSum.decompose 𝒜 x δ).2 + (idealGE_isHomogeneous 𝒜 _ δ hmem) ?_ + exact Nat.lt_succ_of_le (Finset.le_sup (f := fun δ ↦ δ.constantCoeff) hδ) + +/-- The max-additive degree attached to `I_{≥•}`, valued in `ℕᵒᵈ`: its weak filtration at `j` is +`I_{≥j}`. -/ +def filtrationIndex : MaxAddDegree R (OrderDual ℕ) := + (idealGE_isSeparatedFiltration 𝒜).degree + +/-- The associated graded ring `gr_{I_•} A = ⨁_j I_{≥j}/I_{≥j+1}`. -/ +abbrev IdealGEGraded := (filtrationIndex 𝒜).AssociatedGraded + +theorem mem_filtrationIndex_filtrationLE_iff (j : ℕ) (x : R) : + x ∈ (filtrationIndex 𝒜).filtrationLE (OrderDual.toDual j) ↔ x ∈ idealGE 𝒜 j := + (idealGE_isSeparatedFiltration 𝒜).mem_degree_filtrationLE_iff j x + +theorem filtrationIndex_isSeparated : (filtrationIndex 𝒜).IsSeparated := + (idealGE_isSeparatedFiltration 𝒜).degree_isSeparated + +/-- An element of `I_{≥j}`, as an element of the weak filtration at `j`. -/ +def idealGEFiltrationMk (j : ℕ) {x : R} (hx : x ∈ idealGE 𝒜 j) : + (filtrationIndex 𝒜).filtrationLE (OrderDual.toDual j) := + ⟨x, (mem_filtrationIndex_filtrationLE_iff 𝒜 j x).mpr hx⟩ + +theorem coe_idealGEFiltrationMk (j : ℕ) {x : R} (hx : x ∈ idealGE 𝒜 j) : + (idealGEFiltrationMk 𝒜 j hx : R) = x := (rfl) + +/-- The class in `I_{≥j}/I_{≥j+1}` of an element of `I_{≥j}`, as an element of `gr_{I_•} A`. -/ +def idealGEMk (j : ℕ) {x : R} (hx : x ∈ idealGE 𝒜 j) : IdealGEGraded 𝒜 := + (filtrationIndex 𝒜).homogeneousMk (OrderDual.toDual j) (idealGEFiltrationMk 𝒜 j hx) + +/-- The class in `I_{≥j}/I_{≥j+1}` is the direct-sum element concentrated in degree `j`. -/ +theorem idealGEMk_eq_of (j : ℕ) {x : R} (hx : x ∈ idealGE 𝒜 j) : + idealGEMk 𝒜 j hx = DirectSum.of (filtrationIndex 𝒜).Component (OrderDual.toDual j) + ((filtrationIndex 𝒜).componentMk (OrderDual.toDual j) (idealGEFiltrationMk 𝒜 j hx)) := + (filtrationIndex 𝒜).homogeneousMk_apply _ _ + +theorem idealGEMk_eq_zero_iff (j : ℕ) {x : R} (hx : x ∈ idealGE 𝒜 j) : + idealGEMk 𝒜 j hx = 0 ↔ x ∈ idealGE 𝒜 (j + 1) := by + rw [idealGEMk, MaxAddDegree.homogeneousMk_eq_zero_iff, coe_idealGEFiltrationMk, + filtrationIndex, IsSeparatedFiltration.degree_apply] + exact (idealGE_isSeparatedFiltration 𝒜).value_lt_toDual_iff x j + +theorem idealGEMk_add (j : ℕ) {x y : R} (hx : x ∈ idealGE 𝒜 j) (hy : y ∈ idealGE 𝒜 j) : + idealGEMk 𝒜 j (add_mem hx hy) = idealGEMk 𝒜 j hx + idealGEMk 𝒜 j hy := by + rw [idealGEMk, idealGEMk, idealGEMk, ← map_add] + rfl + +theorem idealGEMk_mul {i j : ℕ} {x y : R} (hx : x ∈ idealGE 𝒜 i) (hy : y ∈ idealGE 𝒜 j) : + idealGEMk 𝒜 (i + j) (mul_mem_idealGE 𝒜 hx hy) = idealGEMk 𝒜 i hx * idealGEMk 𝒜 j hy := by + rw [idealGEMk, idealGEMk, idealGEMk] + exact (filtrationIndex 𝒜).homogeneousMk_mul_of_coe_eq rfl _ _ _ rfl + +theorem idealGEMk_congr (j : ℕ) {x y : R} (hx : x ∈ idealGE 𝒜 j) (hy : y ∈ idealGE 𝒜 j) + (h : x - y ∈ idealGE 𝒜 (j + 1)) : idealGEMk 𝒜 j hx = idealGEMk 𝒜 j hy := by + have := (idealGEMk_eq_zero_iff 𝒜 j (sub_mem hx hy)).mpr h + rw [idealGEMk, idealGEMk, ← sub_eq_zero, ← map_sub] + exact this + +theorem mem_idealGE_zero (x : R) : x ∈ idealGE 𝒜 0 := by + rw [idealGE_zero]; exact Submodule.mem_top + +theorem idealGEMk_one : idealGEMk 𝒜 0 (mem_idealGE_zero 𝒜 1) = 1 := by + rw [idealGEMk, MaxAddDegree.homogeneousMk_apply, DirectSum.one_def] + congr 1 + rw [show GradedMonoid.GOne.one = (filtrationIndex 𝒜).componentOne from rfl, + MaxAddDegree.componentOne_eq_componentMk] + rfl + +/-- A sum of classes in distinct `I_{≥n}/I_{≥n+1}` vanishes only if each does. -/ +theorem idealGEMk_eq_zero_of_sum_eq_zero {s : Finset ℕ} {x : ℕ → R} + (hx : ∀ n, x n ∈ idealGE 𝒜 n) (h : ∑ n ∈ s, idealGEMk 𝒜 n (hx n) = 0) : + ∀ n ∈ s, idealGEMk 𝒜 n (hx n) = 0 := by + classical + intro n hn + have := congrArg (fun g : IdealGEGraded 𝒜 ↦ g (OrderDual.toDual n)) h + simp only [DirectSum.sum_apply, DirectSum.zero_apply] at this + rw [Finset.sum_eq_single n] at this + · rw [idealGEMk, MaxAddDegree.homogeneousMk_apply, DirectSum.of_eq_same] at this + rw [idealGEMk, MaxAddDegree.homogeneousMk_apply, this, map_zero] + · intro m _ hmn + rw [idealGEMk, MaxAddDegree.homogeneousMk_apply, DirectSum.of_eq_of_ne] + exact fun h' ↦ hmn (OrderDual.toDual.injective h').symm + · intro h'; exact absurd hn h' + +/-- The class in `I_{≥j}/I_{≥j+1}` of a finite sum is the sum of the classes. -/ +theorem idealGEMk_sum {ι : Type*} (s : Finset ι) (j : ℕ) {x : ι → R} + (hx : ∀ i, x i ∈ idealGE 𝒜 j) (hs : ∑ i ∈ s, x i ∈ idealGE 𝒜 j) : + idealGEMk 𝒜 j hs = ∑ i ∈ s, idealGEMk 𝒜 j (hx i) := by + classical + induction s using Finset.induction_on with + | empty => + conv_rhs => rw [Finset.sum_empty] + exact (idealGEMk_eq_zero_iff 𝒜 j _).mpr (by rw [Finset.sum_empty]; exact zero_mem _) + | insert i s hi ih => + have hs' : ∑ i ∈ s, x i ∈ idealGE 𝒜 j := Submodule.sum_mem _ fun i _ ↦ hx i + conv_rhs => rw [Finset.sum_insert hi, ← ih hs', ← idealGEMk_add] + exact idealGEMk_congr 𝒜 j _ _ (by rw [Finset.sum_insert hi, sub_self]; exact zero_mem _) + +theorem idealGEMk_congr_index {i j : ℕ} (h : i = j) {x : R} (hx : x ∈ idealGE 𝒜 i) : + idealGEMk 𝒜 i hx = idealGEMk 𝒜 j (h ▸ hx) := by + subst h + rfl + +theorem idealGEMk_zero (j : ℕ) : idealGEMk 𝒜 j (zero_mem _) = 0 := + (idealGEMk_eq_zero_iff 𝒜 j _).mpr (zero_mem _) + +/-! ### The degree-zero part: `A/I` -/ + +/-- The class in `I_{≥0}/I_{≥1}`, as a ring homomorphism `A → gr_{I_•} A`. -/ +def idealGEZeroHom : R →+* IdealGEGraded 𝒜 where + toFun x := idealGEMk 𝒜 0 (mem_idealGE_zero 𝒜 x) + map_one' := idealGEMk_one 𝒜 + map_mul' x y := idealGEMk_mul 𝒜 (mem_idealGE_zero 𝒜 x) (mem_idealGE_zero 𝒜 y) + map_zero' := idealGEMk_zero 𝒜 0 + map_add' x y := idealGEMk_add 𝒜 0 (mem_idealGE_zero 𝒜 x) (mem_idealGE_zero 𝒜 y) + +theorem idealGEZeroHom_apply (x : R) : + idealGEZeroHom 𝒜 x = idealGEMk 𝒜 0 (mem_idealGE_zero 𝒜 x) := (rfl) + +/-- The `E`-algebra structure on `gr_{I_•} A`, through the classes of the scalars in degree zero. -/ +instance : Algebra E (IdealGEGraded 𝒜) := ((idealGEZeroHom 𝒜).comp (algebraMap E R)).toAlgebra + +theorem idealGEGraded_algebraMap_apply (e : E) : + algebraMap E (IdealGEGraded 𝒜) e = idealGEZeroHom 𝒜 (algebraMap E R e) := (rfl) + +/-- The quotient `A/I = I_{≥0}/I_{≥1}` maps to degree zero of `gr_{I_•} A`. -/ +def fibreInitialHom : Fibre 𝒜 →+* IdealGEGraded 𝒜 := + Ideal.Quotient.lift (fibreIdeal 𝒜) (idealGEZeroHom 𝒜) fun _ hx ↦ + (idealGEMk_eq_zero_iff 𝒜 0 _).mpr hx + +theorem fibreInitialHom_fibreMap (x : R) : + fibreInitialHom 𝒜 (fibreMap 𝒜 x) = idealGEMk 𝒜 0 (mem_idealGE_zero 𝒜 x) := + Ideal.Quotient.lift_mk _ _ _ + +/-- The map `A/I → gr_{I_•} A` onto degree zero, as an `E`-algebra homomorphism. -/ +def fibreInitialAlgHom : Fibre 𝒜 →ₐ[E] IdealGEGraded 𝒜 := + { fibreInitialHom 𝒜 with + commutes' := fun e ↦ by + change fibreInitialHom 𝒜 (fibreMap 𝒜 (algebraMap E R e)) = _ + rw [fibreInitialHom_fibreMap] + rfl } + +theorem fibreInitialAlgHom_fibreMap (x : R) : + fibreInitialAlgHom 𝒜 (fibreMap 𝒜 x) = idealGEMk 𝒜 0 (mem_idealGE_zero 𝒜 x) := + fibreInitialHom_fibreMap 𝒜 x + +/-! ### The finite degrees -/ + +/-- The class in `gr_{I_•} A` of a homogeneous element of degree `α`: its class in +`I_{≥n}/I_{≥n+1}` when `α = n < ω`, and zero otherwise. -/ +def gradeInitial (α : NatOrdinal) : 𝒜 α →+ IdealGEGraded 𝒜 := + if h : α = (α.constantCoeff : NatOrdinal) then + { toFun := fun a ↦ idealGEMk 𝒜 α.constantCoeff + (mem_idealGE_of_mem 𝒜 le_rfl (show (a : R) ∈ 𝒜 (α.constantCoeff : NatOrdinal) from + h ▸ a.2)) + map_zero' := idealGEMk_zero 𝒜 _ + map_add' := fun _ _ ↦ idealGEMk_add 𝒜 _ _ _ } + else 0 + +theorem gradeInitial_natCast (n : ℕ) (a : 𝒜 (n : NatOrdinal)) : + gradeInitial 𝒜 (n : NatOrdinal) a = idealGEMk 𝒜 n (mem_idealGE_of_mem 𝒜 le_rfl a.2) := by + have h : (n : NatOrdinal) = ((n : NatOrdinal).constantCoeff : NatOrdinal) := by + rw [NatOrdinal.constantCoeff_natCast] + rw [gradeInitial, dif_pos h] + exact idealGEMk_congr_index 𝒜 (NatOrdinal.constantCoeff_natCast n) _ + +theorem gradeInitial_of_not_natCast {α : NatOrdinal} (hα : ¬ ∃ n : ℕ, α = n) (a : 𝒜 α) : + gradeInitial 𝒜 α a = 0 := by + rw [gradeInitial, dif_neg fun h ↦ hα ⟨_, h⟩] + rfl + +/-- The sum of the classes in `gr_{I_•} A` of the homogeneous components of finite degree. -/ +def finiteDegreeInitialAdd : R →+ IdealGEGraded 𝒜 := + (DirectSum.toAddMonoid (gradeInitial 𝒜)).comp (DirectSum.decomposeAddEquiv 𝒜).toAddMonoidHom + +theorem finiteDegreeInitialAdd_coe {α : NatOrdinal} (a : 𝒜 α) : + finiteDegreeInitialAdd 𝒜 a = gradeInitial 𝒜 α a := by + rw [finiteDegreeInitialAdd, AddMonoidHom.comp_apply, AddEquiv.coe_toAddMonoidHom, + DirectSum.decomposeAddEquiv_apply, DirectSum.decompose_coe, DirectSum.toAddMonoid_of] + +theorem finiteDegreeInitialAdd_of_mem {n : ℕ} {x : R} (hx : x ∈ 𝒜 (n : NatOrdinal)) : + finiteDegreeInitialAdd 𝒜 x = idealGEMk 𝒜 n (mem_idealGE_of_mem 𝒜 le_rfl hx) := + (finiteDegreeInitialAdd_coe 𝒜 (⟨x, hx⟩ : 𝒜 (n : NatOrdinal))).trans (gradeInitial_natCast 𝒜 n _) + +theorem finiteDegreeInitialAdd_of_mem_of_not_natCast {α : NatOrdinal} (hα : ¬ ∃ n : ℕ, α = n) + {x : R} + (hx : x ∈ 𝒜 α) : finiteDegreeInitialAdd 𝒜 x = 0 := + (finiteDegreeInitialAdd_coe 𝒜 (⟨x, hx⟩ : 𝒜 α)).trans (gradeInitial_of_not_natCast 𝒜 hα _) + +/-- The finite-degree part `A_{<ω}` maps to `gr_{I_•} A`, a homogeneous element of degree `j` +going to its class in `I_{≥j}/I_{≥j+1}`. -/ +def finiteDegreeInitialHom : finiteDegreePart 𝒜 →+* IdealGEGraded 𝒜 where + toFun a := finiteDegreeInitialAdd 𝒜 a + map_zero' := by rw [Subalgebra.coe_zero, map_zero] + map_add' a b := by rw [Subalgebra.coe_add, map_add] + map_one' := by + rw [Subalgebra.coe_one, finiteDegreeInitialAdd_of_mem 𝒜 (n := 0) + (by rw [Nat.cast_zero]; exact SetLike.one_mem_graded 𝒜)] + exact idealGEMk_one 𝒜 + map_mul' a b := by + rw [Subalgebra.coe_mul] + refine finiteDegreeSubmodule_induction 𝒜 + (p := fun x _ ↦ + finiteDegreeInitialAdd 𝒜 (x * b) = finiteDegreeInitialAdd 𝒜 x * finiteDegreeInitialAdd 𝒜 b) + ?_ ?_ ?_ ((mem_finiteDegreePart_iff 𝒜 _).mp a.2) + · intro m x hx + refine finiteDegreeSubmodule_induction 𝒜 + (p := fun y _ ↦ + finiteDegreeInitialAdd 𝒜 (x * y) = + finiteDegreeInitialAdd 𝒜 x * finiteDegreeInitialAdd 𝒜 y) + ?_ ?_ ?_ ((mem_finiteDegreePart_iff 𝒜 _).mp b.2) + · intro n y hy + have hxy : x * y ∈ 𝒜 ((m + n : ℕ) : NatOrdinal) := by + rw [Nat.cast_add]; exact SetLike.mul_mem_graded hx hy + rw [finiteDegreeInitialAdd_of_mem 𝒜 hxy, finiteDegreeInitialAdd_of_mem 𝒜 hx, + finiteDegreeInitialAdd_of_mem 𝒜 hy, ← idealGEMk_mul] + · rw [mul_zero, map_zero, mul_zero] + · intro y z _ _ hy hz + rw [mul_add, map_add, map_add, hy, hz, mul_add] + · rw [zero_mul, map_zero, zero_mul] + · intro x y _ _ hx hy + rw [add_mul, map_add, map_add, hx, hy, add_mul] + +theorem finiteDegreeInitialHom_apply (a : finiteDegreePart 𝒜) : + finiteDegreeInitialHom 𝒜 a = finiteDegreeInitialAdd 𝒜 a := (rfl) + +/-- The map `A_{<ω} → gr_{I_•} A`, as an `E`-algebra homomorphism. -/ +def finiteDegreeInitialAlgHom : finiteDegreePart 𝒜 →ₐ[E] IdealGEGraded 𝒜 := + { finiteDegreeInitialHom 𝒜 with + commutes' := fun e ↦ by + change finiteDegreeInitialAdd 𝒜 (algebraMap E R e) = _ + rw [finiteDegreeInitialAdd_of_mem 𝒜 (n := 0) + (by rw [Nat.cast_zero]; exact SetLike.algebraMap_mem_graded 𝒜 e)] + rfl } + +theorem finiteDegreeInitialAlgHom_apply (a : finiteDegreePart 𝒜) : + finiteDegreeInitialAlgHom 𝒜 a = finiteDegreeInitialAdd 𝒜 a := (rfl) + +/-! ### The multiplication map `A_{<ω} ⊗_E A/I → gr_{I_•} A` -/ + +/-- Multiplication of the classes, `A_{<ω} ⊗_E A/I →ₐ[E] gr_{I_•} A`; the paper's `⨁_j μ_j`. -/ +def idealGETensorHom : finiteDegreePart 𝒜 ⊗[E] Fibre 𝒜 →ₐ[E] IdealGEGraded 𝒜 := + Algebra.TensorProduct.productMap (finiteDegreeInitialAlgHom 𝒜) (fibreInitialAlgHom 𝒜) + +theorem idealGETensorHom_tmul (a : finiteDegreePart 𝒜) (c : Fibre 𝒜) : + idealGETensorHom 𝒜 (a ⊗ₜ[E] c) = finiteDegreeInitialAlgHom 𝒜 a * fibreInitialAlgHom 𝒜 c := + Algebra.TensorProduct.productMap_apply_tmul _ _ _ _ + +theorem idealGETensorHom_natInclusion_tmul (j : ℕ) (a : 𝒜 (j : NatOrdinal)) (b : R) : + idealGETensorHom 𝒜 (natInclusion 𝒜 j a ⊗ₜ[E] fibreMap 𝒜 b) = + idealGEMk 𝒜 j (Ideal.mul_mem_right b _ (mem_idealGE_of_mem 𝒜 le_rfl a.2)) := by + rw [idealGETensorHom_tmul, finiteDegreeInitialAlgHom_apply, coe_natInclusion, + finiteDegreeInitialAdd_of_mem 𝒜 a.2, fibreInitialAlgHom_fibreMap, ← idealGEMk_mul] + exact idealGEMk_congr_index 𝒜 (Nat.add_zero j) _ + +/-- Tensors in `A_j ⊗ A/I` map to degree `j`, compatibly with `μ_j`. -/ +theorem exists_idealGETensorHom_rTensor_eq (j : ℕ) (T : 𝒜 (j : NatOrdinal) ⊗[E] Fibre 𝒜) : + ∃ x, ∃ hx : x ∈ idealGE 𝒜 j, + mu 𝒜 j T = (Submodule.Quotient.mk x : R ⧸ idealGE 𝒜 (j + 1)) ∧ + idealGETensorHom 𝒜 ((natInclusion 𝒜 j).rTensor _ T) = idealGEMk 𝒜 j hx := by + induction T with + | zero => + exact ⟨0, zero_mem _, by rw [map_zero, Submodule.Quotient.mk_zero], + by rw [map_zero, map_zero, idealGEMk_zero]⟩ + | tmul a c => + obtain ⟨b, rfl⟩ := fibreMap_surjective 𝒜 c + exact ⟨(a : R) * b, Ideal.mul_mem_right _ _ (mem_idealGE_of_mem 𝒜 le_rfl a.2), + mu_tmul 𝒜 j a b, by rw [LinearMap.rTensor_tmul, idealGETensorHom_natInclusion_tmul]⟩ + | add x y hx hy => + obtain ⟨x', hx', hcx, hwx⟩ := hx + obtain ⟨y', hy', hcy, hwy⟩ := hy + exact ⟨x' + y', add_mem hx' hy', by rw [map_add, hcx, hcy, Submodule.Quotient.mk_add], + by rw [map_add, map_add, hwx, hwy, idealGEMk_add]⟩ + +/-- The class in `I_{≥j}/I_{≥j+1}` of any element of `I_{≥j}` is in the image of +`A_{<ω} ⊗_E A/I`. -/ +theorem exists_idealGETensorHom_eq_idealGEMk (j : ℕ) {x : R} (hx : x ∈ idealGE 𝒜 j) : + ∃ u, idealGETensorHom 𝒜 u = idealGEMk 𝒜 j hx := by + obtain ⟨T, hT⟩ := exists_mu_eq 𝒜 hx + obtain ⟨x', hx', hcx, hwx⟩ := exists_idealGETensorHom_rTensor_eq 𝒜 j T + refine ⟨_, hwx.trans (idealGEMk_congr 𝒜 j hx' hx ?_)⟩ + rw [hT] at hcx + exact (Submodule.Quotient.eq _).mp hcx.symm + +theorem idealGETensorHom_surjective : Function.Surjective (idealGETensorHom 𝒜) := by + intro g + induction g using DirectSum.induction_on with + | zero => exact ⟨0, map_zero _⟩ + | of j c => + induction c using MaxAddDegree.componentInductionOn with + | _ x => + obtain ⟨u, hu⟩ := exists_idealGETensorHom_eq_idealGEMk 𝒜 (OrderDual.ofDual j) + ((mem_filtrationIndex_filtrationLE_iff 𝒜 _ x).mp x.2) + refine ⟨u, hu.trans ?_⟩ + rw [idealGEMk, MaxAddDegree.homogeneousMk_apply] + rfl + | add x y hx hy => + obtain ⟨u, rfl⟩ := hx + obtain ⟨v, rfl⟩ := hy + exact ⟨u + v, map_add _ _ _⟩ + +/-- Injectivity: write `u = ∑_n (ι_n ⊗ 1) t_n` with `t_n ∈ A_n ⊗ A/I`; the degree-`n` component +of the image is the class of a lift of `μ_n(t_n)`, so it vanishes only if `μ_n(t_n) = 0`, that is, +`t_n = 0`. -/ +theorem idealGETensorHom_injective (h0 : GradeZeroScalars 𝒜) {Δ : R →ₗ[E] FunAtZeroMinus R} + (hΔ : IsLoweringDerivation 𝒜 Δ) : Function.Injective (idealGETensorHom 𝒜) := by + rw [injective_iff_map_eq_zero] + intro u hu + obtain ⟨N, t, rfl⟩ := exists_eq_sum_rTensor_natInclusion 𝒜 u + choose x hx hchar hw using fun n ↦ exists_idealGETensorHom_rTensor_eq 𝒜 n (t n) + rw [map_sum, Finset.sum_congr rfl fun n _ ↦ hw n] at hu + refine Finset.sum_eq_zero fun n hn ↦ ?_ + have hW := (idealGEMk_eq_zero_iff 𝒜 n (hx n)).mp (idealGEMk_eq_zero_of_sum_eq_zero 𝒜 hx hu n hn) + have hT : mu 𝒜 n (t n) = 0 := by + rw [hchar n, Submodule.Quotient.mk_eq_zero] + exact hW + rw [(injective_iff_map_eq_zero _).mp (hΔ.mu_injective h0 n) _ hT, map_zero] + +/-- Multiplication induces a graded `E`-algebra isomorphism `A_{<ω} ⊗_E A/I ≃ gr_{I_•} A`. -/ +def idealGETensorEquiv (h0 : GradeZeroScalars 𝒜) {Δ : R →ₗ[E] FunAtZeroMinus R} + (hΔ : IsLoweringDerivation 𝒜 Δ) : + finiteDegreePart 𝒜 ⊗[E] Fibre 𝒜 ≃ₐ[E] IdealGEGraded 𝒜 := + AlgEquiv.ofBijective (idealGETensorHom 𝒜) + ⟨idealGETensorHom_injective 𝒜 h0 hΔ, idealGETensorHom_surjective 𝒜⟩ + +theorem coe_idealGETensorEquiv (h0 : GradeZeroScalars 𝒜) {Δ : R →ₗ[E] FunAtZeroMinus R} + (hΔ : IsLoweringDerivation 𝒜 Δ) : + ⇑(idealGETensorEquiv 𝒜 h0 hΔ) = ⇑(idealGETensorHom 𝒜) := (rfl) + +end LoweringDerivation diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Mu.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Mu.lean new file mode 100644 index 0000000000..a3e1b3f7f5 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Mu.lean @@ -0,0 +1,529 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Grading +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus + +import Mathlib.LinearAlgebra.TensorProduct.RightExactness +import Mathlib.LinearAlgebra.TensorProduct.Finiteness + +/-! +# Lowering derivations and the maps `μ_j` + +A *lowering derivation* of a `NatOrdinal`-graded algebra `A` (Lean `R`) over a field `E` is an +`E`-linear derivation `∂ : A → Fun_{0⁻}(A)` with values in functions at `0⁻` which lowers the +degree by one — `∂(A_{α+1}) ⊆ Fun_{0⁻}(A_α)`, and `∂(A_α) = 0` for `α` zero or a limit — and is +injective on every `A_{α+1}`. The Lean variable for `∂` is `Δ`. + +For such a derivation `∂(I_{≥j}) ⊆ Fun_{0⁻}(I_{≥j-1})` for `j ≥ 1`, and the maps + +`μ_j : A_j ⊗_E A/I → I_{≥j}/I_{≥j+1}`, `B ⊗ π(C) ↦ BC + I_{≥j+1}`, + +are injective: for `j = 0` this is `I = ker π`, and the inductive step applies `∂` to a relation +and uses the compatibility `μ_{j-1}((∂ ⊗ 1) T) = ∂H + I_{≥j}` for `μ_j(T) = H + I_{≥j+1}`. The +maps `μ_j` are also compatible with the action of `A/I` on the second factor, and they are graded: +a homogeneous element of `I_{≥j} ∩ A_δ` has class in `μ_j(A_j ⊗ (A/I)_β)` for the `β` with +`j ⊕ β = δ`, and conversely every such tensor is the class of a homogeneous element of +`I_{≥j} ∩ A_δ`. +-/ + +universe u v + +open scoped DirectSum TensorProduct +open Filter Topology + +public noncomputable section + +namespace LoweringDerivation + +variable {E : Type u} {R : Type v} [Field E] [CommRing R] [Algebra E R] +variable (𝒜 : NatOrdinal → Submodule E R) [GradedAlgebra 𝒜] + +/-- The hypothesis `A_0 = E`: every element of degree zero is a scalar. -/ +def GradeZeroScalars : Prop := ∀ x ∈ 𝒜 0, ∃ e : E, x = algebraMap E R e + +omit [GradedAlgebra 𝒜] in +theorem gradeZeroScalars_iff : + GradeZeroScalars 𝒜 ↔ ∀ x ∈ 𝒜 0, ∃ e : E, x = algebraMap E R e := Iff.rfl + +/-- A lowering derivation `∂` (Lean `Δ`) of `A`: an `E`-linear derivation with values in functions +at `0⁻` (D1), which lowers the degree by one — it carries each `A_{α+1}` into `Fun_{0⁻}(A_α)` and +vanishes on `A_α` for `α` zero or a limit (D2) — and is injective on every `A_{α+1}` (D3). -/ +structure IsLoweringDerivation (Δ : R →ₗ[E] FunAtZeroMinus R) : Prop where + map_mul : ∀ x y : R, Δ (x * y) = Δ x * (y : FunAtZeroMinus R) + (x : FunAtZeroMinus R) * Δ y + mem_lower : ∀ {α : NatOrdinal}, 0 < α.constantCoeff → ∀ {x : R}, x ∈ 𝒜 α → + Δ x ∈ funAtZeroMinusSubmodule (𝒜 (α.removeNat 1)) + eq_zero : ∀ {α : NatOrdinal}, α.constantCoeff = 0 → ∀ {x : R}, x ∈ 𝒜 α → Δ x = 0 + injective : ∀ {α : NatOrdinal}, 0 < α.constantCoeff → ∀ {x : R}, x ∈ 𝒜 α → Δ x = 0 → x = 0 + +variable {𝒜} +variable {Δ : R →ₗ[E] FunAtZeroMinus R} (hΔ : IsLoweringDerivation 𝒜 Δ) + +namespace IsLoweringDerivation + +theorem natCast_removeNat_one (j : ℕ) (hj : 1 ≤ j) : + (j : NatOrdinal).removeNat 1 = ((j - 1 : ℕ) : NatOrdinal) := by + have hcoeff : 1 ≤ (j : NatOrdinal).constantCoeff := by + rwa [NatOrdinal.constantCoeff_natCast] + symm + apply (NatOrdinal.eq_removeNat_iff_add_natCast_eq hcoeff).mpr + rw [← Nat.cast_add, Nat.sub_add_cancel hj] + +theorem natCast_constantCoeff_pos (j : ℕ) (hj : 1 ≤ j) : + 0 < (j : NatOrdinal).constantCoeff := by + rw [NatOrdinal.constantCoeff_natCast] + exact hj + +include hΔ + +omit [GradedAlgebra 𝒜] in +theorem mem_lower_natCast {j : ℕ} (hj : 1 ≤ j) {x : R} (hx : x ∈ 𝒜 (j : NatOrdinal)) : + Δ x ∈ funAtZeroMinusSubmodule (𝒜 ((j - 1 : ℕ) : NatOrdinal)) := by + rw [← natCast_removeNat_one j hj] + exact hΔ.mem_lower (natCast_constantCoeff_pos j hj) hx + +omit [GradedAlgebra 𝒜] in +theorem map_one : Δ 1 = 0 := by + have h := hΔ.map_mul 1 1 + rw [one_mul] at h + have h1 : ((1 : R) : FunAtZeroMinus R) = 1 := rfl + rw [h1, mul_one, one_mul] at h + exact (add_eq_left.mp h.symm) + +end IsLoweringDerivation + +/-! ### Functions at `0⁻` with values in an ideal -/ + +variable (E) in +/-- `Fun_{0⁻}(I)`: the functions at `0⁻` with values in the ideal `I`. -/ +abbrev funAtZeroMinusIdeal (I : Ideal R) : Submodule E (FunAtZeroMinus R) := + funAtZeroMinusSubmodule (I.restrictScalars E) + +theorem coe_mem_funAtZeroMinusIdeal_iff (I : Ideal R) (f : ℝ → R) : + (f : FunAtZeroMinus R) ∈ funAtZeroMinusIdeal E I ↔ ∀ᶠ γ in 𝓝[<] (0 : ℝ), f γ ∈ I := + coe_mem_funAtZeroMinusSubmodule_iff _ f + +theorem const_mem_funAtZeroMinusIdeal {I : Ideal R} {x : R} (hx : x ∈ I) : + (x : FunAtZeroMinus R) ∈ funAtZeroMinusIdeal E I := + (coe_mem_funAtZeroMinusIdeal_iff I _).mpr (Eventually.of_forall fun _ ↦ hx) + +theorem mul_const_mem_funAtZeroMinusIdeal {I : Ideal R} {g : FunAtZeroMinus R} + (hg : g ∈ funAtZeroMinusIdeal E I) (y : R) : + g * (y : FunAtZeroMinus R) ∈ funAtZeroMinusIdeal E I := by + induction g using Filter.Germ.inductionOn with + | _ f => + rw [coe_mem_funAtZeroMinusIdeal_iff] at hg + change ((f * fun _ ↦ y : ℝ → R) : FunAtZeroMinus R) ∈ _ + rw [coe_mem_funAtZeroMinusIdeal_iff] + exact hg.mono fun γ hγ ↦ I.mul_mem_right y hγ + +theorem const_mul_mem_funAtZeroMinusIdeal {I : Ideal R} {g : FunAtZeroMinus R} + (hg : g ∈ funAtZeroMinusIdeal E I) (y : R) : + (y : FunAtZeroMinus R) * g ∈ funAtZeroMinusIdeal E I := by + rw [mul_comm] + exact mul_const_mem_funAtZeroMinusIdeal hg y + +theorem mul_mem_funAtZeroMinusIdeal_of_const_mem {I : Ideal R} {y : R} (hy : y ∈ I) + (g : FunAtZeroMinus R) : + g * (y : FunAtZeroMinus R) ∈ funAtZeroMinusIdeal E I := by + induction g using Filter.Germ.inductionOn with + | _ f => + change ((f * fun _ ↦ y : ℝ → R) : FunAtZeroMinus R) ∈ _ + rw [coe_mem_funAtZeroMinusIdeal_iff] + exact Eventually.of_forall fun γ ↦ I.mul_mem_left (f γ) hy + +theorem funAtZeroMinusIdeal_mono {I J : Ideal R} (h : I ≤ J) : + funAtZeroMinusIdeal E I ≤ funAtZeroMinusIdeal E J := + fun _ hg ↦ funAtZeroMinusSubmodule_mono (W := I.restrictScalars E) (W' := J.restrictScalars E) + (fun _ hx ↦ h hx) hg + +omit [GradedAlgebra 𝒜] in +theorem funAtZeroMinusSubmodule_grade_le_funAtZeroMinusIdeal {e j : ℕ} (hje : j ≤ e) : + funAtZeroMinusSubmodule (𝒜 (e : NatOrdinal)) ≤ funAtZeroMinusIdeal E (idealGE 𝒜 j) := + fun _ hg ↦ funAtZeroMinusSubmodule_mono (W := 𝒜 (e : NatOrdinal)) + (W' := (idealGE 𝒜 j).restrictScalars E) + (fun x hx ↦ (Submodule.restrictScalars_mem E _ x).mpr (mem_idealGE_of_mem 𝒜 hje hx)) hg + +namespace IsLoweringDerivation +include hΔ + +omit [GradedAlgebra 𝒜] in +/-- The power rule. -/ +theorem map_pow_succ (x : R) (n : ℕ) : + Δ (x ^ (n + 1)) = (n + 1) • (((x ^ n : R) : FunAtZeroMinus R) * Δ x) := by + induction n with + | zero => + rw [zero_add, pow_one, pow_zero, one_smul] + change Δ x = (1 : FunAtZeroMinus R) * Δ x + rw [one_mul] + | succ n ih => + rw [pow_succ, hΔ.map_mul, ih, smul_mul_assoc, mul_assoc] + have h1 : ((x ^ n : R) : FunAtZeroMinus R) * (x : FunAtZeroMinus R) = + ((x ^ (n + 1) : R) : FunAtZeroMinus R) := by + rw [pow_succ] + rfl + rw [mul_comm (Δ x) (x : FunAtZeroMinus R), ← mul_assoc, h1, succ_nsmul, succ_nsmul, succ_nsmul] + +omit [GradedAlgebra 𝒜] in +/-- `∂(I_{≥j}) ⊆ Fun_{0⁻}(I_{≥j-1})` for `j ≥ 1`. -/ +theorem map_mem_funAtZeroMinusIdeal_idealGE {j : ℕ} (hj : 1 ≤ j) {H : R} (hH : H ∈ idealGE 𝒜 j) : + Δ H ∈ funAtZeroMinusIdeal E (idealGE 𝒜 (j - 1)) := by + classical + rw [idealGE_eq_span] at hH + obtain ⟨n, c, g, rfl⟩ := Submodule.mem_span_set'.mp hH + rw [map_sum] + refine Submodule.sum_mem _ fun i _ ↦ ?_ + obtain ⟨e, hje, hge⟩ := (mem_idealGEGenerators_iff 𝒜 j (g i)).mp (g i).2 + rw [smul_eq_mul, hΔ.map_mul] + refine Submodule.add_mem _ ?_ ?_ + · exact mul_mem_funAtZeroMinusIdeal_of_const_mem + (mem_idealGE_of_mem 𝒜 (Nat.sub_le j 1 |>.trans hje) hge) _ + · refine const_mul_mem_funAtZeroMinusIdeal ?_ _ + refine funAtZeroMinusSubmodule_grade_le_funAtZeroMinusIdeal (e := e - 1) (by omega) ?_ + exact hΔ.mem_lower_natCast (hj.trans hje) hge + +end IsLoweringDerivation + +/-! ### The maps `μ_j` -/ + +section Characteristic + +variable (𝒜) + +/-- Multiplication by a homogeneous `B ∈ A_j`, descended to a map `A/I → A/I_{≥j+1}`. -/ +def muMulLeft (j : ℕ) (a : 𝒜 (j : NatOrdinal)) : + Fibre 𝒜 →ₗ[E] R ⧸ idealGE 𝒜 (j + 1) := + (Submodule.mapQ (fibreIdeal 𝒜) (idealGE 𝒜 (j + 1)) (LinearMap.mulLeft R (a : R)) + fun _ hx ↦ mul_mem_idealGE 𝒜 (mem_idealGE_of_mem 𝒜 le_rfl a.2) hx).restrictScalars E + +omit [GradedAlgebra 𝒜] in +theorem fibreMap_eq_mk (b : R) : fibreMap 𝒜 b = Submodule.Quotient.mk b := rfl + +theorem muMulLeft_mk (j : ℕ) (a : 𝒜 (j : NatOrdinal)) (b : R) : + muMulLeft 𝒜 j a (fibreMap 𝒜 b) = Submodule.Quotient.mk ((a : R) * b) := by + rw [fibreMap_eq_mk, muMulLeft, LinearMap.restrictScalars_apply, Submodule.mapQ_apply] + rfl + +/-- The bilinear map `A_j × A/I → A/I_{≥j+1}`, `(B, π(C)) ↦ BC + I_{≥j+1}`. -/ +def muBilinear (j : ℕ) : 𝒜 (j : NatOrdinal) →ₗ[E] Fibre 𝒜 →ₗ[E] R ⧸ idealGE 𝒜 (j + 1) where + toFun := muMulLeft 𝒜 j + map_add' a a' := LinearMap.ext fun c ↦ by + obtain ⟨b, rfl⟩ := fibreMap_surjective 𝒜 c + rw [LinearMap.add_apply, muMulLeft_mk, muMulLeft_mk, muMulLeft_mk, Submodule.coe_add, + add_mul, Submodule.Quotient.mk_add] + map_smul' e a := LinearMap.ext fun c ↦ by + obtain ⟨b, rfl⟩ := fibreMap_surjective 𝒜 c + rw [LinearMap.smul_apply, muMulLeft_mk, muMulLeft_mk, RingHom.id_apply, + Submodule.coe_smul, Algebra.smul_def, mul_assoc, ← Algebra.smul_def, + Submodule.Quotient.mk_smul] + +/-- The paper's `μ_j : A_j ⊗_E A/I → I_{≥j}/I_{≥j+1}`, `B ⊗ π(C) ↦ BC + I_{≥j+1}`, here with +codomain the quotient `A/I_{≥j+1}`. -/ +def mu (j : ℕ) : 𝒜 (j : NatOrdinal) ⊗[E] Fibre 𝒜 →ₗ[E] R ⧸ idealGE 𝒜 (j + 1) := + TensorProduct.lift (muBilinear 𝒜 j) + +theorem mu_tmul (j : ℕ) (a : 𝒜 (j : NatOrdinal)) (b : R) : + mu 𝒜 j (a ⊗ₜ[E] fibreMap 𝒜 b) = Submodule.Quotient.mk ((a : R) * b) := by + rw [mu, TensorProduct.lift.tmul] + exact muMulLeft_mk 𝒜 j a b + +/-- The quotient map `A → A/I_{≥j}`, as an `E`-linear map. -/ +def idealGEQuot (j : ℕ) : R →ₗ[E] R ⧸ idealGE 𝒜 j := + (idealGE 𝒜 j).mkQ.restrictScalars E + +omit [GradedAlgebra 𝒜] in +theorem idealGEQuot_apply (j : ℕ) (x : R) : + idealGEQuot 𝒜 j x = (Submodule.Quotient.mk x : R ⧸ idealGE 𝒜 j) := (rfl) + +omit [GradedAlgebra 𝒜] in +theorem mapLinear_idealGEQuot_coe (j : ℕ) (f : ℝ → R) : + Filter.Germ.mapLinear (idealGEQuot 𝒜 j) (f : FunAtZeroMinus R) = + ((fun γ ↦ (Submodule.Quotient.mk (f γ) : R ⧸ idealGE 𝒜 j)) : FunAtZeroMinus _) := by + rw [Filter.Germ.mapLinear_coe] + rfl + +omit [GradedAlgebra 𝒜] in +theorem mapLinear_idealGEQuot_eq_zero_iff (j : ℕ) (g : FunAtZeroMinus R) : + Filter.Germ.mapLinear (idealGEQuot 𝒜 j) g = 0 ↔ g ∈ funAtZeroMinusIdeal E (idealGE 𝒜 j) := by + induction g using Filter.Germ.inductionOn with + | _ f => + rw [mapLinear_idealGEQuot_coe, coe_mem_funAtZeroMinusIdeal_iff, + show (0 : FunAtZeroMinus (R ⧸ idealGE 𝒜 j)) = + ((fun _ ↦ (0 : R ⧸ idealGE 𝒜 j) : ℝ → _) : FunAtZeroMinus _) from rfl, + Filter.Germ.coe_eq] + exact ⟨fun h ↦ h.mono fun γ hγ ↦ (Submodule.Quotient.mk_eq_zero _).mp hγ, + fun h ↦ h.mono fun γ hγ ↦ (Submodule.Quotient.mk_eq_zero _).mpr hγ⟩ + +/-- Compatibility of `μ_j` with the action of `A/I` on the second factor: +`μ_j((1 ⊗ π(B)) T) = μ_j(T) · B`. -/ +theorem mu_lTensor_mulLeft (j : ℕ) (B : R) (T : 𝒜 (j : NatOrdinal) ⊗[E] Fibre 𝒜) : + mu 𝒜 j ((LinearMap.mulLeft E (fibreMap 𝒜 B)).lTensor _ T) = + mu 𝒜 j T * (Ideal.Quotient.mk (idealGE 𝒜 (j + 1)) B) := by + induction T with + | zero => simp + | tmul a c => + obtain ⟨b, rfl⟩ := fibreMap_surjective 𝒜 c + rw [LinearMap.lTensor_tmul, LinearMap.mulLeft_apply, ← map_mul, mu_tmul, mu_tmul] + change Ideal.Quotient.mk _ ((a : R) * (B * b)) = Ideal.Quotient.mk _ ((a : R) * b) * _ + rw [← map_mul] + congr 1 + ring + | add x y hx hy => rw [map_add, map_add, hx, hy, map_add, add_mul] + +/-- `μ_j` is onto `I_{≥j}/I_{≥j+1}`: the class of an element of `I_{≥j}` modulo `I_{≥j+1}` is in +the image of `μ_j`. -/ +theorem exists_mu_eq {j : ℕ} {H : R} (hH : H ∈ idealGE 𝒜 j) : + ∃ T : 𝒜 (j : NatOrdinal) ⊗[E] Fibre 𝒜, + mu 𝒜 j T = (Submodule.Quotient.mk H : R ⧸ idealGE 𝒜 (j + 1)) := by + classical + rw [idealGE_eq_span] at hH + obtain ⟨n, c, g, rfl⟩ := Submodule.mem_span_set'.mp hH + choose e hje hge using fun i ↦ (mem_idealGEGenerators_iff 𝒜 j (g i)).mp (g i).2 + let a : Fin n → 𝒜 (j : NatOrdinal) := fun i ↦ + if h : e i = j then ⟨g i, h ▸ hge i⟩ else 0 + refine ⟨∑ i ∈ Finset.univ.filter (fun i ↦ e i = j), a i ⊗ₜ[E] fibreMap 𝒜 (c i), ?_⟩ + rw [map_sum, ← Submodule.mkQ_apply, map_sum, Finset.sum_filter] + refine Finset.sum_congr rfl fun i _ ↦ ?_ + rw [Submodule.mkQ_apply, smul_eq_mul] + by_cases h : e i = j + · rw [if_pos h, mu_tmul] + have ha : (a i : R) = g i := by simp [a, h] + rw [ha, mul_comm] + · rw [if_neg h, eq_comm, Submodule.Quotient.mk_eq_zero] + exact Ideal.mul_mem_left _ _ (mem_idealGE_of_mem 𝒜 (by have := hje i; omega) (hge i)) + +/-- The class of a homogeneous element of `I_{≥j} ∩ A_δ` is in the image of `μ_j` restricted to +`A_j ⊗ (A/I)_β`, where `j ⊕ β = δ` (Lean `β = δ.removeNat j`). -/ +theorem exists_mu_lTensor_eq {j : ℕ} {δ : NatOrdinal} {H : R} (hHδ : H ∈ 𝒜 δ) + (hH : H ∈ idealGE 𝒜 j) : + ∃ T : 𝒜 (j : NatOrdinal) ⊗[E] fibreGrade 𝒜 (δ.removeNat j), + mu 𝒜 j ((fibreGrade 𝒜 (δ.removeNat j)).subtype.lTensor _ T) = + (Submodule.Quotient.mk H : R ⧸ idealGE 𝒜 (j + 1)) := by + classical + obtain ⟨κ, _, e, a, b, β, hje, ha, hb, heβ, rfl⟩ := exists_homogeneous_presentation 𝒜 hHδ hH + have hβ : ∀ k, e k = j → β k = δ.removeNat j := fun k hk ↦ by + have hc : j ≤ δ.constantCoeff := by + rw [← heβ k, NatOrdinal.constantCoeff_add, NatOrdinal.constantCoeff_natCast, hk] + exact Nat.le_add_right _ _ + rw [NatOrdinal.eq_removeNat_iff_add_natCast_eq hc, ← hk, add_comm] + exact heβ k + let a' : κ → 𝒜 (j : NatOrdinal) := fun k ↦ if h : e k = j then ⟨a k, h ▸ ha k⟩ else 0 + let b' : κ → fibreGrade 𝒜 (δ.removeNat j) := fun k ↦ if h : e k = j then + ⟨fibreMap 𝒜 (b k), hβ k h ▸ fibreMap_mem_fibreGrade 𝒜 (hb k)⟩ else 0 + refine ⟨∑ k ∈ Finset.univ.filter (fun k ↦ e k = j), a' k ⊗ₜ[E] b' k, ?_⟩ + rw [map_sum, map_sum, ← Submodule.mkQ_apply, map_sum, Finset.sum_filter] + refine Finset.sum_congr rfl fun k _ ↦ ?_ + rw [Submodule.mkQ_apply] + by_cases h : e k = j + · rw [if_pos h, LinearMap.lTensor_tmul] + have ha' : (a' k : R) = a k := by simp [a', h] + have hb' : ((fibreGrade 𝒜 (δ.removeNat j)).subtype (b' k)) = fibreMap 𝒜 (b k) := by + simp [b', h] + rw [hb', mu_tmul, ha'] + · rw [if_neg h, eq_comm, Submodule.Quotient.mk_eq_zero] + exact Ideal.mul_mem_right _ _ (mem_idealGE_of_mem 𝒜 (by have := hje k; omega) (ha k)) + +/-- Homogeneous lifting: a tensor in `A_j ⊗ (A/I)_β`, `j ⊕ β = α`, is the class modulo `I_{≥j+1}` +of a homogeneous element of `I_{≥j} ∩ A_α`, provided `j` is at most the finite part of `α`. -/ +theorem exists_homogeneous_mu_eq {j : ℕ} {α : NatOrdinal} (hj : j ≤ α.constantCoeff) + (T : 𝒜 (j : NatOrdinal) ⊗[E] fibreGrade 𝒜 (α.removeNat j)) : + ∃ G ∈ 𝒜 α, G ∈ idealGE 𝒜 j ∧ + mu 𝒜 j ((fibreGrade 𝒜 (α.removeNat j)).subtype.lTensor _ T) = + (Submodule.Quotient.mk G : R ⧸ idealGE 𝒜 (j + 1)) := by + classical + induction T with + | zero => exact ⟨0, zero_mem _, zero_mem _, by simp⟩ + | tmul a c => + obtain ⟨b, hb, hbc⟩ := exists_mem_of_mem_fibreGrade 𝒜 c.2 + refine ⟨(a : R) * b, ?_, Ideal.mul_mem_right _ _ (mem_idealGE_of_mem 𝒜 le_rfl a.2), ?_⟩ + · have h := SetLike.mul_mem_graded a.2 hb + have hsum : (j : NatOrdinal) + α.removeNat j = α := by + rw [add_comm] + exact NatOrdinal.removeNat_add_natCast hj + rwa [hsum] at h + · rw [LinearMap.lTensor_tmul, Submodule.subtype_apply, ← hbc] + exact mu_tmul 𝒜 j a b + | add x y hx hy => + obtain ⟨G, hGα, hGW, hG⟩ := hx + obtain ⟨G', hG'α, hG'W, hG'⟩ := hy + exact ⟨G + G', add_mem hGα hG'α, add_mem hGW hG'W, by + rw [map_add, map_add, hG, hG', Submodule.Quotient.mk_add]⟩ + +end Characteristic + +/-! ### Injectivity of the maps `μ_j` -/ + +section Injectivity + +/-- A finite sum of functions at `0⁻` is the class of the pointwise sum. -/ +theorem coe_finset_sum {V : Type*} [AddCommMonoid V] {ι : Type*} (s : Finset ι) (f : ι → ℝ → V) : + ((fun γ ↦ ∑ i ∈ s, f i γ : ℝ → V) : FunAtZeroMinus V) = ∑ i ∈ s, (f i : FunAtZeroMinus V) := by + classical + induction s using Finset.induction_on with + | empty => + simp only [Finset.sum_empty] + rfl + | insert a s ha ih => + simp only [Finset.sum_insert ha] + rw [← ih] + rfl + +theorem coe_mul_const (f : ℝ → R) (y : R) : + (f : FunAtZeroMinus R) * (y : FunAtZeroMinus R) = + ((fun γ ↦ f γ * y : ℝ → R) : FunAtZeroMinus R) := rfl + +variable (𝒜) in +/-- The element `1 ∈ A_0`. -/ +def gradeZeroOne : 𝒜 ((0 : ℕ) : NatOrdinal) := ⟨1, by simp [SetLike.one_mem_graded 𝒜]⟩ + +theorem coe_gradeZeroOne : (gradeZeroOne 𝒜 : R) = 1 := (rfl) + +namespace IsLoweringDerivation +include hΔ + +/-- `∂` on `A_{j+1}`, as a map `A_{j+1} → Fun_{0⁻}(A_j)`. -/ +def derivLinear (j : ℕ) : + 𝒜 ((j + 1 : ℕ) : NatOrdinal) →ₗ[E] FunAtZeroMinus (𝒜 (j : NatOrdinal)) := + (funAtZeroMinusSubmoduleEquiv (𝒜 (j : NatOrdinal))).symm.toLinearMap.comp + ((Δ.comp (𝒜 ((j + 1 : ℕ) : NatOrdinal)).subtype).codRestrict _ fun a ↦ by + simpa using hΔ.mem_lower_natCast (j := j + 1) (Nat.le_add_left 1 j) a.2) + +omit [GradedAlgebra 𝒜] in +theorem funAtZeroMinusSubmoduleMap_derivLinear (j : ℕ) (a : 𝒜 ((j + 1 : ℕ) : NatOrdinal)) : + funAtZeroMinusSubmoduleMap _ (hΔ.derivLinear j a) = Δ a := by + rw [derivLinear, LinearMap.comp_apply, LinearEquiv.coe_coe, + ← coe_funAtZeroMinusSubmoduleEquiv_apply, LinearEquiv.apply_symm_apply] + rfl + +omit [GradedAlgebra 𝒜] in +theorem derivLinear_injective (j : ℕ) : Function.Injective (hΔ.derivLinear j) := by + intro a a' h + apply Subtype.ext + refine sub_eq_zero.mp (hΔ.injective (natCast_constantCoeff_pos (j + 1) (Nat.le_add_left 1 j)) + ((𝒜 ((j + 1 : ℕ) : NatOrdinal)).sub_mem a.2 a'.2) ?_) + rw [map_sub, ← hΔ.funAtZeroMinusSubmoduleMap_derivLinear j, + ← hΔ.funAtZeroMinusSubmoduleMap_derivLinear j, h, sub_self] + +/-- A representative `ℝ → A_j` of `∂(a)` for `a ∈ A_{j+1}`. -/ +def derivRep (j : ℕ) (a : 𝒜 ((j + 1 : ℕ) : NatOrdinal)) : ℝ → 𝒜 (j : NatOrdinal) := + Quotient.out (hΔ.derivLinear j a) + +omit [GradedAlgebra 𝒜] in +theorem coe_derivRep (j : ℕ) (a : 𝒜 ((j + 1 : ℕ) : NatOrdinal)) : + ((hΔ.derivRep j a : ℝ → 𝒜 (j : NatOrdinal)) : FunAtZeroMinus _) = hΔ.derivLinear j a := + Quotient.out_eq _ + +omit [GradedAlgebra 𝒜] in +theorem map_eq_coe_derivRep (j : ℕ) (a : 𝒜 ((j + 1 : ℕ) : NatOrdinal)) : + Δ a = ((fun γ ↦ (hΔ.derivRep j a γ : R) : ℝ → R) : FunAtZeroMinus R) := by + rw [← hΔ.funAtZeroMinusSubmoduleMap_derivLinear j, ← hΔ.coe_derivRep j, + funAtZeroMinusSubmoduleMap_coe] + +omit [GradedAlgebra 𝒜] in +/-- Pointwise form of `∂ ⊗ 1` on a finite sum of pure tensors. -/ +theorem funAtZeroMinusTensorId_derivLinear_sum {ι : Type*} (s : Finset ι) (j : ℕ) + (a : ι → 𝒜 ((j + 1 : ℕ) : NatOrdinal)) (c : ι → Fibre 𝒜) : + funAtZeroMinusTensorId (hΔ.derivLinear j) (∑ p ∈ s, a p ⊗ₜ[E] c p) = + ((fun γ ↦ ∑ p ∈ s, hΔ.derivRep j (a p) γ ⊗ₜ[E] c p : ℝ → _) : FunAtZeroMinus _) := by + rw [map_sum, coe_finset_sum] + exact Finset.sum_congr rfl fun p _ ↦ + funAtZeroMinusTensorId_tmul_of_eq_coe _ _ _ _ (hΔ.coe_derivRep j (a p)).symm + +omit [GradedAlgebra 𝒜] in +/-- `∂` of a finite sum `∑ aₚ bₚ` with `aₚ ∈ A_{j+1}` agrees, modulo `Fun_{0⁻}(I_{≥j+1})`, with +the function `γ ↦ ∑ ∂(aₚ)(γ) bₚ`. -/ +theorem map_sum_mul_sub_mem_funAtZeroMinusIdeal {ι : Type*} (s : Finset ι) (j : ℕ) + (a : ι → 𝒜 ((j + 1 : ℕ) : NatOrdinal)) (b : ι → R) : + Δ (∑ p ∈ s, (a p : R) * b p) - + ((fun γ ↦ ∑ p ∈ s, (hΔ.derivRep j (a p) γ : R) * b p : ℝ → R) : FunAtZeroMinus R) ∈ + funAtZeroMinusIdeal E (idealGE 𝒜 (j + 1)) := by + rw [map_sum] + simp only [hΔ.map_mul] + rw [Finset.sum_add_distrib, coe_finset_sum] + have h2 : ∑ p ∈ s, ((a p : R) : FunAtZeroMinus R) * Δ (b p) ∈ + funAtZeroMinusIdeal E (idealGE 𝒜 (j + 1)) := + Submodule.sum_mem _ fun p _ ↦ by + rw [mul_comm] + exact mul_mem_funAtZeroMinusIdeal_of_const_mem (mem_idealGE_of_mem 𝒜 le_rfl (a p).2) _ + have h1 : ∑ p ∈ s, Δ (a p : R) * (b p : FunAtZeroMinus R) = + ∑ p ∈ s, ((fun γ ↦ (hΔ.derivRep j (a p) γ : R) * b p : ℝ → R) : FunAtZeroMinus R) := + Finset.sum_congr rfl fun p _ ↦ by rw [hΔ.map_eq_coe_derivRep j (a p), coe_mul_const] + rw [h1, add_sub_cancel_left] + exact h2 + +/-- Compatibility of `μ` with `∂`: if `μ_{j+1}(T) = H + I_{≥j+2}`, then +`μ_j((∂ ⊗ 1) T) = ∂H + I_{≥j+1}` as functions at `0⁻` with values in `A/I_{≥j+1}`. -/ +theorem mapLinear_mu_funAtZeroMinusTensorId (j : ℕ) {T : 𝒜 ((j + 1 : ℕ) : NatOrdinal) ⊗[E] Fibre 𝒜} + {H : R} (hT : mu 𝒜 (j + 1) T = Submodule.Quotient.mk H) : + Filter.Germ.mapLinear (mu 𝒜 j) (funAtZeroMinusTensorId (hΔ.derivLinear j) T) = + Filter.Germ.mapLinear (idealGEQuot 𝒜 (j + 1)) (Δ H) := by + classical + obtain ⟨S, rfl⟩ := TensorProduct.exists_finset T + choose b hb using fun p : 𝒜 ((j + 1 : ℕ) : NatOrdinal) × Fibre 𝒜 ↦ fibreMap_surjective 𝒜 p.2 + have hT' : ∑ p ∈ S, p.1 ⊗ₜ[E] p.2 = ∑ p ∈ S, p.1 ⊗ₜ[E] fibreMap 𝒜 (b p) := + Finset.sum_congr rfl fun p _ ↦ by rw [hb p] + rw [hT'] at hT ⊢ + -- `H ≡ ∑ aₚ bₚ` modulo `I_{≥j+2}` + have hmem : H - ∑ p ∈ S, (p.1 : R) * b p ∈ idealGE 𝒜 (j + 1 + 1) := by + rw [map_sum] at hT + simp only [mu_tmul] at hT + simp only [← Submodule.mkQ_apply, ← map_sum] at hT + exact (Submodule.Quotient.eq _).mp hT.symm + have hΔH : Δ H - Δ (∑ p ∈ S, (p.1 : R) * b p) ∈ funAtZeroMinusIdeal E (idealGE 𝒜 (j + 1)) := by + rw [← map_sub] + have := hΔ.map_mem_funAtZeroMinusIdeal_idealGE (j := j + 1 + 1) (by omega) hmem + rwa [Nat.add_sub_cancel] at this + have hsum := hΔ.map_sum_mul_sub_mem_funAtZeroMinusIdeal S j (fun p ↦ p.1) b + have hdiff := Submodule.add_mem _ hΔH hsum + rw [sub_add_sub_cancel, ← mapLinear_idealGEQuot_eq_zero_iff, map_sub, sub_eq_zero] at hdiff + rw [hdiff, hΔ.funAtZeroMinusTensorId_derivLinear_sum, Filter.Germ.mapLinear_coe, + mapLinear_idealGEQuot_coe] + congr 1 + funext γ + simp only [Function.comp_apply, map_sum, mu_tmul] + simp only [← Submodule.mkQ_apply, ← map_sum] + +/-- The maps `μ_j` are injective. -/ +theorem mu_injective (h0 : GradeZeroScalars 𝒜) (j : ℕ) : Function.Injective (mu 𝒜 j) := by + classical + induction j with + | zero => + rw [injective_iff_map_eq_zero] + intro T hT + obtain ⟨S, rfl⟩ := TensorProduct.exists_finset T + choose b hb using fun p : 𝒜 ((0 : ℕ) : NatOrdinal) × Fibre 𝒜 ↦ fibreMap_surjective 𝒜 p.2 + choose e he using fun p : 𝒜 ((0 : ℕ) : NatOrdinal) × Fibre 𝒜 ↦ + h0 p.1 (Nat.cast_zero (R := NatOrdinal) ▸ p.1.2) + have hp : ∀ p : 𝒜 ((0 : ℕ) : NatOrdinal) × Fibre 𝒜, p.1 = e p • gradeZeroOne 𝒜 := fun p ↦ + Subtype.ext (by + rw [Submodule.coe_smul, coe_gradeZeroOne, ← Algebra.algebraMap_eq_smul_one] + exact he p) + have hT' : ∑ p ∈ S, p.1 ⊗ₜ[E] p.2 = + gradeZeroOne 𝒜 ⊗ₜ[E] fibreMap 𝒜 (∑ p ∈ S, e p • b p) := by + rw [map_sum, TensorProduct.tmul_sum] + refine Finset.sum_congr rfl fun p _ ↦ ?_ + rw [hp p, ← hb p, TensorProduct.smul_tmul, map_smul] + rw [hT'] at hT ⊢ + rw [mu_tmul, Submodule.Quotient.mk_eq_zero, coe_gradeZeroOne, one_mul, zero_add] at hT + rw [(fibreMap_eq_zero_iff 𝒜 _).mpr hT, TensorProduct.tmul_zero] + | succ j ih => + rw [injective_iff_map_eq_zero] + intro T hT + -- `∂H + I_{≥j+1} = 0` for `H = 0` representing `μ_{j+1}(T) = 0` + have h := hΔ.mapLinear_mu_funAtZeroMinusTensorId j (H := 0) + (by rw [hT, Submodule.Quotient.mk_zero]) + rw [map_zero, map_zero] at h + have hzero : funAtZeroMinusTensorId (hΔ.derivLinear j) T = 0 := + Filter.Germ.mapLinear_injective (mu 𝒜 j) ih (by rw [h, map_zero]) + exact funAtZeroMinusTensorId_injective_of_injective (E := Fibre 𝒜) _ + (hΔ.derivLinear_injective j) (by rw [hzero, map_zero]) + +end IsLoweringDerivation + +end Injectivity + +end LoweringDerivation diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Polynomial.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Polynomial.lean new file mode 100644 index 0000000000..af21115bcb --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Polynomial.lean @@ -0,0 +1,218 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Mu +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermPolynomial + +/-! +# Polynomiality of the finite-degree part + +The real-line lowering derivation is an instance of the filter-germ lowering derivation. This file +keeps the original real-line interface and transports its polynomiality statements from the single +filter-generic algebraic-independence theorem. +-/ + +universe u v w + +open scoped DirectSum +open Filter Topology MvPolynomial + +public noncomputable section + +namespace LoweringDerivation + +variable {E : Type u} {R : Type v} [Field E] [CommRing R] [Algebra E R] +variable (A : NatOrdinal → Submodule E R) [GradedAlgebra A] + +/-! ### Homogeneous coordinates -/ + +/-- The decomposable part of degree `n`. -/ +abbrev decomposable (n : ℕ) : Submodule E R := + GermPolynomial.decomposable A n + +omit [GradedAlgebra A] in +theorem decomposable_le {n : ℕ} {N : Submodule E R} + (h : ∀ i j : ℕ, 1 ≤ i → 1 ≤ j → i + j = n → + A (i : NatOrdinal) * A (j : NatOrdinal) ≤ N) : + decomposable A n ≤ N := + GermPolynomial.decomposable_le A h + +omit [GradedAlgebra A] in +theorem mul_mem_decomposable {i j : ℕ} (hi : 1 ≤ i) (hj : 1 ≤ j) {a b : R} + (ha : a ∈ A (i : NatOrdinal)) (hb : b ∈ A (j : NatOrdinal)) : + a * b ∈ decomposable A (i + j) := + GermPolynomial.mul_mem_decomposable A hi hj ha hb + +variable {ι : Type w} (wt : ι → ℕ) (x : ι → R) + +/-- Positive homogeneous generators, independent modulo decomposables and generating each finite +grade. -/ +abbrev IsHomogeneousCoordinates : Prop := + GermPolynomial.IsHomogeneousCoordinates A wt x + +variable {A wt x} + +/-- Evaluation of a homogeneous polynomial lands in its prescribed grade. -/ +theorem aeval_mem_of_forall_mem (hmem : ∀ i, x i ∈ A (wt i : NatOrdinal)) + {F : MvPolynomial ι E} {n : ℕ} (hF : IsWeightedHomogeneous wt F n) : + aeval x F ∈ A (n : NatOrdinal) := + GermPolynomial.aeval_mem_of_forall_mem hmem hF + +/-- Evaluation at homogeneous coordinates commutes with taking a homogeneous component. -/ +theorem decompose_aeval (hmem : ∀ i, x i ∈ A (wt i : NatOrdinal)) + (F : MvPolynomial ι E) (n : ℕ) : + (DirectSum.decompose A (aeval x F) (n : NatOrdinal) : R) = + aeval x (weightedHomogeneousComponent wt n F) := + GermPolynomial.decompose_aeval hmem F n + +/-- Arbitrary polynomial generation may be replaced by homogeneous polynomial generation. -/ +theorem IsHomogeneousCoordinates.of_surjective (one_le : ∀ i, 1 ≤ wt i) + (hmem : ∀ i, x i ∈ A (wt i : NatOrdinal)) + (independent : ∀ (n : ℕ) (c : ι →₀ E), (∀ i ∈ c.support, wt i = n) → + Finsupp.linearCombination E x c ∈ decomposable A n → c = 0) + (surj : ∀ (n : ℕ), ∀ y ∈ A (n : NatOrdinal), + ∃ F : MvPolynomial ι E, aeval x F = y) : + IsHomogeneousCoordinates A wt x := + GermPolynomial.IsHomogeneousCoordinates.of_surjective one_le hmem independent surj + +variable (A wt x) in +/-- A minimal system of positive homogeneous generators. -/ +abbrev IsMinimalSystem : Prop := GermPolynomial.IsMinimalSystem A wt x + +/-- A minimal system generates every finite grade. -/ +theorem IsMinimalSystem.isHomogeneousCoordinates (h0 : GradeZeroScalars A) + (hx : IsMinimalSystem A wt x) : IsHomogeneousCoordinates A wt x := + GermPolynomial.IsMinimalSystem.isHomogeneousCoordinates h0 hx + +/-- A positive-degree homogeneous polynomial is its linear part modulo decomposables. -/ +theorem exists_linear_part (hwt : ∀ i, 1 ≤ wt i) + (hmem : ∀ i, x i ∈ A (wt i : NatOrdinal)) + {F : MvPolynomial ι E} {n : ℕ} (hn : 1 ≤ n) (hF : IsWeightedHomogeneous wt F n) : + ∃ c : ι →₀ E, (∀ i ∈ c.support, wt i = n) ∧ + aeval x F - Finsupp.linearCombination E x c ∈ decomposable A n ∧ + ∀ i, c i = coeff (Finsupp.single i 1) F := by + exact GermPolynomial.exists_linear_part hwt hmem hn hF + +/-! ### The real-line derivation as a filter-germ derivation -/ + +variable {Δ : R →ₗ[E] FunAtZeroMinus R} + +private theorem smul_eq_const_mul (a : R) (f : FunAtZeroMinus R) : + a • f = (a : FunAtZeroMinus R) * f := by + induction f using Filter.Germ.inductionOn with + | h f => rfl + +/-- The real-line lowering map with its Leibniz law, regarded as a derivation. -/ +def IsLoweringDerivation.toDerivation (hΔ : IsLoweringDerivation A Δ) : + Derivation E R (FunAtZeroMinus R) := + Derivation.mk' Δ fun a b => by + rw [hΔ.map_mul, smul_eq_const_mul, smul_eq_const_mul, + mul_comm (Δ a) (b : FunAtZeroMinus R), add_comm] + +omit [GradedAlgebra A] in +@[simp] +theorem IsLoweringDerivation.toDerivation_apply (hΔ : IsLoweringDerivation A Δ) (a : R) : + hΔ.toDerivation a = Δ a := by + change Δ a = Δ a + rfl + +omit [GradedAlgebra A] in +private theorem germSubmodule_eq_funAtZeroMinusSubmodule (W : Submodule E R) : + GermPolynomial.germSubmodule (l := 𝓝[<] (0 : ℝ)) W = funAtZeroMinusSubmodule W := by + ext f + rw [GermPolynomial.mem_germSubmodule_iff, mem_funAtZeroMinusSubmodule_iff] + +omit [GradedAlgebra A] in +/-- The real-line lowering derivation satisfies the filter-germ lowering conditions. -/ +theorem IsLoweringDerivation.toGerm (hΔ : IsLoweringDerivation A Δ) : + GermPolynomial.IsLoweringDerivation A hΔ.toDerivation where + mem_lower {α} hα {a} ha := by + rw [IsLoweringDerivation.toDerivation_apply, + germSubmodule_eq_funAtZeroMinusSubmodule] + exact hΔ.mem_lower hα ha + eq_zero {α} hα {a} ha := by + rw [IsLoweringDerivation.toDerivation_apply] + exact hΔ.eq_zero hα ha + injective {α} hα {a} ha hzero := by + rw [IsLoweringDerivation.toDerivation_apply] at hzero + exact hΔ.injective hα ha hzero + +namespace IsHomogeneousCoordinates + +variable (hx : IsHomogeneousCoordinates A wt x) +include hx + +/-- Evaluation of a homogeneous polynomial lands in its prescribed grade. -/ +theorem aeval_mem {F : MvPolynomial ι E} {n : ℕ} (hF : IsWeightedHomogeneous wt F n) : + aeval x F ∈ A (n : NatOrdinal) := + GermPolynomial.IsHomogeneousCoordinates.aeval_mem hx hF + +variable (hΔ : IsLoweringDerivation A Δ) +include hΔ + +omit hx in +theorem map_algebraMap (e : E) : Δ (algebraMap E R e) = 0 := + GermPolynomial.IsHomogeneousCoordinates.map_algebraMap hΔ.toGerm e + +omit hx in +/-- The chain rule for evaluation along homogeneous coordinates. -/ +theorem map_aeval (g : ι → ℝ → MvPolynomial ι E) + (hg : ∀ i, Δ (x i) = ((fun γ ↦ aeval x (g i γ)) : FunAtZeroMinus R)) + (F : MvPolynomial ι E) : + Δ (aeval x F) = + ((fun γ ↦ aeval x (mkDerivation E (fun i ↦ g i γ) F)) : FunAtZeroMinus R) := + GermPolynomial.IsHomogeneousCoordinates.map_aeval hΔ.toGerm g hg F + +omit [GradedAlgebra A] in +/-- Polynomial representatives of the derivatives of the homogeneous coordinates. -/ +theorem exists_lifts : ∃ g : ι → ℝ → MvPolynomial ι E, + (∀ i γ, IsWeightedHomogeneous wt (g i γ) (wt i - 1)) ∧ + ∀ i, Δ (x i) = ((fun γ ↦ aeval x (g i γ)) : FunAtZeroMinus R) := + GermPolynomial.IsHomogeneousCoordinates.exists_lifts hx hΔ.toGerm + +end IsHomogeneousCoordinates + +/-- A positive-weight homogeneous polynomial of degree zero is constant. -/ +theorem eq_C_of_isWeightedHomogeneous_zero (hwt : ∀ i, 1 ≤ wt i) + {p : MvPolynomial ι E} (hp : IsWeightedHomogeneous wt p 0) : + p = C (coeff 0 p) := + GermPolynomial.eq_C_of_isWeightedHomogeneous_zero hwt hp + +/-- A positive-degree homogeneous polynomial in the joint kernel of the pointwise derivations is +zero. -/ +theorem eq_zero_of_eventually_mkDerivation_eq_zero [CharZero E] + (hwt : ∀ i, 1 ≤ wt i) (hmem : ∀ i, x i ∈ A (wt i : NatOrdinal)) + (hind : ∀ (n : ℕ) (c : ι →₀ E), (∀ i ∈ c.support, wt i = n) → + Finsupp.linearCombination E x c ∈ decomposable A n → c = 0) + (hΔ : IsLoweringDerivation A Δ) (g : ι → ℝ → MvPolynomial ι E) + (hghom : ∀ i γ, IsWeightedHomogeneous wt (g i γ) (wt i - 1)) + (hg : ∀ i, Δ (x i) = ((fun γ ↦ aeval x (g i γ)) : FunAtZeroMinus R)) (n : ℕ) : + ∀ F : MvPolynomial ι E, 1 ≤ n → IsWeightedHomogeneous wt F n → + (∀ᶠ γ in 𝓝[<] (0 : ℝ), mkDerivation E (fun i ↦ g i γ) F = 0) → F = 0 := by + apply GermPolynomial.eq_zero_of_eventually_mkDerivation_eq_zero hwt hmem hind + hΔ.toGerm g hghom hg n + +namespace IsHomogeneousCoordinates + +variable [CharZero E] (hx : IsHomogeneousCoordinates A wt x) + (hΔ : IsLoweringDerivation A Δ) +include hx hΔ + +/-- No nonzero homogeneous relation holds among the coordinates. -/ +theorem eq_zero_of_aeval_eq_zero_of_isWeightedHomogeneous [Nontrivial R] (n : ℕ) : + ∀ F : MvPolynomial ι E, IsWeightedHomogeneous wt F n → aeval x F = 0 → F = 0 := + GermPolynomial.IsHomogeneousCoordinates.eq_zero_of_aeval_eq_zero_of_isWeightedHomogeneous + hx hΔ.toGerm n + +/-- The homogeneous coordinates are algebraically independent. -/ +theorem aeval_injective [Nontrivial R] : + Function.Injective (aeval x : MvPolynomial ι E →ₐ[E] R) := + GermPolynomial.IsHomogeneousCoordinates.aeval_injective hx hΔ.toGerm + +end IsHomogeneousCoordinates + +end LoweringDerivation diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MonoidAlgebra.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MonoidAlgebra.lean new file mode 100644 index 0000000000..ab6db543d2 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MonoidAlgebra.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.LatticeFunctional +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.SingleZeroFactors + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MonoidAlgebra/LatticeFunctional.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MonoidAlgebra/LatticeFunctional.lean new file mode 100644 index 0000000000..c2e1c75e2a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MonoidAlgebra/LatticeFunctional.lean @@ -0,0 +1,115 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.BigOperators.Fin +public import Mathlib.Algebra.Order.Ring.Abs +public import Mathlib.Data.Finsupp.Basic + +import Mathlib.Tactic.Ring +import Mathlib.Tactic.Linarith + +/-! +# A linear functional separating finitely many lattice points + +Finitely many points of a finite-rank lattice are separated by a single homomorphism to the +integers: evaluating coordinates in a base larger than twice every coordinate that occurs makes +the resulting integer determine the point, because a base-`N` representation with digits of +absolute value below `N` represents zero only if all its digits vanish. + +Such a functional collapses a finite-rank exponent lattice to a single variable while keeping +prescribed exponents distinct, which is what reduces a statement about group algebras of +finite-rank lattices to the one-variable case. +-/ + +universe u + +public section + +/-- Base-`N` digits with absolute value below `N` represent zero only if they all vanish. -/ +private theorem eq_zero_of_sum_mul_pow_eq_zero {k : ℕ} {N : ℤ} (hN : 0 < N) {d : Fin k → ℤ} + (hd : ∀ i, |d i| < N) (hsum : ∑ i, d i * N ^ (i : ℕ) = 0) : ∀ i, d i = 0 := by + induction k with + | zero => exact fun i ↦ i.elim0 + | succ k ih => + rw [Fin.sum_univ_succ] at hsum + have hshift : ∑ i : Fin k, d i.succ * N ^ ((i : ℕ) + 1) = + N * ∑ i : Fin k, d i.succ * N ^ (i : ℕ) := by + rw [Finset.mul_sum] + refine Finset.sum_congr rfl fun i _ ↦ ?_ + rw [pow_succ] + ring + simp only [Fin.val_zero, pow_zero, mul_one, Fin.val_succ] at hsum + rw [hshift] at hsum + have hd0 : d 0 = 0 := by + have hdvd : N ∣ d 0 := ⟨-(∑ i : Fin k, d i.succ * N ^ (i : ℕ)), by linarith [hsum]⟩ + rcases hdvd with ⟨t, ht⟩ + by_contra hne + have ht0 : t ≠ 0 := by + rintro rfl + rw [mul_zero] at ht + exact hne ht + have h1 : 1 ≤ |t| := Int.one_le_abs ht0 + have : N ≤ |d 0| := by + rw [ht, abs_mul, abs_of_pos hN] + exact le_mul_of_one_le_right hN.le h1 + exact absurd (hd 0) (not_lt.mpr this) + have hrest : ∑ i : Fin k, d i.succ * N ^ (i : ℕ) = 0 := by + rw [hd0, zero_add] at hsum + exact (mul_eq_zero.mp hsum).resolve_left hN.ne' + intro i + refine Fin.cases hd0 (fun j ↦ ?_) i + exact ih (fun j ↦ hd j.succ) hrest j +/-- A group homomorphism to `ℤ` that is injective on a prescribed finite set of lattice points: +evaluate in a base larger than twice every coordinate occurring. -/ +theorem AddMonoidHom.exists_injOn_finInt {k : ℕ} (S : Finset (Fin k → ℤ)) : + ∃ psi : (Fin k → ℤ) →+ ℤ, Set.InjOn psi (S : Set (Fin k → ℤ)) := by + classical + set M : ℕ := S.sup fun x ↦ Finset.univ.sup fun i ↦ (x i).natAbs with hM + set N : ℤ := 2 * (M : ℤ) + 1 with hNdef + have hNpos : (0 : ℤ) < N := by positivity + have hbound : ∀ x ∈ S, ∀ i, |x i| ≤ (M : ℤ) := by + intro x hx i + have h1 : (x i).natAbs ≤ M := by + refine le_trans (Finset.le_sup (f := fun j ↦ (x j).natAbs) (Finset.mem_univ i)) ?_ + exact Finset.le_sup (f := fun y ↦ Finset.univ.sup fun j ↦ (y j).natAbs) hx + rw [Int.abs_eq_natAbs] + exact_mod_cast h1 + refine ⟨{ toFun := fun x ↦ ∑ i, x i * N ^ (i : ℕ) + map_zero' := by simp + map_add' := fun x y ↦ by + simp only [Pi.add_apply, add_mul] + rw [Finset.sum_add_distrib] }, ?_⟩ + intro x hx y hy hxy + simp only [AddMonoidHom.coe_mk, ZeroHom.coe_mk] at hxy + have hzero : ∑ i, (x i - y i) * N ^ (i : ℕ) = 0 := by + simp only [sub_mul] + rw [Finset.sum_sub_distrib, hxy, sub_self] + have hdig : ∀ i, |x i - y i| < N := by + intro i + have h1 := abs_le.mp (hbound x hx i) + have h2 := abs_le.mp (hbound y hy i) + rw [abs_lt] + constructor <;> [linarith [h1.1, h2.2]; linarith [h1.2, h2.1]] + funext i + have := eq_zero_of_sum_mul_pow_eq_zero hNpos hdig hzero i + linarith [this] + +/-! ### Transferring coefficients along an injective relabelling of exponents -/ + +namespace Finsupp + +variable {H : Type*} {N : Type*} {L : Type*} [AddCommMonoid L] + +/-- Relabelling exponents injectively on the support preserves each coefficient. -/ +theorem mapDomain_apply_of_injOn {psi : H → N} {x : H →₀ L} + (hinj : Set.InjOn psi (x.support : Set H)) {g : H} (hg : g ∈ x.support) : + Finsupp.mapDomain psi x (psi g) = x g := + Finsupp.mapDomain_apply' (x.support : Set H) x subset_rfl hinj hg + +end Finsupp + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MonoidAlgebra/SingleZeroFactors.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MonoidAlgebra/SingleZeroFactors.lean new file mode 100644 index 0000000000..29a159fff5 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MonoidAlgebra/SingleZeroFactors.lean @@ -0,0 +1,135 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.TrailingGrade +public import Mathlib.Algebra.MonoidAlgebra.ToDirectSum + +import Mathlib.Algebra.MonoidAlgebra.NoZeroDivisors + +/-! +# Factors of a constant in an additive monoid algebra + +Suppose the grading monoid is linearly ordered, cancellative, and has zero as its largest element. +If a nonzero additive-monoid-algebra element has trailing grade zero, it is supported only at +zero. Consequently, over a coefficient semiring without zero divisors, both nonzero factors of a +monomial supported at zero are themselves supported at zero. +-/ + +open scoped DirectSum + +universe u v + +namespace AddMonoidAlgebra + +public noncomputable section + +variable {R : Type u} {M : Type v} + [Semiring R] [LinearOrder M] [AddCommMonoid M] [OrderTop M] + +private abbrev component (_ : M) := R + +/-- An element with trailing grade zero is supported only at zero when zero is the largest +grade. -/ +theorem exists_eq_single_zero_of_trailingGrade_eq_zero + (hzeroTop : (⊤ : M) = 0) {f : AddMonoidAlgebra R M} + (htrail : DirectSum.trailingGrade (fun _ : M ↦ R) f.toDirectSum = + (0 : WithTop M)) : + ∃ r : R, f = AddMonoidAlgebra.single 0 r := by + classical + refine ⟨f.toDirectSum 0, ?_⟩ + have hdirect : f.toDirectSum = DirectSum.of component 0 (f.toDirectSum 0) := by + apply DirectSum.ext + intro i + by_cases hi : i = 0 + · subst i + simp + · have hfi : f.toDirectSum i = 0 := by + by_contra hfi + have hzeroLe : (0 : M) ≤ i := + (DirectSum.trailingGrade_eq_coe_iff component f.toDirectSum 0).mp htrail |>.2 i hfi + have hiZero : i ≤ 0 := by + rw [← hzeroTop] + exact le_top + exact hi (le_antisymm hiZero hzeroLe) + rw [hfi, DirectSum.of_eq_of_ne 0 i _ hi] + have h := congrArg DirectSum.toAddMonoidAlgebra hdirect + simpa using h + +variable [NoZeroDivisors R] [IsOrderedCancelAddMonoid M] + +/-- If a product is supported only at zero, each nonzero factor is supported only at zero. -/ +theorem exists_eq_single_zero_of_mul_eq_single_zero + (hzeroTop : (⊤ : M) = 0) {f g : AddMonoidAlgebra R M} {r : R} + (hf : f ≠ 0) (hg : g ≠ 0) + (hfg : f * g = AddMonoidAlgebra.single 0 r) : + ∃ a b : R, + f = AddMonoidAlgebra.single 0 a ∧ + g = AddMonoidAlgebra.single 0 b := by + classical + have hr : r ≠ 0 := by + intro hr + subst r + have hzero : f * g = 0 := hfg.trans (AddMonoidAlgebra.single_zero 0) + exact (mul_eq_zero.mp hzero).elim hf hg + have hfDirect : f.toDirectSum ≠ 0 := by + intro hzero + apply hf + have := congrArg DirectSum.toAddMonoidAlgebra hzero + simpa using this + have hgDirect : g.toDirectSum ≠ 0 := by + intro hzero + apply hg + have := congrArg DirectSum.toAddMonoidAlgebra hzero + simpa using this + obtain ⟨m, hm, _⟩ := + DirectSum.exists_grade_eq_trailingGrade component hfDirect + obtain ⟨n, hn, _⟩ := + DirectSum.exists_grade_eq_trailingGrade component hgDirect + have hfgDirect : f.toDirectSum * g.toDirectSum = + DirectSum.of component 0 r := by + simpa using congrArg AddMonoidAlgebra.toDirectSum hfg + have hsumTop : ((m + n : M) : WithTop M) = (0 : M) := by + calc + ((m + n : M) : WithTop M) = + DirectSum.trailingGrade component f.toDirectSum + + DirectSum.trailingGrade component g.toDirectSum := by + rw [hm, hn, WithTop.coe_add] + _ = DirectSum.trailingGrade component + (f.toDirectSum * g.toDirectSum) := + (DirectSum.trailingGrade_mul component + (fun a b ha hb ↦ mul_ne_zero ha hb) f.toDirectSum g.toDirectSum).symm + _ = DirectSum.trailingGrade component (DirectSum.of component 0 r) := by + rw [hfgDirect] + _ = (0 : M) := DirectSum.trailingGrade_of component hr + have hsum : m + n = 0 := WithTop.coe_injective hsumTop + have hmLe : m ≤ 0 := by + rw [← hzeroTop] + exact le_top + have hnLe : n ≤ 0 := by + rw [← hzeroTop] + exact le_top + have hzeroLeM : 0 ≤ m := by + calc + 0 = m + n := hsum.symm + _ ≤ m + 0 := add_le_add_right hnLe m + _ = m := add_zero m + have hzeroLeN : 0 ≤ n := by + calc + 0 = m + n := hsum.symm + _ ≤ 0 + n := add_le_add_left hmLe n + _ = n := zero_add n + have hmZero : m = 0 := le_antisymm hmLe hzeroLeM + have hnZero : n = 0 := le_antisymm hnLe hzeroLeN + obtain ⟨a, ha⟩ := exists_eq_single_zero_of_trailingGrade_eq_zero + hzeroTop (hm.trans (congrArg WithTop.some hmZero)) + obtain ⟨b, hb⟩ := exists_eq_single_zero_of_trailingGrade_eq_zero + hzeroTop (hn.trans (congrArg WithTop.some hnZero)) + exact ⟨a, b, ha, hb⟩ + +end + +end AddMonoidAlgebra diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial.lean new file mode 100644 index 0000000000..1db364fffe --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial.lean @@ -0,0 +1,24 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.BaseChange +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Components +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Expansion +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartDecomposition +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartErasure +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartVars +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.GCDMonoid +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.LimitOrdinalContradiction +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.MapWeight +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalDerivation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalExpansion +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.RemainderBound +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Syzygy +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.TermDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.WeightedTotalDegree + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/BaseChange.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/BaseChange.lean new file mode 100644 index 0000000000..bb66eca979 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/BaseChange.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.RingTheory.TensorProduct.MvPolynomial +public import Mathlib.RingTheory.Flat.Basic + +import Mathlib.RingTheory.MvPolynomial.Tower + +/-! +# Algebraic independence under a flat extension of scalars + +Let `A` be a commutative `K`-algebra and `y i ∈ A` algebraically independent over `K`: evaluation +`K[X_i] → A`, `X_i ↦ y i`, is injective. For a flat commutative `K`-algebra `L`, the elements +`y i ⊗ 1` of `A ⊗_K L` are algebraically independent over `L`: evaluation `L[X_i] → A ⊗_K L`, +`X_i ↦ y i ⊗ 1`, `l ↦ 1 ⊗ l`, is injective. Through the identification `K[X_i] ⊗_K L ≅ L[X_i]` +this evaluation is the base change of `K[X_i] → A` to `L`, which flatness keeps injective; and +if the `y i` generate `A` over `K`, the `y i ⊗ 1` generate `A ⊗_K L` over `L`. +-/ + +open scoped TensorProduct + +universe u v w x + +public noncomputable section + +namespace MvPolynomial + +variable {K : Type u} {A : Type v} {L : Type w} {σ : Type x} +variable [CommRing K] [CommRing A] [Algebra K A] [CommRing L] [Algebra K L] + +/-- The identification `K[X_i] ⊗_K L ≅ L[X_i]` on a variable tensor. -/ +theorem scalarRTensorAlgEquiv_X_tmul_one [DecidableEq σ] (i : σ) : + scalarRTensorAlgEquiv (σ := σ) (R := K) (N := L) (X i ⊗ₜ[K] 1) = X i := by + classical + refine MvPolynomial.ext _ _ fun d ↦ ?_ + simp [scalarRTensorAlgEquiv, rTensorAlgEquiv_apply, coeff_rTensorAlgHom_tmul, coeff_map, + coeff_X, Algebra.smul_def, mul_one, apply_ite (algebraMap K L)] + +/-- The identification `K[X_i] ⊗_K L ≅ L[X_i]` on a scalar tensor. -/ +theorem scalarRTensorAlgEquiv_one_tmul [DecidableEq σ] (l : L) : + scalarRTensorAlgEquiv (σ := σ) (R := K) (N := L) (1 ⊗ₜ[K] l) = C l := by + classical + refine MvPolynomial.ext _ _ fun d ↦ ?_ + simp [scalarRTensorAlgEquiv, rTensorAlgEquiv_apply, coeff_rTensorAlgHom_tmul, coeff_map, + coeff_C, coeff_one, apply_ite] + split_ifs with hd <;> simp [hd] + +variable (K L) in +/-- Evaluation `L[X_i] → A ⊗_K L`, `X_i ↦ y i ⊗ 1`, `l ↦ 1 ⊗ l`, as a `K`-algebra +homomorphism. -/ +def aevalTmulOne (y : σ → A) : MvPolynomial σ L →ₐ[K] A ⊗[K] L := + aevalTower (Algebra.TensorProduct.includeRight : L →ₐ[K] A ⊗[K] L) fun i ↦ y i ⊗ₜ[K] 1 + +theorem aevalTmulOne_X (y : σ → A) (i : σ) : aevalTmulOne K L y (X i) = y i ⊗ₜ[K] 1 := + aevalTower_X _ _ i + +theorem aevalTmulOne_C (y : σ → A) (l : L) : aevalTmulOne K L y (C l) = (1 : A) ⊗ₜ[K] l := + aevalTower_C _ _ l + +/-- Through `K[X_i] ⊗_K L ≅ L[X_i]`, evaluation at the `y i ⊗ 1` is the base change to `L` of +evaluation at the `y i`. -/ +theorem aevalTmulOne_comp_scalarRTensorAlgEquiv [DecidableEq σ] (y : σ → A) : + (aevalTmulOne K L y).comp + (scalarRTensorAlgEquiv (σ := σ) (R := K) (N := L)).toAlgHom = + Algebra.TensorProduct.map (aeval y : MvPolynomial σ K →ₐ[K] A) (AlgHom.id K L) := by + refine Algebra.TensorProduct.ext ?_ ?_ + · refine MvPolynomial.algHom_ext fun i ↦ ?_ + simp only [AlgHom.comp_apply, Algebra.TensorProduct.includeLeft_apply, AlgEquiv.coe_algHom, + scalarRTensorAlgEquiv_X_tmul_one, aevalTmulOne_X, Algebra.TensorProduct.map_tmul, + aeval_X, AlgHom.coe_id, id_eq] + · refine AlgHom.ext fun l ↦ ?_ + simp only [AlgHom.coe_restrictScalars', AlgHom.comp_apply, + Algebra.TensorProduct.includeRight_apply, AlgEquiv.coe_algHom, + scalarRTensorAlgEquiv_one_tmul, aevalTmulOne_C, Algebra.TensorProduct.map_tmul, + map_one, AlgHom.coe_id, id_eq] + +/-- Evaluation at the `y i ⊗ 1` of a polynomial with coefficients in `K` is the evaluation at the +`y i` tensored with `1`. -/ +theorem aevalTmulOne_map (y : σ → A) (G : MvPolynomial σ K) : + aevalTmulOne K L y (map (algebraMap K L) G) = aeval y G ⊗ₜ[K] 1 := by + induction G using MvPolynomial.induction_on with + | C c => + rw [map_C, aevalTmulOne_C, aeval_C, Algebra.algebraMap_eq_smul_one, + Algebra.algebraMap_eq_smul_one, TensorProduct.smul_tmul] + | add p q hp hq => rw [map_add, map_add, hp, hq, map_add, TensorProduct.add_tmul] + | mul_X p i hp => + rw [map_mul, map_mul, hp, map_X, aevalTmulOne_X, map_mul, aeval_X, + Algebra.TensorProduct.tmul_mul_tmul, mul_one] + +/-- Elements generating `A` over `K` generate `A ⊗_K L` over `L`. -/ +theorem aevalTmulOne_surjective {y : σ → A} + (hy : Function.Surjective (aeval y : MvPolynomial σ K →ₐ[K] A)) : + Function.Surjective (aevalTmulOne K L y) := by + intro z + induction z using TensorProduct.induction_on with + | zero => exact ⟨0, map_zero _⟩ + | tmul a l => + obtain ⟨G, rfl⟩ := hy a + refine ⟨C l * map (algebraMap K L) G, ?_⟩ + rw [map_mul, aevalTmulOne_C, aevalTmulOne_map, Algebra.TensorProduct.tmul_mul_tmul, one_mul, + mul_one] + | add z w hz hw => + obtain ⟨F, rfl⟩ := hz + obtain ⟨G, rfl⟩ := hw + exact ⟨F + G, map_add _ _ _⟩ + +/-- Elements algebraically independent over `K` remain algebraically independent over `L` after +a flat extension of scalars `K → L`. -/ +theorem aevalTmulOne_injective [Module.Flat K L] {y : σ → A} + (hy : Function.Injective (aeval y : MvPolynomial σ K →ₐ[K] A)) : + Function.Injective (aevalTmulOne K L y) := by + classical + have hrt : Function.Injective + (Algebra.TensorProduct.map (aeval y : MvPolynomial σ K →ₐ[K] A) (AlgHom.id K L)) := + Module.Flat.rTensor_preserves_injective_linearMap (R := K) (M := L) + (aeval y : MvPolynomial σ K →ₐ[K] A).toLinearMap hy + set e := scalarRTensorAlgEquiv (σ := σ) (R := K) (N := L) + have key : ∀ u, aevalTmulOne K L y (e u) = + Algebra.TensorProduct.map (aeval y : MvPolynomial σ K →ₐ[K] A) (AlgHom.id K L) u := + fun u ↦ congrFun (congrArg (fun f : _ →ₐ[K] _ ↦ (f : _ → _)) + (aevalTmulOne_comp_scalarRTensorAlgEquiv y)) u + intro a b hab + rw [← e.apply_symm_apply a, ← e.apply_symm_apply b, key, key] at hab + rw [← e.apply_symm_apply a, ← e.apply_symm_apply b, hrt hab] + +end MvPolynomial diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Components.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Components.lean new file mode 100644 index 0000000000..14d89f5020 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Components.lean @@ -0,0 +1,115 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.RingTheory.MvPolynomial.WeightedHomogeneous +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart + +/-! +# The part of a polynomial of degree at least `τ` + +For `P ∈ R[X_i]` graded by `deg X_i = wt i` with ordinal degrees `wt : σ → NatOrdinal`, +`componentsGE wt τ P` is the sum of the monomials of `P` of degree at least `τ`: the part +`P_{≥τ} := ∑_{β ≥ τ} P_β` of `P` *at or above the degree `τ`* (by the degree of its monomials, not +by exponent as for the parts of an ordinal). It is additive, vanishes on polynomials of degree +below `τ`, and fixes homogeneous polynomials of degree at least `τ`. +-/ + +universe u v + +open Finsupp + +public section + +namespace MvPolynomial + +variable {σ : Type u} {R : Type v} [CommRing R] (wt : σ → NatOrdinal) + +/-- The part `P_{≥τ}` of `P` at or above the degree `τ`: the sum of the monomials of `P` of degree +at least `τ`. -/ +noncomputable def componentsGE (τ : NatOrdinal) (P : MvPolynomial σ R) : MvPolynomial σ R := by + classical + exact ∑ d ∈ P.support.filter fun d ↦ τ ≤ Finsupp.weight wt d, monomial d (coeff d P) + +open Classical in +theorem coeff_componentsGE (τ : NatOrdinal) (P : MvPolynomial σ R) (d : σ →₀ ℕ) : + coeff d (componentsGE wt τ P) = if τ ≤ Finsupp.weight wt d then coeff d P else 0 := by + classical + rw [componentsGE] + simp only [coeff_sum, coeff_monomial] + split_ifs with hτ + · rw [Finset.sum_eq_single d] + · rw [if_pos rfl] + · intro d' _ hd' + rw [if_neg hd'] + · intro hd + rw [if_pos rfl] + by_contra h + exact hd (Finset.mem_filter.mpr ⟨mem_support_iff.mpr h, hτ⟩) + · refine Finset.sum_eq_zero fun d' hd' ↦ ?_ + rw [if_neg] + rintro rfl + exact hτ (Finset.mem_filter.mp hd').2 + +theorem componentsGE_add (τ : NatOrdinal) (P Q : MvPolynomial σ R) : + componentsGE wt τ (P + Q) = componentsGE wt τ P + componentsGE wt τ Q := by + classical + ext d + simp only [coeff_componentsGE, coeff_add] + split_ifs <;> simp + +theorem componentsGE_neg (τ : NatOrdinal) (P : MvPolynomial σ R) : + componentsGE wt τ (-P) = -componentsGE wt τ P := by + classical + ext d + have hneg : ∀ Q : MvPolynomial σ R, coeff d (-Q) = -coeff d Q := fun Q ↦ by + change (coeffAddMonoidHom d) (-Q) = -(coeffAddMonoidHom d) Q + exact map_neg _ _ + rw [hneg, coeff_componentsGE, coeff_componentsGE, hneg] + split_ifs <;> simp + +theorem componentsGE_sub (τ : NatOrdinal) (P Q : MvPolynomial σ R) : + componentsGE wt τ (P - Q) = componentsGE wt τ P - componentsGE wt τ Q := by + rw [sub_eq_add_neg, componentsGE_add, componentsGE_neg, sub_eq_add_neg] + +theorem componentsGE_zero (τ : NatOrdinal) : componentsGE wt τ (0 : MvPolynomial σ R) = 0 := by + classical + ext d + simp [coeff_componentsGE] + +theorem componentsGE_sum {ι : Type*} (τ : NatOrdinal) (s : Finset ι) (f : ι → MvPolynomial σ R) : + componentsGE wt τ (∑ i ∈ s, f i) = ∑ i ∈ s, componentsGE wt τ (f i) := by + classical + induction s using Finset.induction_on with + | empty => rw [Finset.sum_empty, Finset.sum_empty, componentsGE_zero] + | insert a s ha ih => rw [Finset.sum_insert ha, Finset.sum_insert ha, componentsGE_add, ih] + +/-- The part at or above `τ` of a polynomial all of whose monomials have degree below `τ` is +`0`. -/ +theorem componentsGE_eq_zero_of_forall_lt {τ : NatOrdinal} {P : MvPolynomial σ R} + (hP : ∀ d ∈ P.support, Finsupp.weight wt d < τ) : componentsGE wt τ P = 0 := by + classical + ext d + rw [coeff_componentsGE, coeff_zero] + split_ifs with hτ + · by_contra h + exact absurd (hP d (mem_support_iff.mpr h)) (not_lt.mpr hτ) + · rfl + +/-- A homogeneous polynomial of degree at least `τ` is its own part at or above `τ`. -/ +theorem componentsGE_eq_self_of_isWeightedHomogeneous {τ β : NatOrdinal} {P : MvPolynomial σ R} + (hP : IsWeightedHomogeneous wt P β) (hβ : τ ≤ β) : componentsGE wt τ P = P := by + classical + ext d + rw [coeff_componentsGE] + split_ifs with hτ + · rfl + · by_contra h + exact hτ (hβ.trans_eq (hP (Ne.symm h)).symm) + +end MvPolynomial + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/ComponentsSpan.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/ComponentsSpan.lean new file mode 100644 index 0000000000..2c242b7f98 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/ComponentsSpan.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Components +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan + +/-! +# The part at or above a degree of an element of a homogeneous ideal + +The part `P_{≥τ}` at or above a degree `τ` of an element `P` of the ideal generated by finitely +many homogeneous polynomials lies in that ideal: `componentsGE wt τ P` is the sum of the +homogeneous components of `P` of degree at least `τ`, and each homogeneous component of an element +of a homogeneous ideal lies in the ideal. +-/ + +universe u v w + +open Finsupp DirectSum + +public section + +namespace MvPolynomial + +variable {σ : Type u} {K : Type v} [Field K] (wt : σ → NatOrdinal) + +/-- The part at or above `τ` is the sum of the homogeneous components of degree at least `τ`. -/ +theorem componentsGE_eq_sum_weightedHomogeneousComponent (τ : NatOrdinal) (P : MvPolynomial σ K) : + componentsGE wt τ P = + ∑ e ∈ (P.support.image (Finsupp.weight wt)).filter fun e ↦ τ ≤ e, + weightedHomogeneousComponent wt e P := by + classical + ext d + rw [coeff_componentsGE, coeff_sum] + simp only [coeff_weightedHomogeneousComponent] + split_ifs with hτ + · by_cases hd : d ∈ P.support + · rw [Finset.sum_eq_single (Finsupp.weight wt d)] + · rw [if_pos rfl] + · intro e _ he + rw [if_neg (Ne.symm he)] + · intro h + exact absurd (Finset.mem_filter.mpr ⟨Finset.mem_image_of_mem _ hd, hτ⟩) h + · rw [notMem_support_iff.mp hd] + exact (Finset.sum_eq_zero fun e _ ↦ by split_ifs <;> rfl).symm + · refine (Finset.sum_eq_zero fun e he ↦ ?_).symm + rw [if_neg] + rintro rfl + exact hτ (Finset.mem_filter.mp he).2 + +/-- A homogeneous component of an element of the ideal generated by homogeneous polynomials lies in +the ideal. -/ +theorem weightedHomogeneousComponent_mem_span {ι : Type w} [Finite ι] {q : ι → MvPolynomial σ K} + {c : ι → NatOrdinal} (hq : ∀ j, IsWeightedHomogeneous wt (q j) (c j)) {P : MvPolynomial σ K} + (hP : P ∈ Ideal.span (Set.range q)) (e : NatOrdinal) : + weightedHomogeneousComponent wt e P ∈ Ideal.span (Set.range q) := by + classical + cases nonempty_fintype ι + letI := weightedGradedAlgebra K wt + obtain ⟨u, -, -, hsum⟩ := OrdinalGraded.exists_decompose_eq_sum_mul_of_mem_span + (𝒜 := weightedHomogeneousSubmodule K wt) + (fun j ↦ (mem_weightedHomogeneousSubmodule _ _ _ _).mpr (hq j)) hP e + have hdec : (decompose (weightedHomogeneousSubmodule K wt) P e : MvPolynomial σ K) = + weightedHomogeneousComponent wt e P := by + rw [← decompose'_apply] + rfl + rw [← hdec, hsum] + exact Ideal.sum_mem _ fun j _ ↦ Ideal.mul_mem_right _ _ (Ideal.subset_span ⟨j, rfl⟩) + +/-- The part at or above a degree `τ` of an element of the ideal generated by homogeneous +polynomials lies in the ideal. -/ +theorem componentsGE_mem_span {ι : Type w} [Finite ι] {q : ι → MvPolynomial σ K} + {c : ι → NatOrdinal} (hq : ∀ j, IsWeightedHomogeneous wt (q j) (c j)) {P : MvPolynomial σ K} + (hP : P ∈ Ideal.span (Set.range q)) (τ : NatOrdinal) : + componentsGE wt τ P ∈ Ideal.span (Set.range q) := by + rw [componentsGE_eq_sum_weightedHomogeneousComponent] + exact Ideal.sum_mem _ fun e _ ↦ weightedHomogeneousComponent_mem_span wt hq hP e + +/-- A homogeneous component of degree at least `τ` is unchanged by passing to the part at or +above `τ`. -/ +theorem weightedHomogeneousComponent_componentsGE_of_le {τ e : NatOrdinal} (hτe : τ ≤ e) + (P : MvPolynomial σ K) : + weightedHomogeneousComponent wt e (componentsGE wt τ P) = + weightedHomogeneousComponent wt e P := by + classical + ext d + rw [coeff_weightedHomogeneousComponent, coeff_weightedHomogeneousComponent, coeff_componentsGE] + split_ifs with h1 h2 + · rfl + · exact absurd (h1 ▸ hτe) h2 + · rfl + +/-- If the part at or above `τ` of `P` lies in the ideal generated by homogeneous polynomials, so +does every homogeneous component of `P` of degree at least `τ`. -/ +theorem weightedHomogeneousComponent_mem_span_of_componentsGE_mem {ι : Type w} [Finite ι] + {q : ι → MvPolynomial σ K} {c : ι → NatOrdinal} + (hq : ∀ j, IsWeightedHomogeneous wt (q j) (c j)) {P : MvPolynomial σ K} {τ e : NatOrdinal} + (hP : componentsGE wt τ P ∈ Ideal.span (Set.range q)) (hτe : τ ≤ e) : + weightedHomogeneousComponent wt e P ∈ Ideal.span (Set.range q) := by + rw [← weightedHomogeneousComponent_componentsGE_of_le wt hτe] + exact weightedHomogeneousComponent_mem_span wt hq hP e + +end MvPolynomial + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Expansion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Expansion.lean new file mode 100644 index 0000000000..f56999b7d7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Expansion.lean @@ -0,0 +1,262 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.MvPolynomial.Derivation +public import Mathlib.Algebra.MvPolynomial.Equiv +public import Mathlib.Algebra.MvPolynomial.Supported +public import Mathlib.RingTheory.MvPolynomial.WeightedHomogeneous + +/-! +# Expansion of a multivariate polynomial in one variable + +Mathlib identifies `MvPolynomial (Option σ') R` with polynomials in one variable over +`MvPolynomial σ' R` (`MvPolynomial.optionEquivLeft`). Composing with the renaming along +`Option {y // y ≠ x} ≃ σ` gives, for a variable `x : σ`, the expansion of every +`p : MvPolynomial σ R` in powers of `X x`: `expandEquiv x p` is a polynomial over the polynomials in +the remaining variables, and `xCoeff x k p` is its `k`-th coefficient read back in +`MvPolynomial σ R`, a polynomial not involving `x` (an element of `supported R {x}ᶜ`). The lemmas +here translate the `Polynomial.coeff` API through that identification: the expansion +`p = ∑_k xCoeff x k p * X x ^ k`, the coefficients of such an expansion, the nonvanishing of the +leading coefficient, and the behaviour of the coefficients under weighted homogeneity. + +The file also records how weighted homogeneity interacts with derivations `mkDerivation R f` whose +values on the variables have weight `wt i - 1`: such a derivation lowers weight by one, and it +preserves "does not involve `x`" on polynomials whose variables all have weight at most `wt x`. +-/ + +universe u v + +public noncomputable section + +namespace MvPolynomial + +variable {σ : Type u} {R : Type v} [CommRing R] + +/-! ### Weighted homogeneity and the variables -/ + +variable (wt : σ → ℕ) + +/-- A variable of a weighted-homogeneous polynomial has weight at most the polynomial's. -/ +theorem IsWeightedHomogeneous.weight_le_of_mem_vars {p : MvPolynomial σ R} {w : ℕ} + (hp : IsWeightedHomogeneous wt p w) {i : σ} (hi : i ∈ p.vars) : wt i ≤ w := by + obtain ⟨m, hm, hmi⟩ := (mem_vars_iff_mem_support i).mp hi + rw [← hp (mem_support_iff.mp hm)] + exact Finsupp.le_weight_of_ne_zero' wt (Finsupp.mem_support_iff.mp hmi) + +/-- A weighted-homogeneous polynomial of weight less than `wt x` does not involve `x`. -/ +theorem IsWeightedHomogeneous.mem_supported_of_lt {p : MvPolynomial σ R} {w : ℕ} + (hp : IsWeightedHomogeneous wt p w) {x : σ} (hx : w < wt x) : p ∈ supported R {x}ᶜ := by + rw [mem_supported] + intro y hy + rw [Set.mem_compl_singleton_iff] + rintro rfl + exact absurd (hp.weight_le_of_mem_vars wt hy) (not_le.mpr hx) + +/-- A derivation whose values on the variables are weighted-homogeneous of weight `wt i - 1` +lowers the weight of weighted-homogeneous polynomials by one. -/ +theorem mkDerivation_isWeightedHomogeneous (f : σ → MvPolynomial σ R) + (hf : ∀ i, IsWeightedHomogeneous wt (f i) (wt i - 1)) (hwt : ∀ i, 1 ≤ wt i) + {p : MvPolynomial σ R} {w : ℕ} (hp : IsWeightedHomogeneous wt p w) : + IsWeightedHomogeneous wt (mkDerivation R f p) (w - 1) := by + induction hp using IsWeightedHomogeneous.induction_on with + | zero => rw [map_zero]; exact isWeightedHomogeneous_zero R wt _ + | add p q hp hq ihp ihq => rw [map_add]; exact ihp.add ihq + | monomial d r hr => + rw [mkDerivation_monomial, smul_eq_C_mul] + refine IsWeightedHomogeneous.C_mul ?_ r + unfold Finsupp.sum + refine IsWeightedHomogeneous.sum _ _ _ fun i hi ↦ ?_ + have hd := Finsupp.weight_sub_single_add (w := wt) (Finsupp.mem_support_iff.mp hi) + change IsWeightedHomogeneous wt (monomial (d - Finsupp.single i 1) (d i : R) • f i) (w - 1) + rw [smul_eq_mul] + have hw : w - 1 = Finsupp.weight wt (d - Finsupp.single i 1) + (wt i - 1) := by + have := hwt i + omega + rw [hw] + exact (isWeightedHomogeneous_monomial wt _ _ rfl).mul (hf i) + +/-- Such a derivation preserves "does not involve `x`" on polynomials whose variables all have +weight at most `wt x`. -/ +theorem mkDerivation_mem_supported (hwt : ∀ i, 1 ≤ wt i) (f : σ → MvPolynomial σ R) + (hf : ∀ i, IsWeightedHomogeneous wt (f i) (wt i - 1)) {x : σ} {p : MvPolynomial σ R} + (hp : p ∈ supported R {x}ᶜ) (hvars : ∀ i ∈ p.vars, wt i ≤ wt x) : + mkDerivation R f p ∈ supported R {x}ᶜ := by + have hs : {i | i ≠ x ∧ wt i ≤ wt x} ⊆ {x}ᶜ := fun i hi ↦ hi.1 + have hp' : p ∈ Algebra.adjoin R (X '' {i | i ≠ x ∧ wt i ≤ wt x}) := + mem_supported.mpr fun i hi ↦ ⟨(mem_supported.mp hp) hi, hvars i hi⟩ + clear hp hvars + induction hp' using Algebra.adjoin_induction with + | mem q hq => + obtain ⟨i, hi, rfl⟩ := hq + rw [mkDerivation_X] + exact (hf i).mem_supported_of_lt wt (by have := hwt x; have := hi.2; omega) + | algebraMap r => rw [Derivation.map_algebraMap]; exact zero_mem _ + | add a b _ _ ha hb => rw [map_add]; exact add_mem ha hb + | mul a b ha' hb' ha hb => + rw [Derivation.leibniz, smul_eq_mul, smul_eq_mul] + exact add_mem (mul_mem (supported_mono hs ha') hb) (mul_mem (supported_mono hs hb') ha) + +/-! ### The expansion in powers of one variable -/ + +variable (x : σ) + +/-- Polynomials in the variables other than `x` do not involve `x`. -/ +theorem rename_val_mem_supported (q : MvPolynomial {y // y ≠ x} R) : + rename Subtype.val q ∈ supported R {x}ᶜ := by + classical + rw [mem_supported] + intro y hy + obtain ⟨z, -, rfl⟩ := Finset.mem_image.mp (vars_rename _ _ hy) + exact z.2 + +theorem exists_rename_val_eq_of_mem_supported {a : MvPolynomial σ R} (ha : a ∈ supported R {x}ᶜ) : + ∃ q : MvPolynomial {y // y ≠ x} R, rename Subtype.val q = a := by + rw [supported_eq_range_rename] at ha + obtain ⟨q, hq⟩ := ha + exact ⟨q, hq⟩ + +variable [DecidableEq σ] + +/-- `MvPolynomial σ R` as polynomials in `X x` over the polynomials in the other variables. -/ +def expandEquiv : MvPolynomial σ R ≃ₐ[R] Polynomial (MvPolynomial {y // y ≠ x} R) := + (renameEquiv R (Equiv.optionSubtypeNe x).symm).trans (optionEquivLeft R _) + +theorem expandEquiv_rename_val (q : MvPolynomial {y // y ≠ x} R) : + expandEquiv x (rename Subtype.val q) = Polynomial.C q := by + rw [expandEquiv, AlgEquiv.trans_apply, renameEquiv_apply, rename_rename] + have : (Equiv.optionSubtypeNe x).symm ∘ Subtype.val = some := + funext fun y ↦ Equiv.optionSubtypeNe_symm_of_ne y.2 + rw [this] + induction q using MvPolynomial.induction_on with + | C r => rw [rename_C, optionEquivLeft_C] + | add p q hp hq => rw [map_add, map_add, hp, hq, Polynomial.C_add] + | mul_X p i hp => rw [map_mul, map_mul, hp, rename_X, optionEquivLeft_X_some, Polynomial.C_mul] + +theorem expandEquiv_symm_C (q : MvPolynomial {y // y ≠ x} R) : + (expandEquiv x).symm (Polynomial.C q) = rename Subtype.val q := by + rw [← expandEquiv_rename_val, AlgEquiv.symm_apply_apply] + +theorem expandEquiv_X_self : expandEquiv x (X x : MvPolynomial σ R) = Polynomial.X := by + rw [expandEquiv, AlgEquiv.trans_apply, renameEquiv_apply, rename_X, + Equiv.optionSubtypeNe_symm_self, optionEquivLeft_X_none] + +theorem expandEquiv_symm_X : (expandEquiv x).symm Polynomial.X = (X x : MvPolynomial σ R) := by + rw [← expandEquiv_X_self, AlgEquiv.symm_apply_apply] + +/-- The degree of the expansion is the degree in `x`. -/ +theorem natDegree_expandEquiv (p : MvPolynomial σ R) : + (expandEquiv x p).natDegree = p.degreeOf x := by + rw [expandEquiv, AlgEquiv.trans_apply, natDegree_optionEquivLeft, renameEquiv_apply] + have := degreeOf_rename_of_injective (Equiv.optionSubtypeNe x).symm.injective (p := p) x + rwa [Equiv.optionSubtypeNe_symm_self] at this + +/-- The coefficient of `X x ^ k`, read back as a polynomial in all the variables; it does not +involve `x`. -/ +def xCoeff (k : ℕ) : MvPolynomial σ R →ₗ[R] MvPolynomial σ R := + (rename (Subtype.val : {y // y ≠ x} → σ)).toLinearMap ∘ₗ + Polynomial.lcoeff (MvPolynomial {y // y ≠ x} R) k ∘ₗ (expandEquiv x).toLinearEquiv.toLinearMap + +theorem xCoeff_apply (k : ℕ) (p : MvPolynomial σ R) : + xCoeff x k p = rename Subtype.val ((expandEquiv x p).coeff k) := (rfl) + +theorem xCoeff_mem_supported (k : ℕ) (p : MvPolynomial σ R) : xCoeff x k p ∈ supported R {x}ᶜ := + rename_val_mem_supported x _ + +theorem coeff_xCoeff (k : ℕ) (p : MvPolynomial σ R) (m : σ →₀ ℕ) : + coeff m (xCoeff x k p) = if m x = 0 then coeff (m + Finsupp.single x k) p else 0 := by + rw [xCoeff_apply] + split_ifs with hm + · have hsub : (m.support : Set σ) ⊆ Set.range (Subtype.val : {y // y ≠ x} → σ) := fun y hy ↦ + ⟨⟨y, fun h ↦ (Finsupp.mem_support_iff.mp hy) (h ▸ hm)⟩, rfl⟩ + conv_lhs => rw [← Finsupp.mapDomain_comapDomain Subtype.val Subtype.val_injective m hsub] + rw [coeff_rename_mapDomain _ Subtype.val_injective, expandEquiv, AlgEquiv.trans_apply, + optionEquivLeft_coeff_coeff, renameEquiv_apply, + ← coeff_rename_mapDomain _ (Equiv.optionSubtypeNe x).symm.injective] + congr 2 + ext (_ | y) + · rw [Finsupp.mapDomain_equiv_apply, Finsupp.optionElim_apply_none, Equiv.symm_symm, + Equiv.optionSubtypeNe_none, Finsupp.add_apply, Finsupp.single_eq_same, hm, zero_add] + · rw [Finsupp.mapDomain_equiv_apply, Equiv.symm_symm, Equiv.optionSubtypeNe_some, + Finsupp.optionElim_apply_some, Finsupp.add_apply, Finsupp.single_eq_of_ne y.2, + add_zero, Finsupp.comapDomain_apply] + · refine coeff_rename_eq_zero _ _ _ fun u hu ↦ (hm ?_).elim + rw [← hu, Finsupp.mapDomain_notin_range] + rintro ⟨y, hy⟩ + exact y.2 hy + +/-- The coefficient of `X x ^ k` in `a * X x ^ d`, for `a` not involving `x`. -/ +theorem xCoeff_mul_X_pow {a : MvPolynomial σ R} (ha : a ∈ supported R {x}ᶜ) (k d : ℕ) : + xCoeff x k (a * X x ^ d) = if k = d then a else 0 := by + obtain ⟨q, rfl⟩ := exists_rename_val_eq_of_mem_supported x ha + rw [xCoeff_apply, map_mul, map_pow, expandEquiv_rename_val, expandEquiv_X_self, + Polynomial.coeff_C_mul_X_pow] + split_ifs <;> simp + +/-- The coefficients of an expansion in powers of `X x` whose coefficients do not involve `x`. -/ +theorem xCoeff_sum_mul_X_pow (s : Finset ℕ) {q : ℕ → MvPolynomial σ R} + (hq : ∀ d ∈ s, q d ∈ supported R {x}ᶜ) (k : ℕ) : + xCoeff x k (∑ d ∈ s, q d * X x ^ d) = if k ∈ s then q k else 0 := by + rw [map_sum, Finset.sum_congr rfl fun d hd ↦ xCoeff_mul_X_pow x (hq d hd) k d, Finset.sum_ite_eq] + +/-- Expansion of a polynomial in powers of `X x`. -/ +theorem sum_xCoeff_mul_X_pow (p : MvPolynomial σ R) : + ∑ d ∈ Finset.range (p.degreeOf x + 1), xCoeff x d p * X x ^ d = p := by + conv_rhs => rw [← (expandEquiv x).symm_apply_apply p, (expandEquiv x p).as_sum_range_C_mul_X_pow] + rw [map_sum, natDegree_expandEquiv] + refine Finset.sum_congr rfl fun d _ ↦ ?_ + rw [map_mul, map_pow, expandEquiv_symm_C, expandEquiv_symm_X, xCoeff_apply] + +theorem xCoeff_eq_zero_of_degreeOf_lt {p : MvPolynomial σ R} {k : ℕ} (h : p.degreeOf x < k) : + xCoeff x k p = 0 := by + rw [xCoeff_apply, Polynomial.coeff_eq_zero_of_natDegree_lt (by rwa [natDegree_expandEquiv]), + map_zero] + +/-- The leading coefficient in `X x` is nonzero. -/ +theorem xCoeff_degreeOf_ne_zero {p : MvPolynomial σ R} (hp : p ≠ 0) : + xCoeff x (p.degreeOf x) p ≠ 0 := by + rw [xCoeff_apply, ← natDegree_expandEquiv, ← Polynomial.leadingCoeff, + map_ne_zero_iff _ (rename_injective _ Subtype.val_injective), Polynomial.leadingCoeff_ne_zero] + exact (map_ne_zero_iff _ (expandEquiv x).injective).mpr hp + +theorem vars_xCoeff_subset (k : ℕ) (p : MvPolynomial σ R) : (xCoeff x k p).vars ⊆ p.vars := by + intro i hi + obtain ⟨m, hm, hmi⟩ := (mem_vars_iff_mem_support i).mp hi + have hc := mem_support_iff.mp hm + rw [coeff_xCoeff] at hc + split_ifs at hc with hmx + · refine (mem_vars_iff_mem_support i).mpr ⟨m + Finsupp.single x k, mem_support_iff.mpr hc, ?_⟩ + rw [Finsupp.mem_support_iff, Finsupp.add_apply] + have := Finsupp.mem_support_iff.mp hmi + omega + · exact absurd rfl hc + +/-- The coefficient of `X x ^ k` in a weighted-homogeneous polynomial of weight `w` is +weighted-homogeneous of weight `w - k · wt x`. -/ +theorem xCoeff_isWeightedHomogeneous {p : MvPolynomial σ R} {w : ℕ} + (hp : IsWeightedHomogeneous wt p w) (k : ℕ) : + IsWeightedHomogeneous wt (xCoeff x k p) (w - k * wt x) := by + intro m hm + rw [coeff_xCoeff] at hm + split_ifs at hm with h + · have := hp hm + rw [map_add, Finsupp.weight_single, smul_eq_mul] at this + omega + · exact absurd rfl hm + +/-- A nonzero coefficient of `X x ^ k` in a weighted-homogeneous polynomial of weight `w` forces +`k · wt x ≤ w`. -/ +theorem le_of_xCoeff_ne_zero {p : MvPolynomial σ R} {w : ℕ} (hp : IsWeightedHomogeneous wt p w) + {k : ℕ} (h : xCoeff x k p ≠ 0) : k * wt x ≤ w := by + obtain ⟨m, hm⟩ := exists_coeff_ne_zero h + rw [coeff_xCoeff] at hm + split_ifs at hm with hmx + · have := hp hm + rw [map_add, Finsupp.weight_single, smul_eq_mul] at this + omega + · exact absurd rfl hm + +end MvPolynomial diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartDecomposition.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartDecomposition.lean new file mode 100644 index 0000000000..66171769f1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartDecomposition.lean @@ -0,0 +1,126 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartErasure + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# A weighted-homogeneous polynomial in the ideal of selected partial derivatives + +Suppose `F` is weighted homogeneous of degree `δ`, the coefficient `n` of `1 = ω^0` in the Cantor +normal form of `δ` is positive, and `F` lies in the ideal generated by the partial derivatives at +variables whose weights have constant Cantor coefficient `n`. Then + +`F = ∑_t (∂F/∂X_t) (X_t + V_t)`, + +where each `V_t` is weighted homogeneous of degree `wt t` and contains no variable whose weight has +constant Cantor coefficient `n`. + +Homogeneous ideal membership supplies the cofactors. Setting the selected variables to zero in +each cofactor gives the polynomials `V_t`; the polynomial identity in +`FinitePartErasure` then supplies the terms `X_t`. +-/ + +universe u v + +open scoped NatOrdinal + +open OrdinalGraded + +public noncomputable section + +namespace MvPolynomial + +variable {σ : Type u} {K : Type v} [Field K] {wt : σ → NatOrdinal} + +/-- Decompose a weighted-homogeneous polynomial that belongs to the ideal generated by the partial +derivatives at variables carrying its positive constant Cantor coefficient. -/ +@[blueprint "lem:successor-relation-decomposition" + (phase := "Algebraic and ordinal preliminaries") + (title := "Partial-derivative decomposition of a homogeneous ideal relation") + (statement := /-- + Let $F$ be weighted homogeneous of degree $\delta$, and let $n>0$ be the + coefficient of $1=\omega^0$ in the Cantor normal form of $\delta$. Suppose + \[ + F\in\bigl(\partial_iF:i\in\operatorname{vars}(F),\ + \operatorname{coeff}_{\omega^0}(\operatorname{wt}(i))=n\bigr). + \] + Then there are weighted-homogeneous polynomials $V_i$ of degree + $\operatorname{wt}(i)$, involving no variable whose weight has constant + Cantor coefficient $n$, such that + \[ + F=\sum_{\substack{i\in\operatorname{vars}(F)\\ + \operatorname{coeff}_{\omega^0}(\operatorname{wt}(i))=n}} + \frac{\partial F}{\partial X_i}(X_i+V_i). + \] + -/) + (proof := /-- + By \ref{lem:homogeneous-element-of-generated-ideal}, homogeneous ideal + membership writes $F=\sum_i(\partial_iF)U_i$, with $U_i$ weighted homogeneous + of degree $\operatorname{wt}(i)$. Let $V_i$ be obtained from $U_i$ by setting + to zero every variable whose weight has constant Cantor coefficient $n$. + Applying the same substitution to the displayed ideal identity and combining + it with \ref{lem:relation-shape} gives the required formula. + -/)] +theorem exists_eq_sum_pderiv_mul_X_add_of_mem_span {δ : NatOrdinal} + (hδ : 0 < δ.constantCoeff) {F : MvPolynomial σ K} (hF : IsWeightedHomogeneous wt F δ) + (hFI : F ∈ Ideal.span ((fun t ↦ pderiv t F) '' (varsOfFinitePart wt F δ : Set σ))) : + ∃ V : σ → MvPolynomial σ K, + (∀ t ∈ varsOfFinitePart wt F δ, IsWeightedHomogeneous wt (V t) (wt t) ∧ + V t ∈ supported K {i | (wt i).constantCoeff ≠ δ.constantCoeff}) ∧ + F = ∑ t ∈ varsOfFinitePart wt F δ, pderiv t F * (X t + V t) := by + classical + letI := weightedGradedAlgebra K wt + -- naming the index set keeps later rewrites from reaching inside it + set T := varsOfFinitePart wt F δ with hT + have hmemT : ∀ t : ↥T, (t : σ) ∈ F.vars ∧ (wt t).constantCoeff = δ.constantCoeff := fun t ↦ + mem_varsOfFinitePart_iff.mp (hT ▸ t.2) + obtain ⟨lam, hlam⟩ : ∃ lam : ↥T → NatOrdinal, ∀ t, lam t + wt t = δ := + ⟨_, fun t ↦ (exists_add_wt_eq_of_mem_vars hF (hmemT t).1).choose_spec⟩ + -- `F = ∑_t (∂F/∂X_t) U_t` with `U_t` homogeneous of degree `wt t` + have hFI' : F ∈ Ideal.span (Set.range fun t : ↥T ↦ pderiv (t : σ) F) := by + rwa [Set.image_eq_range] at hFI + obtain ⟨U, hU, -, hFU⟩ := exists_eq_sum_mul_of_mem_span + (𝒜 := weightedHomogeneousSubmodule K wt) + (q := fun t : ↥T ↦ pderiv (t : σ) F) (c := lam) + (fun t ↦ (mem_weightedHomogeneousSubmodule _ _ _ _).mpr + (isWeightedHomogeneous_pderiv_of_add_wt_eq hF (hlam t))) + ((mem_weightedHomogeneousSubmodule _ _ _ _).mpr hF) hFI' + have hUt : ∀ t : ↥T, IsWeightedHomogeneous wt (U t) (wt t) := fun t ↦ + (mem_weightedHomogeneousSubmodule _ _ _ _).mp (hU t (wt t) (by rw [add_comm]; exact hlam t)) + -- the partial derivatives are already free of the variables carrying the finite part + have hc : ∀ t : ↥T, eraseFinitePart wt δ.constantCoeff (pderiv (t : σ) F) = + pderiv (t : σ) F := fun t ↦ + eraseFinitePart_eq_self wt δ.constantCoeff fun i hi ↦ by + rw [constantCoeff_wt_eq_zero_of_mem_vars (isWeightedHomogeneous_pderiv_of_add_wt_eq hF + (hlam t)) (NatOrdinal.constantCoeff_eq_zero_of_add_eq (hmemT t).2 (hlam t)) hi] + exact hδ.ne + have hκF : eraseFinitePart wt δ.constantCoeff F = + ∑ t : ↥T, pderiv (t : σ) F * eraseFinitePart wt δ.constantCoeff (U t) := by + conv_lhs => rw [hFU] + rw [map_sum] + exact Finset.sum_congr rfl fun t _ ↦ by rw [map_mul, hc] + refine ⟨fun t ↦ if h : t ∈ T then eraseFinitePart wt δ.constantCoeff (U ⟨t, h⟩) else 0, + fun t ht ↦ ?_, ?_⟩ + · beta_reduce + rw [dif_pos ht] + exact ⟨isWeightedHomogeneous_eraseFinitePart wt _ (hUt ⟨t, ht⟩), + eraseFinitePart_mem_supported wt _ _⟩ + · have hshape := eraseFinitePart_add_sum_X_mul_pderiv hδ hF + rw [← hT, hκF, ← Finset.sum_coe_sort T] at hshape + rw [← Finset.sum_coe_sort T] + conv_lhs => rw [← hshape] + rw [← Finset.sum_add_distrib] + refine Finset.sum_congr rfl fun t _ ↦ ?_ + beta_reduce + rw [dif_pos t.2, mul_add, mul_comm (X (t : σ)), add_comm] + +end MvPolynomial + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartErasure.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartErasure.lean new file mode 100644 index 0000000000..15a4b500fc --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartErasure.lean @@ -0,0 +1,200 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import Mathlib.Algebra.MvPolynomial.Supported +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartVars + +/-! +# Erasing variables with a fixed constant Cantor coefficient + +Setting `X_i` to zero whenever the coefficient of `1 = ω^0` in the Cantor normal form of its weight +is `k` defines the algebra map `eraseFinitePart wt k`. It preserves weighted homogeneity and its +image contains none of those variables. + +Its defect from the identity is exactly the monomials the successor step needs to see. In a +monomial whose degree `δ` has positive constant Cantor coefficient `n`, a variable with constant +Cantor coefficient `n` occupies the whole coefficient on its own: it occurs to the first power, +and no other such variable occurs beside it. This gives the identity + +`F' + ∑_i X_i ∂F/∂X_i = F`, + +the sum over the variables of `F` carrying the finite part. + +Nothing here depends on where the variables are evaluated, so both the real-exponent development +and the Cantor–Bendixson germ argument use it unchanged. +-/ + +universe u v + +open scoped NatOrdinal + +public noncomputable section + +namespace Finsupp + +variable {ι : Type u} {wt : ι → NatOrdinal} + +/-- In a monomial whose degree `δ` has positive constant Cantor coefficient `n`, a variable whose +weight has constant Cantor coefficient `n` occurs with multiplicity one, and no other such variable +occurs. -/ +theorem eq_one_and_eq_zero_of_constantCoeff_eq {d : ι →₀ ℕ} {δ : NatOrdinal} + (hδ : 0 < δ.constantCoeff) (hd : Finsupp.weight wt d = δ) {i : ι} (hi : i ∈ d.support) + (hik : (wt i).constantCoeff = δ.constantCoeff) : + d i = 1 ∧ ∀ j, j ≠ i → (wt j).constantCoeff = δ.constantCoeff → d j = 0 := by + classical + have hsum : ∑ j ∈ d.support, d j * (wt j).constantCoeff = δ.constantCoeff := by + rw [← Finsupp.constantCoeff_weight, hd] + have hterm : ∀ j ∈ d.support, d j * (wt j).constantCoeff ≤ δ.constantCoeff := fun j hj ↦ + hsum ▸ Finset.single_le_sum (f := fun j ↦ d j * (wt j).constantCoeff) + (fun _ _ ↦ Nat.zero_le _) hj + have hdi : d i = 1 := by + have h1 := hterm i hi + rw [hik] at h1 + have h2 : 1 ≤ d i := Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hi) + nlinarith + refine ⟨hdi, fun j hji hjk ↦ ?_⟩ + by_contra hdj + have hj : j ∈ d.support := Finsupp.mem_support_iff.mpr hdj + -- two distinct variables carrying the finite part would contribute at least twice it + have h2 : d i * (wt i).constantCoeff + d j * (wt j).constantCoeff ≤ δ.constantCoeff := by + rw [← hsum] + exact Finset.add_le_sum (f := fun j ↦ d j * (wt j).constantCoeff) + (fun _ _ ↦ Nat.zero_le _) hi hj hji.symm + rw [hdi, one_mul, hik, hjk] at h2 + have h3 : 1 ≤ d j := Nat.one_le_iff_ne_zero.mpr hdj + nlinarith + +end Finsupp + +namespace MvPolynomial + +variable {σ : Type u} {R : Type v} [CommRing R] (wt : σ → NatOrdinal) (k : ℕ) + +/-- Set `X_i` to zero when the constant Cantor coefficient of its weight is `k`. -/ +def eraseFinitePart : MvPolynomial σ R →ₐ[R] MvPolynomial σ R := + aeval fun i ↦ if (wt i).constantCoeff = k then 0 else X i + +theorem eraseFinitePart_X {i : σ} : + eraseFinitePart (R := R) wt k (X i) = if (wt i).constantCoeff = k then 0 else X i := by + rw [eraseFinitePart, aeval_X] + +theorem eraseFinitePart_monomial (d : σ →₀ ℕ) (r : R) : + eraseFinitePart wt k (monomial d r) = + if ∃ i ∈ d.support, (wt i).constantCoeff = k then 0 else monomial d r := by + classical + rw [eraseFinitePart, aeval_monomial] + split_ifs with h + · obtain ⟨i, hi, hik⟩ := h + rw [Finsupp.prod, Finset.prod_eq_zero hi (by + rw [if_pos hik, zero_pow (Finsupp.mem_support_iff.mp hi)]), mul_zero] + · rw [monomial_eq, algebraMap_eq] + congr 1 + refine Finset.prod_congr rfl fun i hi ↦ ?_ + beta_reduce + rw [if_neg fun hik ↦ h ⟨i, hi, hik⟩] + +/-- The substitution fixes a polynomial none of whose variable weights has constant Cantor +coefficient `k`. -/ +theorem eraseFinitePart_eq_self {G : MvPolynomial σ R} + (hG : ∀ i ∈ G.vars, (wt i).constantCoeff ≠ k) : + eraseFinitePart wt k G = G := by + classical + conv_rhs => rw [G.as_sum] + conv_lhs => rw [G.as_sum, map_sum] + refine Finset.sum_congr rfl fun d hd ↦ ?_ + rw [eraseFinitePart_monomial, if_neg] + rintro ⟨i, hi, hik⟩ + exact hG i ((mem_vars_iff_mem_support i).mpr ⟨d, hd, hi⟩) hik + +/-- The substitution preserves homogeneity of any degree. -/ +theorem isWeightedHomogeneous_eraseFinitePart {G : MvPolynomial σ R} {β : NatOrdinal} + (hG : IsWeightedHomogeneous wt G β) : IsWeightedHomogeneous wt (eraseFinitePart wt k G) β := by + classical + induction hG using IsWeightedHomogeneous.induction_on with + | zero => rw [map_zero]; exact isWeightedHomogeneous_zero R wt β + | add p q _ _ ihp ihq => rw [map_add]; exact ihp.add ihq + | monomial d r hd => + rw [eraseFinitePart_monomial] + split_ifs + · exact isWeightedHomogeneous_zero R wt β + · exact isWeightedHomogeneous_monomial wt d r hd + +/-- The image contains no variable whose weight has constant Cantor coefficient `k`. -/ +theorem eraseFinitePart_mem_supported [Nontrivial R] (G : MvPolynomial σ R) : + eraseFinitePart wt k G ∈ supported R {i | (wt i).constantCoeff ≠ k} := by + classical + induction G using MvPolynomial.induction_on with + | C r => rw [← algebraMap_eq, AlgHom.commutes]; exact Subalgebra.algebraMap_mem _ r + | add p q hp hq => rw [map_add]; exact add_mem hp hq + | mul_X p i ih => + rw [map_mul, eraseFinitePart_X] + split_ifs with hi + · rw [mul_zero]; exact zero_mem _ + · exact mul_mem ih ((X_mem_supported (R := R)).mpr hi) + +variable {wt k} + +/-- Decomposition of a weighted-homogeneous polynomial using the variables whose weights have the +same positive constant Cantor coefficient as its degree. -/ +@[blueprint "lem:relation-shape" + (phase := "Algebraic and ordinal preliminaries") + (title := "Weighted Euler decomposition at the $\\omega^0$ coefficient") + (statement := /-- + Let $F$ be weighted homogeneous of degree $\delta$, and let $n>0$ be the + coefficient of $1=\omega^0$ in the Cantor normal form of $\delta$. Then + \[ + F_0+\sum_{\substack{i\in\operatorname{vars}(F)\\ + \operatorname{coeff}_{\omega^0}(\operatorname{wt}(i))=n}} + X_i\,\frac{\partial F}{\partial X_i}=F, + \] + where $F_0$ is obtained by setting precisely those variables to zero. + -/) + (proof := /-- + Expand $F$ into monomials. If a monomial contains a variable whose weight has + constant Cantor coefficient $n$, additivity of that coefficient under + Hessenberg sum shows that the variable occurs exactly once and all other + variable weights have constant Cantor coefficient zero. Otherwise the + monomial is fixed by the substitution. Summing over the monomials gives the + formula. + -/)] +theorem eraseFinitePart_add_sum_X_mul_pderiv {F : MvPolynomial σ R} {δ : NatOrdinal} + (hδ : 0 < δ.constantCoeff) (hF : IsWeightedHomogeneous wt F δ) : + eraseFinitePart wt δ.constantCoeff F + ∑ t ∈ varsOfFinitePart wt F δ, X t * pderiv t F = F := by + classical + -- naming the index set keeps the `as_sum` rewrite from reaching inside it + set T := varsOfFinitePart wt F δ with hT + conv_rhs => rw [F.as_sum] + conv_lhs => rw [F.as_sum, map_sum] + simp only [map_sum, Finset.mul_sum] + rw [Finset.sum_comm, ← Finset.sum_add_distrib] + refine Finset.sum_congr rfl fun d hd ↦ ?_ + have hwd : Finsupp.weight wt d = δ := hF (mem_support_iff.mp hd) + simp only [X_mul_pderiv_monomial, eraseFinitePart_monomial] + split_ifs with h + · obtain ⟨i, hi, hik⟩ := h + obtain ⟨hdi, hdj⟩ := Finsupp.eq_one_and_eq_zero_of_constantCoeff_eq hδ hwd hi hik + have hiT : i ∈ T := by + rw [hT] + exact mem_varsOfFinitePart_iff.mpr ⟨(mem_vars_iff_mem_support i).mpr ⟨d, hd, hi⟩, hik⟩ + rw [zero_add, Finset.sum_eq_single i] + · rw [hdi, one_smul] + · intro t ht hti + rw [hdj t hti (mem_varsOfFinitePart_iff.mp (hT ▸ ht)).2, zero_smul] + · intro hno + exact absurd hiT hno + · rw [Finset.sum_eq_zero, add_zero] + intro t ht + have hdt : d t = 0 := by + by_contra hdt + exact h ⟨t, Finsupp.mem_support_iff.mpr hdt, (mem_varsOfFinitePart_iff.mp (hT ▸ ht)).2⟩ + rw [hdt, zero_smul] + +end MvPolynomial + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartVars.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartVars.lean new file mode 100644 index 0000000000..e67c09d820 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartVars.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalDerivation + +/-! +# Variables carrying the constant Cantor coefficient of a weighted degree + +The coefficient of `1 = ω^0` in the Cantor normal form of the degree of a monomial is the sum of +the corresponding coefficients of the degrees of its variables. Thus, in a polynomial homogeneous +of degree `δ`, a variable whose degree has the same constant Cantor coefficient as `δ` carries that +coefficient on its own. + +This module collects the elementary degree facts about those variables and the finite set +`varsOfFinitePart` that contains them. + +None of it depends on where the variables are evaluated. Both the real-exponent argument and the +Cantor–Bendixson germ argument need these statements, so they are stated once here over an +arbitrary commutative ring. +-/ + +universe u v + +open scoped NatOrdinal + +public section + +namespace NatOrdinal + +/-- If `b + a = c` and `a` and `c` have the same constant Cantor coefficient, then `b` has +constant Cantor coefficient zero. -/ +theorem constantCoeff_eq_zero_of_add_eq {a b c : NatOrdinal.{u}} + (ha : a.constantCoeff = c.constantCoeff) (h : b + a = c) : b.constantCoeff = 0 := by + have hc := congrArg NatOrdinal.constantCoeff h + rw [constantCoeff_add, ha] at hc + omega + +end NatOrdinal + +namespace MvPolynomial + +variable {σ : Type u} {R : Type v} [CommRing R] {wt : σ → NatOrdinal} + +/-- The constant Cantor coefficient of the degree of a variable of a homogeneous polynomial is at +most that of the degree of the polynomial. -/ +theorem constantCoeff_wt_le_of_mem_vars {F : MvPolynomial σ R} {δ : NatOrdinal} + (hF : IsWeightedHomogeneous wt F δ) {i : σ} (hi : i ∈ F.vars) : + (wt i).constantCoeff ≤ δ.constantCoeff := by + classical + obtain ⟨d, hd, hdi⟩ := (mem_vars_iff_mem_support i).mp hi + rw [← hF (mem_support_iff.mp hd), Finsupp.constantCoeff_weight] + calc (wt i).constantCoeff ≤ d i * (wt i).constantCoeff := + Nat.le_mul_of_pos_left _ (Nat.pos_of_ne_zero (Finsupp.mem_support_iff.mp hdi)) + _ ≤ _ := Finset.single_le_sum (f := fun i ↦ d i * (wt i).constantCoeff) + (fun _ _ ↦ Nat.zero_le _) hdi + +/-- The degree of a variable `X_i` in a homogeneous polynomial of degree `δ` precedes `δ` in the +algebraic order: there is `β` with `β + wt i = δ`. -/ +theorem exists_add_wt_eq_of_mem_vars {F : MvPolynomial σ R} {δ : NatOrdinal} + (hF : IsWeightedHomogeneous wt F δ) {i : σ} (hi : i ∈ F.vars) : ∃ β, β + wt i = δ := by + classical + obtain ⟨d, hd, hdi⟩ := (mem_vars_iff_mem_support i).mp hi + exact ⟨_, (Finsupp.weight_sub_single_add (w := wt) (Finsupp.mem_support_iff.mp hdi)).trans + (hF (mem_support_iff.mp hd))⟩ + +/-- If the degree of a homogeneous polynomial has constant Cantor coefficient zero, so does the +degree of each of its variables. -/ +theorem constantCoeff_wt_eq_zero_of_mem_vars {G : MvPolynomial σ R} {lam : NatOrdinal} + (hG : IsWeightedHomogeneous wt G lam) (hlam : lam.constantCoeff = 0) {i : σ} + (hi : i ∈ G.vars) : (wt i).constantCoeff = 0 := + Nat.eq_zero_of_le_zero ((constantCoeff_wt_le_of_mem_vars hG hi).trans hlam.le) + +/-- For `F` homogeneous of degree `δ` and `β + wt t = δ`, the partial derivative `∂F/∂X_t` is +homogeneous of degree `β`. -/ +theorem isWeightedHomogeneous_pderiv_of_add_wt_eq {F : MvPolynomial σ R} {δ : NatOrdinal} + (hF : IsWeightedHomogeneous wt F δ) {t : σ} {β : NatOrdinal} (hβ : β + wt t = δ) : + IsWeightedHomogeneous wt (pderiv t F) β := + isWeightedHomogeneous_pderiv wt hF t hβ + +/-- A homogeneous polynomial of nonzero degree has zero constant coefficient. -/ +theorem coeff_zero_eq_zero_of_isWeightedHomogeneous {p : MvPolynomial σ R} {β : NatOrdinal} + (hp : IsWeightedHomogeneous wt p β) (hβ : β ≠ 0) : coeff 0 p = 0 := by + by_contra h + exact hβ ((hp h).symm.trans (map_zero _)) + +/-- A polynomial whose variable degrees have constant Cantor coefficient zero has no homogeneous +component whose degree has nonzero constant Cantor coefficient. -/ +theorem weightedHomogeneousComponent_eq_zero_of_forall_vars {G : MvPolynomial σ R} + (hG : ∀ i ∈ G.vars, (wt i).constantCoeff = 0) {β : NatOrdinal} (hβ : β.constantCoeff ≠ 0) : + weightedHomogeneousComponent wt β G = 0 := by + classical + refine weightedHomogeneousComponent_eq_zero' β G fun d hd hw ↦ hβ ?_ + rw [← hw, Finsupp.constantCoeff_weight] + exact Finset.sum_eq_zero fun i hi ↦ by + rw [hG i ((mem_vars_iff_mem_support i).mpr ⟨d, hd, hi⟩), mul_zero] + +variable (wt) in +/-- The variables of `F` whose degrees have the same constant Cantor coefficient as `δ`. -/ +noncomputable def varsOfFinitePart (F : MvPolynomial σ R) (δ : NatOrdinal) : Finset σ := + F.vars.filter fun i ↦ (wt i).constantCoeff = δ.constantCoeff + +theorem mem_varsOfFinitePart_iff {F : MvPolynomial σ R} {δ : NatOrdinal} {i : σ} : + i ∈ varsOfFinitePart wt F δ ↔ i ∈ F.vars ∧ (wt i).constantCoeff = δ.constantCoeff := by + rw [varsOfFinitePart, Finset.mem_filter] + +end MvPolynomial + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/GCDMonoid.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/GCDMonoid.lean new file mode 100644 index 0000000000..0768db534d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/GCDMonoid.lean @@ -0,0 +1,189 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.GCDMonoid.Basic +public import Mathlib.Algebra.MvPolynomial.CommRing + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +import Mathlib.Algebra.MvPolynomial.NoZeroDivisors +import Mathlib.RingTheory.Polynomial.Basic +import Mathlib.RingTheory.Polynomial.Content + +/-! +# Greatest common divisors in multivariate polynomial rings + +A polynomial ring in an arbitrary type of variables over a normalized GCD domain is a GCD +domain. Each pair of polynomials uses only finitely many variables. Mathlib's univariate +polynomial GCD structure gives a GCD in that finite-variable ring. Splitting off the remaining +variables and applying `MvPolynomial.dvd_C_iff_exists` shows that the same element remains a GCD +in the full polynomial ring. + +Gilmer and Parker (1974), Corollary 4.5 gives the classical result for an arbitrary GCD +coefficient domain. The theorem here assumes a normalized GCD structure, which is the form used +by Mathlib's univariate content theory and is sufficient for the finite-support Hahn-series ring. + +The result is stated through `Nonempty (GCDMonoid R)` because `GCDMonoid` contains a choice of +greatest common divisors rather than a proposition alone. +-/ + +public noncomputable section + +universe u v + +variable {A B : Type*} +variable [CommMonoidWithZero A] [CommMonoidWithZero B] + +private theorem existsGCD_pullback (e : A ≃* B) + (h : ∀ a b : B, ∃ c : B, ∀ d : B, d ∣ a ∧ d ∣ b ↔ d ∣ c) : + ∀ a b : A, ∃ c : A, ∀ d : A, d ∣ a ∧ d ∣ b ↔ d ∣ c := by + intro a b + obtain ⟨c, hc⟩ := h (e a) (e b) + refine ⟨e.symm c, fun d ↦ ?_⟩ + simpa only [← map_dvd_iff e, e.apply_symm_apply] using hc (e d) + +/-- The existence of greatest common divisors transfers across a multiplicative equivalence. -/ +theorem MulEquiv.nonemptyGCDMonoid (e : A ≃* B) [IsCancelMulZero A] + [Nonempty (GCDMonoid B)] : Nonempty (GCDMonoid A) := by + classical + letI : GCDMonoid B := Classical.choice inferInstance + exact ⟨gcdMonoidOfExistsGCD (existsGCD_pullback e fun a b ↦ + ⟨gcd a b, fun d ↦ (dvd_gcd_iff d a b).symm⟩)⟩ + +@[implicit_reducible] +private noncomputable def pullbackNormalizationMonoid (e : A ≃* B) + [NormalizationMonoid B] : NormalizationMonoid A where + normUnit a := Units.map e.symm.toMonoidHom (normUnit (e a)) + normUnit_zero := by simp + normUnit_mul ha hb := by + ext + simp [ha, hb] + normUnit_coe_units u := by + ext + change e.symm ↑(normUnit (↑(Units.map e.toMonoidHom u) : B) : Bˣ) = ↑u⁻¹ + rw [normUnit_coe_units] + simp + +@[implicit_reducible] +private noncomputable def pullbackNormalizedGCDMonoid (e : A ≃* B) + [IsCancelMulZero A] [NormalizedGCDMonoid B] : NormalizedGCDMonoid A := by + classical + letI : NormalizationMonoid A := pullbackNormalizationMonoid e + exact normalizedGCDMonoidOfExistsGCD (existsGCD_pullback e fun a b ↦ + ⟨gcd a b, fun d ↦ (dvd_gcd_iff d a b).symm⟩) + +namespace MvPolynomial + +variable {R : Type u} {σ : Type v} +variable [CommRing R] [IsDomain R] + +@[implicit_reducible] +private noncomputable def normalizedGCDMonoidFin [NormalizedGCDMonoid R] : + (n : ℕ) → NormalizedGCDMonoid (MvPolynomial (Fin n) R) + | 0 => pullbackNormalizedGCDMonoid (isEmptyRingEquiv R (Fin 0)).toMulEquiv + | n + 1 => by + letI : NormalizedGCDMonoid (MvPolynomial (Fin n) R) := normalizedGCDMonoidFin n + exact pullbackNormalizedGCDMonoid (finSuccEquiv R n).toMulEquiv + +@[implicit_reducible] +private noncomputable def normalizedGCDMonoidOfFinite [NormalizedGCDMonoid R] + (τ : Type v) [Finite τ] : NormalizedGCDMonoid (MvPolynomial τ R) := by + letI := Fintype.ofFinite τ + letI : NormalizedGCDMonoid (MvPolynomial (Fin (Fintype.card τ)) R) := + normalizedGCDMonoidFin (Fintype.card τ) + exact pullbackNormalizedGCDMonoid + (renameEquiv R (Fintype.equivFin τ)).toMulEquiv + +private noncomputable def adjoiningVariablesEquiv (S : Set σ) : + MvPolynomial (↥(Sᶜ : Set σ)) (MvPolynomial S R) ≃ₐ[R] MvPolynomial σ R := by + classical + exact (sumAlgEquiv R (↥(Sᶜ : Set σ)) S).symm.trans + (renameEquiv R + ((Equiv.sumComm (↥(Sᶜ : Set σ)) S).trans (Equiv.Set.sumCompl S))) + +omit [IsDomain R] in +private theorem adjoiningVariablesEquiv_C (S : Set σ) (p : MvPolynomial S R) : + adjoiningVariablesEquiv S (C p) = rename ((↑) : S → σ) p := by + let eqv := adjoiningVariablesEquiv (R := R) S + have h : (rename ((↑) : S → σ)).toRingHom = + eqv.toAlgHom.toRingHom.comp C := by + apply ringHom_ext + · intro r + simp [eqv, adjoiningVariablesEquiv] + · intro i + simp [eqv, adjoiningVariablesEquiv] + exact (DFunLike.congr_fun h p).symm + +private theorem existsGCD [NormalizedGCDMonoid R] (a b : MvPolynomial σ R) : + ∃ c : MvPolynomial σ R, ∀ d : MvPolynomial σ R, d ∣ a ∧ d ∣ b ↔ d ∣ c := by + classical + obtain ⟨s, p, q, rfl, rfl⟩ := exists_finset_rename₂ a b + letI : NormalizedGCDMonoid (MvPolynomial s R) := normalizedGCDMonoidOfFinite s + let S : Set σ := s + let E := adjoiningVariablesEquiv (R := R) S + have hrename (f : MvPolynomial s R) : E (C f) = rename ((↑) : s → σ) f := + adjoiningVariablesEquiv_C S f + refine ⟨rename ((↑) : s → σ) (gcd p q), fun e ↦ ?_⟩ + constructor + · rintro ⟨hep, heq⟩ + by_cases hp : p = 0 + · by_cases hq : q = 0 + · subst p + subst q + simp + · have heq' : E.symm e ∣ C q := by + rw [← map_dvd_iff E, E.apply_symm_apply, hrename q] + exact heq + obtain ⟨c, hcq, hec⟩ := (dvd_C_iff_exists hq).mp heq' + have hcp : c ∣ p := by simp [hp] + have hcd : c ∣ gcd p q := dvd_gcd hcp hcq + rw [← hrename (gcd p q), ← E.apply_symm_apply e, map_dvd_iff E, hec] + exact map_dvd C hcd + · have hep' : E.symm e ∣ C p := by + rw [← map_dvd_iff E, E.apply_symm_apply, hrename p] + exact hep + obtain ⟨c, hcp, hec⟩ := (dvd_C_iff_exists hp).mp hep' + have heq' : E.symm e ∣ C q := by + rw [← map_dvd_iff E, E.apply_symm_apply, hrename q] + exact heq + rw [hec] at heq' + have hcq : c ∣ q := by + rw [C_dvd_iff_dvd_coeff] at heq' + simpa using heq' 0 + have hcd : c ∣ gcd p q := dvd_gcd hcp hcq + rw [← hrename (gcd p q), ← E.apply_symm_apply e, map_dvd_iff E, hec] + exact map_dvd C hcd + · intro he + exact ⟨he.trans (map_dvd (rename ((↑) : s → σ)) (gcd_dvd_left p q)), + he.trans (map_dvd (rename ((↑) : s → σ)) (gcd_dvd_right p q))⟩ + +/-- A polynomial ring in an arbitrary type of variables over a normalized GCD domain has +greatest common divisors. -/ +@[blueprint "lem:multivariate-polynomial-gcd" + (phase := "Algebraic and ordinal preliminaries") + (title := "Greatest common divisors in multivariate polynomial rings") + (statement := /-- + Let $R$ be a commutative domain admitting a normalized GCD structure, and + let $I$ be any type. Then $R[X_i:i\in I]$ admits greatest common divisors. + -/) + (proof := /-- + A pair of polynomials involves only finitely many variables. Regard their + finite-variable ring as an iterated univariate polynomial ring and choose a + greatest common divisor there. View the full ring as the polynomial ring in + the complementary variables over this finite-variable ring. If at least one + of the original polynomials is non-zero, a common divisor of their constant + images is associated to a constant polynomial; its coefficient divides both + finite-variable polynomials and hence their greatest common divisor. The + case where both polynomials vanish is immediate. Thus the finite-variable + greatest common divisor remains one in the full polynomial ring. + -/)] +theorem nonemptyGCDMonoid [Nonempty (NormalizedGCDMonoid R)] : + Nonempty (GCDMonoid (MvPolynomial σ R)) := by + classical + letI : NormalizedGCDMonoid R := Classical.choice inferInstance + exact ⟨gcdMonoidOfExistsGCD existsGCD⟩ + +end MvPolynomial diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/LimitOrdinalContradiction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/LimitOrdinalContradiction.lean new file mode 100644 index 0000000000..a862f3fe9d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/LimitOrdinalContradiction.lean @@ -0,0 +1,625 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.RemainderBound +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.MapWeight +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Split +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.PairBounds + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# The contradiction when the degree is a limit ordinal + +The limit step of the injectivity induction ends in a purely polynomial argument, and this file +isolates it from the analysis that supplies its hypotheses. + +Fix ordinal degrees `wt` for the variables, a cutoff exponent `β`, and write `a_{<β}` for the part +of `a` below `ω^β` (Lean `NatOrdinal.partLT β a`). Let `F` be homogeneous of degree `α`, let `B₀` +be a variable occurring in `F` to degree at most one with `(wt B₀)_{<β} = α_{<β}`, and set +`H := ∂F/∂X_{B₀}`. + +Then every variable of `H` has vanishing part below `ω^β` +(`partLT_eq_zero_of_mem_vars_pderiv`), because the parts below `ω^β` of a monomial of `F` add up +to `α_{<β}`, all of which is already used by the single occurrence of `X_{B₀}`. In characteristic +zero this makes the classification of variables by their parts below `ω^β` cut `H` off from every +variable with a nonzero part: `pderiv_eq_zero_of_partLT_ne_zero`. + +The contradiction (`false_of_pderiv_eq_sum_of_partLT_ne_zero`) follows: some variable `B'` of `H` +has `∂H/∂X_{B'} ≠ 0`, and `B'` has vanishing part below `ω^β`. Hence +`0 + lam₀ = lam₀`, so the assumed derivative identity applies at `B'`. It writes +`∂F/∂X_{B'} = ∑_B (∂F/∂X_B) U_B` over variables `B` with nonzero part below `ω^β` and with +`∂U_B/∂X_{B₀} = 0`. Differentiating in `X_{B₀}` sends the left side to `∂H/∂X_{B'}` and kills +every summand on the right. +-/ + +universe u v + +open scoped NatOrdinal + +public noncomputable section + +namespace MvPolynomial + +variable {σ : Type u} {R : Type v} [CommRing R] {wt : σ → NatOrdinal} + +/-- **Variables of `∂F/∂X_{B₀}` have vanishing part below `ω^β`.** In every monomial of a +homogeneous `F` the parts below `ω^β` add up to `α_{<β}`; if `X_{B₀}` occurs to degree at most one +and already accounts for all of `α_{<β}`, no other variable of the monomial can contribute. -/ +theorem partLT_eq_zero_of_mem_vars_pderiv {β α : NatOrdinal} {F : MvPolynomial σ R} {B₀ : σ} + (hF : IsWeightedHomogeneous wt F α) (hdeg : degreeOf B₀ F ≤ 1) + (hB₀ : NatOrdinal.partLT β (wt B₀) = NatOrdinal.partLT β α) + {i : σ} (hi : i ∈ (pderiv B₀ F).vars) : NatOrdinal.partLT β (wt i) = 0 := by + classical + obtain ⟨d', hd', hid'⟩ := (mem_vars_iff_mem_support i).mp hi + obtain ⟨d, hd, hdv, rfl⟩ := exists_mem_support_of_mem_support_pderiv hd' + have hd1 : d B₀ = 1 := + le_antisymm ((monomial_le_degreeOf B₀ hd).trans hdeg) (Nat.one_le_iff_ne_zero.mpr hdv) + -- `X_{B₀}` occurs exactly once, so it is gone from the monomial of the derivative + have hi0 : i ≠ B₀ := by + rintro rfl + rw [Finsupp.mem_support_iff, Finsupp.tsub_apply, Finsupp.single_eq_same, hd1] at hid' + exact hid' rfl + have hid : i ∈ d.support := by + rw [Finsupp.mem_support_iff] at hid' ⊢ + rw [Finsupp.tsub_apply, Finsupp.single_apply, if_neg hi0.symm, Nat.sub_zero] at hid' + exact hid' + -- the parts below `ω^β` of the monomial add up to `α_{<β}` + have hsum : ∑ j ∈ d.support, d j • NatOrdinal.partLT β (wt j) = NatOrdinal.partLT β α := by + simpa [Finsupp.weight_apply, Finsupp.sum] using + (hF.map_weight (NatOrdinal.partLTAddMonoidHom β) (mem_support_iff.mp hd)) + -- and `X_{B₀}` alone already accounts for all of it + have hB₀d : B₀ ∈ d.support := Finsupp.mem_support_iff.mpr hdv + rw [← Finset.add_sum_erase _ _ hB₀d, hd1, one_smul, hB₀] at hsum + have hrest : ∑ j ∈ d.support.erase B₀, d j • NatOrdinal.partLT β (wt j) = 0 := + add_eq_left.mp hsum + rw [Finset.sum_eq_zero_iff_of_nonneg fun j _ ↦ zero_le (a := _)] at hrest + rcases smul_eq_zero.mp (hrest i (Finset.mem_erase.mpr ⟨hi0, hid⟩)) with h | h + · exact absurd h (Finsupp.mem_support_iff.mp hid) + · exact h + +/-- **The parts below `ω^β` of a monomial's factors add up.** In a monomial of a homogeneous +polynomial that contains two named variables once each, the part below `ω^β` of the rest of the +monomial, together with the parts of those two variables, is the part below `ω^β` of the +polynomial's degree. -/ +theorem partLT_weight_add_partLT_add_partLT {β α : NatOrdinal} {F : MvPolynomial σ R} + (hF : IsWeightedHomogeneous wt F α) {d : σ →₀ ℕ} {i u : σ} + (hd : d + Finsupp.single i 1 + Finsupp.single u 1 ∈ F.support) : + NatOrdinal.partLT β (Finsupp.weight wt d) + NatOrdinal.partLT β (wt i) + + NatOrdinal.partLT β (wt u) = NatOrdinal.partLT β α := by + have hw : NatOrdinal.partLT β (Finsupp.weight wt + (d + Finsupp.single i 1 + Finsupp.single u 1)) = NatOrdinal.partLT β α := + congrArg _ (hF (mem_support_iff.mp hd)) + rw [← hw, map_add, map_add, Finsupp.weight_single, Finsupp.weight_single, one_smul, one_smul, + NatOrdinal.partLT_add, NatOrdinal.partLT_add] + +/-- Both named variables of a decomposed monomial occur in it. -/ +theorem mem_support_of_eq_add_single_add_single {d m : σ →₀ ℕ} {i u : σ} + (h : m = d + Finsupp.single i 1 + Finsupp.single u 1) : + i ∈ m.support ∧ u ∈ m.support := by + classical + constructor <;> rw [Finsupp.mem_support_iff, h] <;> + simp only [Finsupp.add_apply, Finsupp.single_eq_same, Finsupp.single_apply] <;> omega + +/-- The rest of a decomposed monomial is determined by the monomial and the two variables. -/ +theorem eq_of_eq_add_single_add_single {d d' m : σ →₀ ℕ} {i u : σ} + (h : m = d + Finsupp.single i 1 + Finsupp.single u 1) + (h' : m = d' + Finsupp.single i 1 + Finsupp.single u 1) : d' = d := + add_right_cancel (add_right_cancel (h'.symm.trans h)) + +/-- **The pair bound from the two-truncation remainder bound.** If every term of the expansion of a +monomial of `F` with at least two truncated factors has degree below `α_{≥β} ⊕ λ`, then lowering +the parts below `ω^β` of two variables of a monomial keeps the sum of those parts, together with +the part of the rest of the monomial, at or below `λ`. + +Truncating exactly those two factors exhibits such a term, and its part at or above `ω^β` is +already `α_{≥β}`, so the bound falls entirely on the parts below. -/ +theorem pair_bound_of_forall_termDegree_lt {β α lam : NatOrdinal} + {F : MvPolynomial σ R} (hF : IsWeightedHomogeneous wt F α) + (hlam : lam < NatOrdinal.partLT β α) + (hrem : ∀ d ∈ F.support, ∀ (k : ℕ) (ρ : NatOrdinal), 2 ≤ k → TermDegree wt d k ρ → + ρ < NatOrdinal.partGE β α + lam) + {d : σ →₀ ℕ} {i j : σ} + (hd : d + Finsupp.single i 1 + Finsupp.single j 1 ∈ F.support) + {ρᵢ ρⱼ : NatOrdinal} (hρᵢ : ρᵢ < NatOrdinal.partLT β (wt i)) + (hρⱼ : ρⱼ < NatOrdinal.partLT β (wt j)) : + NatOrdinal.partLT β (Finsupp.weight wt d) + ρᵢ + ρⱼ ≤ lam := by + have hlamβ : lam < ω^ β := hlam.trans (NatOrdinal.partLT_lt _ _) + have hzeroGE : ∀ a : NatOrdinal, NatOrdinal.partLT β (NatOrdinal.partGE β a) = 0 := fun _ ↦ + NatOrdinal.partLT_eq_zero_of_forall_le + fun _ hs ↦ NatOrdinal.wpow_le_of_mem_additivePrincipalTerms_partGE hs + have hGE : NatOrdinal.partGE β (NatOrdinal.partGE β α + lam) = NatOrdinal.partGE β α := by + rw [NatOrdinal.partGE_add, NatOrdinal.partGE_partGE, + NatOrdinal.partGE_eq_zero_of_lt hlamβ, add_zero] + have hLT : NatOrdinal.partLT β (NatOrdinal.partGE β α + lam) = lam := by + rw [NatOrdinal.partLT_add, NatOrdinal.partLT_eq_self_of_lt hlamβ, hzeroGE, zero_add] + -- truncating exactly the two factors exhibits a term of the expansion + have hρᵢ' : NatOrdinal.partGE β (wt i) + ρᵢ < wt i := by + conv_rhs => rw [← NatOrdinal.partGE_add_partLT β (wt i)] + exact add_lt_add_of_le_of_lt le_rfl hρᵢ + have hρⱼ' : NatOrdinal.partGE β (wt j) + ρⱼ < wt j := by + conv_rhs => rw [← NatOrdinal.partGE_add_partLT β (wt j)] + exact add_lt_add_of_le_of_lt le_rfl hρⱼ + have hlt := hrem _ hd 2 _ le_rfl (termDegree_pair (wt := wt) d hρᵢ' hρⱼ') + set ρ := Finsupp.weight wt d + (NatOrdinal.partGE β (wt i) + ρᵢ) + + (NatOrdinal.partGE β (wt j) + ρⱼ) with hρdef + have hρᵢβ : ρᵢ < ω^ β := hρᵢ.trans (NatOrdinal.partLT_lt β _) + have hρⱼβ : ρⱼ < ω^ β := hρⱼ.trans (NatOrdinal.partLT_lt β _) + -- its part at or above `ω^β` is already the whole of `α_{≥β}` + have hhigh : NatOrdinal.partGE β ρ = NatOrdinal.partGE β (NatOrdinal.partGE β α + lam) := by + have hα : NatOrdinal.partGE β α = NatOrdinal.partGE β + (Finsupp.weight wt (d + Finsupp.single i 1 + Finsupp.single j 1)) := + congrArg _ (hF (mem_support_iff.mp hd)).symm + rw [hGE, hα, hρdef, map_add, map_add, Finsupp.weight_single, Finsupp.weight_single, + one_smul, one_smul] + simp only [NatOrdinal.partGE_add, NatOrdinal.partGE_partGE, + NatOrdinal.partGE_eq_zero_of_lt hρᵢβ, NatOrdinal.partGE_eq_zero_of_lt hρⱼβ, add_zero] + have hlow := NatOrdinal.partLT_lt_of_lt_of_partGE_eq hlt hhigh + rw [hLT, hρdef] at hlow + simp only [NatOrdinal.partLT_add, NatOrdinal.partLT_eq_self_of_lt hρᵢβ, + NatOrdinal.partLT_eq_self_of_lt hρⱼβ, hzeroGE, zero_add] at hlow + exact hlow.le + +/-- **The pair bound from a bound on the parts below the cutoff.** The same conclusion from the +form the term-degree analysis actually delivers: a bound on the part below the cutoff of every +term with at least two truncated factors that keeps the whole part above it. -/ +theorem pair_bound_of_forall_partLT_le {β α lam : NatOrdinal} + {F : MvPolynomial σ R} (hF : IsWeightedHomogeneous wt F α) + (hrem : ∀ d ∈ F.support, ∀ (k : ℕ) (ρ : NatOrdinal), 2 ≤ k → TermDegree wt d k ρ → + NatOrdinal.partGE β ρ = NatOrdinal.partGE β α → NatOrdinal.partLT β ρ ≤ lam) + {d : σ →₀ ℕ} {i j : σ} + (hd : d + Finsupp.single i 1 + Finsupp.single j 1 ∈ F.support) + {ρᵢ ρⱼ : NatOrdinal} (hρᵢ : ρᵢ < NatOrdinal.partLT β (wt i)) + (hρⱼ : ρⱼ < NatOrdinal.partLT β (wt j)) : + NatOrdinal.partLT β (Finsupp.weight wt d) + ρᵢ + ρⱼ ≤ lam := by + have hzeroGE : ∀ a : NatOrdinal, NatOrdinal.partLT β (NatOrdinal.partGE β a) = 0 := fun _ ↦ + NatOrdinal.partLT_eq_zero_of_forall_le + fun _ hs ↦ NatOrdinal.wpow_le_of_mem_additivePrincipalTerms_partGE hs + have hρᵢ' : NatOrdinal.partGE β (wt i) + ρᵢ < wt i := by + conv_rhs => rw [← NatOrdinal.partGE_add_partLT β (wt i)] + exact add_lt_add_of_le_of_lt le_rfl hρᵢ + have hρⱼ' : NatOrdinal.partGE β (wt j) + ρⱼ < wt j := by + conv_rhs => rw [← NatOrdinal.partGE_add_partLT β (wt j)] + exact add_lt_add_of_le_of_lt le_rfl hρⱼ + set ρ := Finsupp.weight wt d + (NatOrdinal.partGE β (wt i) + ρᵢ) + + (NatOrdinal.partGE β (wt j) + ρⱼ) with hρdef + have hρᵢβ : ρᵢ < ω^ β := hρᵢ.trans (NatOrdinal.partLT_lt β _) + have hρⱼβ : ρⱼ < ω^ β := hρⱼ.trans (NatOrdinal.partLT_lt β _) + have hhigh : NatOrdinal.partGE β ρ = NatOrdinal.partGE β α := by + have hα : NatOrdinal.partGE β α = NatOrdinal.partGE β + (Finsupp.weight wt (d + Finsupp.single i 1 + Finsupp.single j 1)) := + congrArg _ (hF (mem_support_iff.mp hd)).symm + rw [hα, hρdef, map_add, map_add, Finsupp.weight_single, Finsupp.weight_single, + one_smul, one_smul] + simp only [NatOrdinal.partGE_add, NatOrdinal.partGE_partGE, + NatOrdinal.partGE_eq_zero_of_lt hρᵢβ, NatOrdinal.partGE_eq_zero_of_lt hρⱼβ, add_zero] + have hlow := hrem _ hd 2 _ le_rfl (termDegree_pair (wt := wt) d hρᵢ' hρⱼ') hhigh + simp only [NatOrdinal.partLT_add, NatOrdinal.partLT_eq_self_of_lt hρᵢβ, + NatOrdinal.partLT_eq_self_of_lt hρⱼβ, hzeroGE, zero_add] at hlow + exact hlow + +/-- **The pair bound, unconditionally.** For a homogeneous polynomial whose degree has a nonzero +part below the cutoff, and whose variables with a nonzero part below it have a last Cantor term of +nonzero exponent, there is a bound strictly below the polynomial's part at the cutoff that +dominates every sum obtained by lowering the parts of two variables of a monomial. + +The term-degree analysis supplies the bound and the previous theorem consumes it, so the second +case's pair bound needs no analytic input at all -- only that its variables are of limit weight +below the cutoff. -/ +theorem exists_lt_forall_pair_bound {β α : NatOrdinal} {F : MvPolynomial σ R} + (hF : IsWeightedHomogeneous wt F α) (hμ : NatOrdinal.partLT β α ≠ 0) + (htail : ∀ i ∈ F.vars, NatOrdinal.partLT β (wt i) ≠ 0 → + ∃ e, e ≠ 0 ∧ NatOrdinal.leastTerm (NatOrdinal.partLT β (wt i)) = ω^ e) : + ∃ lam : NatOrdinal, lam < NatOrdinal.partLT β α ∧ + ∀ (d : σ →₀ ℕ) (i j : σ), + d + Finsupp.single i 1 + Finsupp.single j 1 ∈ F.support → + ∀ ρᵢ ρⱼ : NatOrdinal, ρᵢ < NatOrdinal.partLT β (wt i) → + ρⱼ < NatOrdinal.partLT β (wt j) → + NatOrdinal.partLT β (Finsupp.weight wt d) + ρᵢ + ρⱼ ≤ lam := by + obtain ⟨lam, hlam, hrem⟩ := + exists_forall_partLT_le_of_termDegree (K := R) F (fun _ hd ↦ hF (mem_support_iff.mp hd)) + hμ htail + exact ⟨lam, hlam, fun d i j hd ρᵢ ρⱼ hρᵢ hρⱼ ↦ + pair_bound_of_forall_partLT_le hF hrem hd hρᵢ hρⱼ⟩ + +/-- **A uniform pair bound over the support.** For a homogeneous polynomial whose degree has a +nonzero part below `ω^β`, one bound strictly below that part dominates every sum obtained, at any +monomial, by lowering the parts of two of its variables. + +At a single monomial the two-summand lemma supplies such a bound, the parts of the monomial's +factors adding up to the polynomial's; the monomials are finitely many and so are the pairs of +variables in each, and finitely many bounds below a common ceiling collapse to one. -/ +theorem exists_lt_forall_add_add_le_of_isWeightedHomogeneous {β α : NatOrdinal} + {F : MvPolynomial σ R} (hF : IsWeightedHomogeneous wt F α) + (hα : 0 < NatOrdinal.partLT β α) : + ∃ lam : NatOrdinal, lam < NatOrdinal.partLT β α ∧ + ∀ (d : σ →₀ ℕ) (i u : σ), + d + Finsupp.single i 1 + Finsupp.single u 1 ∈ F.support → + NatOrdinal.partLT β (wt i) ≠ 0 → NatOrdinal.partLT β (wt u) ≠ 0 → + ∀ ρ₁ ρ₂ : NatOrdinal, ρ₁ < NatOrdinal.partLT β (wt i) → + ρ₂ < NatOrdinal.partLT β (wt u) → + NatOrdinal.partLT β (Finsupp.weight wt d) + ρ₁ + ρ₂ ≤ lam := by + classical + set P : (σ →₀ ℕ) → NatOrdinal → Prop := fun m B ↦ + ∀ (d : σ →₀ ℕ) (i u : σ), m = d + Finsupp.single i 1 + Finsupp.single u 1 → + NatOrdinal.partLT β (wt i) ≠ 0 → NatOrdinal.partLT β (wt u) ≠ 0 → + ∀ ρ₁ ρ₂ : NatOrdinal, ρ₁ < NatOrdinal.partLT β (wt i) → + ρ₂ < NatOrdinal.partLT β (wt u) → + NatOrdinal.partLT β (Finsupp.weight wt d) + ρ₁ + ρ₂ ≤ B with hPdef + have hPmono : ∀ m, ∀ {B B' : NatOrdinal}, B ≤ B' → P m B → P m B' := + fun m _ _ hBB' hP d i u hd hi hu ρ₁ ρ₂ hρ₁ hρ₂ ↦ + (hP d i u hd hi hu ρ₁ ρ₂ hρ₁ hρ₂).trans hBB' + refine (NatOrdinal.exists_lt_forall_of_forall_exists_lt F.support hα P hPmono ?_).imp + fun lam hlam ↦ ⟨hlam.1, fun d i u hd hi hu ρ₁ ρ₂ hρ₁ hρ₂ ↦ + hlam.2 _ hd d i u rfl hi hu ρ₁ ρ₂ hρ₁ hρ₂⟩ + -- at each monomial, index by the pairs of its variables + intro m hm + set Q : σ × σ → NatOrdinal → Prop := fun p B ↦ + ∀ d : σ →₀ ℕ, m = d + Finsupp.single p.1 1 + Finsupp.single p.2 1 → + NatOrdinal.partLT β (wt p.1) ≠ 0 → NatOrdinal.partLT β (wt p.2) ≠ 0 → + ∀ ρ₁ ρ₂ : NatOrdinal, ρ₁ < NatOrdinal.partLT β (wt p.1) → + ρ₂ < NatOrdinal.partLT β (wt p.2) → + NatOrdinal.partLT β (Finsupp.weight wt d) + ρ₁ + ρ₂ ≤ B with hQdef + have hQmono : ∀ p, ∀ {B B' : NatOrdinal}, B ≤ B' → Q p B → Q p B' := + fun p _ _ hBB' hQ d hd hi hu ρ₁ ρ₂ hρ₁ hρ₂ ↦ (hQ d hd hi hu ρ₁ ρ₂ hρ₁ hρ₂).trans hBB' + -- at each pair, the two-summand lemma, or nothing to prove + have hQmem : ∀ p ∈ m.support ×ˢ m.support, ∃ B, B < NatOrdinal.partLT β α ∧ Q p B := by + rintro p - + by_cases hdec : ∃ d : σ →₀ ℕ, m = d + Finsupp.single p.1 1 + Finsupp.single p.2 1 + · obtain ⟨d, hdm⟩ := hdec + by_cases hi : NatOrdinal.partLT β (wt p.1) = 0 + · exact ⟨0, hα, fun _ _ hi' _ _ _ _ _ ↦ absurd hi hi'⟩ + by_cases hu : NatOrdinal.partLT β (wt p.2) = 0 + · exact ⟨0, hα, fun _ _ _ hu' _ _ _ _ ↦ absurd hu hu'⟩ + obtain ⟨e₁, he₁⟩ := NatOrdinal.exists_leastTerm_eq_wpow hi + obtain ⟨e₂, he₂⟩ := NatOrdinal.exists_leastTerm_eq_wpow hu + obtain ⟨B, hB, hall⟩ := NatOrdinal.exists_lt_forall_add_add_le + (O := NatOrdinal.partLT β (Finsupp.weight wt d)) hi hu he₁ he₂ + have hsum := partLT_weight_add_partLT_add_partLT (β := β) hF (hdm ▸ hm) + refine ⟨B, hsum ▸ hB, fun d' hd' _ _ ρ₁ ρ₂ hρ₁ hρ₂ ↦ ?_⟩ + rw [eq_of_eq_add_single_add_single hdm hd'] + exact hall ρ₁ ρ₂ hρ₁ hρ₂ + · exact ⟨0, hα, fun d hd _ _ _ _ _ _ ↦ absurd ⟨d, hd⟩ hdec⟩ + obtain ⟨B, hB, hQ⟩ := + NatOrdinal.exists_lt_forall_of_forall_exists_lt (m.support ×ˢ m.support) hα Q hQmono hQmem + refine ⟨B, hB, fun d i u hd hi hu ρ₁ ρ₂ hρ₁ hρ₂ ↦ ?_⟩ + obtain ⟨him, hum⟩ := mem_support_of_eq_add_single_add_single hd + exact hQ (i, u) (Finset.mem_product.mpr ⟨him, hum⟩) d hd hi hu ρ₁ ρ₂ hρ₁ hρ₂ + +/-- **The agreement one level up, from a pair bound.** Take two variables occurring once each in a +monomial of a homogeneous polynomial, both with nonzero part below `ω^β`. If a bound below the +polynomial's own part below `ω^β` dominates every sum obtained by lowering those two parts, and the +first variable's part does not precede the bound in the algebraic order, then the exponent of that +part's last Cantor term is below the second's, and the bound agrees with the polynomial's part at +or above the second exponent. + +Everything here except the pair bound is forced: the parts of the monomial's factors add up, and +the ordering of the exponents is what the failed algebraic-order comparison leaves. -/ +theorem partGE_eq_of_forall_add_add_le_of_not_algebraicLE {β α lam : NatOrdinal} + {F : MvPolynomial σ R} (hF : IsWeightedHomogeneous wt F α) + {d : σ →₀ ℕ} {i u : σ} (hd : d + Finsupp.single i 1 + Finsupp.single u 1 ∈ F.support) + (hti : NatOrdinal.partLT β (wt i) ≠ 0) (htu : NatOrdinal.partLT β (wt u) ≠ 0) + {ei eu : NatOrdinal} (hei : NatOrdinal.leastTerm (NatOrdinal.partLT β (wt i)) = ω^ ei) + (heu : NatOrdinal.leastTerm (NatOrdinal.partLT β (wt u)) = ω^ eu) (hei0 : ei ≠ 0) + (hlam : lam < NatOrdinal.partLT β α) + (hall : ∀ ρ₁ ρ₂ : NatOrdinal, ρ₁ < NatOrdinal.partLT β (wt i) → + ρ₂ < NatOrdinal.partLT β (wt u) → + NatOrdinal.partLT β (Finsupp.weight wt d) + ρ₁ + ρ₂ ≤ lam) + (hdiff : ¬ NatOrdinal.AlgebraicLE (NatOrdinal.partLT β (wt i)) lam) : + ei < eu ∧ NatOrdinal.partGE eu lam = NatOrdinal.partGE eu (NatOrdinal.partLT β α) := by + have hsum := partLT_weight_add_partLT_add_partLT (β := β) hF hd + rw [← hsum] + exact NatOrdinal.lt_and_partGE_eq_of_not_algebraicLE hti htu hei heu hei0 (hsum ▸ hlam) hall + hdiff + +/-- A variable with nonzero part below `ω^β` does not occur in `∂F/∂X_{B₀}`, so differentiating +`∂F/∂X_{B₀}` with respect to it gives zero. -/ +theorem pderiv_eq_zero_of_partLT_ne_zero {β α : NatOrdinal} {F : MvPolynomial σ R} {B₀ : σ} + (hF : IsWeightedHomogeneous wt F α) (hdeg : degreeOf B₀ F ≤ 1) + (hB₀ : NatOrdinal.partLT β (wt B₀) = NatOrdinal.partLT β α) + {v : σ} (hv : NatOrdinal.partLT β (wt v) ≠ 0) : + pderiv v (pderiv B₀ F) = 0 := + pderiv_eq_zero_of_notMem_vars fun hmem ↦ + hv (partLT_eq_zero_of_mem_vars_pderiv hF hdeg hB₀ hmem) + +variable [NoZeroDivisors R] [CharZero R] + +/-- Let `F` be homogeneous of degree `α`, let `B₀` occur in `F` to +degree at most one with `(wt B₀)_{<β} = α_{<β}`, and suppose `H := ∂F/∂X_{B₀}` is nonzero of +nonzero degree `δ`. Suppose that for every variable `B'` of `F` whose part below `ω^β` is a +summand of `lam₀`, in the sense that it adds to `lam₀` under Hessenberg sum, there is a relation +expressing `∂F/∂X_{B'}` as a combination of the `∂F/∂X_B` over variables `B` with nonzero part +below `ω^β`, whose cofactors are free of `X_{B₀}`. This is impossible. + +Applied at a variable `B'` of `H` with `∂H/∂X_{B'} ≠ 0` — which exists in characteristic zero, +and whose part below `ω^β` vanishes, hence adds to `lam₀` to give `lam₀` — differentiating the +relation in `X_{B₀}` turns the left side into `∂H/∂X_{B'}` and every right-hand summand into +`(∂H/∂X_B) U_B = 0`, since no `B` with nonzero part below `ω^β` is a variable of `H`. -/ +@[blueprint "lem:relation-at-limit-ordinal-partial-contradiction" + (phase := "Algebraic and ordinal preliminaries") + (title := "Partial-derivative obstruction to a linear variable") + (statement := /-- + For an ordinal $\xi$, let $\xi_{<\beta}$ be the Hessenberg sum of the + terms in its Cantor normal form whose exponents are below $\beta$. + + Let $R$ be a commutative ring of characteristic zero without zero + divisors. Give the variables $X_i$ ordinal weights $w_i$, and let + $F\in R[X_i:i\in I]$ be weighted homogeneous of degree $\alpha$. Suppose + that $X_{B_0}$ occurs in $F$ with degree at most one and + $(w_{B_0})_{<\beta}=\alpha_{<\beta}$. Put + $H=\partial_{B_0}F$, and suppose that $H\ne0$ is weighted homogeneous of + some nonzero degree $\delta$. + + Fix an ordinal $\lambda_0$. Suppose that for every variable $X_{B'}$ + occurring in $F$ such that + $(w_{B'})_{<\beta}\oplus\eta=\lambda_0$ for some ordinal $\eta$, there + are a finite set $S$ and polynomials $U_B$ satisfying + \[ + (w_B)_{<\beta}\ne0,\qquad \partial_{B_0}U_B=0\quad(B\in S), + \qquad + \partial_{B'}F=\sum_{B\in S}(\partial_BF)U_B. + \] + These hypotheses are inconsistent. + -/) + (proof := /-- + Choose a variable $X_{B'}$ occurring in the nonzero homogeneous polynomial + $H$. Its degree is nonzero, so $H$ has a nonconstant monomial and $B'$ can + be chosen with $\partial_{B'}H\ne0$. Because $X_{B_0}$ occurs at most once + and already accounts for every Cantor term below $\omega^\beta$ in the + degree of $F$, every variable of $H$ has + $(w_{B'})_{<\beta}=0$. The equation + $0\oplus\lambda_0=\lambda_0$ therefore supplies the assumed identity for + $\partial_{B'}F$. + + Differentiate this identity with respect to $X_{B_0}$. The left side is + $\partial_{B'}H\ne0$. On the right, every $U_B$ is independent of + $X_{B_0}$, while $(w_B)_{<\beta}\ne0$ prevents $X_B$ from occurring in + $H$; the Leibniz rule therefore makes every summand zero, a contradiction. + -/)] +theorem false_of_pderiv_eq_sum_of_partLT_ne_zero {β α δ lam₀ : NatOrdinal} + {F : MvPolynomial σ R} {B₀ : σ} + (hF : IsWeightedHomogeneous wt F α) (hdeg : degreeOf B₀ F ≤ 1) + (hB₀ : NatOrdinal.partLT β (wt B₀) = NatOrdinal.partLT β α) + (hH : IsWeightedHomogeneous wt (pderiv B₀ F) δ) (hH0 : pderiv B₀ F ≠ 0) (hδ : δ ≠ 0) + (hsyz : ∀ B' ∈ F.vars, NatOrdinal.AlgebraicLE (NatOrdinal.partLT β (wt B')) lam₀ → + ∃ (s : Finset σ) (U : σ → MvPolynomial σ R), + (∀ B ∈ s, NatOrdinal.partLT β (wt B) ≠ 0) ∧ (∀ B ∈ s, pderiv B₀ (U B) = 0) ∧ + pderiv B' F = ∑ B ∈ s, pderiv B F * U B) : + False := by + classical + -- a variable `B'` of `H` with `∂H/∂X_{B'} ≠ 0` + obtain ⟨d, hd⟩ := exists_coeff_ne_zero hH0 + have hdne : d ≠ 0 := by + rintro rfl + exact hδ (by rw [← hH hd, map_zero]) + obtain ⟨B', hB'd⟩ := Finsupp.support_nonempty_iff.mpr hdne + have hB'H : B' ∈ (pderiv B₀ F).vars := + (mem_vars_iff_mem_support B').mpr ⟨d, mem_support_iff.mpr hd, hB'd⟩ + -- `B'` is a variable of `F` with vanishing part below `ω^β` + have hB'F : B' ∈ F.vars := vars_pderiv_subset B₀ F hB'H + have hB'LT : NatOrdinal.partLT β (wt B') = 0 := + partLT_eq_zero_of_mem_vars_pderiv hF hdeg hB₀ hB'H + obtain ⟨s, U, hs, hU, heq⟩ := + hsyz B' hB'F (hB'LT ▸ NatOrdinal.algebraicLE_zero lam₀) + -- differentiating the relation in `X_{B₀}` kills the right side + exact pderiv_ne_zero_of_mem_vars hB'H + (pderiv_pderiv_eq_zero_of_sum_of_notMem_vars heq hU fun B hB hmem ↦ + hs B hB (partLT_eq_zero_of_mem_vars_pderiv hF hdeg hB₀ hmem)) + +/-- **The polynomials free of a variable form a subring.** The kernel of a derivation is closed +under the ring operations, since a product is annihilated as soon as both factors are. -/ +def freeOf (B₀ : σ) : Subring (MvPolynomial σ R) where + carrier := {p | pderiv B₀ p = 0} + zero_mem' := map_zero _ + one_mem' := pderiv_one + add_mem' hp hq := by + rw [Set.mem_setOf_eq, map_add, hp, hq, add_zero] + neg_mem' hp := by + rw [Set.mem_setOf_eq, map_neg, hp, neg_zero] + mul_mem' hp hq := by + rw [Set.mem_setOf_eq, pderiv_mul, hp, hq, zero_mul, mul_zero, add_zero] + +omit [NoZeroDivisors R] [CharZero R] in +@[simp] +theorem mem_freeOf {B₀ : σ} {p : MvPolynomial σ R} : p ∈ freeOf B₀ ↔ pderiv B₀ p = 0 := + Iff.rfl + +omit [NoZeroDivisors R] [CharZero R] in +/-- A polynomial all of whose monomials weigh less than a variable does not involve it. -/ +theorem pderiv_eq_zero_of_forall_weight_lt {P : MvPolynomial σ R} {g : NatOrdinal} + (hP : ∀ d ∈ P.support, Finsupp.weight wt d < g) {v : σ} (hg : g ≤ wt v) : + pderiv v P = 0 := by + by_contra h + obtain ⟨d', hd'⟩ := support_nonempty.mpr h + obtain ⟨d, hd, hw⟩ := exists_add_eq_weight_of_mem_support_pderiv wt hd' + have h1 := hP d hd + rw [← hw] at h1 + exact absurd (hg.trans (le_add_of_nonneg_left zero_le)) (not_le.mpr h1) + +omit [NoZeroDivisors R] [CharZero R] in +/-- A homogeneous polynomial lighter than a variable is free of it. -/ +theorem mem_freeOf_of_isWeightedHomogeneous {c : MvPolynomial σ R} {b : NatOrdinal} + (hc : IsWeightedHomogeneous wt c b) {B₀ : σ} (hb : b < wt B₀) : c ∈ freeOf (R := R) B₀ := + mem_freeOf.mpr (pderiv_eq_zero_of_forall_weight_lt (g := wt B₀) + (fun d hd ↦ by rw [hc (mem_support_iff.mp hd)]; exact hb) le_rfl) + +omit [NoZeroDivisors R] [CharZero R] in +/-- **A combination with cofactors free of a variable lies in the span over them.** This is the +bridge from the identity the syzygy produces to the membership the propagation consumes. -/ +theorem mem_span_of_eq_sum_mul {B₀ : σ} {Θ : MvPolynomial σ R} {κ' : Type*} [Fintype κ'] + {c Q : κ' → MvPolynomial σ R} (hc : ∀ j, c j ∈ freeOf (R := R) B₀) + (heq : Θ = ∑ j, c j * Q j) : + Θ ∈ Submodule.span (freeOf (R := R) B₀) (Set.range Q) := by + rw [heq] + exact Submodule.sum_mem _ fun j _ ↦ + Submodule.smul_mem _ (⟨c j, hc j⟩ : freeOf (R := R) B₀) (Submodule.subset_span ⟨j, rfl⟩) + +/-- The partial derivatives of `F` at the variables heavier than a given one. -/ +def higherPartials (F : MvPolynomial σ R) (wt : σ → NatOrdinal) (v : σ) : + Set (MvPolynomial σ R) := + (fun j ↦ pderiv j F) '' {j | j ∈ F.vars ∧ wt v < wt j} + +omit [NoZeroDivisors R] [CharZero R] in +/-- **Propagation to the variables that do not step further.** If at every variable satisfying a +predicate the partial derivative of `F` is a combination, over the polynomials free of `X_{B₀}`, of +the partial derivatives at heavier variables, then it is such a combination of the partial +derivatives at heavier variables that fail the predicate. + +Each step replaces a generator that satisfies the predicate by generators strictly heavier than it, +and the variables of `F` heavier than a given one shrink strictly with every step, so the process +terminates. -/ +theorem pderiv_mem_span_of_forall_mem_span_higher (B₀ : σ) + (wt : σ → NatOrdinal) {F : MvPolynomial σ R} (Good : σ → Prop) + (hstep : ∀ v ∈ F.vars, Good v → + pderiv v F ∈ Submodule.span (freeOf (R := R) B₀) (higherPartials F wt v)) + {v' : σ} (hv' : v' ∈ F.vars) (hg : Good v') : + pderiv v' F ∈ Submodule.span (freeOf (R := R) B₀) + ((fun j ↦ pderiv j F) '' {j | j ∈ F.vars ∧ ¬ Good j ∧ wt v' < wt j}) := by + classical + suffices H : ∀ n : ℕ, ∀ v' ∈ F.vars, (F.vars.filter fun v ↦ wt v' < wt v).card = n → Good v' → + pderiv v' F ∈ Submodule.span (freeOf (R := R) B₀) + ((fun j ↦ pderiv j F) '' {j | j ∈ F.vars ∧ ¬ Good j ∧ wt v' < wt j}) from + H _ v' hv' rfl hg + intro n + induction n using Nat.strong_induction_on with + | _ n ih => + intro v' hv' hn hgood + refine Submodule.span_le.mpr ?_ (hstep v' hv' hgood) + rintro _ ⟨j, ⟨hjv, hjwt⟩, rfl⟩ + by_cases hj : Good j + · -- a generator that steps further is replaced by strictly heavier ones + have hsub : F.vars.filter (fun v ↦ wt j < wt v) ⊂ F.vars.filter fun v ↦ wt v' < wt v := by + refine Finset.ssubset_iff_of_subset (fun k hk ↦ ?_) |>.mpr ⟨j, ?_, ?_⟩ + · rw [Finset.mem_filter] at hk ⊢ + exact ⟨hk.1, hjwt.trans hk.2⟩ + · exact Finset.mem_filter.mpr ⟨hjv, hjwt⟩ + · rw [Finset.mem_filter] + exact fun h ↦ absurd h.2 (lt_irrefl _) + have hcard := Finset.card_lt_card hsub + rw [hn] at hcard + refine Submodule.span_le.mpr ?_ (ih _ hcard j hjv rfl hj) + rintro _ ⟨k, ⟨hkv, hkg, hkwt⟩, rfl⟩ + exact Submodule.subset_span ⟨k, ⟨hkv, hkg, hjwt.trans hkwt⟩, rfl⟩ + · exact Submodule.subset_span ⟨j, ⟨hjv, hj, hjwt⟩, rfl⟩ + +omit [NoZeroDivisors R] [CharZero R] in +/-- Differentiating at a variable is linear over the polynomials free of that variable, since a +factor it annihilates passes through the Leibniz rule. -/ +theorem pderiv_smul_freeOf (B₀ : σ) (r : freeOf (R := R) B₀) (p : MvPolynomial σ R) : + pderiv B₀ (r • p) = r • pderiv B₀ p := by + have hsmul : ∀ q : MvPolynomial σ R, r • q = (r : MvPolynomial σ R) * q := fun _ ↦ rfl + rw [hsmul, hsmul, pderiv_mul, mem_freeOf.mp r.2, zero_mul, zero_add] + +/-- Differentiating at a variable, as a map linear over the polynomials free of it. -/ +@[expose] +def pderivFreeOf (B₀ : σ) : + MvPolynomial σ R →ₗ[freeOf (R := R) B₀] MvPolynomial σ R where + toFun := pderiv B₀ + map_add' _ _ := map_add _ _ _ + map_smul' := pderiv_smul_freeOf B₀ + +omit [NoZeroDivisors R] [CharZero R] in +@[simp] +theorem pderivFreeOf_apply (B₀ : σ) (p : MvPolynomial σ R) : + pderivFreeOf (R := R) B₀ p = pderiv B₀ p := + rfl + +omit [NoZeroDivisors R] [CharZero R] in +/-- **The differentiated syzygy contradiction, in span form.** If a partial derivative of `F` lies +in the span, over the polynomials free of `X_{B₀}`, of the partial derivatives at a set of +variables none of which occurs in `∂F/∂X_{B₀}`, then that partial derivative of `F` is annihilated +by the distinguished variable. + +Differentiating at `B₀` is linear over that subring, so it carries the span to the span of the +differentiated generators, and each of those vanishes. -/ +theorem pderiv_pderiv_eq_zero_of_mem_span (B₀ : σ) {F : MvPolynomial σ R} {B' : σ} {S : Set σ} + (hmem : pderiv B' F ∈ + Submodule.span (freeOf (R := R) B₀) ((fun j ↦ pderiv j F) '' S)) + (hvars : ∀ j ∈ S, j ∉ (pderiv B₀ F).vars) : + pderiv B' (pderiv B₀ F) = 0 := by + have hker : ∀ q ∈ (fun j ↦ pderiv j F) '' S, pderivFreeOf (R := R) B₀ q = 0 := by + rintro _ ⟨j, hj, rfl⟩ + rw [pderivFreeOf_apply, pderiv_pderiv_comm, pderiv_eq_zero_of_notMem_vars (hvars j hj)] + have hzero : pderivFreeOf (R := R) B₀ (pderiv B' F) = 0 := by + refine Submodule.span_induction (p := fun q _ ↦ pderivFreeOf (R := R) B₀ q = 0) hker ?_ ?_ ?_ + hmem + · exact map_zero _ + · intro a b _ _ ha hb + rw [map_add, ha, hb, add_zero] + · intro a b _ hb + rw [map_smul, hb, smul_zero] + rwa [pderivFreeOf_apply, pderiv_pderiv_comm] at hzero + +/-- **The limit contradiction from a step at every light variable.** Suppose that at every variable +of `F` whose part below `ω^β` vanishes, the partial derivative of `F` is a combination, over the +polynomials free of `X_{B₀}`, of the partial derivatives at heavier variables. With `B₀` occurring +to degree at most one and carrying all of `α_{<β}`, and `H := ∂F/∂X_{B₀}` nonzero of nonzero +degree, this is impossible. + +Every variable of `H` has vanishing part below `ω^β`, so the step applies at one of them with +`∂H/∂X_{B'} ≠ 0`; propagating leaves only variables with nonzero part below `ω^β`, and none of +those occurs in `H`, so differentiating in `X_{B₀}` annihilates `H` at `B'`. -/ +theorem false_of_forall_mem_span_higher {β α δ : NatOrdinal} + {F : MvPolynomial σ R} {B₀ : σ} + (hF : IsWeightedHomogeneous wt F α) (hdeg : degreeOf B₀ F ≤ 1) + (hB₀ : NatOrdinal.partLT β (wt B₀) = NatOrdinal.partLT β α) + (hH : IsWeightedHomogeneous wt (pderiv B₀ F) δ) (hH0 : pderiv B₀ F ≠ 0) (hδ : δ ≠ 0) + (hstep : ∀ v ∈ F.vars, NatOrdinal.partLT β (wt v) = 0 → + pderiv v F ∈ Submodule.span (freeOf (R := R) B₀) (higherPartials F wt v)) : + False := by + classical + -- a variable `B'` of `H` with `∂H/∂X_{B'} ≠ 0` + obtain ⟨d, hd⟩ := exists_coeff_ne_zero hH0 + have hdne : d ≠ 0 := by + rintro rfl + exact hδ (by rw [← hH hd, map_zero]) + obtain ⟨B', hB'd⟩ := Finsupp.support_nonempty_iff.mpr hdne + have hB'H : B' ∈ (pderiv B₀ F).vars := + (mem_vars_iff_mem_support B').mpr ⟨d, mem_support_iff.mpr hd, hB'd⟩ + have hB'F : B' ∈ F.vars := vars_pderiv_subset B₀ F hB'H + have hB'LT : NatOrdinal.partLT β (wt B') = 0 := + partLT_eq_zero_of_mem_vars_pderiv hF hdeg hB₀ hB'H + -- propagating leaves only variables with nonzero part below `ω^β` + have hspan := pderiv_mem_span_of_forall_mem_span_higher B₀ wt + (fun v ↦ NatOrdinal.partLT β (wt v) = 0) hstep hB'F hB'LT + exact pderiv_ne_zero_of_mem_vars hB'H + (pderiv_pderiv_eq_zero_of_mem_span B₀ hspan fun j hj hmem ↦ + hj.2.1 (partLT_eq_zero_of_mem_vars_pderiv hF hdeg hB₀ hmem)) + +omit [NoZeroDivisors R] [CharZero R] in +/-- **The step at a light variable, from a syzygy identity.** If the partial derivative at a +variable is a combination of the partial derivatives at heavier variables, with cofactors +homogeneous of the complementary degrees, then it lies in the span of those partial derivatives +over the polynomials free of `X_{B₀}` -- provided `B₀` is of maximal weight, which makes every +cofactor lighter than it and so free of it. + +This is the join between the analysis, which delivers an identity with graded cofactors, and the +propagation, which consumes a span membership. -/ +theorem mem_span_higherPartials_of_eq_sum_mul {B₀ : σ} {F : MvPolynomial σ R} + {v : σ} {κ' : Type*} [Fintype κ'] {c : κ' → MvPolynomial σ R} {g : κ' → σ} + (hg : ∀ j, g j ∈ F.vars ∧ wt v < wt (g j)) + (hmax : ∀ i ∈ F.vars, wt i ≤ wt B₀) (hv : 0 < wt v) + (hchom : ∀ j, ∃ b, b + wt v = wt (g j) ∧ IsWeightedHomogeneous wt (c j) b) + (heq : pderiv v F = ∑ j, c j * pderiv (g j) F) : + pderiv v F ∈ Submodule.span (freeOf (R := R) B₀) (higherPartials F wt v) := by + classical + have hfree : ∀ j, c j ∈ freeOf (R := R) B₀ := by + intro j + obtain ⟨b, hb, hbhom⟩ := hchom j + refine mem_freeOf_of_isWeightedHomogeneous hbhom ?_ + have h1 : b < wt (g j) := by + rw [← hb] + exact lt_add_of_pos_right _ hv + exact h1.trans_le (hmax _ (hg j).1) + have hspan := mem_span_of_eq_sum_mul (B₀ := B₀) (Q := fun j ↦ pderiv (g j) F) hfree heq + refine Submodule.span_le.mpr ?_ hspan + rintro _ ⟨j, rfl⟩ + exact Submodule.subset_span ⟨g j, ⟨(hg j).1, (hg j).2⟩, rfl⟩ + +end MvPolynomial + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/MapWeight.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/MapWeight.lean new file mode 100644 index 0000000000..505d8bc1fb --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/MapWeight.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.RingTheory.MvPolynomial.WeightedHomogeneous + +/-! +# Changing the grading of a weighted homogeneous polynomial + +Weighted homogeneity is preserved when every weight and the total degree are mapped by the same +additive homomorphism. +-/ + +universe u v w + +public section + +namespace Finsupp + +variable {M : Type v} {N : Type w} [AddCommMonoid M] [AddCommMonoid N] {σ : Type*} + +/-- Applying an additive homomorphism to every weight applies it to the weight of the monomial. -/ +theorem weight_comp_addMonoidHom (f : M →+ N) (wt : σ → M) (d : σ →₀ ℕ) : + weight (fun i ↦ f (wt i)) d = f (weight wt d) := by + rw [weight_apply, weight_apply, sum, sum, map_sum] + exact Finset.sum_congr rfl fun i _ ↦ (f.map_nsmul (d i) (wt i)).symm + +end Finsupp + +namespace MvPolynomial + +variable {R : Type u} [CommSemiring R] {M : Type v} {N : Type w} +variable [AddCommMonoid M] [AddCommMonoid N] {σ : Type*} + +/-- Map the grading of a weighted homogeneous polynomial through an additive homomorphism. -/ +theorem IsWeightedHomogeneous.map_weight {wt : σ → M} {F : MvPolynomial σ R} {m : M} + (hF : IsWeightedHomogeneous wt F m) (f : M →+ N) : + IsWeightedHomogeneous (fun i ↦ f (wt i)) F (f m) := by + intro d hd + rw [Finsupp.weight_comp_addMonoidHom] + exact congrArg f (hF hd) + +end MvPolynomial diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/OrdinalDerivation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/OrdinalDerivation.lean new file mode 100644 index 0000000000..6e00ce5970 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/OrdinalDerivation.lean @@ -0,0 +1,414 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import Mathlib.Algebra.MvPolynomial.PDeriv +public import Mathlib.Algebra.MvPolynomial.Derivation +public import Mathlib.Algebra.MvPolynomial.Variables +public import Mathlib.RingTheory.MvPolynomial.WeightedHomogeneous +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart + +/-! +# Derivations of polynomial rings graded by ordinals + +Polynomial rings `R[X_i]` graded by `deg X_i = wt i` for ordinal degrees `wt : σ → NatOrdinal` +(Mathlib's `IsWeightedHomogeneous wt`). This file collects the degree bookkeeping for the +derivations `∂_g = ∑_i g_i ∂/∂X_i` (Lean `mkDerivation R g`) of such a ring: + +* a variable of a homogeneous polynomial has degree at most the polynomial's, and the finite part + of the degree of a monomial is the sum of the finite parts of the degrees of its variables; +* `∂/∂X_j ∘ ∂_g = ∂_{∂_j g} + ∂_g ∘ ∂/∂X_j`, and `∂_g F = ∑_{i ∈ S} g_i ∂F/∂X_i` for every finite + `S` containing the variables of `F`; +* the partial derivative `∂F/∂X_i` of a homogeneous `F` of degree `δ` is homogeneous of degree + `δ ⊖ wt i` when `wt i ≼ δ` in the algebraic order (there is `β` with + `β ⊕ wt i = δ`), and zero + otherwise; a derivation whose value on `X_i` is homogeneous of degree `wt i ⊖ 1` for `wt i` a + successor and zero otherwise sends homogeneous polynomials of degree `δ` to homogeneous + polynomials of degree `δ.removeNat 1`, which is `δ ⊖ 1` for a successor `δ`; +* Euler's identity `∑_i (wt i)_{<1} X_i ∂F/∂X_i = δ_{<1} F` for `F` homogeneous of degree `δ`, + where `α_{<1}` is the finite part of `α` (Lean `constantCoeff`, the constant term of the Cantor + normal form). +-/ + +universe u v + +open Finsupp + +public section + +namespace Finsupp + +variable {ι : Type u} (wt : ι → NatOrdinal) + +/-- The finite part of the degree of a monomial is the sum of the finite parts of the degrees of +its variables. -/ +theorem constantCoeff_weight (d : ι →₀ ℕ) : + (Finsupp.weight wt d).constantCoeff = ∑ i ∈ d.support, d i * (wt i).constantCoeff := by + classical + rw [Finsupp.weight_apply, Finsupp.sum] + induction d.support using Finset.induction_on with + | empty => simp + | insert a s ha ih => + rw [Finset.sum_insert ha, Finset.sum_insert ha, NatOrdinal.constantCoeff_add, + NatOrdinal.constantCoeff_nsmul, ih] + +/-- The degree of a monomial is at least the degree of each of its variables. -/ +theorem le_weight_of_mem_support (d : ι →₀ ℕ) {i : ι} (hi : i ∈ d.support) : + wt i ≤ Finsupp.weight wt d := by + classical + rw [Finsupp.weight_apply, Finsupp.sum] + refine le_trans ?_ (Finset.single_le_sum (fun j _ ↦ zero_le) hi) + have h1 : 1 ≤ d i := Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hi) + calc wt i = 1 • wt i := (one_nsmul _).symm + _ ≤ d i • wt i := nsmul_le_nsmul_left zero_le h1 + +end Finsupp + +namespace MvPolynomial + +variable {σ : Type u} {R : Type v} [CommRing R] (wt : σ → NatOrdinal) + +/-! ### Variables and degrees -/ + +/-- A variable of a homogeneous polynomial has degree at most the polynomial's. -/ +theorem IsWeightedHomogeneous.wt_le_of_mem_vars {p : MvPolynomial σ R} {δ : NatOrdinal} + (hp : IsWeightedHomogeneous wt p δ) {i : σ} (hi : i ∈ p.vars) : wt i ≤ δ := by + obtain ⟨d, hd, hdi⟩ := (mem_vars_iff_mem_support i).mp hi + rw [← hp (mem_support_iff.mp hd)] + exact Finsupp.le_weight_of_mem_support wt d hdi + +/-! ### Derivations -/ + +/-- A finite sum of derivations, applied. -/ +theorem _root_.Derivation.finset_sum_apply {ι : Type*} (s : Finset ι) + (D : ι → Derivation R (MvPolynomial σ R) (MvPolynomial σ R)) (p : MvPolynomial σ R) : + (∑ i ∈ s, D i) p = ∑ i ∈ s, D i p := by + classical + induction s using Finset.induction_on with + | empty => simp + | insert a s ha ih => rw [Finset.sum_insert ha, Finset.sum_insert ha, Derivation.add_apply, ih] + +/-- `∂_g F = ∑_{i ∈ S} g_i ∂F/∂X_i` for every finite set `S` of variables containing those of +`F`. -/ +theorem mkDerivation_eq_sum (g : σ → MvPolynomial σ R) {p : MvPolynomial σ R} {S : Finset σ} + (hS : ∀ i ∈ p.vars, i ∈ S) : mkDerivation R g p = ∑ i ∈ S, g i * pderiv i p := by + classical + have h : mkDerivation R g p = (∑ i ∈ S, g i • pderiv i) p := by + refine derivation_eq_of_forall_mem_vars fun i hi ↦ ?_ + rw [mkDerivation_X, Derivation.finset_sum_apply, Finset.sum_eq_single i] + · rw [Derivation.smul_apply, pderiv_X_self, smul_eq_mul, mul_one] + · intro j _ hji + rw [Derivation.smul_apply, pderiv_X_of_ne hji.symm, smul_zero] + · intro hiS + exact absurd (hS i hi) hiS + rw [h, Derivation.finset_sum_apply] + exact Finset.sum_congr rfl fun i _ ↦ by rw [Derivation.smul_apply, smul_eq_mul] + +/-- `∂/∂X_j ∘ ∂_g = ∂_{∂_j g} + ∂_g ∘ ∂/∂X_j`. -/ +theorem pderiv_mkDerivation (g : σ → MvPolynomial σ R) (j : σ) (p : MvPolynomial σ R) : + pderiv j (mkDerivation R g p) = + mkDerivation R (fun i ↦ pderiv j (g i)) p + mkDerivation R g (pderiv j p) := by + classical + induction p using MvPolynomial.induction_on with + | C r => simp [derivation_C] + | add p q hp hq => simp only [map_add, hp, hq]; abel + | mul_X p i ih => + have hc : mkDerivation R g (pderiv j (X i)) = 0 := by + by_cases hij : i = j + · subst hij; rw [pderiv_X_self, ← C_1, derivation_C] + · rw [pderiv_X_of_ne hij, map_zero] + rw [Derivation.leibniz, Derivation.leibniz, smul_eq_mul, smul_eq_mul, smul_eq_mul, smul_eq_mul, + map_add, pderiv_mul, pderiv_mul, ih, mkDerivation_X, mkDerivation_X, pderiv_mul, map_add, + Derivation.leibniz, Derivation.leibniz, hc, smul_eq_mul, smul_eq_mul, smul_eq_mul, + smul_eq_mul, mkDerivation_X] + ring + +/-- Partial derivatives commute. -/ +theorem pderiv_pderiv_comm (i j : σ) (p : MvPolynomial σ R) : + pderiv i (pderiv j p) = pderiv j (pderiv i p) := by + classical + have hX : ∀ a b k : σ, pderiv a (pderiv b (X k : MvPolynomial σ R)) = 0 := fun a b k ↦ by + rcases eq_or_ne k b with rfl | h + · rw [pderiv_X_self, pderiv_one] + · rw [pderiv_X_of_ne h, map_zero] + induction p using MvPolynomial.induction_on with + | C r => simp + | add p q hp hq => simp only [map_add, hp, hq] + | mul_X p k ih => + rw [pderiv_mul, pderiv_mul, map_add, map_add, pderiv_mul, pderiv_mul, pderiv_mul, pderiv_mul, + ih, hX, hX] + ring + +/-- The variables of a partial derivative are among those of the polynomial. -/ +theorem vars_pderiv_subset (i : σ) (p : MvPolynomial σ R) : (pderiv i p).vars ⊆ p.vars := by + classical + intro j hj + obtain ⟨d', hd', hjd'⟩ := (mem_vars_iff_mem_support j).mp hj + -- `d'` is `d - single i 1` for a monomial `d` of `p` with `d i ≠ 0` + have : d' ∈ (p.support.image fun d ↦ d - Finsupp.single i 1) := by + have hsum : pderiv i p = + ∑ d ∈ p.support, monomial (d - Finsupp.single i 1) (coeff d p * d i) := by + conv_lhs => rw [p.as_sum, map_sum] + exact Finset.sum_congr rfl fun d _ ↦ pderiv_monomial + rw [hsum] at hd' + obtain ⟨d, hd, hd'd⟩ := Finset.mem_biUnion.mp (support_sum hd') + rw [support_monomial] at hd'd + split_ifs at hd'd with h0 + · exact absurd hd'd (Finset.notMem_empty d') + · rw [Finset.mem_singleton] at hd'd + subst hd'd + exact Finset.mem_image_of_mem _ hd + obtain ⟨d, hd, rfl⟩ := Finset.mem_image.mp this + exact (mem_vars_iff_mem_support j).mpr ⟨d, hd, Finsupp.support_tsub hjd'⟩ + +/-- A monomial of `∂_i p` comes from a monomial of `p` containing `X_i`, with one occurrence of +`X_i` removed. -/ +theorem exists_mem_support_of_mem_support_pderiv {i : σ} + {p : MvPolynomial σ R} {d' : σ →₀ ℕ} (hd' : d' ∈ (pderiv i p).support) : + ∃ d ∈ p.support, d i ≠ 0 ∧ d' = d - Finsupp.single i 1 := by + classical + have hsum : pderiv i p = + ∑ d ∈ p.support, monomial (d - Finsupp.single i 1) (coeff d p * d i) := by + conv_lhs => rw [p.as_sum, map_sum] + exact Finset.sum_congr rfl fun d _ ↦ pderiv_monomial + rw [hsum] at hd' + obtain ⟨d, hd, hd'd⟩ := Finset.mem_biUnion.mp (support_sum hd') + rw [support_monomial] at hd'd + split_ifs at hd'd with h0 + · exact absurd hd'd (Finset.notMem_empty d') + · rw [Finset.mem_singleton] at hd'd + exact ⟨d, hd, fun h ↦ h0 (by rw [h, Nat.cast_zero, mul_zero]), hd'd⟩ + +/-- A monomial of `∂_i p` comes from a monomial of `p` containing `X_i`, with the degree of +`X_i` removed. -/ +theorem exists_add_eq_weight_of_mem_support_pderiv (wt : σ → NatOrdinal) {i : σ} + {p : MvPolynomial σ R} {d' : σ →₀ ℕ} (hd' : d' ∈ (pderiv i p).support) : + ∃ d ∈ p.support, Finsupp.weight wt d' + wt i = Finsupp.weight wt d := by + obtain ⟨d, hd, hdi, rfl⟩ := exists_mem_support_of_mem_support_pderiv hd' + exact ⟨d, hd, Finsupp.weight_sub_single_add (w := wt) hdi⟩ + +/-! ### Nonvanishing of partial derivatives in characteristic zero -/ + +/-- The coefficient of `d - X_v` in `∂_v p`, for a monomial `d` containing `X_v`. -/ +theorem coeff_sub_single_pderiv {v : σ} {p : MvPolynomial σ R} {d : σ →₀ ℕ} (hd : d v ≠ 0) : + coeff (d - Finsupp.single v 1) (pderiv v p) = coeff d p * (d v : R) := by + classical + have hsum : pderiv v p = + ∑ d' ∈ p.support, monomial (d' - Finsupp.single v 1) (coeff d' p * d' v) := by + conv_lhs => rw [p.as_sum, map_sum] + exact Finset.sum_congr rfl fun d' _ ↦ pderiv_monomial + rw [hsum, MvPolynomial.coeff_sum] + by_cases hdp : d ∈ p.support + · rw [Finset.sum_eq_single d] + · rw [coeff_monomial, if_pos rfl] + · intro d' _ hne + rw [coeff_monomial] + split_ifs with h + · by_cases hd'v : d' v = 0 + · rw [hd'v, Nat.cast_zero, mul_zero] + · exfalso + apply hne + have h1 := tsub_add_cancel_of_le + (Finsupp.single_le_iff.mpr (Nat.one_le_iff_ne_zero.mpr hd'v)) + have h2 := tsub_add_cancel_of_le + (Finsupp.single_le_iff.mpr (Nat.one_le_iff_ne_zero.mpr hd)) + rw [← h1, ← h2, h] + · rfl + · intro h; exact absurd hdp h + · rw [Finset.sum_eq_zero, notMem_support_iff.mp hdp, zero_mul] + intro d' hd' + rw [coeff_monomial] + split_ifs with h + · by_cases hd'v : d' v = 0 + · rw [hd'v, Nat.cast_zero, mul_zero] + · exfalso + have h1 := tsub_add_cancel_of_le + (Finsupp.single_le_iff.mpr (Nat.one_le_iff_ne_zero.mpr hd'v)) + have h2 := tsub_add_cancel_of_le (Finsupp.single_le_iff.mpr (Nat.one_le_iff_ne_zero.mpr hd)) + have : d' = d := by rw [← h1, ← h2, h] + exact hdp (this ▸ hd') + · rfl + +/-- In characteristic zero, the partial derivative with respect to a variable that occurs is +nonzero. -/ +theorem pderiv_ne_zero_of_mem_vars [NoZeroDivisors R] [CharZero R] {v : σ} + {p : MvPolynomial σ R} (hv : v ∈ p.vars) : pderiv v p ≠ 0 := by + obtain ⟨d, hd, hdv⟩ := (mem_vars_iff_mem_support v).mp hv + have hdv' : d v ≠ 0 := Finsupp.mem_support_iff.mp hdv + intro h + have := coeff_sub_single_pderiv (p := p) hdv' + rw [h, MvPolynomial.coeff_zero] at this + exact mul_ne_zero (mem_support_iff.mp hd) (Nat.cast_ne_zero.mpr hdv') this.symm + +/-! ### Homogeneity -/ + +/-- The partial derivative `∂/∂X_i` of a homogeneous polynomial of degree `δ` is homogeneous of +degree `β = δ ⊖ wt i` when `β ⊕ wt i = δ`. -/ +theorem isWeightedHomogeneous_pderiv {p : MvPolynomial σ R} {δ : NatOrdinal} + (hp : IsWeightedHomogeneous wt p δ) (i : σ) {β : NatOrdinal} (hβ : β + wt i = δ) : + IsWeightedHomogeneous wt (pderiv i p) β := by + classical + induction hp using IsWeightedHomogeneous.induction_on with + | zero => rw [map_zero]; exact isWeightedHomogeneous_zero R wt _ + | add p q _ _ ihp ihq => rw [map_add]; exact ihp.add ihq + | monomial d r hd => + rw [pderiv_monomial] + by_cases hdi : d i = 0 + · rw [hdi, Nat.cast_zero, mul_zero, monomial_zero] + exact isWeightedHomogeneous_zero R wt _ + · refine isWeightedHomogeneous_monomial wt _ _ ?_ + have h := Finsupp.weight_sub_single_add (w := wt) hdi + rw [hd] at h + exact add_right_cancel (h.trans hβ.symm) + +/-- If `p` is weighted-homogeneous of degree `δ` and `δ ≠ β + wt i` for every `β`, then the +partial derivative of `p` with respect to `X_i` vanishes. -/ +@[blueprint "lem:partial-derivative-vanishes" + (phase := "Algebraic and ordinal preliminaries") + (title := "Vanishing criterion for partial derivatives of weighted-homogeneous polynomials") + (statement := /-- + If $F$ is weighted-homogeneous of degree $\delta$ and + $\delta\ne\beta\oplus w(i)$ for every $\beta$, then $\partial_iF=0$. + -/) + (proof := /-- + Any monomial containing $X_i$ would express $\delta$ as the natural sum of + $w(i)$ and the weight left after removing one occurrence of $X_i$. + -/)] +theorem pderiv_eq_zero_of_isWeightedHomogeneous {p : MvPolynomial σ R} {δ : NatOrdinal} + (hp : IsWeightedHomogeneous wt p δ) (i : σ) (h : ¬ ∃ β, β + wt i = δ) : pderiv i p = 0 := by + classical + induction hp using IsWeightedHomogeneous.induction_on with + | zero => rw [map_zero] + | add p q _ _ ihp ihq => rw [map_add, ihp, ihq, add_zero] + | monomial d r hd => + rw [pderiv_monomial] + by_cases hdi : d i = 0 + · rw [hdi, Nat.cast_zero, mul_zero, monomial_zero] + · exact absurd ⟨_, (Finsupp.weight_sub_single_add (w := wt) hdi).trans hd⟩ h + +/-- Suppose `g i` is weighted-homogeneous of the degree obtained from `wt i` by subtracting one +from its positive constant Cantor coefficient, and is zero when that coefficient vanishes. The +derivation determined by `g` sends weight `δ` to the weight obtained by truncated subtraction of +one from the constant Cantor coefficient of `δ`. -/ +@[blueprint "lem:polynomial-vector-field-lowers-degree" + (phase := "Algebraic and ordinal preliminaries") + (title := "Weighted degree of polynomial derivations") + (statement := /-- + Suppose $g_i$ is weighted-homogeneous of the degree obtained from $w(i)$ by + subtracting one from its positive constant Cantor coefficient, and is zero + when that coefficient vanishes. If $F$ is weighted-homogeneous of degree + $\delta$, then $D_g(F)$ is weighted-homogeneous of the degree obtained by + truncated subtraction of one from the constant Cantor coefficient of + $\delta$ (so the degree remains $\delta$ when that coefficient is zero). + -/) + (proof := /-- + For a monomial, $\partial_iF$ removes $w(i)$ from the weight, while + multiplication by $g_i$ restores it with one subtracted from its constant + Cantor coefficient. Hessenberg addition therefore subtracts one from the + constant Cantor coefficient of $\delta$. Linearity handles sums. + -/)] +theorem mkDerivation_isWeightedHomogeneous_removeNat (g : σ → MvPolynomial σ R) + (hg : ∀ i, 0 < (wt i).constantCoeff → + IsWeightedHomogeneous wt (g i) ((wt i).removeNat 1)) + (hg0 : ∀ i, (wt i).constantCoeff = 0 → g i = 0) {p : MvPolynomial σ R} {δ : NatOrdinal} + (hp : IsWeightedHomogeneous wt p δ) : + IsWeightedHomogeneous wt (mkDerivation R g p) (δ.removeNat 1) := by + classical + induction hp using IsWeightedHomogeneous.induction_on with + | zero => rw [map_zero]; exact isWeightedHomogeneous_zero R wt _ + | add p q _ _ ihp ihq => rw [map_add]; exact ihp.add ihq + | monomial d r hd => + rw [mkDerivation_monomial, smul_eq_C_mul] + refine IsWeightedHomogeneous.C_mul ?_ r + unfold Finsupp.sum + refine IsWeightedHomogeneous.sum _ _ _ fun i hi ↦ ?_ + change IsWeightedHomogeneous wt (monomial (d - Finsupp.single i 1) (d i : R) • g i) _ + rw [smul_eq_mul] + by_cases hci : (wt i).constantCoeff = 0 + · rw [hg0 i hci, mul_zero] + exact isWeightedHomogeneous_zero R wt _ + · have hpos : 0 < (wt i).constantCoeff := Nat.pos_of_ne_zero hci + have hw : δ.removeNat 1 = + Finsupp.weight wt (d - Finsupp.single i 1) + (wt i).removeNat 1 := by + rw [← hd, ← Finsupp.weight_sub_single_add (w := wt) (Finsupp.mem_support_iff.mp hi), + add_comm, NatOrdinal.removeNat_add_right _ _ hpos, add_comm] + rw [hw] + exact (isWeightedHomogeneous_monomial wt _ _ rfl).mul (hg i hpos) + +/-! ### Euler's identity -/ + +/-- **Euler's identity** for constant Cantor coefficients. If `p` is weighted-homogeneous of +degree `δ` and `S` contains the variables of `p`, then +`∑ i ∈ S, (wt i).constantCoeff • (X i * pderiv i p) = δ.constantCoeff • p`. -/ +@[blueprint "lem:weighted-euler-identity" + (phase := "Algebraic and ordinal preliminaries") + (title := "Weighted Euler identity") + (statement := /-- + If $F$ is weighted-homogeneous of degree $\delta$ and $S$ is any finite + set containing its variables, then + \[ + \sum_{i\in S} n_iX_i\frac{\partial F}{\partial X_i}=nF, + \] + where $n_i$ and $n$ are the constant Cantor coefficients of $w(i)$ and + $\delta$. + -/) + (proof := /-- + On a monomial, the coefficient contributed by $X_i\partial_i$ is the + multiplicity of $X_i$. Weighted by the constant Cantor coefficient of + $w(i)$ and summed over $i$, this is the constant Cantor coefficient of the + monomial's total weight, namely $n$. Extend by linearity. + -/)] +theorem IsWeightedHomogeneous.sum_constantCoeff_X_mul_pderiv {p : MvPolynomial σ R} + {δ : NatOrdinal} (hp : IsWeightedHomogeneous wt p δ) {S : Finset σ} + (hS : ∀ i ∈ p.vars, i ∈ S) : + ∑ i ∈ S, (wt i).constantCoeff • (X i * pderiv i p) = δ.constantCoeff • p := by + classical + conv_lhs => rw [p.as_sum] + conv_rhs => rw [p.as_sum] + simp only [map_sum, Finset.mul_sum, Finset.smul_sum] + rw [Finset.sum_comm] + refine Finset.sum_congr rfl fun d hd ↦ ?_ + have hdsupp : ∀ i ∈ d.support, i ∈ S := fun i hi ↦ + hS i ((mem_vars_iff_mem_support i).mpr ⟨d, hd, hi⟩) + have hδ : δ.constantCoeff = ∑ i ∈ S, (wt i).constantCoeff * d i := by + rw [← hp (mem_support_iff.mp hd), Finsupp.constantCoeff_weight] + rw [← Finset.sum_subset (fun i hi ↦ hdsupp i hi) fun i _ hi ↦ by + rw [Finsupp.notMem_support_iff.mp hi, mul_zero]] + exact Finset.sum_congr rfl fun i _ ↦ mul_comm _ _ + rw [hδ, Finset.sum_smul] + refine Finset.sum_congr rfl fun i _ ↦ ?_ + rw [X_mul_pderiv_monomial, mul_smul, smul_comm] + +/-- **The differentiated syzygy contradiction.** Suppose a partial derivative of `F` is a +combination of other partial derivatives of `F` whose cofactors are free of a distinguished +variable, and suppose none of the differentiating variables occurs in the partial derivative of +`F` at that distinguished variable. Then that partial derivative of `F` is annihilated by the +differentiating variable: applying the distinguished derivation to the combination kills every +cofactor term and every remaining factor. + +This is the shape of the final contradiction of the limit step, where the annihilated partial is +known to be nonzero. -/ +theorem pderiv_pderiv_eq_zero_of_sum_of_notMem_vars {σ : Type*} + {R : Type*} [CommRing R] {F : MvPolynomial σ R} {B₀ B' : σ} {s : Finset σ} + {U : σ → MvPolynomial σ R} + (hsyz : pderiv B' F = ∑ B ∈ s, pderiv B F * U B) + (hU : ∀ B ∈ s, pderiv B₀ (U B) = 0) + (hvars : ∀ B ∈ s, B ∉ (pderiv B₀ F).vars) : + pderiv B' (pderiv B₀ F) = 0 := by + classical + have hkey : pderiv B₀ (pderiv B' F) = pderiv B₀ (∑ B ∈ s, pderiv B F * U B) := + congrArg (fun p ↦ pderiv B₀ p) hsyz + rw [pderiv_pderiv_comm, map_sum] at hkey + rw [hkey] + refine Finset.sum_eq_zero fun B hB ↦ ?_ + rw [pderiv_mul, hU B hB, mul_zero, add_zero, pderiv_pderiv_comm, + pderiv_eq_zero_of_notMem_vars (hvars B hB), zero_mul] + +end MvPolynomial + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/OrdinalExpansion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/OrdinalExpansion.lean new file mode 100644 index 0000000000..244b149238 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/OrdinalExpansion.lean @@ -0,0 +1,124 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Expansion +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Basic + +/-! +# Expansion in one variable, for ordinal degrees + +The coefficient `xCoeff x k p` of `X x ^ k` in `p` +(`ConwayRefinement.Algebra.MvPolynomial.Expansion`) for a polynomial graded by ordinal +degrees `wt : σ → NatOrdinal`: homogeneity of the coefficients, +`xCoeff` of a product with a factor not involving `x`, `xCoeff` of `X x * p`, and the fact that a +polynomial of degree below `wt x` does not involve `x`. +-/ + +universe u v + +open MvPolynomial + +public noncomputable section + +namespace MvPolynomial + +variable {σ : Type u} {R : Type v} [CommRing R] [DecidableEq σ] (x : σ) (wt : σ → NatOrdinal) + +omit [DecidableEq σ] in +/-- A monomial involving `x` has degree at least `wt x`. -/ +theorem le_weight_of_ne_zero {d : σ →₀ ℕ} (hd : d x ≠ 0) : wt x ≤ Finsupp.weight wt d := by + calc wt x ≤ d x • wt x := by + simpa using nsmul_le_nsmul_left (bot_le : (0 : NatOrdinal) ≤ wt x) + (Nat.one_le_iff_ne_zero.mpr hd) + _ ≤ Finsupp.weight wt d := by + rw [Finsupp.weight_apply, Finsupp.sum] + exact Finset.single_le_sum (f := fun i ↦ d i • wt i) (fun _ _ ↦ bot_le) + (Finsupp.mem_support_iff.mpr hd) + +omit [DecidableEq σ] in +/-- A polynomial all of whose monomials have degree below `wt x` does not involve `x`. -/ +theorem mem_supported_of_forall_weight_lt {p : MvPolynomial σ R} + (hp : ∀ d ∈ p.support, Finsupp.weight wt d < wt x) : p ∈ supported R {x}ᶜ := by + rw [mem_supported] + intro y hy + rw [Set.mem_compl_iff, Set.mem_singleton_iff] + rintro rfl + obtain ⟨d, hd, hdy⟩ := (mem_vars_iff_mem_support y).mp hy + exact (hp d hd).not_ge (le_weight_of_ne_zero y wt (Finsupp.mem_support_iff.mp hdy)) + +omit [DecidableEq σ] in +/-- A polynomial homogeneous of degree below `wt x` does not involve `x`. -/ +theorem IsWeightedHomogeneous.mem_supported_of_lt' {p : MvPolynomial σ R} {w : NatOrdinal} + (hp : IsWeightedHomogeneous wt p w) (hw : w < wt x) : p ∈ supported R {x}ᶜ := + mem_supported_of_forall_weight_lt x wt fun _ hd ↦ (hp (mem_support_iff.mp hd)).symm ▸ hw + +/-- The coefficient of `X x ^ k` in a polynomial homogeneous of degree `w' ⊕ k ⊙ wt x` is +homogeneous of degree `w'`. -/ +theorem xCoeff_isWeightedHomogeneous' {p : MvPolynomial σ R} {w w' : NatOrdinal} + (hp : IsWeightedHomogeneous wt p w) (k : ℕ) (hw : w' + k • wt x = w) : + IsWeightedHomogeneous wt (xCoeff x k p) w' := by + intro m hm + rw [coeff_xCoeff] at hm + split_ifs at hm with h + · have := hp hm + rw [map_add, Finsupp.weight_single, ← hw] at this + exact add_right_cancel this + · exact absurd rfl hm + +/-- A nonzero coefficient of `X x ^ k` in a polynomial homogeneous of degree `w` has a degree `w'` +with `w' ⊕ k ⊙ wt x = w`. -/ +theorem exists_add_nsmul_eq_of_xCoeff_ne_zero {p : MvPolynomial σ R} {w : NatOrdinal} + (hp : IsWeightedHomogeneous wt p w) {k : ℕ} (h : xCoeff x k p ≠ 0) : + ∃ w' : NatOrdinal, w' + k • wt x = w := by + obtain ⟨m, hm⟩ := exists_coeff_ne_zero h + rw [coeff_xCoeff] at hm + split_ifs at hm with hmx + · refine ⟨Finsupp.weight wt m, ?_⟩ + have := hp hm + rwa [map_add, Finsupp.weight_single] at this + · exact absurd rfl hm + +/-- `xCoeff` of a product with a factor not involving `x`. -/ +theorem xCoeff_mul_of_mem_supported {a : MvPolynomial σ R} (ha : a ∈ supported R {x}ᶜ) (k : ℕ) + (p : MvPolynomial σ R) : xCoeff x k (a * p) = a * xCoeff x k p := by + obtain ⟨q, rfl⟩ := exists_rename_val_eq_of_mem_supported x ha + rw [xCoeff_apply, xCoeff_apply, map_mul, expandEquiv_rename_val, Polynomial.coeff_C_mul, + map_mul] + +/-- `xCoeff` of `X x * p`, positive index. -/ +theorem xCoeff_succ_X_mul (k : ℕ) (p : MvPolynomial σ R) : + xCoeff x (k + 1) (X x * p) = xCoeff x k p := by + rw [xCoeff_apply, xCoeff_apply, map_mul, expandEquiv_X_self, Polynomial.coeff_X_mul] + +/-- `xCoeff` of `X x * p`, index zero. -/ +theorem xCoeff_zero_X_mul (p : MvPolynomial σ R) : xCoeff x 0 (X x * p) = 0 := by + rw [xCoeff_apply, map_mul, expandEquiv_X_self, Polynomial.coeff_X_mul_zero, map_zero] + +/-- `xCoeff` of a polynomial not involving `x`: itself in index zero, zero otherwise. -/ +theorem xCoeff_of_mem_supported {a : MvPolynomial σ R} (ha : a ∈ supported R {x}ᶜ) (k : ℕ) : + xCoeff x k a = if k = 0 then a else 0 := by + have := xCoeff_mul_X_pow x ha k 0 + rwa [pow_zero, mul_one] at this + +/-- The monomials of `xCoeff x k p * X x ^ k` are monomials of `p`. -/ +theorem support_xCoeff_mul_X_pow_subset (k : ℕ) (p : MvPolynomial σ R) : + (xCoeff x k p * X x ^ k).support ⊆ p.support := by + classical + intro m hm + rw [mem_support_iff] at hm ⊢ + rw [X_pow_eq_monomial, coeff_mul_monomial'] at hm + split_ifs at hm with h + · rw [coeff_xCoeff] at hm + split_ifs at hm with h0 + · have hm' : m - Finsupp.single x k + Finsupp.single x k = m := by + rw [tsub_add_cancel_of_le h] + rwa [hm', mul_one] at hm + · rw [zero_mul] at hm + exact absurd rfl hm + · exact absurd rfl hm + +end MvPolynomial diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/RemainderBound.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/RemainderBound.lean new file mode 100644 index 0000000000..b09a62f335 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/RemainderBound.lean @@ -0,0 +1,156 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.TermDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.PairBounds +import Mathlib.Tactic.Abel + +/-! +# A uniform degree bound for terms with two translated truncations + +Fix an exponent `β` in the Cantor normal form. For a weighted-homogeneous polynomial of degree +`α`, consider the terms produced by the convolution formula in which at least two factors are +replaced by translated truncations. Among the terms whose Cantor terms at exponents at least `β` +agree with those of `α`, the sums of the remaining Cantor terms admit one strict upper bound below +the corresponding part of `α`. +-/ + +universe u v + +open scoped NatOrdinal +open Finsupp + +public noncomputable section + +namespace MvPolynomial + +variable {ι : Type u} {K : Type v} [CommRing K] {wt : ι → NatOrdinal} + +/-! ### Equal sums of comparable summands -/ + +theorem _root_.NatOrdinal.eq_and_eq_of_add_eq_add_of_le {a a' b b' : NatOrdinal} (ha : a ≤ a') + (hb : b ≤ b') (h : a + b = a' + b') : a = a' ∧ b = b' := by + have h1 : a' + b ≤ a + b := by rw [h]; exact add_le_add_right hb _ + have h2 : a + b' ≤ a + b := by rw [h]; exact add_le_add_left ha _ + exact ⟨le_antisymm ha (le_of_add_le_add_right h1), le_antisymm hb (le_of_add_le_add_left h2)⟩ + +/-! ### The bound -/ + +/-- Uniform bound below the part of the weighted degree supported at Cantor exponents below `β` for +convolution terms containing at least two translated truncations. -/ +@[blueprint "lem:two-truncations-below" + (phase := "Algebraic and ordinal preliminaries") + (title := "Weighted-degree bound for terms with two translated truncations") + (statement := /-- + For an ordinal $\xi$, write $\xi_{<\beta}$ and $\xi_{\ge\beta}$ for the + Hessenberg sums of the terms in its Cantor normal form whose exponents are, + respectively, below $\beta$ and at least $\beta$. + + Let $K$ be a commutative ring, give each variable $X_i$ an ordinal weight + $w_i$, and let $F\in K[X_i:i\in I]$ be weighted homogeneous of degree + $\alpha$, with $\alpha_{<\beta}\ne0$. Suppose that whenever $X_i$ occurs + in $F$ and $(w_i)_{<\beta}\ne0$, the last term of the Cantor normal form of + $(w_i)_{<\beta}$ is $\omega^e$ for some $e\ne0$. + + There is $\lambda<\alpha_{<\beta}$ such that the following holds. For every + monomial $X^d$ occurring in $F$, every factorisation + $X^d=X^{d'}X_{i_1}\cdots X_{i_k}$ with $k\ge2$, and all + $\rho_j rw [(u b).as_sum] + rw [Finset.sum_subset (Finset.subset_biUnion_of_mem (fun b ↦ (u b).support) + (Finset.mem_univ b))] + · exact Finset.sum_congr rfl fun d _ ↦ by rw [mul_comm, C_mul_monomial, mul_one] + · intro d _ hd + rw [MvPolynomial.notMem_support_iff.mp hd, monomial_zero] + +end BaseChange + +section Supported + +variable {K : Type u} [Field K] {ι : Type w} {B : Type v} [Fintype B] + +/-- The isomorphism `K[X_i : i ∈ ι] ≅ K[X_i : i ∈ Λ][X_i : i ∉ Λ]` separating the variables in +`Λ`. -/ +noncomputable def splitVariables (Λ : Set ι) [DecidablePred (· ∈ Λ)] : + MvPolynomial ι K ≃ₐ[K] MvPolynomial {i // i ∉ Λ} (MvPolynomial Λ K) := + (renameEquiv K ((Equiv.sumComm _ _).trans (Equiv.sumCompl (· ∈ Λ))).symm).trans + (sumAlgEquiv K _ _) + +/-- A polynomial in the variables of `Λ` becomes a constant. -/ +theorem splitVariables_rename (Λ : Set ι) [DecidablePred (· ∈ Λ)] (q : MvPolynomial Λ K) : + splitVariables Λ (rename (Subtype.val : Λ → ι) q) = C q := by + set f : {i // i ∉ Λ} ⊕ Λ ≃ ι := (Equiv.sumComm _ _).trans (Equiv.sumCompl (· ∈ Λ)) with hf + have hval : (Subtype.val : Λ → ι) = f ∘ Sum.inr := by + funext a + simp [hf] + have h1 : splitVariables (K := K) Λ (rename (Subtype.val : Λ → ι) q) = + sumAlgEquiv K {i // i ∉ Λ} Λ (rename Sum.inr q) := by + rw [splitVariables, AlgEquiv.trans_apply, hval, ← rename_rename, renameEquiv_apply, + rename_rename, Equiv.symm_comp_self] + simp + have h2 := AlgHom.congr_fun (sumAlgEquiv_comp_rename_inr K {i // i ∉ Λ} Λ) q + simp only [AlgHom.comp_apply, IsScalarTower.toAlgHom_apply, algebraMap_eq] at h2 + rw [h1] + exact h2 + +/-- A constant comes from a polynomial in the variables of `Λ`. -/ +theorem splitVariables_symm_C (Λ : Set ι) [DecidablePred (· ∈ Λ)] (q : MvPolynomial Λ K) : + (splitVariables Λ).symm (C q) = rename (Subtype.val : Λ → ι) q := by + rw [← splitVariables_rename Λ q, AlgEquiv.symm_apply_apply] + +/-- **Finitely many generating syzygies with entries in the variables of `Λ`.** For a finite set +`Λ` of variables and `c_b ∈ K[X_i : i ∈ Λ]`, there are finitely many syzygies of `c` with entries +in `K[X_i : i ∈ Λ]` generating the `K[X_i : i ∈ ι]`-module of all syzygies of `c`. -/ +@[blueprint "lem:syzygies-finite-variables" + (phase := "Algebraic and ordinal preliminaries") + (title := "Finite generation of polynomial syzygies") + (statement := /-- + Let $B$ be a finite set, let $\Lambda\subseteq I$ be finite, and let + $c_b\in K[X_i:i\in\Lambda]$ for every $b\in B$. There is a finite family + of tuples $\sigma\in K[X_i:i\in\Lambda]^B$ satisfying + $\sum_{b\in B}c_b\sigma_b=0$ that generates, over $K[X_i:i\in I]$, every + tuple $u\in K[X_i:i\in I]^B$ satisfying $\sum_{b\in B}c_bu_b=0$. + -/) + (proof := /-- + The ring $K[X_i:i\in\Lambda]$ is Noetherian, so the kernel of + $(u_b)\mapsto\sum_bc_bu_b$ is finitely generated. Identify + $K[X_i:i\in I]$ with a polynomial ring in the remaining variables over + $K[X_i:i\in\Lambda]$. Expanding an arbitrary syzygy in those variables makes + each coefficient tuple a syzygy over $K[X_i:i\in\Lambda]$. Express each such + tuple in the chosen finite generating family and reassemble the polynomial. + -/)] +theorem exists_finset_syzygy_span_supported (Λ : Set ι) [Finite Λ] (c : B → MvPolynomial ι K) + (hc : ∀ b, c b ∈ supported K Λ) : + ∃ L : Finset (B → MvPolynomial ι K), + (∀ σ ∈ L, (∀ b, σ b ∈ supported K Λ) ∧ ∑ b, c b * σ b = 0) ∧ + ∀ u : B → MvPolynomial ι K, ∑ b, c b * u b = 0 → + u ∈ Submodule.span (MvPolynomial ι K) (L : Set (B → MvPolynomial ι K)) := by + classical + -- lifts of the `c_b` to `K[X_i : i ∈ Λ]` + have hc' : ∀ b, ∃ q : MvPolynomial Λ K, rename (Subtype.val : Λ → ι) q = c b := fun b ↦ by + have := hc b + rwa [supported_eq_range_rename, AlgHom.mem_range] at this + choose c₀ hc₀ using hc' + obtain ⟨L₀, hL₀, hspan₀⟩ := exists_finset_syzygy_span c₀ + let ρ : (B → MvPolynomial Λ K) → (B → MvPolynomial ι K) := fun σ b ↦ rename Subtype.val (σ b) + refine ⟨L₀.image ρ, fun σ hσ ↦ ?_, fun u hu ↦ ?_⟩ + · obtain ⟨σ₀, hσ₀, rfl⟩ := Finset.mem_image.mp hσ + refine ⟨fun b ↦ ?_, ?_⟩ + · rw [supported_eq_range_rename] + exact ⟨σ₀ b, rfl⟩ + · have := congrArg (rename (Subtype.val : Λ → ι)) (hL₀ σ₀ hσ₀) + rw [map_sum, map_zero] at this + simpa only [map_mul, hc₀] using this + · -- separate the variables: the entries of `u` are polynomials over `K[X_i : i ∈ Λ]` + set e := splitVariables (K := K) Λ with hedef + have hu' : ∑ b, C (c₀ b) * e (u b) = 0 := by + have := congrArg e hu + rw [map_sum, map_zero] at this + simpa only [map_mul, ← hc₀, hedef, splitVariables_rename] using this + obtain ⟨m, v, hv, huv⟩ := + exists_eq_sum_monomial_mul_C_of_sum_C_mul_eq_zero c₀ (fun b ↦ e (u b)) hu' + -- the coefficient tuples are combinations of the generators + have hvspan : ∀ d, d ∈ m → ∃ r : (B → MvPolynomial Λ K) → MvPolynomial Λ K, + ∑ σ₀ ∈ L₀, r σ₀ • σ₀ = v d := fun d hd ↦ by + obtain ⟨f, _, hf⟩ := Submodule.mem_span_finset.mp (hspan₀ (v d) (hv d hd)) + exact ⟨f, hf⟩ + choose! r hr using hvspan + have hu_eq : u = ∑ d ∈ m, ∑ σ₀ ∈ L₀, + (e.symm (monomial d 1) * rename Subtype.val (r d σ₀)) • ρ σ₀ := by + funext b + have hvb : ∀ d ∈ m, v d b = ∑ σ₀ ∈ L₀, r d σ₀ * σ₀ b := fun d hd ↦ by + rw [← hr d hd, Finset.sum_apply] + rfl + calc u b = e.symm (e (u b)) := (e.symm_apply_apply _).symm + _ = ∑ d ∈ m, e.symm (monomial d 1) * rename Subtype.val (v d b) := by + rw [huv b, map_sum] + exact Finset.sum_congr rfl fun d _ ↦ by rw [map_mul, hedef, splitVariables_symm_C] + _ = ∑ d ∈ m, ∑ σ₀ ∈ L₀, + (e.symm (monomial d 1) * rename Subtype.val (r d σ₀)) * rename Subtype.val (σ₀ b) := by + refine Finset.sum_congr rfl fun d hd ↦ ?_ + rw [hvb d hd, map_sum, Finset.mul_sum] + exact Finset.sum_congr rfl fun σ₀ _ ↦ by rw [map_mul, mul_assoc] + _ = _ := by + simp only [Finset.sum_apply, Pi.smul_apply, smul_eq_mul, ρ] + rw [hu_eq] + exact Submodule.sum_mem _ fun d _ ↦ Submodule.sum_mem _ fun σ₀ hσ₀ ↦ + Submodule.smul_mem _ _ (Submodule.subset_span (Finset.mem_image_of_mem ρ hσ₀)) + +end Supported + +end MvPolynomial + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/TermDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/TermDegree.lean new file mode 100644 index 0000000000..8f570928a7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/TermDegree.lean @@ -0,0 +1,148 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalDerivation + +/-! +# Degrees of the terms of a truncated expansion + +Expanding a monomial by the convolution formula produces terms in which some factors are truncated +and the rest are not. `MvPolynomial.TermDegree wt d k rho` records that `rho` is the degree of such +a term for the monomial `d` with exactly `k` truncated factors: an untruncated `X_i` contributes +`wt i`, a truncated one some smaller ordinal. + +This is bookkeeping about the weights alone, with no series in it, and the limit step needs it to +bound the terms with at least two truncated factors. +-/ + +universe u v + +open Finsupp + +public section + +namespace MvPolynomial + +variable {ι : Type u} {R : Type v} [CommRing R] {wt : ι → NatOrdinal} + +/-- `TermDegree wt d k ρ`: `ρ` is the degree of a term of the expansion of the monomial `d` by the +convolution formula in which exactly `k` factors are truncated — each untruncated factor `X_i` +contributes `wt i`, each truncated one some `ρ' < wt i`. -/ +inductive TermDegree (wt : ι → NatOrdinal) : (ι →₀ ℕ) → ℕ → NatOrdinal → Prop + | zero : TermDegree wt 0 0 0 + | untrunc {d : ι →₀ ℕ} {k : ℕ} {ρ : NatOrdinal} (i : ι) : + TermDegree wt d k ρ → TermDegree wt (d + Finsupp.single i 1) k (ρ + wt i) + | trunc {d : ι →₀ ℕ} {k : ℕ} {ρ ρ' : NatOrdinal} (i : ι) (h : ρ' < wt i) : + TermDegree wt d k ρ → TermDegree wt (d + Finsupp.single i 1) (k + 1) (ρ + ρ') + +/-- Appending untruncated factors. -/ +theorem TermDegree.add_right {d d' : ι →₀ ℕ} {k : ℕ} {ρ : NatOrdinal} + (h : TermDegree wt d k ρ) : TermDegree wt (d + d') k (ρ + Finsupp.weight wt d') := by + classical + induction d' using Finsupp.induction with + | zero => simpa using h + | single_add a b f haf hb ih => + rw [add_comm (Finsupp.single a b) f, ← add_assoc, map_add, ← add_assoc] + clear haf hb + induction b with + | zero => simpa using ih + | succ b ihb => + rw [show Finsupp.single a (b + 1) = Finsupp.single a b + Finsupp.single a 1 from + Finsupp.single_add a b 1, ← add_assoc, map_add, ← add_assoc, + Finsupp.weight_single wt a 1, one_smul] + exact TermDegree.untrunc a ihb + +/-- The term of a monomial with no truncated factor has the degree of the monomial. -/ +theorem termDegree_weight (wt : ι → NatOrdinal) (d : ι →₀ ℕ) : + TermDegree wt d 0 (Finsupp.weight wt d) := by + have := TermDegree.add_right (wt := wt) (d' := d) TermDegree.zero + rwa [zero_add, zero_add] at this + +/-- Appending untruncated factors on the left. -/ +theorem TermDegree.add_left {d d' : ι →₀ ℕ} {k : ℕ} {ρ : NatOrdinal} + (h : TermDegree wt d k ρ) : TermDegree wt (d' + d) k (Finsupp.weight wt d' + ρ) := by + rw [add_comm d' d, add_comm _ ρ] + exact h.add_right + +/-- A truncated factor `X_i`, appended on the left. -/ +theorem TermDegree.trunc_left {d : ι →₀ ℕ} {k : ℕ} {ρ ρ' : NatOrdinal} (i : ι) (h : ρ' < wt i) + (hd : TermDegree wt d k ρ) : TermDegree wt (Finsupp.single i 1 + d) (k + 1) (ρ' + ρ) := by + rw [add_comm (Finsupp.single i 1) d, add_comm ρ' ρ] + exact TermDegree.trunc i h hd + +/-- A monomial of a product of two polynomials has a degree that is the natural sum of degrees +of monomials of the factors. -/ +theorem exists_add_eq_weight_of_mem_support_mul {P Q : MvPolynomial ι R} {d : ι →₀ ℕ} + (hd : d ∈ (P * Q).support) : + ∃ d₁ ∈ P.support, ∃ d₂ ∈ Q.support, + Finsupp.weight wt d₁ + Finsupp.weight wt d₂ = Finsupp.weight wt d := by + classical + obtain ⟨d₁, hd₁, d₂, hd₂, rfl⟩ := Finset.mem_add.mp (support_mul P Q hd) + exact ⟨d₁, hd₁, d₂, hd₂, (map_add _ _ _).symm⟩ + +/-- Every term of the expansion has degree at most that of the monomial. -/ +theorem TermDegree.le_weight {d : ι →₀ ℕ} {k : ℕ} {ρ : NatOrdinal} (h : TermDegree wt d k ρ) : + ρ ≤ Finsupp.weight wt d := by + induction h with + | zero => simp + | untrunc i _ ih => rw [map_add, Finsupp.weight_single, one_smul]; exact add_le_add_left ih _ + | trunc i hlt _ ih => + rw [map_add, Finsupp.weight_single, one_smul] + exact add_le_add ih hlt.le + +/-- A term with a truncated factor: the monomial is `d' · X_i`, the degree at most `deg d' ⊕ ρ'` +with `ρ' < wt i`. -/ +theorem TermDegree.exists_single_truncated {d : ι →₀ ℕ} {k : ℕ} {ρ : NatOrdinal} + (h : TermDegree wt d k ρ) (hk : 1 ≤ k) : + ∃ (i : ι) (d' : ι →₀ ℕ) (ρ' : NatOrdinal), d = d' + Finsupp.single i 1 ∧ ρ' < wt i ∧ + ρ ≤ Finsupp.weight wt d' + ρ' := by + induction h with + | zero => exact absurd hk (by omega) + | untrunc i _ ih => + obtain ⟨i', d', ρ', rfl, hρ', hle⟩ := ih hk + refine ⟨i', d' + Finsupp.single i 1, ρ', by rw [add_right_comm], hρ', ?_⟩ + rw [map_add, Finsupp.weight_single, one_smul, add_right_comm] + exact add_le_add_left hle _ + | trunc i hlt hd _ => + exact ⟨i, _, _, rfl, hlt, add_le_add_left hd.le_weight _⟩ + +/-- A term with two truncated factors: the monomial is `d' · X_i · X_j`, the degree at most +`deg d' ⊕ ρ'_i ⊕ ρ'_j` with `ρ'_i < wt i`, `ρ'_j < wt j`. -/ +theorem TermDegree.exists_two_truncated {d : ι →₀ ℕ} {k : ℕ} {ρ : NatOrdinal} + (h : TermDegree wt d k ρ) (hk : 2 ≤ k) : + ∃ (i j : ι) (d' : ι →₀ ℕ) (ρᵢ ρⱼ : NatOrdinal), + d = d' + Finsupp.single i 1 + Finsupp.single j 1 ∧ ρᵢ < wt i ∧ ρⱼ < wt j ∧ + ρ ≤ Finsupp.weight wt d' + ρᵢ + ρⱼ := by + induction h with + | zero => exact absurd hk (by omega) + | untrunc i _ ih => + obtain ⟨i', j', d', ρᵢ, ρⱼ, rfl, hρᵢ, hρⱼ, hle⟩ := ih hk + refine ⟨i', j', d' + Finsupp.single i 1, ρᵢ, ρⱼ, by + rw [add_right_comm, add_right_comm d' (Finsupp.single i' 1)], hρᵢ, hρⱼ, ?_⟩ + rw [map_add, Finsupp.weight_single, one_smul] + calc _ ≤ Finsupp.weight wt d' + ρᵢ + ρⱼ + wt i := add_le_add_left hle _ + _ = Finsupp.weight wt d' + wt i + ρᵢ + ρⱼ := by abel + | trunc i hlt hd _ => + obtain ⟨i', d', ρ', rfl, hρ', hle⟩ := hd.exists_single_truncated (by omega) + exact ⟨i', i, d', ρ', _, rfl, hρ', hlt, add_le_add_left hle _⟩ + +/-- Truncating exactly two factors of a monomial `d' · X_i · X_j`. -/ +theorem termDegree_pair (d' : ι →₀ ℕ) {i j : ι} {ρᵢ ρⱼ : NatOrdinal} (hρᵢ : ρᵢ < wt i) + (hρⱼ : ρⱼ < wt j) : + TermDegree wt (d' + Finsupp.single i 1 + Finsupp.single j 1) 2 + (Finsupp.weight wt d' + ρᵢ + ρⱼ) := + TermDegree.trunc j hρⱼ (TermDegree.trunc i hρᵢ (termDegree_weight wt d')) + +/-- A term of the expansion of a monomial by the convolution formula in which at least one factor +is a translated truncation at a cutoff `ζ < 0` has degree below that of the monomial. -/ +theorem TermDegree.lt_weight {d : ι →₀ ℕ} {k : ℕ} {ρ : NatOrdinal} (h : TermDegree wt d k ρ) + (hk : 1 ≤ k) : ρ < Finsupp.weight wt d := by + obtain ⟨i, d', ρ', rfl, hρ', hle⟩ := h.exists_single_truncated hk + rw [map_add, Finsupp.weight_single, one_smul] + exact hle.trans_lt (add_lt_add_right hρ' _) + +end MvPolynomial diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/WeightedTotalDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/WeightedTotalDegree.lean new file mode 100644 index 0000000000..6f5669627e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/WeightedTotalDegree.lean @@ -0,0 +1,177 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.RingTheory.MvPolynomial.WeightedHomogeneous +public import Mathlib.Algebra.MvPolynomial.CommRing +public import Mathlib.Data.Nat.Cast.Order.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.MapWeight + +/-! +# The top weighted-homogeneous component + +For weights in a linearly ordered monoid with a bottom element, a nonzero multivariate polynomial +is the finite sum of its weighted-homogeneous components over the weights occurring in its +support, its component at the weighted total degree is nonzero, and removing that component +either leaves zero or strictly lowers the weighted total degree. Weights in `ℕ` read in the +monoid through `Nat.cast` have the cast weights, homogeneous components and weighted total +degree. +-/ + +universe u v w + +public noncomputable section + +namespace MvPolynomial + +variable {σ : Type u} {R : Type v} {M : Type w} +variable [AddCommMonoid M] [LinearOrder M] [OrderBot M] (w : σ → M) + +section CommSemiring + +variable [CommSemiring R] + +/-- The weighted-homogeneous component of a nonzero polynomial at its weighted total degree is +nonzero. -/ +theorem weightedHomogeneousComponent_weightedTotalDegree_ne_zero {F : MvPolynomial σ R} + (hF : F ≠ 0) : + weightedHomogeneousComponent w (weightedTotalDegree w F) F ≠ 0 := by + classical + obtain ⟨d, hd, hsup⟩ := Finset.exists_mem_eq_sup F.support (support_nonempty.mpr hF) + fun s ↦ Finsupp.weight w s + intro h0 + have := coeff_weightedHomogeneousComponent (w := w) (n := weightedTotalDegree w F) (φ := F) d + rw [h0, coeff_zero, weightedTotalDegree, hsup, if_pos rfl] at this + exact mem_support_iff.mp hd this.symm + +omit [OrderBot M] in +/-- Every polynomial is the finite sum of its weighted-homogeneous components over the weights +occurring in its support. -/ +theorem eq_sum_weightedHomogeneousComponent (F : MvPolynomial σ R) : + F = ∑ m ∈ F.support.image (fun s ↦ Finsupp.weight w s), + weightedHomogeneousComponent w m F := by + classical + refine MvPolynomial.ext _ _ fun d ↦ ?_ + rw [coeff_sum] + simp only [coeff_weightedHomogeneousComponent] + by_cases hd : d ∈ F.support + · rw [Finset.sum_eq_single (Finsupp.weight w d)] + · rw [if_pos rfl] + · intro m _ hm + rw [if_neg (Ne.symm hm)] + · intro hnot + exact absurd (Finset.mem_image_of_mem _ hd) hnot + · rw [notMem_support_iff.mp hd] + exact (Finset.sum_eq_zero fun m _ ↦ ite_self 0).symm + +end CommSemiring + +section CommRing + +variable [CommRing R] + +/-- Removing the top weighted-homogeneous component of a polynomial leaves zero or a polynomial +of strictly smaller weighted total degree. -/ +theorem weightedTotalDegree_sub_weightedHomogeneousComponent_lt (F : MvPolynomial σ R) : + F - weightedHomogeneousComponent w (weightedTotalDegree w F) F = 0 ∨ + weightedTotalDegree w (F - weightedHomogeneousComponent w (weightedTotalDegree w F) F) < + weightedTotalDegree w F := by + classical + set d := weightedTotalDegree w F with hd + set G := weightedHomogeneousComponent w d F with hG + by_cases hFG : F - G = 0 + · exact Or.inl hFG + refine Or.inr (lt_of_le_of_ne (Finset.sup_le fun s hs ↦ ?_) fun heq ↦ ?_) + · have hs' : coeff s (F - G) ≠ 0 := mem_support_iff.mp hs + have hsub : coeff s (F - G) = + if Finsupp.weight w s = d then 0 else coeff s F := by + rw [coeff_sub, hG, coeff_weightedHomogeneousComponent] + split_ifs <;> simp + have hne : Finsupp.weight w s ≠ d := by + intro heq + rw [hsub, if_pos heq] at hs' + exact hs' rfl + have hFne : coeff s F ≠ 0 := by + rw [hsub, if_neg hne] at hs' + exact hs' + exact le_weightedTotalDegree _ (mem_support_iff.mpr hFne) + · obtain ⟨s, hs, hsup⟩ := Finset.exists_mem_eq_sup (F - G).support (support_nonempty.mpr hFG) + fun s ↦ Finsupp.weight w s + have hs' : coeff s (F - G) ≠ 0 := mem_support_iff.mp hs + have hweight : Finsupp.weight w s = d := by + rw [← heq, weightedTotalDegree, hsup] + rw [coeff_sub, hG, coeff_weightedHomogeneousComponent, if_pos hweight, sub_self] at hs' + exact hs' rfl + +end CommRing + +end MvPolynomial + +/-! ### Weights in `ℕ` read in `M` through `Nat.cast` -/ + +namespace MvPolynomial + +variable {σ : Type u} {R : Type v} {M : Type w} + +section Cast + +variable [AddCommMonoidWithOne M] + +/-- For weights in `ℕ` read in `M` through `Nat.cast`, the weight of a monomial is the cast of its +weight in `ℕ`. -/ +theorem weight_natCast_comp (w : σ → ℕ) (e : σ →₀ ℕ) : + Finsupp.weight (fun i ↦ (w i : M)) e = ((Finsupp.weight w e : ℕ) : M) := by + simpa only [Nat.coe_castAddMonoidHom] using + Finsupp.weight_comp_addMonoidHom (Nat.castAddMonoidHom M) w e + +variable [CommSemiring R] + +/-- A nonzero polynomial homogeneous for cast natural weights has a cast natural degree. -/ +theorem IsWeightedHomogeneous.exists_degree_eq_natCast {w : σ → ℕ} + {F : MvPolynomial σ R} {d : M} + (hF : IsWeightedHomogeneous (fun i ↦ (w i : M)) F d) (hF0 : F ≠ 0) : + ∃ n : ℕ, d = (n : M) := by + obtain ⟨e, he⟩ := exists_coeff_ne_zero hF0 + refine ⟨Finsupp.weight w e, ?_⟩ + rw [← hF he, weight_natCast_comp] + +variable [CharZero M] + +/-- Homogeneity of degree `d` for weights read through `Nat.cast` is homogeneity of degree `d` for +the weights in `ℕ`. -/ +theorem isWeightedHomogeneous_natCast_comp_iff (w : σ → ℕ) {F : MvPolynomial σ R} {d : ℕ} : + IsWeightedHomogeneous (fun i ↦ (w i : M)) F (d : M) ↔ IsWeightedHomogeneous w F d := by + simp only [IsWeightedHomogeneous, weight_natCast_comp, Nat.cast_inj] + +/-- The homogeneous component of degree `d` for weights read through `Nat.cast` is the one for the +weights in `ℕ`. -/ +theorem weightedHomogeneousComponent_natCast_comp (w : σ → ℕ) (d : ℕ) (F : MvPolynomial σ R) : + weightedHomogeneousComponent (fun i ↦ (w i : M)) (d : M) F = + weightedHomogeneousComponent w d F := by + classical + ext e + rw [coeff_weightedHomogeneousComponent, coeff_weightedHomogeneousComponent, weight_natCast_comp, + Nat.cast_inj] + by_cases h : Finsupp.weight w e = d <;> simp [h] + +variable [LinearOrder M] [OrderBot M] [AddLeftMono M] [ZeroLEOneClass M] + +omit [CharZero M] in +/-- The weighted total degree for weights read through `Nat.cast` is the cast of the weighted +total degree for the weights in `ℕ`, when `⊥ = 0` in `M`. -/ +theorem weightedTotalDegree_natCast_comp (hbot : (⊥ : M) = 0) (w : σ → ℕ) + (F : MvPolynomial σ R) : + weightedTotalDegree (fun i ↦ (w i : M)) F = ((weightedTotalDegree w F : ℕ) : M) := by + change F.support.sup (fun s ↦ Finsupp.weight (fun i ↦ (w i : M)) s) = + ((F.support.sup fun s ↦ Finsupp.weight w s : ℕ) : M) + rw [Finset.apply_sup_eq_sup_comp_of_linearOrder (Nat.cast : ℕ → M) Nat.mono_cast + (by rw [Nat.bot_eq_zero, Nat.cast_zero, hbot])] + exact Finset.sup_congr rfl fun s _ ↦ weight_natCast_comp w s + +end Cast + +end MvPolynomial diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order.lean new file mode 100644 index 0000000000..6c8286152d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order.lean @@ -0,0 +1,12 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanBall +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ConvexQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/ArchimedeanBall.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/ArchimedeanBall.lean new file mode 100644 index 0000000000..71e513aec7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/ArchimedeanBall.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +module + +public import Mathlib.Algebra.Order.Archimedean.Class +public import Mathlib.Order.Interval.Set.OrdConnected + +/-! +# Convex Archimedean balls + +Closed Archimedean balls are convex additive subgroups of the exponent group. +-/ + +public section + +namespace FiniteArchimedeanClass + +variable {G : Type*} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + +private theorem archimedeanClosedBall_ordConnected (c : ArchimedeanClass G) : + (ArchimedeanClass.closedBallAddSubgroup c : Set G).OrdConnected := by + constructor + intro g hg h hh k hk + change g ∈ ArchimedeanClass.closedBallAddSubgroup c at hg + change h ∈ ArchimedeanClass.closedBallAddSubgroup c at hh + change k ∈ ArchimedeanClass.closedBallAddSubgroup c + rw [ArchimedeanClass.mem_closedBallAddSubgroup_iff] at hg hh ⊢ + exact (le_min hg hh).trans (ArchimedeanClass.min_le_mk_of_le_of_le hk.1 hk.2) + +private theorem finiteClosedBall_eq_closedBall (c : FiniteArchimedeanClass G) : + (FiniteArchimedeanClass.closedBallAddSubgroup c : Set G) = + (ArchimedeanClass.closedBallAddSubgroup c.1 : Set G) := by + ext g + rw [SetLike.mem_coe, SetLike.mem_coe, + FiniteArchimedeanClass.mem_closedBallAddSubgroup_iff, + ArchimedeanClass.mem_closedBallAddSubgroup_iff] + by_cases hg : g = 0 + · subst g + simp + · exact ⟨fun h ↦ h hg, fun h _ ↦ h⟩ + +/-- A finite Archimedean closed ball is order-connected. -/ +theorem closedBall_ordConnected (c : FiniteArchimedeanClass G) : + (closedBallAddSubgroup c : Set G).OrdConnected := by + rw [finiteClosedBall_eq_closedBall] + exact archimedeanClosedBall_ordConnected c.1 + +end FiniteArchimedeanClass diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/ArchimedeanQuotient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/ArchimedeanQuotient.lean new file mode 100644 index 0000000000..6c296cc73b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/ArchimedeanQuotient.lean @@ -0,0 +1,263 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ConvexQuotient +public import Mathlib.Algebra.Group.Subgroup.Lattice +public import Mathlib.Algebra.Order.Archimedean.Class + +/-! +# Archimedean classes in subgroups and limit quotients + +A positively coinitial subgroup of an ordered abelian group inherits the absence of a largest +finite Archimedean class from the ambient group. The ambient hypothesis is essential: positive +coinitiality alone does not create new Archimedean classes. + +There is a separate construction suited to a limit family of classes. For a set `T` of finite +Archimedean classes, `FiniteArchimedeanClass.tailKernel T` is the intersection of their closed +Archimedean balls. If every member of `T` has a strictly later member, the quotient by this convex +subgroup has no largest finite Archimedean class. This is the quotient used at a limit of support +support classes. +-/ + +open Set + +universe u + +public noncomputable section + +namespace AddSubgroup + +variable {C : Type u} [AddCommGroup C] [LinearOrder C] [IsOrderedAddMonoid C] + +/-- An additive subgroup of an ordered abelian group inherits the ordered-additive structure. -/ +instance instIsOrderedAddMonoid (S : AddSubgroup C) : IsOrderedAddMonoid S where + add_le_add_left a b h z := + show (a : C) + (z : C) ≤ (b : C) + (z : C) from by + simpa [add_comm] using + add_le_add_left (show (a : C) ≤ (b : C) from h) (z : C) + +/-- A positively coinitial subgroup inherits the absence of a largest finite Archimedean class +from its ambient ordered group. -/ +theorem finiteArchimedeanClass_noMax_of_pos_coinitial + [NoMaxOrder (FiniteArchimedeanClass C)] (S : AddSubgroup C) + (hS : ∀ y : C, 0 < y → ∃ x : S, 0 < (x : C) ∧ (x : C) ≤ y) : + NoMaxOrder (FiniteArchimedeanClass S) := by + constructor + intro c + induction c using FiniteArchimedeanClass.ind with + | mk x hx => + obtain ⟨d, hxd⟩ := exists_gt + (FiniteArchimedeanClass.mk (x : C) (Subtype.coe_ne_coe.mpr hx)) + induction d using FiniteArchimedeanClass.ind with + | mk y hy => + obtain ⟨z, hzpos, hzy⟩ := hS |y| (abs_pos.mpr hy) + have hz0 : z ≠ 0 := fun hz ↦ hzpos.ne' (Subtype.ext_iff.mp hz) + refine ⟨FiniteArchimedeanClass.mk z hz0, ?_⟩ + let e : S →+o C := + { toFun := fun z ↦ (z : C) + map_zero' := rfl + map_add' := fun _ _ ↦ rfl + monotone' := fun _ _ h ↦ h } + change ArchimedeanClass.mk (e x) < ArchimedeanClass.mk (e z) + rw [← ArchimedeanClass.orderHom_mk e x, ← ArchimedeanClass.orderHom_mk e z] + apply ((ArchimedeanClass.orderHom e).monotone.strictMono_of_injective + (ArchimedeanClass.orderHom_injective Subtype.val_injective)).lt_iff_lt.mpr + change ArchimedeanClass.mk (x : C) < ArchimedeanClass.mk (z : C) + change ArchimedeanClass.mk (x : C) < ArchimedeanClass.mk y at hxd + refine hxd.trans_le ?_ + apply ArchimedeanClass.mk_le_mk_of_abs + simpa [abs_of_pos hzpos] using hzy + +end AddSubgroup + +namespace FiniteArchimedeanClass + +variable {G : Type u} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + +/-- The elements lying in the closed ball of every class in `T`. -/ +def tailKernel (T : Set (FiniteArchimedeanClass G)) : AddSubgroup G := + ⨅ c : T, ArchimedeanClass.closedBallAddSubgroup c.1.1 + +/-- Membership in the tail kernel means having class at least every class in `T`. -/ +theorem mem_tailKernel_iff {T : Set (FiniteArchimedeanClass G)} {x : G} : + x ∈ tailKernel T ↔ ∀ c : T, c.1.1 ≤ ArchimedeanClass.mk x := by + rw [tailKernel, AddSubgroup.mem_iInf] + exact forall_congr' fun c ↦ ArchimedeanClass.mem_closedBallAddSubgroup_iff + +/-- The common tail kernel of a family of Archimedean classes is convex. -/ +instance tailKernel_isConvex (T : Set (FiniteArchimedeanClass G)) : + (tailKernel T).IsConvex where + ordConnected := by + constructor + intro a ha b hb x hx + apply mem_tailKernel_iff.mpr + intro c + exact (le_min (mem_tailKernel_iff.mp ha c) (mem_tailKernel_iff.mp hb c)).trans + (ArchimedeanClass.min_le_mk_of_le_of_le hx.1 hx.2) + +/-- Absolute value commutes with projection to a convex tail quotient. -/ +theorem quotient_abs (T : Set (FiniteArchimedeanClass G)) (x : G) : + |(x : G ⧸ tailKernel T)| = ((|x| : G) : G ⧸ tailKernel T) := by + rcases le_total 0 x with hx | hx + · have hxq : (0 : G ⧸ tailKernel T) ≤ (x : G ⧸ tailKernel T) := by + rw [← QuotientAddGroup.mk_zero] + exact ConvexQuotient.mk_le_mk hx + rw [abs_of_nonneg hx, abs_of_nonneg hxq] + · have hxq : (x : G ⧸ tailKernel T) ≤ (0 : G ⧸ tailKernel T) := by + rw [← QuotientAddGroup.mk_zero] + exact ConvexQuotient.mk_le_mk hx + rw [abs_of_nonpos hx, abs_of_nonpos hxq, ← QuotientAddGroup.mk_neg] + +/-- A strict comparison of Archimedean classes in a common-tail quotient reflects to any chosen +representatives. -/ +theorem archimedeanClass_mk_lt_of_quotient_mk_lt + (T : Set (FiniteArchimedeanClass G)) {x y : G} + (h : ArchimedeanClass.mk (x : G ⧸ tailKernel T) < + ArchimedeanClass.mk (y : G ⧸ tailKernel T)) : + ArchimedeanClass.mk x < ArchimedeanClass.mk y := by + rw [ArchimedeanClass.mk_lt_mk] at h ⊢ + intro n + have hn := h n + have hn' : ((n • |y| : G) : G ⧸ tailKernel T) < + ((|x| : G) : G ⧸ tailKernel T) := by + simpa only [quotient_abs, QuotientAddGroup.mk_nsmul] using hn + exact ConvexQuotient.lt_of_mk_lt_mk hn' + +/-- A nonzero natural multiple of an absolute value stays in the same Archimedean class. -/ +theorem mk_nsmul_abs {x : G} {n : ℕ} (hn : n ≠ 0) : + ArchimedeanClass.mk (n • |x|) = ArchimedeanClass.mk x := by + apply ArchimedeanClass.mk_eq_mk.mpr + constructor + · refine ⟨1, ?_⟩ + rw [one_nsmul, abs_nsmul, abs_abs] + obtain ⟨k, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hn + simpa [succ_nsmul] using + (le_add_of_nonneg_left (nsmul_nonneg (abs_nonneg x) k) : + |x| ≤ k • |x| + |x|) + · refine ⟨n, ?_⟩ + rw [abs_nsmul, abs_abs] + +/-- If `T` has no least member in the magnitude order, its common tail quotient has no least +nonzero Archimedean class in the magnitude order. -/ +theorem quotient_noMax_of_forall_exists_gt (T : Set (FiniteArchimedeanClass G)) + (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) : + NoMaxOrder (FiniteArchimedeanClass (G ⧸ tailKernel T)) := by + constructor + intro c + induction c using FiniteArchimedeanClass.ind with + | mk x hx => + induction x using QuotientAddGroup.induction_on with + | H x => + have hxH : x ∉ tailKernel T := by + simpa using (show (x : G ⧸ tailKernel T) ≠ 0 from hx) + rw [mem_tailKernel_iff] at hxH + push Not at hxH + obtain ⟨d, hxd⟩ := hxH + obtain ⟨e, heT, hde⟩ := hT d.1 d.2 + obtain ⟨f, hfT, hef⟩ := hT e heT + let y : G := e.1.out + have hyclass : ArchimedeanClass.mk y = e.1 := ArchimedeanClass.mk_out e.1 + have hy0 : y ≠ 0 := ArchimedeanClass.mk_eq_top_iff.not.mp + (hyclass.trans_ne e.2) + have hyH : y ∉ tailKernel T := by + intro hy + have hf_le_y : f.1 ≤ ArchimedeanClass.mk y := + mem_tailKernel_iff.mp hy ⟨f, hfT⟩ + rw [hyclass] at hf_le_y + exact (not_le_of_gt hef) hf_le_y + refine ⟨FiniteArchimedeanClass.mk (y : G ⧸ tailKernel T) (by simpa using hyH), ?_⟩ + change ArchimedeanClass.mk (x : G ⧸ tailKernel T) < + ArchimedeanClass.mk (y : G ⧸ tailKernel T) + rw [ArchimedeanClass.mk_lt_mk] + intro n + have hclass : ArchimedeanClass.mk x < ArchimedeanClass.mk y := by + rw [hyclass] + exact hxd.trans hde + have hxy : n • |y| < |x| := ArchimedeanClass.mk_lt_mk.mp hclass n + have hquot : ((n • |y| : G) : G ⧸ tailKernel T) < + ((|x| : G) : G ⧸ tailKernel T) := by + apply ConvexQuotient.mk_lt_mk_iff.mpr + refine ⟨hxy, ?_⟩ + intro hmem + have hdiff : d.1 ≤ ArchimedeanClass.mk (|x| - n • |y|) := + mem_tailKernel_iff.mp hmem d + have hdiffclass : ArchimedeanClass.mk (|x| - n • |y|) = + ArchimedeanClass.mk x := by + by_cases hn : n = 0 + · simp [hn] + rw [ArchimedeanClass.mk_sub_eq_mk_left] + · exact ArchimedeanClass.mk_abs x + · simpa only [ArchimedeanClass.mk_abs, mk_nsmul_abs hn] using hclass + rw [hdiffclass] at hdiff + exact (not_le_of_gt hxd) hdiff + simpa only [quotient_abs, QuotientAddGroup.mk_nsmul] using hquot + +/-- The no-largest-class theorem for a quotient by any additive subgroup whose carrier is the +tail kernel. -/ +theorem quotient_noMax_of_eq_tailKernel (T : Set (FiniteArchimedeanClass G)) + (H : AddSubgroup G) [H.IsConvex] (hH : H = tailKernel T) + (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) : + NoMaxOrder (FiniteArchimedeanClass (G ⧸ H)) := by + subst H + exact quotient_noMax_of_forall_exists_gt T hT + +/-- A canonical positive representative of a finite Archimedean class. -/ +def positiveRepresentative (c : FiniteArchimedeanClass G) : G := + |c.1.out| + +/-- The canonical representative of a finite class is positive. -/ +theorem positiveRepresentative_pos (c : FiniteArchimedeanClass G) : + 0 < positiveRepresentative c := by + rw [positiveRepresentative, abs_pos] + intro h + have := congrArg ArchimedeanClass.mk h + rw [ArchimedeanClass.mk_out, ArchimedeanClass.mk_zero] at this + exact c.2 this + +/-- The canonical positive representative represents the requested class. -/ +theorem mk_positiveRepresentative (c : FiniteArchimedeanClass G) : + ArchimedeanClass.mk (positiveRepresentative c) = c.1 := by + rw [positiveRepresentative, ArchimedeanClass.mk_abs, ArchimedeanClass.mk_out] + +/-- At a limit family, each canonical representative survives the common tail quotient. -/ +theorem positiveRepresentative_not_mem_tailKernel {T : Set (FiniteArchimedeanClass G)} + (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) (c : T) : + positiveRepresentative c.1 ∉ tailKernel T := by + obtain ⟨d, hdT, hcd⟩ := hT c.1 c.2 + intro hmem + have := mem_tailKernel_iff.mp hmem ⟨d, hdT⟩ + rw [mk_positiveRepresentative] at this + exact (not_le_of_gt hcd) this + +/-- The image of a canonical representative in its limit quotient is positive. -/ +theorem quotient_positiveRepresentative_pos {T : Set (FiniteArchimedeanClass G)} + (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) (c : T) : + 0 < ((positiveRepresentative c.1 : G) : G ⧸ tailKernel T) := by + rw [← QuotientAddGroup.mk_zero] + exact ConvexQuotient.mk_lt_mk_iff.mpr ⟨positiveRepresentative_pos c.1, + by simpa using positiveRepresentative_not_mem_tailKernel hT c⟩ + +/-- The canonical representatives of a limit family are coinitial among the positive elements of +the common tail quotient. -/ +theorem exists_quotient_positiveRepresentative_le {T : Set (FiniteArchimedeanClass G)} + {x : G ⧸ tailKernel T} (hx : 0 < x) : + ∃ c : T, ((positiveRepresentative c.1 : G) : G ⧸ tailKernel T) ≤ x := by + induction x using QuotientAddGroup.induction_on with + | H x => + have hxq : ((0 : G) : G ⧸ tailKernel T) < (x : G ⧸ tailKernel T) := by + simpa using hx + have hx0 : 0 < x := ConvexQuotient.lt_of_mk_lt_mk hxq + have hxH : x ∉ tailKernel T := by + simpa using (ConvexQuotient.mk_lt_mk_iff.mp hxq).2 + rw [mem_tailKernel_iff] at hxH + push Not at hxH + obtain ⟨c, hxc⟩ := hxH + refine ⟨c, ConvexQuotient.mk_le_mk ?_⟩ + apply (ArchimedeanClass.lt_of_mk_lt_mk_of_nonneg ?_ hx0.le).le + rwa [mk_positiveRepresentative] + +end FiniteArchimedeanClass diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/ConvexQuotient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/ConvexQuotient.lean new file mode 100644 index 0000000000..8242f23490 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/ConvexQuotient.lean @@ -0,0 +1,185 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.Order.Group.Defs +public import Mathlib.GroupTheory.QuotientGroup.Defs +public import Mathlib.Order.Interval.Set.OrdConnected +import Mathlib.Tactic.Abel + +/-! +# The quotient of an ordered group by a convex subgroup + +A subgroup of a linearly ordered abelian group that is order-connected as a set is *convex*, and +the quotient by it inherits a linear order: one coset lies below another when some representative +of the first lies below some representative of the second. Convexity is exactly what makes that +relation antisymmetric, because an element trapped between zero and a subgroup element belongs to +the subgroup. + +The projection is monotone and reflects the strict order (`mk_le_mk`, `lt_of_mk_lt_mk`). Those +two facts are what let order-theoretic hypotheses be transported to the quotient — filling cuts, +in the intended application, where the quotient is taken to gain a small coinitial family of +positive elements that the group itself lacks. +-/ + +universe u + +open Set + +public section + +namespace AddSubgroup + +variable {G : Type u} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + +/-- A subgroup of an ordered group is convex when it is order-connected. -/ +class IsConvex (H : AddSubgroup G) : Prop where + /-- The carrier of a convex subgroup is order-connected. -/ + ordConnected : (H : Set G).OrdConnected + +omit [IsOrderedAddMonoid G] in +/-- A nonnegative element below an element of a convex subgroup lies in the subgroup. -/ +theorem mem_of_nonneg_of_le (H : AddSubgroup G) [H.IsConvex] {x y : G} (hx : 0 ≤ x) + (hxy : x ≤ y) (hy : y ∈ H) : x ∈ H := + IsConvex.ordConnected.out H.zero_mem hy ⟨hx, hxy⟩ + +end AddSubgroup + +namespace ConvexQuotient + +variable {G : Type u} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + {H : AddSubgroup G} [H.IsConvex] + +/-- One coset lies below another when some representative of the first lies below some +representative of the second. -/ +instance instLE : LE (G ⧸ H) where + le x y := ∃ a b : G, (a : G ⧸ H) = x ∧ (b : G ⧸ H) = y ∧ a ≤ b + +/-- **Comparing cosets.** One coset lies below another exactly when the chosen representatives are +already comparable or differ by a subgroup element. Convexity supplies the forward direction: were +the representatives reversed, their difference would be trapped between zero and the subgroup +element relating the two choices. -/ +theorem mk_le_mk_iff {a b : G} : + ((a : G ⧸ H) ≤ (b : G ⧸ H)) ↔ a ≤ b ∨ b - a ∈ H := by + constructor + · rintro ⟨a', b', ha', hb', hab⟩ + rw [QuotientAddGroup.eq_iff_sub_mem] at ha' hb' + rcases le_or_gt a b with h | h + · exact Or.inl h + refine Or.inr ?_ + have hsub : a - b ≤ (b' - b) - (a' - a) := by + rw [← sub_nonneg] + have heq : (b' - b) - (a' - a) - (a - b) = b' - a' := by abel + rw [heq] + exact sub_nonneg.mpr hab + have hmem := AddSubgroup.mem_of_nonneg_of_le H (sub_nonneg.mpr h.le) hsub + (H.sub_mem hb' ha') + simpa using H.neg_mem hmem + · rintro (h | h) + · exact ⟨a, b, rfl, rfl, h⟩ + · exact ⟨a, a, rfl, + QuotientAddGroup.eq_iff_sub_mem.mpr (by simpa using H.neg_mem h), le_rfl⟩ + +/-- The projection is monotone. -/ +theorem mk_le_mk {a b : G} (h : a ≤ b) : (a : G ⧸ H) ≤ (b : G ⧸ H) := + mk_le_mk_iff.mpr (Or.inl h) + +open Classical in +noncomputable instance instLinearOrder : LinearOrder (G ⧸ H) where + le := (· ≤ ·) + le_refl := by + refine fun x ↦ QuotientAddGroup.induction_on x fun a ↦ ?_ + exact mk_le_mk le_rfl + le_trans := by + refine fun x y z ↦ QuotientAddGroup.induction_on x fun a ↦ QuotientAddGroup.induction_on y + fun b ↦ QuotientAddGroup.induction_on z fun c hab hbc ↦ ?_ + rw [mk_le_mk_iff] at hab hbc ⊢ + rcases hab with hab | hab + · rcases hbc with hbc | hbc + · exact Or.inl (hab.trans hbc) + -- `c` and `b` differ in the subgroup, so `a ≤ c` unless `a - c` is trapped below `b - c`. + · rcases le_or_gt a c with h | h + · exact Or.inl h + refine Or.inr ?_ + have hbc' : b - c ∈ H := by simpa using H.neg_mem hbc + have hmem := AddSubgroup.mem_of_nonneg_of_le H (sub_nonneg.mpr h.le) + (sub_le_sub_right hab c) hbc' + simpa using H.neg_mem hmem + · rcases hbc with hbc | hbc + · rcases le_or_gt a c with h | h + · exact Or.inl h + refine Or.inr ?_ + have hab' : a - b ∈ H := by simpa using H.neg_mem hab + have hmem := AddSubgroup.mem_of_nonneg_of_le H (sub_nonneg.mpr h.le) + (sub_le_sub_left hbc a) hab' + simpa using H.neg_mem hmem + · exact Or.inr (by simpa using H.add_mem hbc hab) + le_antisymm := by + refine fun x y ↦ QuotientAddGroup.induction_on x fun a ↦ QuotientAddGroup.induction_on y + fun b hab hba ↦ ?_ + rw [mk_le_mk_iff] at hab hba + rw [QuotientAddGroup.eq_iff_sub_mem] + rcases hab with hab | hab + · rcases hba with hba | hba + · rw [le_antisymm hab hba, sub_self] + exact H.zero_mem + · exact hba + · simpa using H.neg_mem hab + le_total := by + refine fun x y ↦ QuotientAddGroup.induction_on x fun a ↦ QuotientAddGroup.induction_on y + fun b ↦ ?_ + rcases le_total a b with h | h + · exact Or.inl (mk_le_mk h) + · exact Or.inr (mk_le_mk h) + toDecidableLE := Classical.decRel _ + +instance instIsOrderedAddMonoid : IsOrderedAddMonoid (G ⧸ H) where + add_le_add_left := by + refine fun x y ↦ QuotientAddGroup.induction_on x fun a ↦ QuotientAddGroup.induction_on y + fun b hab z ↦ QuotientAddGroup.induction_on z fun c ↦ ?_ + rw [mk_le_mk_iff] at hab + have hc : ((a + c : G) : G ⧸ H) ≤ ((b + c : G) : G ⧸ H) := by + rw [mk_le_mk_iff] + rcases hab with hab | hab + · exact Or.inl (add_le_add hab le_rfl) + · exact Or.inr (by simpa using hab) + simpa using hc + +/-- **The projection reflects the strict order.** Two representatives whose cosets are strictly +comparable are themselves strictly comparable. -/ +theorem lt_of_mk_lt_mk {a b : G} (h : (a : G ⧸ H) < (b : G ⧸ H)) : a < b := by + rcases mk_le_mk_iff.mp h.le with hab | hab + · refine hab.lt_of_ne fun hEq ↦ ?_ + exact absurd (le_of_eq (congrArg _ hEq.symm)) (not_le.mpr h) + · exact absurd (mk_le_mk_iff.mpr (Or.inr (by simpa using H.neg_mem hab))) (not_le.mpr h) + +/-- One coset lies strictly below another exactly when the representatives do and their difference +escapes the subgroup. -/ +theorem mk_lt_mk_iff {a b : G} : + ((a : G ⧸ H) < (b : G ⧸ H)) ↔ a < b ∧ b - a ∉ H := by + refine ⟨fun h ↦ ⟨lt_of_mk_lt_mk h, fun hmem ↦ ?_⟩, fun ⟨hab, hmem⟩ ↦ ?_⟩ + · exact absurd (mk_le_mk_iff.mpr (Or.inr (by simpa using H.neg_mem hmem))) (not_le.mpr h) + · refine lt_of_le_of_ne (mk_le_mk hab.le) fun hEq ↦ hmem ?_ + simpa using H.neg_mem (QuotientAddGroup.eq_iff_sub_mem.mp hEq) + +/-- **Halving descends to the quotient.** If every positive element of `G` is twice a positive +element, the same holds in the quotient: a representative's half stays outside the subgroup, +since otherwise the representative itself would lie inside it. -/ +theorem exists_half_of_pos (hG : ∀ x : G, 0 < x → ∃ y, 0 < y ∧ y + y = x) {c : G ⧸ H} + (hc : 0 < c) : ∃ d : G ⧸ H, 0 < d ∧ d + d ≤ c := by + induction c using QuotientAddGroup.induction_on with + | H x => + have hpos : ((0 : G) : G ⧸ H) < (x : G ⧸ H) := by + rw [QuotientAddGroup.mk_zero] + exact hc + have hxH : x ∉ H := by simpa using (mk_lt_mk_iff.mp hpos).2 + obtain ⟨y, hy, hyx⟩ := hG x (lt_of_mk_lt_mk hpos) + have hyH : y ∉ H := fun hmem ↦ hxH (hyx ▸ H.add_mem hmem hmem) + refine ⟨(y : G ⧸ H), ?_, ?_⟩ + · exact mk_lt_mk_iff.mpr ⟨hy, by simpa using hyH⟩ + · rw [← QuotientAddGroup.mk_add, hyx] + +end ConvexQuotient diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module.lean new file mode 100644 index 0000000000..b56d87f3ed --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ArchimedeanBallSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ConvexQuotientSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.Tests + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/ArchimedeanBallSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/ArchimedeanBallSplitting.lean new file mode 100644 index 0000000000..290e842e4b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/ArchimedeanBallSplitting.lean @@ -0,0 +1,165 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.Order.Module.Archimedean +public import Mathlib.Algebra.Order.Module.HahnEmbedding +public import Mathlib.Algebra.Order.Monoid.Prod +public import Mathlib.Algebra.Order.Hom.Monoid + +/-! +# Ordered splitting along an Archimedean class + +Let `M` be an ordered vector space over an Archimedean ordered division ring `K`. A choice of +`HahnEmbedding.ArchimedeanStrata K M` complements each open Archimedean ball inside its closed +ball. This file upgrades that algebraic complement to an ordered additive equivalence: the closed +ball is the lexicographic product of the chosen stratum, as the dominant coordinate, and the open +ball, as the infinitesimal coordinate. + +This is the ordered splitting in LM24, Fact 2.4.2(2). Mathlib supplies the complement and proves +that every nonzero element of a stratum has the corresponding Archimedean class. The strict-order +argument here records the convention that Mathlib orders Archimedean classes oppositely to LM24: +a larger Mathlib class consists of smaller elements. +-/ + +public section + +namespace HahnEmbedding.ArchimedeanStrata + +open FiniteArchimedeanClass + +variable {K M : Type*} [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup M] [LinearOrder M] [IsOrderedAddMonoid M] +variable [Module K M] [IsOrderedModule K M] + +private theorem abs_lt_abs_of_mk_lt_mk {s b : M} + (h : ArchimedeanClass.mk s < ArchimedeanClass.mk b) : |b| < |s| := by + simpa using ArchimedeanClass.mk_lt_mk.mp h 1 + +private theorem pos_add_of_abs_lt_abs {s b : M} (hs : 0 < s) (h : |b| < |s|) : + 0 < s + b := by + rw [abs_of_pos hs] at h + have hsb : -b < s := lt_of_le_of_lt (neg_le_abs b) h + have := add_lt_add_right hsb b + rwa [add_neg_cancel, add_comm] at this + +variable (u : HahnEmbedding.ArchimedeanStrata K M) (c : FiniteArchimedeanClass M) + +private theorem stratum_le_closedBall : u.stratum c ≤ closedBall K c := by + rw [← u.ball_sup_stratum_eq c] + exact le_sup_right + +private theorem ball_le_closedBall : ball K c ≤ closedBall K c := + (FiniteArchimedeanClass.ball_lt_closedBall (K := K)).le + +private theorem abs_lt_abs_of_mem {s b : M} (hs : s ∈ u.stratum c) (hs0 : s ≠ 0) + (hb : b ∈ ball K c) (hb0 : b ≠ 0) : |b| < |s| := by + refine abs_lt_abs_of_mk_lt_mk ?_ + have hsc : FiniteArchimedeanClass.mk s hs0 = c := + Subtype.ext (u.archimedeanClassMk_of_mem_stratum hs hs0) + have hcb : c < FiniteArchimedeanClass.mk b hb0 := + (FiniteArchimedeanClass.mem_ball_iff K).mp hb hb0 + rw [← hsc] at hcb + exact (FiniteArchimedeanClass.mk_lt_mk hs0 hb0).mp hcb + +private theorem pos_add_of_mem {s b : M} (hs : s ∈ u.stratum c) (hspos : 0 < s) + (hb : b ∈ ball K c) : 0 < s + b := by + rcases eq_or_ne b 0 with rfl | hb0 + · simpa using hspos + · exact pos_add_of_abs_lt_abs hspos (abs_lt_abs_of_mem u c hs hspos.ne' hb hb0) + +private def strataAdd : ((u.stratum c) ×ₗ (ball K c)) →+ (closedBall K c) where + toFun p := + ⟨((ofLex p).1 : M) + ((ofLex p).2 : M), + add_mem (stratum_le_closedBall u c (ofLex p).1.2) + (ball_le_closedBall c (ofLex p).2.2)⟩ + map_zero' := by ext; simp + map_add' p q := by + apply Subtype.ext + change ((ofLex p).1 : M) + (ofLex q).1 + (((ofLex p).2 : M) + (ofLex q).2) = + (((ofLex p).1 : M) + (ofLex p).2) + (((ofLex q).1 : M) + (ofLex q).2) + ac_rfl + +private theorem strataAdd_injective : Function.Injective (strataAdd u c) := by + intro p q hpq + have hdiff : ((ofLex p).1 : M) - (ofLex q).1 = (ofLex q).2 - (ofLex p).2 := by + have h := congrArg Subtype.val hpq + dsimp [strataAdd] at h + rw [sub_eq_sub_iff_add_eq_add] + simpa [add_comm] using h + have hzero : ((ofLex p).1 : M) - (ofLex q).1 = 0 := by + apply Submodule.disjoint_def.mp (u.disjoint_ball_stratum c) + · rw [hdiff] + exact sub_mem (ofLex q).2.2 (ofLex p).2.2 + · exact sub_mem (ofLex p).1.2 (ofLex q).1.2 + apply ofLex.injective + apply Prod.ext + · apply Subtype.ext + exact sub_eq_zero.mp hzero + · apply Subtype.ext + have h := congrArg Subtype.val hpq + dsimp [strataAdd] at h + rw [sub_eq_zero.mp hzero] at h + exact add_left_cancel h + +private theorem strataAdd_surjective : Function.Surjective (strataAdd u c) := by + intro x + have hx : (x : M) ∈ ball K c ⊔ u.stratum c := by + rw [u.ball_sup_stratum_eq c] + exact x.2 + obtain ⟨b, hb, s, hs, hbs⟩ := Submodule.mem_sup.mp hx + refine ⟨toLex (⟨s, hs⟩, ⟨b, hb⟩), ?_⟩ + apply Subtype.ext + dsimp [strataAdd] + simpa [add_comm] using hbs + +private theorem strataAdd_strictMono : StrictMono (strataAdd u c) := by + intro p q hpq + rcases Prod.Lex.lt_iff.mp hpq with hs | ⟨hs, hb⟩ + · rw [← sub_pos] + change 0 < (((ofLex q).1 : M) + (ofLex q).2) - + (((ofLex p).1 : M) + (ofLex p).2) + rw [show (((ofLex q).1 : M) + (ofLex q).2) - + (((ofLex p).1 : M) + (ofLex p).2) = + ((ofLex q).1 - (ofLex p).1 : M) + ((ofLex q).2 - (ofLex p).2) by abel] + apply pos_add_of_mem u c + · exact sub_mem (ofLex q).1.2 (ofLex p).1.2 + · exact sub_pos.mpr hs + · exact sub_mem (ofLex q).2.2 (ofLex p).2.2 + · change ((ofLex p).1 : M) + (ofLex p).2 < (ofLex q).1 + (ofLex q).2 + rw [hs] + have hb' : ((ofLex p).2 : M) < (ofLex q).2 := hb + simpa [add_comm] using add_lt_add_left hb' ((ofLex q).1 : M) + +/-- The lexicographic product of a chosen Archimedean stratum and its open ball is the +corresponding closed ball. The stratum is the dominant coordinate. -/ +noncomputable def stratumLexBallEquivClosedBall : + ((u.stratum c) ×ₗ (ball K c)) ≃+o (closedBall K c) := + { AddEquiv.ofBijective (strataAdd u c) ⟨strataAdd_injective u c, strataAdd_surjective u c⟩ with + map_le_map_iff' := (strataAdd_strictMono u c).le_iff_le } + +@[simp] +theorem stratumLexBallEquivClosedBall_apply (p : (u.stratum c) ×ₗ (ball K c)) : + stratumLexBallEquivClosedBall u c p = ((ofLex p).1 : M) + (ofLex p).2 := (rfl) + +/-- The closed Archimedean ball, split into its dominant stratum coordinate and infinitesimal +open-ball coordinate. -/ +noncomputable def closedBallEquivStratumLexBall : + (closedBall K c) ≃+o ((u.stratum c) ×ₗ (ball K c)) := + (stratumLexBallEquivClosedBall u c).symm + +@[simp] +theorem stratumLexBallEquivClosedBall_closedBallEquivStratumLexBall (x : closedBall K c) : + stratumLexBallEquivClosedBall u c (closedBallEquivStratumLexBall u c x) = x := + (stratumLexBallEquivClosedBall u c).apply_symm_apply x + +@[simp] +theorem closedBallEquivStratumLexBall_stratumLexBallEquivClosedBall + (p : (u.stratum c) ×ₗ (ball K c)) : + closedBallEquivStratumLexBall u c (stratumLexBallEquivClosedBall u c p) = p := + (stratumLexBallEquivClosedBall u c).symm_apply_apply p + +end HahnEmbedding.ArchimedeanStrata diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/ConvexQuotientSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/ConvexQuotientSplitting.lean new file mode 100644 index 0000000000..2bb7c24eea --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/ConvexQuotientSplitting.lean @@ -0,0 +1,171 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanQuotient +public import Mathlib.Algebra.Order.Module.Archimedean +public import Mathlib.Algebra.Order.Monoid.Prod +public import Mathlib.LinearAlgebra.Basis.VectorSpace +public import Mathlib.LinearAlgebra.Projection + +/-! +# Ordered splitting by a convex subspace + +A subspace of a vector space over a field has an algebraic complement. If the ambient additive +group is linearly ordered and the subspace is convex, this complement presents the ambient group +as the lexicographic product of the ordered quotient and the subspace. The quotient coordinate is +dominant. This additive splitting is what permits Hahn series to be regrouped by quotient cosets +without introducing a cocycle. + +For a family of finite Archimedean classes, `FiniteArchimedeanClass.tailSubmodule` equips their +common tail kernel with its natural subspace structure. Thus the generic splitting applies to the +limit-tail quotients used in the Cantor–Bendixson argument. +-/ + +open Set + +universe u v + +public noncomputable section + +namespace FiniteArchimedeanClass + +variable (K : Type v) {G : Type u} +variable [Field K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [PosSMulMono K G] + +/-- The common tail kernel of `T`, equipped with its natural `K`-subspace structure. -/ +def tailSubmodule (T : Set (FiniteArchimedeanClass G)) : Submodule K G where + __ := tailKernel T + smul_mem' k x hx := by + apply mem_tailKernel_iff.mpr + intro c + exact (mem_tailKernel_iff.mp hx c).trans (ArchimedeanClass.mk_le_mk_smul x k) + +/-- Membership in the common-tail subspace is membership in the underlying common-tail +kernel. -/ +@[simp] +theorem mem_tailSubmodule_iff {T : Set (FiniteArchimedeanClass G)} {x : G} : + x ∈ tailSubmodule K T ↔ x ∈ tailKernel T := + (Iff.rfl) + +@[simp] +theorem tailSubmodule_toAddSubgroup (T : Set (FiniteArchimedeanClass G)) : + (tailSubmodule K T).toAddSubgroup = tailKernel T := + (rfl) + +/-- The subspace form of the common tail kernel is convex. -/ +instance tailSubmodule_isConvex (T : Set (FiniteArchimedeanClass G)) : + (tailSubmodule K T).toAddSubgroup.IsConvex := by + rw [tailSubmodule_toAddSubgroup K T] + infer_instance + +end FiniteArchimedeanClass + +namespace Submodule + +variable {K : Type v} {G : Type u} +variable [Field K] [AddCommGroup G] [Module K G] +variable [LinearOrder G] [IsOrderedAddMonoid G] + +variable (P : Submodule K G) + +/-- A chosen linear complement of `P`. -/ +noncomputable def linearComplement : Submodule K G := + Classical.choose P.exists_isCompl + +omit [LinearOrder G] [IsOrderedAddMonoid G] in +/-- The chosen complement is complementary to `P`. -/ +theorem isCompl_linearComplement : IsCompl P (linearComplement P) := + Classical.choose_spec P.exists_isCompl + +/-- The quotient by `P`, identified linearly with the chosen complement. -/ +noncomputable def quotientLinearEquivComplement : (G ⧸ P) ≃ₗ[K] linearComplement P := + P.quotientEquivOfIsCompl (linearComplement P) (isCompl_linearComplement P) + +/-- Reassemble a quotient coordinate and a `P`-coordinate in the ambient vector space. -/ +noncomputable def quotientProdLinearEquiv : ((G ⧸ P) × P) ≃ₗ[K] G := + ((quotientLinearEquivComplement P).prodCongr (LinearEquiv.refl K P)).trans + ((linearComplement P).prodEquivOfIsCompl P (isCompl_linearComplement P).symm) + +omit [LinearOrder G] [IsOrderedAddMonoid G] in +/-- Reassembly has the prescribed quotient coordinate. -/ +@[simp] +theorem mk_quotientProdLinearEquiv (x : (G ⧸ P) × P) : + Quotient.mk (quotientProdLinearEquiv P x) = x.1 := by + rw [quotientProdLinearEquiv, LinearEquiv.trans_apply, LinearEquiv.prodCongr_apply, + Submodule.coe_prodEquivOfIsCompl'] + change QuotientAddGroup.mk' P.toAddSubgroup + ((quotientLinearEquivComplement P x.1 : G) + (x.2 : G)) = x.1 + rw [map_add, show QuotientAddGroup.mk' P.toAddSubgroup (x.2 : G) = 0 by + exact (Submodule.Quotient.mk_eq_zero P).mpr x.2.property, add_zero] + exact P.mk_quotientEquivOfIsCompl_apply (isCompl_linearComplement P) x.1 + +omit [LinearOrder G] [IsOrderedAddMonoid G] in +/-- Reassembling a zero quotient coordinate returns the subspace coordinate. -/ +@[simp] +theorem quotientProdLinearEquiv_zero_left (p : P) : + quotientProdLinearEquiv P (0, p) = (p : G) := by + rw [quotientProdLinearEquiv, LinearEquiv.trans_apply, LinearEquiv.prodCongr_apply, + Submodule.coe_prodEquivOfIsCompl'] + simp [quotientLinearEquivComplement] + +noncomputable local instance quotientLinearOrder [P.toAddSubgroup.IsConvex] : + LinearOrder (G ⧸ P) := + ConvexQuotient.instLinearOrder (H := P.toAddSubgroup) + +local instance submoduleIsOrderedAddMonoid : IsOrderedAddMonoid P := + AddSubgroup.instIsOrderedAddMonoid P.toAddSubgroup + +/-- A linearly ordered vector space is the lexicographic product of the quotient by a convex +subspace and that subspace. The quotient is the dominant coordinate. -/ +noncomputable def quotientLexEquiv [P.toAddSubgroup.IsConvex] : + ((G ⧸ P) ×ₗ P) ≃+o G := + { (quotientProdLinearEquiv P).toAddEquiv with + map_le_map_iff' := by + intro x y + apply (show StrictMono + (fun x : ((G ⧸ P) ×ₗ P) ↦ quotientProdLinearEquiv P (ofLex x)) by + intro x y hxy + rcases Prod.Lex.lt_iff.mp hxy with houter | ⟨houter, hinner⟩ + · have hq : + ((quotientProdLinearEquiv P (ofLex x) : G) : G ⧸ P.toAddSubgroup) < + ((quotientProdLinearEquiv P (ofLex y) : G) : G ⧸ P.toAddSubgroup) := by + change (Quotient.mk (quotientProdLinearEquiv P (ofLex x)) : G ⧸ P) < + Quotient.mk (quotientProdLinearEquiv P (ofLex y)) + rw [mk_quotientProdLinearEquiv, mk_quotientProdLinearEquiv] + exact houter + exact ConvexQuotient.lt_of_mk_lt_mk hq + · change quotientProdLinearEquiv P (ofLex x) < quotientProdLinearEquiv P (ofLex y) + simp only [quotientProdLinearEquiv, LinearEquiv.trans_apply, + LinearEquiv.prodCongr_apply, Submodule.coe_prodEquivOfIsCompl'] + rw [show (ofLex x).1 = (ofLex y).1 from houter] + simpa only [LinearEquiv.refl_apply, add_comm] using + add_lt_add_left (show ((ofLex x).2 : G) < ((ofLex y).2 : G) from hinner) + (quotientLinearEquivComplement P (ofLex y).1 : G)).le_iff_le } + +@[simp] +theorem quotientLexEquiv_apply [P.toAddSubgroup.IsConvex] (x : (G ⧸ P) ×ₗ P) : + quotientLexEquiv P x = quotientProdLinearEquiv P (ofLex x) := + (rfl) + +end Submodule + +namespace FiniteArchimedeanClass + +variable (K : Type v) {G : Type u} +variable [Field K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [PosSMulMono K G] + +/-- The ambient group split lexicographically into the quotient by its tail subspace and that +subspace. Its additive subgroup is propositionally equal to `tailKernel T`. -/ +noncomputable def tailQuotientLexEquiv (T : Set (FiniteArchimedeanClass G)) : + ((G ⧸ (tailSubmodule K T).toAddSubgroup) ×ₗ tailSubmodule K T) ≃+o G := + Submodule.quotientLexEquiv (tailSubmodule K T) + +end FiniteArchimedeanClass diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/Tests.lean new file mode 100644 index 0000000000..b6f59fa55a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/Tests.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.Tests.ArchimedeanBallSplitting + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/Tests/ArchimedeanBallSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/Tests/ArchimedeanBallSplitting.lean new file mode 100644 index 0000000000..16cc125168 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/Tests/ArchimedeanBallSplitting.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ArchimedeanBallSplitting + +/-! +# API checks for the ordered Archimedean splitting + +This file checks the public interface for the splitting of a closed Archimedean ball into its +stratum and open ball. The nondegenerate check has both coordinates unequal and moving in opposite +directions: the stratum coordinate increases while the open-ball coordinate decreases. The image +must increase, distinguishing the lexicographic order from the componentwise product order. +-/ + +public section + +namespace Tests + +open FiniteArchimedeanClass + +variable {K M : Type*} [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup M] [LinearOrder M] [IsOrderedAddMonoid M] +variable [Module K M] [IsOrderedModule K M] + +open HahnEmbedding in +/-- A strict increase in the stratum dominates a strict decrease in the open-ball coordinate. + +The two strict inequalities exclude equality in either coordinate, so this is not a zero or +one-coordinate smoke test. -/ +theorem archimedeanSplitting_stratum_dominates_ball + (u : ArchimedeanStrata K M) (c : FiniteArchimedeanClass M) + (s₁ s₂ : u.stratum c) (b₁ b₂ : ball K c) (hs : s₁ < s₂) (hb : b₂ < b₁) : + ArchimedeanStrata.stratumLexBallEquivClosedBall u c (toLex (s₁, b₁)) < + ArchimedeanStrata.stratumLexBallEquivClosedBall u c (toLex (s₂, b₂)) := by + have _ := hb + rw [map_lt_map_iff, Prod.Lex.toLex_lt_toLex] + exact Or.inl hs + +open HahnEmbedding in +theorem archimedeanSplitting_addition_formula + (u : ArchimedeanStrata K M) (c : FiniteArchimedeanClass M) + (s : u.stratum c) (b : ball K c) : + ArchimedeanStrata.stratumLexBallEquivClosedBall u c (toLex (s, b)) = + (s : M) + (b : M) := by + simp + +open HahnEmbedding in +theorem archimedeanSplitting_roundtrip + (u : ArchimedeanStrata K M) (c : FiniteArchimedeanClass M) (x : closedBall K c) : + ArchimedeanStrata.stratumLexBallEquivClosedBall u c + (ArchimedeanStrata.closedBallEquivStratumLexBall u c x) = x := by + simp + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring.lean new file mode 100644 index 0000000000..6b49352a1b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring.Hom + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring/Hom.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring/Hom.lean new file mode 100644 index 0000000000..04dc6cba66 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring/Hom.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring.Hom.OfInjectiveComp + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring/Hom/OfInjectiveComp.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring/Hom/OfInjectiveComp.lean new file mode 100644 index 0000000000..934406e238 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring/Hom/OfInjectiveComp.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.Ring.Hom.Defs + +/-! +# Ring homomorphisms detected through an injective homomorphism + +A map `s : A → B` whose composite with an injective ring homomorphism `g : B →+* C` is a ring +homomorphism `A →+* C` is itself a ring homomorphism: each axiom for `s` is the corresponding +axiom for `g ∘ s`, read back through the injectivity of `g`. + +This is how a homomorphism into a subring of a subring is built without elaborating the +homomorphism axioms inside the nested coercions: the axioms are checked after composing out to +an ambient ring where they are already known. +-/ + +public section + +namespace RingHom + +variable {A B C : Type*} [NonAssocSemiring A] [NonAssocSemiring B] [NonAssocSemiring C] + +/-- The ring homomorphism `s : A → B` detected by an injective ring homomorphism `g : B →+* C` +through which it factors a ring homomorphism `f : A →+* C`, so that `g (s a) = f a`. -/ +def ofInjectiveComp (g : B →+* C) (hg : Function.Injective g) (f : A →+* C) (s : A → B) + (hs : ∀ a, g (s a) = f a) : A →+* B where + toFun := s + map_one' := hg <| by rw [hs, map_one, map_one] + map_mul' x y := hg <| by rw [hs, map_mul, map_mul, hs, hs] + map_zero' := hg <| by rw [hs, map_zero, map_zero] + map_add' x y := hg <| by rw [hs, map_add, map_add, hs, hs] + +/-- The detected homomorphism is the given map. -/ +@[simp] +theorem ofInjectiveComp_apply (g : B →+* C) (hg : Function.Injective g) (f : A →+* C) + (s : A → B) (hs : ∀ a, g (s a) = f a) (a : A) : ofInjectiveComp g hg f s hs a = s a := + (rfl) + +/-- Composing the detected homomorphism with the detecting one recovers the factored +homomorphism. -/ +theorem comp_ofInjectiveComp (g : B →+* C) (hg : Function.Injective g) (f : A →+* C) + (s : A → B) (hs : ∀ a, g (s a) = f a) : g.comp (ofInjectiveComp g hg f s hs) = f := + RingHom.ext hs + +end RingHom + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Tests.lean new file mode 100644 index 0000000000..9e7a48d30e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Tests.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Tests.GeometricIntegrality + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Tests/GeometricIntegrality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Tests/GeometricIntegrality.lean new file mode 100644 index 0000000000..cc4df20bf4 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Tests/GeometricIntegrality.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GeometricIntegrality + +import Mathlib.Algebra.MvPolynomial.Division +import Mathlib.RingTheory.TensorProduct.Maps +import Mathlib.RingTheory.TensorProduct.MvPolynomial + +/-! +# API checks for geometric integrality + +The coefficient algebra is the nontrivial polynomial algebra `ℚ[V]`. After every field +extension `K / ℚ`, tensor commutativity and polynomial base change identify +`ℚ[V] ⊗[ℚ] K` with the domain `K[V]`. The geometric-integrality theorem is then applied to +the irreducible auxiliary polynomial `U`, proving that its coefficient extension generates a +prime ideal in `ℚ[V][U]`. + +Using a nontrivial coefficient algebra ensures that this client exercises scalar extension rather +than reducing geometric integrality to the base field itself. +-/ + +open scoped TensorProduct + +public noncomputable section + +namespace Tests + +/-- The polynomial coefficient algebra in the geometric-integrality fixture. -/ +abbrev GeometricCoefficientAlgebra := MvPolynomial (Fin 1) ℚ + +/-- A polynomial algebra over `ℚ` remains a domain after every field extension. -/ +theorem geometricCoefficientAlgebra_isGeometricallyIntegral : + Algebra.IsGeometricallyIntegral ℚ GeometricCoefficientAlgebra := by + rw [Algebra.isGeometricallyIntegral_iff] + intro K _ _ + let e : GeometricCoefficientAlgebra ⊗[ℚ] K ≃+* MvPolynomial (Fin 1) K := + (Algebra.TensorProduct.comm ℚ GeometricCoefficientAlgebra K).toRingEquiv.trans + (MvPolynomial.algebraTensorAlgEquiv ℚ K).toRingEquiv + exact e.toMulEquiv.isDomain (MvPolynomial (Fin 1) K) + +/-- The irreducible polynomial `U` over the base field. -/ +def geometricLinearPolynomial : MvPolynomial (Fin 1) ℚ := + MvPolynomial.X 0 + +theorem geometricLinearPolynomial_irreducible : + Irreducible geometricLinearPolynomial := by + exact MvPolynomial.X_prime.irreducible + +/-- Extending `U` to `ℚ[V][U]` and quotienting by it leaves a domain. -/ +theorem geometricLinearPolynomial_baseChange_quotient_isDomain : + IsDomain + (MvPolynomial (Fin 1) GeometricCoefficientAlgebra ⧸ + Ideal.span + {MvPolynomial.map (algebraMap ℚ GeometricCoefficientAlgebra) + geometricLinearPolynomial}) := + geometricCoefficientAlgebra_isGeometricallyIntegral + |>.isDomain_mvPolynomial_quotient_span_map + geometricLinearPolynomial_irreducible + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation.lean new file mode 100644 index 0000000000..d07bf9de80 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation.lean @@ -0,0 +1,30 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedValuation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.BasisOver +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGraded +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedMap +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeOver +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreePrincipalInitialIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeRepresentatives +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeScalar +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeSum +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeWeightedPolynomial +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.FiltrationDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.MaxAddDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.OfValuation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.QuotientDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.RV +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Residue +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.ResidueMathlib +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/AssociatedGradedDivisibility.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/AssociatedGradedDivisibility.lean new file mode 100644 index 0000000000..2b22524b9e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/AssociatedGradedDivisibility.lean @@ -0,0 +1,268 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedValuation + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.TrailingGrade +import Mathlib.Algebra.GroupWithZero.Divisibility +import Mathlib.Algebra.Ring.Divisibility.Basic + +/-! +# Divisibility in an associated graded ring + +This module equips an associated graded ring with its smallest nonzero grade and proves that this +grade is multiplicative. Comparing smallest and largest grades shows that nonzero factors of a +homogeneous product are themselves homogeneous. It follows that divisibility between homogeneous +classes is the same in the homogeneous-class monoid and in the ambient associated graded ring. +-/ + +universe u v + +public noncomputable section + +open scoped DirectSum + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + +variable (ν : MaxAddDegree R M) + +/-- The smallest nonzero grade of an associated-graded element, with top at zero. -/ +def associatedGradedTrailingValue + (x : ν.AssociatedGraded) : WithTop M := + DirectSum.trailingGrade ν.Component x + +@[simp] +theorem associatedGradedTrailingValue_zero : + ν.associatedGradedTrailingValue 0 = ⊤ := + DirectSum.trailingGrade_zero ν.Component + +@[simp] +theorem associatedGradedTrailingValue_eq_top_iff + (x : ν.AssociatedGraded) : + ν.associatedGradedTrailingValue x = ⊤ ↔ x = 0 := + DirectSum.trailingGrade_eq_top_iff ν.Component x + +omit [IsOrderedCancelAddMonoid M] in +theorem associatedGradedTrailingValue_eq_coe_iff + (x : ν.AssociatedGraded) (m : M) : + ν.associatedGradedTrailingValue x = (m : WithTop M) ↔ + x m ≠ 0 ∧ ∀ i, x i ≠ 0 → m ≤ i := + DirectSum.trailingGrade_eq_coe_iff ν.Component x m + +theorem min_le_associatedGradedTrailingValue_add + (x y : ν.AssociatedGraded) : + min (ν.associatedGradedTrailingValue x) (ν.associatedGradedTrailingValue y) ≤ + ν.associatedGradedTrailingValue (x + y) := + DirectSum.min_le_trailingGrade_add ν.Component x y + +/-- A graded element is zero or homogeneous exactly when its trailing and leading grades agree. -/ +theorem mem_homogeneousClasses_iff_extremeGrades + (x : ν.AssociatedGraded) : + x ∈ ν.homogeneousClasses ↔ + x = 0 ∨ ∃ m : M, + ν.associatedGradedTrailingValue x = m ∧ + ν.associatedGradedValue x = m := by + classical + constructor + · intro hx + rw [ν.mem_homogeneousClasses_iff] at hx + rcases hx with rfl | ⟨m, c, rfl⟩ + · exact Or.inl rfl + by_cases hc : c = 0 + · subst c + exact Or.inl ((DirectSum.of ν.Component m).map_zero) + · refine Or.inr ⟨m, DirectSum.trailingGrade_of ν.Component hc, ?_⟩ + apply (ν.associatedGradedValue_eq_coe_iff _ m).mpr + refine ⟨by simpa, ?_⟩ + intro i hi + have him : i = m := by + by_contra him + rw [DirectSum.of_eq_of_ne m i c him] at hi + exact hi rfl + exact him.le + · rintro (rfl | ⟨m, htrail, hlead⟩) + · exact (ν.mem_homogeneousClasses_iff 0).mpr (Or.inl rfl) + · rw [ν.mem_homogeneousClasses_iff] + refine Or.inr ⟨m, x m, ?_⟩ + apply DirectSum.ext + intro i + by_cases hi : i = m + · subst i + simp + · have hxi : x i = 0 := by + by_contra hxi + have hmi : m ≤ i := + (ν.associatedGradedTrailingValue_eq_coe_iff x m).mp htrail |>.2 i hxi + have him : i ≤ m := + (ν.associatedGradedValue_eq_coe_iff x m).mp hlead |>.2 i hxi + exact hi (le_antisymm him hmi) + rw [hxi] + exact (DirectSum.of_eq_of_ne m i (x m) hi).symm + +/-- A homogeneous class divides a graded element exactly when it divides every component. -/ +theorem homogeneous_dvd_iff_dvd_components + (x : ν.HomogeneousClasses) + (y : ν.AssociatedGraded) : + (x : ν.AssociatedGraded) ∣ y ↔ + ∀ m, (x : ν.AssociatedGraded) ∣ DirectSum.of ν.Component m (y m) := by + classical + have hxMem := x.property + rw [ν.mem_homogeneousClasses_iff] at hxMem + rcases hxMem with hx | ⟨m, c, hx⟩ + · change (x : ν.AssociatedGraded) = 0 at hx + rw [hx] + simp only [zero_dvd_iff] + constructor + · rintro rfl + simp + · intro h + apply DirectSum.ext + intro m + simpa using congrArg (fun z : ν.AssociatedGraded ↦ z m) (h m) + · change (x : ν.AssociatedGraded) = DirectSum.of ν.Component m c at hx + rw [hx] + exact DirectSum.of_dvd_iff_dvd_components ν.Component c y + +variable [ν.IsMultiplicative] + +@[simp] +theorem associatedGradedTrailingValue_mul + (x y : ν.AssociatedGraded) : + ν.associatedGradedTrailingValue (x * y) = + ν.associatedGradedTrailingValue x + ν.associatedGradedTrailingValue y := + DirectSum.trailingGrade_mul ν.Component + (fun a b ha hb ↦ ν.componentMul_ne_zero a b ha hb) x y + +/-- Nonzero factors of a homogeneous product are homogeneous. -/ +theorem mem_homogeneousClasses_of_mul_mem + {x y : ν.AssociatedGraded} + (hx : x ≠ 0) (hy : y ≠ 0) (hxy : x * y ∈ ν.homogeneousClasses) : + x ∈ ν.homogeneousClasses ∧ y ∈ ν.homogeneousClasses := by + obtain ⟨lx, hlx, hxlx⟩ := + DirectSum.exists_grade_eq_trailingGrade ν.Component hx + obtain ⟨ly, hly, hyly⟩ := + DirectSum.exists_grade_eq_trailingGrade ν.Component hy + have hxValueNe : ν.associatedGradedValue x ≠ ⊥ := + (ν.associatedGradedValue_eq_bot_iff x).not.mpr hx + obtain ⟨ux, huxCoe⟩ := WithBot.ne_bot_iff_exists.mp hxValueNe + have hux : ν.associatedGradedValue x = (ux : WithBot M) := huxCoe.symm + have hxux : x ux ≠ 0 := (ν.associatedGradedValue_eq_coe_iff x ux).mp hux |>.1 + have hyValueNe : ν.associatedGradedValue y ≠ ⊥ := + (ν.associatedGradedValue_eq_bot_iff y).not.mpr hy + obtain ⟨uy, huyCoe⟩ := WithBot.ne_bot_iff_exists.mp hyValueNe + have huy : ν.associatedGradedValue y = (uy : WithBot M) := huyCoe.symm + have hyuy : y uy ≠ 0 := (ν.associatedGradedValue_eq_coe_iff y uy).mp huy |>.1 + have hxy0 : x * y ≠ 0 := mul_ne_zero hx hy + rcases (ν.mem_homogeneousClasses_iff_extremeGrades (x * y)).mp hxy with + hzero | ⟨k, htrail, hlead⟩ + · exact (hxy0 hzero).elim + have hlxux : lx ≤ ux := by + exact (ν.associatedGradedValue_eq_coe_iff x ux).mp hux |>.2 lx hxlx + have hlyuy : ly ≤ uy := by + exact (ν.associatedGradedValue_eq_coe_iff y uy).mp huy |>.2 ly hyly + have hlx' : ν.associatedGradedTrailingValue x = (lx : WithTop M) := hlx + have hly' : ν.associatedGradedTrailingValue y = (ly : WithTop M) := hly + have hux' : ν.associatedGradedValue x = (ux : WithBot M) := hux + have huy' : ν.associatedGradedValue y = (uy : WithBot M) := huy + have hlow : lx + ly = k := by + apply WithTop.coe_injective + calc + ((lx + ly : M) : WithTop M) = + ν.associatedGradedTrailingValue x + + ν.associatedGradedTrailingValue y := by + rw [hlx', hly', WithTop.coe_add] + _ = ν.associatedGradedTrailingValue (x * y) := + (ν.associatedGradedTrailingValue_mul x y).symm + _ = (k : WithTop M) := htrail + have hhigh : ux + uy = k := by + apply WithBot.coe_injective + calc + ((ux + uy : M) : WithBot M) = + ν.associatedGradedValue x + ν.associatedGradedValue y := by + rw [hux', huy', WithBot.coe_add] + _ = ν.associatedGradedValue (x * y) := + (ν.associatedGradedValue_mul x y).symm + _ = (k : WithBot M) := hlead + have hsum : lx + ly = ux + uy := hlow.trans hhigh.symm + have hlxEq : lx = ux := by + apply le_antisymm hlxux + apply le_of_not_gt + intro hlxux' + exact (add_lt_add_of_lt_of_le hlxux' hlyuy).ne hsum + have hlyEq : ly = uy := by + apply le_antisymm hlyuy + apply le_of_not_gt + intro hlyuy' + exact (add_lt_add_of_le_of_lt hlxux hlyuy').ne hsum + constructor + · apply (ν.mem_homogeneousClasses_iff_extremeGrades x).mpr + exact Or.inr ⟨lx, hlx', by simpa [hlxEq] using hux'⟩ + · apply (ν.mem_homogeneousClasses_iff_extremeGrades y).mpr + exact Or.inr ⟨ly, hly', by simpa [hlyEq] using huy'⟩ + +/-- Divisibility between homogeneous classes agrees with ambient graded-ring divisibility. -/ +theorem homogeneous_dvd_iff_associatedGraded_dvd + (x y : ν.HomogeneousClasses) : + x ∣ y ↔ (x : ν.AssociatedGraded) ∣ (y : ν.AssociatedGraded) := by + constructor + · rintro ⟨z, rfl⟩ + exact ⟨z, rfl⟩ + · rintro ⟨z, hz⟩ + by_cases hx : x = 0 + · subst x + have hy : y = 0 := by + apply Subtype.ext + change (y : ν.AssociatedGraded) = 0 + change (y : ν.AssociatedGraded) = 0 * z at hz + simpa only [zero_mul] using hz + subst y + exact dvd_zero 0 + by_cases hy : y = 0 + · subst y + exact dvd_zero x + have hxCoe : (x : ν.AssociatedGraded) ≠ 0 := fun h ↦ hx (Subtype.ext h) + have hyCoe : (y : ν.AssociatedGraded) ≠ 0 := fun h ↦ hy (Subtype.ext h) + have hz0 : z ≠ 0 := by + intro hz0 + rw [hz0, mul_zero] at hz + exact hyCoe hz + have hzMem : z ∈ ν.homogeneousClasses := + (ν.mem_homogeneousClasses_of_mul_mem hxCoe hz0 (hz ▸ y.2)).2 + refine ⟨⟨z, hzMem⟩, ?_⟩ + apply Subtype.ext + exact hz + +/-- Divisibility in RV agrees with divisibility after the canonical embedding into the +associated graded ring. -/ +theorem rv_dvd_iff_associatedGraded_dvd + (x y : ν.RV) : + x ∣ y ↔ ν.rvInitialFormHom x ∣ ν.rvInitialFormHom y := by + calc + x ∣ y ↔ ν.rvEquivHomogeneous x ∣ ν.rvEquivHomogeneous y := + (map_dvd_iff ν.rvEquivHomogeneous).symm + _ ↔ ((ν.rvEquivHomogeneous x : ν.HomogeneousClasses) : ν.AssociatedGraded) ∣ + ((ν.rvEquivHomogeneous y : ν.HomogeneousClasses) : ν.AssociatedGraded) := + ν.homogeneous_dvd_iff_associatedGraded_dvd + (ν.rvEquivHomogeneous x) (ν.rvEquivHomogeneous y) + _ ↔ ν.rvInitialFormHom x ∣ ν.rvInitialFormHom y := by + rw [ν.rvEquivHomogeneous_apply, ν.rvEquivHomogeneous_apply, + ν.coe_rvHomogeneous, ν.coe_rvHomogeneous] + +/-- An RV class divides a graded element exactly when it divides every homogeneous component +after the canonical embedding into the associated graded ring. -/ +theorem rv_dvd_iff_dvd_components + (x : ν.RV) (y : ν.AssociatedGraded) : + ν.rvInitialFormHom x ∣ y ↔ + ∀ m, ν.rvInitialFormHom x ∣ DirectSum.of ν.Component m (y m) := by + simpa only [ν.rvEquivHomogeneous_apply, ν.coe_rvHomogeneous] using + ν.homogeneous_dvd_iff_dvd_components (ν.rvEquivHomogeneous x) y + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/AssociatedGradedValuation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/AssociatedGradedValuation.lean new file mode 100644 index 0000000000..fd4a10a798 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/AssociatedGradedValuation.lean @@ -0,0 +1,136 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.LeadingGrade +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.RV +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain + +/-! +# The valuation on an associated graded ring + +The largest nonzero grade of an associated-graded element is a max-additive degree on +`ν.AssociatedGraded` for every max-additive degree `ν`: products of homogeneous components land +in the sum grade, so the leading grade is submultiplicative. It is separated because direct-sum +support is finite, independently of whether `ν` is separated. For a multiplicative `ν`, +multiplication of nonzero homogeneous classes is nonzero, and the leading grade is multiplicative. + +This is the valuation constructed in LM24, Definition 4.3.4 and Proposition 4.3.5. The degree of +an initial form is the degree of its representative, so iteration retains the original +homogeneous data. +-/ + +universe u v + +public noncomputable section + +open scoped DirectSum + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + +variable (ν : MaxAddDegree R M) + +/-- The largest nonzero grade of an associated-graded element. -/ +def associatedGradedValue (x : ν.AssociatedGraded) : WithBot M := + DirectSum.leadingGrade ν.Component x + +@[simp] +theorem associatedGradedValue_zero : ν.associatedGradedValue 0 = ⊥ := + DirectSum.leadingGrade_zero ν.Component + +@[simp] +theorem associatedGradedValue_eq_bot_iff (x : ν.AssociatedGraded) : + ν.associatedGradedValue x = ⊥ ↔ x = 0 := + DirectSum.leadingGrade_eq_bot_iff ν.Component x + +omit [IsOrderedCancelAddMonoid M] in +theorem associatedGradedValue_eq_coe_iff (x : ν.AssociatedGraded) (m : M) : + ν.associatedGradedValue x = (m : WithBot M) ↔ + x m ≠ 0 ∧ ∀ i, x i ≠ 0 → i ≤ m := + DirectSum.leadingGrade_eq_coe_iff ν.Component x m + +theorem associatedGradedValue_add_le_max (x y : ν.AssociatedGraded) : + ν.associatedGradedValue (x + y) ≤ + max (ν.associatedGradedValue x) (ν.associatedGradedValue y) := + DirectSum.leadingGrade_add_le_max ν.Component x y + +omit [IsOrderedCancelAddMonoid M] in +@[simp] +theorem associatedGradedValue_neg (x : ν.AssociatedGraded) : + ν.associatedGradedValue (-x) = ν.associatedGradedValue x := + DirectSum.leadingGrade_neg ν.Component x + +/-- The leading grade of an initial form is the degree of its representative. -/ +@[simp] +theorem associatedGradedValue_initialForm (x : R) : + ν.associatedGradedValue (ν.initialForm x) = ν x := by + by_cases hx : ν x = ⊥ + · rw [ν.initialForm_eq_zero_of_eq_bot hx, ν.associatedGradedValue_zero, hx] + · have hc : ν.componentMk ((ν x).unbot hx) (ν.initialRepresentative x hx) ≠ 0 := by + intro hzero + apply ν.initialForm_ne_zero_of_ne_bot hx + rw [ν.initialForm_eq_homogeneousMk_of_ne_bot hx, ν.homogeneousMk_apply, hzero, + (DirectSum.of ν.Component _).map_zero] + rw [ν.initialForm_eq_homogeneousMk_of_ne_bot hx, ν.homogeneousMk_apply, + associatedGradedValue] + rw [DirectSum.leadingGrade_of ν.Component hc, WithBot.coe_unbot] + +/-- The leading grade of the unit is the degree of the unit: zero, unless the degree is the +degenerate one that is bottom everywhere, in which case the graded ring is trivial. -/ +@[simp] +theorem associatedGradedValue_one : + ν.associatedGradedValue 1 = ν 1 := by + rw [← ν.initialForm_one, ν.associatedGradedValue_initialForm] + +/-- The leading grade of a product is at most the sum of the leading grades: products of +homogeneous components land in the sum grade. -/ +theorem associatedGradedValue_mul_le (x y : ν.AssociatedGraded) : + ν.associatedGradedValue (x * y) ≤ + ν.associatedGradedValue x + ν.associatedGradedValue y := + DirectSum.leadingGrade_mul_le ν.Component x y + +/-- The leading-grade degree on the associated graded ring, for LM24, Proposition 4.3.5. It is +a max-additive degree for every `ν`, and multiplicative when `ν` is. -/ +def associatedGradedValuation : MaxAddDegree ν.AssociatedGraded M where + toFun := ν.associatedGradedValue + map_zero' := ν.associatedGradedValue_zero + map_one_le_zero' := by + rw [ν.associatedGradedValue_one] + exact ν.map_one_le_zero + map_neg' := ν.associatedGradedValue_neg + map_add_le_max' := ν.associatedGradedValue_add_le_max + map_mul_le_add' := ν.associatedGradedValue_mul_le + +@[simp] +theorem associatedGradedValuation_apply (x : ν.AssociatedGraded) : + ν.associatedGradedValuation x = ν.associatedGradedValue x := + (rfl) + +@[simp] +theorem associatedGradedValue_mul [ν.IsMultiplicative] (x y : ν.AssociatedGraded) : + ν.associatedGradedValue (x * y) = + ν.associatedGradedValue x + ν.associatedGradedValue y := + DirectSum.leadingGrade_mul ν.Component (fun a b ha hb ↦ ν.componentMul_ne_zero a b ha hb) x y + +/-- The leading-grade valuation of LM24, Proposition 4.3.5, is multiplicative for a multiplicative +degree. -/ +instance [ν.IsMultiplicative] : ν.associatedGradedValuation.IsMultiplicative := + ⟨ν.associatedGradedValue_mul⟩ + +/-- The leading-grade valuation is separated, regardless of whether `ν` is separated. -/ +theorem associatedGradedValuation_isSeparated : ν.associatedGradedValuation.IsSeparated := by + rw [isSeparated_iff] + intro x + rw [ν.associatedGradedValuation_apply, ν.associatedGradedValue_eq_bot_iff] + +theorem associatedGradedValuation_initialForm (x : R) : + ν.associatedGradedValuation (ν.initialForm x) = ν x := by + rw [ν.associatedGradedValuation_apply, ν.associatedGradedValue_initialForm] + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/BasisOver.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/BasisOver.lean new file mode 100644 index 0000000000..f172be5571 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/BasisOver.lean @@ -0,0 +1,687 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeOver +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeSum +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeScalar +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreePrincipalInitialIdeal +public import Mathlib.LinearAlgebra.Basis.Basic +public import Mathlib.LinearAlgebra.Finsupp.LinearCombination +public import Mathlib.RingTheory.TensorProduct.Maps +public import Mathlib.RingTheory.TensorProduct.Free +public import Mathlib.RingTheory.TensorProduct.Quotient + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Bases over a subalgebra and the associated graded ring of the degree over it + +Let `ν` be a separated multiplicative degree on a commutative ring `R` containing a ring `L` in +degree zero, and let `P` be an `L`-subalgebra of `R`. Suppose given elements `β i ∈ R` of degrees +`γ i` whose initial forms, together with the initial forms of `P`, generate the associated graded +ring freely in the sense of `IsBasisOver`. This is the paper's "basis over `S`": for +`R = K((ℝ^{≤0}))`, `ν = deg`, `P = S` and `β = (c_C)_{C ∈ 𝓒}` it says that `(c_C)_{C ∈ 𝓒}` is a +basis of `K((ℝ^{≤0}))` over `S` with `deg(∑ p_C c_C) = max (deg p_C ⊕ deg C)`. + +Then: + +* the degree of a `P`-combination `∑ pᵢ βᵢ` is `max (ν(pᵢ) + γᵢ)`, so the `β i` are a `P`-basis + of `R` (`IsBasisOver.basis`); +* the degree over `P`, `ν_P`, is the largest degree `γ i` of a basis vector occurring in the + expansion (`IsBasisOver.degreeOver_le_iff_forall_repr`); +* the associated graded ring `gr_{ν_P} R` is free over `P`, which sits in degree zero, on the + classes `β̄ i` of the `β i` in their degrees + (`IsBasisOver.closure_degreeOverSubalgebraHom_mul_layerClass_eq_top` and + `IsBasisOver.eq_zero_of_sum_degreeOverSubalgebraHom_mul_layerClass_eq_zero`); consequently every + additive map `C ⊗ P → gr_{ν_P} R` sending `c i ⊗ p` to `p β̄ i`, for a basis `c` of `C`, is + bijective (`IsBasisOver.bijective_of_tmul`); +* an element `a ∈ P` is prime in `R` whenever `gr_{ν_P} R` is identified with a tensor product + `C ⊗ P` carrying `1 ⊗ a` to the initial form of `a` for `ν_P`, and `C ⊗ P` and `C ⊗ (P ⧸ (a))` + are domains (`prime_coe_of_degreeOverGradedRingEquiv`); for the paper, `Θ : (P̂/I) ⊗_K S ≅ + gr_{deg_S} K((ℝ^{≤0}))`. + +Freeness rests on one computation: the class of any `t ∈ R` in degree `d` for `ν_P` is the sum +of the terms `pᵢ β̄ᵢ` of its expansion whose degree `γ i` is exactly `d`. +-/ + +universe u v w x + +open scoped TensorProduct + +public noncomputable section + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} {L : Type w} +variable [CommRing R] [AddCommMonoid M] [LinearOrder M] [IsOrderedCancelAddMonoid M] + +/-! ### The basis-over-`P` data -/ + +section Data + +variable [CommRing L] [Algebra L R] [WellFoundedLT M] {ι : Type x} + +/-- The hypotheses of the basis-over-`P` theorem: `ν` is separated, the `β i` have degrees `γ i`, +and their initial forms are a basis of the associated graded ring over the initial forms of +`P`. -/ +structure IsBasisOver (ν : MaxAddDegree R M) (P : Subalgebra L R) + (γ : ι → M) (β : ι → R) : Prop where + separated : ν.IsSeparated + degree_beta : ∀ i, ν (β i) = γ i + independent : ∀ (s : Finset ι) (p : ι → P), + ∑ i ∈ s, ν.initialForm (p i) * ν.initialForm (β i) = 0 → + ∀ i ∈ s, (p i : R) = 0 + spanning : ∀ (d : M) (g : ν.Component d), ∃ t ∈ Submodule.span P (Set.range β), + ∃ ht : t ∈ ν.filtrationLE d, ν.componentMk d ⟨t, ht⟩ = g + +variable {ν : MaxAddDegree R M} {P : Subalgebra L R} {γ : ι → M} {β : ι → R} + +namespace IsBasisOver + +omit [WellFoundedLT M] in +/-- Independence follows from independence of the initial forms of the `β i` over any set +containing the initial forms of `P`. -/ +theorem independent_of_forall_mem (hν : ν.IsSeparated) (S' : Set ν.AssociatedGraded) + (hP : ∀ p : P, ν.initialForm (p : R) ∈ S') + (hind : ∀ (s : Finset ι) (x : ι → ν.AssociatedGraded), (∀ i ∈ s, x i ∈ S') → + ∑ i ∈ s, x i * ν.initialForm (β i) = 0 → ∀ i ∈ s, x i = 0) + (s : Finset ι) (p : ι → P) + (h : ∑ i ∈ s, ν.initialForm (p i) * ν.initialForm (β i) = 0) : + ∀ i ∈ s, (p i : R) = 0 := fun i hi ↦ + (ν.initialForm_eq_zero_iff_of_isSeparated hν _).mp (hind s (fun i ↦ ν.initialForm (p i)) + (fun i _ ↦ hP (p i)) h i hi) + +omit [WellFoundedLT M] in +/-- Spanning follows from the associated graded ring being generated, as an abelian group, by +products of initial forms of `P` with initial forms of the `β i`. -/ +theorem spanning_of_forall_exists_sum [ν.IsMultiplicative] + (hspan : ∀ g : ν.AssociatedGraded, ∃ (κ : Type x) (_ : Fintype κ) (p : κ → P) (idx : κ → ι), + g = ∑ k, ν.initialForm (p k) * ν.initialForm (β (idx k))) + (d : M) (g : ν.Component d) : + ∃ t ∈ Submodule.span P (Set.range β), ∃ ht : t ∈ ν.filtrationLE d, + ν.componentMk d ⟨t, ht⟩ = g := by + classical + obtain ⟨κ, _, p, idx, hg⟩ := hspan (DirectSum.of ν.Component d g) + set y : κ → R := fun k ↦ (p k : R) * β (idx k) with hy + have hg' : DirectSum.of ν.Component d g = ∑ k, ν.initialForm (y k) := by + rw [hg] + exact Finset.sum_congr rfl fun k _ ↦ (ν.initialForm_mul _ _).symm + have hcomp : (DirectSum.of ν.Component d g) d = (∑ k, ν.initialForm (y k)) d := + congrArg (fun z : ν.AssociatedGraded ↦ z d) hg' + rw [DirectSum.of_eq_same, DirectSum.sum_apply] at hcomp + simp only [ν.initialForm_apply] at hcomp + rw [Finset.sum_dite, Finset.sum_const_zero, add_zero, ← map_sum] at hcomp + refine ⟨∑ k ∈ Finset.univ.filter (fun k ↦ ν (y k) = (d : WithBot M)), y k, ?_, ?_, ?_⟩ + · refine Submodule.sum_mem _ fun k _ ↦ ?_ + rw [hy] + change (p k) • β (idx k) ∈ _ + exact Submodule.smul_mem _ _ (Submodule.subset_span ⟨idx k, rfl⟩) + · exact (ν.filtrationLE d).sum_mem fun k hk ↦ + (ν.mem_filtrationLE_iff _ _).mpr (Finset.mem_filter.mp hk).2.le + · rw [hcomp] + congr 1 + apply Subtype.ext + rw [AddSubmonoidClass.coe_finsetSum] + simp only + exact (Finset.sum_attach _ y).symm + +variable (H : IsBasisOver ν P γ β) [ν.IsMultiplicative] +include H + +omit [WellFoundedLT M] in +theorem degree_coe_mul_beta (p : P) (i : ι) : ν ((p : R) * β i) = ν p + γ i := by + rw [ν.map_mul, H.degree_beta] + +omit [WellFoundedLT M] in +/-- The degree of a finite `P`-combination of the `β i` is the maximum of the termwise degrees +`ν(p i) + γ i`. -/ +theorem degree_finsupp_sum (f : ι →₀ P) : + ν (f.sum fun i p ↦ (p : R) * β i) = f.support.sup fun i ↦ ν (f i) + γ i := by + classical + by_cases hf : f = 0 + · subst hf + simp + have hne : f.support.Nonempty := Finsupp.support_nonempty_iff.mpr hf + obtain ⟨i₀, hi₀, hsup⟩ := Finset.exists_mem_eq_sup f.support hne fun i ↦ ν (f i) + γ i + rw [hsup] + have hfi₀ : (f i₀ : R) ≠ 0 := fun h ↦ Finsupp.mem_support_iff.mp hi₀ (Subtype.ext h) + obtain ⟨m₀, hm₀⟩ := WithBot.ne_bot_iff_exists.mp (ν.map_ne_bot_of_ne_zero H.separated hfi₀) + set d : M := m₀ + γ i₀ with hd + have hdcoe : ν (f i₀) + (γ i₀ : WithBot M) = (d : WithBot M) := by + rw [← hm₀, hd, WithBot.coe_add] + rw [hdcoe] + -- split the sum into the top-degree terms and the rest + set top := f.support.filter fun i ↦ ν (f i) + γ i = (d : WithBot M) with htop + have hsplit : (f.sum fun i p ↦ (p : R) * β i) = + (∑ i ∈ top, (f i : R) * β i) + + ∑ i ∈ f.support.filter (fun i ↦ ¬ ν (f i) + γ i = d), (f i : R) * β i := by + rw [Finsupp.sum, Finset.sum_filter_add_sum_filter_not] + have hle : ∀ i ∈ f.support, ν (f i) + γ i ≤ (d : WithBot M) := fun i hi ↦ by + rw [← hdcoe, ← hsup] + exact Finset.le_sup (f := fun i ↦ ν (f i) + γ i) hi + have hrest : + ν (∑ i ∈ f.support.filter (fun i ↦ ¬ ν (f i) + γ i = d), (f i : R) * β i) < + (d : WithBot M) := by + refine ν.degree_finsetSum_lt _ _ fun i hi ↦ ?_ + rw [Finset.mem_filter] at hi + rw [H.degree_coe_mul_beta] + exact lt_of_le_of_ne (hle i hi.1) hi.2 + have htopmem : ∀ i ∈ top, (f i : R) * β i ∈ ν.filtrationLE d := fun i hi ↦ by + rw [htop, Finset.mem_filter] at hi + exact (ν.mem_filtrationLE_iff _ _).mpr (by rw [H.degree_coe_mul_beta, hi.2]) + have htopsum : ∑ i ∈ top, (f i : R) * β i ∈ ν.filtrationLE d := + (ν.filtrationLE d).sum_mem htopmem + have hclass : ν.homogeneousMk d ⟨∑ i ∈ top, (f i : R) * β i, htopsum⟩ ≠ 0 := by + rw [ν.homogeneousMk_finsetSum top _ htopmem htopsum] + intro hzero + have hi₀top : i₀ ∈ top := by + rw [htop, Finset.mem_filter] + exact ⟨hi₀, hdcoe⟩ + refine hfi₀ (H.independent top (fun i ↦ f i) ?_ i₀ hi₀top) + rw [← hzero, ← Finset.sum_attach top] + refine Finset.sum_congr rfl fun i _ ↦ ?_ + rw [ν.homogeneousMk_eq_initialForm_of_degree_eq (htopmem i i.2) + (by rw [H.degree_coe_mul_beta]; exact (Finset.mem_filter.mp i.2).2), + ν.initialForm_mul] + have htopdeg : ν (∑ i ∈ top, (f i : R) * β i) = (d : WithBot M) := by + refine le_antisymm ((ν.mem_filtrationLE_iff _ _).mp htopsum) (not_lt.mp fun hlt ↦ ?_) + exact hclass (ν.homogeneousMk_eq_zero_of_degree_lt htopsum hlt) + rw [hsplit, ν.degree_add_eq_of_lt (by rw [htopdeg]; exact hrest), htopdeg] + +omit [WellFoundedLT M] in +/-- The `β i` are linearly independent over `P`. -/ +theorem linearIndependent : LinearIndependent P β := by + classical + rw [LinearIndependent, injective_iff_map_eq_zero] + intro f hf + have hsum : (f.sum fun i p ↦ (p : R) * β i) = 0 := by + rw [← hf, Finsupp.linearCombination_apply] + exact Finsupp.sum_congr fun i _ ↦ by rw [Algebra.smul_def]; rfl + have hdeg := H.degree_finsupp_sum f + rw [hsum, ν.map_zero] at hdeg + by_contra hne + obtain ⟨i, hi⟩ := Finsupp.support_nonempty_iff.mpr hne + have hfi : (f i : R) ≠ 0 := fun h ↦ Finsupp.mem_support_iff.mp hi (Subtype.ext h) + have hle : ν (f i) + γ i ≤ ⊥ := by + rw [hdeg] + exact Finset.le_sup (f := fun i ↦ ν (f i) + γ i) hi + obtain ⟨m, hm⟩ := WithBot.ne_bot_iff_exists.mp (ν.map_ne_bot_of_ne_zero H.separated hfi) + rw [← hm, ← WithBot.coe_add] at hle + exact absurd hle (not_le.mpr (WithBot.bot_lt_coe _)) + +omit [ν.IsMultiplicative] in +/-- The `β i` span `R` over `P`, by well-founded induction on the degree. -/ +theorem span_eq_top : Submodule.span P (Set.range β) = ⊤ := by + rw [eq_top_iff] + intro t _ + suffices h : ∀ (d : WithBot M) (t : R), ν t = d → t ∈ Submodule.span P (Set.range β) from + h (ν t) t rfl + intro d + induction d using WellFoundedLT.induction with + | _ d ih => + intro t ht + cases d with + | bot => rw [((isSeparated_iff ν).mp H.separated t).mp ht]; exact Submodule.zero_mem _ + | coe m => + have hmem : t ∈ ν.filtrationLE m := (ν.mem_filtrationLE_iff _ _).mpr ht.le + obtain ⟨t', ht'span, ht'mem, ht'class⟩ := H.spanning m (ν.componentMk m ⟨t, hmem⟩) + have hdiff : ν (t - t') < (m : WithBot M) := by + have hsub : ν.componentMk m (⟨t, hmem⟩ - ⟨t', ht'mem⟩) = 0 := by + rw [map_sub, ht'class, sub_self] + exact (ν.componentMk_eq_zero_iff m _).mp hsub + have hrec := ih (ν (t - t')) hdiff (t - t') rfl + have : t = (t - t') + t' := by ring + rw [this] + exact Submodule.add_mem _ hrec ht'span + +/-- The basis of `R` over `P` given by the `β i`; for the paper, `(c_C)_{C ∈ 𝓒}` as a basis of +`K((ℝ^{≤0}))` over `S`. -/ +def basis : Module.Basis ι P R := + Module.Basis.mk H.linearIndependent (by rw [H.span_eq_top]) + +@[simp] +theorem basis_apply (i : ι) : H.basis i = β i := + Module.Basis.mk_apply _ _ i + +theorem sum_repr_mul_beta (t : R) : + (H.basis.repr t).sum (fun i p ↦ (p : R) * β i) = t := by + conv_rhs => rw [← H.basis.linearCombination_repr t] + rw [Finsupp.linearCombination_apply] + exact Finsupp.sum_congr fun i _ ↦ by rw [Algebra.smul_def, H.basis_apply]; rfl + +end IsBasisOver + +/-- A subalgebra `P` whose initial forms generate the associated graded ring as an abelian group +is the whole ring: the case `β = 1` of the basis-over-`P` theorem, proved directly by well-founded +induction on the degree. -/ +@[blueprint "lem:initial-forms-generate-subalgebra" + (phase := "Algebraic and ordinal preliminaries") + (title := "Lifting generation from the associated graded ring") + (statement := /-- + Let $\nu$ be a separated multiplicative degree on a ring $R$, with + well-founded value order, and let $P\subseteq R$ be a subalgebra. If every + element of $\operatorname{gr}_\nu R$ is a finite sum of initial forms of + elements of $P$, then $P=R$. + -/) + (proof := /-- + Use well-founded induction on $\nu(t)$. Express the initial form of $t$ as + a finite sum of initial forms of elements of $P$, and subtract their sum + $t'\in P$. Equality of initial forms gives $\nu(t-t')<\nu(t)$, so the + induction hypothesis puts $t-t'$ in $P$. Hence $t=(t-t')+t'$ lies in $P$. + Separatedness handles degree $\bot$. + -/)] +theorem mem_of_forall_exists_sum_initialForm [ν.IsMultiplicative] (hν : ν.IsSeparated) + (hspan : ∀ g : ν.AssociatedGraded, ∃ (κ : Type x) (_ : Fintype κ) (p : κ → P), + g = ∑ k, ν.initialForm (p k)) + (t : R) : t ∈ P := by + refine ν.mem_of_forall_exists_componentMk_eq hν P.toSubring.toAddSubgroup (fun d g ↦ ?_) t + obtain ⟨u, hu, hut, hmk⟩ := IsBasisOver.spanning_of_forall_exists_sum (ν := ν) (P := P) + (β := fun _ : PUnit.{x + 1} ↦ (1 : R)) + (fun g ↦ by + obtain ⟨κ, _, p, hg⟩ := hspan g + refine ⟨κ, inferInstance, p, fun _ ↦ PUnit.unit, ?_⟩ + simp only [ν.initialForm_one, mul_one] + exact hg) d g + refine ⟨u, ?_, hut, hmk⟩ + rw [Set.range_const, Submodule.mem_span_singleton] at hu + obtain ⟨a, rfl⟩ := hu + change (a : R) * 1 ∈ P + rw [mul_one] + exact a.2 + +end Data + +/-! ### Scalars on the associated graded ring `gr_{ν_P} R` -/ + +section Scalars + +variable [CommRing L] [Algebra L R] [FaithfulSMul L R] [Nontrivial R] [WellFoundedLT M] + [Fact (∀ m : M, 0 ≤ m)] +variable (ν : MaxAddDegree R M) (P : Subalgebra L R) + +omit [IsOrderedCancelAddMonoid M] [WellFoundedLT M] in +theorem zero_le_of_fact (m : M) : 0 ≤ m := (Fact.out : ∀ m : M, 0 ≤ m) m + +omit [Nontrivial R] in +theorem degreeOver_algebraMap_eq_zero' {l : L} (hl : l ≠ 0) : + ν.degreeOver P (algebraMap L R l) = 0 := + ν.degreeOver_algebraMap_eq_zero P (zero_le_of_fact) + (fun h ↦ hl ((FaithfulSMul.algebraMap_injective L R) + (h.trans (RingHom.map_zero (algebraMap L R)).symm))) + +omit [Nontrivial R] [FaithfulSMul L R] in +theorem degreeOver_coe_eq_zero' {p : P} (hp : p ≠ 0) : ν.degreeOver P (p : R) = 0 := + ν.degreeOver_coe_eq_zero P (zero_le_of_fact) fun h ↦ hp (Subtype.ext h) + +/-- The scalar homomorphism from `L` to `gr_{ν_P} R`. -/ +def degreeOverScalarHom : L →+* (ν.degreeOver P).AssociatedGraded := + degreeZeroScalarHom (ν.degreeOver P) (algebraMap L R) + fun _ hl ↦ ν.degreeOver_algebraMap_eq_zero' P hl + +/-- The `L`-algebra structure on `gr_{ν_P} R`. -/ +instance degreeOverAlgebra : Algebra L (ν.degreeOver P).AssociatedGraded := + (degreeOverScalarHom ν P).toAlgebra + +omit [Nontrivial R] in +theorem degreeOver_algebraMap_apply (l : L) (x : (ν.degreeOver P).filtrationLE 0) + (hx : (x : R) = algebraMap L R l) : + algebraMap L (ν.degreeOver P).AssociatedGraded l = (ν.degreeOver P).homogeneousMk 0 x := + degreeZeroScalarHom_apply _ _ _ l x hx + +/-- The homomorphism from `P` to degree zero of `gr_{ν_P} R`; for the paper, +`ψ : S → (gr_{deg_S})_0`. -/ +def degreeOverSubalgebraHom : P →+* (ν.degreeOver P).AssociatedGraded := + degreeZeroScalarHom (ν.degreeOver P) (algebraMap P R) + fun _ hp ↦ ν.degreeOver_coe_eq_zero' P hp + +omit [Nontrivial R] [FaithfulSMul L R] in +theorem degreeOverSubalgebraHom_apply (p : P) (x : (ν.degreeOver P).filtrationLE 0) + (hx : (x : R) = p) : degreeOverSubalgebraHom ν P p = (ν.degreeOver P).homogeneousMk 0 x := + degreeZeroScalarHom_apply _ _ _ p x hx + +omit [Nontrivial R] [Fact (∀ m : M, 0 ≤ m)] [FaithfulSMul L R] in +theorem coe_mem_degreeOver_filtrationLE_zero (p : P) : (p : R) ∈ (ν.degreeOver P).filtrationLE 0 := + ((ν.degreeOver P).mem_filtrationLE_iff 0 p).mpr (ν.degreeOver_coe_le_zero P p) + +/-- The homomorphism `P → gr_{ν_P} R` as an `L`-algebra homomorphism. -/ +def degreeOverSubalgebraAlgHom : P →ₐ[L] (ν.degreeOver P).AssociatedGraded := + { degreeOverSubalgebraHom ν P with + commutes' := fun l ↦ by + change degreeOverSubalgebraHom ν P (algebraMap L P l) = algebraMap L _ l + rw [degreeOverSubalgebraHom_apply ν P (algebraMap L P l) + ⟨algebraMap L R l, (ν.coe_mem_degreeOver_filtrationLE_zero P (algebraMap L P l))⟩ rfl, + degreeOver_algebraMap_apply ν P l + ⟨algebraMap L R l, (ν.coe_mem_degreeOver_filtrationLE_zero P (algebraMap L P l))⟩ rfl] } + +omit [Nontrivial R] in +theorem degreeOverSubalgebraAlgHom_apply (p : P) : + degreeOverSubalgebraAlgHom ν P p = degreeOverSubalgebraHom ν P p := (rfl) + +end Scalars + +/-! ### Freeness of `gr_{ν_P} R` over `P` -/ + +section Freeness + +variable [CommRing L] [Algebra L R] [WellFoundedLT M] [Fact (∀ m : M, 0 ≤ m)] +variable {ι : Type x} +variable {ν : MaxAddDegree R M} {P : Subalgebra L R} {γ : ι → M} {β : ι → R} + +namespace IsBasisOver + +variable (H : IsBasisOver ν P γ β) +include H + +omit [Fact (∀ m : M, 0 ≤ m)] in +theorem degreeOver_coe_mul_beta_le (p : P) (i : ι) : + ν.degreeOver P ((p : R) * β i) ≤ γ i := by + refine ((ν.degreeOver P).map_mul_le_add _ _).trans ?_ + calc ν.degreeOver P (p : R) + ν.degreeOver P (β i) ≤ 0 + (γ i : WithBot M) := + add_le_add (ν.degreeOver_coe_le_zero P p) + (ν.degreeOver_le_of_degree_le P (H.degree_beta i).le) + _ = γ i := zero_add _ + +omit [Fact (∀ m : M, 0 ≤ m)] in +theorem beta_mem_degreeOver_filtrationLE (i : ι) : β i ∈ (ν.degreeOver P).filtrationLE (γ i) := + ((ν.degreeOver P).mem_filtrationLE_iff _ _).mpr + (ν.degreeOver_le_of_degree_le P (H.degree_beta i).le) + +/-- The class `β̄ i` of `β i` in degree `γ i` of `gr_{ν_P} R`. -/ +def layerClass (i : ι) : (ν.degreeOver P).AssociatedGraded := + (ν.degreeOver P).homogeneousMk (γ i) ⟨β i, H.beta_mem_degreeOver_filtrationLE i⟩ + +omit [Fact (∀ m : M, 0 ≤ m)] in +theorem layerClass_eq (i : ι) : + H.layerClass i = + (ν.degreeOver P).homogeneousMk (γ i) ⟨β i, H.beta_mem_degreeOver_filtrationLE i⟩ := + (rfl) + +/-- The product of the degree-zero class of `p ∈ P` with `β̄ i` is the class of `p β i`. -/ +theorem degreeOverSubalgebraHom_mul_layerClass (p : P) (i : ι) : + degreeOverSubalgebraHom ν P p * H.layerClass i = + (ν.degreeOver P).homogeneousMk (γ i) + ⟨(p : R) * β i, ((ν.degreeOver P).mem_filtrationLE_iff _ _).mpr + (H.degreeOver_coe_mul_beta_le p i)⟩ := by + rw [degreeOverSubalgebraHom_apply ν P p ⟨(p : R), ν.coe_mem_degreeOver_filtrationLE_zero P p⟩ rfl, + layerClass] + exact ((ν.degreeOver P).homogeneousMk_mul_of_coe_eq (zero_add _).symm _ _ _ rfl).symm + +variable [ν.IsMultiplicative] + +/-- The `P`-submodule of elements whose expansion involves only `β i` with `γ i ≤ d`. -/ +private def coordSubmodule (d : M) : Submodule P R where + carrier := {t | ∀ i ∈ (H.basis.repr t).support, γ i ≤ d} + zero_mem' := by simp + add_mem' {a b} ha hb i hi := by + classical + rw [map_add] at hi + rcases Finset.mem_union.mp (Finsupp.support_add hi) with h | h + · exact ha i h + · exact hb i h + smul_mem' p t ht i hi := by + rw [map_smul] at hi + exact ht i (Finsupp.support_smul hi) + +theorem gamma_le_of_degree_le {t : R} {d : M} (ht : ν t ≤ d) : + ∀ i ∈ (H.basis.repr t).support, γ i ≤ d := by + intro i hi + have hdeg := H.degree_finsupp_sum (H.basis.repr t) + rw [H.sum_repr_mul_beta] at hdeg + have hfi : ((H.basis.repr t) i : R) ≠ 0 := + fun h ↦ Finsupp.mem_support_iff.mp hi (Subtype.ext h) + have h1 : ν ((H.basis.repr t) i) + γ i ≤ ν t := by + rw [hdeg] + exact Finset.le_sup (f := fun i ↦ ν ((H.basis.repr t) i) + γ i) hi + have h2 : ((γ i : M) : WithBot M) ≤ ν ((H.basis.repr t) i) + γ i := by + calc ((γ i : M) : WithBot M) = 0 + (γ i : WithBot M) := (zero_add _).symm + _ ≤ _ := add_le_add (ν.zero_le_degree H.separated (zero_le_of_fact) hfi) le_rfl + exact WithBot.coe_le_coe.mp (h2.trans (h1.trans ht)) + +/-- An element of degree at most `d` lies in `P` provided every `β i` with `γ i ≤ d` does. -/ +theorem mem_of_degree_le {t : R} {d : M} (ht : ν t ≤ d) + (hβ : ∀ i, γ i ≤ d → β i ∈ P) : t ∈ P := by + rw [← H.sum_repr_mul_beta t, Finsupp.sum] + exact Subalgebra.sum_mem _ fun i hi ↦ Subalgebra.mul_mem _ (Subtype.mem _) + (hβ i (H.gamma_le_of_degree_le ht i hi)) + +/-- The degree over `P` in the basis: `ν_P(t) ≤ d` exactly when every `β i` occurring in the +expansion of `t` has `γ i ≤ d`. -/ +theorem degreeOver_le_iff_forall_repr (t : R) (d : M) : + ν.degreeOver P t ≤ d ↔ ∀ i ∈ (H.basis.repr t).support, γ i ≤ d := by + rw [ν.degreeOver_le_iff] + constructor + · intro ht + refine ((ν.degreeOverStage_le_iff P (coordSubmodule H d) d).mpr ?_) ht + intro x hx + exact H.gamma_le_of_degree_le ((ν.mem_filtrationLE_iff d x).mp hx) + · intro h + rw [← H.sum_repr_mul_beta t, Finsupp.sum] + refine Submodule.sum_mem _ fun i hi ↦ ?_ + change ((H.basis.repr t) i) • β i ∈ _ + exact Submodule.smul_mem _ _ (ν.degreeOverStage_mono P (h i hi) + (ν.mem_degreeOverStage_of_degree_le P (H.degree_beta i).le)) + +theorem gamma_lt_of_degreeOver_lt {t : R} {d : M} (h : ν.degreeOver P t < d) : + ∀ i ∈ (H.basis.repr t).support, γ i < d := by + by_cases ht : t = 0 + · subst ht + simp + obtain ⟨m, hm, hmem⟩ := ν.exists_mem_degreeOverStage_of_degreeOver_lt P ht h + intro i hi + exact lt_of_le_of_lt ((H.degreeOver_le_iff_forall_repr t m).mp + ((ν.degreeOver_le_iff P t m).mpr hmem) i hi) hm + +/-- The class of `t` in degree `d` for `ν_P` is the sum of the terms `pᵢ β̄ᵢ` of its expansion +with `γ i = d`. -/ +theorem homogeneousMk_eq_sum (t : R) (d : M) + (ht : t ∈ (ν.degreeOver P).filtrationLE d) : + (ν.degreeOver P).homogeneousMk d ⟨t, ht⟩ = + ∑ i ∈ (H.basis.repr t).support.filter (fun i ↦ γ i = d), + degreeOverSubalgebraHom ν P ((H.basis.repr t) i) * H.layerClass i := by + classical + set f := H.basis.repr t with hf + have hγ : ∀ i ∈ f.support, γ i ≤ d := + (H.degreeOver_le_iff_forall_repr t d).mp + (((ν.degreeOver P).mem_filtrationLE_iff _ _).mp ht) + have hmem : ∀ i ∈ f.support, (f i : R) * β i ∈ (ν.degreeOver P).filtrationLE d := + fun i hi ↦ + ((ν.degreeOver P).mem_filtrationLE_iff _ _).mpr + ((H.degreeOver_coe_mul_beta_le (f i) i).trans (WithBot.coe_le_coe.mpr (hγ i hi))) + have hsum : ∑ i ∈ f.support, (f i : R) * β i ∈ (ν.degreeOver P).filtrationLE d := + ((ν.degreeOver P).filtrationLE d).sum_mem hmem + have ht' : (⟨t, ht⟩ : (ν.degreeOver P).filtrationLE d) = ⟨_, hsum⟩ := by + apply Subtype.ext + change t = ∑ i ∈ f.support, (f i : R) * β i + rw [← H.sum_repr_mul_beta t, Finsupp.sum] + rw [ht', (ν.degreeOver P).homogeneousMk_finsetSum f.support _ hmem hsum, Finset.sum_filter] + rw [← Finset.sum_attach f.support fun i ↦ if γ i = d then + degreeOverSubalgebraHom ν P (f i) * H.layerClass i else 0] + refine Finset.sum_congr rfl fun i _ ↦ ?_ + by_cases h : γ i = d + · rw [if_pos h] + subst h + rw [H.degreeOverSubalgebraHom_mul_layerClass] + · rw [if_neg h] + refine (ν.degreeOver P).homogeneousMk_eq_zero_of_degree_lt (hmem i i.2) ?_ + exact lt_of_le_of_lt (H.degreeOver_coe_mul_beta_le (f i) i) + (WithBot.coe_lt_coe.mpr (lt_of_le_of_ne (hγ i i.2) h)) + +/-- The classes `β̄ i` generate `gr_{ν_P} R` over `P`: every element is a finite sum of products +`p β̄ᵢ` with `p ∈ P`. -/ +theorem closure_degreeOverSubalgebraHom_mul_layerClass_eq_top : + AddSubmonoid.closure + (Set.range fun x : P × ι ↦ degreeOverSubalgebraHom ν P x.1 * H.layerClass x.2) = ⊤ := by + rw [eq_top_iff] + rintro z - + induction z using DirectSum.induction_on with + | zero => exact zero_mem _ + | of d g => + induction g using componentInductionOn with + | H x => + obtain ⟨t, ht⟩ := x + rw [← (ν.degreeOver P).homogeneousMk_apply, H.homogeneousMk_eq_sum] + exact sum_mem fun i _ ↦ AddSubmonoid.subset_closure ⟨(_, i), rfl⟩ + | add u v hu hv => exact add_mem hu hv + +/-- The classes `β̄ i` are independent over `P`: a vanishing finite combination `∑ pₖ β̄ₖ` has +every coefficient zero. -/ +theorem eq_zero_of_sum_degreeOverSubalgebraHom_mul_layerClass_eq_zero (s : Finset ι) (f : ι → P) + (h : ∑ k ∈ s, degreeOverSubalgebraHom ν P (f k) * H.layerClass k = 0) : + ∀ k ∈ s, f k = 0 := by + classical + have hmem : ∀ k, (f k : R) * β k ∈ (ν.degreeOver P).filtrationLE (γ k) := fun k ↦ + ((ν.degreeOver P).mem_filtrationLE_iff _ _).mpr (H.degreeOver_coe_mul_beta_le (f k) k) + have himage : ∑ k ∈ s, degreeOverSubalgebraHom ν P (f k) * H.layerClass k = + ∑ k ∈ s, (ν.degreeOver P).homogeneousMk (γ k) ⟨(f k : R) * β k, hmem k⟩ := + Finset.sum_congr rfl fun k _ ↦ H.degreeOverSubalgebraHom_mul_layerClass (f k) k + intro k₀ hk₀ + have hcomp : (∑ k ∈ s, degreeOverSubalgebraHom ν P (f k) * H.layerClass k) (γ k₀) = + (0 : (ν.degreeOver P).AssociatedGraded) (γ k₀) := congrArg (fun z ↦ z (γ k₀)) h + rw [himage, (ν.degreeOver P).homogeneousMk_finsetSum_apply s γ + (fun k ↦ (f k : R) * β k) hmem (γ k₀), DirectSum.zero_apply, + (ν.degreeOver P).componentMk_eq_zero_iff] at hcomp + set t := ∑ k ∈ s.filter (fun k ↦ γ k = γ k₀), (f k : R) * β k with ht + have hrepr : H.basis.repr t k₀ = f k₀ := by + have : t = ∑ k ∈ s.filter (fun k ↦ γ k = γ k₀), (f k) • H.basis k := by + refine Finset.sum_congr rfl fun k _ ↦ ?_ + rw [Algebra.smul_def, H.basis_apply] + rfl + rw [this, map_sum, Finsupp.finsetSum_apply, Finset.sum_eq_single k₀] + · rw [map_smul, Module.Basis.repr_self, Finsupp.smul_apply, Finsupp.single_eq_same, + smul_eq_mul, mul_one] + · intro k _ hk + rw [map_smul, Module.Basis.repr_self, Finsupp.smul_apply, Finsupp.single_eq_of_ne hk.symm, + smul_zero] + · intro h + exact absurd (Finset.mem_filter.mpr ⟨hk₀, rfl⟩ : k₀ ∈ s.filter (fun k ↦ γ k = γ k₀)) h + by_contra hne + have hsupp : k₀ ∈ (H.basis.repr t).support := by + rw [Finsupp.mem_support_iff, hrepr] + exact hne + exact lt_irrefl _ (H.gamma_lt_of_degreeOver_lt hcomp k₀ hsupp) + +section Bijective + +variable {L' : Type*} [CommRing L'] [Algebra L' P] {C : Type*} [CommRing C] [Algebra L' C] + (c : Module.Basis ι L' C) + {F : Type*} [FunLike F (C ⊗[L'] P) (ν.degreeOver P).AssociatedGraded] + [AddMonoidHomClass F (C ⊗[L'] P) (ν.degreeOver P).AssociatedGraded] + (Θ : F) + (hΘ : ∀ (i : ι) (p : P), Θ (c i ⊗ₜ[L'] p) = degreeOverSubalgebraHom ν P p * H.layerClass i) +include hΘ + +/-- A map `C ⊗ P → gr_{ν_P} R` sending `c i ⊗ p` to `p β̄ i` is surjective. -/ +theorem surjective_of_tmul : Function.Surjective Θ := by + intro z + have hz : z ∈ AddSubmonoid.closure + (Set.range fun x : P × ι ↦ degreeOverSubalgebraHom ν P x.1 * H.layerClass x.2) := by + rw [H.closure_degreeOverSubalgebraHom_mul_layerClass_eq_top] + exact AddSubmonoid.mem_top z + refine AddSubmonoid.closure_induction (fun y hy ↦ ?_) ⟨0, _root_.map_zero Θ⟩ + (fun _ _ _ _ ⟨a, ha⟩ ⟨b, hb⟩ ↦ ⟨a + b, by rw [map_add, ha, hb]⟩) hz + obtain ⟨⟨p, i⟩, rfl⟩ := hy + exact ⟨c i ⊗ₜ[L'] p, hΘ i p⟩ + +/-- A map `C ⊗ P → gr_{ν_P} R` sending `c i ⊗ p` to `p β̄ i` is injective. -/ +theorem injective_of_tmul : Function.Injective Θ := by + classical + rw [injective_iff_map_eq_zero] + intro x hx + set B := Algebra.TensorProduct.basis P c with hB + set x' := Algebra.TensorProduct.comm L' C P x with hx' + set f := B.repr x' with hf + -- expand `x` in the basis of `P ⊗[L'] C` + have hexp : x = ∑ k ∈ f.support, c k ⊗ₜ[L'] f k := by + have h1 : x' = ∑ k ∈ f.support, (f k : P) ⊗ₜ[L'] c k := by + conv_lhs => rw [← B.linearCombination_repr x', Finsupp.linearCombination_apply, Finsupp.sum] + refine Finset.sum_congr rfl fun k _ ↦ ?_ + rw [hB, Algebra.TensorProduct.basis_apply, TensorProduct.smul_tmul', smul_eq_mul, mul_one] + have h2 := congrArg (Algebra.TensorProduct.comm L' C P).symm h1 + rw [hx', AlgEquiv.symm_apply_apply, map_sum] at h2 + rw [h2] + exact Finset.sum_congr rfl fun k _ ↦ by rw [Algebra.TensorProduct.comm_symm_tmul] + have hcoord : ∀ k ∈ f.support, f k = 0 := by + refine H.eq_zero_of_sum_degreeOverSubalgebraHom_mul_layerClass_eq_zero f.support f ?_ + rw [← hx, hexp, map_sum] + exact Finset.sum_congr rfl fun k _ ↦ (hΘ k (f k)).symm + rw [hexp] + exact Finset.sum_eq_zero fun k hk ↦ by rw [hcoord k hk, TensorProduct.tmul_zero] + +/-- A map `C ⊗ P → gr_{ν_P} R` sending `c i ⊗ p` to `p β̄ i` is bijective: `gr_{ν_P} R` is free +over `P` on the classes `β̄ i`, and `C ⊗ P` is free over `P` on `c i ⊗ 1`. -/ +theorem bijective_of_tmul : Function.Bijective Θ := + ⟨H.injective_of_tmul c Θ hΘ, H.surjective_of_tmul c Θ hΘ⟩ + +end Bijective + +end IsBasisOver + +end Freeness + +/-! ### The prime criterion -/ + +section Prime + +variable [CommRing L] [Algebra L R] [WellFoundedLT M] +variable (ν : MaxAddDegree R M) (P : Subalgebra L R) +variable {L' : Type*} [CommRing L'] [Algebra L' P] {C : Type*} [CommRing C] [Algebra L' C] + +/-- The prime criterion: if `C ⊗[L'] P ≃ gr_{ν_P} R` as rings, with `1 ⊗ a ↦ in_{ν_P}(a)` (the +initial form of `a` for `ν_P`), then a non-zero `a ∈ P` is prime in `R` whenever `C ⊗[L'] P` and +`C ⊗[L'] (P ⧸ (a))` are domains. For the paper, `Θ : (P̂/I) ⊗_K S ≅ gr_{deg_S} K((ℝ^{≤0}))`. -/ +theorem prime_coe_of_degreeOverGradedRingEquiv + (Θ : C ⊗[L'] P ≃+* (ν.degreeOver P).AssociatedGraded) + (hΘ : ∀ a : P, Θ (1 ⊗ₜ[L'] a) = (ν.degreeOver P).initialForm a) + {a : P} (ha : a ≠ 0) [IsDomain (C ⊗[L'] P)] [IsDomain (C ⊗[L'] (P ⧸ Ideal.span {a}))] : + Prime (a : R) := by + classical + have hψsep : (ν.degreeOver P).IsSeparated := ν.degreeOver_isSeparated P + haveI : IsDomain (ν.degreeOver P).AssociatedGraded := Θ.symm.toMulEquiv.isDomain _ + -- the quotient by the initial form is a domain + have hmap : Ideal.span {(ν.degreeOver P).initialForm (a : R)} = + (Ideal.span ({1 ⊗ₜ[L'] a} : Set (C ⊗[L'] P))).map + (Θ : C ⊗[L'] P →+* (ν.degreeOver P).AssociatedGraded) := by + rw [Ideal.map_span, Set.image_singleton, ← hΘ] + rfl + have hmap' : (Ideal.span ({a} : Set P)).map + (Algebra.TensorProduct.includeRight : P →ₐ[L'] C ⊗[L'] P) = + Ideal.span ({1 ⊗ₜ[L'] a} : Set (C ⊗[L'] P)) := by + rw [Ideal.map_span, Set.image_singleton] + rfl + haveI : IsDomain ((C ⊗[L'] P) ⧸ Ideal.span ({1 ⊗ₜ[L'] a} : Set (C ⊗[L'] P))) := by + have e := Algebra.TensorProduct.tensorQuotientEquiv (R := L') L' P C (Ideal.span {a}) + rw [hmap'] at e + exact e.symm.toMulEquiv.isDomain _ + haveI : IsDomain ((ν.degreeOver P).AssociatedGraded ⧸ + Ideal.span {(ν.degreeOver P).initialForm (a : R)}) := + (Ideal.quotientEquiv _ _ Θ hmap).symm.toMulEquiv.isDomain _ + exact (ν.degreeOver P).prime_of_quotient_span_initialForm_isDomain hψsep + fun h ↦ ha (Subtype.ext h) + +/-- The prime criterion transported along an algebra isomorphism `P₀ ≃ P`: the domain +hypotheses may be verified on any model `P₀` of the subalgebra. -/ +theorem prime_coe_of_degreeOverGradedRingEquiv_of_algEquiv + (Θ : C ⊗[L'] P ≃+* (ν.degreeOver P).AssociatedGraded) + (hΘ : ∀ a : P, Θ (1 ⊗ₜ[L'] a) = (ν.degreeOver P).initialForm a) + {P₀ : Type*} [CommRing P₀] [Algebra L' P₀] (e : P₀ ≃ₐ[L'] P) + {a₀ : P₀} (ha₀ : a₀ ≠ 0) [IsDomain (C ⊗[L'] P₀)] + [IsDomain (C ⊗[L'] (P₀ ⧸ Ideal.span {a₀}))] : Prime ((e a₀ : P) : R) := by + have ha : e a₀ ≠ 0 := (map_ne_zero_iff e e.injective).mpr ha₀ + haveI : IsDomain (C ⊗[L'] P) := + (Algebra.TensorProduct.congr (AlgEquiv.refl (R := L') (A₁ := C)) e).symm.toMulEquiv.isDomain _ + have hmap : Ideal.span {e a₀} = (Ideal.span {a₀}).map (e : P₀ →+* P) := by + rw [Ideal.map_span, Set.image_singleton] + rfl + let eQ := Ideal.quotientEquivAlg (Ideal.span {a₀}) (Ideal.span {e a₀}) e hmap + haveI : IsDomain (C ⊗[L'] (P ⧸ Ideal.span {e a₀})) := + (Algebra.TensorProduct.congr (AlgEquiv.refl (R := L') (A₁ := C)) eQ).symm.toMulEquiv.isDomain _ + exact ν.prime_coe_of_degreeOverGradedRingEquiv P Θ hΘ ha + +end Prime + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGraded.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGraded.lean new file mode 100644 index 0000000000..8c0fc94472 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGraded.lean @@ -0,0 +1,496 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.MaxAddDegree +public import Mathlib.Algebra.DirectSum.Ring +public import Mathlib.GroupTheory.QuotientGroup.Defs + +/-! +# Associated graded ring of a max-additive degree + +For a max-additive degree `ν` and a grade `m`, the homogeneous component is the additive +quotient + +`ν.filtrationLE m / ν.filtrationLT m`. + +The strict filtration is represented inside the weak filtration by `lowerFiltration`. The mixed +strict product estimates derived from submultiplicativity make representative multiplication well +defined on these quotients. Their direct sum is `MaxAddDegree.AssociatedGraded ν` and inherits a +commutative ring structure. Exact multiplicativity is not needed for the construction; it enters +only where the graded ring is shown to be a domain. + +This quotient-first construction follows the quotient description given after LM24, Proposition +4.2.6. In particular, zero in every homogeneous component is the entire strict filtration, not +only the literal zero representative. The printed representative-dependent branch in LM24, +Definition 4.2.4 is not used; +`ConwayRefinement.Algebra.Valuation.Tests.AssociatedGraded` gives a compiled counterexample to +its commutativity. +-/ + +universe u v + +public noncomputable section + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + +/-- The additive subgroup of elements of degree at most `m`. -/ +def filtrationLE (ν : MaxAddDegree R M) (m : M) : AddSubgroup R where + carrier := {x | ν x ≤ m} + zero_mem' := by simp + add_mem' {x y} hx hy := (ν.map_add_le_max x y).trans (max_le hx hy) + neg_mem' {x} hx := by simpa using hx + +/-- The additive subgroup of elements of degree strictly below `m`. -/ +def filtrationLT (ν : MaxAddDegree R M) (m : M) : AddSubgroup R where + carrier := {x | ν x < m} + zero_mem' := by simp + add_mem' {x y} hx hy := (ν.map_add_le_max x y).trans_lt (max_lt hx hy) + neg_mem' {x} hx := by simpa using hx + +omit [IsOrderedCancelAddMonoid M] in +@[simp] +theorem mem_filtrationLE_iff (ν : MaxAddDegree R M) (m : M) (x : R) : + x ∈ ν.filtrationLE m ↔ ν x ≤ m := + Iff.rfl + +omit [IsOrderedCancelAddMonoid M] in +@[simp] +theorem mem_filtrationLT_iff (ν : MaxAddDegree R M) (m : M) (x : R) : + x ∈ ν.filtrationLT m ↔ ν x < m := + Iff.rfl + +omit [IsOrderedCancelAddMonoid M] in +theorem filtrationLT_le_filtrationLE (ν : MaxAddDegree R M) (m : M) : + ν.filtrationLT m ≤ ν.filtrationLE m := + fun x hx ↦ show ν x ≤ m from hx.le + +theorem degree_mul_le_add {ν : MaxAddDegree R M} {m n : M} {x y : R} + (hx : ν x ≤ m) (hy : ν y ≤ n) : + ν (x * y) ≤ m + n := + (ν.map_mul_le_add x y).trans (add_le_add hx hy) + +theorem degree_mul_lt_add_of_lt_of_le {ν : MaxAddDegree R M} {m n : M} {x y : R} + (hx : ν x < m) (hy : ν y ≤ n) : + ν (x * y) < m + n := by + apply (ν.map_mul_le_add x y).trans_lt + by_cases hybot : ν y = ⊥ + · simp [hybot] + · exact WithBot.add_lt_add_of_lt_of_le hybot hx hy + +theorem degree_mul_lt_add_of_le_of_lt {ν : MaxAddDegree R M} {m n : M} {x y : R} + (hx : ν x ≤ m) (hy : ν y < n) : + ν (x * y) < m + n := by + apply (ν.map_mul_le_add x y).trans_lt + by_cases hxbot : ν x = ⊥ + · simp [hxbot] + · exact WithBot.add_lt_add_of_le_of_lt hxbot hx hy + +/-- Multiplication by a fixed weakly filtered representative. -/ +def mulFiltrationLE (ν : MaxAddDegree R M) {m n : M} + (x : ν.filtrationLE m) : ν.filtrationLE n →+ ν.filtrationLE (m + n) where + toFun y := ⟨(x : R) * (y : R), degree_mul_le_add x.2 y.2⟩ + map_zero' := by ext; exact mul_zero (x : R) + map_add' y z := by ext; exact mul_add (x : R) (y : R) (z : R) + +@[simp] +theorem coe_mulFiltrationLE (ν : MaxAddDegree R M) {m n : M} + (x : ν.filtrationLE m) (y : ν.filtrationLE n) : + (ν.mulFiltrationLE x y : R) = (x : R) * (y : R) := + (rfl) + +/-- The strict filtration, regarded as a subgroup of the weak filtration at the same grade. -/ +def lowerFiltration (ν : MaxAddDegree R M) (m : M) : + AddSubgroup (ν.filtrationLE m) := + (ν.filtrationLT m).comap (ν.filtrationLE m).subtype + +omit [IsOrderedCancelAddMonoid M] in +@[simp] +theorem mem_lowerFiltration_iff (ν : MaxAddDegree R M) (m : M) + (x : ν.filtrationLE m) : + x ∈ ν.lowerFiltration m ↔ ν x < m := by + rw [lowerFiltration] + exact mem_filtrationLT_iff ν m x + +/-- The homogeneous associated-graded component at `m`. + +A `def` rather than an `abbrev`, with instances supplied below: every graded object here is built +from components, and a reducible head sends each instance search down through `filtrationLE` into +the subring of `R`. -/ +@[expose] def Component (ν : MaxAddDegree R M) (m : M) : Type u := + ν.filtrationLE m ⧸ ν.lowerFiltration m + +instance (ν : MaxAddDegree R M) (m : M) : AddCommGroup (ν.Component m) := + inferInstanceAs (AddCommGroup (ν.filtrationLE m ⧸ ν.lowerFiltration m)) + +/-- The quotient map from the weak filtration to its homogeneous component. -/ +def componentMk (ν : MaxAddDegree R M) (m : M) : + ν.filtrationLE m →+ ν.Component m := + QuotientAddGroup.mk' (ν.lowerFiltration m) + +/-- The class of a representative. -/ +instance (ν : MaxAddDegree R M) (m : M) : CoeTC (ν.filtrationLE m) (ν.Component m) := + ⟨QuotientAddGroup.mk⟩ + +omit [IsOrderedCancelAddMonoid M] in +/-- Every element of a homogeneous component is the class of a representative, with the motive +on the component rather than on the underlying quotient. -/ +@[elab_as_elim] +theorem componentInductionOn {ν : MaxAddDegree R M} {m : M} + {motive : ν.Component m → Prop} (x : ν.Component m) + (H : ∀ b : ν.filtrationLE m, motive (ν.componentMk m b)) : + motive x := + QuotientAddGroup.induction_on x H + +omit [IsOrderedCancelAddMonoid M] in +@[simp] +theorem coe_component_eq_componentMk (ν : MaxAddDegree R M) (m : M) + (x : ν.filtrationLE m) : + (x : ν.Component m) = ν.componentMk m x := + (rfl) + +omit [IsOrderedCancelAddMonoid M] in +@[simp] +theorem componentMk_eq_zero_iff (ν : MaxAddDegree R M) (m : M) + (x : ν.filtrationLE m) : + ν.componentMk m x = 0 ↔ ν x < m := by + change (QuotientAddGroup.mk x : + (ν.filtrationLE m) ⧸ ν.lowerFiltration m) = 0 ↔ _ + rw [QuotientAddGroup.eq_zero_iff] + exact mem_lowerFiltration_iff ν m x + +omit [IsOrderedCancelAddMonoid M] in +/-- Homogeneous quotient constructors with equal grades and equal representatives are +heterogeneously equal. -/ +theorem componentMk_heq_of_grade_eq_of_coe_eq (ν : MaxAddDegree R M) {m n : M} + (h : m = n) (x : ν.filtrationLE m) (y : ν.filtrationLE n) + (hxy : (x : R) = (y : R)) : + HEq (ν.componentMk m x) (ν.componentMk n y) := by + subst n + apply heq_of_eq + apply congrArg (ν.componentMk m) + exact Subtype.ext hxy + +omit [IsOrderedCancelAddMonoid M] in +/-- Two representatives have the same homogeneous class exactly when their difference lies in +the strict filtration. -/ +theorem componentMk_eq_componentMk_iff (ν : MaxAddDegree R M) (m : M) + (x y : ν.filtrationLE m) : + ν.componentMk m x = ν.componentMk m y ↔ ν ((x : R) - (y : R)) < m := by + rw [← sub_eq_zero, ← map_sub, ν.componentMk_eq_zero_iff] + rfl + +omit [IsOrderedCancelAddMonoid M] in +/-- Homogeneous classes at equal grades whose representatives differ by an element of the +strict filtration are heterogeneously equal. -/ +theorem componentMk_heq_of_grade_eq_of_sub_lt (ν : MaxAddDegree R M) {m n : M} + (hmn : m = n) (x : ν.filtrationLE m) (y : ν.filtrationLE n) + (hxy : ν ((x : R) - (y : R)) < m) : + HEq (ν.componentMk m x) (ν.componentMk n y) := by + subst n + apply heq_of_eq + rw [ν.componentMk_eq_componentMk_iff] + exact hxy + +omit [IsOrderedCancelAddMonoid M] in +/-- Heterogeneously equal homogeneous classes at equal grades have representatives differing by +an element of the strict filtration. -/ +theorem sub_lt_of_componentMk_heq (ν : MaxAddDegree R M) {m n : M} + (hmn : m = n) (x : ν.filtrationLE m) (y : ν.filtrationLE n) + (hxy : HEq (ν.componentMk m x) (ν.componentMk n y)) : + ν ((x : R) - (y : R)) < m := by + subst n + rw [← ν.componentMk_eq_componentMk_iff] + exact eq_of_heq hxy + +/-- Multiplication followed by projection to a homogeneous component. -/ +private def mulRepresentative (ν : MaxAddDegree R M) {m n : M} + (x : ν.filtrationLE m) : ν.filtrationLE n →+ ν.Component (m + n) := + (ν.componentMk (m + n)).comp (ν.mulFiltrationLE x) + +private theorem lowerFiltration_le_mulRepresentative_ker + (ν : MaxAddDegree R M) {m n : M} + (x : ν.filtrationLE m) : + ν.lowerFiltration n ≤ (ν.mulRepresentative x).ker := by + intro y hy + rw [AddMonoidHom.mem_ker, mulRepresentative, AddMonoidHom.comp_apply, + componentMk_eq_zero_iff] + simpa only [coe_mulFiltrationLE, WithBot.coe_add] using + degree_mul_lt_add_of_le_of_lt + ((mem_filtrationLE_iff ν m x).mp x.2) + ((mem_lowerFiltration_iff ν n y).mp hy) + +/-- Multiplication by a representative, descended in the right argument. -/ +private def mulRight (ν : MaxAddDegree R M) {m n : M} (x : ν.filtrationLE m) : + ν.Component n →+ ν.Component (m + n) := + QuotientAddGroup.lift (ν.lowerFiltration n) (ν.mulRepresentative x) + (ν.lowerFiltration_le_mulRepresentative_ker x) + +@[simp] +private theorem mulRight_componentMk (ν : MaxAddDegree R M) {m n : M} + (x : ν.filtrationLE m) (y : ν.filtrationLE n) : + ν.mulRight x (ν.componentMk n y) = + ν.componentMk (m + n) (ν.mulFiltrationLE x y) := by + rfl + +/-- The additive dependence of descended multiplication on its left representative. -/ +private def mulLeftRepresentative (ν : MaxAddDegree R M) {m n : M} : + ν.filtrationLE m →+ (ν.Component n →+ ν.Component (m + n)) where + toFun := ν.mulRight + map_zero' := by + apply AddMonoidHom.ext + intro y + induction y using QuotientAddGroup.induction_on with + | H y => + change ν.mulRight (0 : ν.filtrationLE m) (ν.componentMk n y) = 0 + rw [mulRight_componentMk] + rw [componentMk_eq_zero_iff] + simp + map_add' x y := by + apply AddMonoidHom.ext + intro z + induction z using QuotientAddGroup.induction_on with + | H z => + change ν.mulRight (x + y) (ν.componentMk n z) = + ν.mulRight x (ν.componentMk n z) + ν.mulRight y (ν.componentMk n z) + rw [mulRight_componentMk, mulRight_componentMk, mulRight_componentMk] + rw [← map_add] + apply congrArg (ν.componentMk (m + n)) + apply Subtype.ext + simp only [coe_mulFiltrationLE, AddSubgroup.coe_add, add_mul] + +private theorem lowerFiltration_le_mulLeftRepresentative_ker + (ν : MaxAddDegree R M) {m n : M} : + ν.lowerFiltration m ≤ (ν.mulLeftRepresentative (m := m) (n := n)).ker := by + intro x hx + rw [AddMonoidHom.mem_ker] + apply AddMonoidHom.ext + intro y + induction y using QuotientAddGroup.induction_on with + | H y => + change ν.mulRight x (ν.componentMk n y) = 0 + rw [mulRight_componentMk] + apply (componentMk_eq_zero_iff ν (m + n) _).mpr + simpa only [coe_mulFiltrationLE, WithBot.coe_add] using + degree_mul_lt_add_of_lt_of_le + ((mem_lowerFiltration_iff ν m x).mp hx) + ((mem_filtrationLE_iff ν n y).mp y.2) + +/-- Homogeneous multiplication on associated-graded components. -/ +private def componentMulHom (ν : MaxAddDegree R M) {m n : M} : + ν.Component m →+ (ν.Component n →+ ν.Component (m + n)) := + QuotientAddGroup.lift (ν.lowerFiltration m) + (ν.mulLeftRepresentative (m := m) (n := n)) + (ν.lowerFiltration_le_mulLeftRepresentative_ker (m := m) (n := n)) + +/-- Multiplication of two homogeneous associated-graded elements. -/ +def componentMul (ν : MaxAddDegree R M) {m n : M} + (x : ν.Component m) (y : ν.Component n) : ν.Component (m + n) := + ν.componentMulHom x y + +private theorem componentMul_eq (ν : MaxAddDegree R M) {m n : M} + (x : ν.Component m) (y : ν.Component n) : + ν.componentMul x y = ν.componentMulHom x y := + (rfl) + +@[simp] +theorem zero_componentMul (ν : MaxAddDegree R M) {m n : M} + (y : ν.Component n) : + ν.componentMul (0 : ν.Component m) y = 0 := by + rw [componentMul_eq] + exact DFunLike.congr_fun (ν.componentMulHom (m := m) (n := n)).map_zero y + +@[simp] +theorem componentMul_zero (ν : MaxAddDegree R M) {m n : M} + (x : ν.Component m) : + ν.componentMul x (0 : ν.Component n) = 0 := by + rw [componentMul_eq] + exact (ν.componentMulHom x).map_zero + +@[simp] +theorem componentMul_componentMk (ν : MaxAddDegree R M) {m n : M} + (x : ν.filtrationLE m) (y : ν.filtrationLE n) : + ν.componentMul (ν.componentMk m x) (ν.componentMk n y) = + ν.componentMk (m + n) (ν.mulFiltrationLE x y) := by + rfl + +/-- The multiplicative identity in the grade-zero component. -/ +def componentOne (ν : MaxAddDegree R M) : ν.Component 0 := + ν.componentMk 0 ⟨1, (ν.mem_filtrationLE_iff 0 1).mpr ν.map_one_le_zero⟩ + +omit [IsOrderedCancelAddMonoid M] in +@[simp] +theorem componentOne_eq_componentMk (ν : MaxAddDegree R M) : + ν.componentOne = + ν.componentMk 0 ⟨1, (ν.mem_filtrationLE_iff 0 1).mpr ν.map_one_le_zero⟩ := + (rfl) + +scoped instance (ν : MaxAddDegree R M) : GradedMonoid.GOne ν.Component where + one := ν.componentOne + +scoped instance (ν : MaxAddDegree R M) : GradedMonoid.GMul ν.Component where + mul := ν.componentMul + +open scoped MaxAddDegree + +/-- The graded commutative ring structure on the components. + +This instance is global so the ring structure on `AssociatedGraded` can be synthesized without +opening a scope. `GCommRing` also supplies `GMul` and `GOne` by projection; their standalone +instances remain scoped to avoid broad instance search on metavariable indices. -/ +instance (ν : MaxAddDegree R M) : DirectSum.GCommRing ν.Component where + mul := ν.componentMul + one := ν.componentOne + mul_zero := by + intro i j x + rw [componentMul_eq] + exact (ν.componentMulHom x).map_zero + zero_mul := by + intro i j y + rw [componentMul_eq] + exact DFunLike.congr_fun (ν.componentMulHom (m := i) (n := j)).map_zero y + mul_add := by + intro i j x y z + rw [componentMul_eq, componentMul_eq, componentMul_eq] + exact (ν.componentMulHom x).map_add y z + add_mul := by + intro i j x y z + rw [componentMul_eq, componentMul_eq, componentMul_eq] + exact DFunLike.congr_fun + ((ν.componentMulHom (m := i) (n := j)).map_add x y) z + one_mul := by + rintro ⟨m, x⟩ + induction x using QuotientAddGroup.induction_on with + | H x => + change GradedMonoid.mk (0 + m) + (ν.componentMul ν.componentOne (ν.componentMk m x)) = + GradedMonoid.mk m (ν.componentMk m x) + rw [componentOne_eq_componentMk, componentMul_componentMk] + apply Sigma.ext (zero_add m) + apply componentMk_heq_of_grade_eq_of_coe_eq ν (zero_add m) + simp + mul_one := by + rintro ⟨m, x⟩ + induction x using QuotientAddGroup.induction_on with + | H x => + change GradedMonoid.mk (m + 0) + (ν.componentMul (ν.componentMk m x) ν.componentOne) = + GradedMonoid.mk m (ν.componentMk m x) + rw [componentOne_eq_componentMk, componentMul_componentMk] + apply Sigma.ext (add_zero m) + apply componentMk_heq_of_grade_eq_of_coe_eq ν (add_zero m) + simp + mul_assoc := by + rintro ⟨i, x⟩ ⟨j, y⟩ ⟨k, z⟩ + induction x using QuotientAddGroup.induction_on with + | H x => + induction y using QuotientAddGroup.induction_on with + | H y => + induction z using QuotientAddGroup.induction_on with + | H z => + change GradedMonoid.mk ((i + j) + k) + (ν.componentMul + (ν.componentMul (ν.componentMk i x) (ν.componentMk j y)) + (ν.componentMk k z)) = + GradedMonoid.mk (i + (j + k)) + (ν.componentMul (ν.componentMk i x) + (ν.componentMul (ν.componentMk j y) (ν.componentMk k z))) + simp only [componentMul_componentMk] + apply Sigma.ext (add_assoc i j k) + apply componentMk_heq_of_grade_eq_of_coe_eq ν (add_assoc i j k) + simp only [coe_mulFiltrationLE, mul_assoc] + natCast := fun n ↦ n • ν.componentOne + natCast_zero := by simp + natCast_succ := by intros; simp [add_nsmul] + intCast := fun z ↦ z • ν.componentOne + intCast_ofNat := by intros; simp + intCast_negSucc_ofNat := by intros; simp + mul_comm := by + rintro ⟨i, x⟩ ⟨j, y⟩ + induction x using QuotientAddGroup.induction_on with + | H x => + induction y using QuotientAddGroup.induction_on with + | H y => + change GradedMonoid.mk (i + j) + (ν.componentMul (ν.componentMk i x) (ν.componentMk j y)) = + GradedMonoid.mk (j + i) + (ν.componentMul (ν.componentMk j y) (ν.componentMk i x)) + simp only [componentMul_componentMk] + apply Sigma.ext (add_comm i j) + apply componentMk_heq_of_grade_eq_of_coe_eq ν (add_comm i j) + simp only [coe_mulFiltrationLE, mul_comm] + +/-- `GAlgebra` and the direct sum's ring and algebra instances all take a `GSemiring` argument, +and reaching it through `GCommRing` rebuilds the componentwise multiplication each time. -/ +instance (ν : MaxAddDegree R M) : DirectSum.GSemiring ν.Component := + inferInstance + +instance (ν : MaxAddDegree R M) : DirectSum.GCommSemiring ν.Component := + inferInstance + +/-- The associated graded ring of a max-additive degree. -/ +abbrev AssociatedGraded (ν : MaxAddDegree R M) := + DirectSum M ν.Component + +/-- +The homogeneous map obtained by quotient projection to grade `m`, followed by the direct-sum +inclusion of that component. +-/ +def homogeneousMk (ν : MaxAddDegree R M) (m : M) : + ν.filtrationLE m →+ ν.AssociatedGraded := + (DirectSum.of ν.Component m).comp (ν.componentMk m) + +theorem homogeneousMk_apply (ν : MaxAddDegree R M) (m : M) + (x : ν.filtrationLE m) : + ν.homogeneousMk m x = DirectSum.of ν.Component m (ν.componentMk m x) := + (rfl) + +@[simp] +theorem homogeneousMk_eq_zero_iff (ν : MaxAddDegree R M) (m : M) + (x : ν.filtrationLE m) : + ν.homogeneousMk m x = 0 ↔ ν x < m := by + rw [ν.homogeneousMk_apply] + constructor + · intro hzero + apply (ν.componentMk_eq_zero_iff m x).mp + exact DirectSum.of_injective m (by simpa using hzero) + · intro hlt + rw [(ν.componentMk_eq_zero_iff m x).mpr hlt] + exact (DirectSum.of ν.Component m).map_zero + +@[simp] +theorem homogeneousMk_mul (ν : MaxAddDegree R M) {m n : M} + (x : ν.filtrationLE m) (y : ν.filtrationLE n) : + ν.homogeneousMk m x * ν.homogeneousMk n y = + ν.homogeneousMk (m + n) (ν.mulFiltrationLE x y) := by + rw [homogeneousMk, homogeneousMk, homogeneousMk, AddMonoidHom.comp_apply, + AddMonoidHom.comp_apply, AddMonoidHom.comp_apply, DirectSum.of_mul_of, + show GradedMonoid.GMul.mul _ _ = ν.componentMul _ _ from rfl, + componentMul_componentMk] + +/-- Homogeneous classes multiply as expected whenever the target index is the sum of the source +indices and the supplied target representative is their product. -/ +theorem homogeneousMk_mul_of_coe_eq (ν : MaxAddDegree R M) {m n p : M} (hp : p = m + n) + (x : ν.filtrationLE m) (y : ν.filtrationLE n) (z : ν.filtrationLE p) + (hz : (z : R) = (x : R) * (y : R)) : + ν.homogeneousMk p z = ν.homogeneousMk m x * ν.homogeneousMk n y := by + subst hp + rw [homogeneousMk_mul] + congr 1 + exact Subtype.ext (by rw [hz, coe_mulFiltrationLE]) + +/-- The grade-zero class of the multiplicative identity is the identity of the associated graded +ring. -/ +@[simp] +theorem homogeneousMk_one (ν : MaxAddDegree R M) : + ν.homogeneousMk 0 ⟨1, (ν.mem_filtrationLE_iff 0 1).mpr ν.map_one_le_zero⟩ = 1 := by + rw [homogeneousMk_apply, ← componentOne_eq_componentMk] + rfl + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedDomain.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedDomain.lean new file mode 100644 index 0000000000..8acb69ed3d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedDomain.lean @@ -0,0 +1,200 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.QuotientDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.LeadingGrade + +/-! +# Domain criterion for the associated graded ring of a degree function + +For a separated submultiplicative degree, every nonzero element has a nonzero homogeneous class +in its exact degree. If products of nonzero homogeneous components are nonzero, the +submultiplicative product inequality is therefore an equality. In particular, a domain associated +graded ring forces the original degree to be multiplicative. + +Applied to the least-representative degree on a quotient ring `R ⧸ I`, this shows that `R ⧸ I` +is a domain whenever the associated graded ring of that degree is one. The canonical isomorphism +of that associated graded ring with a quotient of `gr_ν R` is constructed separately. +-/ + +universe u v + +public noncomputable section + +namespace MaxAddDegree + +open scoped MaxAddDegree + +variable {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + +/-- No two nonzero homogeneous classes have zero product. -/ +def HomogeneousNoZeroDivisors (ν : MaxAddDegree R M) : Prop := + ∀ {m n : M} (x : ν.Component m) (y : ν.Component n), + x ≠ 0 → y ≠ 0 → ν.componentMul x y ≠ 0 + +theorem homogeneousNoZeroDivisors_iff (ν : MaxAddDegree R M) : + ν.HomogeneousNoZeroDivisors ↔ + ∀ {m n : M} (x : ν.Component m) (y : ν.Component n), + x ≠ 0 → y ≠ 0 → ν.componentMul x y ≠ 0 := + Iff.rfl + +/-- A domain associated graded ring has no homogeneous zero divisors. -/ +theorem homogeneousNoZeroDivisors_of_isDomain (ν : MaxAddDegree R M) + [IsDomain ν.AssociatedGraded] : + ν.HomogeneousNoZeroDivisors := by + rw [ν.homogeneousNoZeroDivisors_iff] + intro m n x y hx hy hxy + have hx' : DirectSum.of ν.Component m x ≠ 0 := + fun hzero ↦ hx (DirectSum.of_injective m (by simpa using hzero)) + have hy' : DirectSum.of ν.Component n y ≠ 0 := + fun hzero ↦ hy (DirectSum.of_injective n (by simpa using hzero)) + apply mul_ne_zero hx' hy' + rw [DirectSum.of_mul_of, + show GradedMonoid.GMul.mul x y = ν.componentMul x y from rfl, hxy] + exact (DirectSum.of ν.Component (m + n)).map_zero + +/-- A multiplicative degree has no nonzero homogeneous zero divisors. -/ +theorem homogeneousNoZeroDivisors_of_isMultiplicative + (ν : MaxAddDegree R M) [ν.IsMultiplicative] : + ν.HomogeneousNoZeroDivisors := by + rw [ν.homogeneousNoZeroDivisors_iff] + intro m n x y hx hy + induction x using QuotientAddGroup.induction_on with + | H x => + induction y using QuotientAddGroup.induction_on with + | H y => + rw [ν.coe_component_eq_componentMk] at hx + rw [ν.coe_component_eq_componentMk] at hy + have hxnotlt : ¬ν x < m := + fun hlt ↦ hx ((ν.componentMk_eq_zero_iff m x).mpr hlt) + have hynotlt : ¬ν y < n := + fun hlt ↦ hy ((ν.componentMk_eq_zero_iff n y).mpr hlt) + have hxdegree : ν x = (m : WithBot M) := + le_antisymm ((ν.mem_filtrationLE_iff m x).mp x.2) (le_of_not_gt hxnotlt) + have hydegree : ν y = (n : WithBot M) := + le_antisymm ((ν.mem_filtrationLE_iff n y).mp y.2) (le_of_not_gt hynotlt) + intro hzero + rw [ν.coe_component_eq_componentMk, ν.coe_component_eq_componentMk] at hzero + rw [ν.componentMul_componentMk, ν.componentMk_eq_zero_iff] at hzero + simp only [ν.coe_mulFiltrationLE] at hzero + rw [ν.map_mul, hxdegree, hydegree, WithBot.coe_add] at hzero + exact lt_irrefl _ hzero + +/-- Nonzero homogeneous classes of a multiplicative degree have nonzero product. -/ +theorem componentMul_ne_zero (ν : MaxAddDegree R M) [ν.IsMultiplicative] {m n : M} + (x : ν.Component m) (y : ν.Component n) (hx : x ≠ 0) (hy : y ≠ 0) : + ν.componentMul x y ≠ 0 := + ν.homogeneousNoZeroDivisors_iff.mp ν.homogeneousNoZeroDivisors_of_isMultiplicative x y hx hy + +/-- Multiplicativity of the degree prevents zero divisors in its associated graded ring. -/ +instance associatedGradedNoZeroDivisors + (ν : MaxAddDegree R M) [ν.IsMultiplicative] : + NoZeroDivisors ν.AssociatedGraded := + ⟨by + intro x y hxy + by_contra hnonzero + rw [not_or] at hnonzero + have hleading := DirectSum.leadingGrade_mul ν.Component + (fun a b ha hb ↦ ν.componentMul_ne_zero a b ha hb) x y + have hx : DirectSum.leadingGrade ν.Component x ≠ ⊥ := by + intro hxbot + exact hnonzero.1 ((DirectSum.leadingGrade_eq_bot_iff ν.Component x).mp hxbot) + have hy : DirectSum.leadingGrade ν.Component y ≠ ⊥ := by + intro hybot + exact hnonzero.2 ((DirectSum.leadingGrade_eq_bot_iff ν.Component y).mp hybot) + rw [hxy, DirectSum.leadingGrade_zero] at hleading + exact (WithBot.add_ne_bot.mpr ⟨hx, hy⟩) hleading.symm⟩ + +/-- Homogeneous non-zero-divisors force equality in the product-degree inequality. -/ +theorem degree_mul_eq_add_of_homogeneousNoZeroDivisors + (ν : MaxAddDegree R M) (hν : ν.IsSeparated) + (hgr : ν.HomogeneousNoZeroDivisors) {x y : R} + (hx : x ≠ 0) (hy : y ≠ 0) : + ν (x * y) = ν x + ν y := by + have hx' : ν x ≠ ⊥ := ν.map_ne_bot_of_ne_zero hν hx + have hy' : ν y ≠ ⊥ := ν.map_ne_bot_of_ne_zero hν hy + have hproduct : ν.componentMul + (ν.componentMk _ (ν.initialRepresentative x hx')) + (ν.componentMk _ (ν.initialRepresentative y hy')) ≠ 0 := + hgr _ _ (ν.componentMk_initialRepresentative_ne_zero x hx') + (ν.componentMk_initialRepresentative_ne_zero y hy') + apply le_antisymm + · exact ν.map_mul_le_add x y + · apply le_of_not_gt + intro hlt + apply hproduct + rw [ν.componentMul_componentMk, ν.componentMk_eq_zero_iff, ν.coe_mulFiltrationLE, + ν.coe_initialRepresentative, ν.coe_initialRepresentative, WithBot.coe_add, + WithBot.coe_unbot, WithBot.coe_unbot] + exact hlt + +/-- A separated degree whose associated graded ring has no homogeneous zero divisors is +multiplicative. -/ +theorem isMultiplicative_of_homogeneousNoZeroDivisors + (ν : MaxAddDegree R M) (hν : ν.IsSeparated) + (hgr : ν.HomogeneousNoZeroDivisors) : + ν.IsMultiplicative := by + rw [ν.isMultiplicative_iff] + intro x y + by_cases hx : x = 0 + · simp [hx] + by_cases hy : y = 0 + · simp [hy] + exact ν.degree_mul_eq_add_of_homogeneousNoZeroDivisors hν hgr hx hy + +/-- For a separated degree, multiplicativity is equivalent to absence of nonzero homogeneous +zero divisors. -/ +theorem isMultiplicative_iff_homogeneousNoZeroDivisors + (ν : MaxAddDegree R M) (hν : ν.IsSeparated) : + ν.IsMultiplicative ↔ ν.HomogeneousNoZeroDivisors := + ⟨fun _ ↦ ν.homogeneousNoZeroDivisors_of_isMultiplicative, + ν.isMultiplicative_of_homogeneousNoZeroDivisors hν⟩ + +/-- A separated degree is multiplicative when its associated graded ring is a domain. -/ +theorem isMultiplicative_of_associatedGraded_isDomain + (ν : MaxAddDegree R M) (hν : ν.IsSeparated) + [IsDomain ν.AssociatedGraded] : + ν.IsMultiplicative := + ν.isMultiplicative_of_homogeneousNoZeroDivisors hν + ν.homogeneousNoZeroDivisors_of_isDomain + +/-- A degree with a domain associated graded ring has a nontrivial source ring. -/ +theorem nontrivial_of_associatedGraded_isDomain + (ν : MaxAddDegree R M) [IsDomain ν.AssociatedGraded] : + Nontrivial R := by + apply not_subsingleton_iff_nontrivial.mp + intro hsub + letI : Subsingleton R := hsub + have hcomponent (m : M) (x y : ν.Component m) : x = y := by + induction x using QuotientAddGroup.induction_on with + | H x => + induction y using QuotientAddGroup.induction_on with + | H y => + exact congrArg (fun z : ν.filtrationLE m ↦ (z : ν.Component m)) + (Subtype.ext (Subsingleton.elim (x : R) (y : R))) + have hgraded : (1 : ν.AssociatedGraded) = 0 := + DirectSum.ext ν.Component (fun m ↦ hcomponent m _ _) + exact one_ne_zero hgraded + +variable [WellFoundedLT M] + +/-- If the associated graded ring of the least-representative quotient degree is a domain, then +the quotient ring is a domain. -/ +theorem quotient_isDomain_of_associatedGraded_isDomain + (ν : MaxAddDegree R M) (I : Ideal R) (hν : ν.IsSeparated) + [IsDomain (ν.quotient I hν).AssociatedGraded] : + IsDomain (R ⧸ I) := by + letI : Nontrivial (R ⧸ I) := + (ν.quotient I hν).nontrivial_of_associatedGraded_isDomain + haveI : (ν.quotient I hν).IsMultiplicative := + (ν.quotient I hν).isMultiplicative_of_associatedGraded_isDomain + (ν.quotient_isSeparated I hν) + exact ν.quotient_isDomain I hν + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedMap.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedMap.lean new file mode 100644 index 0000000000..d2764efc81 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedMap.lean @@ -0,0 +1,291 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm + +/-! +# Maps of associated graded rings + +A ring homomorphism that does not increase a max-additive degree sends each weak filtration and +each strict filtration into the corresponding target filtration. It therefore induces additive +maps on the homogeneous quotients and a graded ring homomorphism on their direct sums. Two cases +are used: a degree-preserving ring homomorphism between two filtered rings, and the identity of +one ring carrying a finer degree to a coarser one, `ν₂ ≤ ν₁` pointwise, which gives the canonical +map `gr_{ν₁} → gr_{ν₂}` between the two associated graded rings of the same ring. + +Exact preservation of degree makes every homogeneous component map injective, even if injectivity +of the original ring homomorphism has not been assumed separately. The resulting global graded +map is consequently injective. This functorial interface is used to compare a filtered ring with +its degree-zero localizations. +-/ + +open scoped MaxAddDegree + +universe u v w + +public noncomputable section + +namespace MaxAddDegree + +variable {R : Type u} {A : Type v} {M : Type w} +variable [CommRing R] [CommRing A] [AddCommMonoid M] +variable [LinearOrder M] [IsOrderedCancelAddMonoid M] + +/-- A degree-nonincreasing ring homomorphism restricted to a weak filtration. -/ +def mapFiltrationLE (νR : MaxAddDegree R M) (νA : MaxAddDegree A M) + (f : R →+* A) (hdegree : ∀ x, νA (f x) ≤ νR x) (m : M) : + νR.filtrationLE m →+ νA.filtrationLE m where + toFun x := ⟨f x, by + rw [νA.mem_filtrationLE_iff] + exact (hdegree x).trans ((νR.mem_filtrationLE_iff m x).mp x.2)⟩ + map_zero' := by ext; exact f.map_zero + map_add' x y := by ext; exact f.map_add x y + +omit [IsOrderedCancelAddMonoid M] in +@[simp] +theorem coe_mapFiltrationLE (νR : MaxAddDegree R M) (νA : MaxAddDegree A M) + (f : R →+* A) (hdegree : ∀ x, νA (f x) ≤ νR x) (m : M) + (x : νR.filtrationLE m) : + (νR.mapFiltrationLE νA f hdegree m x : A) = f x := + (rfl) + +omit [IsOrderedCancelAddMonoid M] in +private theorem lowerFiltration_le_componentRepresentative_ker + (νR : MaxAddDegree R M) (νA : MaxAddDegree A M) + (f : R →+* A) (hdegree : ∀ x, νA (f x) ≤ νR x) (m : M) : + νR.lowerFiltration m ≤ + ((νA.componentMk m).comp (νR.mapFiltrationLE νA f hdegree m)).ker := by + intro x hx + rw [AddMonoidHom.mem_ker, AddMonoidHom.comp_apply, + νA.componentMk_eq_zero_iff, coe_mapFiltrationLE] + exact (hdegree x).trans_lt ((νR.mem_lowerFiltration_iff m x).mp hx) + +/-- The map on a homogeneous quotient induced by a degree-nonincreasing ring homomorphism. -/ +def componentMap (νR : MaxAddDegree R M) (νA : MaxAddDegree A M) + (f : R →+* A) (hdegree : ∀ x, νA (f x) ≤ νR x) (m : M) : + νR.Component m →+ νA.Component m := + QuotientAddGroup.lift (νR.lowerFiltration m) + ((νA.componentMk m).comp (νR.mapFiltrationLE νA f hdegree m)) + (νR.lowerFiltration_le_componentRepresentative_ker νA f hdegree m) + +omit [IsOrderedCancelAddMonoid M] in +/-- The component map sends a representative class to the class of its image. -/ +@[simp] +theorem componentMap_componentMk + (νR : MaxAddDegree R M) (νA : MaxAddDegree A M) + (f : R →+* A) (hdegree : ∀ x, νA (f x) ≤ νR x) (m : M) + (x : νR.filtrationLE m) : + νR.componentMap νA f hdegree m (νR.componentMk m x) = + νA.componentMk m (νR.mapFiltrationLE νA f hdegree m x) := by + rw [← νR.coe_component_eq_componentMk] + rfl + +omit [IsOrderedCancelAddMonoid M] in +/-- Exact degree preservation makes the component map detect zero classes. -/ +theorem componentMap_eq_zero_iff + (νR : MaxAddDegree R M) (νA : MaxAddDegree A M) + (f : R →+* A) (hdegree : ∀ x, νA (f x) = νR x) (m : M) + (x : νR.Component m) : + νR.componentMap νA f (fun x ↦ (hdegree x).le) m x = 0 ↔ x = 0 := by + induction x using QuotientAddGroup.induction_on with + | H x => + rw [νR.coe_component_eq_componentMk, νR.componentMap_componentMk, + νA.componentMk_eq_zero_iff, coe_mapFiltrationLE, hdegree, + νR.componentMk_eq_zero_iff] + +omit [IsOrderedCancelAddMonoid M] in +/-- Every exactly degree-preserving component map is injective. -/ +theorem componentMap_injective + (νR : MaxAddDegree R M) (νA : MaxAddDegree A M) + (f : R →+* A) (hdegree : ∀ x, νA (f x) = νR x) (m : M) : + Function.Injective (νR.componentMap νA f (fun x ↦ (hdegree x).le) m) := by + intro x y hxy + apply sub_eq_zero.mp + apply (νR.componentMap_eq_zero_iff νA f hdegree m (x - y)).mp + rw [map_sub, hxy, sub_self] + +omit [IsOrderedCancelAddMonoid M] in +/-- The component maps preserve the homogeneous identity. -/ +theorem componentMap_componentOne + (νR : MaxAddDegree R M) (νA : MaxAddDegree A M) + (f : R →+* A) (hdegree : ∀ x, νA (f x) ≤ νR x) : + νR.componentMap νA f hdegree 0 νR.componentOne = νA.componentOne := by + rw [νR.componentOne_eq_componentMk, νR.componentMap_componentMk, + νA.componentOne_eq_componentMk] + apply congrArg (νA.componentMk 0) + apply Subtype.ext + exact f.map_one + +/-- The component maps commute with homogeneous multiplication. -/ +theorem componentMap_componentMul + (νR : MaxAddDegree R M) (νA : MaxAddDegree A M) + (f : R →+* A) (hdegree : ∀ x, νA (f x) ≤ νR x) + {m n : M} (x : νR.Component m) (y : νR.Component n) : + νR.componentMap νA f hdegree (m + n) (νR.componentMul x y) = + νA.componentMul + (νR.componentMap νA f hdegree m x) + (νR.componentMap νA f hdegree n y) := by + induction x using QuotientAddGroup.induction_on with + | H x => + induction y using QuotientAddGroup.induction_on with + | H y => + rw [νR.coe_component_eq_componentMk, νR.coe_component_eq_componentMk] + rw [νR.componentMul_componentMk, νR.componentMap_componentMk, + νR.componentMap_componentMk, νR.componentMap_componentMk, + νA.componentMul_componentMk] + apply congrArg (νA.componentMk (m + n)) + apply Subtype.ext + simp only [νR.coe_mulFiltrationLE, coe_mapFiltrationLE, + νA.coe_mulFiltrationLE] + exact f.map_mul (x : R) (y : R) + +/-- The graded ring homomorphism induced by a degree-nonincreasing ring homomorphism. -/ +def associatedGradedMap + (νR : MaxAddDegree R M) (νA : MaxAddDegree A M) + (f : R →+* A) (hdegree : ∀ x, νA (f x) ≤ νR x) : + νR.AssociatedGraded →+* νA.AssociatedGraded := + DirectSum.toSemiring + (fun m ↦ (DirectSum.of νA.Component m).comp + (νR.componentMap νA f hdegree m)) + (by + simp only [AddMonoidHom.comp_apply] + rw [show GradedMonoid.GOne.one = νR.componentOne from rfl, + νR.componentMap_componentOne νA f hdegree] + exact DirectSum.of_zero_one νA.Component) + (by + intro m n x y + simp only [AddMonoidHom.comp_apply] + rw [show GradedMonoid.GMul.mul x y = νR.componentMul x y from rfl, + νR.componentMap_componentMul, DirectSum.of_mul_of] + rfl) + +/-- The associated-graded map sends a homogeneous element to the image of its component. -/ +@[simp] +theorem associatedGradedMap_of + (νR : MaxAddDegree R M) (νA : MaxAddDegree A M) + (f : R →+* A) (hdegree : ∀ x, νA (f x) ≤ νR x) + (m : M) (x : νR.Component m) : + νR.associatedGradedMap νA f hdegree (DirectSum.of νR.Component m x) = + DirectSum.of νA.Component m (νR.componentMap νA f hdegree m x) := + DirectSum.toSemiring_of _ _ _ m x + +/-- The associated-graded map is computed componentwise. -/ +theorem associatedGradedMap_apply + (νR : MaxAddDegree R M) (νA : MaxAddDegree A M) + (f : R →+* A) (hdegree : ∀ x, νA (f x) ≤ νR x) + (z : νR.AssociatedGraded) (m : M) : + νR.associatedGradedMap νA f hdegree z m = + νR.componentMap νA f hdegree m (z m) := by + induction z using DirectSum.induction_on with + | zero => simp + | of n z => + by_cases hnm : n = m + · subst m + simp [νR.associatedGradedMap_of] + · simp [νR.associatedGradedMap_of, DirectSum.of_apply, hnm] + | add x y hx hy => simp [map_add, hx, hy] + +/-- An exactly degree-preserving ring homomorphism induces an injective associated-graded +map. -/ +theorem associatedGradedMap_injective + (νR : MaxAddDegree R M) (νA : MaxAddDegree A M) + (f : R →+* A) (hdegree : ∀ x, νA (f x) = νR x) : + Function.Injective (νR.associatedGradedMap νA f (fun x ↦ (hdegree x).le)) := by + intro x y hxy + apply DirectSum.ext + intro m + apply νR.componentMap_injective νA f hdegree m + rw [← νR.associatedGradedMap_apply νA f (fun x ↦ (hdegree x).le), + ← νR.associatedGradedMap_apply νA f (fun x ↦ (hdegree x).le), hxy] + +/-- The associated-graded map induced by an exactly degree-preserving ring homomorphism sends +each initial form to the initial form of its image. -/ +theorem associatedGradedMap_initialForm + (νR : MaxAddDegree R M) (νA : MaxAddDegree A M) + (f : R →+* A) (hdegree : ∀ x, νA (f x) = νR x) (x : R) : + νR.associatedGradedMap νA f (fun x ↦ (hdegree x).le) (νR.initialForm x) = + νA.initialForm (f x) := by + by_cases hx : νR x = ⊥ + · have hfx : νA (f x) = ⊥ := (hdegree x).trans hx + rw [νR.initialForm_eq_zero_of_eq_bot hx, νA.initialForm_eq_zero_of_eq_bot hfx, _root_.map_zero] + · have hfx : νA (f x) ≠ ⊥ := (hdegree x).symm ▸ hx + rw [νR.initialForm_eq_homogeneousMk_of_ne_bot hx, + νA.initialForm_eq_homogeneousMk_of_ne_bot hfx, + νR.homogeneousMk_apply, νA.homogeneousMk_apply, + νR.associatedGradedMap_of, + νR.componentMap_componentMk] + have hm : (νA (f x)).unbot hfx = (νR x).unbot hx := by + apply WithBot.coe_injective + rw [WithBot.coe_unbot, WithBot.coe_unbot, hdegree] + apply DirectSum.of_eq_of_gradedMonoid_eq + apply Sigma.ext hm.symm + apply νA.componentMk_heq_of_grade_eq_of_coe_eq hm.symm + rw [νR.coe_mapFiltrationLE, νR.coe_initialRepresentative, + νA.coe_initialRepresentative] + +/-- The associated-graded map of a degree-nonincreasing ring homomorphism sends the initial form +of an element `x` of degree `d` to the class of `f x` in grade `d`. -/ +theorem associatedGradedMap_initialForm_eq_homogeneousMk + (νR : MaxAddDegree R M) (νA : MaxAddDegree A M) + (f : R →+* A) (hdegree : ∀ x, νA (f x) ≤ νR x) {x : R} {d : M} (hx : νR x = d) : + νR.associatedGradedMap νA f hdegree (νR.initialForm x) = + νA.homogeneousMk d ⟨f x, (νA.mem_filtrationLE_iff d _).mpr ((hdegree x).trans hx.le)⟩ := by + have hmem : x ∈ νR.filtrationLE d := (νR.mem_filtrationLE_iff d x).mpr hx.le + have hne : νR.componentMk d ⟨x, hmem⟩ ≠ 0 := by + rw [Ne, νR.componentMk_eq_zero_iff] + change ¬ νR x < (d : WithBot M) + rw [hx] + exact lt_irrefl _ + rw [νR.initialForm_eq_homogeneousMk_of_componentMk_ne_zero d ⟨x, hmem⟩ hne, + νR.homogeneousMk_apply, νR.associatedGradedMap_of, νR.componentMap_componentMk, + νA.homogeneousMk_apply] + rfl + +/-- Equal max-additive degrees have canonically ring-equivalent associated graded rings. -/ +def associatedGradedCongr {R : Type u} {M : Type w} + [CommRing R] [AddCommMonoid M] [LinearOrder M] + [IsOrderedCancelAddMonoid M] {ν δ : MaxAddDegree R M} + (h : ν = δ) : ν.AssociatedGraded ≃+* δ.AssociatedGraded := by + subst δ + exact RingEquiv.refl _ + +/-- Equal max-additive degrees have canonically equivalent homogeneous components. -/ +def componentCongr {R : Type u} {M : Type w} + [CommRing R] [AddCommMonoid M] [LinearOrder M] + {ν δ : MaxAddDegree R M} (h : ν = δ) (m : M) : ν.Component m ≃+ δ.Component m := by + subst δ + exact AddEquiv.refl _ + +/-- Transport between equal degrees commutes with homogeneous inclusion. -/ +theorem associatedGradedCongr_of {R : Type u} {M : Type w} + [CommRing R] [AddCommMonoid M] [LinearOrder M] + [IsOrderedCancelAddMonoid M] {ν δ : MaxAddDegree R M} + (h : ν = δ) (m : M) (x : ν.Component m) : + ν.associatedGradedCongr h (DirectSum.of ν.Component m x) = + DirectSum.of δ.Component m (ν.componentCongr h m x) := by + subst δ + rfl + +/-- The associated-graded equivalence induced by reflexivity is the identity. -/ +@[simp] +theorem associatedGradedCongr_rfl {R : Type u} {M : Type w} + [CommRing R] [AddCommMonoid M] [LinearOrder M] + [IsOrderedCancelAddMonoid M] (ν : MaxAddDegree R M) + (x : ν.AssociatedGraded) : ν.associatedGradedCongr rfl x = x := + (rfl) + +/-- Transport along equality of max-additive degrees carries an initial form to the corresponding +initial form for the equal degree. -/ +theorem associatedGradedCongr_initialForm {R : Type u} {M : Type w} + [CommRing R] [AddCommMonoid M] [LinearOrder M] + [IsOrderedCancelAddMonoid M] {ν δ : MaxAddDegree R M} + (h : ν = δ) (x : R) : + ν.associatedGradedCongr h (ν.initialForm x) = δ.initialForm x := by + subst δ + exact ν.associatedGradedCongr_rfl (ν.initialForm x) + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedQuotient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedQuotient.lean new file mode 100644 index 0000000000..5059169c35 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedQuotient.lean @@ -0,0 +1,348 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.QuotientDegree +public import Mathlib.RingTheory.Ideal.Maps + +import Mathlib.RingTheory.Ideal.Quotient.Operations + +/-! +# Associated graded rings of least-representative quotients + +Let a separated max-additive degree on `R` be indexed by a well-ordered additive monoid. Passage +to `R ⧸ I` induces a surjective map on every homogeneous component and hence a surjective graded +ring homomorphism. Its kernel is the homogeneous initial ideal of `I`: the ideal generated by the +classes of ideal elements in every weak filtration. + +Consequently, the associated graded ring of the least-representative quotient degree is canonically +isomorphic to the quotient of the source associated graded ring by the initial ideal: the +filtered-quotient isomorphism `gr_ν R ⧸ in_ν(I) ≅ gr_ν̄ (R ⧸ I)`. +-/ + +open scoped MaxAddDegree + +universe u v + +public noncomputable section + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] [WellFoundedLT M] + +/-- The quotient map restricted to the weak filtration at a fixed grade. -/ +def quotientFiltrationMap (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) (m : M) : + ν.filtrationLE m →+ (ν.quotient I hν).filtrationLE m where + toFun x := ⟨Ideal.Quotient.mk I x, by + rw [(ν.quotient I hν).mem_filtrationLE_iff] + rw [ν.quotient_apply I hν] + exact (ν.quotientValue_mk_le I hν x).trans + ((ν.mem_filtrationLE_iff m x).mp x.2)⟩ + map_zero' := by ext; exact (Ideal.Quotient.mk I).map_zero + map_add' x y := by ext; exact (Ideal.Quotient.mk I).map_add x y + +omit [IsOrderedCancelAddMonoid M] in +@[simp] +theorem coe_quotientFiltrationMap (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) (m : M) (x : ν.filtrationLE m) : + ((ν.quotientFiltrationMap I hν m x : + (ν.quotient I hν).filtrationLE m) : R ⧸ I) = + Ideal.Quotient.mk I x := + (rfl) + +omit [IsOrderedCancelAddMonoid M] in +private theorem lowerFiltration_le_quotientComponentRepresentative_ker + (ν : MaxAddDegree R M) (I : Ideal R) (hν : ν.IsSeparated) (m : M) : + ν.lowerFiltration m ≤ + (((ν.quotient I hν).componentMk m).comp + (ν.quotientFiltrationMap I hν m)).ker := by + intro x hx + rw [AddMonoidHom.mem_ker, AddMonoidHom.comp_apply, + (ν.quotient I hν).componentMk_eq_zero_iff] + rw [ν.quotient_apply I hν, coe_quotientFiltrationMap] + exact (ν.quotientValue_mk_le I hν x).trans_lt + ((ν.mem_lowerFiltration_iff m x).mp hx) + +/-- The map on a homogeneous component induced by passage to a quotient ring. -/ +def quotientComponentMap (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) (m : M) : + ν.Component m →+ (ν.quotient I hν).Component m := + QuotientAddGroup.lift (ν.lowerFiltration m) + (((ν.quotient I hν).componentMk m).comp + (ν.quotientFiltrationMap I hν m)) + (ν.lowerFiltration_le_quotientComponentRepresentative_ker I hν m) + +omit [IsOrderedCancelAddMonoid M] in +@[simp] +theorem quotientComponentMap_componentMk (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) (m : M) (x : ν.filtrationLE m) : + ν.quotientComponentMap I hν m (ν.componentMk m x) = + (ν.quotient I hν).componentMk m + (ν.quotientFiltrationMap I hν m x) := + by + rw [← ν.coe_component_eq_componentMk] + rfl + +omit [IsOrderedCancelAddMonoid M] in +/-- Every homogeneous class for the least-representative quotient degree lifts to the +corresponding source component. -/ +theorem quotientComponentMap_surjective (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) (m : M) : + Function.Surjective (ν.quotientComponentMap I hν m) := by + intro z + induction z using QuotientAddGroup.induction_on with + | H z => + by_cases hz : (ν.quotient I hν).componentMk m z = 0 + · refine ⟨0, ?_⟩ + simpa using hz.symm + · have hznotlt : ¬(ν.quotient I hν) z < m := + fun hlt ↦ hz (((ν.quotient I hν).componentMk_eq_zero_iff m z).mpr hlt) + have hzdegree : (ν.quotient I hν) z = (m : WithBot M) := + le_antisymm + (((ν.quotient I hν).mem_filtrationLE_iff m z).mp z.2) + (le_of_not_gt hznotlt) + have hznonzero : (z : R ⧸ I) ≠ 0 := by + intro hzero + apply hz + apply ((ν.quotient I hν).componentMk_eq_zero_iff m z).mpr + simp [hzero] + obtain ⟨x, hxz, hxdegree⟩ := + ν.exists_representative_quotientValue_eq I hν hznonzero + have hxle : ν x ≤ (m : WithBot M) := by + rw [hxdegree] + rw [← ν.quotient_apply I hν] + rw [hzdegree] + refine ⟨ν.componentMk m + ⟨x, (ν.mem_filtrationLE_iff m x).mpr hxle⟩, ?_⟩ + rw [ν.quotientComponentMap_componentMk] + rw [(ν.quotient I hν).coe_component_eq_componentMk] + apply congrArg ((ν.quotient I hν).componentMk m) + apply Subtype.ext + rw [coe_quotientFiltrationMap] + exact hxz + +omit [IsOrderedCancelAddMonoid M] in +/-- A source component lies in the kernel exactly when it can be represented at that grade by +an element of the quotient ideal. -/ +theorem quotientComponentMap_eq_zero_iff (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) (m : M) (x : ν.Component m) : + ν.quotientComponentMap I hν m x = 0 ↔ + ∃ i : ν.filtrationLE m, (i : R) ∈ I ∧ ν.componentMk m i = x := by + induction x using QuotientAddGroup.induction_on with + | H x => + constructor + · intro hx + rw [ν.coe_component_eq_componentMk, ν.quotientComponentMap_componentMk, + (ν.quotient I hν).componentMk_eq_zero_iff] at hx + by_cases hqx : Ideal.Quotient.mk I (x : R) = 0 + · exact ⟨x, Ideal.Quotient.eq_zero_iff_mem.mp hqx, + (ν.coe_component_eq_componentMk m x).symm⟩ + · obtain ⟨y, hyx, hydegree⟩ := + ν.exists_representative_quotientValue_eq I hν hqx + have hylt : ν y < (m : WithBot M) := by + rw [hydegree] + rw [← ν.quotient_apply I hν] + rw [coe_quotientFiltrationMap] at hx + exact hx + let y' : ν.filtrationLE m := + ⟨y, (ν.mem_filtrationLE_iff m y).mpr hylt.le⟩ + have hi : (x : R) - y ∈ I := + (Ideal.Quotient.mk_eq_mk_iff_sub_mem (I := I) (x : R) y).mp hyx.symm + have hile : ν ((x : R) - y) ≤ (m : WithBot M) := + (ν.map_sub_le_max (x : R) y).trans + (max_le ((ν.mem_filtrationLE_iff m x).mp x.2) hylt.le) + let i : ν.filtrationLE m := + ⟨(x : R) - y, (ν.mem_filtrationLE_iff m _).mpr hile⟩ + refine ⟨i, hi, ?_⟩ + rw [ν.coe_component_eq_componentMk] + have hiSub : i = x - y' := Subtype.ext rfl + rw [hiSub, map_sub, + (ν.componentMk_eq_zero_iff m y').mpr hylt, sub_zero] + · rintro ⟨i, hi, hix⟩ + rw [← hix] + rw [ν.quotientComponentMap_componentMk, + (ν.quotient I hν).componentMk_eq_zero_iff] + simp only [coe_quotientFiltrationMap] + rw [Ideal.Quotient.eq_zero_iff_mem.mpr hi] + simp + +omit [IsOrderedCancelAddMonoid M] in +/-- The gradewise quotient map preserves the homogeneous unit. -/ +theorem quotientComponentMap_componentOne (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) : + ν.quotientComponentMap I hν 0 ν.componentOne = + (ν.quotient I hν).componentOne := by + rw [ν.componentOne_eq_componentMk, ν.quotientComponentMap_componentMk, + (ν.quotient I hν).componentOne_eq_componentMk] + apply congrArg ((ν.quotient I hν).componentMk 0) + apply Subtype.ext + exact map_one (Ideal.Quotient.mk I) + +/-- The gradewise quotient maps preserve homogeneous multiplication. -/ +theorem quotientComponentMap_componentMul (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) {m n : M} (x : ν.Component m) (y : ν.Component n) : + ν.quotientComponentMap I hν (m + n) (ν.componentMul x y) = + (ν.quotient I hν).componentMul + (ν.quotientComponentMap I hν m x) + (ν.quotientComponentMap I hν n y) := by + induction x using QuotientAddGroup.induction_on with + | H x => + induction y using QuotientAddGroup.induction_on with + | H y => + rw [ν.coe_component_eq_componentMk, ν.coe_component_eq_componentMk] + rw [ν.componentMul_componentMk, ν.quotientComponentMap_componentMk, + ν.quotientComponentMap_componentMk, ν.quotientComponentMap_componentMk, + (ν.quotient I hν).componentMul_componentMk] + apply congrArg ((ν.quotient I hν).componentMk (m + n)) + apply Subtype.ext + simp only [ν.coe_mulFiltrationLE, coe_quotientFiltrationMap, + (ν.quotient I hν).coe_mulFiltrationLE] + exact (Ideal.Quotient.mk I).map_mul (x : R) (y : R) + +/-- The canonical graded ring map induced by passage to the quotient `R ⧸ I`. -/ +def associatedGradedQuotientMap (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) : + ν.AssociatedGraded →+* (ν.quotient I hν).AssociatedGraded := + DirectSum.toSemiring + (fun m ↦ (DirectSum.of (ν.quotient I hν).Component m).comp + (ν.quotientComponentMap I hν m)) + (by + simp only [AddMonoidHom.comp_apply] + rw [show GradedMonoid.GOne.one = ν.componentOne from rfl, + ν.quotientComponentMap_componentOne] + exact DirectSum.of_zero_one (ν.quotient I hν).Component) + (by + intro m n x y + simp only [AddMonoidHom.comp_apply] + rw [show GradedMonoid.GMul.mul x y = ν.componentMul x y from rfl, + ν.quotientComponentMap_componentMul, DirectSum.of_mul_of] + rfl) + +@[simp] +theorem associatedGradedQuotientMap_of (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) (m : M) (x : ν.Component m) : + ν.associatedGradedQuotientMap I hν (DirectSum.of ν.Component m x) = + DirectSum.of (ν.quotient I hν).Component m + (ν.quotientComponentMap I hν m x) := + DirectSum.toSemiring_of _ _ _ m x + +/-- The canonical graded quotient map is computed componentwise. -/ +theorem associatedGradedQuotientMap_apply (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) (z : ν.AssociatedGraded) (m : M) : + ν.associatedGradedQuotientMap I hν z m = + ν.quotientComponentMap I hν m (z m) := by + induction z using DirectSum.induction_on with + | zero => simp + | of n z => + by_cases hnm : n = m + · subst m + simp [ν.associatedGradedQuotientMap_of] + · simp [ν.associatedGradedQuotientMap_of, DirectSum.of_apply, hnm] + | add x y hx hy => simp [map_add, hx, hy] + +/-- The canonical map onto the associated graded ring of the quotient is surjective. -/ +theorem associatedGradedQuotientMap_surjective (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) : + Function.Surjective (ν.associatedGradedQuotientMap I hν) := by + intro z + induction z using DirectSum.induction_on with + | zero => exact ⟨0, (ν.associatedGradedQuotientMap I hν).map_zero⟩ + | of m z => + obtain ⟨x, hx⟩ := ν.quotientComponentMap_surjective I hν m z + refine ⟨DirectSum.of ν.Component m x, ?_⟩ + rw [ν.associatedGradedQuotientMap_of, hx] + | add x y hx hy => + obtain ⟨a, ha⟩ := hx + obtain ⟨b, hb⟩ := hy + refine ⟨a + b, ?_⟩ + rw [map_add, ha, hb] + +/-- The homogeneous initial ideal generated by the classes of ideal elements in every weak +filtration. Classes placed strictly above their degree are zero, so this is the usual ideal +generated by nonzero initial forms. -/ +def initialIdeal (ν : MaxAddDegree R M) (I : Ideal R) : Ideal ν.AssociatedGraded := + Ideal.span {z | ∃ (m : M) (i : ν.filtrationLE m), + (i : R) ∈ I ∧ z = ν.homogeneousMk m i} + +omit [WellFoundedLT M] in +/-- Every homogeneous class of an ideal element belongs to the initial ideal. -/ +theorem homogeneousMk_mem_initialIdeal (ν : MaxAddDegree R M) (I : Ideal R) + (m : M) (i : ν.filtrationLE m) (hi : (i : R) ∈ I) : + ν.homogeneousMk m i ∈ ν.initialIdeal I := + Ideal.subset_span ⟨m, i, hi, rfl⟩ + +omit [WellFoundedLT M] in +/-- To contain the initial ideal, it suffices and is necessary to contain every homogeneous class +of an element of the original ideal. -/ +theorem initialIdeal_le_iff (ν : MaxAddDegree R M) (I : Ideal R) + (J : Ideal ν.AssociatedGraded) : + ν.initialIdeal I ≤ J ↔ + ∀ (m : M) (i : ν.filtrationLE m), + (i : R) ∈ I → ν.homogeneousMk m i ∈ J := by + rw [initialIdeal, Ideal.span_le] + constructor + · intro h m i hi + exact h ⟨m, i, hi, rfl⟩ + · rintro h z ⟨m, i, hi, rfl⟩ + exact h m i hi + +/-- The initial ideal is exactly the kernel of the canonical graded quotient map. -/ +theorem initialIdeal_eq_ker_associatedGradedQuotientMap + (ν : MaxAddDegree R M) (I : Ideal R) (hν : ν.IsSeparated) : + ν.initialIdeal I = RingHom.ker (ν.associatedGradedQuotientMap I hν) := by + apply le_antisymm + · rw [initialIdeal, Ideal.span_le] + rintro z ⟨m, i, hi, rfl⟩ + change ν.associatedGradedQuotientMap I hν (ν.homogeneousMk m i) = 0 + rw [ν.homogeneousMk_apply, + ν.associatedGradedQuotientMap_of, ν.quotientComponentMap_componentMk] + have hcomponent : + (ν.quotient I hν).componentMk m + (ν.quotientFiltrationMap I hν m i) = 0 := by + rw [(ν.quotient I hν).componentMk_eq_zero_iff] + simp only [coe_quotientFiltrationMap] + rw [Ideal.Quotient.eq_zero_iff_mem.mpr hi] + simp + rw [hcomponent, (DirectSum.of (ν.quotient I hν).Component m).map_zero] + · intro z hz + rw [RingHom.mem_ker] at hz + classical + rw [← DirectSum.sum_support_of z] + apply Submodule.sum_mem + intro m hm + have hmzero : ν.quotientComponentMap I hν m (z m) = 0 := by + rw [← ν.associatedGradedQuotientMap_apply I hν z m, hz] + rfl + obtain ⟨i, hi, hix⟩ := + (ν.quotientComponentMap_eq_zero_iff I hν m (z m)).mp hmzero + rw [← hix] + rw [← ν.homogeneousMk_apply] + exact ν.homogeneousMk_mem_initialIdeal I m i hi + +/-- The associated graded ring of the least-representative quotient is the quotient by the +initial ideal. -/ +def associatedGradedQuotientEquiv (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) : + ν.AssociatedGraded ⧸ ν.initialIdeal I ≃+* + (ν.quotient I hν).AssociatedGraded := + (Ideal.quotEquivOfEq + (ν.initialIdeal_eq_ker_associatedGradedQuotientMap I hν)).trans + (RingHom.quotientKerEquivOfSurjective + (ν.associatedGradedQuotientMap_surjective I hν)) + +@[simp] +theorem associatedGradedQuotientEquiv_mk (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) (z : ν.AssociatedGraded) : + ν.associatedGradedQuotientEquiv I hν + (Ideal.Quotient.mk (ν.initialIdeal I) z) = + ν.associatedGradedQuotientMap I hν z := by + rw [associatedGradedQuotientEquiv, RingEquiv.trans_apply, + Ideal.quotEquivOfEq_mk, RingHom.quotientKerEquivOfSurjective_apply_mk] + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeInitialForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeInitialForm.lean new file mode 100644 index 0000000000..c5d4aa4274 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeInitialForm.lean @@ -0,0 +1,198 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGraded + +/-! +# Initial forms in the associated graded ring + +An element of nonbottom degree is placed in the homogeneous component indexed by its exact +degree; an element of bottom degree has initial form zero. Thus the whole kernel of the degree, +not only the literal zero, is sent to zero, as for the semi-valuations of LM24, Section 4. For a +separated degree the kernel is `{0}`, and only zero has initial form zero. + +The definition needs no hypothesis on the degree. For a multiplicative degree the initial form +preserves products, and `ConwayRefinement.Algebra.Valuation.RV` shows that it descends +to the RV monoid. The unit is always sent to the unit, since every degree sends `1` to zero or is +bottom +everywhere. +-/ + +universe u v + +public noncomputable section + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + +/-- An element of nonbottom degree, placed in the weak filtration at its exact degree. -/ +def initialRepresentative (ν : MaxAddDegree R M) (x : R) (hx : ν x ≠ ⊥) : + ν.filtrationLE ((ν x).unbot hx) := + ⟨x, (ν.mem_filtrationLE_iff _ x).mpr (by rw [WithBot.coe_unbot])⟩ + +omit [IsOrderedCancelAddMonoid M] in +@[simp] +theorem coe_initialRepresentative (ν : MaxAddDegree R M) (x : R) (hx : ν x ≠ ⊥) : + (ν.initialRepresentative x hx : R) = x := (rfl) + +/-- The initial form of an element in the associated graded ring: its class in the component of +its exact degree, or zero if the degree is bottom. -/ +def initialForm (ν : MaxAddDegree R M) (x : R) : ν.AssociatedGraded := + if hx : ν x = ⊥ then + 0 + else + ν.homogeneousMk ((ν x).unbot hx) (ν.initialRepresentative x hx) + +theorem initialForm_eq_zero_of_eq_bot (ν : MaxAddDegree R M) {x : R} + (hx : ν x = ⊥) : ν.initialForm x = 0 := by + rw [initialForm, dif_pos hx] + +theorem initialForm_eq_homogeneousMk_of_ne_bot (ν : MaxAddDegree R M) {x : R} + (hx : ν x ≠ ⊥) : + ν.initialForm x = ν.homogeneousMk ((ν x).unbot hx) (ν.initialRepresentative x hx) := by + rw [initialForm, dif_neg hx] + +omit [IsOrderedCancelAddMonoid M] in +/-- The homogeneous class of an element of nonbottom degree in its exact degree is nonzero. -/ +theorem componentMk_initialRepresentative_ne_zero (ν : MaxAddDegree R M) (x : R) + (hx : ν x ≠ ⊥) : + ν.componentMk _ (ν.initialRepresentative x hx) ≠ 0 := by + rw [ne_eq, ν.componentMk_eq_zero_iff, ν.coe_initialRepresentative, WithBot.coe_unbot] + exact lt_irrefl _ + +theorem initialForm_ne_zero_of_ne_bot (ν : MaxAddDegree R M) {x : R} + (hx : ν x ≠ ⊥) : ν.initialForm x ≠ 0 := by + rw [initialForm, dif_neg hx, ne_eq, ν.homogeneousMk_eq_zero_iff, + ν.coe_initialRepresentative, WithBot.coe_unbot] + exact lt_irrefl _ + +/-- The initial form vanishes exactly on the kernel of the degree. -/ +theorem initialForm_eq_zero_iff (ν : MaxAddDegree R M) (x : R) : + ν.initialForm x = 0 ↔ ν x = ⊥ := by + constructor + · contrapose! + exact ν.initialForm_ne_zero_of_ne_bot + · exact ν.initialForm_eq_zero_of_eq_bot + +/-- A nonzero class represented at grade `m` is the initial form of its representative. -/ +theorem initialForm_eq_homogeneousMk_of_componentMk_ne_zero + (ν : MaxAddDegree R M) (m : M) (x : ν.filtrationLE m) + (hx : ν.componentMk m x ≠ 0) : + ν.initialForm x = ν.homogeneousMk m x := by + have hnotlt : ¬ν x < m := + fun hlt ↦ hx ((ν.componentMk_eq_zero_iff m x).mpr hlt) + have hdegree : ν x = (m : WithBot M) := + le_antisymm ((ν.mem_filtrationLE_iff m x).mp x.2) (le_of_not_gt hnotlt) + have hxbot : ν x ≠ ⊥ := by simp [hdegree] + have hm : (ν x).unbot hxbot = m := + (WithBot.unbot_eq_iff hxbot).mpr hdegree + rw [initialForm, dif_neg hxbot, ν.homogeneousMk_apply, ν.homogeneousMk_apply] + apply DirectSum.of_eq_of_gradedMonoid_eq + apply Sigma.ext hm + apply ν.componentMk_heq_of_grade_eq_of_coe_eq hm + rfl + +/-- At its own degree, the homogeneous class of an element is its initial form. -/ +theorem homogeneousMk_eq_initialForm_of_degree_eq (ν : MaxAddDegree R M) {d : M} {x : R} + (hle : x ∈ ν.filtrationLE d) (hx : ν x = (d : WithBot M)) : + ν.homogeneousMk d ⟨x, hle⟩ = ν.initialForm x := by + refine (ν.initialForm_eq_homogeneousMk_of_componentMk_ne_zero d ⟨x, hle⟩ ?_).symm + rw [Ne, ν.componentMk_eq_zero_iff] + change ¬ ν x < (d : WithBot M) + rw [hx] + exact lt_irrefl _ + +@[simp] +theorem initialForm_zero (ν : MaxAddDegree R M) : ν.initialForm 0 = 0 := + ν.initialForm_eq_zero_of_eq_bot ν.map_zero + +/-- Elements whose difference has smaller degree than one of them have the same initial form. -/ +theorem initialForm_eq_of_sub_lt (ν : MaxAddDegree R M) {x y : R} + (hxy : ν (x - y) < ν x) : ν.initialForm x = ν.initialForm y := by + have hdegree : ν x = ν y := ν.map_eq_of_map_sub_lt hxy + have hx : ν x ≠ ⊥ := ne_bot_of_gt hxy + have hy : ν y ≠ ⊥ := hdegree ▸ hx + have hm : (ν x).unbot hx = (ν y).unbot hy := + (WithBot.unbot_inj hx hy).mpr hdegree + rw [initialForm, dif_neg hx, initialForm, dif_neg hy, + ν.homogeneousMk_apply, ν.homogeneousMk_apply] + apply DirectSum.of_eq_of_gradedMonoid_eq + apply Sigma.ext hm + apply ν.componentMk_heq_of_grade_eq_of_sub_lt hm + simpa only [initialRepresentative, WithBot.coe_unbot] using hxy + +variable (ν : MaxAddDegree R M) in +/-- The initial form of the unit is the unit: the unit has degree zero, or bottom degree when the +degree is bottom everywhere and the graded ring is trivial. -/ +@[simp] +theorem initialForm_one : ν.initialForm 1 = 1 := by + rcases ν.map_one_eq_bot_or_eq_zero with hone | hone + · rw [ν.initialForm_eq_zero_of_eq_bot hone, DirectSum.one_def] + change (0 : ν.AssociatedGraded) = DirectSum.of ν.Component 0 ν.componentOne + have hcomponentOne : ν.componentOne = 0 := by + rw [ν.componentOne_eq_componentMk, ν.componentMk_eq_zero_iff, hone] + exact WithBot.bot_lt_coe 0 + rw [hcomponentOne, (DirectSum.of ν.Component 0).map_zero] + · have hne : ν 1 ≠ ⊥ := by simp [hone] + have hm : (ν 1).unbot hne = 0 := (WithBot.unbot_eq_iff hne).mpr hone + rw [initialForm, dif_neg hne, ν.homogeneousMk_apply, DirectSum.one_def] + change DirectSum.of ν.Component _ _ = DirectSum.of ν.Component 0 ν.componentOne + rw [ν.componentOne_eq_componentMk] + apply DirectSum.of_eq_of_gradedMonoid_eq + apply Sigma.ext hm + apply ν.componentMk_heq_of_grade_eq_of_coe_eq hm + rfl + +section Multiplicative + +variable (ν : MaxAddDegree R M) [ν.IsMultiplicative] + +/-- Initial forms of a multiplicative degree preserve multiplication. -/ +@[simp] +theorem initialForm_mul (x y : R) : + ν.initialForm (x * y) = ν.initialForm x * ν.initialForm y := by + by_cases hx : ν x = ⊥ + · have hxy : ν (x * y) = ⊥ := by simp [hx] + rw [ν.initialForm_eq_zero_of_eq_bot hxy, ν.initialForm_eq_zero_of_eq_bot hx, zero_mul] + by_cases hy : ν y = ⊥ + · have hxy : ν (x * y) = ⊥ := by simp [hy] + rw [ν.initialForm_eq_zero_of_eq_bot hxy, ν.initialForm_eq_zero_of_eq_bot hy, mul_zero] + · have hxy : ν (x * y) ≠ ⊥ := by + rw [ν.map_mul, WithBot.add_ne_bot] + exact ⟨hx, hy⟩ + have hm : (ν (x * y)).unbot hxy = (ν x).unbot hx + (ν y).unbot hy := by + apply WithBot.coe_injective + rw [WithBot.coe_unbot, WithBot.coe_add, ν.map_mul, WithBot.coe_unbot, WithBot.coe_unbot] + rw [initialForm, dif_neg hxy, initialForm, dif_neg hx, initialForm, dif_neg hy, + ν.homogeneousMk_mul, ν.homogeneousMk_apply, ν.homogeneousMk_apply] + apply DirectSum.of_eq_of_gradedMonoid_eq + apply Sigma.ext hm + apply ν.componentMk_heq_of_grade_eq_of_coe_eq hm + simp only [coe_initialRepresentative, coe_mulFiltrationLE] + +end Multiplicative + +section Separated + +variable (ν : MaxAddDegree R M) + +/-- For a separated degree, every nonzero element has nonzero initial form. -/ +theorem initialForm_ne_zero_of_ne_zero (hν : ν.IsSeparated) {x : R} (hx : x ≠ 0) : + ν.initialForm x ≠ 0 := + ν.initialForm_ne_zero_of_ne_bot (ν.map_ne_bot_of_ne_zero hν hx) + +/-- For a separated degree, only zero has initial form zero. -/ +theorem initialForm_eq_zero_iff_of_isSeparated (hν : ν.IsSeparated) (x : R) : + ν.initialForm x = 0 ↔ x = 0 := by + rw [ν.initialForm_eq_zero_iff] + exact (ν.isSeparated_iff).mp hν x + +end Separated + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeOver.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeOver.lean new file mode 100644 index 0000000000..ff56ae42d0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeOver.lean @@ -0,0 +1,251 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm +public import Mathlib.Algebra.Algebra.Subalgebra.Basic +public import Mathlib.Algebra.Algebra.Operations + + +/-! +# The degree over a subalgebra + +Let `ν` be a max-additive degree on a commutative ring `R` and let `P` be a subalgebra of `R`. +The level `γ` of the degree over `P` is the `P`-submodule generated by the elements of degree at +most `γ`, + +`P · R_{ν ≤ γ}`. + +The degree over `P`, `ν_P(t)`, is the least `γ` with `t ∈ P · R_{ν ≤ γ}`; for `ν = deg` on +`K((ℝ^{≤0}))` and `P = S`, the series of finite degree, this is the paper's degree over `S`, +`deg_S`. It is again a max-additive degree, it is bounded by `ν`, it is separated, and every +non-zero element of `P` has degree zero over `P`. +-/ + +universe u v w + +public noncomputable section + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} {L : Type w} +variable [CommRing R] [AddCommMonoid M] [LinearOrder M] [IsOrderedCancelAddMonoid M] +variable [CommRing L] [Algebra L R] + +/-- The level `P · R_{ν ≤ γ}` of the degree over `P`: the `P`-submodule generated by the elements +of degree at most `γ`. -/ +def degreeOverStage (ν : MaxAddDegree R M) (P : Subalgebra L R) (γ : M) : Submodule P R := + Submodule.span P (ν.filtrationLE γ : Set R) + +variable (ν : MaxAddDegree R M) (P : Subalgebra L R) + +omit [IsOrderedCancelAddMonoid M] in +theorem degreeOverStage_le_iff (N : Submodule P R) (γ : M) : + ν.degreeOverStage P γ ≤ N ↔ (ν.filtrationLE γ : Set R) ⊆ N := + Submodule.span_le + +omit [IsOrderedCancelAddMonoid M] in +theorem mem_degreeOverStage_of_degree_le {t : R} {γ : M} (ht : ν t ≤ γ) : + t ∈ ν.degreeOverStage P γ := + Submodule.subset_span ((ν.mem_filtrationLE_iff γ t).mpr ht) + +omit [IsOrderedCancelAddMonoid M] in +theorem degreeOverStage_mono {γ γ' : M} (h : γ ≤ γ') : + ν.degreeOverStage P γ ≤ ν.degreeOverStage P γ' := + Submodule.span_mono fun t ht ↦ (ν.mem_filtrationLE_iff γ' t).mpr + (le_trans ((ν.mem_filtrationLE_iff γ t).mp ht) (WithBot.coe_le_coe.mpr h)) + +theorem degreeOverStage_mul_le (γ γ' : M) : + ν.degreeOverStage P γ * ν.degreeOverStage P γ' ≤ ν.degreeOverStage P (γ + γ') := by + rw [degreeOverStage, degreeOverStage, Submodule.span_mul_span] + refine Submodule.span_le.mpr ?_ + rintro _ ⟨x, hx, y, hy, rfl⟩ + exact Submodule.subset_span ((ν.mem_filtrationLE_iff _ _).mpr + (degree_mul_le_add ((ν.mem_filtrationLE_iff _ _).mp hx) ((ν.mem_filtrationLE_iff _ _).mp hy))) + +theorem mul_mem_degreeOverStage {γ γ' : M} {x y : R} (hx : x ∈ ν.degreeOverStage P γ) + (hy : y ∈ ν.degreeOverStage P γ') : x * y ∈ ν.degreeOverStage P (γ + γ') := + ν.degreeOverStage_mul_le P γ γ' (Submodule.mul_mem_mul hx hy) + +omit [IsOrderedCancelAddMonoid M] in +theorem one_mem_degreeOverStage_zero : (1 : R) ∈ ν.degreeOverStage P 0 := + ν.mem_degreeOverStage_of_degree_le P (by simpa using ν.map_one_le_zero) + +omit [IsOrderedCancelAddMonoid M] in +theorem coe_mem_degreeOverStage_zero (p : P) : (p : R) ∈ ν.degreeOverStage P 0 := by + have := (ν.degreeOverStage P 0).smul_mem p (ν.one_mem_degreeOverStage_zero P) + rwa [Algebra.smul_def, mul_one] at this + +omit [IsOrderedCancelAddMonoid M] in +theorem exists_mem_degreeOverStage (t : R) : ∃ γ : M, t ∈ ν.degreeOverStage P γ := by + cases h : ν t with + | bot => exact ⟨0, ν.mem_degreeOverStage_of_degree_le P (by rw [h]; exact bot_le)⟩ + | coe m => exact ⟨m, ν.mem_degreeOverStage_of_degree_le P h.le⟩ + +variable [WellFoundedLT M] + +omit [IsOrderedCancelAddMonoid M] in +/-- The least `γ` with `t ∈ P · R_{ν ≤ γ}`. -/ +private def fibreMin (t : R) : M := + WellFounded.min wellFounded_lt {γ : M | t ∈ ν.degreeOverStage P γ} + (ν.exists_mem_degreeOverStage P t) + +omit [IsOrderedCancelAddMonoid M] in +private theorem mem_degreeOverStage_fibreMin (t : R) : t ∈ ν.degreeOverStage P (fibreMin ν P t) := + WellFounded.min_mem wellFounded_lt {γ : M | t ∈ ν.degreeOverStage P γ} + (ν.exists_mem_degreeOverStage P t) + +omit [IsOrderedCancelAddMonoid M] in +private theorem fibreMin_le {t : R} {γ : M} (h : t ∈ ν.degreeOverStage P γ) : + fibreMin ν P t ≤ γ := + not_lt.mp fun hlt ↦ WellFounded.not_lt_min wellFounded_lt {γ : M | t ∈ ν.degreeOverStage P γ} + (show γ ∈ {γ : M | t ∈ ν.degreeOverStage P γ} from h) hlt + +omit [IsOrderedCancelAddMonoid M] in +private theorem fibreMin_le_iff (t : R) (γ : M) : + fibreMin ν P t ≤ γ ↔ t ∈ ν.degreeOverStage P γ := + ⟨fun h ↦ ν.degreeOverStage_mono P h (mem_degreeOverStage_fibreMin ν P t), fibreMin_le ν P⟩ + +open Classical in +/-- The value of the degree over `P`, before bundling. -/ +private def degreeOverFun (t : R) : WithBot M := + if t = 0 then ⊥ else ((fibreMin ν P t : M) : WithBot M) + +omit [IsOrderedCancelAddMonoid M] in +private theorem degreeOverFun_le_iff (t : R) (γ : M) : + degreeOverFun ν P t ≤ γ ↔ t ∈ ν.degreeOverStage P γ := by + rw [degreeOverFun] + split_ifs with ht + · subst ht + exact ⟨fun _ ↦ Submodule.zero_mem _, fun _ ↦ bot_le⟩ + · rw [WithBot.coe_le_coe] + exact fibreMin_le_iff ν P t γ + +omit [IsOrderedCancelAddMonoid M] in +private theorem degreeOverFun_eq_bot_iff (t : R) : degreeOverFun ν P t = ⊥ ↔ t = 0 := by + rw [degreeOverFun] + split_ifs with ht + · exact ⟨fun _ ↦ ht, fun _ ↦ rfl⟩ + · exact ⟨fun h ↦ absurd h WithBot.coe_ne_bot, fun h ↦ absurd h ht⟩ + +omit [AddCommMonoid M] [IsOrderedCancelAddMonoid M] [WellFoundedLT M] in +private theorem withBot_eq_of_forall_le_iff {a b : WithBot M} (hbot : a = ⊥ ↔ b = ⊥) + (h : ∀ γ : M, a ≤ γ ↔ b ≤ γ) : a = b := by + cases a with + | bot => exact (hbot.mp rfl).symm + | coe m => + cases b with + | bot => exact absurd (hbot.mpr rfl) WithBot.coe_ne_bot + | coe n => + exact le_antisymm ((h n).mpr le_rfl) ((h m).mp le_rfl) + +/-- The degree over `P`, `ν_P`: the least `γ` with `t ∈ P · R_{ν ≤ γ}`, and `-∞` at `0`. For +`ν = deg` and `P = S` this is the paper's `deg_S`. -/ +def degreeOver : MaxAddDegree R M where + toFun := degreeOverFun ν P + map_zero' := by rw [degreeOverFun, if_pos rfl] + map_one_le_zero' := by + rw [WithBot.coe_zero.symm, degreeOverFun_le_iff] + exact ν.one_mem_degreeOverStage_zero P + map_neg' t := by + refine withBot_eq_of_forall_le_iff ?_ fun γ ↦ ?_ + · rw [degreeOverFun_eq_bot_iff, degreeOverFun_eq_bot_iff, neg_eq_zero] + · rw [degreeOverFun_le_iff, degreeOverFun_le_iff] + exact ⟨fun h ↦ by simpa using Submodule.neg_mem (ν.degreeOverStage P γ) h, + fun h ↦ Submodule.neg_mem (ν.degreeOverStage P γ) h⟩ + map_add_le_max' t t' := by + cases hmax : max (degreeOverFun ν P t) (degreeOverFun ν P t') with + | bot => + have ht : degreeOverFun ν P t = ⊥ := le_bot_iff.mp (hmax ▸ le_max_left _ _) + have ht' : degreeOverFun ν P t' = ⊥ := le_bot_iff.mp (hmax ▸ le_max_right _ _) + rw [(degreeOverFun_eq_bot_iff ν P t).mp ht, (degreeOverFun_eq_bot_iff ν P t').mp ht', + add_zero, (degreeOverFun_eq_bot_iff ν P 0).mpr rfl] + | coe γ => + rw [degreeOverFun_le_iff] + have ht : degreeOverFun ν P t ≤ γ := hmax ▸ le_max_left _ _ + have ht' : degreeOverFun ν P t' ≤ γ := hmax ▸ le_max_right _ _ + exact (ν.degreeOverStage P γ).add_mem ((degreeOverFun_le_iff ν P t γ).mp ht) + ((degreeOverFun_le_iff ν P t' γ).mp ht') + map_mul_le_add' t t' := by + cases ht : degreeOverFun ν P t with + | bot => + rw [(degreeOverFun_eq_bot_iff ν P t).mp ht, zero_mul, + (degreeOverFun_eq_bot_iff ν P 0).mpr rfl] + exact bot_le + | coe γ => + cases ht' : degreeOverFun ν P t' with + | bot => + rw [(degreeOverFun_eq_bot_iff ν P t').mp ht', mul_zero, + (degreeOverFun_eq_bot_iff ν P 0).mpr rfl] + exact bot_le + | coe γ' => + rw [← WithBot.coe_add, degreeOverFun_le_iff] + exact ν.mul_mem_degreeOverStage P ((degreeOverFun_le_iff ν P t γ).mp ht.le) + ((degreeOverFun_le_iff ν P t' γ').mp ht'.le) + +theorem degreeOver_le_iff (t : R) (γ : M) : + ν.degreeOver P t ≤ γ ↔ t ∈ ν.degreeOverStage P γ := + degreeOverFun_le_iff ν P t γ + +theorem degreeOver_eq_bot_iff (t : R) : ν.degreeOver P t = ⊥ ↔ t = 0 := + degreeOverFun_eq_bot_iff ν P t + +theorem degreeOver_isSeparated : (ν.degreeOver P).IsSeparated := + (isSeparated_iff _).mpr fun t ↦ ν.degreeOver_eq_bot_iff P t + +theorem degreeOver_le_of_degree_le {t : R} {γ : M} (ht : ν t ≤ γ) : + ν.degreeOver P t ≤ γ := + (ν.degreeOver_le_iff P t γ).mpr (ν.mem_degreeOverStage_of_degree_le P ht) + +theorem degreeOver_le (hν : ν.IsSeparated) (t : R) : ν.degreeOver P t ≤ ν t := by + cases h : ν t with + | bot => + rw [((isSeparated_iff ν).mp hν t).mp h, (ν.degreeOver_eq_bot_iff P 0).mpr rfl] + | coe γ => exact ν.degreeOver_le_of_degree_le P h.le + +theorem degreeOver_coe_le_zero (p : P) : ν.degreeOver P (p : R) ≤ 0 := by + rw [WithBot.coe_zero.symm, degreeOver_le_iff] + exact ν.coe_mem_degreeOverStage_zero P p + +/-- Multiplying an element of degree at most `γ` by an element of `P` keeps the degree over `P` +at most `γ`. -/ +theorem degreeOver_coe_mul_le_of_degree_le (p : P) {t : R} {γ : M} (ht : ν t ≤ γ) : + ν.degreeOver P ((p : R) * t) ≤ γ := + ((ν.degreeOver P).map_mul_le_add _ _).trans <| by + calc ν.degreeOver P (p : R) + ν.degreeOver P t ≤ 0 + (γ : WithBot M) := + add_le_add (ν.degreeOver_coe_le_zero P p) (ν.degreeOver_le_of_degree_le P ht) + _ = γ := zero_add _ + +theorem coe_mul_mem_degreeOver_filtrationLE_of_degree_le (p : P) {t : R} {γ : M} (ht : ν t ≤ γ) : + (p : R) * t ∈ (ν.degreeOver P).filtrationLE γ := + ((ν.degreeOver P).mem_filtrationLE_iff _ _).mpr (ν.degreeOver_coe_mul_le_of_degree_le P p ht) + +/-- When `0` is the least value, every non-zero element of `P` has degree exactly zero over `P`. -/ +theorem degreeOver_coe_eq_zero (h0 : ∀ m : M, 0 ≤ m) {p : P} (hp : (p : R) ≠ 0) : + ν.degreeOver P (p : R) = 0 := by + refine le_antisymm (ν.degreeOver_coe_le_zero P p) ?_ + cases h : ν.degreeOver P (p : R) with + | bot => exact absurd ((ν.degreeOver_eq_bot_iff P _).mp h) hp + | coe m => exact WithBot.coe_le_coe.mpr (h0 m) + +theorem degreeOver_algebraMap_eq_zero (h0 : ∀ m : M, 0 ≤ m) {l : L} + (hl : algebraMap L R l ≠ 0) : ν.degreeOver P (algebraMap L R l) = 0 := + ν.degreeOver_coe_eq_zero P h0 (p := ⟨algebraMap L R l, P.algebraMap_mem l⟩) hl + +/-- Degree over `P` below `γ` means membership in a strictly lower level, for non-zero elements. -/ +theorem exists_mem_degreeOverStage_of_degreeOver_lt {t : R} {γ : M} (ht : t ≠ 0) + (h : ν.degreeOver P t < γ) : ∃ γ' < γ, t ∈ ν.degreeOverStage P γ' := by + cases hψ : ν.degreeOver P t with + | bot => exact absurd ((ν.degreeOver_eq_bot_iff P t).mp hψ) ht + | coe m => + rw [hψ] at h + exact ⟨m, WithBot.coe_lt_coe.mp h, (ν.degreeOver_le_iff P t m).mp hψ.le⟩ + +theorem degreeOver_lt_of_mem_degreeOverStage_of_lt {t : R} {γ' γ : M} + (h : t ∈ ν.degreeOverStage P γ') (hlt : γ' < γ) : ν.degreeOver P t < γ := + lt_of_le_of_lt ((ν.degreeOver_le_iff P t γ').mpr h) (WithBot.coe_lt_coe.mpr hlt) + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreePrincipalInitialIdeal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreePrincipalInitialIdeal.lean new file mode 100644 index 0000000000..1704eaa312 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreePrincipalInitialIdeal.lean @@ -0,0 +1,200 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousDivisibility +import Mathlib.RingTheory.Ideal.Quotient.Basic + +/-! +# Initial ideals of principal ideals + +For a multiplicative max-additive degree, the initial ideal of `(q)` is generated by the initial +form of `q`. For a separated degree, a domain associated graded ring supplies multiplicativity, so +the associated graded ring of `R / (q)` is the quotient by that single initial form. + +If this graded quotient is a domain, then `R / (q)` is a domain. The same conclusion, that a +nonzero `a` whose initial form generates a prime ideal of the associated graded ring is prime, has +a direct proof for a separated multiplicative degree over a well-ordered value monoid: for +`b ∉ (a)` of least degree in its coset, `in(b) ∈ (in a)` would give `in(b) = in(a) g` with `g` +homogeneous, and a lift `g̃` of `g` would produce `b - a g̃` of smaller degree in the same coset. +-/ + +open scoped MaxAddDegree + +universe u v + +public noncomputable section + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + +/-- The initial ideal of a principal ideal is generated by the initial form of its generator when +the degree is multiplicative. -/ +theorem initialIdeal_span_singleton_eq_span_initialForm + (ν : MaxAddDegree R M) [ν.IsMultiplicative] (q : R) : + ν.initialIdeal (Ideal.span {q}) = Ideal.span {ν.initialForm q} := by + apply le_antisymm + · rw [ν.initialIdeal_le_iff] + intro m i hi + by_cases hic : ν.componentMk m i = 0 + · rw [ν.homogeneousMk_apply, hic, + (DirectSum.of ν.Component m).map_zero] + exact (Ideal.span {ν.initialForm q}).zero_mem + · obtain ⟨b, hb⟩ := Ideal.mem_span_singleton.mp hi + rw [← ν.initialForm_eq_homogeneousMk_of_componentMk_ne_zero m i hic, + hb, ν.initialForm_mul] + exact Ideal.mem_span_singleton.mpr ⟨ν.initialForm b, rfl⟩ + · rw [Ideal.span_le] + intro z hz + rw [Set.mem_singleton_iff.mp hz] + by_cases hq : ν q = ⊥ + · rw [ν.initialForm_eq_zero_of_eq_bot hq] + exact (ν.initialIdeal (Ideal.span {q})).zero_mem + · rw [ν.initialForm_eq_homogeneousMk_of_ne_bot hq] + apply ν.homogeneousMk_mem_initialIdeal + simpa only [ν.coe_initialRepresentative] using + Ideal.mem_span_singleton_self q + +/-- A domain source associated graded ring gives the principal-initial-ideal equality. -/ +theorem initialIdeal_span_singleton_eq_span_initialForm_of_isDomain + (ν : MaxAddDegree R M) (hν : ν.IsSeparated) [IsDomain ν.AssociatedGraded] + (q : R) : + ν.initialIdeal (Ideal.span {q}) = Ideal.span {ν.initialForm q} := + haveI := ν.isMultiplicative_of_associatedGraded_isDomain hν + ν.initialIdeal_span_singleton_eq_span_initialForm q + +variable [WellFoundedLT M] + +/-- The associated graded ring of a principal quotient is the quotient by the generator's initial +form when the source associated graded ring is a domain. -/ +def associatedGradedPrincipalQuotientEquiv + (ν : MaxAddDegree R M) (hν : ν.IsSeparated) [IsDomain ν.AssociatedGraded] + (q : R) : + ν.AssociatedGraded ⧸ Ideal.span {ν.initialForm q} ≃+* + (ν.quotient (Ideal.span {q}) hν).AssociatedGraded := + (Ideal.quotEquivOfEq + (ν.initialIdeal_span_singleton_eq_span_initialForm_of_isDomain hν q).symm).trans + (ν.associatedGradedQuotientEquiv (Ideal.span {q}) hν) + +@[simp] +theorem associatedGradedPrincipalQuotientEquiv_mk + (ν : MaxAddDegree R M) (hν : ν.IsSeparated) [IsDomain ν.AssociatedGraded] + (q : R) (z : ν.AssociatedGraded) : + ν.associatedGradedPrincipalQuotientEquiv hν q + (Ideal.Quotient.mk (Ideal.span {ν.initialForm q}) z) = + ν.associatedGradedQuotientMap (Ideal.span {q}) hν z := by + rw [associatedGradedPrincipalQuotientEquiv, RingEquiv.trans_apply, + Ideal.quotEquivOfEq_mk, ν.associatedGradedQuotientEquiv_mk] + +/-! ### The direct prime criterion -/ + +omit [IsOrderedCancelAddMonoid M] in +/-- A coset of an ideal not containing zero has a representative of least degree. -/ +theorem exists_sub_mem_and_forall_le (ν : MaxAddDegree R M) (hν : ν.IsSeparated) (I : Ideal R) + {b : R} (hb : b ∉ I) : + ∃ b₀, b₀ - b ∈ I ∧ ∀ b', b' - b ∈ I → ν b₀ ≤ ν b' := by + have hq : Ideal.Quotient.mk I b ≠ 0 := fun h ↦ hb (Ideal.Quotient.eq_zero_iff_mem.mp h) + obtain ⟨b₀, hb₀, hνb₀⟩ := ν.exists_representative_quotientValue_eq I hν hq + refine ⟨b₀, Ideal.Quotient.eq.mp hb₀, fun b' hb' ↦ ?_⟩ + rw [hνb₀, ← Ideal.Quotient.eq.mpr hb'] + exact ν.quotientValue_mk_le I hν b' + +omit [WellFoundedLT M] in +/-- For a separated multiplicative degree, an element `b ∉ (a)` of least degree in its coset +modulo `(a)` has initial form outside `(in_ν a)`: otherwise `in_ν b = in_ν a · g` with `g` +homogeneous, and a lift `g̃` of `g` gives `ν (b - a g̃) < ν b` in the same coset. -/ +theorem initialForm_notMem_span_initialForm (ν : MaxAddDegree R M) [ν.IsMultiplicative] + (hν : ν.IsSeparated) {a b : R} (ha : a ≠ 0) (hb : b ∉ Ideal.span {a}) + (hmin : ∀ b', b' - b ∈ Ideal.span {a} → ν b ≤ ν b') : + ν.initialForm b ∉ Ideal.span {ν.initialForm a} := by + classical + intro hmem + obtain ⟨g, hg⟩ := Ideal.mem_span_singleton'.mp hmem + have hb0 : b ≠ 0 := fun h ↦ hb (h ▸ (Ideal.span {a}).zero_mem) + obtain ⟨e, he⟩ := WithBot.ne_bot_iff_exists.mp (ν.map_ne_bot_of_ne_zero hν ha) + obtain ⟨d, hd⟩ := WithBot.ne_bot_iff_exists.mp (ν.map_ne_bot_of_ne_zero hν hb0) + have hale : a ∈ ν.filtrationLE e := (ν.mem_filtrationLE_iff e a).mpr he.ge + have hble : b ∈ ν.filtrationLE d := (ν.mem_filtrationLE_iff d b).mpr hd.ge + rw [← ν.homogeneousMk_eq_initialForm_of_degree_eq hale he.symm, + ← ν.homogeneousMk_eq_initialForm_of_degree_eq hble hd.symm, mul_comm, + ν.homogeneousMk_apply, ν.homogeneousMk_apply] at hg + -- compare the components in grade `d = ν b` + have hd' := congrArg (fun z : ν.AssociatedGraded ↦ z d) hg + simp only [DirectSum.of_eq_same] at hd' + by_cases hj : ∃ j, e + j = d + · obtain ⟨j, rfl⟩ := hj + rw [DirectSum.of_mul_apply_add] at hd' + obtain ⟨gt, hgt⟩ : ∃ gt, ν.componentMk j gt = g j := + componentInductionOn (g j) fun gt ↦ ⟨gt, rfl⟩ + rw [← hgt, show GradedMonoid.GMul.mul _ _ = ν.componentMul _ _ from rfl, + ν.componentMul_componentMk, ν.componentMk_eq_componentMk_iff] at hd' + simp only [ν.coe_mulFiltrationLE] at hd' + have hlt : ν (b - a * gt) < (e + j : WithBot M) := by + rw [← ν.map_neg, neg_sub] + exact hd' + have hcoset : b - a * gt - b ∈ Ideal.span {a} := by + rw [sub_sub_cancel_left, neg_mem_iff] + exact Ideal.mem_span_singleton'.mpr ⟨gt, mul_comm _ _⟩ + exact absurd (hmin _ hcoset) (not_le.mpr (hd ▸ hlt)) + · rw [DirectSum.of_mul_apply_eq_zero_of_not_exists _ _ _ hj, eq_comm, + ν.componentMk_eq_zero_iff] at hd' + exact absurd hd' (not_lt.mpr hd.le) + +/-- For a separated multiplicative degree over a well-ordered value monoid, a nonzero `a` whose +initial form generates a prime ideal of the associated graded ring generates a prime ideal. -/ +theorem span_singleton_isPrime_of_span_initialForm_isPrime (ν : MaxAddDegree R M) + [ν.IsMultiplicative] (hν : ν.IsSeparated) {a : R} (ha : a ≠ 0) + (hprime : (Ideal.span {ν.initialForm a}).IsPrime) : (Ideal.span {a}).IsPrime := by + refine ⟨fun htop ↦ ?_, fun {b c} hbc ↦ ?_⟩ + · -- `in_ν a` is not a unit, so `a` is not a unit + obtain ⟨a', ha'⟩ := (Ideal.span_singleton_eq_top.mp htop).exists_right_inv + apply hprime.ne_top + rw [Ideal.span_singleton_eq_top] + exact IsUnit.of_mul_eq_one (ν.initialForm a') + (by rw [← ν.initialForm_mul, ha', ν.initialForm_one]) + · by_contra hnot + rw [not_or] at hnot + -- replace `b` and `c` by representatives of least degree in their cosets + obtain ⟨b₀, hb₀, hbmin⟩ := ν.exists_sub_mem_and_forall_le hν _ hnot.1 + obtain ⟨c₀, hc₀, hcmin⟩ := ν.exists_sub_mem_and_forall_le hν _ hnot.2 + have hb₀' : b₀ ∉ Ideal.span {a} := fun h ↦ + hnot.1 (by simpa using (Ideal.span {a}).sub_mem h hb₀) + have hc₀' : c₀ ∉ Ideal.span {a} := fun h ↦ + hnot.2 (by simpa using (Ideal.span {a}).sub_mem h hc₀) + have hmin_b : ∀ b', b' - b₀ ∈ Ideal.span {a} → ν b₀ ≤ ν b' := fun b' h ↦ + hbmin b' (by simpa using (Ideal.span {a}).add_mem h hb₀) + have hmin_c : ∀ c', c' - c₀ ∈ Ideal.span {a} → ν c₀ ≤ ν c' := fun c' h ↦ + hcmin c' (by simpa using (Ideal.span {a}).add_mem h hc₀) + have hbc₀ : b₀ * c₀ ∈ Ideal.span {a} := by + have hmem : b₀ * c₀ - b * c ∈ Ideal.span {a} := by + rw [show b₀ * c₀ - b * c = (b₀ - b) * c₀ + b * (c₀ - c) by ring] + exact (Ideal.span {a}).add_mem ((Ideal.span {a}).mul_mem_right _ hb₀) + ((Ideal.span {a}).mul_mem_left _ hc₀) + simpa using (Ideal.span {a}).add_mem hmem hbc + obtain ⟨q, hq⟩ := Ideal.mem_span_singleton'.mp hbc₀ + have hin : ν.initialForm b₀ * ν.initialForm c₀ ∈ Ideal.span {ν.initialForm a} := by + rw [← ν.initialForm_mul, ← hq, ν.initialForm_mul] + exact Ideal.mem_span_singleton'.mpr ⟨_, rfl⟩ + rcases hprime.mem_or_mem hin with h | h + · exact ν.initialForm_notMem_span_initialForm hν ha hb₀' hmin_b h + · exact ν.initialForm_notMem_span_initialForm hν ha hc₀' hmin_c h + +/-- For a separated degree with a domain associated graded ring, a nonzero `a` with +`gr_ν R / (in_ν a)` a domain is prime. -/ +theorem prime_of_quotient_span_initialForm_isDomain (ν : MaxAddDegree R M) (hν : ν.IsSeparated) + [IsDomain ν.AssociatedGraded] {a : R} (ha : a ≠ 0) + [IsDomain (ν.AssociatedGraded ⧸ Ideal.span {ν.initialForm a})] : Prime a := + haveI := ν.isMultiplicative_of_associatedGraded_isDomain hν + (Ideal.span_singleton_prime ha).mp + (ν.span_singleton_isPrime_of_span_initialForm_isPrime hν ha + ((Ideal.Quotient.isDomain_iff_prime _).mp inferInstance)) + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeRepresentatives.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeRepresentatives.lean new file mode 100644 index 0000000000..39d85fe326 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeRepresentatives.lean @@ -0,0 +1,251 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedMap +public import Mathlib.Algebra.MvPolynomial.Eval +public import Mathlib.RingTheory.MvPolynomial.WeightedHomogeneous +import Mathlib.Algebra.MvPolynomial.CommRing + +/-! +# Representatives of homogeneous classes + +An element represents a homogeneous class in degree `m` when it lies in the filtration at `m` +and maps to that class in the associated graded ring. This relation respects the ring operations. +-/ + +public noncomputable section + +open MvPolynomial + +universe u v w z + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + +/-- An element of a filtered ring representing a homogeneous class in a specified degree. -/ +structure Represents (ν : MaxAddDegree R M) (x : R) (m : M) + (e : ν.AssociatedGraded) : Prop where + /-- The representative lies in the specified filtration. -/ + degree_le : ν x ≤ m + /-- Its image in the associated graded ring is the specified class. -/ + class_eq : + ν.homogeneousMk m ⟨x, (ν.mem_filtrationLE_iff m x).mpr degree_le⟩ = e + +theorem represents_iff {ν : MaxAddDegree R M} {x : R} {m : M} {e : ν.AssociatedGraded} : + ν.Represents x m e ↔ ∃ h : ν x ≤ m, + ν.homogeneousMk m ⟨x, (ν.mem_filtrationLE_iff m x).mpr h⟩ = e := by + constructor + · exact fun h ↦ ⟨h.degree_le, h.class_eq⟩ + · rintro ⟨hdegree, hclass⟩ + exact ⟨hdegree, hclass⟩ + +/-- A representative remains a representative after identifying equal degree functions. -/ +theorem Represents.congr {ν δ : MaxAddDegree R M} (h : ν = δ) + {x : R} {m : M} {e : ν.AssociatedGraded} (he : ν.Represents x m e) : + δ.Represents x m (ν.associatedGradedCongr h e) := by + subst δ + simpa using he + +/-- Zero represents zero in every degree. -/ +theorem represents_zero (ν : MaxAddDegree R M) (m : M) : ν.Represents 0 m 0 := by + refine ⟨by simp, (ν.homogeneousMk_eq_zero_iff m _).mpr ?_⟩ + simp + +/-- One represents one in degree zero. -/ +theorem represents_one (ν : MaxAddDegree R M) : ν.Represents 1 0 1 := + ⟨ν.map_one_le_zero, ν.homogeneousMk_one⟩ + +/-- Representatives in a common degree add. -/ +theorem Represents.add {ν : MaxAddDegree R M} {x y : R} {m : M} + {e f : ν.AssociatedGraded} (hx : ν.Represents x m e) (hy : ν.Represents y m f) : + ν.Represents (x + y) m (e + f) := by + obtain ⟨hdx, hex⟩ := hx + obtain ⟨hdy, hey⟩ := hy + have hd : ν (x + y) ≤ m := (ν.map_add_le_max x y).trans (max_le hdx hdy) + refine ⟨hd, ?_⟩ + rw [show (⟨x + y, (ν.mem_filtrationLE_iff m _).mpr hd⟩ : ν.filtrationLE m) = + ⟨x, (ν.mem_filtrationLE_iff m _).mpr hdx⟩ + + ⟨y, (ν.mem_filtrationLE_iff m _).mpr hdy⟩ from Subtype.ext rfl, + map_add, hex, hey] + +/-- Representatives multiply in the sum of their degrees. -/ +theorem Represents.mul {ν : MaxAddDegree R M} {x y : R} {m n p : M} + {e f : ν.AssociatedGraded} (hp : p = m + n) + (hx : ν.Represents x m e) (hy : ν.Represents y n f) : + ν.Represents (x * y) p (e * f) := by + obtain ⟨hdx, hex⟩ := hx + obtain ⟨hdy, hey⟩ := hy + have hd : ν (x * y) ≤ p := by + rw [hp] + exact (ν.map_mul_le_add x y).trans (by simpa using add_le_add hdx hdy) + refine ⟨hd, ?_⟩ + rw [← hex, ← hey, ν.homogeneousMk_mul_of_coe_eq hp + ⟨x, (ν.mem_filtrationLE_iff m _).mpr hdx⟩ + ⟨y, (ν.mem_filtrationLE_iff n _).mpr hdy⟩ + ⟨x * y, (ν.mem_filtrationLE_iff p _).mpr hd⟩ rfl] + +/-- Powers of a representative represent the corresponding powers. -/ +theorem Represents.pow {ν : MaxAddDegree R M} {x : R} {m : M} {e : ν.AssociatedGraded} + (hx : ν.Represents x m e) (n : ℕ) : ν.Represents (x ^ n) (n • m) (e ^ n) := by + induction n with + | zero => simpa using ν.represents_one + | succ n ih => simpa [pow_succ, succ_nsmul] using ih.mul rfl hx + +/-- A finite product of representatives represents the product. -/ +theorem represents_prod {ν : MaxAddDegree R M} {ι : Type w} {s : Finset ι} + {x : ι → R} {m : ι → M} {e : ι → ν.AssociatedGraded} + (h : ∀ i ∈ s, ν.Represents (x i) (m i) (e i)) : + ν.Represents (∏ i ∈ s, x i) (∑ i ∈ s, m i) (∏ i ∈ s, e i) := by + classical + induction s using Finset.cons_induction with + | empty => simpa using ν.represents_one + | cons i s hi ih => + rw [Finset.prod_cons, Finset.prod_cons] + exact (h i (Finset.mem_cons_self i s)).mul (Finset.sum_cons hi) + (ih fun j hj ↦ h j (Finset.mem_cons_of_mem hj)) + +/-- A finite sum of representatives in one degree represents the sum. -/ +theorem represents_sum {ν : MaxAddDegree R M} {ι : Type w} {s : Finset ι} + {x : ι → R} {m : M} {e : ι → ν.AssociatedGraded} + (h : ∀ i ∈ s, ν.Represents (x i) m (e i)) : + ν.Represents (∑ i ∈ s, x i) m (∑ i ∈ s, e i) := by + classical + induction s using Finset.cons_induction with + | empty => simpa using ν.represents_zero m + | cons i s hi ih => + rw [Finset.sum_cons, Finset.sum_cons] + exact (h i (Finset.mem_cons_self i s)).add + (ih fun j hj ↦ h j (Finset.mem_cons_of_mem hj)) + +/-- Representatives of the same class differ by an element of smaller degree. -/ +theorem Represents.degree_sub_lt {ν : MaxAddDegree R M} {x y : R} {m : M} + {e : ν.AssociatedGraded} (hx : ν.Represents x m e) (hy : ν.Represents y m e) : + ν (x - y) < m := by + obtain ⟨hdx, hex⟩ := hx + obtain ⟨hdy, hey⟩ := hy + have hd : ν (x - y) ≤ m := (ν.map_sub_le_max x y).trans (max_le hdx hdy) + apply (ν.homogeneousMk_eq_zero_iff m + ⟨x - y, (ν.mem_filtrationLE_iff m _).mpr hd⟩).mp + rw [show (⟨x - y, (ν.mem_filtrationLE_iff m _).mpr hd⟩ : ν.filtrationLE m) = + ⟨x, (ν.mem_filtrationLE_iff m _).mpr hdx⟩ - + ⟨y, (ν.mem_filtrationLE_iff m _).mpr hdy⟩ from Subtype.ext rfl, + map_sub, hex, hey, sub_self] + +/-- An element of smaller degree represents zero. -/ +theorem represents_zero_of_degree_lt {ν : MaxAddDegree R M} {x : R} {m : M} + (h : ν x < (m : WithBot M)) : ν.Represents x m 0 := + ⟨h.le, (ν.homogeneousMk_eq_zero_iff m _).mpr h⟩ + +/-- An element represents at most one class in a fixed degree. -/ +theorem Represents.unique {ν : MaxAddDegree R M} {x : R} {m : M} + {e f : ν.AssociatedGraded} (he : ν.Represents x m e) (hf : ν.Represents x m f) : e = f := by + obtain ⟨hde, heq⟩ := he + obtain ⟨hdf, hfq⟩ := hf + rw [← heq, ← hfq] + +/-- A representative of a nonzero class has exactly the specified degree. -/ +theorem Represents.degree_eq {ν : MaxAddDegree R M} {x : R} {m : M} + {e : ν.AssociatedGraded} (h : ν.Represents x m e) (he : e ≠ 0) : + ν x = (m : WithBot M) := by + rcases h.degree_le.lt_or_eq with hlt | heq + · exact absurd ((ν.represents_zero_of_degree_lt hlt).unique h) (by simpa [eq_comm] using he) + · exact heq + +/-- A representative of zero has degree below the specified degree. -/ +theorem Represents.degree_lt_of_eq_zero {ν : MaxAddDegree R M} {x : R} {m : M} + (h : ν.Represents x m 0) : ν x < (m : WithBot M) := by + obtain ⟨hd, he⟩ := h + exact (ν.homogeneousMk_eq_zero_iff m + ⟨x, (ν.mem_filtrationLE_iff m _).mpr hd⟩).mp he + +/-- A choice of representative for each member of a graded family. -/ +structure LiftFamily (ν : MaxAddDegree R M) {ι : Type w} (wt : ι → M) + (e : ι → ν.AssociatedGraded) where + /-- The chosen representative. -/ + lift : ι → R + /-- Each chosen element represents the corresponding homogeneous class. -/ + represents : ∀ i, ν.Represents (lift i) (wt i) (e i) + +variable {k : Type z} [CommRing k] [Algebra k R] + +/-- Weighted homogeneous evaluation preserves representation. -/ +theorem represents_aeval {ν : MaxAddDegree R M} {ι : Type w} {wt : ι → M} + {x : ι → R} {e : ι → ν.AssociatedGraded} [Algebra k ν.AssociatedGraded] + (hscalar : ∀ c : k, + ν.Represents (algebraMap k R c) 0 (algebraMap k ν.AssociatedGraded c)) + (hx : ∀ i, ν.Represents (x i) (wt i) (e i)) + {F : MvPolynomial ι k} {m : M} (hF : IsWeightedHomogeneous wt F m) : + ν.Represents (aeval x F) m (aeval e F) := by + classical + induction hF using IsWeightedHomogeneous.induction_on with + | zero => simpa using ν.represents_zero m + | add p q hp hq ihp ihq => simpa using ihp.add ihq + | monomial d c hc => + rw [← hc, aeval_monomial, aeval_monomial, Finsupp.weight_apply, Finsupp.sum, + Finsupp.prod, Finsupp.prod] + exact (hscalar c).mul (zero_add _).symm + (ν.represents_prod fun i _ ↦ (hx i).pow (d i)) + +/-- Evaluating a polynomial whose monomials all have weight below `m` has degree below `m`. -/ +theorem degree_aeval_lt_of_forall_weight_lt {ν : MaxAddDegree R M} {ι : Type w} + {wt : ι → M} {x : ι → R} {e : ι → ν.AssociatedGraded} + [Algebra k ν.AssociatedGraded] + (hscalar : ∀ c : k, + ν.Represents (algebraMap k R c) 0 (algebraMap k ν.AssociatedGraded c)) + (hx : ∀ i, ν.Represents (x i) (wt i) (e i)) + {F : MvPolynomial ι k} {m : M} + (hF : ∀ d ∈ F.support, Finsupp.weight wt d < m) : + ν (aeval x F) < (m : WithBot M) := by + classical + rw [show aeval x F = + ∑ d ∈ F.support, aeval x (monomial d (MvPolynomial.coeff d F)) by + conv_lhs => rw [F.as_sum] + rw [map_sum]] + apply ν.map_sum_lt_of_forall_lt _ _ (WithBot.bot_lt_coe m) + intro d hd + have hhom : IsWeightedHomogeneous wt (monomial d (MvPolynomial.coeff d F)) + (Finsupp.weight wt d) := + isWeightedHomogeneous_monomial wt d (MvPolynomial.coeff d F) rfl + exact (ν.represents_aeval hscalar hx hhom).degree_le.trans_lt + (WithBot.coe_lt_coe.mpr (hF d hd)) + +/-- Polynomial evaluation represents the evaluation of its top weighted homogeneous part. -/ +theorem represents_aeval_weightedHomogeneousComponent {ν : MaxAddDegree R M} {ι : Type w} + {wt : ι → M} {x : ι → R} {e : ι → ν.AssociatedGraded} + [Algebra k ν.AssociatedGraded] + (hscalar : ∀ c : k, + ν.Represents (algebraMap k R c) 0 (algebraMap k ν.AssociatedGraded c)) + (hx : ∀ i, ν.Represents (x i) (wt i) (e i)) + {F : MvPolynomial ι k} {m : M} + (hF : ∀ d ∈ F.support, Finsupp.weight wt d ≤ m) : + ν.Represents (aeval x F) m (aeval e (weightedHomogeneousComponent wt m F)) := by + classical + have hhom : IsWeightedHomogeneous wt (weightedHomogeneousComponent wt m F) m := + weightedHomogeneousComponent_isWeightedHomogeneous (w := wt) (n := m) (φ := F) + have hrest : ∀ d ∈ (F - weightedHomogeneousComponent wt m F).support, + Finsupp.weight wt d < m := by + intro d hd + have hne := MvPolynomial.mem_support_iff.mp hd + rw [MvPolynomial.coeff_sub, coeff_weightedHomogeneousComponent] at hne + by_cases hdw : Finsupp.weight wt d = m + · rw [if_pos hdw, sub_self] at hne + exact absurd rfl hne + · rw [if_neg hdw, sub_zero] at hne + exact lt_of_le_of_ne (hF d (MvPolynomial.mem_support_iff.mpr hne)) hdw + have htop := ν.represents_aeval hscalar hx hhom + have hlow : + ν.Represents (aeval x (F - weightedHomogeneousComponent wt m F)) m 0 := + ν.represents_zero_of_degree_lt + (ν.degree_aeval_lt_of_forall_weight_lt hscalar hx hrest) + have := htop.add hlow + rwa [← map_add, add_sub_cancel, add_zero] at this + +end MaxAddDegree + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeScalar.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeScalar.lean new file mode 100644 index 0000000000..ab8e0cce09 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeScalar.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm + +/-! +# Degree-zero scalar maps + +A scalar map whose nonzero values all have degree zero induces a ring homomorphism from the +scalar ring to the associated graded ring, sending each scalar to its initial form. Its image is +represented in grade zero. This is how the scalars of a subalgebra act on a fibre associated +graded ring. +-/ + +open scoped MaxAddDegree + +universe u v w + +public noncomputable section + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} {k : Type w} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + +private def degreeZeroScalarFiltration [CommRing k] + (ν : MaxAddDegree R M) (ι : k →+* R) + (hdegree : ∀ c : k, c ≠ 0 → ν (ι c) = 0) (c : k) : + ν.filtrationLE 0 := + ⟨ι c, (ν.mem_filtrationLE_iff 0 _).mpr <| by + by_cases hc : c = 0 + · subst c + simp + · rw [hdegree c hc, WithBot.coe_zero]⟩ + +/-- The ring homomorphism from degree-zero scalars to their grade-zero initial classes. -/ +def degreeZeroScalarHom [CommRing k] + (ν : MaxAddDegree R M) (ι : k →+* R) + (hdegree : ∀ c : k, c ≠ 0 → ν (ι c) = 0) : + k →+* ν.AssociatedGraded where + toFun c := ν.homogeneousMk 0 (degreeZeroScalarFiltration ν ι hdegree c) + map_zero' := by + change ν.homogeneousMk 0 (degreeZeroScalarFiltration ν ι hdegree 0) = 0 + have hzero : degreeZeroScalarFiltration ν ι hdegree 0 = 0 := by + apply Subtype.ext + exact ι.map_zero + rw [hzero] + exact (ν.homogeneousMk 0).map_zero + map_one' := by + rw [ν.homogeneousMk_apply] + change DirectSum.of ν.Component 0 + (ν.componentMk 0 (degreeZeroScalarFiltration ν ι hdegree 1)) = + DirectSum.of ν.Component 0 ν.componentOne + apply congrArg (DirectSum.of ν.Component 0) + rw [ν.componentOne_eq_componentMk] + apply congrArg (ν.componentMk 0) + apply Subtype.ext + exact ι.map_one + map_add' c d := by + change ν.homogeneousMk 0 (degreeZeroScalarFiltration ν ι hdegree (c + d)) = + ν.homogeneousMk 0 (degreeZeroScalarFiltration ν ι hdegree c) + + ν.homogeneousMk 0 (degreeZeroScalarFiltration ν ι hdegree d) + rw [← (ν.homogeneousMk 0).map_add] + apply congrArg (ν.homogeneousMk 0) + apply Subtype.ext + exact ι.map_add c d + map_mul' c d := by + rw [ν.homogeneousMk_mul, ν.homogeneousMk_apply, ν.homogeneousMk_apply] + apply DirectSum.of_eq_of_gradedMonoid_eq + apply Sigma.ext (zero_add 0).symm + apply ν.componentMk_heq_of_grade_eq_of_coe_eq (zero_add 0).symm + rw [ν.coe_mulFiltrationLE] + exact ι.map_mul c d + +/-- Evaluation of the degree-zero scalar homomorphism on any grade-zero filtration +representative of the scalar's image. -/ +theorem degreeZeroScalarHom_apply [CommRing k] + (ν : MaxAddDegree R M) (ι : k →+* R) + (hdegree : ∀ c : k, c ≠ 0 → ν (ι c) = 0) (c : k) + (x : ν.filtrationLE 0) (hx : (x : R) = ι c) : + degreeZeroScalarHom ν ι hdegree c = ν.homogeneousMk 0 x := by + change ν.homogeneousMk 0 (degreeZeroScalarFiltration ν ι hdegree c) = _ + refine congrArg (ν.homogeneousMk 0) (Subtype.ext ?_) + exact hx.symm + +/-- The degree-zero scalar homomorphism sends each scalar to its initial form. -/ +theorem degreeZeroScalarHom_apply_eq_initialForm [CommRing k] + (ν : MaxAddDegree R M) (ι : k →+* R) + (hdegree : ∀ c : k, c ≠ 0 → ν (ι c) = 0) (c : k) : + degreeZeroScalarHom ν ι hdegree c = ν.initialForm (ι c) := by + by_cases hc : c = 0 + · subst c + rw [(degreeZeroScalarHom ν ι hdegree).map_zero, ι.map_zero, ν.initialForm_zero] + · rw [degreeZeroScalarHom_apply ν ι hdegree c ⟨ι c, (ν.mem_filtrationLE_iff 0 _).mpr + (hdegree c hc).le⟩ rfl] + exact ν.homogeneousMk_eq_initialForm_of_degree_eq _ (hdegree c hc) + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeSum.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeSum.lean new file mode 100644 index 0000000000..65a1ac2538 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeSum.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm + +import Mathlib.Tactic.Ring + +/-! +# Degrees and homogeneous classes of finite sums + +For a max-additive degree `ν`, a summand of strictly dominant degree determines the degree of a +sum, a finite sum of elements of degree below `d` has degree below `d`, and the homogeneous class +at level `d` of a finite sum of elements of the weak filtration is the sum of the classes. The +grade-`d` component of a finite sum of homogeneous classes `homogeneousMk (m i) (y i)` is the class +of the sum of the terms with `m i = d`, and the grade-`d` component of an initial form is the class +of the element when its degree is `d` and zero otherwise. Finally, for a well-founded value +monoid, an additive subgroup whose elements of degree at most `d` exhaust the classes at level `d`, +for every `d`, is the whole ring. +-/ + +universe u v x + +public noncomputable section + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} +variable [CommRing R] [AddCommMonoid M] [LinearOrder M] [IsOrderedCancelAddMonoid M] + +variable (ν : MaxAddDegree R M) + +theorem homogeneousMk_eq_zero_of_degree_lt {d : M} {x : R} (hle : x ∈ ν.filtrationLE d) + (hx : ν x < (d : WithBot M)) : ν.homogeneousMk d ⟨x, hle⟩ = 0 := + (ν.homogeneousMk_eq_zero_iff d ⟨x, hle⟩).mpr hx + +/-- The homogeneous class of a finite sum at a common level is the sum of the classes. -/ +theorem homogeneousMk_finsetSum {ι : Type x} (s : Finset ι) (x : ι → R) {d : M} + (hx : ∀ i ∈ s, x i ∈ ν.filtrationLE d) (hsum : ∑ i ∈ s, x i ∈ ν.filtrationLE d) : + ν.homogeneousMk d ⟨∑ i ∈ s, x i, hsum⟩ = + ∑ i ∈ s.attach, ν.homogeneousMk d ⟨x i, hx i i.2⟩ := by + rw [← map_sum] + congr 1 + apply Subtype.ext + rw [AddSubmonoidClass.coe_finsetSum] + simp only + rw [Finset.sum_attach s x] + +omit [IsOrderedCancelAddMonoid M] in +/-- A strictly dominant summand determines the degree of a sum. -/ +theorem degree_add_eq_of_lt {x y : R} (h : ν y < ν x) : ν (x + y) = ν x := by + refine le_antisymm ((ν.map_add_le_max x y).trans (max_le le_rfl h.le)) ?_ + by_contra hcon + rw [not_le] at hcon + have hx : x = (x + y) + (-y) := by ring + have hbound := ν.map_add_le_max (x + y) (-y) + rw [← hx, ν.map_neg] at hbound + exact absurd (lt_of_le_of_lt hbound (max_lt hcon h)) (lt_irrefl _) + +omit [IsOrderedCancelAddMonoid M] in +theorem degree_finsetSum_lt {ι : Type x} (s : Finset ι) (x : ι → R) {d : M} + (hx : ∀ i ∈ s, ν (x i) < (d : WithBot M)) : ν (∑ i ∈ s, x i) < (d : WithBot M) := by + classical + refine lt_of_le_of_lt (ν.map_sum_le_of_forall_le s x (s.sup fun i ↦ ν (x i)) + fun i hi ↦ Finset.le_sup (f := fun i ↦ ν (x i)) hi) ?_ + exact (Finset.sup_lt_iff (WithBot.bot_lt_coe d)).mpr hx + +theorem homogeneousMk_apply_of_eq {m d : M} {y : R} (hy : y ∈ ν.filtrationLE m) (h : m = d) : + (ν.homogeneousMk m ⟨y, hy⟩) d = ν.componentMk d ⟨y, h ▸ hy⟩ := by + subst h + rw [ν.homogeneousMk_apply, DirectSum.of_eq_same] + +theorem homogeneousMk_apply_of_ne {m d : M} {y : R} (hy : y ∈ ν.filtrationLE m) (h : m ≠ d) : + (ν.homogeneousMk m ⟨y, hy⟩) d = 0 := by + rw [ν.homogeneousMk_apply, DirectSum.of_eq_of_ne _ _ _ (Ne.symm h)] + +/-- The grade-`d` component of a finite sum of homogeneous classes is the class of the sum of +the terms of grade `d`. -/ +theorem homogeneousMk_finsetSum_apply {ι : Type x} (s : Finset ι) (m : ι → M) (y : ι → R) + (hy : ∀ i, y i ∈ ν.filtrationLE (m i)) (d : M) : + (∑ i ∈ s, ν.homogeneousMk (m i) ⟨y i, hy i⟩) d = + ν.componentMk d ⟨∑ i ∈ s.filter (fun i ↦ m i = d), y i, + (ν.filtrationLE d).sum_mem fun i hi ↦ (Finset.mem_filter.mp hi).2 ▸ hy i⟩ := by + classical + rw [DirectSum.sum_apply] + have hterm : ∀ i ∈ s, (ν.homogeneousMk (m i) ⟨y i, hy i⟩) d = + if h : m i = d then ν.componentMk d ⟨y i, h ▸ hy i⟩ else 0 := fun i _ ↦ by + by_cases h : m i = d + · rw [dif_pos h, ν.homogeneousMk_apply_of_eq (hy i) h] + · rw [dif_neg h, ν.homogeneousMk_apply_of_ne (hy i) h] + rw [Finset.sum_congr rfl hterm, Finset.sum_dite, Finset.sum_const_zero, add_zero, ← map_sum] + congr 1 + apply Subtype.ext + rw [AddSubmonoidClass.coe_finsetSum] + simp only + exact Finset.sum_attach (s.filter fun i ↦ m i = d) y + +/-- The grade-`d` component of an initial form. -/ +theorem initialForm_apply (y : R) (d : M) : + (ν.initialForm y) d = + if h : ν y = (d : WithBot M) then + ν.componentMk d ⟨y, (ν.mem_filtrationLE_iff d y).mpr h.le⟩ else 0 := by + by_cases hy : ν y = ⊥ + · rw [ν.initialForm_eq_zero_of_eq_bot hy, DirectSum.zero_apply] + split_ifs with h + · rw [hy] at h + exact absurd h WithBot.bot_ne_coe + · rfl + · obtain ⟨m, hm⟩ := WithBot.ne_bot_iff_exists.mp hy + have hmem : y ∈ ν.filtrationLE m := (ν.mem_filtrationLE_iff m y).mpr hm.symm.le + rw [← ν.homogeneousMk_eq_initialForm_of_degree_eq hmem hm.symm] + by_cases h : m = d + · rw [ν.homogeneousMk_apply_of_eq hmem h, dif_pos (by rw [← hm, h])] + · rw [ν.homogeneousMk_apply_of_ne hmem h, dif_neg] + intro h' + rw [← hm, WithBot.coe_inj] at h' + exact h h' + +omit [IsOrderedCancelAddMonoid M] in +theorem zero_le_degree (hν : ν.IsSeparated) (h0 : ∀ m : M, 0 ≤ m) {x : R} (hx : x ≠ 0) : + (0 : WithBot M) ≤ ν x := by + cases h : ν x with + | bot => exact absurd (((isSeparated_iff ν).mp hν x).mp h) hx + | coe m => exact WithBot.coe_le_coe.mpr (h0 m) + +omit [IsOrderedCancelAddMonoid M] in +/-- An additive subgroup `P` containing, for every degree `d` and every class `g` at level `d`, +an element of degree at most `d` whose class at level `d` is `g`, is the whole ring: by +well-founded induction on the degree, subtracting such an element lowers the degree. -/ +theorem mem_of_forall_exists_componentMk_eq [WellFoundedLT M] (hν : ν.IsSeparated) + (P : AddSubgroup R) + (h : ∀ (d : M) (g : ν.Component d), ∃ p ∈ P, ∃ hp : p ∈ ν.filtrationLE d, + ν.componentMk d ⟨p, hp⟩ = g) + (t : R) : t ∈ P := by + induction hdeg : ν t using WellFoundedLT.induction generalizing t with + | _ δ ih => + cases hδ : δ with + | bot => + rw [hδ] at hdeg + rw [((ν.isSeparated_iff).mp hν t).mp hdeg] + exact zero_mem P + | coe d => + rw [hδ] at hdeg ih + have hle : t ∈ ν.filtrationLE d := (ν.mem_filtrationLE_iff d t).mpr hdeg.le + obtain ⟨p, hpP, hple, hp⟩ := h d (ν.componentMk d ⟨t, hle⟩) + have hsub : ν.componentMk d ⟨t - p, (ν.filtrationLE d).sub_mem hle hple⟩ = 0 := by + have : (⟨t - p, (ν.filtrationLE d).sub_mem hle hple⟩ : ν.filtrationLE d) = + ⟨t, hle⟩ - ⟨p, hple⟩ := rfl + rw [this, map_sub, hp, sub_self] + rw [ν.componentMk_eq_zero_iff] at hsub + have hmem := ih _ (hdeg ▸ hsub) (t - p) rfl + have : t = (t - p) + p := by ring + rw [this] + exact P.add_mem hmem hpP + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeWeightedPolynomial.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeWeightedPolynomial.lean new file mode 100644 index 0000000000..c1452abbfe --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeWeightedPolynomial.lean @@ -0,0 +1,239 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeSum +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.WeightedTotalDegree +public import Mathlib.Algebra.MvPolynomial.Eval + +import Mathlib.Algebra.BigOperators.Ring.Finset +import Mathlib.Algebra.BigOperators.Finsupp.Basic + +/-! +# The degree of a polynomial in elements with independent initial forms + +Let `ν` be a multiplicative degree on a commutative ring `R` with values in `M`, let `L → R` be a +ring of scalars whose nonzero elements have degree zero, and let `x i ∈ R` be elements of degrees +`w i ∈ M`. Suppose the initial forms of the `x i` are algebraically independent over the initial +forms of `L`: an injective ring homomorphism `Φ : L[X] → gr_ν R` sends `C c` to `in(c)` and `X i` +to `in(x i)`. Then for every nonzero polynomial `F`, the degree of `F(x)` is the weighted total +degree of `F` for the weights `w`, and the initial form of `F(x)` is `Φ` of the top +weighted-homogeneous component of `F`: the monomials of top weight have independent initial +forms, so their sum has exactly that degree, and the remaining terms have smaller degree. +Consequently evaluation at `x` is injective. + +The weights take values in the value monoid `M` itself; weights in `ℕ`, read in `M` through +`Nat.cast`, are the case treated by the cast lemmas of +`ConwayRefinement.Algebra.MvPolynomial.WeightedTotalDegree`. +-/ + +universe u v w x + +public noncomputable section + +open MvPolynomial + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} {L : Type w} {σ : Type x} + +variable [CommRing R] [AddCommMonoid M] [LinearOrder M] [IsOrderedCancelAddMonoid M] + +section Multiplicative + +variable (ν : MaxAddDegree R M) [ν.IsMultiplicative] + +/-- The initial form of a power is the power of the initial form. -/ +theorem initialForm_pow (y : R) (n : ℕ) : ν.initialForm (y ^ n) = ν.initialForm y ^ n := by + induction n with + | zero => rw [pow_zero, pow_zero, ν.initialForm_one] + | succ n ih => rw [pow_succ, pow_succ, ν.initialForm_mul, ih] + +/-- The initial form of a finite product is the product of the initial forms. -/ +theorem initialForm_finset_prod {ι : Type*} (s : Finset ι) (f : ι → R) : + ν.initialForm (∏ i ∈ s, f i) = ∏ i ∈ s, ν.initialForm (f i) := by + classical + induction s using Finset.induction_on with + | empty => rw [Finset.prod_empty, Finset.prod_empty, ν.initialForm_one] + | insert a s ha ih => rw [Finset.prod_insert ha, Finset.prod_insert ha, ν.initialForm_mul, ih] + +end Multiplicative + +variable [CommRing L] [Nontrivial L] [Algebra L R] + +/-- Elements `x i` of degrees `w i` whose initial forms are algebraically independent over the +initial forms of the degree-zero scalars `L`, witnessed by an injective ring homomorphism +`Φ : L[X] → gr_ν R` with `Φ (C c) = in(c)` and `Φ (X i) = in(x i)`. -/ +structure IsInitialFormCoordinates (ν : MaxAddDegree R M) (w : σ → M) (x : σ → R) + (Φ : MvPolynomial σ L →+* ν.AssociatedGraded) : Prop where + degree_algebraMap : ∀ c : L, c ≠ 0 → ν (algebraMap L R c) = 0 + degree_x : ∀ i, ν (x i) = (w i : WithBot M) + injective : Function.Injective Φ + map_C : ∀ c : L, Φ (C c) = ν.initialForm (algebraMap L R c) + map_X : ∀ i, Φ (X i) = ν.initialForm (x i) + +namespace IsInitialFormCoordinates + +variable {ν : MaxAddDegree R M} {w : σ → M} {x : σ → R} + {Φ : MvPolynomial σ L →+* ν.AssociatedGraded} +variable [ν.IsMultiplicative] (H : IsInitialFormCoordinates ν w x Φ) +include H + +omit [ν.IsMultiplicative] in +theorem degree_one : ν 1 = 0 := by + simpa using H.degree_algebraMap 1 one_ne_zero + +theorem degree_pow {y : R} {m : M} (hy : ν y = m) (n : ℕ) : + ν (y ^ n) = ((n • m : M) : WithBot M) := by + induction n with + | zero => rw [pow_zero, zero_smul, WithBot.coe_zero]; exact H.degree_one + | succ n ih => rw [pow_succ, ν.map_mul, ih, hy, succ_nsmul, WithBot.coe_add] + +theorem degree_finset_prod {ι : Type*} (s : Finset ι) (f : ι → R) (m : ι → M) + (h : ∀ i ∈ s, ν (f i) = m i) : + ν (∏ i ∈ s, f i) = ((∑ i ∈ s, m i : M) : WithBot M) := by + classical + induction s using Finset.induction_on with + | empty => simpa using H.degree_one + | insert a s ha ih => + rw [Finset.prod_insert ha, Finset.sum_insert ha, ν.map_mul, h a (Finset.mem_insert_self a s), + ih fun i hi ↦ h i (Finset.mem_insert_of_mem hi), WithBot.coe_add] + +/-- The degree of the value of a monomial with nonzero coefficient is its weight. -/ +theorem degree_aeval_monomial (e : σ →₀ ℕ) {c : L} (hc : c ≠ 0) : + ν (aeval x (monomial e c)) = (Finsupp.weight w e : WithBot M) := by + classical + rw [aeval_monomial, ν.map_mul, H.degree_algebraMap c hc, zero_add, Finsupp.prod, + H.degree_finset_prod e.support (fun i ↦ x i ^ e i) (fun i ↦ e i • w i) + fun i _ ↦ H.degree_pow (H.degree_x i) (e i), + Finsupp.weight_apply, Finsupp.sum] + +omit [Nontrivial L] in +/-- On a monomial, the initial form of the value is `Φ` of the monomial. -/ +theorem initialForm_aeval_monomial (e : σ →₀ ℕ) (c : L) : + ν.initialForm (aeval x (monomial e c)) = Φ (monomial e c) := by + classical + rw [aeval_monomial, ν.initialForm_mul, Finsupp.prod, ν.initialForm_finset_prod, monomial_eq, + _root_.map_mul, H.map_C, Finsupp.prod, _root_.map_prod] + congr 1 + exact Finset.prod_congr rfl fun i _ ↦ by rw [ν.initialForm_pow, _root_.map_pow, H.map_X] + +/-- For a weighted-homogeneous polynomial `G` of weight `d`, the class of `G(x)` at level `d` is +`Φ G`: every monomial of `G` has degree exactly `d`, where the class map is additive. -/ +theorem homogeneousMk_aeval_of_isWeightedHomogeneous {G : MvPolynomial σ L} {d : M} + (hG : IsWeightedHomogeneous w G d) (hle : aeval x G ∈ ν.filtrationLE d) : + ν.homogeneousMk d ⟨aeval x G, hle⟩ = Φ G := by + classical + have hdeg : ∀ e ∈ G.support, + ν (aeval x (monomial e (coeff e G))) = (d : WithBot M) := fun e he ↦ by + rw [H.degree_aeval_monomial e (mem_support_iff.mp he), hG (mem_support_iff.mp he)] + have hmem : ∀ e ∈ G.support, aeval x (monomial e (coeff e G)) ∈ ν.filtrationLE d := + fun e he ↦ (ν.mem_filtrationLE_iff _ _).mpr (hdeg e he).le + have hsplit : (⟨aeval x G, hle⟩ : ν.filtrationLE d) = + ⟨∑ e ∈ G.support, aeval x (monomial e (coeff e G)), (ν.filtrationLE _).sum_mem hmem⟩ := by + apply Subtype.ext + change aeval x G = _ + conv_lhs => rw [as_sum G] + rw [_root_.map_sum] + rw [hsplit, ν.homogeneousMk_finsetSum _ _ hmem] + conv_rhs => rw [as_sum G] + rw [_root_.map_sum, ← Finset.sum_attach G.support fun e ↦ Φ (monomial e (coeff e G))] + refine Finset.sum_congr rfl fun e _ ↦ ?_ + rw [ν.homogeneousMk_eq_initialForm_of_degree_eq _ (hdeg e.1 e.2)] + exact H.initialForm_aeval_monomial e.1 (coeff e.1 G) + +variable [OrderBot M] + +/-- A polynomial of weighted total degree at most `d` evaluates to an element of degree at most +`d`. -/ +theorem degree_aeval_le_of_weightedTotalDegree_le {F : MvPolynomial σ L} {d : M} + (hF : weightedTotalDegree w F ≤ d) : + ν (aeval x F) ≤ (d : WithBot M) := by + classical + conv_lhs => rw [as_sum F] + rw [_root_.map_sum] + refine ν.map_sum_le_of_forall_le _ _ _ fun e he ↦ ?_ + rw [H.degree_aeval_monomial e (mem_support_iff.mp he)] + exact WithBot.coe_le_coe.mpr ((le_weightedTotalDegree w he).trans hF) + +/-- A polynomial value has degree at most the weighted total degree of the polynomial. -/ +theorem degree_aeval_le (F : MvPolynomial σ L) : + ν (aeval x F) ≤ ((weightedTotalDegree w F : M) : WithBot M) := + H.degree_aeval_le_of_weightedTotalDegree_le le_rfl + +/-- A nonzero weighted-homogeneous polynomial of weight `d` evaluates to an element of degree +exactly `d`. -/ +theorem degree_aeval_eq_of_isWeightedHomogeneous {G : MvPolynomial σ L} {d : M} + (hG : IsWeightedHomogeneous w G d) (hne : G ≠ 0) : + ν (aeval x G) = (d : WithBot M) := by + have hle : ν (aeval x G) ≤ (d : WithBot M) := + H.degree_aeval_le_of_weightedTotalDegree_le + (Finset.sup_le fun e he ↦ (hG (mem_support_iff.mp he)).le) + have hmem := (ν.mem_filtrationLE_iff _ _).mpr hle + refine le_antisymm hle (not_lt.mp fun hlt ↦ H.injective.ne hne ?_) + rw [_root_.map_zero, ← H.homogeneousMk_aeval_of_isWeightedHomogeneous hG hmem] + exact ν.homogeneousMk_eq_zero_of_degree_lt hmem hlt + +/-- The initial form of the value of a weighted-homogeneous polynomial `G` is `Φ G`. -/ +theorem initialForm_aeval_of_isWeightedHomogeneous {G : MvPolynomial σ L} {d : M} + (hG : IsWeightedHomogeneous w G d) : + ν.initialForm (aeval x G) = Φ G := by + by_cases hzero : G = 0 + · subst hzero + rw [_root_.map_zero, _root_.map_zero, ν.initialForm_zero] + have hdeg := H.degree_aeval_eq_of_isWeightedHomogeneous hG hzero + have hmem := (ν.mem_filtrationLE_iff _ _).mpr hdeg.le + rw [← ν.homogeneousMk_eq_initialForm_of_degree_eq hmem hdeg] + exact H.homogeneousMk_aeval_of_isWeightedHomogeneous hG hmem + +/-- The degree of the value of a nonzero polynomial is its weighted total degree, and the initial +form of the value is `Φ` of the top weighted-homogeneous component. -/ +theorem degree_aeval_eq_and_initialForm {F : MvPolynomial σ L} (hF : F ≠ 0) : + ν (aeval x F) = ((weightedTotalDegree w F : M) : WithBot M) ∧ + ν.initialForm (aeval x F) = + Φ (weightedHomogeneousComponent w (weightedTotalDegree w F) F) := by + classical + set d := weightedTotalDegree w F with hd + set G := weightedHomogeneousComponent w d F with hG + have hGne : G ≠ 0 := weightedHomogeneousComponent_weightedTotalDegree_ne_zero w hF + have hGhom : IsWeightedHomogeneous w G d := + weightedHomogeneousComponent_isWeightedHomogeneous d F + have hGdeg := H.degree_aeval_eq_of_isWeightedHomogeneous hGhom hGne + have hrest : ν (aeval x (F - G)) < (d : WithBot M) := by + rcases weightedTotalDegree_sub_weightedHomogeneousComponent_lt w F with h0 | hlt + · rw [h0, _root_.map_zero, ν.map_zero] + exact WithBot.bot_lt_coe _ + · exact lt_of_le_of_lt (H.degree_aeval_le (F - G)) (WithBot.coe_lt_coe.mpr hlt) + have hsplit : aeval x F = aeval x G + aeval x (F - G) := by + rw [← _root_.map_add, add_sub_cancel] + have hdegF : ν (aeval x F) = (d : WithBot M) := by + rw [hsplit, ν.degree_add_eq_of_lt (by rw [hGdeg]; exact hrest), hGdeg] + refine ⟨hdegF, ?_⟩ + have hmemF := (ν.mem_filtrationLE_iff _ _).mpr hdegF.le + have hmemG := (ν.mem_filtrationLE_iff _ _).mpr hGdeg.le + have hmemR := (ν.mem_filtrationLE_iff _ _).mpr hrest.le + rw [← ν.homogeneousMk_eq_initialForm_of_degree_eq hmemF hdegF] + have hsum : (⟨aeval x F, hmemF⟩ : ν.filtrationLE d) = + ⟨aeval x G, hmemG⟩ + ⟨aeval x (F - G), hmemR⟩ := Subtype.ext hsplit + rw [hsum, _root_.map_add, H.homogeneousMk_aeval_of_isWeightedHomogeneous hGhom hmemG, + ν.homogeneousMk_eq_zero_of_degree_lt hmemR hrest, add_zero] + +/-- The degree of the value of a nonzero polynomial is its weighted total degree. -/ +theorem degree_aeval_eq {F : MvPolynomial σ L} (hF : F ≠ 0) : + ν (aeval x F) = ((weightedTotalDegree w F : M) : WithBot M) := + (H.degree_aeval_eq_and_initialForm hF).1 + +/-- Evaluation at `x` is injective: the `x i` are algebraically independent over `L`. -/ +theorem aeval_injective : Function.Injective (aeval (R := L) x) := by + refine (injective_iff_map_eq_zero _).mpr fun F hF ↦ ?_ + by_contra hne + have h := H.degree_aeval_eq hne + rw [hF, ν.map_zero] at h + exact WithBot.bot_ne_coe h + +end IsInitialFormCoordinates + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/FiltrationDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/FiltrationDegree.lean new file mode 100644 index 0000000000..d5170c1d30 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/FiltrationDegree.lean @@ -0,0 +1,255 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.MaxAddDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain +public import Mathlib.RingTheory.Ideal.Operations + +/-! +# A max-additive degree from a separated multiplicative filtration + +A decreasing, multiplicative filtration by ideals which is separated — every nonzero element +eventually leaves it — determines a max-additive degree, valued in `OrderDual ℕ` because the +filtration decreases. The generic construction can be reused for scalar extensions and quotient +filtrations. + +The file also proves that a ring with a separated multiplicative filtration and domain associated +graded ring is itself a domain. The proof avoids +`MaxAddDegree.quotient_isDomain_of_associatedGraded_isDomain`, whose `[WellFoundedLT M]` +hypothesis fails for `M = ℕᵒᵈ` — precisely the value monoid of a decreasing `ℕ`-indexed +filtration. The elementary route needs no well-foundedness. +-/ + +open scoped MaxAddDegree + +universe u + +public noncomputable section + +variable {R : Type u} [CommRing R] + +/-- A decreasing multiplicative filtration by ideals, separated in the sense that every nonzero +element eventually leaves it. -/ +structure IsSeparatedFiltration (F : ℕ → Ideal R) : Prop where + /-- The filtration is decreasing. -/ + antitone : Antitone F + /-- The zeroth stage is everything. -/ + top : F 0 = ⊤ + /-- The filtration is multiplicative: `F a · F b ⊆ F (a + b)`. -/ + mul_le : ∀ a b, F a * F b ≤ F (a + b) + /-- Every nonzero element eventually leaves the filtration. -/ + exists_not_mem : ∀ {x : R}, x ≠ 0 → ∃ j, x ∉ F j + +namespace IsSeparatedFiltration + +variable {F : ℕ → Ideal R} (hF : IsSeparatedFiltration F) + +/-- The first stage a nonzero element is absent from. -/ +def firstExcluded {x : R} (hx : x ≠ 0) : ℕ := by + classical + exact Nat.find (hF.exists_not_mem hx) + +theorem not_mem_firstExcluded {x : R} (hx : x ≠ 0) : + x ∉ F (hF.firstExcluded hx) := by + classical + exact Nat.find_spec (hF.exists_not_mem hx) + +theorem firstExcluded_le {x : R} (hx : x ≠ 0) {j : ℕ} (hj : x ∉ F j) : + hF.firstExcluded hx ≤ j := by + classical + exact Nat.find_le hj + +theorem firstExcluded_pos {x : R} (hx : x ≠ 0) : 0 < hF.firstExcluded hx := by + rcases Nat.eq_zero_or_pos (hF.firstExcluded hx) with h | h + · exfalso + apply hF.not_mem_firstExcluded hx + rw [h, hF.top] + trivial + · exact h + +theorem mem_iff_lt_firstExcluded {x : R} (hx : x ≠ 0) (j : ℕ) : + x ∈ F j ↔ j < hF.firstExcluded hx := by + constructor + · intro hmem + by_contra hnot + exact hF.not_mem_firstExcluded hx (hF.antitone (Nat.not_lt.mp hnot) hmem) + · intro hj + by_contra hnot + exact absurd (hF.firstExcluded_le hx hnot) (Nat.not_le.mpr hj) + +/-- The largest stage containing a nonzero element. -/ +def index {x : R} (hx : x ≠ 0) : ℕ := hF.firstExcluded hx - 1 + +theorem mem_iff_le_index {x : R} (hx : x ≠ 0) (j : ℕ) : + x ∈ F j ↔ j ≤ hF.index hx := by + rw [hF.mem_iff_lt_firstExcluded hx] + unfold index + have hpos := hF.firstExcluded_pos hx + omega + +/-- The filtration index as a max-additive degree value, order-reversed. -/ +def value (x : R) : WithBot (OrderDual ℕ) := by + classical + exact if hx : x = 0 then ⊥ else + ((OrderDual.toDual (hF.index hx) : OrderDual ℕ) : WithBot (OrderDual ℕ)) + +@[simp] +theorem value_zero : hF.value 0 = ⊥ := by + rw [value, dif_pos rfl] + +theorem value_of_ne_zero {x : R} (hx : x ≠ 0) : + hF.value x = ((OrderDual.toDual (hF.index hx) : OrderDual ℕ) : + WithBot (OrderDual ℕ)) := by + rw [value, dif_neg hx] + +theorem value_eq_bot_iff (x : R) : hF.value x = ⊥ ↔ x = 0 := by + constructor + · intro h + by_contra hx + rw [hF.value_of_ne_zero hx] at h + exact absurd h (WithBot.coe_ne_bot) + · rintro rfl + exact hF.value_zero + +theorem value_le_toDual_iff (x : R) (j : ℕ) : + hF.value x ≤ ((OrderDual.toDual j : OrderDual ℕ) : WithBot (OrderDual ℕ)) ↔ + x ∈ F j := by + by_cases hx : x = 0 + · subst hx + simp only [hF.value_zero, bot_le, true_iff] + exact Submodule.zero_mem _ + · rw [hF.value_of_ne_zero hx, WithBot.coe_le_coe, hF.mem_iff_le_index hx] + exact OrderDual.toDual_le_toDual + +private theorem firstExcluded_congr {x y : R} (hx : x ≠ 0) (hy : y ≠ 0) + (h : ∀ j, x ∈ F j ↔ y ∈ F j) : hF.firstExcluded hx = hF.firstExcluded hy := by + refine le_antisymm ?_ ?_ + · exact hF.firstExcluded_le hx fun hmem ↦ + hF.not_mem_firstExcluded hy ((h _).mp hmem) + · exact hF.firstExcluded_le hy fun hmem ↦ + hF.not_mem_firstExcluded hx ((h _).mpr hmem) + +theorem value_neg (x : R) : hF.value (-x) = hF.value x := by + by_cases hx : x = 0 + · subst hx + rw [neg_zero] + · have hnx : -x ≠ 0 := neg_ne_zero.mpr hx + rw [hF.value_of_ne_zero hnx, hF.value_of_ne_zero hx] + have hfirst : hF.firstExcluded hnx = hF.firstExcluded hx := + hF.firstExcluded_congr hnx hx fun j ↦ + ⟨fun hmem ↦ by simpa using (F j).neg_mem hmem, fun hmem ↦ (F j).neg_mem hmem⟩ + rw [index, index, hfirst] + +/-- The ultrametric inequality, from additivity of each stage. -/ +theorem value_add_le_max (x y : R) : + hF.value (x + y) ≤ max (hF.value x) (hF.value y) := by + by_cases hx : x = 0 + · subst hx + rw [zero_add, hF.value_zero] + exact le_max_right _ _ + by_cases hy : y = 0 + · subst hy + rw [add_zero, hF.value_zero] + exact le_max_left _ _ + rcases le_total (hF.index hx) (hF.index hy) with hab | hab + · have hmax : max (hF.value x) (hF.value y) = + ((OrderDual.toDual (hF.index hx) : OrderDual ℕ) : WithBot (OrderDual ℕ)) := by + rw [hF.value_of_ne_zero hx, hF.value_of_ne_zero hy] + exact max_eq_left (by simpa using hab) + rw [hmax, hF.value_le_toDual_iff] + exact Submodule.add_mem _ ((hF.mem_iff_le_index hx _).mpr le_rfl) + ((hF.mem_iff_le_index hy _).mpr hab) + · have hmax : max (hF.value x) (hF.value y) = + ((OrderDual.toDual (hF.index hy) : OrderDual ℕ) : WithBot (OrderDual ℕ)) := by + rw [hF.value_of_ne_zero hx, hF.value_of_ne_zero hy] + exact max_eq_right (by simpa using hab) + rw [hmax, hF.value_le_toDual_iff] + exact Submodule.add_mem _ ((hF.mem_iff_le_index hx _).mpr hab) + ((hF.mem_iff_le_index hy _).mpr le_rfl) + +/-- Subadditivity under multiplication, from the multiplicativity hypothesis. -/ +theorem value_mul_le_add (x y : R) : + hF.value (x * y) ≤ hF.value x + hF.value y := by + by_cases hx : x = 0 + · subst hx + rw [zero_mul, hF.value_zero] + exact bot_le + by_cases hy : y = 0 + · subst hy + rw [mul_zero, hF.value_zero] + exact bot_le + have hrhs : hF.value x + hF.value y = + ((OrderDual.toDual (hF.index hx + hF.index hy) : OrderDual ℕ) : + WithBot (OrderDual ℕ)) := by + rw [hF.value_of_ne_zero hx, hF.value_of_ne_zero hy, ← WithBot.coe_add] + rfl + rw [hrhs, hF.value_le_toDual_iff] + exact hF.mul_le _ _ (Ideal.mul_mem_mul ((hF.mem_iff_le_index hx _).mpr le_rfl) + ((hF.mem_iff_le_index hy _).mpr le_rfl)) + +theorem value_lt_toDual_iff (x : R) (j : ℕ) : + hF.value x < ((OrderDual.toDual j : OrderDual ℕ) : WithBot (OrderDual ℕ)) ↔ + x ∈ F (j + 1) := by + by_cases hx : x = 0 + · subst hx + simp only [hF.value_zero, bot_lt_iff_ne_bot, ne_eq, WithBot.coe_ne_bot, + not_false_eq_true, true_iff] + exact Submodule.zero_mem _ + · rw [hF.value_of_ne_zero hx, WithBot.coe_lt_coe, hF.mem_iff_le_index hx] + constructor + · intro hlt + exact Nat.succ_le_of_lt (OrderDual.toDual_lt_toDual.mp hlt) + · intro hle + exact OrderDual.toDual_lt_toDual.mpr (Nat.lt_of_succ_le hle) + +/-- The max-additive degree attached to a separated multiplicative filtration. -/ +def degree : MaxAddDegree R (OrderDual ℕ) where + toFun := hF.value + map_zero' := hF.value_zero + map_one_le_zero' := by + change hF.value 1 ≤ ((OrderDual.toDual 0 : OrderDual ℕ) : WithBot (OrderDual ℕ)) + rw [hF.value_le_toDual_iff, hF.top] + trivial + map_neg' := hF.value_neg + map_add_le_max' := hF.value_add_le_max + map_mul_le_add' := hF.value_mul_le_add + +@[simp] +theorem degree_apply (x : R) : hF.degree x = hF.value x := (rfl) + +/-- The attached degree is separated. -/ +theorem degree_isSeparated : (hF.degree).IsSeparated := + (MaxAddDegree.isSeparated_iff hF.degree).mpr fun x ↦ hF.value_eq_bot_iff x + +/-- A ring with a separated multiplicative filtration and domain associated graded ring is a +domain. + +The proof does not use `MaxAddDegree.quotient_isDomain_of_associatedGraded_isDomain`, whose +`[WellFoundedLT M]` hypothesis fails for `M = ℕᵒᵈ`. Instead it obtains multiplicativity of the +attached degree directly from the domain associated graded ring. -/ +theorem isDomain_of_associatedGraded_isDomain + [IsDomain (hF.degree).AssociatedGraded] : IsDomain R := by + haveI : Nontrivial R := (hF.degree).nontrivial_of_associatedGraded_isDomain + haveI : (hF.degree).IsMultiplicative := + (hF.degree).isMultiplicative_of_associatedGraded_isDomain hF.degree_isSeparated + exact (hF.degree).isDomain hF.degree_isSeparated + +/-- The degree's weak filtration at dual index `j` is the stage `F j`. -/ +theorem mem_degree_filtrationLE_iff (j : ℕ) (x : R) : + x ∈ (hF.degree).filtrationLE (OrderDual.toDual j) ↔ x ∈ F j := by + rw [MaxAddDegree.mem_filtrationLE_iff] + exact hF.value_le_toDual_iff x j + +/-- The degree's strict filtration at dual index `j` is the stage `F (j+1)`. -/ +theorem mem_degree_lowerFiltration_iff (j : ℕ) + (x : (hF.degree).filtrationLE (OrderDual.toDual j)) : + x ∈ (hF.degree).lowerFiltration (OrderDual.toDual j) ↔ (x : R) ∈ F (j + 1) := by + rw [MaxAddDegree.mem_lowerFiltration_iff] + exact hF.value_lt_toDual_iff (x : R) j + +end IsSeparatedFiltration diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/MaxAddDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/MaxAddDegree.lean new file mode 100644 index 0000000000..c7b4411156 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/MaxAddDegree.lean @@ -0,0 +1,209 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.Order.Monoid.Unbundled.WithTop +public import Mathlib.Algebra.Order.Monoid.Defs +public import Mathlib.Algebra.BigOperators.Group.Finset.Basic +public import Mathlib.Algebra.Ring.Basic + +/-! +# Max-additive degree functions + +A `MaxAddDegree` records the properties of a unital ring filtration written in LM24's additive +convention: bottom at zero, degree at most zero for one, invariance under negation, the +ultrametric inequality with `max` for addition, and subadditivity under multiplication. + +Multiplication need not preserve the degree exactly. This is necessary for quotient filtrations: +the degree of a nonzero quotient class is the least degree of a representative, and +multiplication of least-degree representatives gives only an inequality until an +associated-graded argument proves equality. The exact case is the class `IsMultiplicative`; a +multiplicative degree is a multiplicative semi-valuation in the sense of LM24, Section 4, and a +separated one is a multiplicative valuation. LM24's bespoke convention `-∞ < -∞` is not used; +the bottom value is treated by the standard order on `WithBot`. +-/ + +universe u v + +public noncomputable section + +open scoped BigOperators + +/-- A ring degree function with bottom at zero, `max` for addition, and subadditivity under +multiplication. -/ +structure MaxAddDegree (R : Type u) (M : Type v) [CommRing R] [AddCommMonoid M] + [LinearOrder M] where + toFun : R → WithBot M + map_zero' : toFun 0 = ⊥ + map_one_le_zero' : toFun 1 ≤ 0 + map_neg' : ∀ x, toFun (-x) = toFun x + map_add_le_max' : ∀ x y, toFun (x + y) ≤ max (toFun x) (toFun y) + map_mul_le_add' : ∀ x y, toFun (x * y) ≤ toFun x + toFun y + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] [LinearOrder M] + +instance : CoeFun (MaxAddDegree R M) (fun _ ↦ R → WithBot M) := + ⟨MaxAddDegree.toFun⟩ + +/-- Max-additive degrees are equal when their underlying functions are equal. -/ +@[ext] +theorem ext {ν δ : MaxAddDegree R M} (h : ∀ x, ν x = δ x) : ν = δ := by + have hf : ν.toFun = δ.toFun := funext h + cases ν with + | mk f hz ho hn ha hm => + cases δ with + | mk g gz go gn ga gm => + dsimp only [MaxAddDegree.toFun] at hf + subst g + rfl + +@[simp] +theorem map_zero (ν : MaxAddDegree R M) : ν 0 = ⊥ := + ν.map_zero' + +/-- The unit lies in filtration degree zero. -/ +theorem map_one_le_zero (ν : MaxAddDegree R M) : ν 1 ≤ 0 := + ν.map_one_le_zero' + +@[simp] +theorem map_neg (ν : MaxAddDegree R M) (x : R) : ν (-x) = ν x := + ν.map_neg' x + +theorem map_add_le_max (ν : MaxAddDegree R M) (x y : R) : + ν (x + y) ≤ max (ν x) (ν y) := + ν.map_add_le_max' x y + +/-- Subtraction satisfies the same ultrametric inequality as addition. -/ +theorem map_sub_le_max (ν : MaxAddDegree R M) (x y : R) : + ν (x - y) ≤ max (ν x) (ν y) := by + simpa [sub_eq_add_neg] using ν.map_add_le_max x (-y) + +theorem map_mul_le_add (ν : MaxAddDegree R M) (x y : R) : + ν (x * y) ≤ ν x + ν y := + ν.map_mul_le_add' x y + +/-- Two elements whose difference has degree strictly below the degree of one of them have the +same degree. -/ +theorem map_eq_of_map_sub_lt (ν : MaxAddDegree R M) {x y : R} (hxy : ν (x - y) < ν x) : + ν x = ν y := by + apply le_antisymm + · by_contra hyx + have hyx' : ν y < ν x := lt_of_not_ge hyx + have hle : ν x ≤ max (ν y) (ν (x - y)) := by + simpa only [add_sub_cancel] using ν.map_add_le_max y (x - y) + exact (not_lt_of_ge hle) (max_lt hyx' hxy) + · have hle : ν y ≤ max (ν x) (ν (x - y)) := by + simpa only [sub_sub_cancel] using ν.map_sub_le_max x (x - y) + simpa only [max_eq_left hxy.le] using hle + +/-- A finite sum has degree at most a common bound for the degrees of its summands. -/ +theorem map_sum_le_of_forall_le (ν : MaxAddDegree R M) {ι : Type*} + (s : Finset ι) (f : ι → R) (m : WithBot M) + (h : ∀ i ∈ s, ν (f i) ≤ m) : + ν (∑ i ∈ s, f i) ≤ m := by + classical + induction s using Finset.induction_on with + | empty => simp + | @insert i s hi ih => + rw [Finset.sum_insert hi] + exact (ν.map_add_le_max (f i) (∑ j ∈ s, f j)).trans + (max_le (h i (Finset.mem_insert_self i s)) + (ih fun j hj ↦ h j (Finset.mem_insert_of_mem hj))) + +/-- A finite sum has degree strictly below any bound above bottom that strictly bounds every +summand. -/ +theorem map_sum_lt_of_forall_lt (ν : MaxAddDegree R M) {ι : Type*} + (s : Finset ι) (f : ι → R) {m : WithBot M} (hm : ⊥ < m) + (h : ∀ i ∈ s, ν (f i) < m) : + ν (∑ i ∈ s, f i) < m := by + classical + induction s using Finset.induction_on with + | empty => simpa only [Finset.sum_empty, ν.map_zero] using hm + | @insert i s hi ih => + rw [Finset.sum_insert hi] + exact (ν.map_add_le_max (f i) (∑ j ∈ s, f j)).trans_lt + (max_lt (h i (Finset.mem_insert_self i s)) + (ih fun j hj ↦ h j (Finset.mem_insert_of_mem hj))) + +/-- A max-additive degree function is separated when only zero has bottom degree. -/ +def IsSeparated (ν : MaxAddDegree R M) : Prop := + ∀ x, ν x = ⊥ ↔ x = 0 + +/-- The defining condition for a separated max-additive degree function. -/ +theorem isSeparated_iff (ν : MaxAddDegree R M) : + ν.IsSeparated ↔ ∀ x, ν x = ⊥ ↔ x = 0 := + Iff.rfl + +/-- A separated degree sends every nonzero element to a nonbottom degree. -/ +theorem map_ne_bot_of_ne_zero (ν : MaxAddDegree R M) (hν : ν.IsSeparated) {x : R} + (hx : x ≠ 0) : ν x ≠ ⊥ := + fun h ↦ hx (((isSeparated_iff ν).mp hν x).mp h) + +/-- A max-additive degree function is multiplicative when its product inequality is always an +equality. This is the multiplicativity clause of LM24's multiplicative semi-valuations. -/ +class IsMultiplicative (ν : MaxAddDegree R M) : Prop where + map_mul : ∀ x y, ν (x * y) = ν x + ν y + +/-- The defining condition for a multiplicative max-additive degree function. -/ +theorem isMultiplicative_iff (ν : MaxAddDegree R M) : + ν.IsMultiplicative ↔ ∀ x y, ν (x * y) = ν x + ν y := + ⟨fun h ↦ h.map_mul, fun h ↦ ⟨h⟩⟩ + +/-- Multiplicativity with the degree explicit, as `Valuation.map_mul`. Inside `namespace +MaxAddDegree` this shadows the root `map_mul` for homomorphisms, which is then `_root_.map_mul`. -/ +@[simp] +theorem map_mul (ν : MaxAddDegree R M) [ν.IsMultiplicative] (x y : R) : + ν (x * y) = ν x + ν y := + IsMultiplicative.map_mul x y + +/-- Every degree sends the unit to bottom or to zero: `ν 1 ≤ ν 1 + ν 1` by submultiplicativity +and `ν 1 ≤ 0`. The bottom case is the degenerate degree that is bottom everywhere. -/ +theorem map_one_eq_bot_or_eq_zero (ν : MaxAddDegree R M) [IsOrderedCancelAddMonoid M] : + ν 1 = ⊥ ∨ ν 1 = 0 := by + by_cases hbot : ν 1 = ⊥ + · exact Or.inl hbot + obtain ⟨m, hm⟩ := WithBot.ne_bot_iff_exists.mp hbot + have hone := ν.map_mul_le_add 1 1 + rw [one_mul, ← hm, ← WithBot.coe_add, WithBot.coe_le_coe] at hone + have hle : m ≤ 0 := WithBot.coe_le_coe.mp (hm ▸ ν.map_one_le_zero) + have hge : 0 ≤ m := le_of_add_le_add_left (a := m) (by simpa using hone) + exact Or.inr (by rw [← hm, le_antisymm hle hge]; rfl) + +/-- A separated degree on a nontrivial ring sends the unit to degree zero. -/ +theorem map_one_eq_zero_of_isSeparated (ν : MaxAddDegree R M) + [IsOrderedCancelAddMonoid M] [Nontrivial R] (hν : ν.IsSeparated) : + ν 1 = 0 := by + rcases ν.map_one_eq_bot_or_eq_zero with hbot | hzero + · exact absurd (((ν.isSeparated_iff).mp hν 1).mp hbot) one_ne_zero + · exact hzero + +/-- If a degree sends the unit to bottom, it is bottom everywhere: `ν x ≤ ν x + ν 1`. -/ +theorem map_eq_bot_of_map_one_eq_bot (ν : MaxAddDegree R M) (hone : ν 1 = ⊥) (x : R) : + ν x = ⊥ := + le_bot_iff.mp (by simpa [hone] using ν.map_mul_le_add x 1) + +/-- A separated multiplicative degree function detects zero products. -/ +theorem eq_zero_or_eq_zero_of_mul_eq_zero (ν : MaxAddDegree R M) [ν.IsMultiplicative] + (hν : ν.IsSeparated) {x y : R} (hxy : x * y = 0) : + x = 0 ∨ y = 0 := by + have hbot : ν x + ν y = ⊥ := by + rw [← ν.map_mul x y, hxy, ν.map_zero] + rcases WithBot.add_eq_bot.mp hbot with hx | hy + · exact Or.inl (((isSeparated_iff ν).mp hν x).mp hx) + · exact Or.inr (((isSeparated_iff ν).mp hν y).mp hy) + +/-- A nontrivial commutative ring carrying a separated multiplicative degree function is a +domain. -/ +theorem isDomain (ν : MaxAddDegree R M) [Nontrivial R] [ν.IsMultiplicative] + (hν : ν.IsSeparated) : + IsDomain R := by + letI : NoZeroDivisors R := + ⟨fun hxy ↦ ν.eq_zero_or_eq_zero_of_mul_eq_zero hν hxy⟩ + exact NoZeroDivisors.to_isDomain R + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/OfValuation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/OfValuation.lean new file mode 100644 index 0000000000..a9ccc7f859 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/OfValuation.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.MaxAddDegree +public import Mathlib.Algebra.Order.Monoid.ToMulBot +public import Mathlib.RingTheory.Valuation.Basic + +/-! +# Mathlib valuations as max-additive degrees + +A Mathlib `Valuation` with values in `WithZero (Multiplicative M)` is a multiplicative max-additive +degree once its values are read additively, with bottom in place of the absorbing zero. This +reading turns Mathlib's multiplicative convention into LM24's additive one, and makes Mathlib's +stock of valuations available as examples and as a comparison point. Separation of the degree is +triviality of the valuation's support ideal; a nonzero support is allowed, exactly as LM24 allows +a nonzero kernel for its semi-valuations. +-/ + +universe u v + +public noncomputable section + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + +/-- The max-additive degree of a Mathlib valuation: its value, written additively with bottom +at the support. -/ +def ofValuation (w : Valuation R (WithZero (Multiplicative M))) : MaxAddDegree R M where + toFun x := Multiplicative.toAdd (WithZero.toMulBot (w x)) + map_zero' := by simp + map_one_le_zero' := by simp + map_neg' x := by simp [w.map_neg] + map_add_le_max' x y := w.map_add x y + map_mul_le_add' x y := by simp [w.map_mul] + +theorem ofValuation_apply (w : Valuation R (WithZero (Multiplicative M))) (x : R) : + ofValuation w x = Multiplicative.toAdd (WithZero.toMulBot (w x)) := + (rfl) + +instance (w : Valuation R (WithZero (Multiplicative M))) : (ofValuation w).IsMultiplicative := + ⟨fun x y ↦ by simp [ofValuation_apply, w.map_mul]⟩ + +@[simp] +theorem ofValuation_one (w : Valuation R (WithZero (Multiplicative M))) : + ofValuation w 1 = 0 := by + simp [ofValuation_apply] + +@[simp] +theorem ofValuation_eq_bot_iff_mem_supp (w : Valuation R (WithZero (Multiplicative M))) + (x : R) : + ofValuation w x = ⊥ ↔ x ∈ w.supp := by + rw [Valuation.mem_supp_iff] + rfl + +/-- The degree of a Mathlib valuation is separated exactly when the support ideal is zero. -/ +theorem isSeparated_ofValuation_iff (w : Valuation R (WithZero (Multiplicative M))) : + (ofValuation w).IsSeparated ↔ w.supp = ⊥ := by + rw [isSeparated_iff, Ideal.ext_iff] + simp only [ofValuation_eq_bot_iff_mem_supp, Ideal.mem_bot] + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/QuotientDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/QuotientDegree.lean new file mode 100644 index 0000000000..5497d49cfa --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/QuotientDegree.lean @@ -0,0 +1,213 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.MaxAddDegree +public import Mathlib.RingTheory.Ideal.Quotient.Defs + +import Mathlib.Order.Minimal + +/-! +# Least-representative degree on a quotient ring + +Let a commutative ring carry a separated max-additive degree whose value index is well ordered. +The degree of a nonzero class modulo an ideal is defined to be the least degree among all its +representatives, while the zero class has bottom degree. This realizes the quotient-degree +construction for filtered quotient rings. + +The resulting quotient degree is separated and satisfies the ultrametric addition inequality and +the submultiplicative product inequality. Equality for products is a later associated-graded +consequence and is deliberately not asserted here. +-/ + +universe u v + +public noncomputable section + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] [LinearOrder M] + +/-- The grades attained by representatives of a quotient class. -/ +def representativeGrades (ν : MaxAddDegree R M) (I : Ideal R) (q : R ⧸ I) : Set M := + {m | ∃ x : R, Ideal.Quotient.mk I x = q ∧ ν x = m} + +/-- Membership in the set of grades attained by representatives of a quotient class. -/ +theorem mem_representativeGrades_iff (ν : MaxAddDegree R M) (I : Ideal R) + (q : R ⧸ I) (m : M) : + m ∈ ν.representativeGrades I q ↔ + ∃ x : R, Ideal.Quotient.mk I x = q ∧ ν x = m := + Iff.rfl + +theorem representativeGrades_nonempty (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) {q : R ⧸ I} (hq : q ≠ 0) : + (ν.representativeGrades I q).Nonempty := by + obtain ⟨x, rfl⟩ := Ideal.Quotient.mk_surjective q + have hx : x ≠ 0 := by + intro hx + apply hq + simp [hx] + have hνx : ν x ≠ ⊥ := ν.map_ne_bot_of_ne_zero hν hx + refine ⟨(ν x).unbot hνx, x, rfl, ?_⟩ + exact (WithBot.coe_unbot (ν x) hνx).symm + +variable [WellFoundedLT M] + +/-- The least degree of a representative of a quotient class, with bottom assigned to zero. -/ +def quotientValue (ν : MaxAddDegree R M) (I : Ideal R) (hν : ν.IsSeparated) + (q : R ⧸ I) : WithBot M := by + classical + exact if hq : q = 0 then ⊥ + else (wellFounded_lt.min (ν.representativeGrades I q) + (ν.representativeGrades_nonempty I hν hq) : M) + +@[simp] +theorem quotientValue_zero (ν : MaxAddDegree R M) (I : Ideal R) (hν : ν.IsSeparated) : + ν.quotientValue I hν 0 = ⊥ := by + simp [quotientValue] + +theorem quotientValue_eq_coe_min (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) {q : R ⧸ I} (hq : q ≠ 0) : + ν.quotientValue I hν q = + (wellFounded_lt.min (ν.representativeGrades I q) + (ν.representativeGrades_nonempty I hν hq) : M) := by + simp [quotientValue, hq] + +@[simp] +theorem quotientValue_eq_bot_iff (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) (q : R ⧸ I) : + ν.quotientValue I hν q = ⊥ ↔ q = 0 := by + by_cases hq : q = 0 + · simp [hq] + · rw [ν.quotientValue_eq_coe_min I hν hq] + simp [hq] + +/-- Every nonzero quotient class has a representative whose degree is its quotient degree. -/ +theorem exists_representative_quotientValue_eq (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) {q : R ⧸ I} (hq : q ≠ 0) : + ∃ x : R, Ideal.Quotient.mk I x = q ∧ ν x = ν.quotientValue I hν q := by + have hmem := wellFounded_lt.min_mem (ν.representativeGrades I q) + (ν.representativeGrades_nonempty I hν hq) + obtain ⟨x, hxq, hxν⟩ := hmem + refine ⟨x, hxq, ?_⟩ + rw [ν.quotientValue_eq_coe_min I hν hq] + exact hxν + +/-- The quotient degree is at most the degree of every representative. -/ +theorem quotientValue_mk_le (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) (x : R) : + ν.quotientValue I hν (Ideal.Quotient.mk I x) ≤ ν x := by + by_cases hq : Ideal.Quotient.mk I x = 0 + · rw [hq, ν.quotientValue_zero] + exact bot_le + · have hx : x ≠ 0 := by + intro hx + apply hq + simp [hx] + have hνx : ν x ≠ ⊥ := by + intro hbot + exact hx (((isSeparated_iff ν).mp hν x).mp hbot) + have hmem : (ν x).unbot hνx ∈ + ν.representativeGrades I (Ideal.Quotient.mk I x) := by + refine ⟨x, rfl, ?_⟩ + exact (WithBot.coe_unbot (ν x) hνx).symm + rw [ν.quotientValue_eq_coe_min I hν hq, ← WithBot.coe_unbot (ν x) hνx, + WithBot.coe_le_coe] + exact wellFounded_lt.min_le hmem + +/-- The unit of the quotient has degree at most zero. -/ +theorem quotientValue_one_le_zero (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) : + ν.quotientValue I hν 1 ≤ 0 := by + calc + ν.quotientValue I hν 1 = + ν.quotientValue I hν (Ideal.Quotient.mk I 1) := by rw [map_one] + _ ≤ ν 1 := ν.quotientValue_mk_le I hν 1 + _ ≤ 0 := ν.map_one_le_zero + +@[simp] +theorem quotientValue_neg (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) (q : R ⧸ I) : + ν.quotientValue I hν (-q) = ν.quotientValue I hν q := by + by_cases hq : q = 0 + · simp [hq] + · obtain ⟨x, hxq, hxν⟩ := ν.exists_representative_quotientValue_eq I hν hq + have hle : ν.quotientValue I hν (-q) ≤ ν.quotientValue I hν q := by + rw [← hxν, ← map_neg, ← hxq] + exact ν.quotientValue_mk_le I hν (-x) + have hnq : -q ≠ 0 := neg_ne_zero.mpr hq + obtain ⟨y, hyq, hyν⟩ := ν.exists_representative_quotientValue_eq I hν hnq + have hge : ν.quotientValue I hν q ≤ ν.quotientValue I hν (-q) := by + rw [← hyν, ← map_neg, ← neg_neg q, ← hyq] + exact ν.quotientValue_mk_le I hν (-y) + exact le_antisymm hle hge + +theorem quotientValue_add_le_max (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) (q r : R ⧸ I) : + ν.quotientValue I hν (q + r) ≤ + max (ν.quotientValue I hν q) (ν.quotientValue I hν r) := by + by_cases hq : q = 0 + · simp [hq] + by_cases hr : r = 0 + · simp [hr] + obtain ⟨x, hxq, hxν⟩ := ν.exists_representative_quotientValue_eq I hν hq + obtain ⟨y, hyr, hyν⟩ := ν.exists_representative_quotientValue_eq I hν hr + calc + ν.quotientValue I hν (q + r) = + ν.quotientValue I hν (Ideal.Quotient.mk I (x + y)) := by rw [map_add, hxq, hyr] + _ ≤ ν (x + y) := ν.quotientValue_mk_le I hν (x + y) + _ ≤ max (ν x) (ν y) := ν.map_add_le_max x y + _ = max (ν.quotientValue I hν q) (ν.quotientValue I hν r) := by rw [hxν, hyν] + +theorem quotientValue_mul_le_add (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) (q r : R ⧸ I) : + ν.quotientValue I hν (q * r) ≤ + ν.quotientValue I hν q + ν.quotientValue I hν r := by + by_cases hq : q = 0 + · simp [hq] + by_cases hr : r = 0 + · simp [hr] + obtain ⟨x, hxq, hxν⟩ := ν.exists_representative_quotientValue_eq I hν hq + obtain ⟨y, hyr, hyν⟩ := ν.exists_representative_quotientValue_eq I hν hr + calc + ν.quotientValue I hν (q * r) = + ν.quotientValue I hν (Ideal.Quotient.mk I (x * y)) := by rw [_root_.map_mul, hxq, hyr] + _ ≤ ν (x * y) := ν.quotientValue_mk_le I hν (x * y) + _ ≤ ν x + ν y := ν.map_mul_le_add x y + _ = ν.quotientValue I hν q + ν.quotientValue I hν r := by rw [hxν, hyν] + +/-- The quotient degree obtained by minimizing the degree among all representatives. -/ +def quotient (ν : MaxAddDegree R M) (I : Ideal R) (hν : ν.IsSeparated) : + MaxAddDegree (R ⧸ I) M where + toFun := ν.quotientValue I hν + map_zero' := ν.quotientValue_zero I hν + map_one_le_zero' := ν.quotientValue_one_le_zero I hν + map_neg' := ν.quotientValue_neg I hν + map_add_le_max' := ν.quotientValue_add_le_max I hν + map_mul_le_add' := ν.quotientValue_mul_le_add I hν + +@[simp] +theorem quotient_apply (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) (q : R ⧸ I) : + ν.quotient I hν q = ν.quotientValue I hν q := (rfl) + +/-- The least-representative degree on a quotient ring is separated. -/ +theorem quotient_isSeparated (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) : + (ν.quotient I hν).IsSeparated := by + rw [isSeparated_iff] + intro q + rw [ν.quotient_apply I hν] + exact ν.quotientValue_eq_bot_iff I hν q + +/-- If the least-representative quotient degree is multiplicative, then the quotient is a +domain. -/ +theorem quotient_isDomain (ν : MaxAddDegree R M) (I : Ideal R) + (hν : ν.IsSeparated) [Nontrivial (R ⧸ I)] [(ν.quotient I hν).IsMultiplicative] : + IsDomain (R ⧸ I) := + (ν.quotient I hν).isDomain (ν.quotient_isSeparated I hν) + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/RV.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/RV.lean new file mode 100644 index 0000000000..cde11fb4fd --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/RV.lean @@ -0,0 +1,400 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm +public import Mathlib.GroupTheory.Congruence.Hom + +/-! +# RV classes and initial forms + +For a max-additive degree `ν`, two representatives are RV-equivalent when both have bottom +degree, or when their difference has degree strictly below their common nonbottom degree; the +multiplicative structure of RV needs `ν` multiplicative. +Thus the entire kernel of the degree, rather than only the literal zero element, forms the zero +RV class. + +The resulting quotient is a commutative monoid with zero. Its degree is well defined, and the +initial-form map embeds it into the associated graded ring as zero together with the homogeneous +classes. The grade-zero component carries Mathlib's canonical direct-sum grade-zero ring structure +and is exposed as the residue ring. + +LM24 uses the bespoke convention `-∞ < -∞`. Lean's strict order on `WithBot` does not, so the +explicit bottom branch is the standard-order encoding of LM24, Definition 4.1.1. It collapses the +kernel to one class and makes the relation reflexive on its nonzero elements. The degree axioms +also supply `w(0) = -∞`, which is not implied by the two generic semi-valuation equations +displayed in LM24. +-/ +universe u v + +public noncomputable section + +namespace MaxAddDegree + +open scoped DirectSum + +variable {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] [LinearOrder M] + +/-- Two representatives define the same RV class. -/ +def RVRel (ν : MaxAddDegree R M) (x y : R) : Prop := + (ν x = ⊥ ∧ ν y = ⊥) ∨ + (ν x ≠ ⊥ ∧ ν (x - y) < ν x) + +@[simp] +theorem rvRel_iff (ν : MaxAddDegree R M) (x y : R) : + ν.RVRel x y ↔ + (ν x = ⊥ ∧ ν y = ⊥) ∨ + (ν x ≠ ⊥ ∧ ν (x - y) < ν x) := + Iff.rfl + +theorem rvRel_degree_eq {ν : MaxAddDegree R M} {x y : R} (h : ν.RVRel x y) : + ν x = ν y := by + rcases h with hbot | ⟨-, hxy⟩ + · exact hbot.1.trans hbot.2.symm + · exact ν.map_eq_of_map_sub_lt hxy + +theorem rvRel_refl (ν : MaxAddDegree R M) (x : R) : ν.RVRel x x := by + by_cases hx : ν x = ⊥ + · exact Or.inl ⟨hx, hx⟩ + · exact Or.inr ⟨hx, by simpa using WithBot.bot_lt_iff_ne_bot.mpr hx⟩ + +theorem rvRel_symm {ν : MaxAddDegree R M} {x y : R} (h : ν.RVRel x y) : + ν.RVRel y x := by + rcases h with hbot | ⟨hx, hxy⟩ + · exact Or.inl hbot.symm + · refine Or.inr ⟨?_, ?_⟩ + · simpa only [← rvRel_degree_eq (Or.inr ⟨hx, hxy⟩)] using hx + · rw [← rvRel_degree_eq (Or.inr ⟨hx, hxy⟩)] + rw [← neg_sub] + simpa only [ν.map_neg] using hxy + +theorem rvRel_trans {ν : MaxAddDegree R M} {x y z : R} + (hxy : ν.RVRel x y) (hyz : ν.RVRel y z) : ν.RVRel x z := by + have hxyDegree := rvRel_degree_eq hxy + have hyzDegree := rvRel_degree_eq hyz + by_cases hx : ν x = ⊥ + · refine Or.inl ⟨hx, ?_⟩ + exact hyzDegree.symm.trans (hxyDegree.symm.trans hx) + · refine Or.inr ⟨hx, ?_⟩ + have hxyLt : ν (x - y) < ν x := by + rcases hxy with hbot | h + · exact (hx hbot.1).elim + · exact h.2 + have hyzLt : ν (y - z) < ν x := by + rcases hyz with hbot | h + · exact (hx (hxyDegree.trans hbot.1)).elim + · simpa only [hxyDegree] using h.2 + have hle := ν.map_add_le_max (x - y) (y - z) + rw [sub_add_sub_cancel] at hle + exact hle.trans_lt (max_lt hxyLt hyzLt) + +variable [IsOrderedCancelAddMonoid M] + +section Graded + +variable (ν : MaxAddDegree R M) + +/-- The multiplicative submonoid consisting of zero and all homogeneous graded classes. -/ +def homogeneousClasses : Submonoid ν.AssociatedGraded where + carrier := {a | a = 0 ∨ ∃ m, ∃ c : ν.Component m, a = DirectSum.of ν.Component m c} + one_mem' := Or.inr ⟨0, ν.componentOne, (DirectSum.one_def ν.Component).symm⟩ + mul_mem' {a b} ha hb := by + rcases ha with rfl | ⟨m, c, rfl⟩ + · exact Or.inl (zero_mul _) + rcases hb with rfl | ⟨n, d, rfl⟩ + · exact Or.inl (mul_zero _) + · refine Or.inr ⟨m + n, ν.componentMul c d, ?_⟩ + exact DirectSum.of_mul_of c d + +theorem mem_homogeneousClasses_iff (a : ν.AssociatedGraded) : + a ∈ ν.homogeneousClasses ↔ + a = 0 ∨ ∃ m, ∃ c : ν.Component m, a = DirectSum.of ν.Component m c := + Iff.rfl + +/-- Zero and the homogeneous classes, as a commutative monoid with zero. -/ +abbrev HomogeneousClasses := + ν.homogeneousClasses + +instance : Zero ν.HomogeneousClasses := + ⟨⟨0, (ν.mem_homogeneousClasses_iff 0).mpr (Or.inl rfl)⟩⟩ + +instance : CommMonoidWithZero ν.HomogeneousClasses where + zero_mul q := Subtype.ext (zero_mul (q : ν.AssociatedGraded)) + mul_zero q := Subtype.ext (mul_zero (q : ν.AssociatedGraded)) + +theorem initialForm_mem_homogeneousClasses (x : R) : + ν.initialForm x ∈ ν.homogeneousClasses := by + rw [ν.mem_homogeneousClasses_iff] + by_cases hx : ν x = ⊥ + · exact Or.inl (ν.initialForm_eq_zero_of_eq_bot hx) + · refine Or.inr ⟨(ν x).unbot hx, + ν.componentMk _ (ν.initialRepresentative x hx), ?_⟩ + rw [ν.initialForm_eq_homogeneousMk_of_ne_bot hx, ν.homogeneousMk_apply] + +/-- The residue ring, namely the grade-zero homogeneous quotient. -/ +abbrev ResidueRing := + ν.Component 0 + +/-- The canonical embedding of the residue ring into the associated graded ring. -/ +def residueRingHom : ν.ResidueRing →+* ν.AssociatedGraded := + DirectSum.ofZeroRingHom ν.Component + +@[simp] +theorem residueRingHom_apply (c : ν.ResidueRing) : + ν.residueRingHom c = DirectSum.of ν.Component 0 c := (rfl) + +theorem residueRingHom_injective : + Function.Injective ν.residueRingHom := + DirectSum.of_injective 0 + +/-- RV-equivalent representatives have the same initial form. -/ +theorem initialForm_eq_of_rvRel {x y : R} (h : ν.RVRel x y) : + ν.initialForm x = ν.initialForm y := by + rcases h with hbot | ⟨-, hxy⟩ + · rw [ν.initialForm_eq_zero_of_eq_bot hbot.1, ν.initialForm_eq_zero_of_eq_bot hbot.2] + · exact ν.initialForm_eq_of_sub_lt hxy + +end Graded + +/-- The RV relation is compatible with multiplication for a multiplicative degree. -/ +theorem rvRel_mul_left {ν : MaxAddDegree R M} [ν.IsMultiplicative] {x y : R} (z : R) + (h : ν.RVRel x y) : ν.RVRel (z * x) (z * y) := by + by_cases hz : ν z = ⊥ + · exact Or.inl ⟨by simp [hz], by simp [hz]⟩ + rcases h with hbot | ⟨hx, hxy⟩ + · exact Or.inl ⟨by simp [hbot.1], by simp [hbot.2]⟩ + · refine Or.inr ⟨?_, ?_⟩ + · rw [ν.map_mul, WithBot.add_ne_bot] + exact ⟨hz, hx⟩ + · rw [← mul_sub, ν.map_mul, ν.map_mul] + exact WithBot.add_lt_add_of_le_of_lt hz le_rfl hxy + +variable (ν : MaxAddDegree R M) [ν.IsMultiplicative] + +/-- The multiplicative congruence whose quotient is the RV monoid. -/ +def rvCon : Con R where + r := ν.RVRel + iseqv := ⟨ν.rvRel_refl, rvRel_symm, rvRel_trans⟩ + mul' {x y z t} hxy hzt := by + have hxy' : ν.RVRel (x * z) (y * z) := by + simpa only [mul_comm] using ν.rvRel_mul_left z hxy + exact rvRel_trans hxy' (ν.rvRel_mul_left y hzt) + +/-- The RV quotient attached to a multiplicative max-additive degree. -/ +abbrev RV := ν.rvCon.Quotient + +/-- The quotient map to RV classes. -/ +def rv : R →* ν.RV := + ν.rvCon.mk' + +/-- Every RV class has a representative in the original ring. -/ +theorem rv_surjective : Function.Surjective ν.rv := by + exact ν.rvCon.mk'_surjective + +@[simp] +theorem rv_eq_iff {x y : R} : + ν.rv x = ν.rv y ↔ ν.RVRel x y := by + exact ν.rvCon.eq + +/-- For a representative of nonbottom degree, RV equality is exactly strict decrease of the +degree of the difference. -/ +theorem rv_eq_iff_of_value_ne_bot {x y : R} (hx : ν x ≠ ⊥) : + ν.rv x = ν.rv y ↔ ν (x - y) < ν x := by + rw [ν.rv_eq_iff, ν.rvRel_iff] + constructor + · rintro (⟨hxBot, -⟩ | ⟨-, hxy⟩) + · exact (hx hxBot).elim + · exact hxy + · exact fun hxy ↦ Or.inr ⟨hx, hxy⟩ + +/-- The common RV class of the kernel of the degree. -/ +instance : Zero ν.RV := + ⟨ν.rv 0⟩ + +@[simp] +theorem rv_zero : ν.rv 0 = 0 := + rfl + +@[simp] +theorem rv_eq_zero_iff {x : R} : + ν.rv x = 0 ↔ ν x = ⊥ := by + rw [← ν.rv_zero, ν.rv_eq_iff] + constructor + · rintro (⟨hx, -⟩ | ⟨-, hlt⟩) + · exact hx + · have : ν x < ν x := by simpa only [sub_zero] using hlt + exact (lt_irrefl _ this).elim + · intro hx + exact Or.inl ⟨hx, ν.map_zero⟩ + +instance : CommMonoidWithZero ν.RV where + zero_mul q := by + induction q using Con.induction_on with + | _ x => + change ν.rv 0 * ν.rv x = ν.rv 0 + rw [← _root_.map_mul, zero_mul] + mul_zero q := by + induction q using Con.induction_on with + | _ x => + change ν.rv x * ν.rv 0 = ν.rv 0 + rw [← _root_.map_mul, mul_zero] + +/-- The degree of an RV class. -/ +def rvValue (q : ν.RV) : WithBot M := + Con.liftOn q ν fun _ _ h ↦ rvRel_degree_eq h + +@[simp] +theorem rvValue_rv (x : R) : + ν.rvValue (ν.rv x) = ν x := (rfl) + +@[simp] +theorem rvValue_zero : ν.rvValue 0 = ⊥ := by + rw [← ν.rv_zero, ν.rvValue_rv, ν.map_zero] + +/-- The degree of the RV class of one is the degree of one: zero, unless the degree is the +degenerate one that is bottom everywhere. -/ +@[simp] +theorem rvValue_one : ν.rvValue 1 = ν 1 := by + change ν.rvValue (ν.rv 1) = ν 1 + rw [ν.rvValue_rv] + +@[simp] +theorem rvValue_mul (q r : ν.RV) : + ν.rvValue (q * r) = ν.rvValue q + ν.rvValue r := by + induction q, r using Con.induction_on₂ with + | _ x y => + change ν (x * y) = ν x + ν y + exact ν.map_mul x y + +/-- The initial form, viewed as a function of the RV class. -/ +def rvInitialForm (q : ν.RV) : ν.AssociatedGraded := + Con.liftOn q ν.initialForm fun _ _ h ↦ ν.initialForm_eq_of_rvRel h + +@[simp] +theorem rvInitialForm_rv (x : R) : + ν.rvInitialForm (ν.rv x) = ν.initialForm x := (rfl) + +/-- The multiplicative map from RV classes to the associated graded ring, sending the class of +`x` to the initial form of `x`. -/ +def rvInitialFormHom : ν.RV →*₀ ν.AssociatedGraded where + toFun := ν.rvInitialForm + map_one' := by + change ν.initialForm 1 = 1 + exact ν.initialForm_one + map_mul' q r := by + induction q, r using Con.induction_on₂ with + | _ x y => + change ν.initialForm (x * y) = ν.initialForm x * ν.initialForm y + exact ν.initialForm_mul x y + map_zero' := by + change ν.initialForm 0 = 0 + exact ν.initialForm_zero + +@[simp] +theorem rvInitialFormHom_rv (x : R) : + ν.rvInitialFormHom (ν.rv x) = ν.initialForm x := (rfl) + +theorem rvInitialFormHom_injective : + Function.Injective ν.rvInitialFormHom := by + intro q r hqr + induction q, r using Con.induction_on₂ with + | _ x y => + change ν.rv x = ν.rv y + rw [ν.rv_eq_iff] + change ν.initialForm x = ν.initialForm y at hqr + by_cases hx : ν x = ⊥ + · have hy : ν y = ⊥ := by + by_contra hy + have hix := ν.initialForm_eq_zero_of_eq_bot hx + have hiy := ν.initialForm_ne_zero_of_ne_bot hy + exact hiy (hqr.symm.trans hix) + exact Or.inl ⟨hx, hy⟩ + · have hy : ν y ≠ ⊥ := by + intro hy + have hix := ν.initialForm_ne_zero_of_ne_bot hx + have hiy := ν.initialForm_eq_zero_of_eq_bot hy + exact hix (hqr.trans hiy) + rw [ν.initialForm_eq_homogeneousMk_of_ne_bot hx, + ν.initialForm_eq_homogeneousMk_of_ne_bot hy, + ν.homogeneousMk_apply, ν.homogeneousMk_apply] at hqr + rcases (DFinsupp.single_eq_single_iff _ _ _ _).mp hqr with hnonzero | hzero + · refine Or.inr ⟨hx, ?_⟩ + have hlt := ν.sub_lt_of_componentMk_heq hnonzero.1 + (ν.initialRepresentative x hx) (ν.initialRepresentative y hy) hnonzero.2 + simpa only [coe_initialRepresentative, WithBot.coe_unbot] using hlt + · have hlt := (ν.componentMk_eq_zero_iff _ _).mp hzero.1 + have : ν x < ν x := by + simpa only [coe_initialRepresentative, WithBot.coe_unbot] using hlt + exact (lt_irrefl _ this).elim + +/-- The RV class represented as zero or a nonzero homogeneous graded class. -/ +def rvHomogeneous : ν.RV →*₀ ν.HomogeneousClasses where + toFun q := ⟨ν.rvInitialFormHom q, by + induction q using Con.induction_on with + | _ x => exact ν.initialForm_mem_homogeneousClasses x⟩ + map_one' := Subtype.ext ν.rvInitialFormHom.map_one + map_mul' q r := Subtype.ext (ν.rvInitialFormHom.map_mul q r) + map_zero' := Subtype.ext ν.rvInitialFormHom.map_zero + +@[simp] +theorem coe_rvHomogeneous (q : ν.RV) : + (ν.rvHomogeneous q : ν.AssociatedGraded) = ν.rvInitialFormHom q := (rfl) + +theorem rvHomogeneous_injective : + Function.Injective ν.rvHomogeneous := by + intro q r h + apply ν.rvInitialFormHom_injective + exact congrArg Subtype.val h + +theorem rvHomogeneous_surjective : + Function.Surjective ν.rvHomogeneous := by + rintro ⟨a, ha⟩ + rw [ν.mem_homogeneousClasses_iff] at ha + rcases ha with rfl | ⟨m, c, rfl⟩ + · refine ⟨ν.rv 0, Subtype.ext ?_⟩ + change ν.initialForm 0 = 0 + exact ν.initialForm_zero + induction c using QuotientAddGroup.induction_on with + | H x => + by_cases hx : ν.componentMk m x = 0 + · refine ⟨ν.rv 0, Subtype.ext ?_⟩ + change ν.initialForm 0 = DirectSum.of ν.Component m (x : ν.Component m) + have hxc : (x : ν.Component m) = 0 := by + rw [ν.coe_component_eq_componentMk] + exact hx + rw [ν.initialForm_zero, hxc] + exact ((DirectSum.of ν.Component m).map_zero).symm + · refine ⟨ν.rv x, Subtype.ext ?_⟩ + rw [ν.coe_rvHomogeneous, ν.rvInitialFormHom_rv] + change ν.initialForm x = DirectSum.of ν.Component m (x : ν.Component m) + calc + ν.initialForm x = ν.homogeneousMk m x := + ν.initialForm_eq_homogeneousMk_of_componentMk_ne_zero m x hx + _ = DirectSum.of ν.Component m (ν.componentMk m x) := + ν.homogeneousMk_apply m x + _ = DirectSum.of ν.Component m (x : ν.Component m) := + congrArg (DirectSum.of ν.Component m) (ν.coe_component_eq_componentMk m x).symm + +/-- RV is multiplicatively equivalent to zero together with the nonzero homogeneous classes. -/ +def rvEquivHomogeneous : ν.RV ≃* ν.HomogeneousClasses := + MulEquiv.ofBijective ν.rvHomogeneous.toMonoidHom + ⟨ν.rvHomogeneous_injective, ν.rvHomogeneous_surjective⟩ + +@[simp] +theorem rvEquivHomogeneous_apply (q : ν.RV) : + ν.rvEquivHomogeneous q = ν.rvHomogeneous q := (rfl) + +theorem rvEquivHomogeneous_zero : + ν.rvEquivHomogeneous 0 = 0 := by + rw [ν.rvEquivHomogeneous_apply, ν.rvHomogeneous.map_zero] + +@[simp] +theorem rvEquivHomogeneous_symm_zero : + ν.rvEquivHomogeneous.symm 0 = 0 := by + apply ν.rvEquivHomogeneous.injective + rw [ν.rvEquivHomogeneous.apply_symm_apply, ν.rvEquivHomogeneous_zero] + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Residue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Residue.lean new file mode 100644 index 0000000000..ba0cc1b128 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Residue.lean @@ -0,0 +1,180 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.RV +public import Mathlib.RingTheory.Ideal.Quotient.Basic +public import Mathlib.RingTheory.Ideal.Maps + +import Mathlib.RingTheory.Ideal.Quotient.Operations + +/-! +# The residue map + +For a max-additive degree, the elements of nonpositive degree form a subring. Those of strictly +negative degree form an ideal in that subring, and projection to the grade-zero component is a +surjective ring homomorphism with this ideal as its kernel. Consequently, the grade-zero component +is canonically isomorphic to the quotient by the strictly negative ideal. Submultiplicativity +suffices for all of this; multiplicativity enters only in the comparison with the RV class. + +This is the quotient presentation in LM24, Proposition 4.2.10. It also realizes the ring in +Corollary 4.2.8 as `MaxAddDegree.ResidueRing`. The module structure of Corollary 4.2.9 is the +grade-zero action `Module ν.ResidueRing (ν.Component m)` supplied by Mathlib's graded direct sums. +The quotient construction remains additive when two degree-zero representatives cancel to strictly +lower degree; `ConwayRefinement.Algebra.Valuation.Tests.Residue` includes a certificate for that +case. +-/ + +universe u v + +public noncomputable section + +open scoped DirectSum + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + +/-- The subring of elements whose degree is at most zero. -/ +def nonpositiveSubring (ν : MaxAddDegree R M) : Subring R where + carrier := {x | ν x ≤ 0} + zero_mem' := by simp + one_mem' := ν.map_one_le_zero + add_mem' {x y} hx hy := (ν.map_add_le_max x y).trans (max_le hx hy) + mul_mem' {x y} hx hy := by + change ν (x * y) ≤ 0 + change ν x ≤ 0 at hx + change ν y ≤ 0 at hy + simpa using degree_mul_le_add hx hy + neg_mem' {x} hx := by simpa using hx + +@[simp] +theorem mem_nonpositiveSubring_iff (ν : MaxAddDegree R M) (x : R) : + x ∈ ν.nonpositiveSubring ↔ ν x ≤ 0 := + Iff.rfl + +/-- The additive identification of the nonpositive subring with the weak filtration at zero. -/ +def nonpositiveEquivFiltrationLEZero (ν : MaxAddDegree R M) : + ν.nonpositiveSubring ≃+ ν.filtrationLE 0 where + toFun x := ⟨x, (ν.mem_filtrationLE_iff 0 x).mpr + ((ν.mem_nonpositiveSubring_iff x).mp x.2)⟩ + invFun x := ⟨x, (ν.mem_nonpositiveSubring_iff x).mpr + ((ν.mem_filtrationLE_iff 0 x).mp x.2)⟩ + left_inv _ := Subtype.ext rfl + right_inv _ := Subtype.ext rfl + map_add' _ _ := rfl + +@[simp] +theorem coe_nonpositiveEquivFiltrationLEZero (ν : MaxAddDegree R M) + (x : ν.nonpositiveSubring) : + (ν.nonpositiveEquivFiltrationLEZero x : R) = x := + by simp [nonpositiveEquivFiltrationLEZero] + +/-- The projection from the nonpositive subring to the grade-zero homogeneous quotient. -/ +def residueMap (ν : MaxAddDegree R M) : + ν.nonpositiveSubring →+* ν.ResidueRing where + toFun x := ν.componentMk 0 (ν.nonpositiveEquivFiltrationLEZero x) + map_zero' := by simp + map_add' x y := by + change ν.componentMk 0 + (ν.nonpositiveEquivFiltrationLEZero (x + y)) = _ + rw [map_add, map_add] + map_one' := by + change ν.componentMk 0 + (ν.nonpositiveEquivFiltrationLEZero 1) = ν.componentOne + rw [ν.componentOne_eq_componentMk] + congr + map_mul' x y := by + apply ν.residueRingHom_injective + simp only [ν.residueRingHom_apply] + rw [DirectSum.of_zero_mul] + simp only [← ν.homogeneousMk_apply] + rw [ν.homogeneousMk_mul] + simp only [ν.homogeneousMk_apply] + apply DirectSum.of_eq_of_gradedMonoid_eq + apply Sigma.ext (zero_add 0).symm + apply ν.componentMk_heq_of_grade_eq_of_coe_eq (zero_add 0).symm + simp only [ν.coe_nonpositiveEquivFiltrationLEZero, ν.coe_mulFiltrationLE] + exact _root_.map_mul ν.nonpositiveSubring.subtype x y + +@[simp] +theorem residueMap_apply (ν : MaxAddDegree R M) (x : ν.nonpositiveSubring) : + ν.residueMap x = + ν.componentMk 0 (ν.nonpositiveEquivFiltrationLEZero x) := + by simp [residueMap] + +/-- Every grade-zero class has a representative of nonpositive degree. -/ +theorem residueMap_surjective (ν : MaxAddDegree R M) : + Function.Surjective ν.residueMap := by + intro c + induction c using QuotientAddGroup.induction_on with + | H x => exact ⟨ν.nonpositiveEquivFiltrationLEZero.symm x, by simp⟩ + +theorem residueMap_eq_zero_iff (ν : MaxAddDegree R M) + (x : ν.nonpositiveSubring) : + ν.residueMap x = 0 ↔ ν (x : R) < 0 := by + rw [ν.residueMap_apply, ν.componentMk_eq_zero_iff] + rfl + +/-- At degree zero or bottom, the RV class and residue class have the same homogeneous image. -/ +theorem coe_rvEquivHomogeneous_rv_eq_residueRingHom_residueMap + (ν : MaxAddDegree R M) [ν.IsMultiplicative] (x : ν.nonpositiveSubring) + (hx : ν (x : R) = 0 ∨ ν (x : R) = ⊥) : + (ν.rvEquivHomogeneous (ν.rv (x : R)) : ν.AssociatedGraded) = + ν.residueRingHom (ν.residueMap x) := by + rw [ν.rvEquivHomogeneous_apply, ν.coe_rvHomogeneous, + ν.rvInitialFormHom_rv] + rcases hx with hx | hx + · have hxnonbot : ν (x : R) ≠ ⊥ := by simp [hx] + rw [ν.initialForm_eq_homogeneousMk_of_ne_bot hxnonbot] + rw [ν.residueRingHom_apply, ν.residueMap_apply, ν.homogeneousMk_apply] + apply DirectSum.of_eq_of_gradedMonoid_eq + have hgrade : (ν (x : R)).unbot hxnonbot = 0 := + (WithBot.unbot_eq_iff hxnonbot).mpr hx + apply Sigma.ext hgrade + apply ν.componentMk_heq_of_grade_eq_of_coe_eq hgrade + rw [ν.coe_initialRepresentative, ν.coe_nonpositiveEquivFiltrationLEZero] + · rw [ν.initialForm_eq_zero_of_eq_bot hx] + have hresidue : ν.residueMap x = 0 := by + rw [ν.residueMap_eq_zero_iff, hx] + simp + rw [hresidue, ν.residueRingHom.map_zero] + +/-- The ideal of strictly negative elements in the nonpositive subring. -/ +def negativeIdeal (ν : MaxAddDegree R M) : Ideal ν.nonpositiveSubring where + carrier := {x | ν (x : R) < 0} + zero_mem' := by simp + add_mem' {x y} hx hy := (ν.map_add_le_max x y).trans_lt (max_lt hx hy) + smul_mem' x y hy := by + change ν ((x : R) * (y : R)) < 0 + simpa using degree_mul_lt_add_of_le_of_lt x.2 hy + +@[simp] +theorem mem_negativeIdeal_iff (ν : MaxAddDegree R M) + (x : ν.nonpositiveSubring) : + x ∈ ν.negativeIdeal ↔ ν (x : R) < 0 := + Iff.rfl + +/-- The kernel statement in LM24, Proposition 4.2.10. -/ +theorem residueMap_ker (ν : MaxAddDegree R M) : + RingHom.ker ν.residueMap = ν.negativeIdeal := by + ext x + rw [RingHom.mem_ker, ν.residueMap_eq_zero_iff, ν.mem_negativeIdeal_iff] + +/-- The first-isomorphism presentation of the residue ring. -/ +def residueQuotientEquiv (ν : MaxAddDegree R M) : + ν.nonpositiveSubring ⧸ ν.negativeIdeal ≃+* ν.ResidueRing := + (Ideal.quotEquivOfEq ν.residueMap_ker.symm).trans + (RingHom.quotientKerEquivOfSurjective ν.residueMap_surjective) + +@[simp] +theorem residueQuotientEquiv_mk (ν : MaxAddDegree R M) + (x : ν.nonpositiveSubring) : + ν.residueQuotientEquiv (Ideal.Quotient.mk ν.negativeIdeal x) = ν.residueMap x := by + simp [residueQuotientEquiv] + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/ResidueMathlib.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/ResidueMathlib.lean new file mode 100644 index 0000000000..51e0142264 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/ResidueMathlib.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.OfValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Residue +public import Mathlib.RingTheory.Valuation.Integers + +/-! +# Comparison with Mathlib's valuation integers + +For a group-valued Mathlib valuation, read as a max-additive degree by `MaxAddDegree.ofValuation`, +the nonpositive subring is Mathlib's `Valuation.integer`, and the strictly negative ideal is the +pullback of `Valuation.ltIdeal w 1`. These bridges make Mathlib's valuation-ring API available +without imposing a group structure on the monoid-valued construction used in LM24, Section 4. +-/ + +universe u v + +public noncomputable section + +namespace MaxAddDegree + +variable {R : Type u} {M : Type v} [CommRing R] [AddCommGroup M] + [LinearOrder M] [IsOrderedAddMonoid M] + +/-- In the group-valued case, the nonpositive subring is Mathlib's valuation integer subring. -/ +theorem nonpositiveSubring_ofValuation_eq_integer (w : Valuation R (WithZero (Multiplicative M))) : + (ofValuation w).nonpositiveSubring = w.integer := by + ext x + rw [mem_nonpositiveSubring_iff, Valuation.mem_integer_iff, ofValuation_apply] + change Multiplicative.toAdd (WithZero.toMulBot (w x)) ≤ 0 ↔ w x ≤ 1 + rfl + +/-- The canonical equivalence from the LM24 nonpositive subring to Mathlib's valuation integers. -/ +def nonpositiveEquivInteger (w : Valuation R (WithZero (Multiplicative M))) : + (ofValuation w).nonpositiveSubring ≃+* w.integer where + toFun x := ⟨x, by + rw [← nonpositiveSubring_ofValuation_eq_integer] + exact x.2⟩ + invFun x := ⟨x, by + rw [nonpositiveSubring_ofValuation_eq_integer] + exact x.2⟩ + left_inv _ := Subtype.ext rfl + right_inv _ := Subtype.ext rfl + map_add' _ _ := rfl + map_mul' _ _ := rfl + +@[simp] +theorem coe_nonpositiveEquivInteger (w : Valuation R (WithZero (Multiplicative M))) + (x : (ofValuation w).nonpositiveSubring) : + (nonpositiveEquivInteger w x : R) = x := + by simp [nonpositiveEquivInteger] + +/-- The LM24 negative ideal is the pullback of Mathlib's strict ideal below `1`. -/ +theorem negativeIdeal_ofValuation_eq_comap_ltIdeal + (w : Valuation R (WithZero (Multiplicative M))) : + (ofValuation w).negativeIdeal = + (w.ltIdeal 1).comap (nonpositiveEquivInteger w).toRingHom := by + ext x + rw [mem_negativeIdeal_iff, Ideal.mem_comap] + rw [Valuation.mem_ltIdeal_iff] + have hcoe : + (((nonpositiveEquivInteger w).toRingHom x : w.integer) : R) = x := + coe_nonpositiveEquivInteger w x + rw [hcoe, ofValuation_apply] + change Multiplicative.toAdd (WithZero.toMulBot (w (x : R))) < 0 ↔ + w (x : R) < 1 + rfl + +end MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests.lean new file mode 100644 index 0000000000..e929b2de10 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests.lean @@ -0,0 +1,17 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.AssociatedGraded +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.AssociatedGradedValuation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.DegreeAssociatedGraded +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.DegreeAssociatedGradedQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.FiltrationDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.QuotientDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.RV +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Residue + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGraded.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGraded.lean new file mode 100644 index 0000000000..99ba0acb5a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGraded.lean @@ -0,0 +1,193 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.OfValuation +public import Mathlib.Algebra.Order.Ring.Rat + +import Mathlib.Algebra.Ring.Prod + +/-! +# API checks for max-additive degrees and associated graded rings + +The raw constant-value fixture satisfies the two multiplicative semi-valuation axioms printed at +the start of LM24, Section 4, but the relation in Definition 4.1.1 is not reflexive. This verifies +that the additional zero-to-bottom condition used by the formalization is not a consequence of the +printed axioms. + +The remaining fixtures are Mathlib valuations read as multiplicative max-additive degrees through +`MaxAddDegree.ofValuation`. The first is a nonseparated counterexample to representative-sensitive +quotient rules. It pulls the trivial valuation on `ℚ` back along the first projection +`ℚ × ℚ → ℚ`. Thus `(0, 1)` is a nonzero element of the kernel. The certificates verify that its +homogeneous class is zero and that `(1, 1)` and `(1, 0)` have the same nonzero class. These +statements would fail for a construction that collapsed only the literal zero representative. + +The second fixture uses the separated trivial valuation on `ℚ`. It proves that the asymmetric +zero-plus-one test printed in LM24, Definition 4.2.4 selects the zero branch even though the class +of one is nonzero. Its grade-zero multiplication certificate also computes the product of the +homogeneous classes of two and three as the class of six. Together the fixtures exercise support, +separation, the strict quotient, and multiplication. +-/ + +public noncomputable section + +namespace Tests + +/-- The constant finite value map used to test the two semi-valuation axioms printed in LM24. +Ignoring its argument is the point of the fixture, hence the `nolint`. -/ +def printedConstantValue (_ : ℚ) : WithBot ℕ := + 0 + +theorem printedConstantValue_add_le_max (x y : ℚ) : + printedConstantValue (x + y) ≤ max (printedConstantValue x) (printedConstantValue y) := by + simp [printedConstantValue] + +theorem printedConstantValue_mul (x y : ℚ) : + printedConstantValue (x * y) = printedConstantValue x + printedConstantValue y := by + simp [printedConstantValue] + +/-- The two semi-valuation axioms printed in LM24 do not make Definition 4.1.1 reflexive. -/ +theorem printedSemivaluationRelation_not_reflexive : + ¬ Std.Refl (fun x y : ℚ ↦ printedConstantValue (x - y) < printedConstantValue x) := by + intro h + simpa [printedConstantValue] using h.refl 0 + +/-- The trivial valuation on the first coordinate of `ℚ × ℚ`. -/ +def firstProjectionValuation : MaxAddDegree (ℚ × ℚ) ℕ := + MaxAddDegree.ofValuation + ((1 : Valuation ℚ (WithZero (Multiplicative ℕ))).comap (RingHom.fst ℚ ℚ)) + +instance : firstProjectionValuation.IsMultiplicative := + inferInstanceAs (MaxAddDegree.ofValuation _).IsMultiplicative + +theorem firstProjectionValuation_value_zero_one : + firstProjectionValuation (0, 1) = ⊥ := by + simp [MaxAddDegree.ofValuation_apply, firstProjectionValuation, Valuation.one_apply_def] + +theorem firstProjectionValuation_value_one_one : + firstProjectionValuation (1, 1) = 0 := by + simp [MaxAddDegree.ofValuation_apply, firstProjectionValuation, Valuation.one_apply_def] + +/-- The first-projection valuation is genuinely nonseparated. -/ +theorem firstProjectionValuation_not_isSeparated : + ¬ firstProjectionValuation.IsSeparated := by + rw [MaxAddDegree.isSeparated_iff] + push Not + exact ⟨(0, 1), by simp [MaxAddDegree.ofValuation_apply, firstProjectionValuation, + Valuation.one_apply_def]⟩ + +def supportRepresentative : firstProjectionValuation.filtrationLE 0 := + ⟨(0, 1), by simp [MaxAddDegree.ofValuation_apply, firstProjectionValuation, + Valuation.one_apply_def]⟩ + +def nonzeroRepresentative : firstProjectionValuation.filtrationLE 0 := + ⟨(1, 1), by simp [MaxAddDegree.ofValuation_apply, firstProjectionValuation, + Valuation.one_apply_def]⟩ + +def sameLeadingRepresentative : firstProjectionValuation.filtrationLE 0 := + ⟨(1, 0), by simp [MaxAddDegree.ofValuation_apply, firstProjectionValuation, + Valuation.one_apply_def]⟩ + +/-- A nonzero element of the support ideal represents homogeneous zero. -/ +theorem supportRepresentative_componentMk_eq_zero : + firstProjectionValuation.componentMk 0 supportRepresentative = 0 := by + rw [MaxAddDegree.componentMk_eq_zero_iff] + simp [MaxAddDegree.ofValuation_apply, supportRepresentative, firstProjectionValuation, + Valuation.one_apply_def] + +/-- The class represented by `(1, 1)` is nonzero. -/ +theorem nonzeroRepresentative_componentMk_ne_zero : + firstProjectionValuation.componentMk 0 nonzeroRepresentative ≠ 0 := by + rw [ne_eq, MaxAddDegree.componentMk_eq_zero_iff] + simp [MaxAddDegree.ofValuation_apply, nonzeroRepresentative, firstProjectionValuation, + Valuation.one_apply_def] + +/-- Representatives differing by the nonzero support element `(0, 1)` have the same class. -/ +theorem firstProjectionValuation_same_leading_class : + firstProjectionValuation.componentMk 0 nonzeroRepresentative = + firstProjectionValuation.componentMk 0 sameLeadingRepresentative := by + rw [← sub_eq_zero, ← map_sub, MaxAddDegree.componentMk_eq_zero_iff] + change firstProjectionValuation ((1, 1) - (1, 0)) < (0 : ℕ) + simp [MaxAddDegree.ofValuation_apply, firstProjectionValuation, Valuation.one_apply_def] + +/-- Adding a nonzero support representative does not change a homogeneous class. -/ +theorem firstProjectionValuation_add_support_class : + firstProjectionValuation.componentMk 0 nonzeroRepresentative + + firstProjectionValuation.componentMk 0 supportRepresentative = + firstProjectionValuation.componentMk 0 nonzeroRepresentative := by + rw [supportRepresentative_componentMk_eq_zero, add_zero] + +/-- The separated trivial valuation on `ℚ`. -/ +def trivialValuation : MaxAddDegree ℚ ℕ := + MaxAddDegree.ofValuation 1 + +instance : trivialValuation.IsMultiplicative := + inferInstanceAs (MaxAddDegree.ofValuation _).IsMultiplicative + +def oneRepresentative : trivialValuation.filtrationLE 0 := + ⟨1, by simp [MaxAddDegree.ofValuation_apply, trivialValuation, Valuation.one_apply_def]⟩ + +theorem oneRepresentative_componentMk_ne_zero : + trivialValuation.componentMk 0 oneRepresentative ≠ 0 := by + rw [ne_eq, MaxAddDegree.componentMk_eq_zero_iff] + simp [MaxAddDegree.ofValuation_apply, oneRepresentative, trivialValuation, + Valuation.one_apply_def] + +/-- The representative-level addition formula printed in LM24, Definition 4.2.4 at grade zero. -/ +def printedRepresentativeAdd + (x y : trivialValuation.filtrationLE 0) : trivialValuation.Component 0 := + if trivialValuation ((x : ℚ) + (y : ℚ)) = trivialValuation x then + trivialValuation.componentMk 0 (x + y) + else + 0 + +/-- The addition formula printed in LM24, Definition 4.2.4 is not commutative. -/ +theorem printedRepresentativeAdd_not_commutative : + printedRepresentativeAdd 0 oneRepresentative ≠ + printedRepresentativeAdd oneRepresentative 0 := by + have hzeroOne : + trivialValuation + (((0 : trivialValuation.filtrationLE 0) : ℚ) + (oneRepresentative : ℚ)) ≠ + trivialValuation ((0 : trivialValuation.filtrationLE 0) : ℚ) := by + simp [MaxAddDegree.ofValuation_apply, oneRepresentative, trivialValuation, + Valuation.one_apply_def] + have honeZero : + trivialValuation + ((oneRepresentative : ℚ) + ((0 : trivialValuation.filtrationLE 0) : ℚ)) = + trivialValuation oneRepresentative := by + simp + rw [printedRepresentativeAdd, if_neg hzeroOne, printedRepresentativeAdd, if_pos honeZero] + simp only [add_zero] + exact oneRepresentative_componentMk_ne_zero.symm + +theorem trivialValuation_isSeparated : trivialValuation.IsSeparated := by + rw [MaxAddDegree.isSeparated_iff] + intro x + by_cases hx : x = 0 + · simp [MaxAddDegree.ofValuation_apply, trivialValuation, Valuation.one_apply_def, hx] + · simp [MaxAddDegree.ofValuation_apply, trivialValuation, Valuation.one_apply_def, hx] + +def twoRepresentative : trivialValuation.filtrationLE 0 := + ⟨2, by simp [MaxAddDegree.ofValuation_apply, trivialValuation, Valuation.one_apply_def]⟩ + +def threeRepresentative : trivialValuation.filtrationLE 0 := + ⟨3, by simp [MaxAddDegree.ofValuation_apply, trivialValuation, Valuation.one_apply_def]⟩ + +def sixRepresentative : trivialValuation.filtrationLE 0 := + ⟨6, by simp [MaxAddDegree.ofValuation_apply, trivialValuation, Valuation.one_apply_def]⟩ + +/-- Homogeneous multiplication computes `2 * 3 = 6` in the grade-zero component. -/ +theorem trivialValuation_two_mul_three : + trivialValuation.homogeneousMk 0 twoRepresentative * + trivialValuation.homogeneousMk 0 threeRepresentative = + trivialValuation.homogeneousMk 0 sixRepresentative := by + rw [MaxAddDegree.homogeneousMk_mul] + apply congrArg (trivialValuation.homogeneousMk 0) + apply Subtype.ext + norm_num [twoRepresentative, threeRepresentative, sixRepresentative] + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGradedValuation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGradedValuation.lean new file mode 100644 index 0000000000..6ef0c5ba9b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGradedValuation.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.OfValuation +public import Mathlib.Algebra.Order.Ring.Rat + +import Mathlib.Algebra.Ring.Prod + +/-! +# API checks for leading-grade valuations + +A two-grade direct sum over `ℤ` verifies that leading grade uses the largest nonzero grade and +that ordinary addition of grades governs products. The asymmetric grades ensure that the client +is not merely checking the grade-zero ring inherited from the coefficient ring. + +The first-projection valuation on `ℚ × ℚ`, read as a multiplicative max-additive degree, is +nonseparated, while its associated-graded valuation is separated. Its nonzero kernel element has +zero initial form, and a representative outside the kernel retains its degree under the +initial-form map. These certificates exercise the distinction between the original kernel and the +zero element of the associated graded ring. +-/ + +public noncomputable section + +open MaxAddDegree +open scoped DirectSum + +namespace Tests + +abbrev LeadingGradeFixture := DirectSum ℕ (fun _ ↦ ℤ) + +def leadingGradeLow : LeadingGradeFixture := + DirectSum.of (fun _ : ℕ ↦ ℤ) 1 2 + +def leadingGradeHigh : LeadingGradeFixture := + DirectSum.of (fun _ : ℕ ↦ ℤ) 3 5 + +/-- The sum of components in grades one and three has leading grade three. -/ +theorem leadingGrade_sum_fixture : + DirectSum.leadingGrade (fun _ : ℕ ↦ ℤ) (leadingGradeLow + leadingGradeHigh) = 3 := by + have hlow : DirectSum.leadingGrade (fun _ : ℕ ↦ ℤ) leadingGradeLow = 1 := by + rw [leadingGradeLow] + exact DirectSum.leadingGrade_of _ (by norm_num) + have hhigh : DirectSum.leadingGrade (fun _ : ℕ ↦ ℤ) leadingGradeHigh = 3 := by + rw [leadingGradeHigh] + exact DirectSum.leadingGrade_of _ (by norm_num) + apply le_antisymm + · calc + DirectSum.leadingGrade (fun _ : ℕ ↦ ℤ) (leadingGradeLow + leadingGradeHigh) ≤ + max (DirectSum.leadingGrade (fun _ : ℕ ↦ ℤ) leadingGradeLow) + (DirectSum.leadingGrade (fun _ : ℕ ↦ ℤ) leadingGradeHigh) := + DirectSum.leadingGrade_add_le_max _ _ _ + _ = 3 := by + rw [hlow, hhigh] + norm_num + · apply DirectSum.grade_le_leadingGrade + norm_num [leadingGradeLow, leadingGradeHigh, DirectSum.of_apply] + +/-- The product of the grade-one and grade-three components has leading grade four. -/ +theorem leadingGrade_mul_fixture : + DirectSum.leadingGrade (fun _ : ℕ ↦ ℤ) (leadingGradeLow * leadingGradeHigh) = 4 := by + have hlow : DirectSum.leadingGrade (fun _ : ℕ ↦ ℤ) leadingGradeLow = 1 := by + rw [leadingGradeLow] + exact DirectSum.leadingGrade_of _ (by norm_num) + have hhigh : DirectSum.leadingGrade (fun _ : ℕ ↦ ℤ) leadingGradeHigh = 3 := by + rw [leadingGradeHigh] + exact DirectSum.leadingGrade_of _ (by norm_num) + rw [DirectSum.leadingGrade_mul (fun _ : ℕ ↦ ℤ) + (fun a b ha hb ↦ mul_ne_zero ha hb)] + rw [hlow, hhigh] + norm_num + +def associatedFirstProjectionValuation : MaxAddDegree (ℚ × ℚ) ℕ := + MaxAddDegree.ofValuation + ((1 : Valuation ℚ (WithZero (Multiplicative ℕ))).comap (RingHom.fst ℚ ℚ)) + +instance : associatedFirstProjectionValuation.IsMultiplicative := + inferInstanceAs (MaxAddDegree.ofValuation _).IsMultiplicative + +theorem associatedFirstProjectionValuation_not_isSeparated : + ¬associatedFirstProjectionValuation.IsSeparated := by + rw [MaxAddDegree.isSeparated_iff] + push Not + exact ⟨(0, 1), by simp [MaxAddDegree.ofValuation_apply, + associatedFirstProjectionValuation, Valuation.one_apply_def]⟩ + +/-- The associated-graded valuation is separated even when the original valuation is not. -/ +theorem associatedFirstProjectionValuation_associated_isSeparated : + associatedFirstProjectionValuation.associatedGradedValuation.IsSeparated := + associatedFirstProjectionValuation.associatedGradedValuation_isSeparated + +/-- A nonzero element of the original kernel has bottom-valued initial form. -/ +theorem associatedFirstProjectionValuation_support_initialForm : + associatedFirstProjectionValuation.associatedGradedValuation + (associatedFirstProjectionValuation.initialForm (0, 1)) = ⊥ := by + rw [MaxAddDegree.associatedGradedValuation_initialForm] + simp [MaxAddDegree.ofValuation_apply, associatedFirstProjectionValuation, + Valuation.one_apply_def] + +/-- A representative outside the kernel retains its finite degree under the initial-form map. -/ +theorem associatedFirstProjectionValuation_nonzero_initialForm : + associatedFirstProjectionValuation.associatedGradedValuation + (associatedFirstProjectionValuation.initialForm (1, 1)) = 0 := by + rw [MaxAddDegree.associatedGradedValuation_initialForm] + simp [MaxAddDegree.ofValuation_apply, associatedFirstProjectionValuation, + Valuation.one_apply_def] + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/DegreeAssociatedGraded.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/DegreeAssociatedGraded.lean new file mode 100644 index 0000000000..1321e7f9e6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/DegreeAssociatedGraded.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialAssociatedGraded + +import Mathlib.Algebra.Polynomial.Degree.Operations + +/-! +# API checks for the associated graded ring of a degree function + +The class of `X` in grade one is nonzero, and its homogeneous square is represented by `X ^ 2` +in grade two. The square is nonzero because its polynomial degree is exactly two. This checks +multiplication on a genuinely nonconstant representative and distinguishes the intended strict +lower filtration from a quotient that kills all positive-degree elements. + +The zero polynomial still maps to zero in a positive component, checking the bottom-degree branch. +-/ + +public noncomputable section + +namespace Tests + +open Polynomial +open scoped MaxAddDegree + +/-- Exact multiplication of polynomial degree gives the generic homogeneous +non-zero-divisor condition. -/ +theorem polynomialDegree_homogeneousNoZeroDivisors : + polynomialDegree.HomogeneousNoZeroDivisors := + polynomialDegree.homogeneousNoZeroDivisors_of_isMultiplicative + +/-- Homogeneous squaring is represented by polynomial squaring. -/ +theorem polynomialInitial_sq : + polynomialDegree.componentMul polynomialXInitial polynomialXInitial = + polynomialDegree.componentMk 2 + ⟨X ^ 2, (polynomialDegree.mem_filtrationLE_iff 2 (X ^ 2)).mpr (by + rw [polynomialDegree_apply, Polynomial.degree_X_pow] + simp)⟩ := by + rw [polynomialXInitial_eq_componentMk, polynomialDegree.componentMul_componentMk] + apply congrArg (polynomialDegree.componentMk 2) + apply Subtype.ext + rw [polynomialDegree.coe_mulFiltrationLE] + exact (pow_two (X : ℚ[X])).symm + +/-- The square of the nonzero degree-one test class is nonzero. -/ +theorem polynomialInitial_sq_ne_zero : + polynomialDegree.componentMul polynomialXInitial polynomialXInitial ≠ 0 := by + rw [polynomialInitial_sq, ne_eq, polynomialDegree.componentMk_eq_zero_iff, + polynomialDegree_apply, Polynomial.degree_X_pow] + exact lt_irrefl _ + +/-- Bottom degree maps the zero polynomial to zero in a positive component. -/ +theorem polynomialZeroInitial_eq_zero : + polynomialDegree.componentMk 1 ⟨(0 : ℚ[X]), by simp⟩ = 0 := by + rw [polynomialDegree.componentMk_eq_zero_iff, polynomialDegree_apply] + simp + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/DegreeAssociatedGradedQuotient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/DegreeAssociatedGradedQuotient.lean new file mode 100644 index 0000000000..7a92667f73 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/DegreeAssociatedGradedQuotient.lean @@ -0,0 +1,156 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialAssociatedGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialQuotientDegree + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreePrincipalInitialIdeal +import Mathlib.Algebra.Polynomial.Degree.Operations + +/-! +# API checks for the associated graded ring of a quotient + +For `ℚ[X] / (X - 1)`, the degree-one initial class of `X - 1` equals the initial class of `X`. +The canonical graded quotient map therefore kills that nonzero degree-one class, and the class lies +in the initial ideal. The degree-zero unit survives. Together these facts separate the canonical +map from both the identity map and the zero map, while checking that lower-degree terms disappear +from an initial form. +-/ + +open scoped MaxAddDegree + +public noncomputable section + +namespace Tests + +open Polynomial + +private def relationFiltrationOne : polynomialDegree.filtrationLE 1 := + ⟨X - C 1, (polynomialDegree.mem_filtrationLE_iff 1 _).mpr (by + rw [polynomialDegree_apply] + exact Polynomial.degree_X_sub_C_le 1)⟩ + +private theorem relation_mem_evaluationAtOneIdeal : + (relationFiltrationOne : ℚ[X]) ∈ evaluationAtOneIdeal := by + rw [relationFiltrationOne] + exact Ideal.Quotient.eq_zero_iff_mem.mp quotientMk_X_sub_one_eq_zero + +private theorem relation_component_eq_xInitial : + polynomialDegree.componentMk 1 relationFiltrationOne = polynomialXInitial := by + let x : polynomialDegree.filtrationLE 1 := + ⟨X, (polynomialDegree.mem_filtrationLE_iff 1 X).mpr (by + rw [polynomialDegree_apply, Polynomial.degree_X] + simp)⟩ + let c : polynomialDegree.filtrationLE 1 := + ⟨C 1, (polynomialDegree.mem_filtrationLE_iff 1 _).mpr (by + rw [polynomialDegree_apply, Polynomial.degree_C one_ne_zero] + simp)⟩ + have hc : polynomialDegree.componentMk 1 c = 0 := by + rw [polynomialDegree.componentMk_eq_zero_iff, polynomialDegree_apply, + Polynomial.degree_C one_ne_zero] + simp + have hrelation : relationFiltrationOne = x - c := Subtype.ext rfl + rw [hrelation, map_sub, hc, sub_zero, polynomialXInitial_eq_componentMk] + +/-- The degree-one initial class of `X` maps to zero modulo `X - 1`. -/ +theorem polynomialGradedQuotientMap_X_eq_zero : + polynomialDegree.associatedGradedQuotientMap evaluationAtOneIdeal + polynomialDegree_isSeparated + (DirectSum.of polynomialDegree.Component 1 polynomialXInitial) = 0 := by + rw [polynomialDegree.associatedGradedQuotientMap_of] + have hcomponent : + polynomialDegree.quotientComponentMap evaluationAtOneIdeal + polynomialDegree_isSeparated 1 polynomialXInitial = 0 := + (polynomialDegree.quotientComponentMap_eq_zero_iff evaluationAtOneIdeal + polynomialDegree_isSeparated 1 polynomialXInitial).mpr + ⟨relationFiltrationOne, relation_mem_evaluationAtOneIdeal, + relation_component_eq_xInitial⟩ + rw [hcomponent, + (DirectSum.of + (polynomialDegree.quotient evaluationAtOneIdeal + polynomialDegree_isSeparated).Component 1).map_zero] + +/-- The degree-one initial class of `X` belongs to the initial ideal of `(X - 1)`. -/ +theorem polynomialXInitial_mem_initialIdeal : + DirectSum.of polynomialDegree.Component 1 polynomialXInitial ∈ + polynomialDegree.initialIdeal evaluationAtOneIdeal := by + have hmem := polynomialDegree.homogeneousMk_mem_initialIdeal evaluationAtOneIdeal + 1 relationFiltrationOne relation_mem_evaluationAtOneIdeal + rw [polynomialDegree.homogeneousMk_apply, relation_component_eq_xInitial] at hmem + exact hmem + +/-- The quotient-ring equivalence sends the class of the degree-one initial form to zero. -/ +theorem polynomialAssociatedGradedQuotientEquiv_X_eq_zero : + polynomialDegree.associatedGradedQuotientEquiv evaluationAtOneIdeal + polynomialDegree_isSeparated + (Ideal.Quotient.mk (polynomialDegree.initialIdeal evaluationAtOneIdeal) + (DirectSum.of polynomialDegree.Component 1 polynomialXInitial)) = 0 := by + rw [polynomialDegree.associatedGradedQuotientEquiv_mk, + polynomialGradedQuotientMap_X_eq_zero] + +/-- The initial ideal of `(X - 1)` is generated by the degree-one initial class of `X`. -/ +theorem polynomialInitialIdeal_eq_span_XInitial : + polynomialDegree.initialIdeal evaluationAtOneIdeal = + Ideal.span {DirectSum.of polynomialDegree.Component 1 polynomialXInitial} := by + rw [evaluationAtOneIdeal_eq_span, + polynomialDegree.initialIdeal_span_singleton_eq_span_initialForm] + have hcomponent : + polynomialDegree.componentMk 1 relationFiltrationOne ≠ 0 := by + rw [relation_component_eq_xInitial] + exact polynomialXInitial_ne_zero + have hinitial := + polynomialDegree.initialForm_eq_homogeneousMk_of_componentMk_ne_zero + 1 relationFiltrationOne hcomponent + change polynomialDegree.initialForm (X - C 1) = + polynomialDegree.homogeneousMk 1 relationFiltrationOne at hinitial + rw [hinitial, + polynomialDegree.homogeneousMk_apply, relation_component_eq_xInitial] + +private theorem evaluationAtOneQuotient_one_ne_zero : + (1 : ℚ[X] ⧸ evaluationAtOneIdeal) ≠ 0 := by + simpa using quotientMk_one_ne_zero + +private theorem evaluationAtOneQuotientDegree_one_eq_zero : + (polynomialDegree.quotient evaluationAtOneIdeal polynomialDegree_isSeparated) 1 = + (0 : ℕ) := by + let νq := polynomialDegree.quotient evaluationAtOneIdeal polynomialDegree_isSeparated + have hsep : νq.IsSeparated := + polynomialDegree.quotient_isSeparated evaluationAtOneIdeal + polynomialDegree_isSeparated + have hnebot : νq 1 ≠ ⊥ := by + intro hbot + exact evaluationAtOneQuotient_one_ne_zero + (((νq.isSeparated_iff).mp hsep 1).mp hbot) + have hle : νq 1 ≤ (0 : WithBot ℕ) := νq.map_one_le_zero + obtain ⟨n, hn⟩ := WithBot.ne_bot_iff_exists.mp hnebot + rw [← hn] at hle ⊢ + have hnzero : n = 0 := Nat.eq_zero_of_le_zero (WithBot.coe_le_coe.mp hle) + simp [hnzero] + +/-- The degree-zero unit survives the canonical graded quotient map. -/ +theorem polynomialGradedQuotientMap_one_ne_zero : + polynomialDegree.associatedGradedQuotientMap evaluationAtOneIdeal + polynomialDegree_isSeparated 1 ≠ 0 := by + let νq := polynomialDegree.quotient evaluationAtOneIdeal polynomialDegree_isSeparated + have hcomponentOne : νq.componentOne ≠ 0 := by + rw [νq.componentOne_eq_componentMk, ne_eq, νq.componentMk_eq_zero_iff] + rw [evaluationAtOneQuotientDegree_one_eq_zero] + exact lt_irrefl _ + have hgradedOne : (1 : νq.AssociatedGraded) ≠ 0 := by + rw [DirectSum.one_def] + intro hzero + have hzero' : DirectSum.of νq.Component 0 νq.componentOne = 0 := by + simpa only [show GradedMonoid.GOne.one = νq.componentOne from rfl] using hzero + apply hcomponentOne + apply DirectSum.of_injective 0 + simpa using hzero' + rw [(polynomialDegree.associatedGradedQuotientMap evaluationAtOneIdeal + polynomialDegree_isSeparated).map_one] + exact hgradedOne + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/FiltrationDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/FiltrationDegree.lean new file mode 100644 index 0000000000..30c05b6633 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/FiltrationDegree.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.FiltrationDegree + +/-! +# API checks for the degree attached to a separated filtration + +For a nonzero element, `index` is the largest filtration stage containing it. Thus the element +lies in the stage indexed by its index and not in the next stage. + +The value lies in `WithBot (OrderDual ℕ)`: deeper filtration stages give smaller values, as +required for a max-additive degree. Membership in stage `F j` is therefore equivalent to the +corresponding upper bound on the value. The final checks record zero detection, separatedness, +and the weak and strict filtrations recovered from this degree. +-/ + +public noncomputable section + +namespace Tests + +universe u + +variable {R : Type u} [CommRing R] {F : ℕ → Ideal R} + +/-- A nonzero element lies in the filtration stage indexed by its index. -/ +theorem mem_filtration_index (hF : IsSeparatedFiltration F) {x : R} (hx : x ≠ 0) : + x ∈ F (hF.index hx) := + (hF.mem_iff_le_index hx _).mpr le_rfl + +/-- A nonzero element does not lie in the stage immediately above its index. -/ +theorem not_mem_filtration_index_succ (hF : IsSeparatedFiltration F) {x : R} + (hx : x ≠ 0) : + x ∉ F (hF.index hx + 1) := by + rw [hF.mem_iff_le_index hx] + omega + +/-- The value is antitone in the index: deeper filtration means smaller value. -/ +theorem value_antitone_of_index_le (hF : IsSeparatedFiltration F) {x y : R} + (hx : x ≠ 0) (hy : y ≠ 0) (h : hF.index hx ≤ hF.index hy) : + hF.value y ≤ hF.value x := by + rw [hF.value_of_ne_zero hx, hF.value_of_ne_zero hy, WithBot.coe_le_coe] + exact OrderDual.toDual_le_toDual.mpr h + +/-- Membership in a filtration stage is equivalent to the corresponding upper bound on the +value. -/ +theorem mem_iff_value_le (hF : IsSeparatedFiltration F) (x : R) (j : ℕ) : + x ∈ F j ↔ hF.value x ≤ ((OrderDual.toDual j : OrderDual ℕ) : WithBot (OrderDual ℕ)) := + (hF.value_le_toDual_iff x j).symm + +/-- The degree attached to the filtration evaluates to its value function. -/ +theorem degree_eq_value (hF : IsSeparatedFiltration F) (x : R) : + hF.degree x = hF.value x := + hF.degree_apply x + +/-- An element has value `⊥` exactly when it is zero. -/ +theorem value_eq_bot_iff_eq_zero (hF : IsSeparatedFiltration F) (x : R) : + hF.value x = ⊥ ↔ x = 0 := + hF.value_eq_bot_iff x + +/-- The degree attached to a separated filtration is separated. -/ +theorem degree_isSeparated' (hF : IsSeparatedFiltration F) : + (hF.degree).IsSeparated := + hF.degree_isSeparated + +/-- At dual index `j`, the weak filtration of the degree is `F j` and its strict filtration is +`F (j+1)`. -/ +theorem mem_degree_filtration_iff (hF : IsSeparatedFiltration F) (j : ℕ) (x : R) : + (x ∈ (hF.degree).filtrationLE (OrderDual.toDual j) ↔ x ∈ F j) ∧ + ∀ y : (hF.degree).filtrationLE (OrderDual.toDual j), + (y ∈ (hF.degree).lowerFiltration (OrderDual.toDual j) ↔ (y : R) ∈ F (j + 1)) := + ⟨hF.mem_degree_filtrationLE_iff j x, fun y ↦ hF.mem_degree_lowerFiltration_iff j y⟩ + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures.lean new file mode 100644 index 0000000000..c49ed6f658 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialAssociatedGraded +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialQuotientDegree + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures/PolynomialAssociatedGraded.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures/PolynomialAssociatedGraded.lean new file mode 100644 index 0000000000..616502504a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures/PolynomialAssociatedGraded.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialDegree + +/-! +# Polynomial associated-graded fixture + +This module supplies the degree-one initial class of `X` shared by associated-graded API clients. +-/ + +public noncomputable section + +namespace Tests + +open Polynomial + +/-- The class of `X` in the degree-one homogeneous component. -/ +def polynomialXInitial : polynomialDegree.Component 1 := + polynomialDegree.componentMk 1 + ⟨X, (polynomialDegree.mem_filtrationLE_iff 1 X).mpr (by + rw [polynomialDegree_apply, Polynomial.degree_X] + simp)⟩ + +/-- Evaluation of the polynomial initial-class fixture. -/ +theorem polynomialXInitial_eq_componentMk : + polynomialXInitial = polynomialDegree.componentMk 1 + ⟨X, (polynomialDegree.mem_filtrationLE_iff 1 X).mpr (by + rw [polynomialDegree_apply, Polynomial.degree_X] + simp)⟩ := + (rfl) + +/-- The degree-one initial class of `X` is nonzero. -/ +theorem polynomialXInitial_ne_zero : polynomialXInitial ≠ 0 := by + rw [polynomialXInitial_eq_componentMk, ne_eq, + polynomialDegree.componentMk_eq_zero_iff, + polynomialDegree_apply, Polynomial.degree_X] + exact lt_irrefl _ + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures/PolynomialDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures/PolynomialDegree.lean new file mode 100644 index 0000000000..abd4565e68 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures/PolynomialDegree.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.MaxAddDegree +public import Mathlib.Algebra.Polynomial.Degree.Defs +import Mathlib.Algebra.Polynomial.Degree.Operations + +/-! +# Polynomial-degree fixture + +This module packages ordinary degree on `ℚ[X]` as a separated `MaxAddDegree`. It is shared by +the quotient-degree and associated-graded API clients. +-/ + +public noncomputable section + +namespace Tests + +open Polynomial + +/-- The ordinary degree on `ℚ[X]` as a submultiplicative max-additive degree. -/ +def polynomialDegree : MaxAddDegree ℚ[X] ℕ where + toFun := Polynomial.degree + map_zero' := Polynomial.degree_zero + map_one_le_zero' := Polynomial.degree_one_le + map_neg' := Polynomial.degree_neg + map_add_le_max' := Polynomial.degree_add_le + map_mul_le_add' := Polynomial.degree_mul_le + +@[simp] +theorem polynomialDegree_apply (p : ℚ[X]) : + polynomialDegree p = p.degree := (rfl) + +/-- Ordinary polynomial degree is separated. -/ +theorem polynomialDegree_isSeparated : polynomialDegree.IsSeparated := by + rw [MaxAddDegree.isSeparated_iff] + intro p + rw [polynomialDegree_apply, Polynomial.degree_eq_bot] + +/-- Ordinary polynomial degree is exactly multiplicative over `ℚ`. -/ +instance polynomialDegree_isMultiplicative : polynomialDegree.IsMultiplicative := + ⟨fun _ _ ↦ Polynomial.degree_mul⟩ + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures/PolynomialQuotientDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures/PolynomialQuotientDegree.lean new file mode 100644 index 0000000000..5dbf496001 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures/PolynomialQuotientDegree.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.QuotientDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialDegree +public import Mathlib.Algebra.Polynomial.Eval.Defs +public import Mathlib.RingTheory.Ideal.Maps + +/-! +# Polynomial quotient-degree fixture + +This module packages the least-representative degree on `ℚ[X] / (X - 1)`. It is shared by the +quotient-degree and associated-graded-quotient API clients. +-/ + +public noncomputable section + +namespace Tests + +open Polynomial + +/-- The ideal imposing the relation `X = 1`. -/ +def evaluationAtOneIdeal : Ideal ℚ[X] := + Ideal.span {X - C 1} + +/-- Evaluation of the ideal imposing `X = 1`. -/ +theorem evaluationAtOneIdeal_eq_span : + evaluationAtOneIdeal = Ideal.span {X - C 1} := + (rfl) + +theorem evaluationAtOneIdeal_le_ker_evalAtOne : + evaluationAtOneIdeal ≤ RingHom.ker (Polynomial.evalRingHom (1 : ℚ)) := by + rw [evaluationAtOneIdeal, Ideal.span_le] + intro p hp + rw [Set.mem_singleton_iff.mp hp] + change Polynomial.evalRingHom (1 : ℚ) (X - C 1) = 0 + simp + +/-- The quotient degree on `ℚ[X] / (X - 1)`. -/ +def evaluationAtOneQuotientDegree : MaxAddDegree (ℚ[X] ⧸ evaluationAtOneIdeal) ℕ := + polynomialDegree.quotient evaluationAtOneIdeal polynomialDegree_isSeparated + +@[simp] +theorem evaluationAtOneQuotientDegree_apply (q : ℚ[X] ⧸ evaluationAtOneIdeal) : + evaluationAtOneQuotientDegree q = + polynomialDegree.quotientValue evaluationAtOneIdeal + polynomialDegree_isSeparated q := by + rw [evaluationAtOneQuotientDegree, polynomialDegree.quotient_apply] + +theorem quotientMk_X_eq_quotientMk_one : + Ideal.Quotient.mk evaluationAtOneIdeal X = + Ideal.Quotient.mk evaluationAtOneIdeal (C 1) := by + rw [Ideal.Quotient.eq, evaluationAtOneIdeal] + exact Ideal.subset_span (Set.mem_singleton _) + +theorem quotientMk_one_ne_zero : + Ideal.Quotient.mk evaluationAtOneIdeal (C 1) ≠ 0 := by + intro hzero + have hmem : C (1 : ℚ) ∈ evaluationAtOneIdeal := + Ideal.Quotient.eq_zero_iff_mem.mp hzero + have hker := evaluationAtOneIdeal_le_ker_evalAtOne hmem + rw [RingHom.mem_ker] at hker + simp at hker + +theorem quotientMk_X_sub_one_eq_zero : + Ideal.Quotient.mk evaluationAtOneIdeal (X - C 1) = 0 := by + rw [Ideal.Quotient.eq_zero_iff_mem, evaluationAtOneIdeal] + exact Ideal.subset_span (Set.mem_singleton _) + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/QuotientDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/QuotientDegree.lean new file mode 100644 index 0000000000..d5469d32ca --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/QuotientDegree.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialQuotientDegree + +/-! +# API checks for least-representative quotient degree + +The ordinary degree on `ℚ[X]` gives a separated max-additive degree. We quotient by `(X - 1)`. +The nonzero class of `X` also has the constant representative `1`, so its quotient degree is zero +rather than the degree one of `X`. Conversely, the zero class has the nonzero representative +`X - 1` of degree one but receives bottom degree. These two checks distinguish minimization over +all representatives and the explicit zero-class branch from the nearby wrong construction that +uses one arbitrarily chosen representative. +-/ + +public noncomputable section + +namespace Tests + +open Polynomial + +/-- The class of `X` has quotient degree zero because the same class has constant representative +`1`; a construction using the displayed representative `X` would assign degree one. -/ +theorem evaluationAtOneQuotientDegree_X_eq_zero : + evaluationAtOneQuotientDegree + (Ideal.Quotient.mk evaluationAtOneIdeal X) = 0 := by + rw [quotientMk_X_eq_quotientMk_one, evaluationAtOneQuotientDegree_apply] + have hle := polynomialDegree.quotientValue_mk_le evaluationAtOneIdeal + polynomialDegree_isSeparated (C (1 : ℚ)) + rw [polynomialDegree_apply, Polynomial.degree_C one_ne_zero] at hle + have hne : polynomialDegree.quotientValue evaluationAtOneIdeal + polynomialDegree_isSeparated (Ideal.Quotient.mk evaluationAtOneIdeal (C 1)) ≠ ⊥ := by + rw [ne_eq, polynomialDegree.quotientValue_eq_bot_iff] + exact quotientMk_one_ne_zero + obtain ⟨n, hn⟩ := WithBot.ne_bot_iff_exists.mp hne + rw [← hn] at hle ⊢ + have hn0 : n = 0 := Nat.eq_zero_of_le_zero (WithBot.coe_le_coe.mp hle) + simp [hn0] + +/-- The zero quotient class has bottom degree even when displayed by the degree-one representative +`X - 1`; a construction minimizing only nonzero classes without a zero branch would fail here. -/ +theorem evaluationAtOneQuotientDegree_X_sub_one_eq_bot : + evaluationAtOneQuotientDegree + (Ideal.Quotient.mk evaluationAtOneIdeal (X - C 1)) = ⊥ ∧ + (X - C (1 : ℚ)).degree = 1 := by + constructor + · rw [quotientMk_X_sub_one_eq_zero] + exact MaxAddDegree.map_zero evaluationAtOneQuotientDegree + · apply le_antisymm (Polynomial.degree_X_sub_C_le 1) + apply Polynomial.le_degree_of_ne_zero + norm_num [Polynomial.coeff_X, Polynomial.coeff_one] + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/RV.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/RV.lean new file mode 100644 index 0000000000..f8c03f1c46 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/RV.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.RV +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.OfValuation +public import Mathlib.Algebra.Order.Ring.Rat + +import Mathlib.Algebra.Ring.Prod + +/-! +# API checks for RV classes, initial forms, and the residue ring + +The fixtures are Mathlib valuations read as multiplicative max-additive degrees through +`MaxAddDegree.ofValuation`. The first-projection valuation on `ℚ × ℚ` is nonseparated. Its +nonzero kernel element `(0, 1)` therefore separates LM24's RV quotient from a quotient that +collapses only literal zero. The representatives `(1, 1)` and `(1, 0)` further verify that adding +a kernel element preserves both the RV class and the leading homogeneous class. + +The separated trivial valuation on `ℚ` checks the grade-zero residue-ring multiplication on +nontrivial representatives. These tests use only the public RV and associated-graded interfaces. +-/ +public noncomputable section + +namespace Tests + +open scoped DirectSum + +def rvFirstProjectionValuation : MaxAddDegree (ℚ × ℚ) ℕ := + MaxAddDegree.ofValuation + ((1 : Valuation ℚ (WithZero (Multiplicative ℕ))).comap (RingHom.fst ℚ ℚ)) + +instance : rvFirstProjectionValuation.IsMultiplicative := + inferInstanceAs (MaxAddDegree.ofValuation _).IsMultiplicative + +def rvSupportElement : ℚ × ℚ := + (0, 1) + +theorem rvSupportElement_ne_zero : rvSupportElement ≠ 0 := by + norm_num [rvSupportElement] + +theorem rvFirstProjectionValuation_value_support : + rvFirstProjectionValuation rvSupportElement = ⊥ := by + simp [MaxAddDegree.ofValuation_apply, rvSupportElement, rvFirstProjectionValuation, + Valuation.one_apply_def] + +/-- The RV zero class contains the nonzero support element `(0, 1)`. -/ +theorem rvSupportElement_rv_eq_zero : + rvFirstProjectionValuation.rv rvSupportElement = 0 := by + rw [MaxAddDegree.rv_eq_zero_iff] + exact rvFirstProjectionValuation_value_support + +/-- The standard-order encoding of the RV relation is reflexive at a nonzero support element. -/ +theorem rvSupportElement_self_related : + rvFirstProjectionValuation.RVRel rvSupportElement rvSupportElement := + rvFirstProjectionValuation.rvRel_refl rvSupportElement + +/-- Representatives differing by a nonzero support element have the same RV class. -/ +theorem rvFirstProjectionValuation_same_rv : + rvFirstProjectionValuation.rv (1, 1) = rvFirstProjectionValuation.rv (1, 0) := by + rw [MaxAddDegree.rv_eq_iff] + rw [MaxAddDegree.rvRel_iff] + right + constructor + · simp [MaxAddDegree.ofValuation_apply, rvFirstProjectionValuation, + Valuation.one_apply_def] + · simp [MaxAddDegree.ofValuation_apply, rvFirstProjectionValuation, + Valuation.one_apply_def] + +/-- RV-equivalent representatives have the same initial form. -/ +theorem rvFirstProjectionValuation_same_initialForm : + rvFirstProjectionValuation.initialForm (1, 1) = + rvFirstProjectionValuation.initialForm (1, 0) := by + exact rvFirstProjectionValuation.initialForm_eq_of_rvRel + ((MaxAddDegree.rv_eq_iff rvFirstProjectionValuation).mp + rvFirstProjectionValuation_same_rv) + +/-- The RV-to-homogeneous map retains multiplication and the support zero. -/ +theorem rvHomogeneous_support_mul_one : + rvFirstProjectionValuation.rvHomogeneous + (rvFirstProjectionValuation.rv rvSupportElement * + rvFirstProjectionValuation.rv (1, 0)) = 0 := by + rw [rvSupportElement_rv_eq_zero, zero_mul, map_zero] + +def rvTrivialValuation : MaxAddDegree ℚ ℕ := + MaxAddDegree.ofValuation 1 + +instance : rvTrivialValuation.IsMultiplicative := + inferInstanceAs (MaxAddDegree.ofValuation _).IsMultiplicative + +def rvTwoRepresentative : rvTrivialValuation.filtrationLE 0 := + ⟨2, by simp [MaxAddDegree.ofValuation_apply, rvTrivialValuation, Valuation.one_apply_def]⟩ + +def rvThreeRepresentative : rvTrivialValuation.filtrationLE 0 := + ⟨3, by simp [MaxAddDegree.ofValuation_apply, rvTrivialValuation, Valuation.one_apply_def]⟩ + +def rvSixRepresentative : rvTrivialValuation.filtrationLE 0 := + ⟨6, by simp [MaxAddDegree.ofValuation_apply, rvTrivialValuation, Valuation.one_apply_def]⟩ + +/-- Multiplication in the residue ring computes the product of the classes of two and three. -/ +theorem residueRing_two_mul_three : + rvTrivialValuation.componentMk 0 rvTwoRepresentative * + rvTrivialValuation.componentMk 0 rvThreeRepresentative = + rvTrivialValuation.componentMk 0 rvSixRepresentative := by + apply rvTrivialValuation.residueRingHom_injective + rw [map_mul] + rw [MaxAddDegree.residueRingHom_apply, + MaxAddDegree.residueRingHom_apply, MaxAddDegree.residueRingHom_apply, + ← MaxAddDegree.homogeneousMk_apply, ← MaxAddDegree.homogeneousMk_apply, + ← MaxAddDegree.homogeneousMk_apply] + rw [MaxAddDegree.homogeneousMk_mul] + apply congrArg (rvTrivialValuation.homogeneousMk 0) + apply Subtype.ext + norm_num [rvTwoRepresentative, rvThreeRepresentative, rvSixRepresentative] + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Residue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Residue.lean new file mode 100644 index 0000000000..84ec8d7ae8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Residue.lean @@ -0,0 +1,176 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.ResidueMathlib +public import Mathlib.Algebra.Order.Ring.Rat +public import Mathlib.NumberTheory.Padics.PadicNumbers + +import Mathlib.Algebra.Ring.Prod + +/-! +# API checks for the residue map + +The first-projection valuation on `ℚ × ℚ` has a nonzero support ideal. Its residue map kills a +nonzero support element but not an element of value zero, which distinguishes the strictly +negative kernel from the zero ideal. + +The first cancellation fixture uses two representatives of value zero whose sum has bottom value. +A second fixture uses the separated `2`-adic valuation: `2` has the nonbottom value `-1`, and two +copies of the value-zero representative `1` add to it. This distinguishes the strictly negative +ideal from the support ideal and checks additivity across a genuine finite value drop. The root +`LM24` module does not import this client. +-/ + +public noncomputable section + +open scoped DirectSum + +namespace Tests + +def residueFirstProjectionValuation : MaxAddDegree (ℚ × ℚ) ℕ := + MaxAddDegree.ofValuation + ((1 : Valuation ℚ (WithZero (Multiplicative ℕ))).comap (RingHom.fst ℚ ℚ)) + +instance : residueFirstProjectionValuation.IsMultiplicative := + inferInstanceAs (MaxAddDegree.ofValuation _).IsMultiplicative + +def residueSupportElement : residueFirstProjectionValuation.nonpositiveSubring := + ⟨(0, 1), by + rw [MaxAddDegree.mem_nonpositiveSubring_iff] + simp [MaxAddDegree.ofValuation_apply, residueFirstProjectionValuation, + Valuation.one_apply_def]⟩ + +def residueValueZeroElement : residueFirstProjectionValuation.nonpositiveSubring := + ⟨(1, 1), by + rw [MaxAddDegree.mem_nonpositiveSubring_iff] + simp [MaxAddDegree.ofValuation_apply, residueFirstProjectionValuation, + Valuation.one_apply_def]⟩ + +def residuePositiveUnit : residueFirstProjectionValuation.nonpositiveSubring := + ⟨(1, 0), by + rw [MaxAddDegree.mem_nonpositiveSubring_iff] + simp [MaxAddDegree.ofValuation_apply, residueFirstProjectionValuation, + Valuation.one_apply_def]⟩ + +def residueNegativeUnit : residueFirstProjectionValuation.nonpositiveSubring := + ⟨(-1, 0), by + rw [MaxAddDegree.mem_nonpositiveSubring_iff] + simp [MaxAddDegree.ofValuation_apply, residueFirstProjectionValuation, + Valuation.one_apply_def]⟩ + +/-- The residue kernel contains a nonzero element of the original ring. -/ +theorem residueMap_supportElement_eq_zero : + residueFirstProjectionValuation.residueMap residueSupportElement = 0 := by + rw [MaxAddDegree.residueMap_eq_zero_iff] + simp [MaxAddDegree.ofValuation_apply, residueFirstProjectionValuation, + residueSupportElement, Valuation.one_apply_def] + +/-- An element of value zero does not lie in the residue kernel. -/ +theorem residueMap_valueZeroElement_ne_zero : + residueFirstProjectionValuation.residueMap residueValueZeroElement ≠ 0 := by + rw [ne_eq, MaxAddDegree.residueMap_eq_zero_iff] + simp [MaxAddDegree.ofValuation_apply, residueFirstProjectionValuation, + residueValueZeroElement, Valuation.one_apply_def] + +/-- Two value-zero representatives can cancel to an element of strictly lower value. -/ +theorem residueMap_cancellation_fixture : + residueFirstProjectionValuation.residueMap residuePositiveUnit ≠ 0 ∧ + residueFirstProjectionValuation.residueMap residueNegativeUnit ≠ 0 ∧ + residueFirstProjectionValuation.residueMap + (residuePositiveUnit + residueNegativeUnit) = 0 := by + constructor + · rw [ne_eq, MaxAddDegree.residueMap_eq_zero_iff] + simp [MaxAddDegree.ofValuation_apply, residueFirstProjectionValuation, + residuePositiveUnit, Valuation.one_apply_def] + constructor + · rw [ne_eq, MaxAddDegree.residueMap_eq_zero_iff] + simp [MaxAddDegree.ofValuation_apply, residueFirstProjectionValuation, + residueNegativeUnit, Valuation.one_apply_def] + · have hsum : residuePositiveUnit + residueNegativeUnit = 0 := by + apply Subtype.ext + simp [residuePositiveUnit, residueNegativeUnit] + rw [hsum, map_zero] + +/-- The two nonzero residue classes in the cancellation fixture add to zero. -/ +theorem residueMap_cancellation_sum_eq_zero : + residueFirstProjectionValuation.residueMap residuePositiveUnit + + residueFirstProjectionValuation.residueMap residueNegativeUnit = 0 := by + rw [← map_add] + exact residueMap_cancellation_fixture.2.2 + +example (m : ℕ) : Module residueFirstProjectionValuation.ResidueRing + (residueFirstProjectionValuation.Component m) := + inferInstance + +/-- The grade-zero scalar action is the homogeneous product used by LM24. -/ +theorem residueModule_smul_embeds_as_mul (m : ℕ) + (a : residueFirstProjectionValuation.ResidueRing) + (b : residueFirstProjectionValuation.Component m) : + DirectSum.of residueFirstProjectionValuation.Component m (a • b) = + DirectSum.of residueFirstProjectionValuation.Component 0 a * + DirectSum.of residueFirstProjectionValuation.Component m b := + DirectSum.of_zero_smul _ a b + +section Padic + +local instance : Fact (Nat.Prime 2) := ⟨Nat.prime_two⟩ + +abbrev residueTwoAdicValuation : MaxAddDegree ℚ ℤ := + MaxAddDegree.ofValuation (Rat.padicValuation 2) + +def residueTwoAdicOne : residueTwoAdicValuation.nonpositiveSubring := + ⟨1, by simp⟩ + +/-- The element `2` has the nonbottom max-additive value `-1`. -/ +theorem residueTwoAdic_value_two : + residueTwoAdicValuation 2 = ((-1 : ℤ) : WithBot ℤ) := by + rw [MaxAddDegree.ofValuation_apply] + have h := congrArg + (fun z : WithZero (Multiplicative ℤ) ↦ + Multiplicative.toAdd (WithZero.toMulBot z)) + (Rat.padicValuation_self 2) + exact h.trans (by rfl) + +def residueTwoAdicTwo : residueTwoAdicValuation.nonpositiveSubring := + ⟨2, by + rw [MaxAddDegree.mem_nonpositiveSubring_iff, residueTwoAdic_value_two] + simp⟩ + +/-- The strictly negative residue kernel is larger than the support ideal. -/ +theorem residueTwoAdic_two_eq_zero : + residueTwoAdicValuation.residueMap residueTwoAdicTwo = 0 := by + rw [MaxAddDegree.residueMap_eq_zero_iff] + rw [show (residueTwoAdicTwo : ℚ) = 2 from rfl, residueTwoAdic_value_two] + simp + +theorem residueTwoAdic_one_ne_zero : + residueTwoAdicValuation.residueMap residueTwoAdicOne ≠ 0 := by + rw [ne_eq, MaxAddDegree.residueMap_eq_zero_iff] + simp [residueTwoAdicOne] + +/-- +Two value-zero representatives add in the valuation subring to `2`, whose value is strictly +negative and nonbottom; their residue classes therefore sum to zero. +-/ +theorem residueTwoAdic_one_add_one_eq_zero : + residueTwoAdicValuation.residueMap residueTwoAdicOne + + residueTwoAdicValuation.residueMap residueTwoAdicOne = 0 := by + rw [← map_add] + have hsum : residueTwoAdicOne + residueTwoAdicOne = residueTwoAdicTwo := by + apply Subtype.ext + norm_num [residueTwoAdicOne, residueTwoAdicTwo] + rw [hsum, residueTwoAdic_two_eq_zero] + +theorem residueTwoAdic_negativeIdeal_mathlib_bridge : + residueTwoAdicValuation.negativeIdeal = + ((Rat.padicValuation 2).ltIdeal 1).comap + (MaxAddDegree.nonpositiveEquivInteger (Rat.padicValuation 2)).toRingHom := + MaxAddDegree.negativeIdeal_ofValuation_eq_comap_ltIdeal (Rat.padicValuation 2) + +end Padic + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Blueprint.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Blueprint.lean new file mode 100644 index 0000000000..04f2402f65 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Blueprint.lean @@ -0,0 +1,214 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +module + +public import Lean +public meta import Batteries.Lean.NameMapAttribute + +/-! # Blueprint -/ + +public meta section + +open Lean Elab Command + +namespace ConwayRefinement.Blueprint + +/-- Mathematical phases used by the generated proof map. -/ +meta def phases : Array String := #[ + "Algebraic and ordinal preliminaries", + "Ordinal value and degree", + "Cantor–Bendixson ranks of supports", + "Algebraic independence in graded rings", + "Translated truncations", + "Limit ordinals in the degree induction", + "Principal RV-elements", + "Polynomial presentations", + "Primality and factorisation for real exponents", + "Finitely many Archimedean classes", + "Refinement over Archimedean classes", + "A cut criterion for Cauchy completeness", + "Bounded generalised-power-series integer parts", + "Surreal numbers and omnific integers", +] + +/-- The mathematical account attached to one selected Lean declaration. -/ +structure Node where + name : Name + label : String + phase : String + title : String + statement : String + proof : String + highlight : Bool := false +deriving Inhabited, ToExpr + +/-- Checked blueprint metadata, persisted with each compiled module. -/ +initialize nodeExt : NameMapExtension Node ← registerNameMapExtension Node + +syntax blueprintPhaseOption := "(" &"phase" " := " str ")" +syntax blueprintTitleOption := "(" &"title" " := " str ")" +syntax blueprintStatementOption := "(" &"statement" " := " plainDocComment ")" +syntax blueprintProofOption := "(" &"proof" " := " plainDocComment ")" +syntax blueprintHighlightOption := "(" &"highlight" ")" +syntax blueprintOptions := + str ppSpace blueprintPhaseOption ppSpace blueprintTitleOption + ppSpace blueprintStatementOption ppSpace blueprintProofOption + (ppSpace blueprintHighlightOption)? + +/-- Internal attribute implementing proof-map metadata. -/ +syntax (name := conwayRefinementBlueprint) "conway_refinement_blueprint" ppSpace + blueprintOptions : attr + +/-- Select a declaration for the mathematical proof map. -/ +macro "blueprint" ppSpace options:blueprintOptions : attr => + `(attr| conway_refinement_blueprint $options:blueprintOptions) + +def resultKindForLabel (label : String) : CoreM Unit := do + unless #["def:", "thm:", "lem:", "prop:", "cor:", "fact:"].any + (fun resultPrefix => label.startsWith resultPrefix) do + throwError "blueprint label {label} has no recognized mathematical result kind" + +def elaborateNode (name : Name) : Syntax → CoreM Node + | `(attr| conway_refinement_blueprint $label:str + (phase := $phase:str) + (title := $title:str) + (statement := $statement) + (proof := $proof) + $[$highlight:blueprintHighlightOption]?) => do + let label := label.getString + let phase := phase.getString + unless phases.contains phase do + throwError "unknown proof-map phase {phase}" + resultKindForLabel label + return { + name + label + phase + title := title.getString + statement := (← getDocStringText statement).trimAscii.copy + proof := (← getDocStringText proof).trimAscii.copy + highlight := highlight.isSome + } + | _ => throwUnsupportedSyntax + +initialize registerBuiltinAttribute { + name := `conwayRefinementBlueprint + descr := "selects a declaration for the mathematical proof map" + applicationTime := .afterCompilation + add := fun name stx kind => do + unless kind == AttributeKind.global do + throwError "invalid attribute 'blueprint', must be global" + nodeExt.add name (← elaborateNode name stx) +} + +private structure CollectContext where + environment : Environment + root : Name + +private structure CollectState where + visited : NameSet := {} + selected : NameSet := {} + +private abbrev CollectM := ReaderT CollectContext (StateM CollectState) + +private partial def collectSelected (name : Name) : CollectM Unit := do + let state ← get + unless state.visited.contains name do + modify fun state => { state with visited := state.visited.insert name } + let { environment, root } ← read + if name != root && (nodeExt.find? environment name).isSome then + modify fun state => { state with selected := state.selected.insert name } + else + let collectExpression (expression : Expr) : CollectM Unit := + expression.getUsedConstants.forM collectSelected + match environment.find? name with + | some (.axiomInfo _) => pure () + | some (.defnInfo value) => collectExpression value.type *> collectExpression value.value + | some (.thmInfo value) => collectExpression value.type *> collectExpression value.value + | some (.opaqueInfo value) => collectExpression value.type *> collectExpression value.value + | some (.quotInfo _) => pure () + | some (.ctorInfo value) => collectExpression value.type + | some (.recInfo value) => collectExpression value.type + | some (.inductInfo value) => + collectExpression value.type *> value.ctors.forM collectSelected + | none => pure () + +private def declarationType : ConstantInfo → Expr + | .axiomInfo value | .defnInfo value | .thmInfo value | .opaqueInfo value | + .ctorInfo value | .recInfo value | .inductInfo value => value.type + | .quotInfo value => value.type + +private def declarationValue? : ConstantInfo → Option Expr + | .defnInfo value => some value.value + | .thmInfo value => some value.value + | .opaqueInfo value => some value.value + | _ => none + +private def collectDependencies (environment : Environment) (root : Name) : + NameSet × NameSet := Id.run do + let some info := environment.find? root | return ({}, {}) + let mut statementState : CollectState := {} + for name in (declarationType info).getUsedConstants do + (_, statementState) := ((collectSelected name).run { environment, root }).run statementState + let mut proofState := statementState + if let some value := declarationValue? info then + for name in value.getUsedConstants do + (_, proofState) := ((collectSelected name).run { environment, root }).run proofState + return (statementState.selected, proofState.selected \ statementState.selected) + +private def namesJson (names : NameSet) : Json := + .arr <| names.toArray.qsort Name.lt |>.map fun name => .str name.toString + +private def positionJson (position : Position) : Json := Json.mkObj [ + ("line", position.line), + ("column", position.column) +] + +private def rangeJson (range : DeclarationRange) : Json := Json.mkObj [ + ("start", positionJson range.pos), + ("end", positionJson range.endPos) +] + +private def moduleOf (environment : Environment) (name : Name) : Name := + match environment.getModuleIdxFor? name with + | some index => environment.allImportedModuleNames[index.toNat]! + | none => environment.header.mainModule + +private def nodeJson (node : Node) : CoreM Json := do + let environment ← getEnv + let moduleName := moduleOf environment node.name + let range ← findDeclarationRanges? node.name + let (statementDependencies, proofDependencies) := + collectDependencies environment node.name + return Json.mkObj [ + ("name", node.name.toString), + ("label", node.label), + ("phase", node.phase), + ("title", node.title), + ("statement", node.statement), + ("proof", node.proof), + ("highlight", node.highlight), + ("module", moduleName.toString), + ("source", s!"{moduleName.toString.replace "." "/"}.lean"), + ("range", range.map (fun ranges => rangeJson ranges.range) |>.getD Json.null), + ("statementDependencies", namesJson statementDependencies), + ("proofDependencies", namesJson proofDependencies) + ] + +private def blueprintJson : CoreM Json := do + let environment ← getEnv + let entries := (nodeExt.getState environment).get.toList.toArray + let nodes := entries.map (·.2) |>.qsort fun left right => + left.name.toString < right.name.toString + return .arr (← nodes.mapM nodeJson) + +/-- Write checked blueprint metadata for the currently imported modules. -/ +elab "#write_blueprint_data" path:str : command => do + let json ← liftCoreM blueprintJson + IO.FS.writeFile path.getString json.pretty + +end ConwayRefinement.Blueprint diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Data.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Data.lean new file mode 100644 index 0000000000..cca77c0212 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Data.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset.lean new file mode 100644 index 0000000000..8675a693a3 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.SelectionComplexity +import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.Tests + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/SelectionComplexity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/SelectionComplexity.lean new file mode 100644 index 0000000000..32afd8f32f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/SelectionComplexity.lean @@ -0,0 +1,405 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.SetTheory.Cardinal.Order +public import Mathlib.SetTheory.Ordinal.Basic +public import Mathlib.Data.Multiset.DershowitzManna +import Mathlib.Data.Finset.Max +import Lean.Elab.Tactic.Omega + +/-! +# Selection and decreasing multiset complexity + +Selection minimizes an ordinal priority, then maximizes an ordinal weight, with a fixed +well-order resolving ties. Complexity records the weights of distinct members at least as +heavy as the selection, followed by the selected multiplicity. Thus duplicating other members +does not increase the first component. + +Removing one selected copy, doubling the other multiplicities, and adjoining lighter members +of no smaller priority strictly decreases this well-founded complexity. The argument abstracts +the finite-expression reduction in Berarducci, Definitions 9.1--9.3 and Lemma 9.5; it assumes +no series, ring, or valuation. The first component uses the Mathlib Dershowitz--Manna relation. +-/ + +public noncomputable section +universe u v +namespace Multiset + +/-- Ordinal priorities and weights for selection in a finite multiset. -/ +structure SelectionWeights (α : Type v) where + priority : α → Ordinal.{u} + weight : α → Ordinal.{u} + +namespace SelectionWeights +variable {α : Type v} (s : SelectionWeights.{u, v} α) + +/-- A member of least priority, greatest weight among those, and least in a fixed well-order. -/ +structure IsSelected (w : Multiset α) (x : α) : Prop where + mem : x ∈ w + min_priority : ∀ y ∈ w, s.priority x ≤ s.priority y + max_weight : ∀ y ∈ w, s.priority y = s.priority x → + s.weight y ≤ s.weight x + least : ∀ y ∈ w, s.priority y = s.priority x → s.weight y = s.weight x → + ¬ WellOrderingRel y x + +/-- Every nonempty finite multiset has a unique selected member. -/ +theorem existsUnique_isSelected {w : Multiset α} (hw : w ≠ 0) : + ∃! x, s.IsSelected w x := by + classical + have hne : w.toFinset.Nonempty := by + rw [Finset.nonempty_iff_ne_empty] + intro h + exact hw (Multiset.toFinset_eq_empty.mp h) + obtain ⟨x₀, hx₀, hx₀min⟩ := + w.toFinset.exists_min_image (fun y ↦ s.priority y) hne + set A := w.toFinset.filter fun y ↦ s.priority y = s.priority x₀ with hAdef + have hAne : A.Nonempty := ⟨x₀, by simp [hAdef, hx₀]⟩ + obtain ⟨x₁, hx₁, hx₁max⟩ := A.exists_max_image (fun y ↦ s.weight y) hAne + set B := A.filter fun y ↦ s.weight y = s.weight x₁ with hBdef + have hBne : (↑B : Set α).Nonempty := + ⟨x₁, by simp [hBdef, hx₁]⟩ + have hwf : WellFounded (WellOrderingRel (α := α)) := + (WellOrderingRel.isWellOrder (α := α)).wf + set x := hwf.min _ hBne with hxdef + have hxB : x ∈ B := hwf.min_mem _ hBne + have hxA : x ∈ A := (Finset.mem_filter.mp hxB).1 + have hxw : x ∈ w := Multiset.mem_toFinset.mp (Finset.mem_filter.mp hxA).1 + have hxprin : s.priority x = s.priority x₀ := (Finset.mem_filter.mp hxA).2 + have hxord : s.weight x = s.weight x₁ := (Finset.mem_filter.mp hxB).2 + refine ⟨x, ⟨hxw, ?_, ?_, ?_⟩, ?_⟩ + · intro y hy + rw [hxprin] + exact hx₀min y (Multiset.mem_toFinset.mpr hy) + · intro y hy hyprin + rw [hxord] + refine hx₁max y ?_ + simp only [hAdef, Finset.mem_filter, Multiset.mem_toFinset] + exact ⟨hy, hyprin.trans hxprin⟩ + · intro y hy hyprin hyord + have hyB : y ∈ (↑B : Set α) := by + simp only [hBdef, hAdef, Finset.mem_coe, Finset.mem_filter, Multiset.mem_toFinset] + exact ⟨⟨hy, hyprin.trans hxprin⟩, hyord.trans hxord⟩ + exact hwf.not_lt_min _ hyB + · rintro y hy + have hsel : s.IsSelected w x := by + refine ⟨hxw, ?_, ?_, ?_⟩ + · intro z hz + rw [hxprin] + exact hx₀min z (Multiset.mem_toFinset.mpr hz) + · intro z hz hzprin + rw [hxord] + refine hx₁max z ?_ + simp only [hAdef, Finset.mem_filter, Multiset.mem_toFinset] + exact ⟨hz, hzprin.trans hxprin⟩ + · intro z hz hzprin hzord + have hzB : z ∈ (↑B : Set α) := by + simp only [hBdef, hAdef, Finset.mem_coe, Finset.mem_filter, Multiset.mem_toFinset] + exact ⟨⟨hz, hzprin.trans hxprin⟩, hzord.trans hxord⟩ + exact hwf.not_lt_min _ hzB + have hprin : s.priority y = s.priority x := + le_antisymm (hy.min_priority x hxw) (hsel.min_priority y hy.mem) + have hord : s.weight y = s.weight x := + le_antisymm (hsel.max_weight y hy.mem hprin) (hy.max_weight x hxw hprin.symm) + rcases trichotomous_of + (WellOrderingRel : α → _ → Prop) y x with h | h | h + · exact absurd h (hsel.least y hy.mem hprin hord) + · exact h + · exact absurd h (hy.least x hxw hprin.symm hord.symm) + +/-- The selected member of a nonempty multiset. -/ +noncomputable def selected (w : Multiset α) (hw : w ≠ 0) : + α := + (s.existsUnique_isSelected hw).choose + +theorem isSelected_selected (w : Multiset α) (hw : w ≠ 0) : + s.IsSelected w (s.selected w hw) := + (s.existsUnique_isSelected hw).choose_spec.1 + +theorem eq_selected_of_isSelected {w : Multiset α} (hw : w ≠ 0) + {x : α} (hx : s.IsSelected w x) : x = s.selected w hw := + (s.existsUnique_isSelected hw).choose_spec.2 x hx + +theorem selected_singleton (x : α) : + s.selected {x} (by simp) = x := by + refine (s.eq_selected_of_isSelected (by simp) ⟨by simp, ?_, ?_, ?_⟩).symm + · intro y hy + rw [Multiset.mem_singleton.mp hy] + · intro y hy _ + rw [Multiset.mem_singleton.mp hy] + · intro y hy _ _ + rw [Multiset.mem_singleton.mp hy] + exact irrefl_of (WellOrderingRel : α → _ → Prop) x + +open Classical in +/-- The multiplicity of the selected member. -/ +noncomputable def selectedExponent (w : Multiset α) (hw : w ≠ 0) : ℕ := + w.count (s.selected w hw) + +theorem selected_cons_of_mem {w : Multiset α} (hw : w ≠ 0) + {y : α} (hy : y ∈ w) : + s.selected (y ::ₘ w) Multiset.cons_ne_zero = s.selected w hw := by + have hmem : ∀ z ∈ y ::ₘ w, z ∈ w := + fun z hz ↦ (Multiset.mem_cons.mp hz).elim (fun h ↦ h ▸ hy) id + have hsel := s.isSelected_selected w hw + refine (s.eq_selected_of_isSelected Multiset.cons_ne_zero ⟨Multiset.mem_cons_of_mem hsel.mem, + fun z hz ↦ hsel.min_priority z (hmem z hz), + fun z hz ↦ hsel.max_weight z (hmem z hz), + fun z hz ↦ hsel.least z (hmem z hz)⟩).symm + +open Classical in +theorem selectedExponent_eq_count (w : Multiset α) (hw : w ≠ 0) : + s.selectedExponent w hw = w.count (s.selected w hw) := (rfl) + +open Classical in +/-- The weights of distinct members at least as heavy as the selected member. -/ +noncomputable def relevantValues (w : Multiset α) (hw : w ≠ 0) : Multiset Ordinal := + (w.toFinset.filter fun y ↦ s.weight (s.selected w hw) ≤ s.weight y).val.map + fun y ↦ s.weight y + +open Classical in +theorem relevantValues_eq_map (w : Multiset α) (hw : w ≠ 0) : + s.relevantValues w hw = (w.toFinset.filter fun y ↦ + s.weight (s.selected w hw) ≤ s.weight y).val.map fun y ↦ s.weight y := + (rfl) + +open Classical in +/-- Equal selections and equal relevant members give the same relevant-weight multiset. -/ +theorem relevantValues_congr {w w' : Multiset α} (hw : w ≠ 0) (hw' : w' ≠ 0) + (hsel : s.selected w hw = s.selected w' hw') + (hmem : ∀ y, s.weight (s.selected w hw) ≤ s.weight y → (y ∈ w ↔ y ∈ w')) : + s.relevantValues w hw = s.relevantValues w' hw' := by + have hfilter : (w.toFinset.filter fun y ↦ s.weight (s.selected w hw) ≤ s.weight y) + = w'.toFinset.filter fun y ↦ s.weight (s.selected w hw) ≤ s.weight y := by + ext y + simp only [Finset.mem_filter, Multiset.mem_toFinset] + exact and_congr_left fun h ↦ hmem y h + rw [relevantValues, relevantValues, ← hsel, hfilter] + +/-- The distinct relevant weights, followed by the selected multiplicity. -/ +noncomputable def complexity (w : Multiset α) (hw : w ≠ 0) : Multiset Ordinal × ℕ := + (s.relevantValues w hw, s.selectedExponent w hw) + +/-- Lexicographic decrease of relevant weights in the Dershowitz--Manna order, then multiplicity. -/ +def ComplexityLT : (Multiset Ordinal × ℕ) → (Multiset Ordinal × ℕ) → Prop := + Prod.Lex Multiset.IsDershowitzMannaLT (· < ·) + +/-- The complexity order is well-founded. -/ +theorem wellFounded_complexityLT : WellFounded (ComplexityLT) := + WellFounded.prod_lex Multiset.wellFounded_isDershowitzMannaLT wellFounded_lt + +theorem complexityLT_of_relevantValues {w w' : Multiset α} {hw : w ≠ 0} {hw' : w' ≠ 0} + {X Y Z : Multiset Ordinal} (hZ : Z ≠ 0) (hw'X : s.relevantValues w' hw' = X + Y) + (hwX : s.relevantValues w hw = X + Z) (hYZ : ∀ y ∈ Y, ∃ z ∈ Z, y < z) : + ComplexityLT (s.complexity w' hw') (s.complexity w hw) := + Prod.Lex.left _ _ ⟨X, Y, Z, hZ, hw'X, hwX, hYZ⟩ + +theorem complexityLT_of_selectedExponent {w w' : Multiset α} {hw : w ≠ 0} {hw' : w' ≠ 0} + (h₁ : s.relevantValues w' hw' = s.relevantValues w hw) + (h₂ : s.selectedExponent w' hw' < s.selectedExponent w hw) : + ComplexityLT (s.complexity w' hw') (s.complexity w hw) := by + rw [complexity, complexity, h₁] + exact Prod.Lex.right _ h₂ + +open Classical in +/-- The multiset remaining after removing every copy of the selected member. -/ +noncomputable def unselected (w : Multiset α) (hw : w ≠ 0) : Multiset α := + w.filter (· ≠ s.selected w hw) + +open Classical in +theorem unselected_eq (w : Multiset α) (hw : w ≠ 0) : + s.unselected w hw = w.filter (· ≠ s.selected w hw) := (rfl) + +open Classical in +theorem mem_unselected {w : Multiset α} {hw : w ≠ 0} + {y : α} : + y ∈ s.unselected w hw ↔ y ∈ w ∧ y ≠ s.selected w hw := by + rw [unselected] + exact Multiset.mem_filter + +open Classical in +/-- Remove one selected copy, double all other copies, and adjoin the replacement multiset. -/ +noncomputable def reduced (w : Multiset α) (hw : w ≠ 0) (t : Multiset α) : + Multiset α := + t + Multiset.replicate (s.selectedExponent w hw - 1) (s.selected w hw) + + (s.unselected w hw + s.unselected w hw) + +theorem reduced_eq (w : Multiset α) (hw : w ≠ 0) (t : Multiset α) : + s.reduced w hw t = t + Multiset.replicate (s.selectedExponent w hw - 1) (s.selected w hw) + + (s.unselected w hw + s.unselected w hw) := (rfl) + +theorem mem_reduced {w : Multiset α} {hw : w ≠ 0} {t : Multiset α} + {y : α} : + y ∈ s.reduced w hw t ↔ y ∈ t ∨ (s.selectedExponent w hw - 1 ≠ 0 ∧ y = s.selected w hw) ∨ + (y ∈ w ∧ y ≠ s.selected w hw) := by + rw [reduced] + simp only [Multiset.mem_add, Multiset.mem_replicate, s.mem_unselected, or_self, or_assoc] + +theorem one_le_selectedExponent (w : Multiset α) (hw : w ≠ 0) : + 1 ≤ s.selectedExponent w hw := by + classical + rw [s.selectedExponent_eq_count] + exact Multiset.count_pos.mpr (s.isSelected_selected w hw).mem + +open Classical in +/-- A replacement excluding the selected member reduces its multiplicity by one. -/ +theorem count_selected_reduced {w : Multiset α} {hw : w ≠ 0} {t : Multiset α} + (ht : s.selected w hw ∉ t) : + Multiset.count (s.selected w hw) (s.reduced w hw t) = s.selectedExponent w hw - 1 := by + rw [reduced] + simp only [Multiset.count_add, Multiset.count_replicate_self] + rw [Multiset.count_eq_zero.mpr ht, + Multiset.count_eq_zero.mpr fun h ↦ (s.mem_unselected.mp h).2 rfl] + omega + +open Classical in +/-- A member distinct from the selection and absent from the replacement is doubled. -/ +theorem count_reduced_of_ne {w : Multiset α} {hw : w ≠ 0} {t : Multiset α} + {y : α} (hy : y ≠ s.selected w hw) (hyt : y ∉ t) : + Multiset.count y (s.reduced w hw t) = 2 * Multiset.count y w := by + rw [reduced, unselected] + simp only [Multiset.count_add, Multiset.count_replicate, Multiset.count_filter, + if_neg (Ne.symm hy), if_pos hy, Multiset.count_eq_zero.mpr hyt] + omega + +theorem selected_mem_reduced {w : Multiset α} {hw : w ≠ 0} {t : Multiset α} + (hk : 1 < s.selectedExponent w hw) : s.selected w hw ∈ s.reduced w hw t := + s.mem_reduced.mpr (Or.inr (Or.inl ⟨by omega, rfl⟩)) + +theorem selectedExponent_lt_of_isSelected {w : Multiset α} {hw : w ≠ 0} + {t : Multiset α} (hw₂ : s.reduced w hw t ≠ 0) + (ht : s.selected w hw ∉ t) (hsel : s.selected (s.reduced w hw t) hw₂ = s.selected w hw) : + s.selectedExponent (s.reduced w hw t) hw₂ < s.selectedExponent w hw := by + rw [s.selectedExponent_eq_count, hsel, s.count_selected_reduced ht] + have := s.one_le_selectedExponent w hw + omega + +/-- If a selected copy remains, lighter replacements of no smaller priority preserve selection. -/ +theorem isSelected_reduced (w : Multiset α) (hw : w ≠ 0) (t : Multiset α) + (ht : ∀ u ∈ t, s.weight u < s.weight (s.selected w hw)) + (htp : ∀ u ∈ t, s.priority (s.selected w hw) ≤ s.priority u) + (hk : 1 < s.selectedExponent w hw) : + s.IsSelected (s.reduced w hw t) (s.selected w hw) := by + have hsel := s.isSelected_selected w hw + refine ⟨s.mem_reduced.mpr (Or.inr (Or.inl ⟨by omega, rfl⟩)), ?_, ?_, ?_⟩ + · intro y hy + rcases s.mem_reduced.mp hy with h | ⟨-, rfl⟩ | ⟨hyw, -⟩ + · exact htp y h + · exact le_rfl + · exact hsel.min_priority y hyw + · intro y hy hyp + rcases s.mem_reduced.mp hy with h | ⟨-, rfl⟩ | ⟨hyw, -⟩ + · exact (ht y h).le + · exact le_rfl + · exact hsel.max_weight y hyw hyp + · intro y hy hyp hyo + rcases s.mem_reduced.mp hy with h | ⟨-, rfl⟩ | ⟨hyw, -⟩ + · exact absurd hyo (ht y h).ne + · exact irrefl_of (WellOrderingRel : α → _ → Prop) _ + · exact hsel.least y hyw hyp hyo + +/-- Deleting the selection and introducing only lighter new members strictly lowers complexity. -/ +theorem complexityLT_of_forall_lt_or_mem {w w' : Multiset α} (hw : w ≠ 0) (hw' : w' ≠ 0) + (h : ∀ u ∈ w', s.weight u < s.weight (s.selected w hw) ∨ + (u ∈ w ∧ u ≠ s.selected w hw)) : + ComplexityLT (s.complexity w' hw') (s.complexity w hw) := by + classical + set f : α → Ordinal := fun y ↦ s.weight y with hf + set S : Finset α := w'.toFinset.filter + (fun y ↦ s.weight (s.selected w' hw') ≤ s.weight y) with hS + set T : Finset α := + w.toFinset.filter (fun y ↦ s.weight (s.selected w hw) ≤ s.weight y) with hT + have hxT : s.selected w hw ∈ T := + Finset.mem_filter.mpr ⟨Multiset.mem_toFinset.mpr (s.isSelected_selected w hw).mem, le_rfl⟩ + set R : Finset α := T.erase (s.selected w hw) with hR + have hkey : ∀ u ∈ S, u ∉ R → s.weight u < s.weight (s.selected w hw) := by + intro u hu huR + have humem : u ∈ w' := Multiset.mem_toFinset.mp (Finset.mem_filter.mp hu).1 + rcases h u humem with hlt | ⟨huw, hux⟩ + · exact hlt + · rw [hR, Finset.mem_erase] at huR + have hTu : u ∉ T := fun hmem ↦ huR ⟨hux, hmem⟩ + refine lt_of_not_ge fun hle ↦ hTu ?_ + rw [hT] + exact Finset.mem_filter.mpr ⟨Multiset.mem_toFinset.mpr huw, hle⟩ + have hsplit : ∀ A B : Finset α, + A.val = (A ∩ B).val + (A \ B).val := by + intro A B + rw [← Finset.filter_mem_eq_inter, Finset.sdiff_eq_filter, Finset.filter_val, + Finset.filter_val] + exact (Multiset.filter_add_not _ _).symm + refine s.complexityLT_of_relevantValues (X := (S ∩ R).val.map f) (Y := (S \ R).val.map f) + (Z := f (s.selected w hw) ::ₘ (R \ S).val.map f) (by simp) ?_ ?_ ?_ + · rw [relevantValues_eq_map, ← hS, hsplit S R, Multiset.map_add] + · rw [relevantValues_eq_map, ← hT, ← Multiset.cons_erase (s := T.val) hxT, + ← Finset.erase_val, ← hR, Multiset.map_cons, hsplit R S, Multiset.map_add, + Finset.inter_comm, Multiset.add_cons] + · intro y hy + obtain ⟨u, hu, rfl⟩ := Multiset.mem_map.mp hy + rw [Finset.mem_val, Finset.mem_sdiff] at hu + exact ⟨f (s.selected w hw), Multiset.mem_cons_self _ _, + hkey u hu.1 hu.2⟩ + +/-- Removing every selected copy strictly lowers complexity when the remainder is nonempty. -/ +theorem complexityLT_unselected {w : Multiset α} (hw : w ≠ 0) + (hr : s.unselected w hw ≠ 0) : + ComplexityLT (s.complexity (s.unselected w hw) hr) (s.complexity w hw) := + s.complexityLT_of_forall_lt_or_mem hw hr fun _ hu ↦ Or.inr (s.mem_unselected.mp hu) + +/-- Replacing one selected copy by lighter members of no smaller priority strictly lowers +complexity, even while doubling every other member. -/ +theorem complexityLT_reduced (w : Multiset α) (hw : w ≠ 0) (t : Multiset α) + (ht : ∀ u ∈ t, s.weight u < s.weight (s.selected w hw)) + (htp : ∀ u ∈ t, s.priority (s.selected w hw) ≤ s.priority u) + (hw₂ : s.reduced w hw t ≠ 0) : + ComplexityLT (s.complexity (s.reduced w hw t) hw₂) (s.complexity w hw) := by + classical + have htmem : s.selected w hw ∉ t := fun h ↦ absurd (ht _ h) (lt_irrefl _) + rcases lt_or_ge 1 (s.selectedExponent w hw) with hk | hk + · -- Case 1: the selected factor survives, so only its exponent moves. + have hsel : s.selected (s.reduced w hw t) hw₂ = s.selected w hw := + (s.eq_selected_of_isSelected hw₂ (s.isSelected_reduced w hw t ht htp hk)).symm + refine s.complexityLT_of_selectedExponent ?_ + (s.selectedExponent_lt_of_isSelected hw₂ htmem hsel) + refine s.relevantValues_congr hw₂ hw hsel fun y hy ↦ ?_ + rw [hsel] at hy + constructor + · intro hmem + rcases s.mem_reduced.mp hmem with hmem | ⟨-, rfl⟩ | ⟨hmem, -⟩ + · exact absurd hy (not_le.mpr (ht y hmem)) + · exact (s.isSelected_selected w hw).mem + · exact hmem + · intro hmem + by_cases hyx : y = s.selected w hw + · exact s.mem_reduced.mpr (Or.inr (Or.inl ⟨by omega, hyx⟩)) + · exact s.mem_reduced.mpr (Or.inr (Or.inr ⟨hmem, hyx⟩)) + · -- Case 2: the selected factor disappears, and its value is replaced by smaller ones. + have hk1 : s.selectedExponent w hw - 1 = 0 := by + have := s.one_le_selectedExponent w hw + omega + refine s.complexityLT_of_forall_lt_or_mem hw hw₂ fun u hu ↦ ?_ + rcases s.mem_reduced.mp hu with hmem | ⟨hne, -⟩ | hmem + · exact Or.inl (ht u hmem) + · exact absurd hk1 hne + · exact Or.inr hmem + +/-- The selected copies and the remaining factors partition the original multiset. -/ +theorem replicate_selectedExponent_add_unselected (w : Multiset α) (hw : w ≠ 0) : + Multiset.replicate (s.selectedExponent w hw) (s.selected w hw) + s.unselected w hw = w := by + classical + refine Multiset.ext.mpr fun y ↦ ?_ + rw [Multiset.count_add, s.unselected_eq, Multiset.count_replicate, Multiset.count_filter] + by_cases hy : y = s.selected w hw + · subst hy + rw [if_pos rfl, if_neg (fun h ↦ h rfl), add_zero, s.selectedExponent_eq_count] + · rw [if_neg (Ne.symm hy), if_pos hy, zero_add] + +/-- The complexity consists of the relevant distinct-factor weights and selected multiplicity. -/ +theorem complexity_eq (w : Multiset α) (hw : w ≠ 0) : + s.complexity w hw = (s.relevantValues w hw, s.selectedExponent w hw) := (rfl) + +end SelectionWeights +end Multiset diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/Tests.lean new file mode 100644 index 0000000000..522d66f96d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/Tests.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.Tests.SelectionComplexity + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/Tests/SelectionComplexity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/Tests/SelectionComplexity.lean new file mode 100644 index 0000000000..602e0e4eab --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/Tests/SelectionComplexity.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module +public import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.SelectionComplexity +import Mathlib.Tactic.Tauto + +/-! +# Distinct-factor complexity checks + +The fixture separates the intended first component from the tempting wrong version that +counts every occurrence: the number of factors grows from three to four, but distinct +relevant weights remain unchanged and the selected multiplicity falls. A second check removes +the selected member entirely. Both use only the compiled public selection API. +-/ + +public noncomputable section +namespace Tests.Selection +open Multiset + +/-- Lower priority selects 1 over the heavier member 2. -/ +def weights : SelectionWeights.{0, 0} ℕ where + priority n := if n = 2 then 1 else 0 + weight n := n + 1 + +private theorem selected_pair : + weights.selected ((1 ::ₘ {2}) : Multiset ℕ) (by simp) = 1 := by + symm + apply weights.eq_selected_of_isSelected + constructor + · simp + · intro y hy + simp only [mem_cons, mem_singleton] at hy + rcases hy with rfl | rfl <;> simp [weights] + · intro y hy hp + simp only [mem_cons, mem_singleton] at hy + rcases hy with rfl | rfl <;> simp_all [weights] + · intro y hy hp _ + simp only [mem_cons, mem_singleton] at hy + rcases hy with rfl | rfl + · exact irrefl_of (WellOrderingRel : ℕ → ℕ → Prop) 1 + · simp [weights] at hp + +private theorem selected_triple : + weights.selected ((1 ::ₘ 1 ::ₘ {2}) : Multiset ℕ) (by simp) = 1 := by + rw [weights.selected_cons_of_mem (by simp) (by simp : 1 ∈ ((1 ::ₘ {2}) : Multiset ℕ))] + exact selected_pair + +/-- Duplicating the heavier, higher-priority member does not change distinct relevant weights. +The selected multiplicity decreases while the total number of factors increases. -/ +theorem multiplicity_drop : + weights.reduced ((1 ::ₘ 1 ::ₘ {2}) : Multiset ℕ) (by simp) {0} = (0 ::ₘ 1 ::ₘ 2 ::ₘ {2}) ∧ + weights.relevantValues ((1 ::ₘ 1 ::ₘ {2}) : Multiset ℕ) (by simp) = + weights.relevantValues ((0 ::ₘ 1 ::ₘ 2 ::ₘ {2}) : Multiset ℕ) (by simp) ∧ + SelectionWeights.ComplexityLT + (weights.complexity ((0 ::ₘ 1 ::ₘ 2 ::ₘ {2}) : Multiset ℕ) (by simp)) + (weights.complexity ((1 ::ₘ 1 ::ₘ {2}) : Multiset ℕ) (by simp)) := by + have hred : weights.reduced ((1 ::ₘ 1 ::ₘ {2}) : Multiset ℕ) (by simp) {0} = + (0 ::ₘ 1 ::ₘ 2 ::ₘ {2}) := by + rw [weights.reduced_eq, weights.selectedExponent_eq_count, weights.unselected_eq, + selected_triple] + simp [Multiset.filter_singleton, Multiset.cons_swap] + have ht : ∀ u ∈ ({0} : Multiset ℕ), weights.weight u < + weights.weight (weights.selected ((1 ::ₘ 1 ::ₘ {2}) : Multiset ℕ) (by simp)) := by + rw [selected_triple] + simp [weights] + have hp : ∀ u ∈ ({0} : Multiset ℕ), + weights.priority (weights.selected ((1 ::ₘ 1 ::ₘ {2}) : Multiset ℕ) (by simp)) ≤ + weights.priority u := by + rw [selected_triple] + simp [weights] + refine ⟨hred, ?_, ?_⟩ + · have hsel := weights.isSelected_reduced ((1 ::ₘ 1 ::ₘ {2}) : Multiset ℕ) (by simp) {0} + ht hp (by rw [weights.selectedExponent_eq_count, selected_triple]; simp) + rw [hred, selected_triple] at hsel + have hs := weights.eq_selected_of_isSelected (by simp) hsel + apply weights.relevantValues_congr (by simp) (by simp) (selected_triple.trans hs) + intro y hy + rw [selected_triple] at hy + simp only [weights] at hy + simp only [mem_cons, mem_singleton] + constructor + · tauto + · rintro (rfl | rfl | rfl | rfl) + · simp at hy + all_goals simp + · simpa only [hred] using weights.complexityLT_reduced ((1 ::ₘ 1 ::ₘ {2}) : Multiset ℕ) + (by simp) {0} ht hp (by rw [hred]; simp) + +/-- Once the selected copy disappears, the first complexity component decreases. -/ +theorem selection_disappears : + SelectionWeights.ComplexityLT + (weights.complexity ((0 ::ₘ 2 ::ₘ {2}) : Multiset ℕ) (by simp)) + (weights.complexity ((1 ::ₘ {2}) : Multiset ℕ) (by simp)) := by + have hred : weights.reduced ((1 ::ₘ {2}) : Multiset ℕ) (by simp) {0} = (0 ::ₘ 2 ::ₘ {2}) := by + rw [weights.reduced_eq, weights.selectedExponent_eq_count, weights.unselected_eq, + selected_pair] + simp [Multiset.filter_singleton, Multiset.cons_swap] + simpa only [hred] using weights.complexityLT_reduced ((1 ::ₘ {2}) : Multiset ℕ) + (by simp) {0} (by rw [selected_pair]; simp [weights]) (by rw [selected_pair]; simp [weights]) + (by rw [hred]; simp) + +end Tests.Selection diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Examples.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Examples.lean new file mode 100644 index 0000000000..b31b5eb89f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Examples.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger.lean new file mode 100644 index 0000000000..13c61a8013 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoNormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowNormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.ZFCDegreeTwoPrime + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/DegreeTwoNormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/DegreeTwoNormalForm.lean new file mode 100644 index 0000000000..da83183e4e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/DegreeTwoNormalForm.lean @@ -0,0 +1,175 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Data.Prod.Lex +public import Mathlib.SetTheory.Ordinal.Arithmetic +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic + +/-! +# The normal form of a degree-two omnific integer + +The nonconstant exponents of the explicit element are + +`1 / (m + 1) + 1 / ((m + 1) * (m + 2) * (n + 1))`, + +for `m n : ℕ`, and every displayed coefficient is one. For fixed `m` these exponents decrease to +`1 / (m + 1)`; the rows themselves decrease to zero. The final constant term is also one. + +The construction is universe-polymorphic: the normal form is written in the surreal numbers of +every universe `u`. Its support order type and primeness are stated in `DegreeTwoPrime`. +-/ + +universe u + +@[expose] public noncomputable section + +namespace Surreal.OmnificInteger.DegreeTwoExample + +open Set + +/-- The positive Conway exponent in row `m` and column `n`. -/ +def exponent (m n : ℕ) : ℝ := + 1 / (m + 1 : ℝ) + + 1 / ((m + 1 : ℝ) * (m + 2 : ℝ) * (n + 1 : ℝ)) + +@[simp] +theorem exponent_apply (m n : ℕ) : + exponent m n = + 1 / (m + 1 : ℝ) + + 1 / ((m + 1 : ℝ) * (m + 2 : ℝ) * (n + 1 : ℝ)) := by + rfl + +private def cutoff (m : ℕ) : ℝ := + 1 / (m + 1 : ℝ) + +private theorem exponent_strictAnti_second (m : ℕ) : + StrictAnti (exponent m) := by + apply strictAnti_nat_of_succ_lt + intro n + rw [exponent_apply, exponent_apply] + gcongr + omega + +private theorem cutoff_lt_exponent (m n : ℕ) : + cutoff m < exponent m n := by + rw [cutoff, exponent_apply] + have : 0 < + 1 / ((m + 1 : ℝ) * (m + 2 : ℝ) * (n + 1 : ℝ)) := by + positivity + linarith + +private theorem next_exponent_zero_lt_cutoff (m : ℕ) : + exponent (m + 1) 0 < cutoff m := by + rw [exponent_apply, cutoff] + field_simp + norm_num [Nat.cast_add, Nat.cast_one] + ring_nf + nlinarith + +private theorem exponent_gt_of_first_lt + {m m' n n' : ℕ} (hmm' : m < m') : + exponent m n > exponent m' n' := by + calc + exponent m' n' ≤ exponent (m + 1) 0 := by + by_cases hsucc : m + 1 = m' + · subst m' + exact (exponent_strictAnti_second (m + 1)).antitone (Nat.zero_le n') + · have hfirst : m + 1 < m' := lt_of_le_of_ne (Nat.succ_le_iff.mpr hmm') hsucc + exact (exponent_gt_of_first_lt hfirst).le + _ < cutoff m := next_exponent_zero_lt_cutoff m + _ < exponent m n := cutoff_lt_exponent m n +termination_by m' - m + +private theorem exponent_strictAnti_lex : + StrictAnti (fun p : Lex (ℕ × ℕ) ↦ exponent (ofLex p).1 (ofLex p).2) := by + intro p q hpq + rw [Prod.Lex.lt_iff] at hpq + rcases hpq with hfirst | ⟨hfirst, hsecond⟩ + · exact exponent_gt_of_first_lt hfirst + · change exponent (ofLex p).1 (ofLex p).2 > exponent (ofLex q).1 (ofLex q).2 + rw [hfirst] + exact exponent_strictAnti_second _ hsecond + +/-- The row-column index, followed by one final index for the constant term. -/ +abbrev Index := WithTop (Lex (ℕ × ℕ)) + +/-- The exponent sequence of the concrete Conway normal form. -/ +def exponentAtIndex : Index → Surreal.{u} + | ⊤ => 0 + | (p : Lex (ℕ × ℕ)) => (exponent (ofLex p).1 (ofLex p).2 : ℝ) + +private theorem exponent_pos (m n : ℕ) : 0 < exponent m n := by + rw [exponent_apply] + positivity + +private theorem exponentAtIndex_strictAnti : StrictAnti exponentAtIndex.{u} := by + intro p q hpq + induction p using WithTop.recTopCoe with + | top => exact (not_lt_of_ge le_top hpq).elim + | coe p => + induction q using WithTop.recTopCoe with + | top => + change (0 : Surreal) < (exponent (ofLex p).1 (ofLex p).2 : ℝ) + exact_mod_cast exponent_pos (ofLex p).1 (ofLex p).2 + | coe q => + change ((exponent (ofLex q).1 (ofLex q).2 : ℝ) : Surreal) < + (exponent (ofLex p).1 (ofLex p).2 : ℝ) + exact_mod_cast exponent_strictAnti_lex (WithTop.coe_lt_coe.mp hpq) + +/-- The coefficient function of the explicit normal form. -/ +def coefficient (i : Surreal.{u}) : ℝ := + by + classical + exact if i ∈ range exponentAtIndex then 1 else 0 + +private theorem support_coefficient : + Function.support coefficient.{u} = range exponentAtIndex := by + classical + ext i + simp [Function.support, coefficient] + +/-- The displayed coefficient support is small enough for `SurrealHahnSeries` in every +universe. -/ +theorem small_support_coefficient : + Small.{u} (Function.support coefficient.{u}) := by + rw [support_coefficient] + infer_instance + +/-- The displayed exponents are reverse well-ordered. -/ +theorem wellFoundedOn_support_coefficient : + (Function.support coefficient.{u}).WellFoundedOn (· > ·) := by + rw [support_coefficient, wellFoundedOn_range] + convert wellFounded_lt (α := Index) using 1 + ext p q + exact exponentAtIndex_strictAnti.lt_iff_gt + +/-- The explicit Conway normal form with all coefficients equal to one. -/ +def normalForm : SurrealHahnSeries.{u} := + SurrealHahnSeries.mk coefficient small_support_coefficient + wellFoundedOn_support_coefficient + +@[simp] +theorem normalForm_coeff (i : Surreal.{u}) : + normalForm.coeff i = coefficient i := by + rw [normalForm, SurrealHahnSeries.coeff_mk, coefficient] + +@[simp] +theorem normalForm_support : normalForm.{u}.support = range exponentAtIndex := by + rw [normalForm, SurrealHahnSeries.support_mk, support_coefficient] + +theorem normalForm_coeff_exponent (m n : ℕ) : + normalForm.{u}.coeff (exponent m n : ℝ) = 1 := by + classical + rw [normalForm_coeff, coefficient, if_pos] + exact ⟨(↑(toLex (m, n)) : Index), rfl⟩ + +theorem normalForm_coeff_zero : normalForm.{u}.coeff 0 = 1 := by + classical + rw [normalForm_coeff, coefficient, if_pos] + exact ⟨⊤, rfl⟩ + +end Surreal.OmnificInteger.DegreeTwoExample diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/DegreeTwoPrime.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/DegreeTwoPrime.lean new file mode 100644 index 0000000000..ca7cc854d4 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/DegreeTwoPrime.lean @@ -0,0 +1,237 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.IrreducibleOmnificIntegers +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoNormalForm + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwoExample +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CharZero +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveCoefficientMap +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ArchimedeanAssumptions +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.DegreeTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.IntegerPart +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.RealLeadingSplit + +/-! +# An explicit degree-two prime in the omnific integers + +The PS06 construction supplies a generalised power series of support order type `ω ^ 2 + 1` +whose three independent translated-truncation classes modulo `J + K` prevent a nontrivial +factorisation, +over every field of characteristic zero. The omnific integer `ofRealSeries` of its real form has +this series as its signed Conway normal form. Irreducibility over the infinitesimal Hahn field +transfers to the omnific integer by the residue-one case of LM24, Proposition 8.3.6(5). +Every irreducible series and every irreducible omnific integer is prime. Everything is proved in +the model of Conway's `Oz` inside the surreal numbers of an arbitrary universe `u`. + +## References + +* J. Pommersheim, S. Shahriari, *Unique factorization in generalized power series rings*, +Proc. Amer. Math. Soc. 134 (2006), 1277–1287, cited as [PS06]. +* S. L'Innocente, V. Mantova, *A factorisation theory for generalised power series and omnific + integers*, Adv. Math. 442 (2024) 109513, cited as [LM24]. +-/ + +open scoped HahnSeries + +universe u + +noncomputable section + +namespace Surreal.OmnificInteger.DegreeTwoExample + +open HahnSeries.Nonpositive PommersheimShahriari.DegreeTwoExample + +private theorem degreeTwoWithConstant_ne_zero : degreeTwoWithConstant (K := ℝ) ≠ 0 := by + intro hzero + have hcoeff := degreeTwoWithConstant_coeff_zero (K := ℝ) + rw [hzero] at hcoeff + norm_num at hcoeff + +private theorem degreeTwoWithConstant_constantCoeff_mem : + constantCoeff (degreeTwoWithConstant (K := ℝ)) ∈ Surreal.realIntegerSubring := by + rw [degreeTwoWithConstant_constantCoeff] + exact Surreal.realIntegerSubring.one_mem + +/-- The signed degree-two series has negative order: its exponent `q₀,₀` carries coefficient one +and is negative. -/ +theorem signedDegreeTwo_order_neg : + (mapRealDomainToSurreal (degreeTwoWithConstant (K := ℝ)) : ℝ⟦Surreal.{u}⟧).order < 0 := by + have hcoeff : (mapRealDomainToSurreal (degreeTwoWithConstant (K := ℝ)) : + ℝ⟦Surreal.{u}⟧).coeff ((degreeTwoExponentPair (0, 0) : ℝ) : Surreal) ≠ 0 := by + have h := degreeTwoWithConstant_coeff_embedding (K := ℝ) 0 0 + rw [degreeTwoExponentEmbedding_apply] at h + rw [mapRealDomainToSurreal_coeff_real, h] + exact one_ne_zero + refine (HahnSeries.order_le_of_coeff_ne_zero hcoeff).trans_lt ?_ + norm_num [degreeTwoExponentPair_apply] + +theorem signedDegreeTwo_order_ne_zero : + (mapRealDomainToSurreal (degreeTwoWithConstant (K := ℝ)) : ℝ⟦Surreal.{u}⟧).order ≠ 0 := + signedDegreeTwo_order_neg.ne + +private theorem degreeTwoExponentPair_eq_neg_exponent (m n : ℕ) : + degreeTwoExponentPair (m, n) = + -DegreeTwoExample.exponent m n := by + rw [degreeTwoExponentPair_apply, + DegreeTwoExample.exponent_apply] + ring + +public section + +/-- The explicit PS06 series is prime over every characteristic-zero coefficient field. -/ +@[blueprint "thm:degree-two-series-prime" + (phase := "Surreal numbers and omnific integers") + (title := "Primality of an explicit degree-two series") + (statement := /-- + Let $K$ be a field of characteristic $0$. The series + \[ + 1+\sum_{m,n\in\mathbb N} + t^{-\frac{1}{m+1}-\frac{1}{(m+1)(m+2)(n+1)}} + \] + is prime in $K((\mathbb R^{\le 0}))$. + -/) + (proof := /-- + The nonconstant support consists of $\omega$ successive blocks of order type + $\omega$ and accumulates at $0$; adjoining the constant term gives support + order type $\omega^2+1$. Three translated-truncation classes from distinct + blocks are linearly independent modulo $J+K$, so their span has dimension + greater than $2$. Hence \ref{fact:ps06-irreducibility} makes the displayed + series irreducible. It is prime by + \ref{cor:hahn-series-irreducible-is-prime}. + -/)] +theorem degreeTwoWithConstant_prime {K : Type*} [Field K] [CharZero K] : + Prime (degreeTwoWithConstant (K := K)) := + Berarducci.prime_of_irreducible degreeTwoWithConstant_irreducible + +/-- The explicit degree-two omnific integer obtained from the PS06 series with three independent +classes modulo `J`. -/ +def degreeTwoOz : Surreal.OmnificInteger.{u} := + ofRealSeries (degreeTwoWithConstant (K := ℝ)) degreeTwoWithConstant_constantCoeff_mem + +private theorem degreeTwoOz_signed : + degreeTwoOz.{u}.1.toSignedFullHahnSeries = + mapRealDomainToSurreal (degreeTwoWithConstant (K := ℝ)) := + toSignedFullHahnSeries_ofRealSeries _ _ + +/-- The explicit PS06 omnific integer is irreducible. -/ +theorem degreeTwoOz_irreducible : Irreducible degreeTwoOz.{u} := by + apply irreducible_ofRealSeries + apply irreducible_mapRealDomainToSurrealIntegerPart Surreal.archimedeanStrata + Surreal.realIntegerSubring (degreeTwoWithConstant (K := ℝ)) degreeTwoWithConstant_ne_zero + signedDegreeTwo_order_ne_zero degreeTwoWithConstant_constantCoeff + rw [nonpositiveCoefficientMap_degreeTwoWithConstant] + exact degreeTwoWithConstant_irreducible + (K := ℝ⟦FiniteArchimedeanClass.ball ℝ Surreal.realFiniteClass⟧) + +/-- The explicit construction has the prescribed Conway normal form. -/ +theorem degreeTwoOz_toHahnSeries : degreeTwoOz.{u}.1.toHahnSeries = + DegreeTwoExample.normalForm := by + apply Surreal.toHahnSeries_eq_of_toSignedFullHahnSeries_eq degreeTwoOz_signed + · intro r + by_cases hr : r ∈ Set.range degreeTwoExponentEmbedding + · obtain ⟨p, rfl⟩ := hr + rcases p with ⟨m, n⟩ + have hcoeff := degreeTwoWithConstant_coeff_embedding (K := ℝ) m n + rw [degreeTwoExponentEmbedding_apply] at hcoeff + change DegreeTwoExample.normalForm.coeff + (-((degreeTwoExponentEmbedding (toLex (m, n)) : ℝ) : Surreal)) = + ((degreeTwoWithConstant (K := ℝ) : Berarducci.Series ℝ) : ℝ⟦ℝ⟧).coeff + (degreeTwoExponentEmbedding (toLex (m, n))) + rw [degreeTwoExponentEmbedding_apply, hcoeff, degreeTwoExponentPair_eq_neg_exponent, + Real.toSurreal_neg, neg_neg, + DegreeTwoExample.normalForm_coeff_exponent] + · by_cases hr0 : r = 0 + · subst hr0 + rw [degreeTwoWithConstant_coeff_zero] + simpa using DegreeTwoExample.normalForm_coeff_zero + · rw [degreeTwoWithConstant_coeff_eq_zero hr hr0, ← not_ne_iff, + ← SurrealHahnSeries.mem_support_iff, + DegreeTwoExample.normalForm_support] + rintro ⟨p, hp⟩ + induction p using WithTop.recTopCoe with + | top => + apply hr0 + have h0 : (0 : Surreal) = -(r : Surreal) := hp + exact_mod_cast (neg_eq_zero.mp h0.symm) + | coe q => + rcases q with ⟨m, n⟩ + apply hr + refine ⟨toLex (m, n), ?_⟩ + have hmn : + ((DegreeTwoExample.exponent m n : ℝ) : Surreal) = + -(r : Surreal) := hp + rw [← Real.toSurreal_neg, Real.toSurreal_inj] at hmn + rw [degreeTwoExponentEmbedding_apply, degreeTwoExponentPair_eq_neg_exponent, hmn, + neg_neg] + · rw [DegreeTwoExample.normalForm_support] + rintro _ ⟨p, rfl⟩ + induction p using WithTop.recTopCoe with + | top => + refine ⟨0, ?_⟩ + change -((0 : ℝ) : Surreal) = (0 : Surreal) + simp + | coe q => + rcases q with ⟨m, n⟩ + refine ⟨-DegreeTwoExample.exponent m n, ?_⟩ + change -((-DegreeTwoExample.exponent m n : ℝ) : Surreal) = + ((DegreeTwoExample.exponent m n : ℝ) : Surreal) + rw [Real.toSurreal_neg, neg_neg] + +/-- The Conway support of the explicit omnific integer is the displayed two-dimensional exponent +sequence followed by exponent zero. -/ +theorem degreeTwoOz_support : degreeTwoOz.{u}.1.support = + Set.range DegreeTwoExample.exponentAtIndex := by + rw [← Surreal.support_toHahnSeries, degreeTwoOz_toHahnSeries, + DegreeTwoExample.normalForm_support] + +/-- The Conway normal form of the explicit omnific integer has exact support order type +`ω ^ 2 + 1`. -/ +theorem degreeTwoOz_length : degreeTwoOz.{u}.1.length = + Ordinal.omega0 ^ (2 : Ordinal) + 1 := by + have hlift := Ordinal.lift_omega0_opow_natCast.{u, 0} 2 + simp only [Nat.cast_ofNat] at hlift + rw [degreeTwoOz, length_ofRealSeries, degreeTwoWithConstant_supportOrderType, Ordinal.lift_add, + Ordinal.lift_one, hlift] + +/-- The explicit PS06 omnific integer is reduced: its Hahn exponents lie in one nonzero +Archimedean class. -/ +theorem degreeTwoOz_isReduced : degreeTwoOz.{u}.toSignedNonpositiveHahn.IsReduced := + isReduced_ofRealSeries _ _ signedDegreeTwo_order_ne_zero + degreeTwoWithConstant_constantCoeff + +/-- The omnific integer obtained from the explicit PS06 series is prime. -/ +@[blueprint "thm:explicit-omnific-prime" + (phase := "Surreal numbers and omnific integers") + (title := "Primality of an explicit degree-two omnific integer") + (statement := /-- + The omnific integer + \[ + 1+\sum_{m,n\in\mathbb N} + \omega^{\frac{1}{m+1}+\frac{1}{(m+1)(m+2)(n+1)}} + \] + is prime in $\mathbf{Oz}$. + -/) + (proof := /-- + In the signed orientation $t=\omega^{-1}$, the nonconstant part is the + real-exponent series above, now over the coefficient field of the leading + Archimedean class. By \ref{fact:ps06-irreducibility}, that series is + irreducible. Coefficient + transport and the residue-one irreducibility transfer then make the displayed + omnific integer irreducible. It is prime by + \ref{thm:omnific-factorisation}. + -/) + (highlight)] +theorem degreeTwoOz_prime : Prime degreeTwoOz.{u} := + Surreal.OmnificInteger.prime_of_irreducible _ degreeTwoOz_irreducible + +end + +end Surreal.OmnificInteger.DegreeTwoExample diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowNormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowNormalForm.lean new file mode 100644 index 0000000000..6ba43c46dd --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowNormalForm.lean @@ -0,0 +1,121 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic +public import Mathlib.Data.Real.Basic +public import Mathlib.Order.TypeTags + +/-! +# Conway's one-row omnific integer + +This module writes the normal form + +`1 + Σ n : ℕ, ω ^ (1 / (n + 1))`, + +with every displayed coefficient equal to one. Its positive exponents form one decreasing row +converging to zero, followed by the final constant term. The sibling statement `OneRowPrime` +records its arithmetic properties using only Mathlib and CombinatorialGames. +-/ + +@[expose] public noncomputable section + +namespace Surreal.OmnificInteger.OneRowExample + +open Set + +/-- The `n`-th positive exponent in Conway's one-row normal form. -/ +def exponent (n : ℕ) : ℝ := + 1 / (n + 1 : ℝ) + +@[simp] +theorem exponent_apply (n : ℕ) : exponent n = 1 / (n + 1 : ℝ) := by + rfl + +private theorem exponent_strictAnti : StrictAnti exponent := by + refine strictAnti_nat_of_succ_lt fun n ↦ ?_ + rw [exponent_apply, exponent_apply] + apply one_div_lt_one_div_of_lt + · positivity + · norm_num + +/-- The natural-number row followed by the final constant-term index. -/ +abbrev Index := WithTop ℕ + +/-- The exponent at an index of the displayed normal form. -/ +def exponentAtIndex : Index → Surreal + | ⊤ => 0 + | (n : ℕ) => (exponent n : ℝ) + +private theorem exponent_pos (n : ℕ) : 0 < exponent n := by + rw [exponent_apply] + positivity + +private theorem exponentAtIndex_strictAnti : StrictAnti exponentAtIndex := by + intro p q hpq + induction p using WithTop.recTopCoe with + | top => exact (not_lt_of_ge le_top hpq).elim + | coe p => + induction q using WithTop.recTopCoe with + | top => + change (0 : Surreal) < (exponent p : ℝ) + exact_mod_cast exponent_pos p + | coe q => + change ((exponent q : ℝ) : Surreal) < (exponent p : ℝ) + exact_mod_cast exponent_strictAnti (WithTop.coe_lt_coe.mp hpq) + +/-- The coefficient function supported on the displayed exponents. -/ +def coefficient (i : Surreal) : ℝ := + by + classical + exact if i ∈ range exponentAtIndex then 1 else 0 + +private theorem support_coefficient : + Function.support coefficient = range exponentAtIndex := by + classical + ext i + simp [Function.support, coefficient] + +/-- The displayed coefficient support is small enough for a surreal Hahn series. -/ +theorem small_support_coefficient : + Small.{0} (Function.support coefficient) := by + rw [support_coefficient] + infer_instance + +/-- The displayed exponents are reverse well-ordered. -/ +theorem wellFoundedOn_support_coefficient : + (Function.support coefficient).WellFoundedOn (· > ·) := by + rw [support_coefficient, wellFoundedOn_range] + convert wellFounded_lt (α := Index) using 1 + ext p q + exact exponentAtIndex_strictAnti.lt_iff_gt + +/-- Conway's coefficient-one normal form `1 + Σ n, ω ^ (1 / (n + 1))`. -/ +def normalForm : SurrealHahnSeries := + SurrealHahnSeries.mk coefficient small_support_coefficient + wellFoundedOn_support_coefficient + +@[simp] +theorem normalForm_coeff (i : Surreal) : + normalForm.coeff i = coefficient i := by + rw [normalForm, SurrealHahnSeries.coeff_mk, coefficient] + +@[simp] +theorem normalForm_support : normalForm.support = range exponentAtIndex := by + rw [normalForm, SurrealHahnSeries.support_mk, support_coefficient] + +theorem normalForm_coeff_exponent (n : ℕ) : + normalForm.coeff (exponent n : ℝ) = 1 := by + classical + rw [normalForm_coeff, coefficient, if_pos] + exact ⟨(n : Index), rfl⟩ + +theorem normalForm_coeff_zero : normalForm.coeff 0 = 1 := by + classical + rw [normalForm_coeff, coefficient, if_pos] + exact ⟨⊤, rfl⟩ + +end Surreal.OmnificInteger.OneRowExample diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowPrime.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowPrime.lean new file mode 100644 index 0000000000..569c2cbc72 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowPrime.lean @@ -0,0 +1,169 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.IrreducibleOmnificIntegers +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowNormalForm + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CharZero +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OneRow +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ArchimedeanAssumptions +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.DegreeTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.IntegerPart +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.RealLeadingSplit + +/-! +# Conway's one-row prime + +Consider Conway's normal form + +`1 + Σ n : ℕ, ω ^ (1 / (n + 1))`. + +It is the omnific integer `ofRealSeries` of Berarducci's coefficient-one row with constant term. +The row remains irreducible after extending coefficients to the infinitesimal Hahn field, so the +residue-one case of LM24, Proposition 8.3.6(5) makes the omnific integer irreducible. It is +reduced, and its support has exact order type `ω + 1`, below `ω ^ ω`. The finite-degree primality +theorem then makes it prime. + +## References + +* A. Berarducci, *Factorization in generalized power series*, Trans. Amer. Math. Soc. 352 + (2000), 553–577, cited as [Ber00]. +* S. L'Innocente, V. Mantova, *A factorisation theory for generalised power series and omnific + integers*, Adv. Math. 442 (2024) 109513, cited as [LM24]. +-/ + +open scoped HahnSeries + +noncomputable section + +namespace Surreal.OmnificInteger.OneRowExample + +open Berarducci.OneRow HahnSeries.Nonpositive + +private theorem withConstant_ne_zero : withConstant (K := ℝ) ≠ 0 := by + intro hzero + have hcoeff := withConstant_coeff_zero (K := ℝ) + rw [hzero] at hcoeff + norm_num at hcoeff + +private theorem withConstant_constantCoeff_mem : + constantCoeff (withConstant (K := ℝ)) ∈ Surreal.realIntegerSubring := by + rw [withConstant_constantCoeff] + exact Surreal.realIntegerSubring.one_mem + +theorem signedOneRow_order_neg : + (mapRealDomainToSurreal (withConstant (K := ℝ)) : ℝ⟦Surreal.{0}⟧).order < 0 := by + have hcoeff : (mapRealDomainToSurreal (withConstant (K := ℝ)) : ℝ⟦Surreal.{0}⟧).coeff + ((Berarducci.OneRow.exponent 0 : ℝ) : Surreal) ≠ 0 := by + rw [mapRealDomainToSurreal_coeff_real, withConstant_coeff_exponent] + exact one_ne_zero + refine (HahnSeries.order_le_of_coeff_ne_zero hcoeff).trans_lt ?_ + exact_mod_cast (show Berarducci.OneRow.exponent 0 < 0 by + rw [Berarducci.OneRow.exponent_apply] + norm_num) + +theorem signedOneRow_order_ne_zero : + (mapRealDomainToSurreal (withConstant (K := ℝ)) : ℝ⟦Surreal.{0}⟧).order ≠ 0 := + signedOneRow_order_neg.ne + +private theorem signedExponent_eq_neg_normalExponent (n : ℕ) : + Berarducci.OneRow.exponent n = + -OneRowExample.exponent n := by + rw [Berarducci.OneRow.exponent_apply, + OneRowExample.exponent_apply] + +public section + +/-- Conway's one-row omnific integer in the cut presentation. -/ +def oneRowOz : Surreal.OmnificInteger.{0} := + ofRealSeries (withConstant (K := ℝ)) withConstant_constantCoeff_mem + +private theorem oneRowOz_signed : + oneRowOz.1.toSignedFullHahnSeries = mapRealDomainToSurreal (withConstant (K := ℝ)) := + toSignedFullHahnSeries_ofRealSeries _ _ + +/-- Conway's one-row omnific integer is irreducible. -/ +theorem oneRowOz_irreducible : Irreducible oneRowOz := by + apply irreducible_ofRealSeries + apply irreducible_mapRealDomainToSurrealIntegerPart Surreal.archimedeanStrata + Surreal.realIntegerSubring (withConstant (K := ℝ)) withConstant_ne_zero + signedOneRow_order_ne_zero withConstant_constantCoeff + rw [nonpositiveCoefficientMap_withConstant] + exact (irreducible_withoutConstant_and_withConstant + (K := ℝ⟦FiniteArchimedeanClass.ball ℝ Surreal.realFiniteClass⟧)).2 + +/-- The cut-defined omnific integer has the prescribed literal Conway normal form. -/ +theorem oneRowOz_toHahnSeries : oneRowOz.1.toHahnSeries = + OneRowExample.normalForm := by + apply Surreal.toHahnSeries_eq_of_toSignedFullHahnSeries_eq oneRowOz_signed + · intro r + by_cases hr : r ∈ Set.range exponentEmbedding + · obtain ⟨n, rfl⟩ := hr + rw [exponentEmbedding_apply, withConstant_coeff_exponent, + signedExponent_eq_neg_normalExponent, Real.toSurreal_neg, neg_neg, + OneRowExample.normalForm_coeff_exponent] + · by_cases hr0 : r = 0 + · subst hr0 + rw [withConstant_coeff_zero] + simpa using OneRowExample.normalForm_coeff_zero + · have hzero : (withConstant (K := ℝ) : ℝ⟦ℝ⟧).coeff r = 0 := by + rw [← not_ne_iff, ← HahnSeries.mem_support, withConstant_support] + rintro (hrange | hrzero) + · exact hr hrange + · exact hr0 (Set.mem_singleton_iff.mp hrzero) + rw [hzero, ← not_ne_iff, ← SurrealHahnSeries.mem_support_iff, + OneRowExample.normalForm_support] + rintro ⟨p, hp⟩ + induction p using WithTop.recTopCoe with + | top => + apply hr0 + have h0 : (0 : Surreal) = -(r : Surreal) := hp + exact_mod_cast (neg_eq_zero.mp h0.symm) + | coe n => + apply hr + refine ⟨n, ?_⟩ + have hn : ((OneRowExample.exponent n : ℝ) : Surreal) = + -(r : Surreal) := hp + rw [← Real.toSurreal_neg, Real.toSurreal_inj] at hn + rw [exponentEmbedding_apply, signedExponent_eq_neg_normalExponent, hn, neg_neg] + · rw [OneRowExample.normalForm_support] + rintro _ ⟨p, rfl⟩ + induction p using WithTop.recTopCoe with + | top => + refine ⟨0, ?_⟩ + change -((0 : ℝ) : Surreal) = (0 : Surreal) + simp + | coe n => + refine ⟨-OneRowExample.exponent n, ?_⟩ + change -((-OneRowExample.exponent n : ℝ) : Surreal) = + ((OneRowExample.exponent n : ℝ) : Surreal) + rw [Real.toSurreal_neg, neg_neg] + +/-- The Conway support is exactly the displayed positive row followed by zero. -/ +theorem oneRowOz_support : oneRowOz.1.support = + Set.range OneRowExample.exponentAtIndex := by + rw [← Surreal.support_toHahnSeries, oneRowOz_toHahnSeries, + OneRowExample.normalForm_support] + +/-- The one-row Conway normal form has exact support order type `ω + 1`. -/ +theorem oneRowOz_length : oneRowOz.1.length = Ordinal.omega0 + 1 := by + rw [oneRowOz, length_ofRealSeries, withConstant_supportOrderType, Ordinal.lift_id] + +/-- Conway's one-row omnific integer is reduced. -/ +theorem oneRowOz_isReduced : + HahnSeries.Nonpositive.IsReduced oneRowOz.toSignedNonpositiveHahn := + isReduced_ofRealSeries _ _ signedOneRow_order_ne_zero + withConstant_constantCoeff + +/-- Conway's one-row omnific integer is prime. -/ +theorem oneRowOz_prime : Prime oneRowOz := + Surreal.OmnificInteger.prime_of_irreducible _ oneRowOz_irreducible + +end + +end Surreal.OmnificInteger.OneRowExample diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/ZFCDegreeTwoPrime.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/ZFCDegreeTwoPrime.lean new file mode 100644 index 0000000000..20d4659093 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/ZFCDegreeTwoPrime.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.ZFC +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoPrime + +/-! +# A degree-two prime in the class presentation of the omnific integers + +The explicit degree-two prime transfers through the equivalence between the library and +set-coded presentations of the omnific integers. +-/ + +universe u + +public noncomputable section + +namespace ZFSet.Surreal.OmnificInteger.DegreeTwoExample + +/-- The explicit degree-two prime, as a Conway-equivalence class of omnific ZFC codes. -/ +def degreeTwoOz : OmnificInteger.{u} := + ringEquiv.symm _root_.Surreal.OmnificInteger.DegreeTwoExample.degreeTwoOz + +@[simp] +theorem toOmnificInteger_degreeTwoOz : toOmnificInteger degreeTwoOz.{u} = + _root_.Surreal.OmnificInteger.DegreeTwoExample.degreeTwoOz := by + rw [← ringEquiv_apply] + exact ringEquiv.apply_symm_apply _ + +/-- The class-valued example has exactly the displayed Conway normal form. -/ +theorem degreeTwoOz_toHahnSeries : + ZFSet.Surreal.toHahnSeries (degreeTwoOz.{u} : ZFSet.Surreal.{u}) = + _root_.Surreal.OmnificInteger.DegreeTwoExample.normalForm := by + rw [ZFSet.Surreal.toHahnSeries_eq_toSurreal, ← coe_toOmnificInteger, + toOmnificInteger_degreeTwoOz] + exact _root_.Surreal.OmnificInteger.DegreeTwoExample.degreeTwoOz_toHahnSeries + +/-- The prescribed normal form identifies the class-valued example uniquely. -/ +theorem toHahnSeries_eq_normalForm_iff (x : OmnificInteger.{u}) : + ZFSet.Surreal.toHahnSeries (x : ZFSet.Surreal.{u}) = + _root_.Surreal.OmnificInteger.DegreeTwoExample.normalForm ↔ x = degreeTwoOz := by + rw [← degreeTwoOz_toHahnSeries] + constructor + · intro h + apply Subtype.ext + apply ZFSet.Surreal.toSurreal_injective + simpa only [ZFSet.Surreal.toHahnSeries_eq_toSurreal, + _root_.Surreal.toSurreal_toHahnSeries] using congrArg SurrealHahnSeries.toSurreal h + · rintro rfl + rfl + +/-- The normal form of the class-valued example has support order type `ω ^ 2 + 1`. -/ +theorem degreeTwoOz_length : + (ZFSet.Surreal.toHahnSeries (degreeTwoOz.{u} : ZFSet.Surreal.{u})).length = + Ordinal.omega0 ^ (2 : Ordinal) + 1 := by + rw [ZFSet.Surreal.toHahnSeries_eq_toSurreal, ← coe_toOmnificInteger, + toOmnificInteger_degreeTwoOz, _root_.Surreal.length_toHahnSeries] + exact _root_.Surreal.OmnificInteger.DegreeTwoExample.degreeTwoOz_length + +/-- The explicit class-valued example is reduced in the native Conway-support sense. -/ +theorem degreeTwoOz_isReduced : + ZFSet.Surreal.IsReduced (degreeTwoOz.{u} : ZFSet.Surreal.{u}) := by + apply (isReduced_iff_toSignedNonpositiveHahn degreeTwoOz).2 + rw [ringEquiv_apply, toOmnificInteger_degreeTwoOz] + exact _root_.Surreal.OmnificInteger.DegreeTwoExample.degreeTwoOz_isReduced + +/-- The explicit degree-two omnific class value is prime. -/ +theorem degreeTwoOz_prime : Prime degreeTwoOz.{u} := by + apply (MulEquiv.prime_iff ringEquiv).1 + rw [ringEquiv_apply, toOmnificInteger_degreeTwoOz] + exact _root_.Surreal.OmnificInteger.DegreeTwoExample.degreeTwoOz_prime + +end ZFSet.Surreal.OmnificInteger.DegreeTwoExample diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory.lean b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory.lean new file mode 100644 index 0000000000..e00deb2704 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory.lean @@ -0,0 +1,12 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LatticeFactorCoefficients +import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LaurentFactorCoefficients +import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.MonicFactorCoefficients +import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.RelativeAlgebraicClosure + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LatticeFactorCoefficients.lean b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LatticeFactorCoefficients.lean new file mode 100644 index 0000000000..157378a531 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LatticeFactorCoefficients.lean @@ -0,0 +1,127 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LaurentFactorCoefficients +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.LatticeFunctional + +/-! +# Clearing a scalar out of a factor over a finite-rank exponent lattice + +A functional separating the exponents that occur collapses the lattice to a single variable +without merging any of them, and relabelling exponents commutes with extending coefficients. So a +factorisation whose product has coefficients in the subfield descends to the one-variable case, +where a monic factor of a monic polynomial has coefficients integral, hence algebraic, hence in +the subfield when it is relatively algebraically closed. Reading the coefficients back through the +separating functional clears one scalar out of the factor. +-/ + +universe u v w + +namespace AddMonoidAlgebra + +public section + +variable {K : Type u} {L : Type v} [Field K] [Field L] [Algebra K L] + +omit [Algebra K L] in +/-- Coefficient extension is `Finsupp.mapRange` on the underlying finitely supported function. -/ +theorem mapRingHom_apply' {M : Type*} [AddMonoid M] (f : K →+* L) (x : AddMonoidAlgebra K M) : + AddMonoidAlgebra.mapRingHom M f x = Finsupp.mapRange f (map_zero f) x := rfl + +omit [Algebra K L] in +/-- Relabelling exponents commutes with extending coefficients. -/ +theorem mapDomain_mapRingHom {M N : Type*} [AddMonoid M] [AddMonoid N] (psi : M →+ N) + (f : K →+* L) (x : AddMonoidAlgebra K M) : + AddMonoidAlgebra.mapDomainRingHom L psi (AddMonoidAlgebra.mapRingHom M f x) = + AddMonoidAlgebra.mapRingHom N f (AddMonoidAlgebra.mapDomainRingHom K psi x) := by + rw [mapDomainRingHom_apply, mapRingHom_apply', mapRingHom_apply', mapDomainRingHom_apply] + exact Finsupp.mapDomain_mapRange psi x f (map_zero f) (map_add f) + +/-- Lattice form of scalar clearing: collapse the lattice to one variable along a functional that +separates the exponents in play. -/ +theorem exists_scalar_of_mul_eq_map_lattice {k : ℕ} + (hclosed : Algebra.IsRelativelyAlgebraicallyClosed K L) + {q r : AddMonoidAlgebra L (Fin k → ℤ)} {P : AddMonoidAlgebra K (Fin k → ℤ)} + (hq : q ≠ 0) (hr : r ≠ 0) + (hqr : q * r = AddMonoidAlgebra.mapRingHom (Fin k → ℤ) (algebraMap K L) P) : + ∃ c : L, c ≠ 0 ∧ ∀ g, c * q g ∈ (algebraMap K L).range := by + classical + obtain ⟨psi, hpsi⟩ := AddMonoidHom.exists_injOn_finInt (q.support ∪ r.support) + have hsub : (q.support : Set (Fin k → ℤ)) ⊆ ((q.support ∪ r.support : Finset _) : Set _) := + fun x hx ↦ Finset.mem_coe.mpr (Finset.mem_union_left _ (Finset.mem_coe.mp hx)) + have hinjq : Set.InjOn psi (q.support : Set (Fin k → ℤ)) := hpsi.mono hsub + have htransfer : ∀ g ∈ q.support, + (AddMonoidAlgebra.mapDomainRingHom L psi q) (psi g) = q g := fun g hg ↦ + Finsupp.mapDomain_apply' _ q hsub hpsi (Finset.mem_union_left _ hg) + have hq0 : AddMonoidAlgebra.mapDomainRingHom L psi q ≠ 0 := by + obtain ⟨g, hg⟩ := Finsupp.support_nonempty_iff.mpr hq + intro h0 + rw [h0] at htransfer + exact (Finsupp.mem_support_iff.mp hg) (htransfer g hg).symm + have hr0 : AddMonoidAlgebra.mapDomainRingHom L psi r ≠ 0 := by + obtain ⟨g, hg⟩ := Finsupp.support_nonempty_iff.mpr hr + have hsubr : (r.support : Set (Fin k → ℤ)) ⊆ ((q.support ∪ r.support : Finset _) : Set _) := + fun x hx ↦ Finset.mem_coe.mpr (Finset.mem_union_right _ (Finset.mem_coe.mp hx)) + intro h0 + have := Finsupp.mapDomain_apply' ((q.support ∪ r.support : Finset _) : Set _) r hsubr hpsi + (Finset.mem_union_right _ hg) + have h0' : Finsupp.mapDomain psi r = 0 := (mapDomainRingHom_apply L psi r).symm.trans h0 + rw [h0'] at this + exact (Finsupp.mem_support_iff.mp hg) this.symm + have hrel : (AddMonoidAlgebra.mapDomainRingHom L psi q) * + (AddMonoidAlgebra.mapDomainRingHom L psi r) = + AddMonoidAlgebra.mapRingHom ℤ (algebraMap K L) + (AddMonoidAlgebra.mapDomainRingHom K psi P) := by + rw [← map_mul, hqr, mapDomain_mapRingHom] + obtain ⟨c, hc, hcoeff⟩ := + LaurentPolynomial.exists_scalar_of_mul_eq_map hclosed hq0 hr0 hrel + refine ⟨c, hc, fun g ↦ ?_⟩ + by_cases hg : g ∈ q.support + · rw [← htransfer g hg] + exact hcoeff _ + · rw [Finsupp.notMem_support_iff.mp hg, mul_zero] + exact ⟨0, map_zero _⟩ + +/-- Scalar clearing over any free exponent group of finite rank. -/ +theorem exists_scalar_of_mul_eq_map_free {H : Type w} [AddCommGroup H] + (hfree : ∃ k : ℕ, Nonempty (H ≃+ (Fin k → ℤ))) + (hclosed : Algebra.IsRelativelyAlgebraicallyClosed K L) + {q r : AddMonoidAlgebra L H} {P : AddMonoidAlgebra K H} (hq : q ≠ 0) (hr : r ≠ 0) + (hqr : q * r = AddMonoidAlgebra.mapRingHom H (algebraMap K L) P) : + ∃ c : L, c ≠ 0 ∧ ∀ g, c * q g ∈ (algebraMap K L).range := by + obtain ⟨k, ⟨e⟩⟩ := hfree + have hinj : Function.Injective (e : H → (Fin k → ℤ)) := e.injective + have htrans : ∀ (x : AddMonoidAlgebra L H) (g : H), + (AddMonoidAlgebra.mapDomainRingHom L e.toAddMonoidHom x) (e g) = x g := by + intro x g + rw [mapDomainRingHom_apply] + exact Finsupp.mapDomain_apply hinj x g + have hq0 : AddMonoidAlgebra.mapDomainRingHom L e.toAddMonoidHom q ≠ 0 := by + obtain ⟨g, hg⟩ := Finsupp.support_nonempty_iff.mpr hq + intro h0 + apply Finsupp.mem_support_iff.mp hg + rw [← htrans q g, h0] + exact Finsupp.zero_apply + have hr0 : AddMonoidAlgebra.mapDomainRingHom L e.toAddMonoidHom r ≠ 0 := by + obtain ⟨g, hg⟩ := Finsupp.support_nonempty_iff.mpr hr + intro h0 + apply Finsupp.mem_support_iff.mp hg + rw [← htrans r g, h0] + exact Finsupp.zero_apply + have hrel : (AddMonoidAlgebra.mapDomainRingHom L e.toAddMonoidHom q) * + (AddMonoidAlgebra.mapDomainRingHom L e.toAddMonoidHom r) = + AddMonoidAlgebra.mapRingHom (Fin k → ℤ) (algebraMap K L) + (AddMonoidAlgebra.mapDomainRingHom K e.toAddMonoidHom P) := by + rw [← map_mul, hqr, mapDomain_mapRingHom] + obtain ⟨c, hc, hcoeff⟩ := exists_scalar_of_mul_eq_map_lattice hclosed hq0 hr0 hrel + refine ⟨c, hc, fun g ↦ ?_⟩ + rw [← htrans q g] + exact hcoeff _ + +end + +end AddMonoidAlgebra diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LaurentFactorCoefficients.lean b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LaurentFactorCoefficients.lean new file mode 100644 index 0000000000..173899c231 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LaurentFactorCoefficients.lean @@ -0,0 +1,174 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.Polynomial.Laurent +public import Mathlib.Data.Finsupp.Basic +public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.MonicFactorCoefficients + +/-! +# Laurent factors over a relatively algebraically closed subfield + +A Laurent polynomial becomes an ordinary polynomial after multiplication by a large enough power +of the variable, and that multiplication is invertible, so divisibility and coefficients transfer +between the two settings. Coefficient extension commutes with the inclusion of polynomials into +Laurent polynomials and fixes the Laurent monomials. + +Combining these with the polynomial statement: if two Laurent polynomials over the extension have +monic polynomial shifts whose product is the extension of a polynomial over the subfield, then the +coefficients of each shift already lie in the subfield. +-/ + +universe u v + +namespace LaurentPolynomial + +public section + +variable {R : Type u} [Semiring R] + +/-- The Laurent image of a polynomial has the same coefficients at natural exponents. -/ +theorem toLaurent_apply_natCast (p : Polynomial R) (n : ℕ) : + (Polynomial.toLaurent p) (n : ℤ) = p.coeff n := by + rw [Polynomial.toLaurent_apply, Finsupp.mapDomain_apply Nat.cast_injective] + rfl + +/-- The Laurent image of a polynomial vanishes at negative exponents. -/ +theorem toLaurent_apply_of_neg (p : Polynomial R) {z : ℤ} (hz : z < 0) : + (Polynomial.toLaurent p) z = 0 := by + rw [Polynomial.toLaurent_apply] + refine Finsupp.mapDomain_notin_range _ _ ?_ + rintro ⟨n, rfl⟩ + omega +/-- Coefficient extension commutes with the Laurent inclusion. -/ +theorem toLaurent_map {S : Type*} [Semiring S] (f : R →+* S) (p : Polynomial R) : + Polynomial.toLaurent (p.map f) = AddMonoidAlgebra.mapRingHom ℤ f (Polynomial.toLaurent p) := by + refine Finsupp.ext fun z ↦ ?_ + rcases lt_or_ge z 0 with hz | hz + · rw [toLaurent_apply_of_neg _ hz] + change (0 : S) = f ((Polynomial.toLaurent p) z) + rw [toLaurent_apply_of_neg _ hz, map_zero] + · obtain ⟨n, rfl⟩ := Int.eq_ofNat_of_zero_le hz + rw [toLaurent_apply_natCast, Polynomial.coeff_map] + change f (p.coeff n) = f ((Polynomial.toLaurent p) (n : ℤ)) + rw [toLaurent_apply_natCast] + +/-- Coefficient extension fixes the Laurent monomials. -/ +theorem mapRingHom_T {S : Type*} [Semiring S] (f : R →+* S) (z : ℤ) : + AddMonoidAlgebra.mapRingHom ℤ f (LaurentPolynomial.T z) = LaurentPolynomial.T z := by + refine Finsupp.ext fun w ↦ ?_ + change f ((LaurentPolynomial.T z : AddMonoidAlgebra R ℤ) w) = _ + simp only [LaurentPolynomial.T, Finsupp.single_apply] + split_ifs <;> simp + +section Core + +variable {K : Type u} {L : Type v} [Field K] [Field L] [Algebra K L] + +/-- One-variable core, with the shifts supplied: two monic polynomial shifts of Laurent factors +whose product is an extension have coefficients in the base field. -/ +theorem coeff_mem_range_of_shifted + (hclosed : Algebra.IsRelativelyAlgebraicallyClosed K L) + {q r : AddMonoidAlgebra L ℤ} {P : AddMonoidAlgebra K ℤ} + (hmul : q * r = AddMonoidAlgebra.mapRingHom ℤ (algebraMap K L) P) + {q' r' : Polynomial L} {P' : Polynomial K} {n m : ℕ} + (hq' : Polynomial.toLaurent q' = q * LaurentPolynomial.T (n : ℤ)) + (hr' : Polynomial.toLaurent r' = r * LaurentPolynomial.T (m : ℤ)) + (hP' : Polynomial.toLaurent P' = P * LaurentPolynomial.T ((n : ℤ) + (m : ℤ))) + (hqm : q'.Monic) (hrm : r'.Monic) (j : ℕ) : + q'.coeff j ∈ (algebraMap K L).range := by + have hprod : q' * r' = P'.map (algebraMap K L) := by + refine Polynomial.toLaurent_injective ?_ + rw [map_mul, hq', hr', toLaurent_map, hP', map_mul, mul_mul_mul_comm, + ← LaurentPolynomial.T_add, hmul, mapRingHom_T] + exact Polynomial.coeff_mem_range_of_mul_eq_map hclosed hqm hrm hprod j + +end Core + +section Shift + +variable {R : Type u} [CommRing R] + +private theorem mul_T_apply (f : AddMonoidAlgebra R ℤ) (n : ℤ) (z : ℤ) : + ((f * LaurentPolynomial.T n : AddMonoidAlgebra R ℤ)) z = f (z - n) := by + rw [show (LaurentPolynomial.T n : AddMonoidAlgebra R ℤ) = Finsupp.single n (1 : R) from rfl, + AddMonoidAlgebra.mul_single_apply, mul_one, sub_eq_add_neg] + +/-- Coefficients of a Laurent polynomial read off a polynomial shift, at natural indices. -/ +theorem apply_sub_of_toLaurent_eq_mul_T {f : AddMonoidAlgebra R ℤ} {p : Polynomial R} {n : ℕ} + (h : Polynomial.toLaurent p = f * LaurentPolynomial.T (n : ℤ)) (j : ℕ) : + f ((j : ℤ) - n) = p.coeff j := by + have hj := mul_T_apply f (n : ℤ) (j : ℤ) + rw [← h, toLaurent_apply_natCast] at hj + exact hj.symm + +/-- Below the shift the Laurent polynomial vanishes. -/ +theorem apply_eq_zero_of_toLaurent_eq_mul_T {f : AddMonoidAlgebra R ℤ} {p : Polynomial R} {n : ℕ} + (h : Polynomial.toLaurent p = f * LaurentPolynomial.T (n : ℤ)) {z : ℤ} (hz : z + n < 0) : + f z = 0 := by + have hz' := mul_T_apply f (n : ℤ) (z + n) + simp only [add_sub_cancel_right] at hz' + rw [← h, toLaurent_apply_of_neg _ hz] at hz' + exact hz'.symm + +section Clearing + +variable {K : Type u} {L : Type v} [Field K] [Field L] [Algebra K L] + +/-- Laurent form of scalar clearing: one scalar carries the first factor into the subfield. -/ +theorem exists_scalar_of_mul_eq_map + (hclosed : Algebra.IsRelativelyAlgebraicallyClosed K L) + {q r : AddMonoidAlgebra L ℤ} {P : AddMonoidAlgebra K ℤ} (hq : q ≠ 0) (hr : r ≠ 0) + (hqr : q * r = AddMonoidAlgebra.mapRingHom ℤ (algebraMap K L) P) : + ∃ c : L, c ≠ 0 ∧ ∀ z, c * q z ∈ (algebraMap K L).range := by + obtain ⟨n₀, q₀, hq₀⟩ := LaurentPolynomial.exists_T_pow q + obtain ⟨m₀, r₀, hr₀⟩ := LaurentPolynomial.exists_T_pow r + obtain ⟨l, P₀, hP₀⟩ := LaurentPolynomial.exists_T_pow P + have hq'L : Polynomial.toLaurent (q₀ * Polynomial.X ^ l) = + q * LaurentPolynomial.T ((n₀ + l : ℕ) : ℤ) := by + rw [map_mul, hq₀, Polynomial.toLaurent_X_pow, mul_assoc, ← LaurentPolynomial.T_add] + norm_cast + have hr'L : Polynomial.toLaurent (r₀ * Polynomial.X ^ l) = + r * LaurentPolynomial.T ((m₀ + l : ℕ) : ℤ) := by + rw [map_mul, hr₀, Polynomial.toLaurent_X_pow, mul_assoc, ← LaurentPolynomial.T_add] + norm_cast + have hPL : Polynomial.toLaurent ((P₀ * Polynomial.X ^ (n₀ + m₀ + l)).map (algebraMap K L)) = + AddMonoidAlgebra.mapRingHom ℤ (algebraMap K L) P * + LaurentPolynomial.T (((n₀ + l : ℕ) : ℤ) + ((m₀ + l : ℕ) : ℤ)) := by + rw [toLaurent_map, map_mul, hP₀, Polynomial.toLaurent_X_pow, map_mul, mapRingHom_T, + map_mul, mapRingHom_T, mul_assoc, ← LaurentPolynomial.T_add] + push_cast + ring_nf + have hprod : (q₀ * Polynomial.X ^ l) * (r₀ * Polynomial.X ^ l) = + (P₀ * Polynomial.X ^ (n₀ + m₀ + l)).map (algebraMap K L) := by + refine Polynomial.toLaurent_injective ?_ + rw [map_mul, hq'L, hr'L, hPL, mul_mul_mul_comm, ← LaurentPolynomial.T_add, hqr] + have hq'0 : q₀ * Polynomial.X ^ l ≠ 0 := by + intro h0 + rw [h0, map_zero] at hq'L + exact hq ((mul_eq_zero.mp hq'L.symm).resolve_right (LaurentPolynomial.isUnit_T _).ne_zero) + have hr'0 : r₀ * Polynomial.X ^ l ≠ 0 := by + intro h0 + rw [h0, map_zero] at hr'L + exact hr ((mul_eq_zero.mp hr'L.symm).resolve_right (LaurentPolynomial.isUnit_T _).ne_zero) + obtain ⟨c, hc, hcoeff⟩ := Polynomial.exists_scalar_of_mul_eq_map hclosed hq'0 hr'0 hprod + refine ⟨c, hc, fun z ↦ ?_⟩ + rcases le_or_gt 0 (z + ((n₀ + l : ℕ) : ℤ)) with hcase | hcase + · have hz : z = ((z + (n₀ + l : ℕ)).toNat : ℤ) - ((n₀ + l : ℕ) : ℤ) := by + rw [Int.toNat_of_nonneg hcase] + ring + rw [hz, apply_sub_of_toLaurent_eq_mul_T hq'L] + exact hcoeff _ + · rw [apply_eq_zero_of_toLaurent_eq_mul_T hq'L hcase, mul_zero] + exact ⟨0, map_zero _⟩ + +end Clearing + + +end Shift + +end +end LaurentPolynomial diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/MonicFactorCoefficients.lean b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/MonicFactorCoefficients.lean new file mode 100644 index 0000000000..c52212acda --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/MonicFactorCoefficients.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.RelativeAlgebraicClosure +public import Mathlib.RingTheory.Polynomial.IsIntegral +public import Mathlib.Algebra.Polynomial.FieldDivision + +/-! +# Coefficients of a monic factor over a relatively algebraically closed subfield + +A monic divisor of a monic polynomial has coefficients integral over the base ring, because they +are symmetric functions of a subset of the roots. Over a field the integral elements are exactly +the algebraic ones, so if the base field is relatively algebraically closed in the coefficient +field then those coefficients already lie in the base field. +-/ + +universe u v + +namespace Polynomial + +public section + +variable {K : Type u} {L : Type v} [Field K] [Field L] [Algebra K L] + +/-- Over a relatively algebraically closed subfield, a monic factor of a monic polynomial has all +its coefficients in the subfield. -/ +theorem coeff_mem_range_of_monic_dvd + (hclosed : Algebra.IsRelativelyAlgebraicallyClosed K L) + {p : Polynomial K} {q : Polynomial L} (hp : p.Monic) (hq : q.Monic) + (hdvd : q ∣ p.map (algebraMap K L)) (i : ℕ) : + q.coeff i ∈ (algebraMap K L).range := by + obtain ⟨k, hk⟩ := (Algebra.isRelativelyAlgebraicallyClosed_iff K L).mp hclosed _ + (Polynomial.isIntegral_coeff_of_dvd p q hp hq hdvd i).isAlgebraic + exact ⟨k, hk⟩ + +/-- If a product of two monic polynomials over `L` is the extension of a polynomial over `K`, then +each factor already has all its coefficients in `K`. -/ +theorem coeff_mem_range_of_mul_eq_map + (hclosed : Algebra.IsRelativelyAlgebraicallyClosed K L) + {q r : Polynomial L} {P : Polynomial K} (hq : q.Monic) (hr : r.Monic) + (hqr : q * r = P.map (algebraMap K L)) (i : ℕ) : + q.coeff i ∈ (algebraMap K L).range := by + have hPmonic : P.Monic := Polynomial.monic_map_iff.mp (hqr ▸ hq.mul hr) + exact coeff_mem_range_of_monic_dvd hclosed hPmonic hq ⟨r, hqr.symm⟩ i + +/-- If a product of two nonzero polynomials over `L` is the extension of a polynomial over `K`, +one scalar clears the first factor into `K`. -/ +theorem exists_scalar_of_mul_eq_map + (hclosed : Algebra.IsRelativelyAlgebraicallyClosed K L) + {q r : Polynomial L} {P : Polynomial K} (hq : q ≠ 0) (hr : r ≠ 0) + (hqr : q * r = P.map (algebraMap K L)) : + ∃ c : L, c ≠ 0 ∧ ∀ j, c * q.coeff j ∈ (algebraMap K L).range := by + have hc : q.leadingCoeff ≠ 0 := Polynomial.leadingCoeff_ne_zero.mpr hq + have hd : r.leadingCoeff ≠ 0 := Polynomial.leadingCoeff_ne_zero.mpr hr + have hq1 : (Polynomial.C q.leadingCoeff⁻¹ * q).Monic := by + unfold Polynomial.Monic + rw [Polynomial.leadingCoeff_mul, Polynomial.leadingCoeff_C, inv_mul_cancel₀ hc] + have hr1 : (Polynomial.C r.leadingCoeff⁻¹ * r).Monic := by + unfold Polynomial.Monic + rw [Polynomial.leadingCoeff_mul, Polynomial.leadingCoeff_C, inv_mul_cancel₀ hd] + have hlc : (P.map (algebraMap K L)).leadingCoeff = q.leadingCoeff * r.leadingCoeff := by + rw [← hqr, Polynomial.leadingCoeff_mul] + have hPlc : (P.map (algebraMap K L)).leadingCoeff = algebraMap K L P.leadingCoeff := by + rw [Polynomial.leadingCoeff_map] + have hPne : P.leadingCoeff ≠ 0 := by + intro h0 + rw [hPlc, h0, map_zero] at hlc + exact (mul_ne_zero hc hd) hlc.symm + have hprod : (Polynomial.C q.leadingCoeff⁻¹ * q) * (Polynomial.C r.leadingCoeff⁻¹ * r) = + (Polynomial.C P.leadingCoeff⁻¹ * P).map (algebraMap K L) := by + rw [Polynomial.map_mul, Polynomial.map_C, ← hqr] + rw [show algebraMap K L P.leadingCoeff⁻¹ = (q.leadingCoeff * r.leadingCoeff)⁻¹ by + rw [← hlc, hPlc, map_inv₀]] + rw [mul_inv, Polynomial.C_mul] + ring + refine ⟨q.leadingCoeff⁻¹, inv_ne_zero hc, fun j ↦ ?_⟩ + have := coeff_mem_range_of_mul_eq_map hclosed hq1 hr1 hprod j + rwa [Polynomial.coeff_C_mul] at this + +end + +end Polynomial diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/RelativeAlgebraicClosure.lean b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/RelativeAlgebraicClosure.lean new file mode 100644 index 0000000000..57fd9e2cd1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/RelativeAlgebraicClosure.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.FieldTheory.AlgebraicClosure + +/-! +# Relative algebraic closure + +This module packages the assertion that a field is relatively algebraically closed in a field +extension. The elementwise definition is convenient in theorem statements, while the +characteristic theorem identifies it with Mathlib's relative algebraic closure. +-/ + +universe u v + +namespace Algebra + +public noncomputable section + +variable (F : Type u) (E : Type v) [Field F] [Field E] [Algebra F E] + +/-- The field `F` is relatively algebraically closed in `E` when every element of `E` algebraic +over `F` belongs to the range of the scalar embedding. -/ +def IsRelativelyAlgebraicallyClosed : Prop := + ∀ x : E, IsAlgebraic F x → x ∈ (algebraMap F E).range + +theorem isRelativelyAlgebraicallyClosed_iff : + IsRelativelyAlgebraicallyClosed F E ↔ + ∀ x : E, IsAlgebraic F x → + ∃ k : F, algebraMap F E k = x := + Iff.rfl + +theorem isRelativelyAlgebraicallyClosed_iff_algebraicClosure_eq_bot : + IsRelativelyAlgebraicallyClosed F E ↔ + algebraicClosure F E = ⊥ := by + constructor + · intro h + ext x + rw [mem_algebraicClosure_iff, IntermediateField.mem_bot] + constructor + · exact h x + · rintro ⟨k, rfl⟩ + exact isAlgebraic_algebraMap k + · intro h x hx + have hx' : x ∈ algebraicClosure F E := + mem_algebraicClosure_iff.mpr hx + rw [h, IntermediateField.mem_bot] at hx' + exact hx' + +/-- A field is relatively algebraically closed in an extension if every algebraic element has +minimal polynomial of degree at most one. -/ +theorem isRelativelyAlgebraicallyClosed_of_minpoly_natDegree_le_one + (hlinear : ∀ x : E, IsAlgebraic F x → + (minpoly F x).natDegree ≤ 1) : + IsRelativelyAlgebraicallyClosed F E := by + rw [isRelativelyAlgebraicallyClosed_iff] + intro x hx + apply minpoly.natDegree_eq_one_iff.mp + apply le_antisymm (hlinear x hx) + exact minpoly.natDegree_pos (isAlgebraic_iff_isIntegral.mp hx) + +end + +end Algebra diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries.lean new file mode 100644 index 0000000000..045a1b6ff8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ArchimedeanSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEmbedding +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEquiv +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationResidue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CharZero +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CoefficientMap +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexFactorSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexQuotientSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeTermCount +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeValuation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Domain +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEmbedding +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEquiv +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.EPrimitive +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FactorCoefficients +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportConstantTermOne +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportMonoidAlgebra +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalizedGCD +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportResidue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarExtension +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Iterate +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IterateOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.LimitTailQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Monomial +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Multiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Negative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NegativeMonomialIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveCoefficientMap +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveDomainEquiv +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderedIntervalSum +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.RealSupportSupremum +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedPieceSum +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SourceStatements +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupAlgebra +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupGCD +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportArchimedeanClasses +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportSupremum +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Translation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Truncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.TruncationIntegerPartPrimal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.WeakNormalForm + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ArchimedeanSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ArchimedeanSplitting.lean new file mode 100644 index 0000000000..a42aec42fc --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ArchimedeanSplitting.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ArchimedeanBallSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEquiv +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Iterate + +/-! +# Hahn-series splitting along an Archimedean class + +The ordered splitting of a closed Archimedean ball reindexes Hahn series on that ball as Hahn +series on a lexicographic product. Flattening in reverse then presents them as iterated Hahn +series: the chosen stratum is the outer, dominant exponent and the open ball is the inner, +infinitesimal exponent. +-/ + +public noncomputable section + +namespace HahnSeries + +open FiniteArchimedeanClass + +variable {R K M : Type*} [Semiring R] +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup M] [LinearOrder M] [IsOrderedAddMonoid M] +variable [Module K M] [IsOrderedModule K M] + +/-- Hahn series on a closed Archimedean ball as iterated Hahn series, with the chosen stratum +as the outer exponent and the open ball as the coefficient-series exponent. -/ +def archimedeanSplitRingEquiv (u : HahnEmbedding.ArchimedeanStrata K M) + (c : FiniteArchimedeanClass M) : + R⟦closedBall K c⟧ ≃+* (R⟦ball K c⟧)⟦u.stratum c⟧ := + (embDomainRingEquiv + (HahnEmbedding.ArchimedeanStrata.closedBallEquivStratumLexBall u c)).trans + iterateRingEquiv.symm + +@[simp] +theorem archimedeanSplitRingEquiv_coeff + (u : HahnEmbedding.ArchimedeanStrata K M) (c : FiniteArchimedeanClass M) + (x : R⟦closedBall K c⟧) (s : u.stratum c) (b : ball K c) : + ((archimedeanSplitRingEquiv u c x).coeff s).coeff b = + x.coeff (HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c + (toLex (s, b))) := by + apply (iterateRingEquiv_coeff (archimedeanSplitRingEquiv u c x) s b).symm.trans + change (iterateRingEquiv + (iterateRingEquiv.symm + (embDomainRingEquiv + (HahnEmbedding.ArchimedeanStrata.closedBallEquivStratumLexBall u c) x))).coeff + (toLex (s, b)) = _ + rw [RingEquiv.apply_symm_apply] + have h := embDomainRingEquiv_coeff + (R := R) + (HahnEmbedding.ArchimedeanStrata.closedBallEquivStratumLexBall u c) x + (HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c (toLex (s, b))) + rw [HahnEmbedding.ArchimedeanStrata.closedBallEquivStratumLexBall_stratumLexBallEquivClosedBall] + at h + exact h + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncation.lean new file mode 100644 index 0000000000..b0b481f06a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncation.lean @@ -0,0 +1,320 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Archimedean +public import Mathlib.RingTheory.HahnSeries.Cardinal +public import Mathlib.SetTheory.Cardinal.Cofinality.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Cardinal-bounded Hahn truncation integer parts + +This file models the support-cardinality bound in the Hahn fields `K((G))_κ` used by LM24. +It intersects the nonpositive-support and constant-coefficient conditions with Mathlib's subfield +of series having fewer than `κ` terms. + +The fraction-subring lemmas isolate the two nonzero-class alternatives in LM24, assumption +`(A2)_σ`. If `κ ≤ cof(G)`, a support of cardinality less than `κ` is not cofinal, so a +monomial shift supplies a denominator in the truncation integer part. If `G = {0}`, the same +conclusion follows exactly when the coefficient subring has fraction subring equal to the whole +coefficient field. +-/ + +universe u v + +public noncomputable section + +open Cardinal + +namespace HahnSeries + +variable {G : Type u} {R : Type v} {κ : Cardinal.{u}} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Field R] + +/-- A Hahn series over an Archimedean exponent group has countable support. -/ +theorem cardSupp_le_aleph0_of_archimedean [Archimedean G] (x : R⟦G⟧) : + x.cardSupp ≤ ℵ₀ := by + rw [cardSupp, Cardinal.le_aleph0_iff_set_countable] + exact x.isPWO_support.countable_of_archimedean + +variable [Fact (ℵ₀ < κ)] + +/-- The field of Hahn series with fewer than `κ` support terms. -/ +abbrev CardSuppLTField := ↥(cardSuppLTSubfield G R κ) + +/-- The `κ`-bounded nonpositive Hahn series whose coefficient at zero belongs to `Z`. -/ +def cardSuppLTTruncationIntegerPart (Z : Subring R) : Subring (CardSuppLTField (G := G) (R := R) + (κ := κ)) where + carrier x := (x : R⟦G⟧).support ⊆ Set.Iic 0 ∧ (x : R⟦G⟧).coeff 0 ∈ Z + zero_mem' := by + constructor + · simp + · simp + one_mem' := by + constructor + · intro g hg + have hg0 : g = 0 := support_single_subset hg + simp [hg0] + · simp + add_mem' := fun {x y} hx hy => by + constructor + · intro g hg + rcases support_add_subset (x : R⟦G⟧) (y : R⟦G⟧) hg with hg | hg + · exact hx.1 hg + · exact hy.1 hg + · change (((x : R⟦G⟧) + (y : R⟦G⟧)).coeff 0) ∈ Z + rw [coeff_add] + exact Z.add_mem hx.2 hy.2 + neg_mem' := fun {x} hx => by + constructor + · exact (support_neg_subset (x : R⟦G⟧)).trans hx.1 + · change ((-(x : R⟦G⟧)).coeff 0) ∈ Z + rw [coeff_neg] + exact Z.neg_mem hx.2 + mul_mem' := fun {x y} hx hy => by + constructor + · intro g hg + obtain ⟨i, hi, j, hj, rfl⟩ := support_mul_subset hg + exact add_nonpos (hx.1 hi) (hy.1 hj) + · let x' : Nonpositive G R := ⟨x, hx.1⟩ + let y' : Nonpositive G R := ⟨y, hy.1⟩ + change (((x' : R⟦G⟧) * (y' : R⟦G⟧)).coeff 0) ∈ Z + rw [Nonpositive.coeff_zero_mul] + exact Z.mul_mem hx.2 hy.2 + +/-- Membership in the `κ`-bounded truncation integer part. -/ +@[simp] +theorem mem_cardSuppLTTruncationIntegerPart {Z : Subring R} {x : CardSuppLTField (G := G) (R := R) + (κ := κ)} : + x ∈ cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z ↔ + (x : R⟦G⟧).support ⊆ Set.Iic 0 ∧ (x : R⟦G⟧).coeff 0 ∈ Z := + Iff.rfl + +namespace CardSuppLTTruncationIntegerPart + +/-- Forget the cardinal bound while retaining the nonpositive-support witness. -/ +def toNonpositiveRingHom (Z : Subring R) : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z →+* + Nonpositive G R where + toFun x := ⟨x, x.2.1⟩ + map_one' := rfl + map_mul' _ _ := rfl + map_zero' := rfl + map_add' _ _ := rfl + +/-- Forgetting the bound and then coercing to a Hahn series preserves the underlying series. -/ +@[simp] +theorem coe_toNonpositiveRingHom (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + (toNonpositiveRingHom Z x : R⟦G⟧) = (x : CardSuppLTField (G := G) (R := R) (κ := κ)) := + (rfl) + +/-- Forgetting the cardinal bound is injective. -/ +theorem toNonpositiveRingHom_injective (Z : Subring R) : + Function.Injective (toNonpositiveRingHom (G := G) (R := R) (κ := κ) Z) := by + intro x y hxy + apply Subtype.ext + apply Subtype.ext + have hraw := congrArg (fun q : Nonpositive G R ↦ (q : R⟦G⟧)) hxy + simpa only [coe_toNonpositiveRingHom] using hraw + +/-- Forgetting the bound retains the proof that the support has cardinality less than `κ`. -/ +theorem cardSupp_toNonpositiveRingHom_lt (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + (toNonpositiveRingHom Z x : R⟦G⟧).cardSupp < κ := by + rw [coe_toNonpositiveRingHom] + exact (mem_cardSuppLTSubfield (Γ := G) (R := R) (κ := κ)).mp x.1.2 + +/-- Forget the cardinal bound on a bounded truncation-integer-part element. -/ +def toTruncationIntegerPartRingHom (Z : Subring R) : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z →+* + truncationIntegerPart G Z where + toFun x := ⟨toNonpositiveRingHom Z x, + (mem_truncationIntegerPart (R := R) (Γ := G)).mpr x.2.2⟩ + map_one' := rfl + map_mul' _ _ := rfl + map_zero' := rfl + map_add' _ _ := rfl + +/-- Forgetting the bound preserves the underlying nonpositive Hahn series. -/ +@[simp] +theorem coe_toTruncationIntegerPartRingHom (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + (toTruncationIntegerPartRingHom Z x : Nonpositive G R) = toNonpositiveRingHom Z x := + (rfl) + +/-- Forgetting the cardinal bound on a truncation integer part is injective. -/ +theorem toTruncationIntegerPartRingHom_injective (Z : Subring R) : + Function.Injective + (toTruncationIntegerPartRingHom (G := G) (R := R) (κ := κ) Z) := by + intro x y hxy + apply toNonpositiveRingHom_injective Z + have h := congrArg (fun q : truncationIntegerPart G Z ↦ (q : Nonpositive G R)) hxy + simpa only [coe_toTruncationIntegerPartRingHom] using h + +end CardSuppLTTruncationIntegerPart + +/-- If `κ ≤ cof(G)`, the `κ`-bounded truncation integer part has the whole bounded Hahn +field as its fraction subring. -/ +@[blueprint "thm:bounded-hahn-integer-part-fraction-field" + (phase := "Finitely many Archimedean classes") + (title := "Fraction fields of bounded Hahn integer parts") + (statement := /-- + Let $G$ be an ordered abelian group, let $K$ be a field, and let + $\kappa>\aleph_0$. If $\kappa\le\operatorname{cof}(G)$, then the bounded + Hahn field $K((G))_\kappa$ is the fraction field of + $Z+K((G^{<0}))_\kappa$ for every subring $Z\subseteq K$. + -/) + (proof := /-- + The support of a series in $K((G))_\kappa$ has cardinality less than + $\kappa$, so it is not cofinal in $G$. Choose an upper bound $x$ for the + support and put $u=\max\{x,0\}$. Multiplication by $t^{-u}$ moves the + support strictly below zero and gives constant coefficient zero. Thus + both $t^{-u}$ and $t^{-u}b$ belong to the bounded Hahn integer part, and + $b=(t^{-u}b)/t^{-u}$. + -/)] +theorem fracSubring_cardSuppLTTruncationIntegerPart_eq_top_of_le_cof (Z : Subring R) + (hcof : κ ≤ Order.cof G) : + Subring.fracSubring + (cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) = ⊤ := by + apply top_unique + intro b _ + have hsnot : ¬ IsCofinal (b : R⟦G⟧).support := by + intro hs + have hκcard : κ ≤ #(b : R⟦G⟧).support := + (Order.le_cof_iff.mp hcof) _ hs + exact (not_lt_of_ge hκcard) b.2 + obtain ⟨x, hx⟩ := not_isCofinal_iff.mp hsnot + let u : G := max x 0 + let d0 : R⟦G⟧ := single (-u) 1 + have hdcard : d0.cardSupp < κ := + (cardSupp_single_le (-u) (1 : R)).trans_lt + (one_lt_aleph0.trans (Fact.out : ℵ₀ < κ)) + let d : CardSuppLTField (G := G) (R := R) (κ := κ) := ⟨d0, hdcard⟩ + have hdu : -u ≤ 0 := neg_nonpos.mpr (le_max_right x 0) + have hdmem : d ∈ cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z := by + rw [mem_cardSuppLTTruncationIntegerPart] + constructor + · intro g hg + have hg' : g ∈ (single (-u) (1 : R)).support := by + simpa [d, d0] using hg + have hg_eq : g = -u := by + exact eq_of_mem_support_single hg' + rw [hg_eq] + exact hdu + · by_cases hu : u = 0 + · simp [d, d0, hu] + · have hnu : -u ≠ 0 := neg_ne_zero.mpr hu + have hzero : (single (-u) (1 : R)).coeff 0 = 0 := + coeff_single_of_ne (Ne.symm hnu) + simp [d, d0, hzero] + let a0 : R⟦G⟧ := d0 * (b : R⟦G⟧) + have hacard : a0.cardSupp < κ := + (cardSupp_single_mul_le (b : R⟦G⟧) (-u) (1 : R)).trans_lt b.2 + let a : CardSuppLTField (G := G) (R := R) (κ := κ) := ⟨a0, hacard⟩ + have hamem : a ∈ cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z := by + rw [mem_cardSuppLTTruncationIntegerPart] + constructor + · intro g hg + have hcoeff : (b : R⟦G⟧).coeff (g + u) ≠ 0 := by + simpa [a, a0, d0, coeff_single_mul, sub_eq_add_neg] using hg + have hlt : g + u < x := hx _ hcoeff + have hxu : x ≤ u := le_max_left x 0 + have hxu' : x ≤ 0 + u := by simpa using hxu + have hgu : g + u < 0 + u := hlt.trans_le hxu' + simpa using hgu.le + · have : (a0.coeff 0) = (b : R⟦G⟧).coeff u := by + simp [a0, d0, coeff_single_mul, sub_eq_add_neg] + rw [this] + have hnot : u ∉ (b : R⟦G⟧).support := by + intro humem + have := hx u humem + exact (not_lt_of_ge (le_max_left x 0)) this + have hzero : (b : R⟦G⟧).coeff u = 0 := by + simpa [mem_support] using hnot + rw [hzero] + exact Z.zero_mem + have hdF : d ∈ Subring.fracSubring + (cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) := + Subring.le_fracSubring hdmem + have haF : a ∈ Subring.fracSubring + (cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) := + Subring.le_fracSubring hamem + have hd0 : d ≠ 0 := by + intro h + have := congrArg (fun z : CardSuppLTField (G := G) (R := R) (κ := κ) => + (z : R⟦G⟧).coeff (-u)) h + simp [d, d0] at this + have hba : a = d * b := rfl + rw [show b = a * d⁻¹ by rw [hba, mul_comm d b, mul_inv_cancel_right₀ hd0]] + exact (Subring.fracSubring _).mul_mem haF (Subring.inv_mem_fracSubring hdF) + +/-- For the zero exponent group, a coefficient-level fraction-subring equality lifts to the +`κ`-bounded Hahn truncation integer part. -/ +theorem fracSubring_cardSuppLTTruncationIntegerPart_eq_top_of_subsingleton (Z : Subring R) + [Subsingleton G] (hfrac : Subring.fracSubring Z = ⊤) : + Subring.fracSubring + (cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) = ⊤ := by + apply top_unique + intro b _ + let r : R := (b : R⟦G⟧).coeff 0 + have hrF : r ∈ Subring.fracSubring Z := by + rw [hfrac] + trivial + obtain ⟨z, hzZ, hz0, hzrZ⟩ := Subring.exists_den hrF + let d0 : R⟦G⟧ := single 0 z + have hdcard : d0.cardSupp < κ := + (cardSupp_single_le (0 : G) z).trans_lt + (one_lt_aleph0.trans (Fact.out : ℵ₀ < κ)) + let d : CardSuppLTField (G := G) (R := R) (κ := κ) := ⟨d0, hdcard⟩ + have hdmem : d ∈ cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z := by + rw [mem_cardSuppLTTruncationIntegerPart] + constructor + · intro g hg + have hg_eq : g = 0 := Subsingleton.elim _ _ + simp [hg_eq] + · simpa [d, d0] using hzZ + let a0 : R⟦G⟧ := single 0 (z * r) + have hacard : a0.cardSupp < κ := + (cardSupp_single_le (0 : G) (z * r)).trans_lt + (one_lt_aleph0.trans (Fact.out : ℵ₀ < κ)) + let a : CardSuppLTField (G := G) (R := R) (κ := κ) := ⟨a0, hacard⟩ + have hamem : a ∈ cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z := by + rw [mem_cardSuppLTTruncationIntegerPart] + constructor + · intro g hg + have hg_eq : g = 0 := Subsingleton.elim _ _ + simp [hg_eq] + · simpa [a, a0] using hzrZ + have hbC : (b : R⟦G⟧) = single 0 r := by + ext g + have hg : g = 0 := Subsingleton.elim _ _ + subst g + simp [r] + have hdF : d ∈ Subring.fracSubring + (cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) := + Subring.le_fracSubring hdmem + have haF : a ∈ Subring.fracSubring + (cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) := + Subring.le_fracSubring hamem + have hd0 : d ≠ 0 := by + intro h + have := congrArg (fun w : CardSuppLTField (G := G) (R := R) (κ := κ) => + (w : R⟦G⟧).coeff 0) h + simp [d, d0, hz0] at this + have hba : a = d * b := by + apply Subtype.ext + change a0 = d0 * (b : R⟦G⟧) + rw [hbC] + simp [a0, d0] + rw [show b = a * d⁻¹ by rw [hba, mul_comm d b, mul_inv_cancel_right₀ hd0]] + exact (Subring.fracSubring _).mul_mem haF (Subring.inv_mem_fracSubring hdF) + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEmbedding.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEmbedding.lean new file mode 100644 index 0000000000..19143f4aad --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEmbedding.lean @@ -0,0 +1,363 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexFactorSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexQuotientSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Domain +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEmbedding + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupSupport + +/-! +# Exponent-domain embeddings of cardinal-bounded Hahn integer parts + +An additive order embedding of exponent groups induces embeddings of the cardinal-bounded Hahn +fields and their nonpositive integer parts. Restriction along the exponent embedding is a left +inverse, and a right inverse on series whose support lies in the embedding's range. +-/ + +open Cardinal + +universe u v w + +public noncomputable section + +namespace HahnSeries + +variable {G : Type u} {H : Type u} {R : Type v} {κ : Cardinal.{u}} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [AddCommGroup H] [LinearOrder H] [IsOrderedAddMonoid H] +variable [Field R] [Fact (aleph0 < κ)] + +/-- Map a cardinal-bounded Hahn field along an injective additive order embedding. -/ +def cardSuppLTFieldMapDomain (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') : + CardSuppLTField (G := G) (R := R) (κ := κ) →+* + CardSuppLTField (G := H) (R := R) (κ := κ) where + toFun x := ⟨HahnSeries.embDomain (⟨⟨f, hfi⟩, hf _ _⟩ : G ↪o H) x, by + rw [HahnSeries.mem_cardSuppLTSubfield, HahnSeries.cardSupp_embDomain] + exact x.2⟩ + map_one' := by + apply Subtype.ext + exact map_one (HahnSeries.embDomainRingHom f hfi hf) + map_mul' x y := by + apply Subtype.ext + exact map_mul (HahnSeries.embDomainRingHom f hfi hf) (x : R⟦G⟧) y + map_zero' := by + apply Subtype.ext + exact map_zero (HahnSeries.embDomainRingHom f hfi hf) + map_add' x y := by + apply Subtype.ext + exact map_add (HahnSeries.embDomainRingHom f hfi hf) (x : R⟦G⟧) y + +@[simp] +theorem coe_cardSuppLTFieldMapDomain (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') + (x : CardSuppLTField (G := G) (R := R) (κ := κ)) : + (cardSuppLTFieldMapDomain f hfi hf x : R⟦H⟧) = + HahnSeries.embDomain (⟨⟨f, hfi⟩, hf _ _⟩ : G ↪o H) (x : R⟦G⟧) := + (rfl) + +/-- Map a cardinal-bounded Hahn integer part along an injective additive order embedding. -/ +def CardSuppLTTruncationIntegerPart.mapDomain (f : G →+ H) + (hfi : Function.Injective f) (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') + (Z : Subring R) : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z →+* + cardSuppLTTruncationIntegerPart (G := H) (R := R) (κ := κ) Z := + ((cardSuppLTFieldMapDomain f hfi hf).domRestrict + (cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z)).codRestrict + (cardSuppLTTruncationIntegerPart (G := H) (R := R) (κ := κ) Z) (fun x ↦ by + rw [mem_cardSuppLTTruncationIntegerPart] + have hx := (mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp x.2 + constructor + · change (HahnSeries.embDomain + (⟨⟨f, hfi⟩, hf _ _⟩ : G ↪o H) (x : R⟦G⟧)).support ⊆ Set.Iic 0 + rw [HahnSeries.support_embDomain] + rintro _ ⟨g, hg, rfl⟩ + change f g ≤ 0 + simpa only [map_zero] using (hf g 0).mpr (hx.1 hg) + · change (HahnSeries.embDomain + (⟨⟨f, hfi⟩, hf _ _⟩ : G ↪o H) (x : R⟦G⟧)).coeff 0 ∈ Z + have h := HahnSeries.embDomain_coeff + (f := (⟨⟨f, hfi⟩, hf _ _⟩ : G ↪o H)) (x := (x : R⟦G⟧)) (a := 0) + have he0 : (⟨⟨f, hfi⟩, hf _ _⟩ : G ↪o H) 0 = 0 := f.map_zero + rw [he0] at h + exact h.symm ▸ hx.2 + ) + +@[simp] +theorem CardSuppLTTruncationIntegerPart.coe_mapDomain + (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + (((CardSuppLTTruncationIntegerPart.mapDomain f hfi hf Z x : + cardSuppLTTruncationIntegerPart (G := H) (R := R) (κ := κ) Z) : + CardSuppLTField (G := H) (R := R) (κ := κ)) : R⟦H⟧) = + HahnSeries.embDomain (⟨⟨f, hfi⟩, hf _ _⟩ : G ↪o H) (x : R⟦G⟧) := + (rfl) + +/-- Restrict a cardinal-bounded Hahn integer-part element to an embedded exponent domain. -/ +def CardSuppLTTruncationIntegerPart.restrictDomain + (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := H) (R := R) (κ := κ) Z) : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z := by + let e : G ↪o H := ⟨⟨f, hfi⟩, hf _ _⟩ + let y : R⟦G⟧ := HahnSeries.restrictDomain e (x : R⟦H⟧) + have hycard : y.cardSupp < κ := by + rw [HahnSeries.cardSupp] + apply (Cardinal.mk_le_of_injective (f := fun g : y.support ↦ + (⟨f g.1, by + rw [HahnSeries.mem_support] + have hg := (HahnSeries.mem_support _ _).mp g.2 + change (x : R⟦H⟧).coeff (e g.1) ≠ 0 + simpa only [y, HahnSeries.restrictDomain_coeff] using hg⟩ : + (x : R⟦H⟧).support)) ?_).trans_lt x.1.2 + intro a b hab + apply Subtype.ext + exact hfi (congrArg Subtype.val hab) + exact ⟨⟨y, hycard⟩, by + rw [mem_cardSuppLTTruncationIntegerPart] + have hx := (mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp x.2 + constructor + · intro g hg + apply (hf g 0).mp + have hfg : f g ∈ (x : R⟦H⟧).support := by + rw [HahnSeries.mem_support] + have hg' := (HahnSeries.mem_support _ _).mp hg + change (x : R⟦H⟧).coeff (e g) ≠ 0 + simpa only [y, HahnSeries.restrictDomain_coeff] using hg' + rw [f.map_zero] + exact hx.1 hfg + · change y.coeff 0 ∈ Z + rw [HahnSeries.restrictDomain_coeff] + change (x : R⟦H⟧).coeff (f 0) ∈ Z + rw [f.map_zero] + exact hx.2⟩ + +@[simp] +theorem CardSuppLTTruncationIntegerPart.coe_restrictDomain + (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := H) (R := R) (κ := κ) Z) : + ((CardSuppLTTruncationIntegerPart.restrictDomain f hfi hf Z x : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : R⟦G⟧) = + HahnSeries.restrictDomain (⟨⟨f, hfi⟩, hf _ _⟩ : G ↪o H) (x : R⟦H⟧) := + (rfl) + +/-- The bundled outer-zero coefficient of convex quotient regrouping is bounded integer-part +restriction to the convex submodule. -/ +theorem CardSuppLTTruncationIntegerPart.coeff_zero_convexQuotientSplitRingEquiv + {K : Type w} [Field K] [Module K H] [Fact κ.IsRegular] + (P : Submodule K H) [P.toAddSubgroup.IsConvex] (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := H) (R := R) (κ := κ) Z) : + (⟨((cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z x).1.1.coeff 0), + ((mem_cardSuppLTTruncationIntegerPart + (Z := cardSuppLTTruncationIntegerPart + (G := P) (R := R) (κ := κ) Z)).mp + (cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z x).2).2⟩ : + cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) = + CardSuppLTTruncationIntegerPart.restrictDomain + P.toAddSubgroup.subtype Subtype.val_injective (fun _ _ ↦ Iff.rfl) Z x := by + apply Subtype.ext + apply Subtype.ext + rw [coe_restrictDomain] + ext p + have hzero : + ((((cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z x : + cardSuppLTTruncationIntegerPart (G := H ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ) + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z)) : + CardSuppLTField (G := H ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ)).1.coeff 0 : + CardSuppLTField (G := P) (R := R) (κ := κ)) : R⟦P⟧) = + HahnSeries.restrictDomain (submoduleOrderEmbedding P) (x : R⟦H⟧) := by + rw [coe_cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv] + exact coe_coeff_zero_boundedConvexQuotientSplit P x.1 + have hp := congrArg (fun z : R⟦P⟧ ↦ z.coeff p) hzero + rw [HahnSeries.restrictDomain_coeff] at hp ⊢ + change (↑((cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + P Z x).1.1.coeff 0) : R⟦P⟧).coeff p = (x : R⟦H⟧).coeff (p : H) + simpa only [submoduleOrderEmbedding_apply] using hp + +@[simp] +theorem CardSuppLTTruncationIntegerPart.restrictDomain_mapDomain + (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + CardSuppLTTruncationIntegerPart.restrictDomain f hfi hf Z + (CardSuppLTTruncationIntegerPart.mapDomain f hfi hf Z x) = x := by + apply Subtype.ext + apply Subtype.ext + exact HahnSeries.restrictDomain_embDomain _ _ + +theorem CardSuppLTTruncationIntegerPart.mapDomain_restrictDomain + (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := H) (R := R) (κ := κ) Z) + (hx : (x : R⟦H⟧).support ⊆ Set.range f) : + CardSuppLTTruncationIntegerPart.mapDomain f hfi hf Z + (CardSuppLTTruncationIntegerPart.restrictDomain f hfi hf Z x) = x := by + apply Subtype.ext + apply Subtype.ext + exact HahnSeries.embDomain_restrictDomain _ _ hx + +open Classical in +/-- Embedding after restriction keeps exactly the exponents in the embedding's range. -/ +theorem CardSuppLTTruncationIntegerPart.coe_mapDomain_restrictDomain + (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := H) (R := R) (κ := κ) Z) : + ((CardSuppLTTruncationIntegerPart.mapDomain f hfi hf Z + (CardSuppLTTruncationIntegerPart.restrictDomain f hfi hf Z x) : + cardSuppLTTruncationIntegerPart (G := H) (R := R) (κ := κ) Z) : R⟦H⟧) = + HahnSeries.filter (· ∈ f.range) (x : R⟦H⟧) := by + ext h + rw [CardSuppLTTruncationIntegerPart.coe_mapDomain, + CardSuppLTTruncationIntegerPart.coe_restrictDomain] + let e : G ↪o H := ⟨⟨f, hfi⟩, hf _ _⟩ + change (HahnSeries.embDomain e + (HahnSeries.restrictDomain e (x : R⟦H⟧))).coeff h = _ + by_cases hh : h ∈ f.range + · obtain ⟨g, rfl⟩ := hh + change (HahnSeries.embDomain e + (HahnSeries.restrictDomain e (x : R⟦H⟧))).coeff (e g) = _ + rw [HahnSeries.embDomain_coeff, HahnSeries.restrictDomain_coeff, + HahnSeries.coeff_filter, if_pos] + · rfl + · exact Set.mem_range_self g + · rw [HahnSeries.embDomain_notin_range] + · rw [HahnSeries.coeff_filter, if_neg hh] + · exact hh + +namespace CardSuppLTTruncationIntegerPart + +/-- If the image exponent subgroup is convex, primality of an embedded bounded integer-part +element descends to the original exponent domain. -/ +theorem isPrimal_of_isPrimal_mapDomain + (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') (Z : Subring R) + (hrange : (Set.range f).OrdConnected) + (a : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (ha : IsPrimal (mapDomain f hfi hf Z a)) : IsPrimal a := by + let F : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z →+* + cardSuppLTTruncationIntegerPart (G := H) (R := R) (κ := κ) Z := + mapDomain f hfi hf Z + let C : AddSubgroup H := f.range + have hC : (C : Set H).OrdConnected := by + simpa only [C, AddMonoidHom.coe_range] using hrange + rcases eq_or_ne a 0 with rfl | ha0 + · exact isPrimal_zero + intro b c ⟨q, hq⟩ + have hdiv : F a ∣ F b * F c := by + refine ⟨F q, ?_⟩ + rw [← map_mul, hq, map_mul] + obtain ⟨a₁, a₂, ⟨q₁, hq₁⟩, ⟨q₂, hq₂⟩, ha₁a₂⟩ := ha hdiv + have hFa0 : F a ≠ 0 := by + intro h + apply ha0 + apply Subtype.ext + apply Subtype.ext + have hraw := congrArg (fun x : cardSuppLTTruncationIntegerPart + (G := H) (R := R) (κ := κ) Z ↦ (x : R⟦H⟧)) h + rw [coe_mapDomain] at hraw + exact HahnSeries.embDomain_injective (by simpa using hraw) + have ha₁0 : a₁ ≠ 0 := fun h ↦ hFa0 (by rw [ha₁a₂, h, zero_mul]) + have ha₂0 : a₂ ≠ 0 := fun h ↦ hFa0 (by rw [ha₁a₂, h, mul_zero]) + have ha₁N0 : toNonpositiveRingHom Z a₁ ≠ 0 := by + intro h + apply ha₁0 + apply toNonpositiveRingHom_injective Z + exact h.trans (map_zero _).symm + have ha₂N0 : toNonpositiveRingHom Z a₂ ≠ 0 := by + intro h + apply ha₂0 + apply toNonpositiveRingHom_injective Z + exact h.trans (map_zero _).symm + have hFasupp : ((F a : cardSuppLTTruncationIntegerPart + (G := H) (R := R) (κ := κ) Z) : R⟦H⟧).support ⊆ (C : Set H) := by + rw [coe_mapDomain, HahnSeries.support_embDomain] + exact Set.image_subset_range _ _ + have ha₁a₂raw : ((a₁ * a₂ : cardSuppLTTruncationIntegerPart + (G := H) (R := R) (κ := κ) Z) : R⟦H⟧) = (F a : R⟦H⟧) := by + exact congrArg (fun x : cardSuppLTTruncationIntegerPart + (G := H) (R := R) (κ := κ) Z ↦ (x : R⟦H⟧)) ha₁a₂.symm + have hsuppFactors := HahnSeries.Nonpositive.support_subset_convex_of_mul_support_subset + hC (a := toNonpositiveRingHom Z a₁) (b := toNonpositiveRingHom Z a₂) + ha₁N0 ha₂N0 (by + have heq : (toNonpositiveRingHom Z a₁ * toNonpositiveRingHom Z a₂ : + HahnSeries.Nonpositive H R) = toNonpositiveRingHom Z (a₁ * a₂) := by + rw [map_mul] + rw [heq, coe_toNonpositiveRingHom, ha₁a₂raw] + exact hFasupp) + have ha₁supp : (a₁ : R⟦H⟧).support ⊆ (C : Set H) := by + simpa only [coe_toNonpositiveRingHom] using hsuppFactors.1 + have ha₂supp : (a₂ : R⟦H⟧).support ⊆ (C : Set H) := by + simpa only [coe_toNonpositiveRingHom] using hsuppFactors.2 + have hq₁supp : (q₁ : R⟦H⟧).support ⊆ (C : Set H) := by + apply HahnSeries.support_subset_of_mul_eq + (e := (a₁ : R⟦H⟧)) (u := (q₁ : R⟦H⟧)) (f := (F b : R⟦H⟧)) + · exact ha₁supp + · exact fun h ↦ ha₁0 (Subtype.ext (Subtype.ext h)) + · rw [coe_mapDomain, HahnSeries.support_embDomain] + exact Set.image_subset_range _ _ + · exact congrArg (fun x : cardSuppLTTruncationIntegerPart + (G := H) (R := R) (κ := κ) Z ↦ (x : R⟦H⟧)) hq₁ + have hq₂supp : (q₂ : R⟦H⟧).support ⊆ (C : Set H) := by + apply HahnSeries.support_subset_of_mul_eq + (e := (a₂ : R⟦H⟧)) (u := (q₂ : R⟦H⟧)) (f := (F c : R⟦H⟧)) + · exact ha₂supp + · exact fun h ↦ ha₂0 (Subtype.ext (Subtype.ext h)) + · rw [coe_mapDomain, HahnSeries.support_embDomain] + exact Set.image_subset_range _ _ + · exact congrArg (fun x : cardSuppLTTruncationIntegerPart + (G := H) (R := R) (κ := κ) Z ↦ (x : R⟦H⟧)) hq₂ + let A₁ := restrictDomain f hfi hf Z a₁ + let A₂ := restrictDomain f hfi hf Z a₂ + let Q₁ := restrictDomain f hfi hf Z q₁ + let Q₂ := restrictDomain f hfi hf Z q₂ + have hmapA₁ : F A₁ = a₁ := mapDomain_restrictDomain f hfi hf Z a₁ (by + simpa only [C, AddMonoidHom.coe_range] using ha₁supp) + have hmapA₂ : F A₂ = a₂ := mapDomain_restrictDomain f hfi hf Z a₂ (by + simpa only [C, AddMonoidHom.coe_range] using ha₂supp) + have hmapQ₁ : F Q₁ = q₁ := mapDomain_restrictDomain f hfi hf Z q₁ (by + simpa only [C, AddMonoidHom.coe_range] using hq₁supp) + have hmapQ₂ : F Q₂ = q₂ := mapDomain_restrictDomain f hfi hf Z q₂ (by + simpa only [C, AddMonoidHom.coe_range] using hq₂supp) + refine ⟨A₁, A₂, ⟨Q₁, ?_⟩, ⟨Q₂, ?_⟩, ?_⟩ + · apply Subtype.ext + apply Subtype.ext + have hF : F b = F (A₁ * Q₁) := by + rw [map_mul, hmapA₁, hmapQ₁] + exact hq₁ + have hraw := congrArg (fun x : cardSuppLTTruncationIntegerPart + (G := H) (R := R) (κ := κ) Z ↦ (x : R⟦H⟧)) hF + rw [coe_mapDomain, coe_mapDomain] at hraw + exact HahnSeries.embDomain_injective hraw + · apply Subtype.ext + apply Subtype.ext + have hF : F c = F (A₂ * Q₂) := by + rw [map_mul, hmapA₂, hmapQ₂] + exact hq₂ + have hraw := congrArg (fun x : cardSuppLTTruncationIntegerPart + (G := H) (R := R) (κ := κ) Z ↦ (x : R⟦H⟧)) hF + rw [coe_mapDomain, coe_mapDomain] at hraw + exact HahnSeries.embDomain_injective hraw + · apply Subtype.ext + apply Subtype.ext + have hF : F a = F (A₁ * A₂) := by + rw [map_mul, hmapA₁, hmapA₂] + exact ha₁a₂ + have hraw := congrArg (fun x : cardSuppLTTruncationIntegerPart + (G := H) (R := R) (κ := κ) Z ↦ (x : R⟦H⟧)) hF + rw [coe_mapDomain, coe_mapDomain] at hraw + exact HahnSeries.embDomain_injective hraw + +end CardSuppLTTruncationIntegerPart + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEquiv.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEquiv.lean new file mode 100644 index 0000000000..804dfc6d01 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEquiv.lean @@ -0,0 +1,135 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEquiv + +/-! +# Exponent reindexing for cardinal-bounded Hahn integer parts + +An ordered additive equivalence of exponent groups preserves support cardinality, nonpositive +support, and the coefficient at zero. It therefore reindexes both the cardinal-bounded Hahn field +and its truncation integer part. +-/ + +universe u v + +public noncomputable section + +namespace HahnSeries + +open Cardinal + +variable {G H : Type u} {R : Type v} {κ : Cardinal.{u}} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [AddCommGroup H] [LinearOrder H] [IsOrderedAddMonoid H] +variable [Field R] [Fact (ℵ₀ < κ)] + +/-- Reindex a cardinal-bounded Hahn field along an ordered additive equivalence. -/ +def cardSuppLTFieldRingEquiv (e : G ≃+o H) : + CardSuppLTField (G := G) (R := R) (κ := κ) ≃+* + CardSuppLTField (G := H) (R := R) (κ := κ) where + toFun x := ⟨embDomainRingEquiv e x, by + rw [mem_cardSuppLTSubfield, cardSupp_embDomainRingEquiv] + exact x.2⟩ + invFun x := ⟨embDomainRingEquiv e.symm x, by + rw [mem_cardSuppLTSubfield, cardSupp_embDomainRingEquiv] + exact x.2⟩ + left_inv x := by + apply Subtype.ext + ext g + have houter := embDomainRingEquiv_coeff e.symm + (embDomainRingEquiv e (x : R⟦G⟧)) (e g) + rw [e.symm_apply_apply, embDomainRingEquiv_coeff] at houter + exact houter + right_inv x := by + apply Subtype.ext + ext h + have houter := embDomainRingEquiv_coeff e + (embDomainRingEquiv e.symm (x : R⟦H⟧)) (e.symm h) + rw [e.apply_symm_apply, embDomainRingEquiv_coeff] at houter + exact houter + map_mul' x y := by + apply Subtype.ext + exact map_mul (embDomainRingEquiv e) (x : R⟦G⟧) y + map_add' x y := by + apply Subtype.ext + exact map_add (embDomainRingEquiv e) (x : R⟦G⟧) y + +/-- Coercing a reindexed bounded series gives unrestricted exponent reindexing. -/ +@[simp] +theorem coe_cardSuppLTFieldRingEquiv (e : G ≃+o H) + (x : CardSuppLTField (G := G) (R := R) (κ := κ)) : + (cardSuppLTFieldRingEquiv e x : R⟦H⟧) = embDomainRingEquiv e x := + (rfl) + +/-- Reindex a cardinal-bounded truncation integer part along an ordered additive equivalence. -/ +def cardSuppLTTruncationIntegerPartRingEquiv (e : G ≃+o H) (Z : Subring R) : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z ≃+* + cardSuppLTTruncationIntegerPart (G := H) (R := R) (κ := κ) Z where + toFun x := ⟨cardSuppLTFieldRingEquiv e x, by + rw [mem_cardSuppLTTruncationIntegerPart] + have hx := (mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp x.2 + constructor + · intro h hh + rw [coe_cardSuppLTFieldRingEquiv, support_embDomainRingEquiv] at hh + obtain ⟨g, hg, rfl⟩ := hh + change e g ≤ 0 + calc + e g ≤ e 0 := e.map_le_map_iff'.mpr (hx.1 hg) + _ = 0 := map_zero e + · change (embDomainRingEquiv e (x : R⟦G⟧)).coeff 0 ∈ Z + rw [← map_zero e, embDomainRingEquiv_coeff] + exact hx.2⟩ + invFun x := ⟨cardSuppLTFieldRingEquiv e.symm x, by + rw [mem_cardSuppLTTruncationIntegerPart] + have hx := (mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp x.2 + constructor + · intro g hg + rw [coe_cardSuppLTFieldRingEquiv, support_embDomainRingEquiv] at hg + obtain ⟨h, hh, rfl⟩ := hg + change e.symm h ≤ 0 + calc + e.symm h ≤ e.symm 0 := e.symm.map_le_map_iff'.mpr (hx.1 hh) + _ = 0 := map_zero e.symm + · change (embDomainRingEquiv e.symm (x : R⟦H⟧)).coeff 0 ∈ Z + rw [← map_zero e.symm, embDomainRingEquiv_coeff] + exact hx.2⟩ + left_inv x := by + apply Subtype.ext + apply Subtype.ext + ext g + have houter := embDomainRingEquiv_coeff e.symm + (embDomainRingEquiv e (x : R⟦G⟧)) (e g) + rw [e.symm_apply_apply, embDomainRingEquiv_coeff] at houter + exact houter + right_inv x := by + apply Subtype.ext + apply Subtype.ext + ext h + have houter := embDomainRingEquiv_coeff e + (embDomainRingEquiv e.symm (x : R⟦H⟧)) (e.symm h) + rw [e.apply_symm_apply, embDomainRingEquiv_coeff] at houter + exact houter + map_mul' x y := by + apply Subtype.ext + exact map_mul (cardSuppLTFieldRingEquiv e) x.1 y.1 + map_add' x y := by + apply Subtype.ext + exact map_add (cardSuppLTFieldRingEquiv e) x.1 y.1 + +/-- The bounded integer-part equivalence applies through the bounded field equivalence. -/ +@[simp] +theorem coe_cardSuppLTTruncationIntegerPartRingEquiv + (e : G ≃+o H) (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + ((cardSuppLTTruncationIntegerPartRingEquiv e Z x : + CardSuppLTField (G := H) (R := R) (κ := κ)) : R⟦H⟧) = + embDomainRingEquiv e (x : CardSuppLTField (G := G) (R := R) (κ := κ)) := + (rfl) + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationIrreducible.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationIrreducible.lean new file mode 100644 index 0000000000..52b11a2be8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationIrreducible.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Monomial + +/-! +# Irreducibility and support-cardinality bounds + +Forgetting a support-cardinality bound embeds a bounded truncation integer part into its +unbounded counterpart. This embedding reflects units: an inverse in the unbounded ring is a +nonzero constant series, hence still has bounded support. It therefore also reflects +irreducibility. +-/ + +universe u v + +public noncomputable section + +open Cardinal + +namespace HahnSeries.CardSuppLTTruncationIntegerPart + +variable {G : Type u} {R : Type v} {κ : Cardinal.{u}} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Field R] +variable [Fact (ℵ₀ < κ)] + +/-- A bounded truncation-integer-part element is a unit whenever it becomes a unit after the +support-cardinality bound is forgotten. -/ +theorem isUnit_of_isUnit_toTruncationIntegerPart + (Z : Subring R) + {x : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z} + (hx : IsUnit (toTruncationIntegerPartRingHom Z x)) : + IsUnit x := by + obtain ⟨u, hu⟩ := hx + let y : HahnSeries.truncationIntegerPart G Z := ↑u⁻¹ + have hyUnit : IsUnit (y : HahnSeries.Nonpositive G R) := by + exact (HahnSeries.truncationIntegerPart G Z).subtype.isUnit_map + (show IsUnit y by exact (u⁻¹).isUnit) + have hySupport : ((y : HahnSeries.Nonpositive G R) : R⟦G⟧).support = {0} := + HahnSeries.Nonpositive.support_eq_singleton_zero_of_isUnit hyUnit + have hyCard : ((y : HahnSeries.Nonpositive G R) : R⟦G⟧).cardSupp < κ := by + rw [HahnSeries.cardSupp, hySupport, Cardinal.mk_singleton] + exact Cardinal.one_lt_aleph0.trans (Fact.out : ℵ₀ < κ) + let yBounded : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z := + ⟨⟨(y : HahnSeries.Nonpositive G R), hyCard⟩, by + rw [HahnSeries.mem_cardSuppLTTruncationIntegerPart] + exact ⟨HahnSeries.Nonpositive.support_subset (y : HahnSeries.Nonpositive G R), + (HahnSeries.mem_truncationIntegerPart (R := R) (Γ := G)).mp y.2⟩⟩ + have hyForget : toTruncationIntegerPartRingHom Z yBounded = y := by + apply Subtype.ext + apply Subtype.ext + rw [coe_toTruncationIntegerPartRingHom, coe_toNonpositiveRingHom] + apply isUnit_iff_exists.mpr + refine ⟨yBounded, ?_, ?_⟩ + · apply toTruncationIntegerPartRingHom_injective Z + rw [map_mul, map_one, hyForget] + change toTruncationIntegerPartRingHom Z x * y = 1 + rw [← hu] + simp [y] + · apply toTruncationIntegerPartRingHom_injective Z + rw [map_mul, map_one, hyForget] + change y * toTruncationIntegerPartRingHom Z x = 1 + rw [← hu] + simp [y] + +/-- Irreducibility after forgetting a support-cardinality bound implies irreducibility before +forgetting it. -/ +theorem irreducible_of_irreducible_toTruncationIntegerPart + (Z : Subring R) + {x : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z} + (hx : Irreducible (toTruncationIntegerPartRingHom Z x)) : + Irreducible x := by + rw [irreducible_iff] + refine ⟨?_, ?_⟩ + · intro hunit + exact hx.not_isUnit (hunit.map (toTruncationIntegerPartRingHom Z)) + · intro c d hfactor + have hfactor' : toTruncationIntegerPartRingHom Z x = + toTruncationIntegerPartRingHom Z c * + toTruncationIntegerPartRingHom Z d := by + rw [← map_mul, hfactor] + rcases hx.isUnit_or_isUnit hfactor' with hc | hd + · exact Or.inl (isUnit_of_isUnit_toTruncationIntegerPart Z hc) + · exact Or.inr (isUnit_of_isUnit_toTruncationIntegerPart Z hd) + +end HahnSeries.CardSuppLTTruncationIntegerPart diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationResidue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationResidue.lean new file mode 100644 index 0000000000..53315cd9ff --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationResidue.lean @@ -0,0 +1,248 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation + +/-! +# Residues of cardinal-bounded nonpositive Hahn series + +The cardinal-bounded nonpositive Hahn series form an algebra over their coefficient field. +Coefficient at exponent zero is an algebra retraction, and imposing that this residue lie in a +coefficient subring recovers the usual cardinal-bounded truncation integer part. + +This is the bounded counterpart of +`HahnSeries.Nonpositive.truncationIntegerPartEquivResidueSubring`. It allows equation-local +residue normalization without forgetting the support-cardinality bound. +-/ + +public noncomputable section + +open Cardinal +open scoped HahnSeries + +universe u v + +namespace HahnSeries + +variable {G : Type u} {L : Type v} {κ : Cardinal.{u}} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Field L] [Fact (aleph0 < κ)] + +/-- Cardinal-bounded Hahn series with nonpositive support. -/ +abbrev CardSuppLTNonpositive := cardSuppLTTruncationIntegerPart + (G := G) (R := L) (κ := κ) (⊤ : Subring L) + +/-- Constant series as a ring map into cardinal-bounded nonpositive Hahn series. -/ +noncomputable def CardSuppLTNonpositive.C : + L →+* CardSuppLTNonpositive (G := G) (L := L) (κ := κ) where + toFun r := ⟨⟨HahnSeries.C r, by + exact (HahnSeries.cardSupp_single_le (0 : G) r).trans_lt + (one_lt_aleph0.trans (Fact.out : aleph0 < κ))⟩, by + rw [mem_cardSuppLTTruncationIntegerPart] + constructor + · intro g hg + have hg0 : g = 0 := HahnSeries.support_single_subset hg + exact hg0 ▸ le_rfl + · exact Subring.mem_top _⟩ + map_one' := by + apply Subtype.ext + apply Subtype.ext + exact map_one HahnSeries.C + map_mul' x y := by + apply Subtype.ext + apply Subtype.ext + exact map_mul HahnSeries.C x y + map_zero' := by + apply Subtype.ext + apply Subtype.ext + exact map_zero HahnSeries.C + map_add' x y := by + apply Subtype.ext + apply Subtype.ext + exact map_add HahnSeries.C x y + +/-- Cardinal-bounded nonpositive Hahn series form an algebra over their coefficient field. -/ +noncomputable instance : Algebra L (CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) where + algebraMap := CardSuppLTNonpositive.C + smul r x := CardSuppLTNonpositive.C r * x + commutes' _ _ := mul_comm _ _ + smul_def' _ _ := rfl + +namespace CardSuppLTNonpositive + +/-- Coefficient at exponent zero as an algebra retraction on bounded nonpositive series. -/ +def constantCoeffAlgHom : + CardSuppLTNonpositive (G := G) (L := L) (κ := κ) →ₐ[L] L where + toFun x := (x : L⟦G⟧).coeff 0 + map_one' := by simp + map_mul' x y := by + have hx := (mem_cardSuppLTTruncationIntegerPart (Z := (⊤ : Subring L))).mp x.2 + have hy := (mem_cardSuppLTTruncationIntegerPart (Z := (⊤ : Subring L))).mp y.2 + let x' : HahnSeries.Nonpositive G L := ⟨x, hx.1⟩ + let y' : HahnSeries.Nonpositive G L := ⟨y, hy.1⟩ + exact HahnSeries.Nonpositive.coeff_zero_mul x' y' + map_zero' := by simp + map_add' x y := by simp + commutes' r := by + change (HahnSeries.C r : L⟦G⟧).coeff 0 = r + simp + +@[simp] +theorem constantCoeffAlgHom_apply + (x : CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) : + constantCoeffAlgHom x = (x : L⟦G⟧).coeff 0 := + (rfl) + +/-- The canonical identity-on-series equivalence between the bounded truncation integer part and +the residue-preimage presentation inside bounded nonpositive Hahn series. -/ +def truncationIntegerPartEquivResidueSubring (S : Subring L) : + cardSuppLTTruncationIntegerPart (G := G) (R := L) (κ := κ) S ≃+* + Subring.residueSubring + (constantCoeffAlgHom (G := G) (L := L) (κ := κ)) S where + toFun x := ⟨⟨x, by + rw [mem_cardSuppLTTruncationIntegerPart] + exact ⟨((mem_cardSuppLTTruncationIntegerPart (Z := S)).mp x.2).1, + Subring.mem_top _⟩⟩, by + rw [Subring.mem_residueSubring, constantCoeffAlgHom_apply] + exact ((mem_cardSuppLTTruncationIntegerPart (Z := S)).mp x.2).2⟩ + invFun x := ⟨x.1.1, by + rw [mem_cardSuppLTTruncationIntegerPart] + exact ⟨((mem_cardSuppLTTruncationIntegerPart (Z := (⊤ : Subring L))).mp x.1.2).1, + x.2⟩⟩ + left_inv _ := rfl + right_inv _ := rfl + map_mul' _ _ := rfl + map_add' _ _ := rfl + +/-- The residue-subring presentation does not change the underlying Hahn series. -/ +@[simp] +theorem coe_truncationIntegerPartEquivResidueSubring (S : Subring L) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := L) (κ := κ) S) : + ((((truncationIntegerPartEquivResidueSubring S x : + Subring.residueSubring constantCoeffAlgHom S) : + CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) : L⟦G⟧)) = + (x : L⟦G⟧) := + (rfl) + +/-- An exact ambient refinement of bounded nonpositive series can be normalized into the bounded +truncation integer part using primality of the first constant coefficient. -/ +theorem exists_refinement_truncationIntegerPart_of_ambient + (S : Subring L) + {a b c d : cardSuppLTTruncationIntegerPart + (G := G) (R := L) (κ := κ) S} + (haS : IsPrimal (⟨(a : L⟦G⟧).coeff 0, + ((mem_cardSuppLTTruncationIntegerPart (Z := S)).mp a.2).2⟩ : S)) + (hfrac : Subring.fracSubring S = ⊤) (ha0 : a ≠ 0) + (habcd : a * b = c * d) + {e f g h : CardSuppLTNonpositive (G := G) (L := L) (κ := κ)} + (ha : ((truncationIntegerPartEquivResidueSubring S a : + Subring.residueSubring constantCoeffAlgHom S) : + CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) = e * f) + (hb : ((truncationIntegerPartEquivResidueSubring S b : + Subring.residueSubring constantCoeffAlgHom S) : + CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) = g * h) + (hc : ((truncationIntegerPartEquivResidueSubring S c : + Subring.residueSubring constantCoeffAlgHom S) : + CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) = e * g) + (hd : ((truncationIntegerPartEquivResidueSubring S d : + Subring.residueSubring constantCoeffAlgHom S) : + CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) = f * h) : + ∃ E F H₁ H₂ : cardSuppLTTruncationIntegerPart + (G := G) (R := L) (κ := κ) S, + a = E * F ∧ b = H₁ * H₂ ∧ c = E * H₁ ∧ d = F * H₂ := by + let Φ := truncationIntegerPartEquivResidueSubring + (G := G) (L := L) (κ := κ) S + have haS' : IsPrimal + (⟨constantCoeffAlgHom ((Φ a : Subring.residueSubring constantCoeffAlgHom S) : + CardSuppLTNonpositive (G := G) (L := L) (κ := κ)), (Φ a).2⟩ : S) := by + convert haS using 1 + apply Subtype.ext + rfl + have ha0' : Φ a ≠ 0 := Φ.injective.ne ha0 + have habcd' : Φ a * Φ b = Φ c * Φ d := by + simpa only [map_mul] using congrArg Φ habcd + obtain ⟨E, F, H₁, H₂, ha', hb', hc', hd'⟩ := + Subring.exists_refinement_residueSubring_of_ambient haS' hfrac ha0' habcd' + ha hb hc hd + exact ⟨Φ.symm E, Φ.symm F, Φ.symm H₁, Φ.symm H₂, + by simpa using congrArg Φ.symm ha', + by simpa using congrArg Φ.symm hb', + by simpa using congrArg Φ.symm hc', + by simpa using congrArg Φ.symm hd'⟩ + +end CardSuppLTNonpositive + +namespace CardSuppLTTruncationIntegerPart + +private theorem isUnit_map_of_isUnit {M N : Type*} [Monoid M] [Monoid N] + (f : M →* N) {x : M} (hx : IsUnit x) : IsUnit (f x) := + hx.map f + +private theorem isPrimal_residueSubring_of_isUnit + {F A : Type*} [Field F] [CommRing A] [Algebra F A] [IsDomain A] + (π : A →ₐ[F] F) (S : Subring F) [DecompositionMonoid S] + {x : A} (hx : π x ∈ S) (hx0 : π x ≠ 0) (hunit : IsUnit x) : + IsPrimal (⟨x, hx⟩ : Subring.residueSubring π S) := + Subring.isPrimal_residueSubring_of_isPrimal + hx hx0 (DecompositionMonoid.primal _) hunit.isPrimal + +private theorem isPrimal_equiv_preimage + {A B : Type*} [CommRing A] [CommRing B] (e : A ≃+* B) {x : A} + (hx : IsPrimal (e x)) : IsPrimal x := + (RingEquiv.isPrimal_iff e x).mp hx + +/-- An order-zero element of a cardinal-bounded truncation integer part is primal when its +coefficient subring is pre-Schreier. -/ +theorem isPrimal_of_order_eq_zero + (S : Subring L) [DecompositionMonoid S] + (x : cardSuppLTTruncationIntegerPart (G := G) (R := L) (κ := κ) S) + (horder : ((toNonpositiveRingHom S x : Nonpositive G L) : HahnSeries G L).order = 0) : + IsPrimal x := by + let A := CardSuppLTNonpositive (G := G) (L := L) (κ := κ) + let π := CardSuppLTNonpositive.constantCoeffAlgHom (G := G) (L := L) (κ := κ) + let Φ := CardSuppLTNonpositive.truncationIntegerPartEquivResidueSubring + (G := G) (L := L) (κ := κ) S + by_cases hx : x = 0 + · rw [hx] + exact isPrimal_zero + let xN := toNonpositiveRingHom S x + have hconstant : (xN : HahnSeries G L) = HahnSeries.C ((xN : HahnSeries G L).coeff 0) := by + ext g + by_cases hg : g = 0 + · subst g + simp + · rw [HahnSeries.C_apply, HahnSeries.coeff_single_of_ne hg] + by_contra hcoeff + have hgNonpos : g ≤ 0 := Nonpositive.support_subset xN + ((HahnSeries.mem_support _ _).mpr hcoeff) + have hzeroLe : 0 ≤ g := horder ▸ HahnSeries.order_le_of_coeff_ne_zero hcoeff + exact hg (le_antisymm hgNonpos hzeroLe) + have hcoeff : (x : HahnSeries G L).coeff 0 ≠ 0 := by + intro hzero + apply hx + apply Subtype.ext + apply Subtype.ext + change (x : HahnSeries G L) = 0 + simpa only [xN, coe_toNonpositiveRingHom, hzero, map_zero] using hconstant + have hxC : (Φ x : A) = algebraMap L A ((x : HahnSeries G L).coeff 0) := by + apply Subtype.ext + apply Subtype.ext + change (x : HahnSeries G L) = HahnSeries.C ((x : HahnSeries G L).coeff 0) + simpa only [xN, coe_toNonpositiveRingHom] using hconstant + have hunit : IsUnit (Φ x : A) := by + rw [hxC] + have hcoeffUnit : IsUnit ((x : HahnSeries G L).coeff 0) := + isUnit_iff_ne_zero.mpr hcoeff + exact isUnit_map_of_isUnit (algebraMap L A).toMonoidHom hcoeffUnit + have hπ : π (Φ x : A) = (x : HahnSeries G L).coeff 0 := rfl + have hΦ : IsPrimal (Φ x) := + isPrimal_residueSubring_of_isUnit π S (Φ x).2 (hπ ▸ hcoeff) hunit + exact isPrimal_equiv_preimage Φ hΦ + +end CardSuppLTTruncationIntegerPart + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CharZero.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CharZero.lean new file mode 100644 index 0000000000..7db137d736 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CharZero.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.RingTheory.HahnSeries.Multiplication +public import Mathlib.Algebra.CharZero.Defs + +/-! +# Hahn series over a characteristic-zero base + +A Hahn series ring inherits characteristic zero from its coefficients, because the natural numbers +embed as constant series. Mathlib carries no such instance. + +This is needed to apply results stated for a characteristic-zero coefficient field to a Hahn-series +field. That happens whenever the exponent group is not Archimedean and has to be split into an +Archimedean quotient over a coefficient field that is itself a Hahn-series field. +-/ + +public section + +namespace HahnSeries + +instance instCharZero {Γ R : Type*} [LinearOrder Γ] [AddCommMonoid Γ] + [NonAssocSemiring R] [CharZero R] : CharZero (HahnSeries Γ R) where + cast_injective m n h := by + have hm : ((m : ℕ) : R) = ((n : ℕ) : R) := by + have := congrArg (fun x : HahnSeries Γ R => x.coeff 0) h + simpa [← single_zero_natCast] using this + exact Nat.cast_injective hm + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CoefficientMap.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CoefficientMap.lean new file mode 100644 index 0000000000..6227b375f8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CoefficientMap.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive + +/-! +# Coefficientwise ring homomorphisms of Hahn series + +A ring homomorphism on coefficients acts coefficientwise on Hahn series and on their +nonpositive-support subrings. Injective coefficient maps preserve support exactly. These bundled +maps provide the module-safe interface needed when a bounded Hahn field is embedded in the full +Hahn field. +-/ + +public noncomputable section + +namespace HahnSeries + +universe u v w + +section Full + +variable {Γ : Type u} {R : Type v} {S : Type w} +variable [AddCommMonoid Γ] [PartialOrder Γ] [IsOrderedCancelAddMonoid Γ] +variable [Semiring R] [Semiring S] + +/-- Apply a ring homomorphism to every coefficient of a Hahn series. -/ +def coefficientMapRingHom (f : R →+* S) : R⟦Γ⟧ →+* S⟦Γ⟧ where + toFun x := x.map f + map_one' := HahnSeries.map_one f.toMonoidWithZeroHom + map_mul' _ _ := HahnSeries.map_mul f.toNonUnitalRingHom + map_zero' := HahnSeries.map_zero f.toMonoidWithZeroHom.toZeroHom + map_add' _ _ := HahnSeries.map_add f.toAddMonoidHom + +/-- Coefficientwise mapping evaluates by applying the coefficient homomorphism. -/ +@[simp] +theorem coefficientMapRingHom_coeff (f : R →+* S) (x : R⟦Γ⟧) (g : Γ) : + (coefficientMapRingHom f x).coeff g = f (x.coeff g) := + (rfl) + +/-- An injective coefficient homomorphism preserves Hahn-series support. -/ +theorem support_coefficientMapRingHom (f : R →+* S) (hf : Function.Injective f) + (x : R⟦Γ⟧) : + (coefficientMapRingHom f x).support = x.support := by + ext g + rw [mem_support, mem_support, coefficientMapRingHom_coeff] + exact not_congr (map_eq_zero_iff f hf) + +end Full + +namespace Nonpositive + +variable {Γ : Type u} {R : Type v} {S : Type w} +variable [AddCommGroup Γ] [LinearOrder Γ] [IsOrderedAddMonoid Γ] +variable [Ring R] [Ring S] + +/-- Apply a ring homomorphism coefficientwise to a nonpositive Hahn series. -/ +def coefficientMapRingHom (f : R →+* S) : Nonpositive Γ R →+* Nonpositive Γ S where + toFun x := ⟨HahnSeries.coefficientMapRingHom f (x : R⟦Γ⟧), + (HahnSeries.support_map_subset (x : R⟦Γ⟧) f.toZeroHom).trans (support_subset x)⟩ + map_one' := Subtype.ext (map_one (HahnSeries.coefficientMapRingHom f)) + map_mul' x y := Subtype.ext + (map_mul (HahnSeries.coefficientMapRingHom f) (x : R⟦Γ⟧) (y : R⟦Γ⟧)) + map_zero' := Subtype.ext (map_zero (HahnSeries.coefficientMapRingHom f)) + map_add' x y := Subtype.ext + (map_add (HahnSeries.coefficientMapRingHom f) (x : R⟦Γ⟧) (y : R⟦Γ⟧)) + +/-- The nonpositive coefficient map acts coefficientwise. -/ +@[simp] +theorem coe_coefficientMapRingHom (f : R →+* S) (x : Nonpositive Γ R) : + (coefficientMapRingHom f x : S⟦Γ⟧) = HahnSeries.coefficientMapRingHom f x := + (rfl) + +/-- An injective coefficient homomorphism preserves nonpositive Hahn-series support. -/ +theorem support_coefficientMapRingHom (f : R →+* S) (hf : Function.Injective f) + (x : Nonpositive Γ R) : + (coefficientMapRingHom f x : S⟦Γ⟧).support = (x : R⟦Γ⟧).support := by + rw [coe_coefficientMapRingHom, HahnSeries.support_coefficientMapRingHom f hf] + +end Nonpositive + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ConvexFactorSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ConvexFactorSupport.lean new file mode 100644 index 0000000000..e3d9915aaf --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ConvexFactorSupport.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import Mathlib.RingTheory.HahnSeries.Multiplication + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Factors supported in a convex exponent subgroup + +If a product of two nonzero nonpositive Hahn series is supported in a convex subgroup of the +exponents, then both factors are supported there. Their lowest exponents add to the lowest +exponent of the product. Convexity first puts each lowest exponent in the subgroup, then puts +every later nonpositive support exponent there as well. +-/ + +universe u v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type v} +variable [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] [Field K] + +/-- Nonzero nonpositive factors of a series supported in a convex exponent subgroup are +themselves supported in that subgroup. -/ +@[blueprint "lem:convex-support-of-factors" + (phase := "Finitely many Archimedean classes") + (title := "Convexity of the supports of factors") + (statement := /-- + Let $H$ be a convex subgroup of a linearly ordered abelian group $G$. If + $a,b\in K((G^{\le0}))$ are nonzero and + $\operatorname{supp}(ab)\subseteq H$, then + \[ + \operatorname{supp}(a)\subseteq H, + \qquad + \operatorname{supp}(b)\subseteq H. + \] + -/) + (proof := /-- + The least support exponents satisfy + $\min\operatorname{supp}(ab)=\min\operatorname{supp}(a)+ + \min\operatorname{supp}(b)$. This sum and zero lie in $H$, while both + summands are nonpositive, so convexity puts each least exponent in $H$. + Every later support exponent lies between its least exponent and zero and + therefore also belongs to $H$. + -/)] +theorem support_subset_convex_of_mul_support_subset + {H : AddSubgroup G} (hH : (H : Set G).OrdConnected) + {a b : Nonpositive G K} (ha0 : a ≠ 0) (hb0 : b ≠ 0) + (habH : ((a * b : Nonpositive G K) : K⟦G⟧).support ⊆ (H : Set G)) : + (a : K⟦G⟧).support ⊆ (H : Set G) ∧ (b : K⟦G⟧).support ⊆ (H : Set G) := by + have ha0' : (a : K⟦G⟧) ≠ 0 := fun h ↦ ha0 (Subtype.ext h) + have hb0' : (b : K⟦G⟧) ≠ 0 := fun h ↦ hb0 (Subtype.ext h) + have hab0' : ((a * b : Nonpositive G K) : K⟦G⟧) ≠ 0 := mul_ne_zero ha0' hb0' + have habOrder : (a : K⟦G⟧).order + (b : K⟦G⟧).order ∈ H := by + rw [← HahnSeries.order_mul_of_ne_zero (mul_ne_zero + (HahnSeries.leadingCoeff_ne_zero.mpr ha0') + (HahnSeries.leadingCoeff_ne_zero.mpr hb0'))] + apply habH + exact (HahnSeries.mem_support _ _).mpr + (HahnSeries.coeff_order_eq_zero.not.mpr hab0') + have haOrderMem : (a : K⟦G⟧).order ∈ (a : K⟦G⟧).support := + (HahnSeries.mem_support _ _).mpr (HahnSeries.coeff_order_eq_zero.not.mpr ha0') + have hbOrderMem : (b : K⟦G⟧).order ∈ (b : K⟦G⟧).support := + (HahnSeries.mem_support _ _).mpr (HahnSeries.coeff_order_eq_zero.not.mpr hb0') + have haOrderH : (a : K⟦G⟧).order ∈ H := by + apply hH.out habOrder H.zero_mem + constructor + · simpa using add_le_add_left (support_subset b hbOrderMem) (a : K⟦G⟧).order + · exact support_subset a haOrderMem + have hbOrderH : (b : K⟦G⟧).order ∈ H := by + apply hH.out habOrder H.zero_mem + constructor + · simpa [add_comm] using + add_le_add_left (support_subset a haOrderMem) (b : K⟦G⟧).order + · exact support_subset b hbOrderMem + constructor + · intro g hg + apply hH.out haOrderH H.zero_mem + exact ⟨HahnSeries.order_le_of_coeff_ne_zero ((HahnSeries.mem_support _ _).mp hg), + support_subset a hg⟩ + · intro g hg + apply hH.out hbOrderH H.zero_mem + exact ⟨HahnSeries.order_le_of_coeff_ne_zero ((HahnSeries.mem_support _ _).mp hg), + support_subset b hg⟩ + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ConvexQuotientSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ConvexQuotientSplitting.lean new file mode 100644 index 0000000000..13cec69bea --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ConvexQuotientSplitting.lean @@ -0,0 +1,716 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ConvexQuotientSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEquiv +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Iterate +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Truncation +public import Mathlib.SetTheory.Cardinal.Regular + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CoefficientMap + +/-! +# Hahn-series splitting by a convex subspace + +An ordered vector space splits additively as the lexicographic product of the quotient by a convex +subspace and that subspace. Reindexing exponents by this splitting and unflattening the +lexicographic product regroups a Hahn series into an outer series on the quotient whose +coefficients are Hahn series on the subspace. Because the splitting is additive, this regrouping +is a ring equivalence. +-/ + +public noncomputable section + +namespace HahnSeries + +universe u v w + +variable {R : Type v} {K : Type w} {G : Type u} [Semiring R] +variable [Field K] [AddCommGroup G] [Module K G] +variable [LinearOrder G] [IsOrderedAddMonoid G] + +noncomputable instance quotientLinearOrder (P : Submodule K G) + [P.toAddSubgroup.IsConvex] : LinearOrder (G ⧸ P) := + ConvexQuotient.instLinearOrder (H := P.toAddSubgroup) + +instance quotientIsOrderedAddMonoid (P : Submodule K G) [P.toAddSubgroup.IsConvex] : + IsOrderedAddMonoid (G ⧸ P) := + ConvexQuotient.instIsOrderedAddMonoid (H := P.toAddSubgroup) + +local instance submoduleIsOrderedAddMonoid (P : Submodule K G) : IsOrderedAddMonoid P := + AddSubgroup.instIsOrderedAddMonoid P.toAddSubgroup + +/-- Regroup Hahn series by the cosets of a convex subspace. The quotient exponent is the outer, +dominant coordinate, while exponents in the subspace form the coefficient Hahn series. -/ +def convexQuotientSplitRingEquiv (P : Submodule K G) [P.toAddSubgroup.IsConvex] : + R⟦G⟧ ≃+* (R⟦P⟧)⟦G ⧸ P⟧ := + (embDomainRingEquiv (Submodule.quotientLexEquiv P).symm).trans iterateRingEquiv.symm + +@[simp] +theorem convexQuotientSplitRingEquiv_coeff (P : Submodule K G) [P.toAddSubgroup.IsConvex] + (x : R⟦G⟧) (q : G ⧸ P) (p : P) : + ((convexQuotientSplitRingEquiv P x).coeff q).coeff p = + x.coeff (Submodule.quotientLexEquiv P (toLex (q, p))) := by + apply (iterateRingEquiv_coeff (convexQuotientSplitRingEquiv P x) q p).symm.trans + change (iterateRingEquiv + (iterateRingEquiv.symm + (embDomainRingEquiv (Submodule.quotientLexEquiv P).symm x))).coeff + (toLex (q, p)) = _ + rw [RingEquiv.apply_symm_apply] + have h := embDomainRingEquiv_coeff (R := R) (Submodule.quotientLexEquiv P).symm x + (Submodule.quotientLexEquiv P (toLex (q, p))) + rw [OrderAddMonoidIso.symm_apply_apply] at h + exact h + +open Classical in +/-- Regrouping commutes with restriction to the preimage of a subgroup of the quotient. -/ +theorem convexQuotientSplitRingEquiv_filter_comap + (P : Submodule K G) [P.toAddSubgroup.IsConvex] + (D : AddSubgroup (G ⧸ P)) (x : R⟦G⟧) : + convexQuotientSplitRingEquiv P + (HahnSeries.filter (· ∈ D.comap P.mkQ.toAddMonoidHom) x) = + HahnSeries.filter (· ∈ D) (convexQuotientSplitRingEquiv P x) := by + ext q p + rw [convexQuotientSplitRingEquiv_coeff, HahnSeries.coeff_filter, + HahnSeries.coeff_filter] + have hmk : Submodule.Quotient.mk + (Submodule.quotientLexEquiv P (toLex (q, p))) = q := by + rw [Submodule.quotientLexEquiv_apply, Submodule.mk_quotientProdLinearEquiv] + rfl + have hiff : Submodule.quotientLexEquiv P (toLex (q, p)) ∈ + D.comap P.mkQ.toAddMonoidHom ↔ q ∈ D := by + rw [AddSubgroup.mem_comap] + change Submodule.Quotient.mk (Submodule.quotientLexEquiv P (toLex (q, p))) ∈ D ↔ _ + rw [hmk] + split + · rename_i hmem + rw [if_pos (hiff.mp hmem), convexQuotientSplitRingEquiv_coeff] + · rename_i hmem + rw [if_neg (fun hq ↦ hmem (hiff.mpr hq))] + rfl + +open Classical in +/-- The regrouped outer support lies in a quotient subgroup exactly when the ambient support lies +in its preimage. -/ +theorem support_convexQuotientSplitRingEquiv_subset_iff + (P : Submodule K G) [P.toAddSubgroup.IsConvex] + (D : AddSubgroup (G ⧸ P)) (x : R⟦G⟧) : + (convexQuotientSplitRingEquiv P x).support ⊆ (D : Set (G ⧸ P)) ↔ + x.support ⊆ (D.comap P.mkQ.toAddMonoidHom : Set G) := by + constructor + · intro hs g hg + let z : (G ⧸ P) ×ₗ P := (Submodule.quotientLexEquiv P).symm g + let q : G ⧸ P := (ofLex z).1 + let p : P := (ofLex z).2 + have hz : Submodule.quotientLexEquiv P (toLex (q, p)) = g := + (Submodule.quotientLexEquiv P).apply_symm_apply g + have hcoeff : ((convexQuotientSplitRingEquiv P x).coeff q).coeff p ≠ 0 := by + rw [convexQuotientSplitRingEquiv_coeff, hz] + exact (HahnSeries.mem_support _ _).mp hg + have hqsupp : q ∈ (convexQuotientSplitRingEquiv P x).support := by + rw [HahnSeries.mem_support] + intro hzero + exact hcoeff (congrArg (fun y : R⟦P⟧ ↦ y.coeff p) hzero) + have hqD := hs hqsupp + change Submodule.Quotient.mk g ∈ D + have hmk : Submodule.Quotient.mk + (Submodule.quotientLexEquiv P (toLex (q, p))) = q := by + rw [Submodule.quotientLexEquiv_apply, Submodule.mk_quotientProdLinearEquiv] + rfl + rwa [← hz, hmk] + · intro hs q hq + rw [HahnSeries.mem_support] at hq + obtain ⟨p, hp⟩ : ∃ p : P, + ((convexQuotientSplitRingEquiv P x).coeff q).coeff p ≠ 0 := by + by_contra h + push Not at h + apply hq + ext p + exact h p + have hxp : Submodule.quotientLexEquiv P (toLex (q, p)) ∈ x.support := by + rw [HahnSeries.mem_support, ← convexQuotientSplitRingEquiv_coeff] + exact hp + have hmem := hs hxp + change Submodule.Quotient.mk + (Submodule.quotientLexEquiv P (toLex (q, p))) ∈ D at hmem + have hmk : Submodule.Quotient.mk + (Submodule.quotientLexEquiv P (toLex (q, p))) = q := by + rw [Submodule.quotientLexEquiv_apply, Submodule.mk_quotientProdLinearEquiv] + rfl + rwa [hmk] at hmem + +open Classical in +/-- The outer support after regrouping along a convex submodule is exactly the quotient image of +the original support. -/ +theorem support_convexQuotientSplitRingEquiv + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (x : R⟦G⟧) : + (convexQuotientSplitRingEquiv P x).support = P.mkQ '' x.support := by + ext q + constructor + · intro hq + rw [HahnSeries.mem_support] at hq + obtain ⟨p, hp⟩ : ∃ p : P, + ((convexQuotientSplitRingEquiv P x).coeff q).coeff p ≠ 0 := by + by_contra h + push Not at h + apply hq + ext p + exact h p + let g := Submodule.quotientLexEquiv P (toLex (q, p)) + refine ⟨g, ?_, ?_⟩ + · rw [HahnSeries.mem_support, ← convexQuotientSplitRingEquiv_coeff] + exact hp + · dsimp only [g] + change Submodule.Quotient.mk + (Submodule.quotientLexEquiv P (toLex (q, p))) = q + rw [Submodule.quotientLexEquiv_apply, Submodule.mk_quotientProdLinearEquiv] + rfl + · rintro ⟨g, hg, rfl⟩ + let z : (G ⧸ P) ×ₗ P := (Submodule.quotientLexEquiv P).symm g + let q : G ⧸ P := (ofLex z).1 + let p : P := (ofLex z).2 + have hz : Submodule.quotientLexEquiv P (toLex (q, p)) = g := + (Submodule.quotientLexEquiv P).apply_symm_apply g + have hmk : P.mkQ g = q := by + rw [← hz] + change Submodule.Quotient.mk + (Submodule.quotientLexEquiv P (toLex (q, p))) = q + rw [Submodule.quotientLexEquiv_apply, Submodule.mk_quotientProdLinearEquiv] + rfl + rw [hmk, HahnSeries.mem_support] + intro hzero + have hcoeff := congrArg (fun y : R⟦P⟧ ↦ y.coeff p) hzero + rw [convexQuotientSplitRingEquiv_coeff, hz] at hcoeff + exact (HahnSeries.mem_support _ _).mp hg hcoeff + +/-- Regrouping a nonpositive Hahn series produces no positive quotient exponent. -/ +theorem support_convexQuotientSplitRingEquiv_subset_Iic + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (x : R⟦G⟧) + (hx : x.support ⊆ Set.Iic 0) : + (convexQuotientSplitRingEquiv P x).support ⊆ Set.Iic 0 := by + intro q hq + rw [HahnSeries.mem_support] at hq + obtain ⟨p, hp⟩ : ∃ p : P, ((convexQuotientSplitRingEquiv P x).coeff q).coeff p ≠ 0 := by + by_contra h + push Not at h + apply hq + ext p + exact h p + rw [convexQuotientSplitRingEquiv_coeff] at hp + have hnonpos : Submodule.quotientLexEquiv P (toLex (q, p)) ≤ 0 := + hx ((HahnSeries.mem_support _ _).mpr hp) + have hlex : toLex (q, p) ≤ 0 := by + rw [← (Submodule.quotientLexEquiv P).map_zero] at hnonpos + exact (Submodule.quotientLexEquiv P).map_le_map_iff'.mp hnonpos + rcases Prod.Lex.le_iff.mp hlex with hqneg | ⟨hqzero, -⟩ + · exact hqneg.le + · exact hqzero.le + +/-- The ordered inclusion of a subspace into its ambient exponent group. -/ +def submoduleOrderEmbedding (P : Submodule K G) : P ↪o G where + toFun := (↑) + inj' := Subtype.val_injective + map_rel_iff' := Iff.rfl + +omit [IsOrderedAddMonoid G] in +@[simp] +theorem submoduleOrderEmbedding_apply (P : Submodule K G) (p : P) : + submoduleOrderEmbedding P p = (p : G) := + (rfl) + +/-- The outer-zero coefficient of quotient regrouping is precisely exponent-domain restriction +to the convex subspace. -/ +theorem coeff_zero_convexQuotientSplitRingEquiv + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (x : R⟦G⟧) : + (convexQuotientSplitRingEquiv P x).coeff 0 = + HahnSeries.restrictDomain (submoduleOrderEmbedding P) x := by + ext p + rw [convexQuotientSplitRingEquiv_coeff, HahnSeries.restrictDomain_coeff] + rw [Submodule.quotientLexEquiv_apply] + change x.coeff (Submodule.quotientProdLinearEquiv P (0, p)) = x.coeff (p : G) + rw [Submodule.quotientProdLinearEquiv_zero_left] + +/-- A series is nonpositive exactly when quotient regrouping has nonpositive outer support and +its coefficient at outer exponent zero has nonpositive inner support. -/ +theorem support_convexQuotientSplitRingEquiv_subset_Iic_iff + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (x : R⟦G⟧) : + x.support ⊆ Set.Iic 0 ↔ + (convexQuotientSplitRingEquiv P x).support ⊆ Set.Iic 0 ∧ + ((convexQuotientSplitRingEquiv P x).coeff 0).support ⊆ Set.Iic 0 := by + constructor + · intro hx + refine ⟨support_convexQuotientSplitRingEquiv_subset_Iic P x hx, ?_⟩ + intro p hp + have hpx : (p : G) ∈ x.support := by + rw [HahnSeries.mem_support] at hp ⊢ + rw [coeff_zero_convexQuotientSplitRingEquiv, + HahnSeries.restrictDomain_coeff] at hp + simpa only [submoduleOrderEmbedding_apply] using hp + exact hx hpx + · rintro ⟨houter, hinner⟩ g hg + let z : (G ⧸ P) ×ₗ P := (Submodule.quotientLexEquiv P).symm g + let q : G ⧸ P := (ofLex z).1 + let p : P := (ofLex z).2 + have hz : Submodule.quotientLexEquiv P z = g := + (Submodule.quotientLexEquiv P).apply_symm_apply g + have hcoeff : ((convexQuotientSplitRingEquiv P x).coeff q).coeff p ≠ 0 := by + rw [convexQuotientSplitRingEquiv_coeff] + rw [show toLex (q, p) = z from rfl, hz] + exact (HahnSeries.mem_support _ _).mp hg + have hq : q ∈ (convexQuotientSplitRingEquiv P x).support := by + rw [HahnSeries.mem_support] + intro hzero + exact hcoeff (congrArg (fun y : R⟦P⟧ ↦ y.coeff p) hzero) + have hq0 : q ≤ 0 := houter hq + change g ≤ 0 + rw [← hz, ← map_zero (Submodule.quotientLexEquiv P)] + apply (Submodule.quotientLexEquiv P).map_le_map_iff'.mpr + apply Prod.Lex.le_iff.mpr + rcases hq0.eq_or_lt with hqzero | hqneg + · right + refine ⟨hqzero, ?_⟩ + apply hinner + rw [HahnSeries.mem_support] + simpa only [q, hqzero] using hcoeff + · exact Or.inl hqneg + +/-- Suppose the support classes of a nonpositive series lie in the union of a block with no +greatest element and a finite block. After regrouping along the common tail of the first block, +the inner series at outer exponent zero meets only finitely many Archimedean classes. -/ +theorem supportArchimedeanClasses_coeff_zero_convexQuotientSplitRingEquiv_finite + [LinearOrder K] [IsOrderedRing K] [Archimedean K] [PosSMulMono K G] + (T₀ T₁ : Set (ArchimedeanClass G)) + (hT₀gt : ∀ a ∈ T₀, ∃ b ∈ T₀, a < b) (hT₁ : T₁.Finite) + (x : R⟦G⟧) (hxclasses : ArchimedeanClass.mk '' x.support ⊆ T₀ ∪ T₁) : + (ArchimedeanClass.mk '' + ((convexQuotientSplitRingEquiv + (FiniteArchimedeanClass.tailSubmodule K + {c : FiniteArchimedeanClass G | c.1 ∈ T₀}) + x).coeff 0).support).Finite := by + let T : Set (FiniteArchimedeanClass G) := {c | c.1 ∈ T₀} + let P := FiniteArchimedeanClass.tailSubmodule K T + let inner := (convexQuotientSplitRingEquiv P x).coeff 0 + let inc : P →+o G := + { toFun := fun p ↦ (p : G) + map_zero' := rfl + map_add' := fun _ _ ↦ rfl + monotone' := fun _ _ h ↦ h } + have himage : ArchimedeanClass.orderHom inc '' + (ArchimedeanClass.mk '' inner.support) ⊆ T₁ := by + rintro c ⟨d, ⟨p, hp, rfl⟩, rfl⟩ + rw [ArchimedeanClass.orderHom_mk] + have hpx : (p : G) ∈ x.support := by + apply (HahnSeries.mem_support _ _).mpr + have hpne := (HahnSeries.mem_support _ _).mp hp + dsimp only [inner] at hpne + rw [coeff_zero_convexQuotientSplitRingEquiv, + HahnSeries.restrictDomain_coeff] at hpne + simpa only [submoduleOrderEmbedding_apply] using hpne + rcases hxclasses ⟨p, hpx, rfl⟩ with hpT₀ | hpT₁ + · obtain ⟨a, haT₀, hpa⟩ := hT₀gt _ hpT₀ + have hpP : (p : G) ∈ P := p.2 + have ha0 : a ≠ ⊤ := fun ha ↦ by + obtain ⟨b, -, hab⟩ := hT₀gt a haT₀ + exact (not_lt_of_ge le_top) (ha ▸ hab) + have hpTail : (p : G) ∈ FiniteArchimedeanClass.tailKernel T := by + rw [← FiniteArchimedeanClass.tailSubmodule_toAddSubgroup K T] + exact hpP + have ha_le_p : a ≤ ArchimedeanClass.mk (p : G) := + FiniteArchimedeanClass.mem_tailKernel_iff.mp hpTail ⟨⟨a, ha0⟩, haT₀⟩ + exact (not_lt_of_ge ha_le_p) hpa |>.elim + · exact hpT₁ + change (ArchimedeanClass.mk '' inner.support).Finite + exact Set.Finite.of_finite_image (hT₁.subset himage) + (ArchimedeanClass.orderHom_injective Subtype.val_injective).injOn + +/-- The support cardinality of every outer coefficient is bounded by that of the original +unregrouped series. -/ +theorem cardSupp_coeff_convexQuotientSplitRingEquiv_le + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (x : R⟦G⟧) (q : G ⧸ P) : + ((convexQuotientSplitRingEquiv P x).coeff q).cardSupp ≤ x.cardSupp := by + apply (cardSupp_coeff_le_cardSupp_iterateRingEquiv + (iterateRingEquiv.symm (embDomainRingEquiv (Submodule.quotientLexEquiv P).symm x)) q).trans + rw [RingEquiv.apply_symm_apply] + rw [cardSupp_embDomainRingEquiv] + +/-- Regrouping preserves a regular support bound on the outer support and on every coefficient. -/ +theorem cardSupp_convexQuotientSplitRingEquiv_lt + {κ : Cardinal.{u}} (P : Submodule K G) [P.toAddSubgroup.IsConvex] + (x : R⟦G⟧) (hx : x.cardSupp < κ) : + (convexQuotientSplitRingEquiv P x).cardSupp < κ ∧ + ∀ q, ((convexQuotientSplitRingEquiv P x).coeff q).cardSupp < κ := by + constructor + · have h := cardSupp_outer_le_cardSupp_iterateRingEquiv + (iterateRingEquiv.symm (embDomainRingEquiv (Submodule.quotientLexEquiv P).symm x)) + rw [RingEquiv.apply_symm_apply] at h + exact h.trans_lt (by rw [cardSupp_embDomainRingEquiv]; exact hx) + · exact fun q ↦ (cardSupp_coeff_convexQuotientSplitRingEquiv_le P x q).trans_lt hx + +/-- If the outer support and every coefficient support satisfy a regular bound, flattening the +regrouped Hahn series satisfies the same bound. -/ +theorem cardSupp_convexQuotientSplitRingEquiv_symm_lt_of_isRegular + {κ : Cardinal.{u}} (hκ : κ.IsRegular) (P : Submodule K G) + [P.toAddSubgroup.IsConvex] (x : (R⟦P⟧)⟦G ⧸ P⟧) + (houter : x.cardSupp < κ) (hcoeff : ∀ q, (x.coeff q).cardSupp < κ) : + ((convexQuotientSplitRingEquiv P).symm x).cardSupp < κ := by + have heq : (convexQuotientSplitRingEquiv P).symm x = + embDomainRingEquiv (Submodule.quotientLexEquiv P) (iterateRingEquiv x) := by + apply (convexQuotientSplitRingEquiv P).injective + rw [RingEquiv.apply_symm_apply] + rw [eq_comm] + change iterateRingEquiv.symm + (embDomainRingEquiv (Submodule.quotientLexEquiv P).symm + (embDomainRingEquiv (Submodule.quotientLexEquiv P) (iterateRingEquiv x))) = x + have hdomain : embDomainRingEquiv (Submodule.quotientLexEquiv P).symm + (embDomainRingEquiv (Submodule.quotientLexEquiv P) (iterateRingEquiv x)) = + iterateRingEquiv x := by + ext p + have h₁ := embDomainRingEquiv_coeff (R := R) + (Submodule.quotientLexEquiv P).symm + (embDomainRingEquiv (Submodule.quotientLexEquiv P) (iterateRingEquiv x)) + (Submodule.quotientLexEquiv P p) + have h₂ := embDomainRingEquiv_coeff (R := R) + (Submodule.quotientLexEquiv P) (iterateRingEquiv x) p + rw [OrderAddMonoidIso.symm_apply_apply] at h₁ + exact h₁.trans h₂ + rw [hdomain, RingEquiv.symm_apply_apply] + rw [heq] + rw [cardSupp_embDomainRingEquiv] + exact cardSupp_iterateRingEquiv_lt_of_isRegular hκ x houter hcoeff + +end HahnSeries + +namespace HahnSeries + +section Bounded + +open Cardinal + +universe u v w + +variable {R : Type v} {K : Type w} {G : Type u} [Field R] +variable [Field K] [AddCommGroup G] [Module K G] +variable [LinearOrder G] [IsOrderedAddMonoid G] + +noncomputable local instance boundedQuotientLinearOrder (P : Submodule K G) + [P.toAddSubgroup.IsConvex] : LinearOrder (G ⧸ P) := + ConvexQuotient.instLinearOrder (H := P.toAddSubgroup) + +local instance boundedQuotientIsOrderedAddMonoid + (P : Submodule K G) [P.toAddSubgroup.IsConvex] : + IsOrderedAddMonoid (G ⧸ P) := + ConvexQuotient.instIsOrderedAddMonoid (H := P.toAddSubgroup) + +local instance boundedSubmoduleIsOrderedAddMonoid (P : Submodule K G) : + IsOrderedAddMonoid P := + AddSubgroup.instIsOrderedAddMonoid P.toAddSubgroup + +variable {κ : Cardinal.{u}} [Fact (aleph0 < κ)] [Fact κ.IsRegular] + +/-- Embed a cardinal-bounded iterated Hahn field coefficientwise into the unrestricted iterated +Hahn field. -/ +def boundedOuterCoefficientInclusion (P : Submodule K G) [P.toAddSubgroup.IsConvex] : + CardSuppLTField (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ) →+* + (R⟦P⟧)⟦G ⧸ P⟧ := + (coefficientMapRingHom + ((cardSuppLTSubfield P R κ).subtype : + CardSuppLTField (G := P) (R := R) (κ := κ) →+* R⟦P⟧)).comp + ((cardSuppLTSubfield (G ⧸ P) + (CardSuppLTField (G := P) (R := R) (κ := κ)) κ).subtype) + +omit [Fact κ.IsRegular] in +@[simp] +theorem boundedOuterCoefficientInclusion_coeff + (P : Submodule K G) [P.toAddSubgroup.IsConvex] + (x : CardSuppLTField (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ)) + (q : G ⧸ P) : + (boundedOuterCoefficientInclusion P x).coeff q = (x.1.coeff q : R⟦P⟧) := by + change + (coefficientMapRingHom + ((cardSuppLTSubfield P R κ).subtype : + CardSuppLTField (G := P) (R := R) (κ := κ) →+* R⟦P⟧) + (x : (CardSuppLTField (G := P) (R := R) (κ := κ))⟦G ⧸ P⟧)).coeff q = _ + rw [coefficientMapRingHom_coeff] + rfl + +omit [Fact κ.IsRegular] in +/-- Coefficientwise inclusion of a bounded iterated Hahn field is injective. -/ +theorem boundedOuterCoefficientInclusion_injective + (P : Submodule K G) [P.toAddSubgroup.IsConvex] : + Function.Injective (boundedOuterCoefficientInclusion + (R := R) (κ := κ) P) := by + intro x y hxy + apply Subtype.ext + ext q p + have hcoeff := congrArg (fun z : (R⟦P⟧)⟦G ⧸ P⟧ ↦ (z.coeff q).coeff p) hxy + simpa using hcoeff + +/-- Regroup a bounded Hahn series into a bounded outer Hahn series whose coefficients are bounded +inner Hahn series. -/ +def boundedConvexQuotientSplit (P : Submodule K G) [P.toAddSubgroup.IsConvex] + (x : CardSuppLTField (G := G) (R := R) (κ := κ)) : + CardSuppLTField (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ) := by + let y := convexQuotientSplitRingEquiv P (x : R⟦G⟧) + have hy := cardSupp_convexQuotientSplitRingEquiv_lt P (x : R⟦G⟧) x.2 + let f : G ⧸ P → CardSuppLTField (G := P) (R := R) (κ := κ) := + fun q ↦ ⟨y.coeff q, hy.2 q⟩ + let z : (CardSuppLTField (G := P) (R := R) (κ := κ))⟦G ⧸ P⟧ := + { coeff := f + isPWO_support' := by + have hsupport : Function.support f = y.support := by + ext q + simp only [Function.mem_support, ne_eq, HahnSeries.mem_support] + constructor + · intro hf hyq + apply hf + apply Subtype.ext + exact hyq + · intro hyq hf + apply hyq + exact congrArg Subtype.val hf + rw [hsupport] + exact y.isPWO_support } + exact ⟨z, by + change z.cardSupp < κ + have hsupport : z.support = y.support := by + ext q + simp only [HahnSeries.mem_support, z] + constructor + · intro hf hyq + apply hf + apply Subtype.ext + exact hyq + · intro hyq hf + apply hyq + exact congrArg Subtype.val hf + rw [HahnSeries.cardSupp_congr hsupport] + exact hy.1⟩ + +omit [Fact κ.IsRegular] in +/-- Bounded regrouping agrees with unrestricted regrouping after coefficientwise inclusion. -/ +theorem boundedOuterCoefficientInclusion_split + (P : Submodule K G) [P.toAddSubgroup.IsConvex] + (x : CardSuppLTField (G := G) (R := R) (κ := κ)) : + boundedOuterCoefficientInclusion P (boundedConvexQuotientSplit P x) = + convexQuotientSplitRingEquiv P (x : R⟦G⟧) := by + ext q p + rw [boundedOuterCoefficientInclusion_coeff] + rfl + +omit [Fact κ.IsRegular] in +/-- Bounded quotient regrouping has the same outer support as unrestricted regrouping. -/ +theorem support_boundedConvexQuotientSplit + (P : Submodule K G) [P.toAddSubgroup.IsConvex] + (x : CardSuppLTField (G := G) (R := R) (κ := κ)) : + ((boundedConvexQuotientSplit P x : + CardSuppLTField (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ)) : + (CardSuppLTField (G := P) (R := R) (κ := κ))⟦G ⧸ P⟧).support = + (convexQuotientSplitRingEquiv P (x : R⟦G⟧)).support := by + rw [← support_coefficientMapRingHom + ((cardSuppLTSubfield P R κ).subtype) Subtype.val_injective] + exact congrArg HahnSeries.support (boundedOuterCoefficientInclusion_split P x) + +/-- Flatten a bounded outer Hahn series with bounded inner coefficients. Regularity of the bound +ensures that the flattened support is still bounded. -/ +def boundedConvexQuotientUnsplit (P : Submodule K G) [P.toAddSubgroup.IsConvex] + (x : CardSuppLTField (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ)) : + CardSuppLTField (G := G) (R := R) (κ := κ) := + ⟨(convexQuotientSplitRingEquiv P).symm + (boundedOuterCoefficientInclusion P x), by + apply cardSupp_convexQuotientSplitRingEquiv_symm_lt_of_isRegular + (Fact.out : κ.IsRegular) P (boundedOuterCoefficientInclusion P x) + · have hsupport : (boundedOuterCoefficientInclusion P x).support = + (x : (CardSuppLTField (G := P) (R := R) (κ := κ))⟦G ⧸ P⟧).support := + support_coefficientMapRingHom _ Subtype.val_injective _ + rw [HahnSeries.cardSupp_congr hsupport] + exact x.2 + · intro q + rw [boundedOuterCoefficientInclusion_coeff] + exact (x.1.coeff q).2⟩ + +/-- Cardinal-bounded Hahn series split as bounded outer Hahn series with bounded inner Hahn +coefficients along a convex subspace. -/ +def boundedConvexQuotientSplitRingEquiv + (P : Submodule K G) [P.toAddSubgroup.IsConvex] : + CardSuppLTField (G := G) (R := R) (κ := κ) ≃+* + CardSuppLTField (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ) where + toFun := boundedConvexQuotientSplit P + invFun := boundedConvexQuotientUnsplit P + left_inv := by + intro x + apply Subtype.ext + change (convexQuotientSplitRingEquiv P).symm + (boundedOuterCoefficientInclusion P (boundedConvexQuotientSplit P x)) = _ + rw [boundedOuterCoefficientInclusion_split, RingEquiv.symm_apply_apply] + right_inv := by + intro x + apply boundedOuterCoefficientInclusion_injective P + rw [boundedOuterCoefficientInclusion_split] + change convexQuotientSplitRingEquiv P + ((convexQuotientSplitRingEquiv P).symm + (boundedOuterCoefficientInclusion P x)) = _ + rw [RingEquiv.apply_symm_apply] + map_mul' := by + intro x y + apply boundedOuterCoefficientInclusion_injective P + rw [boundedOuterCoefficientInclusion_split, map_mul, + boundedOuterCoefficientInclusion_split, boundedOuterCoefficientInclusion_split] + exact map_mul (convexQuotientSplitRingEquiv P) (x : R⟦G⟧) (y : R⟦G⟧) + map_add' := by + intro x y + apply boundedOuterCoefficientInclusion_injective P + rw [boundedOuterCoefficientInclusion_split, map_add, + boundedOuterCoefficientInclusion_split, boundedOuterCoefficientInclusion_split] + exact map_add (convexQuotientSplitRingEquiv P) (x : R⟦G⟧) (y : R⟦G⟧) + +/-- The bounded splitting equivalence applies by bounded quotient regrouping. -/ +@[simp] +theorem boundedConvexQuotientSplitRingEquiv_apply + (P : Submodule K G) [P.toAddSubgroup.IsConvex] + (x : CardSuppLTField (G := G) (R := R) (κ := κ)) : + boundedConvexQuotientSplitRingEquiv P x = boundedConvexQuotientSplit P x := + (rfl) + +omit [Fact κ.IsRegular] in +/-- The outer-zero coefficient of bounded quotient regrouping is exponent-domain restriction to +the convex subspace. -/ +@[simp] +theorem coe_coeff_zero_boundedConvexQuotientSplit + (P : Submodule K G) [P.toAddSubgroup.IsConvex] + (x : CardSuppLTField (G := G) (R := R) (κ := κ)) : + (((boundedConvexQuotientSplit P x).1.coeff 0 : + CardSuppLTField (G := P) (R := R) (κ := κ)) : R⟦P⟧) = + HahnSeries.restrictDomain (submoduleOrderEmbedding P) (x : R⟦G⟧) := by + have h := congrArg (fun z : (R⟦P⟧)⟦G ⧸ P⟧ ↦ z.coeff 0) + (boundedOuterCoefficientInclusion_split P x) + rw [boundedOuterCoefficientInclusion_coeff, + coeff_zero_convexQuotientSplitRingEquiv] at h + exact h + +/-- Bounded regrouping preserves membership in the integer part when the allowed outer constant +coefficients are the corresponding bounded inner integer part. -/ +theorem mem_cardSuppLTTruncationIntegerPart_boundedConvexQuotientSplitRingEquiv_iff + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (Z : Subring R) + (x : CardSuppLTField (G := G) (R := R) (κ := κ)) : + x ∈ cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z ↔ + boundedConvexQuotientSplitRingEquiv P x ∈ + cardSuppLTTruncationIntegerPart (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ) + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) := by + rw [mem_cardSuppLTTruncationIntegerPart, mem_cardSuppLTTruncationIntegerPart] + change + (x : R⟦G⟧).support ⊆ Set.Iic 0 ∧ (x : R⟦G⟧).coeff 0 ∈ Z ↔ + ((boundedConvexQuotientSplitRingEquiv P x : + CardSuppLTField (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ)) : + (CardSuppLTField (G := P) (R := R) (κ := κ))⟦G ⧸ P⟧).support ⊆ + Set.Iic 0 ∧ + ((boundedConvexQuotientSplitRingEquiv P x : + CardSuppLTField (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ)) : + (CardSuppLTField (G := P) (R := R) (κ := κ))⟦G ⧸ P⟧).coeff 0 ∈ + cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z + rw [mem_cardSuppLTTruncationIntegerPart, boundedConvexQuotientSplitRingEquiv_apply] + let y := boundedConvexQuotientSplit P x + have hcoeff (q : G ⧸ P) : ((y.1.coeff q : + CardSuppLTField (G := P) (R := R) (κ := κ)) : R⟦P⟧) = + (convexQuotientSplitRingEquiv P (x : R⟦G⟧)).coeff q := by + have h := congrArg (fun z : (R⟦P⟧)⟦G ⧸ P⟧ ↦ z.coeff q) + (boundedOuterCoefficientInclusion_split P x) + rw [boundedOuterCoefficientInclusion_coeff] at h + exact h + have hsupport : (y : + (CardSuppLTField (G := P) (R := R) (κ := κ))⟦G ⧸ P⟧).support = + (convexQuotientSplitRingEquiv P (x : R⟦G⟧)).support := by + ext q + rw [HahnSeries.mem_support, HahnSeries.mem_support] + constructor + · intro hy hzero + apply hy + apply Subtype.ext + exact (hcoeff q).trans hzero + · intro hxq hzero + apply hxq + rw [← hcoeff q] + exact congrArg Subtype.val hzero + change + (x : R⟦G⟧).support ⊆ Set.Iic 0 ∧ (x : R⟦G⟧).coeff 0 ∈ Z ↔ + ((boundedConvexQuotientSplit P x : + CardSuppLTField (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ)) : + (CardSuppLTField (G := P) (R := R) (κ := κ))⟦G ⧸ P⟧).support ⊆ + Set.Iic 0 ∧ + (((boundedConvexQuotientSplit P x : + CardSuppLTField (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ)).1.coeff 0 : + CardSuppLTField (G := P) (R := R) (κ := κ)) : R⟦P⟧).support ⊆ + Set.Iic 0 ∧ + (((boundedConvexQuotientSplit P x : + CardSuppLTField (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ)).1.coeff 0 : + CardSuppLTField (G := P) (R := R) (κ := κ)) : R⟦P⟧).coeff 0 ∈ Z + rw [hsupport, hcoeff 0] + change + (x : R⟦G⟧).support ⊆ Set.Iic 0 ∧ (x : R⟦G⟧).coeff 0 ∈ Z ↔ + (convexQuotientSplitRingEquiv P (x : R⟦G⟧)).support ⊆ Set.Iic 0 ∧ + (((convexQuotientSplitRingEquiv P (x : R⟦G⟧)).coeff 0).support ⊆ + Set.Iic 0 ∧ + ((convexQuotientSplitRingEquiv P (x : R⟦G⟧)).coeff 0).coeff 0 ∈ Z) + rw [← and_assoc, ← support_convexQuotientSplitRingEquiv_subset_Iic_iff] + refine and_congr Iff.rfl ?_ + rw [convexQuotientSplitRingEquiv_coeff] + simp + +/-- Regrouping identifies a bounded Hahn integer part with the outer Hahn integer part whose +allowed constant coefficients are the corresponding bounded inner Hahn integer part. -/ +def cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (Z : Subring R) : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z ≃+* + cardSuppLTTruncationIntegerPart (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ) + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) := + RingEquiv.restrict (boundedConvexQuotientSplitRingEquiv P) _ _ + (mem_cardSuppLTTruncationIntegerPart_boundedConvexQuotientSplitRingEquiv_iff P Z) + +/-- The restricted integer-part equivalence is bounded quotient regrouping on underlying +series. -/ +@[simp] +theorem coe_cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + (((cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z x : + cardSuppLTTruncationIntegerPart (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ) + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z)) : + CardSuppLTField (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ)) : + (CardSuppLTField (G := P) (R := R) (κ := κ))⟦G ⧸ P⟧) = + (boundedConvexQuotientSplit P x.1 : + (CardSuppLTField (G := P) (R := R) (κ := κ))⟦G ⧸ P⟧) := + (rfl) + +/-- The integer-part splitting equivalence preserves the outer support of unrestricted +regrouping. -/ +theorem support_cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + ((cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z x : + (CardSuppLTField (G := P) (R := R) (κ := κ))⟦G ⧸ P⟧).support) = + (convexQuotientSplitRingEquiv P (x : R⟦G⟧)).support := by + rw [coe_cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv] + exact support_boundedConvexQuotientSplit P x.1 + +end Bounded + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree.lean new file mode 100644 index 0000000000..2a75827f08 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree.lean @@ -0,0 +1,12 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.PrincipalMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.SupportSupremumMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Tests + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/PrincipalMultiplicativity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/PrincipalMultiplicativity.lean new file mode 100644 index 0000000000..0687538317 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/PrincipalMultiplicativity.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Multiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NegativeMonomialIdeal +public import Mathlib.RingTheory.Ideal.Prime + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrderTypeMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.SupportSupremumMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue + +/-! +# Multiplication of principal real Hahn series + +LM24, Proposition 3.6.1 combines Fact 3.4.1 with Proposition 3.5.1: the product of two principal +series is principal. The first theorem below exposes the two cited Berarducci inputs explicitly. +The second discharges them using their formalized characteristic-zero theorems. + +The theorem below directly combines the two cited Berarducci inputs. +-/ + +universe v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {K : Type v} [Field K] + +/-- LM24, Proposition 3.6.1, reduced to the two Berarducci prerequisites used by LM24. -/ +theorem IsPrincipal.mul_of_multiplicativity + {b c : Nonpositive ℝ K} + (hb : IsPrincipal b) (hc : IsPrincipal c) + (hOrder : OrderTypeMultiplicativeOnWeaklyPrincipal K) + (hJ : (negativeMonomialIdeal K).IsPrime) : + IsPrincipal (b * c) := by + rw [isPrincipal_iff] + constructor + · exact hOrder.isWeaklyPrincipal_mul hb.isWeaklyPrincipal hc.isWeaklyPrincipal + · rw [supportSup_mul_of_negativeMonomialIdeal_isPrime hJ, + hb.supportSup_eq_zero, hc.supportSup_eq_zero, add_zero] + +/-- LM24, Proposition 3.6.1: the product of two principal real Hahn series is principal. -/ +theorem IsPrincipal.mul [CharZero K] + {b c : Nonpositive ℝ K} (hb : IsPrincipal b) (hc : IsPrincipal c) : + IsPrincipal (b * c) := + hb.mul_of_multiplicativity hc orderTypeMultiplicativeOnWeaklyPrincipal + Berarducci.negativeMonomialIdeal_isPrime + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements.lean new file mode 100644 index 0000000000..813e9c775a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeResidue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeValuation + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/Degree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/Degree.lean new file mode 100644 index 0000000000..712fdab7d2 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/Degree.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +public import Mathlib.Data.Real.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrderTypeMultiplicativity + +/-! +# LM24 degree valuation statement + +This module proves LM24, Theorem D with its printed quantifier domain: both input series are +nonzero. The ultrametric inequality and separation at zero are proved directly, while +multiplicativity uses LM24's reduction to Berarducci, Corollary 9.9. + +The addition on degrees is Hessenberg addition transported to `NatOrdinal`, with an absorbing +bottom element for the zero series. The source's third clause is retained even though its fixed +input `b` is assumed nonzero. The stronger all-input separation theorem is +`HahnSeries.degree_eq_bot`. +-/ + +universe v + +open scoped HahnSeries + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +/-- The all-input multiplicativity law underlying LM24, Theorem D. The printed theorem assumes +both inputs are nonzero; the zero cases follow from the ring laws. -/ +@[blueprint "fact:degree-multiplicativity" + (phase := "Ordinal value and degree") + (title := "Multiplicativity of the degree (LM24, Theorem D)") + (statement := /-- + For $b,c\in\Kser$, $\deg(bc)=\deg(b)\nsum\deg(c)$. + -/) + (proof := /-- + Decompose each nonzero series into a principal leading summand and a remainder + of no larger degree. By + \ref{fact:weakly-principal-order-type-multiplicativity}, the support order + types of the two principal summands multiply. Together with the strict degree + bounds for the remaining products, this shows that the leading term of + $bc$ has degree $\deg(b)\mathbin\oplus\deg(c)$. Hence + $\deg(bc)=\deg(b)\mathbin\oplus\deg(c)$. The zero cases follow from the + ring laws. + -/)] +theorem degree_mul (b c : Nonpositive ℝ K) : + ((b * c : Nonpositive ℝ K) : K⟦ℝ⟧).degree = + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := + degree_mul_of_orderTypeMultiplicativeOnWeaklyPrincipal + orderTypeMultiplicativeOnWeaklyPrincipal b c + +/-- LM24, Theorem D: degree is a multiplicative valuation on nonpositive real Hahn series. -/ +theorem real_hahn_series_degree_valuation + (b c : Nonpositive ℝ K) (_hb : b ≠ 0) (_hc : c ≠ 0) : + ((b + c : Nonpositive ℝ K) : K⟦ℝ⟧).degree ≤ + max (b : K⟦ℝ⟧).degree (c : K⟦ℝ⟧).degree ∧ + ((b * c : Nonpositive ℝ K) : K⟦ℝ⟧).degree = + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree ∧ + ((b : K⟦ℝ⟧).degree = ⊥ ↔ b = 0) := by + refine ⟨HahnSeries.degree_add_le _ _, ?_, ?_⟩ + · exact degree_mul b c + · simp + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/DegreeResidue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/DegreeResidue.lean new file mode 100644 index 0000000000..58c4c74819 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/DegreeResidue.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Residue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +public import Mathlib.Data.Real.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeValuation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportResidue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrderTypeMultiplicativity + +/-! +# LM24 degree-residue statement + +This module states LM24, Proposition 5.1.1 in the grade-zero-component presentation of the +residue ring. The degree valuation is exhibited together with its exact value function, its +finite-support nonpositive subring, its zero negative ideal, and the bijective residue map. + +The construction uses LM24's reduction of degree multiplicativity to Berarducci, Corollary 9.9. +The residue identifications are proved in +`ConwayRefinement.HahnSeries.FiniteSupportResidue`. +-/ + +universe v + +public noncomputable section + +open scoped DirectSum HahnSeries + +namespace HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +/-- LM24, Proposition 5.1.1: the degree-zero residue ring of the multiplicative degree valuation +is the finite-support ring. -/ +theorem real_hahn_series_finite_support_residue : + ∃ w : MaxAddDegree (Nonpositive ℝ K) NatOrdinal, w.IsMultiplicative ∧ + (∀ b, w b = (b : K⟦ℝ⟧).degree) ∧ + w.nonpositiveSubring = finiteSupportSubring ∧ + w.negativeIdeal = ⊥ ∧ Function.Bijective w.residueMap := by + let hmul : ∀ b c : Nonpositive ℝ K, + ((b * c : Nonpositive ℝ K) : K⟦ℝ⟧).degree = + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := + degree_mul_of_orderTypeMultiplicativeOnWeaklyPrincipal + orderTypeMultiplicativeOnWeaklyPrincipal + let w := degreeValuation K + have hvalue : ∀ b, w b = (b : K⟦ℝ⟧).degree := degreeValuation_apply + have hwmul : w.IsMultiplicative := ⟨fun b c ↦ by rw [hvalue, hvalue, hvalue]; exact hmul b c⟩ + refine ⟨w, hwmul, hvalue, + nonpositiveSubring_eq_finiteSupportSubring_of_value_eq_degree w hvalue, + negativeIdeal_eq_bot_of_value_eq_degree w hvalue, ?_, w.residueMap_surjective⟩ + exact residueMap_injective_of_value_eq_degree w hvalue + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/DegreeValuation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/DegreeValuation.lean new file mode 100644 index 0000000000..36f626dd03 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/DegreeValuation.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportResidue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree + +/-! +# Multiplicativity of the degree valuation in characteristic zero + +Hahn-series degree on `K((ℝ^{≤0}))` is a max-additive degree over every coefficient field, +bundled as `degreeValuation K` from the submultiplicative bound of LM24, Corollary 3.1.2 alone. +Over a field of characteristic zero it is exactly multiplicative (LM24, Theorem D, proved as +`degree_mul`), so it is LM24's multiplicative valuation `deg`. This module +records Theorem D once, as the instance `(degreeValuation K).IsMultiplicative`; the degree-graded +ring `gr_deg K((ℝ^{≤0}))` therefore has no homogeneous zero divisors under `[CharZero K]`, and +every statement that needs exact degrees of products reads this instance. +-/ + +universe v + +open scoped HahnSeries + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable (K : Type v) [Field K] [CharZero K] + +/-- LM24, Theorem D: the degree valuation is multiplicative. -/ +instance degreeValuation_isMultiplicative : (degreeValuation K).IsMultiplicative := + ⟨fun b c ↦ by + simp only [degreeValuation_apply] + exact degree_mul b c⟩ + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/SupportSupremumMultiplicativity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/SupportSupremumMultiplicativity.lean new file mode 100644 index 0000000000..588c7e88dc --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/SupportSupremumMultiplicativity.lean @@ -0,0 +1,168 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NegativeMonomialIdeal +public import Mathlib.RingTheory.Ideal.Prime + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue + +/-! +# Multiplicativity of the support supremum + +LM24, Proposition 3.5.1(2) states that support supremum is multiplicative on nonpositive real +Hahn series. The paragraph preceding the proposition cites Berarducci, Corollary 9.8: the ideal +`negativeMonomialIdeal K` is prime. This module first proves the proposition from that exact +prerequisite, with zero factors handled explicitly, and then discharges the prerequisite using +the formalized Berarducci theorem. + +For nonzero `b` and `c`, normalize both supports to have supremum zero. Primality prevents the +normalized product from having strictly negative supremum. Translating the product back then +adds the original real suprema. The resulting theorem is valid for all inputs because `⊥` is +absorbing under addition. + +The converse is also proved: full support-supremum multiplicativity implies that the +negative-monomial ideal is prime. Thus +`negativeMonomialIdeal_isPrime_iff_supportSup_mul` records the equivalence. + +The optional normal-form proof printed after LM24, Proposition 3.5.1 assumes strict inequalities +between consecutive normal-form exponents, although the source definition permits equality. The +prime-ideal argument above does not require that extra assumption. +-/ + +universe v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {K : Type v} [Field K] + +/-- If the negative-monomial ideal is prime, the product of two series with support supremum zero +again has support supremum zero. -/ +theorem supportSup_mul_eq_zero_of_negativeMonomialIdeal_isPrime + (hJ : (negativeMonomialIdeal K).IsPrime) + {b c : Nonpositive ℝ K} + (hb : supportSup b = 0) (hc : supportSup c = 0) : + supportSup (b * c) = 0 := by + apply le_antisymm (supportSup_le_zero (b * c)) + apply le_of_not_gt + intro hproduct + have hmem : b * c ∈ negativeMonomialIdeal K := + mem_negativeMonomialIdeal_iff_supportSup_lt_zero.mpr hproduct + rcases hJ.mem_or_mem hmem with hbmem | hcmem + · rw [mem_negativeMonomialIdeal_iff_supportSup_lt_zero, hb] at hbmem + exact (lt_irrefl (0 : WithBot ℝ)) hbmem + · rw [mem_negativeMonomialIdeal_iff_supportSup_lt_zero, hc] at hcmem + exact (lt_irrefl (0 : WithBot ℝ)) hcmem + +/-- LM24, Proposition 3.5.1(2), reduced to its cited Berarducci prerequisite that the +negative-monomial ideal is prime. The equality includes zero factors via the absorbing bottom +convention. -/ +theorem supportSup_mul_of_negativeMonomialIdeal_isPrime + (hJ : (negativeMonomialIdeal K).IsPrime) + (b c : Nonpositive ℝ K) : + supportSup (b * c) = supportSup b + supportSup c := by + by_cases hb : b = 0 + · subst b + simp + by_cases hc : c = 0 + · subst c + simp + have hbc : b * c ≠ 0 := mul_ne_zero hb hc + have hnormalizedProduct : + supportSup (normalize b * normalize c) = 0 := + supportSup_mul_eq_zero_of_negativeMonomialIdeal_isPrime hJ + (supportSup_normalize hb) (supportSup_normalize hc) + have hnormalizedProductNe : normalize b * normalize c ≠ 0 := + mul_ne_zero (normalize_ne_zero hb) (normalize_ne_zero hc) + have hnormalizedProductNe' : + (((normalize b * normalize c : Nonpositive ℝ K) : K⟦ℝ⟧)) ≠ 0 := by + intro hzero + exact hnormalizedProductNe (Subtype.ext hzero) + have hnormalizedProductSup : + sSup (((normalize b * normalize c : Nonpositive ℝ K) : K⟦ℝ⟧).support) = 0 := by + rw [supportSup_of_ne hnormalizedProductNe] at hnormalizedProduct + exact WithBot.coe_eq_coe.mp hnormalizedProduct + have hproduct : + (((b * c : Nonpositive ℝ K) : K⟦ℝ⟧)) = + translate + (sSup (b : K⟦ℝ⟧).support + sSup (c : K⟦ℝ⟧).support) + ((normalize b * normalize c : Nonpositive ℝ K) : K⟦ℝ⟧) := by + calc + (((b * c : Nonpositive ℝ K) : K⟦ℝ⟧)) = + (b : K⟦ℝ⟧) * (c : K⟦ℝ⟧) := rfl + _ = translate (sSup (b : K⟦ℝ⟧).support) (normalize b : K⟦ℝ⟧) * + translate (sSup (c : K⟦ℝ⟧).support) (normalize c : K⟦ℝ⟧) := by + rw [translate_csSup_normalize, translate_csSup_normalize] + _ = _ := translate_mul_translate _ _ _ _ + rw [supportSup_of_ne hbc, supportSup_of_ne hb, supportSup_of_ne hc] + norm_cast + calc + sSup ((((b * c : Nonpositive ℝ K) : K⟦ℝ⟧)).support) = + sSup + (translate + (sSup (b : K⟦ℝ⟧).support + sSup (c : K⟦ℝ⟧).support) + ((normalize b * normalize c : Nonpositive ℝ K) : K⟦ℝ⟧)).support := + congrArg (fun z : K⟦ℝ⟧ ↦ sSup z.support) hproduct + _ = (sSup (b : K⟦ℝ⟧).support + sSup (c : K⟦ℝ⟧).support) + + sSup (((normalize b * normalize c : Nonpositive ℝ K) : K⟦ℝ⟧).support) := + csSup_support_translate + (x := ((normalize b * normalize c : Nonpositive ℝ K) : K⟦ℝ⟧)) + hnormalizedProductNe' (bddAbove_support (normalize b * normalize c)) _ + _ = sSup (b : K⟦ℝ⟧).support + sSup (c : K⟦ℝ⟧).support := by + rw [hnormalizedProductSup, add_zero] + +/-- LM24, Proposition 3.5.1(2): support supremum is multiplicative on nonpositive real Hahn +series. The equality includes zero factors via the absorbing bottom convention. -/ +theorem supportSup_mul [CharZero K] (b c : Nonpositive ℝ K) : + supportSup (b * c) = supportSup b + supportSup c := + supportSup_mul_of_negativeMonomialIdeal_isPrime + Berarducci.negativeMonomialIdeal_isPrime b c + +/-- Primality of the negative-monomial ideal is equivalent to multiplicativity of support +supremum on all nonpositive real Hahn series. -/ +theorem negativeMonomialIdeal_isPrime_iff_supportSup_mul : + (negativeMonomialIdeal K).IsPrime ↔ + ∀ b c : Nonpositive ℝ K, + supportSup (b * c) = supportSup b + supportSup c := by + constructor + · exact fun hJ b c => + supportSup_mul_of_negativeMonomialIdeal_isPrime hJ b c + · intro hmul + rw [Ideal.isPrime_iff] + refine ⟨negativeMonomialIdeal_ne_top, ?_⟩ + intro b c hbc + rw [mem_negativeMonomialIdeal_iff_supportSup_lt_zero] at hbc + rw [hmul] at hbc + by_cases hb : b = 0 + · left + rw [hb] + exact (negativeMonomialIdeal K).zero_mem + by_cases hc : c = 0 + · right + rw [hc] + exact (negativeMonomialIdeal K).zero_mem + have hbSup : sSup (b : K⟦ℝ⟧).support ≤ 0 := + csSup_le + (support_nonempty_iff.mpr (by simpa using hb)) + (support_subset b) + rw [supportSup_of_ne hb, supportSup_of_ne hc] at hbc + have hbc' : + sSup (b : K⟦ℝ⟧).support + sSup (c : K⟦ℝ⟧).support < 0 := by + exact_mod_cast hbc + rcases lt_or_eq_of_le hbSup with hbNeg | hbZero + · left + rw [mem_negativeMonomialIdeal_iff_supportSup_lt_zero, + supportSup_of_ne hb] + exact WithBot.coe_lt_coe.mpr hbNeg + · right + rw [hbZero, zero_add] at hbc' + rw [mem_negativeMonomialIdeal_iff_supportSup_lt_zero, + supportSup_of_ne hc] + exact WithBot.coe_lt_coe.mpr hbc' + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Tests.lean new file mode 100644 index 0000000000..90c5ee9aae --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Tests.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Tests.SupportSupremumMultiplicativity + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Tests/SupportSupremumMultiplicativity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Tests/SupportSupremumMultiplicativity.lean new file mode 100644 index 0000000000..c25b91c43c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Tests/SupportSupremumMultiplicativity.lean @@ -0,0 +1,121 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NegativeMonomialIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm +public import Mathlib.RingTheory.Ideal.Prime +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.PrincipalMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.SupportSupremumMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero + +/-! +# API checks for support-supremum multiplicativity + +The first certificate distinguishes Berarducci's negative-monomial ideal from the kernel of the +constant-coefficient map. A negative monomial and the infinite `approachZero` series both have +zero constant coefficient, but only the negative monomial belongs to the ideal: `approachZero` +has support cofinal in zero and support supremum zero. + +The next certificates apply the parameterized LM24, Proposition 3.5.1(2) bridge to the same +unattained boundary. One checks a normalized square, while another translates one factor to +support supremum `-1`; the latter would fail to exercise the translation-back step if both +factors remained normalized. A further certificate invokes the theorem obtained from +Berarducci, Corollary 9.8. + +The final certificate invokes LM24, Proposition 3.6.1 for a nonconstant principal series whose +support does not contain zero. +-/ + +public noncomputable section + +namespace Tests + +open scoped HahnSeries + +/-- The negative-monomial ideal is not the kernel of the constant-coefficient map. -/ +theorem negativeMonomialIdeal_constantCoeff_separator : + ∃ b c : HahnSeries.Nonpositive ℝ ℚ, + HahnSeries.Nonpositive.constantCoeff b = 0 ∧ + b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal ℚ ∧ + HahnSeries.Nonpositive.constantCoeff c = 0 ∧ + HahnSeries.Nonpositive.supportSup c = 0 ∧ + (c : ℚ⟦ℝ⟧).supportOrderType = Ordinal.omega0 ∧ + 0 ∉ (c : ℚ⟦ℝ⟧).support ∧ + c ∉ HahnSeries.Nonpositive.negativeMonomialIdeal ℚ := by + let b : HahnSeries.Nonpositive ℝ ℚ := + HahnSeries.Nonpositive.single (-1) 1 (by norm_num) + refine ⟨b, approachZeroNonpositive, ?_, ?_, ?_, approachZero_supportSup, ?_, ?_, ?_⟩ + · simp [b, HahnSeries.Nonpositive.constantCoeff_apply] + · exact HahnSeries.Nonpositive.single_one_mem_negativeMonomialIdeal (by norm_num) + · rw [HahnSeries.Nonpositive.constantCoeff_apply, + coe_approachZeroNonpositive] + exact not_ne_iff.mp (by + simpa [HahnSeries.mem_support] using zero_not_mem_approachZero_support) + · simpa only [coe_approachZeroNonpositive] using + approachZero_supportOrderType + · simpa only [coe_approachZeroNonpositive] using + zero_not_mem_approachZero_support + · exact + HahnSeries.Nonpositive.not_mem_negativeMonomialIdeal_of_supportSup_eq_zero + approachZero_supportSup + +/-- The prime-ideal form of support-supremum multiplicativity holds at an unattained normalized +boundary. -/ +theorem exists_unattained_zeroSup_square_of_isPrime + (hJ : (HahnSeries.Nonpositive.negativeMonomialIdeal ℚ).IsPrime) : + ∃ b : HahnSeries.Nonpositive ℝ ℚ, + HahnSeries.Nonpositive.supportSup b = 0 ∧ + 0 ∉ (b : ℚ⟦ℝ⟧).support ∧ + HahnSeries.Nonpositive.supportSup (b * b) = 0 := by + refine ⟨approachZeroNonpositive, approachZero_supportSup, ?_, ?_⟩ + · simpa only [coe_approachZeroNonpositive] using + zero_not_mem_approachZero_support + · rw [HahnSeries.Nonpositive.supportSup_mul_of_negativeMonomialIdeal_isPrime hJ, + approachZero_supportSup, zero_add] + +/-- Conditional support-supremum multiplicativity translates an unattained boundary correctly. -/ +theorem exists_translated_unattained_product + (hJ : (HahnSeries.Nonpositive.negativeMonomialIdeal ℚ).IsPrime) : + ∃ b c : HahnSeries.Nonpositive ℝ ℚ, + HahnSeries.Nonpositive.supportSup b = (-1 : ℝ) ∧ + HahnSeries.Nonpositive.supportSup c = 0 ∧ + 0 ∉ (c : ℚ⟦ℝ⟧).support ∧ + HahnSeries.Nonpositive.supportSup (b * c) = (-1 : ℝ) := by + let b : HahnSeries.Nonpositive ℝ ℚ := + HahnSeries.Nonpositive.single (-1) 1 (by norm_num) + refine ⟨b, approachZeroNonpositive, ?_, approachZero_supportSup, ?_, ?_⟩ + · exact HahnSeries.Nonpositive.supportSup_single one_ne_zero (by norm_num) + · simpa only [coe_approachZeroNonpositive] using + zero_not_mem_approachZero_support + · rw [HahnSeries.Nonpositive.supportSup_mul_of_negativeMonomialIdeal_isPrime hJ, + HahnSeries.Nonpositive.supportSup_single one_ne_zero, + approachZero_supportSup] + norm_num + +/-- Support-supremum multiplicativity holds at an unattained normalized boundary. -/ +theorem exists_unattained_zeroSup_square : + ∃ b : HahnSeries.Nonpositive ℝ ℚ, + HahnSeries.Nonpositive.supportSup b = 0 ∧ + 0 ∉ (b : ℚ⟦ℝ⟧).support ∧ + HahnSeries.Nonpositive.supportSup (b * b) = 0 := by + refine ⟨approachZeroNonpositive, approachZero_supportSup, ?_, ?_⟩ + · simpa only [coe_approachZeroNonpositive] using + zero_not_mem_approachZero_support + · rw [HahnSeries.Nonpositive.supportSup_mul, approachZero_supportSup, zero_add] + +/-- Nonconstant principal series are closed under squaring. -/ +theorem exists_nonconstant_principal_square : + ∃ b : HahnSeries.Nonpositive ℝ ℚ, + HahnSeries.Nonpositive.IsPrincipal b ∧ + 0 ∉ (b : ℚ⟦ℝ⟧).support ∧ + HahnSeries.Nonpositive.IsPrincipal (b * b) := by + refine ⟨approachZeroNonpositive, approachZero_isPrincipal, ?_, ?_⟩ + · simpa only [coe_approachZeroNonpositive] using + zero_not_mem_approachZero_support + · exact approachZero_isPrincipal.mul approachZero_isPrincipal + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DegreeTermCount.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DegreeTermCount.lean new file mode 100644 index 0000000000..2bfece5f27 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DegreeTermCount.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorTermCount + +/-! +# Cantor term count of Hahn-series degree + +LM24, Proposition 5.6.1 bounds the number of infinite-support irreducible factors by the +number of terms in the Cantor normal form of the degree. `HahnSeries.degreeCantorTermCount` +is that number, with value zero at the bottom degree of the zero series. + +Under exact degree multiplicativity, this count is additive on products of nonzero series. +This is the numerical identity used by the factorisation induction. +-/ + +open scoped HahnSeries NatOrdinal + +universe u v + +public noncomputable section + +namespace HahnSeries + +variable {R : Type v} {G : Type u} [LinearOrder G] + +/-- The number of terms in the uncompressed Cantor normal form of a Hahn-series degree, +with value zero at degree `⊥`. -/ +def degreeCantorTermCount [Zero R] (x : R⟦G⟧) : ℕ := + NatOrdinal.cantorTermCount (x.degree.unbotD 0) + +/-- Evaluation of the term count at a specified nonbottom degree. -/ +theorem degreeCantorTermCount_eq_of_degree [Zero R] {x : R⟦G⟧} + {a : NatOrdinal} (hx : x.degree = a) : + degreeCantorTermCount x = NatOrdinal.cantorTermCount a := by + rw [degreeCantorTermCount, hx, WithBot.unbotD_coe] + +/-- Hahn series with equal degree have equal Cantor term counts. -/ +theorem degreeCantorTermCount_congr [Zero R] {x y : R⟦G⟧} + (hxy : x.degree = y.degree) : + degreeCantorTermCount x = degreeCantorTermCount y := by + rw [degreeCantorTermCount, degreeCantorTermCount, hxy] + +@[simp] +theorem degreeCantorTermCount_zero [Zero R] : + degreeCantorTermCount (0 : R⟦G⟧) = 0 := by + rw [degreeCantorTermCount, degree_zero, WithBot.unbotD_bot, + NatOrdinal.cantorTermCount_zero] + +/-- Positive Hahn-series degree has at least one Cantor term. -/ +theorem degreeCantorTermCount_pos_of_degree_pos [Zero R] {x : R⟦G⟧} + (hx : 0 < x.degree) : + 0 < degreeCantorTermCount x := by + have hxNe : x ≠ 0 := by + intro hzero + subst x + simp at hx + have hxDegree : x.degree ≠ ⊥ := degree_eq_bot.not.mpr hxNe + obtain ⟨a, ha⟩ := WithBot.ne_bot_iff_exists.mp hxDegree + rw [degreeCantorTermCount, ← ha, WithBot.unbotD_coe] + apply NatOrdinal.cantorTermCount_pos + intro hzero + subst a + have hdegreeZero : (0 : WithBot NatOrdinal) = x.degree := by + simpa using ha + rw [← hdegreeZero] at hx + exact (lt_irrefl 0 hx).elim + +/-- The Cantor term count of degree is additive on nonzero products when degree is +multiplicative. -/ +theorem degreeCantorTermCount_mul + [Semiring R] [AddCommMonoid G] [IsOrderedCancelAddMonoid G] + {x y : R⟦G⟧} (hdegree : (x * y).degree = x.degree + y.degree) + (hx : x ≠ 0) (hy : y ≠ 0) : + degreeCantorTermCount (x * y) = + degreeCantorTermCount x + degreeCantorTermCount y := by + have hxDegree : x.degree ≠ ⊥ := degree_eq_bot.not.mpr hx + have hyDegree : y.degree ≠ ⊥ := degree_eq_bot.not.mpr hy + obtain ⟨a, ha⟩ := WithBot.ne_bot_iff_exists.mp hxDegree + obtain ⟨b, hb⟩ := WithBot.ne_bot_iff_exists.mp hyDegree + rw [degreeCantorTermCount, degreeCantorTermCount, + degreeCantorTermCount, hdegree, ← ha, ← hb, ← WithBot.coe_add, + WithBot.unbotD_coe, NatOrdinal.cantorTermCount_add] + simp only [WithBot.unbotD_coe] + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DegreeValuation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DegreeValuation.lean new file mode 100644 index 0000000000..627e60df70 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DegreeValuation.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.MaxAddDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +public import Mathlib.Data.Real.Basic + +/-! +# The degree valuation on nonpositive real Hahn series + +Hahn-series degree on `K((ℝ^{≤0}))` is a max-additive degree over every nontrivial coefficient +ring: the degree of a sum is at most the larger degree, and the degree of a product is at most +the Hessenberg sum of the degrees, because the support of a product lies in the sumset of the +supports and the order type of a sumset is at most the Hessenberg product of the order types +(`HahnSeries.degree_mul_le`, LM24, Corollary 3.1.2). The degree is separated: only `0` has +degree `⊥`. + +Exact multiplicativity of the degree, LM24, Theorem D, holds over a field of characteristic zero; +it is recorded separately as an `IsMultiplicative` instance on `degreeValuation K` and is not +needed for the valuation itself. +-/ + +universe v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable (K : Type v) [CommRing K] [Nontrivial K] + +/-- Hahn-series degree on `K((ℝ^{≤0}))` as a max-additive valuation: the value of `b` is the +leading Cantor exponent of the order type of its support, with `⊥` on `0`. -/ +def degreeValuation : MaxAddDegree (Nonpositive ℝ K) NatOrdinal where + toFun b := (b : K⟦ℝ⟧).degree + map_zero' := by simp + map_one_le_zero' := by + change ((1 : Nonpositive ℝ K) : K⟦ℝ⟧).degree ≤ 0 + apply le_of_eq + rw [HahnSeries.degree_eq_zero] + exact ⟨one_ne_zero, + Set.Finite.subset (Set.finite_singleton (0 : ℝ)) HahnSeries.support_single_subset⟩ + map_neg' b := HahnSeries.degree_neg (b : K⟦ℝ⟧) + map_add_le_max' b c := HahnSeries.degree_add_le _ _ + map_mul_le_add' b c := HahnSeries.degree_mul_le _ _ + +variable {K} + +/-- The degree valuation has Hahn-series degree as its value. -/ +@[simp] +theorem degreeValuation_apply (b : Nonpositive ℝ K) : + degreeValuation K b = (b : K⟦ℝ⟧).degree := + (rfl) + +variable (K) + +/-- The degree valuation is separated: only `0` has degree `⊥`. -/ +theorem degreeValuation_isSeparated : (degreeValuation K).IsSeparated := by + rw [MaxAddDegree.isSeparated_iff] + intro b + rw [degreeValuation_apply, HahnSeries.degree_eq_bot] + simp + +variable {K} + +/-- A unit of the nonpositive Hahn-series ring has degree zero whenever degree is exactly +multiplicative. -/ +theorem degree_eq_zero_of_isUnit + (hmul : ∀ b c : Nonpositive ℝ K, + ((b * c : Nonpositive ℝ K) : K⟦ℝ⟧).degree = + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree) + {b : Nonpositive ℝ K} (hb : IsUnit b) : + (b : K⟦ℝ⟧).degree = 0 := by + let c : Nonpositive ℝ K := ↑hb.unit⁻¹ + have hc : c ≠ 0 := Units.ne_zero hb.unit⁻¹ + have hbDegreeNonneg : 0 ≤ (b : K⟦ℝ⟧).degree := + HahnSeries.zero_le_degree_of_ne_zero (by + intro hzero + exact hb.ne_zero (Subtype.ext hzero)) + have hcDegreeNonneg : 0 ≤ (c : K⟦ℝ⟧).degree := + HahnSeries.zero_le_degree_of_ne_zero (by + intro hzero + exact hc (Subtype.ext hzero)) + have hdegreeOne : (((1 : Nonpositive ℝ K) : K⟦ℝ⟧).degree) = 0 := by + rw [HahnSeries.degree_eq_zero] + exact ⟨one_ne_zero, + Set.Finite.subset (Set.finite_singleton (0 : ℝ)) HahnSeries.support_single_subset⟩ + have hdegree := hmul b c + have hproduct : b * c = 1 := hb.mul_val_inv + rw [hproduct, hdegreeOne] at hdegree + have hsum : + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree = 0 := hdegree.symm + exact le_antisymm + (calc + (b : K⟦ℝ⟧).degree ≤ + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + simpa using add_le_add_right hcDegreeNonneg (b : K⟦ℝ⟧).degree + _ = 0 := hsum) + hbDegreeNonneg + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Domain.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Domain.lean new file mode 100644 index 0000000000..6d1d1024ea --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Domain.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.RingTheory.HahnSeries.Cardinal + +/-! +# Exponent-domain embeddings of Hahn series + +Mathlib's exponent-domain embedding has a one-sided support inclusion. Injectivity of the order +embedding gives the exact support formula needed by the translation and nonpositive-series APIs. +-/ + +universe u v w + +public section + +namespace HahnSeries + +variable {G : Type u} {H : Type v} {K : Type w} + [PartialOrder G] [PartialOrder H] [Zero K] + +/-- Extending the exponent domain maps the support exactly onto its image. -/ +@[simp] +theorem support_embDomain (f : G ↪o H) (x : K⟦G⟧) : + (embDomain f x).support = f '' x.support := by + apply Set.Subset.antisymm support_embDomain_subset + rintro _ ⟨g, hg, rfl⟩ + rw [mem_support] at hg ⊢ + intro hzero + exact hg (embDomain_coeff.symm.trans hzero) + +/-- Restrict a Hahn series along an ordered embedding by retaining the coefficients in its +range. This is a left inverse to `embDomain`; it is also a right inverse when the original +series is supported in the embedding's range. -/ +noncomputable def restrictDomain (f : G ↪o H) (x : K⟦H⟧) : K⟦G⟧ where + coeff g := x.coeff (f g) + isPWO_support' := by + rw [Set.isPWO_iff_exists_monotone_subseq] + intro a ha + have hfa : ∀ n, f (a n) ∈ x.support := fun n ↦ ha n + obtain ⟨g, hg⟩ := x.isPWO_support.exists_monotone_subseq hfa + exact ⟨g, fun _ _ h ↦ f.le_iff_le.mp (hg h)⟩ + +@[simp] +theorem restrictDomain_coeff (f : G ↪o H) (x : K⟦H⟧) (g : G) : + (restrictDomain f x).coeff g = x.coeff (f g) := + (rfl) + +/-- Extending an exponent domain after restricting it recovers a series supported in the +embedding's range. -/ +theorem embDomain_restrictDomain (f : G ↪o H) (x : K⟦H⟧) + (hx : x.support ⊆ Set.range f) : + embDomain f (restrictDomain f x) = x := by + ext h + by_cases hh : h ∈ Set.range f + · obtain ⟨g, rfl⟩ := hh + rw [embDomain_coeff, restrictDomain_coeff] + · rw [embDomain_notin_range hh] + have hzero : x.coeff h = 0 := by + by_contra hne + exact hh (hx hne) + exact hzero.symm + +/-- Restricting an extended Hahn series recovers the original series. -/ +@[simp] +theorem restrictDomain_embDomain (f : G ↪o H) (x : K⟦G⟧) : + restrictDomain f (embDomain f x) = x := by + ext g + rw [restrictDomain_coeff, embDomain_coeff] + +section Cardinal + +universe u' v' + +variable {G' H' : Type u'} {K' : Type v'} +variable [PartialOrder G'] [PartialOrder H'] [Zero K'] + +/-- Extending the exponent domain along an order embedding preserves support cardinality. -/ +theorem cardSupp_embDomain (f : G' ↪o H') (x : K'⟦G'⟧) : + (embDomain f x).cardSupp = x.cardSupp := by + rw [cardSupp, cardSupp, support_embDomain] + exact Cardinal.mk_image_eq f.injective + +end Cardinal + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainEmbedding.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainEmbedding.lean new file mode 100644 index 0000000000..5f70a73bc4 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainEmbedding.lean @@ -0,0 +1,185 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Domain + +/-! +# Embeddings between exponent domains of nonpositive Hahn series + +An injective additive order embedding of exponent groups induces a ring embedding between the +corresponding nonpositive Hahn-series rings. This is the nonpositive restriction of Mathlib's +`HahnSeries.embDomainRingHom`. + +The construction is used in LM24, Section 6.5 to regard a series with exponents in a subgroup +`H ⊆ ℝ` as a real-exponent Hahn series. The public support formula ensures that later statements +about real suprema refer to the same support, transported along the given embedding. +-/ + +universe u v w + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {H : Type v} {K : Type w} + [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] + [LinearOrder H] [AddCommGroup H] [IsOrderedAddMonoid H] + [CommRing K] + +/-- Map a nonpositive Hahn series along an injective additive order embedding of exponent +groups. -/ +def mapDomain (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') : + Nonpositive G K →+* Nonpositive H K := + ((HahnSeries.embDomainRingHom f hfi hf).domRestrict + (HahnSeries.nonpositiveSubring G K)).codRestrict + (HahnSeries.nonpositiveSubring H K) (fun b ↦ by + rw [HahnSeries.mem_nonpositiveSubring] + intro h hh + change h ∈ (HahnSeries.embDomain + (⟨⟨f, hfi⟩, hf _ _⟩ : G ↪o H) (b : K⟦G⟧)).support at hh + obtain ⟨g, hg, rfl⟩ := HahnSeries.support_embDomain_subset hh + simpa using (hf g 0).mpr (support_subset b hg)) + +/-- The underlying Hahn series of `mapDomain` is Mathlib's exponent-domain embedding. -/ +@[simp] +theorem coe_mapDomain (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') + (b : Nonpositive G K) : + (mapDomain f hfi hf b : K⟦H⟧) = + HahnSeries.embDomain (⟨⟨f, hfi⟩, hf _ _⟩ : G ↪o H) (b : K⟦G⟧) := + (rfl) + +/-- Mapping the exponent domain preserves the coefficient at every mapped exponent. -/ +theorem mapDomain_coeff_image (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') + (b : Nonpositive G K) (g : G) : + ((mapDomain f hfi hf b : Nonpositive H K) : K⟦H⟧).coeff (f g) = + (b : K⟦G⟧).coeff g := by + rw [coe_mapDomain] + exact HahnSeries.embDomain_coeff + +/-- Mapping the exponent domain maps the support pointwise. -/ +theorem support_mapDomain (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') + (b : Nonpositive G K) : + (mapDomain f hfi hf b : K⟦H⟧).support = f '' (b : K⟦G⟧).support := by + rw [coe_mapDomain, HahnSeries.support_embDomain] + rfl + +/-- Mapping along an exponent-domain embedding preserves support order type, after lifting both +ordinals to account for possibly different exponent universes. -/ +theorem lift_supportOrderType_mapDomain (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') (b : Nonpositive G K) : + Ordinal.lift.{u, v} + (HahnSeries.supportOrderType (mapDomain f hfi hf b : K⟦H⟧)) = + Ordinal.lift.{v, u} (HahnSeries.supportOrderType (b : K⟦G⟧)) := by + let e : G ↪o H := ⟨⟨f, hfi⟩, hf _ _⟩ + letI : WellFoundedLT (b : K⟦G⟧).support := ⟨(b : K⟦G⟧).isWF_support⟩ + letI : WellFoundedLT (mapDomain f hfi hf b : K⟦H⟧).support := + ⟨(mapDomain f hfi hf b : K⟦H⟧).isWF_support⟩ + let supportEquiv : (mapDomain f hfi hf b : K⟦H⟧).support ≃o + (b : K⟦G⟧).support := + (OrderIso.setCongr _ (f '' (b : K⟦G⟧).support) + (support_mapDomain f hfi hf b)).trans + (StrictMonoOn.orderIso e (b : K⟦G⟧).support + (e.strictMono.strictMonoOn (b : K⟦G⟧).support)).symm + rw [HahnSeries.supportOrderType_eq_typeLT (OrderIso.refl _), + HahnSeries.supportOrderType_eq_typeLT (OrderIso.refl _)] + exact supportEquiv.toRelIsoLT.ordinal_lift_type_eq + +/-- Mapping the exponent domain preserves the constant coefficient. -/ +theorem constantCoeff_mapDomain (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') + (b : Nonpositive G K) : + constantCoeff (mapDomain f hfi hf b) = constantCoeff b := by + rw [constantCoeff_apply, constantCoeff_apply, coe_mapDomain, ← f.map_zero] + exact HahnSeries.embDomain_coeff + +/-- Mapping along an injective exponent-domain map is injective on nonpositive series. -/ +theorem mapDomain_injective (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') : + Function.Injective (mapDomain (K := K) f hfi hf) := by + intro b c hbc + apply Subtype.ext + have hbc' := congrArg Subtype.val hbc + change HahnSeries.embDomain (⟨⟨f, hfi⟩, hf _ _⟩ : G ↪o H) (b : K⟦G⟧) = + HahnSeries.embDomain (⟨⟨f, hfi⟩, hf _ _⟩ : G ↪o H) (c : K⟦G⟧) at hbc' + exact HahnSeries.embDomain_injective hbc' + +/-- Restrict a nonpositive Hahn series whose support lies in the range of an exponent-domain +embedding. -/ +def restrictDomain (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') + (b : Nonpositive H K) : Nonpositive G K := + ⟨HahnSeries.restrictDomain (⟨⟨f, hfi⟩, hf _ _⟩ : G ↪o H) (b : K⟦H⟧), by + intro g hg + have hcoeff : (b : K⟦H⟧).coeff (f g) ≠ 0 := by + change (HahnSeries.restrictDomain + (⟨⟨f, hfi⟩, hf _ _⟩ : G ↪o H) (b : K⟦H⟧)).coeff g ≠ 0 at hg + rw [HahnSeries.restrictDomain_coeff] at hg + exact hg + apply (hf g 0).mp + simpa only [map_zero, Set.mem_Iic] using + b.property ((HahnSeries.mem_support _ _).mpr hcoeff)⟩ + +/-- Extending a restricted nonpositive Hahn series recovers the original series. -/ +@[simp] +theorem mapDomain_restrictDomain (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') + (b : Nonpositive H K) (hb : (b : K⟦H⟧).support ⊆ Set.range f) : + mapDomain f hfi hf (restrictDomain f hfi hf b) = b := by + apply Subtype.ext + rw [coe_mapDomain] + exact HahnSeries.embDomain_restrictDomain _ _ hb + +/-- Mapping the exponent domain sends a monomial to the monomial at the mapped exponent. -/ +@[simp] +theorem mapDomain_single (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') + (g : G) (k : K) (hg : g ≤ 0) : + mapDomain f hfi hf (single g k hg) = + single (f g) k (by simpa only [map_zero] using (hf g 0).mpr hg) := by + apply Subtype.ext + rw [coe_mapDomain, coe_single, coe_single, HahnSeries.embDomain_single] + rfl + +/-- Map a finite-support nonpositive Hahn series along an injective additive order embedding of +exponent groups. -/ +def mapDomainFiniteSupport (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') : + (finiteSupportSubring : Subring (Nonpositive G K)) →+* + (finiteSupportSubring : Subring (Nonpositive H K)) := + ((mapDomain (K := K) f hfi hf).domRestrict finiteSupportSubring).codRestrict + finiteSupportSubring (fun b ↦ by + rw [mem_finiteSupportSubring_iff] + change (mapDomain f hfi hf (b : Nonpositive G K) : K⟦H⟧).support.Finite + rw [support_mapDomain] + exact ((mem_finiteSupportSubring_iff (b : Nonpositive G K)).mp b.2).image f) + +/-- The finite-support exponent-domain map is the restriction of `mapDomain`. -/ +@[simp] +theorem coe_mapDomainFiniteSupport (f : G →+ H) (hfi : Function.Injective f) + (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') + (b : (finiteSupportSubring : Subring (Nonpositive G K))) : + ((mapDomainFiniteSupport f hfi hf b : + (finiteSupportSubring : Subring (Nonpositive H K))) : Nonpositive H K) = + mapDomain f hfi hf (b : Nonpositive G K) := + (rfl) + +/-- Mapping a finite-support series along an injective exponent-domain map is injective. -/ +theorem mapDomainFiniteSupport_injective (f : G →+ H) + (hfi : Function.Injective f) (hf : ∀ g g' : G, f g ≤ f g' ↔ g ≤ g') : + Function.Injective (mapDomainFiniteSupport (K := K) f hfi hf) := by + intro b c hbc + apply Subtype.ext + exact mapDomain_injective f hfi hf (congrArg Subtype.val hbc) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainEquiv.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainEquiv.lean new file mode 100644 index 0000000000..7dd825bde6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainEquiv.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Domain +public import Mathlib.RingTheory.HahnSeries.Multiplication +public import Mathlib.RingTheory.HahnSeries.Cardinal +public import Mathlib.Algebra.Order.Hom.Monoid + +/-! +# Reindexing Hahn series along an ordered additive equivalence + +An ordered additive equivalence of exponent groups induces a ring equivalence of Hahn-series +rings. This packages Mathlib's one-way exponent-domain embedding together with its inverse. +-/ + +public noncomputable section + +namespace HahnSeries + +variable {R G H : Type*} +variable [Semiring R] +variable [AddCommMonoid G] [LinearOrder G] [IsOrderedCancelAddMonoid G] +variable [AddCommMonoid H] [LinearOrder H] [IsOrderedCancelAddMonoid H] + +/-- Reindex Hahn-series exponents along an ordered additive equivalence. -/ +def embDomainRingEquiv (e : G ≃+o H) : R⟦G⟧ ≃+* R⟦H⟧ := by + let f : G →+ H := e.toAddEquiv.toAddMonoidHom + let F : R⟦G⟧ →+* R⟦H⟧ := + embDomainRingHom f e.injective fun _ _ ↦ e.map_le_map_iff' + apply RingEquiv.ofBijective F + constructor + · exact embDomain_injective + · intro y + refine ⟨embDomain e.symm.toOrderIso.toOrderEmbedding y, ?_⟩ + ext h + dsimp [F, f] + have outer := embDomain_coeff (f := e.toOrderIso.toOrderEmbedding) + (x := embDomain e.symm.toOrderIso.toOrderEmbedding y) (a := e.symm h) + have inner := embDomain_coeff (f := e.symm.toOrderIso.toOrderEmbedding) (x := y) (a := h) + have heh : e.toOrderIso.toOrderEmbedding (e.symm h) = h := e.apply_symm_apply h + rw [heh] at outer + exact outer.trans inner + +@[simp] +theorem embDomainRingEquiv_coeff (e : G ≃+o H) (x : R⟦G⟧) (g : G) : + (embDomainRingEquiv e x).coeff (e g) = x.coeff g := + embDomain_coeff + +/-- Reindexing exponents maps a singleton Hahn series to the corresponding singleton. -/ +@[simp] +theorem embDomainRingEquiv_single (e : G ≃+o H) (g : G) (r : R) : + embDomainRingEquiv e (single g r) = single (e g) r := by + change embDomain e.toOrderIso.toOrderEmbedding (single g r) = single (e g) r + exact embDomain_single + +/-- Reindexing exponents along an ordered additive equivalence maps support pointwise. -/ +@[simp] +theorem support_embDomainRingEquiv (e : G ≃+o H) (x : R⟦G⟧) : + (embDomainRingEquiv e x).support = e '' x.support := by + change (embDomain e.toOrderIso.toOrderEmbedding x).support = _ + exact support_embDomain e.toOrderIso.toOrderEmbedding x + +section Cardinal + +universe u v + +variable {S : Type v} {G' H' : Type u} +variable [Semiring S] +variable [AddCommMonoid G'] [LinearOrder G'] [IsOrderedCancelAddMonoid G'] +variable [AddCommMonoid H'] [LinearOrder H'] [IsOrderedCancelAddMonoid H'] + +/-- Reindexing exponents along an ordered additive equivalence preserves support cardinality. -/ +theorem cardSupp_embDomainRingEquiv (e : G' ≃+o H') (x : S⟦G'⟧) : + (embDomainRingEquiv e x).cardSupp = x.cardSupp := by + rw [cardSupp, cardSupp] + have hsupport : (embDomainRingEquiv e x).support = (fun g ↦ e g) '' x.support := by + ext h + constructor + · intro hh + refine ⟨e.symm h, ?_, e.apply_symm_apply h⟩ + rw [HahnSeries.mem_support] + have hhCoeff := (HahnSeries.mem_support _ _).mp hh + rw [← e.apply_symm_apply h, embDomainRingEquiv_coeff] at hhCoeff + exact hhCoeff + · rintro ⟨g, hg, rfl⟩ + rw [HahnSeries.mem_support, embDomainRingEquiv_coeff] + exact (HahnSeries.mem_support _ _).mp hg + rw [hsupport] + exact Cardinal.mk_image_eq (f := fun g : G' ↦ e g) e.injective + +end Cardinal + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainOrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainOrderType.lean new file mode 100644 index 0000000000..cee53cc971 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainOrderType.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEquiv +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Translation + +/-! +# Support order type under exponent-domain restriction + +Restricting a Hahn series to the range of an ordered exponent embedding cannot increase its +ordinary support order type. The support inclusion itself crosses exponent types, so the proof +uses the induced order embedding between the two support subtypes. +-/ + +public noncomputable section + +open Ordinal + +namespace HahnSeries + +universe u v + +variable {R : Type v} {G H : Type u} +variable [LinearOrder G] [LinearOrder H] + +section Restrict + +variable [Zero R] + +/-- Restricting the exponent domain along an order embedding cannot increase support order type. +-/ +theorem supportOrderType_restrictDomain_le (f : G ↪o H) (x : R⟦H⟧) : + (restrictDomain f x).supportOrderType ≤ x.supportOrderType := by + let e : ↑(restrictDomain f x).support → ↑x.support := fun g ↦ + ⟨f g.1, by + rw [mem_support] + have hg := (mem_support (restrictDomain f x) g.1).mp g.2 + rw [restrictDomain_coeff] at hg + exact hg⟩ + have he : StrictMono e := by + intro a b hab + exact f.strictMono hab + letI : WellFoundedLT ↑(restrictDomain f x).support := + ⟨(restrictDomain f x).isPWO_support.isWF⟩ + letI : WellFoundedLT ↑x.support := ⟨x.isPWO_support.isWF⟩ + rw [supportOrderType_eq_setOrderType, supportOrderType_eq_setOrderType] + calc + (restrictDomain f x).isPWO_support.orderType = + typeLT ↑(restrictDomain f x).support := + (restrictDomain f x).isPWO_support.orderType_eq_typeLT_of_orderIso + (OrderIso.refl ↑(restrictDomain f x).support) + _ ≤ typeLT ↑x.support := + (OrderEmbedding.ofStrictMono e he).ltEmbedding.ordinal_type_le + _ = x.isPWO_support.orderType := + (x.isPWO_support.orderType_eq_typeLT_of_orderIso + (OrderIso.refl ↑x.support)).symm + +end Restrict + +section RingEquiv + +variable [Semiring R] +variable [AddCommMonoid G] [IsOrderedCancelAddMonoid G] +variable [AddCommMonoid H] [IsOrderedCancelAddMonoid H] + +/-- Reindexing exponents along an ordered additive equivalence preserves support order type. -/ +@[simp] +theorem supportOrderType_embDomainRingEquiv (e : G ≃+o H) (x : R⟦G⟧) : + (embDomainRingEquiv e x).supportOrderType = x.supportOrderType := by + rw [supportOrderType_eq_setOrderType, supportOrderType_eq_setOrderType] + letI : WellFoundedLT x.support := ⟨x.isWF_support⟩ + let supportEquiv : (embDomainRingEquiv e x).support ≃o x.support := + (OrderIso.setCongr _ (e '' x.support) (support_embDomainRingEquiv e x)).trans + (StrictMonoOn.orderIso e x.support + (e.strictMono.strictMonoOn x.support)).symm + exact (embDomainRingEquiv e x).isPWO_support.orderType_eq_typeLT_of_orderIso + supportEquiv |>.trans + (x.isPWO_support.orderType_eq_typeLT_of_orderIso (OrderIso.refl x.support)).symm + +end RingEquiv + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/EPrimitive.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/EPrimitive.lean new file mode 100644 index 0000000000..4c348825a7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/EPrimitive.lean @@ -0,0 +1,332 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Translation + +/-! +# Exponent-primitive finite-support series + +Gilmer and Parker call a semigroup-ring element exponent-primitive when the greatest common +divisor of its exponents is zero. In `G ^ (≤ 0)` divisibility is the reverse order, so that +greatest common divisor is the largest exponent, and an element is exponent-primitive exactly when +its support meets zero. That reading is taken as the definition here. + +This is the reduction step of Gilmer and Parker, Theorem 6.4, specialized to a totally ordered +exponent group, where it replaces their Theorem 3.1 and their Propositions 4.6, 6.2 and 6.3. The +largest exponent is additive on products, so every nonzero element is a monomial times an +exponent-primitive element and divisibility splits along that decomposition. +-/ + +open scoped HahnSeries + +universe u v + +public noncomputable section + +namespace HahnSeries + +variable {G : Type u} {K : Type v} +variable [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] +variable [Field K] + +/-- A series supported in the nonpositive exponents is exponent-primitive when its largest +exponent is zero. -/ +def IsEPrimitive (x : K⟦G⟧) : Prop := + x.support ⊆ Set.Iic 0 ∧ x.coeff 0 ≠ 0 + +omit [IsOrderedAddMonoid G] in +theorem IsEPrimitive.support_subset {x : K⟦G⟧} (hx : IsEPrimitive x) : + x.support ⊆ Set.Iic 0 := hx.1 + +omit [IsOrderedAddMonoid G] in +theorem IsEPrimitive.ne_zero {x : K⟦G⟧} (hx : IsEPrimitive x) : x ≠ 0 := + fun h ↦ hx.2 (by simp [h]) + +/-- At the sum of two exponents dominating the respective supports, the coefficient of a product +is the product of the coefficients: that decomposition of the sum is the only one available. -/ +theorem coeff_add_of_forall_le {x y : K⟦G⟧} {a b : G} + (ha : ∀ g ∈ x.support, g ≤ a) (hb : ∀ g ∈ y.support, g ≤ b) : + (x * y).coeff (a + b) = x.coeff a * y.coeff b := by + classical + have hsplit : ∀ c ∈ Finset.addAntidiagonal x.isPWO_support y.isPWO_support (a + b), + c = (a, b) := by + intro c hc + rw [Finset.mem_addAntidiagonal] at hc + obtain ⟨hc1, hc2, hc0⟩ := hc + have h1 : c.1 = a := by + refine le_antisymm (ha _ hc1) ?_ + by_contra hlt + rw [not_le] at hlt + exact absurd hc0 (ne_of_lt (add_lt_add_of_lt_of_le hlt (hb _ hc2))) + refine Prod.ext h1 ?_ + have h2 := hc0 + rw [h1] at h2 + exact add_left_cancel h2 + rw [HahnSeries.coeff_mul] + by_cases hx0 : x.coeff a = 0 + · rw [hx0, zero_mul] + refine Finset.sum_eq_zero fun c hc ↦ ?_ + rw [hsplit c hc, hx0, zero_mul] + by_cases hy0 : y.coeff b = 0 + · rw [hy0, mul_zero] + refine Finset.sum_eq_zero fun c hc ↦ ?_ + rw [hsplit c hc, hy0, mul_zero] + refine Finset.sum_eq_single_of_mem (a, b) ?_ (fun c hc hne ↦ absurd (hsplit c hc) hne) + refine Finset.mem_addAntidiagonal.mpr ⟨?_, ?_, rfl⟩ + · exact (HahnSeries.mem_support x a).mpr hx0 + · exact (HahnSeries.mem_support y b).mpr hy0 + +/-- Zero has a unique decomposition into nonpositive exponents, so the coefficient there is +multiplicative on series supported in the nonpositive exponents. -/ +theorem coeff_zero_mul_of_support_subset {x y : K⟦G⟧} (hx : x.support ⊆ Set.Iic 0) + (hy : y.support ⊆ Set.Iic 0) : (x * y).coeff 0 = x.coeff 0 * y.coeff 0 := by + have h := coeff_add_of_forall_le (x := x) (y := y) (a := 0) (b := 0) hx hy + rwa [add_zero] at h + +theorem IsEPrimitive.mul {x y : K⟦G⟧} (hx : IsEPrimitive x) (hy : IsEPrimitive y) : + IsEPrimitive (x * y) := by + refine ⟨?_, ?_⟩ + · intro g hg + obtain ⟨i, hi, j, hj, rfl⟩ := HahnSeries.support_mul_subset hg + exact add_nonpos (hx.1 hi) (hy.1 hj) + · rw [coeff_zero_mul_of_support_subset hx.1 hy.1] + exact mul_ne_zero hx.2 hy.2 + +omit [AddCommGroup G] [IsOrderedAddMonoid G] in +/-- A nonzero finite-support series has a largest exponent. -/ +theorem exists_max_mem_support {x : K⟦G⟧} (hfin : x.support.Finite) (hx : x ≠ 0) : + ∃ a ∈ x.support, ∀ g ∈ x.support, g ≤ a := by + classical + have hne : hfin.toFinset.Nonempty := by + rw [Set.Finite.toFinset_nonempty] + exact HahnSeries.support_nonempty_iff.mpr hx + obtain ⟨a, ha, hmax⟩ := hfin.toFinset.exists_max_image id hne + exact ⟨a, (Set.Finite.mem_toFinset hfin).mp ha, + fun g hg ↦ hmax g ((Set.Finite.mem_toFinset hfin).mpr hg)⟩ + +/-- The largest exponent is additive on products. -/ +theorem isMax_support_mul {x y : K⟦G⟧} {a b : G} + (ha : a ∈ x.support) (hamax : ∀ g ∈ x.support, g ≤ a) + (hb : b ∈ y.support) (hbmax : ∀ g ∈ y.support, g ≤ b) : + a + b ∈ (x * y).support ∧ ∀ g ∈ (x * y).support, g ≤ a + b := by + refine ⟨?_, fun g hg ↦ ?_⟩ + · rw [HahnSeries.mem_support, coeff_add_of_forall_le hamax hbmax] + exact mul_ne_zero ((HahnSeries.mem_support _ _).mp ha) ((HahnSeries.mem_support _ _).mp hb) + · obtain ⟨i, hi, j, hj, rfl⟩ := HahnSeries.support_mul_subset hg + exact add_le_add (hamax i hi) (hbmax j hj) + +/-- Every nonzero finite-support series is a monomial times an exponent-primitive one, the +monomial exponent being the largest exponent of its support. -/ +theorem exists_eprimitive_decomposition' {x : K⟦G⟧} (hfin : x.support.Finite) (hx : x ≠ 0) : + ∃ m : G, ∃ y : K⟦G⟧, + m ∈ x.support ∧ y.support.Finite ∧ IsEPrimitive y ∧ x = translate m y := by + classical + obtain ⟨m, hm, hmax⟩ := exists_max_mem_support hfin hx + refine ⟨m, translate (-m) x, hm, ?_, ⟨?_, ?_⟩, ?_⟩ + · rw [HahnSeries.support_translate] + exact hfin.image _ + · intro g hg + rw [HahnSeries.support_translate] at hg + obtain ⟨a, ha, rfl⟩ := hg + simpa using hmax a ha + · rw [HahnSeries.coeff_translate] + simpa using (HahnSeries.mem_support _ _).mp hm + · rw [HahnSeries.translate_add_apply] + simp + +/-- The same decomposition in the nonpositive exponents, where the monomial exponent is +nonpositive. -/ +theorem exists_eprimitive_decomposition {x : K⟦G⟧} (hfin : x.support.Finite) + (hsub : x.support ⊆ Set.Iic 0) (hx : x ≠ 0) : + ∃ m : G, ∃ y : K⟦G⟧, + m ≤ 0 ∧ y.support.Finite ∧ IsEPrimitive y ∧ x = translate m y := by + obtain ⟨m, y, hm, hyf, hy, hxy⟩ := exists_eprimitive_decomposition' hfin hx + exact ⟨m, y, hsub hm, hyf, hy, hxy⟩ + +/-- Divisibility among finite-support series in the nonpositive exponents, with the divisor +exponent-primitive: the quotient may be taken exponent-primitive as well. -/ +theorem eprimitive_of_mul_eq {x y w : K⟦G⟧} (hx : IsEPrimitive x) (hy : IsEPrimitive y) + (hw : w.support ⊆ Set.Iic 0) (hmul : y = x * w) : IsEPrimitive w := by + refine ⟨hw, ?_⟩ + intro h0 + apply hy.2 + rw [hmul, coeff_zero_mul_of_support_subset hx.1 hw, h0, mul_zero] + +/-- Two exponent-primitive series differing by a translation are equal: the translation must be +trivial, since it moves both the largest exponent and the exponent carrying a nonzero +coefficient. -/ +theorem eq_zero_of_isEPrimitive_translate {d : G} {u v : K⟦G⟧} (hu : IsEPrimitive u) + (hv : IsEPrimitive v) (h : u = translate d v) : d = 0 := by + have hmem : d ∈ u.support := by + refine (HahnSeries.mem_support _ _).mpr ?_ + rw [h, HahnSeries.coeff_translate] + simpa using hv.2 + have hneg : -d ∈ v.support := by + refine (HahnSeries.mem_support _ _).mpr ?_ + have h0 := hu.2 + rw [h, HahnSeries.coeff_translate] at h0 + simpa [sub_eq_add_neg] using h0 + exact le_antisymm (hu.1 hmem) (neg_nonpos.mp (hv.1 hneg)) + +/-- Divisibility in the finite-support ring on the nonpositive exponents. -/ +def DvdNP (x z : K⟦G⟧) : Prop := + ∃ w : K⟦G⟧, w.support.Finite ∧ w.support ⊆ Set.Iic 0 ∧ z = x * w + +/-- Divisibility in the finite-support ring on the whole exponent group. -/ +def DvdFS (x z : K⟦G⟧) : Prop := + ∃ w : K⟦G⟧, w.support.Finite ∧ z = x * w + +theorem dvdNP_iff {x z : K⟦G⟧} : + DvdNP x z ↔ + ∃ w : K⟦G⟧, w.support.Finite ∧ w.support ⊆ Set.Iic 0 ∧ z = x * w := (Iff.rfl) + +theorem dvdFS_iff {x z : K⟦G⟧} : + DvdFS x z ↔ ∃ w : K⟦G⟧, w.support.Finite ∧ z = x * w := (Iff.rfl) + +theorem DvdNP.dvdFS {x z : K⟦G⟧} (h : DvdNP x z) : DvdFS x z := by + obtain ⟨w, hwf, -, hw⟩ := h + exact ⟨w, hwf, hw⟩ + +/-- On exponent-primitive elements the two divisibilities agree: a quotient with a positive +exponent would push the largest exponent of the product above zero. -/ +theorem dvdNP_iff_dvdFS {x z : K⟦G⟧} (hx : IsEPrimitive x) (hz : IsEPrimitive z) : + DvdNP x z ↔ DvdFS x z := by + refine ⟨DvdNP.dvdFS, ?_⟩ + rintro ⟨w, hwf, rfl⟩ + have hw0 : w ≠ 0 := by + rintro rfl + exact hz.ne_zero (by simp) + obtain ⟨m, hm, hmmax⟩ := exists_max_mem_support hwf hw0 + obtain ⟨hmem, hmax⟩ := + isMax_support_mul ((HahnSeries.mem_support x 0).mpr hx.2) hx.1 hm hmmax + rw [zero_add] at hmem hmax + have hm0 : m = 0 := + le_antisymm (hz.1 hmem) (hmax 0 ((HahnSeries.mem_support _ _).mpr hz.2)) + exact ⟨w, hwf, fun g hg ↦ hm0 ▸ hmmax g hg, rfl⟩ + +/-- Divisibility splits along the monomial decomposition: the monomial exponents compare and the +exponent-primitive parts divide. -/ +theorem dvdNP_translate_iff {a c : G} {x₀ z₀ : K⟦G⟧} + (hx₀ : IsEPrimitive x₀) (hz₀ : IsEPrimitive z₀) : + DvdNP (translate a x₀) (translate c z₀) ↔ c ≤ a ∧ DvdNP x₀ z₀ := by + constructor + · rintro ⟨w, hwf, hws, hw⟩ + have hw0 : w ≠ 0 := by + rintro rfl + rw [mul_zero] at hw + exact hz₀.ne_zero ((translate c).injective (by simpa using hw)) + obtain ⟨e, y, hele, hyf, hy, rfl⟩ := exists_eprimitive_decomposition hwf hws hw0 + have hprod : translate c z₀ = translate (a + e) (x₀ * y) := by + rw [hw, HahnSeries.translate_mul_translate] + have hshift : x₀ * y = translate (c - (a + e)) z₀ := by + have h2 := congrArg (translate (-(a + e))) hprod + rw [HahnSeries.translate_add_apply, HahnSeries.translate_add_apply] at h2 + simp only [neg_add_cancel, HahnSeries.translate_zero_apply] at h2 + rw [← h2] + congr 1 + abel_nf + have hzero : c - (a + e) = 0 := + eq_zero_of_isEPrimitive_translate (hx₀.mul hy) hz₀ hshift + have hce : c = a + e := by + have := hzero + rwa [sub_eq_zero] at this + refine ⟨?_, y, hyf, hy.1, ?_⟩ + · rw [hce] + simpa using add_le_add_left hele a + · rw [hshift, hzero] + simp + · rintro ⟨hca, w, hwf, hws, rfl⟩ + refine ⟨translate (c - a) w, ?_, ?_, ?_⟩ + · rw [HahnSeries.support_translate] + exact hwf.image _ + · rw [HahnSeries.support_translate] + rintro _ ⟨g, hg, rfl⟩ + exact add_nonpos (by simpa using sub_nonpos.mpr hca) (hws hg) + · rw [HahnSeries.translate_mul_translate] + congr 1 + abel_nf + +theorem dvdNP_zero (e : K⟦G⟧) : DvdNP e 0 := ⟨0, by simp, by simp, by simp⟩ + +theorem translate_mul_left (a : G) (x y : K⟦G⟧) : translate a (x * y) = x * translate a y := by + have h := HahnSeries.translate_mul_translate (0 : G) a x y + rw [HahnSeries.translate_zero_apply, zero_add] at h + exact h.symm + +/-- Divisibility in the whole group ring is unchanged by translating the dividend, since a +translation is multiplication by a unit. -/ +theorem dvdFS_translate_iff {b : G} {e w : K⟦G⟧} : DvdFS e (translate b w) ↔ DvdFS e w := by + constructor + · rintro ⟨v, hvf, hv⟩ + refine ⟨translate (-b) v, ?_, ?_⟩ + · rw [HahnSeries.support_translate] + exact hvf.image _ + · have h2 := congrArg (translate (-b)) hv + rw [HahnSeries.translate_add_apply] at h2 + simp only [neg_add_cancel, HahnSeries.translate_zero_apply] at h2 + rw [h2] + exact translate_mul_left _ _ _ + · rintro ⟨v, hvf, hv⟩ + refine ⟨translate b v, ?_, ?_⟩ + · rw [HahnSeries.support_translate] + exact hvf.image _ + · rw [hv] + exact translate_mul_left _ _ _ + +/-- Gilmer and Parker, Theorem 6.4 for a totally ordered exponent group: greatest common divisors +in the whole group ring produce greatest common divisors in the nonpositive ring. -/ +theorem exists_gcd_nonpositive_of_exists_gcd + (Hgcd : ∀ x z : K⟦G⟧, x.support.Finite → z.support.Finite → + ∃ d : K⟦G⟧, d.support.Finite ∧ + ∀ e : K⟦G⟧, e.support.Finite → (DvdFS e x ∧ DvdFS e z ↔ DvdFS e d)) + {x z : K⟦G⟧} (hxf : x.support.Finite) (hxs : x.support ⊆ Set.Iic 0) + (hzf : z.support.Finite) (hzs : z.support ⊆ Set.Iic 0) : + ∃ d : K⟦G⟧, d.support.Finite ∧ d.support ⊆ Set.Iic 0 ∧ + ∀ e : K⟦G⟧, e.support.Finite → e.support ⊆ Set.Iic 0 → + (DvdNP e x ∧ DvdNP e z ↔ DvdNP e d) := by + classical + rcases eq_or_ne x 0 with rfl | hx0 + · exact ⟨z, hzf, hzs, fun e _ _ ↦ ⟨fun h ↦ h.2, fun h ↦ ⟨dvdNP_zero e, h⟩⟩⟩ + rcases eq_or_ne z 0 with rfl | hz0 + · exact ⟨x, hxf, hxs, fun e _ _ ↦ ⟨fun h ↦ h.1, fun h ↦ ⟨h, dvdNP_zero e⟩⟩⟩ + obtain ⟨a, x₀, hale, hx₀f, hx₀, rfl⟩ := exists_eprimitive_decomposition hxf hxs hx0 + obtain ⟨c, z₀, hcle, hz₀f, hz₀, rfl⟩ := exists_eprimitive_decomposition hzf hzs hz0 + obtain ⟨d₀, hd₀f, hd₀⟩ := Hgcd x₀ z₀ hx₀f hz₀f + have hd₀ne : d₀ ≠ 0 := by + rintro rfl + obtain ⟨hdx, -⟩ := (hd₀ 0 (by simp)).mpr ⟨1, by simp, by simp⟩ + obtain ⟨w, -, hw⟩ := hdx + exact hx₀.ne_zero (by simpa using hw) + obtain ⟨b, d₁, -, hd₁f, hd₁, hd₀eq⟩ := exists_eprimitive_decomposition' hd₀f hd₀ne + have hd₁gcd : ∀ e : K⟦G⟧, e.support.Finite → + (DvdFS e x₀ ∧ DvdFS e z₀ ↔ DvdFS e d₁) := by + intro e hef + rw [hd₀ e hef, hd₀eq, dvdFS_translate_iff] + refine ⟨translate (max a c) d₁, ?_, ?_, ?_⟩ + · rw [HahnSeries.support_translate] + exact hd₁f.image _ + · rw [HahnSeries.support_translate] + rintro _ ⟨g, hg, rfl⟩ + exact add_nonpos (max_le hale hcle) (hd₁.1 hg) + · intro e hef hes + rcases eq_or_ne e 0 with rfl | he0 + · constructor + · rintro ⟨⟨w, -, -, hw⟩, -⟩ + refine absurd ?_ hx₀.ne_zero + have hz : translate a x₀ = 0 := by simpa using hw + exact (translate a).injective (by simpa using hz) + · rintro ⟨w, -, -, hw⟩ + refine absurd ?_ hd₁.ne_zero + have hz : translate (max a c) d₁ = 0 := by simpa using hw + exact (translate (max a c)).injective (by simpa using hz) + obtain ⟨f, e₀, -, he₀f, he₀, rfl⟩ := exists_eprimitive_decomposition hef hes he0 + rw [dvdNP_translate_iff he₀ hx₀, dvdNP_translate_iff he₀ hz₀, + dvdNP_translate_iff he₀ hd₁, dvdNP_iff_dvdFS he₀ hx₀, dvdNP_iff_dvdFS he₀ hz₀, + dvdNP_iff_dvdFS he₀ hd₁, ← hd₁gcd e₀ he₀f, max_le_iff] + tauto + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FactorCoefficients.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FactorCoefficients.lean new file mode 100644 index 0000000000..ec56a74488 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FactorCoefficients.lean @@ -0,0 +1,99 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LatticeFactorCoefficients +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupAlgebra + +/-! +# Clearing a scalar out of a finite-support Hahn factor + +Two finite-support series have finitely many exponents between them, so both lie in the group ring +of the subgroup those exponents generate, which is free of finite rank. Coefficient extension +commutes with the inclusion of that group ring into the series ring, so a factorisation whose +product has coefficients in the subfield transports to the group ring, where one scalar clears a +factor into the subfield. +-/ + +universe u v w + +namespace HahnSeries + +public section + +variable {K : Type u} {L : Type v} [Field K] [Field L] [Algebra K L] +variable {G : Type w} [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] + +/-- Coefficient extension commutes with the subgroup-algebra inclusion. -/ +theorem subgroupAlgebraHom_mapRingHom (H : AddSubgroup G) (P : AddMonoidAlgebra K H) : + HahnSeries.subgroupAlgebraHom H (AddMonoidAlgebra.mapRingHom H (algebraMap K L) P) = + (HahnSeries.subgroupAlgebraHom H P).map (algebraMap K L) := by + classical + refine HahnSeries.coeff_injective (funext fun g ↦ ?_) + rw [HahnSeries.coeff_subgroupAlgebraHom, HahnSeries.map_coeff, + HahnSeries.coeff_subgroupAlgebraHom] + by_cases hg : g ∈ H + · rw [dif_pos hg, dif_pos hg, AddMonoidAlgebra.mapRingHom_apply', + Finsupp.mapRange_apply] + · rw [dif_neg hg, dif_neg hg, map_zero] + +/-- Hahn-series form of scalar clearing for finite-support factors. -/ +theorem exists_scalar_of_hahn_mul_eq_map + (hclosed : Algebra.IsRelativelyAlgebraicallyClosed K L) + {p q : HahnSeries G L} {a : HahnSeries G K} (hp : p ≠ 0) (hq : q ≠ 0) + (hpfin : p.support.Finite) (hqfin : q.support.Finite) + (hrel : p * q = a.map (algebraMap K L)) : + ∃ c : L, c ≠ 0 ∧ ∀ x, c * p.coeff x ∈ (algebraMap K L).range := by + classical + set S : Finset G := hpfin.toFinset ∪ hqfin.toFinset with hS + set H : AddSubgroup G := AddSubgroup.closure (S : Set G) with hH + have hpH : p.support ⊆ (H : Set G) := fun x hx ↦ AddSubgroup.subset_closure + (Finset.mem_coe.mpr (Finset.mem_union_left _ (hpfin.mem_toFinset.mpr hx))) + have hqH : q.support ⊆ (H : Set G) := fun x hx ↦ AddSubgroup.subset_closure + (Finset.mem_coe.mpr (Finset.mem_union_right _ (hqfin.mem_toFinset.mpr hx))) + have haH : a.support ⊆ (H : Set G) := by + intro x hx + have hxa : x ∈ (a.map (algebraMap K L)).support := by + rw [HahnSeries.mem_support, HahnSeries.map_coeff] + exact fun h0 ↦ (HahnSeries.mem_support _ _).mp hx + ((algebraMap K L).injective (by rw [h0, map_zero])) + rw [← hrel] at hxa + obtain ⟨u, hu, v, hv, rfl⟩ := Set.mem_add.mp (HahnSeries.support_mul_subset hxa) + exact AddSubgroup.add_mem H (hpH hu) (hqH hv) + have hafin : a.support.Finite := by + refine Set.Finite.subset (Set.Finite.add hpfin hqfin) ?_ + intro x hx + have hxa : x ∈ (a.map (algebraMap K L)).support := by + rw [HahnSeries.mem_support, HahnSeries.map_coeff] + exact fun h0 ↦ (HahnSeries.mem_support _ _).mp hx + ((algebraMap K L).injective (by rw [h0, map_zero])) + rw [← hrel] at hxa + exact HahnSeries.support_mul_subset hxa + obtain ⟨p₁, hp₁⟩ := HahnSeries.exists_subgroupAlgebraHom_eq H hpfin hpH + obtain ⟨q₁, hq₁⟩ := HahnSeries.exists_subgroupAlgebraHom_eq H hqfin hqH + obtain ⟨a₁, ha₁⟩ := HahnSeries.exists_subgroupAlgebraHom_eq H hafin haH + have hp₁0 : p₁ ≠ 0 := fun h0 ↦ hp (by rw [← hp₁, h0, map_zero]) + have hq₁0 : q₁ ≠ 0 := fun h0 ↦ hq (by rw [← hq₁, h0, map_zero]) + have hrel₁ : p₁ * q₁ = AddMonoidAlgebra.mapRingHom H (algebraMap K L) a₁ := by + refine HahnSeries.subgroupAlgebraHom_injective H ?_ + rw [map_mul, hp₁, hq₁, hrel, subgroupAlgebraHom_mapRingHom, ha₁] + obtain ⟨c, hc, hcoeff⟩ := AddMonoidAlgebra.exists_scalar_of_mul_eq_map_free + (HahnSeries.exists_addEquiv_fin S) hclosed hp₁0 hq₁0 hrel₁ + refine ⟨c, hc, fun x ↦ ?_⟩ + by_cases hx : x ∈ H + · have : p.coeff x = p₁ ⟨x, hx⟩ := by + rw [← hp₁, HahnSeries.coeff_subgroupAlgebraHom, dif_pos hx] + rw [this] + exact hcoeff _ + · have : p.coeff x = 0 := by + rw [← hp₁, HahnSeries.coeff_subgroupAlgebraHom, dif_neg hx] + rw [this, mul_zero] + exact ⟨0, map_zero _⟩ + +end + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization.lean new file mode 100644 index 0000000000..6465f38467 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducibleFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.FiniteSupportFactorUniqueness +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GermLike +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GradedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.InfiniteSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFiniteMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPart +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartSeries +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PreSchreier +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringLocalization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVGradedMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/AlmostIrreducible.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/AlmostIrreducible.lean new file mode 100644 index 0000000000..a723efa195 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/AlmostIrreducible.lean @@ -0,0 +1,187 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Monomial +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.RealSupportSupremum +public import Mathlib.Algebra.Group.Irreducible.Defs +public import Mathlib.GroupTheory.Divisible + +import Mathlib.Algebra.GroupWithZero.Divisibility + +/-! +# Almost-irreducible Hahn series + +LM24, Section 6.5 weakens irreducibility for a divisible additive subgroup `H ⊆ ℝ`. A +series is almost irreducible when, in every factorisation, a nonmonomial factor forces the other +factor to be a monomial. + +The three consequences surrounding LM24, Remark 6.5.1 are formalized explicitly. Irreducibility +implies almost irreducibility, and a strictly negative real support supremum prevents +irreducibility. The printed converse at support supremum zero omits the condition that the series +is not a unit: `1` is almost irreducible and has support supremum zero, but is not irreducible. +The corrected theorem below adds exactly that missing condition. The definition itself is not +changed, because monomials are intended to remain almost irreducible later in LM24. +-/ + +open scoped HahnSeries + +universe v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {H : AddSubgroup ℝ} {K : Type v} [Field K] + +/-- Every factorisation with a nonmonomial left factor has a monomial right factor. This is +LM24's notion of an almost-irreducible series from Section 6.5. -/ +def IsAlmostIrreducible (b : Nonpositive H K) : Prop := + ∀ c d : Nonpositive H K, b = c * d → ¬IsMonomial c → IsMonomial d + +/-- Characterization of almost irreducibility by factorisations. -/ +theorem isAlmostIrreducible_iff {b : Nonpositive H K} : + IsAlmostIrreducible b ↔ + ∀ c d : Nonpositive H K, b = c * d → ¬IsMonomial c → IsMonomial d := + Iff.rfl + +/-- An almost-irreducible series is nonzero. -/ +theorem IsAlmostIrreducible.ne_zero {b : Nonpositive H K} + (hb : IsAlmostIrreducible b) : b ≠ 0 := by + intro hzero + subst b + have hzeroNotMonomial : ¬IsMonomial (0 : Nonpositive H K) := + fun h ↦ h.ne_zero rfl + exact (hb 0 0 (by simp) hzeroNotMonomial).ne_zero rfl + +/-- An irreducible nonpositive Hahn series is almost irreducible. This is the first assertion of +LM24, Remark 6.5.1. -/ +theorem Irreducible.isAlmostIrreducible {b : Nonpositive H K} + (hb : Irreducible b) : IsAlmostIrreducible b := by + intro c d hfactor hc + rcases hb.isUnit_or_isUnit hfactor with hcUnit | hdUnit + · exact (hc (isMonomial_of_isUnit hcUnit)).elim + · exact isMonomial_of_isUnit hdUnit + +/-- The multiplicative identity is almost irreducible. This is the counterexample showing that +the printed support-supremum-zero implication in LM24, Remark 6.5.1 needs a nonunit hypothesis. +-/ +theorem one_isAlmostIrreducible : + IsAlmostIrreducible (1 : Nonpositive H K) := by + intro c d hfactor _ + exact isMonomial_of_isUnit (IsUnit.of_mul_eq_one_right c hfactor.symm) + +/-- A monomial divisor of a series with real support supremum zero is a unit. -/ +theorem IsMonomial.isUnit_of_dvd_of_realSupportSup_eq_zero + {b c : Nonpositive H K} (hc : IsMonomial c) (hcb : c ∣ b) + (hbSup : realSupportSup H b = 0) : IsUnit c := by + obtain ⟨d, hfactor⟩ := hcb + obtain ⟨g, k, hg, hk, rfl⟩ := isMonomial_iff.mp hc + rcases lt_or_eq_of_le hg with hgNeg | rfl + · have hlub := (Iff.mp (realSupportSup_eq_coe_iff H) hbSup).2 + have hgUpper : (g : ℝ) ∈ upperBounds + ((fun h : H ↦ (h : ℝ)) '' (b : K⟦H⟧).support) := by + rintro _ ⟨z, hz, rfl⟩ + rw [hfactor] at hz + obtain ⟨x, hx, y, hy, rfl⟩ := HahnSeries.support_mul_subset hz + have hxg : x = g := by + have hx' : x ∈ (HahnSeries.single g k : K⟦H⟧).support := by + simpa only [coe_single] using hx + simpa [HahnSeries.support_single_of_ne hk] using hx' + subst x + have hyNonpos := support_subset d hy + exact_mod_cast (add_le_of_nonpos_right hyNonpos) + have hzeroLe : (0 : ℝ) ≤ g := hlub.2 hgUpper + exfalso + exact (not_le_of_gt (show (g : ℝ) < 0 by exact_mod_cast hgNeg)) hzeroLe + · have hconstant : single (0 : H) k le_rfl = (C : K →+* Nonpositive H K) k := by + apply Subtype.ext + rw [coe_single, coe_C] + rfl + rw [hconstant] + exact (isUnit_iff_ne_zero.mpr hk).map C + +/-- Corrected support-supremum-zero implication from LM24, Remark 6.5.1. An +almost-irreducible nonunit with real support supremum zero is irreducible. -/ +theorem IsAlmostIrreducible.irreducible_of_not_isUnit_of_realSupportSup_eq_zero + {b : Nonpositive H K} (hb : IsAlmostIrreducible b) (hbNotUnit : ¬IsUnit b) + (hbSup : realSupportSup H b = 0) : Irreducible b := by + rw [irreducible_iff] + refine ⟨hbNotUnit, ?_⟩ + intro c d hfactor + by_cases hc : IsMonomial c + · exact Or.inl (hc.isUnit_of_dvd_of_realSupportSup_eq_zero + ⟨d, hfactor⟩ hbSup) + · have hd := hb c d hfactor hc + exact Or.inr (hd.isUnit_of_dvd_of_realSupportSup_eq_zero + ⟨c, by simpa [mul_comm] using hfactor⟩ hbSup) + +/-- A series with strictly negative real support supremum is not irreducible. This is the final +assertion of LM24, Remark 6.5.1. -/ +theorem not_irreducible_of_realSupportSup_lt_zero [DivisibleBy H ℤ] + {b : Nonpositive H K} (hbSup : realSupportSup H b < 0) : ¬Irreducible b := by + letI : DivisibleBy H ℕ := AddGroup.divisibleByNatOfDivisibleByInt H + intro hbIrreducible + have hbNe : b ≠ 0 := hbIrreducible.ne_zero + have hbSupNeBot : realSupportSup H b ≠ ⊥ := by + intro hbot + exact hbNe (Iff.mp (realSupportSup_eq_bot H) hbot) + obtain ⟨s, hsSup⟩ := WithBot.ne_bot_iff_exists.mp hbSupNeBot + have hsSup' : realSupportSup H b = (s : WithBot ℝ) := hsSup.symm + have hsNeg : s < 0 := by + rw [hsSup'] at hbSup + exact_mod_cast hbSup + have hlub := (Iff.mp (realSupportSup_eq_coe_iff H) hsSup').2 + have htwoSNotUpper : (2 * s : ℝ) ∉ upperBounds + ((fun h : H ↦ (h : ℝ)) '' (b : K⟦H⟧).support) := by + intro htwoSUpper + have hsLeTwoS := hlub.2 htwoSUpper + linarith + rw [mem_upperBounds] at htwoSNotUpper + push Not at htwoSNotUpper + obtain ⟨_, ⟨y, hySupport, rfl⟩, hyLower⟩ := htwoSNotUpper + have hyUpper : (y : ℝ) ≤ s := hlub.1 ⟨y, hySupport, rfl⟩ + have hyNeg : (y : ℝ) < 0 := hyUpper.trans_lt hsNeg + let x : H := DivisibleBy.div y (2 : ℕ) + have htwoX : 2 • x = y := DivisibleBy.div_cancel y (by norm_num) + have htwoXReal : (x : ℝ) + x = y := by + exact_mod_cast (by simpa [two_nsmul] using htwoX) + have hsLtX : s < (x : ℝ) := by linarith + have hxNeg : (x : ℝ) < 0 := by linarith + have hxNonpos : x ≤ 0 := by exact_mod_cast hxNeg.le + let dFull : K⟦H⟧ := HahnSeries.single (-x) 1 * (b : K⟦H⟧) + have hdSupportStrict : ∀ z ∈ dFull.support, z < 0 := by + intro z hz + obtain ⟨u, hu, v, hv, rfl⟩ := HahnSeries.support_mul_subset hz + have huEq : u = -x := by + simpa [HahnSeries.support_single_of_ne one_ne_zero] using hu + subst u + have hvLe : (v : ℝ) ≤ s := hlub.1 ⟨v, hv, rfl⟩ + exact_mod_cast (show (-(x : ℝ) + v) < 0 by linarith) + let d : Nonpositive H K := + ⟨dFull, by + rw [HahnSeries.mem_nonpositiveSubring] + exact fun z hz ↦ (hdSupportStrict z hz).le⟩ + have hfactor : b = single x 1 hxNonpos * d := by + apply Subtype.ext + rw [Subring.coe_mul, coe_single] + change (b : K⟦H⟧) = HahnSeries.single x 1 * dFull + simp [dFull, ← mul_assoc] + have hxNonzero : x ≠ 0 := by + intro hxZero + exact (ne_of_lt hxNeg) (congrArg Subtype.val hxZero) + have hxNotUnit : ¬IsUnit (single x (1 : K) hxNonpos) := by + rw [isUnit_single_iff (G := H) (K := K) one_ne_zero hxNonpos] + exact hxNonzero + have hdNotUnit : ¬IsUnit d := by + intro hdUnit + have hsupport := support_eq_singleton_zero_of_isUnit hdUnit + have hzeroMem : (0 : H) ∈ (d : K⟦H⟧).support := by simp [hsupport] + exact (lt_irrefl (0 : H)) (hdSupportStrict 0 hzeroMem) + exact hxNotUnit + (hbIrreducible.isUnit_or_isUnit hfactor |>.resolve_right hdNotUnit) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/AlmostIrreducibleFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/AlmostIrreducibleFactorization.lean new file mode 100644 index 0000000000..a21aeae1c9 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/AlmostIrreducibleFactorization.lean @@ -0,0 +1,132 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportConstantTermOne + +/-! +# Factorisations over a divisible exponent subgroup + +This file defines the factorisation objects in LM24, Theorem 6.5.7. The coefficient scalar is +retained explicitly: the printed product omits it, and therefore does not represent a nonunit +constant series. A nonpositive subgroup exponent represents the monomial factor, while a list +represents the finite family of almost irreducible factors. + +The normalized finite-support factor and the monomial exponent have separate uniqueness +predicates. No uniqueness is asserted for the list of almost irreducible or irreducible factors. +-/ + +open scoped HahnSeries + +universe v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {H : AddSubgroup ℝ} {K : Type v} [Field K] + +/-- A corrected LM24, Theorem 6.5.7 factorisation: a nonzero coefficient scalar, a normalized +finite-support factor, a coefficient-one monomial, and finitely many almost irreducible factors +with infinite support. -/ +def IsAlmostIrreducibleFactorization + (b : Nonpositive H K) (k : Kˣ) + (p : ConstantTermOneFiniteSupport (G := H) (K := K)) + (x : exponentMonoid H) (factors : List (Nonpositive H K)) : Prop := + b = C (k : K) * + ((p : FiniteSupportRing (G := H) (K := K)) : Nonpositive H K) * + (finiteSupportMonomial (K := K) x : Nonpositive H K) * factors.prod ∧ + ∀ c ∈ factors, IsAlmostIrreducible c ∧ (c : K⟦H⟧).support.Infinite + +/-- Characterization of an almost-irreducible factorisation over an exponent subgroup. -/ +theorem isAlmostIrreducibleFactorization_iff + (b : Nonpositive H K) (k : Kˣ) + (p : ConstantTermOneFiniteSupport (G := H) (K := K)) + (x : exponentMonoid H) (factors : List (Nonpositive H K)) : + IsAlmostIrreducibleFactorization b k p x factors ↔ + b = C (k : K) * + ((p : FiniteSupportRing (G := H) (K := K)) : Nonpositive H K) * + (finiteSupportMonomial (K := K) x : Nonpositive H K) * factors.prod ∧ + ∀ c ∈ factors, IsAlmostIrreducible c ∧ (c : K⟦H⟧).support.Infinite := + Iff.rfl + +/-- The normalized finite-support factor is unique among all corrected almost-irreducible +factorisations of the same series. -/ +def IsUniqueNormalizedHFactor + (b : Nonpositive H K) + (p : ConstantTermOneFiniteSupport (G := H) (K := K)) : Prop := + ∀ (k : Kˣ) (q : ConstantTermOneFiniteSupport (G := H) (K := K)) + (x : exponentMonoid H) (factors : List (Nonpositive H K)), + IsAlmostIrreducibleFactorization b k q x factors → q = p + +/-- Characterization of uniqueness of the normalized finite-support factor. -/ +theorem isUniqueNormalizedHFactor_iff + (b : Nonpositive H K) + (p : ConstantTermOneFiniteSupport (G := H) (K := K)) : + IsUniqueNormalizedHFactor b p ↔ + ∀ (k : Kˣ) (q : ConstantTermOneFiniteSupport (G := H) (K := K)) + (x : exponentMonoid H) (factors : List (Nonpositive H K)), + IsAlmostIrreducibleFactorization b k q x factors → q = p := + Iff.rfl + +/-- The strengthened factorisation in LM24, Theorem 6.5.7, in which every infinite-support +factor is irreducible rather than merely almost irreducible. -/ +def IsIrreducibleSubgroupFactorization + (b : Nonpositive H K) (k : Kˣ) + (p : ConstantTermOneFiniteSupport (G := H) (K := K)) + (x : exponentMonoid H) (factors : List (Nonpositive H K)) : Prop := + b = C (k : K) * + ((p : FiniteSupportRing (G := H) (K := K)) : Nonpositive H K) * + (finiteSupportMonomial (K := K) x : Nonpositive H K) * factors.prod ∧ + ∀ c ∈ factors, Irreducible c ∧ (c : K⟦H⟧).support.Infinite + +/-- Characterization of an irreducible infinite-support factorisation over an exponent +subgroup. -/ +theorem isIrreducibleSubgroupFactorization_iff + (b : Nonpositive H K) (k : Kˣ) + (p : ConstantTermOneFiniteSupport (G := H) (K := K)) + (x : exponentMonoid H) (factors : List (Nonpositive H K)) : + IsIrreducibleSubgroupFactorization b k p x factors ↔ + b = C (k : K) * + ((p : FiniteSupportRing (G := H) (K := K)) : Nonpositive H K) * + (finiteSupportMonomial (K := K) x : Nonpositive H K) * factors.prod ∧ + ∀ c ∈ factors, Irreducible c ∧ (c : K⟦H⟧).support.Infinite := + Iff.rfl + +/-- An irreducible subgroup factorisation is, in particular, an almost-irreducible +factorisation with the same data. -/ +theorem IsIrreducibleSubgroupFactorization.isAlmostIrreducibleFactorization + {b : Nonpositive H K} {k : Kˣ} + {p : ConstantTermOneFiniteSupport (G := H) (K := K)} + {x : exponentMonoid H} {factors : List (Nonpositive H K)} + (h : IsIrreducibleSubgroupFactorization b k p x factors) : + IsAlmostIrreducibleFactorization b k p x factors := by + rw [isIrreducibleSubgroupFactorization_iff] at h + rw [isAlmostIrreducibleFactorization_iff] + refine ⟨h.1, fun c hc ↦ ?_⟩ + exact ⟨HahnSeries.Nonpositive.Irreducible.isAlmostIrreducible + (h.2 c hc).1, (h.2 c hc).2⟩ + +/-- The monomial exponent is unique among all irreducible subgroup factorisations of the same +series. -/ +def IsUniqueIrreducibleFactorizationExponent + (b : Nonpositive H K) (x : exponentMonoid H) : Prop := + ∀ (k : Kˣ) (p : ConstantTermOneFiniteSupport (G := H) (K := K)) + (y : exponentMonoid H) (factors : List (Nonpositive H K)), + IsIrreducibleSubgroupFactorization b k p y factors → y = x + +/-- Characterization of uniqueness of the monomial exponent in irreducible subgroup +factorisations. -/ +theorem isUniqueIrreducibleFactorizationExponent_iff + (b : Nonpositive H K) (x : exponentMonoid H) : + IsUniqueIrreducibleFactorizationExponent b x ↔ + ∀ (k : Kˣ) (p : ConstantTermOneFiniteSupport (G := H) (K := K)) + (y : exponentMonoid H) (factors : List (Nonpositive H K)), + IsIrreducibleSubgroupFactorization b k p y factors → y = x := + Iff.rfl + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo.lean new file mode 100644 index 0000000000..eee27e2f14 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo.lean @@ -0,0 +1,14 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwo +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwoExample +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.Factorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.FactorizationClassification +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedSpanFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedTruncationSpan + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwo.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwo.lean new file mode 100644 index 0000000000..0bbc39720a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwo.lean @@ -0,0 +1,267 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.Factorization + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermDegree +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType + +/-! +# Support and ordinal value in PS06 degree two + +This module supplies the support-theoretic input to Pommersheim--Shahriari, Lemma 3.1. A series +outside `J + K` whose support has order type `ω²` or `ω² + 1` has negative support of +order type exactly `ω²`. Its value is therefore `ω²`, while every translated truncation at +a strictly negative cutoff has smaller value. + +These conclusions precede the factorisation argument: they derive Berarducci's value hypotheses +directly from the two visible support-order alternatives used in PS06. + +## References + +* J. Pommersheim, S. Shahriari, *Unique factorization in generalized power series rings*, +Proc. Amer. Math. Soc. 134 (2006), 1277–1287, cited as [PS06]. +-/ + +universe v + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace PommersheimShahriari + +open Berarducci HahnSeries Ordinal + +variable {K : Type v} [Field K] + +private theorem truncGE_zero_eq_single (a : Series K) : + HahnSeries.truncGE 0 (a : K⟦ℝ⟧) = + HahnSeries.single 0 ((a : K⟦ℝ⟧).coeff 0) := by + ext x + rcases lt_trichotomy x 0 with hx | rfl | hx + · simp [HahnSeries.coeff_truncGE, not_le_of_gt hx, hx.ne] + · simp + · have hcoeff : (a : K⟦ℝ⟧).coeff x = 0 := by + apply not_ne_iff.mp + rw [← HahnSeries.mem_support] + exact fun hmem ↦ (not_le_of_gt hx) + (HahnSeries.Nonpositive.support_subset a hmem) + simp [HahnSeries.coeff_truncGE, hx.le, hcoeff, hx.ne'] + +private theorem supportOrderType_truncGE_zero_eq_zero_or_one (a : Series K) : + (HahnSeries.truncGE 0 (a : K⟦ℝ⟧)).supportOrderType = 0 ∨ + (HahnSeries.truncGE 0 (a : K⟦ℝ⟧)).supportOrderType = 1 := by + rw [truncGE_zero_eq_single] + by_cases hcoeff : (a : K⟦ℝ⟧).coeff 0 = 0 + · left + simp [hcoeff] + · right + exact HahnSeries.supportOrderType_single hcoeff + +/-- A series outside `J + K`, of support order type `ω²` or `ω² + 1`, has strictly +negative support of order type exactly `ω²`. -/ +theorem negativeSupport_orderType_eq_wpow_two + {a : Series K} (haNear : a ∉ nearConstantSubgroup K) + (haType : (a : K⟦ℝ⟧).supportOrderType = + (Ordinal.omega0 ^ (2 : Ordinal)) ∨ + (a : K⟦ℝ⟧).supportOrderType = + Ordinal.omega0 ^ (2 : Ordinal) + 1) : + ((a : K⟦ℝ⟧).isPWO_support.mono + (s := (a : K⟦ℝ⟧).support ∩ Set.Iio 0) + Set.inter_subset_left).orderType = Ordinal.omega0 ^ (2 : Ordinal) := by + let S : Set ℝ := (a : K⟦ℝ⟧).support ∩ Set.Iio 0 + let hS : S.IsPWO := (a : K⟦ℝ⟧).isPWO_support.mono Set.inter_subset_left + have haOne : 1 < ordinalValue a := one_lt_ordinalValue_iff.mpr haNear + have hSLUB : IsLUB S 0 := isLUB_negativeSupport_zero_of_one_lt_ordinalValue haOne + have hSne : S.Nonempty := by + obtain ⟨x, hx, -, -⟩ := hSLUB.exists_between (show (-1 : ℝ) < 0 by norm_num) + exact ⟨x, hx⟩ + have hSgt : ∀ x ∈ S, ∃ y ∈ S, x < y := by + intro x hx + obtain ⟨y, hy, hxy, -⟩ := hSLUB.exists_between hx.2 + exact ⟨y, hy, hxy⟩ + have hSlimit : Order.IsSuccLimit hS.orderType := + Set.IsPWO.isSuccLimit_orderType_of_forall_exists_gt hS hSne hSgt + have htruncSupport : + (HahnSeries.truncLT 0 (a : K⟦ℝ⟧)).support = S := by + rw [HahnSeries.support_truncLT] + rfl + have htruncType : + (HahnSeries.truncLT 0 (a : K⟦ℝ⟧)).supportOrderType = hS.orderType := by + rw [HahnSeries.supportOrderType_eq_setOrderType] + exact (HahnSeries.truncLT 0 (a : K⟦ℝ⟧)).isPWO_support.orderType_congr + hS htruncSupport + have hsplit := HahnSeries.supportOrderType_eq_truncLT_add_truncGE + 0 (a : K⟦ℝ⟧) + rcases supportOrderType_truncGE_zero_eq_zero_or_one a with hz | hz + · rw [hz, add_zero, htruncType] at hsplit + rcases haType with haType | haType + · exact hsplit.symm.trans haType + · have hbad : hS.orderType = Ordinal.omega0 ^ (2 : Ordinal) + 1 := + hsplit.symm.trans haType + rw [hbad, ← Order.succ_eq_add_one] at hSlimit + exact (Order.not_isSuccLimit_succ _ hSlimit).elim + · rw [hz, htruncType] at hsplit + rcases haType with haType | haType + · have hbad : Ordinal.omega0 ^ (2 : Ordinal) = hS.orderType + 1 := + haType.symm.trans hsplit + have homegaLimit : Order.IsSuccLimit (Ordinal.omega0 ^ (2 : Ordinal)) := + Ordinal.isSuccLimit_opow_left Ordinal.isSuccLimit_omega0 (by norm_num) + rw [hbad, ← Order.succ_eq_add_one] at homegaLimit + exact (Order.not_isSuccLimit_succ _ homegaLimit).elim + · have heq : Ordinal.omega0 ^ (2 : Ordinal) + 1 = hS.orderType + 1 := + haType.symm.trans hsplit + exact (Ordinal.add_right_cancel 1).mp (by simpa using heq) |>.symm + +/-- Every translated truncation at a strictly negative cutoff has ordinal value below `ω²` +under the degree-two PS06 hypotheses. -/ +theorem ordinalValue_translatedTruncation_lt_wpow_two + {a : Series K} (haNear : a ∉ nearConstantSubgroup K) + (haType : (a : K⟦ℝ⟧).supportOrderType = + (Ordinal.omega0 ^ (2 : Ordinal)) ∨ + (a : K⟦ℝ⟧).supportOrderType = + Ordinal.omega0 ^ (2 : Ordinal) + 1) + {u : ℝ} (hu : u < 0) : + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) u) < ω^ (2 : NatOrdinal) := by + let S : Set ℝ := (a : K⟦ℝ⟧).support ∩ Set.Iio 0 + let hS : S.IsPWO := (a : K⟦ℝ⟧).isPWO_support.mono Set.inter_subset_left + have hSType : hS.orderType = Ordinal.omega0 ^ (2 : Ordinal) := + negativeSupport_orderType_eq_wpow_two haNear haType + have haOne : 1 < ordinalValue a := one_lt_ordinalValue_iff.mpr haNear + have hSLUB : IsLUB S 0 := isLUB_negativeSupport_zero_of_one_lt_ordinalValue haOne + obtain ⟨y, hy, huy, -⟩ := hSLUB.exists_between hu + let T : Set ℝ := (HahnSeries.truncLE u (a : K⟦ℝ⟧)).support + let hT : T.IsPWO := (HahnSeries.truncLE u (a : K⟦ℝ⟧)).isPWO_support + have hTsub : T ⊆ S ∩ Set.Iio y := by + intro x hx + change x ∈ (HahnSeries.truncLE u (a : K⟦ℝ⟧)).support at hx + rw [HahnSeries.support_truncLE] at hx + exact ⟨⟨hx.1, hx.2.trans_lt hu⟩, hx.2.trans_lt huy⟩ + have hTlt : hT.orderType < hS.orderType := + (hT.orderType_mono + (hS.mono (s := S ∩ Set.Iio y) Set.inter_subset_left) hTsub).trans_lt + (hS.orderType_inter_Iio_lt hy) + calc + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) u) ≤ + NatOrdinal.of + ((translatedTruncation (a : K⟦ℝ⟧) u : Series K) : K⟦ℝ⟧).supportOrderType := + ordinalValue_le_supportOrderType _ + _ = NatOrdinal.of hT.orderType := by + rw [coe_translatedTruncation, HahnSeries.supportOrderType_translate, + HahnSeries.supportOrderType_eq_setOrderType] + _ < NatOrdinal.of (Ordinal.omega0 ^ (2 : Ordinal)) := by + apply NatOrdinal.of.lt_iff_lt.mpr + rwa [hSType] at hTlt + _ = ω^ (2 : NatOrdinal) := by + rw [NatOrdinal.of_omega0_opow] + congr 1 + +private theorem degree_eq_two + {a : Series K} (haNear : a ∉ nearConstantSubgroup K) + (haType : (a : K⟦ℝ⟧).supportOrderType = + (Ordinal.omega0 ^ (2 : Ordinal)) ∨ + (a : K⟦ℝ⟧).supportOrderType = + Ordinal.omega0 ^ (2 : Ordinal) + 1) : + (a : K⟦ℝ⟧).degree = (2 : WithBot NatOrdinal) := by + change (a : K⟦ℝ⟧).degree = + ((NatOrdinal.of (2 : Ordinal)) : WithBot NatOrdinal) + have haNe : (a : K⟦ℝ⟧) ≠ 0 := by + intro ha + apply haNear + have haSeries : a = 0 := Subtype.ext ha + rw [haSeries] + exact (nearConstantSubgroup K).zero_mem + apply le_antisymm + · rw [← Order.lt_succ_iff] + change (a : K⟦ℝ⟧).degree < + Order.succ ((NatOrdinal.of (2 : Ordinal)) : WithBot NatOrdinal) + rw [WithBot.orderSucc_coe, Order.succ_eq_add_one] + apply (HahnSeries.degree_lt_coe_iff_supportOrderType_lt_wpow + (a : K⟦ℝ⟧) (NatOrdinal.of (2 : Ordinal) + 1)).mpr + simp only [NatOrdinal.val_wpow, NatOrdinal.val_add_one, NatOrdinal.val_of] + rcases haType with haType | haType + · rw [haType] + exact (Ordinal.opow_lt_opow_iff_right Ordinal.one_lt_omega0).mpr + (Order.lt_succ (2 : Ordinal)) + · rw [haType] + simpa [Ordinal.opow_add] using + (Ordinal.opow_mul_add_lt_opow_mul + (b := Ordinal.omega0) (u := 2) (w := 1) (v := 1) (x := Ordinal.omega0) + (by norm_num) Ordinal.one_lt_omega0) + · have hlow := (HahnSeries.coe_le_degree_iff + (x := (a : K⟦ℝ⟧)) (a := (2 : Ordinal)) haNe).mpr (by + rcases haType with haType | haType + · exact haType.ge + · rw [haType] + exact le_self_add) + exact hlow + +/-- A non-near-constant series of support order type `ω²` or `ω² + 1` has +Berarducci ordinal value exactly `ω²`. -/ +theorem ordinalValue_eq_wpow_two + {a : Series K} (haNear : a ∉ nearConstantSubgroup K) + (haType : (a : K⟦ℝ⟧).supportOrderType = + (Ordinal.omega0 ^ (2 : Ordinal)) ∨ + (a : K⟦ℝ⟧).supportOrderType = + Ordinal.omega0 ^ (2 : Ordinal) + 1) : + ordinalValue a = ω^ (2 : NatOrdinal) := by + let S : Set ℝ := (a : K⟦ℝ⟧).support ∩ Set.Iio 0 + let hS : S.IsPWO := (a : K⟦ℝ⟧).isPWO_support.mono Set.inter_subset_left + have hSType : hS.orderType = Ordinal.omega0 ^ (2 : Ordinal) := + negativeSupport_orderType_eq_wpow_two haNear haType + have hSLUB : IsLUB S 0 := + isLUB_negativeSupport_zero_of_one_lt_ordinalValue (one_lt_ordinalValue_iff.mpr haNear) + have hvalueLower : ω^ (2 : NatOrdinal) ≤ ordinalValue a := by + have hordinary : NatOrdinal.of (Ordinal.omega0 ^ (2 : Ordinal)) ≤ + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) 0) := by + apply le_ordinalValue_translatedTruncation_of_forall_le_orderType + intro θ hθ + obtain ⟨y, hy, hθy, -⟩ := hSLUB.exists_between hθ + let U : Set ℝ := S ∩ Set.Ioi θ + let hU : U.IsPWO := hS.mono Set.inter_subset_left + let W : Set ℝ := (a : K⟦ℝ⟧).support ∩ Set.Ioo θ 0 + let hW : W.IsPWO := (a : K⟦ℝ⟧).isPWO_support.mono Set.inter_subset_left + have hprincipal : IsPrincipal (fun x y : Ordinal ↦ x + y) hS.orderType := by + rw [hSType] + exact Ordinal.isPrincipal_add_omega0_opow 2 + have hUType : hU.orderType = hS.orderType := + hS.orderType_inter_Ioi_eq_of_isPrincipal hprincipal ⟨y, hy, hθy⟩ + have hUW : U = W := by + ext x + simp only [U, W, S, Set.mem_inter_iff, Set.mem_Iio, Set.mem_Ioi, + Set.mem_Ioo] + tauto + have hwindowType : Ordinal.omega0 ^ (2 : Ordinal) = + ((a : K⟦ℝ⟧).isPWO_support.mono + (s := (a : K⟦ℝ⟧).support ∩ Set.Ioo θ 0) + Set.inter_subset_left).orderType := by + calc + Ordinal.omega0 ^ (2 : Ordinal) = hS.orderType := hSType.symm + _ = hU.orderType := hUType.symm + _ = ((a : K⟦ℝ⟧).isPWO_support.mono + (s := (a : K⟦ℝ⟧).support ∩ Set.Ioo θ 0) + Set.inter_subset_left).orderType := by + simpa only [hW, W] using hU.orderType_congr hW hUW + exact hwindowType.le + rw [translatedTruncation_zero] at hordinary + rw [NatOrdinal.of_omega0_opow] at hordinary + convert hordinary using 1 + congr 1 + have hdegree : (a : K⟦ℝ⟧).degree = (2 : WithBot NatOrdinal) := + degree_eq_two haNear haType + have hvalueDegreeGe : (2 : WithBot NatOrdinal) ≤ ordinalValueDegree a := by + rw [← not_lt] + intro hlt + exact (not_lt_of_ge hvalueLower) ((ordinalValueDegree_lt_coe_iff a 2).mp hlt) + have hvalueDegreeLe : ordinalValueDegree a ≤ (2 : WithBot NatOrdinal) := + (ordinalValueDegree_le_degree a).trans_eq hdegree + exact (ordinalValueDegree_eq_coe_iff a 2).mp + (le_antisymm hvalueDegreeLe hvalueDegreeGe) + +end PommersheimShahriari diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwoExample.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwoExample.lean new file mode 100644 index 0000000000..50859f317a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwoExample.lean @@ -0,0 +1,773 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedSpanFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveCoefficientMap +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.TruncationIntegerPartPrimal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Domain +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +import Mathlib.Data.Prod.Lex +import Mathlib.SetTheory.Ordinal.Arithmetic + +/-! +# An explicit PS06 degree-two irreducible + +This module constructs a coefficient-one series whose support consists of rows converging to +`-1/(m+1)`, with those row limits converging to zero. Its support has exact order type `ω²`; after +adding the constant term one, it has order type `ω² + 1`. + +The translated-truncation classes at the first three row limits have pairwise separated cofinal +supports and are linearly independent modulo `J + K`. Thus `V(a)` has dimension greater than two, +and PS06, Corollary 3.3 proves the series irreducible over every characteristic-zero coefficient +field. This is the explicit witness used by the omnific-integer example. +-/ + +open scoped HahnSeries + +public noncomputable section + +namespace PommersheimShahriari.DegreeTwoExample + +universe v + +variable {K : Type v} [Field K] + +/-- The limit point of block `m` in the explicit degree-two support. -/ +def degreeTwoCutoff (m : ℕ) : ℝ := + -(1 / (m + 1 : ℝ)) + +@[simp] +theorem degreeTwoCutoff_apply (m : ℕ) : + degreeTwoCutoff m = -(1 / (m + 1 : ℝ)) := (rfl) + +/-- The exponent in block `p.1` at position `p.2`. -/ +def degreeTwoExponentPair (p : ℕ × ℕ) : ℝ := + degreeTwoCutoff p.1 - + 1 / ((p.1 + 1 : ℝ) * (p.1 + 2 : ℝ) * (p.2 + 1 : ℝ)) + +theorem degreeTwoExponentPair_apply (p : ℕ × ℕ) : + degreeTwoExponentPair p = + -(1 / (p.1 + 1 : ℝ)) - 1 / ((p.1 + 1 : ℝ) * (p.1 + 2 : ℝ) * (p.2 + 1 : ℝ)) := (rfl) + +private theorem degreeTwoExponentPair_strictMono_second (m : ℕ) : + StrictMono (fun n : ℕ ↦ degreeTwoExponentPair (m, n)) := by + apply strictMono_nat_of_lt_succ + intro n + dsimp [degreeTwoExponentPair] + apply sub_lt_sub_left + apply one_div_lt_one_div_of_lt + · positivity + · gcongr + omega + +private theorem degreeTwoExponentPair_lt_cutoff (m n : ℕ) : + degreeTwoExponentPair (m, n) < degreeTwoCutoff m := by + dsimp [degreeTwoExponentPair] + have : 0 < + 1 / ((m + 1 : ℝ) * (m + 2 : ℝ) * (n + 1 : ℝ)) := by + positivity + linarith + +private theorem degreeTwoCutoff_lt_next_exponent_zero (m : ℕ) : + degreeTwoCutoff m < degreeTwoExponentPair (m + 1, 0) := by + dsimp [degreeTwoCutoff, degreeTwoExponentPair] + field_simp + norm_num [Nat.cast_add, Nat.cast_one] + ring_nf + nlinarith + +private theorem degreeTwoExponentPair_lt_of_first_lt + {m m' n n' : ℕ} (hmm' : m < m') : + degreeTwoExponentPair (m, n) < degreeTwoExponentPair (m', n') := by + calc + degreeTwoExponentPair (m, n) < degreeTwoCutoff m := + degreeTwoExponentPair_lt_cutoff m n + _ < degreeTwoExponentPair (m + 1, 0) := + degreeTwoCutoff_lt_next_exponent_zero m + _ ≤ degreeTwoExponentPair (m', n') := by + by_cases hsucc : m + 1 = m' + · subst m' + exact (degreeTwoExponentPair_strictMono_second (m + 1)).monotone + (Nat.zero_le n') + · have hfirst : m + 1 < m' := lt_of_le_of_ne (Nat.succ_le_iff.mpr hmm') hsucc + exact (degreeTwoExponentPair_lt_of_first_lt hfirst).le +termination_by m' - m + +private theorem degreeTwoExponent_strictMono : + StrictMono (fun p : Lex (ℕ × ℕ) ↦ degreeTwoExponentPair (ofLex p)) := by + intro p q hpq + rw [Prod.Lex.lt_iff] at hpq + rcases hpq with hfirst | ⟨hfirst, hsecond⟩ + · exact degreeTwoExponentPair_lt_of_first_lt hfirst + · change degreeTwoExponentPair ((ofLex p).1, (ofLex p).2) < + degreeTwoExponentPair ((ofLex q).1, (ofLex q).2) + rw [hfirst] + exact degreeTwoExponentPair_strictMono_second _ hsecond + +/-- The explicit order embedding used by the degree-two witness. -/ +def degreeTwoExponentEmbedding : Lex (ℕ × ℕ) ↪o ℝ := + OrderEmbedding.ofStrictMono _ degreeTwoExponent_strictMono + +@[simp] +theorem degreeTwoExponentEmbedding_apply (m n : ℕ) : + degreeTwoExponentEmbedding (toLex (m, n)) = degreeTwoExponentPair (m, n) := + (rfl) + +/-- The coefficient-one series on the natural numbers. -/ +def natOnes : K⟦ℕ⟧ where + coeff _ := 1 + isPWO_support' := by + simpa [Function.support] using Set.IsPWO.of_linearOrder (Set.univ : Set ℕ) + +@[simp] +theorem natOnes_coeff (n : ℕ) : (natOnes (K := K)).coeff n = 1 := + (rfl) + +@[simp] +theorem natOnes_support : (natOnes (K := K)).support = Set.univ := by + ext n + simp [natOnes] + +/-- The coefficient-one series indexed by two lexicographic natural coordinates. -/ +def lexNatPairOnes : K⟦Lex (ℕ × ℕ)⟧ where + coeff _ := 1 + isPWO_support' := by + simpa [Function.support] using + Set.IsPWO.of_linearOrder (Set.univ : Set (Lex (ℕ × ℕ))) + +@[simp] +theorem lexNatPairOnes_support : + (lexNatPairOnes (K := K)).support = Set.univ := by + ext p + simp [lexNatPairOnes] + +/-- An explicit coefficient-one Hahn series of support order type `ω²`. -/ +def degreeTwoSeries : K⟦ℝ⟧ := + HahnSeries.embDomain degreeTwoExponentEmbedding (lexNatPairOnes (K := K)) + +theorem degreeTwoSeries_coeff_embedding (m n : ℕ) : + (degreeTwoSeries (K := K)).coeff + (degreeTwoExponentEmbedding (toLex (m, n))) = 1 := by + rw [degreeTwoSeries, HahnSeries.embDomain_coeff] + rfl + +theorem degreeTwoSeries_support : + (degreeTwoSeries (K := K)).support = Set.range degreeTwoExponentEmbedding := by + rw [degreeTwoSeries, HahnSeries.support_embDomain, lexNatPairOnes_support, + Set.image_univ] + +@[simp] +theorem degreeTwoSeries_coeff_zero : (degreeTwoSeries (K := K)).coeff 0 = 0 := by + rw [← not_ne_iff, ← HahnSeries.mem_support, degreeTwoSeries_support (K := K)] + rintro ⟨p, hp⟩ + rcases p with ⟨m, n⟩ + have hneg := (degreeTwoExponentPair_lt_cutoff m n).trans (by + rw [degreeTwoCutoff_apply] + exact neg_neg_of_pos (by positivity)) + change degreeTwoExponentPair (m, n) = 0 at hp + linarith + +theorem degreeTwoSeries_supportOrderType : + (degreeTwoSeries (K := K)).supportOrderType = + Ordinal.omega0 ^ (2 : Ordinal) := by + rw [HahnSeries.supportOrderType_eq_setOrderType] + have e : (degreeTwoSeries (K := K)).support ≃o Lex (ℕ × ℕ) := + (OrderIso.setCongr (degreeTwoSeries (K := K)).support + (Set.range degreeTwoExponentEmbedding) + (degreeTwoSeries_support (K := K))).trans + degreeTwoExponentEmbedding.orderIso.symm + rw [(degreeTwoSeries (K := K)).isPWO_support.orderType_eq_typeLT_of_orderIso e] + change Ordinal.type (Prod.Lex (fun a b : ℕ ↦ a < b) (fun a b : ℕ ↦ a < b)) = _ + rw [Ordinal.type_prod_lex] + simp only [Ordinal.type_nat_lt] + have hsucc : Order.succ (1 : Ordinal) = 2 := one_add_one_eq_two + rw [← hsucc, Ordinal.opow_succ, Ordinal.opow_one] + +/-- The degree-two series regarded as a nonpositive real Hahn series. -/ +def degreeTwoNonpositive : HahnSeries.Nonpositive ℝ K := + ⟨degreeTwoSeries (K := K), by + rw [HahnSeries.mem_nonpositiveSubring, degreeTwoSeries_support (K := K)] + rintro _ ⟨p, rfl⟩ + rcases p with ⟨m, n⟩ + exact (degreeTwoExponentPair_lt_cutoff m n).le.trans + (by rw [degreeTwoCutoff_apply] + exact neg_nonpos.mpr (by positivity))⟩ + +/-- The exponent in block `m` after translating its limit point to zero. -/ +def degreeTwoBlockExponent (m n : ℕ) : ℝ := + -(1 / ((m + 1 : ℝ) * (m + 2 : ℝ) * (n + 1 : ℝ))) + +@[simp] +theorem degreeTwoBlockExponent_apply (m n : ℕ) : + degreeTwoBlockExponent m n = + -(1 / ((m + 1 : ℝ) * (m + 2 : ℝ) * (n + 1 : ℝ))) := (rfl) + +private theorem degreeTwoBlockExponent_strictMono (m : ℕ) : + StrictMono (degreeTwoBlockExponent m) := by + apply strictMono_nat_of_lt_succ + intro n + dsimp [degreeTwoBlockExponent] + apply neg_lt_neg + apply one_div_lt_one_div_of_lt + · positivity + · gcongr + omega + +/-- The translated support of block `m`, approaching exponent zero from below. -/ +def degreeTwoBlockEmbedding (m : ℕ) : ℕ ↪o ℝ := + OrderEmbedding.ofStrictMono _ (degreeTwoBlockExponent_strictMono m) + +@[simp] +theorem degreeTwoBlockEmbedding_apply (m n : ℕ) : + degreeTwoBlockEmbedding m n = degreeTwoBlockExponent m n := + (rfl) + +/-- Block `m` translated so that its limiting cutoff is zero. -/ +def degreeTwoBlock (m : ℕ) : Berarducci.Series K := + ⟨HahnSeries.embDomain (degreeTwoBlockEmbedding m) (natOnes (K := K)), by + rw [HahnSeries.mem_nonpositiveSubring, HahnSeries.support_embDomain, + natOnes_support, Set.image_univ] + rintro _ ⟨n, rfl⟩ + rw [degreeTwoBlockEmbedding_apply, degreeTwoBlockExponent_apply] + have h : (0 : ℝ) < + 1 / ((m + 1 : ℝ) * (m + 2 : ℝ) * (n + 1 : ℝ)) := by + positivity + exact neg_nonpos.mpr h.le⟩ + +theorem degreeTwoBlock_coeff_embedding (m n : ℕ) : + ((degreeTwoBlock (K := K) m : Berarducci.Series K) : K⟦ℝ⟧).coeff + (degreeTwoBlockEmbedding m n) = 1 := by + rw [degreeTwoBlock, HahnSeries.embDomain_coeff] + exact natOnes_coeff n + +theorem degreeTwoBlock_support (m : ℕ) : + ((degreeTwoBlock (K := K) m : Berarducci.Series K) : K⟦ℝ⟧).support = + Set.range (degreeTwoBlockEmbedding m) := by + rw [degreeTwoBlock, HahnSeries.support_embDomain, natOnes_support, + Set.image_univ] + +private theorem degreeTwoCutoff_strictMono : StrictMono degreeTwoCutoff := by + apply strictMono_nat_of_lt_succ + intro m + rw [degreeTwoCutoff_apply, degreeTwoCutoff_apply] + apply neg_lt_neg + apply one_div_lt_one_div_of_lt + · positivity + · norm_num + +private theorem degreeTwoExponentPair_eq_cutoff_add_block (m n : ℕ) : + degreeTwoExponentPair (m, n) = + degreeTwoCutoff m + degreeTwoBlockExponent m n := by + rw [degreeTwoCutoff_apply, degreeTwoBlockExponent_apply] + rfl + +private theorem degreeTwoCutoff_lt_exponentPair_of_lt + {m m' n' : ℕ} (hmm' : m < m') : + degreeTwoCutoff m < degreeTwoExponentPair (m', n') := by + calc + degreeTwoCutoff m < degreeTwoExponentPair (m + 1, 0) := + degreeTwoCutoff_lt_next_exponent_zero m + _ ≤ degreeTwoExponentPair (m', n') := by + by_cases hsucc : m + 1 = m' + · subst m' + exact (degreeTwoExponentPair_strictMono_second (m + 1)).monotone + (Nat.zero_le n') + · have hfirst : m + 1 < m' := lt_of_le_of_ne (Nat.succ_le_iff.mpr hmm') hsucc + exact (degreeTwoExponentPair_lt_of_first_lt hfirst).le + +private def degreeTwoGermLowerBound : ℕ → ℝ + | 0 => -2 + | m + 1 => degreeTwoCutoff m - degreeTwoCutoff (m + 1) + +private theorem degreeTwoGermLowerBound_neg (m : ℕ) : + degreeTwoGermLowerBound m < 0 := by + cases m with + | zero => norm_num [degreeTwoGermLowerBound] + | succ m => + rw [degreeTwoGermLowerBound] + exact sub_neg.mpr (degreeTwoCutoff_strictMono (Nat.lt_succ_self m)) + +private theorem first_eq_of_exponent_eq_cutoff_add_of_lowerBound_lt + {m m' n' : ℕ} {delta : ℝ} + (hdelta : degreeTwoGermLowerBound m < delta) (hdelta0 : delta ≤ 0) + (hexponent : degreeTwoExponentPair (m', n') = degreeTwoCutoff m + delta) : + m' = m := by + rcases lt_trichotomy m' m with hlt | heq | hgt + · cases m with + | zero => omega + | succ m => + have hm'le : m' ≤ m := Nat.lt_succ_iff.mp hlt + have hcutoff : degreeTwoCutoff m' ≤ degreeTwoCutoff m := + degreeTwoCutoff_strictMono.monotone hm'le + have hexpLt : degreeTwoExponentPair (m', n') < degreeTwoCutoff m := + (degreeTwoExponentPair_lt_cutoff m' n').trans_le hcutoff + rw [hexponent] at hexpLt + rw [degreeTwoGermLowerBound] at hdelta + linarith + · exact heq + · have hbad := degreeTwoCutoff_lt_exponentPair_of_lt (n' := n') hgt + rw [hexponent] at hbad + linarith + +private theorem degreeTwo_germ_coeff_eq_block (m : ℕ) {delta : ℝ} + (hlower : degreeTwoGermLowerBound m < delta) (hdelta0 : delta ≤ 0) : + ((Berarducci.translatedTruncation (degreeTwoSeries (K := K) : K⟦ℝ⟧) + (degreeTwoCutoff m) : Berarducci.Series K) : K⟦ℝ⟧).coeff delta = + ((degreeTwoBlock (K := K) m : Berarducci.Series K) : K⟦ℝ⟧).coeff delta := by + rw [Berarducci.coeff_translatedTruncation, if_pos hdelta0] + by_cases hblock : delta ∈ Set.range (degreeTwoBlockEmbedding m) + · obtain ⟨n, rfl⟩ := hblock + rw [degreeTwoBlock_coeff_embedding (K := K)] + have harg : degreeTwoCutoff m + degreeTwoBlockEmbedding m n = + degreeTwoExponentEmbedding (toLex (m, n)) := by + rw [degreeTwoBlockEmbedding_apply, degreeTwoExponentEmbedding_apply, + degreeTwoExponentPair_eq_cutoff_add_block] + rw [harg, degreeTwoSeries_coeff_embedding (K := K)] + · have hblockCoeff : + ((degreeTwoBlock (K := K) m : Berarducci.Series K) : K⟦ℝ⟧).coeff delta = 0 := by + apply not_ne_iff.mp + intro hne + apply hblock + rw [← degreeTwoBlock_support (K := K)] + exact (HahnSeries.mem_support _ _).mpr hne + rw [hblockCoeff] + apply not_ne_iff.mp + rw [← HahnSeries.mem_support, degreeTwoSeries_support (K := K)] + rintro ⟨p, hp⟩ + rcases p with ⟨m', n'⟩ + change degreeTwoExponentPair (m', n') = degreeTwoCutoff m + delta at hp + have hm' : m' = m := first_eq_of_exponent_eq_cutoff_add_of_lowerBound_lt + hlower hdelta0 hp + subst m' + apply hblock + refine ⟨n', ?_⟩ + rw [degreeTwoBlockEmbedding_apply] + rw [degreeTwoExponentPair_eq_cutoff_add_block] at hp + linarith + +/-- At cutoff `m`, the translated germ of the degree-two series is the germ of block `m`. -/ +theorem degreeTwo_translatedTruncationClass_eq_block (m : ℕ) : + PommersheimShahriari.translatedTruncationClass (degreeTwoSeries (K := K)) + (degreeTwoCutoff m) = + PommersheimShahriari.toSeriesQuotientByJAddConstants (degreeTwoBlock (K := K) m) := by + rw [PommersheimShahriari.translatedTruncationClass_apply, + PommersheimShahriari.toSeriesQuotientByJAddConstants_eq_iff] + apply Berarducci.negativeMonomialIdeal_le_nearConstantSubgroup + change Berarducci.translatedTruncation (degreeTwoSeries (K := K)) (degreeTwoCutoff m) - + degreeTwoBlock (K := K) m ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K + rw [← Berarducci.toGerm_eq_toGerm_iff] + apply Berarducci.toGerm_eq_toGerm_iff_exists_coeff_eq.mpr + exact ⟨degreeTwoGermLowerBound m, degreeTwoGermLowerBound_neg m, + fun _ hlower hdelta0 ↦ degreeTwo_germ_coeff_eq_block (K := K) m hlower hdelta0⟩ + +private theorem degreeTwoBlock_zero_threeMul_not_mem_one (N : ℕ) : + degreeTwoBlockEmbedding 0 (3 * N) ∉ + Set.range (degreeTwoBlockEmbedding 1) := by + rintro ⟨k, hk⟩ + rw [degreeTwoBlockEmbedding_apply, degreeTwoBlockExponent_apply, + degreeTwoBlockEmbedding_apply, degreeTwoBlockExponent_apply] at hk + field_simp at hk + norm_num [Nat.cast_add, Nat.cast_mul] at hk + ring_nf at hk + have hkNat : 2 + N * 6 = 6 + k * 6 := by exact_mod_cast hk + omega + +private theorem degreeTwoBlock_zero_threeMul_not_mem_two (N : ℕ) : + degreeTwoBlockEmbedding 0 (3 * N) ∉ + Set.range (degreeTwoBlockEmbedding 2) := by + rintro ⟨k, hk⟩ + rw [degreeTwoBlockEmbedding_apply, degreeTwoBlockExponent_apply, + degreeTwoBlockEmbedding_apply, degreeTwoBlockExponent_apply] at hk + field_simp at hk + norm_num [Nat.cast_add, Nat.cast_mul] at hk + ring_nf at hk + have hkNat : 2 + N * 6 = 12 + k * 12 := by exact_mod_cast hk + omega + +private theorem degreeTwoBlock_one_twoMul_not_mem_two (N : ℕ) : + degreeTwoBlockEmbedding 1 (2 * N) ∉ + Set.range (degreeTwoBlockEmbedding 2) := by + rintro ⟨k, hk⟩ + rw [degreeTwoBlockEmbedding_apply, degreeTwoBlockExponent_apply, + degreeTwoBlockEmbedding_apply, degreeTwoBlockExponent_apply] at hk + field_simp at hk + norm_num [Nat.cast_add, Nat.cast_mul] at hk + ring_nf at hk + have hkNat : 6 + N * 12 = 12 + k * 12 := by exact_mod_cast hk + omega + +private theorem exists_degreeTwoBlockEmbedding_gt + (m scale : ℕ) (hscale : 0 < scale) {eta : ℝ} (heta : eta < 0) : + ∃ N, eta < degreeTwoBlockEmbedding m (scale * N) := by + obtain ⟨N, hN⟩ := exists_nat_one_div_lt (neg_pos.mpr heta) + refine ⟨N, ?_⟩ + rw [degreeTwoBlockEmbedding_apply, degreeTwoBlockExponent_apply] + have hdenNat : N + 1 ≤ (m + 1) * (m + 2) * (scale * N + 1) := by + calc + N + 1 ≤ scale * N + 1 := by + apply Nat.add_le_add_right + simpa using Nat.mul_le_mul_right N (Nat.succ_le_iff.mpr hscale) + _ ≤ (m + 1) * (m + 2) * (scale * N + 1) := + Nat.le_mul_of_pos_left _ (by positivity) + have hden : (N + 1 : ℝ) ≤ + (m + 1 : ℝ) * (m + 2 : ℝ) * (scale * N + 1 : ℝ) := by + exact_mod_cast hdenNat + have hrecip := one_div_le_one_div_of_le (by positivity : (0 : ℝ) < N + 1) hden + norm_num [Nat.cast_mul] at hN hrecip ⊢ + linarith + +private theorem degreeTwoBlock_coeff_eq_zero_of_not_mem_range + (m : ℕ) {delta : ℝ} + (hdelta : delta ∉ Set.range (degreeTwoBlockEmbedding m)) : + ((degreeTwoBlock (K := K) m : Berarducci.Series K) : K⟦ℝ⟧).coeff delta = 0 := by + apply not_ne_iff.mp + intro hne + apply hdelta + rw [← degreeTwoBlock_support (K := K)] + exact (HahnSeries.mem_support _ _).mpr hne + +private theorem degreeTwoBlock_coeff_smul (r : K) (m : ℕ) (delta : ℝ) : + ((r • degreeTwoBlock (K := K) m : Berarducci.Series K) : K⟦ℝ⟧).coeff delta = + r * ((degreeTwoBlock (K := K) m : Berarducci.Series K) : K⟦ℝ⟧).coeff delta := by + rw [HahnSeries.Nonpositive.coe_smul, HahnSeries.coeff_smul, smul_eq_mul] + +/-- The three translated row germs used to certify dimension greater than two. -/ +def degreeTwoTranslatedTruncationClass (i : Fin 3) : + PommersheimShahriari.SeriesQuotientByJAddConstants K := + PommersheimShahriari.toSeriesQuotientByJAddConstants (degreeTwoBlock (K := K) i) + +theorem degreeTwoTranslatedTruncationClass_linearIndependent : + LinearIndependent K (degreeTwoTranslatedTruncationClass (K := K)) := by + rw [Fintype.linearIndependent_iff] + intro g hsum i + have hsum' : + g 0 • degreeTwoTranslatedTruncationClass (K := K) 0 + + g 1 • degreeTwoTranslatedTruncationClass (K := K) 1 + + g 2 • degreeTwoTranslatedTruncationClass (K := K) 2 = 0 := by + simpa [Fin.sum_univ_three] using hsum + let b : Berarducci.Series K := + g 0 • degreeTwoBlock (K := K) 0 + g 1 • degreeTwoBlock (K := K) 1 + + g 2 • degreeTwoBlock (K := K) 2 + have hzero : PommersheimShahriari.toSeriesQuotientByJAddConstants b = 0 := by + simpa [b, degreeTwoTranslatedTruncationClass, map_add, map_smul] using hsum' + have hnear : b ∈ Berarducci.nearConstantSubgroup K := + PommersheimShahriari.toSeriesQuotientByJAddConstants_eq_zero_iff.mp hzero + obtain ⟨eta, heta, hcoeff⟩ := + Berarducci.exists_coeff_eq_of_sub_mem_nearConstantSubgroup + (b := b) (c := 0) (by simpa using hnear) + obtain ⟨N0, hN0⟩ := + exists_degreeTwoBlockEmbedding_gt 0 3 (by norm_num) heta + have hdelta0 : degreeTwoBlockEmbedding 0 (3 * N0) < 0 := by + rw [degreeTwoBlockEmbedding_apply, degreeTwoBlockExponent_apply] + exact neg_neg_of_pos (by positivity) + have heq0 := hcoeff (degreeTwoBlockEmbedding 0 (3 * N0)) hN0 hdelta0 + have h01 := degreeTwoBlock_coeff_eq_zero_of_not_mem_range (K := K) 1 + (degreeTwoBlock_zero_threeMul_not_mem_one N0) + have h02 := degreeTwoBlock_coeff_eq_zero_of_not_mem_range (K := K) 2 + (degreeTwoBlock_zero_threeMul_not_mem_two N0) + have hg0 : g 0 = 0 := by + simp only [b, Subring.coe_add, HahnSeries.coeff_add, + degreeTwoBlock_coeff_smul (K := K)] at heq0 + rw [degreeTwoBlock_coeff_embedding (K := K), h01, h02] at heq0 + simpa using heq0 + obtain ⟨N1, hN1⟩ := + exists_degreeTwoBlockEmbedding_gt 1 2 (by norm_num) heta + have hdelta1 : degreeTwoBlockEmbedding 1 (2 * N1) < 0 := by + rw [degreeTwoBlockEmbedding_apply, degreeTwoBlockExponent_apply] + exact neg_neg_of_pos (by positivity) + have heq1 := hcoeff (degreeTwoBlockEmbedding 1 (2 * N1)) hN1 hdelta1 + have h12 := degreeTwoBlock_coeff_eq_zero_of_not_mem_range (K := K) 2 + (degreeTwoBlock_one_twoMul_not_mem_two N1) + have hg1 : g 1 = 0 := by + simp only [b, Subring.coe_add, HahnSeries.coeff_add, + degreeTwoBlock_coeff_smul (K := K)] at heq1 + rw [hg0, degreeTwoBlock_coeff_embedding (K := K), h12] at heq1 + simpa using heq1 + obtain ⟨N2, hN2⟩ := + exists_degreeTwoBlockEmbedding_gt 2 1 (by norm_num) heta + have hdelta2 : degreeTwoBlockEmbedding 2 (1 * N2) < 0 := by + rw [degreeTwoBlockEmbedding_apply, degreeTwoBlockExponent_apply] + exact neg_neg_of_pos (by positivity) + have heq2 := hcoeff (degreeTwoBlockEmbedding 2 (1 * N2)) hN2 hdelta2 + have hg2 : g 2 = 0 := by + simp only [b, Subring.coe_add, HahnSeries.coeff_add, + degreeTwoBlock_coeff_smul (K := K)] at heq2 + rw [hg0, hg1, degreeTwoBlock_coeff_embedding (K := K)] at heq2 + simpa using heq2 + fin_cases i <;> assumption + +private theorem degreeTwoCutoff_neg (m : ℕ) : degreeTwoCutoff m < 0 := by + rw [degreeTwoCutoff_apply] + exact neg_neg_of_pos (by positivity) + +theorem degreeTwoTranslatedTruncationClass_mem_translatedTruncationSpan (i : Fin 3) : + degreeTwoTranslatedTruncationClass (K := K) i ∈ + PommersheimShahriari.translatedTruncationSpan (degreeTwoNonpositive (K := K)) := by + have h := PommersheimShahriari.translatedTruncationClass_mem_translatedTruncationSpan + (degreeTwoNonpositive (K := K)) (degreeTwoCutoff_neg i) + change PommersheimShahriari.translatedTruncationClass (degreeTwoSeries (K := K)) + (degreeTwoCutoff i) ∈ + PommersheimShahriari.translatedTruncationSpan (degreeTwoNonpositive (K := K)) at h + rw [degreeTwo_translatedTruncationClass_eq_block (K := K)] at h + exact h + +/-- The three row classes, regarded as elements of the witness's translated-truncation span. -/ +def degreeTwoTranslatedTruncationSpanVector (i : Fin 3) : + PommersheimShahriari.translatedTruncationSpan (degreeTwoNonpositive (K := K)) := + ⟨degreeTwoTranslatedTruncationClass (K := K) i, + degreeTwoTranslatedTruncationClass_mem_translatedTruncationSpan (K := K) i⟩ + +theorem degreeTwoTranslatedTruncationSpanVector_linearIndependent : + LinearIndependent K (degreeTwoTranslatedTruncationSpanVector (K := K)) := by + apply LinearIndependent.of_comp + (PommersheimShahriari.translatedTruncationSpan (degreeTwoNonpositive (K := K))).subtype + simpa [Function.comp_def, degreeTwoTranslatedTruncationSpanVector] using + (degreeTwoTranslatedTruncationClass_linearIndependent (K := K)) + +theorem two_lt_rank_degreeTwo_translatedTruncationSpan : + (2 : Cardinal) < Module.rank K + (PommersheimShahriari.translatedTruncationSpan (degreeTwoNonpositive (K := K))) := by + have h := + (degreeTwoTranslatedTruncationSpanVector_linearIndependent (K := K)).cardinal_lift_le_rank + simp only [Cardinal.mk_fintype, Fintype.card_fin, Cardinal.lift_natCast, + Cardinal.lift_id'] at h + exact (by norm_num : (2 : Cardinal) < 3).trans_le h + +private theorem exists_degreeTwoCutoff_gt {eta : ℝ} (heta : eta < 0) : + ∃ m, eta < degreeTwoCutoff m := by + obtain ⟨m, hm⟩ := exists_nat_one_div_lt (neg_pos.mpr heta) + refine ⟨m, ?_⟩ + rw [degreeTwoCutoff_apply] + linarith + +theorem degreeTwoNonpositive_not_mem_nearConstantSubgroup : + degreeTwoNonpositive (K := K) ∉ Berarducci.nearConstantSubgroup K := by + intro hnear + obtain ⟨eta, heta, hcoeff⟩ := + Berarducci.exists_coeff_eq_of_sub_mem_nearConstantSubgroup + (b := degreeTwoNonpositive (K := K)) (c := 0) (by simpa using hnear) + obtain ⟨m, hm⟩ := exists_degreeTwoCutoff_gt heta + obtain ⟨n, hn⟩ := exists_degreeTwoBlockEmbedding_gt m 1 (by norm_num) + (sub_neg.mpr hm) + have hdeltaEta : + eta < degreeTwoExponentEmbedding (toLex (m, 1 * n)) := by + rw [degreeTwoExponentEmbedding_apply, + degreeTwoExponentPair_eq_cutoff_add_block, + ← degreeTwoBlockEmbedding_apply] + linarith + have hdelta0 : + degreeTwoExponentEmbedding (toLex (m, 1 * n)) < 0 := by + rw [degreeTwoExponentEmbedding_apply] + exact (degreeTwoExponentPair_lt_cutoff m (1 * n)).trans + (degreeTwoCutoff_neg m) + have heq := hcoeff (degreeTwoExponentEmbedding (toLex (m, 1 * n))) + hdeltaEta hdelta0 + change (degreeTwoSeries (K := K)).coeff + (degreeTwoExponentEmbedding (toLex (m, 1 * n))) = 0 at heq + rw [degreeTwoSeries_coeff_embedding (K := K)] at heq + exact one_ne_zero heq + +theorem degreeTwoNonpositive_irreducible [CharZero K] : + Irreducible (degreeTwoNonpositive (K := K)) := by + apply PommersheimShahriari.irreducible_of_two_lt_rank_translatedTruncationSpan + (degreeTwoNonpositive_not_mem_nearConstantSubgroup (K := K)) + · left + change (degreeTwoSeries (K := K)).supportOrderType = _ + exact degreeTwoSeries_supportOrderType (K := K) + · exact two_lt_rank_degreeTwo_translatedTruncationSpan (K := K) + +/-- The degree-two witness with constant coefficient one. -/ +def degreeTwoWithConstant : Berarducci.Series K := + degreeTwoNonpositive (K := K) + HahnSeries.Nonpositive.C 1 + +theorem degreeTwoWithConstant_coe : + ((degreeTwoWithConstant (K := K) : Berarducci.Series K) : K⟦ℝ⟧) = + degreeTwoSeries (K := K) + HahnSeries.C 1 := by + rw [degreeTwoWithConstant, Subring.coe_add, HahnSeries.Nonpositive.coe_C] + rfl + +theorem degreeTwoWithConstant_coeff_embedding (m n : ℕ) : + ((degreeTwoWithConstant (K := K) : Berarducci.Series K) : K⟦ℝ⟧).coeff + (degreeTwoExponentEmbedding (toLex (m, n))) = 1 := by + rw [degreeTwoWithConstant_coe (K := K), HahnSeries.coeff_add, + degreeTwoSeries_coeff_embedding (K := K), HahnSeries.C_apply] + have hpair : degreeTwoExponentPair (m, n) ≠ 0 := + ((degreeTwoExponentPair_lt_cutoff m n).trans (by + rw [degreeTwoCutoff_apply] + exact neg_neg_of_pos (by positivity))).ne + simp [hpair] + +@[simp] +theorem degreeTwoWithConstant_coeff_zero : + ((degreeTwoWithConstant (K := K) : Berarducci.Series K) : K⟦ℝ⟧).coeff 0 = 1 := by + rw [degreeTwoWithConstant_coe (K := K), HahnSeries.coeff_add, + degreeTwoSeries_coeff_zero, HahnSeries.C_apply] + simp + +theorem degreeTwoWithConstant_coeff_eq_zero {x : ℝ} + (hrange : x ∉ Set.range degreeTwoExponentEmbedding) (hx0 : x ≠ 0) : + ((degreeTwoWithConstant (K := K) : Berarducci.Series K) : K⟦ℝ⟧).coeff x = 0 := by + rw [degreeTwoWithConstant_coe (K := K), HahnSeries.coeff_add] + simp only [HahnSeries.C_apply, HahnSeries.coeff_single, if_neg hx0, add_zero] + rw [← not_ne_iff, ← HahnSeries.mem_support, degreeTwoSeries_support (K := K)] + exact hrange + +/-- The constant term together with the explicit two-dimensional exponent range is the whole +support of the degree-two witness. -/ +theorem degreeTwoWithConstant_support : + ((degreeTwoWithConstant (K := K) : Berarducci.Series K) : K⟦ℝ⟧).support = + Set.range degreeTwoExponentEmbedding ∪ {0} := by + ext x + constructor + · intro hx + by_cases hrange : x ∈ Set.range degreeTwoExponentEmbedding + · exact Set.mem_union_left _ hrange + · by_cases hx0 : x = 0 + · exact Set.mem_union_right _ (Set.mem_singleton_iff.mpr hx0) + · have hzero := degreeTwoWithConstant_coeff_eq_zero (K := K) hrange hx0 + rw [HahnSeries.mem_support] at hx + exact (hx hzero).elim + · intro hx + rcases hx with hrange | hx0 + · obtain ⟨p, rfl⟩ := hrange + rcases p with ⟨m, n⟩ + change ((degreeTwoWithConstant (K := K) : Berarducci.Series K) : K⟦ℝ⟧).coeff + (degreeTwoExponentEmbedding (toLex (m, n))) ≠ 0 + rw [degreeTwoWithConstant_coeff_embedding] + exact one_ne_zero + · have hx : x = 0 := by simpa using hx0 + subst x + rw [HahnSeries.mem_support, degreeTwoWithConstant_coeff_zero] + exact one_ne_zero + +theorem degreeTwoWithConstant_constantCoeff : + HahnSeries.Nonpositive.constantCoeff (degreeTwoWithConstant (K := K)) = 1 := by + rw [HahnSeries.Nonpositive.constantCoeff_apply, degreeTwoWithConstant_coe (K := K), + HahnSeries.coeff_add, degreeTwoSeries_coeff_zero, HahnSeries.C_apply] + simp + +private theorem degreeTwoSeries_supportBelow_C_one : + HahnSeries.SupportBelow (degreeTwoSeries (K := K)) (HahnSeries.C 1) := by + rw [HahnSeries.supportBelow_iff] + intro i hi j hj + rw [degreeTwoSeries_support (K := K)] at hi + obtain ⟨p, rfl⟩ := hi + rw [HahnSeries.C_apply] at hj + have hj0 : j = 0 := HahnSeries.eq_of_mem_support_single hj + subst j + rcases p with ⟨m, n⟩ + exact (degreeTwoExponentPair_lt_cutoff m n).trans (degreeTwoCutoff_neg m) +theorem degreeTwoWithConstant_supportOrderType : + ((degreeTwoWithConstant (K := K) : Berarducci.Series K) : K⟦ℝ⟧).supportOrderType = + Ordinal.omega0 ^ (2 : Ordinal) + 1 := by + apply (HahnSeries.supportOrderType_eq_add_iff _ _ _).mpr + refine ⟨degreeTwoSeries (K := K), HahnSeries.C 1, + degreeTwoSeries_supportBelow_C_one (K := K), degreeTwoSeries_supportOrderType (K := K), + ?_, ?_⟩ + · rw [HahnSeries.C_apply, HahnSeries.supportOrderType_single one_ne_zero] + · exact degreeTwoWithConstant_coe (K := K) + +theorem degreeTwoWithConstant_not_mem_nearConstantSubgroup : + degreeTwoWithConstant (K := K) ∉ Berarducci.nearConstantSubgroup K := by + intro hnear + have hconstant : HahnSeries.Nonpositive.C (1 : K) ∈ + Berarducci.nearConstantSubgroup K := by + rw [Berarducci.mem_nearConstantSubgroup_iff] + exact ⟨0, (HahnSeries.Nonpositive.negativeMonomialIdeal K).zero_mem, + 1, zero_add _⟩ + apply degreeTwoNonpositive_not_mem_nearConstantSubgroup (K := K) + have hsub := (Berarducci.nearConstantSubgroup K).sub_mem hnear hconstant + simpa [degreeTwoWithConstant] using hsub + +private theorem translatedTruncation_C_one_eq_zero {x : ℝ} (hx : x < 0) : + Berarducci.translatedTruncation (HahnSeries.C (1 : K)) x = 0 := by + apply Subtype.ext + apply HahnSeries.coeff_injective + funext delta + rw [Berarducci.coeff_translatedTruncation] + by_cases hdelta : delta ≤ 0 + · rw [if_pos hdelta, HahnSeries.C_apply] + have hsum : x + delta ≠ 0 := ne_of_lt (add_neg_of_neg_of_nonpos hx hdelta) + simp [hsum] + · rw [if_neg hdelta] + rfl + +theorem degreeTwoWithConstant_translatedTruncationClass_eq_block (m : ℕ) : + PommersheimShahriari.translatedTruncationClass + (degreeTwoWithConstant (K := K) : K⟦ℝ⟧) (degreeTwoCutoff m) = + PommersheimShahriari.toSeriesQuotientByJAddConstants (degreeTwoBlock (K := K) m) := by + rw [PommersheimShahriari.translatedTruncationClass_apply] + rw [degreeTwoWithConstant_coe (K := K)] + rw [Berarducci.translatedTruncation_add, + translatedTruncation_C_one_eq_zero (degreeTwoCutoff_neg m), add_zero] + simpa only [PommersheimShahriari.translatedTruncationClass_apply] using + degreeTwo_translatedTruncationClass_eq_block (K := K) m + +theorem degreeTwoWithConstant_translatedTruncationClass_mem_translatedTruncationSpan (i : Fin 3) : + degreeTwoTranslatedTruncationClass (K := K) i ∈ + PommersheimShahriari.translatedTruncationSpan (degreeTwoWithConstant (K := K)) := by + have h := PommersheimShahriari.translatedTruncationClass_mem_translatedTruncationSpan + (degreeTwoWithConstant (K := K)) (degreeTwoCutoff_neg i) + rw [degreeTwoWithConstant_translatedTruncationClass_eq_block (K := K)] at h + exact h + +/-- The three row classes in the constant-one witness's translated-truncation span. -/ +def degreeTwoWithConstantTranslatedTruncationSpanVector (i : Fin 3) : + PommersheimShahriari.translatedTruncationSpan (degreeTwoWithConstant (K := K)) := + ⟨degreeTwoTranslatedTruncationClass (K := K) i, + degreeTwoWithConstant_translatedTruncationClass_mem_translatedTruncationSpan (K := K) i⟩ + +theorem degreeTwoWithConstant_two_lt_rank_translatedTruncationSpan : + (2 : Cardinal) < Module.rank K + (PommersheimShahriari.translatedTruncationSpan (degreeTwoWithConstant (K := K))) := by + have hli : LinearIndependent K + (degreeTwoWithConstantTranslatedTruncationSpanVector (K := K)) := by + apply LinearIndependent.of_comp + (PommersheimShahriari.translatedTruncationSpan (degreeTwoWithConstant (K := K))).subtype + simpa [Function.comp_def, degreeTwoWithConstantTranslatedTruncationSpanVector] using + (degreeTwoTranslatedTruncationClass_linearIndependent (K := K)) + have h := hli.cardinal_lift_le_rank + simp only [Cardinal.mk_fintype, Fintype.card_fin, Cardinal.lift_natCast, + Cardinal.lift_id'] at h + exact (by norm_num : (2 : Cardinal) < 3).trans_le h +theorem degreeTwoWithConstant_irreducible [CharZero K] : + Irreducible (degreeTwoWithConstant (K := K)) := by + apply PommersheimShahriari.irreducible_of_two_lt_rank_translatedTruncationSpan + (degreeTwoWithConstant_not_mem_nearConstantSubgroup (K := K)) + · exact Or.inr (degreeTwoWithConstant_supportOrderType (K := K)) + · exact degreeTwoWithConstant_two_lt_rank_translatedTruncationSpan (K := K) + + +/-- Coefficient maps along a field homomorphism out of `ℝ` carry the degree-two series with +constant term over `ℝ` to the same series over the target field: all its coefficients are `0` or +`1`. -/ +theorem nonpositiveCoefficientMap_degreeTwoWithConstant {E : Type*} [Field E] (f : ℝ →+* E) : + HahnSeries.Nonpositive.nonpositiveCoefficientMap f (degreeTwoWithConstant (K := ℝ)) = + degreeTwoWithConstant (K := E) := by + apply Subtype.ext + apply HahnSeries.coeff_injective + funext x + rw [HahnSeries.Nonpositive.coe_nonpositiveCoefficientMap] + by_cases hx : x ∈ Set.range degreeTwoExponentEmbedding + · obtain ⟨p, rfl⟩ := hx + rcases p with ⟨m, n⟩ + have hR := degreeTwoWithConstant_coeff_embedding (K := ℝ) m n + have hE := degreeTwoWithConstant_coeff_embedding (K := E) m n + rw [degreeTwoExponentEmbedding_apply] at hR hE + change f (((degreeTwoWithConstant (K := ℝ) : Berarducci.Series ℝ) : ℝ⟦ℝ⟧).coeff + (degreeTwoExponentPair (m, n))) = + ((degreeTwoWithConstant (K := E) : Berarducci.Series E) : E⟦ℝ⟧).coeff + (degreeTwoExponentPair (m, n)) + rw [hR, hE, map_one] + · by_cases hx0 : x = 0 + · subst hx0 + rw [degreeTwoWithConstant_coeff_zero, degreeTwoWithConstant_coeff_zero, map_one] + · rw [degreeTwoWithConstant_coeff_eq_zero hx hx0, + degreeTwoWithConstant_coeff_eq_zero hx hx0, map_zero] + +end PommersheimShahriari.DegreeTwoExample diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/Factorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/Factorization.lean new file mode 100644 index 0000000000..1f2da741c2 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/Factorization.lean @@ -0,0 +1,143 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPointExistence + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue + +/-! +# Factorisations of series of ordinal value omega squared + +This module begins the proof of Pommersheim--Shahriari, Lemma 3.1. If a product has Berarducci +ordinal value `ω²`, the values of its ordered factors are either `1` and `ω²`, or `ω` and +`ω`. For a degree-two series whose negative translated truncations all have value below `ω²`, +Berarducci's critical-product formula then forces the two critical points to be zero. + +The remaining support-theoretic step—turning critical point zero into the precise factor order +types printed in PS06—is kept separate rather than hidden in the ordinal calculation. + +## References + +* J. Pommersheim, S. Shahriari, *Unique factorization in generalized power series rings*, +Proc. Amer. Math. Soc. 134 (2006), 1277–1287, cited as [PS06]. +-/ + +universe v + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace PommersheimShahriari + +open Berarducci HahnSeries Ordinal + +variable {K : Type v} [Field K] [CharZero K] + +omit [CharZero K] in +private theorem ordinalValue_ne_zero_of_mul_eq_wpow_two_left + {b c : Series K} (h : ordinalValue b * ordinalValue c = ω^ (2 : NatOrdinal)) : + ordinalValue b ≠ 0 := by + intro hb + rw [hb, zero_mul] at h + exact (NatOrdinal.wpow_ne_zero 2) h.symm + +omit [CharZero K] in +/-- PS06, Lemma 3.1, ordinal factorisation step: an ordered factorisation of value `ω²` +has factor values `1` and `ω²`, or two factor values `ω`. -/ +theorem ordinalValue_factors_of_mul_eq_wpow_two + {b c : Series K} + (hmul : ordinalValue b * ordinalValue c = ω^ (2 : NatOrdinal)) + (hle : ordinalValue b ≤ ordinalValue c) : + (ordinalValue b = 1 ∧ ordinalValue c = ω^ (2 : NatOrdinal)) ∨ + (ordinalValue b = ω^ (1 : NatOrdinal) ∧ + ordinalValue c = ω^ (1 : NatOrdinal)) := by + have hbNe := ordinalValue_ne_zero_of_mul_eq_wpow_two_left hmul + have hcNe : ordinalValue c ≠ 0 := by + intro hc + rw [hc, mul_zero] at hmul + exact (NatOrdinal.wpow_ne_zero 2) hmul.symm + have hbDegreeNe : ordinalValueDegree b ≠ ⊥ := fun hbot ↦ + hbNe (ordinalValue_eq_zero_iff.mpr (ordinalValueDegree_eq_bot_iff.mp hbot)) + have hcDegreeNe : ordinalValueDegree c ≠ ⊥ := fun hbot ↦ + hcNe (ordinalValue_eq_zero_iff.mpr (ordinalValueDegree_eq_bot_iff.mp hbot)) + let d := (ordinalValueDegree b).unbot hbDegreeNe + let e := (ordinalValueDegree c).unbot hcDegreeNe + have hdDegree : ordinalValueDegree b = (d : WithBot NatOrdinal) := + (WithBot.coe_unbot _ hbDegreeNe).symm + have heDegree : ordinalValueDegree c = (e : WithBot NatOrdinal) := + (WithBot.coe_unbot _ hcDegreeNe).symm + have hbValue : ordinalValue b = ω^ d := + (ordinalValueDegree_eq_coe_iff b d).mp hdDegree + have hcValue : ordinalValue c = ω^ e := + (ordinalValueDegree_eq_coe_iff c e).mp heDegree + have hde : d + e = 2 := by + rw [hbValue, hcValue, ← NatOrdinal.wpow_add] at hmul + exact NatOrdinal.wpow_inj.mp hmul + have hdele : d ≤ e := by + rw [hbValue, hcValue, NatOrdinal.wpow_le_wpow] at hle + exact hle + rcases eq_or_ne d 0 with hd | hd + · left + have he : e = 2 := by simpa [hd] using hde + rw [hd] at hbValue + rw [he] at hcValue + exact ⟨by simpa only [NatOrdinal.wpow_zero] using hbValue, hcValue⟩ + · right + have hdOne : 1 ≤ d := Order.one_le_iff_pos.mpr (pos_iff_ne_zero.mpr hd) + have heOne : 1 ≤ e := hdOne.trans hdele + have heLe : e ≤ 1 := by + apply (add_le_add_iff_left (a := (1 : NatOrdinal))).mp + calc + 1 + e ≤ d + e := add_le_add hdOne le_rfl + _ = 1 + 1 := hde.trans (one_add_one_eq_two (R := NatOrdinal)).symm + have he : e = 1 := le_antisymm heLe heOne + have hdLe : d ≤ 1 := hdele.trans heLe + have hdEq : d = 1 := le_antisymm hdLe hdOne + rw [hdEq] at hbValue + rw [he] at hcValue + simpa using ⟨hbValue, hcValue⟩ + +/-- In the PS06 degree-two situation, critical points of both factors must be zero once negative +translated truncations of the product all have value below `ω²`. -/ +theorem criticalPoints_eq_zero_of_product_wpow_two + {a b c : Series K} {x y : ℝ} + (habc : a = b * c) + (haValue : ordinalValue a = ω^ (2 : NatOrdinal)) + (haNegative : ∀ u : ℝ, u < 0 → + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) u) < ω^ (2 : NatOrdinal)) + (hx : IsCriticalPoint b x) (hy : IsCriticalPoint c y) : + x = 0 ∧ y = 0 := by + have hbLe : ordinalValue b ≤ + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) := by + simpa using hx.value_le 0 le_rfl + have hcLe : ordinalValue c ≤ + ordinalValue (translatedTruncation (c : K⟦ℝ⟧) y) := by + simpa using hy.value_le 0 le_rfl + have hcriticalLower : ω^ (2 : NatOrdinal) ≤ + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) (x + y)) := by + calc + ω^ (2 : NatOrdinal) = ordinalValue a := haValue.symm + _ = ordinalValue b * ordinalValue c := by rw [habc, ordinalValue_mul] + _ ≤ ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) * + ordinalValue (translatedTruncation (c : K⟦ℝ⟧) y) := + mul_le_mul hbLe hcLe bot_le bot_le + _ = ordinalValue (translatedTruncation (a : K⟦ℝ⟧) (x + y)) := by + rw [habc, criticalPoint_product_value hx hy] + have hsumNonnegative : 0 ≤ x + y := by + apply le_of_not_gt + intro hnegative + exact (not_lt_of_ge hcriticalLower) (by + simpa [habc] using haNegative (x + y) hnegative) + have hsum : x + y = 0 := le_antisymm (add_nonpos hx.nonpositive hy.nonpositive) + hsumNonnegative + have hx0 := hx.nonpositive + have hy0 := hy.nonpositive + constructor <;> linarith + +end PommersheimShahriari diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/FactorizationClassification.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/FactorizationClassification.lean new file mode 100644 index 0000000000..af806c0e62 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/FactorizationClassification.lean @@ -0,0 +1,320 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwo + +import Mathlib.Topology.Compactness.Compact +import Mathlib.Topology.Instances.Real.Lemmas +import Mathlib.Topology.Order.OrderClosed +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueConstantMul +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue + +/-! +# The degree-two factorisation classification + +This module proves Pommersheim--Shahriari, Lemma 3.1. For an ordered factorisation of a series +outside `J + K` whose support has order type `ω²` or `ω² + 1`, either the first factor is a +nonzero constant, or both factors have value `ω` and support order type `ω` or `ω + 1`. + +The final support step is topological. Critical point zero makes every negative translated +truncation of a value-`ω` factor constant modulo `J`. Thus the support is locally finite below +zero; compactness makes each closed negative initial segment finite, forcing order type `ω` with +an optional constant term. + +## References + +* J. Pommersheim, S. Shahriari, *Unique factorization in generalized power series rings*, +Proc. Amer. Math. Soc. 134 (2006), 1277–1287, cited as [PS06]. +-/ + +universe v + +open scoped HahnSeries NatOrdinal Topology + +public noncomputable section + +namespace PommersheimShahriari + +open Berarducci HahnSeries Ordinal + +variable {K : Type v} [Field K] + +private theorem not_accPt_support_of_translatedTruncation_mem_nearConstantSubgroup + {b : Series K} {z : ℝ} + (hzNear : translatedTruncation (b : K⟦ℝ⟧) z ∈ nearConstantSubgroup K) : + ¬ AccPt z (Filter.principal (b : K⟦ℝ⟧).support) := by + have hsub : translatedTruncation (b : K⟦ℝ⟧) z - 0 ∈ nearConstantSubgroup K := by + simpa using hzNear + obtain ⟨η, hη0, hcoeff⟩ := + exists_coeff_eq_of_sub_mem_nearConstantSubgroup hsub + let T : Set ℝ := (b : K⟦ℝ⟧).support ∩ Set.Ioi z + let hT : T.IsWF := (b : K⟦ℝ⟧).isPWO_support.isWF.mono Set.inter_subset_left + have hright : ∃ r : ℝ, z < r ∧ + ∀ w ∈ (b : K⟦ℝ⟧).support, z < w → r ≤ w := by + by_cases hTne : T.Nonempty + · let r := hT.min hTne + have hrT : r ∈ T := hT.min_mem hTne + refine ⟨r, hrT.2, ?_⟩ + intro w hw hzw + exact hT.min_le hTne ⟨hw, hzw⟩ + · refine ⟨z + 1, by linarith, ?_⟩ + intro w hw hzw + exact (hTne ⟨w, hw, hzw⟩).elim + intro hzAcc + rw [accPt_iff_nhds] at hzAcc + obtain ⟨r, hzr, hright⟩ := hright + have hnhds : Set.Ioo (z + η) r ∈ nhds z := Ioo_mem_nhds (by linarith) hzr + obtain ⟨w, ⟨⟨hwLeft, hwRight⟩, hwSupport⟩, hwNe⟩ := hzAcc _ hnhds + rcases lt_or_gt_of_ne hwNe with hwz | hzw + · let δ : ℝ := w - z + have hη0 : η < δ := by dsimp [δ]; linarith + have hδ0 : δ < 0 := by dsimp [δ]; linarith + have hzero := hcoeff δ hη0 hδ0 + rw [coeff_translatedTruncation, if_pos hδ0.le] at hzero + have hcoeffZero : (b : K⟦ℝ⟧).coeff w = 0 := by + simpa [δ] using hzero + exact (HahnSeries.mem_support _ _).mp hwSupport hcoeffZero + · exact (not_lt_of_ge (hright w hwSupport hzw)) hwRight + +/-- A negative translated truncation of a value-`ω` series lies in `J + K` when the series has +critical point zero. -/ +theorem translatedTruncation_mem_nearConstantSubgroup_of_criticalPoint_zero_of_value_omega + {b : Series K} (hbCritical : IsCriticalPoint b 0) + (hbValue : ordinalValue b = ω^ (1 : NatOrdinal)) + {z : ℝ} (hz : z < 0) : + translatedTruncation (b : K⟦ℝ⟧) z ∈ nearConstantSubgroup K := by + have hcriticalValue : + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) 0) = ω^ (1 : NatOrdinal) := by + simpa using hbValue + have hvalueLt : ordinalValue (translatedTruncation (b : K⟦ℝ⟧) z) < + ω^ (1 : NatOrdinal) := by + rw [← hcriticalValue] + apply lt_of_le_of_ne (hbCritical.value_le z hz.le) + intro heq + exact (not_le_of_gt hz) (hbCritical.le_of_value_eq z hz.le heq) + by_contra hnear + have hone : 1 < ordinalValue (translatedTruncation (b : K⟦ℝ⟧) z) := + one_lt_ordinalValue_iff.mpr hnear + have honeVal : (1 : Ordinal) < + (ordinalValue (translatedTruncation (b : K⟦ℝ⟧) z)).val := + NatOrdinal.of_lt_iff.mp hone + have homegaVal : Ordinal.omega0 ≤ + (ordinalValue (translatedTruncation (b : K⟦ℝ⟧) z)).val := + (ordinalValue_isAdditivelyPrincipal_of_one_lt hone).omega0_le_of_one_lt honeVal + have homega : NatOrdinal.of Ordinal.omega0 ≤ + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) z) := + NatOrdinal.of_le_iff.mpr homegaVal + have homega' : ω^ (1 : NatOrdinal) ≤ + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) z) := by + convert homega using 1 + apply NatOrdinal.val.injective + simp only [NatOrdinal.val_wpow, NatOrdinal.val_one, NatOrdinal.val_of, + Ordinal.opow_one] + exact (not_lt_of_ge homega') hvalueLt + +/-- If a factor has value one and critical point zero, it is a constant series. -/ +theorem mem_constantSubgroup_of_ordinalValue_one_of_criticalPoint_zero + {b : Series K} (hbValue : ordinalValue b = 1) + (hbCritical : IsCriticalPoint b 0) : + b ∈ constantSubgroup K := by + have hsupport : (b : K⟦ℝ⟧).support ⊆ {0} := by + intro z hz + have hz0 := HahnSeries.Nonpositive.support_subset b hz + by_cases hzero : z = 0 + · simp [hzero] + · have hzNeg : z < 0 := lt_of_le_of_ne hz0 hzero + have hcriticalValue : + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) 0) = 1 := by + simpa using hbValue + have hvalueLt : ordinalValue (translatedTruncation (b : K⟦ℝ⟧) z) < 1 := by + rw [← hcriticalValue] + apply lt_of_le_of_ne (hbCritical.value_le z hz0) + intro heq + exact (not_le_of_gt hzNeg) (hbCritical.le_of_value_eq z hz0 heq) + have hvalueZero : ordinalValue (translatedTruncation (b : K⟦ℝ⟧) z) = 0 := by + rwa [Order.lt_one_iff] at hvalueLt + exact (ne_of_gt (ordinalValue_translatedTruncation_pos_of_mem_support hz) hvalueZero).elim + apply mem_constantSubgroup_iff.mpr + refine ⟨HahnSeries.Nonpositive.constantCoeff b, ?_⟩ + apply Subtype.ext + ext z + by_cases hz : z = 0 + · subst z + simp [HahnSeries.Nonpositive.constantCoeff_apply] + · have hzSupport : z ∉ (b : K⟦ℝ⟧).support := fun hmem ↦ + hz (Set.mem_singleton_iff.mp (hsupport hmem)) + rw [HahnSeries.mem_support] at hzSupport + rw [not_ne_iff.mp hzSupport] + simp [hz] + +private theorem supportOrderType_eq_omega_or_omega_add_one_of_ordinalValue_omega_criticalPoint_zero + {b : Series K} (hbValue : ordinalValue b = ω^ (1 : NatOrdinal)) + (hbCritical : IsCriticalPoint b 0) : + (b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ∨ + (b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 + 1 := by + let S : Set ℝ := (b : K⟦ℝ⟧).support ∩ Set.Iio 0 + let hS : S.IsPWO := (b : K⟦ℝ⟧).isPWO_support.mono Set.inter_subset_left + have hIicFinite : ∀ x ∈ S, (S ∩ Set.Iic x).Finite := by + intro x hx + let I : Set ℝ := S ∩ Set.Iic x + let hI : I.IsPWO := hS.mono Set.inter_subset_left + by_cases hIne : I.Nonempty + · let m := hI.isWF.min hIne + have hmI : m ∈ I := hI.isWF.min_mem hIne + by_contra hIfinite + have hIsub : I ⊆ Set.Icc m x := by + intro y hy + exact ⟨hI.isWF.min_le hIne hy, hy.2⟩ + obtain ⟨z, hzIcc, hzAcc⟩ := + (show I.Infinite from hIfinite).exists_accPt_of_subset_isCompact + isCompact_Icc hIsub + have hzNeg : z < 0 := hzIcc.2.trans_lt hx.2 + have hzNear := + translatedTruncation_mem_nearConstantSubgroup_of_criticalPoint_zero_of_value_omega + hbCritical hbValue hzNeg + apply not_accPt_support_of_translatedTruncation_mem_nearConstantSubgroup hzNear + exact hzAcc.mono (Filter.principal_mono.mpr fun y hy ↦ hy.1.1) + · change I.Finite + rw [Set.not_nonempty_iff_eq_empty.mp hIne] + exact Set.finite_empty + have hSle : hS.orderType ≤ Ordinal.omega0 := by + apply hS.orderType_le_of_forall_inter_Iic_lt + intro x hx + exact Set.IsPWO.finite_iff_orderType_lt_omega + (hS.mono (s := S ∩ Set.Iic x) Set.inter_subset_left) |>.mp (hIicFinite x hx) + have hSLUB : IsLUB S 0 := by + apply isLUB_negativeSupport_zero_of_one_lt_ordinalValue + rw [hbValue] + apply NatOrdinal.val.lt_iff_lt.mpr + simp only [NatOrdinal.val_one, Ordinal.opow_one] + exact Ordinal.one_lt_omega0 + have hSne : S.Nonempty := by + obtain ⟨x, hx, -, -⟩ := hSLUB.exists_between (show (-1 : ℝ) < 0 by norm_num) + exact ⟨x, hx⟩ + have hSgt : ∀ x ∈ S, ∃ y ∈ S, x < y := by + intro x hx + obtain ⟨y, hy, hxy, -⟩ := hSLUB.exists_between hx.2 + exact ⟨y, hy, hxy⟩ + have hSlimit : Order.IsSuccLimit hS.orderType := + hS.isSuccLimit_orderType_of_forall_exists_gt hSne hSgt + have hSType : hS.orderType = Ordinal.omega0 := + le_antisymm hSle (Ordinal.omega0_le_of_isSuccLimit hSlimit) + have htruncSupport : + (HahnSeries.truncLT 0 (b : K⟦ℝ⟧)).support = S := by + rw [HahnSeries.support_truncLT] + rfl + have htruncType : + (HahnSeries.truncLT 0 (b : K⟦ℝ⟧)).supportOrderType = Ordinal.omega0 := by + rw [HahnSeries.supportOrderType_eq_setOrderType] + exact ((HahnSeries.truncLT 0 (b : K⟦ℝ⟧)).isPWO_support.orderType_congr + hS htruncSupport).trans hSType + have hge : HahnSeries.truncGE 0 (b : K⟦ℝ⟧) = + HahnSeries.single 0 ((b : K⟦ℝ⟧).coeff 0) := by + ext x + rcases lt_trichotomy x 0 with hx | rfl | hx + · simp [HahnSeries.coeff_truncGE, not_le_of_gt hx, hx.ne] + · simp + · have hcoeff : (b : K⟦ℝ⟧).coeff x = 0 := by + apply not_ne_iff.mp + rw [← HahnSeries.mem_support] + exact fun hmem ↦ (not_le_of_gt hx) + (HahnSeries.Nonpositive.support_subset b hmem) + simp [HahnSeries.coeff_truncGE, hx.le, hcoeff, hx.ne'] + have hsplit := HahnSeries.supportOrderType_eq_truncLT_add_truncGE + 0 (b : K⟦ℝ⟧) + by_cases hzero : 0 ∈ (b : K⟦ℝ⟧).support + · right + have hcoeff : (b : K⟦ℝ⟧).coeff 0 ≠ 0 := + (HahnSeries.mem_support _ _).mp hzero + have hgeType : + (HahnSeries.truncGE 0 (b : K⟦ℝ⟧)).supportOrderType = 1 := by + rw [hge] + exact HahnSeries.supportOrderType_single hcoeff + rw [htruncType, hgeType] at hsplit + exact hsplit + · left + have hcoeff : (b : K⟦ℝ⟧).coeff 0 = 0 := by + rw [HahnSeries.mem_support] at hzero + exact not_ne_iff.mp hzero + have hgeType : + (HahnSeries.truncGE 0 (b : K⟦ℝ⟧)).supportOrderType = 0 := by + rw [hge] + simp [hcoeff] + rw [htruncType, hgeType, add_zero] at hsplit + exact hsplit + +/-- PS06, Lemma 3.1: an ordered factorisation of a degree-two series has either a nonzero +constant first factor, or two factors of value `ω` and support order type `ω` or `ω + 1`. -/ +theorem factorization_cases_of_supportOrderType_wpow_two + [CharZero K] {a b c : Series K} + (haNear : a ∉ nearConstantSubgroup K) + (haType : (a : K⟦ℝ⟧).supportOrderType = + (Ordinal.omega0 ^ (2 : Ordinal)) ∨ + (a : K⟦ℝ⟧).supportOrderType = + Ordinal.omega0 ^ (2 : Ordinal) + 1) + (habc : a = b * c) (hle : ordinalValue b ≤ ordinalValue c) : + (∃ k : K, k ≠ 0 ∧ b = HahnSeries.Nonpositive.C k ∧ + c = HahnSeries.Nonpositive.C k⁻¹ * a ∧ + (c : K⟦ℝ⟧).supportOrderType = (a : K⟦ℝ⟧).supportOrderType) ∨ + (((b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ∨ + (b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 + 1) ∧ + ((c : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ∨ + (c : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 + 1) ∧ + ordinalValue b = ω^ (1 : NatOrdinal) ∧ + ordinalValue c = ω^ (1 : NatOrdinal)) := by + have haNe : a ≠ 0 := by + intro ha + apply haNear + rw [ha] + exact (nearConstantSubgroup K).zero_mem + have hbNe : b ≠ 0 := by + intro hb + apply haNe + rw [habc, hb, zero_mul] + have hcNe : c ≠ 0 := by + intro hc + apply haNe + rw [habc, hc, mul_zero] + obtain ⟨x, hx⟩ := exists_isCriticalPoint hbNe + obtain ⟨y, hy⟩ := exists_isCriticalPoint hcNe + have haValue : ordinalValue a = ω^ (2 : NatOrdinal) := + ordinalValue_eq_wpow_two haNear haType + have haNegative : ∀ u : ℝ, u < 0 → + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) u) < ω^ (2 : NatOrdinal) := + fun _ hu ↦ ordinalValue_translatedTruncation_lt_wpow_two haNear haType hu + have hmulValue : ordinalValue b * ordinalValue c = ω^ (2 : NatOrdinal) := by + rw [← ordinalValue_mul, ← habc, haValue] + have hcritical := criticalPoints_eq_zero_of_product_wpow_two + habc haValue haNegative hx hy + obtain ⟨rfl, rfl⟩ := hcritical + rcases ordinalValue_factors_of_mul_eq_wpow_two hmulValue hle with + hconstant | hbalanced + · left + have hbConstant := + mem_constantSubgroup_of_ordinalValue_one_of_criticalPoint_zero hconstant.1 hx + obtain ⟨k, hk⟩ := mem_constantSubgroup_iff.mp hbConstant + have hkNe : k ≠ 0 := by + intro hkZero + apply hbNe + rw [← hk, hkZero] + simp + have hbc : b = HahnSeries.Nonpositive.C k := hk.symm + have hc : c = HahnSeries.Nonpositive.C k⁻¹ * a := by + rw [habc, hbc] + rw [← mul_assoc, ← map_mul, inv_mul_cancel₀ hkNe, map_one, one_mul] + refine ⟨k, hkNe, hbc, hc, ?_⟩ + rw [habc, hbc, supportOrderType_C_mul_of_ne_zero hkNe] + · right + exact ⟨supportOrderType_eq_omega_or_omega_add_one_of_ordinalValue_omega_criticalPoint_zero + hbalanced.1 hx, + supportOrderType_eq_omega_or_omega_add_one_of_ordinalValue_omega_criticalPoint_zero + hbalanced.2 hy, + hbalanced⟩ + +end PommersheimShahriari diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/TranslatedSpanFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/TranslatedSpanFactorization.lean new file mode 100644 index 0000000000..53eb5b27be --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/TranslatedSpanFactorization.lean @@ -0,0 +1,442 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.FactorizationClassification +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedTruncationSpan +public import Mathlib.LinearAlgebra.Dimension.Finrank + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Monomial +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +import Mathlib.LinearAlgebra.Dimension.Constructions +import Mathlib.Topology.Instances.Real.Lemmas +import Mathlib.Topology.Order.OrderClosed + +/-! +# Translated-truncation spans of degree-two factorisations + +This module proves the part of Pommersheim--Shahriari, Proposition 3.2 used by their first +irreducibility criterion. If two nonpositive Hahn series have ordinal value `ω`, with critical +point zero, each negative translated-truncation class of their product is a coefficient-weighted +sum of the two factor classes modulo `J + K`. Consequently `V(bc)` has dimension at most two. + +Combining that bound with PS06, Lemma 3.1 gives Corollary 3.3: a series outside `J + K`, with +support order type `ω²` or `ω² + 1`, is irreducible whenever `dim V(a) > 2`. + +## References + +* J. Pommersheim, S. Shahriari, *Unique factorization in generalized power series rings*, +Proc. Amer. Math. Soc. 134 (2006), 1277–1287, cited as [PS06]. +-/ + +universe v + +open scoped Cardinal HahnSeries NatOrdinal + +public noncomputable section + +namespace PommersheimShahriari + +open Berarducci HahnSeries Ordinal + +variable {K : Type v} [Field K] + +private theorem toSeriesQuotientByJAddConstants_mul_eq_smul_of_sub_C_mem_negativeMonomialIdeal + {p q : Series K} {k : K} + (hp : p - HahnSeries.Nonpositive.C k ∈ + HahnSeries.Nonpositive.negativeMonomialIdeal K) : + toSeriesQuotientByJAddConstants (p * q) = k • toSeriesQuotientByJAddConstants q := by + rw [← map_smul toSeriesQuotientByJAddConstants] + change toSeriesQuotientByJAddConstants (p * q) = + toSeriesQuotientByJAddConstants (HahnSeries.Nonpositive.C k * q) + rw [toSeriesQuotientByJAddConstants_eq_iff] + have hJ : p * q - HahnSeries.Nonpositive.C k * q ∈ + HahnSeries.Nonpositive.negativeMonomialIdeal K := by + rw [← sub_mul] + exact Ideal.mul_mem_right q (HahnSeries.Nonpositive.negativeMonomialIdeal K) hp + exact Berarducci.negativeMonomialIdeal_le_nearConstantSubgroup hJ + +private theorem translatedTruncation_sub_C_coeff_mem_negativeMonomialIdeal + {b : Series K} {x : ℝ} + (hnear : translatedTruncation (b : K⟦ℝ⟧) x ∈ nearConstantSubgroup K) : + translatedTruncation (b : K⟦ℝ⟧) x - + HahnSeries.Nonpositive.C ((b : K⟦ℝ⟧).coeff x) ∈ + HahnSeries.Nonpositive.negativeMonomialIdeal K := by + have hJ := mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem.mp hnear + convert hJ using 1 + congr 2 + rw [HahnSeries.Nonpositive.constantCoeff_apply, coeff_translatedTruncation] + simp + +private theorem toSeriesQuotientByJAddConstants_translatedTruncation_mul_eq_coeff_smul + {b q : Series K} {x : ℝ} + (hnear : translatedTruncation (b : K⟦ℝ⟧) x ∈ nearConstantSubgroup K) : + toSeriesQuotientByJAddConstants (translatedTruncation (b : K⟦ℝ⟧) x * q) = + (b : K⟦ℝ⟧).coeff x • toSeriesQuotientByJAddConstants q := + toSeriesQuotientByJAddConstants_mul_eq_smul_of_sub_C_mem_negativeMonomialIdeal + (translatedTruncation_sub_C_coeff_mem_negativeMonomialIdeal hnear) + +private theorem toSeriesQuotientByJAddConstants_mul_translatedTruncation_eq_coeff_smul + {p b : Series K} {x : ℝ} + (hnear : translatedTruncation (b : K⟦ℝ⟧) x ∈ nearConstantSubgroup K) : + toSeriesQuotientByJAddConstants (p * translatedTruncation (b : K⟦ℝ⟧) x) = + (b : K⟦ℝ⟧).coeff x • toSeriesQuotientByJAddConstants p := by + rw [mul_comm] + exact toSeriesQuotientByJAddConstants_translatedTruncation_mul_eq_coeff_smul hnear + +private theorem translatedTruncationClass_mul_eq_sum (b c : Series K) (x : ℝ) : + translatedTruncationClass (((b * c : Series K) : K⟦ℝ⟧)) x = + ∑ β ∈ convolutionIndex (b : K⟦ℝ⟧) (c : K⟦ℝ⟧) x, + toSeriesQuotientByJAddConstants + (translatedTruncation (b : K⟦ℝ⟧) β * translatedTruncation (c : K⟦ℝ⟧) (x - β)) := by + let s : Series K := ∑ β ∈ convolutionIndex (b : K⟦ℝ⟧) (c : K⟦ℝ⟧) x, + translatedTruncation (b : K⟦ℝ⟧) β * translatedTruncation (c : K⟦ℝ⟧) (x - β) + have hgerm : toGerm (translatedTruncation (((b * c : Series K) : K⟦ℝ⟧)) x) = + toGerm s := by + have hconv := germAt_mul (b : K⟦ℝ⟧) (c : K⟦ℝ⟧) x + simpa only [germAt_apply, s, map_sum, map_mul, Subring.coe_mul] using hconv + have hnear : translatedTruncation (((b * c : Series K) : K⟦ℝ⟧)) x - s ∈ + nearConstantSubgroup K := + negativeMonomialIdeal_le_nearConstantSubgroup (toGerm_eq_toGerm_iff.mp hgerm) + rw [translatedTruncationClass_apply] + calc + toSeriesQuotientByJAddConstants (translatedTruncation (((b * c : Series K) : K⟦ℝ⟧)) x) = + toSeriesQuotientByJAddConstants s := toSeriesQuotientByJAddConstants_eq_iff.mpr hnear + _ = _ := by simp only [s, map_sum] + +/-- PS06, Proposition 3.2(2): at a negative cutoff, the translated-truncation class of a product +of two value-`ω` factors with critical point zero is the coefficient-weighted sum of the two +factor classes modulo `J + K`. -/ +theorem translatedTruncationClass_mul_eq + {b c : Series K} (hbValue : ordinalValue b = ω^ (1 : NatOrdinal)) + (hcValue : ordinalValue c = ω^ (1 : NatOrdinal)) + (hbCritical : IsCriticalPoint b 0) (hcCritical : IsCriticalPoint c 0) + {x : ℝ} (hx : x < 0) : + translatedTruncationClass (((b * c : Series K) : K⟦ℝ⟧)) x = + (c : K⟦ℝ⟧).coeff x • toSeriesQuotientByJAddConstants b + + (b : K⟦ℝ⟧).coeff x • toSeriesQuotientByJAddConstants c := by + classical + rw [translatedTruncationClass_mul_eq_sum] + let T := convolutionIndex (b : K⟦ℝ⟧) (c : K⟦ℝ⟧) x + have hbNear : ∀ {y : ℝ}, y < 0 → + translatedTruncation (b : K⟦ℝ⟧) y ∈ nearConstantSubgroup K := + translatedTruncation_mem_nearConstantSubgroup_of_criticalPoint_zero_of_value_omega + hbCritical hbValue + have hcNear : ∀ {y : ℝ}, y < 0 → + translatedTruncation (c : K⟦ℝ⟧) y ∈ nearConstantSubgroup K := + translatedTruncation_mem_nearConstantSubgroup_of_criticalPoint_zero_of_value_omega + hcCritical hcValue + have hbClosure : closure (b : K⟦ℝ⟧).support ⊆ Set.Iic 0 := + closure_minimal (HahnSeries.Nonpositive.support_subset b) isClosed_Iic + have hcClosure : closure (c : K⟦ℝ⟧).support ⊆ Set.Iic 0 := + closure_minimal (HahnSeries.Nonpositive.support_subset c) isClosed_Iic + have hterm : ∀ β ∈ T, + toSeriesQuotientByJAddConstants + (translatedTruncation (b : K⟦ℝ⟧) β * translatedTruncation (c : K⟦ℝ⟧) (x - β)) = + if β = 0 then + (c : K⟦ℝ⟧).coeff x • toSeriesQuotientByJAddConstants b + else if β = x then + (b : K⟦ℝ⟧).coeff x • toSeriesQuotientByJAddConstants c + else 0 := by + intro β hβ + have hβClosure := mem_convolutionIndex.mp hβ + have hβle : β ≤ 0 := hbClosure hβClosure.1 + have hxβle : x - β ≤ 0 := hcClosure hβClosure.2 + by_cases hβ0 : β = 0 + · subst β + rw [if_pos rfl, _root_.sub_zero, translatedTruncation_zero] + exact toSeriesQuotientByJAddConstants_mul_translatedTruncation_eq_coeff_smul (hcNear hx) + · rw [if_neg hβ0] + by_cases hβx : β = x + · subst β + rw [if_pos rfl, _root_.sub_self, translatedTruncation_zero] + exact toSeriesQuotientByJAddConstants_translatedTruncation_mul_eq_coeff_smul (hbNear hx) + · rw [if_neg hβx] + have hβneg : β < 0 := lt_of_le_of_ne hβle hβ0 + have hxβneg : x - β < 0 := by + apply lt_of_le_of_ne hxβle + intro heq + exact hβx (by linarith) + rw [toSeriesQuotientByJAddConstants_translatedTruncation_mul_eq_coeff_smul (hbNear hβneg)] + rw [toSeriesQuotientByJAddConstants_eq_zero_iff.mpr (hcNear hxβneg), smul_zero] + rw [Finset.sum_congr rfl hterm] + let B := (c : K⟦ℝ⟧).coeff x • toSeriesQuotientByJAddConstants b + let C := (b : K⟦ℝ⟧).coeff x • toSeriesQuotientByJAddConstants c + have hsplit : ∀ β : ℝ, + (if β = 0 then B else if β = x then C else 0) = + (if β = 0 then B else 0) + (if β = x then C else 0) := by + intro β + by_cases hβ0 : β = 0 + · subst β + simp [hx.ne'] + · simp [hβ0] + have hzero : (if 0 ∈ T then B else 0) = B := by + by_cases hxClosure : x ∈ closure (c : K⟦ℝ⟧).support + · rw [if_pos] + exact mem_convolutionIndex.mpr + ⟨hbCritical.mem_closure_support, by simpa using hxClosure⟩ + · have hxSupport : x ∉ (c : K⟦ℝ⟧).support := + fun hmem ↦ hxClosure (subset_closure hmem) + rw [HahnSeries.mem_support, not_ne_iff] at hxSupport + have hnot : 0 ∉ T := by + rw [mem_convolutionIndex] + simp [hxClosure] + simp [hnot, B, hxSupport] + have hxIndex : (if x ∈ T then C else 0) = C := by + by_cases hxClosure : x ∈ closure (b : K⟦ℝ⟧).support + · rw [if_pos] + exact mem_convolutionIndex.mpr + ⟨hxClosure, by simpa using hcCritical.mem_closure_support⟩ + · have hxSupport : x ∉ (b : K⟦ℝ⟧).support := + fun hmem ↦ hxClosure (subset_closure hmem) + rw [HahnSeries.mem_support, not_ne_iff] at hxSupport + have hnot : x ∉ T := by + rw [mem_convolutionIndex] + simp [hxClosure] + simp [hnot, C, hxSupport] + calc + (∑ β ∈ T, if β = 0 then B else if β = x then C else 0) = + (∑ β ∈ T, if β = 0 then B else 0) + + ∑ β ∈ T, if β = x then C else 0 := by + rw [← Finset.sum_add_distrib] + exact Finset.sum_congr rfl fun β _ ↦ hsplit β + _ = (if 0 ∈ T then B else 0) + (if x ∈ T then C else 0) := by simp + _ = B + C := by rw [hzero, hxIndex] + +/-- PS06, Proposition 3.2(5), upper-bound direction: `V(bc)` is contained in the span of the two +factor classes modulo `J + K`. -/ +theorem translatedTruncationSpan_mul_le_span_pair + {b c : Series K} (hbValue : ordinalValue b = ω^ (1 : NatOrdinal)) + (hcValue : ordinalValue c = ω^ (1 : NatOrdinal)) + (hbCritical : IsCriticalPoint b 0) (hcCritical : IsCriticalPoint c 0) : + translatedTruncationSpan (b * c) ≤ + Submodule.span K {toSeriesQuotientByJAddConstants b, toSeriesQuotientByJAddConstants c} := by + rw [translatedTruncationSpan_le_iff] + intro x hx + rw [translatedTruncationClass_mul_eq hbValue hcValue hbCritical hcCritical hx] + apply Submodule.add_mem + · apply Submodule.smul_mem + exact Submodule.subset_span (by simp) + · apply Submodule.smul_mem + exact Submodule.subset_span (by simp) + +/-- PS06, Proposition 3.2(5): a balanced product has translated-truncation-span dimension at most +two. -/ +theorem rank_translatedTruncationSpan_mul_le_two + {b c : Series K} (hbValue : ordinalValue b = ω^ (1 : NatOrdinal)) + (hcValue : ordinalValue c = ω^ (1 : NatOrdinal)) + (hbCritical : IsCriticalPoint b 0) (hcCritical : IsCriticalPoint c 0) : + Module.rank K (translatedTruncationSpan (b * c)) ≤ 2 := by + classical + let s : Set (SeriesQuotientByJAddConstants K) := + {toSeriesQuotientByJAddConstants b, toSeriesQuotientByJAddConstants c} + have hs : s.Finite := (Set.finite_singleton _).insert _ + letI : Fintype s := hs.fintype + have hcard : s.toFinset.card ≤ 2 := by + change ({toSeriesQuotientByJAddConstants b, toSeriesQuotientByJAddConstants c} : + Set (SeriesQuotientByJAddConstants K)).toFinset.card ≤ 2 + rw [Set.toFinset_insert, Set.toFinset_singleton] + exact (Finset.card_insert_le _ _).trans (by simp) + calc + Module.rank K (translatedTruncationSpan (b * c)) ≤ + Module.rank K (Submodule.span K s) := + Submodule.rank_mono + (by simpa [s] using + translatedTruncationSpan_mul_le_span_pair hbValue hcValue hbCritical hcCritical) + _ ≤ #s := rank_span_le s + _ ≤ 2 := by + rw [Cardinal.mk_fintype, ← Set.toFinset_card] + exact_mod_cast hcard + +/-- The finite-rank form of PS06, Proposition 3.2(5). -/ +theorem finrank_translatedTruncationSpan_mul_le_two + {b c : Series K} (hbValue : ordinalValue b = ω^ (1 : NatOrdinal)) + (hcValue : ordinalValue c = ω^ (1 : NatOrdinal)) + (hbCritical : IsCriticalPoint b 0) (hcCritical : IsCriticalPoint c 0) : + Module.finrank K (translatedTruncationSpan (b * c)) ≤ 2 := by + classical + let s : Set (SeriesQuotientByJAddConstants K) := + {toSeriesQuotientByJAddConstants b, toSeriesQuotientByJAddConstants c} + have hs : s.Finite := (Set.finite_singleton _).insert _ + letI : Fintype s := hs.fintype + letI : Module.Finite K + (Submodule.span K s) := Module.Finite.span_of_finite K hs + have hcard : s.toFinset.card ≤ 2 := by + change ({toSeriesQuotientByJAddConstants b, toSeriesQuotientByJAddConstants c} : + Set (SeriesQuotientByJAddConstants K)).toFinset.card ≤ 2 + rw [Set.toFinset_insert, Set.toFinset_singleton] + exact (Finset.card_insert_le _ _).trans (by simp) + calc + Module.finrank K (translatedTruncationSpan (b * c)) ≤ + Module.finrank K (Submodule.span K s) := + Submodule.finrank_mono + (by simpa [s] using + translatedTruncationSpan_mul_le_span_pair hbValue hcValue hbCritical hcCritical) + _ ≤ s.toFinset.card := finrank_span_le_card s + _ ≤ 2 := hcard + +private theorem mem_nearConstantSubgroup_of_isUnit {a : Series K} (ha : IsUnit a) : + a ∈ nearConstantSubgroup K := by + have hsupport := HahnSeries.Nonpositive.support_eq_singleton_zero_of_isUnit ha + have hconstant : HahnSeries.Nonpositive.C + (HahnSeries.Nonpositive.constantCoeff a) = a := by + apply Subtype.ext + apply HahnSeries.coeff_injective + funext x + by_cases hx : x = 0 + · subst x + simp [HahnSeries.Nonpositive.constantCoeff_apply] + · have hxmem : x ∉ (a : K⟦ℝ⟧).support := by + rw [hsupport] + simpa using hx + rw [HahnSeries.mem_support, not_ne_iff] at hxmem + simp [hx, hxmem] + exact Berarducci.mem_nearConstantSubgroup_iff.mpr + ⟨0, (HahnSeries.Nonpositive.negativeMonomialIdeal K).zero_mem, + HahnSeries.Nonpositive.constantCoeff a, by simpa using hconstant⟩ + +/-- PS06, Corollary 3.3: a degree-two series outside `J + K` whose translated-truncation span has +dimension greater than two is irreducible. -/ +@[blueprint "fact:ps06-irreducibility" + (phase := "Primality and factorisation for real exponents") + (title := "Irreducibility from translated truncation dimension") + (statement := /-- + Let $K$ be a field of characteristic $0$ and + $a\in K((\mathbb R^{\le 0}))$. Assume that + \[ + \operatorname{ot}(a)=\omega^2\quad\text{or}\quad + \operatorname{ot}(a)=\omega^2+1, + \] + and that $0$ is an accumulation point of $\operatorname{supp}(a)$, + equivalently $a\notin J+K$. In + $K((\mathbb R^{\le 0}))/(J+K)$, take the $K$-linear span of the classes of + the translated truncations $a^{\vert x}$ for $x<0$. If this span has + dimension greater than $2$, then $a$ is irreducible in + $K((\mathbb R^{\le 0}))$. This is [PS06, Cor. 3.3] (Theorem A). + -/) + (proof := /-- + Suppose that $a=bc$. After exchanging the factors if necessary, the + factorisation classification for these two support order types leaves two + cases: either $b$ is a nonzero constant, or + $v_J(b)=v_J(c)=\omega$. In the second case, multiplicativity of $v_J$ from + \ref{fact:ordinal-value-multiplicativity}, together with the support-tail bound for + negative translated truncations, forces the critical points of $b$ and $c$ to be $0$. + The convolution formula modulo + $J+K$ then writes, for every $x<0$, the class of $a^{\vert x}$ as + \[ + c_x[b]+b_x[c]. + \] + Thus the classes of translated truncations of $a$ lie in the span of $[b]$ and + $[c]$, which has dimension at most $2$, a contradiction. Hence one factor + is a unit, and $a$ is irreducible. + -/)] +theorem irreducible_of_two_lt_rank_translatedTruncationSpan [CharZero K] {a : Series K} + (haNear : a ∉ nearConstantSubgroup K) + (haType : (a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) ∨ + (a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) + 1) + (haDimension : (2 : Cardinal) < Module.rank K (translatedTruncationSpan a)) : + Irreducible a := by + rw [irreducible_iff] + refine ⟨fun haUnit ↦ haNear (mem_nearConstantSubgroup_of_isUnit haUnit), ?_⟩ + intro b c habc + have haNe : a ≠ 0 := by + intro ha + apply haNear + rw [ha] + exact (nearConstantSubgroup K).zero_mem + have hbNe : b ≠ 0 := by + intro hb + apply haNe + rw [habc, hb, zero_mul] + have hcNe : c ≠ 0 := by + intro hc + apply haNe + rw [habc, hc, mul_zero] + have haValue : ordinalValue a = ω^ (2 : NatOrdinal) := + ordinalValue_eq_wpow_two haNear haType + have haNegative : ∀ u : ℝ, u < 0 → + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) u) < ω^ (2 : NatOrdinal) := + fun _ hu ↦ ordinalValue_translatedTruncation_lt_wpow_two haNear haType hu + have balancedContradiction + (hbValue : ordinalValue b = ω^ (1 : NatOrdinal)) + (hcValue : ordinalValue c = ω^ (1 : NatOrdinal)) : False := by + obtain ⟨x, hx⟩ := exists_isCriticalPoint hbNe + obtain ⟨y, hy⟩ := exists_isCriticalPoint hcNe + obtain ⟨rfl, rfl⟩ := criticalPoints_eq_zero_of_product_wpow_two + habc haValue haNegative hx hy + have hdim : Module.rank K (translatedTruncationSpan a) ≤ 2 := by + rw [habc] + exact rank_translatedTruncationSpan_mul_le_two hbValue hcValue hx hy + exact (not_lt_of_ge hdim) haDimension + rcases le_total (ordinalValue b) (ordinalValue c) with hbc | hcb + · rcases factorization_cases_of_supportOrderType_wpow_two + haNear haType habc hbc with hconstant | hbalanced + · obtain ⟨k, hk, rfl, -⟩ := hconstant + exact Or.inl ((isUnit_iff_ne_zero.mpr hk).map HahnSeries.Nonpositive.C) + · exact (balancedContradiction hbalanced.2.2.1 hbalanced.2.2.2).elim + · have hacb : a = c * b := by simpa [mul_comm] using habc + rcases factorization_cases_of_supportOrderType_wpow_two + haNear haType hacb hcb with hconstant | hbalanced + · obtain ⟨k, hk, rfl, -⟩ := hconstant + exact Or.inr ((isUnit_iff_ne_zero.mpr hk).map HahnSeries.Nonpositive.C) + · exact (balancedContradiction hbalanced.2.2.2 hbalanced.2.2.1).elim + +/-- The finite-rank specialization of PS06, Corollary 3.3. -/ +theorem irreducible_of_two_lt_finrank_translatedTruncationSpan [CharZero K] {a : Series K} + (haNear : a ∉ nearConstantSubgroup K) + (haType : (a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) ∨ + (a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) + 1) + (haDimension : 2 < Module.finrank K (translatedTruncationSpan a)) : + Irreducible a := by + rw [irreducible_iff] + refine ⟨fun haUnit ↦ haNear (mem_nearConstantSubgroup_of_isUnit haUnit), ?_⟩ + intro b c habc + have haNe : a ≠ 0 := by + intro ha + apply haNear + rw [ha] + exact (nearConstantSubgroup K).zero_mem + have hbNe : b ≠ 0 := by + intro hb + apply haNe + rw [habc, hb, zero_mul] + have hcNe : c ≠ 0 := by + intro hc + apply haNe + rw [habc, hc, mul_zero] + have haValue : ordinalValue a = ω^ (2 : NatOrdinal) := + ordinalValue_eq_wpow_two haNear haType + have haNegative : ∀ u : ℝ, u < 0 → + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) u) < ω^ (2 : NatOrdinal) := + fun _ hu ↦ ordinalValue_translatedTruncation_lt_wpow_two haNear haType hu + have balancedContradiction + (hbValue : ordinalValue b = ω^ (1 : NatOrdinal)) + (hcValue : ordinalValue c = ω^ (1 : NatOrdinal)) : False := by + obtain ⟨x, hx⟩ := exists_isCriticalPoint hbNe + obtain ⟨y, hy⟩ := exists_isCriticalPoint hcNe + obtain ⟨rfl, rfl⟩ := criticalPoints_eq_zero_of_product_wpow_two + habc haValue haNegative hx hy + have hdim : Module.finrank K (translatedTruncationSpan a) ≤ 2 := by + rw [habc] + exact finrank_translatedTruncationSpan_mul_le_two hbValue hcValue hx hy + exact (not_lt_of_ge hdim) haDimension + rcases le_total (ordinalValue b) (ordinalValue c) with hbc | hcb + · rcases factorization_cases_of_supportOrderType_wpow_two + haNear haType habc hbc with hconstant | hbalanced + · obtain ⟨k, hk, rfl, -⟩ := hconstant + exact Or.inl ((isUnit_iff_ne_zero.mpr hk).map HahnSeries.Nonpositive.C) + · exact (balancedContradiction hbalanced.2.2.1 hbalanced.2.2.2).elim + · have hacb : a = c * b := by simpa [mul_comm] using habc + rcases factorization_cases_of_supportOrderType_wpow_two + haNear haType hacb hcb with hconstant | hbalanced + · obtain ⟨k, hk, rfl, -⟩ := hconstant + exact Or.inr ((isUnit_iff_ne_zero.mpr hk).map HahnSeries.Nonpositive.C) + · exact (balancedContradiction hbalanced.2.2.2 hbalanced.2.2.1).elim + +end PommersheimShahriari diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/TranslatedTruncationSpan.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/TranslatedTruncationSpan.lean new file mode 100644 index 0000000000..91a1253090 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/TranslatedTruncationSpan.lean @@ -0,0 +1,132 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation +public import Mathlib.LinearAlgebra.Quotient.Basic + +/-! +# Translated-truncation spans modulo `J + K` in Pommersheim--Shahriari + +Pommersheim--Shahriari [PS06] study the vector space +`K((ℝ⁽≤0⁾)) / (J + K)`. This differs from Berarducci's germ ring, whose denominator is only `J`: +the extra quotient by constant series is essential to their degree-two irreducibility criterion. + +The submodule `nearConstantSubmodule` is proved to have exactly the carrier of Berarducci's +additive subgroup `nearConstantSubgroup`. Thus the two developments use the same `J + K`, while +this module exposes the scalar quotient needed for linear spans and dimensions. + +For a series `a`, `translatedTruncationSpan a` is the space denoted `V(a)` in [PS06]: the +span, modulo `J + K`, of its translated truncations at negative exponents. + +## References + +* J. Pommersheim, S. Shahriari, *Unique factorization in generalized power series rings*, +Proc. Amer. Math. Soc. 134 (2006), 1277–1287, cited as [PS06]. +-/ + +universe v + +public noncomputable section + +namespace PommersheimShahriari + +open HahnSeries + +variable {K : Type v} [Field K] + +/-- Scalar multiplication on nonpositive Hahn series through the constant-series embedding. -/ +instance seriesAlgebra : Algebra K (Berarducci.Series K) := + (HahnSeries.Nonpositive.C : K →+* Berarducci.Series K).toAlgebra + +/-- The constant-series embedding as a linear map. -/ +def constantLinearMap : K →ₗ[K] Berarducci.Series K where + toFun := HahnSeries.Nonpositive.C + map_add' x y := + (HahnSeries.Nonpositive.C : K →+* Berarducci.Series K).map_add x y + map_smul' r x := by + change HahnSeries.Nonpositive.C (r * x) = + HahnSeries.Nonpositive.C r * HahnSeries.Nonpositive.C x + exact (HahnSeries.Nonpositive.C : K →+* Berarducci.Series K).map_mul r x + +/-- The scalar submodule `J + K` of negative-monomial-ideal elements plus constants. -/ +def nearConstantSubmodule (K : Type v) [Field K] : + Submodule K (Berarducci.Series K) := + ((HahnSeries.Nonpositive.negativeMonomialIdeal K : + Submodule (Berarducci.Series K) (Berarducci.Series K)).restrictScalars K) ⊔ + LinearMap.range (constantLinearMap (K := K)) + +/-- The scalar submodule `J + K` has exactly the carrier of Berarducci's additive subgroup with +the same name. -/ +theorem mem_nearConstantSubmodule_iff {b : Berarducci.Series K} : + b ∈ nearConstantSubmodule K ↔ b ∈ Berarducci.nearConstantSubgroup K := by + rw [nearConstantSubmodule, Submodule.mem_sup] + constructor + · rintro ⟨j, hj, c, hc, rfl⟩ + rw [LinearMap.mem_range] at hc + obtain ⟨k, rfl⟩ := hc + exact Berarducci.mem_nearConstantSubgroup_iff.mpr ⟨j, hj, k, rfl⟩ + · intro hb + obtain ⟨j, hj, k, rfl⟩ := Berarducci.mem_nearConstantSubgroup_iff.mp hb + exact ⟨j, hj, HahnSeries.Nonpositive.C k, ⟨k, rfl⟩, rfl⟩ + +/-- The [PS06] vector space `K((ℝ⁽≤0⁾)) / (J + K)`. -/ +abbrev SeriesQuotientByJAddConstants (K : Type v) [Field K] := + Berarducci.Series K ⧸ nearConstantSubmodule K + +/-- The quotient map from nonpositive Hahn series to the quotient by `J + K`. -/ +def toSeriesQuotientByJAddConstants : + Berarducci.Series K →ₗ[K] SeriesQuotientByJAddConstants K := + Submodule.mkQ (nearConstantSubmodule K) + +/-- Two series have the same class modulo `J + K` exactly when their difference lies in +Berarducci's subgroup `J + K`. -/ +theorem toSeriesQuotientByJAddConstants_eq_iff {b c : Berarducci.Series K} : + toSeriesQuotientByJAddConstants b = toSeriesQuotientByJAddConstants c ↔ + b - c ∈ Berarducci.nearConstantSubgroup K := by + rw [toSeriesQuotientByJAddConstants, Submodule.mkQ_apply, Submodule.mkQ_apply, + Submodule.Quotient.eq, mem_nearConstantSubmodule_iff] + +/-- A series has zero image modulo constants exactly when it lies in `J + K`. -/ +theorem toSeriesQuotientByJAddConstants_eq_zero_iff {b : Berarducci.Series K} : + toSeriesQuotientByJAddConstants b = 0 ↔ b ∈ Berarducci.nearConstantSubgroup K := by + rw [← map_zero toSeriesQuotientByJAddConstants, toSeriesQuotientByJAddConstants_eq_iff, sub_zero] + +/-- The class modulo `J + K` of the translated truncation at `x`. -/ +def translatedTruncationClass (b : K⟦ℝ⟧) (x : ℝ) : SeriesQuotientByJAddConstants K := + toSeriesQuotientByJAddConstants (Berarducci.translatedTruncation b x) + +/-- Evaluate a translated-truncation class modulo `J + K`. -/ +theorem translatedTruncationClass_apply (b : K⟦ℝ⟧) (x : ℝ) : + translatedTruncationClass b x = + toSeriesQuotientByJAddConstants (Berarducci.translatedTruncation b x) := (rfl) + +/-- [PS06]'s space `V(a)`, spanned modulo `J + K` by translated truncations at negative +exponents. -/ +def translatedTruncationSpan (a : Berarducci.Series K) : + Submodule K (SeriesQuotientByJAddConstants K) := + Submodule.span K (translatedTruncationClass (a : K⟦ℝ⟧) '' Set.Iio 0) + +/-- Every translated-truncation class at a negative exponent belongs to `V(a)`. -/ +theorem translatedTruncationClass_mem_translatedTruncationSpan (a : Berarducci.Series K) + {x : ℝ} (hx : x < 0) : + translatedTruncationClass (a : K⟦ℝ⟧) x ∈ translatedTruncationSpan a := + Submodule.subset_span ⟨x, hx, rfl⟩ + +/-- A subspace contains `V(a)` exactly when it contains every negative translated-truncation +class used to generate `V(a)`. -/ +theorem translatedTruncationSpan_le_iff {a : Berarducci.Series K} + {p : Submodule K (SeriesQuotientByJAddConstants K)} : + translatedTruncationSpan a ≤ p ↔ + ∀ x : ℝ, x < 0 → translatedTruncationClass (a : K⟦ℝ⟧) x ∈ p := by + rw [translatedTruncationSpan, Submodule.span_le] + constructor + · intro h x hx + exact h ⟨x, hx, rfl⟩ + · rintro h _ ⟨x, hx, rfl⟩ + exact h x hx + +end PommersheimShahriari diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/FiniteSupportFactorUniqueness.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/FiniteSupportFactorUniqueness.lean new file mode 100644 index 0000000000..3319138246 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/FiniteSupportFactorUniqueness.lean @@ -0,0 +1,280 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.InfiniteSupport + +import Mathlib.Algebra.GroupWithZero.Associated + +/-! +# Uniqueness of the finite-support factor + +This module proves the conditional core of LM24, Theorem 6.4.1. A factorisation consists of one +finite-support series followed by a finite list of irreducible series with infinite support. The +finite-support factor is unique up to multiplication by a nonzero coefficient scalar. + +The proof first shows that every irreducible infinite-support factor has normalized maximal +finite-support divisor `1`. Multiplicativity of the normalized maximal divisor then identifies the +finite-support factor with the canonical divisor up to a scalar. No uniqueness assertion is made +about the list of infinite-support irreducible factors. + +Finite-support greatest-common-divisor existence, finite-support unit classification, and +multiplicativity of the normalized maximal divisor remain explicit hypotheses; the coefficient +field has characteristic zero. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +namespace Berarducci + +public noncomputable section + +open HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +private theorem degree_eq_of_associated {b c : Series K} (hbc : Associated b c) : + (b : K⟦ℝ⟧).degree = (c : K⟦ℝ⟧).degree := by + obtain ⟨u, hu⟩ := hbc + have huDegree : (((u : Series K) : K⟦ℝ⟧).degree) = 0 := + degree_eq_zero_of_isUnit HahnSeries.Nonpositive.degree_mul u.isUnit + have hdegree := HahnSeries.Nonpositive.degree_mul b (u : Series K) + rw [hu, huDegree, add_zero] at hdegree + exact hdegree.symm + +/-- An irreducible series with infinite support has no nonunit finite-support divisor. -/ +theorem hasOnlyUnitFiniteSupportDivisors_of_irreducible_of_support_infinite + {c : Series K} (hcIrreducible : Irreducible c) + (hcInfinite : (c : K⟦ℝ⟧).support.Infinite) : + HasOnlyUnitFiniteSupportDivisors c := by + apply (hasOnlyUnitFiniteSupportDivisors_iff c).mpr + intro p hp + rcases (hcIrreducible.dvd_iff).mp hp with hpUnit | hcp + · apply isUnit_of_dvd_one + apply (finiteSupport_dvd_iff_coe_dvd + (1 : FiniteSupportRing (K := K)) p).mpr + simpa using hpUnit.dvd + · have hcNe : c ≠ 0 := by + intro hzero + subst c + simp at hcInfinite + have hpSeriesNe : (p : Series K) ≠ 0 := hcp.ne_zero_iff.mp hcNe + have hpHahnNe : (p : K⟦ℝ⟧) ≠ 0 := by + intro hzero + exact hpSeriesNe (Subtype.ext hzero) + have hpDegree : (p : K⟦ℝ⟧).degree = 0 := by + rw [HahnSeries.degree_eq_zero] + exact ⟨hpHahnNe, (mem_finiteSupportSubring_iff (p : Series K)).mp p.2⟩ + have hcDegree : (c : K⟦ℝ⟧).degree = 0 := + (degree_eq_of_associated hcp).trans hpDegree + exact (not_le_of_gt + (HahnSeries.degree_pos_iff_support_infinite.mpr hcInfinite) hcDegree.le).elim + +/-- The normalized maximal finite-support divisor of an irreducible infinite-support series is +one. -/ +theorem seriesNormalizedMaximalFiniteSupportDivisor_eq_one_of_irreducible_of_support_infinite + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hunits : ∀ p : FiniteSupportRing (K := K), + IsUnit p ↔ ∃ k : K, k ≠ 0 ∧ + p = finiteSupportScalarHom (G := ℝ) k) + {c : Series K} (hcIrreducible : Irreducible c) + (hcInfinite : (c : K⟦ℝ⟧).support.Infinite) : + seriesNormalizedMaximalFiniteSupportDivisor c = 1 := by + have hcPrimitive := + hasOnlyUnitFiniteSupportDivisors_of_irreducible_of_support_infinite + hcIrreducible hcInfinite + have hcPrimitive' := (hasOnlyUnitFiniteSupportDivisors_iff c).mp hcPrimitive + apply seriesNormalizedMaximalFiniteSupportDivisor_eq_of_is hgcd hunits + rw [isNormalizedSeriesMaximalFiniteSupportDivisor_iff] + constructor + · intro q + constructor + · exact fun hq ↦ (hcPrimitive' q hq).dvd + · intro hq + have hqSeries : (q : Series K) ∣ (1 : Series K) := + map_dvd (finiteSupportSubring (G := ℝ) (K := K)).subtype hq + exact hqSeries.trans (one_dvd c) + · refine Or.inr ⟨?_, isMonicFiniteSupport_one⟩ + intro hzero + subst c + simp at hcInfinite + +/-- The normalized maximal finite-support divisor of a product list of irreducible +infinite-support series is one. -/ +theorem seriesNormalizedMaximalFiniteSupportDivisor_list_prod_eq_one + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hunits : ∀ p : FiniteSupportRing (K := K), + IsUnit p ↔ ∃ k : K, k ≠ 0 ∧ + p = finiteSupportScalarHom (G := ℝ) k) + (hmaxMul : ∀ b c : Series K, + seriesNormalizedMaximalFiniteSupportDivisor (b * c) = + seriesNormalizedMaximalFiniteSupportDivisor b * + seriesNormalizedMaximalFiniteSupportDivisor c) + (factors : List (Series K)) + (hfactors : ∀ c ∈ factors, + Irreducible c ∧ (c : K⟦ℝ⟧).support.Infinite) : + seriesNormalizedMaximalFiniteSupportDivisor factors.prod = 1 := by + induction factors with + | nil => + simpa using seriesNormalizedMaximalFiniteSupportDivisor_eq_one_of_isPrincipal hunits + (isPrincipal_one (R := K)) + | cons c factors ih => + rw [List.prod_cons, hmaxMul, + seriesNormalizedMaximalFiniteSupportDivisor_eq_one_of_irreducible_of_support_infinite hgcd + hunits (hfactors c (by simp)).1 + (hfactors c (by simp)).2, + ih (fun d hd ↦ hfactors d (by simp [hd]))] + exact one_mul 1 + +/-- A factorisation into one finite-support factor and finitely many irreducible +infinite-support factors. -/ +def IsInfiniteSupportIrreducibleFactorization (b : Series K) (p : FiniteSupportRing (K := K)) + (factors : List (Series K)) : Prop := + b = (p : Series K) * factors.prod ∧ + ∀ c ∈ factors, Irreducible c ∧ (c : K⟦ℝ⟧).support.Infinite + +omit [CharZero K] in +/-- Characterization of a factorisation into a finite-support factor and irreducible +infinite-support factors. -/ +theorem isInfiniteSupportIrreducibleFactorization_iff + (b : Series K) (p : FiniteSupportRing (K := K)) + (factors : List (Series K)) : + IsInfiniteSupportIrreducibleFactorization b p factors ↔ + b = (p : Series K) * factors.prod ∧ + ∀ c ∈ factors, Irreducible c ∧ (c : K⟦ℝ⟧).support.Infinite := + Iff.rfl + +/-- A finite-support factor is unique up to multiplication by a nonzero coefficient scalar +among all factorisations with irreducible infinite-support residual factors. -/ +def IsUniqueFiniteSupportFactorUpToScalar (b : Series K) (p : FiniteSupportRing (K := K)) : Prop := + ∀ (q : FiniteSupportRing (K := K)) (factors : List (Series K)), + IsInfiniteSupportIrreducibleFactorization b q factors → + ∃ k : K, k ≠ 0 ∧ q = finiteSupportScalarHom (G := ℝ) k * p + +omit [CharZero K] in +/-- Characterization of uniqueness of the finite-support factor up to a nonzero coefficient +scalar. -/ +theorem isUniqueFiniteSupportFactorUpToScalar_iff (b : Series K) (p : FiniteSupportRing (K := K)) : + IsUniqueFiniteSupportFactorUpToScalar b p ↔ + ∀ (q : FiniteSupportRing (K := K)) (factors : List (Series K)), + IsInfiniteSupportIrreducibleFactorization b q factors → + ∃ k : K, k ≠ 0 ∧ q = finiteSupportScalarHom (G := ℝ) k * p := + Iff.rfl + +/-- Any finite-support factor in such a factorisation differs from the canonical normalized +maximal finite-support divisor by a nonzero coefficient scalar. -/ +theorem seriesNormalizedMaximalFiniteSupportDivisor_eq_scalar_mul_of_factorization + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hunits : ∀ p : FiniteSupportRing (K := K), + IsUnit p ↔ ∃ k : K, k ≠ 0 ∧ + p = finiteSupportScalarHom (G := ℝ) k) + (hmaxMul : ∀ b c : Series K, + seriesNormalizedMaximalFiniteSupportDivisor (b * c) = + seriesNormalizedMaximalFiniteSupportDivisor b * + seriesNormalizedMaximalFiniteSupportDivisor c) + {b : Series K} {p : FiniteSupportRing (K := K)} + {factors : List (Series K)} + (hfactorization : IsInfiniteSupportIrreducibleFactorization b p factors) : + ∃ k : K, k ≠ 0 ∧ + seriesNormalizedMaximalFiniteSupportDivisor b = + finiteSupportScalarHom (G := ℝ) k * p := by + obtain ⟨k, hk, hp⟩ := + exists_scalar_seriesNormalizedMaximalFiniteSupportDivisor_coe hunits p + refine ⟨k, hk, ?_⟩ + rw [hfactorization.1, hmaxMul, hp, + seriesNormalizedMaximalFiniteSupportDivisor_list_prod_eq_one hgcd hunits hmaxMul factors + hfactorization.2, + mul_one] + +/-- The finite-support factors in any two such factorisations differ by multiplication by a +nonzero coefficient scalar. -/ +theorem finiteSupportFactor_eq_scalar_mul_of_factorizations + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hunits : ∀ p : FiniteSupportRing (K := K), + IsUnit p ↔ ∃ k : K, k ≠ 0 ∧ + p = finiteSupportScalarHom (G := ℝ) k) + (hmaxMul : ∀ b c : Series K, + seriesNormalizedMaximalFiniteSupportDivisor (b * c) = + seriesNormalizedMaximalFiniteSupportDivisor b * + seriesNormalizedMaximalFiniteSupportDivisor c) + {b : Series K} {p q : FiniteSupportRing (K := K)} + {factors otherFactors : List (Series K)} + (hp : IsInfiniteSupportIrreducibleFactorization b p factors) + (hq : IsInfiniteSupportIrreducibleFactorization b q otherFactors) : + ∃ k : K, k ≠ 0 ∧ q = finiteSupportScalarHom (G := ℝ) k * p := by + obtain ⟨a, ha, hpa⟩ := + seriesNormalizedMaximalFiniteSupportDivisor_eq_scalar_mul_of_factorization hgcd hunits hmaxMul + hp + obtain ⟨d, hd, hqd⟩ := + seriesNormalizedMaximalFiniteSupportDivisor_eq_scalar_mul_of_factorization hgcd hunits hmaxMul + hq + have haUnit : + IsUnit (finiteSupportScalarHom (G := ℝ) a : FiniteSupportRing (K := K)) := + (hunits _).mpr ⟨a, ha, rfl⟩ + have hdUnit : + IsUnit (finiteSupportScalarHom (G := ℝ) d : FiniteSupportRing (K := K)) := + (hunits _).mpr ⟨d, hd, rfl⟩ + have hmkP : Associates.mk (seriesNormalizedMaximalFiniteSupportDivisor b) = + Associates.mk p := by + rw [hpa, ← Associates.mk_mul_mk, Associates.mk_eq_one.mpr haUnit, one_mul] + have hmkQ : Associates.mk (seriesNormalizedMaximalFiniteSupportDivisor b) = + Associates.mk q := by + rw [hqd, ← Associates.mk_mul_mk, Associates.mk_eq_one.mpr hdUnit, one_mul] + exact exists_nonzero_scalar_mul_of_mk_eq_mk hunits (hmkP.symm.trans hmkQ) + +/-- Conditional existence, Cantor-term bound, and finite-support-factor uniqueness underlying +LM24, Theorem 6.4.1. -/ +theorem exists_factorization_with_unique_finiteSupportFactor + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hunits : ∀ p : FiniteSupportRing (K := K), + IsUnit p ↔ ∃ k : K, k ≠ 0 ∧ + p = finiteSupportScalarHom (G := ℝ) k) + (hmaxMul : ∀ b c : Series K, + seriesNormalizedMaximalFiniteSupportDivisor (b * c) = + seriesNormalizedMaximalFiniteSupportDivisor b * + seriesNormalizedMaximalFiniteSupportDivisor c) + {b : Series K} (hb : b ≠ 0) : + ∃ (p : FiniteSupportRing (K := K)) (factors : List (Series K)), + IsInfiniteSupportIrreducibleFactorization b p factors ∧ + factors.length ≤ HahnSeries.degreeCantorTermCount (b : K⟦ℝ⟧) ∧ + IsUniqueFiniteSupportFactorUpToScalar b p := by + obtain ⟨k, factors, hk, hfactor, hfactors, hbound⟩ := + exists_series_infinite_support_factorization_of_exists_gcd hgcd hunits hb + let p := finiteSupportScalarHom (G := ℝ) k * + seriesNormalizedMaximalFiniteSupportDivisor b + have hpFactor : IsInfiniteSupportIrreducibleFactorization b p factors := by + constructor + · have hscalar : + ((finiteSupportScalarHom (G := ℝ) k : + FiniteSupportRing (K := K)) : Series K) = C k := by + apply Subtype.ext + rw [coe_finiteSupportScalarHom, coe_C] + change b = + ((finiteSupportScalarHom (G := ℝ) k * + seriesNormalizedMaximalFiniteSupportDivisor b : + FiniteSupportRing (K := K)) : Series K) * factors.prod + rw [Subring.coe_mul, hscalar] + exact hfactor + · exact hfactors + refine ⟨p, factors, hpFactor, hbound, ?_⟩ + intro q otherFactors hq + exact finiteSupportFactor_eq_scalar_mul_of_factorizations hgcd hunits hmaxMul hpFactor hq + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/GermLike.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/GermLike.lean new file mode 100644 index 0000000000..7d517a20d6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/GermLike.lean @@ -0,0 +1,339 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPointExistence + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.FactorizationClassification +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import Mathlib.Tactic.Linarith + +/-! +# Factorisation of germ-like series + +L'Innocente--Mantova define a series `a` to be germ-like when its support order type is either +`v_J(a)` or, for `v_J(a) > 1`, `v_J(a) + 1`. Their Lemmas 4.4 and 4.5 identify this condition +with critical point zero and show that it passes to nonzero factors. Well-founded induction on +the ordinal value then gives their Theorem 4.8: every nonzero germ-like series factors into +irreducibles. + +The critical-point proof below uses the two defining support-order alternatives directly. In the +second alternative, the strictly negative support has order type exactly `v_J(a)`; every proper +negative translated truncation therefore has smaller ordinal value. + +## References + +* S. L'Innocente, V. Mantova, *Factorisation of germ-like series*, J. Log. Anal. 9 (2017), + paper no. 3, cited as [LM17]. +-/ + +universe v + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace LM17 + +open Berarducci HahnSeries Ordinal + +variable {K : Type v} [Field K] + +/-- LM17, Definition 4.1: a series is germ-like when its support order type is its ordinal value, +or is its ordinal value plus one when that value is greater than one. -/ +def IsGermLike (a : Series K) : Prop := + (a : K⟦ℝ⟧).supportOrderType = (ordinalValue a).val ∨ + (1 < ordinalValue a ∧ + (a : K⟦ℝ⟧).supportOrderType = (ordinalValue a).val + 1) + +/-- Characterisation of the germ-like predicate. -/ +theorem isGermLike_iff {a : Series K} : + IsGermLike a ↔ + (a : K⟦ℝ⟧).supportOrderType = (ordinalValue a).val ∨ + (1 < ordinalValue a ∧ + (a : K⟦ℝ⟧).supportOrderType = (ordinalValue a).val + 1) := + (Iff.rfl) + +/-- A germ-like series satisfies one of its two defining support-order identities. -/ +theorem IsGermLike.elim {a : Series K} (ha : IsGermLike a) : + (a : K⟦ℝ⟧).supportOrderType = (ordinalValue a).val ∨ + (1 < ordinalValue a ∧ + (a : K⟦ℝ⟧).supportOrderType = (ordinalValue a).val + 1) := + ha + +private theorem truncGE_zero_eq_single (a : Series K) : + HahnSeries.truncGE 0 (a : K⟦ℝ⟧) = + HahnSeries.single 0 ((a : K⟦ℝ⟧).coeff 0) := by + ext x + rcases lt_trichotomy x 0 with hx | rfl | hx + · simp [HahnSeries.coeff_truncGE, not_le_of_gt hx, hx.ne] + · simp + · have hcoeff : (a : K⟦ℝ⟧).coeff x = 0 := by + apply not_ne_iff.mp + rw [← HahnSeries.mem_support] + exact fun hmem ↦ (not_le_of_gt hx) + (HahnSeries.Nonpositive.support_subset a hmem) + simp [HahnSeries.coeff_truncGE, hx.le, hcoeff, hx.ne'] + +private theorem supportOrderType_truncGE_zero_eq_zero_or_one (a : Series K) : + (HahnSeries.truncGE 0 (a : K⟦ℝ⟧)).supportOrderType = 0 ∨ + (HahnSeries.truncGE 0 (a : K⟦ℝ⟧)).supportOrderType = 1 := by + rw [truncGE_zero_eq_single] + by_cases hcoeff : (a : K⟦ℝ⟧).coeff 0 = 0 + · left + simp [hcoeff] + · right + exact HahnSeries.supportOrderType_single hcoeff + +private theorem negativeSupport_orderType_eq_ordinalValue + {a : Series K} (haOne : 1 < ordinalValue a) + (haType : (a : K⟦ℝ⟧).supportOrderType = (ordinalValue a).val + 1) : + ((a : K⟦ℝ⟧).isPWO_support.mono + (s := (a : K⟦ℝ⟧).support ∩ Set.Iio 0) + Set.inter_subset_left).orderType = (ordinalValue a).val := by + let S : Set ℝ := (a : K⟦ℝ⟧).support ∩ Set.Iio 0 + let hS : S.IsPWO := (a : K⟦ℝ⟧).isPWO_support.mono Set.inter_subset_left + have hSLUB : IsLUB S 0 := isLUB_negativeSupport_zero_of_one_lt_ordinalValue haOne + have hSne : S.Nonempty := by + obtain ⟨x, hx, -, -⟩ := hSLUB.exists_between (show (-1 : ℝ) < 0 by norm_num) + exact ⟨x, hx⟩ + have hSgt : ∀ x ∈ S, ∃ y ∈ S, x < y := by + intro x hx + obtain ⟨y, hy, hxy, -⟩ := hSLUB.exists_between hx.2 + exact ⟨y, hy, hxy⟩ + have hSlimit : Order.IsSuccLimit hS.orderType := + Set.IsPWO.isSuccLimit_orderType_of_forall_exists_gt hS hSne hSgt + have htruncSupport : + (HahnSeries.truncLT 0 (a : K⟦ℝ⟧)).support = S := by + rw [HahnSeries.support_truncLT] + rfl + have htruncType : + (HahnSeries.truncLT 0 (a : K⟦ℝ⟧)).supportOrderType = hS.orderType := by + rw [HahnSeries.supportOrderType_eq_setOrderType] + exact (HahnSeries.truncLT 0 (a : K⟦ℝ⟧)).isPWO_support.orderType_congr + hS htruncSupport + have hsplit := HahnSeries.supportOrderType_eq_truncLT_add_truncGE + 0 (a : K⟦ℝ⟧) + rcases supportOrderType_truncGE_zero_eq_zero_or_one a with hz | hz + · rw [hz, add_zero, htruncType] at hsplit + have hbad : hS.orderType = (ordinalValue a).val + 1 := + hsplit.symm.trans haType + rw [hbad, ← Order.succ_eq_add_one] at hSlimit + exact (Order.not_isSuccLimit_succ _ hSlimit).elim + · rw [hz, htruncType] at hsplit + have heq : (ordinalValue a).val + 1 = hS.orderType + 1 := + haType.symm.trans hsplit + exact (Ordinal.add_right_cancel 1).mp (by simpa using heq) |>.symm + +private theorem ordinalValue_translatedTruncation_lt_of_supportOrderType_eq + {a : Series K} + (haValue : (a : K⟦ℝ⟧).supportOrderType = (ordinalValue a).val) + (haZero : ordinalValue a ≠ 0) {u : ℝ} (hu : u < 0) : + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) u) < ordinalValue a := by + have hLUB := isLUB_support_zero_of_ordinalValue_ne_zero haZero + obtain ⟨gamma, hgammaSupport, hugamma, -⟩ := hLUB.exists_between hu + have htruncNe : HahnSeries.truncLE u (a : K⟦ℝ⟧) ≠ (a : K⟦ℝ⟧) := by + intro htrunc + have hgammaTrunc : gamma ∈ (HahnSeries.truncLE u (a : K⟦ℝ⟧)).support := by + rw [htrunc] + exact hgammaSupport + rw [HahnSeries.support_truncLE] at hgammaTrunc + exact (not_le_of_gt hugamma) hgammaTrunc.2 + calc + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) u) ≤ + NatOrdinal.of + ((translatedTruncation (a : K⟦ℝ⟧) u : Series K) : K⟦ℝ⟧).supportOrderType := + ordinalValue_le_supportOrderType _ + _ = NatOrdinal.of (HahnSeries.truncLE u (a : K⟦ℝ⟧)).supportOrderType := by + rw [coe_translatedTruncation, HahnSeries.supportOrderType_translate] + _ < NatOrdinal.of (a : K⟦ℝ⟧).supportOrderType := + NatOrdinal.of.lt_iff_lt.mpr (HahnSeries.supportOrderType_truncLE_lt u htruncNe) + _ = ordinalValue a := by rw [haValue, NatOrdinal.of_val] + +private theorem ordinalValue_translatedTruncation_lt_of_negativeSupport_orderType_eq + {a : Series K} (haOne : 1 < ordinalValue a) + (hSType : ((a : K⟦ℝ⟧).isPWO_support.mono + (s := (a : K⟦ℝ⟧).support ∩ Set.Iio 0) + Set.inter_subset_left).orderType = (ordinalValue a).val) + {u : ℝ} (hu : u < 0) : + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) u) < ordinalValue a := by + let S : Set ℝ := (a : K⟦ℝ⟧).support ∩ Set.Iio 0 + let hS : S.IsPWO := (a : K⟦ℝ⟧).isPWO_support.mono Set.inter_subset_left + have hSLUB : IsLUB S 0 := isLUB_negativeSupport_zero_of_one_lt_ordinalValue haOne + obtain ⟨y, hy, huy, -⟩ := hSLUB.exists_between hu + let T : Set ℝ := (HahnSeries.truncLE u (a : K⟦ℝ⟧)).support + let hT : T.IsPWO := (HahnSeries.truncLE u (a : K⟦ℝ⟧)).isPWO_support + have hTsub : T ⊆ S ∩ Set.Iio y := by + intro x hx + change x ∈ (HahnSeries.truncLE u (a : K⟦ℝ⟧)).support at hx + rw [HahnSeries.support_truncLE] at hx + exact ⟨⟨hx.1, hx.2.trans_lt hu⟩, hx.2.trans_lt huy⟩ + have hTlt : hT.orderType < hS.orderType := + (hT.orderType_mono + (hS.mono (s := S ∩ Set.Iio y) Set.inter_subset_left) hTsub).trans_lt + (hS.orderType_inter_Iio_lt hy) + calc + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) u) ≤ + NatOrdinal.of + ((translatedTruncation (a : K⟦ℝ⟧) u : Series K) : K⟦ℝ⟧).supportOrderType := + ordinalValue_le_supportOrderType _ + _ = NatOrdinal.of hT.orderType := by + rw [coe_translatedTruncation, HahnSeries.supportOrderType_translate, + HahnSeries.supportOrderType_eq_setOrderType] + _ < NatOrdinal.of (ordinalValue a).val := by + apply NatOrdinal.of.lt_iff_lt.mpr + rwa [hSType] at hTlt + _ = ordinalValue a := by rw [NatOrdinal.of_val] + +private theorem ordinalValue_translatedTruncation_lt {a : Series K} + (ha : IsGermLike a) (ha0 : a ≠ 0) {u : ℝ} (hu : u < 0) : + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) u) < ordinalValue a := by + rcases ha.elim with haType | ⟨haOne, haType⟩ + · exact ordinalValue_translatedTruncation_lt_of_supportOrderType_eq haType + (fun hzero ↦ ha0 (Subtype.ext (HahnSeries.supportOrderType_eq_zero.mp (by + simpa [hzero] using haType)))) hu + · exact ordinalValue_translatedTruncation_lt_of_negativeSupport_orderType_eq + haOne (negativeSupport_orderType_eq_ordinalValue haOne haType) hu + +/-- LM17, Lemma 4.4, forward direction: a nonzero germ-like series has critical point zero. -/ +theorem IsGermLike.isCriticalPoint_zero {a : Series K} + (ha : IsGermLike a) (ha0 : a ≠ 0) : + IsCriticalPoint a 0 := by + rw [isCriticalPoint_iff] + refine ⟨ha0, le_rfl, ?_, ?_⟩ + · intro y hy + rcases hy.eq_or_lt with rfl | hy + · exact le_rfl + · simpa using (ordinalValue_translatedTruncation_lt ha ha0 hy).le + · intro y _ hvalue + by_contra hnot + have hylt : y < 0 := lt_of_not_ge hnot + exact (ordinalValue_translatedTruncation_lt ha ha0 hylt).ne (by simpa using hvalue) + +/-- LM17, Lemma 4.5 and Corollary 4.6: if a series with critical point zero is a product of +two nonzero series, then both factors have critical point zero. -/ +theorem factors_isCriticalPoint_zero [CharZero K] + {a b c : Series K} (ha : IsCriticalPoint a 0) + (habc : a = b * c) (hb0 : b ≠ 0) (hc0 : c ≠ 0) : + IsCriticalPoint b 0 ∧ IsCriticalPoint c 0 := by + obtain ⟨x, hx⟩ := exists_isCriticalPoint hb0 + obtain ⟨y, hy⟩ := exists_isCriticalPoint hc0 + have hxy0 : x + y ≤ 0 := add_nonpos hx.nonpositive hy.nonpositive + have hbLe : + ordinalValue b ≤ ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) := by + simpa using hx.value_le 0 le_rfl + have hcLe : + ordinalValue c ≤ ordinalValue (translatedTruncation (c : K⟦ℝ⟧) y) := by + simpa using hy.value_le 0 le_rfl + have hcriticalEq : + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) (x + y)) = + ordinalValue a := by + apply le_antisymm + · simpa using ha.value_le (x + y) hxy0 + · calc + ordinalValue a = ordinalValue b * ordinalValue c := by + rw [habc, ordinalValue_mul] + _ ≤ ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) * + ordinalValue (translatedTruncation (c : K⟦ℝ⟧) y) := + mul_le_mul hbLe hcLe bot_le bot_le + _ = ordinalValue + (translatedTruncation (((b * c : Series K) : K⟦ℝ⟧)) (x + y)) := + (criticalPoint_product_value hx hy).symm + _ = ordinalValue (translatedTruncation (a : K⟦ℝ⟧) (x + y)) := by + rw [habc] + have hzeroLe : 0 ≤ x + y := + ha.le_of_value_eq (x + y) hxy0 (by simpa using hcriticalEq) + have hx0 : x = 0 := + le_antisymm hx.nonpositive (by linarith [hzeroLe, hy.nonpositive]) + have hy0 : y = 0 := + le_antisymm hy.nonpositive (by linarith [hzeroLe, hx.nonpositive]) + exact ⟨hx0 ▸ hx, hy0 ▸ hy⟩ + +private theorem isUnit_of_ordinalValue_eq_one_of_isCriticalPoint_zero + {a : Series K} (haValue : ordinalValue a = 1) + (haCritical : IsCriticalPoint a 0) : IsUnit a := by + have haConstant := + PommersheimShahriari.mem_constantSubgroup_of_ordinalValue_one_of_criticalPoint_zero + haValue haCritical + obtain ⟨k, hk⟩ := Berarducci.mem_constantSubgroup_iff.mp haConstant + have hk0 : k ≠ 0 := by + intro hzero + apply haCritical.ne_zero + rw [← hk, hzero, map_zero] + rw [← hk] + exact (isUnit_iff_ne_zero.mpr hk0).map HahnSeries.Nonpositive.C + +private theorem one_lt_ordinalValue_of_not_isUnit_of_isCriticalPoint_zero + {a : Series K} (haUnit : ¬IsUnit a) + (haCritical : IsCriticalPoint a 0) : 1 < ordinalValue a := by + have hpos : 0 < ordinalValue a := by + simpa using haCritical.value_pos + have hone : ordinalValue a ≠ 1 := fun hvalue ↦ + haUnit (isUnit_of_ordinalValue_eq_one_of_isCriticalPoint_zero hvalue haCritical) + exact lt_of_le_of_ne (Order.one_le_iff_pos.mpr hpos) (Ne.symm hone) + +/-- LM17, Theorem 4.8: every nonzero series with critical point zero admits a finite +factorisation into irreducibles. The theorem is stated through association so that unit factors +are absorbed rather than chosen. -/ +theorem exists_factorization_of_isCriticalPoint_zero [CharZero K] + {a : Series K} (haCritical : IsCriticalPoint a 0) : + ∃ f : Multiset (Series K), + (∀ b ∈ f, Irreducible b) ∧ Associated f.prod a := by + let wf : WellFounded (Function.onFun (fun x y : NatOrdinal ↦ x < y) + (fun b : Series K ↦ ordinalValue b)) := wellFounded_lt.onFun + refine wf.induction (C := fun a ↦ IsCriticalPoint a 0 → + ∃ f : Multiset (Series K), + (∀ b ∈ f, Irreducible b) ∧ Associated f.prod a) a ?_ haCritical + intro a ih haCritical + by_cases haUnit : IsUnit a + · refine ⟨0, by simp, ?_⟩ + simpa using (associated_one_iff_isUnit.mpr haUnit).symm + by_cases haIrreducible : Irreducible a + · exact ⟨{a}, by simpa using haIrreducible, by simp⟩ + obtain ⟨b, c, hbUnit, hcUnit, habc⟩ := + (irreducible_or_factor haUnit).resolve_left haIrreducible + have hb0 : b ≠ 0 := by + intro hzero + apply haCritical.ne_zero + rw [habc, hzero, zero_mul] + have hc0 : c ≠ 0 := by + intro hzero + apply haCritical.ne_zero + rw [habc, hzero, mul_zero] + obtain ⟨hbCritical, hcCritical⟩ := + factors_isCriticalPoint_zero haCritical habc hb0 hc0 + have hbOne := + one_lt_ordinalValue_of_not_isUnit_of_isCriticalPoint_zero hbUnit hbCritical + have hcOne := + one_lt_ordinalValue_of_not_isUnit_of_isCriticalPoint_zero hcUnit hcCritical + have hbPos : 0 < ordinalValue b := zero_lt_one.trans hbOne + have hcPos : 0 < ordinalValue c := zero_lt_one.trans hcOne + have hbLt : ordinalValue b < ordinalValue a := by + rw [habc, ordinalValue_mul] + simpa only [mul_one] using mul_lt_mul_of_pos_left hcOne hbPos + have hcLt : ordinalValue c < ordinalValue a := by + rw [habc, ordinalValue_mul] + simpa only [one_mul] using mul_lt_mul_of_pos_right hbOne hcPos + obtain ⟨fb, hfbIrr, hfb⟩ := ih b hbLt hbCritical + obtain ⟨fc, hfcIrr, hfc⟩ := ih c hcLt hcCritical + refine ⟨fb + fc, ?_, ?_⟩ + · intro x hx + rcases Multiset.mem_add.mp hx with hx | hx + · exact hfbIrr x hx + · exact hfcIrr x hx + · rw [Multiset.prod_add] + simpa [habc] using hfb.mul_mul hfc + +/-- LM17, Theorem 4.8: every nonzero germ-like series admits a finite factorisation into +irreducibles. -/ +theorem IsGermLike.exists_factorization [CharZero K] + {a : Series K} (ha : IsGermLike a) (ha0 : a ≠ 0) : + ∃ f : Multiset (Series K), + (∀ b ∈ f, Irreducible b) ∧ Associated f.prod a := + exists_factorization_of_isCriticalPoint_zero (ha.isCriticalPoint_zero ha0) + +end LM17 diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/GradedDivisibility.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/GradedDivisibility.lean new file mode 100644 index 0000000000..e1cd99d16a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/GradedDivisibility.lean @@ -0,0 +1,222 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringMonoidAlgebra + +/-! +# Divisibility in the degree-graded ring + +This module formalizes LM24, Proposition 6.2.1, Corollaries 6.2.2--6.2.3, and Proposition +6.2.4. Degree RV is represented by the homogeneous classes in the associated graded ring. The +paper's set `P` of principal RV classes is represented intrinsically as the image of +`IsPrincipalRV` under the canonical RV embedding; `isPrincipalRVImage_iff` relates this exact +image predicate to homogeneous, componentwise-principal graded elements. + +The published results retain the characteristic-zero hypothesis. Their divisibility arguments use +field-generic results about trailing grades, homogeneous divisibility, and the monoid-algebra +presentation of the principal graded subring. +-/ + +open scoped DirectSum HahnSeries NatOrdinal + +universe v + +namespace Berarducci + +public noncomputable section + +open HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +/-- Membership in the image of the paper's principal RV classes inside the degree-graded +graded ring. -/ +def IsPrincipalRVImage (x : DegreeGraded K) : Prop := + ∃ B : HahnDegreeRV K, IsPrincipalRV B ∧ + (degreeValuation K).rvInitialFormHom B = x + +/-- Introduction and elimination rule for the image of the principal RV classes. -/ +theorem isPrincipalRVImage_iff_exists (x : DegreeGraded K) : + IsPrincipalRVImage x ↔ + ∃ B : HahnDegreeRV K, IsPrincipalRV B ∧ + (degreeValuation K).rvInitialFormHom B = x := + Iff.rfl + +/-- The canonical graded image of a principal RV class belongs to `P`. -/ +theorem isPrincipalRVImage_initialForm (B : HahnDegreeRV K) (hB : IsPrincipalRV B) : + IsPrincipalRVImage + ((degreeValuation K).rvInitialFormHom B) := + (isPrincipalRVImage_iff_exists _).mpr ⟨B, hB, rfl⟩ + +/-- The image of `P` consists exactly of the nonzero homogeneous graded elements whose sole +component is principal. -/ +theorem isPrincipalRVImage_iff (x : DegreeGraded K) : + IsPrincipalRVImage x ↔ + x ≠ 0 ∧ + x ∈ (degreeValuation K).homogeneousClasses ∧ + IsPrincipalGraded x := by + let w := degreeValuation K + constructor + · rintro ⟨B, hBPrincipal, rfl⟩ + obtain ⟨α, C, hC, hCPrincipal, hBC⟩ := + (isPrincipalRV_iff_exists_degreeHomogeneousClass B).mp hBPrincipal + have hBInitial : w.rvInitialFormHom B = DirectSum.of w.Component α C := by + calc + w.rvInitialFormHom B = + ((w.rvEquivHomogeneous B : w.HomogeneousClasses) : w.AssociatedGraded) := by + rw [w.rvEquivHomogeneous_apply, w.coe_rvHomogeneous] + _ = (degreeHomogeneousClass α C : w.AssociatedGraded) := + congrArg Subtype.val hBC + _ = DirectSum.of w.Component α C := + coe_degreeHomogeneousClass α C + have hBHomogeneous : + w.rvInitialFormHom B ∈ w.homogeneousClasses := by + rw [← w.coe_rvHomogeneous] + exact (w.rvHomogeneous B).2 + refine ⟨?_, hBHomogeneous, ?_⟩ + · rw [hBInitial] + intro hzero + apply hC + apply DirectSum.of_injective α + simpa using hzero + · rw [isPrincipalGraded_iff] + intro β + rw [hBInitial] + by_cases hβ : α = β + · subst β + simpa using hCPrincipal + · rw [DirectSum.of_eq_of_ne α β C (Ne.symm hβ)] + exact (isPrincipalDegreeClass_iff β 0).mpr (Or.inl rfl) + · rintro ⟨hx, hxHomogeneous, hxPrincipal⟩ + rw [w.mem_homogeneousClasses_iff] at hxHomogeneous + rcases hxHomogeneous with hzero | ⟨α, C, hCeq⟩ + · exact (hx hzero).elim + have hC : C ≠ 0 := by + intro hC + subst C + exact hx (hCeq.trans (map_zero _)) + let xHomogeneous : w.HomogeneousClasses := + ⟨x, (w.mem_homogeneousClasses_iff x).mpr (Or.inr ⟨α, C, hCeq⟩)⟩ + let B := w.rvEquivHomogeneous.symm xHomogeneous + refine ⟨B, ?_, ?_⟩ + · apply (isPrincipalRV_iff_exists_degreeHomogeneousClass B).mpr + refine ⟨α, C, hC, ?_, ?_⟩ + · rw [isPrincipalGraded_iff] at hxPrincipal + have hα := hxPrincipal α + rw [hCeq, DirectSum.of_eq_same] at hα + exact hα + · change w.rvEquivHomogeneous B = degreeHomogeneousClass α C + apply Subtype.ext + calc + ((w.rvEquivHomogeneous B : w.HomogeneousClasses) : w.AssociatedGraded) = x := by + exact congrArg Subtype.val (w.rvEquivHomogeneous.apply_symm_apply xHomogeneous) + _ = DirectSum.of w.Component α C := hCeq + _ = (degreeHomogeneousClass α C : w.AssociatedGraded) := + (coe_degreeHomogeneousClass α C).symm + · change w.rvInitialFormHom B = x + calc + w.rvInitialFormHom B = + ((w.rvEquivHomogeneous B : w.HomogeneousClasses) : w.AssociatedGraded) := by + rw [w.rvEquivHomogeneous_apply, w.coe_rvHomogeneous] + _ = x := congrArg Subtype.val (w.rvEquivHomogeneous.apply_symm_apply xHomogeneous) + +/-- LM24, Proposition 6.2.1: nonzero factors of a product lying in degree RV also lie in +degree RV. -/ +theorem hahnDegreeRV_factors_of_mul_mem {B C : DegreeGraded K} + (hB : B ≠ 0) (hC : C ≠ 0) + (hBC : B * C ∈ (degreeValuation K).homogeneousClasses) : + B ∈ (degreeValuation K).homogeneousClasses ∧ + C ∈ (degreeValuation K).homogeneousClasses := by + exact (degreeValuation K).mem_homogeneousClasses_of_mul_mem + hB hC hBC + +/-- The `P̂` clause of LM24, Corollary 6.2.2: nonzero factors of a componentwise-principal +product are componentwise principal. -/ +theorem hahnDegreePrincipalGraded_factors_of_mul_mem {B C : DegreeGraded K} + (hB : B ≠ 0) (hC : C ≠ 0) + (hBC : IsPrincipalGraded (B * C)) : + IsPrincipalGraded B ∧ IsPrincipalGraded C := by + have hFactors := factors_mem_principalGradedSubalgebra_of_mul_mem hB hC + ((mem_principalGradedSubalgebra_iff (B * C)).mpr hBC) + exact ⟨(mem_principalGradedSubalgebra_iff B).mp hFactors.1, + (mem_principalGradedSubalgebra_iff C).mp hFactors.2⟩ + +/-- The `P` clause of LM24, Corollary 6.2.2: nonzero factors of a product in the image of the +principal RV classes also lie in that image. -/ +theorem hahnDegreePrincipalRVImage_factors_of_mul_mem {B C : DegreeGraded K} + (hB : B ≠ 0) (hC : C ≠ 0) + (hBC : IsPrincipalRVImage (B * C)) : + IsPrincipalRVImage B ∧ IsPrincipalRVImage C := by + have hBC' := (isPrincipalRVImage_iff (B * C)).mp hBC + have hHomogeneous := hahnDegreeRV_factors_of_mul_mem hB hC hBC'.2.1 + have hPrincipal := hahnDegreePrincipalGraded_factors_of_mul_mem hB hC hBC'.2.2 + exact ⟨(isPrincipalRVImage_iff B).mpr + ⟨hB, hHomogeneous.1, hPrincipal.1⟩, + (isPrincipalRVImage_iff C).mpr + ⟨hC, hHomogeneous.2, hPrincipal.2⟩⟩ + +/-- The first clause of LM24, Corollary 6.2.3: divisibility in degree RV agrees with +divisibility after the canonical embedding into the degree-graded ring. -/ +theorem hahnDegreeRV_dvd_iff_associatedGraded_dvd (B C : HahnDegreeRV K) : + B ∣ C ↔ + (degreeValuation K).rvInitialFormHom B ∣ + (degreeValuation K).rvInitialFormHom C := by + exact (degreeValuation K).rv_dvd_iff_associatedGraded_dvd B C + +/-- The finite-support clause of LM24, Corollary 6.2.3: ambient graded divisibility between +finite-support classes is exactly divisibility in the finite-support Hahn-series ring. -/ +theorem finiteSupportGradedEmbedding_dvd_iff (p q : FiniteSupportRing (K := K)) : + finiteSupportGradedEmbedding K p ∣ finiteSupportGradedEmbedding K q ↔ + p ∣ q := by + let w := degreeValuation K + constructor + · intro hpq + have hpqHomogeneous : + finiteSupportHomogeneousClass p ∣ + finiteSupportHomogeneousClass q := + (w.homogeneous_dvd_iff_associatedGraded_dvd + (finiteSupportHomogeneousClass p) + (finiteSupportHomogeneousClass q)).mpr (by + simpa only [coe_finiteSupportHomogeneousClass] using hpq) + have hqHomogeneous : + finiteSupportHomogeneousClass q = + degreeHomogeneousClass 0 + (degreeFiniteSupportResidueEquiv K q) := by + apply Subtype.ext + rw [coe_finiteSupportHomogeneousClass, coe_degreeHomogeneousClass, + finiteSupportGradedEmbedding_apply] + have hScalar : ∃ C : w.Component 0, + degreeFiniteSupportResidueEquiv K p • C = + degreeFiniteSupportResidueEquiv K q := + (finiteSupportHomogeneousClass_dvd_degreeHomogeneousClass_iff p 0 + (degreeFiniteSupportResidueEquiv K q)).mp (by + rw [← hqHomogeneous] + exact hpqHomogeneous) + obtain ⟨C, hC⟩ := hScalar + let e := degreeFiniteSupportResidueEquiv K + refine ⟨e.symm C, ?_⟩ + apply e.injective + rw [map_mul, e.apply_symm_apply] + simpa only [smul_eq_mul] using hC.symm + · exact map_dvd (finiteSupportGradedEmbedding K) + +/-- LM24, Proposition 6.2.4: an RV class divides a graded element if and only if it divides +every homogeneous component. -/ +theorem hahnDegreeRV_dvd_iff_dvd_components + (B : HahnDegreeRV K) (C : DegreeGraded K) : + (degreeValuation K).rvInitialFormHom B ∣ C ↔ + ∀ α, + (degreeValuation K).rvInitialFormHom B ∣ + DirectSum.of (degreeValuation K).Component α (C α) := by + exact (degreeValuation K).rv_dvd_iff_dvd_components B C + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/InfiniteSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/InfiniteSupport.lean new file mode 100644 index 0000000000..13dc96a195 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/InfiniteSupport.lean @@ -0,0 +1,298 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeTermCount +public import Mathlib.Algebra.Group.Irreducible.Defs + +/-! +# Factorisation after removing finite-support divisors + +This module proves the conditional core of LM24, Proposition 5.6.1. A Hahn series with no +nonunit finite-support divisor factors into a nonzero scalar and a finite list of irreducible +series with infinite support. Well-founded induction on degree gives the factorisation, while +additivity of the uncompressed Cantor term count gives the sharp numerical upper bound. + +For an arbitrary nonzero series `b`, division by its normalized maximal finite-support divisor +`p(b)` produces a residual with the required divisor property. The resulting theorem retains +the nonzeroness of the scalar, although the printed proposition does not state that consequence. + +Pairwise greatest-common-divisor existence and the classification of units in the +finite-support ring remain explicit hypotheses. They are not hidden in instances. The coefficient +field has characteristic zero. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [CharZero K] + +/-- A Hahn series has only unit finite-support divisors. This is the intrinsic property of the +residual after removing its maximal finite-support divisor. -/ +def HasOnlyUnitFiniteSupportDivisors (b : Series K) : Prop := + ∀ p : FiniteSupportRing (K := K), (p : Series K) ∣ b → IsUnit p + +omit [CharZero K] in +/-- Characterization of having only unit finite-support divisors. -/ +theorem hasOnlyUnitFiniteSupportDivisors_iff (b : Series K) : + HasOnlyUnitFiniteSupportDivisors b ↔ + ∀ p : FiniteSupportRing (K := K), (p : Series K) ∣ b → IsUnit p := + Iff.rfl + +omit [CharZero K] in +/-- Every divisor of a series with only unit finite-support divisors has the same property. -/ +theorem HasOnlyUnitFiniteSupportDivisors.of_dvd + {b c : Series K} (hb : HasOnlyUnitFiniteSupportDivisors b) (hcb : c ∣ b) : + HasOnlyUnitFiniteSupportDivisors c := by + intro p hpc + exact hb p (dvd_trans hpc hcb) + +omit [CharZero K] in +private theorem series_coe_ne_zero {b : Series K} (hb : b ≠ 0) : + (b : K⟦ℝ⟧) ≠ 0 := by + intro hzero + apply hb + exact Subtype.ext hzero + +omit [CharZero K] in +/-- A nonunit series with only unit finite-support divisors has infinite support. -/ +theorem HasOnlyUnitFiniteSupportDivisors.support_infinite_of_not_isUnit + {b : Series K} (hb : HasOnlyUnitFiniteSupportDivisors b) + (hbUnit : ¬IsUnit b) : + (b : K⟦ℝ⟧).support.Infinite := by + by_contra hInfinite + have hFinite : (b : K⟦ℝ⟧).support.Finite := Set.not_infinite.mp hInfinite + let p : FiniteSupportRing (K := K) := ⟨b, by + rw [HahnSeries.Nonpositive.mem_finiteSupportSubring_iff] + exact hFinite⟩ + have hpDvd : (p : Series K) ∣ b := ⟨1, by simp [p]⟩ + have hpUnit : IsUnit p := hb p hpDvd + apply hbUnit + change IsUnit (p : Series K) + exact hpUnit.map + (HahnSeries.Nonpositive.finiteSupportSubring + (G := ℝ) (K := K)).subtype + +/-- A nonzero series with only unit finite-support divisors factors into a nonzero scalar and +irreducible infinite-support series, with the number of factors bounded by the Cantor term count +of its degree. -/ +theorem HasOnlyUnitFiniteSupportDivisors.exists_factorization + (hunits : ∀ p : FiniteSupportRing (K := K), + IsUnit p ↔ ∃ k : K, k ≠ 0 ∧ + p = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k) + {b : Series K} (hb : b ≠ 0) + (hbPrimitive : HasOnlyUnitFiniteSupportDivisors b) : + ∃ (k : K) (factors : List (Series K)), + k ≠ 0 ∧ b = HahnSeries.Nonpositive.C k * factors.prod ∧ + (∀ c ∈ factors, + Irreducible c ∧ (c : K⟦ℝ⟧).support.Infinite) ∧ + factors.length ≤ HahnSeries.degreeCantorTermCount (b : K⟦ℝ⟧) := by + classical + let wf : WellFounded (Function.onFun (fun α β : WithBot NatOrdinal ↦ α < β) + (fun c : Series K ↦ (c : K⟦ℝ⟧).degree)) := + wellFounded_lt.onFun + refine wf.induction + (C := fun b ↦ b ≠ 0 → HasOnlyUnitFiniteSupportDivisors b → + ∃ (k : K) (factors : List (Series K)), + k ≠ 0 ∧ b = HahnSeries.Nonpositive.C k * factors.prod ∧ + (∀ c ∈ factors, + Irreducible c ∧ (c : K⟦ℝ⟧).support.Infinite) ∧ + factors.length ≤ + HahnSeries.degreeCantorTermCount (b : K⟦ℝ⟧)) b ?_ hb hbPrimitive + intro b ih hb hbPrimitive + by_cases hbDegree : (b : K⟦ℝ⟧).degree ≤ 0 + · have hbFinite : (b : K⟦ℝ⟧).support.Finite := + HahnSeries.degree_le_zero_iff.mp hbDegree + let p : FiniteSupportRing (K := K) := ⟨b, by + rw [HahnSeries.Nonpositive.mem_finiteSupportSubring_iff] + exact hbFinite⟩ + have hpDvd : (p : Series K) ∣ b := ⟨1, by simp [p]⟩ + obtain ⟨k, hk, hpk⟩ := (hunits p).mp (hbPrimitive p hpDvd) + refine ⟨k, [], hk, ?_, ?_, ?_⟩ + · rw [List.prod_nil, mul_one] + apply Subtype.ext + simpa only [p, HahnSeries.Nonpositive.coe_C, + HahnSeries.Nonpositive.coe_finiteSupportScalarHom] using congrArg + (fun q : FiniteSupportRing (K := K) ↦ + ((q : Series K) : K⟦ℝ⟧)) hpk + · simp + · simp + · have hbDegreePos : 0 < (b : K⟦ℝ⟧).degree := lt_of_not_ge hbDegree + have hbNotUnit : ¬IsUnit b := by + intro hbUnit + exact (not_le_of_gt hbDegreePos) + (HahnSeries.Nonpositive.degree_eq_zero_of_isUnit + HahnSeries.Nonpositive.degree_mul hbUnit).le + rcases irreducible_or_factor hbNotUnit with hbIrreducible | ⟨c, d, hcUnit, hdUnit, hfactor⟩ + · refine ⟨1, [b], one_ne_zero, ?_, ?_, ?_⟩ + · simp + · simp only [List.mem_singleton, forall_eq] + exact ⟨hbIrreducible, + HahnSeries.degree_pos_iff_support_infinite.mp hbDegreePos⟩ + · exact HahnSeries.degreeCantorTermCount_pos_of_degree_pos hbDegreePos + · have hc : c ≠ 0 := by + intro hc + apply hb + rw [hfactor, hc, zero_mul] + have hd : d ≠ 0 := by + intro hd + apply hb + rw [hfactor, hd, mul_zero] + have hcPrimitive := hbPrimitive.of_dvd ⟨d, hfactor⟩ + have hdPrimitive := hbPrimitive.of_dvd ⟨c, by + rw [mul_comm] + exact hfactor⟩ + have hcInfinite := hcPrimitive.support_infinite_of_not_isUnit hcUnit + have hdInfinite := hdPrimitive.support_infinite_of_not_isUnit hdUnit + have hcDegreePos : 0 < (c : K⟦ℝ⟧).degree := + HahnSeries.degree_pos_iff_support_infinite.mpr hcInfinite + have hdDegreePos : 0 < (d : K⟦ℝ⟧).degree := + HahnSeries.degree_pos_iff_support_infinite.mpr hdInfinite + have hcDegreeLt : (c : K⟦ℝ⟧).degree < (b : K⟦ℝ⟧).degree := by + calc + (c : K⟦ℝ⟧).degree < + (c : K⟦ℝ⟧).degree + (d : K⟦ℝ⟧).degree := + calc + (c : K⟦ℝ⟧).degree = + (c : K⟦ℝ⟧).degree + 0 := (add_zero _).symm + _ < (c : K⟦ℝ⟧).degree + (d : K⟦ℝ⟧).degree := + WithBot.add_lt_add_left + (HahnSeries.degree_eq_bot.not.mpr (series_coe_ne_zero hc)) + hdDegreePos + _ = ((c * d : Series K) : K⟦ℝ⟧).degree := + (HahnSeries.Nonpositive.degree_mul c d).symm + _ = (b : K⟦ℝ⟧).degree := congrArg + (fun q : Series K ↦ (q : K⟦ℝ⟧).degree) hfactor.symm + have hdDegreeLt : (d : K⟦ℝ⟧).degree < (b : K⟦ℝ⟧).degree := by + calc + (d : K⟦ℝ⟧).degree < + (c : K⟦ℝ⟧).degree + (d : K⟦ℝ⟧).degree := + calc + (d : K⟦ℝ⟧).degree = + 0 + (d : K⟦ℝ⟧).degree := (zero_add _).symm + _ < (c : K⟦ℝ⟧).degree + (d : K⟦ℝ⟧).degree := + WithBot.add_lt_add_right + (HahnSeries.degree_eq_bot.not.mpr (series_coe_ne_zero hd)) + hcDegreePos + _ = ((c * d : Series K) : K⟦ℝ⟧).degree := + (HahnSeries.Nonpositive.degree_mul c d).symm + _ = (b : K⟦ℝ⟧).degree := congrArg + (fun q : Series K ↦ (q : K⟦ℝ⟧).degree) hfactor.symm + obtain ⟨kc, cs, hkc, hcFactor, hcs, hcsBound⟩ := + ih c hcDegreeLt hc hcPrimitive + obtain ⟨kd, ds, hkd, hdFactor, hds, hdsBound⟩ := + ih d hdDegreeLt hd hdPrimitive + refine ⟨kc * kd, cs ++ ds, mul_ne_zero hkc hkd, ?_, ?_, ?_⟩ + · rw [hfactor, hcFactor, hdFactor, List.prod_append, + map_mul, mul_assoc] + ring + · intro q hq + rw [List.mem_append] at hq + exact hq.elim (hcs q) (hds q) + · rw [List.length_append] + calc + cs.length + ds.length ≤ + HahnSeries.degreeCantorTermCount (c : K⟦ℝ⟧) + + HahnSeries.degreeCantorTermCount (d : K⟦ℝ⟧) := + Nat.add_le_add hcsBound hdsBound + _ = HahnSeries.degreeCantorTermCount ((c * d : Series K) : K⟦ℝ⟧) := by + symm + apply HahnSeries.degreeCantorTermCount_mul + · simpa using HahnSeries.Nonpositive.degree_mul c d + · exact series_coe_ne_zero hc + · exact series_coe_ne_zero hd + _ = HahnSeries.degreeCantorTermCount (b : K⟦ℝ⟧) := by + rw [← hfactor] + +/-- Dividing a nonzero series by its normalized maximal finite-support divisor leaves only unit +finite-support divisors. -/ +theorem hasOnlyUnitFiniteSupportDivisors_residual (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + {b q : Series K} (hb : b ≠ 0) + (hq : b = + (seriesNormalizedMaximalFiniteSupportDivisor b : Series K) * q) : + HasOnlyUnitFiniteSupportDivisors q := by + let p := seriesNormalizedMaximalFiniteSupportDivisor b + have hpSpec := (isNormalizedSeriesMaximalFiniteSupportDivisor_iff b p).mp + (seriesNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd b) + have hpNe : p ≠ 0 := + (seriesNormalizedMaximalFiniteSupportDivisor_isMonic_of_ne_zero hgcd hb).ne_zero + intro r hrq + obtain ⟨s, hs⟩ := hrq + let pr : FiniteSupportRing (K := K) := p * r + have hprDvdB : (pr : Series K) ∣ b := by + refine ⟨s, ?_⟩ + rw [hq, hs] + simp only [pr, p, Subring.coe_mul, mul_assoc] + have hprDvdP : pr ∣ p := (hpSpec.1 pr).mp hprDvdB + obtain ⟨t, ht⟩ := hprDvdP + apply isUnit_iff_exists.mpr + have hrt : r * t = 1 := by + apply mul_left_cancel₀ hpNe + calc + p * (r * t) = (p * r) * t := (mul_assoc _ _ _).symm + _ = p := ht.symm + _ = p * 1 := (mul_one p).symm + exact ⟨t, hrt, by simpa only [mul_comm] using hrt⟩ + +/-- Conditional strengthened form of LM24, Proposition 5.6.1, retaining that the scalar is +nonzero. -/ +theorem exists_series_infinite_support_factorization_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hunits : ∀ p : FiniteSupportRing (K := K), + IsUnit p ↔ ∃ k : K, k ≠ 0 ∧ + p = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k) + {b : Series K} (hb : b ≠ 0) : + ∃ (k : K) (factors : List (Series K)), + k ≠ 0 ∧ + b = HahnSeries.Nonpositive.C k * + (seriesNormalizedMaximalFiniteSupportDivisor b : Series K) * + factors.prod ∧ + (∀ c ∈ factors, + Irreducible c ∧ (c : K⟦ℝ⟧).support.Infinite) ∧ + factors.length ≤ HahnSeries.degreeCantorTermCount (b : K⟦ℝ⟧) := by + let p := seriesNormalizedMaximalFiniteSupportDivisor b + have hpDvd : (p : Series K) ∣ b := + seriesNormalizedMaximalFiniteSupportDivisor_dvd_of_exists_gcd hgcd b + obtain ⟨q, hq⟩ := hpDvd + have hqNe : q ≠ 0 := by + intro hzero + apply hb + rw [hq, hzero, mul_zero] + have hqPrimitive : HasOnlyUnitFiniteSupportDivisors q := + hasOnlyUnitFiniteSupportDivisors_residual hgcd hb hq + obtain ⟨k, factors, hk, hqFactor, hfactors, hbound⟩ := + hqPrimitive.exists_factorization hunits hqNe + refine ⟨k, factors, hk, ?_, hfactors, ?_⟩ + · change b = HahnSeries.Nonpositive.C k * (p : Series K) * factors.prod + rw [hq, hqFactor] + ring + · apply hbound.trans_eq + apply HahnSeries.degreeCantorTermCount_congr + rw [hq, HahnSeries.Nonpositive.degree_mul] + have hpNe : p ≠ 0 := + (seriesNormalizedMaximalFiniteSupportDivisor_isMonic_of_ne_zero hgcd hb).ne_zero + have hpSeriesNe : (p : Series K) ≠ 0 := by + intro hzero + exact hpNe (Subtype.ext hzero) + have hpHahnNe : (p : K⟦ℝ⟧) ≠ 0 := + series_coe_ne_zero hpSeriesNe + rw [HahnSeries.degree_eq_zero.mpr ⟨hpHahnNe, + (HahnSeries.Nonpositive.mem_finiteSupportSubring_iff (p : Series K)).mp p.2⟩, + zero_add] + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFinite.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFinite.lean new file mode 100644 index 0000000000..f9c4f111cf --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFinite.lean @@ -0,0 +1,597 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.MaximalDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.Content + +/-! +# Maximal finite-support divisors in the degree-graded ring + +This module constructs the intrinsic associate classes underlying LM24, Proposition 5.4.3, +Corollary 5.4.4, and Proposition 5.4.8. For a homogeneous component or for the full +degree-graded ring, a class is characterized by the equivalence + +`q divides the class ↔ Associates.mk q divides the maximal associate class`. + +The construction transports the basis-independent content of a tensor through the componentwise +and global tensor equivalences. A basis is therefore used only inside the generic existence proof; +it does not occur in any definition in this module. Pairwise gcd existence is an explicit theorem +hypothesis. It is neither installed as a typeclass nor incorporated into the primitive +definitions. + +The paper's representative-valued normalization and its exact statements in the RV monoid are +kept separate from this associate-class core. +-/ + +open scoped DirectSum HahnSeries NatOrdinal TensorProduct + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [CharZero K] + +/-- Multiplication on the finite-support tensor factor agrees with the residue-ring action on a +fixed component of `RV̂`. -/ +theorem principalComponentTensorEquiv_mulRightFactor + (α : NatOrdinal) (q : FiniteSupportRing (K := K)) + (z : PrincipalComponent K α ⊗[K] FiniteSupportRing (K := K)) : + principalComponentTensorEquiv K α + (TensorProduct.mulRightFactor q z) = + HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K q • + principalComponentTensorEquiv K α z := by + induction z using TensorProduct.induction_on with + | zero => + rw [(TensorProduct.mulRightFactor (K := K) q).map_zero, + (principalComponentTensorEquiv K α).map_zero, smul_zero] + | tmul x p => + rw [TensorProduct.mulRightFactor_tmul, + principalComponentTensorEquiv_tmul, + principalComponentTensorEquiv_tmul, map_mul] + exact degreeResidue_smul_smul α _ _ _ + | add x y hx hy => + rw [(TensorProduct.mulRightFactor (K := K) q).map_add, + (principalComponentTensorEquiv K α).map_add, + (principalComponentTensorEquiv K α).map_add, hx, hy] + exact (smul_add + (HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K q) + (principalComponentTensorEquiv K α x) + (principalComponentTensorEquiv K α y)).symm + +/-- Multiplication on the finite-support tensor factor agrees with multiplication by the +grade-zero finite-support embedding in the associated graded ring. -/ +theorem principalSubringTensorEquiv_mulRightFactor (q : FiniteSupportRing (K := K)) + (z : PrincipalSubring K ⊗[K] FiniteSupportRing (K := K)) : + principalSubringTensorEquiv K + (TensorProduct.mulRightFactor q z) = + finiteSupportGradedEmbedding K q * + principalSubringTensorEquiv K z := by + induction z using TensorProduct.induction_on with + | zero => + calc + principalSubringTensorEquiv K + (TensorProduct.mulRightFactor q 0) = + principalSubringTensorEquiv K 0 := + congrArg (principalSubringTensorEquiv K) + ((TensorProduct.mulRightFactor (K := K) q).map_zero) + _ = 0 := map_zero (principalSubringTensorEquiv K) + _ = finiteSupportGradedEmbedding K q * 0 := + (mul_zero _).symm + _ = finiteSupportGradedEmbedding K q * + principalSubringTensorEquiv K 0 := + congrArg (finiteSupportGradedEmbedding K q * ·) + (map_zero (principalSubringTensorEquiv K)).symm + | tmul x p => + rw [TensorProduct.mulRightFactor_tmul, + principalSubringTensorEquiv_tmul, + principalSubringTensorEquiv_tmul, map_mul] + ac_rfl + | add x y hx hy => + calc + principalSubringTensorEquiv K + (TensorProduct.mulRightFactor q (x + y)) = + principalSubringTensorEquiv K + (TensorProduct.mulRightFactor q x + + TensorProduct.mulRightFactor q y) := + congrArg (principalSubringTensorEquiv K) + ((TensorProduct.mulRightFactor (K := K) q).map_add x y) + _ = principalSubringTensorEquiv K + (TensorProduct.mulRightFactor q x) + + principalSubringTensorEquiv K + (TensorProduct.mulRightFactor q y) := + map_add (principalSubringTensorEquiv K) _ _ + _ = finiteSupportGradedEmbedding K q * + principalSubringTensorEquiv K x + + finiteSupportGradedEmbedding K q * + principalSubringTensorEquiv K y := + congrArg₂ (· + ·) hx hy + _ = finiteSupportGradedEmbedding K q * + (principalSubringTensorEquiv K x + + principalSubringTensorEquiv K y) := + (mul_add _ _ _).symm + _ = finiteSupportGradedEmbedding K q * + principalSubringTensorEquiv K (x + y) := + congrArg (finiteSupportGradedEmbedding K q * ·) + (map_add (principalSubringTensorEquiv K) x y).symm + +/-- An associate class records exactly the finite-support divisors of a fixed homogeneous +component of `RV̂`. -/ +def IsLayerMaximalFiniteSupportDivisor (α : NatOrdinal) + (B : (HahnSeries.Nonpositive.degreeValuation K).Component α) + (a : Associates (FiniteSupportRing (K := K))) : Prop := + ∀ q : FiniteSupportRing (K := K), Associates.mk q ≤ a ↔ + ∃ C : (HahnSeries.Nonpositive.degreeValuation K).Component α, + HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K q • C = B + +omit [CharZero K] in +/-- The defining divisibility characterization for a fixed homogeneous component. -/ +theorem isLayerMaximalFiniteSupportDivisor_iff (α : NatOrdinal) + (B : (HahnSeries.Nonpositive.degreeValuation K).Component α) + (a : Associates (FiniteSupportRing (K := K))) : + IsLayerMaximalFiniteSupportDivisor α B a ↔ + ∀ q : FiniteSupportRing (K := K), Associates.mk q ≤ a ↔ + ∃ C : + (HahnSeries.Nonpositive.degreeValuation K).Component α, + HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K q • C = B := + Iff.rfl + +/-- An associate class records exactly the divisors of a graded element that arise from the +finite-support subring in grade zero. -/ +def IsGradedMaximalFiniteSupportDivisor (B : DegreeGraded K) + (a : Associates (FiniteSupportRing (K := K))) : Prop := + IsMaximalDivisorAlong + (finiteSupportGradedEmbedding K).toMonoidHom B a + +omit [CharZero K] in +/-- The defining divisibility characterization for an element of the associated graded ring. -/ +theorem isGradedMaximalFiniteSupportDivisor_iff (B : DegreeGraded K) + (a : Associates (FiniteSupportRing (K := K))) : + IsGradedMaximalFiniteSupportDivisor B a ↔ + ∀ q : FiniteSupportRing (K := K), Associates.mk q ≤ a ↔ + (finiteSupportGradedEmbedding K).toMonoidHom q ∣ B := by + rw [IsGradedMaximalFiniteSupportDivisor, + isMaximalDivisorAlong_iff] + +omit [CharZero K] in +/-- Representative form of the maximal-divisor characterization used in LM24, +Corollary 5.4.4. -/ +theorem isGradedMaximalFiniteSupportDivisor_mk_iff (B : DegreeGraded K) + (p : FiniteSupportRing (K := K)) : + IsGradedMaximalFiniteSupportDivisor B (Associates.mk p) ↔ + ∀ q : FiniteSupportRing (K := K), + finiteSupportGradedEmbedding K q ∣ B ↔ q ∣ p := by + rw [isGradedMaximalFiniteSupportDivisor_iff] + constructor + · intro h q + constructor + · intro hqB + exact Associates.mk_le_mk_iff_dvd.mp ((h q).mpr hqB) + · intro hqp + exact (h q).mp (Associates.mk_le_mk_iff_dvd.mpr hqp) + · intro h q + constructor + · intro hqp + exact (h q).mpr (Associates.mk_le_mk_iff_dvd.mp hqp) + · intro hqB + exact Associates.mk_le_mk_iff_dvd.mpr ((h q).mp hqB) + +/-- The maximal-divisor predicate on a homogeneous component is the intrinsic tensor-content +predicate transported through the homogeneous-component equivalence. -/ +theorem isContent_principalComponentTensorEquiv_symm_iff (α : NatOrdinal) + (B : (HahnSeries.Nonpositive.degreeValuation K).Component α) + (a : Associates (FiniteSupportRing (K := K))) : + TensorProduct.IsContent + ((principalComponentTensorEquiv K α).symm B) a ↔ + IsLayerMaximalFiniteSupportDivisor α B a := by + rw [TensorProduct.isContent_iff, + isLayerMaximalFiniteSupportDivisor_iff] + constructor + · intro h q + rw [h q] + constructor + · rintro ⟨z, hz⟩ + refine ⟨principalComponentTensorEquiv K α z, ?_⟩ + rw [← principalComponentTensorEquiv_mulRightFactor, + hz, LinearEquiv.apply_symm_apply] + · rintro ⟨C, hC⟩ + refine ⟨(principalComponentTensorEquiv K α).symm C, ?_⟩ + apply (principalComponentTensorEquiv K α).injective + rw [principalComponentTensorEquiv_mulRightFactor, + LinearEquiv.apply_symm_apply, LinearEquiv.apply_symm_apply, hC] + · intro h q + rw [h q] + constructor + · rintro ⟨C, hC⟩ + refine ⟨(principalComponentTensorEquiv K α).symm C, ?_⟩ + apply (principalComponentTensorEquiv K α).injective + rw [principalComponentTensorEquiv_mulRightFactor, + LinearEquiv.apply_symm_apply, LinearEquiv.apply_symm_apply, hC] + · rintro ⟨z, hz⟩ + refine ⟨principalComponentTensorEquiv K α z, ?_⟩ + rw [← principalComponentTensorEquiv_mulRightFactor, + hz, LinearEquiv.apply_symm_apply] + +/-- Multiplying a nonzero principal fixed-degree class by a finite-support series gives a class +whose maximal finite-support divisor is represented by that finite-support series. -/ +theorem isLayerMaximalFiniteSupportDivisor_finiteSupport_mul_principal + (α : NatOrdinal) (p : FiniteSupportRing (K := K)) (a : Series K) + (ha : HahnSeries.Nonpositive.IsPrincipal a) + (haDegree : (a : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) : + IsLayerMaximalFiniteSupportDivisor α + (degreeLayerMk α ((p : Series K) * a) (by + rw [HahnSeries.Nonpositive.degree_mul, haDegree] + exact add_le_of_nonpos_left (HahnSeries.degree_le_zero_iff.mpr + ((HahnSeries.Nonpositive.mem_finiteSupportSubring_iff + (p : Series K)).mp p.2)))) + (Associates.mk p) := by + let C := degreeLayerMk α a haDegree.le + have hCPrincipal : IsPrincipalDegreeClass α C := by + rw [isPrincipalDegreeClass_iff] + exact Or.inr ⟨a, ha, haDegree, rfl⟩ + let x := degreeLayerToPrincipalComponent K α C + have hxImage : principalComponentToHahnDegreeLayer K α x = C := + principalComponentToHahnDegreeLayer_degreeLayerToPrincipalComponent_of_isPrincipal + α C hCPrincipal + have hC : C ≠ 0 := by + intro hzero + have hlt := (degreeLayerMk_eq_zero_iff α a haDegree.le).mp hzero + rw [haDegree] at hlt + exact lt_irrefl _ hlt + have hx : x ≠ 0 := by + intro hzero + apply hC + rw [← hxImage, hzero, map_zero] + have heq : + principalComponentTensorEquiv K α (x ⊗ₜ[K] p) = + degreeLayerMk α ((p : Series K) * a) (by + rw [HahnSeries.Nonpositive.degree_mul, haDegree] + exact add_le_of_nonpos_left (HahnSeries.degree_le_zero_iff.mpr + ((HahnSeries.Nonpositive.mem_finiteSupportSubring_iff + (p : Series K)).mp p.2))) := by + rw [principalComponentTensorEquiv_tmul, hxImage] + exact degreeFiniteSupportResidueEquiv_smul_degreeLayerMk α p a haDegree.le + apply (isContent_principalComponentTensorEquiv_symm_iff α _ (Associates.mk p)).mp + rw [← heq, LinearEquiv.symm_apply_apply] + exact TensorProduct.isContent_tmul_of_ne_zero x hx p + +/-- The graded maximal-divisor predicate is intrinsic tensor content transported through the +global tensor equivalence. -/ +theorem isContent_principalGradedTensorEquiv_symm_iff (B : DegreeGraded K) + (a : Associates (FiniteSupportRing (K := K))) : + TensorProduct.IsContent + ((principalSubringTensorEquiv K).symm B) a ↔ + IsGradedMaximalFiniteSupportDivisor B a := by + rw [TensorProduct.isContent_iff, + isGradedMaximalFiniteSupportDivisor_iff] + constructor + · intro h q + rw [h q] + constructor + · rintro ⟨z, hz⟩ + refine ⟨principalSubringTensorEquiv K z, ?_⟩ + change B = finiteSupportGradedEmbedding K q * + principalSubringTensorEquiv K z + rw [← principalSubringTensorEquiv_mulRightFactor, + hz, AlgEquiv.apply_symm_apply] + · rintro ⟨C, hC⟩ + change B = finiteSupportGradedEmbedding K q * C at hC + refine ⟨(principalSubringTensorEquiv K).symm C, ?_⟩ + apply (principalSubringTensorEquiv K).injective + rw [principalSubringTensorEquiv_mulRightFactor, + AlgEquiv.apply_symm_apply, AlgEquiv.apply_symm_apply] + exact hC.symm + · intro h q + rw [h q] + constructor + · rintro ⟨C, hC⟩ + change B = finiteSupportGradedEmbedding K q * C at hC + refine ⟨(principalSubringTensorEquiv K).symm C, ?_⟩ + apply (principalSubringTensorEquiv K).injective + rw [principalSubringTensorEquiv_mulRightFactor, + AlgEquiv.apply_symm_apply, AlgEquiv.apply_symm_apply] + exact hC.symm + · rintro ⟨z, hz⟩ + refine ⟨principalSubringTensorEquiv K z, ?_⟩ + change B = finiteSupportGradedEmbedding K q * + principalSubringTensorEquiv K z + rw [← principalSubringTensorEquiv_mulRightFactor, + hz, AlgEquiv.apply_symm_apply] + +/-- A finite-support series, embedded in grade zero, is its own maximal finite-support +divisor. -/ +theorem isGradedMaximalFiniteSupportDivisor_finiteSupport (p : FiniteSupportRing (K := K)) : + IsGradedMaximalFiniteSupportDivisor + (finiteSupportGradedEmbedding K p) (Associates.mk p) := by + apply (isContent_principalGradedTensorEquiv_symm_iff _ (Associates.mk p)).mp + rw [← principalSubringTensorEquiv_one_tmul p, + AlgEquiv.symm_apply_apply] + have hOne : (1 : PrincipalSubring K) ≠ 0 := by + intro hzero + have htarget : (1 : DegreeGraded K) = 0 := by + rw [← map_one (principalSubringEmbedding K), + ← map_zero (principalSubringEmbedding K), hzero] + have hfinite : + finiteSupportGradedEmbedding K + (1 : FiniteSupportRing (K := K)) = + finiteSupportGradedEmbedding K 0 := by + calc + finiteSupportGradedEmbedding K + (1 : FiniteSupportRing (K := K)) = 1 := + map_one (finiteSupportGradedEmbedding K) + _ = 0 := htarget + _ = finiteSupportGradedEmbedding K 0 := + (map_zero (finiteSupportGradedEmbedding K)).symm + exact one_ne_zero (finiteSupportGradedEmbedding_injective K hfinite) + exact TensorProduct.isContent_tmul_of_ne_zero + (1 : PrincipalSubring K) hOne p + +/-- Multiplying a nonzero principal fixed-degree class by a finite-support series gives a +homogeneous graded class whose maximal finite-support divisor is represented by that series. -/ +theorem isGradedMaximalFiniteSupportDivisor_finiteSupport_mul_principal + (α : NatOrdinal) (p : FiniteSupportRing (K := K)) (a : Series K) + (ha : HahnSeries.Nonpositive.IsPrincipal a) + (haDegree : (a : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) : + IsGradedMaximalFiniteSupportDivisor + (DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component + α + (degreeLayerMk α ((p : Series K) * a) (by + rw [HahnSeries.Nonpositive.degree_mul, haDegree] + exact add_le_of_nonpos_left (HahnSeries.degree_le_zero_iff.mpr + ((HahnSeries.Nonpositive.mem_finiteSupportSubring_iff + (p : Series K)).mp p.2))))) + (Associates.mk p) := by + let C := degreeLayerMk α a haDegree.le + have hCPrincipal : IsPrincipalDegreeClass α C := by + rw [isPrincipalDegreeClass_iff] + exact Or.inr ⟨a, ha, haDegree, rfl⟩ + let x := degreeLayerToPrincipalComponent K α C + have hxImage : principalComponentToHahnDegreeLayer K α x = C := + principalComponentToHahnDegreeLayer_degreeLayerToPrincipalComponent_of_isPrincipal + α C hCPrincipal + have hC : C ≠ 0 := by + intro hzero + have hlt := (degreeLayerMk_eq_zero_iff α a haDegree.le).mp hzero + rw [haDegree] at hlt + exact lt_irrefl _ hlt + have hx : x ≠ 0 := by + intro hzero + apply hC + rw [← hxImage, hzero, map_zero] + let X : PrincipalSubring K := + DirectSum.of (PrincipalComponent K) α x + have hX : X ≠ 0 := by + intro hzero + apply hx + exact DirectSum.of_injective α (by simpa [X] using hzero) + have heq : + principalSubringTensorEquiv K (X ⊗ₜ[K] p) = + DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component + α + (degreeLayerMk α ((p : Series K) * a) (by + rw [HahnSeries.Nonpositive.degree_mul, haDegree] + exact add_le_of_nonpos_left (HahnSeries.degree_le_zero_iff.mpr + ((HahnSeries.Nonpositive.mem_finiteSupportSubring_iff + (p : Series K)).mp p.2)))) := by + rw [principalSubringTensorEquiv_tmul, show X = + DirectSum.of (PrincipalComponent K) α x by rfl, + principalSubringEmbedding_of, hxImage, mul_comm, + finiteSupportGradedEmbedding_mul_of] + exact congrArg + (DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component + α) + (degreeFiniteSupportResidueEquiv_smul_degreeLayerMk α p a haDegree.le) + apply (isContent_principalGradedTensorEquiv_symm_iff _ (Associates.mk p)).mp + rw [← heq, AlgEquiv.symm_apply_apply] + exact TensorProduct.isContent_tmul_of_ne_zero X hX p + +omit [CharZero K] in +/-- A fixed homogeneous component has at most one maximal finite-support divisor class. -/ +theorem IsLayerMaximalFiniteSupportDivisor.eq {α : NatOrdinal} + {B : (HahnSeries.Nonpositive.degreeValuation K).Component α} + {a b : Associates (FiniteSupportRing (K := K))} + (ha : IsLayerMaximalFiniteSupportDivisor α B a) + (hb : IsLayerMaximalFiniteSupportDivisor α B b) : a = b := by + induction a using Quotient.inductionOn with + | _ p => + induction b using Quotient.inductionOn with + | _ q => + apply le_antisymm + · exact (hb p).2 ((ha p).1 le_rfl) + · exact (ha q).2 ((hb q).1 le_rfl) + +omit [CharZero K] in +/-- A graded element has at most one maximal finite-support divisor class. -/ +theorem IsGradedMaximalFiniteSupportDivisor.eq {B : DegreeGraded K} + {a b : Associates (FiniteSupportRing (K := K))} + (ha : IsGradedMaximalFiniteSupportDivisor B a) + (hb : IsGradedMaximalFiniteSupportDivisor B b) : a = b := by + exact IsMaximalDivisorAlong.eq ha hb + +/-- Pairwise gcd existence gives a unique maximal finite-support divisor of every fixed +homogeneous component. -/ +theorem existsUnique_isLayerMaximalFiniteSupportDivisor_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), + e ∣ p ∧ e ∣ q ↔ e ∣ d) + (α : NatOrdinal) + (B : (HahnSeries.Nonpositive.degreeValuation K).Component α) : + ∃! a : Associates (FiniteSupportRing (K := K)), + IsLayerMaximalFiniteSupportDivisor α B a := by + obtain ⟨a, ha, hunique⟩ := + TensorProduct.existsUnique_isContent_of_exists_gcd hgcd + ((principalComponentTensorEquiv K α).symm B) + refine ⟨a, + (isContent_principalComponentTensorEquiv_symm_iff α B a).mp ha, + ?_⟩ + intro b hb + exact hunique b + ((isContent_principalComponentTensorEquiv_symm_iff α B b).mpr hb) + +/-- A principal fixed-degree class has a maximal finite-support divisor represented by a +constant series. -/ +theorem exists_scalar_isLayerMaximalFiniteSupportDivisor_of_isPrincipal (α : NatOrdinal) + (B : (HahnSeries.Nonpositive.degreeValuation K).Component α) + (hB : IsPrincipalDegreeClass α B) : + ∃ k : K, IsLayerMaximalFiniteSupportDivisor α B + (Associates.mk + (HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k)) := by + by_cases hB0 : B = 0 + · subst B + refine ⟨0, ?_⟩ + simpa using + (isContent_principalComponentTensorEquiv_symm_iff α 0 0).mp + (by + simpa using + (TensorProduct.isContent_zero (K := K) + (D := FiniteSupportRing (K := K)) + (V := PrincipalComponent K α))) + · let x := degreeLayerToPrincipalComponent K α B + have hxImage : principalComponentToHahnDegreeLayer K α x = B := + principalComponentToHahnDegreeLayer_degreeLayerToPrincipalComponent_of_isPrincipal α B hB + have hx : x ≠ 0 := by + intro hx0 + apply hB0 + rw [← hxImage, hx0, map_zero] + have hinv : (principalComponentTensorEquiv K α).symm B = + x ⊗ₜ[K] (1 : FiniteSupportRing (K := K)) := by + apply (principalComponentTensorEquiv K α).injective + rw [LinearEquiv.apply_symm_apply, principalComponentTensorEquiv_tmul, + map_one, degreeResidue_one_smul, hxImage] + refine ⟨1, ?_⟩ + have hcontent := TensorProduct.isContent_tmul_one_of_ne_zero + (K := K) (D := FiniteSupportRing (K := K)) x hx + rw [← hinv] at hcontent + simpa using + (isContent_principalComponentTensorEquiv_symm_iff α B 1).mp hcontent + +/-- Pairwise gcd existence gives a unique maximal finite-support divisor of every element of the +degree-graded ring. -/ +theorem existsUnique_isGradedMaximalFiniteSupportDivisor_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), + e ∣ p ∧ e ∣ q ↔ e ∣ d) + (B : DegreeGraded K) : + ∃! a : Associates (FiniteSupportRing (K := K)), + IsGradedMaximalFiniteSupportDivisor B a := by + obtain ⟨a, ha, hunique⟩ := + TensorProduct.existsUnique_isContent_of_exists_gcd hgcd + ((principalSubringTensorEquiv K).symm B) + refine ⟨a, + (isContent_principalGradedTensorEquiv_symm_iff B a).mp ha, + ?_⟩ + intro b hb + exact hunique b + ((isContent_principalGradedTensorEquiv_symm_iff B b).mpr hb) + +/-- The canonical maximal finite-support divisor class of a homogeneous component. + +The fallback branch is unreachable whenever maximal-divisor existence has been established. -/ +noncomputable def layerMaximalFiniteSupportDivisor (α : NatOrdinal) + (B : (HahnSeries.Nonpositive.degreeValuation K).Component α) : + Associates (FiniteSupportRing (K := K)) := by + classical + exact if h : ∃ a : Associates (FiniteSupportRing (K := K)), + IsLayerMaximalFiniteSupportDivisor α B a then + Classical.choose h + else + 0 + +omit [CharZero K] in +/-- Any class satisfying the homogeneous-component characterization is the canonical class. -/ +theorem layerMaximalFiniteSupportDivisor_eq_of_is {α : NatOrdinal} + {B : (HahnSeries.Nonpositive.degreeValuation K).Component α} + {a : Associates (FiniteSupportRing (K := K))} + (ha : IsLayerMaximalFiniteSupportDivisor α B a) : + layerMaximalFiniteSupportDivisor α B = a := by + classical + let hex : ∃ b : Associates (FiniteSupportRing (K := K)), + IsLayerMaximalFiniteSupportDivisor α B b := ⟨a, ha⟩ + rw [layerMaximalFiniteSupportDivisor, dif_pos hex] + exact (Classical.choose_spec hex).eq ha + +/-- Under pairwise gcd existence, the canonical homogeneous class satisfies its defining +characterization. -/ +theorem layerMaximalFiniteSupportDivisor_is_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), + e ∣ p ∧ e ∣ q ↔ e ∣ d) + (α : NatOrdinal) + (B : (HahnSeries.Nonpositive.degreeValuation K).Component α) : + IsLayerMaximalFiniteSupportDivisor α B + (layerMaximalFiniteSupportDivisor α B) := by + obtain ⟨a, ha, _⟩ := + existsUnique_isLayerMaximalFiniteSupportDivisor_of_exists_gcd hgcd α B + rw [layerMaximalFiniteSupportDivisor_eq_of_is ha] + exact ha + +/-- The canonical maximal finite-support divisor class of a graded element. + +The fallback branch is unreachable whenever maximal-divisor existence has been established. -/ +noncomputable def gradedMaximalFiniteSupportDivisor (B : DegreeGraded K) : + Associates (FiniteSupportRing (K := K)) := by + classical + exact if h : ∃ a : Associates (FiniteSupportRing (K := K)), + IsGradedMaximalFiniteSupportDivisor B a then + Classical.choose h + else + 0 + +omit [CharZero K] in +/-- Any class satisfying the graded characterization is the canonical class. -/ +theorem gradedMaximalFiniteSupportDivisor_eq_of_is {B : DegreeGraded K} + {a : Associates (FiniteSupportRing (K := K))} + (ha : IsGradedMaximalFiniteSupportDivisor B a) : + gradedMaximalFiniteSupportDivisor B = a := by + classical + let hex : ∃ b : Associates (FiniteSupportRing (K := K)), + IsGradedMaximalFiniteSupportDivisor B b := ⟨a, ha⟩ + rw [gradedMaximalFiniteSupportDivisor, dif_pos hex] + exact (Classical.choose_spec hex).eq ha + +/-- Under pairwise gcd existence, the canonical graded class satisfies its defining +characterization. -/ +theorem gradedMaximalFiniteSupportDivisor_is_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), + e ∣ p ∧ e ∣ q ↔ e ∣ d) + (B : DegreeGraded K) : + IsGradedMaximalFiniteSupportDivisor B + (gradedMaximalFiniteSupportDivisor B) := by + obtain ⟨a, ha, _⟩ := + existsUnique_isGradedMaximalFiniteSupportDivisor_of_exists_gcd hgcd B + rw [gradedMaximalFiniteSupportDivisor_eq_of_is ha] + exact ha + +/-- Associate-class form of LM24, Proposition 5.4.8: maximal finite-support divisor classes are +supermultiplicative. -/ +theorem gradedMaximalFiniteSupportDivisor_mul_le_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), + e ∣ p ∧ e ∣ q ↔ e ∣ d) + (B C : DegreeGraded K) : + gradedMaximalFiniteSupportDivisor B * + gradedMaximalFiniteSupportDivisor C ≤ + gradedMaximalFiniteSupportDivisor (B * C) := by + exact IsMaximalDivisorAlong.mul_le + (gradedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd B) + (gradedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd C) + (gradedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd (B * C)) + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFiniteMultiplicativity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFiniteMultiplicativity.lean new file mode 100644 index 0000000000..d9ce694253 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFiniteMultiplicativity.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedMaximalFinite + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility + +/-! +# Multiplicativity of normalized maximal finite-support divisors + +This module proves the field-generic reduction underlying LM24, Corollary 6.3.7. If every +finite-support divisor of a product in `RV̂` factors into finite-support divisors of the two +factors, then the normalized maximal finite-support divisor is multiplicative. + +Pairwise greatest-common-divisor existence and the classification of finite-support units remain +explicit hypotheses; the statements module discharges both over the real exponents. +-/ + +open scoped DirectSum HahnSeries NatOrdinal + +universe v + +namespace Berarducci + +public noncomputable section + +open HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +/-- The normalized maximal finite-support divisor is multiplicative whenever finite-support +divisors of products admit compatible finite-support factorisations. -/ +theorem gradedNormalizedMaximalFiniteSupportDivisor_mul_of_factorization + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hunits : ∀ u : FiniteSupportRing (K := K), + IsUnit u ↔ ∃ k : K, k ≠ 0 ∧ + u = finiteSupportScalarHom (G := ℝ) k) + (hfactor : ∀ (p : FiniteSupportRing (K := K)) + (B C : DegreeGraded K), + finiteSupportGradedEmbedding K p ∣ B * C → + ∃ p₁ p₂ : FiniteSupportRing (K := K), + p = p₁ * p₂ ∧ + finiteSupportGradedEmbedding K p₁ ∣ B ∧ + finiteSupportGradedEmbedding K p₂ ∣ C) + (B C : DegreeGraded K) : + gradedNormalizedMaximalFiniteSupportDivisor (B * C) = + gradedNormalizedMaximalFiniteSupportDivisor B * + gradedNormalizedMaximalFiniteSupportDivisor C := by + let pB := gradedNormalizedMaximalFiniteSupportDivisor B + let pC := gradedNormalizedMaximalFiniteSupportDivisor C + have hmaxB := (isNormalizedGradedMaximalFiniteSupportDivisor_iff B _).mp + (gradedNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd B) + have hmaxC := (isNormalizedGradedMaximalFiniteSupportDivisor_iff C _).mp + (gradedNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd C) + have hmaxBC := (isNormalizedGradedMaximalFiniteSupportDivisor_iff (B * C) _).mp + (gradedNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd (B * C)) + apply gradedNormalizedMaximalFiniteSupportDivisor_eq_of_is hgcd hunits + rw [isNormalizedGradedMaximalFiniteSupportDivisor_iff] + constructor + · intro q + constructor + · intro hq + obtain ⟨q₁, q₂, hqFactor, hq₁, hq₂⟩ := hfactor q B C hq + rw [hqFactor] + exact mul_dvd_mul ((hmaxB.1 q₁).mp hq₁) ((hmaxC.1 q₂).mp hq₂) + · intro hq + apply (hmaxBC.1 q).mpr + exact hq.trans + (gradedNormalizedMaximalFiniteSupportDivisor_mul_dvd_of_exists_gcd hgcd B C) + · by_cases hBC : B * C = 0 + · apply Or.inl + refine ⟨hBC, ?_⟩ + change pB * pC = 0 + rcases eq_zero_or_eq_zero_of_mul_eq_zero hBC with hB | hC + · have hpB : pB = 0 := by + rcases hmaxB.2 with h | h + · exact h.2 + · exact (h.1 hB).elim + rw [hpB, zero_mul] + · have hpC : pC = 0 := by + rcases hmaxC.2 with h | h + · exact h.2 + · exact (h.1 hC).elim + rw [hpC, mul_zero] + · apply Or.inr + refine ⟨hBC, ?_⟩ + apply IsMonicFiniteSupport.mul + · apply gradedNormalizedMaximalFiniteSupportDivisor_isMonic_of_ne_zero hgcd + intro hB + apply hBC + rw [hB, zero_mul] + · apply gradedNormalizedMaximalFiniteSupportDivisor_isMonic_of_ne_zero hgcd + intro hC + apply hBC + rw [hC, mul_zero] + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedHPart.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedHPart.lean new file mode 100644 index 0000000000..b8e04516dc --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedHPart.lean @@ -0,0 +1,173 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportConstantTermOne +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.RealSupportSupremum + +import Mathlib.Algebra.GroupWithZero.Divisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Monomial + +/-! +# Normalized finite-support part over an exponent subgroup + +LM24, Lemma 6.5.2 associates to a nonzero finite-support real-exponent series `p` a unique +series `p_H` in `1 + K(H^{< 0})`. The defining property is intrinsic: every normalized +finite-support `H`-series divides `p` after exponent-domain extension exactly when it divides +`p_H` over `H`. + +This file freezes that property and its uniqueness proposition without choosing a factorisation +of `p`. The full existence theorem depends on the Ritt factorisation and greatest-common-divisor +prerequisites used in the paper; no such prerequisite is hidden in the definition. The identity +case is proved completely as a semantic boundary check. +-/ + +open scoped HahnSeries + +universe v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable (H : AddSubgroup ℝ) {K : Type v} [Field K] + +/-- The finite-support exponent-domain embedding induced by `H ⊆ ℝ`. -/ +def finiteSupportToReal : + FiniteSupportRing (G := H) (K := K) →+* + FiniteSupportRing (G := ℝ) (K := K) := + mapDomainFiniteSupport H.subtype Subtype.val_injective fun _ _ ↦ Iff.rfl + +/-- The underlying nonpositive series of `finiteSupportToReal` is `mapDomainToReal`. -/ +@[simp] +theorem coe_finiteSupportToReal + (p : FiniteSupportRing (G := H) (K := K)) : + ((finiteSupportToReal H p : FiniteSupportRing (G := ℝ) (K := K)) : + Nonpositive ℝ K) = mapDomainToReal H (p : Nonpositive H K) := + by + apply Subtype.ext + rw [finiteSupportToReal, coe_mapDomainFiniteSupport, + coe_mapDomainToReal, coe_mapDomain] + +/-- A normalized finite-support `H`-series is the normalized `H`-part of `p` when it has exactly +the same normalized `H`-divisors as `p` has after exponent-domain extension. -/ +def IsNormalizedHPart + (p : FiniteSupportRing (G := ℝ) (K := K)) + (q : ConstantTermOneFiniteSupport (G := H) (K := K)) : Prop := + ∀ r : ConstantTermOneFiniteSupport (G := H) (K := K), + finiteSupportToReal H + (r : FiniteSupportRing (G := H) (K := K)) ∣ p ↔ + (r : FiniteSupportRing (G := H) (K := K)) ∣ + (q : FiniteSupportRing (G := H) (K := K)) + +/-- Characterization of the normalized `H`-part property by divisibility. -/ +theorem isNormalizedHPart_iff + (p : FiniteSupportRing (G := ℝ) (K := K)) + (q : ConstantTermOneFiniteSupport (G := H) (K := K)) : + IsNormalizedHPart H p q ↔ + ∀ r : ConstantTermOneFiniteSupport (G := H) (K := K), + finiteSupportToReal H + (r : FiniteSupportRing (G := H) (K := K)) ∣ p ↔ + (r : FiniteSupportRing (G := H) (K := K)) ∣ + (q : FiniteSupportRing (G := H) (K := K)) := + Iff.rfl + +/-- Existence and uniqueness of a normalized `H`-part for a finite-support real series. -/ +def HasUniqueNormalizedHPart + (p : FiniteSupportRing (G := ℝ) (K := K)) : Prop := + ∃! q : ConstantTermOneFiniteSupport (G := H) (K := K), + IsNormalizedHPart H p q + +/-- Two normalized `H`-parts of the same finite-support real series are equal. Thus the +uniqueness clause in LM24, Lemma 6.5.2 follows from the intrinsic divisibility property alone. -/ +theorem IsNormalizedHPart.eq + {p : FiniteSupportRing (G := ℝ) (K := K)} + {q q' : ConstantTermOneFiniteSupport (G := H) (K := K)} + (hq : IsNormalizedHPart H p q) (hq' : IsNormalizedHPart H p q') : q = q' := by + have hqDvdQ' : + (q : FiniteSupportRing (G := H) (K := K)) ∣ + (q' : FiniteSupportRing (G := H) (K := K)) := + (hq' q).mp ((hq q).mpr dvd_rfl) + have hq'DvdQ : + (q' : FiniteSupportRing (G := H) (K := K)) ∣ + (q : FiniteSupportRing (G := H) (K := K)) := + (hq q').mp ((hq' q').mpr dvd_rfl) + obtain ⟨u, hu⟩ := associated_of_dvd_dvd hqDvdQ' hq'DvdQ + have huUnit : IsUnit + (((u : FiniteSupportRing (G := H) (K := K)) : Nonpositive H K)) := + u.isUnit.map (finiteSupportSubring (G := H) (K := K)).subtype + have huConstant : constantCoeff + (((u : FiniteSupportRing (G := H) (K := K)) : Nonpositive H K)) = 1 := by + have hconstant := congrArg + (fun r : FiniteSupportRing (G := H) (K := K) ↦ + constantCoeff (r : Nonpositive H K)) hu + simpa only [Subring.coe_mul, map_mul, q.constantCoeff_eq_one, + q'.constantCoeff_eq_one, one_mul] using hconstant + have huOne : (u : FiniteSupportRing (G := H) (K := K)) = 1 := by + apply Subtype.ext + exact eq_one_of_isUnit_of_constantCoeff_eq_one huUnit huConstant + apply Subtype.ext + simpa only [huOne, mul_one] using hu + +/-- For the normalized `H`-part property, existence already implies unique existence. -/ +theorem hasUniqueNormalizedHPart_iff_exists + (p : FiniteSupportRing (G := ℝ) (K := K)) : + HasUniqueNormalizedHPart H p ↔ + ∃ q : ConstantTermOneFiniteSupport (G := H) (K := K), + IsNormalizedHPart H p q := by + constructor + · rintro ⟨q, hq, _⟩ + exact ⟨q, hq⟩ + · rintro ⟨q, hq⟩ + exact ⟨q, hq, fun _ hq' ↦ hq'.eq H hq⟩ + +/-- A normalized series whose real-domain image divides one is itself one. -/ +theorem ConstantTermOneFiniteSupport.eq_one_of_finiteSupportToReal_dvd_one + (r : ConstantTermOneFiniteSupport (G := H) (K := K)) + (hr : finiteSupportToReal H + (r : FiniteSupportRing (G := H) (K := K)) ∣ 1) : r = 1 := by + have hrUnitFinite : IsUnit (finiteSupportToReal H + (r : FiniteSupportRing (G := H) (K := K))) := + isUnit_iff_dvd_one.mpr hr + have hrUnit : IsUnit (mapDomainToReal H + ((r : FiniteSupportRing (G := H) (K := K)) : Nonpositive H K)) := by + rw [← coe_finiteSupportToReal] + exact hrUnitFinite.map + (finiteSupportSubring (G := ℝ) (K := K)).subtype + have hrConstant : constantCoeff (mapDomainToReal H + ((r : FiniteSupportRing (G := H) (K := K)) : Nonpositive H K)) = 1 := by + rw [constantCoeff_mapDomainToReal] + exact r.constantCoeff_eq_one + have hrImageEq : mapDomainToReal H + ((r : FiniteSupportRing (G := H) (K := K)) : Nonpositive H K) = 1 := + eq_one_of_isUnit_of_constantCoeff_eq_one hrUnit hrConstant + apply Subtype.ext + apply Subtype.ext + exact mapDomainToReal_injective H (by simpa using hrImageEq) + +/-- The multiplicative identity is its own normalized `H`-part. -/ +theorem one_isNormalizedHPart : + IsNormalizedHPart H + (1 : FiniteSupportRing (G := ℝ) (K := K)) + (1 : ConstantTermOneFiniteSupport (G := H) (K := K)) := by + intro r + constructor + · intro hr + rw [r.eq_one_of_finiteSupportToReal_dvd_one H hr] + · intro hr + simpa using (finiteSupportToReal H).map_dvd hr + +/-- The identity has a unique normalized `H`-part, namely itself. -/ +theorem existsUnique_normalizedHPart_one : + ∃! q : ConstantTermOneFiniteSupport (G := H) (K := K), + IsNormalizedHPart H + (1 : FiniteSupportRing (G := ℝ) (K := K)) q := by + refine ⟨1, one_isNormalizedHPart H, ?_⟩ + intro q hq + apply q.eq_one_of_finiteSupportToReal_dvd_one H + exact (hq q).mpr (dvd_refl _) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedHPartMultiplicativity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedHPartMultiplicativity.lean new file mode 100644 index 0000000000..9a9889d9db --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedHPartMultiplicativity.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPart + +/-! +# Multiplication of normalized exponent-subgroup parts + +LM24, Corollary 6.5.4 states that the normalized `H`-part of a product is the product of +the normalized `H`-parts. Its proof uses a specific Ritt-factorisation consequence: a normalized +`H`-divisor of a product of finite-support real series can be split into normalized `H`-divisors +of the two factors. + +This module names that prerequisite explicitly and proves the complete reduction from it. The +prerequisite is neither installed as an instance nor folded into the definition of a normalized +`H`-part. Thus the intrinsic definition and uniqueness theorem remain independent of the later +Ritt and greatest-common-divisor proof. +-/ + +open scoped HahnSeries + +universe v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable (H : AddSubgroup ℝ) {K : Type v} [Field K] + +/-- Every normalized finite-support `H`-divisor of a product of finite-support real series splits +as a product of normalized `H`-divisors of the two factors. This is the exact factor-splitting +input used in LM24's proof of Corollary 6.5.4. -/ +def HasNormalizedHDivisorRefinement : Prop := + ∀ (p q : FiniteSupportRing (G := ℝ) (K := K)) + (r : ConstantTermOneFiniteSupport (G := H) (K := K)), + finiteSupportToReal H + (r : FiniteSupportRing (G := H) (K := K)) ∣ p * q → + ∃ r₁ r₂ : ConstantTermOneFiniteSupport (G := H) (K := K), + r = r₁ * r₂ ∧ + finiteSupportToReal H + (r₁ : FiniteSupportRing (G := H) (K := K)) ∣ p ∧ + finiteSupportToReal H + (r₂ : FiniteSupportRing (G := H) (K := K)) ∣ q + +/-- Characterization of normalized `H`-divisor refinement by factor witnesses. -/ +theorem hasNormalizedHDivisorRefinement_iff : + HasNormalizedHDivisorRefinement H (K := K) ↔ + ∀ (p q : FiniteSupportRing (G := ℝ) (K := K)) + (r : ConstantTermOneFiniteSupport (G := H) (K := K)), + finiteSupportToReal H + (r : FiniteSupportRing (G := H) (K := K)) ∣ p * q → + ∃ r₁ r₂ : ConstantTermOneFiniteSupport (G := H) (K := K), + r = r₁ * r₂ ∧ + finiteSupportToReal H + (r₁ : FiniteSupportRing (G := H) (K := K)) ∣ p ∧ + finiteSupportToReal H + (r₂ : FiniteSupportRing (G := H) (K := K)) ∣ q := + Iff.rfl + +/-- The product of two normalized `H`-parts satisfies the normalized-part divisibility +characterization for the product. -/ +theorem isNormalizedHPart_mul + (hrefine : HasNormalizedHDivisorRefinement H (K := K)) + {p q : FiniteSupportRing (G := ℝ) (K := K)} + {pH qH : ConstantTermOneFiniteSupport (G := H) (K := K)} + (hpH : IsNormalizedHPart H p pH) + (hqH : IsNormalizedHPart H q qH) : + IsNormalizedHPart H (p * q) (pH * qH) := by + rw [isNormalizedHPart_iff] + have hpH' := (isNormalizedHPart_iff H p pH).mp hpH + have hqH' := (isNormalizedHPart_iff H q qH).mp hqH + intro r + constructor + · intro hr + obtain ⟨r₁, r₂, rfl, hr₁, hr₂⟩ := hrefine p q r hr + exact mul_dvd_mul (Iff.mp (hpH' r₁) hr₁) (Iff.mp (hqH' r₂) hr₂) + · intro hr + have hpDvd : finiteSupportToReal H + (pH : FiniteSupportRing (G := H) (K := K)) ∣ p := + (hpH' pH).mpr dvd_rfl + have hqDvd : finiteSupportToReal H + (qH : FiniteSupportRing (G := H) (K := K)) ∣ q := + (hqH' qH).mpr dvd_rfl + have hrMapped := (finiteSupportToReal H).map_dvd hr + have hpartsDvd : finiteSupportToReal H + ((pH * qH : ConstantTermOneFiniteSupport (G := H) (K := K)) : + FiniteSupportRing (G := H) (K := K)) ∣ p * q := by + change finiteSupportToReal H + ((pH : FiniteSupportRing (G := H) (K := K)) * + (qH : FiniteSupportRing (G := H) (K := K))) ∣ p * q + rw [map_mul] + exact mul_dvd_mul hpDvd hqDvd + exact hrMapped.trans hpartsDvd + +/-- Relational form of LM24, Corollary 6.5.4: any normalized `H`-part of a product equals the +product of normalized `H`-parts of its factors. -/ +theorem normalizedHPart_mul_eq + (hrefine : HasNormalizedHDivisorRefinement H (K := K)) + {p q : FiniteSupportRing (G := ℝ) (K := K)} + {pH qH pqH : ConstantTermOneFiniteSupport (G := H) (K := K)} + (hpH : IsNormalizedHPart H p pH) + (hqH : IsNormalizedHPart H q qH) + (hpqH : IsNormalizedHPart H (p * q) pqH) : + pqH = pH * qH := + hpqH.eq H (isNormalizedHPart_mul H hrefine hpH hqH) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedHPartSeries.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedHPartSeries.lean new file mode 100644 index 0000000000..5c2a75151f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedHPartSeries.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite + +/-! +# Normalized exponent-subgroup parts of Hahn-series maximal divisors + +LM24, Corollary 6.5.3 combines two intrinsic divisor characterizations. The real finite-support +series `p(b)` has exactly the finite-support divisors of `b`, while its normalized `H`-part has +exactly its normalized finite-support `H`-divisors. + +The theorem below proves this composition for arbitrary representatives satisfying those two +predicates. It therefore needs no Ritt-factorisation or Berarducci input; the corresponding source +theorem reduces to the two existence results. +-/ + +open scoped HahnSeries + +universe v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable (H : AddSubgroup ℝ) {K : Type v} [Field K] + +/-- Relational form of LM24, Corollary 6.5.3: normalized finite-support `H`-divisors of a Hahn +series are exactly the divisors of the normalized `H`-part of its maximal finite-support +divisor. -/ +theorem normalizedHPart_dvd_iff_dvd_series + {b : Nonpositive ℝ K} {p : FiniteSupportRing (G := ℝ) (K := K)} + {pH : ConstantTermOneFiniteSupport (G := H) (K := K)} + (hmax : Berarducci.IsNormalizedSeriesMaximalFiniteSupportDivisor b p) + (hpH : IsNormalizedHPart H p pH) + (q : ConstantTermOneFiniteSupport (G := H) (K := K)) : + mapDomainToReal H + ((q : FiniteSupportRing (G := H) (K := K)) : Nonpositive H K) ∣ b ↔ + (q : FiniteSupportRing (G := H) (K := K)) ∣ + (pH : FiniteSupportRing (G := H) (K := K)) := by + have hmax' := + (Berarducci.isNormalizedSeriesMaximalFiniteSupportDivisor_iff b p).mp hmax + have hpH' := (isNormalizedHPart_iff H p pH).mp hpH + calc + mapDomainToReal H + ((q : FiniteSupportRing (G := H) (K := K)) : Nonpositive H K) ∣ b ↔ + ((finiteSupportToReal H + (q : FiniteSupportRing (G := H) (K := K)) : + FiniteSupportRing (G := ℝ) (K := K)) : Nonpositive ℝ K) ∣ b := by + rw [coe_finiteSupportToReal] + _ ↔ finiteSupportToReal H + (q : FiniteSupportRing (G := H) (K := K)) ∣ p := + hmax'.1 _ + _ ↔ (q : FiniteSupportRing (G := H) (K := K)) ∣ + (pH : FiniteSupportRing (G := H) (K := K)) := hpH' q + +/-- Relational reduction underlying LM24, Corollary 6.5.5: multiplicativity of the real +series-level maximal finite-support divisor and normalized-divisor refinement imply +multiplicativity of its normalized `H`-part. -/ +theorem normalizedHPart_seriesMaximal_mul_eq + (hrefine : HasNormalizedHDivisorRefinement H (K := K)) + {b c : Nonpositive ℝ K} + {bH cH bcH : ConstantTermOneFiniteSupport (G := H) (K := K)} + (hbH : IsNormalizedHPart H + (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b) bH) + (hcH : IsNormalizedHPart H + (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor c) cH) + (hbcH : IsNormalizedHPart H + (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor (b * c)) bcH) + (hmaxMul : Berarducci.seriesNormalizedMaximalFiniteSupportDivisor (b * c) = + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b * + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor c) : + bcH = bH * cH := by + apply hbcH.eq H + rw [hmaxMul] + exact isNormalizedHPart_mul H hrefine hbH hcH + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedMaximalFinite.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedMaximalFinite.lean new file mode 100644 index 0000000000..8f14513f31 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedMaximalFinite.lean @@ -0,0 +1,252 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalization + +/-! +# Normalized maximal finite-support divisors + +This module passes from the intrinsic associate class of a maximal finite-support divisor to the +representative normalization used in LM24, Notation 5.4.5. The zero graded element is represented +by zero. For a nonzero graded element, the greatest exponent in the support of the representative +has coefficient `1`. + +The normalization is defined for the canonical associate class without assuming greatest common +divisors or classifying units. Pairwise greatest-common-divisor existence proves that its associate +class is the maximal one. The same hypothesis then gives the representative form of LM24, +Proposition 5.4.8. +-/ + +open scoped DirectSum HahnSeries NatOrdinal + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [CharZero K] + +/-- A series is the normalized maximal finite-support divisor of a graded element when it has +exactly the finite-support divisors of that element and satisfies the normalization convention of +LM24, Notation 5.4.5. -/ +def IsNormalizedGradedMaximalFiniteSupportDivisor (B : DegreeGraded K) + (p : FiniteSupportRing (K := K)) : Prop := + (∀ q : FiniteSupportRing (K := K), + finiteSupportGradedEmbedding K q ∣ B ↔ q ∣ p) ∧ + ((B = 0 ∧ p = 0) ∨ + (B ≠ 0 ∧ HahnSeries.Nonpositive.IsMonicFiniteSupport p)) + +omit [CharZero K] in +/-- Characterization of a normalized maximal finite-support divisor by divisibility and its zero +or monic normalization clause. -/ +theorem isNormalizedGradedMaximalFiniteSupportDivisor_iff (B : DegreeGraded K) + (p : FiniteSupportRing (K := K)) : + IsNormalizedGradedMaximalFiniteSupportDivisor B p ↔ + (∀ q : FiniteSupportRing (K := K), + finiteSupportGradedEmbedding K q ∣ B ↔ q ∣ p) ∧ + ((B = 0 ∧ p = 0) ∨ + (B ≠ 0 ∧ HahnSeries.Nonpositive.IsMonicFiniteSupport p)) := + Iff.rfl + +/-- The normalized representative of the maximal finite-support divisor class of a graded +element. -/ +def gradedNormalizedMaximalFiniteSupportDivisor + (B : DegreeGraded K) : FiniteSupportRing (K := K) := + HahnSeries.Nonpositive.normalizedAssociateRepresentative (G := ℝ) + (gradedMaximalFiniteSupportDivisor B) + +omit [CharZero K] in +/-- The normalized maximal finite-support divisor is the canonical normalized representative of +its intrinsic associate class. -/ +theorem gradedNormalizedMaximalFiniteSupportDivisor_eq_normalizedRepresentative + (B : DegreeGraded K) : + gradedNormalizedMaximalFiniteSupportDivisor B = + HahnSeries.Nonpositive.normalizedAssociateRepresentative (G := ℝ) + (gradedMaximalFiniteSupportDivisor B) := + (rfl) + +omit [CharZero K] in +/-- The normalized maximal finite-support divisor satisfies the intrinsic normalization +predicate. -/ +theorem gradedNormalizedMaximalFiniteSupportDivisor_isNormalized + (B : DegreeGraded K) : + HahnSeries.Nonpositive.IsNormalizedAssociateRepresentative + (gradedMaximalFiniteSupportDivisor B) + (gradedNormalizedMaximalFiniteSupportDivisor B) := + HahnSeries.Nonpositive.normalizedAssociateRepresentative_is _ + +omit [CharZero K] in +/-- The associate class of the normalized representative is the intrinsic maximal-divisor +class. -/ +theorem gradedNormalizedMaximalFiniteSupportDivisor_mk (B : DegreeGraded K) : + Associates.mk (gradedNormalizedMaximalFiniteSupportDivisor B) = + gradedMaximalFiniteSupportDivisor B := + HahnSeries.Nonpositive.normalizedAssociateRepresentative_mk _ + +/-- On an embedded finite-support series, the graded normalized divisor is the normalized +representative of that series's own associate class. -/ +theorem gradedNormalizedMaximalFiniteSupportDivisor_finiteSupport (p : FiniteSupportRing (K := K)) : + gradedNormalizedMaximalFiniteSupportDivisor + (finiteSupportGradedEmbedding K p) = + HahnSeries.Nonpositive.normalizedAssociateRepresentative (G := ℝ) + (Associates.mk p) := by + rw [gradedNormalizedMaximalFiniteSupportDivisor, + gradedMaximalFiniteSupportDivisor_eq_of_is + (isGradedMaximalFiniteSupportDivisor_finiteSupport p)] + +/-- Under pairwise greatest-common-divisor existence, the normalized representative has exactly +the finite-support divisors of the graded element. -/ +theorem gradedNormalizedMaximalFiniteSupportDivisor_isMaximal_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (B : DegreeGraded K) : + IsGradedMaximalFiniteSupportDivisor B + (Associates.mk (gradedNormalizedMaximalFiniteSupportDivisor B)) := by + rw [gradedNormalizedMaximalFiniteSupportDivisor_mk] + exact gradedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd B + +/-- A nonzero graded element has a nonzero maximal finite-support divisor class. -/ +theorem gradedMaximalFiniteSupportDivisor_ne_zero_of_ne_zero + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + {B : DegreeGraded K} (hB : B ≠ 0) : + gradedMaximalFiniteSupportDivisor B ≠ 0 := by + intro hclass + have hmax := + gradedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd B + have hzeroLe : Associates.mk (0 : FiniteSupportRing (K := K)) ≤ + gradedMaximalFiniteSupportDivisor B := by + rw [hclass] + exact le_rfl + have hzeroDvd := + (isGradedMaximalFiniteSupportDivisor_iff B _).mp hmax 0 |>.mp hzeroLe + obtain ⟨D, hD⟩ := hzeroDvd + apply hB + change B = finiteSupportGradedEmbedding K 0 * D at hD + rw [map_zero, zero_mul] at hD + exact hD + +/-- The normalized maximal finite-support divisor of a nonzero graded element is monic. -/ +theorem gradedNormalizedMaximalFiniteSupportDivisor_isMonic_of_ne_zero + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + {B : DegreeGraded K} (hB : B ≠ 0) : + HahnSeries.Nonpositive.IsMonicFiniteSupport + (gradedNormalizedMaximalFiniteSupportDivisor B) := by + apply HahnSeries.Nonpositive.normalizedAssociateRepresentative_isMonic_of_ne_zero + exact gradedMaximalFiniteSupportDivisor_ne_zero_of_ne_zero hgcd hB + +/-- Under pairwise greatest-common-divisor existence, the chosen representative satisfies the +source-level normalized maximal-divisor predicate. -/ +theorem gradedNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (B : DegreeGraded K) : + IsNormalizedGradedMaximalFiniteSupportDivisor B + (gradedNormalizedMaximalFiniteSupportDivisor B) := by + constructor + · exact (isGradedMaximalFiniteSupportDivisor_mk_iff B _).mp + (gradedNormalizedMaximalFiniteSupportDivisor_isMaximal_of_exists_gcd hgcd B) + · by_cases hB : B = 0 + · subst B + apply Or.inl + refine ⟨rfl, ?_⟩ + have hmax := gradedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd 0 + have hzero : IsGradedMaximalFiniteSupportDivisor (0 : DegreeGraded K) 0 := by + rw [isGradedMaximalFiniteSupportDivisor_iff] + intro q + constructor + · intro _ + exact dvd_zero _ + · intro _ + exact Associates.mk_le_mk_of_dvd (dvd_zero q) + have hclass := IsGradedMaximalFiniteSupportDivisor.eq hmax hzero + rw [gradedNormalizedMaximalFiniteSupportDivisor, hclass, + HahnSeries.Nonpositive.normalizedAssociateRepresentative_zero] + · exact Or.inr ⟨hB, + gradedNormalizedMaximalFiniteSupportDivisor_isMonic_of_ne_zero hgcd hB⟩ + +omit [CharZero K] in +/-- The normalized maximal-divisor predicate determines at most one finite-support series when all +units are nonzero constant series. -/ +theorem IsNormalizedGradedMaximalFiniteSupportDivisor.eq (hunits : ∀ u : FiniteSupportRing (K := K), + IsUnit u ↔ ∃ k : K, k ≠ 0 ∧ + u = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k) + {B : DegreeGraded K} + {p q : FiniteSupportRing (K := K)} + (hp : IsNormalizedGradedMaximalFiniteSupportDivisor B p) + (hq : IsNormalizedGradedMaximalFiniteSupportDivisor B q) : + p = q := by + have hpMax := + (isGradedMaximalFiniteSupportDivisor_mk_iff B p).mpr hp.1 + have hqMax := + (isGradedMaximalFiniteSupportDivisor_mk_iff B q).mpr hq.1 + have hclasses : Associates.mk p = Associates.mk q := + IsGradedMaximalFiniteSupportDivisor.eq hpMax hqMax + rcases hp.2 with hpZero | hpNonzero + · rcases hq.2 with hqZero | hqNonzero + · exact hpZero.2.trans hqZero.2.symm + · exact (hqNonzero.1 hpZero.1).elim + · rcases hq.2 with hqZero | hqNonzero + · exact (hpNonzero.1 hqZero.1).elim + · have hpNormalized : + HahnSeries.Nonpositive.IsNormalizedAssociateRepresentative + (Associates.mk p) p := + (HahnSeries.Nonpositive.isNormalizedAssociateRepresentative_iff + (Associates.mk p) p).mpr + (Or.inr ⟨Associates.mk_ne_zero.mpr hpNonzero.2.ne_zero, + rfl, hpNonzero.2⟩) + have hqNormalized : + HahnSeries.Nonpositive.IsNormalizedAssociateRepresentative + (Associates.mk p) q := + (HahnSeries.Nonpositive.isNormalizedAssociateRepresentative_iff + (Associates.mk p) q).mpr + (Or.inr ⟨Associates.mk_ne_zero.mpr hpNonzero.2.ne_zero, + hclasses.symm, hqNonzero.2⟩) + exact hpNormalized.eq hunits hqNormalized + +/-- Any series satisfying the normalized maximal-divisor predicate is the chosen normalized +representative, under pairwise greatest-common-divisor existence and the unit classification. -/ +theorem gradedNormalizedMaximalFiniteSupportDivisor_eq_of_is + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hunits : ∀ u : FiniteSupportRing (K := K), + IsUnit u ↔ ∃ k : K, k ≠ 0 ∧ + u = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k) + {B : DegreeGraded K} + {p : FiniteSupportRing (K := K)} + (hp : IsNormalizedGradedMaximalFiniteSupportDivisor B p) : + gradedNormalizedMaximalFiniteSupportDivisor B = p := by + exact (gradedNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd B).eq hunits hp + +/-- Representative form of LM24, Proposition 5.4.8: the product of the normalized maximal +finite-support divisors divides the normalized maximal finite-support divisor of the product. -/ +theorem gradedNormalizedMaximalFiniteSupportDivisor_mul_dvd_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (B C : DegreeGraded K) : + gradedNormalizedMaximalFiniteSupportDivisor B * + gradedNormalizedMaximalFiniteSupportDivisor C ∣ + gradedNormalizedMaximalFiniteSupportDivisor (B * C) := by + apply Associates.mk_le_mk_iff_dvd.mp + rw [← Associates.mk_mul_mk, + gradedNormalizedMaximalFiniteSupportDivisor_mk, + gradedNormalizedMaximalFiniteSupportDivisor_mk, + gradedNormalizedMaximalFiniteSupportDivisor_mk] + exact gradedMaximalFiniteSupportDivisor_mul_le_of_exists_gcd hgcd B C + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedSeriesMaximalFinite.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedSeriesMaximalFinite.lean new file mode 100644 index 0000000000..7201fd282e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedSeriesMaximalFinite.lean @@ -0,0 +1,267 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalization + +/-! +# Normalized maximal finite-support divisors of Hahn series + +This module passes from the intrinsic associate class of LM24, Proposition 5.5.1 to the +representative `p(b)` fixed by Notation 5.5.2. The representative is zero when `b = 0`; otherwise +its coefficient at the greatest support exponent is `1`. + +The source-level divisibility characterization, the three clauses of Remark 5.5.3, and the +one-sided product divisibility of Proposition 5.5.5 are proved with their exact orientations. Unit +classification and pairwise greatest-common-divisor existence remain explicit hypotheses. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [CharZero K] + +/-- A finite-support series is the normalized maximal divisor of a Hahn series when it has +exactly its finite-support divisors and is zero at zero or monic otherwise. -/ +def IsNormalizedSeriesMaximalFiniteSupportDivisor + (b : Series K) (p : FiniteSupportRing (K := K)) : Prop := + (∀ q : FiniteSupportRing (K := K), (q : Series K) ∣ b ↔ q ∣ p) ∧ + ((b = 0 ∧ p = 0) ∨ + (b ≠ 0 ∧ HahnSeries.Nonpositive.IsMonicFiniteSupport p)) + +omit [CharZero K] in +/-- Characterization of a normalized maximal finite-support divisor of a Hahn series. -/ +theorem isNormalizedSeriesMaximalFiniteSupportDivisor_iff + (b : Series K) (p : FiniteSupportRing (K := K)) : + IsNormalizedSeriesMaximalFiniteSupportDivisor b p ↔ + (∀ q : FiniteSupportRing (K := K), (q : Series K) ∣ b ↔ q ∣ p) ∧ + ((b = 0 ∧ p = 0) ∨ + (b ≠ 0 ∧ HahnSeries.Nonpositive.IsMonicFiniteSupport p)) := + Iff.rfl + +/-- The normalized representative of the maximal finite-support divisor class of a Hahn series. +-/ +noncomputable def seriesNormalizedMaximalFiniteSupportDivisor + (b : Series K) : FiniteSupportRing (K := K) := + HahnSeries.Nonpositive.normalizedAssociateRepresentative (G := ℝ) + (seriesMaximalFiniteSupportDivisor b) + +omit [CharZero K] in +/-- The chosen series-level representative is normalized in its associate class. -/ +theorem seriesNormalizedMaximalFiniteSupportDivisor_isNormalized (b : Series K) : + HahnSeries.Nonpositive.IsNormalizedAssociateRepresentative + (seriesMaximalFiniteSupportDivisor b) + (seriesNormalizedMaximalFiniteSupportDivisor b) := + HahnSeries.Nonpositive.normalizedAssociateRepresentative_is _ + +omit [CharZero K] in +/-- The associate class of the normalized representative is the intrinsic maximal-divisor +class. -/ +theorem seriesNormalizedMaximalFiniteSupportDivisor_mk (b : Series K) : + Associates.mk (seriesNormalizedMaximalFiniteSupportDivisor b) = + seriesMaximalFiniteSupportDivisor b := + HahnSeries.Nonpositive.normalizedAssociateRepresentative_mk _ + +/-- On a finite-support input, the series-level normalization coincides with the earlier +graded normalization from LM24, Notation 5.4.5. This includes the zero input. -/ +theorem seriesNormalizedMaximalFiniteSupportDivisor_coe_eq_graded (p : FiniteSupportRing (K := K)) : + seriesNormalizedMaximalFiniteSupportDivisor (p : Series K) = + gradedNormalizedMaximalFiniteSupportDivisor + (finiteSupportGradedEmbedding K p) := by + rw [seriesNormalizedMaximalFiniteSupportDivisor, + seriesMaximalFiniteSupportDivisor_coe, + gradedNormalizedMaximalFiniteSupportDivisor_finiteSupport] + +/-- Under pairwise greatest-common-divisor existence, the normalized representative has exactly +the finite-support divisors of the Hahn series. -/ +theorem seriesNormalizedMaximalFiniteSupportDivisor_isMaximal_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (b : Series K) : + IsSeriesMaximalFiniteSupportDivisor b + (Associates.mk (seriesNormalizedMaximalFiniteSupportDivisor b)) := by + rw [seriesNormalizedMaximalFiniteSupportDivisor_mk] + exact seriesMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd b + +/-- A nonzero Hahn series has a nonzero maximal finite-support divisor class. -/ +theorem seriesMaximalFiniteSupportDivisor_ne_zero_of_ne_zero + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + {b : Series K} (hb : b ≠ 0) : + seriesMaximalFiniteSupportDivisor b ≠ 0 := by + intro hclass + have hmax := seriesMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd b + have hzeroLe : Associates.mk (0 : FiniteSupportRing (K := K)) ≤ + seriesMaximalFiniteSupportDivisor b := by + rw [hclass] + exact le_rfl + have hzeroDvd := + (isSeriesMaximalFiniteSupportDivisor_iff b _).mp hmax 0 |>.mp hzeroLe + exact hb (zero_dvd_iff.mp hzeroDvd) + +/-- The normalized maximal finite-support divisor of a nonzero Hahn series is monic. -/ +theorem seriesNormalizedMaximalFiniteSupportDivisor_isMonic_of_ne_zero + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + {b : Series K} (hb : b ≠ 0) : + HahnSeries.Nonpositive.IsMonicFiniteSupport + (seriesNormalizedMaximalFiniteSupportDivisor b) := by + apply HahnSeries.Nonpositive.normalizedAssociateRepresentative_isMonic_of_ne_zero + exact seriesMaximalFiniteSupportDivisor_ne_zero_of_ne_zero hgcd hb + +/-- Under pairwise greatest-common-divisor existence, the chosen representative satisfies the +normalized series-level maximal-divisor predicate. -/ +theorem seriesNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (b : Series K) : + IsNormalizedSeriesMaximalFiniteSupportDivisor b + (seriesNormalizedMaximalFiniteSupportDivisor b) := by + constructor + · exact (isSeriesMaximalFiniteSupportDivisor_mk_iff b _).mp + (seriesNormalizedMaximalFiniteSupportDivisor_isMaximal_of_exists_gcd hgcd b) + · by_cases hb : b = 0 + · subst b + apply Or.inl + refine ⟨rfl, ?_⟩ + have hzero : IsSeriesMaximalFiniteSupportDivisor (0 : Series K) 0 := + IsSeriesMaximalFiniteSupportDivisor.zero + rw [seriesNormalizedMaximalFiniteSupportDivisor, + seriesMaximalFiniteSupportDivisor_eq_of_is hzero, + HahnSeries.Nonpositive.normalizedAssociateRepresentative_zero] + · exact Or.inr ⟨hb, + seriesNormalizedMaximalFiniteSupportDivisor_isMonic_of_ne_zero hgcd hb⟩ + +omit [CharZero K] in +/-- The normalized series-level predicate determines at most one finite-support series when all +units are nonzero constant series. -/ +theorem IsNormalizedSeriesMaximalFiniteSupportDivisor.eq (hunits : ∀ u : FiniteSupportRing (K := K), + IsUnit u ↔ ∃ k : K, k ≠ 0 ∧ + u = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k) + {b : Series K} {p q : FiniteSupportRing (K := K)} + (hp : IsNormalizedSeriesMaximalFiniteSupportDivisor b p) + (hq : IsNormalizedSeriesMaximalFiniteSupportDivisor b q) : p = q := by + have hpMax := (isSeriesMaximalFiniteSupportDivisor_mk_iff b p).mpr hp.1 + have hqMax := (isSeriesMaximalFiniteSupportDivisor_mk_iff b q).mpr hq.1 + have hclasses : Associates.mk p = Associates.mk q := hpMax.eq hqMax + rcases hp.2 with hpZero | hpNonzero + · rcases hq.2 with hqZero | hqNonzero + · exact hpZero.2.trans hqZero.2.symm + · exact (hqNonzero.1 hpZero.1).elim + · rcases hq.2 with hqZero | hqNonzero + · exact (hpNonzero.1 hqZero.1).elim + · have hpNormalized : + HahnSeries.Nonpositive.IsNormalizedAssociateRepresentative + (Associates.mk p) p := + (HahnSeries.Nonpositive.isNormalizedAssociateRepresentative_iff + (Associates.mk p) p).mpr + (Or.inr ⟨Associates.mk_ne_zero.mpr hpNonzero.2.ne_zero, + rfl, hpNonzero.2⟩) + have hqNormalized : + HahnSeries.Nonpositive.IsNormalizedAssociateRepresentative + (Associates.mk p) q := + (HahnSeries.Nonpositive.isNormalizedAssociateRepresentative_iff + (Associates.mk p) q).mpr + (Or.inr ⟨Associates.mk_ne_zero.mpr hpNonzero.2.ne_zero, + hclasses.symm, hqNonzero.2⟩) + exact hpNormalized.eq hunits hqNormalized + +/-- Any finite-support series satisfying the normalized predicate is the chosen normalized +representative. -/ +theorem seriesNormalizedMaximalFiniteSupportDivisor_eq_of_is + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hunits : ∀ u : FiniteSupportRing (K := K), + IsUnit u ↔ ∃ k : K, k ≠ 0 ∧ + u = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k) + {b : Series K} {p : FiniteSupportRing (K := K)} + (hp : IsNormalizedSeriesMaximalFiniteSupportDivisor b p) : + seriesNormalizedMaximalFiniteSupportDivisor b = p := by + exact (seriesNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd b).eq hunits hp + +/-- The product of the normalized maximal finite-support divisors divides the normalized maximal +finite-support divisor of the product. -/ +theorem seriesNormalizedMaximalFiniteSupportDivisor_mul_dvd_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (b c : Series K) : + seriesNormalizedMaximalFiniteSupportDivisor b * + seriesNormalizedMaximalFiniteSupportDivisor c ∣ + seriesNormalizedMaximalFiniteSupportDivisor (b * c) := by + apply Associates.mk_le_mk_iff_dvd.mp + rw [← Associates.mk_mul_mk, + seriesNormalizedMaximalFiniteSupportDivisor_mk, + seriesNormalizedMaximalFiniteSupportDivisor_mk, + seriesNormalizedMaximalFiniteSupportDivisor_mk] + exact seriesMaximalFiniteSupportDivisor_mul_le_of_exists_gcd hgcd b c + +/-- The normalized maximal finite-support divisor embeds as a divisor of the Hahn series. -/ +theorem seriesNormalizedMaximalFiniteSupportDivisor_dvd_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (b : Series K) : + (seriesNormalizedMaximalFiniteSupportDivisor b : Series K) ∣ b := by + have h := seriesNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd b + exact (h.1 (seriesNormalizedMaximalFiniteSupportDivisor b)).mpr dvd_rfl + +/-- The normalized maximal finite-support divisor of zero is zero. -/ +theorem seriesNormalizedMaximalFiniteSupportDivisor_zero_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) : + seriesNormalizedMaximalFiniteSupportDivisor (0 : Series K) = 0 := by + have h := seriesNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd (0 : Series K) + rcases h.2 with hzero | hnonzero + · exact hzero.2 + · exact (hnonzero.1 rfl).elim + +/-- The normalized maximal divisor of a finite-support series is a nonzero scalar multiple of +that series. -/ +theorem exists_scalar_seriesNormalizedMaximalFiniteSupportDivisor_coe + (hunits : ∀ u : FiniteSupportRing (K := K), + IsUnit u ↔ ∃ k : K, k ≠ 0 ∧ + u = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k) + (p : FiniteSupportRing (K := K)) : + ∃ k : K, k ≠ 0 ∧ + seriesNormalizedMaximalFiniteSupportDivisor (p : Series K) = + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k * p := by + have hclasses : Associates.mk p = + Associates.mk (seriesNormalizedMaximalFiniteSupportDivisor (p : Series K)) := by + rw [seriesNormalizedMaximalFiniteSupportDivisor_mk, + seriesMaximalFiniteSupportDivisor_coe] + exact HahnSeries.Nonpositive.exists_nonzero_scalar_mul_of_mk_eq_mk + hunits hclasses + +/-- The normalized maximal finite-support divisor of a principal Hahn series is one. -/ +theorem seriesNormalizedMaximalFiniteSupportDivisor_eq_one_of_isPrincipal + (hunits : ∀ u : FiniteSupportRing (K := K), + IsUnit u ↔ ∃ k : K, k ≠ 0 ∧ + u = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k) + {b : Series K} (hb : HahnSeries.Nonpositive.IsPrincipal b) : + seriesNormalizedMaximalFiniteSupportDivisor b = 1 := by + have hclass := seriesMaximalFiniteSupportDivisor_eq_one_of_isPrincipal hb + apply HahnSeries.Nonpositive.normalizedAssociateRepresentative_eq_of_is hunits + rw [HahnSeries.Nonpositive.isNormalizedAssociateRepresentative_iff, hclass] + exact Or.inr ⟨one_ne_zero, Associates.mk_one, + HahnSeries.Nonpositive.isMonicFiniteSupport_one⟩ + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PreSchreier.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PreSchreier.lean new file mode 100644 index 0000000000..6c67f26c6a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PreSchreier.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.FiniteSupportFactorUniqueness +public import Mathlib.Algebra.GroupWithZero.Divisibility + +/-! +# Pre-Schreier reduction from LM24 factorisation + +This module proves the factorisation-theoretic reduction used in LM24, Corollary 6.4.2. If every +finite-support factor is primal, every irreducible infinite-support factor is prime, and every +nonzero series has the factorisation supplied by Theorem 6.4.1, then the full Hahn-series ring is +a decomposition monoid, equivalently a pre-Schreier domain in the terminology of the paper. +-/ + +open scoped HahnSeries + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] + +/-- A product list of prime elements is primal. -/ +theorem list_prod_isPrimal_of_prime + (factors : List (Series K)) + (hfactors : ∀ c ∈ factors, Prime c) : + IsPrimal factors.prod := by + induction factors with + | nil => simpa using isUnit_one.isPrimal + | cons c factors ih => + rw [List.prod_cons] + exact (hfactors c (by simp)).isPrimal.mul + (ih (fun d hd ↦ hfactors d (by simp [hd]))) + +/-- Factorisation into a primal finite-support factor and prime infinite-support factors makes +every series primal. -/ +theorem decompositionMonoid_of_infiniteSupportFactorization + (hfinitePrimal : ∀ p : FiniteSupportRing (K := K), IsPrimal (p : Series K)) + (hfactorization : ∀ b : Series K, b ≠ 0 → + ∃ (p : FiniteSupportRing (K := K)) (factors : List (Series K)), + IsInfiniteSupportIrreducibleFactorization b p factors) + (hinfinitePrime : ∀ c : Series K, + Irreducible c → (c : K⟦ℝ⟧).support.Infinite → Prime c) : + DecompositionMonoid (Series K) := by + constructor + intro b + by_cases hb : b = 0 + · subst b + exact isPrimal_zero + · obtain ⟨p, factors, hfactorization⟩ := hfactorization b hb + have hfactorization' := + (isInfiniteSupportIrreducibleFactorization_iff b p factors).mp hfactorization + rw [hfactorization'.1] + exact (hfinitePrimal p).mul + (list_prod_isPrimal_of_prime factors fun c hc ↦ + hinfinitePrime c (hfactorization'.2 c hc).1 (hfactorization'.2 c hc).2) + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PrincipalMaximalFinite.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PrincipalMaximalFinite.lean new file mode 100644 index 0000000000..db2be30e9d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PrincipalMaximalFinite.lean @@ -0,0 +1,195 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GradedDivisibility + +/-! +# Maximal finite-support divisors and principal factors + +This module proves the field-generic cores of LM24, Lemmas 6.3.1--6.3.2. Multiplication by a +nonzero element of `P̂` is injective. Under the intrinsic tensor +decomposition, it acts only on the principal tensor factor, so it preserves tensor content and +hence the maximal finite-support divisor. + +The RV result is obtained from the full graded result through the canonical RV embedding. +Finite-support greatest-common-divisor existence remains an explicit hypothesis; the coefficient +field has characteristic zero. +-/ + +open scoped DirectSum HahnSeries NatOrdinal TensorProduct + +universe v + +namespace Berarducci + +public noncomputable section + +open HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +private theorem principalSubringMulLeft_injective {c : PrincipalSubring K} (hc : c ≠ 0) : + Function.Injective (LinearMap.mulLeft K c) := by + intro x y hxy + change c * x = c * y at hxy + apply principalSubringEmbedding_injective K + have hcImage : principalSubringEmbedding K c ≠ 0 := by + intro hzero + apply hc + exact principalSubringEmbedding_injective K + (hzero.trans (map_zero (principalSubringEmbedding K)).symm) + apply mul_left_cancel₀ hcImage + simpa only [map_mul] using + congrArg (principalSubringEmbedding K) hxy + +private theorem principalSubringTensorEquiv_mulLeft_rTensor (c : PrincipalSubring K) + (z : PrincipalSubring K ⊗[K] FiniteSupportRing (K := K)) : + principalSubringTensorEquiv K + ((LinearMap.mulLeft K c).rTensor (FiniteSupportRing (K := K)) z) = + principalSubringEmbedding K c * + principalSubringTensorEquiv K z := by + induction z using TensorProduct.induction_on with + | zero => simp + | tmul x p => + rw [LinearMap.rTensor_tmul, + principalSubringTensorEquiv_tmul, + principalSubringTensorEquiv_tmul] + change principalSubringEmbedding K (c * x) * + finiteSupportGradedEmbedding K p = _ + rw [map_mul] + exact mul_assoc _ _ _ + | add x y hx hy => simp [map_add, hx, hy, mul_add] + +/-- Multiplication by a nonzero componentwise-principal graded element preserves the intrinsic +maximal finite-support divisor predicate. -/ +theorem isGradedMaximalFiniteSupportDivisor_mul_principal_iff (B : DegreeGraded K) + {C : DegreeGraded K} + (hC : IsPrincipalGraded C) (hC0 : C ≠ 0) + (a : Associates (FiniteSupportRing (K := K))) : + IsGradedMaximalFiniteSupportDivisor (B * C) a ↔ + IsGradedMaximalFiniteSupportDivisor B a := by + rw [isPrincipalGraded_iff] at hC + let c := rvProjection K C + have hc : principalSubringEmbedding K c = C := by + apply DirectSum.ext + intro α + rw [principalSubringEmbedding_apply, rvProjection_apply] + exact + principalComponentToHahnDegreeLayer_degreeLayerToPrincipalComponent_of_isPrincipal + α (C α) (hC α) + have hc0 : c ≠ 0 := by + intro hzero + apply hC0 + rw [← hc, hzero, map_zero] + let e := principalSubringTensorEquiv K + let z := e.symm B + let f := LinearMap.mulLeft K c + have hef : e (f.rTensor (FiniteSupportRing (K := K)) z) = B * C := by + calc + e (f.rTensor (FiniteSupportRing (K := K)) z) = + principalSubringEmbedding K c * e z := by + exact principalSubringTensorEquiv_mulLeft_rTensor c z + _ = C * B := by rw [hc, e.apply_symm_apply] + _ = B * C := mul_comm _ _ + have hpreimage : + e.symm (B * C) = f.rTensor (FiniteSupportRing (K := K)) z := by + apply e.injective + rw [e.apply_symm_apply, hef] + rw [← isContent_principalGradedTensorEquiv_symm_iff (B * C) a, + ← isContent_principalGradedTensorEquiv_symm_iff B a, + hpreimage] + exact TensorProduct.isContent_rTensor_iff_of_injective + f (principalSubringMulLeft_injective hc0) z a + +/-- Multiplication by a nonzero componentwise-principal graded element preserves the canonical +maximal finite-support divisor class, assuming pairwise greatest-common-divisor existence. -/ +theorem gradedMaximalFiniteSupportDivisor_mul_principal_eq_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (B : DegreeGraded K) + {C : DegreeGraded K} + (hC : IsPrincipalGraded C) (hC0 : C ≠ 0) : + gradedMaximalFiniteSupportDivisor (B * C) = + gradedMaximalFiniteSupportDivisor B := by + exact IsGradedMaximalFiniteSupportDivisor.eq + (gradedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd (B * C)) + ((isGradedMaximalFiniteSupportDivisor_mul_principal_iff B hC hC0 _).mpr + (gradedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd B)) + +/-- Multiplication by a nonzero componentwise-principal graded element preserves the normalized +maximal finite-support divisor, assuming pairwise greatest-common-divisor existence. This is the +field-generic core of LM24, Lemma 6.3.2. -/ +theorem gradedNormalizedMaximalFiniteSupportDivisor_mul_principal_eq_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (B : DegreeGraded K) + {C : DegreeGraded K} + (hC : IsPrincipalGraded C) (hC0 : C ≠ 0) : + gradedNormalizedMaximalFiniteSupportDivisor (B * C) = + gradedNormalizedMaximalFiniteSupportDivisor B := by + rw [gradedNormalizedMaximalFiniteSupportDivisor_eq_normalizedRepresentative, + gradedNormalizedMaximalFiniteSupportDivisor_eq_normalizedRepresentative, + gradedMaximalFiniteSupportDivisor_mul_principal_eq_of_exists_gcd hgcd B hC hC0] + +/-- Multiplication by a nonzero componentwise-principal graded element neither creates nor +destroys divisibility by an embedded finite-support series. -/ +theorem finiteSupportGradedEmbedding_dvd_mul_principal_iff_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (p : FiniteSupportRing (K := K)) + (B : DegreeGraded K) + {C : DegreeGraded K} + (hC : IsPrincipalGraded C) (hC0 : C ≠ 0) : + finiteSupportGradedEmbedding K p ∣ B * C ↔ + finiteSupportGradedEmbedding K p ∣ B := by + have hmaxBC := + gradedNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd (B * C) + have hmaxB := + gradedNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd B + have hmaxBC' := + (isNormalizedGradedMaximalFiniteSupportDivisor_iff _ _).mp hmaxBC + have hmaxB' := + (isNormalizedGradedMaximalFiniteSupportDivisor_iff _ _).mp hmaxB + rw [hmaxBC'.1 p, hmaxB'.1 p, + gradedNormalizedMaximalFiniteSupportDivisor_mul_principal_eq_of_exists_gcd hgcd B hC hC0] + +/-- Multiplication by a nonzero principal RV class preserves the normalized maximal +finite-support divisor of its canonical graded image. This is the field-generic core of LM24, +Lemma 6.3.1. -/ +theorem gradedNormalizedMaximalFiniteSupportDivisor_rv_mul_principal_eq_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (B : HahnDegreeRV K) {C : HahnDegreeRV K} + (hC : IsPrincipalRV C) (hC0 : C ≠ 0) : + gradedNormalizedMaximalFiniteSupportDivisor + ((degreeValuation K).rvInitialFormHom (B * C)) = + gradedNormalizedMaximalFiniteSupportDivisor + ((degreeValuation K).rvInitialFormHom B) := by + let w := degreeValuation K + have hCImage := isPrincipalRVImage_initialForm C hC + have hCPrincipal := (isPrincipalRVImage_iff (w.rvInitialFormHom C)).mp + hCImage |>.2.2 + have hCImage0 : w.rvInitialFormHom C ≠ 0 := by + intro hzero + apply hC0 + apply w.rvInitialFormHom_injective + simpa using hzero + rw [map_mul] + exact gradedNormalizedMaximalFiniteSupportDivisor_mul_principal_eq_of_exists_gcd hgcd + (w.rvInitialFormHom B) hCPrincipal hCImage0 + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PrincipalSubringLocalization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PrincipalSubringLocalization.lean new file mode 100644 index 0000000000..3c94a3350c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PrincipalSubringLocalization.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringLocalization + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalMaximalFinite + +/-! +# Finite-support divisibility and principal graded localization + +The localization of `RV̂` at the nonzero elements of `P̂` does not create new divisibility +relations by finite-support series. For the nontrivial direction, clear a principal denominator +and then use the field-generic core of LM24, Lemma 6.3.2, to remove that denominator. + +This is the precise localization step used in the proof of LM24, Corollary 6.3.6. +-/ + +open scoped HahnSeries + +universe v + +namespace Berarducci + +public noncomputable section + +open HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +/-- Divisibility by an embedded finite-support series is reflected by localization at nonzero +principal graded factors. -/ +theorem principalSubringLocalizationMap_finiteSupport_dvd_iff_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (p : FiniteSupportRing (K := K)) + (B : DegreeGraded K) : + principalSubringFractionScalarExtension K p ∣ + principalSubringLocalizationMap K B ↔ + finiteSupportGradedEmbedding K p ∣ B := by + constructor + · intro hp + obtain ⟨X, d, hd, hclear⟩ := + principalSubringLocalization_exists_finiteSupport_dvd_mul_principal hp + have hdivPrincipal : + finiteSupportGradedEmbedding K p ∣ + B * principalSubringEmbedding K d := + ⟨X, hclear⟩ + have hdPrincipal : + IsPrincipalGraded + (principalSubringEmbedding K d) := + principalSubringEmbedding_isPrincipal d + have hdImage : principalSubringEmbedding K d ≠ 0 := by + intro hzero + apply hd + apply principalSubringEmbedding_injective K + simpa using hzero + exact + (finiteSupportGradedEmbedding_dvd_mul_principal_iff_of_exists_gcd hgcd p B hdPrincipal + hdImage).mp hdivPrincipal + · exact principalSubringLocalizationMap_finiteSupport_dvd + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PrincipalSubringPrimality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PrincipalSubringPrimality.lean new file mode 100644 index 0000000000..6063d3be41 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PrincipalSubringPrimality.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringLocalization + +/-! +# Primality of finite-support elements in the degree-graded ring + +This module proves the field-generic core of LM24, Corollary 6.3.6. A factorisation supplied in +the localization of `RV̂` is scalar-redistributed to the original coefficient field. Clearing its +two principal denominators and applying LM24, Lemma 6.3.2, then recovers divisibility in `RV̂`. + +The stronger theorem retains both factors as elements of the finite-support ring. Primality of the +embedded element is derived from that witness theorem. +-/ + +open scoped HahnSeries + +universe v + +namespace Berarducci + +public noncomputable section + +open HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +/-- A finite-support divisor of a product in `RV̂` factors into finite-support divisors of the +two factors, assuming scalar redistribution and pairwise greatest-common-divisor existence over +both coefficient fields. -/ +theorem finiteSupportGradedEmbedding_exists_factor_dvd_of_scalarRedistribution + (hgcdK : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hgcdL : ∀ p q : PrincipalSubringFractionFiniteSupportRing K, + ∃ d : PrincipalSubringFractionFiniteSupportRing K, + ∀ e : PrincipalSubringFractionFiniteSupportRing K, + e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hredistribute : PrincipalSubringFractionScalarRedistribution K) + (p : FiniteSupportRing (K := K)) + (B C : DegreeGraded K) + (hp : finiteSupportGradedEmbedding K p ∣ B * C) : + ∃ p₁ p₂ : FiniteSupportRing (K := K), + p = p₁ * p₂ ∧ + finiteSupportGradedEmbedding K p₁ ∣ B ∧ + finiteSupportGradedEmbedding K p₂ ∣ C := by + have hpLocalized := + principalSubringLocalizationMap_finiteSupport_dvd_mul hp + obtain ⟨p₁, p₂, hpFactors, hp₁, hp₂⟩ := + principalSubringFractionScalarExtension_exists_factor_dvd_of_scalarRedistribution hredistribute + hgcdL p + (principalSubringLocalizationMap K B) + (principalSubringLocalizationMap K C) hpLocalized + refine ⟨p₁, p₂, hpFactors, ?_, ?_⟩ + · exact + (principalSubringLocalizationMap_finiteSupport_dvd_iff_of_exists_gcd hgcdK p₁ B).mp hp₁ + · exact + (principalSubringLocalizationMap_finiteSupport_dvd_iff_of_exists_gcd hgcdK p₂ C).mp hp₂ + +/-- Every embedded finite-support element is primal in `RV̂` under the same explicit +prerequisites. -/ +theorem finiteSupportGradedEmbedding_isPrimal_of_scalarRedistribution + (hgcdK : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hgcdL : ∀ p q : PrincipalSubringFractionFiniteSupportRing K, + ∃ d : PrincipalSubringFractionFiniteSupportRing K, + ∀ e : PrincipalSubringFractionFiniteSupportRing K, + e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hredistribute : PrincipalSubringFractionScalarRedistribution K) + (p : FiniteSupportRing (K := K)) : + IsPrimal (finiteSupportGradedEmbedding K p) := by + intro B C hp + obtain ⟨p₁, p₂, hpFactors, hp₁, hp₂⟩ := + finiteSupportGradedEmbedding_exists_factor_dvd_of_scalarRedistribution hgcdK hgcdL + hredistribute p B C hp + refine ⟨finiteSupportGradedEmbedding K p₁, + finiteSupportGradedEmbedding K p₂, hp₁, hp₂, ?_⟩ + rw [hpFactors, map_mul] + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/RVGradedMaximalFinite.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/RVGradedMaximalFinite.lean new file mode 100644 index 0000000000..54c741f540 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/RVGradedMaximalFinite.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility + +/-! +# Maximal finite-support divisors under the RV-to-graded embedding + +The canonical multiplicative embedding of degree RV into the associated graded ring preserves +and reflects divisibility. Consequently it also preserves the intrinsic maximal finite-support +divisor class. +-/ + +open scoped HahnSeries + +universe v + +namespace Berarducci + +public noncomputable section + +open HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +/-- A maximal finite-support divisor class of an RV element is equivalently a maximal +finite-support divisor class of its canonical image in the associated graded ring. -/ +theorem isRVMaximalFiniteSupportDivisor_iff_isGradedMaximalFiniteSupportDivisor (B : HahnDegreeRV K) + (a : Associates (FiniteSupportRing (K := K))) : + IsRVMaximalFiniteSupportDivisor B a ↔ + IsGradedMaximalFiniteSupportDivisor + ((degreeValuation K).rvInitialFormHom B) a := by + let w := degreeValuation K + rw [isRVMaximalFiniteSupportDivisor_iff, + isGradedMaximalFiniteSupportDivisor_iff] + constructor <;> intro h q + · rw [h q] + have htransport := + w.rv_dvd_iff_associatedGraded_dvd (finiteSupportRVEmbedding K q) B + have hfinite : + w.rvInitialFormHom (finiteSupportRVEmbedding K q) = + finiteSupportGradedEmbedding K q := by + calc + w.rvInitialFormHom (finiteSupportRVEmbedding K q) = + ((w.rvEquivHomogeneous (finiteSupportRVEmbedding K q) : + w.HomogeneousClasses) : w.AssociatedGraded) := by + rw [w.rvEquivHomogeneous_apply, w.coe_rvHomogeneous] + _ = finiteSupportGradedEmbedding K q := by + simpa only [w] using + coe_rvEquivHomogeneous_finiteSupportRVEmbedding q + rw [hfinite] at htransport + exact htransport + · rw [h q] + have htransport := + w.rv_dvd_iff_associatedGraded_dvd (finiteSupportRVEmbedding K q) B + have hfinite : + w.rvInitialFormHom (finiteSupportRVEmbedding K q) = + finiteSupportGradedEmbedding K q := by + calc + w.rvInitialFormHom (finiteSupportRVEmbedding K q) = + ((w.rvEquivHomogeneous (finiteSupportRVEmbedding K q) : + w.HomogeneousClasses) : w.AssociatedGraded) := by + rw [w.rvEquivHomogeneous_apply, w.coe_rvHomogeneous] + _ = finiteSupportGradedEmbedding K q := by + simpa only [w] using + coe_rvEquivHomogeneous_finiteSupportRVEmbedding q + rw [hfinite] at htransport + exact htransport.symm + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/RVMaximalFinite.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/RVMaximalFinite.lean new file mode 100644 index 0000000000..576d436b13 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/RVMaximalFinite.lean @@ -0,0 +1,575 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.MaximalDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFinite + +/-! +# Maximal finite-support divisors in RV + +This module works with the actual multiplicative RV quotient attached to Hahn-series degree. It +defines the finite-support embedding into RV and proves that divisibility in RV agrees with the +fixed-component divisibility used by the tensor-content construction. + +Consequently every RV class has a unique intrinsic maximal finite-support divisor in +`Associates K(ℝ^{≤ 0})`, assuming only pairwise gcd existence in the finite-support ring. This +is the associate-class form of LM24, Proposition 5.4.3. In particular, the source statement is +not silently replaced by divisibility in the full associated graded ring. +-/ + +open scoped DirectSum HahnSeries NatOrdinal + +universe v + +namespace Berarducci + +public noncomputable section + +open HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +private theorem directSum_index_eq_of_of_eq {ι : Type*} [DecidableEq ι] + {A : ι → Type*} [∀ i, AddCommMonoid (A i)] + {i j : ι} {x : A i} {y : A j} + (hx : x ≠ 0) (h : DirectSum.of A i x = DirectSum.of A j y) : i = j := by + by_contra hij + have hvalue := congrArg (fun z : DirectSum ι A ↦ z i) h + rw [DirectSum.of_eq_same, + DirectSum.of_eq_of_ne j i y hij] at hvalue + exact hx hvalue + +variable (K) in +/-- The RV monoid attached to the multiplicative Hahn-series degree valuation. -/ +abbrev HahnDegreeRV := + (HahnSeries.Nonpositive.degreeValuation K).RV + +variable (K) in +/-- The finite-support ring embeds multiplicatively into degree RV. -/ +def finiteSupportRVEmbedding : + FiniteSupportRing (K := K) →*₀ HahnDegreeRV K where + toFun p := + (HahnSeries.Nonpositive.degreeValuation K).rv (p : Series K) + map_one' := map_one _ + map_mul' p q := by + change (HahnSeries.Nonpositive.degreeValuation K).rv + ((p : Series K) * (q : Series K)) = _ + rw [map_mul] + map_zero' := + (HahnSeries.Nonpositive.degreeValuation K).rv_zero + +/-- The finite-support RV embedding is the RV quotient map on the underlying Hahn series. -/ +@[simp] +theorem finiteSupportRVEmbedding_apply (p : FiniteSupportRing (K := K)) : + finiteSupportRVEmbedding K p = + (HahnSeries.Nonpositive.degreeValuation K).rv (p : Series K) := + (rfl) + +/-- Under the RV/homogeneous equivalence, the finite-support RV embedding agrees with the +grade-zero embedding into the associated graded ring. -/ +theorem coe_rvEquivHomogeneous_finiteSupportRVEmbedding (p : FiniteSupportRing (K := K)) : + (((HahnSeries.Nonpositive.degreeValuation K).rvEquivHomogeneous + (finiteSupportRVEmbedding K p) : + (HahnSeries.Nonpositive.degreeValuation K).HomogeneousClasses) : + DegreeGraded K) = + finiteSupportGradedEmbedding K p := by + rw [finiteSupportRVEmbedding_apply] + rw [coe_rvEquivHomogeneous_rv_eq_residueRingHom_finiteSupportResidueEquiv + (w := HahnSeries.Nonpositive.degreeValuation K) + (HahnSeries.Nonpositive.degreeValuation_apply) p] + rw [(HahnSeries.Nonpositive.degreeValuation K).residueRingHom_apply, + finiteSupportGradedEmbedding_apply, + degreeFiniteSupportResidueEquiv_apply, + finiteSupportResidueEquiv_apply] + +variable (K) in +/-- The finite-support embedding into degree RV is injective. -/ +theorem finiteSupportRVEmbedding_injective : + Function.Injective (finiteSupportRVEmbedding K) := by + intro p q hpq + apply finiteSupportGradedEmbedding_injective K + rw [← coe_rvEquivHomogeneous_finiteSupportRVEmbedding p, + ← coe_rvEquivHomogeneous_finiteSupportRVEmbedding q, + hpq] + +/-- The homogeneous graded class corresponding to the RV class of a finite-support series. -/ +def finiteSupportHomogeneousClass (p : FiniteSupportRing (K := K)) : + (HahnSeries.Nonpositive.degreeValuation K).HomogeneousClasses := + (HahnSeries.Nonpositive.degreeValuation K).rvHomogeneous + (finiteSupportRVEmbedding K p) + +/-- Evaluation of the finite-support homogeneous class. -/ +@[simp] +theorem finiteSupportHomogeneousClass_apply (p : FiniteSupportRing (K := K)) : + finiteSupportHomogeneousClass p = + (HahnSeries.Nonpositive.degreeValuation K).rvHomogeneous + (finiteSupportRVEmbedding K p) := + (rfl) + +/-- The finite-support homogeneous class has the expected grade-zero image. -/ +theorem coe_finiteSupportHomogeneousClass (p : FiniteSupportRing (K := K)) : + (finiteSupportHomogeneousClass p : + DegreeGraded K) = + finiteSupportGradedEmbedding K p := + by + rw [finiteSupportHomogeneousClass_apply, + ← (HahnSeries.Nonpositive.degreeValuation K).rvEquivHomogeneous_apply] + exact coe_rvEquivHomogeneous_finiteSupportRVEmbedding p + +/-- A fixed component, regarded as an element of the monoid of homogeneous graded classes. -/ +def degreeHomogeneousClass (α : NatOrdinal) + (B : (HahnSeries.Nonpositive.degreeValuation K).Component α) : + (HahnSeries.Nonpositive.degreeValuation K).HomogeneousClasses := + ⟨DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component α B, + (MaxAddDegree.mem_homogeneousClasses_iff + (HahnSeries.Nonpositive.degreeValuation K) _).mpr + (Or.inr ⟨α, B, rfl⟩)⟩ + +omit [CharZero K] in +/-- The underlying graded element of a fixed homogeneous class. -/ +@[simp] +theorem coe_degreeHomogeneousClass (α : NatOrdinal) + (B : (HahnSeries.Nonpositive.degreeValuation K).Component α) : + (degreeHomogeneousClass α B : DegreeGraded K) = + DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component α B := + (rfl) + +/-- Multiplication of a finite-support homogeneous class with a fixed homogeneous class is the +degree-zero residue action on that component. -/ +theorem finiteSupportHomogeneousClass_mul_degreeHomogeneousClass + (q : FiniteSupportRing (K := K)) (α : NatOrdinal) + (C : (HahnSeries.Nonpositive.degreeValuation K).Component α) : + finiteSupportHomogeneousClass q * degreeHomogeneousClass α C = + degreeHomogeneousClass α + (HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K q • C) := by + apply Subtype.ext + rw [Submonoid.coe_mul, + coe_finiteSupportHomogeneousClass, + coe_degreeHomogeneousClass, + coe_degreeHomogeneousClass] + exact finiteSupportGradedEmbedding_mul_of q α C + +/-- The RV class of a series of exact degree `α` corresponds to its class in the degree-`α` +homogeneous component. -/ +theorem rvEquivHomogeneous_rv_eq_degreeHomogeneousClass (α : NatOrdinal) (p : Series K) + (hpDegree : (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) : + (HahnSeries.Nonpositive.degreeValuation K).rvEquivHomogeneous + ((HahnSeries.Nonpositive.degreeValuation K).rv p) = + degreeHomogeneousClass α + (degreeLayerMk α p hpDegree.le) := by + let w := HahnSeries.Nonpositive.degreeValuation K + let pLE : w.filtrationLE α := + ⟨p, (w.mem_filtrationLE_iff α p).mpr (by + rw [HahnSeries.Nonpositive.degreeValuation_apply, hpDegree])⟩ + have hpComponent : w.componentMk α pLE ≠ 0 := by + intro hzero + have hlt := (w.componentMk_eq_zero_iff α pLE).mp hzero + rw [HahnSeries.Nonpositive.degreeValuation_apply, hpDegree] at hlt + exact lt_irrefl _ hlt + apply Subtype.ext + rw [w.rvEquivHomogeneous_apply, w.coe_rvHomogeneous, w.rvInitialFormHom_rv] + calc + w.initialForm p = w.homogeneousMk α pLE := + w.initialForm_eq_homogeneousMk_of_componentMk_ne_zero α pLE hpComponent + _ = DirectSum.of w.Component α (w.componentMk α pLE) := + w.homogeneousMk_apply α pLE + _ = DirectSum.of w.Component α (degreeLayerMk α p hpDegree.le) := by + apply congrArg (DirectSum.of w.Component α) + exact (degreeLayerMk_eq_componentMk α p hpDegree.le).symm + +/-- LM24, Definition 5.2.1: an RV class is principal when it has a principal Hahn-series +representative. Zero is deliberately excluded because principal series are nonzero. -/ +def IsPrincipalRV (B : HahnDegreeRV K) : Prop := + ∃ p : Series K, HahnSeries.Nonpositive.IsPrincipal p ∧ + B = (HahnSeries.Nonpositive.degreeValuation K).rv p + +/-- Characterization of a principal RV class by a principal representative. -/ +theorem isPrincipalRV_iff (B : HahnDegreeRV K) : + IsPrincipalRV B ↔ + ∃ p : Series K, HahnSeries.Nonpositive.IsPrincipal p ∧ + B = (HahnSeries.Nonpositive.degreeValuation K).rv p := + Iff.rfl + +/-- An RV class is principal in the sense of LM24, Definition 5.2.1 exactly when its homogeneous +image is a nonzero principal vector in one degree component. -/ +theorem isPrincipalRV_iff_exists_degreeHomogeneousClass (B : HahnDegreeRV K) : + IsPrincipalRV B ↔ + ∃ (α : NatOrdinal) + (C : (HahnSeries.Nonpositive.degreeValuation K).Component α), + C ≠ 0 ∧ IsPrincipalDegreeClass α C ∧ + (HahnSeries.Nonpositive.degreeValuation K).rvEquivHomogeneous B = + degreeHomogeneousClass α C := by + let w := HahnSeries.Nonpositive.degreeValuation K + constructor + · rintro ⟨p, hp, rfl⟩ + have hpDegreeNe : (p : K⟦ℝ⟧).degree ≠ ⊥ := by + intro hbot + exact hp.ne_zero (Subtype.ext (HahnSeries.degree_eq_bot.mp hbot)) + let α := (p : K⟦ℝ⟧).degree.unbot hpDegreeNe + have hpDegree : (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal) := + (WithBot.coe_unbot _ hpDegreeNe).symm + let C := degreeLayerMk α p hpDegree.le + have hC : C ≠ 0 := by + intro hzero + have hlt := (degreeLayerMk_eq_zero_iff α p hpDegree.le).mp hzero + rw [hpDegree] at hlt + exact lt_irrefl _ hlt + refine ⟨α, C, hC, + (isPrincipalDegreeClass_iff α C).mpr + (Or.inr ⟨p, hp, hpDegree, rfl⟩), ?_⟩ + exact rvEquivHomogeneous_rv_eq_degreeHomogeneousClass α p hpDegree + · rintro ⟨α, C, hC, hCPrincipal, hB⟩ + rcases (isPrincipalDegreeClass_iff α C).mp hCPrincipal with + hCzero | ⟨p, hp, hpDegree, hCp⟩ + · exact (hC hCzero).elim + · refine ⟨p, hp, ?_⟩ + apply w.rvEquivHomogeneous.injective + calc + w.rvEquivHomogeneous B = degreeHomogeneousClass α C := hB + _ = degreeHomogeneousClass α + (degreeLayerMk α p hpDegree.le) := + congrArg (degreeHomogeneousClass α) hCp + _ = w.rvEquivHomogeneous (w.rv p) := + (rvEquivHomogeneous_rv_eq_degreeHomogeneousClass α p hpDegree).symm + +/-- Divisibility of a fixed homogeneous class by a finite-support class is exactly scalar +divisibility in that fixed component. -/ +theorem finiteSupportHomogeneousClass_dvd_degreeHomogeneousClass_iff + (q : FiniteSupportRing (K := K)) (α : NatOrdinal) + (B : (HahnSeries.Nonpositive.degreeValuation K).Component α) : + finiteSupportHomogeneousClass q ∣ + degreeHomogeneousClass α B ↔ + ∃ C : + (HahnSeries.Nonpositive.degreeValuation K).Component α, + HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K q • C = B := by + by_cases hB : B = 0 + · subst B + constructor + · intro _ + refine ⟨0, ?_⟩ + let w := HahnSeries.Nonpositive.degreeValuation K + apply DirectSum.of_injective (β := w.Component) α + rw [DirectSum.of_zero_smul, map_zero, mul_zero] + · rintro ⟨C, hC⟩ + refine ⟨degreeHomogeneousClass α C, ?_⟩ + apply Subtype.ext + change DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component + α 0 = + (finiteSupportHomogeneousClass q : + DegreeGraded K) * + (degreeHomogeneousClass α C : DegreeGraded K) + rw [coe_finiteSupportHomogeneousClass, + finiteSupportGradedEmbedding_apply, + coe_degreeHomogeneousClass, + ← DirectSum.of_zero_smul, hC, map_zero] + · constructor + · rintro ⟨H, hH⟩ + have hHCoe := congrArg Subtype.val hH + have hHmem := + (MaxAddDegree.mem_homogeneousClasses_iff + (HahnSeries.Nonpositive.degreeValuation K) + (H : DegreeGraded K)).mp H.2 + rcases hHmem with hzero | ⟨β, C, hC⟩ + · have hOfZero : DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component + α B = 0 := by + change DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component + α B = + (finiteSupportHomogeneousClass q : + DegreeGraded K) * + (H : DegreeGraded K) at hHCoe + simpa [hzero] using hHCoe + apply (hB ?_).elim + apply DirectSum.of_injective α + simpa using hOfZero + · have hHrepr : H = degreeHomogeneousClass β C := + Subtype.ext hC + subst H + change DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component + α B = + (finiteSupportHomogeneousClass q : + DegreeGraded K) * + (degreeHomogeneousClass β C : DegreeGraded K) + at hHCoe + rw [coe_finiteSupportHomogeneousClass, + coe_degreeHomogeneousClass, + finiteSupportGradedEmbedding_mul_of] at hHCoe + have hαβ : α = β := directSum_index_eq_of_of_eq hB hHCoe + subst β + exact ⟨C, ((DirectSum.of_injective α) hHCoe).symm⟩ + · rintro ⟨C, hC⟩ + refine ⟨degreeHomogeneousClass α C, ?_⟩ + rw [finiteSupportHomogeneousClass_mul_degreeHomogeneousClass, hC] + +/-- Divisibility is preserved and reflected by the multiplicative equivalence from RV to +homogeneous graded classes. -/ +theorem finiteSupportRVEmbedding_dvd_iff_homogeneous + (q : FiniteSupportRing (K := K)) (B : HahnDegreeRV K) : + finiteSupportRVEmbedding K q ∣ B ↔ + finiteSupportHomogeneousClass q ∣ + (HahnSeries.Nonpositive.degreeValuation K).rvEquivHomogeneous B := by + let e := + (HahnSeries.Nonpositive.degreeValuation K).rvEquivHomogeneous + constructor + · rintro ⟨C, hC⟩ + refine ⟨(HahnSeries.Nonpositive.degreeValuation K).rvHomogeneous C, + ?_⟩ + apply Subtype.ext + rw [(HahnSeries.Nonpositive.degreeValuation K).rvEquivHomogeneous_apply, + (HahnSeries.Nonpositive.degreeValuation K).coe_rvHomogeneous] + change + (HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom B = + (finiteSupportHomogeneousClass q : DegreeGraded K) * + ((HahnSeries.Nonpositive.degreeValuation K).rvHomogeneous C : + DegreeGraded K) + rw [finiteSupportHomogeneousClass_apply, + (HahnSeries.Nonpositive.degreeValuation K).coe_rvHomogeneous + (finiteSupportRVEmbedding K q), + (HahnSeries.Nonpositive.degreeValuation K).coe_rvHomogeneous C] + rw [← (HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom.map_mul, hC] + · rintro ⟨H, hH⟩ + refine ⟨e.symm H, ?_⟩ + apply (HahnSeries.Nonpositive.degreeValuation K).rvHomogeneous_injective + have hsymm : + (HahnSeries.Nonpositive.degreeValuation K).rvHomogeneous + (e.symm H) = H := by + rw [← (HahnSeries.Nonpositive.degreeValuation K).rvEquivHomogeneous_apply, e.apply_symm_apply] + apply Subtype.ext + have hHCoe := congrArg Subtype.val hH + rw [(HahnSeries.Nonpositive.degreeValuation K).rvEquivHomogeneous_apply, + (HahnSeries.Nonpositive.degreeValuation K).coe_rvHomogeneous] at hHCoe + change + (HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom B = + (finiteSupportHomogeneousClass q : DegreeGraded K) * + (H : DegreeGraded K) at hHCoe + rw [finiteSupportHomogeneousClass_apply, + (HahnSeries.Nonpositive.degreeValuation K).coe_rvHomogeneous + (finiteSupportRVEmbedding K q)] at hHCoe + rw [(HahnSeries.Nonpositive.degreeValuation K).coe_rvHomogeneous B, + (HahnSeries.Nonpositive.degreeValuation K).coe_rvHomogeneous + (finiteSupportRVEmbedding K q * e.symm H)] + change + (HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom B = + (HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom + (finiteSupportRVEmbedding K q * e.symm H) + rw [(HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom.map_mul] + have hsymmCoe := congrArg Subtype.val hsymm + rw [(HahnSeries.Nonpositive.degreeValuation K).coe_rvHomogeneous (e.symm H)] at hsymmCoe + change + (HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom + (e.symm H) = (H : DegreeGraded K) at hsymmCoe + rw [hsymmCoe] + exact hHCoe + +/-- An associate class records exactly the finite-support divisors of an RV class. This is the +intrinsic predicate underlying LM24, Proposition 5.4.3. -/ +def IsRVMaximalFiniteSupportDivisor (B : HahnDegreeRV K) + (a : Associates (FiniteSupportRing (K := K))) : Prop := + IsMaximalDivisorAlong + (finiteSupportRVEmbedding K).toMonoidHom B a + +/-- The defining divisibility characterization for a maximal finite-support divisor in RV. -/ +theorem isRVMaximalFiniteSupportDivisor_iff (B : HahnDegreeRV K) + (a : Associates (FiniteSupportRing (K := K))) : + IsRVMaximalFiniteSupportDivisor B a ↔ + ∀ q : FiniteSupportRing (K := K), Associates.mk q ≤ a ↔ + (finiteSupportRVEmbedding K).toMonoidHom q ∣ B := by + rw [IsRVMaximalFiniteSupportDivisor, + isMaximalDivisorAlong_iff] + +/-- Representative form of the maximal-divisor characterization used in LM24, +Proposition 5.4.3. -/ +theorem isRVMaximalFiniteSupportDivisor_mk_iff + (B : HahnDegreeRV K) (p : FiniteSupportRing (K := K)) : + IsRVMaximalFiniteSupportDivisor B (Associates.mk p) ↔ + ∀ q : FiniteSupportRing (K := K), + finiteSupportRVEmbedding K q ∣ B ↔ q ∣ p := by + rw [isRVMaximalFiniteSupportDivisor_iff] + constructor + · intro h q + constructor + · intro hqB + exact Associates.mk_le_mk_iff_dvd.mp ((h q).mpr hqB) + · intro hqp + exact (h q).mp (Associates.mk_le_mk_iff_dvd.mpr hqp) + · intro h q + constructor + · intro hqp + exact (h q).mpr (Associates.mk_le_mk_iff_dvd.mp hqp) + · intro hqB + exact Associates.mk_le_mk_iff_dvd.mpr ((h q).mp hqB) + +/-- An RV class has at most one maximal finite-support divisor class. -/ +theorem IsRVMaximalFiniteSupportDivisor.eq {B : HahnDegreeRV K} + {a b : Associates (FiniteSupportRing (K := K))} + (ha : IsRVMaximalFiniteSupportDivisor B a) + (hb : IsRVMaximalFiniteSupportDivisor B b) : a = b := by + exact IsMaximalDivisorAlong.eq ha hb + +/-- Pairwise gcd existence gives a unique maximal finite-support divisor class for every RV +class. -/ +theorem existsUnique_isRVMaximalFiniteSupportDivisor_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (B : HahnDegreeRV K) : + ∃! a : Associates (FiniteSupportRing (K := K)), + IsRVMaximalFiniteSupportDivisor B a := by + let w := HahnSeries.Nonpositive.degreeValuation K + let e := w.rvEquivHomogeneous + by_cases hB : B = 0 + · subst B + refine ⟨0, ?_, ?_⟩ + · exact IsMaximalDivisorAlong.zero + (finiteSupportRVEmbedding K).toMonoidHom + · intro a ha + exact IsRVMaximalFiniteSupportDivisor.eq ha + (IsMaximalDivisorAlong.zero + (finiteSupportRVEmbedding K).toMonoidHom) + · have hEB : e B ≠ 0 := by + intro hzero + apply hB + apply e.injective + rw [w.rvEquivHomogeneous_zero] + exact hzero + have hEBmem := (w.mem_homogeneousClasses_iff (e B : w.AssociatedGraded)).mp (e B).2 + rcases hEBmem with hzero | ⟨α, C, hC⟩ + · exact (hEB (Subtype.ext hzero)).elim + · obtain ⟨a, ha, hunique⟩ := + existsUnique_isLayerMaximalFiniteSupportDivisor_of_exists_gcd hgcd α C + have hEBrepr : e B = degreeHomogeneousClass α C := + Subtype.ext hC + refine ⟨a, ?_, ?_⟩ + · apply (isRVMaximalFiniteSupportDivisor_iff B a).mpr + intro q + change Associates.mk q ≤ a ↔ finiteSupportRVEmbedding K q ∣ B + rw [finiteSupportRVEmbedding_dvd_iff_homogeneous, + hEBrepr, + finiteSupportHomogeneousClass_dvd_degreeHomogeneousClass_iff] + exact (isLayerMaximalFiniteSupportDivisor_iff α C a).mp ha q + · intro b hb + apply hunique b + apply (isLayerMaximalFiniteSupportDivisor_iff α C b).mpr + intro q + rw [← finiteSupportHomogeneousClass_dvd_degreeHomogeneousClass_iff, + ← hEBrepr, + ← finiteSupportRVEmbedding_dvd_iff_homogeneous] + exact (isRVMaximalFiniteSupportDivisor_iff B b).mp hb q + +/-- If `a` is principal of degree `α` and `p` is a nonzero finite-support series, then the +RV class of `p * a` has maximal finite-support divisor class represented by `p`. -/ +theorem isRVMaximalFiniteSupportDivisor_finiteSupport_mul_principal + (α : NatOrdinal) (p : FiniteSupportRing (K := K)) (hp : p ≠ 0) + (a : Series K) (ha : HahnSeries.Nonpositive.IsPrincipal a) + (haDegree : (a : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) : + IsRVMaximalFiniteSupportDivisor + ((HahnSeries.Nonpositive.degreeValuation K).rv + ((p : Series K) * a)) + (Associates.mk p) := by + have hpHahn : (p : K⟦ℝ⟧) ≠ 0 := by + intro hzero + apply hp + exact Subtype.ext (Subtype.ext hzero) + have hpDegree : (p : K⟦ℝ⟧).degree = 0 := by + rw [HahnSeries.degree_eq_zero] + exact ⟨hpHahn, + (HahnSeries.Nonpositive.mem_finiteSupportSubring_iff + (p : Series K)).mp p.2⟩ + have hprodDegree : (((p : Series K) * a : Series K) : K⟦ℝ⟧).degree = + (α : WithBot NatOrdinal) := by + rw [HahnSeries.Nonpositive.degree_mul, hpDegree, haDegree, zero_add] + have hLayer := + isLayerMaximalFiniteSupportDivisor_finiteSupport_mul_principal α p a ha haDegree + apply (isRVMaximalFiniteSupportDivisor_iff _ (Associates.mk p)).mpr + intro q + change Associates.mk q ≤ Associates.mk p ↔ + finiteSupportRVEmbedding K q ∣ + (HahnSeries.Nonpositive.degreeValuation K).rv + ((p : Series K) * a) + rw [finiteSupportRVEmbedding_dvd_iff_homogeneous, + rvEquivHomogeneous_rv_eq_degreeHomogeneousClass α _ hprodDegree, + finiteSupportHomogeneousClass_dvd_degreeHomogeneousClass_iff] + exact (isLayerMaximalFiniteSupportDivisor_iff α _ _).mp hLayer q + +/-- A principal RV class has a maximal finite-support divisor represented by a constant series, +as in the final clause of LM24, Proposition 5.4.3. -/ +theorem exists_scalar_isRVMaximalFiniteSupportDivisor_of_isPrincipal + (B : HahnDegreeRV K) (hB : IsPrincipalRV B) : + ∃ k : K, IsRVMaximalFiniteSupportDivisor B + (Associates.mk + (HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k)) := by + obtain ⟨α, C, _, hCPrincipal, hBCoe⟩ := + (isPrincipalRV_iff_exists_degreeHomogeneousClass B).mp hB + obtain ⟨k, hk⟩ := + exists_scalar_isLayerMaximalFiniteSupportDivisor_of_isPrincipal α C hCPrincipal + refine ⟨k, (isRVMaximalFiniteSupportDivisor_iff B _).mpr ?_⟩ + intro q + change Associates.mk q ≤ Associates.mk + (HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k) ↔ + finiteSupportRVEmbedding K q ∣ B + rw [finiteSupportRVEmbedding_dvd_iff_homogeneous, + hBCoe, + finiteSupportHomogeneousClass_dvd_degreeHomogeneousClass_iff] + exact (isLayerMaximalFiniteSupportDivisor_iff α C _).mp hk q + +/-- The canonical maximal finite-support divisor class of an RV element. + +The fallback branch is unreachable whenever maximal-divisor existence has been established. -/ +noncomputable def rvMaximalFiniteSupportDivisor (B : HahnDegreeRV K) : + Associates (FiniteSupportRing (K := K)) := by + classical + exact if h : ∃ a : Associates (FiniteSupportRing (K := K)), + IsRVMaximalFiniteSupportDivisor B a then + Classical.choose h + else + 0 + +/-- Any class satisfying the RV characterization is the canonical class. -/ +theorem rvMaximalFiniteSupportDivisor_eq_of_is {B : HahnDegreeRV K} + {a : Associates (FiniteSupportRing (K := K))} + (ha : IsRVMaximalFiniteSupportDivisor B a) : + rvMaximalFiniteSupportDivisor B = a := by + classical + let hex : ∃ b : Associates (FiniteSupportRing (K := K)), + IsRVMaximalFiniteSupportDivisor B b := ⟨a, ha⟩ + rw [rvMaximalFiniteSupportDivisor, dif_pos hex] + exact (Classical.choose_spec hex).eq ha + +/-- Under pairwise gcd existence, the canonical RV class satisfies its defining +characterization. -/ +theorem rvMaximalFiniteSupportDivisor_is_of_exists_gcd (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (B : HahnDegreeRV K) : + IsRVMaximalFiniteSupportDivisor B + (rvMaximalFiniteSupportDivisor B) := by + obtain ⟨a, ha, _⟩ := + existsUnique_isRVMaximalFiniteSupportDivisor_of_exists_gcd hgcd B + rw [rvMaximalFiniteSupportDivisor_eq_of_is ha] + exact ha + +/-- For a principal RV class, the canonical maximal finite-support divisor is represented by a +constant series. -/ +theorem exists_scalar_rvMaximalFiniteSupportDivisor_of_isPrincipal + (B : HahnDegreeRV K) (hB : IsPrincipalRV B) : + ∃ k : K, rvMaximalFiniteSupportDivisor B = + Associates.mk + (HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k) := by + obtain ⟨k, hk⟩ := + exists_scalar_isRVMaximalFiniteSupportDivisor_of_isPrincipal B hB + exact ⟨k, rvMaximalFiniteSupportDivisor_eq_of_is hk⟩ + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random.lean new file mode 100644 index 0000000000..45e98a8942 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random.lean @@ -0,0 +1,23 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ClassIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.CoefficientRandom +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.GradedIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.HereditaryIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.IndependenceWindow +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.MainTheorem +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NonPrincipalIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NormalFormBlocks +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.PrincipalIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.Random +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.RandomBlocks +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ReducibleSpan +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SuccessorStep +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SupportRandom +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.TruncationIndependence + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/ClassIrreducible.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/ClassIrreducible.lean new file mode 100644 index 0000000000..283e3b4eb9 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/ClassIrreducible.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SuccessorStep +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.PrincipalIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.OrdinalValueDegree + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility + +/-! +# Irreducible classes in $\widehat{\mathrm P}$ + +Fornasiero, Lavi, L'Innocente and Mantova, *Irreducibility in generalized power series* (2024), +Corollary 4.5, first clause, for `α = n < ω`: if `b ∈ P_n` is hereditarily `rv_J`-independent, +then `rv(b)` is irreducible. The class `rv(b)` is `rv_J(b) ∈ P_n ⊆ P̂`, and the statement is +irreducibility in `P̂`. + +The argument is the one of the source's proof: a factorisation `rv_J(b) = X · Y` in `P̂` has +homogeneous factors, because `P̂` is a graded domain (Berarducci, Theorem 9.7); if both factors +have positive grade, `rv_J(b)` lies in the span `D_n` of such products, which `(*)_n` excludes +for a hereditarily `rv_J`-independent `b`; and a nonzero class of grade zero is a unit. +-/ + +open scoped DirectSum HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace FLLM24 + +open Berarducci + +variable {K : Type v} [Field K] [CharZero K] + +/-- A nonzero class of positive grade `n` outside `D_n` is irreducible in `P̂`. -/ +theorem irreducible_of_notMem_decomposableSpan {n : NatOrdinal} (hn : 0 < n) + {x : PrincipalComponent K n} (hx : x ≠ 0) + (hmem : DirectSum.of (PrincipalComponent K) n x ∉ decomposableSpan K n) : + Irreducible (DirectSum.of (PrincipalComponent K) n x) := by + refine ⟨not_isUnit_of_grade_ne_zero hn.ne' x, fun A C hAC ↦ ?_⟩ + have hne : DirectSum.of (PrincipalComponent K) n x ≠ 0 := fun h ↦ + hx (DirectSum.of_injective n (by rw [h, map_zero])) + have hA : A ≠ 0 := fun h ↦ hne (by rw [hAC, h, zero_mul]) + have hC : C ≠ 0 := fun h ↦ hne (by rw [hAC, h, mul_zero]) + have hhom : A * C ∈ (ordinalValueDegreeValuation K).homogeneousClasses := by + rw [← hAC, MaxAddDegree.mem_homogeneousClasses_iff] + exact Or.inr ⟨n, x, rfl⟩ + obtain ⟨hAhom, hChom⟩ := + (ordinalValueDegreeValuation K).mem_homogeneousClasses_of_mul_mem hA hC hhom + rcases (MaxAddDegree.mem_homogeneousClasses_iff _ A).mp hAhom with rfl | ⟨β, y, rfl⟩ + · exact absurd rfl hA + rcases (MaxAddDegree.mem_homogeneousClasses_iff _ C).mp hChom with rfl | ⟨γ, z, rfl⟩ + · exact absurd rfl hC + have hy : y ≠ 0 := fun h ↦ hA (by rw [h, map_zero]) + have hz : z ≠ 0 := fun h ↦ hC (by rw [h, map_zero]) + -- The product of the homogeneous factors sits in grade `β + γ`, which must be `n`. + have hgrade : n = β + γ := by + by_contra hne' + have hcomp := congrArg (fun w : PrincipalSubring K ↦ w (β + γ)) hAC + simp only [DirectSum.of_mul_of, DirectSum.of_eq_of_ne _ _ _ (Ne.symm hne'), + DirectSum.of_eq_same] at hcomp + exact MaxAddDegree.componentMul_ne_zero (ordinalValueDegreeValuation K) y z hy hz hcomp.symm + rcases eq_or_ne β 0 with hβ | hβ + · subst hβ + exact Or.inl (isUnit_of_grade_zero y hy) + rcases eq_or_ne γ 0 with hγ | hγ + · subst hγ + exact Or.inr (isUnit_of_grade_zero z hz) + exfalso + apply hmem + rw [hAC, hgrade] + exact of_mul_of_mem_decomposableSpan (pos_iff_ne_zero.mpr hβ) (pos_iff_ne_zero.mpr hγ) y z + +/-- FLLM24, Corollary 4.5 (first clause) for `α = n ≥ 1`: the class `rv_J(b)` of a hereditarily +`rv_J`-independent series of ordinal-value degree `n` is irreducible in `P̂`. -/ +theorem irreducible_rvJ_of_hereditarilyRVIndependent {n : ℕ} (hn : 1 ≤ n) {b : Series K} + (hb : HereditarilyRVIndependent n (fun _ : Unit ↦ b)) : Irreducible (rvJ b) := by + have hval : ordinalValue b = ω^ (n : NatOrdinal) := hb.ordinalValue_eq () + have hmem := rvJ_notMem_decomposableSpan (independentModuloDecomposable_of_pos hn) hb + have hcut : ordinalValue b < ω^ ((n : NatOrdinal) + 1) := by + rw [hval]; exact NatOrdinal.wpow_lt_wpow.mpr (lt_add_one _) + rw [rvJ_eq_gradeClass hval, gradeClass_of_lt hcut] at hmem ⊢ + refine irreducible_of_notMem_decomposableSpan (Nat.cast_pos.mpr hn) ?_ hmem + rw [Ne, principalComponentMk_eq_zero_iff, hval] + exact lt_irrefl _ + +end FLLM24 + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/CoefficientRandom.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/CoefficientRandom.lean new file mode 100644 index 0000000000..3efac0a9eb --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/CoefficientRandom.lean @@ -0,0 +1,179 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.Random +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.TruncationIndependence +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.IndependenceWindow +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.AlgebraicIndependentDet +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.DifferenceAvoidance + +import Mathlib.LinearAlgebra.Matrix.ToLinearEquiv + +/-! +# Algebraically independent coefficients give hereditary `rv_J`-independence + +Fornasiero, Lavi, L'Innocente and Mantova, *Irreducibility in generalized power series* (2024), +Proposition 3.4 and Corollary 3.5: if the coefficients of `b_1, …, b_n` are algebraically +independent over `ℚ` and `deg_J(b_i) = α ≥ 1`, then `rv_J(b_1), …, rv_J(b_n)` are linearly +independent, and `Q(b_1, …, b_n)` holds. + +The source's proof of Proposition 3.4 picks exponents `γ_1, …, γ_n` in `supp(u_1)` and forms +the matrix `A[i, j] = u_{j, γ_i}`, whose determinant vanishes because `A v = 0` for the +coefficient vector `v ≠ 0` of the relation; it concludes that "the elements of `A` are not +algebraically independent". Two points are completed here. The entries `u_{j, γ_i}` must be +distinct members of the coefficient family, so the `γ_i` have to be chosen in the supports of +all the `u_j` at once; and Corollary 3.5 applies Proposition 3.4 to families of translated +truncations `b_i^{|γ_{i,j}}`, whose joint coefficient family is not algebraically independent, +since one coefficient of `b_i` reappears in several truncations. Both are met by a single +argument for families of translated truncations `c_k = b_{j(k)}^{|γ(k)}` at distinct pairs: the +exponents `x_q`, one in the support of each `c_q` near zero and outside the support of the +relation, are chosen so that no difference `x_q - x_{q'}` equals a difference `γ(k) - γ(k')`. +Then the entries `c_k(x_q) = b_{j(k)}(γ(k) + x_q)` are zero or pairwise distinct coefficients, the +diagonal entries are nonzero, and the determinant is a nonzero polynomial in the coefficients, +being `1` when the diagonal variables are set to `1` and the others to `0`. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace FLLM24 + +open Berarducci HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +/-- FLLM24, Proposition 3.4 in the form needed for Corollary 3.5: the translated truncations at +distinct pairs of a family with algebraically independent coefficients, when of a common positive +degree, have linearly independent classes. -/ +theorem IsMutuallyCoefficientRandom.truncationsIndependent {ι : Type} {b : ι → Series K} + (hb : IsMutuallyCoefficientRandom b) : TruncationsIndependent K b := by + refine TruncationsIndependent.of fun d hd κ _ j γ hinj hγ hval ↦ ?_ + classical + cases nonempty_fintype κ + set c : κ → Series K := fun k ↦ translatedTruncation (b (j k) : K⟦ℝ⟧) (γ k) with hc + rw [linearIndependent_iff'] + intro s g hsum k₀ hk₀ + by_contra hg₀ + -- Restrict to the support `P` of the coefficients. + set P := s.filter (fun k ↦ g k ≠ 0) with hP + have hk₀P : k₀ ∈ P := Finset.mem_filter.mpr ⟨hk₀, hg₀⟩ + have hgP : ∀ k ∈ P, g k ≠ 0 := fun k hk ↦ (Finset.mem_filter.mp hk).2 + have hrelP : ∑ k ∈ P, g k • rvJ (c k) = 0 := by + rw [hP, Finset.sum_filter_of_ne] + · exact hsum + · intro k _ hk hgk + exact hk (by rw [hgk, zero_smul]) + have hrel' : ∑ k : P, g k • rvJ (c k) = 0 := by + rw [Finset.sum_coe_sort P (fun k ↦ g k • rvJ (c k))] + exact hrelP + -- The relation has ordinal value below `ω^d`. + set R : Series K := ∑ k : P, (HahnSeries.Nonpositive.C : K →+* Series K) (g k) * c k with hR + have hRlt : ordinalValue R < ω^ (d : NatOrdinal) := + ordinalValue_sum_C_mul_lt_of_sum_smul_rvJ_eq_zero (fun k : P ↦ hval k) (fun k : P ↦ g k) + hrel' + have hd' : (0 : NatOrdinal) < d := Nat.cast_pos.mpr hd + -- A common window `(η, 0)` in which every `c k` has infinitely many support points outside + -- the support of `R`. + have hwin : ∀ k : P, ∃ η₀ < (0 : ℝ), ∀ η, η₀ < η → η < 0 → + ((((c k : Series K) : K⟦ℝ⟧).support ∩ Set.Ioo η 0) \ (R : K⟦ℝ⟧).support).Infinite := + fun k ↦ exists_forall_infinite_support_diff hd' (hval k) hRlt + choose η₀ hη₀ hwin using hwin + have hPne : (Finset.univ : Finset P).Nonempty := ⟨⟨k₀, hk₀P⟩, Finset.mem_univ _⟩ + set η := (Finset.univ.sup' hPne η₀) / 2 with hη + have hηneg : η < 0 := by + have : Finset.univ.sup' hPne η₀ < 0 := by + obtain ⟨k, -, hk⟩ := Finset.exists_mem_eq_sup' hPne η₀ + rw [hk]; exact hη₀ k + rw [hη]; linarith + have hηgt : ∀ k : P, η₀ k < η := fun k ↦ by + have h1 : η₀ k ≤ Finset.univ.sup' hPne η₀ := Finset.le_sup' η₀ (Finset.mem_univ k) + have h2 : Finset.univ.sup' hPne η₀ < 0 := by linarith [hηneg] + rw [hη]; linarith + set E : P → Set ℝ := fun k ↦ (((c k : Series K) : K⟦ℝ⟧).support ∩ Set.Ioo η 0) \ + (R : K⟦ℝ⟧).support with hE + have hEinf : ∀ k : P, (E k).Infinite := fun k ↦ hwin k η (hηgt k) hηneg + -- Exponents with differences avoiding the differences of the `γ k`. + set D : Finset ℝ := (Finset.univ : Finset (P × P)).image fun p ↦ γ p.1 - γ p.2 with hD + obtain ⟨x, hxE, hxD⟩ := exists_forall_mem_forall_sub_notMem (Finset.univ : Finset P) E hEinf D + have hxE' : ∀ q : P, x q ∈ E q := fun q ↦ hxE q (Finset.mem_univ q) + have hxneg : ∀ q : P, x q < 0 := fun q ↦ (hxE' q).1.2.2 + have hxR : ∀ q : P, ((R : Series K) : K⟦ℝ⟧).coeff (x q) = 0 := fun q ↦ by + have := (hxE' q).2 + rwa [HahnSeries.mem_support, not_ne_iff] at this + have hxc : ∀ q : P, ((c q : Series K) : K⟦ℝ⟧).coeff (x q) ≠ 0 := fun q ↦ (hxE' q).1.1 + -- The matrix of coefficients. + have hcoeff : ∀ (q k : P), ((c k : Series K) : K⟦ℝ⟧).coeff (x q) = + ((b (j k) : Series K) : K⟦ℝ⟧).coeff (γ k + x q) := fun q k ↦ by + rw [hc, coeff_translatedTruncation, if_pos (hxneg q).le] + let M : Matrix P P K := Matrix.of fun q k ↦ ((c k : Series K) : K⟦ℝ⟧).coeff (x q) + have hMg : M.mulVec (fun k : P ↦ g k) = 0 := by + funext q + rw [Matrix.mulVec, Pi.zero_apply, ← hxR q, hR, coeff_sum_C_mul] + simp only [dotProduct, Matrix.of_apply, M] + exact Finset.sum_congr rfl fun k _ ↦ mul_comm _ _ + have hgne : (fun k : P ↦ g k) ≠ 0 := by + intro h + exact hgP k₀ hk₀P (congrFun h ⟨k₀, hk₀P⟩) + have hdet : M.det = 0 := Matrix.exists_mulVec_eq_zero_iff.mp ⟨_, hgne, hMg⟩ + -- The pattern of variables. + let v : P → P → Option (coefficientIndex b) := fun q k ↦ + if h : (j k, γ k + x q) ∈ coefficientIndex b then some ⟨(j k, γ k + x q), h⟩ else none + have hM : ∀ q k, M q k = (v q k).elim 0 (fun p : coefficientIndex b ↦ + ((b p.1.1 : Series K) : K⟦ℝ⟧).coeff p.1.2) := by + intro q k + simp only [M, Matrix.of_apply, v] + rw [hcoeff q k] + by_cases h : (j k, γ k + x q) ∈ coefficientIndex b + · rw [dif_pos h] + rfl + · rw [dif_neg h, Option.elim] + rw [mem_coefficientIndex_iff, not_ne_iff] at h + exact h + have hdiag : ∀ q, (v q q).isSome := by + intro q + have h : (j q, γ q + x q) ∈ coefficientIndex b := by + rw [mem_coefficientIndex_iff] + rw [← hcoeff q q] + exact hxc q + simp only [v, dif_pos h, Option.isSome_some] + have hdistinct : ∀ q k q' k' w, v q k = some w → v q' k' = some w → q = q' ∧ k = k' := by + intro q k q' k' w h1 h2 + have hpair : (j k, γ k + x q) = (j k', γ k' + x q') := by + by_cases hk : (j k, γ k + x q) ∈ coefficientIndex b + · by_cases hk' : (j k', γ k' + x q') ∈ coefficientIndex b + · simp only [v, dif_pos hk, dif_pos hk', Option.some.injEq] at h1 h2 + exact congrArg Subtype.val (h1.trans h2.symm) + · simp [v, dif_neg hk'] at h2 + · simp [v, dif_neg hk] at h1 + have hj : j k = j k' := congrArg Prod.fst hpair + have hγ' : γ k + x q = γ k' + x q' := congrArg Prod.snd hpair + by_cases hqq : q = q' + · subst hqq + have hγk : γ k = γ k' := add_right_cancel hγ' + exact ⟨rfl, Subtype.ext (hinj (Prod.ext hj hγk))⟩ + · exfalso + apply hxD q (Finset.mem_univ q) q' (Finset.mem_univ q') hqq + refine Finset.mem_image.mpr ⟨(k', k), Finset.mem_univ _, ?_⟩ + linarith + exact Matrix.det_ne_zero_of_algebraicIndependent hb.algebraicIndependent v M hM hdiag + hdistinct hdet + +/-- FLLM24, Corollary 3.5 for finite degrees: a finite family of series with algebraically +independent coefficients and ordinal value `ω^n`, `n ≥ 1`, is hereditarily +`rv_J`-independent. -/ +theorem IsMutuallyCoefficientRandom.hereditarilyRVIndependent {ι : Type} [Finite ι] + {b : ι → Series K} (hb : IsMutuallyCoefficientRandom b) {n : ℕ} (hn : 1 ≤ n) + (hval : ∀ i, ordinalValue (b i) = ω^ (n : NatOrdinal)) : + HereditarilyRVIndependent n b := + hb.truncationsIndependent.hereditarilyRVIndependent_self hn hval + +end FLLM24 + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/GradedIrreducible.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/GradedIrreducible.lean new file mode 100644 index 0000000000..2a75fa0c0e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/GradedIrreducible.lean @@ -0,0 +1,507 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Monomial +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ReducibleSpan + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.PrincipalIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.SupportSupremumMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeSum +import Mathlib.LinearAlgebra.Basis.VectorSpace +import Mathlib.RingTheory.TensorProduct.Basic + +/-! +# Block forms in the degree-graded ring + +Fornasiero, Lavi, L'Innocente and Mantova, *Irreducibility in generalized power series* (2024), +Proposition 3.2, proves irreducibility of `b = ∑ b_i t^{γ_i} + r` from that of `rv(b_m)` by +working in the degree-graded ring `RV̂` of LM24: the initial form of `b` is +`t^{γ_m} · B` with `B = ∑ rv(b_i) t^{γ_i - γ_m}`, and a factorisation of `b` gives one of `B` +after the monomial `t^{γ_m}` has been split between the factors. This module carries out the +graded part of the argument. + +`RV̂ ≅ P̂ ⊗_K K(ℝ^{≤0})` (LM24, Proposition 6.1.2). A *block form* is an element +`∑ᵢ X_i · t^{δ_i}` with `X_i ∈ P_n` linearly independent, `δ_i ≤ 0`, one `δ_m = 0` and all other +`δ_i < 0`; its image under the graded projection `RV̂ → P̂` is `X_m`. If `X_m` is irreducible in +`P̂`, the block form is irreducible in `RV̂`: a factorisation `B = A C` has homogeneous factors, +the projection of one factor is a unit of `P̂`, so that factor has grade zero and is a +finite-support series `p`; the coordinate functional extracting the coefficient of `X_m` is +`K(ℝ^{≤0})`-linear and sends `B` to `t^{δ_m} = 1`, whence `p` is a unit. The source words this +step as "`p(B) = 1` implies `p(A) = 1`" and "`deg_J(a_i) = 0` for every `i`". + +Finite-support series are primal in `RV̂` (LM24, Corollary 6.3.6), and the divisors of a monomial +in `K(ℝ^{≤0})` are monomials. Hence in any factorisation `A C = t^γ · B` one factor is a monomial +`k t^x`; and a series whose initial form is the image of a finite-support series is that series. +-/ + +open scoped DirectSum HahnSeries NatOrdinal TensorProduct + +universe v + +public noncomputable section + +namespace FLLM24 + +open Berarducci HahnSeries.Nonpositive + +variable {K : Type v} [Field K] + +/-! ### Monomials and units -/ + +/-- A factor of a nonzero monomial of `K((ℝ^{≤0}))` is a monomial: the order and the support +supremum of a product are both additive (Berarducci, Corollary 9.8 for the supremum), and they +agree on a monomial, so they agree on each factor. -/ +theorem isMonomial_of_mul_eq_single [CharZero K] {p q : Series K} {γ : ℝ} {k : K} (hk : k ≠ 0) + (hγ : γ ≤ 0) (h : p * q = single γ k hγ) : IsMonomial p := by + have hsingle : single γ k hγ ≠ 0 := by + intro hzero + have hcoeff := congrArg (fun x : Series K ↦ (x : K⟦ℝ⟧).coeff γ) hzero + exact hk (by simpa [coe_single] using hcoeff) + have hp : p ≠ 0 := fun hp ↦ hsingle (by rw [← h, hp, zero_mul]) + have hq : q ≠ 0 := fun hq ↦ hsingle (by rw [← h, hq, mul_zero]) + have hp' : (p : K⟦ℝ⟧) ≠ 0 := fun h' ↦ hp (Subtype.ext h') + have hq' : (q : K⟦ℝ⟧) ≠ 0 := fun h' ↦ hq (Subtype.ext h') + -- The supremum of the support is additive. + have hsup : sSup (p : K⟦ℝ⟧).support + sSup (q : K⟦ℝ⟧).support = γ := by + have h1 := supportSup_mul p q + rw [h, supportSup_single hk hγ, supportSup_of_ne hp, supportSup_of_ne hq, ← WithBot.coe_add] + at h1 + exact WithBot.coe_inj.mp h1.symm + -- The order is additive. + have horder : (p : K⟦ℝ⟧).order + (q : K⟦ℝ⟧).order = γ := by + have h1 := congrArg (fun x : Series K ↦ (x : K⟦ℝ⟧).order) h + simp only [Subring.coe_mul, coe_single] at h1 + rw [HahnSeries.order_mul hp' hq', HahnSeries.order_single hk] at h1 + exact h1 + have hpmem : (p : K⟦ℝ⟧).order ∈ (p : K⟦ℝ⟧).support := + HahnSeries.coeff_order_eq_zero.not.mpr hp' + have hqmem : (q : K⟦ℝ⟧).order ∈ (q : K⟦ℝ⟧).support := + HahnSeries.coeff_order_eq_zero.not.mpr hq' + have hple : (p : K⟦ℝ⟧).order ≤ sSup (p : K⟦ℝ⟧).support := + le_csSup (bddAbove_support p) hpmem + have hqle : (q : K⟦ℝ⟧).order ≤ sSup (q : K⟦ℝ⟧).support := + le_csSup (bddAbove_support q) hqmem + have hpeq : (p : K⟦ℝ⟧).order = sSup (p : K⟦ℝ⟧).support := by linarith + rw [isMonomial_iff_support_eq_singleton] + refine ⟨(p : K⟦ℝ⟧).order, Set.Subset.antisymm (fun y hy ↦ ?_) (fun y hy ↦ ?_)⟩ + · have h1 : (p : K⟦ℝ⟧).order ≤ y := HahnSeries.order_le_of_coeff_ne_zero hy + have h2 : y ≤ (p : K⟦ℝ⟧).order := by + rw [hpeq] + exact le_csSup (bddAbove_support p) hy + exact Set.mem_singleton_iff.mpr (le_antisymm h2 h1) + · rw [Set.mem_singleton_iff] at hy + rw [hy] + exact hpmem + +/-- Every element of grade zero in `RV̂` is the image of a finite-support series. -/ +theorem exists_finiteSupportGradedEmbedding_eq_of + (y : (degreeValuation K).Component 0) : + ∃ p : Berarducci.FiniteSupportRing (K := K), + finiteSupportGradedEmbedding K p = DirectSum.of (degreeValuation K).Component 0 y := by + refine ⟨(degreeFiniteSupportResidueEquiv K).symm y, ?_⟩ + rw [finiteSupportGradedEmbedding_apply, RingEquiv.apply_symm_apply] + +/-- A nonzero factor of a nonzero homogeneous element of `RV̂` is homogeneous, with grades +adding up to the grade of the product. -/ +theorem exists_of_eq_of_mul_eq_of [CharZero K] {n : NatOrdinal} + {Y : (degreeValuation K).Component n} (hY : Y ≠ 0) {A C : DegreeGraded K} + (hAC : A * C = DirectSum.of (degreeValuation K).Component n Y) : + ∃ (a c : NatOrdinal) (A₀ : (degreeValuation K).Component a) + (C₀ : (degreeValuation K).Component c), A₀ ≠ 0 ∧ C₀ ≠ 0 ∧ a + c = n ∧ + A = DirectSum.of (degreeValuation K).Component a A₀ ∧ + C = DirectSum.of (degreeValuation K).Component c C₀ := by + have hne : DirectSum.of (degreeValuation K).Component n Y ≠ 0 := fun h ↦ + hY (DirectSum.of_injective n (by rw [h, map_zero])) + have hA : A ≠ 0 := fun h ↦ hne (by rw [← hAC, h, zero_mul]) + have hC : C ≠ 0 := fun h ↦ hne (by rw [← hAC, h, mul_zero]) + have hhom : A * C ∈ (degreeValuation K).homogeneousClasses := by + rw [hAC, MaxAddDegree.mem_homogeneousClasses_iff] + exact Or.inr ⟨n, Y, rfl⟩ + obtain ⟨hAhom, hChom⟩ := (degreeValuation K).mem_homogeneousClasses_of_mul_mem hA hC hhom + rcases (MaxAddDegree.mem_homogeneousClasses_iff _ A).mp hAhom with rfl | ⟨a, A₀, rfl⟩ + · exact absurd rfl hA + rcases (MaxAddDegree.mem_homogeneousClasses_iff _ C).mp hChom with rfl | ⟨c, C₀, rfl⟩ + · exact absurd rfl hC + have hA₀ : A₀ ≠ 0 := fun h ↦ hA (by rw [h, map_zero]) + have hC₀ : C₀ ≠ 0 := fun h ↦ hC (by rw [h, map_zero]) + refine ⟨a, c, A₀, C₀, hA₀, hC₀, ?_, rfl, rfl⟩ + by_contra hne' + have hcomp := congrArg (fun w : DegreeGraded K ↦ w (a + c)) hAC + simp only [DirectSum.of_mul_of, DirectSum.of_eq_of_ne _ _ _ hne', DirectSum.of_eq_same] at hcomp + exact MaxAddDegree.componentMul_ne_zero (degreeValuation K) A₀ C₀ hA₀ hC₀ hcomp + +/-- The units of `RV̂` are the nonzero scalars: a unit is homogeneous of grade zero, hence a +finite-support series, and the units of `K(ℝ^{≤0})` are `K^×`. -/ +theorem exists_algebraMap_eq_of_isUnit [CharZero K] {A : DegreeGraded K} (hA : IsUnit A) : + ∃ k : K, k ≠ 0 ∧ A = algebraMap K (DegreeGraded K) k := by + obtain ⟨A', hAA'⟩ := hA.exists_right_inv + have hone : A * A' = DirectSum.of (degreeValuation K).Component 0 + (degreeValuation K).componentOne := by + rw [hAA'] + exact DirectSum.one_def _ + have hone_ne : (degreeValuation K).componentOne ≠ 0 := by + rw [MaxAddDegree.componentOne_eq_componentMk, Ne, MaxAddDegree.componentMk_eq_zero_iff, + (degreeValuation K).map_one_eq_zero_of_isSeparated (degreeValuation_isSeparated K)] + exact lt_irrefl _ + obtain ⟨a, c, A₀, C₀, -, -, hac, rfl, rfl⟩ := exists_of_eq_of_mul_eq_of hone_ne hone + obtain ⟨ha, hc⟩ := NatOrdinal.add_eq_zero_iff.mp hac + subst ha hc + obtain ⟨p, hp⟩ := exists_finiteSupportGradedEmbedding_eq_of A₀ + obtain ⟨q, hq⟩ := exists_finiteSupportGradedEmbedding_eq_of C₀ + rw [← hp, ← hq, ← map_mul, ← map_one (finiteSupportGradedEmbedding K)] at hAA' + have hpq : p * q = 1 := finiteSupportGradedEmbedding_injective K hAA' + obtain ⟨k, hk, hpk⟩ := (isUnit_finiteSupport_iff_exists_scalar p).mp + (isUnit_iff_exists_inv.mpr ⟨q, hpq⟩) + refine ⟨k, hk, ?_⟩ + rw [← hp, hpk, + show finiteSupportScalarHom (G := ℝ) k = + algebraMap K (Berarducci.FiniteSupportRing (K := K)) k from rfl] + exact (finiteSupportGradedEmbedding K).commutes k + +/-! ### The coordinate functional -/ + +/-- A linearly independent family in a vector space admits, for each index `m`, a linear +functional equal to `1` at the `m`-th vector and `0` at the others. -/ +theorem _root_.LinearIndependent.exists_dual_apply_eq {V : Type*} [AddCommGroup V] [Module K V] + {ι : Type*} [DecidableEq ι] {v : ι → V} (hv : LinearIndependent K v) (m : ι) : + ∃ φ : V →ₗ[K] K, ∀ i, φ (v i) = if i = m then 1 else 0 := by + obtain ⟨φ, hφ⟩ := LinearMap.exists_extend ((Finsupp.lapply m) ∘ₗ hv.repr) + refine ⟨φ, fun i ↦ ?_⟩ + have h := congrArg (fun f : Submodule.span K (Set.range v) →ₗ[K] K ↦ + f ⟨v i, Submodule.subset_span (Set.mem_range_self i)⟩) hφ + simp only [LinearMap.comp_apply, Submodule.subtype_apply] at h + rw [h, hv.repr_eq_single i ⟨v i, Submodule.subset_span (Set.mem_range_self i)⟩ rfl, + Finsupp.lapply_apply, Finsupp.single_apply] + +variable (K) in +/-- The `K(ℝ^{≤0})`-coordinate of `RV̂ ≅ P̂ ⊗ K(ℝ^{≤0})` along a linear functional +`φ : P̂ → K`: the composite `RV̂ ≃ P̂ ⊗ K(ℝ^{≤0}) → K ⊗ K(ℝ^{≤0}) ≃ K(ℝ^{≤0})`. -/ +def coordinate [CharZero K] (φ : PrincipalSubring K →ₗ[K] K) : + DegreeGraded K →ₗ[K] Berarducci.FiniteSupportRing (K := K) := + (TensorProduct.lid K (Berarducci.FiniteSupportRing (K := K))).toLinearMap ∘ₗ + TensorProduct.map φ LinearMap.id ∘ₗ (principalSubringTensorEquiv K).symm.toLinearMap + +theorem coordinate_tmul [CharZero K] (φ : PrincipalSubring K →ₗ[K] K) (x : PrincipalSubring K) + (p : Berarducci.FiniteSupportRing (K := K)) : + coordinate K φ + (principalSubringEmbedding K x * finiteSupportGradedEmbedding K p) = + φ x • p := by + rw [coordinate, LinearMap.comp_apply, LinearMap.comp_apply, AlgEquiv.toLinearMap_apply, + ← principalSubringTensorEquiv_tmul, AlgEquiv.symm_apply_apply, TensorProduct.map_tmul, + LinearMap.id_apply, LinearEquiv.coe_toLinearMap, TensorProduct.lid_tmul] + +/-- The coordinate functional is `K(ℝ^{≤0})`-linear for the grade-zero action. -/ +theorem coordinate_finiteSupportGradedEmbedding_mul [CharZero K] (φ : PrincipalSubring K →ₗ[K] K) + (p : Berarducci.FiniteSupportRing (K := K)) (z : DegreeGraded K) : + coordinate K φ (finiteSupportGradedEmbedding K p * z) = p * coordinate K φ z := by + obtain ⟨t, rfl⟩ := (principalSubringTensorEquiv K).surjective z + rw [← principalSubringTensorEquiv_one_tmul, ← map_mul] + induction t using TensorProduct.induction_on with + | zero => simp + | tmul x q => + rw [Algebra.TensorProduct.tmul_mul_tmul, one_mul, principalSubringTensorEquiv_tmul, + principalSubringTensorEquiv_tmul, coordinate_tmul, coordinate_tmul, mul_smul_comm] + | add t₁ t₂ h₁ h₂ => + simp only [mul_add, map_add, h₁, h₂] + +/-! ### The graded projection on finite-support series -/ + +/-- The graded projection `RV̂ → P̂` sends the image of a finite-support series `p` to the class +of `p` in grade zero of `P̂`, which is its constant coefficient. -/ +theorem rvProjection_finiteSupportGradedEmbedding [CharZero K] + (p : Berarducci.FiniteSupportRing (K := K)) : + rvProjection K (finiteSupportGradedEmbedding K p) = gradeClass 0 (p : Series K) := by + have hcut : ordinalValue (p : Series K) < ω^ ((0 : NatOrdinal) + 1) := by + rw [← ordinalValueDegree_le_coe_iff] + refine (ordinalValueDegree_le_degree _).trans ?_ + rw [WithBot.coe_zero, HahnSeries.degree_le_zero_iff] + exact (mem_finiteSupportSubring_iff (p : Series K)).mp p.2 + rw [finiteSupportGradedEmbedding_eq_homogeneousMk, MaxAddDegree.homogeneousMk_apply, + rvProjection_of, degreeLayerToPrincipalComponent_componentMk, + gradeClass_eq_homogeneousMk hcut, MaxAddDegree.homogeneousMk_apply] + exact congrArg _ (congrArg _ (Subtype.ext (coe_finiteSupportFiltrationRepresentative p))) + +/-- The graded projection kills the image of a strictly negative monomial. -/ +theorem rvProjection_finiteSupportMonomial_of_neg [CharZero K] + {g : exponentMonoid ℝ} (hg : (g : ℝ) < 0) : + rvProjection K (finiteSupportGradedEmbedding K (finiteSupportMonomial g)) = 0 := by + rw [rvProjection_finiteSupportGradedEmbedding] + apply gradeClass_eq_zero_of_lt + have heq : ((finiteSupportMonomial (K := K) g : Berarducci.FiniteSupportRing (K := K)) : + Series K) = single (g : ℝ) 1 g.2 := + Subtype.ext ((coe_finiteSupportMonomial g).trans (coe_single _ _ _).symm) + rw [heq, ordinalValue_of_mem_negativeMonomialIdeal (single_one_mem_negativeMonomialIdeal hg), + NatOrdinal.wpow_zero] + exact zero_lt_one + +/-- The graded projection sends the image of `t^0 = 1` to `1`. -/ +theorem rvProjection_finiteSupportMonomial_zero [CharZero K] : + rvProjection K (finiteSupportGradedEmbedding K + (finiteSupportMonomial (K := K) (0 : exponentMonoid ℝ))) = 1 := by + have h1 : finiteSupportMonomial (K := K) (0 : exponentMonoid ℝ) = 1 := by + apply Subtype.ext + apply Subtype.ext + rw [coe_finiteSupportMonomial] + exact HahnSeries.single_zero_one + rw [h1, map_one, map_one] + +/-! ### Block forms -/ + +variable (K) in +/-- The block form `∑ᵢ rv_J(X_i) · t^{δ_i}` in `RV̂`, for classes `X_i ∈ P̂` and exponents +`δ_i ≤ 0`. -/ +def blockForm [CharZero K] {ι : Type*} [Fintype ι] (X : ι → PrincipalSubring K) + (δ : ι → exponentMonoid ℝ) : DegreeGraded K := + ∑ i, principalSubringEmbedding K (X i) * + finiteSupportGradedEmbedding K (finiteSupportMonomial (δ i)) + +theorem blockForm_def [CharZero K] {ι : Type*} [Fintype ι] (X : ι → PrincipalSubring K) + (δ : ι → exponentMonoid ℝ) : + blockForm K X δ = ∑ i, principalSubringEmbedding K (X i) * + finiteSupportGradedEmbedding K (finiteSupportMonomial (δ i)) := + (rfl) + +/-- The graded projection of a block form with a single exponent `δ_m = 0` is `X_m`. -/ +theorem rvProjection_blockForm [CharZero K] {ι : Type*} [Fintype ι] + (X : ι → PrincipalSubring K) (δ : ι → exponentMonoid ℝ) (m : ι) (hm : δ m = 0) + (hδ : ∀ i, δ i = 0 → i = m) : + rvProjection K (blockForm K X δ) = X m := by + classical + rw [blockForm_def, map_sum] + rw [Finset.sum_eq_single m] + · rw [map_mul, rvProjection_principalGradedEmbedding, hm, + rvProjection_finiteSupportMonomial_zero, mul_one] + · intro i _ hi + have hneg : ((δ i : exponentMonoid ℝ) : ℝ) < 0 := by + rcases lt_or_eq_of_le (show ((δ i : exponentMonoid ℝ) : ℝ) ≤ 0 from (δ i).2) with h | h + · exact h + · exact absurd (hδ i (Subtype.ext h)) hi + rw [map_mul, rvProjection_finiteSupportMonomial_of_neg hneg, mul_zero] + · intro h + exact absurd (Finset.mem_univ m) h + +/-- The block form is homogeneous of grade `n` when its classes lie in `P_n`. -/ +theorem blockForm_eq_of [CharZero K] {n : NatOrdinal} {ι : Type*} [Fintype ι] + (x : ι → PrincipalComponent K n) (δ : ι → exponentMonoid ℝ) : + blockForm K (fun i ↦ DirectSum.of (PrincipalComponent K) n (x i)) δ = + DirectSum.of (degreeValuation K).Component n + (∑ i, degreeFiniteSupportResidueEquiv K (finiteSupportMonomial (δ i)) • + principalComponentToHahnDegreeLayer K n (x i)) := by + rw [blockForm_def, map_sum] + refine Finset.sum_congr rfl fun i _ ↦ ?_ + rw [mul_comm, principalSubringEmbedding_of, finiteSupportGradedEmbedding_mul_of] + +/-- The coordinate of a block form along a functional with `φ(X_i) = δ_{im}` is `t^{δ_m}`. -/ +theorem coordinate_blockForm [CharZero K] {ι : Type*} [Fintype ι] [DecidableEq ι] + (X : ι → PrincipalSubring K) (δ : ι → exponentMonoid ℝ) (m : ι) (φ : PrincipalSubring K →ₗ[K] K) + (hφ : ∀ i, φ (X i) = if i = m then 1 else 0) : + coordinate K φ (blockForm K X δ) = finiteSupportMonomial (δ m) := by + classical + rw [blockForm_def, map_sum] + rw [Finset.sum_eq_single m] + · rw [coordinate_tmul, hφ, if_pos rfl, one_smul] + · intro i _ hi + rw [coordinate_tmul, hφ, if_neg hi, zero_smul] + · intro h + exact absurd (Finset.mem_univ m) h + +/-- FLLM24, proof of Proposition 3.2: a block form `∑ᵢ X_i t^{δ_i}` in `RV̂` with `X_i ∈ P_n` +linearly independent, `δ_m = 0` the only zero exponent and `X_m` irreducible in `P̂` is +irreducible in `RV̂`. -/ +theorem irreducible_blockForm [CharZero K] {n : NatOrdinal} {ι : Type*} [Fintype ι] + (x : ι → PrincipalComponent K n) + (hli : LinearIndependent K (fun i ↦ DirectSum.of (PrincipalComponent K) n (x i))) + (δ : ι → exponentMonoid ℝ) (m : ι) (hm : δ m = 0) (hδ : ∀ i, δ i = 0 → i = m) + (hirr : Irreducible (DirectSum.of (PrincipalComponent K) n (x m))) : + Irreducible (blockForm K (fun i ↦ DirectSum.of (PrincipalComponent K) n (x i)) δ) := by + classical + set B := blockForm K (fun i ↦ DirectSum.of (PrincipalComponent K) n (x i)) δ with hB + have hproj : rvProjection K B = DirectSum.of (PrincipalComponent K) n (x m) := + rvProjection_blockForm _ δ m hm hδ + obtain ⟨φ, hφ⟩ := hli.exists_dual_apply_eq m + -- A factor whose projection is a unit is itself a unit. + have key : ∀ A C : DegreeGraded K, B = A * C → IsUnit (rvProjection K A) → + IsUnit A := by + intro A C hAC hunit + have hY : (∑ i, degreeFiniteSupportResidueEquiv K (finiteSupportMonomial (δ i)) • + principalComponentToHahnDegreeLayer K n (x i)) ≠ 0 := by + intro hzero + have hBzero : B = 0 := by rw [hB, blockForm_eq_of, hzero, map_zero] + rw [hBzero, map_zero] at hproj + exact hirr.ne_zero hproj.symm + have hAC' : A * C = DirectSum.of (degreeValuation K).Component n + (∑ i, degreeFiniteSupportResidueEquiv K (finiteSupportMonomial (δ i)) • + principalComponentToHahnDegreeLayer K n (x i)) := by + rw [← hAC, hB, blockForm_eq_of] + obtain ⟨a, c, A₀, C₀, hA₀, -, -, rfl, rfl⟩ := exists_of_eq_of_mul_eq_of hY hAC' + -- The unit projection forces grade zero. + have ha : a = 0 := by + by_contra ha + rw [rvProjection_of] at hunit + exact not_isUnit_of_grade_ne_zero ha _ hunit + subst ha + obtain ⟨p, hp⟩ := exists_finiteSupportGradedEmbedding_eq_of A₀ + rw [← hp] at hAC ⊢ + -- The coordinate along `φ` shows that `p` divides `1`. + have hcoord := congrArg (coordinate K φ) hAC + rw [coordinate_blockForm _ δ m φ hφ, coordinate_finiteSupportGradedEmbedding_mul, hm] at hcoord + have hone : finiteSupportMonomial (K := K) (0 : exponentMonoid ℝ) = 1 := by + apply Subtype.ext + apply Subtype.ext + rw [coe_finiteSupportMonomial] + exact HahnSeries.single_zero_one + rw [hone] at hcoord + have hunit : IsUnit p := + ⟨Units.mkOfMulEqOne p _ hcoord.symm, Units.val_mkOfMulEqOne hcoord.symm⟩ + exact hunit.map (finiteSupportGradedEmbedding K) + refine ⟨fun hunit ↦ hirr.not_isUnit (hproj ▸ hunit.map (rvProjection K)), + fun A C hAC ↦ ?_⟩ + have hprod : rvProjection K A * rvProjection K C = + DirectSum.of (PrincipalComponent K) n (x m) := by + rw [← map_mul, ← hAC, hproj] + rcases hirr.isUnit_or_isUnit hprod.symm with hA | hC + · exact Or.inl (key A C hAC hA) + · exact Or.inr (key C A (by rw [hAC, mul_comm]) hC) + +/-- FLLM24, proof of Proposition 3.2, the monomial step: if `A · C = t^γ · B` with `B` an +irreducible block form, then one of `A`, `C` is the image of a monomial `k t^x` of +`K(ℝ^{≤0})`. Finite-support series are primal in `RV̂` (LM24, Corollary 6.3.6), so `t^γ` +splits as `p₁ p₂` with `p₁ ∣ A` and `p₂ ∣ C`; the `p_i` are monomials, and cancelling them +leaves a factorisation of `B`. -/ +theorem exists_isMonomial_factor_of_mul_eq [CharZero K] {n : NatOrdinal} + {ι : Type*} [Fintype ι] (x : ι → PrincipalComponent K n) + (hli : LinearIndependent K (fun i ↦ DirectSum.of (PrincipalComponent K) n (x i))) + (δ : ι → exponentMonoid ℝ) (m : ι) (hm : δ m = 0) (hδ : ∀ i, δ i = 0 → i = m) + (hirr : Irreducible (DirectSum.of (PrincipalComponent K) n (x m))) + (γ : exponentMonoid ℝ) {A C : DegreeGraded K} + (hAC : A * C = finiteSupportGradedEmbedding K (finiteSupportMonomial γ) * + blockForm K (fun i ↦ DirectSum.of (PrincipalComponent K) n (x i)) δ) : + ∃ p : Berarducci.FiniteSupportRing (K := K), IsMonomial (p : Series K) ∧ + (A = finiteSupportGradedEmbedding K p ∨ C = finiteSupportGradedEmbedding K p) := by + set B := blockForm K (fun i ↦ DirectSum.of (PrincipalComponent K) n (x i)) δ with hB + have hBirr : Irreducible B := irreducible_blockForm x hli δ m hm hδ hirr + have hdvd : finiteSupportGradedEmbedding K (finiteSupportMonomial γ) ∣ A * C := + ⟨B, hAC⟩ + obtain ⟨a₁, a₂, ⟨A', hA'⟩, ⟨C', hC'⟩, hsplit⟩ := + finiteSupportGradedEmbedding_isPrimal (finiteSupportMonomial γ) hdvd + -- The two factors of `t^γ` are monomials. + have hres_ne : degreeFiniteSupportResidueEquiv K (finiteSupportMonomial (K := K) γ) ≠ 0 := by + intro h + have h1 : finiteSupportMonomial (K := K) γ = 0 := + (degreeFiniteSupportResidueEquiv K).injective (by rw [h, map_zero]) + have h2 := congrArg + (fun q : Berarducci.FiniteSupportRing (K := K) ↦ ((q : Series K) : K⟦ℝ⟧).coeff γ) h1 + simp [coe_finiteSupportMonomial] at h2 + have hsplit' : a₁ * a₂ = DirectSum.of (degreeValuation K).Component 0 + (degreeFiniteSupportResidueEquiv K (finiteSupportMonomial γ)) := by + rw [← hsplit, finiteSupportGradedEmbedding_apply] + obtain ⟨a, c, A₀, C₀, -, -, hac, rfl, rfl⟩ := exists_of_eq_of_mul_eq_of hres_ne hsplit' + obtain ⟨ha, hc⟩ := NatOrdinal.add_eq_zero_iff.mp hac + subst ha hc + obtain ⟨p₁, hp₁⟩ := exists_finiteSupportGradedEmbedding_eq_of A₀ + obtain ⟨p₂, hp₂⟩ := exists_finiteSupportGradedEmbedding_eq_of C₀ + rw [← hp₁, ← hp₂, ← map_mul] at hsplit + have hp₁p₂ : p₁ * p₂ = finiteSupportMonomial γ := + finiteSupportGradedEmbedding_injective K hsplit.symm + have hγ0 : ((γ : exponentMonoid ℝ) : ℝ) ≤ 0 := γ.2 + have hp₁p₂' : (p₁ : Series K) * (p₂ : Series K) = single (γ : ℝ) (1 : K) hγ0 := by + have h1 := congrArg Subtype.val hp₁p₂ + rw [Subring.coe_mul] at h1 + rw [h1] + exact Subtype.ext ((coe_finiteSupportMonomial γ).trans (coe_single _ _ _).symm) + have hmono₁ : IsMonomial (p₁ : Series K) := isMonomial_of_mul_eq_single one_ne_zero hγ0 hp₁p₂' + have hmono₂ : IsMonomial (p₂ : Series K) := + isMonomial_of_mul_eq_single one_ne_zero hγ0 (by rw [mul_comm]; exact hp₁p₂') + -- Cancel `t^γ` to obtain a factorisation of `B`. + have hγne : finiteSupportGradedEmbedding K (finiteSupportMonomial (K := K) γ) ≠ 0 := by + rw [finiteSupportGradedEmbedding_apply] + intro h + exact hres_ne (DirectSum.of_injective 0 (by rw [h, map_zero])) + have hBeq : B = A' * C' := by + apply mul_left_cancel₀ hγne + rw [← hAC, hA', hC', ← hp₁, ← hp₂, hsplit, map_mul] + ring + rcases hBirr.isUnit_or_isUnit hBeq with hA'u | hC'u + · obtain ⟨k, hk, hk'⟩ := exists_algebraMap_eq_of_isUnit hA'u + refine ⟨p₁ * algebraMap K _ k, ?_, Or.inl ?_⟩ + · obtain ⟨g, l, hg, hl, hp₁eq⟩ := isMonomial_iff.mp hmono₁ + refine isMonomial_iff.mpr ⟨g, l * k, hg, mul_ne_zero hl hk, ?_⟩ + rw [Subring.coe_mul, + show ((algebraMap K (Berarducci.FiniteSupportRing (K := K)) k : + Berarducci.FiniteSupportRing (K := K)) : Series K) = HahnSeries.Nonpositive.C k from + congrArg Subtype.val (show algebraMap K (Berarducci.FiniteSupportRing (K := K)) k = + finiteSupportScalarHom k from rfl) |>.trans + (Subtype.ext ((coe_finiteSupportScalarHom k).trans + (HahnSeries.Nonpositive.coe_C k).symm)), + hp₁eq] + apply Subtype.ext + simp only [Subring.coe_mul, coe_single, HahnSeries.Nonpositive.coe_C, HahnSeries.C_apply, + HahnSeries.single_mul_single, add_zero] + · rw [hA', ← hp₁, hk', map_mul, (finiteSupportGradedEmbedding K).commutes] + · obtain ⟨k, hk, hk'⟩ := exists_algebraMap_eq_of_isUnit hC'u + refine ⟨p₂ * algebraMap K _ k, ?_, Or.inr ?_⟩ + · obtain ⟨g, l, hg, hl, hp₂eq⟩ := isMonomial_iff.mp hmono₂ + refine isMonomial_iff.mpr ⟨g, l * k, hg, mul_ne_zero hl hk, ?_⟩ + rw [Subring.coe_mul, + show ((algebraMap K (Berarducci.FiniteSupportRing (K := K)) k : + Berarducci.FiniteSupportRing (K := K)) : Series K) = HahnSeries.Nonpositive.C k from + congrArg Subtype.val (show algebraMap K (Berarducci.FiniteSupportRing (K := K)) k = + finiteSupportScalarHom k from rfl) |>.trans + (Subtype.ext ((coe_finiteSupportScalarHom k).trans + (HahnSeries.Nonpositive.coe_C k).symm)), + hp₂eq] + apply Subtype.ext + simp only [Subring.coe_mul, coe_single, HahnSeries.Nonpositive.coe_C, HahnSeries.C_apply, + HahnSeries.single_mul_single, add_zero] + · rw [hC', ← hp₂, hk', map_mul, (finiteSupportGradedEmbedding K).commutes] + +/-! ### Back to series -/ + +/-- A series whose initial form is the image of a nonzero finite-support series `p` is `p`. -/ +theorem eq_of_initialForm_eq_finiteSupportGradedEmbedding [CharZero K] {a : Series K} + {p : Berarducci.FiniteSupportRing (K := K)} (hp : p ≠ 0) + (h : (degreeValuation K).initialForm a = finiteSupportGradedEmbedding K p) : + a = (p : Series K) := by + have hp' : (p : Series K) ≠ 0 := fun h' ↦ hp (Subtype.ext h') + have hdeg0 : degreeValuation K (p : Series K) = 0 := degreeValuation_finiteSupport_eq_zero p hp + -- `a` has degree zero, because its initial form lives in grade zero. + have ha0 : degreeValuation K a = 0 := by + have hne : (degreeValuation K).initialForm a ≠ 0 := by + rw [h, finiteSupportGradedEmbedding_eq_initialForm] + exact (degreeValuation K).initialForm_ne_zero_of_ne_zero (degreeValuation_isSeparated K) hp' + have hbot : degreeValuation K a ≠ ⊥ := fun hbot ↦ hne + ((degreeValuation K).initialForm_eq_zero_of_eq_bot hbot) + obtain ⟨d, hd⟩ := WithBot.ne_bot_iff_exists.mp hbot + by_contra hd0 + have hcomp := congrArg (fun z : DegreeGraded K ↦ z d) h + rw [finiteSupportGradedEmbedding_eq_initialForm, MaxAddDegree.initialForm_apply, + MaxAddDegree.initialForm_apply, dif_pos hd.symm, dif_neg (by + rw [hdeg0] + intro h0 + exact hd0 (by rw [← hd, ← h0]))] at hcomp + exact ((degreeValuation K).componentMk_eq_zero_iff d _).not.mpr + (by rw [← hd]; exact lt_irrefl _) hcomp + -- Hence `a` has finite support and its image in `RV̂` is its initial form. + have hafin : a ∈ (finiteSupportSubring : Subring (Series K)) := by + rw [mem_finiteSupportSubring_iff] + rw [degreeValuation_apply] at ha0 + exact (HahnSeries.degree_eq_zero.mp ha0).2 + have ha : finiteSupportGradedEmbedding K ⟨a, hafin⟩ = finiteSupportGradedEmbedding K p := by + rw [finiteSupportGradedEmbedding_eq_initialForm] + exact h + exact congrArg Subtype.val (finiteSupportGradedEmbedding_injective K ha) + +end FLLM24 + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/HereditaryIndependence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/HereditaryIndependence.lean new file mode 100644 index 0000000000..1342c00654 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/HereditaryIndependence.lean @@ -0,0 +1,174 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubring +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeSum + +/-! +# Hereditary `rv_J`-independence at finite ordinal-value degrees + +Fornasiero, Lavi, L'Innocente and Mantova, *Irreducibility in generalized power series* (2024), +§ 3, define by recursion on `deg_J(b_1)` when series `b_1, …, b_n` of a common ordinal-value degree +are *hereditarily `rv_J`-independent*, written `Q(b_1, …, b_n)`: + +1. the classes `rv_J(b_1), …, rv_J(b_n)` are `K`-linearly independent; +2. when `deg_J(b_1) ≠ deg_J^p(b_1)`, there is `δ < 0` such that for every degree `α` with + `deg_J^r(b_1) ≤ α < deg_J(b_1)` and all exponents `γ_{i,j} ≥ δ`, distinct for fixed `i`, with + `deg_J(b_i^{|γ_{i,j}}) = α`, the family of translated truncations `b_i^{|γ_{i,j}}` is again + hereditarily `rv_J`-independent. + +This module records the definition for finite ordinal-value degrees `n < ω`, the case of the +finite-degree irreducibility theorem. For `deg_J(b) = n ≥ 1` one has `v_J(b) = ω^n = ω^(n-1) · ω`, +so `deg_J^p(b) = 1` and `deg_J^r(b) = n - 1`: the second clause applies exactly when `n ≥ 2`, and +the degrees `α` it ranges over reduce to the single value `n - 1`. The class `rv_J(b)` is the +initial form of `b` in `P̂ = ⊕ P_α` for the ordinal-value degree. + +Families are indexed by an arbitrary type in `Type`; the families of translated truncations in +the second clause are indexed by a finite type `κ` together with maps `j : κ → ι` and +`γ : κ → ℝ`, the requirement "`γ_{i,j} ≠ γ_{i,j'}` whenever `j ≠ j'`" being injectivity of +`k ↦ (j k, γ k)`. Translated truncations are taken at exponents `γ ≤ 0`, the domain of +Definition 2.4; at `γ = 0` the truncation is the series itself, whose degree excludes it from the +second clause. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace FLLM24 + +open Berarducci + +variable {K : Type v} [Field K] + +/-- The class `rv_J(b)` of FLLM24, Definition 2.15: the initial form of `b` in Berarducci's +ring `P̂` for the ordinal-value degree `deg_J`, which is zero exactly on `J`. -/ +def rvJ (b : Series K) : PrincipalSubring K := + (ordinalValueDegreeValuation K).initialForm b + +theorem rvJ_eq_initialForm (b : Series K) : + rvJ b = (ordinalValueDegreeValuation K).initialForm b := + (rfl) + +/-- At ordinal value `ω^α`, the class `rv_J(b)` is the homogeneous class of `b` in grade `α`. -/ +theorem rvJ_eq_homogeneousMk {b : Series K} {α : NatOrdinal} (hb : ordinalValue b = ω^ α) : + rvJ b = (ordinalValueDegreeValuation K).homogeneousMk α + ⟨b, (mem_ordinalValueDegreeValuation_filtrationLE_iff b α).mpr + (hb ▸ NatOrdinal.wpow_lt_wpow.mpr (Order.lt_add_one_iff.mpr le_rfl))⟩ := by + rw [rvJ_eq_initialForm] + symm + apply MaxAddDegree.homogeneousMk_eq_initialForm_of_degree_eq + rw [ordinalValueDegreeValuation_apply, ordinalValueDegree_eq_coe_iff] + exact hb + +/-- `rv_J(b)` vanishes exactly on `J`. -/ +theorem rvJ_eq_zero_iff (b : Series K) : + rvJ b = 0 ↔ b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + rw [rvJ_eq_initialForm, MaxAddDegree.initialForm_eq_zero_iff, + ordinalValueDegreeValuation_eq_bot_iff] + +/-- FLLM24, § 3, at a finite ordinal-value degree `n`: the series `b i` have `v_J(b i) = ω^n`, +their classes `rv_J(b i)` are `K`-linearly independent, and, when `n ≥ 2`, there is `δ < 0` +such that every finite family of translated truncations `(b (j k))^{|γ k}` at distinct pairs +`(j k, γ k)` with `δ ≤ γ k ≤ 0` and `v_J((b (j k))^{|γ k}) = ω^(n-1)` is hereditarily +`rv_J`-independent at degree `n - 1`. -/ +def HereditarilyRVIndependent : ℕ → {ι : Type} → (ι → Series K) → Prop + | 0, _, b => + (∀ i, ordinalValue (b i) = ω^ ((0 : ℕ) : NatOrdinal)) ∧ + LinearIndependent K (fun i ↦ rvJ (b i)) + | n + 1, ι, b => + (∀ i, ordinalValue (b i) = ω^ ((n + 1 : ℕ) : NatOrdinal)) ∧ + LinearIndependent K (fun i ↦ rvJ (b i)) ∧ + (1 ≤ n → ∃ δ : ℝ, δ < 0 ∧ + ∀ (κ : Type) [Finite κ] (j : κ → ι) (γ : κ → ℝ), + Function.Injective (fun k ↦ (j k, γ k)) → + (∀ k, δ ≤ γ k) → (∀ k, γ k ≤ 0) → + (∀ k, ordinalValue (translatedTruncation (b (j k) : K⟦ℝ⟧) (γ k)) = + ω^ (n : NatOrdinal)) → + HereditarilyRVIndependent n + (fun k ↦ translatedTruncation (b (j k) : K⟦ℝ⟧) (γ k))) + +namespace HereditarilyRVIndependent + +variable {ι : Type} {b : ι → Series K} + +/-- Every member of a hereditarily `rv_J`-independent family at degree `n` has ordinal value +`ω^n`. -/ +theorem ordinalValue_eq {n : ℕ} (h : HereditarilyRVIndependent n b) (i : ι) : + ordinalValue (b i) = ω^ (n : NatOrdinal) := by + cases n with + | zero => exact h.1 i + | succ n => exact h.1 i + +/-- Axiom 1 of FLLM24, § 3: the classes `rv_J(b i)` are `K`-linearly independent. -/ +theorem linearIndependent {n : ℕ} (h : HereditarilyRVIndependent n b) : + LinearIndependent K (fun i ↦ rvJ (b i)) := by + cases n with + | zero => exact h.2 + | succ n => exact h.2.1 + +/-- Axiom 2 of FLLM24, § 3, at degree `n + 1 ≥ 2`: some threshold `δ < 0` makes every finite +family of translated truncations at distinct pairs above `δ` and of ordinal value `ω^n` +hereditarily `rv_J`-independent at degree `n`. -/ +theorem truncations {n : ℕ} (hn : 1 ≤ n) (h : HereditarilyRVIndependent (n + 1) b) : + ∃ δ : ℝ, δ < 0 ∧ + ∀ (κ : Type) [Finite κ] (j : κ → ι) (γ : κ → ℝ), + Function.Injective (fun k ↦ (j k, γ k)) → + (∀ k, δ ≤ γ k) → (∀ k, γ k ≤ 0) → + (∀ k, ordinalValue (translatedTruncation (b (j k) : K⟦ℝ⟧) (γ k)) = + ω^ (n : NatOrdinal)) → + HereditarilyRVIndependent n (fun k ↦ translatedTruncation (b (j k) : K⟦ℝ⟧) (γ k)) := + h.2.2 hn + +/-- The constructor for degree `n + 1`: the two axioms, the second required when `n ≥ 1`. -/ +theorem of_succ {n : ℕ} + (hvalue : ∀ i, ordinalValue (b i) = ω^ ((n + 1 : ℕ) : NatOrdinal)) + (hindep : LinearIndependent K (fun i ↦ rvJ (b i))) + (htrunc : 1 ≤ n → ∃ δ : ℝ, δ < 0 ∧ + ∀ (κ : Type) [Finite κ] (j : κ → ι) (γ : κ → ℝ), + Function.Injective (fun k ↦ (j k, γ k)) → + (∀ k, δ ≤ γ k) → (∀ k, γ k ≤ 0) → + (∀ k, ordinalValue (translatedTruncation (b (j k) : K⟦ℝ⟧) (γ k)) = + ω^ (n : NatOrdinal)) → + HereditarilyRVIndependent n (fun k ↦ translatedTruncation (b (j k) : K⟦ℝ⟧) (γ k))) : + HereditarilyRVIndependent (n + 1) b := + ⟨hvalue, hindep, htrunc⟩ + +/-- At degree one only Axiom 1 is required: `deg_J^p(b) = 1 = deg_J(b)`. -/ +theorem of_one (hvalue : ∀ i, ordinalValue (b i) = ω^ ((1 : ℕ) : NatOrdinal)) + (hindep : LinearIndependent K (fun i ↦ rvJ (b i))) : + HereditarilyRVIndependent 1 b := + ⟨hvalue, hindep, fun h ↦ absurd h (by decide)⟩ + +/-- Hereditary `rv_J`-independence passes to subfamilies. -/ +theorem comp_injective {n : ℕ} (h : HereditarilyRVIndependent n b) {ι' : Type} (f : ι' → ι) + (hf : Function.Injective f) : + HereditarilyRVIndependent n (b ∘ f) := by + induction n generalizing ι with + | zero => + exact ⟨fun i ↦ h.1 (f i), h.2.comp f hf⟩ + | succ n ih => + refine ⟨fun i ↦ h.1 (f i), h.2.1.comp f hf, fun hn ↦ ?_⟩ + obtain ⟨δ, hδ, hδfam⟩ := h.2.2 hn + refine ⟨δ, hδ, fun κ _ j γ hinj hδγ hγ hvalue ↦ ?_⟩ + have hinj' : Function.Injective (fun k ↦ (f (j k), γ k)) := by + intro k k' hkk' + have h1 : f (j k) = f (j k') := congrArg Prod.fst hkk' + have h2 : γ k = γ k' := congrArg Prod.snd hkk' + exact hinj (Prod.ext (hf h1) h2) + exact hδfam κ (fun k ↦ f (j k)) γ hinj' hδγ hγ hvalue + +end HereditarilyRVIndependent + +end FLLM24 + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/IndependenceWindow.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/IndependenceWindow.lean new file mode 100644 index 0000000000..7add9d5043 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/IndependenceWindow.lean @@ -0,0 +1,154 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ReducibleSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveCoefficientMap +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +import Mathlib.Tactic.Linarith + +/-! +# The support of a vanishing relation among classes + +Fornasiero, Lavi, L'Innocente and Mantova, *Irreducibility in generalized power series* (2024), +Propositions 3.4 and 3.6, both start from a relation `∑ k_i rv_J(b_i) = 0`, that is +`r := ∑ k_i b_i ∈ J_{deg_J(b_1)}`, and compare the supports of the `b_i` with that of `r` near +zero: the support of each `b_i` in `(η, 0)` has order type `v_J(b_i)`, while that of `r` has +order type at most `v_J(r) < v_J(b_i)`, so each `b_i` has infinitely many support points in +`(η, 0)` outside the support of `r`. This module proves these two facts and the coefficient +formula for `r`; the two propositions then differ only in how they exploit such a point. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace FLLM24 + +open Berarducci HahnSeries.Nonpositive + +variable {K : Type v} [Field K] + +/-- A vanishing `K`-linear relation among the classes `rv_J(c k)` of series of a common ordinal +value `ω^d` puts the corresponding combination of the `c k` into `J_{ω^d}`. -/ +theorem ordinalValue_sum_C_mul_lt_of_sum_smul_rvJ_eq_zero {κ : Type*} [Fintype κ] + {c : κ → Series K} {d : NatOrdinal} (hc : ∀ k, ordinalValue (c k) = ω^ d) (g : κ → K) + (hrel : ∑ k, g k • rvJ (c k) = 0) : + ordinalValue (∑ k, (HahnSeries.Nonpositive.C : K →+* Series K) (g k) * c k) < ω^ d := by + have hcut : ∀ k ∈ (Finset.univ : Finset κ), ordinalValue (c k) < ω^ (d + 1) := fun k _ ↦ by + rw [hc k]; exact NatOrdinal.wpow_lt_wpow.mpr (lt_add_one d) + have hCcut : ∀ k ∈ (Finset.univ : Finset κ), + ordinalValue ((HahnSeries.Nonpositive.C : K →+* Series K) (g k) * c k) < ω^ (d + 1) := + fun k hk ↦ by + simpa only [zero_add] using + ordinalValue_mul_lt_wpow_add_one (ordinalValue_C_lt_wpow_one (g k)) (hcut k hk) + rw [← gradeClass_eq_zero_iff (ordinalValue_sum_lt_wpow_add_one _ _ hCcut), + gradeClass_sum _ _ hCcut, ← hrel] + exact Finset.sum_congr rfl fun k hk ↦ by + rw [gradeClass_C_mul (g k) (hcut k hk), rvJ_eq_gradeClass (hc k)] + +/-- The coefficient of a `K`-linear combination of series. -/ +theorem coeff_sum_C_mul {κ : Type*} [Fintype κ] (c : κ → Series K) (g : κ → K) (x : ℝ) : + (((∑ k, (HahnSeries.Nonpositive.C : K →+* Series K) (g k) * c k : Series K)) : + K⟦ℝ⟧).coeff x = ∑ k, g k * ((c k : Series K) : K⟦ℝ⟧).coeff x := by + rw [AddSubmonoidClass.coe_finsetSum, HahnSeries.coeff_sum] + refine Finset.sum_congr rfl fun k _ ↦ ?_ + rw [Subring.coe_mul, HahnSeries.Nonpositive.coe_C, HahnSeries.C_mul_eq_smul, + HahnSeries.coeff_smul, smul_eq_mul] + +/-- Near zero, the support of a series in `(η, 0)` has order type at most its ordinal value: +equality holds on a stable tail when `1 < v_J`, and the support is empty in `(η, 0)` when the +series lies in `J + K`. -/ +theorem exists_forall_orderType_negativeSupportTail_le (r : Series K) : + ∃ η₀ < (0 : ℝ), ∀ η, η₀ < η → η < 0 → + NatOrdinal.of ((r : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support r η)).orderType ≤ ordinalValue r := by + by_cases hone : 1 < ordinalValue r + · obtain ⟨η₀, hη₀, h⟩ := + exists_forall_later_negativeSupportTail_orderType_eq_ordinalValue r hone + refine ⟨η₀, hη₀, fun η hη₀η hη ↦ ?_⟩ + rw [h η hη₀η hη, NatOrdinal.of_val] + · have hnear : r ∈ nearConstantSubgroup K := not_not.mp (mt one_lt_ordinalValue_iff.mpr hone) + have hJ := mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem.mp hnear + set j := r - HahnSeries.Nonpositive.C (HahnSeries.Nonpositive.constantCoeff r) with hj + -- Every nonzero support point of `r` lies in the support of `j`, which is bounded below + -- zero. + have hsupp : (j : K⟦ℝ⟧).support = (r : K⟦ℝ⟧).support \ {0} := support_sub_C_constantCoeff r + obtain ⟨η₀, hη₀, hbound⟩ : ∃ η₀ < (0 : ℝ), ∀ x ∈ (j : K⟦ℝ⟧).support, x ≤ η₀ := by + rcases eq_or_ne j 0 with hj0 | hj0 + · exact ⟨-1, by norm_num, fun x hx ↦ by + rw [hj0] at hx + simp at hx⟩ + · have hlt := mem_negativeMonomialIdeal_iff_supportSup_lt_zero.mp hJ + rw [supportSup_of_ne hj0] at hlt + exact ⟨sSup (j : K⟦ℝ⟧).support, WithBot.coe_lt_coe.mp hlt, + fun x hx ↦ le_csSup (bddAbove_support j) hx⟩ + refine ⟨η₀, hη₀, fun η hη₀η hη ↦ ?_⟩ + have hempty : negativeSupportTail r η = ∅ := by + ext x + simp only [Set.mem_empty_iff_false, iff_false] + intro hx + obtain ⟨hxsupp, hηx, hx0⟩ := mem_negativeSupportTail_iff.mp hx + have hxj : x ∈ (j : K⟦ℝ⟧).support := by + rw [hsupp]; exact ⟨hxsupp, hx0.ne⟩ + exact absurd (hbound x hxj) (not_le.mpr (by linarith)) + rw [(Set.IsPWO.orderType_eq_zero _).mpr hempty] + simp + +/-- FLLM24, proofs of Propositions 3.4 and 3.6: if `v_J(c) = ω^d > 1` and `v_J(r) < ω^d`, then +on every interval `(η, 0)` close to zero the support of `c` has infinitely many points outside +the support of `r`. -/ +theorem exists_forall_infinite_support_diff {c r : Series K} {d : NatOrdinal} (hd : 0 < d) + (hc : ordinalValue c = ω^ d) (hr : ordinalValue r < ω^ d) : + ∃ η₀ < (0 : ℝ), ∀ η, η₀ < η → η < 0 → + (((c : K⟦ℝ⟧).support ∩ Set.Ioo η 0) \ (r : K⟦ℝ⟧).support).Infinite := by + have hone : 1 < ordinalValue c := by + rw [hc, ← NatOrdinal.wpow_zero] + exact NatOrdinal.wpow_lt_wpow.mpr hd + obtain ⟨η₁, hη₁, hstable⟩ := + exists_forall_later_negativeSupportTail_orderType_eq_ordinalValue c hone + obtain ⟨η₂, hη₂, hbound⟩ := exists_forall_orderType_negativeSupportTail_le r + refine ⟨max η₁ η₂, max_lt hη₁ hη₂, fun η hη₀η hη hfin ↦ ?_⟩ + have hη₁η : η₁ < η := (le_max_left _ _).trans_lt hη₀η + have hη₂η : η₂ < η := (le_max_right _ _).trans_lt hη₀η + -- The tail of `c` is covered by the tail of `r` and a finite set. + set E := ((c : K⟦ℝ⟧).support ∩ Set.Ioo η 0) \ (r : K⟦ℝ⟧).support with hE + have hcover : negativeSupportTail c η ⊆ negativeSupportTail r η ∪ E := by + intro x hx + obtain ⟨hxc, hηx, hx0⟩ := mem_negativeSupportTail_iff.mp hx + by_cases hxr : x ∈ (r : K⟦ℝ⟧).support + · exact Or.inl (mem_negativeSupportTail_iff.mpr ⟨hxr, hηx, hx0⟩) + · exact Or.inr ⟨⟨hxc, hηx, hx0⟩, hxr⟩ + have hcPWO := (c : K⟦ℝ⟧).isPWO_support.mono (negativeSupportTail_subset_support c η) + have hrPWO := (r : K⟦ℝ⟧).isPWO_support.mono (negativeSupportTail_subset_support r η) + have hEPWO : E.IsPWO := hfin.isPWO + have hle := Set.IsPWO.orderType_mono hcPWO (hrPWO.union hEPWO) hcover + have hunion := Set.IsPWO.orderType_union_le_naturalAdd hrPWO hEPWO + have hEfin : NatOrdinal.of hEPWO.orderType < ω^ d := by + have h1 : hEPWO.orderType < Ordinal.omega0 := (hEPWO.finite_iff_orderType_lt_omega).mp hfin + have h2 : NatOrdinal.of hEPWO.orderType < ω^ (1 : NatOrdinal) := by + rw [NatOrdinal.wpow_def, NatOrdinal.of.lt_iff_lt] + simpa using h1 + exact h2.trans_le (NatOrdinal.wpow_le_wpow.mpr (Order.one_le_iff_pos.mpr hd)) + have hrlt : NatOrdinal.of hrPWO.orderType < ω^ d := (hbound η hη₂η hη).trans_lt hr + have hsum : NatOrdinal.of hrPWO.orderType + NatOrdinal.of hEPWO.orderType < ω^ d := + NatOrdinal.add_lt_wpow hrlt hEfin + have hcval : NatOrdinal.of hcPWO.orderType = ω^ d := by + rw [hstable η hη₁η hη, NatOrdinal.of_val, hc] + have : NatOrdinal.of hcPWO.orderType ≤ NatOrdinal.of hrPWO.orderType + + NatOrdinal.of hEPWO.orderType := by + rw [← NatOrdinal.val.le_iff_le, NatOrdinal.val_of] + exact hle.trans hunion + rw [hcval] at this + exact absurd this (not_le.mpr hsum) + +end FLLM24 + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/MainTheorem.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/MainTheorem.lean new file mode 100644 index 0000000000..ae7f7ae051 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/MainTheorem.lean @@ -0,0 +1,99 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.RandomBlocks + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentDegree + +/-! +# Irreducibility of random series of finite degree + +Fornasiero, Lavi, L'Innocente and Mantova, *Irreducibility in generalized power series* (2024), +Theorem 1.8 for `α = n < ω`, and Corollary 1.5. + +Theorem 1.8: let `b ∈ K((ℝ^{≤0}))` with `sup(b) = 0` and `ot(b) = m ω^n + β`, `m ≥ 1`, +`β < ω^n`. If `b` is random, then `b` is irreducible, and so is `b + r` for every `r` with +`ot(r) < ω^n` and `sup(b + r) = 0`. The proof is the one of the source, Corollary 4.13 for +`α = n`: the normal form of `b` gives `b = ∑ᵢ bᵢ t^{γᵢ} + r'` with `b₁, …, bₘ ∈ P_n` and +`deg(r') < n`; randomness of `b` makes the blocks mutually random, hence hereditarily +`rv_J`-independent; and Proposition 3.2 applies to `b + r = ∑ᵢ bᵢ t^{γᵢ} + (r' + r)`. + +Corollary 1.5: a random principal series of degree `n ≥ 1` is irreducible, the case `m = 1`, +`β = 0`, `r = 0`. The source states Corollary 1.5 for every `n ∈ ℕ`; at `n = 0` a principal +series is a nonzero constant, a unit, and the statement is false as printed, so the corollary is +stated here for `n ≥ 1`. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace FLLM24 + +open Berarducci HahnSeries HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +/-- FLLM24, Theorem 1.8 for `α = n ≥ 1`, the perturbed form: if `b` is random with +`ot(b) = ω^n · m + β`, `m ≥ 1`, `β < ω^n`, then `b + r` is irreducible for every `r` with +`ot(r) < ω^n` and `sup(b + r) = 0`. -/ +theorem irreducible_add_of_isRandom {n m : ℕ} (hn : 1 ≤ n) (hm : 1 ≤ m) {β : Ordinal} + (hβ : β < Ordinal.omega0 ^ (n : Ordinal)) {b : Series K} (hb : IsRandom b) + (hot : (b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (n : Ordinal) * m + β) + {r : Series K} (hr : (r : K⟦ℝ⟧).supportOrderType < Ordinal.omega0 ^ (n : Ordinal)) + (hsup : supportSup (b + r) = 0) : + Irreducible (b + r) := by + obtain ⟨d⟩ := exists_blockDecomposition hn hβ hot + have hQ : HereditarilyRVIndependent n d.block := d.hereditarilyRVIndependent_block hn hb + haveI : Nonempty (Fin m) := ⟨⟨0, hm⟩⟩ + obtain ⟨i₀, hi₀⟩ := Finite.exists_max d.exponent + have hr' : ((d.rest + r : Series K) : K⟦ℝ⟧).degree < + ((n : NatOrdinal) : WithBot NatOrdinal) := by + have hrdeg : (r : K⟦ℝ⟧).degree < ((n : NatOrdinal) : WithBot NatOrdinal) := by + rw [degree_lt_coe_iff_supportOrderType_lt_wpow, NatOrdinal.val_wpow, NatOrdinal.val_natCast] + exact hr + rw [Subring.coe_add] + exact (HahnSeries.degree_add_le _ _).trans_lt (max_lt d.rest_degree hrdeg) + have heq : b + r = blockSum d.block d.exponent d.exponent_nonpos (d.rest + r) := by + rw [blockSum_def, ← add_assoc, ← blockSum_def, ← d.eq_blockSum] + rw [heq] at hsup ⊢ + exact irreducible_blockSum hn d.block_isPrincipal hQ d.exponent_nonpos + d.exponent_strictMono.injective i₀ hi₀ hr' hsup + +/-- FLLM24, Theorem 1.8 for `α = n ≥ 1`: a random series `b` with `sup(b) = 0` and +`ot(b) = ω^n · m + β`, `m ≥ 1`, `β < ω^n`, is irreducible. -/ +theorem irreducible_of_isRandom {n m : ℕ} (hn : 1 ≤ n) (hm : 1 ≤ m) {β : Ordinal} + (hβ : β < Ordinal.omega0 ^ (n : Ordinal)) {b : Series K} (hb : IsRandom b) + (hsup : supportSup b = 0) + (hot : (b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (n : Ordinal) * m + β) : + Irreducible b := by + have h := irreducible_add_of_isRandom hn hm hβ hb hot (r := 0) + (by + rw [ZeroMemClass.coe_zero, supportOrderType_zero] + exact Ordinal.opow_pos _ Ordinal.omega0_pos) + (by rw [add_zero]; exact hsup) + rwa [add_zero] at h + +/-- FLLM24, Corollary 1.5 for `n ≥ 1`: a random principal series of degree `n` is +irreducible. -/ +theorem irreducible_of_isRandom_of_isPrincipal {n : ℕ} (hn : 1 ≤ n) {b : Series K} + (hb : IsRandom b) (hp : IsPrincipal b) + (hdeg : (b : K⟦ℝ⟧).degree = ((n : NatOrdinal) : WithBot NatOrdinal)) : + Irreducible b := by + have hot : (b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (n : Ordinal) * (1 : ℕ) + 0 := by + rw [Nat.cast_one, mul_one, add_zero] + have h := hp.supportOrderType_eq_wpow_of_degree_eq hdeg + rw [h, NatOrdinal.val_wpow, NatOrdinal.val_natCast] + exact irreducible_of_isRandom hn le_rfl (Ordinal.opow_pos _ Ordinal.omega0_pos) hb + hp.supportSup_eq_zero hot + +end FLLM24 + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/NonPrincipalIrreducible.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/NonPrincipalIrreducible.lean new file mode 100644 index 0000000000..3e85c4b6a3 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/NonPrincipalIrreducible.lean @@ -0,0 +1,266 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ClassIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.GradedIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeSum +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm + +/-! +# Irreducibility of non-principal series of finite degree + +Fornasiero, Lavi, L'Innocente and Mantova, *Irreducibility in generalized power series* (2024), +Proposition 3.2, for `α = n < ω`: let `b = ∑ᵢ bᵢ t^{γᵢ} + r` with `b₁, …, bₘ ∈ P_n`, +`γ₁ < ⋯ < γₘ ≤ 0`, `deg(r) < n`, `sup(b) = 0`, and `Q(b₁, …, bₘ)`. Then `b` is irreducible. + +The source reduces to LM24, Lemma 7.1.1 (`b` is irreducible when `rv(b)/p(rv(b))` is +irreducible and `p(b) = 1`) and Lemma 3.1 (`p(b) = 1`). The proof here keeps its shape but does +not pass through the maximal finite-support divisor: the initial form of `b` in the +degree-graded ring `RV̂` is `t^{γₘ} · B` for the block form `B = ∑ᵢ rv_J(bᵢ) t^{γᵢ - γₘ}`, which +is irreducible by `ConwayRefinement.HahnSeries.Factorization.Random.GradedIrreducible` because +`rv_J(bₘ)` is irreducible in `P̂` (Corollary 4.5, from `Q(bₘ)`); a factorisation `b = a c` +gives `in(a) in(c) = t^{γₘ} B`, so +one factor, say `a`, has initial form a monomial `k t^x`, hence `a = k t^x`; and `x < 0` is +impossible because `sup(b) = 0`, while `x = 0` makes `a` a unit. The hypothesis `sup(b) = 0` is +exactly what the source uses to pass from `p(b) ∣ t^{γₘ}` to `p(b) = 1`. + +The source's "`a ∈ J + K` without loss of generality" is the step `deg_J(a) = 0` obtained from +the irreducibility of `rv(bₘ)`; the step "`deg_J(aᵢ) = 0` for every `i`, hence `a ∈ K(ℝ^{≤0})`" +is the coordinate-functional argument of the graded module. +-/ + +open scoped DirectSum HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace FLLM24 + +open Berarducci HahnSeries.Nonpositive + +variable {K : Type v} [Field K] + +/-- The series `∑ᵢ bᵢ t^{γᵢ} + r` of FLLM24, Proposition 3.2. -/ +def blockSum {ι : Type*} [Fintype ι] (b : ι → Series K) (γ : ι → ℝ) (hγ : ∀ i, γ i ≤ 0) + (r : Series K) : Series K := + ∑ i, b i * single (γ i) (1 : K) (hγ i) + r + +theorem blockSum_def {ι : Type*} [Fintype ι] (b : ι → Series K) (γ : ι → ℝ) (hγ : ∀ i, γ i ≤ 0) + (r : Series K) : + blockSum b γ hγ r = ∑ i, b i * single (γ i) (1 : K) (hγ i) + r := + (rfl) + +/-- The monomial `t^γ` as a finite-support series, for `γ ≤ 0`. -/ +private theorem coe_monomial (γ : ℝ) (hγ : γ ≤ 0) : + ((finiteSupportMonomial (K := K) (⟨γ, hγ⟩ : exponentMonoid ℝ) : + Berarducci.FiniteSupportRing (K := K)) : Series K) = single γ (1 : K) hγ := + Subtype.ext ((coe_finiteSupportMonomial _).trans (coe_single _ _ _).symm) + +variable [CharZero K] + +omit [CharZero K] in +/-- The image of a finite-support series in `RV̂` is its class in grade zero, for any proof of +membership in the weak filtration at zero. -/ +private theorem finiteSupportGradedEmbedding_eq_homogeneousMk' + (p : Berarducci.FiniteSupportRing (K := K)) + (h : (p : Series K) ∈ (degreeValuation K).filtrationLE 0) : + finiteSupportGradedEmbedding K p = (degreeValuation K).homogeneousMk 0 ⟨(p : Series K), h⟩ := by + rw [finiteSupportGradedEmbedding_eq_homogeneousMk] + exact congrArg _ (Subtype.ext (coe_finiteSupportFiltrationRepresentative p)) + +/-- The image of a principal series `p` of degree `n` in `RV̂` through `P̂`: its degree-initial +form is the image of its class `rv_J(p)`. -/ +private theorem principalSubringEmbedding_rvJ_of_isPrincipal {n : NatOrdinal} {p : Series K} + (hp : IsPrincipal p) (hpDegree : (p : K⟦ℝ⟧).degree = (n : WithBot NatOrdinal)) : + principalSubringEmbedding K (rvJ p) = (degreeValuation K).initialForm p := by + have hval : ordinalValue p = ω^ n := ordinalValue_eq_wpow_of_isPrincipal hp hpDegree + have hcut : ordinalValue p < ω^ (n + 1) := by + rw [hval]; exact NatOrdinal.wpow_lt_wpow.mpr (lt_add_one n) + rw [rvJ_eq_gradeClass hval, gradeClass_of_lt hcut, principalSubringEmbedding_of, + principalComponentToHahnDegreeLayer_mk n p hp hpDegree hcut, degreeLayerMk_eq_componentMk, + ← MaxAddDegree.homogeneousMk_apply] + apply MaxAddDegree.homogeneousMk_eq_initialForm_of_degree_eq + rw [degreeValuation_apply, hpDegree] + +/-- FLLM24, Proposition 3.2, for `α = n ≥ 1`: if `b₁, …, bₘ ∈ P_n` are hereditarily +`rv_J`-independent, `γ₁, …, γₘ ≤ 0` are distinct with maximum `γₘ`, `deg(r) < n`, and +`b = ∑ᵢ bᵢ t^{γᵢ} + r` has `sup(b) = 0`, then `b` is irreducible in `K((ℝ^{≤0}))`. -/ +theorem irreducible_blockSum {n : ℕ} (hn : 1 ≤ n) {ι : Type} [Fintype ι] + {b : ι → Series K} (hb : ∀ i, IsPrincipal (b i)) (hQ : HereditarilyRVIndependent n b) + {γ : ι → ℝ} (hγ : ∀ i, γ i ≤ 0) (hinj : Function.Injective γ) (m : ι) + (hm : ∀ i, γ i ≤ γ m) {r : Series K} (hr : (r : K⟦ℝ⟧).degree < ((n : NatOrdinal) : WithBot + NatOrdinal)) (hsup : supportSup (blockSum b γ hγ r) = 0) : + Irreducible (blockSum b γ hγ r) := by + classical + set B := blockSum b γ hγ r with hBdef + have hval : ∀ i, ordinalValue (b i) = ω^ (n : NatOrdinal) := hQ.ordinalValue_eq + have hdeg : ∀ i, ((b i : Series K) : K⟦ℝ⟧).degree = ((n : NatOrdinal) : WithBot NatOrdinal) := + fun i ↦ by + rw [← ordinalValueDegree_eq_degree_of_isPrincipal (hb i), ordinalValueDegree_eq_coe_iff] + exact hval i + have hcut : ∀ i, ordinalValue (b i) < ω^ ((n : NatOrdinal) + 1) := fun i ↦ by + rw [hval i]; exact NatOrdinal.wpow_lt_wpow.mpr (lt_add_one _) + -- The classes and the exponents of the block form. + let x : ι → PrincipalComponent K (n : NatOrdinal) := + fun i ↦ principalComponentMk _ (b i) (hcut i) + have hx : ∀ i, + rvJ (b i) = DirectSum.of (PrincipalComponent K) (n : NatOrdinal) (x i) := fun i ↦ by + rw [rvJ_eq_gradeClass (hval i), gradeClass_of_lt (hcut i)] + have hli : LinearIndependent K + (fun i ↦ DirectSum.of (PrincipalComponent K) (n : NatOrdinal) (x i)) := by + simpa only [hx] using hQ.linearIndependent + let δ : ι → exponentMonoid ℝ := fun i ↦ ⟨γ i - γ m, sub_nonpos.mpr (hm i)⟩ + have hδm : δ m = 0 := Subtype.ext (sub_self (γ m)) + have hδ : ∀ i, δ i = 0 → i = m := fun i hi ↦ hinj (sub_eq_zero.mp (congrArg Subtype.val hi)) + let γm : exponentMonoid ℝ := ⟨γ m, hγ m⟩ + have hirr : Irreducible (DirectSum.of (PrincipalComponent K) (n : NatOrdinal) (x m)) := by + rw [← hx] + exact irreducible_rvJ_of_hereditarilyRVIndependent hn + (hQ.comp_injective (fun _ : Unit ↦ m) fun _ _ _ ↦ rfl) + set Bform := blockForm K (fun i ↦ DirectSum.of (PrincipalComponent K) (n : NatOrdinal) (x i)) δ + with hBform + -- The degree-`n` class of `B` is `t^{γₘ} · Bform`. + have hle : ∀ i, ((b i * single (γ i) (1 : K) (hγ i) : Series K) : K⟦ℝ⟧).degree ≤ + ((n : NatOrdinal) : WithBot NatOrdinal) := fun i ↦ by + rw [degree_mul, hdeg i] + have h0 : ((single (γ i) (1 : K) (hγ i) : Series K) : K⟦ℝ⟧).degree ≤ 0 := by + rw [HahnSeries.degree_le_zero_iff, coe_single] + exact (Set.finite_singleton (γ i)).subset HahnSeries.support_single_subset + calc ((n : NatOrdinal) : WithBot NatOrdinal) + ((single (γ i) (1 : K) (hγ i) : Series K) : + K⟦ℝ⟧).degree ≤ (n : NatOrdinal) + (0 : WithBot NatOrdinal) := add_le_add le_rfl h0 + _ = (n : NatOrdinal) := add_zero _ + have hsum_le : degreeValuation K (∑ i, b i * single (γ i) (1 : K) (hγ i)) ≤ + ((n : NatOrdinal) : WithBot NatOrdinal) := + MaxAddDegree.map_sum_le_of_forall_le _ _ _ _ fun i _ ↦ by + rw [degreeValuation_apply]; exact hle i + have hBmem : B ∈ (degreeValuation K).filtrationLE (n : NatOrdinal) := by + rw [MaxAddDegree.mem_filtrationLE_iff, hBdef, blockSum_def] + exact ((degreeValuation K).map_add_le_max _ _).trans (max_le hsum_le (by + rw [degreeValuation_apply]; exact hr.le)) + have hclass : (degreeValuation K).homogeneousMk (n : NatOrdinal) ⟨B, hBmem⟩ = + finiteSupportGradedEmbedding K (finiteSupportMonomial γm) * Bform := by + have hsum_mem : ∑ i, b i * single (γ i) (1 : K) (hγ i) ∈ + (degreeValuation K).filtrationLE (n : NatOrdinal) := + (MaxAddDegree.mem_filtrationLE_iff _ _ _).mpr hsum_le + have hr_mem : r ∈ (degreeValuation K).filtrationLE (n : NatOrdinal) := by + rw [MaxAddDegree.mem_filtrationLE_iff, degreeValuation_apply]; exact hr.le + have hsplit : (degreeValuation K).homogeneousMk (n : NatOrdinal) ⟨B, hBmem⟩ = + (degreeValuation K).homogeneousMk (n : NatOrdinal) ⟨_, hsum_mem⟩ + + (degreeValuation K).homogeneousMk (n : NatOrdinal) ⟨r, hr_mem⟩ := by + rw [← map_add]; rfl + have hr_zero : (degreeValuation K).homogeneousMk (n : NatOrdinal) ⟨r, hr_mem⟩ = 0 := + (degreeValuation K).homogeneousMk_eq_zero_of_degree_lt hr_mem + (by rw [degreeValuation_apply]; exact hr) + rw [hsplit, hr_zero, add_zero, MaxAddDegree.homogeneousMk_finsetSum _ _ _ + (fun i _ ↦ (MaxAddDegree.mem_filtrationLE_iff _ _ _).mpr + (by rw [degreeValuation_apply]; exact hle i)), hBform, blockForm_def, Finset.mul_sum, + ← Finset.sum_attach Finset.univ] + refine Finset.sum_congr rfl fun i _ ↦ ?_ + -- Each term is `in(bᵢ) · t^{γᵢ}` with `t^{γᵢ} = t^{γₘ} t^{γᵢ - γₘ}`. + have hbi_mem : b i ∈ (degreeValuation K).filtrationLE (n : NatOrdinal) := by + rw [MaxAddDegree.mem_filtrationLE_iff, degreeValuation_apply, hdeg i] + have hti_mem : ((finiteSupportMonomial (K := K) (⟨γ i, hγ i⟩ : exponentMonoid ℝ) : + Berarducci.FiniteSupportRing (K := K)) : Series K) ∈ + (degreeValuation K).filtrationLE 0 := by + rw [MaxAddDegree.mem_filtrationLE_iff, degreeValuation_apply, WithBot.coe_zero, + HahnSeries.degree_le_zero_iff] + exact (mem_finiteSupportSubring_iff _).mp (finiteSupportMonomial _).2 + have hbi_form : (degreeValuation K).homogeneousMk (n : NatOrdinal) ⟨b i, hbi_mem⟩ = + principalSubringEmbedding K + (DirectSum.of (PrincipalComponent K) (n : NatOrdinal) (x i)) := by + rw [← hx i, principalSubringEmbedding_rvJ_of_isPrincipal (hb i) (hdeg i)] + exact (degreeValuation K).homogeneousMk_eq_initialForm_of_degree_eq hbi_mem + (by rw [degreeValuation_apply, hdeg i]) + rw [(degreeValuation K).homogeneousMk_mul_of_coe_eq (add_zero (n : NatOrdinal)).symm + ⟨b i, hbi_mem⟩ ⟨_, hti_mem⟩ _ (by + change b i * single (γ i) (1 : K) (hγ i) = b i * _ + rw [coe_monomial]), + ← finiteSupportGradedEmbedding_eq_homogeneousMk' _ hti_mem, hbi_form, + show (⟨γ i, hγ i⟩ : exponentMonoid ℝ) = + ⟨(γm : ℝ) + ((δ i : exponentMonoid ℝ) : ℝ), (exponentMonoid ℝ).add_mem γm.2 (δ i).2⟩ from + Subtype.ext (by change γ i = γ m + (γ i - γ m); ring), + ← finiteSupportMonomial_mul, map_mul] + ring + -- The block form and the monomial are nonzero, so `B` has degree exactly `n`. + have hBform_ne : Bform ≠ 0 := by + intro h + have hproj := rvProjection_blockForm + (fun i ↦ DirectSum.of (PrincipalComponent K) (n : NatOrdinal) (x i)) δ m hδm hδ + rw [← hBform, h, map_zero] at hproj + exact hirr.ne_zero hproj.symm + have hγm_ne : finiteSupportGradedEmbedding K (finiteSupportMonomial (K := K) γm) ≠ 0 := by + intro h + rw [← map_zero (finiteSupportGradedEmbedding K)] at h + have h1 := finiteSupportGradedEmbedding_injective K h + have h2 := congrArg (fun q : Berarducci.FiniteSupportRing (K := K) ↦ + ((q : Series K) : K⟦ℝ⟧).coeff (γ m)) h1 + simp only [coe_finiteSupportMonomial, ZeroMemClass.coe_zero, HahnSeries.coeff_zero] at h2 + rw [show ((γm : exponentMonoid ℝ) : ℝ) = γ m from rfl, HahnSeries.coeff_single_same] at h2 + exact one_ne_zero h2 + have hBclass_ne : (degreeValuation K).homogeneousMk (n : NatOrdinal) ⟨B, hBmem⟩ ≠ 0 := by + rw [hclass]; exact mul_ne_zero hγm_ne hBform_ne + have hBdeg : degreeValuation K B = ((n : NatOrdinal) : WithBot NatOrdinal) := by + have hle' : degreeValuation K B ≤ (n : NatOrdinal) := + (MaxAddDegree.mem_filtrationLE_iff _ _ _).mp hBmem + rcases hle'.lt_or_eq with hlt | heq + · exact absurd ((degreeValuation K).homogeneousMk_eq_zero_iff _ _ |>.mpr hlt) hBclass_ne + · exact heq + have hinit : (degreeValuation K).initialForm B = + finiteSupportGradedEmbedding K (finiteSupportMonomial γm) * Bform := by + rw [← hclass] + exact ((degreeValuation K).homogeneousMk_eq_initialForm_of_degree_eq hBmem hBdeg).symm + -- `B` is not a unit: the units are the constants, of degree zero. + refine ⟨fun hunit ↦ ?_, fun a c hac ↦ ?_⟩ + · have hconst := eq_C_constantCoeff_of_isUnit hunit + have h0 : degreeValuation K B ≤ 0 := by + rw [hconst, degreeValuation_apply] + exact degree_C_le_zero _ + rw [hBdeg] at h0 + exact absurd (WithBot.coe_le_coe.mp h0) (not_le.mpr (Nat.cast_pos.mpr hn)) + -- A factorisation: one factor has a monomial initial form, hence is a monomial. + have hprod : (degreeValuation K).initialForm a * (degreeValuation K).initialForm c = + finiteSupportGradedEmbedding K (finiteSupportMonomial γm) * Bform := by + rw [← MaxAddDegree.initialForm_mul, ← hac, hinit] + obtain ⟨p, hp, hpa⟩ := exists_isMonomial_factor_of_mul_eq x hli δ m hδm hδ hirr γm hprod + have hp0 : p ≠ 0 := by + intro h + obtain ⟨g, l, hg, hl, hpeq⟩ := isMonomial_iff.mp hp + rw [h] at hpeq + have hcoeff := congrArg (fun q : Series K ↦ (q : K⟦ℝ⟧).coeff g) hpeq + exact hl (by simpa [coe_single] using hcoeff.symm) + -- A monomial factor of `B` is a unit, because `sup(B) = 0`. + have hunit_of : ∀ a' : Series K, a' = (p : Series K) → a' ∣ B → IsUnit a' := by + intro a' ha' hdvd + obtain ⟨g, l, hg, hl, hpeq⟩ := isMonomial_iff.mp hp + rw [ha', hpeq] + rcases hg.lt_or_eq with hneg | hzero + · exfalso + have hJ : B ∈ negativeMonomialIdeal K := by + have hmem : single g l hg ∈ negativeMonomialIdeal K := by + rw [mem_negativeMonomialIdeal_iff_supportSup_lt_zero, supportSup_single hl hg] + exact WithBot.coe_lt_coe.mpr hneg + rw [ha', hpeq] at hdvd + exact Ideal.mem_of_dvd _ hdvd hmem + rw [mem_negativeMonomialIdeal_iff_supportSup_lt_zero, hsup] at hJ + exact lt_irrefl _ hJ + · subst hzero + exact (isUnit_single_iff hl le_rfl).mpr rfl + rcases hpa with ha | hc + · exact Or.inl (hunit_of a (eq_of_initialForm_eq_finiteSupportGradedEmbedding hp0 ha) + (Dvd.intro c hac.symm)) + · exact Or.inr (hunit_of c (eq_of_initialForm_eq_finiteSupportGradedEmbedding hp0 hc) + (Dvd.intro_left a hac.symm)) + +end FLLM24 + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/NormalFormBlocks.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/NormalFormBlocks.lean new file mode 100644 index 0000000000..a0d8a7c0e5 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/NormalFormBlocks.lean @@ -0,0 +1,323 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NonPrincipalIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedSupport +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal +import Mathlib.SetTheory.Ordinal.Principal +import Mathlib.Topology.Order.Monotone + +/-! +# The block decomposition of a series of order type `ω^n · m + β` + +Fornasiero, Lavi, L'Innocente and Mantova, *Irreducibility in generalized power series* (2024), +Theorem 1.8, treat a series `b` with `sup(b) = 0` and `ot(b) = m ω^α + β`, `β < ω^α`, through +its normal form (LM24, Definition 3.3.6 and Proposition 3.3.7, recalled as Definition 2.1): +`b = ∑ᵢ bᵢ t^{γᵢ} + r` with `b₁, …, bₘ ∈ P_α`, `γ₁ < ⋯ < γₘ ≤ 0` and `deg(r) < α`. The source +does not spell out this reading of the normal form; it is carried out here for `α = n < ω`. + +The normal form lists principal terms `bᵢ t^{γᵢ}` with supports in strictly increasing +position and order types forming the Cantor normal form of `ot(b)`. When +`ot(b) = ω^n · m + β` with `β < ω^n`, the first `m` terms have order type `ω^n` and the remaining +ones order types below `ω^n`; the latter sum to `r`. The exponents of the first `m` terms are +strictly increasing: two consecutive terms of order type `ω^n ≥ ω` cannot share their support +supremum, since the upper one would then be a single monomial. + +The decomposition records, besides the identity `b = ∑ᵢ bᵢ t^{γᵢ} + r`, the position of the +supports: the support of each block `bᵢ t^{γᵢ}` lies strictly below that of the later blocks and +of `r`. These are the facts used to transfer randomness from `b` to `b₁, …, bₘ`. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace FLLM24 + +open Berarducci HahnSeries HahnSeries.Nonpositive + +variable {K : Type v} [Field K] + +/-- The block decomposition `b = ∑ᵢ bᵢ t^{γᵢ} + r` of a series of order type `ω^n · m + β`, +`β < ω^n`: `m` principal blocks of degree `n` at strictly increasing exponents `γᵢ ≤ 0`, a rest +of degree below `n`, and the supports of the blocks lying in increasing position below the +support of the rest. -/ +structure BlockDecomposition (b : Series K) (n m : ℕ) where + /-- The principal blocks `b₁, …, bₘ`. -/ + block : Fin m → Series K + /-- The exponents `γ₁ < ⋯ < γₘ`. -/ + exponent : Fin m → ℝ + /-- The rest `r`. -/ + rest : Series K + /-- Each block is principal. -/ + block_isPrincipal : ∀ i, IsPrincipal (block i) + /-- Each block has degree `n`. -/ + block_degree : ∀ i, ((block i : Series K) : K⟦ℝ⟧).degree = ((n : NatOrdinal) : WithBot NatOrdinal) + /-- The exponents are nonpositive. -/ + exponent_nonpos : ∀ i, exponent i ≤ 0 + /-- The exponents are strictly increasing. -/ + exponent_strictMono : StrictMono exponent + /-- The rest has degree below `n`. -/ + rest_degree : (rest : K⟦ℝ⟧).degree < ((n : NatOrdinal) : WithBot NatOrdinal) + /-- `b = ∑ᵢ bᵢ t^{γᵢ} + r`. -/ + eq_blockSum : b = blockSum block exponent exponent_nonpos rest + /-- The support of an earlier block lies strictly below the support of a later block. -/ + piece_lt_piece : ∀ i j, i < j → + ∀ x ∈ ((block i * single (exponent i) (1 : K) (exponent_nonpos i) : Series K) : K⟦ℝ⟧).support, + ∀ y ∈ ((block j * single (exponent j) (1 : K) (exponent_nonpos j) : Series K) : K⟦ℝ⟧).support, + x < y + /-- The support of every block lies strictly below the support of the rest. -/ + piece_lt_rest : ∀ i, + ∀ x ∈ ((block i * single (exponent i) (1 : K) (exponent_nonpos i) : Series K) : K⟦ℝ⟧).support, + ∀ y ∈ (rest : K⟦ℝ⟧).support, x < y + +namespace BlockDecomposition + +variable {b : Series K} {n m : ℕ} (d : BlockDecomposition b n m) + +/-- The `i`-th block in position, `bᵢ t^{γᵢ}`. -/ +def piece (i : Fin m) : Series K := + d.block i * single (d.exponent i) (1 : K) (d.exponent_nonpos i) + +theorem piece_def (i : Fin m) : + d.piece i = d.block i * single (d.exponent i) (1 : K) (d.exponent_nonpos i) := + (rfl) + +theorem coe_piece (i : Fin m) : + ((d.piece i : Series K) : K⟦ℝ⟧) = translate (d.exponent i) (d.block i : K⟦ℝ⟧) := by + rw [piece_def, Subring.coe_mul, coe_single, mul_single_one_eq_translate] + +theorem eq_sum_piece_add_rest : b = ∑ i, d.piece i + d.rest := + d.eq_blockSum.trans (blockSum_def _ _ _ _) + +/-- The support of an earlier piece lies strictly below the support of a later piece. -/ +theorem piece_support_lt {i j : Fin m} (hij : i < j) {x y : ℝ} + (hx : x ∈ ((d.piece i : Series K) : K⟦ℝ⟧).support) + (hy : y ∈ ((d.piece j : Series K) : K⟦ℝ⟧).support) : x < y := + d.piece_lt_piece i j hij x hx y hy + +/-- The support of every piece lies strictly below the support of the rest. -/ +theorem piece_support_lt_rest (i : Fin m) {x y : ℝ} + (hx : x ∈ ((d.piece i : Series K) : K⟦ℝ⟧).support) (hy : y ∈ (d.rest : K⟦ℝ⟧).support) : + x < y := + d.piece_lt_rest i x hx y hy + +end BlockDecomposition + +/-- Every element of a list of ordinals is at most the ordinary sum of the list. -/ +private theorem le_list_sum_of_mem {l : List Ordinal} {a : Ordinal} (ha : a ∈ l) : a ≤ l.sum := by + induction l with + | nil => exact absurd ha (List.not_mem_nil) + | cons c l ih => + rw [List.sum_cons] + rcases List.mem_cons.mp ha with rfl | ha + · exact le_self_add + · exact (ih ha).trans le_add_self + +/-- The Cantor terms of `ω^n · m + β` for `β < ω^n`: `m` copies of `ω^n` followed by the Cantor +terms of `β`. -/ +theorem additivePrincipalTerms_omega0_opow_mul_add {n m : ℕ} {β : Ordinal} + (hβ : β < Ordinal.omega0 ^ (n : Ordinal)) : + (Ordinal.omega0 ^ (n : Ordinal) * m + β).additivePrincipalTerms = + List.replicate m (Ordinal.omega0 ^ (n : Ordinal)) ++ β.additivePrincipalTerms := by + symm + apply Ordinal.additivePrincipalTerms_unique + · rw [List.sum_append, List.sum_replicate, Ordinal.nsmul_eq_mul, + Ordinal.additivePrincipalTerms_sum] + · intro a ha + rcases List.mem_append.mp ha with ha | ha + · rw [List.eq_of_mem_replicate ha] + exact Ordinal.isAdditivelyPrincipal_omega0_opow _ + · exact Ordinal.isAdditivelyPrincipal_of_mem_additivePrincipalTerms ha + · rw [List.sortedGE_iff_pairwise, List.pairwise_append] + refine ⟨?_, List.sortedGE_iff_pairwise.mp (Ordinal.additivePrincipalTerms_sortedGE β), + fun a ha c hc ↦ ?_⟩ + · rw [List.pairwise_iff_forall_sublist] + intro a c hsub + have ha := List.eq_of_mem_replicate (hsub.subset (List.mem_cons_self ..)) + have hc := List.eq_of_mem_replicate (hsub.subset (List.mem_cons_of_mem _ + (List.mem_cons_self ..))) + rw [ha, hc] + · rw [List.eq_of_mem_replicate ha] + exact ((le_list_sum_of_mem hc).trans_eq (Ordinal.additivePrincipalTerms_sum β)).trans hβ.le + +/-- A Hahn series whose support has order type `ω^n` with `n ≥ 1` is not a monomial: its +support is not contained in a singleton. -/ +private theorem not_subset_singleton_of_supportOrderType_eq {n : ℕ} (hn : 1 ≤ n) {x : K⟦ℝ⟧} + (hx : x.supportOrderType = Ordinal.omega0 ^ (n : Ordinal)) (g : ℝ) : + ¬ x.support ⊆ {g} := by + intro hsub + have hle : x.supportOrderType ≤ (HahnSeries.single g (1 : K)).supportOrderType := + supportOrderType_mono (by rw [HahnSeries.support_single_of_ne one_ne_zero]; exact hsub) + rw [supportOrderType_single one_ne_zero, hx] at hle + have hlt : (1 : Ordinal) < Ordinal.omega0 ^ (n : Ordinal) := + Ordinal.one_lt_omega0.trans_le (by + calc Ordinal.omega0 = Ordinal.omega0 ^ (1 : Ordinal) := (Ordinal.opow_one _).symm + _ ≤ Ordinal.omega0 ^ (n : Ordinal) := + Ordinal.opow_le_opow_right Ordinal.omega0_pos (by exact_mod_cast hn)) + exact absurd hle (not_le.mpr hlt) + +/-- LM24, Proposition 3.3.7, read at order type `ω^n · m + β` with `β < ω^n` and `n ≥ 1`: the +normal form of `b` is a block decomposition with `m` blocks of degree `n`. -/ +theorem exists_blockDecomposition {b : Series K} {n m : ℕ} (hn : 1 ≤ n) {β : Ordinal} + (hβ : β < Ordinal.omega0 ^ (n : Ordinal)) + (hot : (b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (n : Ordinal) * m + β) : + Nonempty (BlockDecomposition b n m) := by + classical + obtain ⟨terms, hterms⟩ := exists_isNormalForm b + obtain ⟨hsum, -, hprinc, -, hpair⟩ := isNormalForm_iff.mp hterms + set L : List K⟦ℝ⟧ := terms.map NormalForm.Term.series with hL + have htypes : L.map supportOrderType = + List.replicate m (Ordinal.omega0 ^ (n : Ordinal)) ++ β.additivePrincipalTerms := by + rw [hterms.isWeakNormalForm.supportOrderTypes_eq_additivePrincipalTerms, hot, + additivePrincipalTerms_omega0_opow_mul_add hβ] + have hlen : m ≤ L.length := by + have := congrArg List.length htypes + rw [List.length_map, List.length_append, List.length_replicate] at this + omega + have hlenT : m ≤ terms.length := by rwa [hL, List.length_map] at hlen + -- The first `m` series have order type `ω^n`; the remaining ones have smaller order type. + have htake : (L.take m).map supportOrderType = + List.replicate m (Ordinal.omega0 ^ (n : Ordinal)) := by + rw [List.map_take, htypes, List.take_left' (List.length_replicate ..)] + have hdrop : (L.drop m).map supportOrderType = β.additivePrincipalTerms := by + rw [List.map_drop, htypes, List.drop_left' (List.length_replicate ..)] + have hot_take : ∀ y ∈ L.take m, y.supportOrderType = Ordinal.omega0 ^ (n : Ordinal) := + fun y hy ↦ List.eq_of_mem_replicate (htake ▸ List.mem_map_of_mem hy) + have hot_drop : ∀ y ∈ L.drop m, y.supportOrderType < Ordinal.omega0 ^ (n : Ordinal) := by + intro y hy + have hmem : y.supportOrderType ∈ β.additivePrincipalTerms := hdrop ▸ List.mem_map_of_mem hy + exact ((le_list_sum_of_mem hmem).trans_eq (Ordinal.additivePrincipalTerms_sum β)).trans_lt hβ + -- The terms of the first `m` blocks. + have hltT : ∀ i : Fin m, i.1 < terms.length := fun i ↦ lt_of_lt_of_le i.2 hlenT + have hltL : ∀ i : Fin m, i.1 < L.length := fun i ↦ lt_of_lt_of_le i.2 hlen + let tm : Fin m → NormalForm.Term K := fun i ↦ terms[i.1]'(hltT i) + have htm_mem : ∀ i, tm i ∈ terms := fun i ↦ List.getElem_mem _ + have hLget : ∀ i : Fin m, L[i.1]'(hltL i) = (tm i).series := fun i ↦ by + simp only [hL, List.getElem_map, tm] + have hseries_mem : ∀ i, (tm i).series ∈ L.take m := by + intro i + rw [← hLget i, + ← List.getElem_take (h := (by rw [List.length_take]; exact lt_min i.2 (hltL i)))] + exact List.getElem_mem _ + have hprinc' : ∀ i, IsPrincipal (tm i).coefficient := fun i ↦ hprinc _ (htm_mem i) + have hot_tm : ∀ i, ((tm i).coefficient : K⟦ℝ⟧).supportOrderType = + Ordinal.omega0 ^ (n : Ordinal) := fun i ↦ by + rw [← supportOrderType_translate (tm i).exponent, ← NormalForm.Term.series_eq_translate] + exact hot_take _ (hseries_mem i) + have hexp : ∀ i, (tm i).exponent = sSup (tm i).series.support := fun i ↦ + (NormalForm.Term.csSup_support_series (tm i) (hprinc' i)).symm + have hseries_ne : ∀ i, (tm i).series ≠ 0 := fun i ↦ + NormalForm.Term.series_ne_zero (hprinc' i) + have hsub_b : ∀ i, (tm i).series.support ⊆ (b : K⟦ℝ⟧).support := fun i ↦ by + rw [← hsum] + exact support_subset_list_sum_of_mem hpair (List.mem_map_of_mem (htm_mem i)) + -- Pairwise position of the series. + have hlenL : (L.take m).length = m := by + rw [List.length_take]; exact min_eq_left hlen + have hbelow : ∀ i j, i < j → SupportBelow (tm i).series (tm j).series := by + intro i j hij + rw [← hLget i, ← hLget j] + have h := List.pairwise_iff_get.mp hpair ⟨i.1, hltL i⟩ ⟨j.1, hltL j⟩ (by simpa using hij) + simpa only [List.get_eq_getElem] using h + have hpairAll : (L.take m ++ L.drop m).Pairwise SupportBelow := by + rw [List.take_append_drop]; exact hpair + have hbelow_drop : ∀ i, SupportBelow (tm i).series (L.drop m).sum := by + intro i + apply supportBelow_list_sum + intro y hy + exact (List.pairwise_append.mp hpairAll).2.2 _ (hseries_mem i) y hy + -- The exponents. + have hexp_nonpos : ∀ i, (tm i).exponent ≤ 0 := fun i ↦ by + rw [hexp i] + exact csSup_le (support_nonempty_iff.mpr (hseries_ne i)) + fun x hx ↦ HahnSeries.Nonpositive.support_subset b (hsub_b i hx) + have hexp_mono : StrictMono fun i ↦ (tm i).exponent := by + intro i j hij + have hbel := hbelow i j hij + have hle : (tm i).exponent ≤ (tm j).exponent := by + rw [hexp i, hexp j] + exact csSup_support_le_of_supportBelow (hseries_ne i) (hseries_ne j) + (NormalForm.Term.bddAbove_support _) hbel + refine lt_of_le_of_ne hle fun heq ↦ ?_ + apply not_subset_singleton_of_supportOrderType_eq hn (hot_take _ (hseries_mem j)) + (tm j).exponent + intro y hy + have hy_le : y ≤ (tm j).exponent := by + rw [hexp j]; exact le_csSup (NormalForm.Term.bddAbove_support _) hy + have hy_ge : (tm i).exponent ≤ y := by + rw [hexp i] + exact csSup_le (support_nonempty_iff.mpr (hseries_ne i)) fun x hx ↦ (hbel.lt hx hy).le + have heq' : (tm i).exponent = (tm j).exponent := heq + exact Set.mem_singleton_iff.mpr (le_antisymm hy_le (heq' ▸ hy_ge)) + -- The sum of the first `m` series and the rest. + have hsum_take : ∑ i, (tm i).series = (L.take m).sum := by + have hofFn : List.ofFn (fun i : Fin m ↦ (tm i).series) = L.take m := by + apply List.ext_getElem + · rw [List.length_ofFn, hlenL] + · intro i h₁ h₂ + have hi : i < m := by simpa using h₁ + rw [List.getElem_ofFn, ← hLget ⟨i, hi⟩, List.getElem_take] + rw [← hofFn, List.sum_ofFn] + have hsplit : L.sum = (L.take m).sum + (L.drop m).sum := by + have h := List.sum_append (l₁ := L.take m) (l₂ := L.drop m) + rwa [List.take_append_drop] at h + have hrest : (b : K⟦ℝ⟧) - ∑ i, (tm i).series = (L.drop m).sum := by + rw [hsum_take, ← hsum, hsplit] + abel + have hbelowSum : SupportBelow (L.take m).sum (L.drop m).sum := by + apply list_sum_supportBelow + intro x hx + apply supportBelow_list_sum + intro y hy + exact (List.pairwise_append.mp hpairAll).2.2 x hx y hy + have hdropsub : (L.drop m).sum.support ⊆ (b : K⟦ℝ⟧).support := by + rw [← hsum, hsplit, support_add_eq_union_of_supportBelow _ _ hbelowSum] + exact Set.subset_union_right + have hrest_mem : (b : K⟦ℝ⟧) - ∑ i, (tm i).series ∈ nonpositiveSubring ℝ K := by + rw [mem_nonpositiveSubring] + intro y hy + rw [hrest] at hy + exact HahnSeries.Nonpositive.support_subset b (hdropsub hy) + let rest : Series K := ⟨_, hrest_mem⟩ + have hcoe_rest : (rest : K⟦ℝ⟧) = (L.drop m).sum := hrest + have hpairDrop : (L.drop m).Pairwise SupportBelow := hpair.sublist (List.drop_sublist m L) + have hpiece : ∀ i, ((((tm i).coefficient * single (tm i).exponent (1 : K) (hexp_nonpos i)) : + Series K) : K⟦ℝ⟧) = (tm i).series := fun i ↦ by + rw [Subring.coe_mul, coe_single, mul_single_one_eq_translate, + NormalForm.Term.series_eq_translate] + -- Assemble the decomposition. + refine ⟨⟨fun i ↦ (tm i).coefficient, fun i ↦ (tm i).exponent, rest, hprinc', ?_, hexp_nonpos, + hexp_mono, ?_, ?_, ?_, ?_⟩⟩ + · intro i + rw [degree_eq_cantorDegree, hot_tm i, ← NatOrdinal.cantorDegree_of, ← NatOrdinal.val_natCast, + ← NatOrdinal.wpow_def, NatOrdinal.cantorDegree_wpow] + · rw [hcoe_rest, degree_lt_coe_iff_supportOrderType_lt_wpow, supportOrderType_list_sum hpairDrop, + NatOrdinal.val_wpow, NatOrdinal.val_natCast] + exact (Ordinal.isAdditivelyPrincipal_omega0_opow _).list_sum_lt fun a ha ↦ by + obtain ⟨y, hy, rfl⟩ := List.mem_map.mp ha + exact hot_drop y hy + · apply Subtype.ext + rw [blockSum_def, Subring.coe_add, AddSubmonoidClass.coe_finsetSum] + simp only [hpiece] + change (b : K⟦ℝ⟧) = ∑ i, (tm i).series + ((b : K⟦ℝ⟧) - ∑ i, (tm i).series) + abel + · intro i j hij x hx y hy + rw [hpiece] at hx hy + exact (hbelow i j hij).lt hx hy + · intro i x hx y hy + rw [hpiece] at hx + rw [hcoe_rest] at hy + exact (hbelow_drop i).lt hx hy + +end FLLM24 + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/PrincipalIrreducible.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/PrincipalIrreducible.lean new file mode 100644 index 0000000000..ac8a886286 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/PrincipalIrreducible.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTerm +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubring +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedValuation + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.OrdinalValueDegree + +/-! +# Irreducibility at a power of `ω` + +Fornasiero, Lavi, L'Innocente and Mantova, *Irreducibility of generalised power series* (2024), +§ 1, deduce from Berarducci's `P_α · P_β ⊆ P_{α ⊕ β}` that every principal series of order type +`ω ^ (ω ^ α)` is irreducible, because there are no nonzero `β, γ` with `β ⊕ γ = ω ^ α`. This +module is that deduction, carried out on the graded ring rather than on series. + +Their statement is the stronger one: it concludes irreducibility in `K((ℝ^{≤ 0}))` itself, where +this concludes it for the class in `P̂`. LM24, Theorem E is stronger again, covering order type +`ω ^ (ω ^ α) +̂ β` for every `β < ω ^ (ω ^ α)` and every `α`, not only the additively principal +grades. Nothing here is new; the point of formalizing it is that the grade-splitting argument is +general, and lives in `ConwayRefinement.Algebra.DirectSum.HomogeneousPrime` next to the +primality lift it is the easy counterpart of. +-/ + +open scoped DirectSum NatOrdinal + +universe v + +public noncomputable section + +namespace FLLM24 + +open Berarducci + +variable {K : Type v} [Field K] + +theorem not_isUnit_of_grade_ne_zero {alpha : NatOrdinal} (halpha : alpha ≠ 0) + (X : PrincipalComponent K alpha) : + ¬ IsUnit (DirectSum.of (PrincipalComponent K) alpha X) := by + intro hunit + obtain ⟨y, hy⟩ := hunit.exists_right_inv + have hzero : (DirectSum.of (PrincipalComponent K) alpha X * y) 0 = 0 := by + apply DirectSum.of_mul_apply_eq_zero_of_not_exists + rintro ⟨j, hj⟩ + exact halpha (NatOrdinal.add_eq_zero_iff.mp hj).1 + rw [hy] at hzero + apply (one_ne_zero : (1 : PrincipalSubring K) ≠ 0) + rw [DirectSum.one_def] at hzero ⊢ + simp only [DirectSum.of_apply, dif_pos] at hzero + rw [show (GradedMonoid.GOne.one : PrincipalComponent K 0) = 0 by simpa using hzero, map_zero] + +/-- A nonzero class of grade zero is a unit: grade zero is the scalar field. -/ +theorem isUnit_of_grade_zero (u : PrincipalComponent K 0) (hu : u ≠ 0) : + IsUnit (DirectSum.of (PrincipalComponent K) 0 u) := by + obtain ⟨c, rfl⟩ := principalComponentScalarHom_surjective K u + have hc : c ≠ 0 := by + intro hzero + exact hu (by rw [hzero, map_zero]) + have heq : DirectSum.of (PrincipalComponent K) 0 (principalComponentScalarHom K c) = + algebraMap K (PrincipalSubring K) c := rfl + rw [heq] + exact (isUnit_iff_ne_zero.mpr hc).map (algebraMap K (PrincipalSubring K)) + +variable [CharZero K] in +/-- FLLM24, § 1: a nonzero homogeneous class at a power of `ω` is irreducible, here in `P̂`: the +products of nonzero homogeneous classes are nonzero because the ordinal value is multiplicative +(Berarducci, Theorem 9.7). -/ +theorem irreducible_of_isAdditivelyPrincipal + {alpha : NatOrdinal} (halpha : Ordinal.IsAdditivelyPrincipal alpha.val) + (X : PrincipalComponent K alpha) (hX : X ≠ 0) : + Irreducible (DirectSum.of (PrincipalComponent K) alpha X) := by + have halphaNe : alpha ≠ 0 := by + obtain ⟨e, he⟩ := Ordinal.isAdditivelyPrincipal_iff.mp halpha + intro hzero + rw [hzero] at he + exact Ordinal.opow_ne_zero e Ordinal.omega0_ne_zero (by simpa using he.symm) + refine DirectSum.irreducible_of_homogeneous_of_grade_not_split + (PrincipalComponent K) X + (fun u v hu hv ↦ MaxAddDegree.componentMul_ne_zero + (ordinalValueDegreeValuation K) u v hu hv) + (fun _ ↦ zero_le) isUnit_of_grade_zero + (fun j k hjk ↦ ?_) ?_ (not_isUnit_of_grade_ne_zero halphaNe X) + · rcases eq_or_ne j 0 with h | h + · exact Or.inl h + · rcases eq_or_ne k 0 with h' | h' + · exact Or.inr h' + · exact absurd hjk (NatOrdinal.add_ne_of_isAdditivelyPrincipal halpha h h') + · intro hzero + exact hX (DirectSum.of_injective alpha (by rw [hzero, map_zero])) + +end FLLM24 + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/Random.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/Random.lean new file mode 100644 index 0000000000..c6bf1d0945 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/Random.lean @@ -0,0 +1,150 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ +public import Mathlib.RingTheory.AlgebraicIndependent.Defs +public import Mathlib.Algebra.Algebra.Rat +public import Mathlib.Topology.MetricSpace.Pseudo.Defs +public import Mathlib.LinearAlgebra.LinearIndependent.Defs + +/-! +# Random series + +Fornasiero, Lavi, L'Innocente and Mantova, *Irreducibility in generalized power series* (2024), +Definition 1.3: a series `b = ∑ b_γ t^γ ∈ K((ℝ^{≤0}))` is *random* if the set +`cl(supp b) ∖ {0}` is `ℚ`-linearly independent in `ℝ`, or the family of coefficients +`⟨b_γ : γ ∈ supp b⟩` is algebraically independent over `ℚ`. Section 3 extends this to finitely +many series: `b_1, …, b_m` are *mutually random* if the closures of their supports meet pairwise +only in `{0}` and the union of the sets `cl(supp b_i) ∖ {0}` is `ℚ`-linearly independent, or +the joint family of all their coefficients is algebraically independent over `ℚ`. + +The coefficient field has characteristic zero, so it is a `ℚ`-algebra through Mathlib's +`DivisionRing.toRatAlgebra`; algebraic independence is Mathlib's `AlgebraicIndependent ℚ`. +The two clauses are recorded as separate predicates, `IsSupportRandom` and +`IsCoefficientRandom`, and `IsRandom` is their disjunction, so that the theorems proved from +each clause can be stated for that clause alone. +-/ + +open scoped HahnSeries + +universe v + +public noncomputable section + +namespace FLLM24 + +open Berarducci + +variable {K : Type v} [Field K] + +/-- The set `cl(supp b) ∖ {0}` of FLLM24, Definition 1.3. -/ +def supportClosure (b : Series K) : Set ℝ := + closure (b : K⟦ℝ⟧).support \ {0} + +theorem mem_supportClosure_iff (b : Series K) (x : ℝ) : + x ∈ supportClosure b ↔ x ∈ closure (b : K⟦ℝ⟧).support ∧ x ≠ 0 := + (Iff.rfl) + +/-- The first clause of FLLM24, Definition 1.3: the closure of the support of `b`, with zero +removed, is a `ℚ`-linearly independent subset of `ℝ`. -/ +def IsSupportRandom (b : Series K) : Prop := + LinearIndependent ℚ (fun x : supportClosure b ↦ (x : ℝ)) + +theorem IsSupportRandom.linearIndependent {b : Series K} (h : IsSupportRandom b) : + LinearIndependent ℚ (fun x : supportClosure b ↦ (x : ℝ)) := + h + +theorem IsSupportRandom.of {b : Series K} + (h : LinearIndependent ℚ (fun x : supportClosure b ↦ (x : ℝ))) : IsSupportRandom b := + h + +variable [CharZero K] in +/-- The second clause of FLLM24, Definition 1.3: the coefficients `⟨b_γ : γ ∈ supp b⟩` are +algebraically independent over `ℚ`. -/ +def IsCoefficientRandom (b : Series K) : Prop := + AlgebraicIndependent ℚ (fun γ : (b : K⟦ℝ⟧).support ↦ (b : K⟦ℝ⟧).coeff γ) + +variable [CharZero K] in +theorem IsCoefficientRandom.algebraicIndependent {b : Series K} (h : IsCoefficientRandom b) : + AlgebraicIndependent ℚ (fun γ : (b : K⟦ℝ⟧).support ↦ (b : K⟦ℝ⟧).coeff γ) := + h + +variable [CharZero K] in +theorem IsCoefficientRandom.of {b : Series K} + (h : AlgebraicIndependent ℚ (fun γ : (b : K⟦ℝ⟧).support ↦ (b : K⟦ℝ⟧).coeff γ)) : + IsCoefficientRandom b := + h + +variable [CharZero K] in +/-- FLLM24, Definition 1.3: a series is random if its support closure (without zero) is +`ℚ`-linearly independent or its coefficients are algebraically independent over `ℚ`. -/ +def IsRandom (b : Series K) : Prop := + IsSupportRandom b ∨ IsCoefficientRandom b + +variable [CharZero K] in +theorem isRandom_iff (b : Series K) : + IsRandom b ↔ IsSupportRandom b ∨ IsCoefficientRandom b := + (Iff.rfl) + +/-- The set `⋃ᵢ cl(supp bᵢ) ∖ {0}` of a family of series. -/ +def supportClosureUnion {ι : Type*} (b : ι → Series K) : Set ℝ := + (⋃ i, closure ((b i : K⟦ℝ⟧)).support) \ {0} + +theorem mem_supportClosureUnion_iff {ι : Type*} (b : ι → Series K) (x : ℝ) : + x ∈ supportClosureUnion b ↔ (∃ i, x ∈ closure ((b i : K⟦ℝ⟧)).support) ∧ x ≠ 0 := by + simp [supportClosureUnion] + +/-- The support clause of mutual randomness, FLLM24, § 3: the closures of the supports meet +pairwise only in `{0}`, and their union with zero removed is `ℚ`-linearly independent. -/ +structure IsMutuallySupportRandom {ι : Type*} (b : ι → Series K) : Prop where + /-- `cl(supp bᵢ) ∩ cl(supp bⱼ) ⊆ {0}` for `i ≠ j`. -/ + closure_inter_subset : ∀ i j, i ≠ j → + closure ((b i : K⟦ℝ⟧)).support ∩ closure ((b j : K⟦ℝ⟧)).support ⊆ {0} + /-- `⋃ᵢ cl(supp bᵢ) ∖ {0}` is `ℚ`-linearly independent. -/ + linearIndependent : LinearIndependent ℚ (fun x : supportClosureUnion b ↦ (x : ℝ)) + +/-- The index set of the joint coefficient family of a family of series: the pairs `(i, γ)` with +`γ ∈ supp bᵢ`. -/ +def coefficientIndex {ι : Type*} (b : ι → Series K) : Set (ι × ℝ) := + {p | p.2 ∈ ((b p.1 : K⟦ℝ⟧)).support} + +theorem mem_coefficientIndex_iff {ι : Type*} (b : ι → Series K) (p : ι × ℝ) : + p ∈ coefficientIndex b ↔ ((b p.1 : K⟦ℝ⟧)).coeff p.2 ≠ 0 := + (Iff.rfl) + +variable [CharZero K] in +/-- The coefficient clause of mutual randomness, FLLM24, § 3: the joint family +`⟨b_{iγ} : i, γ ∈ supp bᵢ⟩` is algebraically independent over `ℚ`. -/ +def IsMutuallyCoefficientRandom {ι : Type*} (b : ι → Series K) : Prop := + AlgebraicIndependent ℚ (fun p : coefficientIndex b ↦ ((b p.1.1 : K⟦ℝ⟧)).coeff p.1.2) + +variable [CharZero K] in +theorem IsMutuallyCoefficientRandom.algebraicIndependent {ι : Type*} {b : ι → Series K} + (h : IsMutuallyCoefficientRandom b) : + AlgebraicIndependent ℚ (fun p : coefficientIndex b ↦ ((b p.1.1 : K⟦ℝ⟧)).coeff p.1.2) := + h + +variable [CharZero K] in +theorem IsMutuallyCoefficientRandom.of {ι : Type*} {b : ι → Series K} + (h : AlgebraicIndependent ℚ (fun p : coefficientIndex b ↦ ((b p.1.1 : K⟦ℝ⟧)).coeff p.1.2)) : + IsMutuallyCoefficientRandom b := + h + +variable [CharZero K] in +/-- FLLM24, § 3: `b₁, …, bₘ` are mutually random if they satisfy the support clause or the +coefficient clause. -/ +def IsMutuallyRandom {ι : Type*} (b : ι → Series K) : Prop := + IsMutuallySupportRandom b ∨ IsMutuallyCoefficientRandom b + +variable [CharZero K] in +theorem isMutuallyRandom_iff {ι : Type*} (b : ι → Series K) : + IsMutuallyRandom b ↔ IsMutuallySupportRandom b ∨ IsMutuallyCoefficientRandom b := + (Iff.rfl) + +end FLLM24 + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/RandomBlocks.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/RandomBlocks.lean new file mode 100644 index 0000000000..944cb74e14 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/RandomBlocks.lean @@ -0,0 +1,325 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NormalFormBlocks +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.Random +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.CoefficientRandom +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SupportRandom +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.IndicatorFinsupp + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentDegree +import Mathlib.Topology.Algebra.Group.Basic +import Mathlib.Topology.Order.Monotone + +/-! +# Randomness of a series passes to its blocks + +Fornasiero, Lavi, L'Innocente and Mantova, *Irreducibility in generalized power series* (2024), +Theorem 1.8, apply Proposition 3.2 to the blocks `b₁, …, bₘ` of a random series +`b = ∑ᵢ bᵢ t^{γᵢ} + r`, which requires `Q(b₁, …, bₘ)`, hence the mutual randomness of the +blocks. The source does not write this step; it is carried out here. + +Coefficient clause: every coefficient of a block is a coefficient of `b`, since the blocks +`bᵢ t^{γᵢ}` occupy disjoint parts of the support of `b`; the joint coefficient family of the +blocks is a subfamily of the coefficient family of `b`, indexed injectively. + +Support clause: `cl(supp bᵢ) = cl(supp (bᵢ t^{γᵢ})) - γᵢ`, and `γᵢ ∈ cl(supp b)`. Two distinct +blocks cannot share a nonzero point `z` of their support closures, for `z + γᵢ`, `z + γⱼ`, +`γᵢ`, `γⱼ` would then satisfy a `ℚ`-relation in `cl(supp b) ∖ {0}` forcing `γᵢ = γⱼ`. A vanishing +`ℚ`-combination of elements `z` of `⋃ᵢ cl(supp bᵢ) ∖ {0}` lifts to the free module on +`cl(supp b) ∖ {0}` as a combination of `e(z + γ_{i(z)}) - e(γ_{i(z)})`; evaluated at the +smallest point `z₀ + γ_{i(z₀)}` occurring, only the coefficient of `z₀` survives, because +`γ_{i(z)} > z + γ_{i(z)}` for every `z`, and `z ↦ z + γ_{i(z)}` is injective. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace FLLM24 + +open Berarducci HahnSeries HahnSeries.Nonpositive + +variable {K : Type v} [Field K] + +namespace BlockDecomposition + +variable {b : Series K} {n m : ℕ} (d : BlockDecomposition b n m) + +/-! ### Supports of the pieces -/ + +/-- The supports of two distinct pieces are disjoint. -/ +theorem piece_disjoint {i j : Fin m} (hij : i ≠ j) {x : ℝ} + (hx : x ∈ ((d.piece i : Series K) : K⟦ℝ⟧).support) : + x ∉ ((d.piece j : Series K) : K⟦ℝ⟧).support := by + intro hx' + rcases lt_or_gt_of_ne hij with h | h + · exact lt_irrefl x (d.piece_support_lt h hx hx') + · exact lt_irrefl x (d.piece_support_lt h hx' hx) + +/-- The coefficient of `b` at a support point of the `i`-th piece is the coefficient of that +piece. -/ +theorem coeff_eq_coeff_piece (i : Fin m) {x : ℝ} + (hx : x ∈ ((d.piece i : Series K) : K⟦ℝ⟧).support) : + (b : K⟦ℝ⟧).coeff x = ((d.piece i : Series K) : K⟦ℝ⟧).coeff x := by + classical + have hsum := congrArg (fun c : Series K ↦ (c : K⟦ℝ⟧).coeff x) d.eq_sum_piece_add_rest + simp only [Subring.coe_add, AddSubmonoidClass.coe_finsetSum, HahnSeries.coeff_add, + HahnSeries.coeff_sum] at hsum + rw [hsum, Finset.sum_eq_single i] + · have hrest : ((d.rest : Series K) : K⟦ℝ⟧).coeff x = 0 := by + by_contra hne + exact lt_irrefl x (d.piece_support_lt_rest i hx hne) + rw [hrest, add_zero] + · intro j _ hji + by_contra hne + exact d.piece_disjoint hji.symm hx hne + · intro h + exact absurd (Finset.mem_univ i) h + +/-- The support of each piece is contained in the support of `b`. -/ +theorem support_piece_subset (i : Fin m) : + ((d.piece i : Series K) : K⟦ℝ⟧).support ⊆ (b : K⟦ℝ⟧).support := by + intro x hx + rw [HahnSeries.mem_support, d.coeff_eq_coeff_piece i hx] + exact hx + +/-- The coefficient of a block is the coefficient of its piece at the translated exponent. -/ +theorem coeff_block (i : Fin m) (y : ℝ) : + ((d.block i : Series K) : K⟦ℝ⟧).coeff y = + ((d.piece i : Series K) : K⟦ℝ⟧).coeff (d.exponent i + y) := by + rw [d.coe_piece, coeff_translate, add_sub_cancel_left] + +/-- The support of a piece is the translate of the support of its block. -/ +theorem support_piece (i : Fin m) : + ((d.piece i : Series K) : K⟦ℝ⟧).support = (d.exponent i + ·) '' ((d.block i : Series K) : + K⟦ℝ⟧).support := by + rw [d.coe_piece, support_translate] + +/-- The closure of the support of a piece is the translate of the closure of the support of its +block. -/ +theorem closure_support_piece (i : Fin m) : + closure ((d.piece i : Series K) : K⟦ℝ⟧).support = + (d.exponent i + ·) '' closure ((d.block i : Series K) : K⟦ℝ⟧).support := by + rw [d.support_piece] + exact ((Homeomorph.addLeft (d.exponent i)).image_closure _).symm + +/-- The exponent of a block lies in the closure of the support of its piece. -/ +theorem exponent_mem_closure (i : Fin m) : + d.exponent i ∈ closure ((d.piece i : Series K) : K⟦ℝ⟧).support := by + rw [d.closure_support_piece] + refine ⟨0, ?_, add_zero _⟩ + have hsup := (d.block_isPrincipal i).supportSup_eq_zero + rw [supportSup_of_ne (d.block_isPrincipal i).ne_zero] at hsup + have h0 : sSup ((d.block i : Series K) : K⟦ℝ⟧).support = 0 := WithBot.coe_inj.mp hsup + rw [← h0] + exact csSup_mem_closure (support_nonempty_iff.mpr (by + intro h; exact (d.block_isPrincipal i).ne_zero (Subtype.ext h))) (bddAbove_support _) + +/-- Points of the closure of a later piece are at least the exponent of an earlier block. -/ +theorem exponent_le_of_mem_closure_piece {i j : Fin m} (hij : i < j) {y : ℝ} + (hy : y ∈ closure ((d.piece j : Series K) : K⟦ℝ⟧).support) : d.exponent i ≤ y := by + have hsub : ((d.piece j : Series K) : K⟦ℝ⟧).support ⊆ Set.Ici (d.exponent i) := by + intro y' hy' + have hbound : ((d.piece i : Series K) : K⟦ℝ⟧).support ⊆ Set.Iic y' := + fun x hx ↦ (d.piece_support_lt hij hx hy').le + exact closure_minimal hbound isClosed_Iic (d.exponent_mem_closure i) + exact closure_minimal hsub isClosed_Ici hy + +/-- Points of the closure of the support of a block are nonpositive. -/ +theorem nonpos_of_mem_closure_block (i : Fin m) {z : ℝ} + (hz : z ∈ closure ((d.block i : Series K) : K⟦ℝ⟧).support) : z ≤ 0 := + closure_minimal (support_subset (d.block i)) isClosed_Iic hz + +/-- A point of the closure of the support of a block, translated by the exponent, lies in the +closure of the support of `b`. -/ +theorem add_mem_closure_support (i : Fin m) {z : ℝ} + (hz : z ∈ closure ((d.block i : Series K) : K⟦ℝ⟧).support) : + d.exponent i + z ∈ closure (b : K⟦ℝ⟧).support := by + apply closure_mono (d.support_piece_subset i) + rw [d.closure_support_piece] + exact ⟨z, hz, rfl⟩ + +/-- Two distinct blocks have no common nonzero point in their support closures translated into +position: `γᵢ + z = γⱼ + z'` with `z, z' ≠ 0` forces `i = j`. -/ +theorem eq_of_exponent_add_eq {i j : Fin m} {z z' : ℝ} + (hz : z ∈ closure ((d.block i : Series K) : K⟦ℝ⟧).support) + (hz' : z' ∈ closure ((d.block j : Series K) : K⟦ℝ⟧).support) (hz0 : z ≠ 0) (hz0' : z' ≠ 0) + (h : d.exponent i + z = d.exponent j + z') : i = j := by + by_contra hij + rcases lt_or_gt_of_ne hij with hlt | hlt + · have hmem : d.exponent j + z' ∈ closure ((d.piece j : Series K) : K⟦ℝ⟧).support := by + rw [d.closure_support_piece]; exact ⟨z', hz', rfl⟩ + have hge := d.exponent_le_of_mem_closure_piece hlt hmem + have hzneg : z < 0 := lt_of_le_of_ne (d.nonpos_of_mem_closure_block i hz) hz0 + linarith + · have hmem : d.exponent i + z ∈ closure ((d.piece i : Series K) : K⟦ℝ⟧).support := by + rw [d.closure_support_piece]; exact ⟨z, hz, rfl⟩ + have hge := d.exponent_le_of_mem_closure_piece hlt hmem + have hzneg : z' < 0 := lt_of_le_of_ne (d.nonpos_of_mem_closure_block j hz') hz0' + linarith + +/-! ### The coefficient clause -/ + +/-- The blocks of a series with algebraically independent coefficients have jointly +algebraically independent coefficients. -/ +theorem isMutuallyCoefficientRandom_block [CharZero K] (hb : IsCoefficientRandom b) : + IsMutuallyCoefficientRandom d.block := by + apply IsMutuallyCoefficientRandom.of + have hpiece : ∀ p : coefficientIndex d.block, + d.exponent p.1.1 + p.1.2 ∈ ((d.piece p.1.1 : Series K) : K⟦ℝ⟧).support := by + intro p + rw [HahnSeries.mem_support, ← d.coeff_block] + exact (mem_coefficientIndex_iff d.block p.1).mp p.2 + have hcoeff : ∀ p : coefficientIndex d.block, + ((d.block p.1.1 : Series K) : K⟦ℝ⟧).coeff p.1.2 = + (b : K⟦ℝ⟧).coeff (d.exponent p.1.1 + p.1.2) := fun p ↦ by + rw [d.coeff_eq_coeff_piece _ (hpiece p), d.coeff_block] + let f : coefficientIndex d.block → (b : K⟦ℝ⟧).support := fun p ↦ + ⟨d.exponent p.1.1 + p.1.2, by + rw [HahnSeries.mem_support, ← hcoeff p] + exact (mem_coefficientIndex_iff d.block p.1).mp p.2⟩ + have hf : Function.Injective f := by + intro p q hpq + have h : d.exponent p.1.1 + p.1.2 = d.exponent q.1.1 + q.1.2 := congrArg Subtype.val hpq + have hij : p.1.1 = q.1.1 := by + by_contra hne + exact d.piece_disjoint hne (hpiece p) (h ▸ hpiece q) + apply Subtype.ext + apply Prod.ext hij + rw [hij] at h + exact add_left_cancel h + have := hb.algebraicIndependent.comp f hf + convert this using 1 + funext p + exact hcoeff p + +/-! ### The support clause -/ + +/-- The blocks of a series with `ℚ`-linearly independent support closure satisfy the support +clause of mutual randomness. -/ +theorem isMutuallySupportRandom_block (hb : IsSupportRandom b) : + IsMutuallySupportRandom d.block := by + classical + set L := supportClosure b with hL + set T := Finsupp.linearCombination ℚ (fun z : L ↦ (z : ℝ)) with hT + have hinjL : Function.Injective T := + linearIndependent_iff_injective_finsuppLinearCombination.mp hb.linearIndependent + -- Translated closure points and exponents as elements of `L`. + have hmemL : ∀ (i : Fin m) {z : ℝ}, z ∈ closure ((d.block i : Series K) : K⟦ℝ⟧).support → + z ≠ 0 → d.exponent i + z ∈ L := by + intro i z hz hz0 + refine (mem_supportClosure_iff b _).mpr ⟨d.add_mem_closure_support i hz, ?_⟩ + have hzneg : z < 0 := lt_of_le_of_ne (d.nonpos_of_mem_closure_block i hz) hz0 + linarith [d.exponent_nonpos i] + have hγcomb : ∀ i : Fin m, T (L.indicatorFinsupp ℚ (d.exponent i)) = d.exponent i := by + intro i + rcases eq_or_ne (d.exponent i) 0 with h0 | h0 + · rw [h0]; exact L.linearCombination_indicatorFinsupp_zero ℚ + · exact L.linearCombination_indicatorFinsupp_of_mem ℚ ((mem_supportClosure_iff b _).mpr + ⟨closure_mono (d.support_piece_subset i) (d.exponent_mem_closure i), h0⟩) + refine ⟨fun i j hij z hz ↦ ?_, ?_⟩ + · -- A common nonzero point of two support closures gives a relation in `L`. + obtain ⟨hzi, hzj⟩ := hz + by_contra hz0' + have hz0 : z ≠ 0 := fun h ↦ hz0' (Set.mem_singleton_iff.mpr h) + have hxL := hmemL i hzi hz0 + have hx'L := hmemL j hzj hz0 + have hrel : L.indicatorFinsupp ℚ (d.exponent i + z) + L.indicatorFinsupp ℚ (d.exponent j) = + L.indicatorFinsupp ℚ (d.exponent j + z) + L.indicatorFinsupp ℚ (d.exponent i) := by + apply hinjL + rw [map_add, map_add, L.linearCombination_indicatorFinsupp_of_mem ℚ hxL, + L.linearCombination_indicatorFinsupp_of_mem ℚ hx'L, hγcomb, hγcomb] + ring + have hpos : 0 < (L.indicatorFinsupp ℚ (d.exponent i + z) + + L.indicatorFinsupp ℚ (d.exponent j)) ⟨_, hxL⟩ := by + rw [Finsupp.add_apply, L.indicatorFinsupp_apply_self hxL] + linarith [L.indicatorFinsupp_apply_nonneg (R := ℚ) (d.exponent j) ⟨_, hxL⟩] + rw [hrel, Finsupp.add_apply] at hpos + have hγi : L.indicatorFinsupp ℚ (d.exponent i) ⟨_, hxL⟩ = 0 := by + apply L.indicatorFinsupp_apply_of_ne + intro heq + exact hz0 (by simp only at heq; linarith) + rw [hγi, add_zero] at hpos + have heq : d.exponent i + z = d.exponent j + z := by + by_contra hne + rw [L.indicatorFinsupp_apply_of_ne _ _ hne] at hpos + exact lt_irrefl _ hpos + exact hij (d.exponent_strictMono.injective (add_right_cancel heq)) + · -- A vanishing combination of the translated points, tested at the smallest point. + rw [linearIndependent_iff'] + intro s g hsum z₀ hz₀ + by_contra hg₀ + set S := s.filter (fun z ↦ g z ≠ 0) with hS + have hz₀S : z₀ ∈ S := Finset.mem_filter.mpr ⟨hz₀, hg₀⟩ + have hgS : ∀ z ∈ S, g z ≠ 0 := fun z hz ↦ (Finset.mem_filter.mp hz).2 + have hidx : ∀ z : supportClosureUnion d.block, + ∃ i, (z : ℝ) ∈ closure ((d.block i : Series K) : K⟦ℝ⟧).support := fun z ↦ + ((mem_supportClosureUnion_iff d.block z).mp z.2).1 + choose idx hidx using hidx + have hzne : ∀ z : supportClosureUnion d.block, (z : ℝ) ≠ 0 := fun z ↦ + ((mem_supportClosureUnion_iff d.block z).mp z.2).2 + have hzneg : ∀ z : supportClosureUnion d.block, (z : ℝ) < 0 := fun z ↦ + lt_of_le_of_ne (d.nonpos_of_mem_closure_block (idx z) (hidx z)) (hzne z) + set ψ : supportClosureUnion d.block → ℝ := fun z ↦ d.exponent (idx z) + z with hψ + have hψL : ∀ z, ψ z ∈ L := fun z ↦ hmemL (idx z) (hidx z) (hzne z) + have hψinj : Function.Injective ψ := by + intro z z' h + have hij := d.eq_of_exponent_add_eq (hidx z) (hidx z') (hzne z) (hzne z') h + apply Subtype.ext + simp only [hψ] at h + rw [hij] at h + exact add_left_cancel h + have hψlt : ∀ z, ψ z < d.exponent (idx z) := fun z ↦ by + simp only [hψ]; linarith [hzneg z] + obtain ⟨z₁, hz₁S, hmin⟩ := S.exists_min_image ψ ⟨z₀, hz₀S⟩ + have hz₁s : z₁ ∈ s := (Finset.mem_filter.mp hz₁S).1 + -- The lifted relation in the free module on `L`. + set F : L →₀ ℚ := ∑ z ∈ s, g z • + (L.indicatorFinsupp ℚ (ψ z) - L.indicatorFinsupp ℚ (d.exponent (idx z))) with hF + have hTF : T F = 0 := by + rw [hF, map_sum, ← hsum] + refine Finset.sum_congr rfl fun z _ ↦ ?_ + rw [map_smul, map_sub, L.linearCombination_indicatorFinsupp_of_mem ℚ (hψL z), hγcomb] + simp only [hψ, add_sub_cancel_left] + have hF0 : F = 0 := hinjL (by rw [hTF, map_zero]) + have hval := congrArg (fun f : L →₀ ℚ ↦ f ⟨ψ z₁, hψL z₁⟩) hF0 + simp only [hF, Finsupp.finsetSum_apply, Finsupp.smul_apply, Finsupp.sub_apply, + Finsupp.zero_apply, smul_eq_mul] at hval + rw [Finset.sum_eq_single z₁] at hval + · rw [L.indicatorFinsupp_apply_self (hψL z₁), + L.indicatorFinsupp_apply_of_ne _ _ (hψlt z₁).ne, sub_zero, mul_one] at hval + exact hgS z₁ hz₁S hval + · intro z hz hne + by_cases hgz : g z = 0 + · rw [hgz, zero_mul] + · have hzS : z ∈ S := Finset.mem_filter.mpr ⟨hz, hgz⟩ + rw [L.indicatorFinsupp_apply_of_ne _ _ (fun h ↦ hne (hψinj h).symm), + L.indicatorFinsupp_apply_of_ne _ _ ((hmin z hzS).trans_lt (hψlt z)).ne, sub_zero, + mul_zero] + · intro h + exact absurd hz₁s h + +/-! ### Hereditary `rv_J`-independence of the blocks -/ + +/-- The blocks of a random series of order type `ω^n · m + β` are hereditarily +`rv_J`-independent at degree `n ≥ 1`. -/ +theorem hereditarilyRVIndependent_block [CharZero K] (hn : 1 ≤ n) (hb : IsRandom b) : + HereditarilyRVIndependent n d.block := by + have hval : ∀ i, ordinalValue (d.block i) = ω^ (n : NatOrdinal) := fun i ↦ + ordinalValue_eq_wpow_of_isPrincipal (d.block_isPrincipal i) (d.block_degree i) + rcases (isRandom_iff b).mp hb with hsupp | hcoeff + · exact (d.isMutuallySupportRandom_block hsupp).hereditarilyRVIndependent hn hval + · exact (d.isMutuallyCoefficientRandom_block hcoeff).hereditarilyRVIndependent hn hval + +end BlockDecomposition + +end FLLM24 + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/ReducibleSpan.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/ReducibleSpan.lean new file mode 100644 index 0000000000..403cbb21c1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/ReducibleSpan.lean @@ -0,0 +1,313 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.HereditaryIndependence +public import Mathlib.LinearAlgebra.Quotient.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeSum +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +import Mathlib.LinearAlgebra.Finsupp.LinearCombination +import Mathlib.LinearAlgebra.LinearIndependent.Basic + +/-! +# The space of reducible classes and the property `(*)_α` + +Fornasiero, Lavi, L'Innocente and Mantova, *Irreducibility in generalized power series* (2024), +Definition 4.1, let `R_α` be the set of products `bc` of two principal series not in `K` with +`deg_J(bc) = α`, and `A_α := J_α + Span_K(R_α)`. Property `(*)_α` says: whenever `b_1, …, b_n` +in `P_α` are hereditarily `rv_J`-independent, they are `K`-linearly independent over `A_α`. + +This module states `(*)_α` in `P̂`. The class map `rv_J` sends +`J_{ω^(α+1)}` onto the homogeneous component `P_α` with kernel `J_α = J_{ω^α}`, and it sends +`R_α` onto the +products of two homogeneous classes of positive grades `β, γ` with `β + γ = α`. Hence, for series +in `J_{ω^(α+1)}`, membership in `A_α` is the same as membership of the grade-`α` class in + +`D_α := Span_K { X · Y : X ∈ P_β, Y ∈ P_γ, β, γ > 0, β + γ = α }`, + +and `K`-linear independence over `A_α` is linear independence of the classes modulo `D_α`. Two +repairs of the printed statement are built in. First, `(*)_α` quantifies over all series of +ordinal-value degree `α`, not only the principal ones: the inductive step of the source applies +`(*)_α` to translated truncations, which need not be principal. Second, the classes are compared +modulo `D_α` rather than the series modulo `A_α`; this is the same condition for series of degree +`α`, and it is the form in which the induction is carried out. + +The total map `gradeClass α` sends a series of `J_{ω^(α+1)}` to its class in grade `α` and every +other series to zero; it is the map `rv_J^α : J_{α+1} → RV_J^α` of the source extended by zero. +-/ + +open scoped DirectSum HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace FLLM24 + +open Berarducci + +variable {K : Type v} [Field K] + +/-! ### The class of a series in a fixed grade -/ + +/-- The class of `c` in grade `α` of `P̂`: the image of `c ∈ J_{ω^(α+1)}` in +`P_α = J_{ω^(α+1)} / J_{ω^α}`, and zero when `c ∉ J_{ω^(α+1)}`. -/ +def gradeClass (α : NatOrdinal) (c : Series K) : PrincipalSubring K := + if h : ordinalValue c < ω^ (α + 1) then + DirectSum.of (PrincipalComponent K) α (principalComponentMk α c h) + else + 0 + +theorem gradeClass_of_lt {α : NatOrdinal} {c : Series K} (h : ordinalValue c < ω^ (α + 1)) : + gradeClass α c = DirectSum.of (PrincipalComponent K) α (principalComponentMk α c h) := by + rw [gradeClass, dif_pos h] + +theorem gradeClass_eq_homogeneousMk {α : NatOrdinal} {c : Series K} + (h : ordinalValue c < ω^ (α + 1)) : + gradeClass α c = (ordinalValueDegreeValuation K).homogeneousMk α + ⟨c, (mem_ordinalValueDegreeValuation_filtrationLE_iff c α).mpr h⟩ := by + rw [gradeClass_of_lt h, principalComponentMk_eq_componentMk, MaxAddDegree.homogeneousMk_apply] + +/-- A series of ordinal value below `ω^α` has zero class in grade `α`. -/ +theorem gradeClass_eq_zero_of_lt {α : NatOrdinal} {c : Series K} (h : ordinalValue c < ω^ α) : + gradeClass α c = 0 := by + have h' : ordinalValue c < ω^ (α + 1) := + h.trans (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one α)) + rw [gradeClass_of_lt h', (principalComponentMk_eq_zero_iff α c h').mpr h, map_zero] + +/-- For `c ∈ J_{ω^(α+1)}`, the class of `c` in grade `α` vanishes exactly when `c ∈ J_{ω^α}`. -/ +theorem gradeClass_eq_zero_iff {α : NatOrdinal} {c : Series K} (h : ordinalValue c < ω^ (α + 1)) : + gradeClass α c = 0 ↔ ordinalValue c < ω^ α := by + rw [gradeClass_of_lt h] + constructor + · intro hzero + exact (principalComponentMk_eq_zero_iff α c h).mp + (DirectSum.of_injective α (by simpa using hzero)) + · intro hlt + rw [(principalComponentMk_eq_zero_iff α c h).mpr hlt, map_zero] + +/-- At ordinal value exactly `ω^α`, the grade-`α` class is `rv_J`. -/ +theorem rvJ_eq_gradeClass {α : NatOrdinal} {c : Series K} (h : ordinalValue c = ω^ α) : + rvJ c = gradeClass α c := by + rw [rvJ_eq_homogeneousMk h, + gradeClass_eq_homogeneousMk (h ▸ NatOrdinal.wpow_lt_wpow.mpr (lt_add_one α))] + +/-- At ordinal value exactly `ω^α`, the class `rv_J(c)` is nonzero. -/ +theorem rvJ_ne_zero_of_eq {α : NatOrdinal} {c : Series K} (h : ordinalValue c = ω^ α) : + rvJ c ≠ 0 := by + rw [rvJ_eq_gradeClass h, Ne, gradeClass_eq_zero_iff (h ▸ NatOrdinal.wpow_lt_wpow.mpr + (lt_add_one α)), h] + exact lt_irrefl _ + +/-- For `c ∈ J_{ω^(α+1)}` the grade-`α` class is nonzero exactly when `v_J(c) = ω^α`. -/ +theorem ordinalValue_eq_of_gradeClass_ne_zero {α : NatOrdinal} {c : Series K} + (h : ordinalValue c < ω^ (α + 1)) (hne : gradeClass α c ≠ 0) : + ordinalValue c = ω^ α := by + have hnot : ¬ ordinalValue c < ω^ α := fun hlt ↦ hne (gradeClass_eq_zero_of_lt hlt) + rcases ordinalValue_eq_zero_or_isAdditivelyPrincipal c with hzero | hprin + · exact absurd (hzero ▸ NatOrdinal.wpow_pos α) hnot + · have hxi := Ordinal.natOrdinal_of_eq_wpow_log hprin + rw [NatOrdinal.of_val] at hxi + rw [hxi] at hnot h ⊢ + congr 1 + exact le_antisymm (Order.lt_add_one_iff.mp (NatOrdinal.wpow_lt_wpow.mp h)) + (le_of_not_gt fun hlt ↦ hnot (NatOrdinal.wpow_lt_wpow.mpr hlt)) + +/-- A series of `J_{ω^(α+1)}` has ordinal value `ω^α` or lies in `J_{ω^α}`. -/ +theorem ordinalValue_eq_or_lt_of_lt_wpow_add_one {α : NatOrdinal} {c : Series K} + (h : ordinalValue c < ω^ (α + 1)) : + ordinalValue c = ω^ α ∨ ordinalValue c < ω^ α := by + by_cases hne : gradeClass α c = 0 + · exact Or.inr ((gradeClass_eq_zero_iff h).mp hne) + · exact Or.inl (ordinalValue_eq_of_gradeClass_ne_zero h hne) + +/-- The grade-`α` class is additive on `J_{ω^(α+1)}`. -/ +theorem gradeClass_add {α : NatOrdinal} {b c : Series K} + (hb : ordinalValue b < ω^ (α + 1)) (hc : ordinalValue c < ω^ (α + 1)) : + gradeClass α (b + c) = gradeClass α b + gradeClass α c := by + have hbc : ordinalValue (b + c) < ω^ (α + 1) := + (ordinalValue_add_le_max b c).trans_lt (max_lt hb hc) + rw [gradeClass_eq_homogeneousMk hb, gradeClass_eq_homogeneousMk hc, + gradeClass_eq_homogeneousMk hbc, ← map_add] + rfl + +/-- The grade-`α` class of a constant multiple is the scalar multiple of the class. -/ +theorem gradeClass_C_mul {α : NatOrdinal} (k : K) {c : Series K} + (hc : ordinalValue c < ω^ (α + 1)) : + gradeClass α ((HahnSeries.Nonpositive.C : K →+* Series K) k * c) = k • gradeClass α c := by + have hkc : ordinalValue ((HahnSeries.Nonpositive.C : K →+* Series K) k * c) < ω^ (α + 1) := by + simpa only [zero_add] using + ordinalValue_mul_lt_wpow_add_one (ordinalValue_C_lt_wpow_one k) hc + rw [gradeClass_of_lt hkc, gradeClass_of_lt hc, ← DirectSum.of_smul, smul_principalComponentMk] + +/-- A finite sum of series of `J_{ω^(α+1)}` lies in `J_{ω^(α+1)}`. -/ +theorem ordinalValue_sum_lt_wpow_add_one {α : NatOrdinal} {ι : Type*} (s : Finset ι) + (f : ι → Series K) (hf : ∀ i ∈ s, ordinalValue (f i) < ω^ (α + 1)) : + ordinalValue (∑ i ∈ s, f i) < ω^ (α + 1) := by + rw [← ordinalValueDegree_le_coe_iff, ← ordinalValueDegreeValuation_apply] + refine MaxAddDegree.map_sum_le_of_forall_le (ordinalValueDegreeValuation K) s f _ + fun i hi ↦ ?_ + rw [ordinalValueDegreeValuation_apply, ordinalValueDegree_le_coe_iff] + exact hf i hi + +/-- The grade-`α` class of a finite sum of series in `J_{ω^(α+1)}`. -/ +theorem gradeClass_sum {α : NatOrdinal} {ι : Type*} (s : Finset ι) (f : ι → Series K) + (hf : ∀ i ∈ s, ordinalValue (f i) < ω^ (α + 1)) : + gradeClass α (∑ i ∈ s, f i) = ∑ i ∈ s, gradeClass α (f i) := by + classical + induction s using Finset.induction_on with + | empty => + rw [Finset.sum_empty, Finset.sum_empty] + exact gradeClass_eq_zero_of_lt (by rw [ordinalValue_zero]; exact NatOrdinal.wpow_pos α) + | insert a s ha ih => + have hsum : ordinalValue (∑ i ∈ s, f i) < ω^ (α + 1) := + ordinalValue_sum_lt_wpow_add_one s f fun i hi ↦ hf i (Finset.mem_insert_of_mem hi) + rw [Finset.sum_insert ha, Finset.sum_insert ha, + gradeClass_add (hf a (Finset.mem_insert_self a s)) hsum, + ih fun i hi ↦ hf i (Finset.mem_insert_of_mem hi)] + +/-- The grade-`α` class of a difference of series in `J_{ω^(α+1)}`. -/ +theorem gradeClass_sub {α : NatOrdinal} {b c : Series K} + (hb : ordinalValue b < ω^ (α + 1)) (hc : ordinalValue c < ω^ (α + 1)) : + gradeClass α (b - c) = gradeClass α b - gradeClass α c := by + have hbc : ordinalValue (b - c) < ω^ (α + 1) := by + rw [sub_eq_add_neg] + exact (ordinalValue_add_le_max b (-c)).trans_lt (max_lt hb (by rwa [ordinalValue_neg])) + rw [eq_sub_iff_add_eq, ← gradeClass_add hbc hc, sub_add_cancel] + +/-- The grade-`(α + β)` class of a product is the product of the grade classes. -/ +theorem gradeClass_mul {α β : NatOrdinal} {b c : Series K} + (hb : ordinalValue b < ω^ (α + 1)) (hc : ordinalValue c < ω^ (β + 1)) : + gradeClass (α + β) (b * c) = gradeClass α b * gradeClass β c := by + rw [gradeClass_of_lt (ordinalValue_mul_lt_wpow_add_one hb hc), gradeClass_of_lt hb, + gradeClass_of_lt hc, ← principalComponentMul_mk, principalComponentMul_eq_componentMul, + DirectSum.of_mul_of] + rfl + +/-- Series of `J_{ω^(α+1)}` congruent modulo `J_{ω^α}` have the same grade-`α` class. -/ +theorem gradeClass_eq_of_sub_lt {α : NatOrdinal} {b c : Series K} + (hb : ordinalValue b < ω^ (α + 1)) (hc : ordinalValue c < ω^ (α + 1)) + (h : ordinalValue (b - c) < ω^ α) : + gradeClass α b = gradeClass α c := by + rw [gradeClass_of_lt hb, gradeClass_of_lt hc, (principalComponentMk_eq_iff α b c hb hc).mpr h] + +/-- The grade-`α` class lives in grade `α`: it is the inclusion of its `α`-component. -/ +theorem gradeClass_eq_of_apply (α : NatOrdinal) (c : Series K) : + gradeClass α c = DirectSum.of (PrincipalComponent K) α (gradeClass α c α) := by + by_cases h : ordinalValue c < ω^ (α + 1) + · rw [gradeClass_of_lt h, DirectSum.of_eq_same] + · rw [gradeClass, dif_neg h, DirectSum.zero_apply, map_zero] + +/-! ### The reducible span -/ + +variable (K) in +/-- FLLM24, Definition 4.1, in `P̂`: the `K`-span `D_α` of the products of two homogeneous +classes of positive grades `β, γ` with `β + γ = α`. It is the image `rv_J(R_α)`'s span, and +`c ∈ J_{ω^(α+1)}` lies in `A_α = J_α + Span_K(R_α)` exactly when its grade-`α` class lies in +`D_α`. -/ +def decomposableSpan (α : NatOrdinal) : Submodule K (PrincipalSubring K) := + Submodule.span K + {z | ∃ (β γ : NatOrdinal) (x : PrincipalComponent K β) (y : PrincipalComponent K γ), + 0 < β ∧ 0 < γ ∧ β + γ = α ∧ + z = DirectSum.of (PrincipalComponent K) β x * + DirectSum.of (PrincipalComponent K) γ y} + +theorem of_mul_of_mem_decomposableSpan {β γ : NatOrdinal} (hβ : 0 < β) (hγ : 0 < γ) + (x : PrincipalComponent K β) (y : PrincipalComponent K γ) : + DirectSum.of (PrincipalComponent K) β x * DirectSum.of (PrincipalComponent K) γ y ∈ + decomposableSpan K (β + γ) := + Submodule.subset_span ⟨β, γ, x, y, hβ, hγ, rfl, rfl⟩ + +/-- The grade class of a product of series of positive degrees `β, γ` lies in `D_{β+γ}`. -/ +theorem gradeClass_mul_mem_decomposableSpan {β γ : NatOrdinal} (hβ : 0 < β) (hγ : 0 < γ) + {b c : Series K} (hb : ordinalValue b < ω^ (β + 1)) (hc : ordinalValue c < ω^ (γ + 1)) : + gradeClass (β + γ) (b * c) ∈ decomposableSpan K (β + γ) := by + rw [gradeClass_mul hb hc, gradeClass_of_lt hb, gradeClass_of_lt hc] + exact of_mul_of_mem_decomposableSpan hβ hγ _ _ + +/-- Every element of `D_α` is a finite combination of grade-`α` classes of products `u v` of +series of positive ordinal-value degrees `β, γ` with `β + γ = α`. -/ +theorem exists_sum_of_mem_decomposableSpan {α : NatOrdinal} {z : PrincipalSubring K} + (hz : z ∈ decomposableSpan K α) : + ∃ (m : ℕ) (μ : Fin m → K) (β γ : Fin m → NatOrdinal) (u w : Fin m → Series K), + (∀ k, 0 < β k ∧ 0 < γ k ∧ β k + γ k = α ∧ + ordinalValue (u k) < ω^ (β k + 1) ∧ ordinalValue (w k) < ω^ (γ k + 1)) ∧ + z = ∑ k, μ k • gradeClass α (u k * w k) := by + rw [decomposableSpan, Submodule.mem_span_set'] at hz + obtain ⟨m, μ, g, hsum⟩ := hz + have hrep : ∀ k : Fin m, ∃ (β γ : NatOrdinal) (u w : Series K), + 0 < β ∧ 0 < γ ∧ β + γ = α ∧ ordinalValue u < ω^ (β + 1) ∧ ordinalValue w < ω^ (γ + 1) ∧ + (g k : PrincipalSubring K) = gradeClass α (u * w) := by + intro k + obtain ⟨β, γ, x, y, hβ, hγ, hβγ, hz⟩ := (g k).2 + obtain ⟨u, hu, rfl⟩ := exists_principalComponentMk β x + obtain ⟨w, hw, rfl⟩ := exists_principalComponentMk γ y + refine ⟨β, γ, u, w, hβ, hγ, hβγ, hu, hw, ?_⟩ + rw [hz, ← gradeClass_of_lt hu, ← gradeClass_of_lt hw, ← gradeClass_mul hu hw, hβγ] + choose β γ u w hβ hγ hβγ hu hw hg using hrep + refine ⟨m, μ, β, γ, u, w, fun k ↦ ⟨hβ k, hγ k, hβγ k, hu k, hw k⟩, ?_⟩ + rw [← hsum] + exact Finset.sum_congr rfl fun k _ ↦ by rw [hg k] + +/-- No product of two positive grades is `1`: `D_1 = 0`, FLLM24, Remark 4.2. -/ +theorem decomposableSpan_one : decomposableSpan K 1 = ⊥ := by + rw [decomposableSpan, Submodule.span_eq_bot] + rintro z ⟨β, γ, x, y, hβ, hγ, hβγ, rfl⟩ + exfalso + have h1 : (1 : NatOrdinal) ≤ β := Order.one_le_iff_pos.mpr hβ + have h2 : (1 : NatOrdinal) ≤ γ := Order.one_le_iff_pos.mpr hγ + have h12 : (1 : NatOrdinal) + 1 ≤ β + γ := add_le_add h1 h2 + rw [hβγ] at h12 + exact absurd h12 (not_le.mpr (lt_add_one 1)) + +/-! ### The property `(*)_α` -/ + +variable (K) in +/-- FLLM24, § 4, property `(*)_α` at a finite degree `n`: every hereditarily `rv_J`-independent +family `b` of series with `v_J(b i) = ω^n` has classes `rv_J(b i)` that are `K`-linearly +independent modulo `D_n`, which is the source's "`K`-linearly independent over `A_n`". -/ +def IndependentModuloDecomposable (n : ℕ) : Prop := + ∀ {ι : Type} (b : ι → Series K), HereditarilyRVIndependent n b → + LinearIndependent K (fun i ↦ (decomposableSpan K (n : NatOrdinal)).mkQ (rvJ (b i))) + +/-- Introduction rule for `(*)_n`. -/ +theorem IndependentModuloDecomposable.of {n : ℕ} + (h : ∀ {ι : Type} (b : ι → Series K), HereditarilyRVIndependent n b → + LinearIndependent K (fun i ↦ (decomposableSpan K (n : NatOrdinal)).mkQ (rvJ (b i)))) : + IndependentModuloDecomposable K n := + h + +/-- Elimination rule for `(*)_n`. -/ +theorem IndependentModuloDecomposable.linearIndependent {n : ℕ} + (h : IndependentModuloDecomposable K n) {ι : Type} {b : ι → Series K} + (hb : HereditarilyRVIndependent n b) : + LinearIndependent K (fun i ↦ (decomposableSpan K (n : NatOrdinal)).mkQ (rvJ (b i))) := + h b hb + +/-- FLLM24, Proposition 4.3, for `β = 0`: `(*)_1` holds, because `A_1 = J_1` and hereditary +`rv_J`-independence at degree `1` is linear independence of the classes. -/ +theorem independentModuloDecomposable_one : IndependentModuloDecomposable K 1 := by + intro ι b hb + have hlin := hb.linearIndependent + refine hlin.map' (decomposableSpan K ((1 : ℕ) : NatOrdinal)).mkQ ?_ + rw [Submodule.ker_mkQ, Nat.cast_one, decomposableSpan_one] + +/-- Under `(*)_n`, the class of a single hereditarily `rv_J`-independent series of degree `n` +lies outside `D_n`. -/ +theorem rvJ_notMem_decomposableSpan {n : ℕ} (hstar : IndependentModuloDecomposable K n) + {b : Series K} (hb : HereditarilyRVIndependent n (fun _ : Unit ↦ b)) : + rvJ b ∉ decomposableSpan K (n : NatOrdinal) := by + intro hmem + have hlin := hstar (fun _ : Unit ↦ b) hb + have hne := hlin.ne_zero () + apply hne + rw [Submodule.mkQ_apply, Submodule.Quotient.mk_eq_zero] + exact hmem + +end FLLM24 + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/SuccessorStep.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/SuccessorStep.lean new file mode 100644 index 0000000000..f0e10aa430 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/SuccessorStep.lean @@ -0,0 +1,491 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ReducibleSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.LeibnizRemainder +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPoint +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.FiniteSpanRelation + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointCofinality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +import Mathlib.Order.ConditionallyCompleteLattice.Finset +import Mathlib.Topology.Instances.Real.Lemmas + +/-! +# The successor step `(*)_α ⇒ (*)_{α+1}` and `(*)_n` for finite `n` + +Fornasiero, Lavi, L'Innocente and Mantova, *Irreducibility in generalized power series* (2024), +Proposition 4.4, and Corollary 4.5 for `α = n < ω` (Remark 4.6). + +Suppose `b = ∑ λ_j b_j ∈ A_{n+1}` with `Q(b_1, …, b_m)` and `λ ≠ 0`; write +`b = ∑ μ_k p_k q_k + r` with `p_k, q_k` of positive degrees `β_k + γ_k = n + 1` and +`r ∈ J_{n+1}`. For `γ < 0` close to zero, Berarducci's Leibniz rule (Proposition 2.10) gives +`b^{|γ} ≡ ∑ μ_k (p_k^{|γ} q_k + p_k q_k^{|γ})` modulo `J_n`, and each term `p_k^{|γ} q_k` lies in +`K q_k + A_n`: its class is `k · rv_J(q_k)` when `p_k^{|γ} ∈ J + K`, and a product of two classes +of positive grades otherwise. So the classes of the `b^{|γ}` lie, modulo `D_n`, in the span of +`2m` fixed vectors. The residual points of `b` are cofinal at zero (Berarducci, Lemma 6.8), so +`2m + 1` of them close to zero give a nontrivial relation `∑ δ_i b^{|γ_i} ∈ A_n`. Expanding +`b^{|γ_i} = ∑ λ_j b_j^{|γ_i}` and discarding the truncations of degree below `n`, Axiom 2 of +`Q(b_1, …, b_m)` makes the remaining truncations hereditarily `rv_J`-independent at degree `n`, +so `(*)_n` forces every coefficient `δ_i λ_j` with `deg_J(b_j^{|γ_i}) = n` to vanish; since each +residual point `γ_i` has some `j` with `λ_j ≠ 0` and `deg_J(b_j^{|γ_i}) = n`, this contradicts +`δ ≠ 0`. + +The source applies `(*)_n` to the translated truncations `b_j^{|γ_i}`, which are not principal +in general; `(*)_n` is therefore stated here for all series of degree `n`, as explained in +`ConwayRefinement.HahnSeries.Factorization.Random.ReducibleSpan`. The representatives `p_k, q_k` +of the classes generating `D_{n+1}` need not be principal either: the Leibniz rule is available +for every series of the relevant ordinal-value cuts. +-/ + +open Filter Topology +open scoped DirectSum HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace FLLM24 + +open Berarducci + +variable {K : Type v} [Field K] + +/-- A positive natural ordinal bounded by a natural number has positive constant coefficient. -/ +theorem _root_.NatOrdinal.constantCoeff_pos_of_pos_of_le_natCast {β : NatOrdinal} {m : ℕ} + (hpos : 0 < β) (hle : β ≤ m) : 0 < β.constantCoeff := by + obtain ⟨k, rfl⟩ := NatOrdinal.lt_omega0.mp (hle.trans_lt (NatOrdinal.natCast_lt_omega0 m)) + rw [NatOrdinal.constantCoeff_natCast] + exact Nat.cast_pos.mp hpos + +/-- Translated truncation of a `K`-linear combination of series. -/ +theorem translatedTruncation_sum_C_mul {ι : Type*} (s : Finset ι) (g : ι → K) (b : ι → Series K) + (γ : ℝ) : + translatedTruncation ((∑ i ∈ s, (HahnSeries.Nonpositive.C : K →+* Series K) (g i) * b i : + Series K) : K⟦ℝ⟧) γ = + ∑ i ∈ s, (HahnSeries.Nonpositive.C : K →+* Series K) (g i) * + translatedTruncation (b i : K⟦ℝ⟧) γ := by + rw [← translatedTruncationAddMonoidHom_apply, AddSubmonoidClass.coe_finsetSum, map_sum] + refine Finset.sum_congr rfl fun i _ ↦ ?_ + rw [translatedTruncationAddMonoidHom_apply, Subring.coe_mul, HahnSeries.Nonpositive.coe_C, + translatedTruncation_C_mul] + +/-- FLLM24, proof of Proposition 4.4: if `deg_J(p) = β ≥ 1`, `deg_J(q) = γ ≥ 1` and +`(β - 1) + γ = n`, then for `γ' < 0` close to zero the grade-`n` class of `p^{|γ'} q` lies in +`K · rv_J(q) + D_n`: when `p^{|γ'} ∈ J + K` it is a scalar multiple of the class of `q`, and +otherwise it is a product of two classes of positive grades. -/ +theorem eventually_gradeClass_translatedTruncation_mul_mem {n : ℕ} {β γ : NatOrdinal} + (hβ : 0 < β.constantCoeff) (hγ : 0 < γ) (hsum : β.removeNat 1 + γ = n) + {p q : Series K} (hp : ordinalValue p < ω^ (β + 1)) (hq : ordinalValue q < ω^ (γ + 1)) : + ∀ᶠ γ' in 𝓝[<] (0 : ℝ), + gradeClass (n : NatOrdinal) (translatedTruncation (p : K⟦ℝ⟧) γ' * q) ∈ + (K ∙ gradeClass (n : NatOrdinal) q) ⊔ decomposableSpan K (n : NatOrdinal) := by + have hβ' : β.removeNat 1 + 1 = β := by + simpa using NatOrdinal.removeNat_add_natCast hβ + have hdrop := eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one + β p hp + filter_upwards [hdrop] with γ' hγ' + set w := translatedTruncation (p : K⟦ℝ⟧) γ' with hw + rw [← hβ'] at hγ' + rcases eq_or_ne (β.removeNat 1) 0 with hzero | hpos + · -- `w ∈ J + K`: the class of `w q` is a scalar multiple of the class of `q`. + rw [hzero, zero_add] at hsum hγ' + rw [← hsum] + have hwNear : w ∈ nearConstantSubgroup K := by + by_contra hnot + have hlt := one_lt_ordinalValue_iff.mpr hnot + rcases ordinalValue_eq_or_lt_of_lt_wpow_add_one + (α := 0) (by rwa [zero_add]) with hone | hzero' + · rw [NatOrdinal.wpow_zero] at hone + exact absurd hone hlt.ne' + · rw [NatOrdinal.wpow_zero] at hzero' + exact absurd (hzero'.trans hlt) (lt_irrefl _) + obtain ⟨j, hj, k, hjk⟩ := mem_nearConstantSubgroup_iff.mp hwNear + have hjq : gradeClass γ (j * q) = 0 := by + apply gradeClass_eq_zero_of_lt + rw [ordinalValue_of_mem_negativeMonomialIdeal (Ideal.mul_mem_right q _ hj)] + exact NatOrdinal.wpow_pos γ + have hjqcut : ordinalValue (j * q) < ω^ (γ + 1) := by + rw [ordinalValue_of_mem_negativeMonomialIdeal (Ideal.mul_mem_right q _ hj)] + exact NatOrdinal.wpow_pos _ + have hkq : ordinalValue ((HahnSeries.Nonpositive.C : K →+* Series K) k * q) < ω^ (γ + 1) := by + simpa only [zero_add] using + ordinalValue_mul_lt_wpow_add_one (ordinalValue_C_lt_wpow_one k) hq + rw [← hjk, add_mul, gradeClass_add hjqcut hkq, hjq, zero_add, gradeClass_C_mul k hq] + exact Submodule.mem_sup_left (Submodule.mem_span_singleton.mpr ⟨k, rfl⟩) + · -- `w` has positive degree `β - 1`: the class of `w q` is decomposable. + have hmem := gradeClass_mul_mem_decomposableSpan (pos_iff_ne_zero.mpr hpos) hγ hγ' hq + rw [hsum] at hmem + exact Submodule.mem_sup_right hmem + +/-- Berarducci, Lemma 6.8, as used in FLLM24, Proposition 4.4: a series of ordinal value +`ω^(α+1)` has, in every interval `(η, 0)`, as many residual points as desired; at a residual +point the translated truncation has ordinal value `ω^α`. -/ +theorem exists_finset_residualPoints {α : NatOrdinal} {b : Series K} + (hb : ordinalValue b = ω^ (α + 1)) {η : ℝ} (hη : η < 0) (N : ℕ) : + ∃ Γ : Finset ℝ, Γ.card = N ∧ + ∀ γ ∈ Γ, η < γ ∧ γ < 0 ∧ ordinalValue (translatedTruncation (b : K⟦ℝ⟧) γ) = ω^ α := by + have hone : 1 < ordinalValue b := by + rw [hb] + calc (1 : NatOrdinal) = ω^ (0 : NatOrdinal) := NatOrdinal.wpow_zero.symm + _ < ω^ (α + 1) := NatOrdinal.wpow_lt_wpow.mpr + (lt_of_lt_of_le (lt_add_one (0 : NatOrdinal)) + (add_le_add (bot_le : (0 : NatOrdinal) ≤ α) le_rfl)) + let b' : SeriesWithOrdinalValueAboveOne K := ⟨b, hone⟩ + have hres : b'.residualValue = ω^ α := by + have hcoeff : 0 < (α + 1).constantCoeff := by + have h := NatOrdinal.constantCoeff_add_natCast α 1 + rw [Nat.cast_one] at h + rw [h] + exact Nat.succ_pos _ + rw [b'.residualValue_eq_wpow_removeNat_of_ordinalValue_eq_wpow (α + 1) hcoeff hb] + congr 1 + have h := NatOrdinal.removeNat_add_natCast (a := α + 1) (n := 1) (by + have h := NatOrdinal.constantCoeff_add_natCast α 1 + rw [Nat.cast_one] at h + rw [h]; exact Nat.le_add_left 1 _) + rw [Nat.cast_one] at h + exact add_right_cancel h + have hLUB := residualPointSet_isLUB_zero b' + -- Residual points in `(η, 0)` form an infinite set. + have hinf : (residualPointSet b' ∩ Set.Ioo η 0).Infinite := by + intro hfin + let S := residualPointSet b' ∩ Set.Ioo η 0 ∪ {η} + have hSfin : S.Finite := hfin.union (Set.finite_singleton η) + have hSne : S.Nonempty := ⟨η, Set.mem_union_right _ rfl⟩ + have hmem := hSne.csSup_mem hSfin + have hneg : sSup S < 0 := by + rcases hmem with hmem | hmem + · exact hmem.2.2 + · rw [Set.mem_singleton_iff] at hmem + rw [hmem]; exact hη + have hηle : η ≤ sSup S := le_csSup hSfin.bddAbove (Set.mem_union_right _ rfl) + obtain ⟨c, hc, hlt, hc0⟩ := hLUB.exists_between' (zero_not_mem_residualPointSet b') hneg + have hcS : c ∈ S := Set.mem_union_left _ ⟨hc, hηle.trans_lt hlt, hc0⟩ + exact absurd (le_csSup hSfin.bddAbove hcS) (not_le.mpr hlt) + obtain ⟨Γ, hΓ, hcard⟩ := hinf.exists_subset_card_eq N + refine ⟨Γ, hcard, fun γ hγ ↦ ?_⟩ + have hγ' := hΓ hγ + refine ⟨hγ'.2.1, hγ'.2.2, ?_⟩ + rw [← hres] + exact (mem_residualPointSet_iff.mp hγ'.1).2 + +/-- The quotient map by `D` sends `(K · v) + D` into `K · (v mod D)`. -/ +private theorem mkQ_mem_span_singleton_of_mem_sup {V : Type*} [AddCommGroup V] [Module K V] + {D : Submodule K V} {x v : V} (h : x ∈ (K ∙ v) ⊔ D) : D.mkQ x ∈ K ∙ D.mkQ v := by + obtain ⟨y, hy, z, hz, rfl⟩ := Submodule.mem_sup.mp h + obtain ⟨c, rfl⟩ := Submodule.mem_span_singleton.mp hy + have hz0 : D.mkQ z = 0 := by + rw [Submodule.mkQ_apply, Submodule.Quotient.mk_eq_zero] + exact hz + rw [map_add, map_smul, hz0, add_zero] + exact Submodule.mem_span_singleton.mpr ⟨c, rfl⟩ + +/-- FLLM24, Proposition 4.4, at finite degrees: `(*)_n` implies `(*)_{n+1}` for `n ≥ 1`. -/ +theorem independentModuloDecomposable_succ {n : ℕ} (hn : 1 ≤ n) + (hstar : IndependentModuloDecomposable K n) : + IndependentModuloDecomposable K (n + 1) := by + classical + refine IndependentModuloDecomposable.of fun {ι} b hQ ↦ ?_ + rw [Nat.cast_succ, linearIndependent_iff'] + intro s g hsum i₀ hi₀ + by_contra hg₀ + set N : NatOrdinal := (n : NatOrdinal) + 1 with hN + have hNcast : ((n + 1 : ℕ) : NatOrdinal) = N := Nat.cast_succ n + have hval : ∀ i, ordinalValue (b i) = ω^ N := fun i ↦ by + rw [← hNcast]; exact hQ.ordinalValue_eq i + have hcut : ∀ i, ordinalValue (b i) < ω^ (N + 1) := fun i ↦ by + rw [hval i]; exact NatOrdinal.wpow_lt_wpow.mpr (lt_add_one N) + -- The support `T` of the coefficients `g` inside `s`. + set T := s.filter (fun i ↦ g i ≠ 0) with hT + have hi₀T : i₀ ∈ T := Finset.mem_filter.mpr ⟨hi₀, hg₀⟩ + have hgT : ∀ i ∈ T, g i ≠ 0 := fun i hi ↦ (Finset.mem_filter.mp hi).2 + have hsumT : ∑ i ∈ T, g i • (decomposableSpan K N).mkQ (rvJ (b i)) = 0 := by + rw [hT, Finset.sum_filter_of_ne] + · exact hsum + · intro x _ hx hgx + exact hx (by rw [hgx, zero_smul]) + have hrel : ∑ i ∈ T, g i • rvJ (b i) ∈ decomposableSpan K N := by + rw [← Submodule.Quotient.mk_eq_zero, ← Submodule.mkQ_apply, map_sum] + simpa only [map_smul] using hsumT + -- The series `B = ∑ g i • b i` has ordinal value `ω^N` and class in `D_N`. + set B : Series K := ∑ i ∈ T, (HahnSeries.Nonpositive.C : K →+* Series K) (g i) * b i with hB + have hCcut : ∀ i ∈ T, + ordinalValue ((HahnSeries.Nonpositive.C : K →+* Series K) (g i) * b i) < ω^ (N + 1) := + fun i _ ↦ by + simpa only [zero_add] using + ordinalValue_mul_lt_wpow_add_one (ordinalValue_C_lt_wpow_one (g i)) (hcut i) + have hBcut : ordinalValue B < ω^ (N + 1) := ordinalValue_sum_lt_wpow_add_one T _ hCcut + have hBclass : gradeClass N B = ∑ i ∈ T, g i • rvJ (b i) := by + rw [hB, gradeClass_sum T _ hCcut] + exact Finset.sum_congr rfl fun i _ ↦ by + rw [gradeClass_C_mul (g i) (hcut i), rvJ_eq_gradeClass (hval i)] + have hBne : gradeClass N B ≠ 0 := by + intro hzero + rw [hBclass] at hzero + exact hg₀ (linearIndependent_iff'.mp hQ.linearIndependent T g hzero i₀ hi₀T) + have hBval : ordinalValue B = ω^ N := ordinalValue_eq_of_gradeClass_ne_zero hBcut hBne + -- The decomposition `B = ∑ μ_k u_k w_k + r` with `r ∈ J_N`. + have hBmem : gradeClass N B ∈ decomposableSpan K N := by rw [hBclass]; exact hrel + obtain ⟨m, μ, β, γ, u, w, hk, hdecomp⟩ := exists_sum_of_mem_decomposableSpan hBmem + have hNle : ∀ k, β k ≤ ((n + 1 : ℕ) : NatOrdinal) ∧ γ k ≤ ((n + 1 : ℕ) : NatOrdinal) := by + intro k + rw [hNcast, ← (hk k).2.2.1] + exact ⟨NatOrdinal.le_add_right, NatOrdinal.le_add_left⟩ + have hβc : ∀ k, 0 < (β k).constantCoeff := fun k ↦ + NatOrdinal.constantCoeff_pos_of_pos_of_le_natCast (hk k).1 (hNle k).1 + have hγc : ∀ k, 0 < (γ k).constantCoeff := fun k ↦ + NatOrdinal.constantCoeff_pos_of_pos_of_le_natCast (hk k).2.1 (hNle k).2 + have hβγ : ∀ k, (β k).removeNat 1 + γ k = n := by + intro k + have h1 : (β k).removeNat 1 + 1 = β k := by + simpa using NatOrdinal.removeNat_add_natCast (hβc k) + apply add_right_cancel (b := (1 : NatOrdinal)) + rw [add_right_comm, h1, (hk k).2.2.1] + have hγβ : ∀ k, (γ k).removeNat 1 + β k = n := by + intro k + have h1 : (γ k).removeNat 1 + 1 = γ k := by + simpa using NatOrdinal.removeNat_add_natCast (hγc k) + apply add_right_cancel (b := (1 : NatOrdinal)) + rw [add_right_comm, h1, add_comm, (hk k).2.2.1] + have huw : ∀ k, ordinalValue (u k * w k) < ω^ (N + 1) := fun k ↦ by + have h := ordinalValue_mul_lt_wpow_add_one (hk k).2.2.2.1 (hk k).2.2.2.2 + rwa [(hk k).2.2.1] at h + have hCuw : ∀ k ∈ (Finset.univ : Finset (Fin m)), + ordinalValue ((HahnSeries.Nonpositive.C : K →+* Series K) (μ k) * (u k * w k)) < + ω^ (N + 1) := fun k _ ↦ by + simpa only [zero_add] using + ordinalValue_mul_lt_wpow_add_one (ordinalValue_C_lt_wpow_one (μ k)) (huw k) + set P : Series K := + ∑ k, (HahnSeries.Nonpositive.C : K →+* Series K) (μ k) * (u k * w k) with hP + have hPcut : ordinalValue P < ω^ (N + 1) := ordinalValue_sum_lt_wpow_add_one _ _ hCuw + have hPclass : gradeClass N P = ∑ k, μ k • gradeClass N (u k * w k) := by + rw [hP, gradeClass_sum _ _ hCuw] + exact Finset.sum_congr rfl fun k _ ↦ gradeClass_C_mul (μ k) (huw k) + set r : Series K := B - P with hr + have hrlt : ordinalValue r < ω^ N := by + rw [← gradeClass_eq_zero_iff (by + rw [hr, sub_eq_add_neg] + exact (ordinalValue_add_le_max B (-P)).trans_lt + (max_lt hBcut (by rwa [ordinalValue_neg]))), hr, gradeClass_sub hBcut hPcut, hPclass, + ← hdecomp, sub_self] + have hBPr : B = P + r := by rw [hr]; abel + -- The eventual statements near zero. + have hev : ∀ᶠ γ' in 𝓝[<] (0 : ℝ), + (∀ k, ordinalValue (translatedTruncation ((u k * w k : Series K) : K⟦ℝ⟧) γ' - + translatedTruncation (u k : K⟦ℝ⟧) γ' * w k - u k * translatedTruncation (w k : K⟦ℝ⟧) γ') + < ω^ (n : NatOrdinal)) ∧ + (∀ k, gradeClass (n : NatOrdinal) (translatedTruncation (u k : K⟦ℝ⟧) γ' * w k) ∈ + (K ∙ gradeClass (n : NatOrdinal) (w k)) ⊔ decomposableSpan K (n : NatOrdinal)) ∧ + (∀ k, gradeClass (n : NatOrdinal) (translatedTruncation (w k : K⟦ℝ⟧) γ' * u k) ∈ + (K ∙ gradeClass (n : NatOrdinal) (u k)) ⊔ decomposableSpan K (n : NatOrdinal)) ∧ + (∀ k, ordinalValue (translatedTruncation (u k : K⟦ℝ⟧) γ') < ω^ (β k)) ∧ + (∀ k, ordinalValue (translatedTruncation (w k : K⟦ℝ⟧) γ') < ω^ (γ k)) ∧ + (∀ k, ordinalValue (translatedTruncation ((u k * w k : Series K) : K⟦ℝ⟧) γ') < ω^ N) ∧ + ordinalValue (translatedTruncation (r : K⟦ℝ⟧) γ') < ω^ (n : NatOrdinal) ∧ + (∀ i ∈ T, ordinalValue (translatedTruncation (b i : K⟦ℝ⟧) γ') < ω^ N) := by + refine Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) + (Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) + (Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) + (Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) + (Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) + (Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) + (Filter.Eventually.and ?_ ((Filter.eventually_all_finset T).mpr fun i _ ↦ ?_))))))) + · have h := eventually_ordinalValue_leibnizRemainder_lt (hβc k) (u k) (w k) + (hk k).2.2.2.1 (hk k).2.2.2.2 + rwa [hβγ k] at h + · exact eventually_gradeClass_translatedTruncation_mul_mem (hβc k) (hk k).2.1 (hβγ k) + (hk k).2.2.2.1 (hk k).2.2.2.2 + · exact eventually_gradeClass_translatedTruncation_mul_mem (hγc k) (hk k).1 (hγβ k) + (hk k).2.2.2.2 (hk k).2.2.2.1 + · exact eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one + (β k) (u k) (hk k).2.2.2.1 + · exact eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one + (γ k) (w k) (hk k).2.2.2.2 + · exact eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one + N (u k * w k) (huw k) + · exact eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one + (n : NatOrdinal) r hrlt + · exact eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one + N (b i) (hcut i) + obtain ⟨η, hη, hη'⟩ := eventually_nhdsLT_iff_exists.mp hev + obtain ⟨δQ, hδQ, hQ2⟩ := hQ.truncations hn + -- Residual points of `B` above both thresholds. + obtain ⟨Γ, hΓcard, hΓ⟩ := + exists_finset_residualPoints (α := (n : NatOrdinal)) hBval (max_lt hη hδQ) (2 * m + 1) + set π := (decomposableSpan K (n : NatOrdinal)).mkQ with hπ + -- For a residual point `γ'`, the class of `B^{|γ'}` expands along `T` and along the + -- Leibniz rule. + have hBtrunc : ∀ γ' ∈ Γ, + gradeClass (n : NatOrdinal) (translatedTruncation (B : K⟦ℝ⟧) γ') = + ∑ i ∈ T, g i • gradeClass (n : NatOrdinal) (translatedTruncation (b i : K⟦ℝ⟧) γ') := by + intro γ' hγ' + obtain ⟨hηγ, hγ0, -⟩ := hΓ γ' hγ' + have hE := hη' γ' ((le_max_left η δQ).trans_lt hηγ) hγ0 + rw [hB, translatedTruncation_sum_C_mul, gradeClass_sum] + · exact Finset.sum_congr rfl fun i hi ↦ gradeClass_C_mul (g i) (hE.2.2.2.2.2.2.2 i hi) + · intro i hi + simpa only [zero_add] using ordinalValue_mul_lt_wpow_add_one + (ordinalValue_C_lt_wpow_one (g i)) (hE.2.2.2.2.2.2.2 i hi) + have hBleib : ∀ γ' ∈ Γ, + gradeClass (n : NatOrdinal) (translatedTruncation (B : K⟦ℝ⟧) γ') = + ∑ k, μ k • (gradeClass (n : NatOrdinal) (translatedTruncation (u k : K⟦ℝ⟧) γ' * w k) + + gradeClass (n : NatOrdinal) (translatedTruncation (w k : K⟦ℝ⟧) γ' * u k)) := by + intro γ' hγ' + obtain ⟨hηγ, hγ0, -⟩ := hΓ γ' hγ' + obtain ⟨hE1, -, -, hE8, hE9, hE4, hE5, -⟩ := hη' γ' ((le_max_left η δQ).trans_lt hηγ) hγ0 + have hYcut : ∀ k, + ordinalValue (translatedTruncation (u k : K⟦ℝ⟧) γ' * w k) < ω^ N := fun k ↦ by + have h1 : ordinalValue (translatedTruncation (u k : K⟦ℝ⟧) γ') < + ω^ ((β k).removeNat 1 + 1) := by + rw [show (β k).removeNat 1 + 1 = β k by + simpa using NatOrdinal.removeNat_add_natCast (hβc k)] + exact hE8 k + have h := ordinalValue_mul_lt_wpow_add_one h1 (hk k).2.2.2.2 + rwa [hβγ k] at h + have hZcut : ∀ k, + ordinalValue (translatedTruncation (w k : K⟦ℝ⟧) γ' * u k) < ω^ N := fun k ↦ by + have h1 : ordinalValue (translatedTruncation (w k : K⟦ℝ⟧) γ') < + ω^ ((γ k).removeNat 1 + 1) := by + rw [show (γ k).removeNat 1 + 1 = γ k by + simpa using NatOrdinal.removeNat_add_natCast (hγc k)] + exact hE9 k + have h := ordinalValue_mul_lt_wpow_add_one h1 (hk k).2.2.2.1 + rwa [hγβ k] at h + have hCtrunc : ∀ k ∈ (Finset.univ : Finset (Fin m)), + ordinalValue ((HahnSeries.Nonpositive.C : K →+* Series K) (μ k) * + translatedTruncation ((u k * w k : Series K) : K⟦ℝ⟧) γ') < ω^ N := fun k _ ↦ by + simpa only [zero_add] using + ordinalValue_mul_lt_wpow_add_one (ordinalValue_C_lt_wpow_one (μ k)) (hE4 k) + have hPtrunc : ordinalValue (translatedTruncation (P : K⟦ℝ⟧) γ') < ω^ N := by + rw [hP, translatedTruncation_sum_C_mul] + exact ordinalValue_sum_lt_wpow_add_one _ _ hCtrunc + have hrtrunc : ordinalValue (translatedTruncation (r : K⟦ℝ⟧) γ') < ω^ N := + hE5.trans (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one _)) + rw [hBPr, Subring.coe_add, translatedTruncation_add, gradeClass_add hPtrunc hrtrunc, + gradeClass_eq_zero_of_lt hE5, add_zero, hP, translatedTruncation_sum_C_mul, + gradeClass_sum _ _ hCtrunc] + refine Finset.sum_congr rfl fun k _ ↦ ?_ + rw [gradeClass_C_mul (μ k) (hE4 k)] + congr 1 + rw [← gradeClass_add (hYcut k) (hZcut k)] + apply gradeClass_eq_of_sub_lt (hE4 k) + ((ordinalValue_add_le_max _ _).trans_lt (max_lt (hYcut k) (hZcut k))) + rw [mul_comm (translatedTruncation (w k : K⟦ℝ⟧) γ') (u k), ← sub_sub] + exact hE1 k + -- The classes of the `B^{|γ'}`, modulo `D_n`, lie in the span of `2m` vectors. + let gens : Fin m ⊕ Fin m → PrincipalSubring K ⧸ decomposableSpan K (n : NatOrdinal) := + Sum.elim (fun k ↦ π (gradeClass (n : NatOrdinal) (u k))) + (fun k ↦ π (gradeClass (n : NatOrdinal) (w k))) + have hspan : ∀ γ' : Γ, + π (gradeClass (n : NatOrdinal) (translatedTruncation (B : K⟦ℝ⟧) γ')) ∈ + Submodule.span K (Set.range gens) := by + intro γ' + obtain ⟨hηγ, hγ0, -⟩ := hΓ γ' γ'.2 + obtain ⟨-, hE2, hE3, -⟩ := hη' γ' ((le_max_left η δQ).trans_lt hηγ) hγ0 + rw [hBleib γ' γ'.2, map_sum] + refine Submodule.sum_mem _ fun k _ ↦ ?_ + rw [map_smul, map_add] + refine Submodule.smul_mem _ _ (Submodule.add_mem _ ?_ ?_) + · refine Submodule.span_mono ?_ (mkQ_mem_span_singleton_of_mem_sup (hE2 k)) + exact Set.singleton_subset_iff.mpr ⟨Sum.inr k, rfl⟩ + · refine Submodule.span_mono ?_ (mkQ_mem_span_singleton_of_mem_sup (hE3 k)) + exact Set.singleton_subset_iff.mpr ⟨Sum.inl k, rfl⟩ + have hcard : Fintype.card (Fin m ⊕ Fin m) < Fintype.card Γ := by + rw [Fintype.card_sum, Fintype.card_fin, Fintype.card_coe, hΓcard] + omega + obtain ⟨sΓ, δ, hδrel, γ₀, hγ₀, hδ₀⟩ := + Module.exists_nontrivial_relation_of_mem_span_range gens + (fun γ' : Γ ↦ π (gradeClass (n : NatOrdinal) (translatedTruncation (B : K⟦ℝ⟧) γ'))) + hspan hcard + -- The relation, expanded along `T` and restricted to the truncations of degree `n`. + have hδmem : ∑ γ' ∈ sΓ, δ γ' • gradeClass (n : NatOrdinal) + (translatedTruncation (B : K⟦ℝ⟧) γ') ∈ decomposableSpan K (n : NatOrdinal) := by + rw [← Submodule.Quotient.mk_eq_zero, ← Submodule.mkQ_apply, map_sum] + simpa only [map_smul] using hδrel + have hcutT : ∀ γ' ∈ sΓ, ∀ i ∈ T, + ordinalValue (translatedTruncation (b i : K⟦ℝ⟧) γ') < ω^ ((n : NatOrdinal) + 1) := by + intro γ' _ i hi + obtain ⟨hηγ, hγ0, -⟩ := hΓ γ' γ'.2 + exact (hη' γ' ((le_max_left η δQ).trans_lt hηγ) hγ0).2.2.2.2.2.2.2 i hi + set S₁ := (sΓ ×ˢ T).filter (fun p : Γ × ι ↦ + ordinalValue (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) = ω^ (n : NatOrdinal)) with hS₁ + have hrelS₁ : ∑ p ∈ S₁, (δ p.1 * g p.2) • rvJ (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) ∈ + decomposableSpan K (n : NatOrdinal) := by + have hexpand : ∑ γ' ∈ sΓ, δ γ' • gradeClass (n : NatOrdinal) + (translatedTruncation (B : K⟦ℝ⟧) γ') = + ∑ p ∈ sΓ ×ˢ T, (δ p.1 * g p.2) • + gradeClass (n : NatOrdinal) (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) := by + rw [Finset.sum_product] + refine Finset.sum_congr rfl fun γ' _ ↦ ?_ + rw [hBtrunc γ' γ'.2, Finset.smul_sum] + exact Finset.sum_congr rfl fun i _ ↦ by rw [smul_smul] + rw [hexpand, ← Finset.sum_filter_add_sum_filter_not (sΓ ×ˢ T) (fun p : Γ × ι ↦ + ordinalValue (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) = ω^ (n : NatOrdinal))] at hδmem + have hzero : ∑ p ∈ (sΓ ×ˢ T).filter (fun p : Γ × ι ↦ + ¬ ordinalValue (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) = ω^ (n : NatOrdinal)), + (δ p.1 * g p.2) • gradeClass (n : NatOrdinal) (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) + = 0 := by + refine Finset.sum_eq_zero fun p hp ↦ ?_ + obtain ⟨hp, hne⟩ := Finset.mem_filter.mp hp + obtain ⟨hγ', hi⟩ := Finset.mem_product.mp hp + rcases ordinalValue_eq_or_lt_of_lt_wpow_add_one (hcutT p.1 hγ' p.2 hi) with heq | hlt + · exact absurd heq hne + · rw [gradeClass_eq_zero_of_lt hlt, smul_zero] + rw [hzero, add_zero] at hδmem + convert hδmem using 2 with p hp + rw [rvJ_eq_gradeClass (Finset.mem_filter.mp hp).2] + -- Axiom 2 makes the surviving truncations hereditarily `rv_J`-independent at degree `n`. + have hQS₁ : HereditarilyRVIndependent n + (fun p : S₁ ↦ translatedTruncation (b p.1.2 : K⟦ℝ⟧) (p.1.1 : ℝ)) := by + refine hQ2 S₁ (fun p ↦ p.1.2) (fun p ↦ (p.1.1 : ℝ)) ?_ ?_ ?_ ?_ + · intro p q hpq + have h1 : p.1.2 = q.1.2 := congrArg Prod.fst hpq + have h2 : (p.1.1 : ℝ) = (q.1.1 : ℝ) := congrArg Prod.snd hpq + exact Subtype.ext (Prod.ext (Subtype.ext h2) h1) + · intro p + obtain ⟨hηγ, -, -⟩ := hΓ p.1.1 p.1.1.2 + exact ((le_max_right η δQ).trans_lt hηγ).le + · intro p + exact (hΓ p.1.1 p.1.1.2).2.1.le + · intro p + exact (Finset.mem_filter.mp p.2).2 + have hlin := hstar.linearIndependent hQS₁ + rw [Fintype.linearIndependent_iff] at hlin + have hcoeff : ∀ p : S₁, δ p.1.1 * g p.1.2 = 0 := by + refine hlin (fun p ↦ δ p.1.1 * g p.1.2) ?_ + rw [← Submodule.Quotient.mk_eq_zero, ← Submodule.mkQ_apply, map_sum] at hrelS₁ + rw [← Finset.sum_coe_sort S₁] at hrelS₁ + simpa only [map_smul] using hrelS₁ + -- At the residual point `γ₀` some `b i^{|γ₀}` with `g i ≠ 0` has degree `n`. + have hBγ₀ : gradeClass (n : NatOrdinal) (translatedTruncation (B : K⟦ℝ⟧) γ₀) ≠ 0 := by + have hres := (hΓ γ₀ γ₀.2).2.2 + rw [← rvJ_eq_gradeClass hres] + exact rvJ_ne_zero_of_eq hres + rw [hBtrunc γ₀ γ₀.2] at hBγ₀ + obtain ⟨i, hi, hne⟩ := Finset.exists_ne_zero_of_sum_ne_zero hBγ₀ + have hgc : gradeClass (n : NatOrdinal) (translatedTruncation (b i : K⟦ℝ⟧) γ₀) ≠ 0 := + fun h ↦ hne (by rw [h, smul_zero]) + have hdeg : ordinalValue (translatedTruncation (b i : K⟦ℝ⟧) γ₀) = ω^ (n : NatOrdinal) := + ordinalValue_eq_of_gradeClass_ne_zero (hcutT γ₀ hγ₀ i hi) hgc + have hpS₁ : (γ₀, i) ∈ S₁ := Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨hγ₀, hi⟩, hdeg⟩ + exact mul_ne_zero hδ₀ (hgT i hi) (hcoeff ⟨(γ₀, i), hpS₁⟩) + +/-- FLLM24, Corollary 4.5 for `α = n < ω` (Remark 4.6): `(*)_n` holds for every `n ≥ 1`, by +induction from Proposition 4.3 through Proposition 4.4. -/ +theorem independentModuloDecomposable_of_pos {n : ℕ} (hn : 1 ≤ n) : + IndependentModuloDecomposable K n := by + induction n with + | zero => exact absurd hn (by decide) + | succ n ih => + rcases Nat.eq_zero_or_pos n with rfl | hpos + · exact independentModuloDecomposable_one + · exact independentModuloDecomposable_succ hpos (ih hpos) + +end FLLM24 + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/SupportRandom.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/SupportRandom.lean new file mode 100644 index 0000000000..a2131401c9 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/SupportRandom.lean @@ -0,0 +1,176 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.Random +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.TruncationIndependence +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.IndependenceWindow +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.IndicatorFinsupp + +/-! +# Independent support closures give hereditary `rv_J`-independence + +Fornasiero, Lavi, L'Innocente and Mantova, *Irreducibility in generalized power series* (2024), +Proposition 3.6: if `deg_J(b_i) = α > 0`, the closures of the supports of the `b_i` meet pairwise +only in `{0}`, and the union of these closures with `0` removed is `ℚ`-linearly independent, then +`Q(b_1, …, b_n)` holds. + +As in the source, a vanishing relation `∑ k_p c_p ∈ J_α` among translated truncations +`c_p = b_{i(p)}^{|γ_p}` at distinct pairs is tested at a support point `x < 0` of one `c_p` near +zero outside the support of the relation; the coefficient at `x` must cancel against another +`c_{p'}`, giving `β - γ_p = x = β' - γ_{p'}` with `β ∈ supp b_{i(p)}`, `β' ∈ supp b_{i(p')}`. The +`ℚ`-relation `β + γ_{p'} = β' + γ_p` among elements of the independent set (each `γ` lies in the +closure of the corresponding support, or is `0`) forces `β = β'` and `γ_p = γ_{p'}`, since +`β = γ_p` would give `x = 0`; then `β ≠ 0` lies in two support closures, so `i(p) = i(p')`, and +the pairs coincide. The source states Axiom 2 for the family itself and assumes principality +"for simplicity"; the argument here covers the truncation families directly, which is what +Axiom 2 needs at every depth. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace FLLM24 + +open Berarducci HahnSeries.Nonpositive + +variable {K : Type v} [Field K] + +/-- A translated truncation outside `J` is taken at a point of the closure of the support. -/ +private theorem mem_closure_support_of_ordinalValue_ne_zero {b : Series K} {γ : ℝ} + (h : ordinalValue (translatedTruncation (b : K⟦ℝ⟧) γ) ≠ 0) : + γ ∈ closure (b : K⟦ℝ⟧).support := by + by_contra hγ + exact h (ordinalValue_of_mem_negativeMonomialIdeal + (translatedTruncation_mem_negativeMonomialIdeal_of_not_mem_closure_support hγ)) + +/-- FLLM24, Proposition 3.6 in the form needed for Axiom 2: under the support clause of mutual +randomness, the translated truncations at distinct pairs of a common positive degree have +linearly independent classes. -/ +theorem IsMutuallySupportRandom.truncationsIndependent {ι : Type} {b : ι → Series K} + (hb : IsMutuallySupportRandom b) : TruncationsIndependent K b := by + refine TruncationsIndependent.of fun d hd κ _ j γ hinj hγ hval ↦ ?_ + classical + cases nonempty_fintype κ + set c : κ → Series K := fun k ↦ translatedTruncation (b (j k) : K⟦ℝ⟧) (γ k) with hc + rw [linearIndependent_iff'] + intro s g hsum k₀ hk₀ + by_contra hg₀ + set P := s.filter (fun k ↦ g k ≠ 0) with hP + have hk₀P : k₀ ∈ P := Finset.mem_filter.mpr ⟨hk₀, hg₀⟩ + have hgP : ∀ k ∈ P, g k ≠ 0 := fun k hk ↦ (Finset.mem_filter.mp hk).2 + have hrelP : ∑ k ∈ P, g k • rvJ (c k) = 0 := by + rw [hP, Finset.sum_filter_of_ne] + · exact hsum + · intro k _ hk hgk + exact hk (by rw [hgk, zero_smul]) + have hrel' : ∑ k : P, g k • rvJ (c k) = 0 := by + rw [Finset.sum_coe_sort P (fun k ↦ g k • rvJ (c k))] + exact hrelP + set R : Series K := ∑ k : P, (HahnSeries.Nonpositive.C : K →+* Series K) (g k) * c k with hR + have hRlt : ordinalValue R < ω^ (d : NatOrdinal) := + ordinalValue_sum_C_mul_lt_of_sum_smul_rvJ_eq_zero (fun k : P ↦ hval k) (fun k : P ↦ g k) + hrel' + have hd' : (0 : NatOrdinal) < d := Nat.cast_pos.mpr hd + -- A support point of `c k₀` near zero outside the support of `R`. + obtain ⟨η₀, hη₀, hwin⟩ := exists_forall_infinite_support_diff hd' (hval k₀) hRlt + obtain ⟨x, ⟨hxc, -, hx0⟩, hxR⟩ := (hwin (η₀ / 2) (by linarith) (by linarith)).nonempty + rw [HahnSeries.mem_support, not_ne_iff] at hxR + -- The coefficient of `R` at `x` vanishes, so another `c k₁` contributes at `x`. + have hcoeff : ∀ k : κ, ((c k : Series K) : K⟦ℝ⟧).coeff x = + ((b (j k) : Series K) : K⟦ℝ⟧).coeff (γ k + x) := fun k ↦ by + rw [hc, coeff_translatedTruncation, if_pos hx0.le] + obtain ⟨k₁, hk₁P, hk₁ne, hk₁c⟩ : ∃ k₁ ∈ P, k₁ ≠ k₀ ∧ ((c k₁ : Series K) : K⟦ℝ⟧).coeff x ≠ 0 := by + by_contra hnone + push Not at hnone + have hsum' : ((R : Series K) : K⟦ℝ⟧).coeff x = g k₀ * ((c k₀ : Series K) : K⟦ℝ⟧).coeff x := by + rw [hR, coeff_sum_C_mul] + rw [Finset.sum_eq_single ⟨k₀, hk₀P⟩] + · intro k _ hk + have hkne : (k : κ) ≠ k₀ := fun h ↦ hk (Subtype.ext h) + rw [hnone k k.2 hkne, mul_zero] + · intro h + exact absurd (Finset.mem_univ _) h + rw [hxR] at hsum' + exact mul_ne_zero (hgP k₀ hk₀P) hxc hsum'.symm + -- The two support points and the linear relation between them. + set β := γ k₀ + x with hβ + set β' := γ k₁ + x with hβ' + have hβsupp : β ∈ ((b (j k₀) : Series K) : K⟦ℝ⟧).support := by + rw [HahnSeries.mem_support, ← hcoeff k₀]; exact hxc + have hβ'supp : β' ∈ ((b (j k₁) : Series K) : K⟦ℝ⟧).support := by + rw [HahnSeries.mem_support, ← hcoeff k₁]; exact hk₁c + have hβneg : β < 0 := by linarith [hγ k₀] + have hβ'neg : β' < 0 := by linarith [hγ k₁] + set L := supportClosureUnion b with hL + have hβL : β ∈ L := (mem_supportClosureUnion_iff b β).mpr + ⟨⟨j k₀, subset_closure hβsupp⟩, hβneg.ne⟩ + have hβ'L : β' ∈ L := (mem_supportClosureUnion_iff b β').mpr + ⟨⟨j k₁, subset_closure hβ'supp⟩, hβ'neg.ne⟩ + have hγcl : ∀ k, γ k ∈ closure ((b (j k) : Series K) : K⟦ℝ⟧).support := fun k ↦ + mem_closure_support_of_ordinalValue_ne_zero (by rw [hval k]; exact (NatOrdinal.wpow_pos _).ne') + have hγL : ∀ k, γ k ∈ L ∨ γ k = 0 := fun k ↦ by + rcases eq_or_ne (γ k) 0 with h | h + · exact Or.inr h + · exact Or.inl ((mem_supportClosureUnion_iff b (γ k)).mpr ⟨⟨j k, hγcl k⟩, h⟩) + -- Injectivity of the linear combination over the independent set `L`. + have hinjL : Function.Injective (Finsupp.linearCombination ℚ (fun z : L ↦ (z : ℝ))) := + linearIndependent_iff_injective_finsuppLinearCombination.mp hb.linearIndependent + have hcomb : ∀ k, Finsupp.linearCombination ℚ (fun z : L ↦ (z : ℝ)) + (L.indicatorFinsupp ℚ (γ k)) = γ k := fun k ↦ by + rcases hγL k with h | h + · exact L.linearCombination_indicatorFinsupp_of_mem ℚ h + · rw [h]; exact L.linearCombination_indicatorFinsupp_zero ℚ + have hrelation : L.indicatorFinsupp ℚ β + L.indicatorFinsupp ℚ (γ k₁) = + L.indicatorFinsupp ℚ β' + L.indicatorFinsupp ℚ (γ k₀) := by + apply hinjL + rw [map_add, map_add, L.linearCombination_indicatorFinsupp_of_mem ℚ hβL, + L.linearCombination_indicatorFinsupp_of_mem ℚ hβ'L, hcomb k₁, hcomb k₀, hβ, hβ'] + ring + -- Evaluate at `β`: the right side must be nonzero there. + have hpos : 0 < (L.indicatorFinsupp ℚ β + L.indicatorFinsupp ℚ (γ k₁)) ⟨β, hβL⟩ := by + rw [Finsupp.add_apply, L.indicatorFinsupp_apply_self hβL] + linarith [L.indicatorFinsupp_apply_nonneg (R := ℚ) (γ k₁) ⟨β, hβL⟩] + rw [hrelation, Finsupp.add_apply] at hpos + have hγ₀ : L.indicatorFinsupp ℚ (γ k₀) ⟨β, hβL⟩ = 0 := by + apply L.indicatorFinsupp_apply_of_ne + intro heq + have : x = 0 := by simp only at heq; linarith + exact hx0.ne this + rw [hγ₀, add_zero] at hpos + have hββ' : β = β' := by + by_contra hne + rw [L.indicatorFinsupp_apply_of_ne β' ⟨β, hβL⟩ hne] at hpos + exact lt_irrefl _ hpos + -- Hence the exponents agree and the support closures meet at `β ≠ 0`. + have hγeq : γ k₁ = γ k₀ := by + have h := hrelation + rw [hββ', add_comm (L.indicatorFinsupp ℚ β'), add_comm (L.indicatorFinsupp ℚ β')] at h + have h' := add_right_cancel h + have := congrArg (Finsupp.linearCombination ℚ (fun z : L ↦ (z : ℝ))) h' + rwa [hcomb k₁, hcomb k₀] at this + have hj : j k₀ = j k₁ := by + by_contra hne + have hmem : β ∈ closure ((b (j k₀) : Series K) : K⟦ℝ⟧).support ∩ + closure ((b (j k₁) : Series K) : K⟦ℝ⟧).support := + ⟨subset_closure hβsupp, hββ' ▸ subset_closure hβ'supp⟩ + exact hβneg.ne (hb.closure_inter_subset _ _ hne hmem) + exact hk₁ne (hinj (Prod.ext hj.symm hγeq)) + +/-- FLLM24, Proposition 3.6 for finite degrees: a finite family satisfying the support clause of +mutual randomness, of ordinal value `ω^n` with `n ≥ 1`, is hereditarily `rv_J`-independent. -/ +theorem IsMutuallySupportRandom.hereditarilyRVIndependent {ι : Type} [Finite ι] + {b : ι → Series K} (hb : IsMutuallySupportRandom b) {n : ℕ} (hn : 1 ≤ n) + (hval : ∀ i, ordinalValue (b i) = ω^ (n : NatOrdinal)) : + HereditarilyRVIndependent n b := + hb.truncationsIndependent.hereditarilyRVIndependent_self hn hval + +end FLLM24 + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/TruncationIndependence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/TruncationIndependence.lean new file mode 100644 index 0000000000..1dcdddb0ad --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/TruncationIndependence.lean @@ -0,0 +1,167 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.HereditaryIndependence + +import Mathlib.Data.Finset.Lattice.Fold +import Mathlib.Data.Finset.Max + +/-! +# Hereditary `rv_J`-independence from the independence of truncations + +Fornasiero, Lavi, L'Innocente and Mantova, *Irreducibility in generalized power series* (2024), +Corollary 3.5 and Proposition 3.6, derive `Q(b_1, …, b_n)` from a randomness hypothesis by +verifying Axiom 1 for the family and for all families of translated truncations that Axiom 2 +produces, the hypothesis being inherited by the truncations. This module isolates the +induction: if every finite family of translated truncations `(b_{j(k)})^{|γ(k)}` at distinct +pairs `(j(k), γ(k))` of a common positive degree `d` has linearly independent classes, then every +such family is hereditarily `rv_J`-independent. + +The point needing care is the threshold `δ` of Axiom 2. Translated truncations compose, +`(b^{|γ})^{|γ'} = b^{|γ + γ'}`, so a family of truncations of the truncations is again a family of +truncations of the `b_i`, but two distinct pairs `(j, γ)`, `(j, γ'')` can produce the same pair +`(j, γ + δ₁) = (j, γ'' + δ₂)` when `|γ - γ''| = |δ₁ - δ₂|`. Choosing `δ` below half the least +gap between exponents attached to the same index keeps the composed pairs distinct, and the +source's requirement "`γ_{i,j} ≠ γ_{i,j'}` for `j ≠ j'`" is preserved. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace FLLM24 + +open Berarducci + +variable {K : Type v} [Field K] + +variable (K) in +/-- Every finite family of translated truncations of the `b i` at distinct pairs, all of ordinal +value `ω^d` with `d ≥ 1`, has `K`-linearly independent classes `rv_J`. -/ +def TruncationsIndependent {ι : Type} (b : ι → Series K) : Prop := + ∀ (d : ℕ), 1 ≤ d → ∀ (κ : Type) [Finite κ] (j : κ → ι) (γ : κ → ℝ), + Function.Injective (fun k ↦ (j k, γ k)) → (∀ k, γ k ≤ 0) → + (∀ k, ordinalValue (translatedTruncation (b (j k) : K⟦ℝ⟧) (γ k)) = ω^ (d : NatOrdinal)) → + LinearIndependent K (fun k ↦ rvJ (translatedTruncation (b (j k) : K⟦ℝ⟧) (γ k))) + +/-- Introduction rule for `TruncationsIndependent`. -/ +theorem TruncationsIndependent.of {ι : Type} {b : ι → Series K} + (h : ∀ (d : ℕ), 1 ≤ d → ∀ (κ : Type) [Finite κ] (j : κ → ι) (γ : κ → ℝ), + Function.Injective (fun k ↦ (j k, γ k)) → (∀ k, γ k ≤ 0) → + (∀ k, ordinalValue (translatedTruncation (b (j k) : K⟦ℝ⟧) (γ k)) = ω^ (d : NatOrdinal)) → + LinearIndependent K (fun k ↦ rvJ (translatedTruncation (b (j k) : K⟦ℝ⟧) (γ k)))) : + TruncationsIndependent K b := + h + +theorem TruncationsIndependent.linearIndependent {ι : Type} {b : ι → Series K} + (hb : TruncationsIndependent K b) {d : ℕ} (hd : 1 ≤ d) (κ : Type) [Finite κ] (j : κ → ι) + (γ : κ → ℝ) (hinj : Function.Injective (fun k ↦ (j k, γ k))) (hγ : ∀ k, γ k ≤ 0) + (hval : ∀ k, ordinalValue (translatedTruncation (b (j k) : K⟦ℝ⟧) (γ k)) = + ω^ (d : NatOrdinal)) : + LinearIndependent K (fun k ↦ rvJ (translatedTruncation (b (j k) : K⟦ℝ⟧) (γ k))) := + hb d hd κ j γ hinj hγ hval + +/-- The least gap between two exponents attached to the same index of a finite family of pairs: +the minimum of the finite set `{|γ k - γ k'| : k ≠ k', j k = j k'}`, or `1` if the set is +empty. -/ +private theorem exists_gap {ι κ : Type} [Finite κ] (j : κ → ι) (γ : κ → ℝ) + (hinj : Function.Injective (fun k ↦ (j k, γ k))) : + ∃ g : ℝ, 0 < g ∧ ∀ k k', k ≠ k' → j k = j k' → g ≤ |γ k - γ k'| := by + classical + cases nonempty_fintype κ + let P : Finset (κ × κ) := Finset.univ.filter fun p ↦ p.1 ≠ p.2 ∧ j p.1 = j p.2 + let G : Finset ℝ := P.image fun p ↦ |γ p.1 - γ p.2| + have hpos : ∀ g ∈ G, 0 < g := by + intro g hg + obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hg + obtain ⟨hne, hj⟩ := (Finset.mem_filter.mp hp).2 + rw [abs_pos, sub_ne_zero] + intro hγ + exact hne (hinj (Prod.ext hj hγ)) + rcases G.eq_empty_or_nonempty with hG | hG + · refine ⟨1, one_pos, fun k k' hne hj ↦ ?_⟩ + exfalso + have : |γ k - γ k'| ∈ G := + Finset.mem_image.mpr ⟨(k, k'), Finset.mem_filter.mpr ⟨Finset.mem_univ _, hne, hj⟩, rfl⟩ + rw [hG] at this + exact Finset.notMem_empty _ this + · refine ⟨G.min' hG, hpos _ (G.min'_mem hG), fun k k' hne hj ↦ ?_⟩ + exact G.min'_le _ + (Finset.mem_image.mpr ⟨(k, k'), Finset.mem_filter.mpr ⟨Finset.mem_univ _, hne, hj⟩, rfl⟩) + +/-- FLLM24, the common inductive core of Corollary 3.5 and Proposition 3.6: if all finite +families of translated truncations of the `b i` at distinct pairs and of a common positive degree +have independent classes, then every such family is hereditarily `rv_J`-independent. -/ +theorem TruncationsIndependent.hereditarilyRVIndependent {ι : Type} {b : ι → Series K} + (hb : TruncationsIndependent K b) {d : ℕ} (hd : 1 ≤ d) (κ : Type) [Finite κ] (j : κ → ι) + (γ : κ → ℝ) (hinj : Function.Injective (fun k ↦ (j k, γ k))) (hγ : ∀ k, γ k ≤ 0) + (hval : ∀ k, ordinalValue (translatedTruncation (b (j k) : K⟦ℝ⟧) (γ k)) = + ω^ (d : NatOrdinal)) : + HereditarilyRVIndependent d (fun k ↦ translatedTruncation (b (j k) : K⟦ℝ⟧) (γ k)) := by + induction d generalizing κ with + | zero => exact absurd hd (by decide) + | succ d ih => + refine HereditarilyRVIndependent.of_succ hval + (hb.linearIndependent hd κ j γ hinj hγ hval) fun hd' ↦ ?_ + obtain ⟨g, hg, hgap⟩ := exists_gap j γ hinj + refine ⟨-(g / 2), by linarith, fun κ' _ j' γ' hinj' hδγ' hγ' hval' ↦ ?_⟩ + -- The composed family of truncations of the `b i`. + have hcomp : ∀ k', translatedTruncation + ((translatedTruncation (b (j (j' k')) : K⟦ℝ⟧) (γ (j' k')) : Series K) : K⟦ℝ⟧) (γ' k') = + translatedTruncation (b (j (j' k')) : K⟦ℝ⟧) (γ (j' k') + γ' k') := fun k' ↦ + translatedTruncation_translatedTruncation _ _ (hγ' k') + have hinj'' : Function.Injective (fun k' ↦ (j (j' k'), γ (j' k') + γ' k')) := by + intro k₁ k₂ h + have h1 : j (j' k₁) = j (j' k₂) := congrArg Prod.fst h + have h2 : γ (j' k₁) + γ' k₁ = γ (j' k₂) + γ' k₂ := congrArg Prod.snd h + by_cases hk : j' k₁ = j' k₂ + · apply hinj' + refine Prod.ext hk ?_ + rw [hk] at h2 + exact add_left_cancel h2 + · exfalso + have hge := hgap _ _ hk h1 + have hsub : γ (j' k₁) - γ (j' k₂) = γ' k₂ - γ' k₁ := by linarith + rw [hsub] at hge + have h3 := hδγ' k₁ + have h4 := hδγ' k₂ + have h5 := hγ' k₁ + have h6 := hγ' k₂ + have hsmall : |γ' k₂ - γ' k₁| ≤ g / 2 := abs_sub_le_iff.mpr ⟨by linarith, by linarith⟩ + linarith + have hval'' : ∀ k', ordinalValue (translatedTruncation (b (j (j' k')) : K⟦ℝ⟧) + (γ (j' k') + γ' k')) = ω^ (d : NatOrdinal) := fun k' ↦ by + rw [← hcomp k']; exact hval' k' + have hQ := ih hd' κ' (fun k' ↦ j (j' k')) (fun k' ↦ γ (j' k') + γ' k') hinj'' + (fun k' ↦ add_nonpos (hγ (j' k')) (hγ' k')) hval'' + have hfun : (fun k' ↦ translatedTruncation + ((translatedTruncation (b (j (j' k')) : K⟦ℝ⟧) (γ (j' k')) : Series K) : K⟦ℝ⟧) + (γ' k')) = + fun k' ↦ translatedTruncation (b (j (j' k')) : K⟦ℝ⟧) (γ (j' k') + γ' k') := + funext hcomp + rw [hfun] + exact hQ + +/-- A finite family with independent truncations is hereditarily `rv_J`-independent at its +common positive degree. -/ +theorem TruncationsIndependent.hereditarilyRVIndependent_self {ι : Type} [Finite ι] + {b : ι → Series K} (hb : TruncationsIndependent K b) {d : ℕ} (hd : 1 ≤ d) + (hval : ∀ i, ordinalValue (b i) = ω^ (d : NatOrdinal)) : + HereditarilyRVIndependent d b := by + have h := hb.hereditarilyRVIndependent hd ι id (fun _ ↦ 0) + (fun i i' h ↦ congrArg Prod.fst h) (fun _ ↦ le_rfl) + (fun i ↦ by rw [translatedTruncation_zero]; exact hval i) + have hfun : (fun i ↦ translatedTruncation (b (id i) : K⟦ℝ⟧) 0) = b := by + funext i + exact translatedTruncation_zero (b i) + rwa [hfun] at h + +end FLLM24 + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesMaximalFinite.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesMaximalFinite.lean new file mode 100644 index 0000000000..bc004fca80 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesMaximalFinite.lean @@ -0,0 +1,382 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite + +/-! +# Maximal finite-support divisors of Hahn series + +This module proves the intrinsic associate-class form of LM24, Proposition 5.5.1. It lifts the +maximal finite-support divisor from degree RV to the original ring `K((ℝ^{≤ 0}))` by +well-founded induction on Hahn-series degree. + +At degree at most zero, exact degree multiplicativity reflects ambient divisibility back into the +finite-support subring. At positive degree, an RV-maximal finite-support divisor is lifted to a +series factor; subtracting that factor lowers degree. A pairwise greatest-common-divisor +hypothesis combines its divisor class with the recursively constructed residual class. + +The definition and uniqueness of the intrinsic class do not depend on the existence proof. +Pairwise gcd existence remains an explicit hypothesis and is not installed as an instance; the +coefficient field has characteristic zero. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [CharZero K] + +/-- A finite-support series divides another finite-support series in the finite-support subring +exactly when it divides it in the ambient Hahn-series ring. -/ +theorem finiteSupport_dvd_iff_coe_dvd (p q : FiniteSupportRing (K := K)) : + q ∣ p ↔ (q : Series K) ∣ (p : Series K) := by + constructor + · exact map_dvd + (HahnSeries.Nonpositive.finiteSupportSubring (G := ℝ) (K := K)).subtype + · rintro ⟨c, hc⟩ + by_cases hp : p = 0 + · subst p + exact dvd_zero q + have hpCoe : (p : Series K) ≠ 0 := by + intro h + apply hp + exact Subtype.ext h + have hq : q ≠ 0 := by + intro hq + subst q + apply hpCoe + simpa using hc + have hpHahn : (p : K⟦ℝ⟧) ≠ 0 := by + intro h + apply hpCoe + exact Subtype.ext h + have hqHahn : (q : K⟦ℝ⟧) ≠ 0 := by + intro h + apply hq + apply Subtype.ext + exact Subtype.ext h + have hpDegree : (p : K⟦ℝ⟧).degree = 0 := by + rw [HahnSeries.degree_eq_zero] + exact ⟨hpHahn, + (HahnSeries.Nonpositive.mem_finiteSupportSubring_iff + (p : Series K)).mp p.2⟩ + have hqDegree : (q : K⟦ℝ⟧).degree = 0 := by + rw [HahnSeries.degree_eq_zero] + exact ⟨hqHahn, + (HahnSeries.Nonpositive.mem_finiteSupportSubring_iff + (q : Series K)).mp q.2⟩ + have hcDegree : (c : K⟦ℝ⟧).degree = 0 := by + have h := HahnSeries.Nonpositive.degree_mul (q : Series K) c + rw [← hc, hpDegree, hqDegree, zero_add] at h + exact h.symm + let c' : FiniteSupportRing (K := K) := ⟨c, by + rw [HahnSeries.Nonpositive.mem_finiteSupportSubring_iff, + ← HahnSeries.degree_le_zero_iff] + exact hcDegree.le⟩ + refine ⟨c', ?_⟩ + apply Subtype.ext + exact hc + +/-- An associate class records exactly the finite-support divisors of a Hahn series. -/ +def IsSeriesMaximalFiniteSupportDivisor + (b : Series K) (a : Associates (FiniteSupportRing (K := K))) : Prop := + IsMaximalDivisorAlong + (HahnSeries.Nonpositive.finiteSupportSubring (G := ℝ) (K := K)).subtype.toMonoidHom + b a + +omit [CharZero K] in +/-- The defining characterization of a maximal finite-support divisor class of a Hahn series. -/ +theorem isSeriesMaximalFiniteSupportDivisor_iff + (b : Series K) (a : Associates (FiniteSupportRing (K := K))) : + IsSeriesMaximalFiniteSupportDivisor b a ↔ + ∀ q : FiniteSupportRing (K := K), + Associates.mk q ≤ a ↔ (q : Series K) ∣ b := by + rw [IsSeriesMaximalFiniteSupportDivisor, isMaximalDivisorAlong_iff] + constructor <;> intro h q + · have hq := h q + change Associates.mk q ≤ a ↔ (q : Series K) ∣ b at hq + exact hq + · have hq := h q + change Associates.mk q ≤ a ↔ + (HahnSeries.Nonpositive.finiteSupportSubring + (G := ℝ) (K := K)).subtype q ∣ b + exact hq + +omit [CharZero K] in +/-- Representative form of the maximal finite-support divisor characterization. -/ +theorem isSeriesMaximalFiniteSupportDivisor_mk_iff (b : Series K) (p : FiniteSupportRing (K := K)) : + IsSeriesMaximalFiniteSupportDivisor b (Associates.mk p) ↔ + ∀ q : FiniteSupportRing (K := K), (q : Series K) ∣ b ↔ q ∣ p := by + rw [isSeriesMaximalFiniteSupportDivisor_iff] + constructor + · intro h q + constructor + · intro hqb + exact Associates.mk_le_mk_iff_dvd.mp ((h q).mpr hqb) + · intro hqp + exact (h q).mp (Associates.mk_le_mk_iff_dvd.mpr hqp) + · intro h q + constructor + · intro hqp + exact (h q).mpr (Associates.mk_le_mk_iff_dvd.mp hqp) + · intro hqb + exact Associates.mk_le_mk_iff_dvd.mpr ((h q).mp hqb) + +omit [CharZero K] in +/-- A Hahn series has at most one maximal finite-support divisor class. -/ +theorem IsSeriesMaximalFiniteSupportDivisor.eq + {b : Series K} {a c : Associates (FiniteSupportRing (K := K))} + (ha : IsSeriesMaximalFiniteSupportDivisor b a) + (hc : IsSeriesMaximalFiniteSupportDivisor b c) : a = c := by + exact IsMaximalDivisorAlong.eq ha hc + +omit [CharZero K] in +/-- Zero has the zero maximal finite-support divisor class. -/ +theorem IsSeriesMaximalFiniteSupportDivisor.zero : + IsSeriesMaximalFiniteSupportDivisor (0 : Series K) 0 := by + apply (isSeriesMaximalFiniteSupportDivisor_iff 0 0).mpr + intro q + constructor + · intro _ + exact dvd_zero _ + · intro _ + exact Associates.mk_le_mk_of_dvd (dvd_zero q) + +/-- Divisibility by a finite-support series splits across an RV-maximal divisor and the +corresponding subtraction residual. -/ +theorem coe_dvd_iff_dvd_rvMaximal_and_residual (b b' : Series K) (p q : FiniteSupportRing (K := K)) + (hp : IsRVMaximalFiniteSupportDivisor + ((HahnSeries.Nonpositive.degreeValuation K).rv b) + (Associates.mk p)) : + (q : Series K) ∣ b ↔ + q ∣ p ∧ (q : Series K) ∣ b - (p : Series K) * b' := by + have hpSpec := (isRVMaximalFiniteSupportDivisor_mk_iff _ p).mp hp + constructor + · intro hqb + have hqRV : finiteSupportRVEmbedding K q ∣ + (HahnSeries.Nonpositive.degreeValuation K).rv b := by + simpa only [finiteSupportRVEmbedding_apply] using + map_dvd + (HahnSeries.Nonpositive.degreeValuation K).rv hqb + have hqp : q ∣ p := (hpSpec q).mp hqRV + have hqpCoe : (q : Series K) ∣ (p : Series K) := + (finiteSupport_dvd_iff_coe_dvd p q).mp hqp + exact ⟨hqp, dvd_sub hqb (hqpCoe.mul_right b')⟩ + · rintro ⟨hqp, hqResidual⟩ + have hqpCoe : (q : Series K) ∣ (p : Series K) := + (finiteSupport_dvd_iff_coe_dvd p q).mp hqp + simpa only [sub_add_cancel] using + dvd_add hqResidual (hqpCoe.mul_right b') + +/-- A positive-degree Hahn series admits an RV-maximal finite-support factor whose subtraction +residual has strictly smaller degree. -/ +theorem exists_rvMaximalFiniteSupportApproximation_of_degree_pos + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + {b : Series K} (hb : 0 < (b : K⟦ℝ⟧).degree) : + ∃ (p : FiniteSupportRing (K := K)) (b' : Series K), + IsRVMaximalFiniteSupportDivisor + ((HahnSeries.Nonpositive.degreeValuation K).rv b) + (Associates.mk p) ∧ + ((b - (p : Series K) * b' : Series K) : K⟦ℝ⟧).degree < + (b : K⟦ℝ⟧).degree := by + let w := HahnSeries.Nonpositive.degreeValuation K + obtain ⟨a, ha, _⟩ := + existsUnique_isRVMaximalFiniteSupportDivisor_of_exists_gcd hgcd (w.rv b) + induction a using Quotient.inductionOn with + | _ p => + have hpDvd : finiteSupportRVEmbedding K p ∣ w.rv b := + ((isRVMaximalFiniteSupportDivisor_mk_iff (w.rv b) p).mp ha p).mpr + dvd_rfl + obtain ⟨B', hB'⟩ := hpDvd + obtain ⟨b', hb'⟩ := w.rv_surjective B' + refine ⟨p, b', ha, ?_⟩ + have hbValue : w b ≠ ⊥ := by + rw [HahnSeries.Nonpositive.degreeValuation_apply] + intro hbot + rw [hbot] at hb + exact (not_lt_of_ge bot_le hb) + have hrv : w.rv b = w.rv ((p : Series K) * b') := by + calc + w.rv b = finiteSupportRVEmbedding K p * B' := hB' + _ = w.rv (p : Series K) * w.rv b' := by + rw [finiteSupportRVEmbedding_apply, hb'] + _ = w.rv ((p : Series K) * b') := (map_mul w.rv _ _).symm + have hdrop := (w.rv_eq_iff_of_value_ne_bot hbValue).mp hrv + simpa only [w, + HahnSeries.Nonpositive.degreeValuation_apply] using hdrop + +/-- Pairwise greatest-common-divisor existence gives a maximal finite-support divisor class for +every Hahn series. -/ +theorem exists_isSeriesMaximalFiniteSupportDivisor_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (b : Series K) : + ∃ a : Associates (FiniteSupportRing (K := K)), + IsSeriesMaximalFiniteSupportDivisor b a := by + classical + let wf : WellFounded (Function.onFun (fun α β : WithBot NatOrdinal ↦ α < β) + (fun c : Series K ↦ (c : K⟦ℝ⟧).degree)) := + wellFounded_lt.onFun + refine wf.induction + (C := fun b ↦ ∃ a : Associates (FiniteSupportRing (K := K)), + IsSeriesMaximalFiniteSupportDivisor b a) b ?_ + intro b ih + by_cases hbFinite : (b : K⟦ℝ⟧).degree ≤ 0 + · let p : FiniteSupportRing (K := K) := ⟨b, by + rw [HahnSeries.Nonpositive.mem_finiteSupportSubring_iff, + ← HahnSeries.degree_le_zero_iff] + exact hbFinite⟩ + refine ⟨Associates.mk p, + (isSeriesMaximalFiniteSupportDivisor_mk_iff b p).mpr ?_⟩ + intro q + simpa only [p] using (finiteSupport_dvd_iff_coe_dvd p q).symm + · have hbPos : 0 < (b : K⟦ℝ⟧).degree := lt_of_not_ge hbFinite + obtain ⟨p, b', hp, hdrop⟩ := + exists_rvMaximalFiniteSupportApproximation_of_degree_pos hgcd hbPos + let c : Series K := b - (p : Series K) * b' + obtain ⟨a, ha⟩ := ih c (by simpa only [c] using hdrop) + induction a using Quotient.inductionOn with + | _ p' => + obtain ⟨d, hd⟩ := hgcd p p' + refine ⟨Associates.mk d, + (isSeriesMaximalFiniteSupportDivisor_mk_iff b d).mpr ?_⟩ + intro q + calc + (q : Series K) ∣ b ↔ q ∣ p ∧ (q : Series K) ∣ c := by + simpa only [c] using + coe_dvd_iff_dvd_rvMaximal_and_residual b b' p q hp + _ ↔ q ∣ p ∧ q ∣ p' := + and_congr Iff.rfl + ((isSeriesMaximalFiniteSupportDivisor_mk_iff c p').mp ha q) + _ ↔ q ∣ d := hd q + +/-- Pairwise greatest-common-divisor existence gives a unique maximal finite-support divisor +class for every Hahn series. -/ +theorem existsUnique_isSeriesMaximalFiniteSupportDivisor_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (b : Series K) : + ∃! a : Associates (FiniteSupportRing (K := K)), + IsSeriesMaximalFiniteSupportDivisor b a := by + obtain ⟨a, ha⟩ := + exists_isSeriesMaximalFiniteSupportDivisor_of_exists_gcd hgcd b + exact ⟨a, ha, fun c hc ↦ hc.eq ha⟩ + +/-- The canonical maximal finite-support divisor class of a Hahn series. + +The fallback branch is unreachable whenever maximal-divisor existence has been established. -/ +noncomputable def seriesMaximalFiniteSupportDivisor + (b : Series K) : Associates (FiniteSupportRing (K := K)) := by + classical + exact if h : ∃ a : Associates (FiniteSupportRing (K := K)), + IsSeriesMaximalFiniteSupportDivisor b a then + Classical.choose h + else + 0 + +omit [CharZero K] in +/-- Any class satisfying the series characterization is the canonical class. -/ +theorem seriesMaximalFiniteSupportDivisor_eq_of_is + {b : Series K} {a : Associates (FiniteSupportRing (K := K))} + (ha : IsSeriesMaximalFiniteSupportDivisor b a) : + seriesMaximalFiniteSupportDivisor b = a := by + classical + let hex : ∃ c : Associates (FiniteSupportRing (K := K)), + IsSeriesMaximalFiniteSupportDivisor b c := ⟨a, ha⟩ + rw [seriesMaximalFiniteSupportDivisor, dif_pos hex] + exact (Classical.choose_spec hex).eq ha + +/-- Under pairwise greatest-common-divisor existence, the canonical class satisfies its defining +characterization. -/ +theorem seriesMaximalFiniteSupportDivisor_is_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (b : Series K) : + IsSeriesMaximalFiniteSupportDivisor b + (seriesMaximalFiniteSupportDivisor b) := by + obtain ⟨a, ha, _⟩ := + existsUnique_isSeriesMaximalFiniteSupportDivisor_of_exists_gcd hgcd b + rw [seriesMaximalFiniteSupportDivisor_eq_of_is ha] + exact ha + +/-- Maximal finite-support divisor classes of Hahn series are supermultiplicative. -/ +theorem seriesMaximalFiniteSupportDivisor_mul_le_of_exists_gcd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (b c : Series K) : + seriesMaximalFiniteSupportDivisor b * + seriesMaximalFiniteSupportDivisor c ≤ + seriesMaximalFiniteSupportDivisor (b * c) := by + exact IsMaximalDivisorAlong.mul_le + (seriesMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd b) + (seriesMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd c) + (seriesMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd (b * c)) + +/-- The maximal divisor class of a finite-support series is its own associate class. -/ +theorem seriesMaximalFiniteSupportDivisor_coe (p : FiniteSupportRing (K := K)) : + seriesMaximalFiniteSupportDivisor (p : Series K) = Associates.mk p := by + apply seriesMaximalFiniteSupportDivisor_eq_of_is + apply (isSeriesMaximalFiniteSupportDivisor_mk_iff (p : Series K) p).mpr + intro q + exact (finiteSupport_dvd_iff_coe_dvd p q).symm + +/-- A principal Hahn series has the unit associate class as its maximal finite-support divisor. +-/ +theorem seriesMaximalFiniteSupportDivisor_eq_one_of_isPrincipal + {b : Series K} (hb : HahnSeries.Nonpositive.IsPrincipal b) : + seriesMaximalFiniteSupportDivisor b = 1 := by + let w := HahnSeries.Nonpositive.degreeValuation K + have hPrincipalRV : IsPrincipalRV (w.rv b) := + (isPrincipalRV_iff (w.rv b)).mpr ⟨b, hb, rfl⟩ + obtain ⟨k, hk⟩ := + exists_scalar_isRVMaximalFiniteSupportDivisor_of_isPrincipal (w.rv b) hPrincipalRV + let scalar := HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k + have hkSpec := (isRVMaximalFiniteSupportDivisor_mk_iff (w.rv b) scalar).mp hk + have hBNe : w.rv b ≠ 0 := by + intro hzero + have hbot := (w.rv_eq_zero_iff).mp hzero + rw [HahnSeries.Nonpositive.degreeValuation_apply, + HahnSeries.degree_eq_bot] at hbot + exact hb.ne_zero (Subtype.ext hbot) + have hkNe : k ≠ 0 := by + intro hkZero + subst k + have hzeroDvd : finiteSupportRVEmbedding K 0 ∣ w.rv b := + (hkSpec 0).mpr (by simp [scalar]) + apply hBNe + apply zero_dvd_iff.mp + simpa using hzeroDvd + have hscalarUnit : IsUnit scalar := by + exact (isUnit_iff_ne_zero.mpr hkNe).map + (HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) (K := K)) + apply seriesMaximalFiniteSupportDivisor_eq_of_is + apply (isSeriesMaximalFiniteSupportDivisor_mk_iff b 1).mpr + intro q + constructor + · intro hqb + have hqRV : finiteSupportRVEmbedding K q ∣ w.rv b := by + simpa only [finiteSupportRVEmbedding_apply] using map_dvd w.rv hqb + exact isUnit_iff_dvd_one.mp + (isUnit_of_dvd_unit ((hkSpec q).mp hqRV) hscalarUnit) + · intro hqOne + exact (isUnit_of_dvd_one hqOne).map + (HahnSeries.Nonpositive.finiteSupportSubring + (G := ℝ) (K := K)).subtype |>.dvd + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesMaximalMultiplicativity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesMaximalMultiplicativity.lean new file mode 100644 index 0000000000..ee3f93297a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesMaximalMultiplicativity.lean @@ -0,0 +1,412 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVGradedMaximalFinite +import Mathlib.Algebra.GCDMonoid.Basic +import Mathlib.Order.RelClasses + +/-! +# Multiplicativity of maximal finite-support divisors of Hahn series + +This module proves the field-generic reduction underlying LM24, Proposition 6.3.8. The proof is +by lexicographic well-founded induction on the degrees of the two factors. Its explicit leading-RV +hypothesis is precisely the conclusion of LM24, Corollary 6.3.7. + +Pairwise greatest-common-divisor existence and the classification of finite-support units remain +explicit hypotheses. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +namespace Berarducci + +public noncomputable section + +open HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +private def IsFiniteSupportPrimitive (b : Series K) : Prop := + ∀ q : FiniteSupportRing (K := K), (q : Series K) ∣ b → IsUnit q + +private theorem degree_rightFactor_eq_of_monicFiniteSupport {p : FiniteSupportRing (K := K)} + (hp : IsMonicFiniteSupport p) + {b b₀ : Series K} (hbFactor : b = (p : Series K) * b₀) : + (b₀ : K⟦ℝ⟧).degree = (b : K⟦ℝ⟧).degree := by + have hpHahn : (p : K⟦ℝ⟧) ≠ 0 := by + intro hpZero + apply hp.ne_zero + exact Subtype.ext (Subtype.ext hpZero) + have hpDegree : (p : K⟦ℝ⟧).degree = 0 := by + rw [HahnSeries.degree_eq_zero] + exact ⟨hpHahn, + (mem_finiteSupportSubring_iff (p : Series K)).mp p.2⟩ + have hproduct := HahnSeries.Nonpositive.degree_mul (p : Series K) b₀ + rw [← hbFactor, hpDegree, zero_add] at hproduct + exact hproduct.symm + +private theorem isFiniteSupportPrimitive_factor_of_normalizedMaximal + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + {b b₀ : Series K} (hb : b ≠ 0) + (hbFactor : b = + (seriesNormalizedMaximalFiniteSupportDivisor b : Series K) * b₀) : + IsFiniteSupportPrimitive b₀ := by + let pB := seriesNormalizedMaximalFiniteSupportDivisor b + have hmax := (isNormalizedSeriesMaximalFiniteSupportDivisor_iff b pB).mp + (seriesNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd b) + have hpBMonic := seriesNormalizedMaximalFiniteSupportDivisor_isMonic_of_ne_zero hgcd hb + have hpB : pB ≠ 0 := hpBMonic.ne_zero + intro q hq + have hpBq : ((pB * q : FiniteSupportRing (K := K)) : Series K) ∣ b := by + rw [hbFactor] + change ((pB * q : FiniteSupportRing (K := K)) : Series K) ∣ + (pB : Series K) * b₀ + have hq' := mul_dvd_mul_left (pB : Series K) hq + simpa only [Subring.coe_mul] using hq' + have hpBqDvd : pB * q ∣ pB := (hmax.1 (pB * q)).mp hpBq + have hqOne : q ∣ 1 := by + apply (mul_dvd_mul_iff_left hpB).mp + simpa only [mul_one] using hpBqDvd + exact isUnit_of_dvd_one hqOne + +/-- A positive-degree series can be approximated by its normalized maximal finite-support +divisor of the leading RV class, with a remainder of strictly smaller degree. -/ +theorem exists_normalizedRVMaximalFiniteSupportApproximation_of_degree_pos + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + {b : Series K} (hb : 0 < (b : K⟦ℝ⟧).degree) : + ∃ b' : Series K, + ((b - + (gradedNormalizedMaximalFiniteSupportDivisor + ((degreeValuation K).rvInitialFormHom + ((degreeValuation K).rv b)) : Series K) * + b' : Series K) : K⟦ℝ⟧).degree < + (b : K⟦ℝ⟧).degree := by + let w := degreeValuation K + let pB := gradedNormalizedMaximalFiniteSupportDivisor + (w.rvInitialFormHom (w.rv b)) + obtain ⟨p, b', hp, hdrop⟩ := + exists_rvMaximalFiniteSupportApproximation_of_degree_pos hgcd hb + have hpGraded : + IsGradedMaximalFiniteSupportDivisor + (w.rvInitialFormHom (w.rv b)) (Associates.mk p) := + (isRVMaximalFiniteSupportDivisor_iff_isGradedMaximalFiniteSupportDivisor (w.rv b) + (Associates.mk p)).mp hp + have hpBGraded : + IsGradedMaximalFiniteSupportDivisor + (w.rvInitialFormHom (w.rv b)) (Associates.mk pB) := by + exact (isGradedMaximalFiniteSupportDivisor_mk_iff _ pB).mpr + ((isNormalizedGradedMaximalFiniteSupportDivisor_iff _ pB).mp + (gradedNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd _)).1 + have hclasses : Associates.mk pB = Associates.mk p := + hpBGraded.eq hpGraded + obtain ⟨u, hu⟩ := Associates.mk_eq_mk_iff_associated.mp hclasses + let b'' : Series K := (((u : FiniteSupportRing (K := K)) : Series K) * b') + refine ⟨b'', ?_⟩ + have hproduct : (pB : Series K) * b'' = (p : Series K) * b' := by + have hpEq : p = pB * (u : FiniteSupportRing (K := K)) := hu.symm + calc + (pB : Series K) * b'' = + (pB : Series K) * + ((u : FiniteSupportRing (K := K)) : Series K) * b' := by + dsimp only [b''] + rw [mul_assoc] + _ = ((pB * (u : FiniteSupportRing (K := K)) : + FiniteSupportRing (K := K)) : Series K) * b' := by + exact congrArg (· * b') + (map_mul + (finiteSupportSubring (G := ℝ) (K := K)).subtype pB + (u : FiniteSupportRing (K := K))).symm + _ = (p : Series K) * b' := by rw [hpEq] + simpa only [pB, w, hproduct] using hdrop + +omit [CharZero K] in +/-- A finite-support-primitive series of degree at most `0` is a unit: it has finite support, so +it is its own finite-support divisor, and primitivity makes that divisor a unit. -/ +private theorem isUnit_of_isFiniteSupportPrimitive_of_degree_le_zero {b : Series K} + (hbPrimitive : IsFiniteSupportPrimitive b) (hbFinite : (b : K⟦ℝ⟧).degree ≤ 0) : + IsUnit b := by + let p : FiniteSupportRing (K := K) := ⟨b, by + rw [mem_finiteSupportSubring_iff, ← HahnSeries.degree_le_zero_iff] + exact hbFinite⟩ + have hpUnit : IsUnit p := hbPrimitive p (by simp [p]) + change IsUnit ((p : FiniteSupportRing (K := K)) : Series K) + exact hpUnit.map (finiteSupportSubring (G := ℝ) (K := K)).subtype + +/-- The coprimality step of the induction. Let `q` be a finite-support divisor of `b * c`, with +`b` finite-support primitive and the normalized maximal divisor of `c` a unit, and write +`b = p * b' + d` where multiplicativity of the normalized maximal divisor is known for `d * c`. +Every common finite-support divisor `r` of `q` and `p` divides `d * c`, hence the normalized +maximal divisor of `d`, hence `d`, hence `b`; primitivity of `b` makes `r` a unit. -/ +private theorem isRelPrime_of_dvd_mul_of_eq_mul_add + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + {b c b' d : Series K} {q p : FiniteSupportRing (K := K)} + (hqbc : (q : Series K) ∣ b * c) + (hbPrimitive : IsFiniteSupportPrimitive b) + (hpCUnit : IsUnit (seriesNormalizedMaximalFiniteSupportDivisor c)) + (hsum : (p : Series K) * b' + d = b) + (hmul : seriesNormalizedMaximalFiniteSupportDivisor (d * c) = + seriesNormalizedMaximalFiniteSupportDivisor d * + seriesNormalizedMaximalFiniteSupportDivisor c) : + IsRelPrime q p := by + intro r hrq hrp + have hrbc : (r : Series K) ∣ b * c := + (map_dvd (finiteSupportSubring (G := ℝ) (K := K)).subtype hrq).trans hqbc + have hrpCoe : (r : Series K) ∣ (p : Series K) := + map_dvd (finiteSupportSubring (G := ℝ) (K := K)).subtype hrp + have hrdc : (r : Series K) ∣ d * c := by + have hdc : d * c = b * c - (p : Series K) * b' * c := by + rw [← hsum] + ring + rw [hdc] + exact dvd_sub hrbc ((hrpCoe.mul_right b').mul_right c) + have hmaxdc := (isNormalizedSeriesMaximalFiniteSupportDivisor_iff + (d * c) (seriesNormalizedMaximalFiniteSupportDivisor (d * c))).mp + (seriesNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd (d * c)) + have hrpdc := (hmaxdc.1 r).mp hrdc + rw [hmul] at hrpdc + have hrpd : r ∣ seriesNormalizedMaximalFiniteSupportDivisor d := + hpCUnit.dvd_mul_right.mp hrpdc + have hmaxd := (isNormalizedSeriesMaximalFiniteSupportDivisor_iff + d (seriesNormalizedMaximalFiniteSupportDivisor d)).mp + (seriesNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd d) + have hrd : (r : Series K) ∣ d := (hmaxd.1 r).mpr hrpd + apply hbPrimitive r + rw [← hsum] + exact dvd_add (hrpCoe.mul_right b') hrd + +/-- A finite-support divisor of a series divides the normalized maximal finite-support divisor of +the initial form of its leading RV class: the RV map and the initial-form map are multiplicative, +and on finite-support elements their composite is the graded embedding. -/ +private theorem dvd_gradedNormalizedMaximalFiniteSupportDivisor_rvInitialForm_of_dvd + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + {d : Series K} {q : FiniteSupportRing (K := K)} (hqd : (q : Series K) ∣ d) : + q ∣ gradedNormalizedMaximalFiniteSupportDivisor + ((degreeValuation K).rvInitialFormHom ((degreeValuation K).rv d)) := by + let w := degreeValuation K + have hqRV : finiteSupportRVEmbedding K q ∣ w.rv d := by + simpa only [finiteSupportRVEmbedding_apply] using map_dvd w.rv hqd + have hqInitialRaw := map_dvd w.rvInitialFormHom hqRV + have hfinite : + w.rvInitialFormHom (finiteSupportRVEmbedding K q) = + finiteSupportGradedEmbedding K q := by + calc + w.rvInitialFormHom (finiteSupportRVEmbedding K q) = + ((w.rvEquivHomogeneous (finiteSupportRVEmbedding K q) : + w.HomogeneousClasses) : w.AssociatedGraded) := by + rw [w.rvEquivHomogeneous_apply, w.coe_rvHomogeneous] + _ = finiteSupportGradedEmbedding K q := by + simpa only [w] using + coe_rvEquivHomogeneous_finiteSupportRVEmbedding q + rw [hfinite] at hqInitialRaw + have hmax := (isNormalizedGradedMaximalFiniteSupportDivisor_iff + (w.rvInitialFormHom (w.rv d)) + (gradedNormalizedMaximalFiniteSupportDivisor (w.rvInitialFormHom (w.rv d)))).mp + (gradedNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd + (w.rvInitialFormHom (w.rv d))) + exact (hmax.1 q).mp hqInitialRaw + +/-- Under leading-RV multiplicativity, the normalized maximal finite-support divisor of the +initial form of `rv (b * c)` is the product of those of the initial forms of `rv b` and +`rv c`, because `rv` and the initial-form map are monoid homomorphisms. -/ +private theorem gradedNormalizedMaximalFiniteSupportDivisor_rvInitialForm_mul + (hgradedMul : ∀ B C : DegreeGraded K, + gradedNormalizedMaximalFiniteSupportDivisor (B * C) = + gradedNormalizedMaximalFiniteSupportDivisor B * + gradedNormalizedMaximalFiniteSupportDivisor C) + (b c : Series K) : + gradedNormalizedMaximalFiniteSupportDivisor + ((degreeValuation K).rvInitialFormHom ((degreeValuation K).rv (b * c))) = + gradedNormalizedMaximalFiniteSupportDivisor + ((degreeValuation K).rvInitialFormHom ((degreeValuation K).rv b)) * + gradedNormalizedMaximalFiniteSupportDivisor + ((degreeValuation K).rvInitialFormHom ((degreeValuation K).rv c)) := by + rw [map_mul, map_mul] + exact hgradedMul _ _ + +/-- The inductive step: the product of two finite-support-primitive series is finite-support +primitive, given multiplicativity of the normalized maximal divisor for pairs of strictly +smaller degree on either side. A factor of degree at most `0` is a unit and drops out. Otherwise +each factor is approximated by its leading-RV normalized maximal divisor with a remainder of +smaller degree; a finite-support divisor `q` of the product is coprime to both approximating +divisors and divides their product, so it is a unit. -/ +private theorem isFiniteSupportPrimitive_mul_of_induction + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hgradedMul : ∀ B C : DegreeGraded K, + gradedNormalizedMaximalFiniteSupportDivisor (B * C) = + gradedNormalizedMaximalFiniteSupportDivisor B * + gradedNormalizedMaximalFiniteSupportDivisor C) + {b c : Series K} + (hbPrimitive : IsFiniteSupportPrimitive b) + (hcPrimitive : IsFiniteSupportPrimitive c) + (ihLeft : ∀ d : Series K, + (d : K⟦ℝ⟧).degree < (b : K⟦ℝ⟧).degree → + seriesNormalizedMaximalFiniteSupportDivisor (d * c) = + seriesNormalizedMaximalFiniteSupportDivisor d * + seriesNormalizedMaximalFiniteSupportDivisor c) + (ihRight : ∀ d : Series K, + (d : K⟦ℝ⟧).degree < (c : K⟦ℝ⟧).degree → + seriesNormalizedMaximalFiniteSupportDivisor (b * d) = + seriesNormalizedMaximalFiniteSupportDivisor b * + seriesNormalizedMaximalFiniteSupportDivisor d) : + IsFiniteSupportPrimitive (b * c) := by + classical + intro q hqbc + by_cases hbFinite : (b : K⟦ℝ⟧).degree ≤ 0 + · exact hcPrimitive q + ((isUnit_of_isFiniteSupportPrimitive_of_degree_le_zero hbPrimitive hbFinite).dvd_mul_left.mp + hqbc) + by_cases hcFinite : (c : K⟦ℝ⟧).degree ≤ 0 + · exact hbPrimitive q + ((isUnit_of_isFiniteSupportPrimitive_of_degree_le_zero hcPrimitive hcFinite).dvd_mul_right.mp + hqbc) + obtain ⟨b', hdropB⟩ := + exists_normalizedRVMaximalFiniteSupportApproximation_of_degree_pos hgcd + (lt_of_not_ge hbFinite) + obtain ⟨c', hdropC⟩ := + exists_normalizedRVMaximalFiniteSupportApproximation_of_degree_pos hgcd + (lt_of_not_ge hcFinite) + have hpBUnit : IsUnit (seriesNormalizedMaximalFiniteSupportDivisor b) := + hbPrimitive _ (seriesNormalizedMaximalFiniteSupportDivisor_dvd_of_exists_gcd hgcd b) + have hpCUnit : IsUnit (seriesNormalizedMaximalFiniteSupportDivisor c) := + hcPrimitive _ (seriesNormalizedMaximalFiniteSupportDivisor_dvd_of_exists_gcd hgcd c) + have hrelB := isRelPrime_of_dvd_mul_of_eq_mul_add hgcd hqbc hbPrimitive hpCUnit + (add_sub_cancel _ _) (ihLeft _ hdropB) + have hrelC := isRelPrime_of_dvd_mul_of_eq_mul_add hgcd (by rw [mul_comm]; exact hqbc) + hcPrimitive hpBUnit (add_sub_cancel _ _) (by rw [mul_comm, ihRight _ hdropC, mul_comm]) + have hq := dvd_gradedNormalizedMaximalFiniteSupportDivisor_rvInitialForm_of_dvd hgcd hqbc + rw [gradedNormalizedMaximalFiniteSupportDivisor_rvInitialForm_mul hgradedMul] at hq + letI : GCDMonoid (FiniteSupportRing (K := K)) := gcdMonoidOfExistsGCD hgcd + exact (hrelB.mul_right hrelC).isUnit_of_dvd hq + +/-- Multiplicativity of normalized maximal finite-support divisors of Hahn series follows from +the corresponding leading-RV multiplicativity theorem. -/ +theorem seriesNormalizedMaximalFiniteSupportDivisor_mul_of_graded + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hunits : ∀ u : FiniteSupportRing (K := K), + IsUnit u ↔ ∃ k : K, k ≠ 0 ∧ + u = finiteSupportScalarHom (G := ℝ) k) + (hgradedMul : ∀ B C : DegreeGraded K, + gradedNormalizedMaximalFiniteSupportDivisor (B * C) = + gradedNormalizedMaximalFiniteSupportDivisor B * + gradedNormalizedMaximalFiniteSupportDivisor C) + (b c : Series K) : + seriesNormalizedMaximalFiniteSupportDivisor (b * c) = + seriesNormalizedMaximalFiniteSupportDivisor b * + seriesNormalizedMaximalFiniteSupportDivisor c := by + classical + let degreePair : Series K × Series K → + WithBot NatOrdinal × WithBot NatOrdinal := + fun bc ↦ ((bc.1 : K⟦ℝ⟧).degree, (bc.2 : K⟦ℝ⟧).degree) + let wf : WellFounded + (Function.onFun (Prod.Lex (· < ·) (· < ·)) degreePair) := + (wellFounded_lt.prod_lex wellFounded_lt).onFun + refine wf.induction (C := fun bc ↦ + seriesNormalizedMaximalFiniteSupportDivisor (bc.1 * bc.2) = + seriesNormalizedMaximalFiniteSupportDivisor bc.1 * + seriesNormalizedMaximalFiniteSupportDivisor bc.2) (b, c) ?_ + rintro ⟨b, c⟩ ih + change seriesNormalizedMaximalFiniteSupportDivisor (b * c) = + seriesNormalizedMaximalFiniteSupportDivisor b * + seriesNormalizedMaximalFiniteSupportDivisor c + by_cases hb : b = 0 + · subst b + rw [zero_mul, + seriesNormalizedMaximalFiniteSupportDivisor_zero_of_exists_gcd hgcd, + zero_mul] + by_cases hc : c = 0 + · subst c + rw [mul_zero, + seriesNormalizedMaximalFiniteSupportDivisor_zero_of_exists_gcd hgcd, + mul_zero] + let pB := seriesNormalizedMaximalFiniteSupportDivisor b + let pC := seriesNormalizedMaximalFiniteSupportDivisor c + have hpBMonic := seriesNormalizedMaximalFiniteSupportDivisor_isMonic_of_ne_zero hgcd hb + have hpCMonic := seriesNormalizedMaximalFiniteSupportDivisor_isMonic_of_ne_zero hgcd hc + obtain ⟨b₀, hbFactor⟩ := + seriesNormalizedMaximalFiniteSupportDivisor_dvd_of_exists_gcd hgcd b + obtain ⟨c₀, hcFactor⟩ := + seriesNormalizedMaximalFiniteSupportDivisor_dvd_of_exists_gcd hgcd c + have hb₀Degree : (b₀ : K⟦ℝ⟧).degree = (b : K⟦ℝ⟧).degree := + degree_rightFactor_eq_of_monicFiniteSupport hpBMonic hbFactor + have hc₀Degree : (c₀ : K⟦ℝ⟧).degree = (c : K⟦ℝ⟧).degree := + degree_rightFactor_eq_of_monicFiniteSupport hpCMonic hcFactor + have hb₀Primitive : IsFiniteSupportPrimitive b₀ := + isFiniteSupportPrimitive_factor_of_normalizedMaximal hgcd hb hbFactor + have hc₀Primitive : IsFiniteSupportPrimitive c₀ := + isFiniteSupportPrimitive_factor_of_normalizedMaximal hgcd hc hcFactor + have hb₀c₀Primitive : IsFiniteSupportPrimitive (b₀ * c₀) := + isFiniteSupportPrimitive_mul_of_induction hgcd hgradedMul + hb₀Primitive hc₀Primitive + (fun d hd ↦ ih (d, c₀) (by + change Prod.Lex (· < ·) (· < ·) + ((d : K⟦ℝ⟧).degree, (c₀ : K⟦ℝ⟧).degree) + ((b : K⟦ℝ⟧).degree, (c : K⟦ℝ⟧).degree) + exact Prod.Lex.left _ _ (hd.trans_eq hb₀Degree))) + (fun d hd ↦ ih (b₀, d) (by + change Prod.Lex (· < ·) (· < ·) + ((b₀ : K⟦ℝ⟧).degree, (d : K⟦ℝ⟧).degree) + ((b : K⟦ℝ⟧).degree, (c : K⟦ℝ⟧).degree) + rw [hb₀Degree] + exact Prod.Lex.right _ (hd.trans_eq hc₀Degree))) + let pBC := seriesNormalizedMaximalFiniteSupportDivisor (b * c) + have hpProdDvd : pB * pC ∣ pBC := by + exact seriesNormalizedMaximalFiniteSupportDivisor_mul_dvd_of_exists_gcd hgcd b c + obtain ⟨r, hr⟩ := hpProdDvd + have hpBCDvd : (pBC : Series K) ∣ b * c := + seriesNormalizedMaximalFiniteSupportDivisor_dvd_of_exists_gcd hgcd (b * c) + have hleft : + ((pB * pC * r : FiniteSupportRing (K := K)) : Series K) = + (((pB * pC : FiniteSupportRing (K := K)) : Series K) * + (r : Series K)) := by + simp only [Subring.coe_mul] + have hright : + b * c = + ((pB * pC : FiniteSupportRing (K := K)) : Series K) * (b₀ * c₀) := by + rw [hbFactor, hcFactor] + simp only [Subring.coe_mul] + ring + have hrDiv : (r : Series K) ∣ b₀ * c₀ := by + have hdiv : + ((pB * pC * r : FiniteSupportRing (K := K)) : Series K) ∣ b * c := by + rw [← hr] + exact hpBCDvd + rw [hleft, hright] at hdiv + apply (mul_dvd_mul_iff_left ?_).mp hdiv + exact (map_ne_zero_iff + (finiteSupportSubring (G := ℝ) (K := K)).subtype + (finiteSupportSubring (G := ℝ) (K := K)).subtype_injective).mpr + (mul_ne_zero hpBMonic.ne_zero hpCMonic.ne_zero) + have hrUnit : IsUnit r := hb₀c₀Primitive r hrDiv + have hmaxBC := (isNormalizedSeriesMaximalFiniteSupportDivisor_iff + (b * c) pBC).mp + (seriesNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd (b * c)) + apply seriesNormalizedMaximalFiniteSupportDivisor_eq_of_is hgcd hunits + rw [isNormalizedSeriesMaximalFiniteSupportDivisor_iff] + constructor + · intro q + rw [hmaxBC.1 q, hr, hrUnit.dvd_mul_right] + · exact Or.inr ⟨mul_ne_zero hb hc, hpBMonic.mul hpCMonic⟩ + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesPrimality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesPrimality.lean new file mode 100644 index 0000000000..f37c004b2a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesPrimality.lean @@ -0,0 +1,87 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite + +import Mathlib.Algebra.GCDMonoid.Basic + +/-! +# Primality of finite-support elements in the Hahn-series ring + +This module proves the field-generic reduction underlying LM24, Corollary 6.3.9. The stronger +theorem retains both factors inside the finite-support subring. Primality of their images in the +Hahn-series ring is derived from that witness theorem. +-/ + +open scoped HahnSeries + +universe v + +namespace Berarducci + +public noncomputable section + +open HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +/-- A finite-support divisor of a product of Hahn series factors into finite-support divisors of +the two factors, assuming multiplicativity of normalized maximal finite-support divisors. -/ +theorem finiteSupportSeries_exists_factor_dvd_of_maximalMultiplicative + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hmaxMul : ∀ b c : Series K, + seriesNormalizedMaximalFiniteSupportDivisor (b * c) = + seriesNormalizedMaximalFiniteSupportDivisor b * + seriesNormalizedMaximalFiniteSupportDivisor c) + (p : FiniteSupportRing (K := K)) (b c : Series K) + (hp : (p : Series K) ∣ b * c) : + ∃ p₁ p₂ : FiniteSupportRing (K := K), + p = p₁ * p₂ ∧ (p₁ : Series K) ∣ b ∧ (p₂ : Series K) ∣ c := by + classical + have hmaxBC := (isNormalizedSeriesMaximalFiniteSupportDivisor_iff + (b * c) (seriesNormalizedMaximalFiniteSupportDivisor (b * c))).mp + (seriesNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd (b * c)) + have hpMax : p ∣ seriesNormalizedMaximalFiniteSupportDivisor (b * c) := + (hmaxBC.1 p).mp hp + rw [hmaxMul b c] at hpMax + letI : GCDMonoid (FiniteSupportRing (K := K)) := + gcdMonoidOfExistsGCD hgcd + obtain ⟨p₁, p₂, hp₁, hp₂, hpFactor⟩ := + exists_dvd_and_dvd_of_dvd_mul hpMax + have hmaxB := (isNormalizedSeriesMaximalFiniteSupportDivisor_iff + b (seriesNormalizedMaximalFiniteSupportDivisor b)).mp + (seriesNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd b) + have hmaxC := (isNormalizedSeriesMaximalFiniteSupportDivisor_iff + c (seriesNormalizedMaximalFiniteSupportDivisor c)).mp + (seriesNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd c) + exact ⟨p₁, p₂, hpFactor, + (hmaxB.1 p₁).mpr hp₁, (hmaxC.1 p₂).mpr hp₂⟩ + +/-- Every finite-support element is primal in the Hahn-series ring under the same explicit +prerequisites. -/ +theorem finiteSupportSeries_isPrimal_of_maximalMultiplicative + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hmaxMul : ∀ b c : Series K, + seriesNormalizedMaximalFiniteSupportDivisor (b * c) = + seriesNormalizedMaximalFiniteSupportDivisor b * + seriesNormalizedMaximalFiniteSupportDivisor c) + (p : FiniteSupportRing (K := K)) : + IsPrimal (p : Series K) := by + intro b c hp + obtain ⟨p₁, p₂, hpFactor, hp₁, hp₂⟩ := + finiteSupportSeries_exists_factor_dvd_of_maximalMultiplicative hgcd hmaxMul p b c hp + refine ⟨(p₁ : Series K), (p₂ : Series K), hp₁, hp₂, ?_⟩ + exact congrArg + (finiteSupportSubring (G := ℝ) (K := K)).subtype hpFactor + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements.lean new file mode 100644 index 0000000000..d751e3ece9 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements.lean @@ -0,0 +1,19 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.Factorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.FiniteSupportFactorUniqueness +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteSupportDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalDivisibilityReflection +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalMaximalDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalScalarRedistribution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringFraction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesMaximalFiniteSupportDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesPrimality + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/Factorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/Factorization.lean new file mode 100644 index 0000000000..fae37c9b55 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/Factorization.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeTermCount + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.InfiniteSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree + +/-! +# LM24 factorisation statement + +This module gives the exact public signature of LM24, Proposition 5.6.1 for `K((ℝ^{≤ 0}))`. +A list represents the finite sequence `c₁, …, cₙ` from the paper, and its length is `n`. Every +list member is irreducible and has infinite support. The list length is bounded by the number of +terms in the uncompressed Cantor normal form of the degree. + +The first theorem retains the derived fact that the coefficient scalar is nonzero. The second +theorem has exactly the conclusion printed in Proposition 5.6.1. Both retain the normalized +maximal finite-support divisor `p(b)` from LM24, Notation 5.5.2. + +The proofs combine Berarducci multiplicativity, the finite-support greatest-common-divisor and +unit-classification theorems, Cantor-term arithmetic, residual reduction, and factorisation +induction. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [hchar : CharZero K] + +include hchar in +/-- Strengthened form of LM24, Proposition 5.6.1, recording that the coefficient scalar is +nonzero. -/ +theorem series_infinite_support_factorization_with_nonzero_scalar {b : Series K} (hb : b ≠ 0) : + ∃ (factors : List (Series K)) (k : K), + k ≠ 0 ∧ + b = HahnSeries.Nonpositive.C k * + (seriesNormalizedMaximalFiniteSupportDivisor b : Series K) * + factors.prod ∧ + (∀ c ∈ factors, + Irreducible c ∧ (c : K⟦ℝ⟧).support.Infinite) ∧ + factors.length ≤ HahnSeries.degreeCantorTermCount (b : K⟦ℝ⟧) := by + obtain ⟨k, factors, hk, hfactor, hfactors, hbound⟩ := + exists_series_infinite_support_factorization_of_exists_gcd + (HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K)) + (HahnSeries.Nonpositive.isUnit_finiteSupport_iff_exists_scalar + (G := ℝ) (K := K)) hb + exact ⟨factors, k, hk, hfactor, hfactors, hbound⟩ + +include hchar in +/-- LM24, Proposition 5.6.1: every nonzero series is a scalar times its normalized maximal +finite-support divisor and finitely many irreducible infinite-support series, with the number of +such factors bounded by the Cantor term count of its degree. -/ +theorem series_infinite_support_factorization {b : Series K} (hb : b ≠ 0) : + ∃ (factors : List (Series K)) (k : K), + b = HahnSeries.Nonpositive.C k * + (seriesNormalizedMaximalFiniteSupportDivisor b : Series K) * + factors.prod ∧ + (∀ c ∈ factors, + Irreducible c ∧ (c : K⟦ℝ⟧).support.Infinite) ∧ + factors.length ≤ HahnSeries.degreeCantorTermCount (b : K⟦ℝ⟧) := by + obtain ⟨factors, k, _, hfactor, hfactors, hbound⟩ := + series_infinite_support_factorization_with_nonzero_scalar hb + exact ⟨factors, k, hfactor, hfactors, hbound⟩ + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/FiniteSupportFactorUniqueness.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/FiniteSupportFactorUniqueness.lean new file mode 100644 index 0000000000..b3dcc145ec --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/FiniteSupportFactorUniqueness.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.FiniteSupportFactorUniqueness + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteMultiplicativity + +/-! +# LM24 uniqueness of the finite-support factor + +This module states LM24, Theorem 6.4.1. For each nonzero series, it gives one finite-support +factor and finitely many irreducible infinite-support factors. The number of infinite-support +factors is bounded by the number of terms in the Cantor normal form of the degree. Only the +finite-support factor is asserted to be unique, and only up to multiplication by a nonzero +coefficient scalar. + +The list represents the source sequence `c₁, …, cₙ`; its length is the source natural number +`n`. The proof combines LM24, Proposition 5.6.1 and Proposition 6.3.8. +-/ + +open scoped HahnSeries + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [CharZero K] + +/-- LM24, Theorem 6.4.1: every nonzero series factors into one finite-support factor and a +bounded finite list of irreducible infinite-support factors, and the finite-support factor is +unique up to multiplication by a nonzero coefficient scalar. -/ +theorem series_factorization_with_unique_finiteSupportFactor {b : Series K} (hb : b ≠ 0) : + ∃ (p : FiniteSupportRing (K := K)) (factors : List (Series K)), + IsInfiniteSupportIrreducibleFactorization b p factors ∧ + factors.length ≤ HahnSeries.degreeCantorTermCount (b : K⟦ℝ⟧) ∧ + IsUniqueFiniteSupportFactorUpToScalar b p := by + let hgcd := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K) + let hunits := HahnSeries.Nonpositive.isUnit_finiteSupport_iff_exists_scalar + (G := ℝ) (K := K) + exact exists_factorization_with_unique_finiteSupportFactor hgcd hunits + (seriesMaximalFiniteSupportDivisor_mul (K := K)) hb + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/MaximalFiniteMultiplicativity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/MaximalFiniteMultiplicativity.lean new file mode 100644 index 0000000000..3ffc8a4580 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/MaximalFiniteMultiplicativity.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFiniteMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringPrimality + +/-! +# LM24 multiplicativity of maximal finite-support divisors + +This module states LM24, Corollary 6.3.7. The normalized maximal finite-support divisor of a +product in `RV̂` is the product of the two normalized maximal finite-support divisors. + +The proof applies the finite-support factor witness from Corollary 6.3.6 to the generic +normalization argument. + +Both statements assume only that the coefficient field has characteristic zero; Proposition +6.3.8 below has the printed signature on Hahn series. +-/ + +open scoped HahnSeries + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [hchar : CharZero K] + +include hchar in +/-- LM24, Corollary 6.3.7: the normalized maximal finite-support divisor is multiplicative on +the degree-graded ring `RV̂`. -/ +theorem maximalFiniteSupportDivisor_mul (B C : DegreeGraded K) : + gradedNormalizedMaximalFiniteSupportDivisor (B * C) = + gradedNormalizedMaximalFiniteSupportDivisor B * + gradedNormalizedMaximalFiniteSupportDivisor C := by + let hgcd := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K) + let hunits := HahnSeries.Nonpositive.isUnit_finiteSupport_iff_exists_scalar + (G := ℝ) (K := K) + apply gradedNormalizedMaximalFiniteSupportDivisor_mul_of_factorization hgcd hunits + intro p X Y hp + exact finiteSupportGradedEmbedding_exists_factor_dvd p X Y hp + +include hchar in +/-- LM24, Proposition 6.3.8: the normalized maximal finite-support divisor is multiplicative on +the Hahn-series ring `K((ℝ^{≤ 0}))`. -/ +theorem seriesMaximalFiniteSupportDivisor_mul (b c : Series K) : + seriesNormalizedMaximalFiniteSupportDivisor (b * c) = + seriesNormalizedMaximalFiniteSupportDivisor b * + seriesNormalizedMaximalFiniteSupportDivisor c := by + let hgcd := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K) + let hunits := HahnSeries.Nonpositive.isUnit_finiteSupport_iff_exists_scalar + (G := ℝ) (K := K) + exact seriesNormalizedMaximalFiniteSupportDivisor_mul_of_graded hgcd hunits + maximalFiniteSupportDivisor_mul b c + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/MaximalFiniteSupportDivisor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/MaximalFiniteSupportDivisor.lean new file mode 100644 index 0000000000..98bb8b0b53 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/MaximalFiniteSupportDivisor.lean @@ -0,0 +1,204 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof + +/-! +# LM24 maximal finite-support divisor statements + +This module gives representative-valued statements of LM24, Proposition 5.4.3 and Corollary +5.4.4. The proved core first constructs the maximal divisor intrinsically in the associates of +the finite-support ring. Here LM24, Fact 2.5.2 is used only to supply pairwise gcds and to identify +the units with nonzero constant series. + +The proposition is stated in the multiplicative RV quotient, whereas the corollary is stated in +the full degree-graded ring. These two divisibility relations are not conflated. +The proofs use Berarducci ordinal-value multiplicativity. Degree multiplicativity is an explicit +hypothesis. +-/ + +open scoped DirectSum HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] [CharZero K] + +private theorem rv_representative_spec_and_uniqueness (B : HahnDegreeRV K) + (p : FiniteSupportRing (K := K)) + (hp : IsRVMaximalFiniteSupportDivisor B (Associates.mk p)) : + (∀ q : FiniteSupportRing (K := K), + finiteSupportRVEmbedding K q ∣ B ↔ q ∣ p) ∧ + ∀ p' : FiniteSupportRing (K := K), + (∀ q : FiniteSupportRing (K := K), + finiteSupportRVEmbedding K q ∣ B ↔ q ∣ p') → + ∃ k : K, k ≠ 0 ∧ + p' = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k * p := by + have hpSpec := + (isRVMaximalFiniteSupportDivisor_mk_iff B p).mp hp + refine ⟨hpSpec, ?_⟩ + intro p' hp'Spec + have hp' := + (isRVMaximalFiniteSupportDivisor_mk_iff B p').mpr hp'Spec + exact HahnSeries.Nonpositive.exists_nonzero_scalar_mul_of_mk_eq_mk + (HahnSeries.Nonpositive.isUnit_finiteSupport_iff_exists_scalar + (G := ℝ) (K := K)) + (IsRVMaximalFiniteSupportDivisor.eq hp hp') + +/-- LM24, Proposition 5.4.3: every RV class has a finite-support series with exactly the same +finite-support divisors. It is unique up to a nonzero scalar and can be chosen constant when the +RV class is principal. -/ +theorem rv_maximal_finite_support_divisor (B : HahnDegreeRV K) : + ∃ p : FiniteSupportRing (K := K), + (∀ q : FiniteSupportRing (K := K), + finiteSupportRVEmbedding K q ∣ B ↔ q ∣ p) ∧ + (∀ p' : FiniteSupportRing (K := K), + (∀ q : FiniteSupportRing (K := K), + finiteSupportRVEmbedding K q ∣ B ↔ q ∣ p') → + ∃ k : K, k ≠ 0 ∧ + p' = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k * p) ∧ + (IsPrincipalRV B → + ∃ k : K, + p = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k) := by + let hgcd := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K) + by_cases hBPrincipal : IsPrincipalRV B + · obtain ⟨k, hk⟩ := + exists_scalar_isRVMaximalFiniteSupportDivisor_of_isPrincipal B hBPrincipal + obtain ⟨hkSpec, hkUnique⟩ := + rv_representative_spec_and_uniqueness B + (HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k) hk + exact ⟨HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k, + hkSpec, hkUnique, fun _ ↦ ⟨k, rfl⟩⟩ + · obtain ⟨a, ha, _⟩ := + existsUnique_isRVMaximalFiniteSupportDivisor_of_exists_gcd hgcd B + induction a using Quotient.inductionOn with + | _ p => + obtain ⟨hpSpec, hpUnique⟩ := + rv_representative_spec_and_uniqueness B p ha + exact ⟨p, hpSpec, hpUnique, fun hB ↦ (hBPrincipal hB).elim⟩ + +omit [CharZero K] in +private theorem graded_representative_spec_and_uniqueness (B : DegreeGraded K) + (p : FiniteSupportRing (K := K)) + (hp : IsGradedMaximalFiniteSupportDivisor B (Associates.mk p)) : + (∀ q : FiniteSupportRing (K := K), + finiteSupportGradedEmbedding K q ∣ B ↔ q ∣ p) ∧ + ∀ p' : FiniteSupportRing (K := K), + (∀ q : FiniteSupportRing (K := K), + finiteSupportGradedEmbedding K q ∣ B ↔ q ∣ p') → + ∃ k : K, k ≠ 0 ∧ + p' = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k * p := by + have hpSpec := + (isGradedMaximalFiniteSupportDivisor_mk_iff B p).mp hp + refine ⟨hpSpec, ?_⟩ + intro p' hp'Spec + have hp' := + (isGradedMaximalFiniteSupportDivisor_mk_iff B p').mpr hp'Spec + exact HahnSeries.Nonpositive.exists_nonzero_scalar_mul_of_mk_eq_mk + (HahnSeries.Nonpositive.isUnit_finiteSupport_iff_exists_scalar + (G := ℝ) (K := K)) + (IsGradedMaximalFiniteSupportDivisor.eq hp hp') + +/-- LM24, Corollary 5.4.4: every element of the full associated graded ring has a finite-support +series with exactly the same finite-support divisors, unique up to a nonzero scalar. -/ +theorem graded_maximal_finite_support_divisor (B : DegreeGraded K) : + ∃ p : FiniteSupportRing (K := K), + (∀ q : FiniteSupportRing (K := K), + finiteSupportGradedEmbedding K q ∣ B ↔ q ∣ p) ∧ + ∀ p' : FiniteSupportRing (K := K), + (∀ q : FiniteSupportRing (K := K), + finiteSupportGradedEmbedding K q ∣ B ↔ q ∣ p') → + ∃ k : K, k ≠ 0 ∧ + p' = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k * p := by + let hgcd := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K) + obtain ⟨a, ha, _⟩ := + existsUnique_isGradedMaximalFiniteSupportDivisor_of_exists_gcd hgcd B + induction a using Quotient.inductionOn with + | _ p => + obtain ⟨hpSpec, hpUnique⟩ := + graded_representative_spec_and_uniqueness B p ha + exact ⟨p, hpSpec, hpUnique⟩ + +/-- LM24, Notation 5.4.5: there is exactly one maximal finite-support divisor that is zero for +the zero graded element and monic for every nonzero graded element. -/ +theorem existsUnique_normalized_maximal_finite_support_divisor (B : DegreeGraded K) : + ∃! p : FiniteSupportRing (K := K), + IsNormalizedGradedMaximalFiniteSupportDivisor B p := by + let hgcd := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K) + let hunits := HahnSeries.Nonpositive.isUnit_finiteSupport_iff_exists_scalar + (G := ℝ) (K := K) + refine ⟨gradedNormalizedMaximalFiniteSupportDivisor B, ?_, ?_⟩ + · exact gradedNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd B + · intro p hp + exact (gradedNormalizedMaximalFiniteSupportDivisor_eq_of_is hgcd hunits hp).symm + +/-- The normalized maximal finite-support divisor satisfies its source-level defining +predicate. -/ +theorem maximalFiniteSupportDivisor_is (B : DegreeGraded K) : + IsNormalizedGradedMaximalFiniteSupportDivisor B + (gradedNormalizedMaximalFiniteSupportDivisor B) := by + let hgcd := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K) + exact gradedNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd B + +/-- LM24, Remark 5.4.6: the maximal finite-support divisor embeds as a divisor of the graded +element. -/ +theorem maximalFiniteSupportDivisor_dvd (B : DegreeGraded K) : + finiteSupportGradedEmbedding K + (gradedNormalizedMaximalFiniteSupportDivisor B) ∣ B := by + have h := (isNormalizedGradedMaximalFiniteSupportDivisor_iff B + (gradedNormalizedMaximalFiniteSupportDivisor B)).mp + (maximalFiniteSupportDivisor_is B) + exact (h.1 (gradedNormalizedMaximalFiniteSupportDivisor B)).mpr dvd_rfl + +variable (K) in +/-- The maximal finite-support divisor of zero is zero. -/ +@[simp] +theorem maximalFiniteSupportDivisor_zero : + gradedNormalizedMaximalFiniteSupportDivisor + (0 : DegreeGraded K) = 0 := by + have hspec := (isNormalizedGradedMaximalFiniteSupportDivisor_iff (0 : DegreeGraded + K) + (gradedNormalizedMaximalFiniteSupportDivisor 0)).mp + (maximalFiniteSupportDivisor_is 0) + rcases hspec.2 with h | h + · exact h.2 + · exact (h.1 rfl).elim + +/-- The maximal finite-support divisor of a nonzero graded element is monic. -/ +theorem maximalFiniteSupportDivisor_isMonic {B : DegreeGraded K} (hB : B ≠ 0) : + HahnSeries.Nonpositive.IsMonicFiniteSupport + (gradedNormalizedMaximalFiniteSupportDivisor B) := by + have hspec := (isNormalizedGradedMaximalFiniteSupportDivisor_iff B + (gradedNormalizedMaximalFiniteSupportDivisor B)).mp + (maximalFiniteSupportDivisor_is B) + rcases hspec.2 with h | h + · exact (hB h.1).elim + · exact h.2 + +/-- LM24, Proposition 5.4.8: the product of the two normalized maximal finite-support divisors +divides the normalized maximal finite-support divisor of the product. -/ +theorem maximalFiniteSupportDivisor_mul_dvd (B C : DegreeGraded K) : + gradedNormalizedMaximalFiniteSupportDivisor B * + gradedNormalizedMaximalFiniteSupportDivisor C ∣ + gradedNormalizedMaximalFiniteSupportDivisor (B * C) := by + let hgcd := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K) + exact gradedNormalizedMaximalFiniteSupportDivisor_mul_dvd_of_exists_gcd hgcd B C + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalDivisibilityReflection.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalDivisibilityReflection.lean new file mode 100644 index 0000000000..7d7e600430 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalDivisibilityReflection.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalScalarRedistribution + +/-! +# Divisibility reflection over the principal graded fraction field + +This module states LM24, Remark 6.3.5. Under the identification from Remark 6.1.3, coefficient +extension embeds `K(ℝ^{≤0})` in `Frac(P̂)(ℝ^{≤0})`. An extended finite-support series +divides another extended series if and only if the corresponding divisibility already holds over +`K`. + +The reverse implication uses Lemma 6.3.4 to redistribute a nonzero fraction-field scalar. A +nonzero coefficient of the first factor then forces that scalar to belong to `K`. +-/ + +open scoped HahnSeries + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [CharZero K] + +/-- LM24, Remark 6.3.5: coefficient extension from `K(ℝ^{≤0})` to +`Frac(P̂)(ℝ^{≤0})` reflects divisibility. -/ +theorem principalSubringFractionScalarExtension_dvd_iff + (p q : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)) : + principalSubringFractionScalarExtension K p ∣ + principalSubringFractionScalarExtension K q ↔ + p ∣ q := by + apply principalSubringFractionScalarExtension_dvd_iff_of_scalarRedistribution ?_ p q + intro p₁ p₂ hp₁ hp₂ hprod + exact principalSubringFraction_exists_scalarRedistribution hp₁ hp₂ hprod + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalMaximalDivisor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalMaximalDivisor.lean new file mode 100644 index 0000000000..532d5d58f9 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalMaximalDivisor.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalMaximalFinite +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof + +/-! +# LM24 principal-factor invariance statements + +This module states LM24, Lemmas 6.3.1--6.3.2. The first lemma concerns the multiplicative RV +quotient and the paper's set `P` of principal RV classes. The second concerns the full +degree-graded ring `RV̂` and the principal graded subring `P̂`. In both cases multiplication +by a nonzero principal factor preserves the normalized maximal finite-support divisor. + +The RV notation `p(B)` is represented by applying the full graded normalization to the canonical +graded image of `B`. The proofs use Berarducci multiplicativity and finite-support +greatest-common divisors. +-/ + +open scoped DirectSum HahnSeries NatOrdinal + +universe v + +namespace Berarducci + +public noncomputable section + +open HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +/-- LM24, Lemma 6.3.1: multiplying an RV class by a nonzero principal RV class does not change +its normalized maximal finite-support divisor. -/ +theorem maximalFiniteSupportDivisor_rv_mul_principal (B C : HahnDegreeRV K) + (hC : IsPrincipalRV C) (hC0 : C ≠ 0) : + gradedNormalizedMaximalFiniteSupportDivisor + ((degreeValuation K).rvInitialFormHom (B * C)) = + gradedNormalizedMaximalFiniteSupportDivisor + ((degreeValuation K).rvInitialFormHom B) := by + let hgcd := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K) + exact + gradedNormalizedMaximalFiniteSupportDivisor_rv_mul_principal_eq_of_exists_gcd hgcd B hC hC0 + +/-- LM24, Lemma 6.3.2: multiplying a full graded element by a nonzero element of the principal +graded subring does not change its normalized maximal finite-support divisor. -/ +theorem maximalFiniteSupportDivisor_mul_principal (B C : DegreeGraded K) + (hC : IsPrincipalGraded C) (hC0 : C ≠ 0) : + gradedNormalizedMaximalFiniteSupportDivisor (B * C) = + gradedNormalizedMaximalFiniteSupportDivisor B := by + let hgcd := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K) + exact gradedNormalizedMaximalFiniteSupportDivisor_mul_principal_eq_of_exists_gcd hgcd B hC hC0 + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalScalarRedistribution.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalScalarRedistribution.lean new file mode 100644 index 0000000000..790127e279 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalScalarRedistribution.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringScalarRedistributionProof +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringFraction + +/-! +# Scalar redistribution over the principal graded fraction field + +This module states LM24, Lemma 6.3.4. For nonzero finite-support series `p₁` and `p₂` over +`Frac(P̂)` whose product has coefficients in `K`, a nonzero coefficient `B ∈ Frac(P̂)` can be +moved from one factor to the other so that both resulting series have coefficients in `K`. + +The rendered statement writes `B⁻¹`, which conventionally presupposes `B ≠ 0`. Because +inversion is total in Lean, the theorem records that condition explicitly. The final theorem proves +that the formula without this condition is satisfied by `B = 0` for arbitrary inputs; it is a +regression theorem, not the mathematical content of Lemma 6.3.4. +-/ + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [CharZero K] + +/-- LM24, Lemma 6.3.4, with the conventional nonzeroness of the inverted coefficient made +explicit. -/ +theorem principalSubringFraction_exists_scalarRedistribution + {p₁ p₂ : PrincipalSubringFractionFiniteSupportRing K} + (hp₁ : p₁ ≠ 0) (hp₂ : p₂ ≠ 0) + (hprod : p₁ * p₂ ∈ principalSubringFractionCoefficientSubring K) : + ∃ B : PrincipalSubringFractionField K, + B ≠ 0 ∧ + p₁ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B ∈ + principalSubringFractionCoefficientSubring K ∧ + p₂ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B⁻¹ ∈ + principalSubringFractionCoefficientSubring K := by + apply principalSubringFraction_exists_scalarRedistribution_of_isRelativelyAlgebraicallyClosed + (isRelativelyAlgebraicallyClosed_principalGradedFractionField K) + hp₁ hp₂ hprod + +/-- If the nonzeroness of the inverted coefficient is omitted, Lean's total inverse makes the +displayed conclusion hold for arbitrary factors by taking the coefficient to be zero. -/ +theorem principalSubringFraction_exists_literalTotalInverseScalarRedistribution + (p₁ p₂ : PrincipalSubringFractionFiniteSupportRing K) : + ∃ B : PrincipalSubringFractionField K, + p₁ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B ∈ + principalSubringFractionCoefficientSubring K ∧ + p₂ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B⁻¹ ∈ + principalSubringFractionCoefficientSubring K := by + refine ⟨0, ?_, ?_⟩ <;> simp + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalSubringFraction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalSubringFraction.lean new file mode 100644 index 0000000000..58ea62eca8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalSubringFraction.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFraction +public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.RelativeAlgebraicClosure + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFractionAlgebraic + +/-! +# Relative algebraic closure in the principal graded fraction field + +This module states LM24, Lemma 6.3.3: the coefficient field is relatively algebraically closed in +the fraction field of `P̂`. Equivalently, every element of `Frac(P̂)` that is +algebraic over `K` already belongs to the image of `K`. The coefficient field has characteristic +zero, which supplies the ordinal-value multiplicativity behind the ring structure on the intrinsic +ring `P̂`. + +The proof reduces to the minimal-polynomial bound for a nonzero algebraic fraction, which is +established in the Berarducci development. +-/ + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [CharZero K] + +variable (K) in +/-- LM24, Lemma 6.3.3: `K` is relatively algebraically closed in `Frac(P̂)`. -/ +theorem isRelativelyAlgebraicallyClosed_principalGradedFractionField : + @Algebra.IsRelativelyAlgebraicallyClosed K + (PrincipalSubringFractionField K) _ _ + (principalSubringFractionAlgebra K) := by + letI := principalSubringFractionAlgebra K + apply Algebra.isRelativelyAlgebraicallyClosed_of_minpoly_natDegree_le_one + intro x hx + by_cases hx0 : x = 0 + · subst x + simp + · exact principalSubringFraction_minpoly_natDegree_le_one_of_ne_zero x hx hx0 + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalSubringPrimality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalSubringPrimality.lean new file mode 100644 index 0000000000..ddb2e39abf --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalSubringPrimality.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalScalarRedistribution + +/-! +# LM24 primality in the degree-graded ring + +This module states LM24, Corollary 6.3.6. In the degree-graded ring `RV̂`, every +finite-support series is primal. The stronger witness theorem retains the two primal factors as +elements of `K(ℝ^{≤0})`; the source-level primality statement is derived from it. + +The proof depends only on the finite-support greatest-common-divisor and scalar-redistribution +prerequisites, both proved over the real exponents, and on the characteristic-zero hypothesis +that supplies ordinal-value and degree multiplicativity. +-/ + +open scoped HahnSeries + +universe v + +namespace Berarducci + +public noncomputable section + +open HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [hchar : CharZero K] + +include hchar in +/-- The factor-witness form of LM24, Corollary 6.3.6: the two factors of `p` remain +finite-support series over `K`. -/ +theorem finiteSupportGradedEmbedding_exists_factor_dvd (p : FiniteSupportRing (K := K)) + (B C : DegreeGraded K) + (hp : finiteSupportGradedEmbedding K p ∣ B * C) : + ∃ p₁ p₂ : FiniteSupportRing (K := K), + p = p₁ * p₂ ∧ + finiteSupportGradedEmbedding K p₁ ∣ B ∧ + finiteSupportGradedEmbedding K p₂ ∣ C := by + let hgcdK := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K) + let hgcdL := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := PrincipalSubringFractionField K) + let hredistribute : PrincipalSubringFractionScalarRedistribution K := + ⟨fun hp₁ hp₂ hprod ↦ + principalSubringFraction_exists_scalarRedistribution hp₁ hp₂ hprod⟩ + exact finiteSupportGradedEmbedding_exists_factor_dvd_of_scalarRedistribution hgcdK hgcdL + hredistribute p B C hp + +include hchar in +/-- LM24, Corollary 6.3.6: every finite-support series is primal in `RV̂`. -/ +theorem finiteSupportGradedEmbedding_isPrimal (p : FiniteSupportRing (K := K)) : + IsPrimal (finiteSupportGradedEmbedding K p) := by + intro B C hp + obtain ⟨p₁, p₂, hpFactors, hp₁, hp₂⟩ := + finiteSupportGradedEmbedding_exists_factor_dvd p B C hp + refine ⟨finiteSupportGradedEmbedding K p₁, + finiteSupportGradedEmbedding K p₂, hp₁, hp₂, ?_⟩ + rw [hpFactors, map_mul] + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/SeriesMaximalFiniteSupportDivisor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/SeriesMaximalFiniteSupportDivisor.lean new file mode 100644 index 0000000000..ce99f480a8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/SeriesMaximalFiniteSupportDivisor.lean @@ -0,0 +1,156 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof + +/-! +# LM24 series-level maximal finite-support divisor statements + +This module states LM24, Proposition 5.5.1, Notation 5.5.2, Remark 5.5.3, and Proposition 5.5.5 +for the ring `K((ℝ^{≤ 0}))`. Proposition 5.5.1 is the bidirectional assertion + +`(q : K((ℝ^{≤ 0}))) ∣ b ↔ q ∣ p` + +for every finite-support `q`; its uniqueness clause is multiplication by a nonzero coefficient. +The notation is represented by the monic finite-support series +`seriesNormalizedMaximalFiniteSupportDivisor b`, with zero fixed separately. + +The theorem proofs use LM24, Fact 2.5.2 and Berarducci ordinal-value multiplicativity; the +coefficient field has characteristic zero. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [CharZero K] + +omit [CharZero K] in +private theorem series_representative_spec_and_uniqueness + (b : Series K) (p : FiniteSupportRing (K := K)) + (hp : IsSeriesMaximalFiniteSupportDivisor b (Associates.mk p)) : + (∀ q : FiniteSupportRing (K := K), (q : Series K) ∣ b ↔ q ∣ p) ∧ + ∀ p' : FiniteSupportRing (K := K), + (∀ q : FiniteSupportRing (K := K), (q : Series K) ∣ b ↔ q ∣ p') → + ∃ k : K, k ≠ 0 ∧ + p' = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k * p := by + have hpSpec := (isSeriesMaximalFiniteSupportDivisor_mk_iff b p).mp hp + refine ⟨hpSpec, ?_⟩ + intro p' hp'Spec + have hp' := (isSeriesMaximalFiniteSupportDivisor_mk_iff b p').mpr hp'Spec + exact HahnSeries.Nonpositive.exists_nonzero_scalar_mul_of_mk_eq_mk + (HahnSeries.Nonpositive.isUnit_finiteSupport_iff_exists_scalar + (G := ℝ) (K := K)) + (hp.eq hp') + +/-- LM24, Proposition 5.5.1: every Hahn series has a finite-support series with exactly the same +finite-support divisors, unique up to multiplication by a nonzero coefficient. -/ +theorem series_maximal_finite_support_divisor (b : Series K) : + ∃ p : FiniteSupportRing (K := K), + (∀ q : FiniteSupportRing (K := K), (q : Series K) ∣ b ↔ q ∣ p) ∧ + ∀ p' : FiniteSupportRing (K := K), + (∀ q : FiniteSupportRing (K := K), (q : Series K) ∣ b ↔ q ∣ p') → + ∃ k : K, k ≠ 0 ∧ + p' = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k * p := by + let hgcd := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K) + obtain ⟨a, ha, _⟩ := + existsUnique_isSeriesMaximalFiniteSupportDivisor_of_exists_gcd hgcd b + induction a using Quotient.inductionOn with + | _ p => + obtain ⟨hpSpec, hpUnique⟩ := + series_representative_spec_and_uniqueness b p ha + exact ⟨p, hpSpec, hpUnique⟩ + +/-- LM24, Notation 5.5.2: the maximal finite-support divisor has a unique representative that is +zero at zero and monic otherwise. -/ +theorem existsUnique_normalized_series_maximal_finite_support_divisor (b : Series K) : + ∃! p : FiniteSupportRing (K := K), + IsNormalizedSeriesMaximalFiniteSupportDivisor b p := by + let hgcd := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K) + let hunits := HahnSeries.Nonpositive.isUnit_finiteSupport_iff_exists_scalar + (G := ℝ) (K := K) + refine ⟨seriesNormalizedMaximalFiniteSupportDivisor b, ?_, ?_⟩ + · exact seriesNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd b + · intro p hp + exact (seriesNormalizedMaximalFiniteSupportDivisor_eq_of_is hgcd hunits hp).symm + +/-- The representative fixed by LM24, Notation 5.5.2 satisfies its defining predicate. -/ +theorem seriesNormalizedMaximalFiniteSupportDivisor_is (b : Series K) : + IsNormalizedSeriesMaximalFiniteSupportDivisor b + (seriesNormalizedMaximalFiniteSupportDivisor b) := by + let hgcd := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K) + exact seriesNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd b + +/-- LM24, Remark 5.5.3: the normalized maximal finite-support divisor divides the Hahn series. -/ +theorem seriesMaximalFiniteSupportDivisor_dvd (b : Series K) : + (seriesNormalizedMaximalFiniteSupportDivisor b : Series K) ∣ b := by + have h := (isNormalizedSeriesMaximalFiniteSupportDivisor_iff + b (seriesNormalizedMaximalFiniteSupportDivisor b)).mp + (seriesNormalizedMaximalFiniteSupportDivisor_is b) + exact (h.1 (seriesNormalizedMaximalFiniteSupportDivisor b)).mpr dvd_rfl + +variable (K) in +/-- The series-level maximal finite-support divisor of zero is zero. -/ +theorem seriesMaximalFiniteSupportDivisor_zero : + seriesNormalizedMaximalFiniteSupportDivisor (0 : Series K) = 0 := by + have h := (isNormalizedSeriesMaximalFiniteSupportDivisor_iff + (0 : Series K) (seriesNormalizedMaximalFiniteSupportDivisor 0)).mp + (seriesNormalizedMaximalFiniteSupportDivisor_is 0) + rcases h.2 with hzero | hnonzero + · exact hzero.2 + · exact (hnonzero.1 rfl).elim +/-- LM24, Remark 5.5.3: on a finite-support input, the normalized maximal divisor is a nonzero +scalar multiple of that input. -/ +theorem exists_scalar_seriesMaximalFiniteSupportDivisor_coe (p : FiniteSupportRing (K := K)) : + ∃ k : K, k ≠ 0 ∧ + seriesNormalizedMaximalFiniteSupportDivisor (p : Series K) = + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k * p := by + exact exists_scalar_seriesNormalizedMaximalFiniteSupportDivisor_coe + (HahnSeries.Nonpositive.isUnit_finiteSupport_iff_exists_scalar + (G := ℝ) (K := K)) p + +/-- LM24, Remark 5.5.3: on a finite-support input, the series-level normalized divisor +coincides with the normalized divisor from LM24, Notation 5.4.5. -/ +theorem seriesMaximalFiniteSupportDivisor_coe_eq_graded (p : FiniteSupportRing (K := K)) : + seriesNormalizedMaximalFiniteSupportDivisor (p : Series K) = + gradedNormalizedMaximalFiniteSupportDivisor + (finiteSupportGradedEmbedding K p) := by + exact seriesNormalizedMaximalFiniteSupportDivisor_coe_eq_graded p + +/-- LM24, Remark 5.5.3: the normalized maximal finite-support divisor of a principal Hahn series +is one. -/ +theorem seriesMaximalFiniteSupportDivisor_principal_eq_one + {b : Series K} (hb : HahnSeries.Nonpositive.IsPrincipal b) : + seriesNormalizedMaximalFiniteSupportDivisor b = 1 := by + exact seriesNormalizedMaximalFiniteSupportDivisor_eq_one_of_isPrincipal + (HahnSeries.Nonpositive.isUnit_finiteSupport_iff_exists_scalar + (G := ℝ) (K := K)) hb + +/-- LM24, Proposition 5.5.5: the product of the two normalized maximal finite-support divisors +divides the normalized maximal finite-support divisor of the product. -/ +theorem seriesMaximalFiniteSupportDivisor_mul_dvd (b c : Series K) : + seriesNormalizedMaximalFiniteSupportDivisor b * + seriesNormalizedMaximalFiniteSupportDivisor c ∣ + seriesNormalizedMaximalFiniteSupportDivisor (b * c) := by + exact seriesNormalizedMaximalFiniteSupportDivisor_mul_dvd_of_exists_gcd + (HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K)) b c + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/SeriesPrimality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/SeriesPrimality.lean new file mode 100644 index 0000000000..dbe224a46c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/SeriesPrimality.lean @@ -0,0 +1,89 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentTensor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import Mathlib.Algebra.Divisibility.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteMultiplicativity + +/-! +# LM24 primality in the Hahn-series ring + +This module states LM24, Corollary 6.3.9. The stronger witness theorem retains the factors of the +finite-support divisor as elements of `K(ℝ^{≤ 0})`; primality of every element of the +finite-support subring is derived from it. +-/ + +open scoped HahnSeries + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [hchar : CharZero K] + +include hchar in +/-- The factor-witness form of LM24, Corollary 6.3.9: both factors remain elements of the +finite-support subring `K(ℝ^{≤ 0})`. -/ +theorem finiteSupportSeries_exists_factor_dvd (p : FiniteSupportRing (K := K)) (b c : Series K) + (hp : (p : Series K) ∣ b * c) : + ∃ p₁ p₂ : FiniteSupportRing (K := K), + (p : Series K) = (p₁ : Series K) * (p₂ : Series K) ∧ + (p₁ : Series K) ∣ b ∧ (p₂ : Series K) ∣ c := by + let hgcd := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (G := ℝ) (K := K) + obtain ⟨p₁, p₂, hpFactor, hp₁, hp₂⟩ := + finiteSupportSeries_exists_factor_dvd_of_maximalMultiplicative hgcd + (seriesMaximalFiniteSupportDivisor_mul (K := K)) + p b c hp + refine ⟨p₁, p₂, ?_, hp₁, hp₂⟩ + exact congrArg + (HahnSeries.Nonpositive.finiteSupportSubring + (G := ℝ) (K := K)).subtype hpFactor + +end + +end Berarducci + +namespace HahnSeries.Nonpositive + +public noncomputable section + +variable {K : Type v} [Field K] [CharZero K] + +/-- Strengthened form of LM24, Corollary 6.3.9: a finite-support divisor `p` of `b * c` +has a factorisation `p = p₁ * p₂` into finite-support series with `p₁ ∣ b` and +`p₂ ∣ c`. -/ +theorem exists_finiteSupport_split_of_dvd_mul + {p b c : Nonpositive ℝ K} (hp : p ∈ finiteSupportSubring) + (hdiv : p ∣ b * c) : + ∃ p₁ p₂ : Nonpositive ℝ K, + p₁ ∈ finiteSupportSubring ∧ p₂ ∈ finiteSupportSubring ∧ + p = p₁ * p₂ ∧ p₁ ∣ b ∧ p₂ ∣ c := by + let p' : Berarducci.FiniteSupportRing (K := K) := ⟨p, hp⟩ + obtain ⟨p₁, p₂, hpFactor, hp₁, hp₂⟩ := + Berarducci.finiteSupportSeries_exists_factor_dvd p' b c hdiv + exact ⟨p₁, p₂, p₁.property, p₂.property, hpFactor, hp₁, hp₂⟩ + +/-- LM24, Corollary 6.3.9: every finite-support nonpositive real Hahn series is primal. -/ +theorem isPrimal_of_mem_finiteSupportSubring + {p : Nonpositive ℝ K} (hp : p ∈ finiteSupportSubring) : IsPrimal p := by + intro b c hdiv + obtain ⟨p₁, p₂, -, -, hpFactor, hp₁, hp₂⟩ := exists_finiteSupport_split_of_dvd_mul hp hdiv + exact ⟨p₁, p₂, hp₁, hp₂, hpFactor⟩ + +end + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests.lean new file mode 100644 index 0000000000..1819b22b2a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests.lean @@ -0,0 +1,20 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducibleFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GermLikeFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GradedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.InfiniteSupportFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.MaximalFiniteSupportDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPart +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPartMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.PrincipalMaximalFiniteSupportDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SectionSixFour +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SeriesMaximalFiniteSupportDivisor + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/AlmostIrreducible.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/AlmostIrreducible.lean new file mode 100644 index 0000000000..847f5658e7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/AlmostIrreducible.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducible + +/-! +# API checks for almost-irreducible Hahn series + +The identity fixture preserves the exact boundary omitted from the second assertion of LM24, +Remark 6.5.1: `1` is almost irreducible and has real support supremum zero, but is not +irreducible. The negative monomial `t⁻¹` exercises the strict-negative-supremum assertion over +the divisible exponent group `ℝ` and is visibly nonzero and nonconstant. +-/ + +open scoped HahnSeries + +namespace Tests + +public noncomputable section + +open HahnSeries.Nonpositive + +abbrev RealExponentSubgroup : AddSubgroup ℝ := ⊤ + +abbrev RealExponentSeries := + HahnSeries.Nonpositive RealExponentSubgroup ℚ + +noncomputable local instance : DivisibleBy RealExponentSubgroup ℤ where + div a n := ⟨DivisibleBy.div (a : ℝ) n, Set.mem_univ _⟩ + div_zero a := Subtype.ext (DivisibleBy.div_zero (a : ℝ)) + div_cancel a hn := Subtype.ext (DivisibleBy.div_cancel (a : ℝ) hn) + +/-- The printed support-supremum-zero implication in LM24, Remark 6.5.1 is false for the +multiplicative identity. -/ +theorem one_almostIrreducible_counterexample : + IsAlmostIrreducible (1 : RealExponentSeries) ∧ + realSupportSup RealExponentSubgroup (1 : RealExponentSeries) = 0 ∧ + ¬Irreducible (1 : RealExponentSeries) := + ⟨one_isAlmostIrreducible, + realSupportSup_one RealExponentSubgroup (K := ℚ), not_irreducible_one⟩ + +/-- The exponent `-1`, regarded as an element of the full real exponent subgroup. -/ +def minusOneExponent : RealExponentSubgroup := ⟨-1, Set.mem_univ _⟩ + +/-- The exponent `-1` is nonpositive. -/ +theorem minusOneExponent_nonpos : minusOneExponent ≤ 0 := by + change (-1 : ℝ) ≤ 0 + norm_num + +/-- The nonconstant monomial `t⁻¹`. -/ +def almostIrreducibleNegativeMonomial : RealExponentSeries := + single minusOneExponent 1 minusOneExponent_nonpos + +/-- The support of `t⁻¹` is exactly the singleton containing `-1`. -/ +theorem almostIrreducibleNegativeMonomial_support : + (almostIrreducibleNegativeMonomial : ℚ⟦RealExponentSubgroup⟧).support = + {minusOneExponent} := by + rw [almostIrreducibleNegativeMonomial, coe_single, + HahnSeries.support_single_of_ne one_ne_zero] + +/-- The real support supremum of `t⁻¹` is `-1`. -/ +theorem almostIrreducibleNegativeMonomial_realSupportSup : + realSupportSup RealExponentSubgroup almostIrreducibleNegativeMonomial = (-1 : ℝ) := by + rw [almostIrreducibleNegativeMonomial] + exact realSupportSup_single RealExponentSubgroup one_ne_zero + minusOneExponent_nonpos + +/-- The strict-negative-supremum clause of LM24, Remark 6.5.1 rejects the nonconstant +monomial `t⁻¹` as irreducible. -/ +theorem almostIrreducibleNegativeMonomial_not_irreducible : + ¬Irreducible almostIrreducibleNegativeMonomial := by + apply not_irreducible_of_realSupportSup_lt_zero + rw [almostIrreducibleNegativeMonomial_realSupportSup] + norm_num + +end + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/AlmostIrreducibleFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/AlmostIrreducibleFactorization.lean new file mode 100644 index 0000000000..377c59ddc0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/AlmostIrreducibleFactorization.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducibleFactorization + +/-! +# API checks for exponent-subgroup factorisation + +The scalar series `2` has a corrected factorisation with no almost irreducible factors. The same +series is not the unscaled product with normalized finite-support factor `1`, monomial exponent +`0`, and an empty factor list. This is the smallest boundary example that detects the coefficient +scalar missing from the printed formula in LM24, Theorem 6.5.7. +-/ + +open scoped HahnSeries + +namespace Tests + +public noncomputable section + +open HahnSeries.Nonpositive + +abbrev FactorizationExponentSubgroup : AddSubgroup ℝ := ⊤ + +abbrev FactorizationSeries := + HahnSeries.Nonpositive FactorizationExponentSubgroup ℚ + +/-- The zero exponent as an element of the nonpositive exponent monoid. -/ +def factorizationZeroExponent : + HahnSeries.Nonpositive.exponentMonoid FactorizationExponentSubgroup := + ⟨(0 : FactorizationExponentSubgroup), by + change (0 : FactorizationExponentSubgroup) ≤ 0 + exact le_rfl⟩ + +/-- The scalar series `2` has a corrected factorisation with an explicit coefficient scalar. -/ +theorem scalarTwo_almostIrreducibleFactorization : + IsAlmostIrreducibleFactorization + (C 2 : FactorizationSeries) (Units.mk0 2 (by norm_num)) + (1 : ConstantTermOneFiniteSupport + (G := FactorizationExponentSubgroup) (K := ℚ)) + factorizationZeroExponent [] := by + rw [isAlmostIrreducibleFactorization_iff] + constructor + · apply Subtype.ext + simp [factorizationZeroExponent, coe_finiteSupportMonomial, coe_C] + · simp + +/-- Omitting the coefficient scalar makes the corresponding empty factorisation of `2` false. -/ +theorem scalarTwo_ne_unscaled_empty_factorization : + (C 2 : FactorizationSeries) ≠ + (((1 : ConstantTermOneFiniteSupport + (G := FactorizationExponentSubgroup) (K := ℚ)) : + FiniteSupportRing (G := FactorizationExponentSubgroup) (K := ℚ)) : + FactorizationSeries) * + (finiteSupportMonomial (K := ℚ) factorizationZeroExponent : + FactorizationSeries) * ([] : List FactorizationSeries).prod := by + intro h + have hconstant := congrArg constantCoeff h + norm_num [factorizationZeroExponent, coe_finiteSupportMonomial, + constantCoeff_apply] at hconstant + +end + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo.lean new file mode 100644 index 0000000000..34bcee3719 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.FactorizationClassification +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedSpanFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedTruncationSpan + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo/FactorizationClassification.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo/FactorizationClassification.lean new file mode 100644 index 0000000000..ce56f809cb --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo/FactorizationClassification.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.FactorizationClassification + +/-! +# Public-interface check for PS06 Lemma 3.1 + +This separately compiled client exercises the complete factorisation classification through its +public signature. It does not unfold the degree-two support predicates or the critical-point +machinery used in the proof. +-/ + +universe v + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace Tests + +/-- The public PS06 Lemma 3.1 API reproduces the printed constant-or-balanced dichotomy. -/ +theorem ps06_degreeTwo_factorization_client + {K : Type v} [Field K] [CharZero K] + {a b c : Berarducci.Series K} + (haNear : a ∉ Berarducci.nearConstantSubgroup K) + (haType : (a : K⟦ℝ⟧).supportOrderType = + (Ordinal.omega0 ^ (2 : Ordinal)) ∨ + (a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) + 1) + (habc : a = b * c) + (hle : Berarducci.ordinalValue b ≤ Berarducci.ordinalValue c) : + (∃ k : K, k ≠ 0 ∧ b = HahnSeries.Nonpositive.C k ∧ + c = HahnSeries.Nonpositive.C k⁻¹ * a ∧ + (c : K⟦ℝ⟧).supportOrderType = (a : K⟦ℝ⟧).supportOrderType) ∨ + (((b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ∨ + (b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 + 1) ∧ + ((c : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ∨ + (c : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 + 1) ∧ + Berarducci.ordinalValue b = ω^ (1 : NatOrdinal) ∧ + Berarducci.ordinalValue c = ω^ (1 : NatOrdinal)) := + PommersheimShahriari.factorization_cases_of_supportOrderType_wpow_two + haNear haType habc hle + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo/TranslatedSpanFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo/TranslatedSpanFactorization.lean new file mode 100644 index 0000000000..08ce84054c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo/TranslatedSpanFactorization.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedSpanFactorization + +/-! +# Public-interface check for the PS06 translated-truncation-span irreducibility criterion + +This separately compiled client exercises the dimension bound and PS06, Corollary 3.3 through +their public signatures, without unfolding the quotient or translated-truncation-span definitions. +-/ + +universe v + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace Tests + +/-- The public Proposition 3.2 API bounds the translated-truncation span of a balanced product by +two. -/ +theorem ps06_balancedProduct_translatedTruncationSpan_client + {K : Type v} [Field K] {b c : Berarducci.Series K} + (hbValue : Berarducci.ordinalValue b = ω^ (1 : NatOrdinal)) + (hcValue : Berarducci.ordinalValue c = ω^ (1 : NatOrdinal)) + (hbCritical : Berarducci.IsCriticalPoint b 0) + (hcCritical : Berarducci.IsCriticalPoint c 0) : + Module.finrank K (PommersheimShahriari.translatedTruncationSpan (b * c)) ≤ 2 := + PommersheimShahriari.finrank_translatedTruncationSpan_mul_le_two + hbValue hcValue hbCritical hcCritical + +/-- The public Corollary 3.3 API reproduces PS06's degree-two irreducibility criterion. -/ +theorem ps06_degreeTwo_irreducibility_client + {K : Type v} [Field K] [CharZero K] {a : Berarducci.Series K} + (haNear : a ∉ Berarducci.nearConstantSubgroup K) + (haType : (a : K⟦ℝ⟧).supportOrderType = + Ordinal.omega0 ^ (2 : Ordinal) ∨ + (a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) + 1) + (haDimension : 2 < + Module.finrank K (PommersheimShahriari.translatedTruncationSpan a)) : + Irreducible a := + PommersheimShahriari.irreducible_of_two_lt_finrank_translatedTruncationSpan + haNear haType haDimension + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo/TranslatedTruncationSpan.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo/TranslatedTruncationSpan.lean new file mode 100644 index 0000000000..5835ea200a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo/TranslatedTruncationSpan.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedTruncationSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue + +/-! +# API checks for the Pommersheim--Shahriari translated-truncation span + +The constant-one series separates the [PS06] quotient by `J + K` from Berarducci's quotient by +`J`: it vanishes in the former and remains nonzero in the latter. The approach-zero series then +shows that quotienting constants has not collapsed the whole space. +-/ + +public noncomputable section + +namespace Tests + +open scoped HahnSeries + +/-- Constant one vanishes modulo `J + K`. -/ +theorem constant_one_eq_zero_modulo_constants : + PommersheimShahriari.toSeriesQuotientByJAddConstants + (HahnSeries.Nonpositive.C (1 : ℚ)) = 0 := by + rw [PommersheimShahriari.toSeriesQuotientByJAddConstants_eq_zero_iff] + exact Berarducci.mem_nearConstantSubgroup_iff.mpr + ⟨0, (HahnSeries.Nonpositive.negativeMonomialIdeal ℚ).zero_mem, 1, by simp⟩ + +/-- The same constant remains nonzero in Berarducci's quotient by `J` alone. -/ +theorem constant_one_ne_zero_in_berarducci_germ : + Berarducci.toGerm (HahnSeries.Nonpositive.C (1 : ℚ)) ≠ 0 := by + intro hzero + have hmem : HahnSeries.Nonpositive.C (1 : ℚ) ∈ + HahnSeries.Nonpositive.negativeMonomialIdeal ℚ := by + rw [← sub_zero (HahnSeries.Nonpositive.C (1 : ℚ)), + ← Berarducci.toGerm_eq_toGerm_iff] + simpa using hzero + have hcoeff := Berarducci.constantCoeff_eq_zero_of_mem_negativeMonomialIdeal hmem + norm_num at hcoeff + +/-- The approach-zero series is nonzero modulo `J + K`, so the [PS06] vector space is +nondegenerate. -/ +theorem approachZero_ne_zero_modulo_constants : + PommersheimShahriari.toSeriesQuotientByJAddConstants approachZeroNonpositive ≠ 0 := by + intro hzero + have hnear := + PommersheimShahriari.toSeriesQuotientByJAddConstants_eq_zero_iff.mp hzero + exact (Berarducci.one_lt_ordinalValue_iff.mp + (Berarducci.one_lt_ordinalValue_of_constantCoeff_eq_zero_of_supportSup_eq_zero + (by + rw [HahnSeries.Nonpositive.constantCoeff_apply, coe_approachZeroNonpositive] + exact not_ne_iff.mp (by + simpa [HahnSeries.mem_support] using zero_not_mem_approachZero_support)) + approachZero_supportSup)) hnear + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/GermLikeFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/GermLikeFactorization.lean new file mode 100644 index 0000000000..d64b4922c4 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/GermLikeFactorization.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GermLike +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwoExample + +/-! +# Checks for germ-like factorisation + +The PS06 degree-two series with constant coefficient one exercises the second branch of the +LM17 germ-like definition: its support order type is `ω² + 1` and its ordinal value is `ω²`. +Thus this certificate distinguishes the intended definition from the nearby wrong definition +that retains only the equality `ot(a) = v_J(a)`. +-/ + +universe v + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace Tests.LM17 + +open Berarducci PommersheimShahriari PommersheimShahriari.DegreeTwoExample + +variable {K : Type v} [Field K] + +/-- The degree-two series with constant coefficient one is germ-like by the nontrivial +`ot(a) = v_J(a) + 1` branch. -/ +theorem degreeTwoWithConstant_isGermLike : + LM17.IsGermLike (degreeTwoWithConstant (K := K)) := by + rw [LM17.isGermLike_iff] + right + have hvalue : ordinalValue (degreeTwoWithConstant (K := K)) = ω^ (2 : NatOrdinal) := + ordinalValue_eq_wpow_two + (degreeTwoWithConstant_not_mem_nearConstantSubgroup (K := K)) + (Or.inr (degreeTwoWithConstant_supportOrderType (K := K))) + refine ⟨?_, ?_⟩ + · rw [hvalue, ← NatOrdinal.val.lt_iff_lt] + simp only [NatOrdinal.val_one, NatOrdinal.val_wpow] + rw [Ordinal.one_lt_opow] + exact ⟨Ordinal.one_lt_omega0, by norm_num⟩ + · rw [hvalue, NatOrdinal.val_wpow] + have h2 : (2 : NatOrdinal).val = (2 : Ordinal) := rfl + rw [h2] + exact degreeTwoWithConstant_supportOrderType (K := K) + +/-- The degree-two germ-like series with constant coefficient one admits an irreducible +factorisation. -/ +theorem degreeTwoWithConstant_exists_factorization [CharZero K] : + ∃ f : Multiset (Series K), + (∀ b ∈ f, Irreducible b) ∧ + Associated f.prod (degreeTwoWithConstant (K := K)) := + degreeTwoWithConstant_isGermLike.exists_factorization + (degreeTwoWithConstant_irreducible (K := K)).ne_zero + +end Tests.LM17 diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/GradedDivisibility.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/GradedDivisibility.lean new file mode 100644 index 0000000000..af6d7bca96 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/GradedDivisibility.lean @@ -0,0 +1,302 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.SingleZeroFactors +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringMonoidAlgebra +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GradedDivisibility +public import Mathlib.Data.Rat.Defs + +import Mathlib.Tactic.NormNum + +/-! +# API checks for graded divisibility + +The two-component fixture has independently nonzero grades zero and one. Its trailing grade is +zero, its leading grade is one, and it is not homogeneous. This distinguishes the minimum-grade +invariant used in LM24, Proposition 6.2.1 from the existing maximum-grade invariant, and it +distinguishes `RV` from the full associated graded ring `RV̂`. + +The strictly negative finite-support monomial does not divide one in the nonpositive-exponent +monoid algebra: such a quotient would require a positive exponent. Its graded image therefore +also does not divide one, exercising the reflection direction of LM24, Corollary 6.2.3 and +excluding a nearby group-algebra model with unrestricted real exponents. + +Finally, a principal coefficient multiplied by that strictly negative monomial has nonzero +monoid-algebra exponent. It lies outside `P̂`, distinguishing the principal graded subring from all +of `RV̂`. The principal-one and zero-boundary checks separately certify the exact embedded image +predicate for the paper's set `P`. +-/ + +open scoped DirectSum HahnSeries NatOrdinal + +universe v + +namespace Tests + +public noncomputable section + +/-- The strictly negative exponent used in the finite-support divisibility separator. -/ +def gradedDivisibilityNegativeExponent : + HahnSeries.Nonpositive.exponentMonoid ℝ := + ⟨-1, by norm_num⟩ + +/-- The finite-support Hahn monomial at exponent `-1`. -/ +def gradedDivisibilityNegativeMonomial : + HahnSeries.Nonpositive.finiteSupportSubring (G := ℝ) (K := ℚ) := + HahnSeries.Nonpositive.finiteSupportMonomial gradedDivisibilityNegativeExponent + +/-- The chosen strictly negative exponent is not zero. -/ +theorem gradedDivisibilityNegativeExponent_ne_zero : + gradedDivisibilityNegativeExponent ≠ 0 := by + intro h + have := congrArg Subtype.val h + norm_num [gradedDivisibilityNegativeExponent] at this + +/-- The finite-support monomial at exponent `-1` is nonzero. -/ +theorem gradedDivisibilityNegativeMonomial_ne_zero : + gradedDivisibilityNegativeMonomial ≠ 0 := by + intro h + have hcoeff := congrArg + (fun p : HahnSeries.Nonpositive.finiteSupportSubring (G := ℝ) (K := ℚ) ↦ + (((p : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).coeff (-1))) h + simp [gradedDivisibilityNegativeMonomial, gradedDivisibilityNegativeExponent] at hcoeff + +/-- A negative monomial cannot divide one within the nonpositive-exponent finite-support ring. -/ +theorem gradedDivisibilityNegativeMonomial_not_dvd_one : + ¬ gradedDivisibilityNegativeMonomial ∣ 1 := by + intro hDvd + obtain ⟨r, hr⟩ := hDvd + let e := HahnSeries.Nonpositive.finiteSupportAddMonoidAlgebraEquiv + (G := ℝ) (K := ℚ) + have her : e r ≠ 0 := by + intro hzero + have hrZero : r = 0 := by + apply e.injective + simpa using hzero + rw [hrZero, mul_zero] at hr + exact one_ne_zero hr + have heMonomial : e gradedDivisibilityNegativeMonomial = + AddMonoidAlgebra.single gradedDivisibilityNegativeExponent 1 := by + exact HahnSeries.Nonpositive.finiteSupportAddMonoidAlgebraEquiv_monomial + gradedDivisibilityNegativeExponent + have hProduct : + AddMonoidAlgebra.single gradedDivisibilityNegativeExponent (1 : ℚ) * e r = + AddMonoidAlgebra.single 0 1 := by + calc + AddMonoidAlgebra.single gradedDivisibilityNegativeExponent (1 : ℚ) * e r = + e gradedDivisibilityNegativeMonomial * e r := + congrArg (· * e r) heMonomial.symm + _ = e (gradedDivisibilityNegativeMonomial * r) := + (map_mul e gradedDivisibilityNegativeMonomial r).symm + _ = e 1 := congrArg e hr.symm + _ = 1 := map_one e + _ = AddMonoidAlgebra.single 0 1 := AddMonoidAlgebra.one_def + obtain ⟨_, _, ha, _⟩ := + AddMonoidAlgebra.exists_eq_single_zero_of_mul_eq_single_zero + (R := ℚ) (M := HahnSeries.Nonpositive.exponentMonoid ℝ) + (HahnSeries.Nonpositive.exponentMonoid_top_eq_zero ℝ) + (AddMonoidAlgebra.single_ne_zero.mpr one_ne_zero) + her hProduct + have hcoeff := congrArg + (fun f : AddMonoidAlgebra ℚ (HahnSeries.Nonpositive.exponentMonoid ℝ) ↦ + f gradedDivisibilityNegativeExponent) ha + simp [gradedDivisibilityNegativeExponent_ne_zero] at hcoeff + +/-- The graded image of the negative monomial does not divide the graded image of one. -/ +theorem gradedDivisibilityNegativeMonomialGraded_not_dvd_one : + ¬ Berarducci.finiteSupportGradedEmbedding ℚ + gradedDivisibilityNegativeMonomial ∣ + Berarducci.finiteSupportGradedEmbedding ℚ 1 := by + intro hDvd + exact gradedDivisibilityNegativeMonomial_not_dvd_one + ((Berarducci.finiteSupportGradedEmbedding_dvd_iff + gradedDivisibilityNegativeMonomial 1).mp hDvd) + +variable {K : Type v} [Field K] [CharZero K] + +variable (K) in +/-- The degree-RV class of one, used as a nonzero principal-image boundary case. -/ +def gradedDivisibilityPrincipalOneRV : Berarducci.HahnDegreeRV K := + (HahnSeries.Nonpositive.degreeValuation K).rv 1 + +variable (K) in +/-- The degree-RV class of one is principal in the exact sense of LM24, Definition 5.2.1. -/ +theorem gradedDivisibilityPrincipalOneRV_isPrincipal : + Berarducci.IsPrincipalRV (gradedDivisibilityPrincipalOneRV K) := by + rw [Berarducci.isPrincipalRV_iff] + exact ⟨1, HahnSeries.Nonpositive.isPrincipal_one, rfl⟩ + +variable (K) in +/-- The canonical graded image of the principal RV class of one belongs to `P`. -/ +theorem gradedDivisibilityPrincipalOneRV_image : + Berarducci.IsPrincipalRVImage + ((HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom + (gradedDivisibilityPrincipalOneRV K)) := + Berarducci.isPrincipalRVImage_initialForm + (gradedDivisibilityPrincipalOneRV K) + (gradedDivisibilityPrincipalOneRV_isPrincipal K) + +variable (K) in +/-- Zero is not in the image of principal RV classes because principal series are nonzero. -/ +theorem gradedDivisibilityPrincipalRVImage_zero_false : + ¬ Berarducci.IsPrincipalRVImage (0 : Berarducci.DegreeGraded K) := by + intro hzero + exact (Berarducci.isPrincipalRVImage_iff _).mp hzero |>.1 rfl + +/-- A graded element supported in the two distinct grades zero and one. -/ +def gradedDivisibilityTwoComponent (a₀ : (HahnSeries.Nonpositive.degreeValuation K).Component 0) + (a₁ : (HahnSeries.Nonpositive.degreeValuation K).Component 1) : + Berarducci.DegreeGraded K := + DirectSum.of _ 0 a₀ + DirectSum.of _ 1 a₁ + +omit [CharZero K] in +/-- The two-component fixture retains its prescribed grade-zero and grade-one components. -/ +theorem gradedDivisibilityTwoComponent_components + (a₀ : (HahnSeries.Nonpositive.degreeValuation K).Component 0) + (a₁ : (HahnSeries.Nonpositive.degreeValuation K).Component 1) : + gradedDivisibilityTwoComponent a₀ a₁ 0 = a₀ ∧ + gradedDivisibilityTwoComponent a₀ a₁ 1 = a₁ := by + simp [gradedDivisibilityTwoComponent, DirectSum.of_apply] + +omit [CharZero K] in +/-- With a nonzero grade-zero component, the fixture's trailing grade is zero. -/ +theorem gradedDivisibilityTwoComponent_trailingValue + (a₀ : (HahnSeries.Nonpositive.degreeValuation K).Component 0) + (a₁ : (HahnSeries.Nonpositive.degreeValuation K).Component 1) + (ha₀ : a₀ ≠ 0) : + MaxAddDegree.associatedGradedTrailingValue + (HahnSeries.Nonpositive.degreeValuation K) + (gradedDivisibilityTwoComponent a₀ a₁) = 0 := by + let w := HahnSeries.Nonpositive.degreeValuation K + apply (w.associatedGradedTrailingValue_eq_coe_iff + (gradedDivisibilityTwoComponent a₀ a₁) 0).mpr + exact ⟨by simpa [gradedDivisibilityTwoComponent, DirectSum.of_apply] using ha₀, + fun _ _ ↦ bot_le⟩ + +omit [CharZero K] in +/-- With a nonzero grade-one component, the fixture's leading grade is one. -/ +theorem gradedDivisibilityTwoComponent_leadingValue + (a₀ : (HahnSeries.Nonpositive.degreeValuation K).Component 0) + (a₁ : (HahnSeries.Nonpositive.degreeValuation K).Component 1) + (ha₁ : a₁ ≠ 0) : + (HahnSeries.Nonpositive.degreeValuation K).associatedGradedValue + (gradedDivisibilityTwoComponent a₀ a₁) = 1 := by + let w := HahnSeries.Nonpositive.degreeValuation K + apply (w.associatedGradedValue_eq_coe_iff + (gradedDivisibilityTwoComponent a₀ a₁) 1).mpr + constructor + · simpa [gradedDivisibilityTwoComponent, DirectSum.of_apply] using ha₁ + · intro i hi + by_cases hi₀ : i = 0 + · subst i + exact zero_le_one + by_cases hi₁ : i = 1 + · subst i + exact le_rfl + have hzero : gradedDivisibilityTwoComponent a₀ a₁ i = 0 := by + simp [gradedDivisibilityTwoComponent, DirectSum.of_apply, Ne.symm hi₀, Ne.symm hi₁] + exact (hi hzero).elim + +omit [CharZero K] in +/-- With both displayed components nonzero, the two-component fixture is not in degree RV. -/ +theorem gradedDivisibilityTwoComponent_not_homogeneous + (a₀ : (HahnSeries.Nonpositive.degreeValuation K).Component 0) + (a₁ : (HahnSeries.Nonpositive.degreeValuation K).Component 1) + (ha₀ : a₀ ≠ 0) (ha₁ : a₁ ≠ 0) : + gradedDivisibilityTwoComponent a₀ a₁ ∉ + (HahnSeries.Nonpositive.degreeValuation K).homogeneousClasses := by + let w := HahnSeries.Nonpositive.degreeValuation K + intro hHomogeneous + rcases (w.mem_homogeneousClasses_iff_extremeGrades + (gradedDivisibilityTwoComponent a₀ a₁)).mp hHomogeneous with + hzero | ⟨m, htrail, hlead⟩ + · apply ha₀ + rw [← (gradedDivisibilityTwoComponent_components a₀ a₁).1, hzero] + rfl + · have htrailZero := gradedDivisibilityTwoComponent_trailingValue a₀ a₁ ha₀ + have hleadOne := gradedDivisibilityTwoComponent_leadingValue a₀ a₁ ha₁ + have hzeroM : (0 : NatOrdinal) = m := + WithTop.coe_injective (htrailZero.symm.trans htrail) + have honeM : (1 : NatOrdinal) = m := + WithBot.coe_injective (hleadOne.symm.trans hlead) + exact zero_ne_one (hzeroM.trans honeM.symm) + +/-- The strictly negative exponent used to separate `P̂` from `RV̂`. -/ +def gradedDivisibilityNonprincipalExponent : + HahnSeries.Nonpositive.exponentMonoid ℝ := + ⟨-1, by norm_num⟩ + +variable (K) in +/-- A principal coefficient multiplied by a strictly negative finite-support monomial. -/ +def gradedDivisibilityNonprincipalElement : + Berarducci.DegreeGraded K := + Berarducci.principalSubringEmbedding K 1 * + Berarducci.finiteSupportGradedEmbedding K + (HahnSeries.Nonpositive.finiteSupportMonomial (K := K) + gradedDivisibilityNonprincipalExponent) + +variable (K) in +/-- The nonprincipal fixture has coefficient one at the strictly negative monoid exponent. -/ +theorem gradedDivisibilityNonprincipalElement_coordinate : + Berarducci.degreeGradedEquivPrincipalMonoidAlgebra K + (gradedDivisibilityNonprincipalElement K) = + AddMonoidAlgebra.single gradedDivisibilityNonprincipalExponent 1 := by + exact Berarducci.degreeGradedEquivPrincipalMonoidAlgebra_principal_monomial 1 + gradedDivisibilityNonprincipalExponent + +variable (K) in +/-- A nonzero monoid exponent prevents the fixture from lying in the principal graded +subalgebra. -/ +theorem gradedDivisibilityNonprincipalElement_not_mem : + gradedDivisibilityNonprincipalElement K ∉ + Berarducci.principalSubringSubalgebra K := by + intro hmem + let eP := Berarducci.principalSubringEquivSubalgebra K + let z : Berarducci.principalSubringSubalgebra K := + ⟨gradedDivisibilityNonprincipalElement K, hmem⟩ + let x := eP.symm z + have hx : Berarducci.principalSubringEmbedding K x = + gradedDivisibilityNonprincipalElement K := by + calc + Berarducci.principalSubringEmbedding K x = + (eP x : Berarducci.DegreeGraded K) := + (Berarducci.principalSubringEquivSubalgebra_apply x).symm + _ = gradedDivisibilityNonprincipalElement K := + congrArg Subtype.val (eP.apply_symm_apply z) + have hcoordinates := congrArg + (Berarducci.degreeGradedEquivPrincipalMonoidAlgebra K) hx + rw [Berarducci.degreeGradedEquivPrincipalMonoidAlgebra_principal, + gradedDivisibilityNonprincipalElement_coordinate] at hcoordinates + have hcoeff := congrArg + (fun f : AddMonoidAlgebra (Berarducci.PrincipalSubring K) + (HahnSeries.Nonpositive.exponentMonoid ℝ) ↦ + f gradedDivisibilityNonprincipalExponent) hcoordinates + have hne : gradedDivisibilityNonprincipalExponent ≠ 0 := by + intro h + have := congrArg Subtype.val h + norm_num [gradedDivisibilityNonprincipalExponent] at this + rw [AddMonoidAlgebra.single_apply, if_neg (Ne.symm hne), + AddMonoidAlgebra.single_apply, if_pos rfl] at hcoeff + have hgraded : + (0 : Berarducci.DegreeGraded K) = 1 := by + simpa using congrArg + (Berarducci.principalSubringEmbedding K) hcoeff + have hfinite : + (0 : Berarducci.FiniteSupportRing (K := K)) = 1 := by + apply Berarducci.finiteSupportGradedEmbedding_injective K + calc + Berarducci.finiteSupportGradedEmbedding K 0 = 0 := + map_zero (Berarducci.finiteSupportGradedEmbedding K) + _ = 1 := hgraded + _ = Berarducci.finiteSupportGradedEmbedding K 1 := + (map_one (Berarducci.finiteSupportGradedEmbedding K)).symm + exact zero_ne_one hfinite + +end + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/InfiniteSupportFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/InfiniteSupportFactorization.lean new file mode 100644 index 0000000000..161952cd47 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/InfiniteSupportFactorization.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.InfiniteSupport + +/-! +# API checks for infinite-support factorisation + +The zero series separates `HasOnlyUnitFiniteSupportDivisors` from a predicate that ignores the +zero finite-support divisor. The nonzero-scalar client runs the full parameterized factorisation +theorem and uses its Cantor-term bound to force the factor list to be empty. Thus the client +checks the degree-zero branch, the normalized maximal finite-support factor in the product, and +the exact orientation of the numerical bound. + +Pairwise gcd existence and the unit classification of the finite-support ring remain explicit +parameters of the generic theorem; the coefficient field has characteristic zero. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +namespace Tests + +public noncomputable section + +open Berarducci + +/-- Zero does not have only unit finite-support divisors because zero itself is a nonunit +finite-support divisor. -/ +theorem zero_not_hasOnlyUnitFiniteSupportDivisors : + ¬HasOnlyUnitFiniteSupportDivisors (0 : Series ℚ) := by + intro hzero + have hzeroSpec := (hasOnlyUnitFiniteSupportDivisors_iff (0 : Series ℚ)).mp hzero + exact not_isUnit_zero (hzeroSpec 0 (dvd_zero 0)) + +/-- The factorisation theorem produces no infinite-support factor for a nonzero scalar series. -/ +theorem scalar_factorization_has_no_infinite_support_factors {K : Type v} [Field K] [CharZero K] + (hgcd : ∀ p q : FiniteSupportRing (K := K), + ∃ d : FiniteSupportRing (K := K), + ∀ e : FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hunits : ∀ p : FiniteSupportRing (K := K), + IsUnit p ↔ ∃ a : K, a ≠ 0 ∧ + p = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) a) + {k : K} (hk : k ≠ 0) : + ∃ (factors : List (Series K)) (a : K), + a ≠ 0 ∧ + HahnSeries.Nonpositive.C k = + HahnSeries.Nonpositive.C a * + (seriesNormalizedMaximalFiniteSupportDivisor + (HahnSeries.Nonpositive.C k) : Series K) * + factors.prod ∧ + (∀ c ∈ factors, + Irreducible c ∧ (c : K⟦ℝ⟧).support.Infinite) ∧ + factors = [] := by + have hb : (HahnSeries.Nonpositive.C k : Series K) ≠ 0 := by + intro hzero + apply HahnSeries.C_ne_zero (R := K) (Γ := ℝ) hk + simpa [HahnSeries.Nonpositive.coe_C] using congrArg + (fun b : Series K ↦ (b : K⟦ℝ⟧)) hzero + obtain ⟨a, factors, ha, hfactor, hfactors, hbound⟩ := + exists_series_infinite_support_factorization_of_exists_gcd hgcd hunits hb + have hbDegree : + ((HahnSeries.Nonpositive.C k : Series K) : K⟦ℝ⟧).degree = 0 := by + rw [HahnSeries.degree_eq_zero] + refine ⟨?_, ?_⟩ + · simpa only [HahnSeries.Nonpositive.coe_C] using + HahnSeries.C_ne_zero (R := K) (Γ := ℝ) hk + · rw [HahnSeries.Nonpositive.coe_C, HahnSeries.C_apply, + HahnSeries.support_single_of_ne hk] + exact Set.finite_singleton 0 + have hcount : + HahnSeries.degreeCantorTermCount + ((HahnSeries.Nonpositive.C k : Series K) : K⟦ℝ⟧) = 0 := by + rw [HahnSeries.degreeCantorTermCount_eq_of_degree hbDegree, + NatOrdinal.cantorTermCount_zero] + have hlength : factors.length = 0 := + Nat.eq_zero_of_le_zero (hcount ▸ hbound) + exact ⟨factors, a, ha, hfactor, hfactors, + List.length_eq_zero_iff.mp hlength⟩ + +end + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/MaximalFiniteSupportDivisor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/MaximalFiniteSupportDivisor.lean new file mode 100644 index 0000000000..90f925e201 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/MaximalFiniteSupportDivisor.lean @@ -0,0 +1,295 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite +public import Mathlib.Data.Real.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero + +/-! +# API checks for normalized maximal finite-support divisors + +The two-term fixture has support `{-1, 0}`, coefficient `2` at its least exponent, and coefficient +`1` at its greatest exponent. It is therefore monic in the precise sense used by LM24, Notation +5.4.5, while the nearby incorrect definition that normalizes at the least exponent rejects it. + +The RV fixture is the class of that nonconstant series. Its checks use the actual multiplicative +RV quotient and freeze the orientation `q ∣ B ↔ q ∣ p` from LM24, Proposition 5.4.3. A second +fixture has independently nonzero components in degrees zero and one; it tests the full direct-sum +graded ring of Corollary 5.4.4 rather than a single homogeneous class. The final certificate states +only the one-sided divisibility of Proposition 5.4.8. Pairwise gcd existence and the unit +classification of the finite-support ring remain explicit parameters. +-/ + +open scoped DirectSum HahnSeries NatOrdinal + +public noncomputable section + +namespace Tests + +/-- A two-term finite-support series whose coefficients distinguish greatest-endpoint +normalization from least-endpoint normalization. -/ +def normalizationAsymmetricSeries : HahnSeries.Nonpositive ℝ ℚ := + HahnSeries.Nonpositive.C 1 + + HahnSeries.Nonpositive.single (-1) 2 (by norm_num) + +/-- The asymmetric series has finite support. -/ +theorem normalizationAsymmetricSeries_mem : + normalizationAsymmetricSeries ∈ + (HahnSeries.Nonpositive.finiteSupportSubring : + Subring (HahnSeries.Nonpositive ℝ ℚ)) := by + rw [HahnSeries.Nonpositive.mem_finiteSupportSubring_iff] + apply Set.Finite.subset + ((Set.finite_singleton 0).union (Set.finite_singleton (-1))) + intro x hx + rcases HahnSeries.support_add_subset _ _ hx with hx | hx + · left + rw [HahnSeries.Nonpositive.coe_C] at hx + exact HahnSeries.support_single_subset hx + · right + rw [HahnSeries.Nonpositive.coe_single] at hx + exact HahnSeries.support_single_subset hx + +/-- The asymmetric fixture as an element of the finite-support subring. -/ +def normalizationAsymmetric : + HahnSeries.Nonpositive.finiteSupportSubring (G := ℝ) (K := ℚ) := + ⟨normalizationAsymmetricSeries, normalizationAsymmetricSeries_mem⟩ + +/-- The greatest exponent of the asymmetric fixture is zero. -/ +theorem normalizationAsymmetric_greatest : + IsGreatest + (((normalizationAsymmetric : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).support) 0 := by + constructor + · rw [HahnSeries.mem_support] + simp [normalizationAsymmetric, normalizationAsymmetricSeries] + · intro x hx + exact HahnSeries.Nonpositive.support_subset + (normalizationAsymmetric : HahnSeries.Nonpositive ℝ ℚ) hx + +/-- The least exponent of the asymmetric fixture is `-1`. -/ +theorem normalizationAsymmetric_least : + IsLeast + (((normalizationAsymmetric : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).support) + (-1) := by + constructor + · rw [HahnSeries.mem_support] + simp [normalizationAsymmetric, normalizationAsymmetricSeries] + · intro x hx + have hx' : x ∈ (normalizationAsymmetricSeries : ℚ⟦ℝ⟧).support := by + simpa [normalizationAsymmetric] using hx + rcases HahnSeries.support_add_subset _ _ hx' with hxConstant | hxNegative + · rw [HahnSeries.Nonpositive.coe_C] at hxConstant + have hxZero : x = 0 := by + simpa using HahnSeries.support_single_subset hxConstant + rw [hxZero] + norm_num + · rw [HahnSeries.Nonpositive.coe_single] at hxNegative + have hxNegOne : x = -1 := by + simpa using HahnSeries.support_single_subset hxNegative + rw [hxNegOne] + +/-- The coefficient at the greatest exponent is one. -/ +theorem normalizationAsymmetric_coeff_greatest : + ((normalizationAsymmetric : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).coeff 0 = 1 := by + simp [normalizationAsymmetric, normalizationAsymmetricSeries] + +/-- The coefficient at the least exponent is two, not one. -/ +theorem normalizationAsymmetric_coeff_least : + ((normalizationAsymmetric : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).coeff (-1) = 2 := by + simp [normalizationAsymmetric, normalizationAsymmetricSeries] + +/-- The fixture satisfies the intended greatest-exponent normalization. -/ +theorem normalizationAsymmetric_isMonic : + HahnSeries.Nonpositive.IsMonicFiniteSupport normalizationAsymmetric := by + rw [HahnSeries.Nonpositive.isMonicFiniteSupport_iff] + exact ⟨0, normalizationAsymmetric_greatest, + normalizationAsymmetric_coeff_greatest⟩ + +/-- The fixture rejects normalization at the least support exponent. -/ +theorem normalizationAsymmetric_least_coeff_ne_one : + ((normalizationAsymmetric : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).coeff + (-1) ≠ 1 := by + rw [normalizationAsymmetric_coeff_least] + norm_num + +/-- The nonconstant fixture is a normalized representative of its own associate class. -/ +theorem normalizationAsymmetric_isNormalizedRepresentative : + HahnSeries.Nonpositive.IsNormalizedAssociateRepresentative + (Associates.mk normalizationAsymmetric) normalizationAsymmetric := by + rw [HahnSeries.Nonpositive.isNormalizedAssociateRepresentative_iff] + exact Or.inr + ⟨Associates.mk_ne_zero.mpr normalizationAsymmetric_isMonic.ne_zero, + rfl, normalizationAsymmetric_isMonic⟩ + +/-- The chosen normalized representative preserves the fixture's nonzero associate class. -/ +theorem normalizationAsymmetric_chosen_mk : + Associates.mk + (HahnSeries.Nonpositive.normalizedAssociateRepresentative + (Associates.mk normalizationAsymmetric)) = + Associates.mk normalizationAsymmetric := + HahnSeries.Nonpositive.normalizedAssociateRepresentative_mk _ + +/-- The chosen representative of the fixture's associate class is monic. -/ +theorem normalizationAsymmetric_chosen_isMonic : + HahnSeries.Nonpositive.IsMonicFiniteSupport + (HahnSeries.Nonpositive.normalizedAssociateRepresentative + (Associates.mk normalizationAsymmetric)) := + HahnSeries.Nonpositive.normalizedAssociateRepresentative_isMonic_of_ne_zero + (Associates.mk_ne_zero.mpr normalizationAsymmetric_isMonic.ne_zero) + +/-- The normalized representative of the zero associate class is zero. -/ +theorem normalization_zero_class : + HahnSeries.Nonpositive.normalizedAssociateRepresentative + (0 : Associates + (HahnSeries.Nonpositive.finiteSupportSubring (G := ℝ) (K := ℚ))) = 0 := by + rw [HahnSeries.Nonpositive.normalizedAssociateRepresentative_zero] + +/-- The asymmetric fixture is not a coefficient scalar. -/ +theorem normalizationAsymmetric_not_scalar (k : ℚ) : + normalizationAsymmetric ≠ + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k := by + intro h + have hcoeff := congrArg + (fun p : HahnSeries.Nonpositive.finiteSupportSubring (G := ℝ) (K := ℚ) ↦ + (((p : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).coeff (-1))) h + rw [normalizationAsymmetric_coeff_least] at hcoeff + rw [HahnSeries.Nonpositive.coe_finiteSupportScalarHom] at hcoeff + change 2 = (HahnSeries.C k).coeff (-1) at hcoeff + rw [HahnSeries.C_apply, + HahnSeries.coeff_single_of_ne (by norm_num : (-1 : ℝ) ≠ 0)] at hcoeff + norm_num at hcoeff + +/-- The actual degree-RV class of the nonconstant asymmetric finite-support series. -/ +def maximalFiniteRVFixture : Berarducci.HahnDegreeRV ℚ := + Berarducci.finiteSupportRVEmbedding ℚ normalizationAsymmetric + +/-- The nonconstant finite-support series gives a nonzero RV class. -/ +theorem maximalFiniteRVFixture_ne_zero : + maximalFiniteRVFixture ≠ 0 := by + intro h + apply normalizationAsymmetric_isMonic.ne_zero + apply Berarducci.finiteSupportRVEmbedding_injective ℚ + simpa [maximalFiniteRVFixture] using h + +/-- The RV fixture has a representative satisfying the exact divisibility orientation of LM24, +Proposition 5.4.3. -/ +theorem maximalFiniteRVFixture_exists_spec (hgcd : ∀ p q : Berarducci.FiniteSupportRing (K := ℚ), + ∃ d : Berarducci.FiniteSupportRing (K := ℚ), + ∀ e : Berarducci.FiniteSupportRing (K := ℚ), + e ∣ p ∧ e ∣ q ↔ e ∣ d) : + ∃ p : Berarducci.FiniteSupportRing (K := ℚ), + ∀ q : Berarducci.FiniteSupportRing (K := ℚ), + Berarducci.finiteSupportRVEmbedding ℚ q ∣ + maximalFiniteRVFixture ↔ + q ∣ p := by + obtain ⟨a, ha, _⟩ := + Berarducci.existsUnique_isRVMaximalFiniteSupportDivisor_of_exists_gcd hgcd + maximalFiniteRVFixture + induction a using Quotient.inductionOn with + | _ p => + exact ⟨p, + (Berarducci.isRVMaximalFiniteSupportDivisor_mk_iff maximalFiniteRVFixture p).mp ha⟩ + +/-- A nonzero element of the degree-zero component. -/ +def maximalFiniteDegreeZero : + (HahnSeries.Nonpositive.degreeValuation ℚ).Component 0 := + HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv ℚ 1 + +/-- The prescribed degree-zero component is nonzero. -/ +theorem maximalFiniteDegreeZero_ne_zero : + maximalFiniteDegreeZero ≠ 0 := by + intro h + let e := HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv ℚ + change e 1 = 0 at h + rw [← map_zero e] at h + exact one_ne_zero (e.injective h) + +/-- The degree-one component represented by the approach-zero principal series. -/ +def maximalFiniteDegreeOne : + (HahnSeries.Nonpositive.degreeValuation ℚ).Component 1 := + Berarducci.degreeLayerMk 1 approachZeroNonpositive + approachZero_degree_eq_one.le + +/-- The prescribed degree-one component is nonzero. -/ +theorem maximalFiniteDegreeOne_ne_zero : + maximalFiniteDegreeOne ≠ 0 := by + rw [maximalFiniteDegreeOne, ne_eq, + Berarducci.degreeLayerMk_eq_zero_iff, approachZero_degree_eq_one] + exact lt_irrefl _ + +/-- An associated-graded element with independently nonzero components in degrees zero and one. -/ +def maximalFiniteTwoComponentGraded : + Berarducci.DegreeGraded ℚ := + DirectSum.of _ 0 maximalFiniteDegreeZero + + DirectSum.of _ 1 maximalFiniteDegreeOne + +/-- Both prescribed components survive in the direct sum. -/ +theorem maximalFiniteTwoComponentGraded_components : + maximalFiniteTwoComponentGraded 0 = + maximalFiniteDegreeZero ∧ + maximalFiniteTwoComponentGraded 1 = + maximalFiniteDegreeOne := by + simp [maximalFiniteTwoComponentGraded, DirectSum.of_apply] + +/-- The two-component graded fixture is nonzero. -/ +theorem maximalFiniteTwoComponentGraded_ne_zero : + maximalFiniteTwoComponentGraded ≠ 0 := by + intro h + apply maximalFiniteDegreeOne_ne_zero + rw [← maximalFiniteTwoComponentGraded_components.2, h] + rfl + +/-- The two-component fixture has a representative satisfying the full-graded divisibility +characterization of LM24, Corollary 5.4.4. -/ +theorem maximalFiniteTwoComponentGraded_exists_spec + (hgcd : ∀ p q : Berarducci.FiniteSupportRing (K := ℚ), + ∃ d : Berarducci.FiniteSupportRing (K := ℚ), + ∀ e : Berarducci.FiniteSupportRing (K := ℚ), + e ∣ p ∧ e ∣ q ↔ e ∣ d) : + ∃ p : Berarducci.FiniteSupportRing (K := ℚ), + ∀ q : Berarducci.FiniteSupportRing (K := ℚ), + Berarducci.finiteSupportGradedEmbedding ℚ q ∣ + maximalFiniteTwoComponentGraded ↔ + q ∣ p := by + obtain ⟨a, ha, _⟩ := + Berarducci.existsUnique_isGradedMaximalFiniteSupportDivisor_of_exists_gcd hgcd + maximalFiniteTwoComponentGraded + induction a using Quotient.inductionOn with + | _ p => + exact ⟨p, + (Berarducci.isGradedMaximalFiniteSupportDivisor_mk_iff maximalFiniteTwoComponentGraded + p).mp ha⟩ + +/-- The normalized maximal divisor of the nonzero two-component fixture is monic. -/ +theorem maximalFiniteTwoComponentGraded_normalized_isMonic + (hgcd : ∀ p q : Berarducci.FiniteSupportRing (K := ℚ), + ∃ d : Berarducci.FiniteSupportRing (K := ℚ), + ∀ e : Berarducci.FiniteSupportRing (K := ℚ), + e ∣ p ∧ e ∣ q ↔ e ∣ d) : + HahnSeries.Nonpositive.IsMonicFiniteSupport + (Berarducci.gradedNormalizedMaximalFiniteSupportDivisor + maximalFiniteTwoComponentGraded) := + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor_isMonic_of_ne_zero hgcd + maximalFiniteTwoComponentGraded_ne_zero + +/-- LM24, Proposition 5.4.8, with its stated one-sided divisibility conclusion. -/ +theorem maximalFiniteTwoComponentGraded_mul_dvd + (hgcd : ∀ p q : Berarducci.FiniteSupportRing (K := ℚ), + ∃ d : Berarducci.FiniteSupportRing (K := ℚ), + ∀ e : Berarducci.FiniteSupportRing (K := ℚ), + e ∣ p ∧ e ∣ q ↔ e ∣ d) : + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor + maximalFiniteTwoComponentGraded * + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor + maximalFiniteTwoComponentGraded ∣ + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor + (maximalFiniteTwoComponentGraded * + maximalFiniteTwoComponentGraded) := + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor_mul_dvd_of_exists_gcd hgcd _ _ + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPart.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPart.lean new file mode 100644 index 0000000000..584d1c8de5 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPart.lean @@ -0,0 +1,96 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPart + +/-! +# API checks for normalized exponent-subgroup parts + +The identity fixture exercises the existence-and-uniqueness predicate for a case that is proved +without Ritt factorisation. The second fixture constructs the genuinely nonconstant normalized +series `1 + t⁻¹` and proves that it is not the normalized subgroup part of `1`, separating the +divisor-characterization predicate from mere constant-term normalization. +-/ + +open scoped HahnSeries + +namespace Tests + +public noncomputable section + +open HahnSeries.Nonpositive + +abbrev HPartExponentSubgroup : AddSubgroup ℝ := ⊤ + +abbrev HPartFiniteSupportRing := + FiniteSupportRing (G := HPartExponentSubgroup) (K := ℚ) + +abbrev HPartNormalizedFiniteSupport := + ConstantTermOneFiniteSupport (G := HPartExponentSubgroup) (K := ℚ) + +/-- The exponent `-1` in the nonpositive exponent monoid of the full real subgroup. -/ +def hPartMinusOneExponent : exponentMonoid HPartExponentSubgroup := + ⟨⟨-1, Set.mem_univ _⟩, by + change (-1 : ℝ) ≤ 0 + norm_num⟩ + +/-- The underlying subgroup exponent `-1` differs from zero. -/ +theorem hPartMinusOneExponent_coe_ne_zero : + (hPartMinusOneExponent : HPartExponentSubgroup) ≠ 0 := by + intro h + have hval := congrArg (fun g : HPartExponentSubgroup ↦ (g : ℝ)) h + norm_num [hPartMinusOneExponent] at hval + +/-- The normalized nonconstant finite-support series `1 + t⁻¹`. -/ +def onePlusNegativeMonomial : HPartNormalizedFiniteSupport := + ⟨1 + finiteSupportMonomial (K := ℚ) hPartMinusOneExponent, by + rw [mem_constantTermOneSubmonoid_iff] + change constantCoeff + ((1 : HahnSeries.Nonpositive HPartExponentSubgroup ℚ) + + (finiteSupportMonomial (K := ℚ) hPartMinusOneExponent : + HahnSeries.Nonpositive HPartExponentSubgroup ℚ)) = 1 + rw [map_add, map_one, constantCoeff_apply, + coe_finiteSupportMonomial] + rw [HahnSeries.coeff_single_of_ne + hPartMinusOneExponent_coe_ne_zero.symm] + simp⟩ + +/-- The normalized series `1 + t⁻¹` is not the identity. -/ +theorem onePlusNegativeMonomial_ne_one : + onePlusNegativeMonomial ≠ 1 := by + intro h + have hcoeff := congrArg + (fun p : HPartNormalizedFiniteSupport ↦ + ((((p : HPartFiniteSupportRing) : + HahnSeries.Nonpositive HPartExponentSubgroup ℚ) : + ℚ⟦HPartExponentSubgroup⟧).coeff hPartMinusOneExponent)) h + simp [onePlusNegativeMonomial, hPartMinusOneExponent, + HahnSeries.Nonpositive.coe_finiteSupportMonomial] at hcoeff + +/-- The normalized `H`-part of one exists uniquely and is one. -/ +theorem one_unique_normalizedHPart : + ∃! q : HPartNormalizedFiniteSupport, + IsNormalizedHPart HPartExponentSubgroup + (1 : FiniteSupportRing (G := ℝ) (K := ℚ)) q := + existsUnique_normalizedHPart_one HPartExponentSubgroup + +/-- Constant-term normalization alone does not make `1 + t⁻¹` the normalized `H`-part of +one. -/ +theorem onePlusNegativeMonomial_not_normalizedHPart_one : + ¬IsNormalizedHPart HPartExponentSubgroup + (1 : FiniteSupportRing (G := ℝ) (K := ℚ)) + onePlusNegativeMonomial := by + intro hpart + apply onePlusNegativeMonomial_ne_one + apply ConstantTermOneFiniteSupport.eq_one_of_finiteSupportToReal_dvd_one + exact (Iff.mp (isNormalizedHPart_iff HPartExponentSubgroup + (1 : FiniteSupportRing (G := ℝ) (K := ℚ)) onePlusNegativeMonomial) hpart + onePlusNegativeMonomial).mpr (dvd_refl _) + +end + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPartMultiplicativity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPartMultiplicativity.lean new file mode 100644 index 0000000000..58446d8ef6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPartMultiplicativity.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartMultiplicativity + +/-! +# API checks for multiplication of normalized exponent-subgroup parts + +For the trivial exponent subgroup, every normalized finite-support subgroup series is `1`. +The real finite-support series `1 + t⁻¹` is nevertheless nonconstant, so its normalized trivial- +subgroup part is genuinely smaller than the original series. Applying the multiplication theorem +to its square checks both directions of the divisor characterization and the product orientation. +-/ + +open scoped HahnSeries + +namespace Tests + +public noncomputable section + +open HahnSeries.Nonpositive + +abbrev TrivialExponentSubgroup : AddSubgroup ℝ := ⊥ + +/-- Every normalized finite-support series over the trivial exponent subgroup is the identity. -/ +theorem normalized_trivialExponentSubgroup_eq_one + (p : ConstantTermOneFiniteSupport (G := TrivialExponentSubgroup) (K := ℚ)) : + p = 1 := by + apply Subtype.ext + apply Subtype.ext + apply Subtype.ext + apply HahnSeries.coeff_injective + funext g + have hg : g = 0 := Subsingleton.elim _ _ + subst g + simpa [constantCoeff_apply] using p.constantCoeff_eq_one + +/-- Normalized divisors over the trivial exponent subgroup satisfy the required product +refinement property. -/ +theorem trivialExponentSubgroup_hasNormalizedHDivisorRefinement : + HasNormalizedHDivisorRefinement TrivialExponentSubgroup (K := ℚ) := by + rw [hasNormalizedHDivisorRefinement_iff] + intro p q r _ + refine ⟨1, 1, ?_, ?_, ?_⟩ <;> + simp [normalized_trivialExponentSubgroup_eq_one r] + +/-- The identity is the normalized trivial-subgroup part of every finite-support real series. -/ +theorem one_isNormalizedTrivialExponentSubgroupPart + (p : FiniteSupportRing (G := ℝ) (K := ℚ)) : + IsNormalizedHPart TrivialExponentSubgroup p 1 := by + rw [isNormalizedHPart_iff] + intro r + rw [normalized_trivialExponentSubgroup_eq_one r] + simp + +/-- The real exponent `-1` as a nonpositive exponent. -/ +def normalizedPartMinusOneExponent : exponentMonoid ℝ := + ⟨-1, by norm_num⟩ + +/-- The nonconstant finite-support real series `1 + t⁻¹`. -/ +def normalizedPartNonconstantSeries : FiniteSupportRing (G := ℝ) (K := ℚ) := + 1 + finiteSupportMonomial normalizedPartMinusOneExponent + +/-- The fixture `1 + t⁻¹` is not the identity. -/ +theorem normalizedPartNonconstantSeries_ne_one : + normalizedPartNonconstantSeries ≠ 1 := by + intro h + have hcoeff := congrArg + (fun p : FiniteSupportRing (G := ℝ) (K := ℚ) ↦ + (((p : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).coeff (-1))) h + norm_num [normalizedPartNonconstantSeries, normalizedPartMinusOneExponent, + coe_finiteSupportMonomial] at hcoeff + +/-- The normalized trivial-subgroup part is not merely the original nonconstant series. -/ +theorem normalizedPartNonconstantSeries_ne_embeddedPart : + normalizedPartNonconstantSeries ≠ + finiteSupportToReal TrivialExponentSubgroup + (1 : FiniteSupportRing (G := TrivialExponentSubgroup) (K := ℚ)) := by + simpa using normalizedPartNonconstantSeries_ne_one + +/-- The product theorem computes the normalized trivial-subgroup part of +`(1 + t⁻¹)²` as `1`. -/ +theorem normalizedPartNonconstantSeries_mul_isNormalizedPart : + IsNormalizedHPart TrivialExponentSubgroup + (normalizedPartNonconstantSeries * normalizedPartNonconstantSeries) 1 := by + simpa using + (isNormalizedHPart_mul TrivialExponentSubgroup + trivialExponentSubgroup_hasNormalizedHDivisorRefinement + (one_isNormalizedTrivialExponentSubgroupPart normalizedPartNonconstantSeries) + (one_isNormalizedTrivialExponentSubgroupPart normalizedPartNonconstantSeries)) + +end + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/PrincipalMaximalFiniteSupportDivisor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/PrincipalMaximalFiniteSupportDivisor.lean new file mode 100644 index 0000000000..66e418c02a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/PrincipalMaximalFiniteSupportDivisor.lean @@ -0,0 +1,246 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalMaximalFinite +import Mathlib.Tactic.NormNum + +/-! +# API checks for principal-factor invariance + +These checks exercise the field-generic cores of LM24, Lemmas 6.3.1--6.3.2. The finite-support +factor is the nonconstant monomial `t⁻¹`. The RV principal factor is represented by the +approach-zero series, so it is nonzero and nonconstant. + +For the full graded result, the principal factor has independently nonzero components in degrees +zero and one. It therefore tests `P̂` rather than a single RV component. A final boundary check +shows that replacing the nonzero principal factor by zero changes the maximal divisor. Pairwise +gcd existence remains an explicit parameter in these generic checks. +-/ + +open scoped DirectSum HahnSeries NatOrdinal + +namespace Tests + +public noncomputable section + +private theorem approachZero_ordinalValue_bound : + Berarducci.ordinalValue approachZeroNonpositive < ω^ (1 + 1 : NatOrdinal) := by + rw [Berarducci.ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal + approachZero_degree_eq_one] + exact NatOrdinal.wpow_lt_wpow.mpr (lt_add_one (1 : NatOrdinal)) + +/-- The nonzero class in `P_1` represented by the approach-zero series. -/ +def principalInvariantApproachZeroLayer : Berarducci.PrincipalComponent ℚ 1 := + Berarducci.principalComponentMk 1 approachZeroNonpositive + approachZero_ordinalValue_bound + +/-- The approach-zero class survives in the degree-one principal quotient. -/ +theorem principalInvariantApproachZeroLayer_ne_zero : + principalInvariantApproachZeroLayer ≠ 0 := by + rw [principalInvariantApproachZeroLayer, ne_eq, + Berarducci.principalComponentMk_eq_zero_iff, + Berarducci.ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal + approachZero_degree_eq_one] + exact lt_irrefl _ + +/-- The grade-zero principal class of the coefficient one. -/ +def principalInvariantScalarLayer : Berarducci.PrincipalComponent ℚ 0 := + Berarducci.principalComponentScalarHom ℚ 1 + +/-- The grade-zero class of one is nonzero. -/ +theorem principalInvariantScalarLayer_ne_zero : + principalInvariantScalarLayer ≠ 0 := by + rw [principalInvariantScalarLayer, + Berarducci.principalComponentScalarHom_apply, ne_eq, + Berarducci.principalComponentMk_eq_zero_iff, + Berarducci.ordinalValue_C_of_ne one_ne_zero] + simpa only [NatOrdinal.wpow_zero] using (lt_irrefl (1 : NatOrdinal)) + +/-- An intrinsic principal graded element supported in degrees zero and one. -/ +def principalInvariantTwoGrade : Berarducci.PrincipalSubring ℚ := + DirectSum.of _ 0 principalInvariantScalarLayer + + DirectSum.of _ 1 principalInvariantApproachZeroLayer + +/-- The two prescribed components of the intrinsic principal graded fixture are unchanged. -/ +theorem principalInvariantTwoGrade_components : + principalInvariantTwoGrade 0 = principalInvariantScalarLayer ∧ + principalInvariantTwoGrade 1 = principalInvariantApproachZeroLayer := by + simp [principalInvariantTwoGrade, DirectSum.of_apply] + +/-- The positive-degree component makes the intrinsic two-grade fixture nonzero. -/ +theorem principalInvariantTwoGrade_ne_zero : + principalInvariantTwoGrade ≠ 0 := by + intro hzero + apply principalInvariantApproachZeroLayer_ne_zero + rw [← principalInvariantTwoGrade_components.2, hzero] + rfl + +/-- The two-degree example embedded in the degree-graded ring. -/ +def principalInvariantGraded : Berarducci.DegreeGraded ℚ := + Berarducci.principalSubringEmbedding ℚ + principalInvariantTwoGrade + +/-- The embedded two-grade fixture satisfies the componentwise definition of `P̂`. -/ +theorem principalInvariantGraded_isPrincipal : + Berarducci.IsPrincipalGraded + principalInvariantGraded := by + rw [Berarducci.isPrincipalGraded_iff] + intro α + rw [principalInvariantGraded, + Berarducci.principalSubringEmbedding_apply] + exact Berarducci.principalComponentToHahnDegreeLayer_isPrincipal α (principalInvariantTwoGrade α) + +/-- Injectivity of the canonical graded embedding preserves nonzeroness of the fixture. -/ +theorem principalInvariantGraded_ne_zero : + principalInvariantGraded ≠ 0 := by + intro hzero + rw [principalInvariantGraded] at hzero + apply principalInvariantTwoGrade_ne_zero + apply Berarducci.principalSubringEmbedding_injective ℚ + simpa using hzero + +/-- The full graded principal factor has independently nonzero components in degrees zero and +one. -/ +theorem principalInvariantGraded_components_ne_zero : + principalInvariantGraded 0 ≠ 0 ∧ + principalInvariantGraded 1 ≠ 0 := by + constructor + · rw [principalInvariantGraded, Berarducci.principalSubringEmbedding_apply, + principalInvariantTwoGrade_components.1] + intro hzero + apply principalInvariantScalarLayer_ne_zero + apply Berarducci.principalComponentToHahnDegreeLayer_injective ℚ 0 + simpa using hzero + · rw [principalInvariantGraded, Berarducci.principalSubringEmbedding_apply, + principalInvariantTwoGrade_components.2] + intro hzero + apply principalInvariantApproachZeroLayer_ne_zero + apply Berarducci.principalComponentToHahnDegreeLayer_injective ℚ 1 + simpa using hzero + +/-- The strictly negative exponent used by the nonconstant finite-support fixture. -/ +def principalInvariantNegativeExponent : + HahnSeries.Nonpositive.exponentMonoid ℝ := + ⟨-1, by norm_num⟩ + +/-- The nonconstant finite-support monomial `t⁻¹`. -/ +def principalInvariantFiniteMonomial : Berarducci.FiniteSupportRing (K := ℚ) := + HahnSeries.Nonpositive.finiteSupportMonomial principalInvariantNegativeExponent + +/-- The coefficient at exponent `-1` proves that the finite-support fixture is nonzero. -/ +theorem principalInvariantFiniteMonomial_ne_zero : + principalInvariantFiniteMonomial ≠ 0 := by + intro hzero + have hcoeff := congrArg + (fun p : Berarducci.FiniteSupportRing (K := ℚ) ↦ + (((p : Berarducci.Series ℚ) : ℚ⟦ℝ⟧).coeff (-1))) hzero + simp [principalInvariantFiniteMonomial, + principalInvariantNegativeExponent] at hcoeff + +/-- The degree-RV class represented by the approach-zero principal series. -/ +def principalInvariantRV : Berarducci.HahnDegreeRV ℚ := + (HahnSeries.Nonpositive.degreeValuation ℚ).rv + approachZeroNonpositive + +/-- The approach-zero RV fixture is principal in the exact sense of LM24, Definition 5.2.1. -/ +theorem principalInvariantRV_isPrincipal : + Berarducci.IsPrincipalRV principalInvariantRV := + (Berarducci.isPrincipalRV_iff _).mpr + ⟨approachZeroNonpositive, approachZero_isPrincipal, rfl⟩ + +/-- Separatedness of the degree valuation proves that the approach-zero RV fixture is nonzero. -/ +theorem principalInvariantRV_ne_zero : principalInvariantRV ≠ 0 := by + intro hzero + let w := HahnSeries.Nonpositive.degreeValuation ℚ + have hbot : w approachZeroNonpositive = ⊥ := by + exact w.rv_eq_zero_iff.mp hzero + have hsep := + (MaxAddDegree.isSeparated_iff w).mp + (HahnSeries.Nonpositive.degreeValuation_isSeparated ℚ) + exact approachZero_ne_zero ((hsep approachZeroNonpositive).mp hbot) + +/-- Multiplication by the nonhomogeneous two-grade principal fixture preserves the normalized +maximal finite-support divisor of the negative monomial. -/ +theorem principalInvariant_fullGraded (hgcd : ∀ p q : Berarducci.FiniteSupportRing (K := ℚ), + ∃ d : Berarducci.FiniteSupportRing (K := ℚ), + ∀ e : Berarducci.FiniteSupportRing (K := ℚ), + e ∣ p ∧ e ∣ q ↔ e ∣ d) : + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor + (Berarducci.finiteSupportGradedEmbedding ℚ + principalInvariantFiniteMonomial * + principalInvariantGraded) = + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor + (Berarducci.finiteSupportGradedEmbedding ℚ + principalInvariantFiniteMonomial) := by + exact + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor_mul_principal_eq_of_exists_gcd hgcd _ + principalInvariantGraded_isPrincipal + principalInvariantGraded_ne_zero + +/-- The same nonzero graded input has a different normalized maximal divisor after multiplication +by zero, certifying the nonzero-factor boundary. -/ +theorem principalInvariant_zero_factor_changes_divisor + (hgcd : ∀ p q : Berarducci.FiniteSupportRing (K := ℚ), + ∃ d : Berarducci.FiniteSupportRing (K := ℚ), + ∀ e : Berarducci.FiniteSupportRing (K := ℚ), + e ∣ p ∧ e ∣ q ↔ e ∣ d) : + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor + (Berarducci.finiteSupportGradedEmbedding ℚ + principalInvariantFiniteMonomial * 0) ≠ + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor + (Berarducci.finiteSupportGradedEmbedding ℚ + principalInvariantFiniteMonomial) := by + have hB : Berarducci.finiteSupportGradedEmbedding ℚ + principalInvariantFiniteMonomial ≠ 0 := by + intro hzero + apply principalInvariantFiniteMonomial_ne_zero + apply Berarducci.finiteSupportGradedEmbedding_injective ℚ + simpa using hzero + have hright := + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor_isMonic_of_ne_zero hgcd hB |>.ne_zero + have hleft : + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor + (Berarducci.finiteSupportGradedEmbedding ℚ + principalInvariantFiniteMonomial * 0) = 0 := by + rw [mul_zero] + have hspec := + (Berarducci.isNormalizedGradedMaximalFiniteSupportDivisor_iff (0 : + Berarducci.DegreeGraded ℚ) _).mp + (Berarducci.gradedNormalizedMaximalFiniteSupportDivisor_is_of_exists_gcd hgcd + (0 : Berarducci.DegreeGraded ℚ)) + rcases hspec.2 with hzero | hnonzero + · exact hzero.2 + · exact (hnonzero.1 rfl).elim + rw [hleft] + exact Ne.symm hright + +/-- Multiplication by the nonconstant approach-zero principal RV class preserves the normalized +maximal finite-support divisor of the negative-monomial RV class. -/ +theorem principalInvariant_rv (hgcd : ∀ p q : Berarducci.FiniteSupportRing (K := ℚ), + ∃ d : Berarducci.FiniteSupportRing (K := ℚ), + ∀ e : Berarducci.FiniteSupportRing (K := ℚ), + e ∣ p ∧ e ∣ q ↔ e ∣ d) : + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor + ((HahnSeries.Nonpositive.degreeValuation ℚ).rvInitialFormHom + (Berarducci.finiteSupportRVEmbedding ℚ principalInvariantFiniteMonomial * + principalInvariantRV)) = + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor + ((HahnSeries.Nonpositive.degreeValuation ℚ).rvInitialFormHom + (Berarducci.finiteSupportRVEmbedding ℚ + principalInvariantFiniteMonomial)) := by + exact + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor_rv_mul_principal_eq_of_exists_gcd hgcd _ + principalInvariantRV_isPrincipal + principalInvariantRV_ne_zero + +end + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/SectionSixFour.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/SectionSixFour.lean new file mode 100644 index 0000000000..5653e01daf --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/SectionSixFour.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.FiniteSupportFactorUniqueness + +import Mathlib.Tactic.NormNum + +/-! +# API checks for LM24 Section 6.4 + +The empty-list fixture certifies that the source natural number `n` may be zero. The sign-change +fixture gives two factorisations of the same series with finite-support factors `1` and `-1`. +Those factors are unequal but differ by a nonzero coefficient scalar, separating the source's +uniqueness up to scalar from the stronger and false assertion of literal equality. + +The full uniqueness statement retains every unresolved mathematical prerequisite as an explicit +hypothesis. +-/ + +open scoped HahnSeries + +namespace Tests + +public noncomputable section + +open Berarducci HahnSeries.Nonpositive + +/-- The multiplicative identity has a Section 6.4 factorisation with no infinite-support +factors. -/ +theorem one_empty_infiniteSupportIrreducibleFactorization : + IsInfiniteSupportIrreducibleFactorization + (1 : Series ℚ) (1 : FiniteSupportRing (K := ℚ)) [] := by + rw [isInfiniteSupportIrreducibleFactorization_iff] + simp + +private theorem neg_irreducible {c : Series ℚ} (hc : Irreducible c) : + Irreducible (-c) := + Associated.irreducible ⟨-1, mul_neg_one c⟩ hc + +private theorem neg_support_infinite {c : Series ℚ} + (hc : (c : ℚ⟦ℝ⟧).support.Infinite) : + ((-c : Series ℚ) : ℚ⟦ℝ⟧).support.Infinite := by + change (-((c : Series ℚ) : ℚ⟦ℝ⟧)).support.Infinite + simpa only [HahnSeries.support_neg] using hc + +/-- A sign change may be transferred between the finite-support factor and the sole listed +infinite-support factor. -/ +theorem neg_one_neg_factorization {c : Series ℚ} + (hcIrreducible : Irreducible c) + (hcInfinite : (c : ℚ⟦ℝ⟧).support.Infinite) : + IsInfiniteSupportIrreducibleFactorization c + (-1 : FiniteSupportRing (K := ℚ)) [-c] := by + rw [isInfiniteSupportIrreducibleFactorization_iff] + constructor + · simp + · simp only [List.mem_singleton, forall_eq] + exact ⟨neg_irreducible hcIrreducible, neg_support_infinite hcInfinite⟩ + +/-- The two sign-related finite-support factors are not literally equal. -/ +theorem neg_one_finiteSupportFactor_ne_one : + (-1 : FiniteSupportRing (K := ℚ)) ≠ 1 := by + intro h + have hcoeff := congrArg + (fun p : FiniteSupportRing (K := ℚ) ↦ + ((p : Series ℚ) : ℚ⟦ℝ⟧).coeff 0) h + norm_num at hcoeff + +/-- The Section 6.4 uniqueness theorem identifies the sign-related finite-support factors up to +a nonzero coefficient scalar. -/ +theorem sign_changed_factorizations_are_unique_up_to_scalar + (hgcd : ∀ p q : FiniteSupportRing (K := ℚ), + ∃ d : FiniteSupportRing (K := ℚ), + ∀ e : FiniteSupportRing (K := ℚ), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hunits : ∀ p : FiniteSupportRing (K := ℚ), + IsUnit p ↔ ∃ k : ℚ, k ≠ 0 ∧ + p = finiteSupportScalarHom (G := ℝ) k) + (hmaxMul : ∀ b c : Series ℚ, + seriesNormalizedMaximalFiniteSupportDivisor (b * c) = + seriesNormalizedMaximalFiniteSupportDivisor b * + seriesNormalizedMaximalFiniteSupportDivisor c) + {c : Series ℚ} (hcIrreducible : Irreducible c) + (hcInfinite : (c : ℚ⟦ℝ⟧).support.Infinite) : + ∃ k : ℚ, k ≠ 0 ∧ + (-1 : FiniteSupportRing (K := ℚ)) = + finiteSupportScalarHom (G := ℝ) k * 1 := by + have hpositive : IsInfiniteSupportIrreducibleFactorization c + (1 : FiniteSupportRing (K := ℚ)) [c] := by + rw [isInfiniteSupportIrreducibleFactorization_iff] + constructor + · simp + · simp only [List.mem_singleton, forall_eq] + exact ⟨hcIrreducible, hcInfinite⟩ + exact finiteSupportFactor_eq_scalar_mul_of_factorizations + (b := c) (p := (1 : FiniteSupportRing (K := ℚ))) + (q := (-1 : FiniteSupportRing (K := ℚ))) + (factors := [c]) (otherFactors := [-c]) + hgcd hunits hmaxMul hpositive (neg_one_neg_factorization hcIrreducible hcInfinite) + +end + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/SeriesMaximalFiniteSupportDivisor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/SeriesMaximalFiniteSupportDivisor.lean new file mode 100644 index 0000000000..bd87a4698c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/SeriesMaximalFiniteSupportDivisor.lean @@ -0,0 +1,319 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero + +/-! +# API checks for series-level maximal finite-support divisors + +This module formalizes the mechanism in LM24, Example 5.5.4. Put `x = t⁻¹`, let +`p₀ = 1 - x²`, let `p₁ = x + 1`, and let `a` be the principal series with support +`{-1/(n+1) | n ∈ ℕ}`. The series tested here is + +`b = p₀ * a + p₁`. + +The leading RV class of `b` has normalized maximal finite-support divisor `p₀`, whereas the +full series has normalized maximal finite-support divisor `p₁`. The proof also certifies that +`p₀ ≠ p₁`. Thus the client rejects the incorrect shortcut that defines the series-level +divisor solely from the leading RV class. Pairwise gcd existence and unit classification remain +explicit parameters. +-/ + +open scoped HahnSeries NatOrdinal + +namespace Tests + +public noncomputable section + +/-- The finite-support monomial `x = t⁻¹` used in LM24, Example 5.5.4. -/ +def seriesMaximalExampleMonomial : Berarducci.FiniteSupportRing (K := ℚ) := + HahnSeries.Nonpositive.finiteSupportMonomial (K := ℚ) ⟨-1, by norm_num⟩ + +/-- The leading-RV maximal divisor `p₀ = 1 - t⁻²` from LM24, Example 5.5.4. -/ +def seriesMaximalExampleRVDivisor : Berarducci.FiniteSupportRing (K := ℚ) := + 1 - seriesMaximalExampleMonomial * seriesMaximalExampleMonomial + +/-- The full-series maximal divisor `p₁ = t⁻¹ + 1` from LM24, Example 5.5.4. -/ +def seriesMaximalExampleDivisor : Berarducci.FiniteSupportRing (K := ℚ) := + seriesMaximalExampleMonomial + 1 + +/-- The Hahn series `b = (1 - t⁻²)a + (t⁻¹ + 1)` from LM24, Example 5.5.4. -/ +def seriesMaximalExample : Berarducci.Series ℚ := + (seriesMaximalExampleRVDivisor : Berarducci.Series ℚ) * + approachZeroNonpositive + + (seriesMaximalExampleDivisor : Berarducci.Series ℚ) + +/-- The full-series divisor `t⁻¹ + 1` is monic at its greatest support exponent. -/ +theorem seriesMaximalExampleDivisor_isMonic : + HahnSeries.Nonpositive.IsMonicFiniteSupport seriesMaximalExampleDivisor := by + rw [HahnSeries.Nonpositive.isMonicFiniteSupport_iff] + refine ⟨0, ⟨?_, ?_⟩, ?_⟩ + · rw [HahnSeries.mem_support] + simp [seriesMaximalExampleDivisor, seriesMaximalExampleMonomial] + · intro g hg + exact HahnSeries.Nonpositive.support_subset + (seriesMaximalExampleDivisor : HahnSeries.Nonpositive ℝ ℚ) hg + · simp [seriesMaximalExampleDivisor, seriesMaximalExampleMonomial] + +/-- The coefficient of `1 - t⁻²` at its greatest support exponent is one. -/ +theorem seriesMaximalExampleRVDivisor_coeff_zero : + (((seriesMaximalExampleRVDivisor : Berarducci.Series ℚ) : ℚ⟦ℝ⟧).coeff 0) = + 1 := by + simp only [seriesMaximalExampleRVDivisor, seriesMaximalExampleMonomial, + HahnSeries.Nonpositive.finiteSupportMonomial_mul, AddSubgroupClass.coe_sub, + OneMemClass.coe_one, HahnSeries.Nonpositive.coe_finiteSupportMonomial, + HahnSeries.coeff_sub', Pi.sub_apply, HahnSeries.coeff_one, reduceIte, sub_eq_self] + rw [HahnSeries.coeff_single_of_ne (by norm_num)] + +/-- The leading-RV divisor `1 - t⁻²` is monic at its greatest support exponent. -/ +theorem seriesMaximalExampleRVDivisor_isMonic : + HahnSeries.Nonpositive.IsMonicFiniteSupport seriesMaximalExampleRVDivisor := by + rw [HahnSeries.Nonpositive.isMonicFiniteSupport_iff] + refine ⟨0, ⟨?_, ?_⟩, seriesMaximalExampleRVDivisor_coeff_zero⟩ + · rw [HahnSeries.mem_support, seriesMaximalExampleRVDivisor_coeff_zero] + norm_num + · intro g hg + exact HahnSeries.Nonpositive.support_subset + (seriesMaximalExampleRVDivisor : HahnSeries.Nonpositive ℝ ℚ) hg + +/-- The leading-RV divisor is nonzero. -/ +theorem seriesMaximalExampleRVDivisor_ne_zero : + seriesMaximalExampleRVDivisor ≠ 0 := + seriesMaximalExampleRVDivisor_isMonic.ne_zero + +/-- The leading-RV and full-series divisors in LM24, Example 5.5.4 are distinct. -/ +theorem seriesMaximalExample_divisors_ne : + seriesMaximalExampleRVDivisor ≠ seriesMaximalExampleDivisor := by + intro h + have hcoeff := congrArg + (fun p : Berarducci.FiniteSupportRing (K := ℚ) ↦ + (((p : Berarducci.Series ℚ) : ℚ⟦ℝ⟧).coeff (-1))) h + simp [seriesMaximalExampleRVDivisor, seriesMaximalExampleDivisor, + seriesMaximalExampleMonomial] at hcoeff + +/-- The full-series divisor divides the leading-RV divisor: +`t⁻¹ + 1 ∣ 1 - t⁻²`. -/ +theorem seriesMaximalExampleDivisor_dvd_rvDivisor : + seriesMaximalExampleDivisor ∣ seriesMaximalExampleRVDivisor := by + refine ⟨1 - seriesMaximalExampleMonomial, ?_⟩ + dsimp only [seriesMaximalExampleRVDivisor, seriesMaximalExampleDivisor] + ring + +/-- The associated-graded representative of the leading RV class in LM24, +Example 5.5.4. -/ +def seriesMaximalExampleLeadingGraded : + Berarducci.DegreeGraded ℚ := + (((HahnSeries.Nonpositive.degreeValuation ℚ).rvEquivHomogeneous + ((HahnSeries.Nonpositive.degreeValuation ℚ).rv + seriesMaximalExample) : + (HahnSeries.Nonpositive.degreeValuation ℚ).HomogeneousClasses) : + Berarducci.DegreeGraded ℚ) + +/-- The leading-RV divisor has Hahn-series degree zero. -/ +theorem seriesMaximalExampleRVDivisor_degree : + ((seriesMaximalExampleRVDivisor : Berarducci.Series ℚ) : ℚ⟦ℝ⟧).degree = + 0 := by + rw [HahnSeries.degree_eq_zero] + exact ⟨by + intro hzero + apply seriesMaximalExampleRVDivisor_ne_zero + exact Subtype.ext (Subtype.ext hzero), + (HahnSeries.Nonpositive.mem_finiteSupportSubring_iff + (seriesMaximalExampleRVDivisor : Berarducci.Series ℚ)).mp + seriesMaximalExampleRVDivisor.2⟩ + +/-- The full-series divisor has Hahn-series degree zero. -/ +theorem seriesMaximalExampleDivisor_degree : + ((seriesMaximalExampleDivisor : Berarducci.Series ℚ) : ℚ⟦ℝ⟧).degree = 0 := by + rw [HahnSeries.degree_eq_zero] + exact ⟨by + intro hzero + apply seriesMaximalExampleDivisor_isMonic.ne_zero + exact Subtype.ext (Subtype.ext hzero), + (HahnSeries.Nonpositive.mem_finiteSupportSubring_iff + (seriesMaximalExampleDivisor : Berarducci.Series ℚ)).mp + seriesMaximalExampleDivisor.2⟩ + +/-- The leading term `(1 - t⁻²)a` has degree one. -/ +theorem seriesMaximalExample_leading_degree : + (((seriesMaximalExampleRVDivisor : Berarducci.Series ℚ) * + approachZeroNonpositive : Berarducci.Series ℚ) : ℚ⟦ℝ⟧).degree = 1 := by + rw [HahnSeries.Nonpositive.degree_mul, seriesMaximalExampleRVDivisor_degree, + approachZero_degree_eq_one, zero_add] + +/-- The series in LM24, Example 5.5.4 has degree one. -/ +theorem seriesMaximalExample_degree : + (seriesMaximalExample : ℚ⟦ℝ⟧).degree = 1 := by + calc + (seriesMaximalExample : ℚ⟦ℝ⟧).degree = + (((seriesMaximalExampleRVDivisor : Berarducci.Series ℚ) * + approachZeroNonpositive : Berarducci.Series ℚ) : ℚ⟦ℝ⟧).degree := by + apply HahnSeries.degree_add_eq_left_of_lt + rw [seriesMaximalExample_leading_degree, + seriesMaximalExampleDivisor_degree] + norm_num + _ = 1 := seriesMaximalExample_leading_degree + +/-- The leading RV class of the example is the RV class of `(1 - t⁻²)a`. -/ +theorem seriesMaximalExample_rv_eq : + (HahnSeries.Nonpositive.degreeValuation ℚ).rv + seriesMaximalExample = + (HahnSeries.Nonpositive.degreeValuation ℚ).rv + ((seriesMaximalExampleRVDivisor : Berarducci.Series ℚ) * + approachZeroNonpositive) := by + let w := HahnSeries.Nonpositive.degreeValuation ℚ + have hvalue : w seriesMaximalExample ≠ ⊥ := by + rw [HahnSeries.Nonpositive.degreeValuation_apply, + seriesMaximalExample_degree] + norm_num + apply (w.rv_eq_iff_of_value_ne_bot hvalue).mpr + rw [HahnSeries.Nonpositive.degreeValuation_apply, + HahnSeries.Nonpositive.degreeValuation_apply, + seriesMaximalExample_degree] + have hdiff : seriesMaximalExample - + (seriesMaximalExampleRVDivisor : Berarducci.Series ℚ) * + approachZeroNonpositive = + (seriesMaximalExampleDivisor : Berarducci.Series ℚ) := by + simp only [seriesMaximalExample] + abel + rw [hdiff, seriesMaximalExampleDivisor_degree] + norm_num + +/-- The associated-graded representative of the example's leading RV class is its +degree-one initial form. -/ +theorem seriesMaximalExampleLeadingGraded_eq : + seriesMaximalExampleLeadingGraded = + DirectSum.of + (HahnSeries.Nonpositive.degreeValuation ℚ).Component + 1 + (Berarducci.degreeLayerMk 1 + ((seriesMaximalExampleRVDivisor : Berarducci.Series ℚ) * + approachZeroNonpositive) + seriesMaximalExample_leading_degree.le) := by + rw [seriesMaximalExampleLeadingGraded, seriesMaximalExample_rv_eq] + calc + _ = (Berarducci.degreeHomogeneousClass 1 + (Berarducci.degreeLayerMk 1 + ((seriesMaximalExampleRVDivisor : Berarducci.Series ℚ) * + approachZeroNonpositive) + seriesMaximalExample_leading_degree.le) : + Berarducci.DegreeGraded ℚ) := + congrArg Subtype.val + (Berarducci.rvEquivHomogeneous_rv_eq_degreeHomogeneousClass 1 + ((seriesMaximalExampleRVDivisor : Berarducci.Series ℚ) * + approachZeroNonpositive) + seriesMaximalExample_leading_degree) + _ = _ := Berarducci.coe_degreeHomogeneousClass 1 _ + +/-- The leading RV class has maximal finite-support divisor class represented by +`1 - t⁻²`. -/ +theorem seriesMaximalExample_isRVMaximalFiniteSupportDivisor : + Berarducci.IsRVMaximalFiniteSupportDivisor + ((HahnSeries.Nonpositive.degreeValuation ℚ).rv + seriesMaximalExample) + (Associates.mk seriesMaximalExampleRVDivisor) := by + rw [seriesMaximalExample_rv_eq] + exact Berarducci.isRVMaximalFiniteSupportDivisor_finiteSupport_mul_principal 1 + seriesMaximalExampleRVDivisor + seriesMaximalExampleRVDivisor_ne_zero approachZeroNonpositive + approachZero_isPrincipal approachZero_degree_eq_one + +/-- The associated-graded representative of the leading RV class has maximal +finite-support divisor represented by `1 - t⁻²`. -/ +theorem seriesMaximalExample_isGradedMaximalFiniteSupportDivisor : + Berarducci.IsGradedMaximalFiniteSupportDivisor + seriesMaximalExampleLeadingGraded + (Associates.mk seriesMaximalExampleRVDivisor) := by + rw [seriesMaximalExampleLeadingGraded_eq] + exact Berarducci.isGradedMaximalFiniteSupportDivisor_finiteSupport_mul_principal 1 + seriesMaximalExampleRVDivisor approachZeroNonpositive + approachZero_isPrincipal approachZero_degree_eq_one + +/-- The full series has maximal finite-support divisor class represented by `t⁻¹ + 1`. -/ +theorem seriesMaximalExample_isSeriesMaximalFiniteSupportDivisor : + Berarducci.IsSeriesMaximalFiniteSupportDivisor seriesMaximalExample + (Associates.mk seriesMaximalExampleDivisor) := by + apply (Berarducci.isSeriesMaximalFiniteSupportDivisor_mk_iff + seriesMaximalExample seriesMaximalExampleDivisor).mpr + intro q + rw [Berarducci.coe_dvd_iff_dvd_rvMaximal_and_residual + seriesMaximalExample approachZeroNonpositive seriesMaximalExampleRVDivisor q + seriesMaximalExample_isRVMaximalFiniteSupportDivisor] + have hresidual : seriesMaximalExample - + (seriesMaximalExampleRVDivisor : Berarducci.Series ℚ) * + approachZeroNonpositive = + (seriesMaximalExampleDivisor : Berarducci.Series ℚ) := by + simp only [seriesMaximalExample] + abel + rw [hresidual, ← Berarducci.finiteSupport_dvd_iff_coe_dvd] + constructor + · exact fun h ↦ h.2 + · intro hq + exact ⟨dvd_trans hq seriesMaximalExampleDivisor_dvd_rvDivisor, hq⟩ + +variable + (hgcd : ∀ p q : Berarducci.FiniteSupportRing (K := ℚ), + ∃ d : Berarducci.FiniteSupportRing (K := ℚ), + ∀ e : Berarducci.FiniteSupportRing (K := ℚ), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hunits : ∀ u : Berarducci.FiniteSupportRing (K := ℚ), + IsUnit u ↔ ∃ k : ℚ, k ≠ 0 ∧ + u = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k) + +include hgcd hunits in +/-- The earlier normalized divisor from LM24, Notation 5.4.5 is exactly `1 - t⁻²` on +the leading class in Example 5.5.4. -/ +theorem seriesMaximalExample_gradedNormalized_eq : + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor + seriesMaximalExampleLeadingGraded = + seriesMaximalExampleRVDivisor := by + apply Berarducci.gradedNormalizedMaximalFiniteSupportDivisor_eq_of_is hgcd hunits + apply (Berarducci.isNormalizedGradedMaximalFiniteSupportDivisor_iff _ _).mpr + exact ⟨(Berarducci.isGradedMaximalFiniteSupportDivisor_mk_iff _ _).mp + seriesMaximalExample_isGradedMaximalFiniteSupportDivisor, + Or.inr ⟨by + intro hzero + have hclass := + seriesMaximalExample_isGradedMaximalFiniteSupportDivisor + rw [hzero] at hclass + have hzeroMax : + Berarducci.IsGradedMaximalFiniteSupportDivisor + (0 : Berarducci.DegreeGraded ℚ) 0 := by + rw [Berarducci.isGradedMaximalFiniteSupportDivisor_iff] + intro q + constructor + · intro _ + exact dvd_zero _ + · intro _ + exact Associates.mk_le_mk_of_dvd (dvd_zero q) + have hmkZero := hclass.eq hzeroMax + exact seriesMaximalExampleRVDivisor_ne_zero + (Associates.mk_eq_zero.mp hmkZero), + seriesMaximalExampleRVDivisor_isMonic⟩⟩ + +include hgcd hunits in +/-- The chosen normalized series-level maximal divisor of the example is `t⁻¹ + 1`, not +the normalized leading-RV divisor `1 - t⁻²`. -/ +theorem seriesMaximalExample_normalized_eq : + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor seriesMaximalExample = + seriesMaximalExampleDivisor := by + apply Berarducci.seriesNormalizedMaximalFiniteSupportDivisor_eq_of_is hgcd hunits + apply (Berarducci.isNormalizedSeriesMaximalFiniteSupportDivisor_iff _ _).mpr + exact ⟨(Berarducci.isSeriesMaximalFiniteSupportDivisor_mk_iff _ _).mp + seriesMaximalExample_isSeriesMaximalFiniteSupportDivisor, + Or.inr ⟨by + intro hzero + have hHahn : (seriesMaximalExample : ℚ⟦ℝ⟧) = 0 := + congrArg Subtype.val hzero + have hdegree := HahnSeries.degree_eq_bot.mpr hHahn + rw [seriesMaximalExample_degree] at hdegree + norm_num at hdegree, + seriesMaximalExampleDivisor_isMonic⟩⟩ + +end + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupport.lean new file mode 100644 index 0000000000..df16624e79 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupport.lean @@ -0,0 +1,340 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import Mathlib.Algebra.Order.Monoid.Submonoid +public import Mathlib.LinearAlgebra.Basis.Defs +public import Mathlib.LinearAlgebra.DFinsupp + +import Mathlib.LinearAlgebra.Finsupp.VectorSpace +import Mathlib.RingTheory.HahnSeries.Cardinal + +/-! +# Finite-support Hahn series + +This file packages finite-support Hahn series as the specialization at `Cardinal.aleph0` of +Mathlib's cardinal-bounded Hahn-series subring. It also pulls that subring back to nonpositive +Hahn series. The latter is the ring denoted by `K(G^{≤ 0})` in LM24. +-/ + +universe u v + +public noncomputable section + +namespace HahnSeries + +variable {G : Type u} {K : Type v} + +section HahnSeries + +variable [PartialOrder G] [AddCommMonoid G] [IsOrderedCancelAddMonoid G] [Ring K] + +/-- The subring of Hahn series with finite support. -/ +def finiteSupportSubring : Subring K⟦G⟧ := + let _ : Fact (Cardinal.aleph0 ≤ Cardinal.aleph0) := ⟨le_rfl⟩ + HahnSeries.cardSuppLTSubring G K Cardinal.aleph0 + +/-- Membership in the finite-support subring is finiteness of the Hahn-series support. -/ +@[simp] +theorem mem_finiteSupportSubring_iff (b : K⟦G⟧) : + b ∈ (finiteSupportSubring : Subring K⟦G⟧) ↔ b.support.Finite := by + letI : Fact (Cardinal.aleph0 ≤ Cardinal.aleph0) := ⟨le_rfl⟩ + rw [finiteSupportSubring, HahnSeries.mem_cardSuppLTSubring, HahnSeries.cardSupp] + exact Cardinal.lt_aleph0_iff_set_finite + +end HahnSeries + +namespace Nonpositive + +/-- The additive monoid of nonpositive exponents. -/ +abbrev exponentMonoid (G : Type u) [PartialOrder G] [AddCommGroup G] + [IsOrderedAddMonoid G] : AddSubmonoid G where + carrier := Set.Iic 0 + zero_mem' := le_rfl + add_mem' := add_nonpos + +/-- Zero is the largest nonpositive exponent. -/ +instance exponentMonoidOrderTop (G : Type u) [PartialOrder G] [AddCommGroup G] + [IsOrderedAddMonoid G] : OrderTop (exponentMonoid G) where + top := 0 + le_top g := g.2 + +@[simp] +theorem exponentMonoid_top_eq_zero (G : Type u) [PartialOrder G] [AddCommGroup G] + [IsOrderedAddMonoid G] : (⊤ : exponentMonoid G) = 0 := + rfl + +variable [PartialOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] [Ring K] + +/-- The subring of nonpositive Hahn series with finite support. -/ +def finiteSupportSubring : Subring (Nonpositive G K) := + HahnSeries.finiteSupportSubring.comap (HahnSeries.nonpositiveSubring G K).subtype + +/-- The type of finite-support nonpositive Hahn series. -/ +abbrev FiniteSupportRing := + (finiteSupportSubring : Subring (Nonpositive G K)) + +/-! The structures on the finite-support ring, named here rather than rebuilt at each use. +`Zero` is the one that matters: it is asked for by every comparison against `0`, and resolving it +through the `Subring` membership classes is not cheap. -/ + +instance : Zero (FiniteSupportRing (G := G) (K := K)) := inferInstance + +instance : One (FiniteSupportRing (G := G) (K := K)) := inferInstance + +instance : Semiring (FiniteSupportRing (G := G) (K := K)) := inferInstance + +instance : Ring (FiniteSupportRing (G := G) (K := K)) := inferInstance + +/-- The finite-support ring acts faithfully on the series ring, because it is a subring of it. +Named here because the generic route to this instance goes through torsion-freeness and freeness +first and is too expensive to re-run at every use. -/ +instance : FaithfulSMul (FiniteSupportRing (G := G) (K := K)) (Nonpositive G K) := + ⟨fun h ↦ Subtype.ext (eq_of_smul_eq_smul h)⟩ + +/-- Membership in the nonpositive finite-support subring is finiteness of the underlying support. +-/ +@[simp] +theorem mem_finiteSupportSubring_iff (b : Nonpositive G K) : + b ∈ (finiteSupportSubring : Subring (Nonpositive G K)) ↔ + (b : K⟦G⟧).support.Finite := by + rw [finiteSupportSubring, Subring.mem_comap] + rw [HahnSeries.mem_finiteSupportSubring_iff] + simp only [Subring.subtype_apply] + +end Nonpositive + +namespace Nonpositive + +variable [PartialOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] [CommRing K] + +instance : CommRing (FiniteSupportRing (G := G) (K := K)) := inferInstance + +/-- The coefficient field embeds in the finite-support ring as constant Hahn series. -/ +def finiteSupportScalarHom : + K →+* (finiteSupportSubring : Subring (Nonpositive G K)) := + (C : K →+* Nonpositive G K).codRestrict finiteSupportSubring fun k ↦ by + rw [mem_finiteSupportSubring_iff, coe_C] + exact Set.Finite.subset (Set.finite_singleton (0 : G)) + HahnSeries.support_single_subset + +/-- The canonical coefficient-algebra structure on the finite-support ring. -/ +noncomputable instance finiteSupportAlgebra : + Algebra K (finiteSupportSubring : Subring (Nonpositive G K)) := + finiteSupportScalarHom.toAlgebra + +/-- Scalar multiplication in the finite-support algebra is multiplication by a constant +series. -/ +theorem smul_finiteSupport_eq_scalar_mul + (k : K) (b : (finiteSupportSubring : Subring (Nonpositive G K))) : + k • b = finiteSupportScalarHom k * b := by + rw [Algebra.smul_def] + rfl + +/-- The scalar map is the constant-series embedding on underlying Hahn series. -/ +@[simp] +theorem coe_finiteSupportScalarHom (k : K) : + ((((finiteSupportScalarHom (G := G) k : + (finiteSupportSubring : Subring (Nonpositive G K))) : + Nonpositive G K) : K⟦G⟧)) = HahnSeries.C k := + coe_C k + +/-- The constant-series embedding into the finite-support ring is injective. -/ +theorem finiteSupportScalarHom_injective : + Function.Injective (finiteSupportScalarHom (G := G) : + K → (finiteSupportSubring : Subring (Nonpositive G K))) := by + intro k l hkl + have hcoeff := congrArg + (fun b : (finiteSupportSubring : Subring (Nonpositive G K)) ↦ + ((b : Nonpositive G K) : K⟦G⟧)) hkl + apply (HahnSeries.C_injective (R := K) (Γ := G)) + simpa only [coe_finiteSupportScalarHom] using hcoeff + +/-- Read a finite-support nonpositive Hahn series as its finitely supported coefficient +function on the nonpositive exponents. -/ +def finiteSupportCoefficients : + (finiteSupportSubring : Subring (Nonpositive G K)) →ₗ[K] + (exponentMonoid G →₀ K) where + toFun b := Finsupp.ofSupportFinite + (fun g ↦ ((b : Nonpositive G K) : K⟦G⟧).coeff g) + (by + rw [show Function.support (fun g : exponentMonoid G ↦ + ((b : Nonpositive G K) : K⟦G⟧).coeff g) = + ((b : Nonpositive G K) : K⟦G⟧).support.preimage Subtype.val from rfl] + apply Set.Finite.preimage Subtype.val_injective.injOn + exact (mem_finiteSupportSubring_iff (b : Nonpositive G K)).mp b.2) + map_add' b c := by + ext g + simp only [Finsupp.ofSupportFinite_coe] + exact HahnSeries.coeff_add + map_smul' k b := by + ext g + simp only [Finsupp.ofSupportFinite_coe] + change (((((finiteSupportScalarHom (G := G) k) * b : + (finiteSupportSubring : Subring (Nonpositive G K))) : + Nonpositive G K) : K⟦G⟧).coeff g) = _ + rw [Subring.coe_mul] + change ((C k : Nonpositive G K) * (b : Nonpositive G K) : K⟦G⟧).coeff g = _ + rw [coe_C, HahnSeries.C_mul_eq_smul, HahnSeries.coeff_smul] + rfl + +/-- Evaluating the coefficient map returns the corresponding Hahn-series coefficient. -/ +@[simp] +theorem finiteSupportCoefficients_apply + (b : (finiteSupportSubring : Subring (Nonpositive G K))) + (g : exponentMonoid G) : + finiteSupportCoefficients b g = ((b : Nonpositive G K) : K⟦G⟧).coeff g := by + exact congrFun Finsupp.ofSupportFinite_coe g + +private theorem finiteSupportCoefficients_injective : + Function.Injective + (finiteSupportCoefficients (G := G) (K := K)) := by + intro b c hbc + apply Subtype.ext + apply Subtype.ext + apply HahnSeries.coeff_injective + funext g + by_cases hg : g ≤ 0 + · have h := DFunLike.congr_fun hbc ⟨g, hg⟩ + simpa only [finiteSupportCoefficients_apply] using h + · have hgb : g ∉ ((b : Nonpositive G K) : K⟦G⟧).support := by + intro hsupport + exact hg (support_subset (b : Nonpositive G K) hsupport) + have hgc : g ∉ ((c : Nonpositive G K) : K⟦G⟧).support := by + intro hsupport + exact hg (support_subset (c : Nonpositive G K) hsupport) + rw [HahnSeries.mem_support] at hgb hgc + exact (not_ne_iff.mp hgb).trans (not_ne_iff.mp hgc).symm + +private theorem finiteSupportCoefficients_surjective : + Function.Surjective + (finiteSupportCoefficients (G := G) (K := K)) := by + intro f + let e : exponentMonoid G ↪ G := Function.Embedding.subtype _ + let f' : G →₀ K := Finsupp.embDomain e f + let bHahn : K⟦G⟧ := HahnSeries.ofFinsupp f' + have hbSupport : bHahn.support ⊆ Set.Iic 0 := by + intro g hg + have hgf' : f' g ≠ 0 := by + simpa [bHahn, HahnSeries.mem_support] using hg + have hgrange : g ∈ Set.range e := by + contrapose! hgf' + exact Finsupp.embDomain_notin_range e f g hgf' + obtain ⟨x, rfl⟩ := hgrange + exact x.2 + let b : Nonpositive G K := + ⟨bHahn, (mem_nonpositiveSubring (x := bHahn)).mpr hbSupport⟩ + have hbFinite : ((b : Nonpositive G K) : K⟦G⟧).support.Finite := by + change (Function.support (f' : G → K)).Finite + exact f'.hasFiniteSupport + let bd : (finiteSupportSubring : Subring (Nonpositive G K)) := ⟨b, by + rw [mem_finiteSupportSubring_iff] + exact hbFinite⟩ + refine ⟨bd, ?_⟩ + ext g + rw [finiteSupportCoefficients_apply] + change f' g = f g + exact Finsupp.embDomain_apply_self e f g + +/-- Finite-support nonpositive Hahn series are linearly equivalent to finitely supported +coefficient functions on the nonpositive exponents. -/ +def finiteSupportFinsuppEquiv : + (finiteSupportSubring : Subring (Nonpositive G K)) ≃ₗ[K] + (exponentMonoid G →₀ K) := + LinearEquiv.ofBijective finiteSupportCoefficients + ⟨finiteSupportCoefficients_injective, finiteSupportCoefficients_surjective⟩ + +/-- The finite-support linear equivalence evaluates as the coefficient map. -/ +@[simp] +theorem finiteSupportFinsuppEquiv_apply + (b : (finiteSupportSubring : Subring (Nonpositive G K))) : + finiteSupportFinsuppEquiv b = finiteSupportCoefficients b := + (rfl) + +/-- The finite-support monomial `t^g`, for a nonpositive exponent `g`. -/ +def finiteSupportMonomial (g : exponentMonoid G) : + (finiteSupportSubring : Subring (Nonpositive G K)) := + ⟨single (g : G) (1 : K) g.2, by + rw [mem_finiteSupportSubring_iff, coe_single] + exact Set.Finite.subset (Set.finite_singleton (g : G)) + (HahnSeries.support_single_subset (a := (g : G)) (r := (1 : K)))⟩ + +/-- The underlying Hahn series of a finite-support monomial is the corresponding singleton. -/ +@[simp] +theorem coe_finiteSupportMonomial (g : exponentMonoid G) : + (((finiteSupportMonomial (K := K) g : + (finiteSupportSubring : Subring (Nonpositive G K))) : + Nonpositive G K) : K⟦G⟧) = HahnSeries.single (g : G) (1 : K) := + coe_single (g : G) (1 : K) g.2 + +/-- Multiplication of finite-support monomials adds their exponents. -/ +@[simp] +theorem finiteSupportMonomial_mul (g h : exponentMonoid G) : + finiteSupportMonomial (K := K) g * finiteSupportMonomial (K := K) h = + finiteSupportMonomial (K := K) + ⟨(g : G) + (h : G), add_nonpos g.2 h.2⟩ := by + apply Subtype.ext + change + (finiteSupportMonomial (K := K) g : Nonpositive G K) * + (finiteSupportMonomial (K := K) h : Nonpositive G K) = + (finiteSupportMonomial (K := K) + ⟨(g : G) + (h : G), add_nonpos g.2 h.2⟩ : Nonpositive G K) + apply Subtype.ext + change + (((finiteSupportMonomial (K := K) g : Nonpositive G K) : K⟦G⟧) * + ((finiteSupportMonomial (K := K) h : Nonpositive G K) : K⟦G⟧)) = _ + rw [coe_finiteSupportMonomial, coe_finiteSupportMonomial, + coe_finiteSupportMonomial, HahnSeries.single_mul_single, one_mul] + +/-- The coefficient function of `t^g` is the standard finitely supported basis vector. -/ +@[simp] +theorem finiteSupportCoefficients_monomial (g : exponentMonoid G) : + finiteSupportCoefficients (finiteSupportMonomial (K := K) g) = + Finsupp.single g 1 := by + classical + ext x + rw [finiteSupportCoefficients_apply] + rw [coe_finiteSupportMonomial] + change (HahnSeries.single (g : G) (1 : K)).coeff x = _ + rw [HahnSeries.coeff_single, Finsupp.single_apply] + by_cases hgx : g = x + · subst x + simp + · have hval : (x : G) ≠ g := by + intro h + exact hgx (Subtype.ext h.symm) + simp [hgx, hval] + +/-- The monomials `t^g`, indexed by the nonpositive exponents, form the canonical coefficient +basis of the finite-support ring. -/ +def finiteSupportBasis : + Module.Basis (exponentMonoid G) K + (finiteSupportSubring : Subring (Nonpositive G K)) := + (Finsupp.basisSingleOne (R := K)).map finiteSupportFinsuppEquiv.symm + +/-- The canonical finite-support basis vector at `g` is the monomial `t^g`. -/ +@[simp] +theorem finiteSupportBasis_apply (g : exponentMonoid G) : + finiteSupportBasis (K := K) g = finiteSupportMonomial (K := K) g := by + apply finiteSupportCoefficients_injective + rw [finiteSupportCoefficients_monomial] + change finiteSupportFinsuppEquiv + (finiteSupportFinsuppEquiv.symm (Finsupp.single g 1)) = _ + exact finiteSupportFinsuppEquiv.apply_symm_apply _ + +/-- The coordinate of a finite-support series at `g` is its Hahn-series coefficient at `g`. -/ +@[simp] +theorem finiteSupportBasis_repr_apply + (b : (finiteSupportSubring : Subring (Nonpositive G K))) + (g : exponentMonoid G) : + finiteSupportBasis.repr b g = ((b : Nonpositive G K) : K⟦G⟧).coeff g := by + change finiteSupportFinsuppEquiv b g = _ + exact finiteSupportCoefficients_apply b g + +end Nonpositive + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportConstantTermOne.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportConstantTermOne.lean new file mode 100644 index 0000000000..48319843bd --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportConstantTermOne.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport + +/-! +# Finite-support Hahn series with constant term one + +The multiplicative set written `1 + K(G^{< 0})` in LM24 consists intrinsically of the +finite-support nonpositive Hahn series whose coefficient at exponent zero is one. Packaging it +as a submonoid retains precisely the multiplication used in Sections 6.5 and 8.3, without +incorrectly giving it additive or unital-subring structure. +-/ + +open scoped HahnSeries + +universe u v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type v} + [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] + [Field K] + +/-- Finite-support nonpositive Hahn series whose coefficient at exponent zero is one. -/ +def constantTermOneSubmonoid : + Submonoid (FiniteSupportRing (G := G) (K := K)) where + carrier := {p | constantCoeff (p : Nonpositive G K) = 1} + one_mem' := by simp + mul_mem' := by + intro p q hp hq + change constantCoeff ((p * q : FiniteSupportRing (G := G) (K := K)) : + Nonpositive G K) = 1 + change constantCoeff ((p : Nonpositive G K) * (q : Nonpositive G K)) = 1 + rw [map_mul, hp, hq, one_mul] + +/-- The type of finite-support nonpositive Hahn series with constant term one. -/ +abbrev ConstantTermOneFiniteSupport := + ↥(constantTermOneSubmonoid (G := G) (K := K)) + +/-- Membership in `constantTermOneSubmonoid` is the constant-coefficient-one condition. -/ +@[simp] +theorem mem_constantTermOneSubmonoid_iff + (p : FiniteSupportRing (G := G) (K := K)) : + p ∈ constantTermOneSubmonoid ↔ constantCoeff (p : Nonpositive G K) = 1 := + Iff.rfl + +/-- A constant-term-one finite-support series has constant coefficient one after coercion. -/ +theorem ConstantTermOneFiniteSupport.constantCoeff_eq_one + (p : ConstantTermOneFiniteSupport (G := G) (K := K)) : + constantCoeff ((p : FiniteSupportRing (G := G) (K := K)) : + Nonpositive G K) = 1 := + p.2 + +/-- A constant-term-one finite-support series is nonzero in the finite-support ring. -/ +theorem ConstantTermOneFiniteSupport.ne_zero + (p : ConstantTermOneFiniteSupport (G := G) (K := K)) : + (p : FiniteSupportRing (G := G) (K := K)) ≠ 0 := by + intro hp + have hconstant := p.constantCoeff_eq_one + rw [hp] at hconstant + simp at hconstant + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportGCDProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportGCDProof.lean new file mode 100644 index 0000000000..51e77f500a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportGCDProof.lean @@ -0,0 +1,220 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.EPrimitive +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport +public import Mathlib.Algebra.MonoidAlgebra.Defs +public import Mathlib.RingTheory.UniqueFactorizationDomain.Defs + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupAlgebra +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupGCD +import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LaurentTower +import Mathlib.LinearAlgebra.FreeModule.PID +import Mathlib.RingTheory.Int.Basic +import Mathlib.RingTheory.UniqueFactorizationDomain.GCDMonoid + +/-! +# Greatest common divisors of finite-support nonpositive series + +LM24, Fact 2.5.2, following Gilmer and Parker, Theorem 6.4 specialized to a totally ordered +exponent group. + +Two series involve only finitely many exponents, so they live in a finitely generated subgroup, +which is free of finite rank because a linearly ordered group is torsion free. Its group ring is +reached from the coefficient field by a tower of Laurent extensions and so has unique +factorisation, hence least common multiples. Those transfer to the whole exponent group one coset +at a time, and greatest common divisors on the nonpositive exponents follow by splitting at the +largest exponent. +-/ + +open scoped HahnSeries + +universe u v + +public noncomputable section + +namespace HahnSeries + +variable {G : Type u} {K : Type v} +variable [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] +variable [Field K] + +/-- A finitely generated subgroup of a linearly ordered group is free of finite rank. -/ +theorem exists_addEquiv_fin (S : Finset G) : + ∃ k : ℕ, Nonempty ((AddSubgroup.closure (S : Set G)) ≃+ (Fin k → ℤ)) := by + have heq : (AddSubgroup.closure (S : Set G)).toIntSubmodule = Submodule.span ℤ (S : Set G) := + AddSubgroup.toIntSubmodule_closure _ + have : Module.Finite ℤ (AddSubgroup.closure (S : Set G)) := + Module.Finite.iff_fg (N := (AddSubgroup.closure (S : Set G)).toIntSubmodule).mpr + (heq ▸ Submodule.fg_span S.finite_toSet) + obtain ⟨k, b⟩ := + Module.basisOfFiniteTypeTorsionFree' (R := ℤ) (M := (AddSubgroup.closure (S : Set G))) + exact ⟨k, ⟨b.equivFun.toAddEquiv⟩⟩ + +omit [LinearOrder G] [IsOrderedAddMonoid G] in +/-- The group ring of a free subgroup of finite rank has unique factorisation. -/ +theorem uniqueFactorizationMonoid_subgroupAlgebra {H : AddSubgroup G} + (h : ∃ k : ℕ, Nonempty (H ≃+ (Fin k → ℤ))) : + UniqueFactorizationMonoid (AddMonoidAlgebra K H) := by + obtain ⟨k, ⟨e⟩⟩ := h + exact MulEquiv.uniqueFactorizationMonoid + (AddMonoidAlgebra.domCongr (R := K) (A := K) (e := e)).symm.toRingEquiv.toMulEquiv + (AddMonoidAlgebra.uniqueFactorizationMonoid_finInt K k) + +omit [LinearOrder G] [IsOrderedAddMonoid G] in +/-- Least common multiples in the group ring of such a subgroup. -/ +theorem exists_lcm_subgroupAlgebra {H : AddSubgroup G} + (hufm : UniqueFactorizationMonoid (AddMonoidAlgebra K H)) (a b : AddMonoidAlgebra K H) : + ∃ c : AddMonoidAlgebra K H, ∀ d, a ∣ d ∧ b ∣ d ↔ c ∣ d := by + have := hufm + obtain ⟨inst⟩ : Nonempty (NormalizedGCDMonoid (AddMonoidAlgebra K H)) := inferInstance + letI := inst + exact ⟨lcm a b, fun d ↦ ⟨fun h ↦ lcm_dvd h.1 h.2, + fun h ↦ ⟨(dvd_lcm_left a b).trans h, (dvd_lcm_right a b).trans h⟩⟩⟩ + +/-- Least common multiples of finite-support series, in the whole exponent group. -/ +theorem exists_lcm_dvdFS (f g : K⟦G⟧) (hf : f.support.Finite) (hg : g.support.Finite) : + ∃ h : K⟦G⟧, h.support.Finite ∧ ∀ m : K⟦G⟧, m.support.Finite → + (DvdFS f m ∧ DvdFS g m ↔ DvdFS h m) := by + classical + -- the exponents of both arguments generate a finitely generated subgroup + set S : Finset G := hf.toFinset ∪ hg.toFinset with hS + set H : AddSubgroup G := AddSubgroup.closure (S : Set G) with hH + have hfsub : f.support ⊆ (H : Set G) := fun x hx ↦ + AddSubgroup.subset_closure + (Finset.mem_coe.mpr (Finset.mem_union_left _ (hf.mem_toFinset.mpr hx))) + have hgsub : g.support ⊆ (H : Set G) := fun x hx ↦ + AddSubgroup.subset_closure + (Finset.mem_coe.mpr (Finset.mem_union_right _ (hg.mem_toFinset.mpr hx))) + have hufm : UniqueFactorizationMonoid (AddMonoidAlgebra K H) := + uniqueFactorizationMonoid_subgroupAlgebra (exists_addEquiv_fin S) + obtain ⟨a, ha⟩ := exists_subgroupAlgebraHom_eq H hf hfsub + obtain ⟨b, hb⟩ := exists_subgroupAlgebraHom_eq H hg hgsub + obtain ⟨c, hc⟩ := exists_lcm_subgroupAlgebra hufm a b + refine ⟨subgroupAlgebraHom H c, support_subgroupAlgebraHom_finite H c, fun m hm ↦ ?_⟩ + -- inside the subgroup the statement is the group-ring one + have hin : ∀ n : K⟦G⟧, n.support.Finite → n.support ⊆ (H : Set G) → + (DvdFS f n ∧ DvdFS g n → DvdFS (subgroupAlgebraHom H c) n) := by + intro n hnf hnsub hdvd + obtain ⟨d, hd⟩ := exists_subgroupAlgebraHom_eq H hnf hnsub + subst hd + rw [← ha, ← hb] at hdvd + rw [← dvd_iff_dvdFS_subgroupAlgebraHom, ← dvd_iff_dvdFS_subgroupAlgebraHom] at hdvd + exact (dvd_iff_dvdFS_subgroupAlgebraHom H c d).mp ((hc d).mp hdvd) + constructor + · rintro ⟨h1, h2⟩ + refine dvdFS_of_forall_subgroup hfsub hgsub ?_ hm h1 h2 + intro n hnf hnsub hn1 hn2 + exact hin n hnf hnsub ⟨hn1, hn2⟩ + · intro hdvd + have hcf : DvdFS f (subgroupAlgebraHom H c) := by + rw [← ha, ← dvd_iff_dvdFS_subgroupAlgebraHom] + exact ((hc c).mpr dvd_rfl).1 + have hcg : DvdFS g (subgroupAlgebraHom H c) := by + rw [← hb, ← dvd_iff_dvdFS_subgroupAlgebraHom] + exact ((hc c).mpr dvd_rfl).2 + exact ⟨hcf.trans hdvd, hcg.trans hdvd⟩ + +/-- Divisibility in the finite-support ring is divisibility with a finite-support quotient. -/ +theorem dvd_iff_dvdFS (a b : (HahnSeries.finiteSupportSubring : Subring K⟦G⟧)) : + a ∣ b ↔ DvdFS (a : K⟦G⟧) (b : K⟦G⟧) := by + constructor + · rintro ⟨c, rfl⟩ + exact dvdFS_iff.mpr + ⟨(c : K⟦G⟧), (HahnSeries.mem_finiteSupportSubring_iff _).mp c.2, rfl⟩ + · intro h + obtain ⟨w, hwf, hw⟩ := dvdFS_iff.mp h + exact ⟨⟨w, (HahnSeries.mem_finiteSupportSubring_iff w).mpr hwf⟩, Subtype.ext hw⟩ + +open Classical in +/-- Greatest common divisors of finite-support series, in the whole exponent group. -/ +theorem exists_gcd_dvdFS (x z : K⟦G⟧) (hx : x.support.Finite) (hz : z.support.Finite) : + ∃ d : K⟦G⟧, d.support.Finite ∧ + ∀ e : K⟦G⟧, e.support.Finite → (DvdFS e x ∧ DvdFS e z ↔ DvdFS e d) := by + letI : GCDMonoid (HahnSeries.finiteSupportSubring : Subring K⟦G⟧) := by + refine gcdMonoidOfExistsLCM fun a b ↦ ?_ + obtain ⟨h, hhf, hh⟩ := exists_lcm_dvdFS (a : K⟦G⟧) (b : K⟦G⟧) + ((HahnSeries.mem_finiteSupportSubring_iff _).mp a.2) + ((HahnSeries.mem_finiteSupportSubring_iff _).mp b.2) + refine ⟨⟨h, (HahnSeries.mem_finiteSupportSubring_iff h).mpr hhf⟩, fun d ↦ ?_⟩ + rw [dvd_iff_dvdFS, dvd_iff_dvdFS, dvd_iff_dvdFS] + exact hh (d : K⟦G⟧) ((HahnSeries.mem_finiteSupportSubring_iff _).mp d.2) + set a : (HahnSeries.finiteSupportSubring : Subring K⟦G⟧) := + ⟨x, (HahnSeries.mem_finiteSupportSubring_iff x).mpr hx⟩ with ha + set b : (HahnSeries.finiteSupportSubring : Subring K⟦G⟧) := + ⟨z, (HahnSeries.mem_finiteSupportSubring_iff z).mpr hz⟩ with hb + set d : (HahnSeries.finiteSupportSubring : Subring K⟦G⟧) := gcd a b with hd + refine ⟨(d : K⟦G⟧), (HahnSeries.mem_finiteSupportSubring_iff _).mp d.2, fun e hef ↦ ?_⟩ + set c : (HahnSeries.finiteSupportSubring : Subring K⟦G⟧) := + ⟨e, (HahnSeries.mem_finiteSupportSubring_iff e).mpr hef⟩ with hc + rw [show x = (a : K⟦G⟧) from rfl, show z = (b : K⟦G⟧) from rfl, + show e = (c : K⟦G⟧) from rfl, ← dvd_iff_dvdFS, ← dvd_iff_dvdFS, ← dvd_iff_dvdFS, hd] + exact ⟨fun hq ↦ dvd_gcd hq.1 hq.2, + fun hq ↦ ⟨hq.trans (gcd_dvd_left a b), hq.trans (gcd_dvd_right a b)⟩⟩ + +namespace Nonpositive + +/-- Divisibility in the nonpositive finite-support ring. -/ +theorem dvd_iff_dvdNP (a b : (finiteSupportSubring : Subring (Nonpositive G K))) : + a ∣ b ↔ DvdNP ((a : Nonpositive G K) : K⟦G⟧) ((b : Nonpositive G K) : K⟦G⟧) := by + constructor + · rintro ⟨c, rfl⟩ + exact dvdNP_iff.mpr ⟨((c : Nonpositive G K) : K⟦G⟧), + (mem_finiteSupportSubring_iff _).mp c.2, + (HahnSeries.mem_nonpositiveSubring (Γ := G) (R := K)).mp (c : Nonpositive G K).2, rfl⟩ + · intro h + obtain ⟨w, hwf, hws, hw⟩ := dvdNP_iff.mp h + refine ⟨⟨⟨w, (HahnSeries.mem_nonpositiveSubring (Γ := G) (R := K)).mpr hws⟩, + (mem_finiteSupportSubring_iff _).mpr hwf⟩, ?_⟩ + exact Subtype.ext (Subtype.ext hw) + +/-- LM24, Fact 2.5.2: every pair of finite-support nonpositive series has a greatest common +divisor. -/ +@[blueprint "fact:finite-support-hahn-gcd" + (phase := "Primality and factorisation for real exponents") + (title := "Greatest common divisors of finite-support series") + (statement := /-- + Let $G$ be a linearly ordered abelian group and $K$ a field. For all $p,q$ + in the finite-support subring $K(G^{\le 0})$ of $K((G^{\le 0}))$, there is + $d\in K(G^{\le 0})$ such that, for every $e\in K(G^{\le 0})$, + \[ + e\mid p\ \text{and}\ e\mid q \quad\Longleftrightarrow\quad e\mid d. + \] + This is the greatest-common-divisor assertion of [LM24, Fact 2.5.2]. + -/) + (proof := /-- + The zero cases are immediate. Otherwise, the supports of $p$ and $q$ + generate a finite-rank free subgroup $H$ of $G$. Finite-support series with + exponents in $H$ form a Laurent polynomial ring, hence a unique factorisation + domain. Compute a least common multiple there, compare coefficients on + cosets of $H$ to transfer divisibility to finite-support series with exponents + in $G$, and use the lcm-to-gcd construction. Write each input as a monomial + times a series whose support meets $0$, and translate the resulting gcd by + the larger of the two monomial exponents. The gcd and its two cofactors then + have nonpositive support. + -/)] +theorem finiteSupport_pairwise_gcd_exists + (p q : (finiteSupportSubring : Subring (Nonpositive G K))) : + ∃ d : (finiteSupportSubring : Subring (Nonpositive G K)), + ∀ e : (finiteSupportSubring : Subring (Nonpositive G K)), + e ∣ p ∧ e ∣ q ↔ e ∣ d := by + obtain ⟨d, hdf, hds, hd⟩ := exists_gcd_nonpositive_of_exists_gcd + (fun x z hx hz ↦ exists_gcd_dvdFS x z hx hz) + ((mem_finiteSupportSubring_iff _).mp p.2) + ((HahnSeries.mem_nonpositiveSubring (Γ := G) (R := K)).mp (p : Nonpositive G K).2) + ((mem_finiteSupportSubring_iff _).mp q.2) + ((HahnSeries.mem_nonpositiveSubring (Γ := G) (R := K)).mp (q : Nonpositive G K).2) + refine ⟨⟨⟨d, (HahnSeries.mem_nonpositiveSubring (Γ := G) (R := K)).mpr hds⟩, + (mem_finiteSupportSubring_iff _).mpr hdf⟩, fun e ↦ ?_⟩ + rw [dvd_iff_dvdNP, dvd_iff_dvdNP, dvd_iff_dvdNP] + exact hd _ ((mem_finiteSupportSubring_iff _).mp e.2) + ((HahnSeries.mem_nonpositiveSubring (Γ := G) (R := K)).mp (e : Nonpositive G K).2) + +end Nonpositive + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportMonoidAlgebra.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportMonoidAlgebra.lean new file mode 100644 index 0000000000..4f84091e50 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportMonoidAlgebra.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport +public import Mathlib.Algebra.MonoidAlgebra.Basic + +/-! +# Finite-support Hahn series as an additive monoid algebra + +Finite-support nonpositive Hahn series are canonically the additive monoid algebra on the monoid +of nonpositive exponents. The equivalence is defined without a choice of basis: its inverse sends +each formal monomial to the corresponding Hahn monomial, and its forward map reads coefficients. + +This algebra equivalence is the multiplicative strengthening of `finiteSupportFinsuppEquiv`. +-/ + +open scoped HahnSeries + +universe u v + +namespace HahnSeries.Nonpositive + +public noncomputable section + +variable {G : Type u} {K : Type v} + [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] [CommRing K] + +/-- The monoid homomorphism sending a formal nonpositive exponent to its Hahn monomial. -/ +def finiteSupportMonomialHom : + Multiplicative (exponentMonoid G) →* FiniteSupportRing (G := G) (K := K) where + toFun g := finiteSupportMonomial (K := K) g.toAdd + map_one' := by + apply Subtype.ext + apply Subtype.ext + rw [coe_finiteSupportMonomial] + exact HahnSeries.single_zero_one + map_mul' g h := by + rw [finiteSupportMonomial_mul] + apply congrArg (finiteSupportMonomial (K := K)) + apply Subtype.ext + rfl + +/-- Evaluate a finite formal sum of monomials as a finite-support Hahn series. -/ +def finiteSupportAddMonoidAlgebraToSeries : + AddMonoidAlgebra K (exponentMonoid G) →ₐ[K] + FiniteSupportRing (G := G) (K := K) := + AddMonoidAlgebra.lift K _ _ finiteSupportMonomialHom + +/-- Reading coefficients after evaluating a formal sum returns the original coefficient +function. -/ +@[simp] +theorem finiteSupportCoefficients_toSeries + (f : AddMonoidAlgebra K (exponentMonoid G)) : + finiteSupportCoefficients (finiteSupportAddMonoidAlgebraToSeries f) = + AddMonoidAlgebra.coeff f := by + induction f using AddMonoidAlgebra.induction_on with + | hM g => + rw [AddMonoidAlgebra.of_apply] + rw [finiteSupportAddMonoidAlgebraToSeries, AddMonoidAlgebra.lift_single] + rw [one_smul] + change finiteSupportCoefficients + (finiteSupportMonomialHom (Multiplicative.ofAdd g)) = + AddMonoidAlgebra.coeff (AddMonoidAlgebra.single g 1) + rw [show finiteSupportMonomialHom (Multiplicative.ofAdd g) = + finiteSupportMonomial (K := K) g from rfl] + rw [finiteSupportCoefficients_monomial] + rfl + | hadd f g hf hg => + rw [map_add, map_add, hf, hg] + exact (AddMonoidAlgebra.coeff_add f g).symm + | hsmul k f hf => + rw [map_smul, map_smul, hf] + exact (AddMonoidAlgebra.coeff_smul k f).symm + +theorem finiteSupportAddMonoidAlgebraToSeries_bijective : + Function.Bijective (finiteSupportAddMonoidAlgebraToSeries (G := G) (K := K)) := by + constructor + · intro f g hfg + apply AddMonoidAlgebra.coeff_injective + rw [← finiteSupportCoefficients_toSeries f, + ← finiteSupportCoefficients_toSeries g, hfg] + · intro b + refine ⟨AddMonoidAlgebra.ofCoeff (finiteSupportFinsuppEquiv b), ?_⟩ + apply finiteSupportFinsuppEquiv.injective + rw [finiteSupportFinsuppEquiv_apply, finiteSupportFinsuppEquiv_apply, + finiteSupportCoefficients_toSeries, AddMonoidAlgebra.coeff_ofCoeff] + +/-- The canonical algebra equivalence between finite-support nonpositive Hahn series and the +additive monoid algebra on nonpositive exponents. -/ +def finiteSupportAddMonoidAlgebraEquiv : + FiniteSupportRing (G := G) (K := K) ≃ₐ[K] + AddMonoidAlgebra K (exponentMonoid G) := + (AlgEquiv.ofBijective finiteSupportAddMonoidAlgebraToSeries + finiteSupportAddMonoidAlgebraToSeries_bijective).symm + +/-- The inverse algebra equivalence evaluates formal sums as Hahn series. -/ +@[simp] +theorem finiteSupportAddMonoidAlgebraEquiv_symm_apply + (f : AddMonoidAlgebra K (exponentMonoid G)) : + finiteSupportAddMonoidAlgebraEquiv.symm f = + finiteSupportAddMonoidAlgebraToSeries f := + (rfl) + +/-- The forward algebra equivalence reads the Hahn-series coefficient function. -/ +@[simp] +theorem coeff_finiteSupportAddMonoidAlgebraEquiv + (b : FiniteSupportRing (G := G) (K := K)) : + AddMonoidAlgebra.coeff (finiteSupportAddMonoidAlgebraEquiv b) = + finiteSupportCoefficients b := by + have h := congrArg finiteSupportCoefficients + (finiteSupportAddMonoidAlgebraEquiv.symm_apply_apply b) + rw [finiteSupportAddMonoidAlgebraEquiv_symm_apply, + finiteSupportCoefficients_toSeries] at h + exact h + +/-- A Hahn monomial corresponds to the formal monomial with coefficient one. -/ +@[simp] +theorem finiteSupportAddMonoidAlgebraEquiv_monomial + (g : exponentMonoid G) : + finiteSupportAddMonoidAlgebraEquiv (finiteSupportMonomial (K := K) g) = + AddMonoidAlgebra.single g 1 := by + apply AddMonoidAlgebra.coeff_injective + rw [coeff_finiteSupportAddMonoidAlgebraEquiv, + finiteSupportCoefficients_monomial] + rfl + +end + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalization.lean new file mode 100644 index 0000000000..fbd26af105 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalization.lean @@ -0,0 +1,329 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport + +import Mathlib.Data.Set.Finite.Lemmas + +/-! +# Normalized finite-support Hahn series + +A nonzero finite-support Hahn series is normalized when the coefficient at its greatest support +exponent is `1`. This is the normalization used in LM24, Notation 5.4.5. The definition uses the +intrinsic order-theoretic predicate `IsGreatest`; it does not choose a basis or identify the +greatest exponent with a real supremum. + +Every nonzero finite-support series is associated to such a normalized series. Consequently every +associate class has a canonical, choice-defined normalized representative, with the zero class +represented by zero. Uniqueness is stated separately under the exact hypothesis that all units are +nonzero constant series. +-/ + +open scoped HahnSeries + +universe u v + +namespace HahnSeries.Nonpositive + +public noncomputable section + +variable {G : Type u} {K : Type v} +variable [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] +variable [Field K] + +/-- A finite-support nonpositive Hahn series is monic when its coefficient at the greatest +exponent in its support is one. -/ +def IsMonicFiniteSupport + (p : finiteSupportSubring (G := G) (K := K)) : Prop := + ∃ x : G, + IsGreatest (((p : Nonpositive G K) : K⟦G⟧).support) x ∧ + ((p : Nonpositive G K) : K⟦G⟧).coeff x = 1 + +/-- Characterization of a monic finite-support series by its greatest support exponent. -/ +theorem isMonicFiniteSupport_iff + (p : finiteSupportSubring (G := G) (K := K)) : + IsMonicFiniteSupport p ↔ + ∃ x : G, + IsGreatest (((p : Nonpositive G K) : K⟦G⟧).support) x ∧ + ((p : Nonpositive G K) : K⟦G⟧).coeff x = 1 := + Iff.rfl + +/-- A monic finite-support series is nonzero. -/ +theorem IsMonicFiniteSupport.ne_zero + {p : finiteSupportSubring (G := G) (K := K)} + (hp : IsMonicFiniteSupport p) : p ≠ 0 := by + rintro rfl + obtain ⟨x, hx, _⟩ := hp + exact hx.1 (by simp) + +/-- The multiplicative identity is a monic finite-support series. -/ +@[simp] +theorem isMonicFiniteSupport_one : + IsMonicFiniteSupport + (1 : finiteSupportSubring (G := G) (K := K)) := by + rw [isMonicFiniteSupport_iff] + refine ⟨0, ?_, ?_⟩ <;> simp + +/-- The product of two monic finite-support series is monic. -/ +theorem IsMonicFiniteSupport.mul + {p q : finiteSupportSubring (G := G) (K := K)} + (hp : IsMonicFiniteSupport p) (hq : IsMonicFiniteSupport q) : + IsMonicFiniteSupport (p * q) := by + obtain ⟨x, hxGreatest, hxCoeff⟩ := (isMonicFiniteSupport_iff p).mp hp + obtain ⟨y, hyGreatest, hyCoeff⟩ := (isMonicFiniteSupport_iff q).mp hq + let P : K⟦G⟧ := ((p : Nonpositive G K) : K⟦G⟧) + let Q : K⟦G⟧ := ((q : Nonpositive G K) : K⟦G⟧) + have hantidiagonal : + Finset.addAntidiagonal P.isPWO_support Q.isPWO_support (x + y) = {(x, y)} := by + ext ⟨i, j⟩ + simp only [Finset.mem_addAntidiagonal, Finset.mem_singleton, Prod.mk.injEq] + constructor + · rintro ⟨hi, hj, hij⟩ + have hix := hxGreatest.2 hi + have hjy := hyGreatest.2 hj + have hix' : i = x := by + apply le_antisymm hix + by_contra hxi + have hixStrict : i < x := lt_of_not_ge hxi + have : i + j < x + y := add_lt_add_of_lt_of_le hixStrict hjy + exact (ne_of_lt this) hij + subst i + exact ⟨rfl, add_left_cancel hij⟩ + · rintro ⟨rfl, rfl⟩ + exact ⟨hxGreatest.1, hyGreatest.1, rfl⟩ + have hcoeff : + ((((p * q : finiteSupportSubring (G := G) (K := K)) : + Nonpositive G K) : K⟦G⟧).coeff (x + y)) = 1 := by + have hPx : P.coeff x = 1 := by + simpa [P] using hxCoeff + have hQy : Q.coeff y = 1 := by + simpa [Q] using hyCoeff + change (P * Q).coeff (x + y) = 1 + rw [HahnSeries.coeff_mul, hantidiagonal] + simp [hPx, hQy] + rw [isMonicFiniteSupport_iff] + refine ⟨x + y, ?_, hcoeff⟩ + constructor + · exact (HahnSeries.mem_support _ _).mpr (hcoeff.trans_ne one_ne_zero) + · intro z hz + change z ∈ (P * Q).support at hz + obtain ⟨i, hi, j, hj, rfl⟩ := HahnSeries.support_mul_subset hz + exact add_le_add (hxGreatest.2 hi) (hyGreatest.2 hj) + +/-- Multiplication by a nonzero constant preserves the support of a finite-support series. -/ +theorem support_finiteSupportScalarHom_mul + {k : K} (hk : k ≠ 0) + (p : finiteSupportSubring (G := G) (K := K)) : + (((finiteSupportScalarHom (G := G) k * p : + finiteSupportSubring (G := G) (K := K)) : Nonpositive G K) : + K⟦G⟧).support = + ((p : Nonpositive G K) : K⟦G⟧).support := by + rw [Subring.coe_mul, Subring.coe_mul, coe_finiteSupportScalarHom, + HahnSeries.C_mul_eq_smul] + ext x + simp [HahnSeries.mem_support, HahnSeries.coeff_smul, hk] + +/-- Multiplication by a constant scales each coefficient of a finite-support series. -/ +theorem coeff_finiteSupportScalarHom_mul + (k : K) (p : finiteSupportSubring (G := G) (K := K)) (x : G) : + ((((finiteSupportScalarHom (G := G) k * p : + finiteSupportSubring (G := G) (K := K)) : Nonpositive G K) : + K⟦G⟧).coeff x) = + k * ((p : Nonpositive G K) : K⟦G⟧).coeff x := by + rw [Subring.coe_mul, Subring.coe_mul, coe_finiteSupportScalarHom, + HahnSeries.C_mul_eq_smul, HahnSeries.coeff_smul] + rfl + +/-- Every nonzero finite-support series is associated to a monic finite-support series. -/ +theorem exists_isMonicFiniteSupport_associated + (p : finiteSupportSubring (G := G) (K := K)) (hp : p ≠ 0) : + ∃ q : finiteSupportSubring (G := G) (K := K), + IsMonicFiniteSupport q ∧ Associates.mk q = Associates.mk p := by + let support : Set G := ((p : Nonpositive G K) : K⟦G⟧).support + have hsupportFinite : support.Finite := by + exact (mem_finiteSupportSubring_iff + (G := G) (K := K) (p : Nonpositive G K)).mp p.2 + have hsupportNonempty : support.Nonempty := by + rw [HahnSeries.support_nonempty_iff] + intro hzero + apply hp + apply Subtype.ext + apply Subtype.ext + exact hzero + obtain ⟨x, hxSupport, hxGreatest⟩ := + Set.exists_max_image support id hsupportFinite hsupportNonempty + let a : K := ((p : Nonpositive G K) : K⟦G⟧).coeff x + have ha : a ≠ 0 := (HahnSeries.mem_support _ _).mp hxSupport + let q : finiteSupportSubring (G := G) (K := K) := + finiteSupportScalarHom (G := G) a⁻¹ * p + have hsupportQ : + ((q : Nonpositive G K) : K⟦G⟧).support = support := by + exact support_finiteSupportScalarHom_mul (G := G) (K := K) + (inv_ne_zero ha) p + have hqMonic : IsMonicFiniteSupport q := by + refine ⟨x, ?_, ?_⟩ + · rw [hsupportQ] + exact ⟨hxSupport, fun y hy ↦ hxGreatest y hy⟩ + · rw [coeff_finiteSupportScalarHom_mul] + exact inv_mul_cancel₀ ha + refine ⟨q, hqMonic, ?_⟩ + apply Associates.mk_eq_mk_iff_associated.mpr + let uK : Kˣ := Units.mk0 a⁻¹ (inv_ne_zero ha) + let uD : (finiteSupportSubring (G := G) (K := K))ˣ := + Units.map (finiteSupportScalarHom (G := G)).toMonoidHom uK + apply Associated.symm + refine ⟨uD, ?_⟩ + change p * finiteSupportScalarHom (G := G) a⁻¹ = q + rw [mul_comm] + +/-- A normalized representative of an associate class is zero exactly for the zero class and is +otherwise a monic representative of that class. -/ +def IsNormalizedAssociateRepresentative + (a : Associates (finiteSupportSubring (G := G) (K := K))) + (p : finiteSupportSubring (G := G) (K := K)) : Prop := + (a = 0 ∧ p = 0) ∨ + (a ≠ 0 ∧ Associates.mk p = a ∧ IsMonicFiniteSupport p) + +/-- Characterization of normalized representatives of finite-support associate classes. -/ +theorem isNormalizedAssociateRepresentative_iff + (a : Associates (finiteSupportSubring (G := G) (K := K))) + (p : finiteSupportSubring (G := G) (K := K)) : + IsNormalizedAssociateRepresentative a p ↔ + (a = 0 ∧ p = 0) ∨ + (a ≠ 0 ∧ Associates.mk p = a ∧ IsMonicFiniteSupport p) := + Iff.rfl + +/-- Every finite-support associate class has a normalized representative. -/ +theorem exists_isNormalizedAssociateRepresentative + (a : Associates (finiteSupportSubring (G := G) (K := K))) : + ∃ p : finiteSupportSubring (G := G) (K := K), + IsNormalizedAssociateRepresentative a p := by + induction a using Quotient.inductionOn with + | _ p => + by_cases hp : p = 0 + · subst p + exact ⟨0, Or.inl ⟨rfl, rfl⟩⟩ + · obtain ⟨q, hqMonic, hqAssociated⟩ := + exists_isMonicFiniteSupport_associated p hp + exact ⟨q, Or.inr ⟨Associates.mk_ne_zero.mpr hp, + hqAssociated, hqMonic⟩⟩ + +/-- The choice-defined normalized representative of a finite-support associate class. -/ +noncomputable def normalizedAssociateRepresentative + (a : Associates (finiteSupportSubring (G := G) (K := K))) : + finiteSupportSubring (G := G) (K := K) := + Classical.choose (exists_isNormalizedAssociateRepresentative a) + +/-- The chosen representative satisfies the normalization predicate. -/ +theorem normalizedAssociateRepresentative_is + (a : Associates (finiteSupportSubring (G := G) (K := K))) : + IsNormalizedAssociateRepresentative a (normalizedAssociateRepresentative a) := + Classical.choose_spec (exists_isNormalizedAssociateRepresentative a) + +/-- The normalized representative of the zero associate class is zero. -/ +@[simp] +theorem normalizedAssociateRepresentative_zero : + normalizedAssociateRepresentative + (0 : Associates (finiteSupportSubring (G := G) (K := K))) = 0 := by + rcases normalizedAssociateRepresentative_is + (0 : Associates (finiteSupportSubring (G := G) (K := K))) with h | h + · exact h.2 + · exact (h.1 rfl).elim + +/-- The associate class of the normalized representative is the original class. -/ +theorem normalizedAssociateRepresentative_mk + (a : Associates (finiteSupportSubring (G := G) (K := K))) : + Associates.mk (normalizedAssociateRepresentative a) = a := by + rcases normalizedAssociateRepresentative_is a with h | h + · calc + Associates.mk (normalizedAssociateRepresentative a) = Associates.mk 0 := + congrArg Associates.mk h.2 + _ = 0 := Associates.mk_zero + _ = a := h.1.symm + · exact h.2.1 + +/-- The normalized representative of a nonzero associate class is monic. -/ +theorem normalizedAssociateRepresentative_isMonic_of_ne_zero + {a : Associates (finiteSupportSubring (G := G) (K := K))} + (ha : a ≠ 0) : + IsMonicFiniteSupport (normalizedAssociateRepresentative a) := by + rcases normalizedAssociateRepresentative_is a with h | h + · exact (ha h.1).elim + · exact h.2.2 + +/-- Normalized representatives are unique when every unit is a nonzero constant series. -/ +theorem IsNormalizedAssociateRepresentative.eq + (hunits : ∀ u : finiteSupportSubring (G := G) (K := K), + IsUnit u ↔ ∃ k : K, k ≠ 0 ∧ u = finiteSupportScalarHom (G := G) k) + {a : Associates (finiteSupportSubring (G := G) (K := K))} + {p q : finiteSupportSubring (G := G) (K := K)} + (hp : IsNormalizedAssociateRepresentative a p) + (hq : IsNormalizedAssociateRepresentative a q) : p = q := by + rcases hp with hpZero | hpNonzero + · rcases hq with hqZero | hqNonzero + · exact hpZero.2.trans hqZero.2.symm + · exact (hqNonzero.1 hpZero.1).elim + · rcases hq with hqZero | hqNonzero + · exact (hpNonzero.1 hqZero.1).elim + · obtain ⟨u, hu⟩ := Associates.mk_eq_mk_iff_associated.mp + (hpNonzero.2.1.trans hqNonzero.2.1.symm) + obtain ⟨k, hk, huk⟩ := + (hunits (u : finiteSupportSubring (G := G) (K := K))).mp u.isUnit + have hqp : q = finiteSupportScalarHom (G := G) k * p := by + calc + q = p * (u : finiteSupportSubring (G := G) (K := K)) := hu.symm + _ = p * finiteSupportScalarHom (G := G) k := congrArg (p * ·) huk + _ = finiteSupportScalarHom (G := G) k * p := mul_comm _ _ + obtain ⟨xp, hxpGreatest, hxpCoeff⟩ := hpNonzero.2.2 + obtain ⟨xq, hxqGreatest, hxqCoeff⟩ := hqNonzero.2.2 + have hsupport : + ((q : Nonpositive G K) : K⟦G⟧).support = + ((p : Nonpositive G K) : K⟦G⟧).support := by + rw [hqp] + exact support_finiteSupportScalarHom_mul (G := G) (K := K) hk p + have hxpq : xp = xq := by + apply le_antisymm + · exact hxqGreatest.2 (hsupport ▸ hxpGreatest.1) + · exact hxpGreatest.2 (hsupport.symm ▸ hxqGreatest.1) + subst xq + have hcoeff := congrArg + (fun r : finiteSupportSubring (G := G) (K := K) ↦ + ((r : Nonpositive G K) : K⟦G⟧).coeff xp) hqp + rw [coeff_finiteSupportScalarHom_mul, hxpCoeff, mul_one, hxqCoeff] at hcoeff + rw [hqp, hcoeff.symm, map_one, one_mul] + +/-- Equal associate classes differ by multiplication by a nonzero coefficient scalar when all +units are nonzero constant series. -/ +theorem exists_nonzero_scalar_mul_of_mk_eq_mk + (hunits : ∀ u : finiteSupportSubring (G := G) (K := K), + IsUnit u ↔ ∃ k : K, k ≠ 0 ∧ u = finiteSupportScalarHom (G := G) k) + {p q : finiteSupportSubring (G := G) (K := K)} + (h : Associates.mk p = Associates.mk q) : + ∃ k : K, k ≠ 0 ∧ q = finiteSupportScalarHom (G := G) k * p := by + obtain ⟨u, hu⟩ := Associates.mk_eq_mk_iff_associated.mp h + obtain ⟨k, hk, huk⟩ := + (hunits (u : finiteSupportSubring (G := G) (K := K))).mp u.isUnit + refine ⟨k, hk, ?_⟩ + calc + q = p * (u : finiteSupportSubring (G := G) (K := K)) := hu.symm + _ = p * finiteSupportScalarHom (G := G) k := congrArg (p * ·) huk + _ = finiteSupportScalarHom (G := G) k * p := mul_comm _ _ + +/-- The chosen normalized representative is the unique normalized representative when all units +are nonzero constant series. -/ +theorem normalizedAssociateRepresentative_eq_of_is + (hunits : ∀ u : finiteSupportSubring (G := G) (K := K), + IsUnit u ↔ ∃ k : K, k ≠ 0 ∧ u = finiteSupportScalarHom (G := G) k) + {a : Associates (finiteSupportSubring (G := G) (K := K))} + {p : finiteSupportSubring (G := G) (K := K)} + (hp : IsNormalizedAssociateRepresentative a p) : + normalizedAssociateRepresentative a = p := by + exact (normalizedAssociateRepresentative_is a).eq hunits hp + +end + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalizedGCD.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalizedGCD.lean new file mode 100644 index 0000000000..6a68953f4a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalizedGCD.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport +public import Mathlib.Algebra.GCDMonoid.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit + +/-! +# A normalized GCD structure on finite-support nonpositive series + +LM24, Fact 2.5.2 shows that the finite-support nonpositive Hahn-series ring is a GCD domain and +that its units are precisely the nonzero constants. The normalization here represents the zero +associate class by zero and every nonzero class by the unique associate whose coefficient at its +greatest support exponent is one. This turns the existing pairwise GCD theorem into a +`NormalizedGCDMonoid` structure. +-/ + +open scoped HahnSeries + +universe u v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type v} +variable [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] +variable [Field K] + +private theorem normalizedAssociateRepresentative_one : + normalizedAssociateRepresentative + (1 : Associates (finiteSupportSubring (G := G) (K := K))) = 1 := by + apply normalizedAssociateRepresentative_eq_of_is isUnit_finiteSupport_iff_exists_scalar + rw [isNormalizedAssociateRepresentative_iff] + exact Or.inr ⟨one_ne_zero, by simp, isMonicFiniteSupport_one⟩ + +private theorem normalizedAssociateRepresentative_mul + (a b : Associates (finiteSupportSubring (G := G) (K := K))) : + normalizedAssociateRepresentative (a * b) = + normalizedAssociateRepresentative a * normalizedAssociateRepresentative b := by + by_cases ha : a = 0 + · subst a + simp + by_cases hb : b = 0 + · subst b + simp + apply normalizedAssociateRepresentative_eq_of_is isUnit_finiteSupport_iff_exists_scalar + rw [isNormalizedAssociateRepresentative_iff] + refine Or.inr ⟨mul_ne_zero ha hb, ?_, ?_⟩ + · rw [← Associates.mk_mul_mk, normalizedAssociateRepresentative_mk, + normalizedAssociateRepresentative_mk] + · exact (normalizedAssociateRepresentative_isMonic_of_ne_zero ha).mul + (normalizedAssociateRepresentative_isMonic_of_ne_zero hb) + +private noncomputable def normalizedAssociateRepresentativeMonoidHom : + Associates (finiteSupportSubring (G := G) (K := K)) →* + finiteSupportSubring (G := G) (K := K) where + toFun := normalizedAssociateRepresentative + map_one' := normalizedAssociateRepresentative_one + map_mul' := normalizedAssociateRepresentative_mul + +@[implicit_reducible] +private noncomputable def finiteSupportNormalizationMonoid : + NormalizationMonoid (finiteSupportSubring (G := G) (K := K)) := by + classical + exact normalizationMonoidOfMonoidHomRightInverse normalizedAssociateRepresentativeMonoidHom + normalizedAssociateRepresentative_mk + +/-- The nonpositive finite-support Hahn-series ring over a field is a normalized GCD domain. -/ +theorem nonemptyNormalizedGCDMonoid_finiteSupport : + Nonempty (NormalizedGCDMonoid (finiteSupportSubring (G := G) (K := K))) := by + classical + letI : NormalizationMonoid (finiteSupportSubring (G := G) (K := K)) := + finiteSupportNormalizationMonoid + exact ⟨normalizedGCDMonoidOfExistsGCD finiteSupport_pairwise_gcd_exists⟩ + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportResidue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportResidue.lean new file mode 100644 index 0000000000..256f4fdc16 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportResidue.lean @@ -0,0 +1,127 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Residue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport + +/-! +# The degree-zero residue ring + +For a max-additive degree on nonpositive real Hahn series whose value is degree, the nonpositive +subring is the finite-support subring and the negative ideal is zero. The residue map is +therefore a ring isomorphism from finite-support nonpositive Hahn series. This is the proof of +LM24, Proposition 5.1.1, stated for any degree whose value is Hahn-series degree. +-/ + +universe v + +public noncomputable section + +open scoped DirectSum + +namespace HahnSeries.Nonpositive + +variable {K : Type v} [CommRing K] + +variable (w : MaxAddDegree (Nonpositive ℝ K) NatOrdinal) + +/-- A degree function equal to the Hahn-series degree has the finite-support subring as its +nonpositive subring. -/ +theorem nonpositiveSubring_eq_finiteSupportSubring_of_value_eq_degree + (hvalue : ∀ b, w b = (b : K⟦ℝ⟧).degree) : + w.nonpositiveSubring = finiteSupportSubring := by + ext b + rw [MaxAddDegree.mem_nonpositiveSubring_iff, + mem_finiteSupportSubring_iff, hvalue, HahnSeries.degree_le_zero_iff] + +/-- A degree function equal to the Hahn-series degree has zero strictly-negative ideal. -/ +theorem negativeIdeal_eq_bot_of_value_eq_degree + (hvalue : ∀ b, w b = (b : K⟦ℝ⟧).degree) : + w.negativeIdeal = ⊥ := by + ext b + rw [MaxAddDegree.mem_negativeIdeal_iff, Ideal.mem_bot, hvalue, + HahnSeries.degree_lt_zero_iff] + simp + +/-- The residue map of a degree function equal to the Hahn-series degree is injective. -/ +theorem residueMap_injective_of_value_eq_degree + (hvalue : ∀ b, w b = (b : K⟦ℝ⟧).degree) : + Function.Injective w.residueMap := by + apply (RingHom.injective_iff_ker_eq_bot w.residueMap).mpr + rw [w.residueMap_ker, negativeIdeal_eq_bot_of_value_eq_degree w hvalue] + +/-- LM24, Proposition 5.1.1 in the grade-zero-component presentation of the residue ring. -/ +def finiteSupportResidueEquiv + (hvalue : ∀ b, w b = (b : K⟦ℝ⟧).degree) : + (finiteSupportSubring : Subring (Nonpositive ℝ K)) ≃+* w.ResidueRing := + (RingEquiv.subringCongr + (nonpositiveSubring_eq_finiteSupportSubring_of_value_eq_degree w hvalue).symm).trans + (RingEquiv.ofBijective w.residueMap + ⟨residueMap_injective_of_value_eq_degree w hvalue, w.residueMap_surjective⟩) + +/-- The residue-ring equivalence is the restriction of the residue map. -/ +@[simp] +theorem finiteSupportResidueEquiv_apply + (hvalue : ∀ b, w b = (b : K⟦ℝ⟧).degree) + (b : (finiteSupportSubring : Subring (Nonpositive ℝ K))) : + finiteSupportResidueEquiv w hvalue b = + w.residueMap + (RingEquiv.subringCongr + (nonpositiveSubring_eq_finiteSupportSubring_of_value_eq_degree w hvalue).symm b) := by + simp [finiteSupportResidueEquiv] + +/-- Under the RV/homogeneous equivalence, the residue isomorphism is the restriction of `rv`. -/ +theorem coe_rvEquivHomogeneous_rv_eq_residueRingHom_finiteSupportResidueEquiv + [w.IsMultiplicative] + (hvalue : ∀ b, w b = (b : K⟦ℝ⟧).degree) + (b : (finiteSupportSubring : Subring (Nonpositive ℝ K))) : + (w.rvEquivHomogeneous (w.rv (b : Nonpositive ℝ K)) : + w.AssociatedGraded) = + w.residueRingHom (finiteSupportResidueEquiv w hvalue b) := by + rw [finiteSupportResidueEquiv_apply] + let x : w.nonpositiveSubring := + RingEquiv.subringCongr + (nonpositiveSubring_eq_finiteSupportSubring_of_value_eq_degree w hvalue).symm b + have hxcoe : (x : Nonpositive ℝ K) = b := by + exact RingEquiv.coe_subringCongr_apply _ b + have hxvalue : w (x : Nonpositive ℝ K) = 0 ∨ + w (x : Nonpositive ℝ K) = ⊥ := by + by_cases hb : (b : Nonpositive ℝ K) = 0 + · right + rw [hvalue, hxcoe, hb] + simp + · left + rw [hvalue, hxcoe] + apply HahnSeries.degree_eq_zero.mpr + refine ⟨?_, + (mem_finiteSupportSubring_iff (b : Nonpositive ℝ K)).mp b.2⟩ + simpa using hb + have hdiagram := + w.coe_rvEquivHomogeneous_rv_eq_residueRingHom_residueMap x hxvalue + rw [hxcoe] at hdiagram + exact hdiagram + +variable (K) in +/-- LM24, Proposition 5.1.1 for the degree valuation: the finite-support subring is its +degree-zero residue ring. -/ +def degreeFiniteSupportResidueEquiv [Nontrivial K] : + (finiteSupportSubring : Subring (Nonpositive ℝ K)) ≃+* (degreeValuation K).ResidueRing := + finiteSupportResidueEquiv (degreeValuation K) degreeValuation_apply + +/-- The degree-residue equivalence is the residue map restricted to finite-support series. -/ +@[simp] +theorem degreeFiniteSupportResidueEquiv_apply [Nontrivial K] + (b : (finiteSupportSubring : Subring (Nonpositive ℝ K))) : + degreeFiniteSupportResidueEquiv K b = + (degreeValuation K).residueMap + (RingEquiv.subringCongr + (nonpositiveSubring_eq_finiteSupportSubring_of_value_eq_degree + (degreeValuation K) degreeValuation_apply).symm b) := + finiteSupportResidueEquiv_apply (degreeValuation K) degreeValuation_apply b + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportScalarExtension.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportScalarExtension.lean new file mode 100644 index 0000000000..8466ef34a6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportScalarExtension.lean @@ -0,0 +1,456 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportMonoidAlgebra +public import Mathlib.Algebra.Field.IsField +public import Mathlib.Algebra.MonoidAlgebra.MapDomain + +import Mathlib.Algebra.GCDMonoid.Basic + +/-! +# Coefficient extension for finite-support Hahn series + +A ring homomorphism between coefficient rings induces a ring homomorphism between the +corresponding finite-support nonpositive Hahn-series rings. The construction is intrinsic: under +the canonical additive-monoid-algebra presentation, it applies the coefficient homomorphism and +leaves every exponent unchanged. + +The range characterization identifies the image with the series whose coefficients all belong to +the image of the coefficient homomorphism. In particular, scalar extension realizes the inclusion +of `K(ℝ^{≤0})` in `L(ℝ^{≤0})` used in LM24, Lemma 6.3.4. +-/ + +open scoped HahnSeries + +universe u v w + +namespace HahnSeries.Nonpositive + +public noncomputable section + +variable {G : Type u} {K : Type v} {L : Type w} + [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] + [CommRing K] [CommRing L] + +/-- Apply a coefficient-ring homomorphism to a finite-support nonpositive Hahn series. -/ +def finiteSupportMap (f : K →+* L) : + FiniteSupportRing (G := G) (K := K) →+* + FiniteSupportRing (G := G) (K := L) := + (finiteSupportAddMonoidAlgebraEquiv (G := G) (K := L)).symm.toRingHom.comp + ((AddMonoidAlgebra.mapRingHom (exponentMonoid G) f).comp + (finiteSupportAddMonoidAlgebraEquiv (G := G) (K := K)).toRingHom) + +/-- Under the additive-monoid-algebra presentation, `finiteSupportMap` applies the coefficient +homomorphism. -/ +@[simp] +theorem finiteSupportAddMonoidAlgebraEquiv_map (f : K →+* L) + (b : FiniteSupportRing (G := G) (K := K)) : + finiteSupportAddMonoidAlgebraEquiv (finiteSupportMap f b) = + AddMonoidAlgebra.mapRingHom (exponentMonoid G) f + (finiteSupportAddMonoidAlgebraEquiv b) := by + rw [finiteSupportMap, RingHom.comp_apply, RingHom.comp_apply] + exact finiteSupportAddMonoidAlgebraEquiv.apply_symm_apply _ + +/-- `finiteSupportMap` applies the coefficient homomorphism at every exponent. -/ +theorem finiteSupportMap_coeff (f : K →+* L) + (b : FiniteSupportRing (G := G) (K := K)) + (g : exponentMonoid G) : + finiteSupportCoefficients (finiteSupportMap f b) g = + f (finiteSupportCoefficients b g) := by + calc + finiteSupportCoefficients (finiteSupportMap f b) g = + AddMonoidAlgebra.coeff + (finiteSupportAddMonoidAlgebraEquiv (finiteSupportMap f b)) g := + (congrArg (fun q : exponentMonoid G →₀ L ↦ q g) + (coeff_finiteSupportAddMonoidAlgebraEquiv + (G := G) (K := L) (finiteSupportMap f b))).symm + _ = f (finiteSupportCoefficients b g) := by + rw [finiteSupportAddMonoidAlgebraEquiv_map] + change + AddMonoidAlgebra.mapRingHom (exponentMonoid G) f + (finiteSupportAddMonoidAlgebraEquiv b) g = _ + rw [AddMonoidAlgebra.mapRingHom_apply] + exact congrArg f (congrArg (fun q : exponentMonoid G →₀ K ↦ q g) + (coeff_finiteSupportAddMonoidAlgebraEquiv (G := G) (K := K) b)) + +/-- An injective coefficient homomorphism induces an injective finite-support map. -/ +theorem finiteSupportMap_injective (f : K →+* L) + (hf : Function.Injective f) : + Function.Injective (finiteSupportMap (G := G) f) := by + intro b c hbc + apply finiteSupportFinsuppEquiv.injective + rw [finiteSupportFinsuppEquiv_apply, finiteSupportFinsuppEquiv_apply] + ext g + apply hf + have hcoeff := congrArg + (fun q : FiniteSupportRing (G := G) (K := L) ↦ + finiteSupportCoefficients q g) hbc + simpa only [finiteSupportMap_coeff] using hcoeff + +/-- Applying the identity coefficient homomorphism is the identity on finite-support series. -/ +@[simp] +theorem finiteSupportMap_id : + finiteSupportMap (G := G) (RingHom.id K) = RingHom.id _ := by + apply RingHom.ext + intro b + apply finiteSupportAddMonoidAlgebraEquiv.injective + rw [finiteSupportAddMonoidAlgebraEquiv_map, + AddMonoidAlgebra.mapRingHom_id] + rfl + +/-- Coefficient maps respect composition. -/ +@[simp] +theorem finiteSupportMap_comp {M : Type*} [CommRing M] + (g : L →+* M) (f : K →+* L) : + finiteSupportMap (G := G) (g.comp f) = + (finiteSupportMap (G := G) g).comp (finiteSupportMap (G := G) f) := by + apply RingHom.ext + intro b + apply finiteSupportAddMonoidAlgebraEquiv.injective + rw [finiteSupportAddMonoidAlgebraEquiv_map, + RingHom.comp_apply, finiteSupportAddMonoidAlgebraEquiv_map, + finiteSupportAddMonoidAlgebraEquiv_map, + AddMonoidAlgebra.mapRingHom_comp] + rfl + +/-- A coefficient map preserves every finite-support Hahn monomial. -/ +@[simp] +theorem finiteSupportMap_monomial (f : K →+* L) + (g : exponentMonoid G) : + finiteSupportMap f (finiteSupportMonomial (K := K) g) = + finiteSupportMonomial (K := L) g := by + apply finiteSupportAddMonoidAlgebraEquiv.injective + rw [finiteSupportAddMonoidAlgebraEquiv_map, + finiteSupportAddMonoidAlgebraEquiv_monomial, + AddMonoidAlgebra.mapRingHom_single, map_one, + finiteSupportAddMonoidAlgebraEquiv_monomial] + +/-- A coefficient map sends a constant series to the constant series with mapped coefficient. -/ +@[simp] +theorem finiteSupportMap_scalar (f : K →+* L) (k : K) : + finiteSupportMap f (finiteSupportScalarHom (G := G) k) = + finiteSupportScalarHom (G := G) (f k) := by + apply finiteSupportAddMonoidAlgebraEquiv.injective + rw [finiteSupportAddMonoidAlgebraEquiv_map] + change + AddMonoidAlgebra.mapRingHom (exponentMonoid G) f + (finiteSupportAddMonoidAlgebraEquiv + (algebraMap K (FiniteSupportRing (G := G) (K := K)) k)) = + finiteSupportAddMonoidAlgebraEquiv + (algebraMap L (FiniteSupportRing (G := G) (K := L)) (f k)) + rw [AlgEquiv.commutes, AlgEquiv.commutes] + change + AddMonoidAlgebra.mapRingHom (exponentMonoid G) f + (AddMonoidAlgebra.single 0 k) = + AddMonoidAlgebra.single 0 (f k) + exact AddMonoidAlgebra.mapRingHom_single f 0 k + +/-- A finite-support series belongs to the range of a coefficient map exactly when each of its +coefficients belongs to the range of the coefficient homomorphism. -/ +theorem mem_range_finiteSupportMap_iff (f : K →+* L) + (b : FiniteSupportRing (G := G) (K := L)) : + b ∈ Set.range (finiteSupportMap (G := G) f) ↔ + ∀ g, finiteSupportCoefficients b g ∈ Set.range f := by + constructor + · rintro ⟨a, rfl⟩ g + exact ⟨finiteSupportCoefficients a g, (finiteSupportMap_coeff f a g).symm⟩ + · intro hb + have hcoeff : ∀ g, + AddMonoidAlgebra.coeff (finiteSupportAddMonoidAlgebraEquiv b) g ∈ + Set.range f.toAddMonoidHom := by + intro g + rw [show AddMonoidAlgebra.coeff + (finiteSupportAddMonoidAlgebraEquiv b) g = + finiteSupportCoefficients b g from + congrArg (fun q : exponentMonoid G →₀ L ↦ q g) + (coeff_finiteSupportAddMonoidAlgebraEquiv + (G := G) (K := L) b)] + exact hb g + have hrange : finiteSupportAddMonoidAlgebraEquiv b ∈ + Set.range (AddMonoidAlgebra.map + (M := exponentMonoid G) f.toAddMonoidHom) := by + rw [AddMonoidAlgebra.range_map] + exact hcoeff + obtain ⟨a, ha⟩ := hrange + refine ⟨finiteSupportAddMonoidAlgebraEquiv.symm a, ?_⟩ + apply finiteSupportAddMonoidAlgebraEquiv.injective + rw [finiteSupportAddMonoidAlgebraEquiv_map, + finiteSupportAddMonoidAlgebraEquiv.apply_symm_apply] + change AddMonoidAlgebra.map f.toAddMonoidHom a = + finiteSupportAddMonoidAlgebraEquiv b + exact ha + +/-- If a nonzero finite-support series over `K` becomes a scalar multiple whose coefficients are +still in the image of `K`, then the scalar itself belongs to the image of `K`. -/ +theorem coefficient_mem_range_of_map_mul_scalar_mem_range + (hK : IsField K) (f : K →+* L) + {p : FiniteSupportRing (G := G) (K := K)} (hp : p ≠ 0) + {B : L} + (hmem : finiteSupportMap f p * finiteSupportScalarHom (G := G) B ∈ + Set.range (finiteSupportMap (G := G) f)) : + B ∈ Set.range f := by + have hpCoefficients : finiteSupportCoefficients p ≠ 0 := by + rw [← finiteSupportFinsuppEquiv_apply] + exact (finiteSupportFinsuppEquiv (G := G) (K := K)).map_ne_zero_iff.mpr hp + obtain ⟨g, hg⟩ := Finsupp.ne_iff.mp hpCoefficients + obtain ⟨q, hq⟩ := hmem + have hcoeff := congrArg + (fun r : FiniteSupportRing (G := G) (K := L) ↦ + finiteSupportCoefficients r g) hq + rw [finiteSupportMap_coeff, mul_comm, + ← smul_finiteSupport_eq_scalar_mul, map_smul, Finsupp.smul_apply, + finiteSupportMap_coeff] at hcoeff + obtain ⟨a, ha⟩ := hK.mul_inv_cancel hg + refine ⟨a * finiteSupportCoefficients q g, ?_⟩ + rw [map_mul, hcoeff] + change f a * (B * f (finiteSupportCoefficients p g)) = B + calc + _ = B * f (finiteSupportCoefficients p g * a) := by rw [map_mul]; ring + _ = B := by rw [ha, map_one, mul_one] + +section ScalarExtension + +variable [Algebra K L] + +/-- Extend the coefficients of a finite-support Hahn series along a coefficient algebra. -/ +def finiteSupportScalarExtension : + FiniteSupportRing (G := G) (K := K) →+* + FiniteSupportRing (G := G) (K := L) := + finiteSupportMap (G := G) (algebraMap K L) + +/-- Under the additive-monoid-algebra presentation, scalar extension applies the coefficient +algebra map. -/ +@[simp] +theorem finiteSupportAddMonoidAlgebraEquiv_scalarExtension + (b : FiniteSupportRing (G := G) (K := K)) : + finiteSupportAddMonoidAlgebraEquiv + (finiteSupportScalarExtension (G := G) (K := K) (L := L) b) = + AddMonoidAlgebra.mapRingHom (exponentMonoid G) (algebraMap K L) + (finiteSupportAddMonoidAlgebraEquiv b) := by + rw [finiteSupportScalarExtension, finiteSupportAddMonoidAlgebraEquiv_map] + +/-- Scalar extension applies the coefficient algebra map at every exponent. -/ +theorem finiteSupportScalarExtension_coeff + (b : FiniteSupportRing (G := G) (K := K)) + (g : exponentMonoid G) : + finiteSupportCoefficients + (finiteSupportScalarExtension (G := G) (K := K) (L := L) b) g = + algebraMap K L (finiteSupportCoefficients b g) := + finiteSupportMap_coeff (algebraMap K L) b g + +/-- Scalar extension preserves every finite-support Hahn monomial. -/ +@[simp] +theorem finiteSupportScalarExtension_monomial (g : exponentMonoid G) : + finiteSupportScalarExtension (G := G) (K := K) (L := L) + (finiteSupportMonomial (K := K) g) = + finiteSupportMonomial (K := L) g := + finiteSupportMap_monomial (algebraMap K L) g + +/-- Scalar extension sends a constant series through the coefficient algebra map. -/ +@[simp] +theorem finiteSupportScalarExtension_scalar (k : K) : + finiteSupportScalarExtension (G := G) (K := K) (L := L) + (finiteSupportScalarHom (G := G) k) = + finiteSupportScalarHom (G := G) (algebraMap K L k) := + finiteSupportMap_scalar (algebraMap K L) k + +/-- Scalar extension is injective when the coefficient algebra map is injective. -/ +theorem finiteSupportScalarExtension_injective + (hKL : Function.Injective (algebraMap K L)) : + Function.Injective + (finiteSupportScalarExtension (G := G) (K := K) (L := L)) := + finiteSupportMap_injective (algebraMap K L) hKL + +/-- The range of scalar extension consists exactly of the finite-support series whose coefficients +belong to the image of the coefficient algebra map. -/ +theorem mem_range_finiteSupportScalarExtension_iff + (b : FiniteSupportRing (G := G) (K := L)) : + b ∈ Set.range (finiteSupportScalarExtension (G := G) (K := K) (L := L)) ↔ + ∀ g, finiteSupportCoefficients b g ∈ Set.range (algebraMap K L) := + mem_range_finiteSupportMap_iff (algebraMap K L) b + +end ScalarExtension + +end + +end HahnSeries.Nonpositive + +namespace HahnSeries.Nonpositive + +public noncomputable section + +variable {G : Type u} {K : Type v} {L : Type w} + [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] + [Field K] [Field L] + +private theorem mul_scalar_mul_inv_scalar + (B : L) (hB : B ≠ 0) + (x y : FiniteSupportRing (G := G) (K := L)) : + (x * finiteSupportScalarHom (G := G) B) * + (y * finiteSupportScalarHom (G := G) B⁻¹) = + x * y := by + calc + _ = x * y * + (finiteSupportScalarHom (G := G) B * + finiteSupportScalarHom (G := G) B⁻¹) := by ac_rfl + _ = x * y * finiteSupportScalarHom (G := G) (B * B⁻¹) := by + rw [map_mul] + _ = x * y := by rw [mul_inv_cancel₀ hB, map_one, mul_one] + +private theorem eq_mul_of_scalar_redistribution + (f : K →+* L) (hf : Function.Injective f) + (B : L) (hB : B ≠ 0) + {p p₁ p₂ : FiniteSupportRing (G := G) (K := K)} + {q₁ q₂ : FiniteSupportRing (G := G) (K := L)} + (hpq : finiteSupportMap f p = q₁ * q₂) + (hp₁ : finiteSupportMap f p₁ = + q₁ * finiteSupportScalarHom (G := G) B) + (hp₂ : finiteSupportMap f p₂ = + q₂ * finiteSupportScalarHom (G := G) B⁻¹) : + p = p₁ * p₂ := by + apply finiteSupportMap_injective f hf + calc + finiteSupportMap f p = q₁ * q₂ := hpq + _ = (q₁ * finiteSupportScalarHom (G := G) B) * + (q₂ * finiteSupportScalarHom (G := G) B⁻¹) := + (mul_scalar_mul_inv_scalar B hB q₁ q₂).symm + _ = finiteSupportMap f p₁ * finiteSupportMap f p₂ := by rw [← hp₁, ← hp₂] + _ = finiteSupportMap f (p₁ * p₂) := + ((finiteSupportMap f).map_mul p₁ p₂).symm + +private theorem map_dvd_of_eq_mul_scalar + (f : K →+* L) (B : L) (hB : B ≠ 0) + {p : FiniteSupportRing (G := G) (K := K)} + {q b : FiniteSupportRing (G := G) (K := L)} + (hp : finiteSupportMap f p = q * finiteSupportScalarHom (G := G) B) + (hq : q ∣ b) : + finiteSupportMap f p ∣ b := by + obtain ⟨r, hr⟩ := hq + refine ⟨r * finiteSupportScalarHom (G := G) B⁻¹, ?_⟩ + calc + b = q * r := hr + _ = (q * finiteSupportScalarHom (G := G) B) * + (r * finiteSupportScalarHom (G := G) B⁻¹) := + (mul_scalar_mul_inv_scalar B hB q r).symm + _ = finiteSupportMap f p * + (r * finiteSupportScalarHom (G := G) B⁻¹) := by rw [hp] + +/-- An injective coefficient map reflects divisibility of finite-support series provided that +nonzero factorisations whose product lies in its range can be scalar-redistributed into the +range. -/ +theorem finiteSupportMap_dvd_iff_of_scalarRedistribution + (f : K →+* L) (hf : Function.Injective f) + (hredistribute : + ∀ {p₁ p₂ : FiniteSupportRing (G := G) (K := L)}, + p₁ ≠ 0 → p₂ ≠ 0 → + p₁ * p₂ ∈ Set.range (finiteSupportMap (G := G) f) → + ∃ B : L, + B ≠ 0 ∧ + p₁ * finiteSupportScalarHom (G := G) B ∈ + Set.range (finiteSupportMap (G := G) f) ∧ + p₂ * finiteSupportScalarHom (G := G) B⁻¹ ∈ + Set.range (finiteSupportMap (G := G) f)) + (p q : FiniteSupportRing (G := G) (K := K)) : + finiteSupportMap f p ∣ finiteSupportMap f q ↔ p ∣ q := by + constructor + · rintro ⟨r, hr⟩ + by_cases hp : p = 0 + · subst p + have hqImage : finiteSupportMap f q = 0 := by simpa using hr + have hq : q = 0 := + (finiteSupportMap_injective f hf) (hqImage.trans (map_zero _).symm) + simp [hq] + by_cases hq : q = 0 + · simp [hq] + have hpImage : finiteSupportMap f p ≠ 0 := + (map_ne_zero_iff _ (finiteSupportMap_injective f hf)).mpr hp + have hqImage : finiteSupportMap f q ≠ 0 := + (map_ne_zero_iff _ (finiteSupportMap_injective f hf)).mpr hq + have hrNe : r ≠ 0 := by + intro hrZero + rw [hrZero, mul_zero] at hr + exact hqImage hr + have hprod : + finiteSupportMap f p * r ∈ + Set.range (finiteSupportMap (G := G) f) := by + exact ⟨q, hr⟩ + obtain ⟨B, hB, hleft, hright⟩ := + hredistribute hpImage hrNe hprod + have hBRange : B ∈ Set.range f := + coefficient_mem_range_of_map_mul_scalar_mem_range + (Field.toIsField K) f hp hleft + obtain ⟨k, hk⟩ := hBRange + obtain ⟨t, ht⟩ := hright + have hrRange : r ∈ Set.range (finiteSupportMap (G := G) f) := by + refine ⟨t * finiteSupportScalarHom (G := G) k, ?_⟩ + rw [map_mul, ht, finiteSupportMap_scalar, hk] + simp only [mul_assoc, ← map_mul, inv_mul_cancel₀ hB, map_one, mul_one] + obtain ⟨s, hs⟩ := hrRange + refine ⟨s, ?_⟩ + apply finiteSupportMap_injective f hf + rw [map_mul, hs, hr] + · rintro ⟨r, rfl⟩ + exact ⟨finiteSupportMap f r, map_mul _ _ _⟩ + +/-- Scalar redistribution descends the primal factor witnesses supplied by greatest-common- +divisor existence after coefficient extension. In particular, both descended factors remain in +the finite-support ring over the original coefficient field. -/ +theorem finiteSupportMap_exists_factor_dvd_of_scalarRedistribution + (f : K →+* L) (hf : Function.Injective f) + (hredistribute : + ∀ {p₁ p₂ : FiniteSupportRing (G := G) (K := L)}, + p₁ ≠ 0 → p₂ ≠ 0 → + p₁ * p₂ ∈ Set.range (finiteSupportMap (G := G) f) → + ∃ B : L, + B ≠ 0 ∧ + p₁ * finiteSupportScalarHom (G := G) B ∈ + Set.range (finiteSupportMap (G := G) f) ∧ + p₂ * finiteSupportScalarHom (G := G) B⁻¹ ∈ + Set.range (finiteSupportMap (G := G) f)) + (hgcd : ∀ p q : FiniteSupportRing (G := G) (K := L), + ∃ d : FiniteSupportRing (G := G) (K := L), + ∀ e : FiniteSupportRing (G := G) (K := L), + e ∣ p ∧ e ∣ q ↔ e ∣ d) + (p : FiniteSupportRing (G := G) (K := K)) + (b c : FiniteSupportRing (G := G) (K := L)) + (hp : finiteSupportMap f p ∣ b * c) : + ∃ p₁ p₂ : FiniteSupportRing (G := G) (K := K), + p = p₁ * p₂ ∧ + finiteSupportMap f p₁ ∣ b ∧ + finiteSupportMap f p₂ ∣ c := by + classical + by_cases hpZero : p = 0 + · obtain ⟨q, hq⟩ := hp + have hbc : b * c = 0 := by simpa [hpZero] using hq + rcases eq_zero_or_eq_zero_of_mul_eq_zero hbc with hb | hc + · exact ⟨0, 1, by simp [hpZero], by simp [hb], by simp⟩ + · exact ⟨1, 0, by simp [hpZero], by simp, by simp [hc]⟩ + · letI : GCDMonoid (FiniteSupportRing (G := G) (K := L)) := + gcdMonoidOfExistsGCD hgcd + obtain ⟨q₁, q₂, hq₁b, hq₂c, hpq⟩ := + exists_dvd_and_dvd_of_dvd_mul hp + have hpImage : finiteSupportMap f p ≠ 0 := + (map_ne_zero_iff _ (finiteSupportMap_injective f hf)).mpr hpZero + have hq₁ : q₁ ≠ 0 := by + intro hzero + apply hpImage + simpa [hzero] using hpq + have hq₂ : q₂ ≠ 0 := by + intro hzero + apply hpImage + simpa [hzero] using hpq + obtain ⟨B, hB, hleft, hright⟩ := + hredistribute hq₁ hq₂ ⟨p, hpq⟩ + obtain ⟨p₁, hp₁⟩ := hleft + obtain ⟨p₂, hp₂⟩ := hright + refine ⟨p₁, p₂, eq_mul_of_scalar_redistribution f hf B hB hpq hp₁ hp₂, + map_dvd_of_eq_mul_scalar f B hB hp₁ hq₁b, ?_⟩ + simpa using map_dvd_of_eq_mul_scalar f B⁻¹ (inv_ne_zero hB) hp₂ hq₂c + +end + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportScalarTensor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportScalarTensor.lean new file mode 100644 index 0000000000..a487a25d3a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportScalarTensor.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarExtension +public import Mathlib.RingTheory.TensorProduct.Basic + +import Mathlib.RingTheory.TensorProduct.MonoidAlgebra + +/-! +# Scalar extension as a tensor product for finite-support Hahn series + +For commutative rings `K` and `L` with a `K`-algebra structure on `L`, finite-support +nonpositive Hahn series over `L` are the scalar extension of the corresponding ring over `K`. +The equivalence is transported through the canonical additive-monoid-algebra presentation, so it +does not choose a basis or enumerate the support. + +This is the generic base-change identification used for the localization of the principal graded +ring in LM24, Section 6.3. +-/ + +open scoped HahnSeries TensorProduct + +universe u v w + +namespace HahnSeries.Nonpositive + +public noncomputable section + +variable {G : Type u} {K : Type v} {L : Type w} + [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] + [CommRing K] [CommRing L] [Algebra K L] + +/-- Base change of finite-support nonpositive Hahn series along a commutative-ring algebra. -/ +def finiteSupportScalarTensorEquiv : + L ⊗[K] FiniteSupportRing (G := G) (K := K) ≃ₐ[L] + FiniteSupportRing (G := G) (K := L) := + (Algebra.TensorProduct.congr + (AlgEquiv.refl : L ≃ₐ[L] L) + (finiteSupportAddMonoidAlgebraEquiv (G := G) (K := K))).trans + ((AddMonoidAlgebra.scalarTensorEquiv K L).trans + (finiteSupportAddMonoidAlgebraEquiv (G := G) (K := L)).symm) + +/-- On a pure tensor, finite-support scalar base change multiplies the constant series by the +coefficientwise scalar extension. -/ +theorem finiteSupportScalarTensorEquiv_tmul + (l : L) (p : FiniteSupportRing (G := G) (K := K)) : + finiteSupportScalarTensorEquiv (G := G) (K := K) (L := L) (l ⊗ₜ p) = + finiteSupportScalarHom (G := G) l * finiteSupportScalarExtension p := by + have hscalar : + finiteSupportAddMonoidAlgebraEquiv + (finiteSupportScalarHom (G := G) l) = + AddMonoidAlgebra.single 0 l := by + change finiteSupportAddMonoidAlgebraEquiv + (algebraMap L (FiniteSupportRing (G := G) (K := L)) l) = _ + rw [AlgEquiv.commutes] + rfl + rw [finiteSupportScalarTensorEquiv] + simp only [AlgEquiv.trans_apply, Algebra.TensorProduct.congr_apply, + Algebra.TensorProduct.map_tmul] + rw [AddMonoidAlgebra.scalarTensorEquiv_tmul] + apply finiteSupportAddMonoidAlgebraEquiv.injective + rw [finiteSupportAddMonoidAlgebraEquiv.apply_symm_apply, map_mul, hscalar] + rw [finiteSupportAddMonoidAlgebraEquiv_scalarExtension] + simp only [Algebra.smul_def] + congr 1 + +end + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportUnit.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportUnit.lean new file mode 100644 index 0000000000..0f7c9d96c6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportUnit.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport + +/-! +# Units of the nonpositive Hahn-series ring + +Half of LM24, Fact 2.5.2: the units of the finite-support nonpositive Hahn-series ring are +exactly the nonzero constant series. + +Finiteness of the support is not used. The order of a nonzero series is the least exponent of its +support, so it is at most zero here, and it is additive on products over a domain. A product equal +to one therefore forces both orders to vanish, which leaves the whole support at zero. +-/ + +open scoped HahnSeries + +universe u v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type v} +variable [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] +variable [Field K] + +/-- A factor of a product equal to one, among series supported in the nonpositive exponents, has +order zero. -/ +private theorem order_eq_zero_of_mul_eq_one {x y : K⟦G⟧} + (hx : x.support ⊆ Set.Iic 0) (hy : y.support ⊆ Set.Iic 0) (hxy : x * y = 1) : + x.order = 0 := by + have hx0 : x ≠ 0 := left_ne_zero_of_mul_eq_one hxy + have hy0 : y ≠ 0 := right_ne_zero_of_mul_eq_one hxy + have hmem : ∀ {z : K⟦G⟧}, z ≠ 0 → z.support ⊆ Set.Iic 0 → z.order ≤ 0 := by + intro z hz hsub + exact hsub ((HahnSeries.mem_support _ _).mpr + fun hc ↦ hz (HahnSeries.coeff_order_eq_zero.mp hc)) + have hsum := HahnSeries.order_mul hx0 hy0 + rw [hxy, HahnSeries.order_one] at hsum + refine le_antisymm (hmem hx0 hx) ?_ + by_contra hlt + rw [not_le] at hlt + refine absurd ?_ (lt_irrefl (0 : G)) + calc (0 : G) = x.order + y.order := hsum + _ < 0 + 0 := add_lt_add_of_lt_of_le hlt (hmem hy0 hy) + _ = 0 := add_zero 0 + +/-- A nonpositive series of order zero is a constant. -/ +private theorem eq_C_coeff_of_order_eq_zero {x : K⟦G⟧} (hx : x.support ⊆ Set.Iic 0) + (horder : x.order = 0) : x = HahnSeries.C (x.coeff 0) := by + ext g + rcases eq_or_ne g 0 with rfl | hg + · simp + · rw [HahnSeries.C_apply, HahnSeries.coeff_single_of_ne hg] + by_contra hne + exact hg (le_antisymm (hx hne) (horder ▸ HahnSeries.order_le_of_coeff_ne_zero hne)) + +/-- LM24, Fact 2.5.2: the units of the finite-support nonpositive Hahn-series ring are exactly +the nonzero constant series. -/ +theorem isUnit_finiteSupport_iff_exists_scalar + (p : (finiteSupportSubring : Subring (Nonpositive G K))) : + IsUnit p ↔ + ∃ k : K, k ≠ 0 ∧ p = finiteSupportScalarHom (G := G) k := by + constructor + · rintro ⟨u, rfl⟩ + obtain ⟨q, hq⟩ : ∃ q, (u : (finiteSupportSubring : Subring (Nonpositive G K))) * q = 1 := + ⟨↑u⁻¹, u.mul_inv⟩ + have hmul : (((u : (finiteSupportSubring : Subring (Nonpositive G K))) : + Nonpositive G K) : K⟦G⟧) * ((q : Nonpositive G K) : K⟦G⟧) = 1 := by + have hcast := congrArg (fun r : (finiteSupportSubring : Subring (Nonpositive G K)) ↦ + ((r : Nonpositive G K) : K⟦G⟧)) hq + simpa using hcast + have hsub : ∀ r : (finiteSupportSubring : Subring (Nonpositive G K)), + ((r : Nonpositive G K) : K⟦G⟧).support ⊆ Set.Iic 0 := + fun r ↦ (HahnSeries.mem_nonpositiveSubring (Γ := G) (R := K)).mp (r : Nonpositive G K).2 + have horder := order_eq_zero_of_mul_eq_one (hsub _) (hsub q) hmul + refine ⟨(((u : (finiteSupportSubring : Subring (Nonpositive G K))) : + Nonpositive G K) : K⟦G⟧).coeff 0, ?_, ?_⟩ + · rw [← horder] + intro hc + have h0 : (((u : (finiteSupportSubring : Subring (Nonpositive G K))) : + Nonpositive G K) : K⟦G⟧) = 0 := HahnSeries.coeff_order_eq_zero.mp hc + rw [h0, zero_mul] at hmul + exact one_ne_zero hmul.symm + · apply Subtype.ext + apply Subtype.ext + rw [coe_finiteSupportScalarHom] + exact eq_C_coeff_of_order_eq_zero (hsub _) horder + · rintro ⟨k, hk, rfl⟩ + exact (Ne.isUnit hk).map (finiteSupportScalarHom (G := G)) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ.lean new file mode 100644 index 0000000000..b9cef5f768 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence.lean new file mode 100644 index 0000000000..e9c61c7bf3 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence.lean @@ -0,0 +1,49 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Additive +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.AlgebraicIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Boundary +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Cancellation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonRankLevels +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValueMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CofactorInduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Convolution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationSet +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Germ +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.GlobalCofactors +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Graded +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LeadingCoefficient +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Leibniz +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LiftFamily +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Lifts +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalEvaluation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalRelationAtCutoff +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LinearMaximal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LowerTruncationDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Multiplication +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Obligations +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.OrderedIntervalCantorBendixson +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativeIndices +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativesAtLimitOrdinal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Power +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PrincipalSeries +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Scalar +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.ScalarLeadingCoefficientAtLimitOrdinal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SeparatedPieceCantorBendixson +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SuccessorLeibniz +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SyzygyIntegration +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolationOnSets +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Truncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationExpansion +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationPolynomial + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Additive.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Additive.lean new file mode 100644 index 0000000000..2549b8ff98 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Additive.lean @@ -0,0 +1,204 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValue +public import Mathlib.RingTheory.HahnSeries.Addition + +/-! +# Additive laws for the Cantor–Bendixson value + +Binary union commutes with every transfinite derivative. The support of a sum is contained in +the union of the factor supports, so the value of a sum is bounded by their maximum. If the +values differ, the larger value survives. A difference of value zero preserves the value. +These statements use the given order topology, with no completeness hypothesis. +-/ + +public noncomputable section + +open Set Topology TopologicalSpace + +universe u v + +namespace HahnSeries + +variable {G : Type u} {R : Type v} [LinearOrder G] [TopologicalSpace G] + [OrderTopology G] [Zero G] + +section AddMonoid + +variable [AddMonoid R] + +/-- The value of a sum is bounded by the maximum of the summand values. -/ +theorem cantorBendixsonValue_add_le (b d : HahnSeries G R) : + (b + d).cantorBendixsonValue ≤ max b.cantorBendixsonValue d.cantorBendixsonValue := by + by_cases hm : 0 ∈ closure (b + d).support + · have hsub : (b + d).closedSupport ≤ b.closedSupport ⊔ d.closedSupport := by + change ((b + d).closedSupport : Set G) ⊆ + (b.closedSupport : Set G) ∪ (d.closedSupport : Set G) + rw [coe_closedSupport, coe_closedSupport, coe_closedSupport, ← closure_union] + exact closure_mono (support_add_subset b d) + have hh := Closeds.cantorBendixson_mono hsub ((b + d).cantorBendixsonRank 0) + (((b + d).mem_support_derivative_iff 0 _).mpr ⟨hm, le_rfl⟩) + rw [Closeds.cantorBendixson_sup] at hh + rcases hh with hb | hd + · obtain ⟨hb0, hr⟩ := (b.mem_support_derivative_iff 0 _).mp hb + apply le_max_of_le_left + rw [(b + d).cantorBendixsonValue_of_mem hm, b.cantorBendixsonValue_of_mem hb0] + exact Ordinal.opow_le_opow_right Ordinal.omega0_pos hr + · obtain ⟨hd0, hr⟩ := (d.mem_support_derivative_iff 0 _).mp hd + apply le_max_of_le_right + rw [(b + d).cantorBendixsonValue_of_mem hm, d.cantorBendixsonValue_of_mem hd0] + exact Ordinal.opow_le_opow_right Ordinal.omega0_pos hr + · rw [(b + d).cantorBendixsonValue_of_notMem hm] + exact zero_le + +/-- Repeated addition cannot increase the value. -/ +theorem cantorBendixsonValue_nsmul_le (b : HahnSeries G R) (n : ℕ) : + (n • b).cantorBendixsonValue ≤ b.cantorBendixsonValue := by + induction n with + | zero => simp + | succ n ih => + rw [succ_nsmul] + exact (cantorBendixsonValue_add_le _ _).trans (max_le ih le_rfl) + +end AddMonoid + +section AddCommMonoid + +variable [AddCommMonoid R] + +/-- A finite sum preserves a strict positive upper bound on the values. -/ +theorem cantorBendixsonValue_sum_lt {ι : Type*} (s : Finset ι) (f : ι → HahnSeries G R) + {ρ : Ordinal.{u}} (hρ : 0 < ρ) (h : ∀ i ∈ s, (f i).cantorBendixsonValue < ρ) : + (∑ i ∈ s, f i).cantorBendixsonValue < ρ := by + classical + induction s using Finset.induction_on with + | empty => simpa only [Finset.sum_empty, cantorBendixsonValue_zero] using hρ + | insert a s ha ih => + rw [Finset.sum_insert ha] + exact (cantorBendixsonValue_add_le _ _).trans_lt + (max_lt (h a (Finset.mem_insert_self a s)) + (ih fun i hi ↦ h i (Finset.mem_insert_of_mem hi))) + +/-- A finite sum of value-zero terms has value zero. -/ +theorem cantorBendixsonValue_sum_eq_zero {ι : Type*} (s : Finset ι) (f : ι → HahnSeries G R) + (h : ∀ i ∈ s, (f i).cantorBendixsonValue = 0) : + (∑ i ∈ s, f i).cantorBendixsonValue = 0 := by + classical + induction s using Finset.induction_on with + | empty => simp only [Finset.sum_empty, cantorBendixsonValue_zero] + | insert a s ha ih => + rw [Finset.sum_insert ha] + apply le_antisymm _ zero_le + exact (cantorBendixsonValue_add_le _ _).trans (by + rw [h a (Finset.mem_insert_self a s), + ih (fun i hi ↦ h i (Finset.mem_insert_of_mem hi)), max_self]) + +end AddCommMonoid + +section AddGroup + +variable [AddGroup R] + +/-- Negation preserves the value. -/ +theorem cantorBendixsonValue_neg (b : HahnSeries G R) : + (-b).cantorBendixsonValue = b.cantorBendixsonValue := + cantorBendixsonValue_congr_support support_neg + +/-- Subtraction is bounded by the maximum of the two values. -/ +theorem cantorBendixsonValue_sub_le (b d : HahnSeries G R) : + (b - d).cantorBendixsonValue ≤ max b.cantorBendixsonValue d.cantorBendixsonValue := by + simpa only [sub_eq_add_neg, cantorBendixsonValue_neg] using + b.cantorBendixsonValue_add_le (-d) + +/-- When two values differ, their sum has the larger value. -/ +theorem cantorBendixsonValue_add_eq_max_of_ne (b d : HahnSeries G R) + (hne : b.cantorBendixsonValue ≠ d.cantorBendixsonValue) : + (b + d).cantorBendixsonValue = max b.cantorBendixsonValue d.cantorBendixsonValue := by + apply le_antisymm (b.cantorBendixsonValue_add_le d) + rcases lt_or_gt_of_ne hne with hlt | hgt + · rw [max_eq_right hlt.le] + have hd := (-b).cantorBendixsonValue_add_le (b + d) + rw [neg_add_cancel_left, cantorBendixsonValue_neg] at hd + exact (le_max_iff.mp hd).resolve_left (not_le_of_gt hlt) + · rw [max_eq_left hgt.le] + have hb := (b + d).cantorBendixsonValue_add_le (-d) + rw [add_neg_cancel_right, cantorBendixsonValue_neg] at hb + exact (le_max_iff.mp hb).resolve_right (not_le_of_gt hgt) + +/-- An error of value zero does not change the value. -/ +theorem cantorBendixsonValue_eq_of_sub_value_eq_zero (b d : HahnSeries G R) + (h : (b - d).cantorBendixsonValue = 0) : + b.cantorBendixsonValue = d.cantorBendixsonValue := by + have hbd := (b - d).cantorBendixsonValue_add_le d + rw [sub_add_cancel, h, max_eq_right zero_le] at hbd + have hdb := (d - b).cantorBendixsonValue_add_le b + rw [sub_add_cancel, ← neg_sub b d, cantorBendixsonValue_neg, h, + max_eq_right zero_le] at hdb + exact hbd.antisymm hdb + +/-- Value one means a nonzero ordinary coefficient with a remainder of value zero. -/ +theorem cantorBendixsonValue_eq_one_iff (b : HahnSeries G R) : + b.cantorBendixsonValue = 1 ↔ + b.coeff 0 ≠ 0 ∧ (b - single 0 (b.coeff 0)).cantorBendixsonValue = 0 := by + classical + constructor + · intro hv + have hm : 0 ∈ closure b.support := by + by_contra hn + have he := b.cantorBendixsonValue_of_notMem hn + rw [hv] at he + exact one_ne_zero he + have hr : b.cantorBendixsonRank 0 = 0 := by + rw [b.cantorBendixsonValue_of_mem hm, Ordinal.opow_eq_one_iff] at hv + exact hv.resolve_left Ordinal.one_lt_omega0.ne' + have hn : (0 : G) ∉ derivedSet (closure b.support) := by + have he := b.closedSupport.notMem_cantorBendixson_rank_add_one b.closedSupport_isPWO 0 + rw [← cantorBendixsonRank_eq, hr, zero_add, + show (1 : Ordinal.{u}) = 0 + 1 by simp, + Closeds.cantorBendixson_add_one, Closeds.cantorBendixson_zero] at he + simpa only [Closeds.coe_derived, coe_closedSupport] using he + have hcoeff : b.coeff 0 ≠ 0 := by + rw [closure_eq_self_union_derivedSet] at hm + exact hm.resolve_right (fun ha ↦ hn (derivedSet_mono _ _ subset_closure ha)) + refine ⟨hcoeff, cantorBendixsonValue_of_notMem _ ?_⟩ + rw [mem_closure_iff_frequently, Filter.not_frequently] + rw [mem_derivedSet, accPt_iff_frequently, Filter.not_frequently] at hn + filter_upwards [hn] with x hx + change ¬ (b - single 0 (b.coeff 0)).coeff x ≠ 0 + rw [coeff_sub] + by_cases hx0 : x = 0 + · subst x + simp + · have hbx : b.coeff x = 0 := by + by_contra hnonzero + exact hx ⟨hx0, subset_closure hnonzero⟩ + simp [hbx, hx0] + · rintro ⟨hc, hz⟩ + rw [b.cantorBendixsonValue_eq_of_sub_value_eq_zero _ hz] + apply cantorBendixsonValue_of_finite_of_coeff_ne_zero + · exact (finite_singleton _).subset support_single_subset + · simpa using hc + +end AddGroup + +section Ring + +variable [Ring R] [NoZeroDivisors R] + +/-- A natural scalar that is nonzero in the coefficient domain preserves the value. -/ +theorem cantorBendixsonValue_nsmul (b : HahnSeries G R) (n : ℕ) (hn : (n : R) ≠ 0) : + (n • b).cantorBendixsonValue = b.cantorBendixsonValue := by + apply cantorBendixsonValue_congr_support + ext x + simp only [mem_support] + rw [coeff_nsmul] + simp [nsmul_eq_mul, hn] + +end Ring + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/AlgebraicIndependence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/AlgebraicIndependence.lean new file mode 100644 index 0000000000..3b57a3bb19 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/AlgebraicIndependence.lean @@ -0,0 +1,326 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LeadingCoefficient +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LinearMaximal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Obligations +public import + LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativesAtLimitOrdinal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Scalar +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ArchimedeanBallBase +public import Mathlib.RingTheory.AlgebraicIndependent.Defs + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Algebraic independence for the Cantor--Bendixson degree + +A minimal system of homogeneous generators is algebraically independent. Equivalently, polynomial +evaluation at the generators is injective. The proof is a transfinite induction on weighted degree. +Degree zero is scalar. A successor weighted degree is handled by the lowering derivation. At a +non-zero limit weighted degree, maximal-variable linearity and the required partial-derivative +identities are established together. + +The argument for a successor degree is stated over an arbitrary filter. The argument for a limit +ordinal degree uses the hypotheses supplied by its ordered-group setting. This file records what +the induction needs and does not otherwise depend on the setting, so that what remains for the +Cantor--Bendixson degree is exactly the list of hypotheses below. +-/ + +universe u v w x + +open scoped NatOrdinal Topology + +open Filter MvPolynomial HahnSeries HahnSeries.Nonpositive + +public noncomputable section + +namespace HahnSeries.Germ + +variable {G : Type u} {K : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [Field K] [CharZero K] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := K)) + +variable {ι : Type w} {wt : ι → NatOrdinal.{u}} + {xg : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded} +variable (σ : LiftFamily wt xg) +variable (hx : OrdinalGraded.IsMinimalSystem + (DirectSum.rangeLof K (cantorBendixsonDegreeValuation (G := G) (R := K)).Component) wt xg) +include hx + +/-- **Polynomiality, degree by degree.** Evaluation at a minimal system is injective in every +degree, given the successor step and the three inputs of the limit step in every degree below. -/ +theorem injectiveAt_of_isMinimalSystem + (hleading : ∀ α : NatOrdinal.{u}, (∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) → + ∀ {F : MvPolynomial ι K}, IsWeightedHomogeneous wt F α → aeval xg F = 0 → + ∀ {B₀ : ι}, B₀ ∈ F.vars → (∀ i ∈ F.vars, wt i ≤ wt B₀) → wt B₀ < α → + ∀ {degHD : NatOrdinal.{u}}, degHD + degreeOf B₀ F • wt B₀ = α → + (degHD = 0 ∨ NatOrdinal.leastTerm degHD ≤ NatOrdinal.leastTerm (wt B₀)) → False) + (hlin : ∀ α : NatOrdinal.{u}, (∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) → + ∀ S : LimitOrdinalRelationAtCutoff σ α, degreeOf S.B₀ S.F = 1) + (hpartials : ∀ α : NatOrdinal.{u}, (∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) → + ∀ S : LimitOrdinalRelationAtCutoff σ α, ∀ v', v' ∈ S.F.vars → S.LowDegreePartAlgebraicLE v' → + ∃ (s : Finset ι) (U : ι → MvPolynomial ι K), (∀ v ∈ s, + S.ContributesToPartialDerivativeAt v' v) ∧ + (∀ v ∈ s, pderiv S.B₀ (U v) = 0) ∧ pderiv v' S.F = ∑ v ∈ s, pderiv v S.F * U v) + (α : NatOrdinal.{u}) : OrdinalGraded.InjectiveAt K wt xg α := by + letI : Nontrivial ((cantorBendixsonDegreeValuation (G := G) (R := K)).Component 0) := + Function.Injective.nontrivial + (cantorBendixsonLayerScalarHom_injective (G := G) (K := K)) + letI : Nontrivial (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded := + Function.Injective.nontrivial (DirectSum.of_injective 0) + exact OrdinalGraded.injectiveAt_of_zero_successor_limit + (OrdinalGraded.injectiveAt_zero hx.ne_zero) + (fun _ hcc ih ↦ HahnSeries.Nonpositive.injectiveAt_of_forall_lt hx + (pos_iff_ne_zero.mpr hcc) ih) + (fun α hα hcc ih ↦ + injectiveAt_of_limit σ hx (hleading α ih) (hlin α ih) (hpartials α ih) hα hcc) + α + +/-- **Polynomiality, degree by degree.** The leading-coefficient obstruction has been discharged; +only linearity of the maximal variable and the partial-derivative identities remain. -/ +@[blueprint "lem:cantor-bendixson-degree-induction" + (phase := "Algebraic independence in graded rings") + (title := "Degreewise injectivity of homogeneous evaluation") + (statement := /-- + Let $K$ be a field of characteristic zero and $G$ a nontrivial complete + ordered abelian group with compatible additive uniformity and order + topology. Let $\nu$ be the Cantor--Bendixson degree on + $K((G^{\le0}))$. Let $x_i\in(\operatorname{gr}_\nu)_{w_i}$ be a minimal + homogeneous generating system, and choose series $b_i$ representing + $x_i$ in degree $w_i$. Suppose + \[ + \nu(b_i)\le w_i, + \qquad \nu(b_i^{\vert y}) (cantorBendixsonDegreeValuation (G := G) (R := R)) + +/-- A product of a factor of degree at most `ρ` with a factor of degree strictly below `σ` has +degree strictly below every bound `τ` separated from `ρ` by `σ`. -/ +theorem degree_mul_lt_of_le_of_lt_of_separated + (a b : Nonpositive G R) (ρ σ τ : NatOrdinal.{u}) + (ha : ν a ≤ ρ) (hb : ν b < σ) + (hsep : ∀ θ, θ < σ → ρ + θ < τ) : + ν (a * b) < τ := by + have hmul := (ν).map_mul_le_add a b + cases hdegree : ν b using WithBot.recBotCoe with + | bot => + rw [hdegree, WithBot.add_bot] at hmul + exact hmul.trans_lt (WithBot.bot_lt_coe τ) + | coe θ => + have hθ : θ < σ := by simpa only [hdegree, WithBot.coe_lt_coe] using hb + apply hmul.trans_lt + rw [hdegree] + calc + ν a + (θ : WithBot NatOrdinal) ≤ (ρ : WithBot NatOrdinal) + θ := + by simpa only [add_comm] using add_le_add_right ha θ + _ = ((ρ + θ : NatOrdinal) : WithBot NatOrdinal) := (WithBot.coe_add ρ θ).symm + _ < (τ : WithBot NatOrdinal) := by + simpa only [WithBot.coe_lt_coe] using hsep θ hθ + +/-- Under the separation inequality, the nonboundary convolution terms and the truncation of the +second factor are strictly below `τ`. Hence only the first boundary term survives at degree at +least `τ`. -/ +theorem degree_translatedTruncLE_mul_sub_mul_lt_of_pointwise_bounds + (a b : Nonpositive G R) (ρ σ τ : NatOrdinal.{u}) + (ha : ν a ≤ ρ) + (hat : ∀ x : G, x < 0 → ν (translatedTruncLE x a) ≤ ρ) + (hbt : ∀ x : G, x < 0 → ν (translatedTruncLE x b) < σ) + (hsep : ∀ θ, θ < σ → ρ + θ < τ) + {γ : G} (hγ : γ < 0) : + ν (translatedTruncLE γ (a * b) - translatedTruncLE γ a * b) < τ := by + have hremValue := HahnSeries.cantorBendixsonValue_leibnizRemainder_lt_of_forall + (a : HahnSeries G R) (b : HahnSeries G R) a.property b.property hγ + (ρ := (ω^ τ).val) (NatOrdinal.wpow_pos τ) (fun x y _ hx _ hy _ ↦ by + have hprod := degree_mul_lt_of_le_of_lt_of_separated + (translatedTruncLE x a) (translatedTruncLE y b) ρ σ τ + (hat x hx) (hbt y hy) hsep + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + NatOrdinal.cantorDegree_lt_coe_iff] at hprod + exact NatOrdinal.of.lt_iff_lt.mp + (by simpa only [coe_translatedTruncLE, Subring.coe_mul, NatOrdinal.of_val] using hprod)) + have hrem : ν (translatedTruncLE γ (a * b) - translatedTruncLE γ a * b - + a * translatedTruncLE γ b) < τ := by + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + NatOrdinal.cantorDegree_lt_coe_iff] + change NatOrdinal.of (((translatedTruncLE γ (a * b) : HahnSeries G R) - + (translatedTruncLE γ a : HahnSeries G R) * b - + (a : HahnSeries G R) * translatedTruncLE γ b).cantorBendixsonValue) < ω^ τ + exact NatOrdinal.of.lt_iff_lt.mpr (by + simpa only [coe_translatedTruncLE, Subring.coe_mul, NatOrdinal.val_wpow] using hremValue) + have hlast : ν (a * translatedTruncLE γ b) < τ := + degree_mul_lt_of_le_of_lt_of_separated a (translatedTruncLE γ b) + ρ σ τ ha (hbt γ hγ) hsep + have heq : translatedTruncLE γ (a * b) - translatedTruncLE γ a * b = + (translatedTruncLE γ (a * b) - translatedTruncLE γ a * b - + a * translatedTruncLE γ b) + a * translatedTruncLE γ b := by + abel + rw [heq] + exact ((ν).map_add_le_max _ _).trans_lt (max_lt hrem hlast) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Cancellation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Cancellation.lean new file mode 100644 index 0000000000..9c6f7ffa10 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Cancellation.lean @@ -0,0 +1,304 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Power + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPrincipal +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPowerFactorization + +/-! +# Cancellation through residual Cantor–Bendixson ranks + +A lower bound on translated truncations at residual-rank cutoffs reconstructs a lower bound +at zero. Applied to the power remainder, this proves the pure-power cancellation step. +For a power times a second factor, multiply the product rule by that factor; the smaller +remainder and the deficient-product term cannot cancel the term of known value. + +Both cancellation statements retain an explicit hypothesis about smaller products. They do +not assert multiplicativity on their own. The natural-number multiplicity survives because +the coefficient domain has characteristic zero. No field inverse is used. + +V denotes the value in NatOrdinal, and T denotes translated weak truncation, in the proofs. +The ordinal factorisation calculation is the one used in Berarducci, Lemma 8.2, applied here +to the Cantor–Bendixson value on an ordered exponent group that is Cauchy complete. +-/ + +public noncomputable section + +open Set Filter Topology +universe u v +namespace HahnSeries +variable {G : Type u} {R : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [CommRing R] [NoZeroDivisors R] [CharZero R] + + +local notation "V" => (fun b : HahnSeries G R ↦ NatOrdinal.of (cantorBendixsonValue b)) +local notation:max "T" x:arg "," c:arg => translate (-c) (truncLE c x) + +omit [CompleteSpace G] [NoZeroDivisors R] [CharZero R] in +/-- Eventual bounds at residual-rank cutoffs reconstruct an ordinary principal-factor multiple. -/ +theorem cantorBendixsonValue_residual_reconstruction (b d : HahnSeries G R) (hb : b.support ⊆ Iic 0) + (B : Ordinal.AdditivePrincipalAboveOne.{u}) (hB : b.cantorBendixsonValue = B.val) + (X : NatOrdinal.{u}) (hX : Ordinal.IsAdditivelyPrincipal X.val) + (hyp : ∀ᶠ γ in 𝓝[<] (0 : G), + NatOrdinal.of (translate (-γ) (truncLE γ b)).cantorBendixsonValue = + NatOrdinal.of B.residualFactor → + X ≤ NatOrdinal.of (translate (-γ) (truncLE γ d)).cantorBendixsonValue) : + X.val * B.principalFactor ≤ d.cantorBendixsonValue := by + let a := Ordinal.log Ordinal.omega0 B.residualFactor + let r := Ordinal.log Ordinal.omega0 B.principalFactor + let c := Ordinal.log Ordinal.omega0 X.val + have ha : Ordinal.omega0 ^ a = B.residualFactor := + B.residualFactor_isAdditivelyPrincipal.opow_log_self + have hr : Ordinal.omega0 ^ r = B.principalFactor := + B.principalFactor_isInfiniteMultiplicativelyPrincipal.isAdditivelyPrincipal.opow_log_self + have hc : Ordinal.omega0 ^ c = X.val := hX.opow_log_self + have hrpos : 0 < r := by + apply (Ordinal.opow_lt_opow_iff_right Ordinal.one_lt_omega0).mp + simpa only [Ordinal.opow_zero, hr] using B.one_lt_principalFactor + have hbv : b.cantorBendixsonValue = Ordinal.omega0 ^ (a + r) := by + rw [Ordinal.opow_add, ha, hr, B.residualFactor_mul_principalFactor, hB] + have hl : ∀ᶠ γ in 𝓝[<] (0 : G), + (T b, γ).cantorBendixsonValue = Ordinal.omega0 ^ a → + Ordinal.omega0 ^ c ≤ (T d, γ).cantorBendixsonValue := by + filter_upwards [hyp] with γ hγ he + rw [ha] at he + rw [hc] + exact hγ (congrArg NatOrdinal.of he) + have h := b.cantorBendixsonValue_reconstruction d hb a c r hrpos hbv hl + rwa [Ordinal.opow_add, hc, hr] at h + +/-- The expected values of the smaller residual-point products imply the pure-power formula. -/ +@[blueprint "lem:cantor-bendixson-pure-power-cancellation" + (phase := "Cantor–Bendixson ranks of supports") + (title := "Pure-power cancellation for the Cantor--Bendixson value") + (statement := /-- + Let $R$ be a characteristic-zero domain, let $G$ be a nontrivial complete + ordered abelian group equipped with a compatible additive uniformity and + its order topology, and let $b\in R((G^{\le0}))$. Suppose + $V_{\mathrm{CB}}(b)=B>1$, where $B$ is additively principal, and write + $B=\rho_B\odot\pi_B$ for its residual factor and its final infinite + multiplicatively principal factor. Let $m\in\mathbb N$. + + Suppose that, for every $\gamma<0$ sufficiently close to $0$, + \[ + V_{\mathrm{CB}}(b^{\vert\gamma})=\rho_B + \quad\Longrightarrow\quad + V_{\mathrm{CB}}(b^{\vert\gamma}b^m) + =B^{\odot m}\odot\rho_B. + \] + Then + \[ + V_{\mathrm{CB}}(b^{m+1})=B^{\odot(m+1)}. + \] + Here products and powers marked by $\odot$ are Hessenberg's natural + operations. + -/) + (proof := /-- + The translated truncation of $b^{m+1}$ is the main term + $(m+1)b^{\vert\gamma}b^m$ plus a remainder of smaller + Cantor--Bendixson value. Characteristic zero preserves the value of the + nonzero coefficient $m+1$, so the local hypothesis computes the value of + the main term and hence of the whole truncation. Applying + \ref{lem:cantor-bendixson-rank-reconstruction} supplies the required lower + bound at $0$; the reverse inequality follows by iterating + \ref{lem:cantor-bendixson-value-product-upper-bound} over the power. + -/)] +theorem cantorBendixsonValue_pow_eq_of_eventually (b : HahnSeries G R) (hb : b.support ⊆ Iic 0) + (B : Ordinal.AdditivePrincipalAboveOne.{u}) (hB : b.cantorBendixsonValue = B.val) (m : ℕ) + (hyp : ∀ᶠ γ in 𝓝[<] (0 : G), + NatOrdinal.of (translate (-γ) (truncLE γ b)).cantorBendixsonValue = + NatOrdinal.of B.residualFactor → + NatOrdinal.of (translate (-γ) (truncLE γ b) * b ^ m).cantorBendixsonValue = + NatOrdinal.of B.val ^ m * NatOrdinal.of B.residualFactor) : + NatOrdinal.of (b ^ (m + 1)).cantorBendixsonValue = + NatOrdinal.of B.val ^ (m + 1) := by + let X := NatOrdinal.of B.val ^ m * NatOrdinal.of B.residualFactor + have hX := B.power_residual_factorization m + have hkey : ∀ᶠ γ in 𝓝[<] (0 : G), V (T b, γ) = NatOrdinal.of B.residualFactor → + X ≤ V (T (b ^ (m + 1)), γ) := by + filter_upwards [hyp, b.eventually_cantorBendixsonValue_powerRemainder_lt hb B hB m] + with γ hγ hrem he + have hmain : V ((m + 1) • (T b, γ * b ^ m)) = X := by + dsimp only + rw [cantorBendixsonValue_nsmul _ _ (Nat.cast_ne_zero.mpr (Nat.succ_ne_zero m))] + exact hγ he + have hsmall : V (T (b ^ (m + 1)), γ - (m + 1) • (T b, γ * b ^ m)) < + V ((m + 1) • (T b, γ * b ^ m)) := by rwa [hmain] + have hsum := cantorBendixsonValue_add_eq_max_of_ne + (T (b ^ (m + 1)), γ - (m + 1) • (T b, γ * b ^ m)) + ((m + 1) • (T b, γ * b ^ m)) (ne_of_lt hsmall) + rw [sub_add_cancel, max_eq_right (NatOrdinal.of.le_iff_le.mp hsmall.le)] at hsum + exact le_of_eq ((congrArg NatOrdinal.of hsum).trans hmain).symm + have hlow := cantorBendixsonValue_residual_reconstruction b (b ^ (m + 1)) hb B hB X hX.1 hkey + have hid : X * NatOrdinal.of B.principalFactor = NatOrdinal.of B.val ^ (m + 1) := by + dsimp only [X] + rw [mul_assoc, B.naturalResidual_mul_naturalPrincipal, ← pow_succ] + rw [← hX.2, hid] at hlow + refine le_antisymm ?_ hlow + simpa only [hB] using b.cantorBendixsonValue_pow_le hb (m + 1) + + +omit [CharZero R] [NoZeroDivisors R] [CommRing R] [CompleteSpace G] [Nontrivial G] + [OrderTopology G] [IsUniformAddGroup G] [UniformSpace G] [IsOrderedAddMonoid G] + [LinearOrder G] [AddCommGroup G] in +private theorem small_mul_lt (B C : Ordinal.AdditivePrincipalAboveOne.{u}) + (hp : B.principalFactor ≤ C.principalFactor) (X : NatOrdinal.{u}) (hX : 0 < X) + (hfactor : (X * NatOrdinal.of B.principalFactor).val = X.val * B.principalFactor) + {s t : NatOrdinal.{u}} (hs : s < X * NatOrdinal.of B.principalFactor) + (ht : t < NatOrdinal.of C.val) : + s * t < X * NatOrdinal.of C.val := by + have hs' : s.val < X.val * B.principalFactor := by + rw [← hfactor] + exact hs + have ht' : t.val < C.residualFactor * C.principalFactor := by + rw [C.residualFactor_mul_principalFactor] + exact ht + obtain ⟨i, hi, hsi⟩ := (Ordinal.lt_mul_iff_of_isSuccLimit + B.principalFactor_isInfiniteMultiplicativelyPrincipal.isSuccLimit).mp hs' + obtain ⟨j, hj, htj⟩ := (Ordinal.lt_mul_iff_of_isSuccLimit + C.principalFactor_isInfiniteMultiplicativelyPrincipal.isSuccLimit).mp ht' + have hρ : 0 < NatOrdinal.of C.residualFactor := + pos_iff_ne_zero.mpr C.residualFactor_isAdditivelyPrincipal.ne_zero + have h := NatOrdinal.naturalMul_mul_lt_of_lt + (ρ₁ := X) (ρ₂ := NatOrdinal.of C.residualFactor) + (π₁ := NatOrdinal.of B.principalFactor) (π₂ := NatOrdinal.of C.principalFactor) + (α₁ := NatOrdinal.of i) (α₂ := NatOrdinal.of j) + C.principalFactor_isMultiplicativelyPrincipal hp hi hj (mul_pos hX hρ) + rw [mul_assoc, C.naturalResidual_mul_naturalPrincipal] at h + exact (mul_le_mul' (NatOrdinal.of.le_iff_le.mpr hsi.le) + (NatOrdinal.of.le_iff_le.mpr htj.le)).trans_lt h + +/-- The expected residual-point products imply the power-times-factor formula. +The second factor must have no smaller canonical principal factor. -/ +@[blueprint "lem:cantor-bendixson-power-factor-cancellation" + (phase := "Cantor–Bendixson ranks of supports") + (title := "Power-times-factor cancellation for the Cantor--Bendixson value") + (statement := /-- + Under the coefficient and exponent-group hypotheses of + \ref{lem:cantor-bendixson-pure-power-cancellation}, let + $b,c\in R((G^{\le0}))$ have additively principal values + $V_{\mathrm{CB}}(b)=B>1$ and $V_{\mathrm{CB}}(c)=C>1$. Write + $B=\rho_B\odot\pi_B$ and $C=\rho_C\odot\pi_C$ as above, and suppose + $\pi_B\le\pi_C$. If, for every $\gamma<0$ sufficiently close to $0$, + \[ + V_{\mathrm{CB}}(b^{\vert\gamma})=\rho_B + \quad\Longrightarrow\quad + V_{\mathrm{CB}}\!\left( + b^{\vert\gamma}b^mc^2 + \right) + =B^{\odot m}\odot\rho_B\odot C\odot C, + \] + then + \[ + V_{\mathrm{CB}}(b^{m+1}c) + =B^{\odot(m+1)}\odot C. + \] + -/) + (proof := /-- + Put $d=b^{m+1}c$. Multiply the translated-truncation expansion of $d$ + by $c$. Its main term is + $(m+1)b^{\vert\gamma}b^mc^2$; the two remaining terms have strictly + smaller value by + \ref{lem:cantor-bendixson-value-product-upper-bound}, the ordering + $\pi_B\le\pi_C$, and the ordinal factorisation of $B$ and $C$. Thus the + hypothesis computes $V_{\mathrm{CB}}(c d^{\vert\gamma})$. If + $V_{\mathrm{CB}}(d^{\vert\gamma})$ were too small, the same upper bound + would contradict this computation. The resulting local lower bound is + lifted to $0$ by + \ref{lem:cantor-bendixson-rank-reconstruction}; the product upper bound + gives the reverse inequality. + -/)] +theorem cantorBendixsonValue_pow_mul_eq_of_eventually (b c : HahnSeries G R) + (hb : b.support ⊆ Iic 0) (hc : c.support ⊆ Iic 0) + (B C : Ordinal.AdditivePrincipalAboveOne.{u}) + (hB : b.cantorBendixsonValue = B.val) (hC : c.cantorBendixsonValue = C.val) + (hp : B.principalFactor ≤ C.principalFactor) (m : ℕ) + (hyp : ∀ᶠ γ in 𝓝[<] (0 : G), + NatOrdinal.of (translate (-γ) (truncLE γ b)).cantorBendixsonValue = + NatOrdinal.of B.residualFactor → + NatOrdinal.of (translate (-γ) (truncLE γ b) * (b ^ m * c ^ 2)).cantorBendixsonValue = + NatOrdinal.of B.val ^ m * NatOrdinal.of B.residualFactor * + NatOrdinal.of C.val * NatOrdinal.of C.val) : + NatOrdinal.of (b ^ (m + 1) * c).cantorBendixsonValue = + NatOrdinal.of B.val ^ (m + 1) * NatOrdinal.of C.val := by + let X := NatOrdinal.of B.val ^ m * NatOrdinal.of B.residualFactor * NatOrdinal.of C.val + let d := b ^ (m + 1) * c + have hd : d.support ⊆ Iic 0 := + (nonpositiveSubring G R).mul_mem ((nonpositiveSubring G R).pow_mem hb _) hc + have hX := B.power_residual_mul_factorization C hp m + have hCpos : 0 < NatOrdinal.of C.val := pos_iff_ne_zero.mpr C.2.1.ne_zero + have hXpos : 0 < X := pos_iff_ne_zero.mpr hX.1.ne_zero + have hZ : X * NatOrdinal.of B.principalFactor = + NatOrdinal.of B.val ^ (m + 1) * NatOrdinal.of C.val := by + dsimp only [X] + rw [mul_assoc, mul_comm (NatOrdinal.of C.val), ← mul_assoc, mul_assoc _ _ + (NatOrdinal.of B.principalFactor), B.naturalResidual_mul_naturalPrincipal, ← pow_succ] + refine le_antisymm ?_ ?_ + · exact (cantorBendixsonValue_mul_le _ _ ((nonpositiveSubring G R).pow_mem hb _) hc).trans + (mul_le_mul' (by simpa only [hB] using b.cantorBendixsonValue_pow_le hb (m + 1)) + (le_of_eq (congrArg NatOrdinal.of hC))) + by_contra hcon + rw [not_le, ← hZ] at hcon + have hkey : ∀ᶠ γ in 𝓝[<] (0 : G), V (T b, γ) = NatOrdinal.of B.residualFactor → + X ≤ V (T d, γ) := by + have hcut := (c.eventually_value_translated_truncLE_lt + (hC ▸ C.2.1.ne_zero)).filter_mono (nhdsWithin_le_nhds (s := Iio (0 : G))) + filter_upwards [hyp, b.eventually_cantorBendixsonValue_leibnizPowerRemainder_lt + c hb hc B C hB hC hp m, hcut, self_mem_nhdsWithin] + with γ hγ hrem hcut hneg he + let main := (m + 1) • (T b, γ * (b ^ m * c ^ 2)) + let s1 := d * T c, γ + let s2 := c * leibnizPowerRemainder b c m γ + have hid : c * T d, γ = main + s1 + s2 := by + dsimp only [main, s1, s2, d] + rw [leibnizPowerRemainder_eq] + simp only [nsmul_eq_mul] + ring + have hmain : V main = X * NatOrdinal.of C.val := by + dsimp only [main] + rw [cantorBendixsonValue_nsmul _ _ (Nat.cast_ne_zero.mpr (Nat.succ_ne_zero m))] + exact hγ he + have hs1 : V s1 < X * NatOrdinal.of C.val := by + refine (d.cantorBendixsonValue_mul_le (T c, γ) hd + (c.support_translated_truncLE γ)).trans_lt ?_ + apply small_mul_lt B C hp X hXpos hX.2 hcon + exact NatOrdinal.of.lt_iff_lt.mpr (hC ▸ hcut (ne_of_lt hneg)) + have hs2 : V s2 < X * NatOrdinal.of C.val := by + have hle := c.cantorBendixsonValue_mul_le (leibnizPowerRemainder b c m γ) hc + (support_leibnizPowerRemainder b c hb hc m γ) + rw [hC] at hle + have hlt : NatOrdinal.of C.val * V (leibnizPowerRemainder b c m γ) < + NatOrdinal.of C.val * X := mul_lt_mul_of_pos_left hrem hCpos + rw [mul_comm _ X] at hlt + exact hle.trans_lt hlt + have hsmall : (s1 + s2).cantorBendixsonValue < + main.cantorBendixsonValue := by + apply (s1.cantorBendixsonValue_add_le s2).trans_lt + apply max_lt + · exact NatOrdinal.of.lt_iff_lt.mp (hs1.trans_eq hmain.symm) + · exact NatOrdinal.of.lt_iff_lt.mp (hs2.trans_eq hmain.symm) + have hsum := main.cantorBendixsonValue_add_eq_max_of_ne (s1 + s2) (ne_of_gt hsmall) + rw [max_eq_left hsmall.le] at hsum + have hval : V (c * T d, γ) = X * NatOrdinal.of C.val := by + rw [hid, add_assoc] + exact (congrArg NatOrdinal.of hsum).trans hmain + have hmul := c.cantorBendixsonValue_mul_le (T d, γ) hc (d.support_translated_truncLE γ) + rw [hC] at hmul + have hmul' : NatOrdinal.of C.val * X ≤ NatOrdinal.of C.val * V (T d, γ) := by + rw [mul_comm _ X, ← hval] + exact hmul + exact le_of_mul_le_mul_left hmul' hCpos + have hlow := cantorBendixsonValue_residual_reconstruction b d hb B hB X hX.1 hkey + rw [← hX.2] at hlow + exact (not_le.mpr hcon) hlow + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonRankLevels.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonRankLevels.lean new file mode 100644 index 0000000000..8354c69389 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonRankLevels.lean @@ -0,0 +1,198 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import + LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolationOnSets + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Cantor–Bendixson rank levels of a closed support + +The interpolation theorem over an arbitrary set of centers asks for five things. This file checks +them for the exact-rank level of a single series, so that the level version is recovered, and +records the two closure facts in the form a union of levels will use: the closure of a level is the +corresponding derivative stage, and near zero a point of that derivative whose truncations have +already dropped lies in the level itself. +-/ + +universe u v w + +open scoped NatOrdinal Topology + +open Filter Set TopologicalSpace HahnSeries + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {R : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [CommRing R] [NoZeroDivisors R] [CharZero R] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := R)) + +variable (p : Nonpositive G R) (α : NatOrdinal.{u}) + +/-- The exact-rank level of a series, as a subset of the exponents. -/ +def rankLevelSet : Set G := + {x | x ∈ (p : HahnSeries G R).closedSupport ∧ + (p : HahnSeries G R).closedSupport.cantorBendixsonRank + (p : HahnSeries G R).closedSupport_isPWO x = α.val} + +omit [IsUniformAddGroup G] [Nontrivial G] [CompleteSpace G] [NoZeroDivisors R] + [CharZero R] in +theorem mem_rankLevelSet_iff {x : G} : + x ∈ rankLevelSet p α ↔ x ∈ (p : HahnSeries G R).closedSupport ∧ + (p : HahnSeries G R).closedSupport.cantorBendixsonRank + (p : HahnSeries G R).closedSupport_isPWO x = α.val := Iff.rfl + +omit [IsUniformAddGroup G] [Nontrivial G] [CompleteSpace G] [NoZeroDivisors R] + [CharZero R] in +/-- A level sits at or below zero, since the support does. -/ +theorem rankLevelSet_subset_Iic : rankLevelSet p α ⊆ Iic 0 := fun _ hx ↦ + closure_minimal p.property isClosed_Iic ((mem_closedSupport _ _).mp hx.1) + +omit [IsUniformAddGroup G] [Nontrivial G] [CompleteSpace G] [NoZeroDivisors R] + [CharZero R] in +/-- The closure of a level is the corresponding derivative stage. -/ +theorem closure_rankLevelSet : + closure (rankLevelSet p α) = + ((p : HahnSeries G R).closedSupport.cantorBendixson α.val : Set G) := + (p : HahnSeries G R).closedSupport.closure_rank_level_eq + (p : HahnSeries G R).closedSupport_isPWO α.val + +/-- **Near zero the level is recovered from its closure.** Once the truncations of the series have +dropped to the level's degree, a point of the derivative stage has exactly that rank, so it lies in +the level. -/ +theorem eventually_mem_rankLevelSet_of_mem_closure (hp : ν p ≤ (α + 1 : NatOrdinal)) : + ∀ᶠ γ in 𝓝[<] (0 : G), γ ∈ closure (rankLevelSet p α) → γ ∈ rankLevelSet p α := by + filter_upwards [eventually_degree_translatedTruncLE_le p α hp] with γ hpγ hγ + rw [closure_rankLevelSet] at hγ + have hmem := ((p : HahnSeries G R).mem_support_derivative_iff γ α.val).mp hγ + refine ⟨(mem_closedSupport _ _).mpr hmem.1, ?_⟩ + rw [← cantorBendixsonRank_eq] + exact cantorBendixsonRank_eq_of_mem_derivative_of_degree_translatedTruncLE_le α p γ + ((mem_closedSupport _ _).mpr hmem.1) hmem.2 hpγ + +/-- The origin has dropped out of the stage two above the level's. -/ +theorem notMem_cantorBendixson_add_two (hp : ν p ≤ (α + 1 : NatOrdinal)) : + (0 : G) ∉ ((p : HahnSeries G R).closedSupport.cantorBendixson ((α.val + 1) + 1) : Set G) := by + have hpRank : (p : HahnSeries G R).cantorBendixsonRank 0 ≤ α.val + 1 := by + by_cases hm : 0 ∈ (p : HahnSeries G R).closedSupport + · rw [cantorBendixsonDegreeValuation_of_mem p hm, WithBot.coe_le_coe] at hp + have h := NatOrdinal.of.symm.monotone hp + change NatOrdinal.val (NatOrdinal.of ((p : HahnSeries G R).cantorBendixsonRank 0)) ≤ + NatOrdinal.val (α + 1) at h + simpa only [NatOrdinal.val_of, NatOrdinal.val_add_one] using h + · rw [cantorBendixsonRank_eq, + (p : HahnSeries G R).closedSupport.cantorBendixsonRank_of_notMem + (p : HahnSeries G R).closedSupport_isPWO hm] + exact zero_le + intro hm + have hr := ((p : HahnSeries G R).mem_support_derivative_iff 0 _).mp hm |>.2 + exact (not_le_of_gt (hpRank.trans_lt (lt_add_one _))) hr + +omit [IsUniformAddGroup G] [Nontrivial G] [CompleteSpace G] [NoZeroDivisors R] + [CharZero R] in +/-- **A level is discrete.** -/ +theorem isDiscrete_rankLevelSet : IsDiscrete (rankLevelSet p α) := + (p : HahnSeries G R).closedSupport.rankLevel_isDiscrete + (p : HahnSeries G R).closedSupport_isPWO α.val + +/-- **Near zero a level stays away from every point it does not contain.** Past the cutoff where +the truncations of the series have dropped to the level's degree, a point of the derivative stage +has exactly that rank, so the level agrees there with its own closure and its complement is a +neighbourhood of every other point. -/ +theorem exists_compl_rankLevelSet_mem_nhds (hp : ν p ≤ (α + 1 : NatOrdinal)) : + ∃ η < (0 : G), ∀ x, η < x → x < 0 → x ∉ rankLevelSet p α → + (rankLevelSet p α)ᶜ ∈ 𝓝 x := by + obtain ⟨η, hη, hcut⟩ := + eventually_nhdsLT_iff_exists.mp (eventually_mem_rankLevelSet_of_mem_closure p α hp) + refine ⟨η, hη, fun x hηx hx0 hxL ↦ ?_⟩ + have hopen : IsOpen (Ioo η 0 ∩ (closure (rankLevelSet p α))ᶜ) := + isOpen_Ioo.inter isClosed_closure.isOpen_compl + have hmem : x ∈ Ioo η 0 ∩ (closure (rankLevelSet p α))ᶜ := + ⟨⟨hηx, hx0⟩, fun hc ↦ hxL (hcut x hηx hx0 hc)⟩ + refine Filter.mem_of_superset (hopen.mem_nhds hmem) ?_ + exact fun y hy hyL ↦ hy.2 (subset_closure hyL) + +variable {B : Type w} [Finite B] + +/-- **A finite family of levels is discrete above a common cutoff.** Each level is discrete, and +past its own cutoff it stays away from the points it misses; taking the largest of finitely many +cutoffs makes all of them do so at once, so the union is discrete there. -/ +@[blueprint "lem:discrete-finite-union-cantor-bendixson-rank-sets" + (phase := "Algebraic independence in graded rings") + (title := "Discrete finite unions of Cantor--Bendixson rank sets") + (statement := /-- + Let $G$ be a nontrivial ordered abelian group with compatible additive + uniformity and order topology, and let $R$ be a characteristic-zero + domain. Assume that $G$ is Cauchy complete. Write $\nu$ for the + Cantor--Bendixson degree on + $R((G^{\leq 0}))$. For a series $q$ and an ordinal $\rho$, let + \[ + L_\rho(q)=\{\gamma\in\overline{\operatorname{supp}(q)}: + \operatorname{rk}_{\overline{\operatorname{supp}(q)}}(\gamma)=\rho\}. + \] + If $B$ is finite and $\nu(q_b)\leq\rho_b+1$ for every $b\in B$, then + there is $\eta<0$ such that + \[ + \bigcup_{b\in B}\bigl(L_{\rho_b}(q_b)\cap(\eta,0)\bigr) + \] + is discrete. + -/) + (proof := /-- + By \ref{thm:cantor-bendixson-value-multiplicative}, the Cantor--Bendixson + degree is the multiplicative degree denoted by $\nu$. Each exact-rank set + is discrete. Moreover, once the translated + truncations of $q_b$ have degree at most $\rho_b$, the exact-rank set + agrees locally with its closure. Choose such a negative cutoff for each + $b$ and take their maximum. Above this common cutoff, each set has a + neighbourhood disjoint from every other set at any point it does not + contain. The finite union is therefore discrete. + -/)] +theorem exists_isDiscrete_iUnion_rankLevelSet + (q : B → Nonpositive G R) (ρ : B → NatOrdinal.{u}) + (hq : ∀ b, ν (q b) ≤ (ρ b + 1 : NatOrdinal)) : + ∃ η < (0 : G), IsDiscrete (⋃ b : B, rankLevelSet (q b) (ρ b) ∩ Ioo η 0) := by + classical + cases nonempty_fintype B + choose ηf hηf hcut using fun b ↦ exists_compl_rankLevelSet_mem_nhds (q b) (ρ b) (hq b) + obtain ⟨η₀, hη₀⟩ := exists_lt (0 : G) + rcases isEmpty_or_nonempty B with hB | hB + · refine ⟨η₀, hη₀, ?_⟩ + simp only [Set.iUnion_of_empty] + rw [isDiscrete_iff_nhdsNE] + simp + have hne : ((Finset.univ : Finset B).image ηf).Nonempty := + (Finset.univ_nonempty (α := B)).image ηf + set ηmax : G := ((Finset.univ : Finset B).image ηf).max' hne with hηmaxdef + have hηmax0 : ηmax < 0 := by + obtain ⟨b, -, hb⟩ := Finset.mem_image.mp (Finset.max'_mem _ hne) + rw [hηmaxdef, ← hb] + exact hηf b + have hle : ∀ b, ηf b ≤ ηmax := fun b ↦ + Finset.le_max' _ _ (Finset.mem_image_of_mem ηf (Finset.mem_univ b)) + refine ⟨ηmax, hηmax0, ?_⟩ + have hiUnion : (⋃ b : B, rankLevelSet (q b) (ρ b) ∩ Ioo ηmax 0) = + ⋃ b ∈ (Finset.univ : Finset B), rankLevelSet (q b) (ρ b) ∩ Ioo ηmax 0 := by + simp + rw [hiUnion] + refine TopologicalSpace.Closeds.isDiscrete_biUnion _ _ (fun b _ ↦ ?_) (fun i _ j _ x hx hxi ↦ ?_) + · exact (isDiscrete_rankLevelSet (q b) (ρ b)).mono Set.inter_subset_left + · by_cases hxL : x ∈ rankLevelSet (q i) (ρ i) + · have hxIoo : x ∈ Ioo ηmax 0 := hx.2 + exact absurd ⟨hxL, hxIoo⟩ hxi + · refine Filter.mem_of_superset + (hcut i x (lt_of_le_of_lt (hle i) hx.2.1) hx.2.2 hxL) ?_ + exact fun y hy hyi ↦ hy hyi.1 + +end HahnSeries.Nonpositive + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonValue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonValue.lean new file mode 100644 index 0000000000..535e13907c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonValue.lean @@ -0,0 +1,173 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonRank +public import Mathlib.RingTheory.HahnSeries.Basic +public import Mathlib.SetTheory.Ordinal.Exponential +public import Mathlib.Topology.Order.LeftRightNhds + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Cantor–Bendixson ranks of closed Hahn supports + +The closed support is taken in the exponent type's given order topology. Its point ranks use +transfinite derived sets in that same topology, without passing to an order completion. + +At exponent zero the associated ordinal value is zero if zero is outside the closed support, +and is `omega` to the point rank otherwise. In particular, a finite support has value one exactly +when its zero coefficient is nonzero, and value zero otherwise. These definitions impose no +multiplicativity assertion. +-/ + +public noncomputable section + +open Set Topology TopologicalSpace + +universe u v + +namespace HahnSeries + +variable {Γ : Type u} {R : Type v} [LinearOrder Γ] [TopologicalSpace Γ] + [OrderTopology Γ] [Zero R] + +/-- The closure of the Hahn support in the given topology on the exponent type. -/ +def closedSupport (b : HahnSeries Γ R) : Closeds Γ := ⟨closure b.support, isClosed_closure⟩ + +omit [OrderTopology Γ] in +@[simp] +theorem coe_closedSupport (b : HahnSeries Γ R) : + (b.closedSupport : Set Γ) = closure b.support := (rfl) + +omit [OrderTopology Γ] in +@[simp] +theorem mem_closedSupport (b : HahnSeries Γ R) (x : Γ) : + x ∈ b.closedSupport ↔ x ∈ closure b.support := (Iff.rfl) + +/-- The ambient closed support remains well ordered. -/ +theorem closedSupport_isPWO (b : HahnSeries Γ R) : (b.closedSupport : Set Γ).IsPWO := by + rw [coe_closedSupport] + exact b.isPWO_support.closure + +/-- An abbreviation for the Cantor–Bendixson point rank of the closed support, zero outside it. -/ +def cantorBendixsonRank (b : HahnSeries Γ R) (x : Γ) : Ordinal.{u} := + b.closedSupport.cantorBendixsonRank b.closedSupport_isPWO x + +theorem cantorBendixsonRank_eq (b : HahnSeries Γ R) (x : Γ) : + b.cantorBendixsonRank x = b.closedSupport.cantorBendixsonRank b.closedSupport_isPWO x := (rfl) + +/-- Derivative membership characterizes the Cantor–Bendixson rank at each exponent. -/ +theorem mem_support_derivative_iff (b : HahnSeries Γ R) (x : Γ) (o : Ordinal.{u}) : + x ∈ (b.closedSupport.cantorBendixson o : Set Γ) ↔ + x ∈ closure b.support ∧ o ≤ b.cantorBendixsonRank x := by + rw [cantorBendixsonRank_eq, ← coe_closedSupport] + exact b.closedSupport.mem_cantorBendixson_iff b.closedSupport_isPWO x o + +variable [Zero Γ] + +/-- Zero off the closed support, and `omega` to its Cantor–Bendixson rank at zero otherwise. -/ +@[blueprint "def:cantor-bendixson-value" + (phase := "Cantor–Bendixson ranks of supports") + (title := "The Cantor--Bendixson value at exponent zero") + (statement := /-- + Let $G$ be a linearly ordered set with zero and its order topology, let + $R$ be a set with zero, and let $b\in R((G))$ be a generalised power + series. Write $C=\operatorname{cl}(\operatorname{supp}(b))$. If + $\operatorname{rk}_C(0)$ denotes the Cantor--Bendixson rank of $0$ in + $C$, define + \[ + V_{\mathrm{CB}}(b)= + \begin{cases} + \omega^{\operatorname{rk}_C(0)},&0\in C,\\ + 0,&0\notin C. + \end{cases} + \] + -/) + (proof := /-- + The closure of a well-ordered support is again well ordered, so its + Cantor--Bendixson point rank is defined. The displayed alternatives are + the two branches of the definition. + -/)] +def cantorBendixsonValue (b : HahnSeries Γ R) : Ordinal.{u} := by + classical + exact if 0 ∈ b.closedSupport then Ordinal.omega0 ^ b.cantorBendixsonRank 0 else 0 + +/-- At a closed-support point, the value is the corresponding power of `omega`. -/ +theorem cantorBendixsonValue_of_mem (b : HahnSeries Γ R) (h : 0 ∈ closure b.support) : + b.cantorBendixsonValue = Ordinal.omega0 ^ b.cantorBendixsonRank 0 := by + simp only [cantorBendixsonValue, mem_closedSupport, h, if_true] + +/-- A support avoiding a neighborhood of zero has value zero. -/ +theorem cantorBendixsonValue_of_notMem (b : HahnSeries Γ R) (h : 0 ∉ closure b.support) : + b.cantorBendixsonValue = 0 := by + simp only [cantorBendixsonValue, mem_closedSupport, h, if_false] + +/-- The value vanishes exactly when zero is outside the ambient closed support. -/ +theorem cantorBendixsonValue_eq_zero_iff (b : HahnSeries Γ R) : + b.cantorBendixsonValue = 0 ↔ 0 ∉ closure b.support := by + constructor + · intro hv hm + rw [b.cantorBendixsonValue_of_mem hm] at hv + exact (Ordinal.opow_pos _ Ordinal.omega0_pos).ne' hv + · exact b.cantorBendixsonValue_of_notMem + +@[simp] +theorem cantorBendixsonValue_zero : (0 : HahnSeries Γ R).cantorBendixsonValue = 0 := by + apply cantorBendixsonValue_of_notMem + simp + +omit [Zero Γ] in +/-- Finite Hahn supports have point rank zero everywhere. -/ +theorem cantorBendixsonRank_of_finite (b : HahnSeries Γ R) (hfin : b.support.Finite) (x : Γ) : + b.cantorBendixsonRank x = 0 := by + rw [cantorBendixsonRank_eq] + apply b.closedSupport.cantorBendixsonRank_of_finite b.closedSupport_isPWO + simpa only [coe_closedSupport, hfin.isClosed.closure_eq] using hfin + +/-- A finite support with nonzero ordinary coefficient has value one. -/ +theorem cantorBendixsonValue_of_finite_of_coeff_ne_zero (b : HahnSeries Γ R) + (hfin : b.support.Finite) (h : b.coeff 0 ≠ 0) : b.cantorBendixsonValue = 1 := by + rw [b.cantorBendixsonValue_of_mem (subset_closure h), b.cantorBendixsonRank_of_finite hfin] + exact Ordinal.opow_zero _ + +/-- A finite support with zero ordinary coefficient has value zero. -/ +theorem cantorBendixsonValue_of_finite_of_coeff_eq_zero (b : HahnSeries Γ R) + (hfin : b.support.Finite) (h : b.coeff 0 = 0) : b.cantorBendixsonValue = 0 := by + apply b.cantorBendixsonValue_of_notMem + rw [hfin.isClosed.closure_eq] + simpa using h + +/-- For nonpositive supports, value zero is equivalent to a strictly negative support bound. -/ +theorem cantorBendixsonValue_eq_zero_iff_support_bounded_lt [NoMinOrder Γ] + (b : HahnSeries Γ R) (hb : b.support ⊆ Iic 0) : + b.cantorBendixsonValue = 0 ↔ ∃ c < (0 : Γ), b.support ⊆ Iic c := by + rw [cantorBendixsonValue_eq_zero_iff] + constructor + · intro hn + have hnh : (closure b.support)ᶜ ∈ 𝓝[≤] (0 : Γ) := + nhdsWithin_le_nhds (isClosed_closure.isOpen_compl.mem_nhds hn) + obtain ⟨c, hc, hcut⟩ := mem_nhdsLE_iff_exists_Ioc_subset.mp hnh + refine ⟨c, hc, fun x hx ↦ ?_⟩ + apply le_of_not_gt + intro hcx + exact hcut ⟨hcx, hb hx⟩ (subset_closure hx) + · rintro ⟨c, hc, hbound⟩ hmem + exact (not_le_of_gt hc) (closure_minimal hbound isClosed_Iic hmem) + +/-- Equal supports give equal Cantor–Bendixson values. -/ +theorem cantorBendixsonValue_congr_support {b d : HahnSeries Γ R} (h : b.support = d.support) : + b.cantorBendixsonValue = d.cantorBendixsonValue := by + have he : b.closedSupport = d.closedSupport := by + apply Closeds.ext + simp only [coe_closedSupport, h] + have hr : b.cantorBendixsonRank 0 = d.cantorBendixsonRank 0 := by + simp only [cantorBendixsonRank_eq, he] + by_cases hm : 0 ∈ closure b.support + · rw [b.cantorBendixsonValue_of_mem hm, d.cantorBendixsonValue_of_mem (h ▸ hm), hr] + · rw [b.cantorBendixsonValue_of_notMem hm, d.cantorBendixsonValue_of_notMem (h ▸ hm)] + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonValueMultiplicativity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonValueMultiplicativity.lean new file mode 100644 index 0000000000..742429dadd --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonValueMultiplicativity.lean @@ -0,0 +1,300 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Cancellation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.SelectionComplexity +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPowerFactorization + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Multiplicativity of the Cantor–Bendixson value + +For nonpositive Hahn series over a characteristic-zero domain, the value defined by the +Cantor--Bendixson rank at zero is multiplicative for natural ordinal multiplication. The +exponent group is a nontrivial ordered uniform additive group that is Cauchy complete. + +The finite-multiset induction selects a factor with least principal factor, then greatest +value. Replacing one copy by its residual truncation and doubling the remaining factors +strictly decreases the distinct-factor complexity. Conditional cancellation therefore applies +without a remaining hypothesis on smaller products. Values zero and one are handled separately. + +This proof uses Cantor–Bendixson ranks and the finite convolution theorem, not the real-exponent +order-value valuation. Completeness of the exponent group is retained. +-/ + +public noncomputable section +open Set Filter Topology +universe u v +namespace HahnSeries +variable {G : Type u} {R : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [OrderTopology G] [CommRing R] + +private abbrev Factor := {b : ↥(nonpositiveSubring G R) // + 1 < (b : HahnSeries G R).cantorBendixsonValue} + +private def factorOrdinal (b : Factor (G := G) (R := R)) : Ordinal.AdditivePrincipalAboveOne.{u} := + ⟨(b.1 : HahnSeries G R).cantorBendixsonValue, by + have hb : 0 ∈ closure (b.1 : HahnSeries G R).support := by + by_contra h + have hpos := b.2 + rw [cantorBendixsonValue_of_notMem _ h] at hpos + exact not_lt_of_ge (zero_le : (0 : Ordinal.{u}) ≤ 1) hpos + rw [cantorBendixsonValue_of_mem _ hb] + exact Ordinal.isAdditivelyPrincipal_omega0_opow _, b.2⟩ + +private def selection : Multiset.SelectionWeights.{u, max u v} (Factor (G := G) (R := R)) := + ⟨fun b ↦ (factorOrdinal b).principalFactor, fun b ↦ (b.1 : HahnSeries G R).cantorBendixsonValue⟩ + +private def eval (w : Multiset (Factor (G := G) (R := R))) : + ↥(nonpositiveSubring G R) := (w.map (·.1)).prod + +private def valueProd (w : Multiset (Factor (G := G) (R := R))) : NatOrdinal.{u} := + (w.map fun x ↦ NatOrdinal.of (x.1 : HahnSeries G R).cantorBendixsonValue).prod + +private theorem eval_add (w w' : Multiset (Factor (G := G) (R := R))) : + eval (w + w') = eval w * eval w' := by + simp only [eval, Multiset.map_add, Multiset.prod_add] + +private theorem eval_singleton (x : Factor (G := G) (R := R)) : + eval {x} = x.1 := by + simp only [eval, Multiset.map_singleton, Multiset.prod_singleton] + +private theorem valueProd_singleton (x : Factor (G := G) (R := R)) : + valueProd {x} = NatOrdinal.of (x.1 : HahnSeries G R).cantorBendixsonValue := by + simp only [valueProd, Multiset.map_singleton, Multiset.prod_singleton] + +private theorem eval_replicate (n : ℕ) (x : Factor (G := G) (R := R)) : + eval (Multiset.replicate n x) = x.1 ^ n := by + simp only [eval, Multiset.map_replicate, Multiset.prod_replicate] + +private theorem valueProd_add (w w' : Multiset (Factor (G := G) (R := R))) : + valueProd (w + w') = valueProd w * valueProd w' := by + simp only [valueProd, Multiset.map_add, Multiset.prod_add] + +private theorem valueProd_replicate (n : ℕ) (x : Factor (G := G) (R := R)) : + valueProd (Multiset.replicate n x) = + NatOrdinal.of (x.1 : HahnSeries G R).cantorBendixsonValue ^ n := by + simp only [valueProd, Multiset.map_replicate, Multiset.prod_replicate] + +private theorem one_le_valueProd (w : Multiset (Factor (G := G) (R := R))) : + 1 ≤ valueProd w := by + induction w using Multiset.induction with + | empty => simp [valueProd] + | cons a s ih => + rw [valueProd, Multiset.map_cons, Multiset.prod_cons, ← valueProd] + simpa only [NatOrdinal.of_one, one_mul] using mul_le_mul' + (NatOrdinal.of.le_iff_le.mpr a.2.le) ih + +private theorem one_lt_valueProd {w : Multiset (Factor (G := G) (R := R))} (hw : w ≠ 0) : + 1 < valueProd w := by + obtain ⟨a, ha⟩ := Multiset.exists_mem_of_ne_zero hw + obtain ⟨s, rfl⟩ := Multiset.exists_cons_of_mem ha + rw [valueProd, Multiset.map_cons, Multiset.prod_cons, ← valueProd] + calc (1 : NatOrdinal.{u}) < NatOrdinal.of (a.1 : HahnSeries G R).cantorBendixsonValue := + a.2 + _ = NatOrdinal.of (a.1 : HahnSeries G R).cantorBendixsonValue * 1 := (mul_one _).symm + _ ≤ _ := mul_le_mul' le_rfl (one_le_valueProd s) + +private theorem eval_zero : eval (0 : Multiset (Factor (G := G) (R := R))) = 1 := by + simp only [eval, Multiset.map_zero, Multiset.prod_zero] + +private theorem valueProd_zero : valueProd (0 : Multiset (Factor (G := G) (R := R))) = 1 := by + simp only [valueProd, Multiset.map_zero, Multiset.prod_zero] + +private def translated (b : ↥(nonpositiveSubring G R)) (γ : G) : + ↥(nonpositiveSubring G R) := + ⟨translate (-γ) (truncLE γ (b : HahnSeries G R)), support_translated_truncLE _ _⟩ + +local notation "V" => (fun b : ↥(nonpositiveSubring G R) ↦ + NatOrdinal.of (cantorBendixsonValue (b : HahnSeries G R))) + +variable [IsUniformAddGroup G] [Nontrivial G] [CompleteSpace G] + [NoZeroDivisors R] [CharZero R] + +omit [IsUniformAddGroup G] [Nontrivial G] [CompleteSpace G] [NoZeroDivisors R] in +private theorem value_one : V 1 = 1 := by + apply congrArg NatOrdinal.of + exact cantorBendixsonValue_of_finite_of_coeff_ne_zero (1 : HahnSeries G R) + (by rw [support_one]; exact finite_singleton _) (by simp) + +private theorem value_eval (w : Multiset (Factor (G := G) (R := R))) : + V (eval w) = valueProd w := by + let s := selection (G := G) (R := R) + suffices h : ∀ p : Multiset Ordinal.{u} × ℕ, + ∀ (w : Multiset (Factor (G := G) (R := R))) (hw : w ≠ 0), + s.complexity w hw = p → V (eval w) = valueProd w by + rcases eq_or_ne w 0 with rfl | hw + · rw [eval_zero, valueProd_zero, value_one] + · exact h _ w hw rfl + refine fun p ↦ Multiset.SelectionWeights.wellFounded_complexityLT.induction + (C := fun q ↦ ∀ (w : Multiset (Factor (G := G) (R := R))) (hw : w ≠ 0), + s.complexity w hw = q → V (eval w) = valueProd w) p ?_ + clear p + intro p ih w hw hp + classical + have IH : ∀ w' : Multiset (Factor (G := G) (R := R)), + (∀ hw' : w' ≠ 0, Multiset.SelectionWeights.ComplexityLT + (s.complexity w' hw') (s.complexity w hw)) → + V (eval w') = valueProd w' := by + intro w' hlt + rcases eq_or_ne w' 0 with rfl | hw' + · rw [eval_zero, valueProd_zero, value_one] + · exact ih (s.complexity w' hw') (hp ▸ hlt hw') w' hw' rfl + set x := s.selected w hw with hx + set r := s.unselected w hw with hrdef + obtain ⟨m, hm⟩ : ∃ m, s.selectedExponent w hw = m + 1 := + ⟨s.selectedExponent w hw - 1, by have := s.one_le_selectedExponent w hw; omega⟩ + have hdecomp : w = Multiset.replicate (m + 1) x + r := by + rw [hrdef, hx, ← hm, s.replicate_selectedExponent_add_unselected] + have heval : eval w = x.1 ^ (m + 1) * eval r := by + conv_lhs => rw [hdecomp] + rw [eval_add, eval_replicate] + have hvp : valueProd w = V x.1 ^ (m + 1) * valueProd r := by + conv_lhs => rw [hdecomp] + rw [valueProd_add, valueProd_replicate] + have hr : V (eval r) = valueProd r := + IH r fun hr0 ↦ s.complexityLT_unselected hw hr0 + have hIHred : ∀ t : Multiset (Factor (G := G) (R := R)), + (∀ u ∈ t, V u.1 < V x.1) → + (∀ u ∈ t, (factorOrdinal x).principalFactor ≤ (factorOrdinal u).principalFactor) → + V (eval t * x.1 ^ m * (eval r * eval r)) = + valueProd t * V x.1 ^ m * (valueProd r * valueProd r) := by + intro t ht htp + have hred := IH (s.reduced w hw t) fun hne ↦ + s.complexityLT_reduced w hw t ht htp hne + rw [s.reduced_eq, hm, Nat.add_sub_cancel] at hred + simpa only [eval_add, eval_replicate, valueProd_add, valueProd_replicate] using hred + have hkey : ∀ᶠ γ in 𝓝[<] (0 : G), + V (translated x.1 γ) = NatOrdinal.of (factorOrdinal x).residualFactor → + V (translated x.1 γ * x.1 ^ m * (eval r * eval r)) = + V x.1 ^ m * V (translated x.1 γ) * valueProd r * valueProd r := by + have hcut := ((x.1 : HahnSeries G R).eventually_value_translated_truncLE_lt + (ne_of_gt (zero_lt_one.trans x.2))).filter_mono + (nhdsWithin_le_nhds (s := Iio (0 : G))) + filter_upwards [hcut, self_mem_nhdsWithin] with γ hγ hneg he + have hsmall : V (translated x.1 γ) < V x.1 := hγ (ne_of_lt hneg) + by_cases hg1 : 1 < V (translated x.1 γ) + · let z : Factor (G := G) (R := R) := ⟨translated x.1 γ, hg1⟩ + have hpri : (factorOrdinal x).principalFactor ≤ (factorOrdinal z).principalFactor := + (factorOrdinal x).principalFactor_le_principalFactor_of_eq_residualFactor + (factorOrdinal z) (NatOrdinal.of.injective he) + have h := hIHred {z} + (fun u hu ↦ by rw [Multiset.mem_singleton.mp hu]; exact hsmall) + (fun u hu ↦ by rw [Multiset.mem_singleton.mp hu]; exact hpri) + rw [eval_singleton, valueProd_singleton] at h + change V (translated x.1 γ * x.1 ^ m * (eval r * eval r)) = _ at h + dsimp only at h + rw [h] + ring + · have hone : V (translated x.1 γ) = 1 := by + have hne : V (translated x.1 γ) ≠ 0 := by + dsimp only + rw [he] + exact (factorOrdinal x).residualFactor_isAdditivelyPrincipal.ne_zero + exact le_antisymm (not_lt.mp hg1) (Order.one_le_iff_pos.mpr (pos_iff_ne_zero.mpr hne)) + have h := hIHred 0 (by simp) (by simp) + rw [eval_zero, valueProd_zero, one_mul, one_mul] at h + have hmul : V (translated x.1 γ * (x.1 ^ m * (eval r * eval r))) = + V (x.1 ^ m * (eval r * eval r)) := + congrArg NatOrdinal.of (cantorBendixsonValue_mul_of_left_eq_one _ _ + (translated x.1 γ).property (x.1 ^ m * (eval r * eval r)).property + (NatOrdinal.of.injective hone)) + dsimp only at hmul h hone + rw [mul_assoc, hmul, h, hone] + ring + rcases eq_or_ne r 0 with hr0 | hr0 + · rw [heval, hvp, hr0, eval_zero, valueProd_zero, mul_one, mul_one] + apply cantorBendixsonValue_pow_eq_of_eventually (x.1 : HahnSeries G R) x.1.property + (factorOrdinal x) rfl m + filter_upwards [hkey] with γ hγ he + have h := hγ he + change V (translated x.1 γ) = _ at he + dsimp only at he + rw [he] at h + simpa only [hr0, eval_zero, valueProd_zero, mul_one, Subring.coe_mul, + Subring.coe_pow, translated, factorOrdinal] using h + · have hc1 : 1 < V (eval r) := hr ▸ one_lt_valueProd hr0 + let c : Factor (G := G) (R := R) := ⟨eval r, hc1⟩ + have hp' : (factorOrdinal x).principalFactor ≤ (factorOrdinal c).principalFactor := by + apply (factorOrdinal x).principalFactor_le_of_naturalProd (factorOrdinal c) + (r.map factorOrdinal) + · intro y hy + obtain ⟨z, hz, rfl⟩ := Multiset.mem_map.mp hy + exact (s.isSelected_selected w hw).min_priority z (s.mem_unselected.mp hz).1 + · simpa only [Multiset.map_map, Function.comp_def, valueProd, factorOrdinal] using hr + have hev : ∀ᶠ γ in 𝓝[<] (0 : G), + V (translated x.1 γ) = NatOrdinal.of (factorOrdinal x).residualFactor → + V (translated x.1 γ * (x.1 ^ m * c.1 ^ 2)) = + V x.1 ^ m * NatOrdinal.of (factorOrdinal x).residualFactor * V c.1 * V c.1 := by + filter_upwards [hkey] with γ hγ he + have h := hγ he + rw [he] at h + dsimp only at hr + simpa only [c, sq, mul_assoc, hr] using h + have h := cantorBendixsonValue_pow_mul_eq_of_eventually + (x.1 : HahnSeries G R) (c.1 : HahnSeries G R) x.1.property c.1.property + (factorOrdinal x) (factorOrdinal c) rfl rfl hp' m hev + rw [heval, hvp] + exact h.trans (congrArg (V x.1 ^ (m + 1) * ·) hr) + +/-- The Cantor–Bendixson value is multiplicative on nonpositive Hahn series over a +characteristic-zero domain with an ordered exponent group that is Cauchy complete. -/ +@[blueprint "thm:cantor-bendixson-value-multiplicative" + (phase := "Cantor–Bendixson ranks of supports") + (title := "Multiplicativity of the Cantor--Bendixson value") + (statement := /-- + Let $R$ be a characteristic-zero domain and let $G$ be a nontrivial + ordered abelian group equipped with a compatible additive uniformity and + its order topology. Assume that $G$ is Cauchy complete. For all + $b,c\in R((G^{\le0}))$, + \[ + V_{\mathrm{CB}}(bc) + =V_{\mathrm{CB}}(b)\odot V_{\mathrm{CB}}(c), + \] + where $\odot$ is Hessenberg's natural product. + -/) + (proof := /-- + If either value is $0$, the product upper bound forces the product value + to be $0$. A factor of value $1$ is a nonzero scalar at exponent $0$ + plus a remainder of value $0$, so it preserves the other value. For + values greater than $1$, argue by well-founded induction on the finite + multiset of factors. Choose a factor for which the final multiplicatively + principal factor is least, and among ties choose one of greatest value. + At a cutoff where its + translated truncation has the residual value, that truncation has smaller + value, so the induction hypothesis computes every required local product. + If no other factors remain, apply + \ref{lem:cantor-bendixson-pure-power-cancellation}; otherwise combine the + remaining factors and apply + \ref{lem:cantor-bendixson-power-factor-cancellation}. In both cases the + result is the natural product of the factor values, and the two-factor + statement follows. + -/) + (highlight)] +theorem cantorBendixsonValue_mul (b c : HahnSeries G R) + (hb : b.support ⊆ Iic 0) (hc : c.support ⊆ Iic 0) : + NatOrdinal.of (b * c).cantorBendixsonValue = + NatOrdinal.of b.cantorBendixsonValue * NatOrdinal.of c.cantorBendixsonValue := by + rcases eq_or_ne b.cantorBendixsonValue 0 with hb0 | hb0 + · rw [cantorBendixsonValue_mul_eq_zero_of_left b c hb hc hb0, hb0, + NatOrdinal.of_zero, zero_mul] + rcases eq_or_ne c.cantorBendixsonValue 0 with hc0 | hc0 + · rw [mul_comm b c, cantorBendixsonValue_mul_eq_zero_of_left c b hc hb hc0, hc0, + NatOrdinal.of_zero, mul_zero] + rcases eq_or_lt_of_le (Order.one_le_iff_pos.mpr (pos_iff_ne_zero.mpr hb0)) with hb1 | hb1 + · rw [cantorBendixsonValue_mul_of_left_eq_one b c hb hc hb1.symm, ← hb1, + NatOrdinal.of_one, one_mul] + rcases eq_or_lt_of_le (Order.one_le_iff_pos.mpr (pos_iff_ne_zero.mpr hc0)) with hc1 | hc1 + · rw [mul_comm b c, cantorBendixsonValue_mul_of_left_eq_one c b hc hb hc1.symm, ← hc1, + NatOrdinal.of_one, mul_one] + have h := value_eval ({⟨⟨b, hb⟩, hb1⟩, ⟨⟨c, hc⟩, hc1⟩} : + Multiset (Factor (G := G) (R := R))) + simpa [eval, valueProd] using h + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CofactorInduction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CofactorInduction.lean new file mode 100644 index 0000000000..343d0e019a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CofactorInduction.lean @@ -0,0 +1,2077 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.GlobalCofactors +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LowerTruncationDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SeparatedPieceCantorBendixson +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonConvexCover +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Components +import Mathlib.Algebra.MvPolynomial.CommRing +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Boundary +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Cofactors by well-founded induction + +This file constructs global cofactors by well-founded induction at arbitrary cofinality. Helper +lemmas transfer translated truncations between a sum, its terms on disjoint ordered convex +carriers, and the local series translated to the piece centers, all modulo series bounded strictly +below zero. +-/ + +public noncomputable section + +open Set Filter Topology MvPolynomial +open scoped NatOrdinal DirectSum + +universe u v w x + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [Field K] [CharZero K] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := K)) + +/-- Reversing a difference preserves the property of having degree bottom. -/ +theorem degree_reverse_sub_eq_bot {a b : Nonpositive G K} (h : ν (a - b) = ⊥) : + ν (b - a) = ⊥ := by + rw [← (ν).map_neg, neg_sub] + exact h + +/-- Reversing a difference preserves every strict degree bound. -/ +theorem degree_reverse_sub_lt {a b : Nonpositive G K} {τ : WithBot NatOrdinal} + (h : ν (a - b) < τ) : ν (b - a) < τ := by + rw [← (ν).map_neg, neg_sub] + exact h + +/-- Three summands satisfying a common degree bound have a sum satisfying that bound. -/ +theorem degree_add_add_le {a b c : Nonpositive G K} {τ : WithBot NatOrdinal} + (ha : ν a ≤ τ) (hb : ν b ≤ τ) (hc : ν c ≤ τ) : ν (a + b + c) ≤ τ := + ((ν).map_add_le_max _ _).trans + (max_le (((ν).map_add_le_max _ _).trans (max_le ha hb)) hc) + +/-- Two terms and a finite family satisfying a common degree bound have a sum satisfying that +bound. -/ +theorem degree_add_add_sum_le {J : Type w} [Fintype J] + {a b : Nonpositive G K} {f : J → Nonpositive G K} {τ : WithBot NatOrdinal} + (ha : ν a ≤ τ) (hb : ν b ≤ τ) (hf : ∀ j, ν (f j) ≤ τ) : + ν (a + b + ∑ j, f j) ≤ τ := + ((ν).map_add_le_max _ _).trans (max_le + (((ν).map_add_le_max _ _).trans (max_le ha hb)) + ((ν).map_sum_le_of_forall_le Finset.univ f τ fun j _ ↦ hf j)) + +/-- Degrees agree modulo series bounded strictly below zero. -/ +theorem degree_eq_of_degree_sub_eq_bot {a b : Nonpositive G K} + (h : ν (a - b) = ⊥) : ν a = ν b := by + have h1 : ν a ≤ ν b := by + have := (ν).map_add_le_max (a - b) b + rw [sub_add_cancel, h, max_eq_right bot_le] at this + exact this + have h2 : ν b ≤ ν a := by + have hba : ν (b - a) = ⊥ := degree_reverse_sub_eq_bot h + have := (ν).map_add_le_max (b - a) a + rw [sub_add_cancel, hba, max_eq_right bot_le] at this + exact this + exact le_antisymm h1 h2 + +/-- The strict tail of a nonpositive series above a cutoff. -/ +def strictTail (c : G) (b : Nonpositive G K) : Nonpositive G K := + ⟨truncGT c (b : HahnSeries G K), fun _ hg ↦ b.property (support_truncGT_subset c _ hg)⟩ + +/-- Cutting away everything at or below a negative cutoff does not change the germ at zero. -/ +theorem degree_sub_strictTail_eq_bot {c : G} (hc : c < 0) (b : Nonpositive G K) : + ν (b - strictTail c b) = ⊥ := by + apply (cantorBendixsonDegreeValuation_eq_bot_iff _).mpr + refine ⟨c, hc, ?_⟩ + intro g hg + have hg' : (b : HahnSeries G K).coeff g - + (truncGT c (b : HahnSeries G K)).coeff g ≠ 0 := by + simpa only [AddSubgroupClass.coe_sub, HahnSeries.coeff_sub, strictTail] using + (mem_support _ _).mp hg + rw [HahnSeries.coeff_truncGT] at hg' + by_contra hcg + rw [if_pos (not_le.mp hcg), sub_self] at hg' + exact hg' rfl + +/-- Above the cut, translated truncations of a series and its strict tail differ only by a series +bounded strictly below zero. -/ +theorem degree_translatedTruncLE_sub_strictTail_eq_bot {c y : G} (hcy : c < y) + (b : Nonpositive G K) : + ν (translatedTruncLE y (b - strictTail c b)) = ⊥ := by + apply (cantorBendixsonDegreeValuation_eq_bot_iff _).mpr + refine ⟨c - y, sub_neg.mpr hcy, ?_⟩ + intro g hg + have hg' : g + y ∈ ((b : HahnSeries G K) - + (strictTail c b : HahnSeries G K)).support := by + rw [coe_translatedTruncLE, mem_support, HahnSeries.coeff_translate, + HahnSeries.coeff_truncLE] at hg + split_ifs at hg with hle + · exact (mem_support _ _).mpr (by simpa using hg) + · exact absurd rfl hg + have hcoeff : (b : HahnSeries G K).coeff (g + y) - + (truncGT c (b : HahnSeries G K)).coeff (g + y) ≠ 0 := by + simpa only [HahnSeries.coeff_sub, strictTail] using (mem_support _ _).mp hg' + rw [HahnSeries.coeff_truncGT] at hcoeff + have hle : g + y ≤ c := by + by_contra hn + rw [if_pos (not_le.mp hn), sub_self] at hcoeff + exact hcoeff rfl + simpa using sub_le_sub_right hle y + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [CharZero K] in +/-- At or below the cut, every translated truncation of a strict tail vanishes. -/ +theorem translatedTruncLE_strictTail_eq_zero {c y : G} (hyc : y ≤ c) + (b : Nonpositive G K) : translatedTruncLE y (strictTail c b) = 0 := by + apply Subtype.ext + ext g + rw [coe_translatedTruncLE, HahnSeries.coeff_translate, HahnSeries.coeff_truncLE, + strictTail, HahnSeries.coeff_truncGT] + split_ifs with h1 h2 + · exact absurd h2 (not_lt.mpr (le_trans (by simpa using h1) hyc)) + · rfl + · rfl + +/-- A strict tail above a negative cutoff represents the same homogeneous germ. -/ +theorem represents_strictTail {c : G} (hc : c < 0) {b : Nonpositive G K} + {m : NatOrdinal.{u}} {e : (ν).AssociatedGraded} (h : Represents b m e) : + Represents (strictTail c b) m e := by + have hbot := degree_sub_strictTail_eq_bot hc b + have hdeg : ν b = ν (strictTail c b) := degree_eq_of_degree_sub_eq_bot hbot + rw [represents_iff] + refine ⟨hdeg ▸ h.degree_le, ?_⟩ + obtain ⟨hb, he⟩ := (represents_iff.mp h) + calc + (ν).homogeneousMk m ⟨strictTail c b, ((ν).mem_filtrationLE_iff m _).mpr (hdeg ▸ hb)⟩ = + (ν).homogeneousMk m ⟨b, ((ν).mem_filtrationLE_iff m _).mpr hb⟩ := by + rw [MaxAddDegree.homogeneousMk_apply, MaxAddDegree.homogeneousMk_apply] + congr 1 + apply ((ν).componentMk_eq_componentMk_iff m _ _).mpr + rw [show strictTail c b - b = -(b - strictTail c b) by ring, (ν).map_neg, hbot] + exact WithBot.bot_lt_coe m + _ = e := he + +/-- Strict tails preserve the degree and proper-truncation bounds. -/ +theorem hasLowerTruncationDegree_strictTail {c : G} (hc : c < 0) {b : Nonpositive G K} + {m : NatOrdinal.{u}} (h : HasLowerTruncationDegree b m) : + HasLowerTruncationDegree (strictTail c b) m := by + have hbot := degree_sub_strictTail_eq_bot hc b + have hdeg : ν b = ν (strictTail c b) := degree_eq_of_degree_sub_eq_bot hbot + rw [hasLowerTruncationDegree_iff] + refine ⟨hdeg ▸ h.degree_le, fun y hy ↦ ?_⟩ + by_cases hcy : c < y + · have hdiff := degree_translatedTruncLE_sub_strictTail_eq_bot hcy b + have heq := degree_eq_of_degree_sub_eq_bot + (a := translatedTruncLE y b) (b := translatedTruncLE y (strictTail c b)) + (by rw [← map_sub]; exact hdiff) + rw [← heq] + exact h.degree_translatedTruncLE_lt hy + · rw [translatedTruncLE_strictTail_eq_zero (not_lt.mp hcy), (ν).map_zero] + exact WithBot.bot_lt_coe m + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [CharZero K] in +/-- The translated truncation of a placed local series reads the local series at the shifted +cutoff. -/ +theorem translatedTruncLE_placed (x y : G) (f : K⟦G⟧) + (hshift : (translate (-x) f).support ⊆ Iic 0) : + (translatedTruncLE (y - x) (⟨translate (-x) f, hshift⟩ : Nonpositive G K) : + HahnSeries G K) = translate (-y) (truncLE y f) := by + rw [coe_translatedTruncLE] + change translate (-(y - x)) (truncLE (y - x) (translate (-x) f)) = _ + rw [truncLE_translate, show y - x - -x = y by abel, translate_add_apply] + congr 1 + abel_nf + +omit [AddCommGroup G] [IsOrderedAddMonoid G] [UniformSpace G] [IsUniformAddGroup G] + [OrderTopology G] [Nontrivial G] [CompleteSpace G] [CharZero K] in +/-- A weak truncation of a series vanishes when the cutoff lies below the whole support. -/ +theorem truncLE_eq_zero_of_forall_lt (f : K⟦G⟧) (y : G) + (h : ∀ p ∈ f.support, y < p) : truncLE y f = 0 := by + ext g + rw [HahnSeries.coeff_truncLE] + by_cases hgy : g ≤ y + · rw [if_pos hgy] + by_contra hne + exact absurd hgy (not_le.mpr (h g ((mem_support _ _).mpr hne))) + · rw [if_neg hgy, HahnSeries.coeff_zero] + +omit [AddCommGroup G] [IsOrderedAddMonoid G] [UniformSpace G] [IsUniformAddGroup G] + [OrderTopology G] [Nontrivial G] [CompleteSpace G] in +/-- Outside a convex piece containing a bound of the support, support points are below the whole +piece. -/ +theorem lt_of_notMem_ordConnected {C : Set G} (hC : C.OrdConnected) + {x : G} (hx : x ∈ C) {p : G} (hp : p ≤ x) (hpC : p ∉ C) : + ∀ c ∈ C, p < c := by + intro c hc + by_contra hcp + exact hpC (hC.out hc hx ⟨not_lt.mp hcp, hp⟩) + +omit [AddCommGroup G] [IsOrderedAddMonoid G] [UniformSpace G] [IsUniformAddGroup G] + [OrderTopology G] [Nontrivial G] [CompleteSpace G] in +/-- A point below a convex piece but outside it lies below each element of the piece. -/ +theorem le_of_notMem_ordConnected {C : Set G} (hC : C.OrdConnected) + {y c p : G} (hy : y ∈ C) (hc : c ∈ C) (hpy : p ≤ y) (hpC : p ∉ C) : p ≤ c := + (lt_of_notMem_ordConnected hC hy hpy hpC c hc).le + +omit [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [IsUniformAddGroup G] + [OrderTopology G] [Nontrivial G] [CompleteSpace G] [Field K] [CharZero K] in +/-- A point outside a closed set lies outside the closure of the range of its subtype coercion. -/ +theorem notMem_closure_range_subtype_coe {S : Set G} {y : G} (hS : closure S = S) + (hy : y ∉ S) : y ∉ closure (Set.range (fun x : S ↦ (x : G))) := by + rwa [Subtype.range_coe, hS] + +omit [AddCommGroup G] [IsOrderedAddMonoid G] [IsUniformAddGroup G] [Nontrivial G] + [CompleteSpace G] in +/-- In an open convex piece of a densely ordered group there is a piece element strictly below +any given piece element. -/ +theorem exists_lt_mem_of_isOpen_ordConnected [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + {C : Set G} (hCopen : IsOpen C) {y : G} (hy : y ∈ C) : + ∃ c ∈ C, c < y := by + obtain ⟨a, b, ⟨hay, hyb⟩, hab⟩ := mem_nhds_iff_exists_Ioo_subset.mp (hCopen.mem_nhds hy) + obtain ⟨c, hac, hcy⟩ := exists_between hay + exact ⟨c, hab ⟨hac, hcy.trans hyb⟩, hcy⟩ + +omit [AddCommGroup G] [IsOrderedAddMonoid G] [IsUniformAddGroup G] [Nontrivial G] + [CompleteSpace G] [CharZero K] in +/-- Cantor–Bendixson ranks of closed supports are monotone under support inclusion. -/ +theorem cantorBendixsonRank_le_of_support_subset {a b : K⟦G⟧} (h : a.support ⊆ b.support) (z : G) : + a.cantorBendixsonRank z ≤ b.cantorBendixsonRank z := by + have hle : a.closedSupport ≤ b.closedSupport := by + have h1 : (a.closedSupport : Set G) ⊆ (b.closedSupport : Set G) := by + rw [coe_closedSupport, coe_closedSupport] + exact closure_mono h + exact h1 + rw [cantorBendixsonRank_eq, cantorBendixsonRank_eq] + apply TopologicalSpace.Closeds.cantorBendixsonRank_le_of_notMem _ _ z + intro hmem + exact b.closedSupport.notMem_cantorBendixson_rank_add_one b.closedSupport_isPWO z + (TopologicalSpace.Closeds.cantorBendixson_mono hle _ hmem) + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [CharZero K] in +/-- The translated truncation at a shifted cutoff reads the series placed at the shift. -/ +theorem translatedTruncLE_shift (x y : G) (b : Nonpositive G K) : + (translatedTruncLE (y - x) b : HahnSeries G K) = + translate (-y) (truncLE y (translate x (b : HahnSeries G K))) := by + rw [coe_translatedTruncLE, truncLE_translate, translate_add_apply] + congr 1 + abel_nf + +open Classical in +/-- Inside one piece, a separated sum of restricted translates has the same local germ as the +corresponding untranslated series. -/ +theorem degree_translatedTruncLE_separatedHsum_sub_piece_eq_bot + [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + {X : Type w} [LinearOrder X] (hX : (Set.univ : Set X).IsPWO) + (C : X → Set G) (hCopen : ∀ x, IsOpen (C x)) (hCconv : ∀ x, (C x).OrdConnected) + (f : X → K⟦G⟧) (hfC : ∀ x, (f x).support ⊆ C x) + (hord : ∀ x y : X, x < y → ∀ a ∈ C x, ∀ b ∈ C y, a < b) + (hsep : ∀ i j, i < j → ∀ a ∈ (f i).support, ∀ b ∈ (f j).support, a < b) + (x : X) (z : G) {y : G} (hy : y ∈ C x) (b : Nonpositive G K) + (hpiece : f x = setRestrict (C x) (translate z (b : HahnSeries G K))) + (c : Nonpositive G K) (hc : (c : HahnSeries G K) = separatedHsum hX f hsep) : + ν (translatedTruncLE y c - translatedTruncLE (y - z) b) = ⊥ := by + obtain ⟨cst, hcst, hcsty⟩ := exists_lt_mem_of_isOpen_ordConnected (hCopen x) hy + apply (cantorBendixsonDegreeValuation_eq_bot_iff _).mpr + refine ⟨cst - y, sub_neg.mpr hcsty, ?_⟩ + intro g hg + rw [AddSubgroupClass.coe_sub, translatedTruncLE_shift z y b, + coe_translatedTruncLE, hc] at hg + have hb : ∀ p ∈ (translate z (b : HahnSeries G K)).support, + p ∉ C x → p ≤ y → p ≤ cst := + fun _ _ hpC hpy ↦ le_of_notMem_ordConnected (hCconv x) hy hcst hpy hpC + exact support_translate_truncLE_separatedHsum_sub_source_subset + (G := G) (K := K) (X := X) hX C f hfC hord hsep x hy hcst + (translate z (b : HahnSeries G K)) hpiece hb hg + +open Classical in +/-- A separated sum has degree bottom at a cutoff outside every piece and outside the closure of +the piece centres. -/ +theorem degree_translatedTruncLE_separatedHsum_eq_bot_of_notMem + {X : Type w} [LinearOrder X] (hX : (Set.univ : Set X).IsPWO) + (C : X → Set G) (z : X → G) (f : X → K⟦G⟧) + (hfC : ∀ x, (f x).support ⊆ C x) (hfle : ∀ x, ∀ p ∈ (f x).support, p ≤ z x) + (hzC : ∀ x, z x ∈ C x) (hCopen : ∀ x, IsOpen (C x)) + (hCconv : ∀ x, (C x).OrdConnected) (hCdisj : ∀ x y, x ≠ y → Disjoint (C x) (C y)) + (hCord : ∀ x y, x < y → ∀ a ∈ C x, ∀ b ∈ C y, a < b) + (hsep : ∀ x y, x < y → ∀ a ∈ (f x).support, ∀ b ∈ (f y).support, a < b) + (c : Nonpositive G K) (hc : (c : HahnSeries G K) = separatedHsum hX f hsep) + {y : G} (hyC : ∀ x, y ∉ C x) (hyz : y ∉ closure (Set.range z)) : + ν (translatedTruncLE y c) = ⊥ := by + rw [degree_translatedTruncLE_eq, if_neg ?_] + intro hy + exact (by + have hcl : ((c : HahnSeries G K).closedSupport : Set G) ⊆ + (⋃ x, C x) ∪ closure (Set.range z) := by + rw [coe_closedSupport, hc, support_separatedHsum] + exact closure_iUnion_subset_of_closure_piece_subset + (fun x ↦ (f x).support) C z hfC hfle hzC hCopen hCdisj hCord + (fun x ↦ closure_subset_of_isPWO_of_ordConnected (hCconv x) + (f x).isPWO_support (hfC x) (hzC x) (hfle x)) + rcases hcl hy with hy | hy + · obtain ⟨x, hyx⟩ := Set.mem_iUnion.mp hy + exact hyC x hyx + · exact hyz hy) + +private structure SeparatedHsumFamily (J : Type x) (X : Type w) [LinearOrder X] where + hX : (Set.univ : Set X).IsPWO + piece : X → Set G + center : X → G + term : J → X → K⟦G⟧ + support_subset : ∀ j x, (term j x).support ⊆ piece x + support_le_center : ∀ j x, ∀ p ∈ (term j x).support, p ≤ center x + center_mem : ∀ x, center x ∈ piece x + isOpen_piece : ∀ x, IsOpen (piece x) + ordConnected_piece : ∀ x, (piece x).OrdConnected + disjoint_piece : ∀ x y, x ≠ y → Disjoint (piece x) (piece y) + piece_lt_piece : ∀ x y, x < y → ∀ a ∈ piece x, ∀ b ∈ piece y, a < b + separated : ∀ j x y, x < y → + ∀ a ∈ (term j x).support, ∀ b ∈ (term j y).support, a < b + sum : J → Nonpositive G K + coe_sum : ∀ j, (sum j : HahnSeries G K) = separatedHsum hX (term j) (separated j) + +/-- Every member of a family of separated sums has degree bottom at a cutoff outside all pieces +and outside the closure of their common centres. -/ +private theorem SeparatedHsumFamily.degree_translatedTruncLE_eq_bot_of_notMem + {J : Type x} {X : Type w} [LinearOrder X] (F : SeparatedHsumFamily J X) + {y : G} (hyC : ∀ x, y ∉ F.piece x) (hyz : y ∉ closure (Set.range F.center)) : + ∀ j, ν (translatedTruncLE y (F.sum j)) = ⊥ := by + intro j + exact degree_translatedTruncLE_separatedHsum_eq_bot_of_notMem + (G := G) (K := K) (X := X) (hX := F.hX) (C := F.piece) (z := F.center) + (f := F.term j) (hfC := F.support_subset j) (hfle := F.support_le_center j) + (hzC := F.center_mem) (hCopen := F.isOpen_piece) + (hCconv := F.ordConnected_piece) (hCdisj := F.disjoint_piece) + (hCord := F.piece_lt_piece) (hsep := F.separated j) (c := F.sum j) + (hc := F.coe_sum j) (hyC := hyC) (hyz := hyz) + +/-- A translated truncation at a strictly positive cutoff is bounded strictly below zero. -/ +theorem degree_translatedTruncLE_of_pos {s : G} (hs : 0 < s) (b : Nonpositive G K) : + ν (translatedTruncLE s b) = ⊥ := by + apply (cantorBendixsonDegreeValuation_eq_bot_iff _).mpr + refine ⟨-s, neg_neg_iff_pos.mpr hs, ?_⟩ + intro g hg + rw [coe_translatedTruncLE, support_translate] at hg + obtain ⟨p, hp, rfl⟩ := hg + rw [support_truncLE] at hp + have hp0 : p ≤ 0 := b.property hp.1 + have h := add_le_add_left hp0 (-s) + rw [zero_add] at h + have h' : -s + p ≤ -s := by + rw [add_comm] + exact h + exact mem_Iic.mpr h' + +/-- A translated truncation at a point outside the closed support has degree bottom. -/ +theorem degree_translatedTruncLE_eq_bot_of_notMem_closedSupport + {s : G} {b : Nonpositive G K} (hs : s ∉ (b : HahnSeries G K).closedSupport) : + ν (translatedTruncLE s b) = ⊥ := by + rw [degree_translatedTruncLE_eq, if_neg hs] + +/-- A uniform degree bound at nonpositive cutoffs extends to every cutoff. -/ +theorem degree_translatedTruncLE_le_of_nonpositive {b : Nonpositive G K} + {τ : WithBot NatOrdinal} (hb : ∀ s : G, s ≤ 0 → ν (translatedTruncLE s b) ≤ τ) + (s : G) : ν (translatedTruncLE s b) ≤ τ := by + rcases le_or_gt s 0 with hs | hs + · exact hb s hs + · rw [degree_translatedTruncLE_of_pos hs] + exact bot_le + +/-- The boundary estimate at every cutoff: strictly negative cutoffs by the finite convolution +estimate, zero trivially, and strictly positive cutoffs because both terms are bounded strictly +below zero. -/ +theorem degree_translatedTruncLE_mul_sub_mul_lt_forall + (a b : Nonpositive G K) (ρ σ τ : NatOrdinal.{u}) + (ha : ν a ≤ ρ) + (hat : ∀ x : G, x < 0 → ν (translatedTruncLE x a) ≤ ρ) + (hbt : ∀ x : G, x < 0 → ν (translatedTruncLE x b) < σ) + (hsep : ∀ θ, θ < σ → ρ + θ < τ) (γ : G) : + ν (translatedTruncLE γ (a * b) - translatedTruncLE γ a * b) < τ := by + rcases lt_trichotomy γ 0 with hγ | hγ | hγ + · exact degree_translatedTruncLE_mul_sub_mul_lt_of_pointwise_bounds a b ρ σ τ ha hat hbt hsep hγ + · subst hγ + rw [translatedTruncLE_zero, translatedTruncLE_zero, sub_self, (ν).map_zero] + exact WithBot.bot_lt_coe τ + · have h1 : ν (translatedTruncLE γ (a * b)) = ⊥ := degree_translatedTruncLE_of_pos hγ _ + have h2 : ν (translatedTruncLE γ a * b) = ⊥ := by + have := (ν).map_mul_le_add (translatedTruncLE γ a) b + rw [degree_translatedTruncLE_of_pos hγ, WithBot.bot_add] at this + exact le_bot_iff.mp this + refine ((ν).map_sub_le_max _ _).trans_lt ?_ + rw [h1, h2, max_self] + exact WithBot.bot_lt_coe τ + +/-- The translated product error is small when the first factor either vanishes below the target +degree or satisfies the complementary degree bound. -/ +theorem degree_translatedTruncLE_mul_sub_mul_lt_of_eq_zero_or_bounds + (a b : Nonpositive G K) (ρ σ τ β : NatOrdinal.{u}) + (ha0 : β ≤ τ → a = 0) + (ha : ν a ≤ ρ) + (hat : ∀ x : G, x < 0 → ν (translatedTruncLE x a) ≤ ρ) + (hbt : ∀ x : G, x < 0 → ν (translatedTruncLE x b) < σ) + (hsep : τ < β → ∀ θ, θ < σ → ρ + θ < τ) (γ : G) : + ν (translatedTruncLE γ (a * b) - translatedTruncLE γ a * b) < τ := by + by_cases hβτ : β ≤ τ + · rw [ha0 hβτ] + simp only [zero_mul, map_zero, sub_zero, (ν).map_zero] + exact WithBot.bot_lt_coe τ + · exact degree_translatedTruncLE_mul_sub_mul_lt_forall a b ρ σ τ ha hat hbt + (hsep (lt_of_not_ge hβτ)) γ + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] + [CompleteSpace G] [CharZero K] in +/-- Decomposition of a summed residual into the local residual and three truncation errors. -/ +theorem translatedTruncLE_sub_sum_eq_local_errors + {J : Type w} [Fintype J] (y s : G) (R u : Nonpositive G K) + (cp cP q : J → Nonpositive G K) : + translatedTruncLE y R - ∑ j, translatedTruncLE y (cP j * q j) = + (translatedTruncLE y R - translatedTruncLE s u) + + translatedTruncLE s (u - ∑ j, cp j * q j) + + ∑ j, ((translatedTruncLE s (cp j * q j) - translatedTruncLE s (cp j) * q j) + + (translatedTruncLE s (cp j) - translatedTruncLE y (cP j)) * q j + + (translatedTruncLE y (cP j) * q j - translatedTruncLE y (cP j * q j))) := by + rw [map_sub, map_sum, Finset.sum_add_distrib, Finset.sum_add_distrib, + Finset.sum_congr rfl fun j _ ↦ sub_mul (translatedTruncLE s (cp j)) + (translatedTruncLE y (cP j)) (q j), + Finset.sum_sub_distrib, Finset.sum_sub_distrib, Finset.sum_sub_distrib] + abel + +/-- If the source cutoff and all first-factor cutoffs have degree bottom, then bounds on the +truncation product errors bound the residual finite sum. -/ +theorem degree_translatedTruncLE_sub_sum_le_of_eq_bot + {J : Type w} [Fintype J] (R : Nonpositive G K) (c q : J → Nonpositive G K) + {y : G} {τ : WithBot NatOrdinal} + (hR : ν (translatedTruncLE y R) = ⊥) + (herror : ∀ j, ν (translatedTruncLE y (c j * q j) - + translatedTruncLE y (c j) * q j) < τ) + (hc : ∀ j, ν (translatedTruncLE y (c j)) = ⊥) : + ν (translatedTruncLE y R - ∑ j, translatedTruncLE y (c j * q j)) ≤ τ := by + refine ((ν).map_sub_le_max _ _).trans ?_ + rw [hR] + refine max_le bot_le ?_ + apply (ν).map_sum_le_of_forall_le + intro j _ + have hsplit : translatedTruncLE y (c j * q j) = + (translatedTruncLE y (c j * q j) - translatedTruncLE y (c j) * q j) + + translatedTruncLE y (c j) * q j := by + abel + rw [hsplit] + refine ((ν).map_add_le_max _ _).trans (max_le (herror j).le ?_) + have hmul := (ν).map_mul_le_add (translatedTruncLE y (c j)) (q j) + rw [hc j, WithBot.bot_add] at hmul + exact hmul.trans bot_le + + +variable {κ : Type x} {ι : Type w} {κ' : Type w} + +open Classical in +/-- **Cofactors by well-founded induction.** Fix representatives of homogeneous classes generating +the associated graded ring below `α`, each satisfying its assigned degree and proper-truncation +bounds, with graded evaluation injective below `α`, finitely many weighted homogeneous ideal +generators, and natural-sum separation data for their degrees. +If every translated truncation of `u` has degree at most `β ≤ μ` and, at every nonpositive +cutoff, the truncation agrees below every negative bound with an evaluated polynomial whose part +at or above `τ` lies in the polynomial ideal, then there are global cofactors, with the +prescribed pointwise degree bounds, whose combination with the evaluated generators corrects every +translated truncation of `u` to degree at most `τ`. The recursion covers each residual support by +disjoint convex pieces on a nested convex subgroup base and combines the local cofactors, so no +countability or cofinality hypothesis enters. -/ +theorem exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal + [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + [LinearOrder κ] [WellFoundedLT κ] [Fintype κ'] + (U : κ → AddSubgroup G) + (hUmono : ∀ {i j : κ}, i ≤ j → (U j : Set G) ⊆ (U i : Set G)) + (hUopen : ∀ i, IsOpen (U i : Set G)) + (hUconv : ∀ i, (U i : Set G).OrdConnected) + (hUbase : ∀ ε : G, 0 < ε → ∃ i, (U i : Set G) ⊆ Ioo (-ε) ε) + {wt : ι → NatOrdinal.{u}} {V : ι → Nonpositive G K} + (xg : ι → (ν).AssociatedGraded) + (hV : ∀ i, Represents (V i) (wt i) (xg i)) + (hVbounds : ∀ i, HasLowerTruncationDegree (V i) (wt i)) + (α : NatOrdinal.{u}) + (hgen : ∀ β : NatOrdinal.{u}, β < α → ∀ y ∈ DirectSum.rangeLof K (ν).Component β, + ∃ F : MvPolynomial ι K, IsWeightedHomogeneous wt F β ∧ aeval xg F = y) + (hinj : ∀ (β : NatOrdinal.{u}) (F : MvPolynomial ι K), β < α → + IsWeightedHomogeneous wt F β → aeval xg F = 0 → F = 0) + (Q : κ' → MvPolynomial ι K) (σQ : κ' → NatOrdinal.{u}) + (hQ : ∀ j, IsWeightedHomogeneous wt (Q j) (σQ j)) + (τ μ : NatOrdinal.{u}) (hτμ : τ < μ) (hμα : μ < α) + (P : κ' → NatOrdinal.{u} → NatOrdinal.{u}) + (hP : ∀ j β, τ < β → β ≤ μ → P j β + σQ j = β) + (hPsep : ∀ j θ, θ < σQ j → P j μ + θ < τ) + (β : NatOrdinal.{u}) (hβμ : β ≤ μ) + (u : Nonpositive G K) + (hu : ∀ y : G, y ≤ 0 → ν (translatedTruncLE y u) ≤ β) + (hp : ∀ y : G, y ≤ 0 → ∃ F : MvPolynomial ι K, + (∀ d ∈ F.support, (Finsupp.weight wt) d < α) ∧ + ν (translatedTruncLE y u - aeval V F) = ⊥ ∧ + MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q)) : + ∃ c : κ' → Nonpositive G K, + (∀ j, ∀ y : G, y ≤ 0 → ν (translatedTruncLE y (c j)) ≤ P j β) ∧ + (β ≤ τ → ∀ j, c j = 0) ∧ + ∀ y : G, y ≤ 0 → + ν (translatedTruncLE y (u - ∑ j, c j * aeval V (Q j))) ≤ τ := by + classical + let q : κ' → Nonpositive G K := fun j ↦ aeval V (Q j) + change ∃ c : κ' → Nonpositive G K, + (∀ j, ∀ y : G, y ≤ 0 → ν (translatedTruncLE y (c j)) ≤ P j β) ∧ + (β ≤ τ → ∀ j, c j = 0) ∧ + ∀ y : G, y ≤ 0 → ν (translatedTruncLE y (u - ∑ j, c j * q j)) ≤ τ + -- Global data used at every stage of the induction. + have hW : ∀ j, HasLowerTruncationDegree (q j) (σQ j) := fun j ↦ + hasLowerTruncationDegree_aeval hVbounds (hQ j) + have hPle : ∀ j β', τ < β' → β' ≤ μ → P j β' ≤ μ := by + intro j β' h1 h2 + have h0 : P j β' + 0 ≤ P j β' + σQ j := add_le_add le_rfl (zero_le (a := σQ j)) + rw [add_zero, hP j β' h1 h2] at h0 + exact h0.trans h2 + have hPmono : ∀ j β' β'', τ < β' → β' ≤ β'' → β'' ≤ μ → P j β' ≤ P j β'' := by + intro j β' β'' h1 h2 h3 + have e1 := hP j β' h1 (h2.trans h3) + have e2 := hP j β'' (h1.trans_le h2) h3 + have : P j β' + σQ j ≤ P j β'' + σQ j := by rw [e1, e2]; exact h2 + exact le_of_add_le_add_right this + have hPlt : ∀ j β' β'', τ < β' → β' < β'' → β'' ≤ μ → P j β' < P j β'' := by + intro j β' β'' h1 h2 h3 + have e1 := hP j β' h1 (h2.le.trans h3) + have e2 := hP j β'' (h1.trans h2) h3 + have : P j β' + σQ j < P j β'' + σQ j := by rw [e1, e2]; exact h2 + exact lt_of_add_lt_add_right this + have hPsep' : ∀ j β', τ < β' → β' ≤ μ → ∀ θ, θ < σQ j → P j β' + θ < τ := by + intro j β' h1 h2 θ hθ + exact (add_le_add (hPmono j β' μ h1 h2 le_rfl) le_rfl).trans_lt (hPsep j θ hθ) + -- The induction over the stage. + induction β using WellFoundedLT.induction generalizing u with + | _ β ih => + by_cases hβτ : β ≤ τ + · -- Base: the truncations are already at the floor. + refine ⟨fun _ ↦ 0, ?_, fun _ j ↦ rfl, ?_⟩ + · intro j y hy + rw [map_zero, (ν).map_zero] + exact bot_le + · intro y hy + have hz : (∑ j, (0 : Nonpositive G K) * q j) = 0 := by + simp + rw [hz, sub_zero] + exact (hu y hy).trans (WithBot.coe_le_coe.mpr hβτ) + -- Main case: correct the top rank level, then partition and recurse. + · have hτβ : τ < β := lt_of_not_ge hβτ + have hβα : β < α := lt_of_le_of_lt hβμ hμα + -- Step A: choose local cofactors at every exact rank-`β` cutoff. + have hlocal : ∀ i : {x // x ∈ (u : HahnSeries G K).closedSupport ∧ + (u : HahnSeries G K).closedSupport.cantorBendixsonRank + (u : HahnSeries G K).closedSupport_isPWO x = β.val}, + ∃ w : κ' → Nonpositive G K, (∀ j, ν (w j) ≤ P j β) ∧ + ν (translatedTruncLE (i : G) u - ∑ j, w j * q j) < + (β : WithBot NatOrdinal) := by + rintro ⟨z, hzs, hzr⟩ + have hz0 : z ≤ 0 := closure_minimal u.property isClosed_Iic + ((mem_closedSupport _ _).mp hzs) + obtain ⟨F, hFw, hFbot, hFGE⟩ := hp z hz0 + have hνT : ν (translatedTruncLE z u) = (β : WithBot NatOrdinal) := by + rw [degree_translatedTruncLE_eq, if_pos hzs, cantorBendixsonRank_eq, hzr, NatOrdinal.of_val] + have hνF : ν (aeval V F) = (β : WithBot NatOrdinal) := by + rw [← degree_eq_of_degree_sub_eq_bot hFbot, hνT] + have hwle : ∀ d ∈ F.support, (Finsupp.weight wt) d ≤ β := by + intro d hd + have := forall_weight_le_degree_aeval_of_injective xg hV hinj hFw d hd + rw [hνF] at this + exact WithBot.coe_le_coe.mp this + set Fβ := weightedHomogeneousComponent wt β F with hFβ_def + have hFβspan : Fβ ∈ Ideal.span (Set.range Q) := + weightedHomogeneousComponent_mem_span_of_componentsGE_mem wt hQ hFGE hτβ.le + letI := weightedGradedAlgebra K wt + obtain ⟨A, hA, -, hAsum⟩ := OrdinalGraded.exists_eq_sum_mul_of_mem_span + (𝒜 := weightedHomogeneousSubmodule K wt) + (fun j ↦ (mem_weightedHomogeneousSubmodule _ _ _ _).mpr (hQ j)) + ((mem_weightedHomogeneousSubmodule _ _ _ _).mpr + (weightedHomogeneousComponent_isWeightedHomogeneous (w := wt) (n := β) (φ := F))) + hFβspan + have hAhom : ∀ j, IsWeightedHomogeneous wt (A j) (P j β) := fun j ↦ + (mem_weightedHomogeneousSubmodule _ _ _ _).mp (hA j (P j β) (hP j β hτβ hβμ)) + refine ⟨fun j ↦ aeval V (A j), fun j ↦ (represents_aeval xg hV (hAhom j)).degree_le, ?_⟩ + have hsum : (∑ j, aeval V (A j) * q j) = aeval V Fβ := by + rw [hFβ_def, hAsum, map_sum] + refine Finset.sum_congr rfl fun j _ ↦ ?_ + rw [map_mul, mul_comm] + rw [hsum] + have hrest : ∀ d ∈ (F - Fβ).support, (Finsupp.weight wt) d < β := by + intro d hd + have hne := MvPolynomial.mem_support_iff.mp hd + rw [MvPolynomial.coeff_sub, hFβ_def, coeff_weightedHomogeneousComponent] at hne + by_cases hdw : (Finsupp.weight wt) d = β + · rw [if_pos hdw, sub_self] at hne + exact absurd rfl hne + · rw [if_neg hdw, sub_zero] at hne + exact lt_of_le_of_ne (hwle d (MvPolynomial.mem_support_iff.mpr hne)) hdw + have hkey : translatedTruncLE z u - aeval V Fβ = + (translatedTruncLE z u - aeval V F) + aeval V (F - Fβ) := by + rw [map_sub] + ring + rw [hkey] + refine ((ν).map_add_le_max _ _).trans_lt (max_lt ?_ ?_) + · rw [hFbot] + exact WithBot.bot_lt_coe β + · exact degree_aeval_lt_of_forall_weight_lt xg hV hrest + choose wA hwAb hwAcorr using hlocal + obtain ⟨ctop, hctopb, hRdrop⟩ := + exists_forall_degree_translatedTruncLE_sub_sum_mul_lt β q + (fun j ↦ P j β) σQ (fun j ↦ (hP j β hτβ hβμ).le) (fun j ↦ (hW j).degree_le) + (fun j x hx ↦ (hW j).degree_translatedTruncLE_lt hx) u hu wA hwAb hwAcorr + set R : Nonpositive G K := u - ∑ j, ctop j * q j with hR_def + have hτα : τ < α := hτμ.trans hμα + -- Step B: the local ideal condition passes to the corrected residual. + have hpR : ∀ y : G, y ≤ 0 → ∃ F : MvPolynomial ι K, + (∀ d ∈ F.support, (Finsupp.weight wt) d < α) ∧ + ν (translatedTruncLE y R - aeval V F) = ⊥ ∧ + MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q) := by + intro y hy + obtain ⟨F₀, hF₀w, hF₀bot, hF₀GE⟩ := hp y hy + have hpolc : ∀ j, ∃ A' : MvPolynomial ι K, + (∀ d ∈ A'.support, + (((Finsupp.weight wt) d : NatOrdinal) : WithBot NatOrdinal) ≤ + ν (translatedTruncLE y (ctop j))) ∧ + (∀ d ∈ A'.support, (Finsupp.weight wt) d < α) ∧ + ν (translatedTruncLE y (ctop j) - aeval V A') = ⊥ := fun j ↦ + exists_forall_weight_lt_and_degree_sub_aeval_eq_bot xg hV α hgen _ + ((hctopb j y hy).trans_lt (WithBot.coe_lt_coe.mpr + ((hPle j β hτβ hβμ).trans_lt hμα))) + choose A' hA'd hA'w hA'bot using hpolc + have hEbound : ∀ j, ν (translatedTruncLE y (ctop j * q j) - + translatedTruncLE y (ctop j) * q j) < (τ : WithBot NatOrdinal) := by + intro j + exact degree_translatedTruncLE_mul_sub_mul_lt_forall (ctop j) (q j) + (P j β) (σQ j) τ (by simpa only [translatedTruncLE_zero] using hctopb j 0 le_rfl) + (fun x hx ↦ hctopb j x hx.le) + (fun x hx ↦ (hW j).degree_translatedTruncLE_lt hx) + (hPsep' j β hτβ hβμ) y + have hpolE : ∀ j, ∃ FE : MvPolynomial ι K, + (∀ d ∈ FE.support, + (((Finsupp.weight wt) d : NatOrdinal) : WithBot NatOrdinal) ≤ + ν (translatedTruncLE y (ctop j * q j) - + translatedTruncLE y (ctop j) * q j)) ∧ + (∀ d ∈ FE.support, (Finsupp.weight wt) d < α) ∧ + ν ((translatedTruncLE y (ctop j * q j) - + translatedTruncLE y (ctop j) * q j) - aeval V FE) = ⊥ := fun j ↦ + exists_forall_weight_lt_and_degree_sub_aeval_eq_bot xg hV α hgen _ + ((hEbound j).trans (WithBot.coe_lt_coe.mpr hτα)) + choose FE hFEd hFEw hFEbot using hpolE + have hFEGE : ∀ j, MvPolynomial.componentsGE wt τ (FE j) = 0 := by + intro j + apply componentsGE_eq_zero_of_forall_lt + intro d hd + have h1 := (hFEd j d hd).trans_lt (hEbound j) + exact WithBot.coe_lt_coe.mp h1 + refine ⟨F₀ - ∑ j, A' j * Q j - ∑ j, FE j, ?_, ?_, ?_⟩ + · intro d hd + rcases Finset.mem_union.mp (MvPolynomial.support_sub ι _ _ hd) with hd | hd + · rcases Finset.mem_union.mp (MvPolynomial.support_sub ι _ _ hd) with hd | hd + · exact hF₀w d hd + · have hsum := MvPolynomial.support_sum hd + rw [Finset.mem_biUnion] at hsum + obtain ⟨j, -, hdj⟩ := hsum + have hmul := MvPolynomial.support_mul _ _ hdj + rw [Finset.mem_add] at hmul + obtain ⟨d₁, hd₁, d₂, hd₂, rfl⟩ := hmul + rw [map_add] + have h1 : (Finsupp.weight wt) d₁ ≤ P j β := by + have := (hA'd j d₁ hd₁).trans (hctopb j y hy) + exact WithBot.coe_le_coe.mp this + have h2 : (Finsupp.weight wt) d₂ = σQ j := + hQ j (MvPolynomial.mem_support_iff.mp hd₂) + calc + (Finsupp.weight wt) d₁ + (Finsupp.weight wt) d₂ ≤ P j β + σQ j := by + rw [h2] + exact add_le_add h1 le_rfl + _ = β := hP j β hτβ hβμ + _ < α := hβα + · have hsum := MvPolynomial.support_sum hd + rw [Finset.mem_biUnion] at hsum + obtain ⟨j, -, hdj⟩ := hsum + exact hFEw j d hdj + · have hTsub : translatedTruncLE y R = + translatedTruncLE y u - ∑ j, translatedTruncLE y (ctop j * q j) := by + rw [hR_def, map_sub, map_sum] + have hAQ : ∀ j, aeval V (A' j * Q j) = aeval V (A' j) * q j := + fun j ↦ map_mul _ _ _ + have hcalc : translatedTruncLE y R - aeval V (F₀ - ∑ j, A' j * Q j - ∑ j, FE j) = + (translatedTruncLE y u - aeval V F₀) - + ∑ j, (translatedTruncLE y (ctop j * q j) - + aeval V (A' j) * q j - aeval V (FE j)) := by + rw [hTsub, map_sub, map_sub, map_sum, map_sum, + Finset.sum_congr rfl fun j _ ↦ hAQ j] + conv_rhs => rw [Finset.sum_sub_distrib, Finset.sum_sub_distrib] + abel + rw [hcalc] + have hbot1 : ∀ j, ν (translatedTruncLE y (ctop j * q j) - + aeval V (A' j) * q j - aeval V (FE j)) = ⊥ := by + intro j + have hshape : translatedTruncLE y (ctop j * q j) - + aeval V (A' j) * q j - aeval V (FE j) = + (translatedTruncLE y (ctop j) - aeval V (A' j)) * q j + + ((translatedTruncLE y (ctop j * q j) - + translatedTruncLE y (ctop j) * q j) - aeval V (FE j)) := by + ring + rw [hshape] + have h1 : ν ((translatedTruncLE y (ctop j) - aeval V (A' j)) * q j) = ⊥ := by + have := (ν).map_mul_le_add (translatedTruncLE y (ctop j) - aeval V (A' j)) + (q j) + rw [hA'bot j, WithBot.bot_add] at this + exact le_bot_iff.mp this + have h2 := hFEbot j + refine le_bot_iff.mp (((ν).map_add_le_max _ _).trans ?_) + rw [h1, h2, max_self] + have hsumbot : ν (∑ j, (translatedTruncLE y (ctop j * q j) - + aeval V (A' j) * q j - aeval V (FE j))) = ⊥ := + le_bot_iff.mp ((ν).map_sum_le_of_forall_le _ _ ⊥ fun j _ ↦ (hbot1 j).le) + refine le_bot_iff.mp (((ν).map_sub_le_max _ _).trans ?_) + rw [hF₀bot, hsumbot, max_self] + · rw [componentsGE_sub, componentsGE_sub, componentsGE_sum, componentsGE_sum] + have hAQGE : ∀ j ∈ Finset.univ, MvPolynomial.componentsGE wt τ (A' j * Q j) ∈ + Ideal.span (Set.range Q) := by + intro j _ + exact componentsGE_mem_span wt hQ + (Ideal.mul_mem_left _ _ (Ideal.subset_span ⟨j, rfl⟩)) τ + have hFEGE' : (∑ j, MvPolynomial.componentsGE wt τ (FE j)) = 0 := by + rw [Finset.sum_congr rfl fun j _ ↦ hFEGE j, Finset.sum_const_zero] + rw [hFEGE', sub_zero] + exact Ideal.sub_mem _ hF₀GE (Ideal.sum_mem _ hAQGE) + -- Step C: cover the residual support by disjoint convex pieces and recurse. + obtain ⟨Xset, C, hXs, hCmem, hCopen, hCconv, hCdisj, hCord, hCcov, hCmax, hCrank, hXdisc⟩ := + TopologicalSpace.Closeds.exists_disjoint_convex_cover_with_rank_lt_center + (R : HahnSeries G K).closedSupport (R : HahnSeries G K).closedSupport_isPWO + U hUmono hUopen hUconv hUbase + have hXpieces : Xset ⊆ ⋃ x : ↥Xset, C x := hXs.trans hCcov + have hX0 : ∀ x : ↥Xset, (x : G) ≤ 0 := fun x ↦ + closure_minimal R.property isClosed_Iic ((mem_closedSupport _ _).mp (hXs x.2)) + have hXset_pwo : Xset.IsPWO := (R : HahnSeries G K).closedSupport_isPWO.mono hXs + have hXpwo : (Set.univ : Set ↥Xset).IsPWO := by + rw [Set.isPWO_iff_exists_monotone_subseq] + intro f _ + obtain ⟨g, hg⟩ := hXset_pwo.exists_monotone_subseq fun n ↦ (f n).2 + exact ⟨g, fun a b hab ↦ Subtype.coe_le_coe.mp (hg hab)⟩ + let fx : ↥Xset → HahnSeries G K := fun x ↦ setRestrict (C x) (R : HahnSeries G K) + have hfxC : ∀ x, (fx x).support ⊆ C x := by + intro x + rw [show fx x = setRestrict (C x) (R : HahnSeries G K) from rfl, support_setRestrict] + exact inter_subset_right + have hfxle : ∀ x : ↥Xset, ∀ p ∈ (fx x).support, p ≤ (x : G) := by + intro x p hp + have hp' : p ∈ (R : HahnSeries G K).support ∩ C x := by + rwa [show fx x = setRestrict (C x) (R : HahnSeries G K) from rfl, + support_setRestrict] at hp + exact hCmax x p ⟨(mem_closedSupport _ _).mpr (subset_closure hp'.1), hp'.2⟩ + have hsepx : ∀ i j : ↥Xset, i < j → + ∀ a ∈ (fx i).support, ∀ b ∈ (fx j).support, a < b := + fun i j hij a ha b hb ↦ hCord i j hij a (hfxC i ha) b (hfxC j hb) + have hRsum : (R : HahnSeries G K) = separatedHsum hXpwo fx hsepx := by + have hcov : (R : HahnSeries G K).support ⊆ ⋃ x : ↥Xset, C x := fun g hg ↦ + hCcov ((mem_closedSupport _ _).mpr (subset_closure hg)) + exact (separatedHsum_setRestrict_eq hXpwo C (R : HahnSeries G K) hcov + (fun i j hij ↦ hCdisj i j hij) + (fun i j hij a ha b hb ↦ hCord i j hij a ha b hb)).symm + have hfx_shift : ∀ x : ↥Xset, (translate (-(x : G)) (fx x)).support ⊆ Iic 0 := by + intro x + rw [support_translate] + rintro g ⟨p, hp, rfl⟩ + have hpx := hfxle x p hp + have h3 : -(x : G) + p ≤ 0 := by + have h2 : -(x : G) + p ≤ -(x : G) + (x : G) := add_le_add le_rfl hpx + rwa [neg_add_cancel] at h2 + exact mem_Iic.mpr h3 + let ux : ↥Xset → Nonpositive G K := fun x ↦ ⟨translate (-(x : G)) (fx x), hfx_shift x⟩ + let bx : ↥Xset → NatOrdinal.{u} := fun x ↦ + NatOrdinal.of ((R : HahnSeries G K).cantorBendixsonRank (x : G)) + -- Locality of truncations inside a piece. + have hloc : ∀ (x : ↥Xset) (y' : G), y' ∈ C x → + ν (translatedTruncLE (y' - (x : G)) (ux x) - translatedTruncLE y' R) = ⊥ := by + intro x y' hy' + obtain ⟨cst, hcst, hcsty⟩ := exists_lt_mem_of_isOpen_ordConnected (hCopen x) hy' + have hdiff := support_truncLE_separatedHsum_sub_piece_subset hXpwo C fx hfxC hCord + hsepx x hy' hcst + apply (cantorBendixsonDegreeValuation_eq_bot_iff _).mpr + refine ⟨cst - y', sub_neg.mpr hcsty, ?_⟩ + intro g hg + have hcoe1 : ((translatedTruncLE (y' - (x : G)) (ux x) : Nonpositive G K) : + HahnSeries G K) = translate (-y') (truncLE y' (fx x)) := + translatedTruncLE_placed (x : G) y' (fx x) (hfx_shift x) + rw [AddSubgroupClass.coe_sub, hcoe1, coe_translatedTruncLE] at hg + have hcombine : translate (-y') (truncLE y' (fx x)) - + translate (-y') (truncLE y' (R : HahnSeries G K)) = + translate (-y') (truncLE y' (fx x) - truncLE y' (R : HahnSeries G K)) := + (map_sub (translate (-y')) _ _).symm + rw [hcombine, support_translate] at hg + obtain ⟨q, hq, rfl⟩ := hg + have hq' : q ∈ (truncLE y' (separatedHsum hXpwo fx hsepx) - + truncLE y' (fx x)).support := by + rw [← support_neg, neg_sub, ← hRsum] + exact hq + have hqc : q ≤ cst := hdiff hq' + have h3 : -y' + q ≤ cst - y' := by + have h2 : -y' + q ≤ -y' + cst := add_le_add le_rfl hqc + calc -y' + q ≤ -y' + cst := h2 + _ = cst - y' := by abel + exact mem_Iic.mpr h3 + have hplaced_eq : ∀ (x : ↥Xset) (s : G), + (translatedTruncLE s (ux x) : HahnSeries G K) = + translate (-((x : G) + s)) (truncLE ((x : G) + s) (fx x)) := by + intro x s + have h2 : ((x : G) + s) - (x : G) = s := by abel + have := translatedTruncLE_placed (x : G) ((x : G) + s) (fx x) (hfx_shift x) + rw [h2] at this + exact this + -- The translated degree profile of each piece. + have hux_prof : ∀ x : ↥Xset, ∀ s : G, s ≤ 0 → + ν (translatedTruncLE s (ux x)) ≤ (bx x : WithBot NatOrdinal) := by + intro x s hs + have hy'x : (x : G) + s ≤ (x : G) := by + calc (x : G) + s ≤ (x : G) + 0 := add_le_add le_rfl hs + _ = (x : G) := add_zero _ + by_cases hy'C : (x : G) + s ∈ C x + · have h1 := hloc x ((x : G) + s) hy'C + have h2 : ((x : G) + s) - (x : G) = s := by abel + rw [h2] at h1 + rw [degree_eq_of_degree_sub_eq_bot h1] + rw [degree_translatedTruncLE_eq] + by_cases hm : (x : G) + s ∈ (R : HahnSeries G K).closedSupport + · rw [if_pos hm] + rcases eq_or_ne ((x : G) + s) (x : G) with heq | hne + · rw [heq] + · have hlt := hCrank x ((x : G) + s) ⟨hm, hy'C⟩ hne + have hlt' : (R : HahnSeries G K).cantorBendixsonRank ((x : G) + s) < + (R : HahnSeries G K).cantorBendixsonRank (x : G) := by + rw [cantorBendixsonRank_eq, cantorBendixsonRank_eq] + exact hlt + exact (WithBot.coe_le_coe.mpr (NatOrdinal.of.monotone hlt'.le)) + · rw [if_neg hm] + exact bot_le + · have hbelow := lt_of_notMem_ordConnected (hCconv x) (hCmem x) hy'x hy'C + have hzero : truncLE ((x : G) + s) (fx x) = 0 := + truncLE_eq_zero_of_forall_lt _ _ (fun p hp ↦ hbelow p (hfxC x hp)) + have hzero' : translatedTruncLE s (ux x) = 0 := by + apply Subtype.ext + rw [hplaced_eq x s, hzero, map_zero] + rfl + rw [hzero', (ν).map_zero] + exact bot_le + have hbx_lt : ∀ x : ↥Xset, bx x < β := by + intro x + have h1 := hRdrop (x : G) (hX0 x) + have hm : (x : G) ∈ (R : HahnSeries G K).closedSupport := hXs x.2 + rw [degree_translatedTruncLE_eq, if_pos hm] at h1 + exact WithBot.coe_lt_coe.mp h1 + -- The local ideal condition for each piece. + have hpux : ∀ x : ↥Xset, ∀ s : G, s ≤ 0 → ∃ F : MvPolynomial ι K, + (∀ d ∈ F.support, (Finsupp.weight wt) d < α) ∧ + ν (translatedTruncLE s (ux x) - aeval V F) = ⊥ ∧ + MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q) := by + intro x s hs + have hy'0 : (x : G) + s ≤ 0 := by + calc (x : G) + s ≤ 0 + 0 := add_le_add (hX0 x) hs + _ = 0 := add_zero _ + by_cases hy'C : (x : G) + s ∈ C x + · obtain ⟨F, hFw, hFbot, hFGE⟩ := hpR ((x : G) + s) hy'0 + refine ⟨F, hFw, ?_, hFGE⟩ + have h1 := hloc x ((x : G) + s) hy'C + have h2 : ((x : G) + s) - (x : G) = s := by abel + rw [h2] at h1 + have hsplit : translatedTruncLE s (ux x) - aeval V F = + (translatedTruncLE s (ux x) - translatedTruncLE ((x : G) + s) R) + + (translatedTruncLE ((x : G) + s) R - aeval V F) := by + abel + rw [hsplit] + refine le_bot_iff.mp (((ν).map_add_le_max _ _).trans ?_) + rw [h1, hFbot, max_self] + · have hy'x : (x : G) + s ≤ (x : G) := by + calc (x : G) + s ≤ (x : G) + 0 := add_le_add le_rfl hs + _ = (x : G) := add_zero _ + have hbelow := lt_of_notMem_ordConnected (hCconv x) (hCmem x) hy'x hy'C + have hzero : truncLE ((x : G) + s) (fx x) = 0 := + truncLE_eq_zero_of_forall_lt _ _ (fun p hp ↦ hbelow p (hfxC x hp)) + have hzero' : translatedTruncLE s (ux x) = 0 := by + apply Subtype.ext + rw [hplaced_eq x s, hzero, map_zero] + rfl + refine ⟨0, by simp, ?_, ?_⟩ + · rw [hzero', map_zero, sub_zero, (ν).map_zero] + · rw [componentsGE_zero] + exact Ideal.zero_mem _ + -- Recurse on every piece. + have hpiece : ∀ x : ↥Xset, ∃ cp : κ' → Nonpositive G K, + (∀ j, ∀ s : G, s ≤ 0 → ν (translatedTruncLE s (cp j)) ≤ P j (bx x)) ∧ + (bx x ≤ τ → ∀ j, cp j = 0) ∧ + ∀ s : G, s ≤ 0 → + ν (translatedTruncLE s (ux x - ∑ j, cp j * q j)) ≤ τ := + fun x ↦ ih (bx x) (hbx_lt x) ((hbx_lt x).le.trans hβμ) (ux x) (hux_prof x) (hpux x) + choose cp hcpb hcp0 hcpres using hpiece + -- Step D: translate the piece cofactors back and sum them. + obtain ⟨placed, hplaced⟩ : ∃ placed : κ' → ↥Xset → K⟦G⟧, ∀ j x, + placed j x = setRestrict (C x) + (translate (x : G) ((cp x j : Nonpositive G K) : HahnSeries G K)) := + ⟨fun j x ↦ setRestrict (C x) + (translate (x : G) ((cp x j : Nonpositive G K) : HahnSeries G K)), fun _ _ ↦ rfl⟩ + have hplC : ∀ j x, (placed j x).support ⊆ C x := by + intro j x + rw [hplaced j x, support_setRestrict] + exact inter_subset_right + have hplle : ∀ j (x : ↥Xset), ∀ p ∈ (placed j x).support, p ≤ (x : G) := by + intro j x p hp + rw [hplaced j x, support_setRestrict] at hp + obtain ⟨hp1, -⟩ := hp + rw [support_translate] at hp1 + obtain ⟨q, hq, rfl⟩ := hp1 + have hq0 : q ≤ 0 := (cp x j).property hq + calc (x : G) + q ≤ (x : G) + 0 := add_le_add le_rfl hq0 + _ = (x : G) := add_zero _ + have hsepP : ∀ j, ∀ a b : ↥Xset, a < b → + ∀ p ∈ (placed j a).support, ∀ q ∈ (placed j b).support, p < q := + fun j a b hab p hp q hq ↦ hCord a b hab p (hplC j a hp) q (hplC j b hq) + have hcPnonpos : ∀ j, (separatedHsum hXpwo (placed j) (hsepP j)).support ⊆ Iic 0 := by + intro j g hg + rw [support_separatedHsum, Set.mem_iUnion] at hg + obtain ⟨x, hgx⟩ := hg + exact (hplle j x g hgx).trans (hX0 x) + obtain ⟨cP, hcP_coe⟩ : ∃ cP : κ' → Nonpositive G K, ∀ j, + ((cP j : Nonpositive G K) : HahnSeries G K) = + separatedHsum hXpwo (placed j) (hsepP j) := + ⟨fun j ↦ ⟨separatedHsum hXpwo (placed j) (hsepP j), hcPnonpos j⟩, fun _ ↦ rfl⟩ + let pieceFamily : SeparatedHsumFamily κ' ↥Xset := + { hX := hXpwo + piece := C + center := fun x ↦ (x : G) + term := placed + support_subset := hplC + support_le_center := hplle + center_mem := hCmem + isOpen_piece := hCopen + ordConnected_piece := hCconv + disjoint_piece := hCdisj + piece_lt_piece := hCord + separated := hsepP + sum := cP + coe_sum := hcP_coe } + have hdiscP : ∀ z : G, ¬ AccPt z (𝓟 (Set.range (fun x : ↥Xset ↦ (x : G)))) := by + intro z + rw [Subtype.range_coe] + exact hXdisc z + have hplzero : ∀ j (x : ↥Xset), bx x ≤ τ → placed j x = 0 := by + intro j x hbxτ + rw [hplaced j x, hcp0 x hbxτ j] + rw [show ((0 : Nonpositive G K) : HahnSeries G K) = 0 from rfl, map_zero] + ext g + rw [coeff_setRestrict] + split_ifs <;> rfl + have hstageP : ∀ j (x : ↥Xset), + (((placed j x).closedSupport).cantorBendixson (P j β).val : Set G) ⊆ {(x : G)} := by + intro j x + by_cases hbxτ : bx x ≤ τ + · rw [hplzero j x hbxτ] + intro z hz + exfalso + have hzs := TopologicalSpace.Closeds.cantorBendixson_le _ _ hz + rw [mem_closedSupport, HahnSeries.support_zero, closure_empty] at hzs + exact hzs + · intro z hz + exfalso + obtain ⟨hzs, hzr⟩ := ((placed j x).mem_support_derivative_iff z (P j β).val).mp hz + have h1 : (placed j x).cantorBendixsonRank z ≤ + (translate (x : G) + ((cp x j : Nonpositive G K) : HahnSeries G K)).cantorBendixsonRank z := + cantorBendixsonRank_le_of_support_subset (by + rw [hplaced j x, support_setRestrict] + exact inter_subset_left) z + have h2 : (translate (x : G) ((cp x j : Nonpositive G K) : + HahnSeries G K)).cantorBendixsonRank z = + ((cp x j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank (z - (x : G)) := by + have := cantorBendixsonRank_translate ((cp x j : Nonpositive G K) : HahnSeries G K) + (x : G) (z - (x : G)) + rw [show (x : G) + (z - (x : G)) = z by abel] at this + exact this + have h3 : ((cp x j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank (z - (x : G)) ≤ + (P j (bx x)).val := by + by_cases hm : z - (x : G) ∈ + ((cp x j : Nonpositive G K) : HahnSeries G K).closedSupport + · have hz0 : z - (x : G) ≤ 0 := closure_minimal (cp x j).property isClosed_Iic + ((mem_closedSupport _ _).mp hm) + have hprof := hcpb x j (z - (x : G)) hz0 + rw [degree_translatedTruncLE_eq, if_pos hm, WithBot.coe_le_coe] at hprof + have hval := NatOrdinal.of.symm.monotone hprof + change NatOrdinal.val (NatOrdinal.of _) ≤ NatOrdinal.val _ at hval + rwa [NatOrdinal.val_of] at hval + · rw [cantorBendixsonRank_eq, + TopologicalSpace.Closeds.cantorBendixsonRank_of_notMem _ _ hm] + exact zero_le (a := (P j (bx x)).val) + have h4 : (P j (bx x)).val < (P j β).val := by + have hlt := hPlt j (bx x) β (lt_of_not_ge hbxτ) (hbx_lt x) hβμ + have h := NatOrdinal.of.symm.strictMono hlt + change NatOrdinal.val _ < NatOrdinal.val _ at h + exact h + exact absurd hzr (not_le_of_gt (((h1.trans_eq h2).trans h3).trans_lt h4)) + have hcPb : ∀ j, ∀ y : G, y ≤ 0 → ν (translatedTruncLE y (cP j)) ≤ P j β := by + intro j y hy + have hbounds := cantorBendixsonRank_separatedHsum_bounds hXpwo C (fun x ↦ (x : G)) (placed j) + (hplC j) (hplle j) hCmem hCopen hCdisj hCord (hsepP j) hdiscP (P j β).val (hstageP j) + rw [degree_translatedTruncLE_eq] + by_cases hm : y ∈ ((cP j : Nonpositive G K) : HahnSeries G K).closedSupport + · rw [if_pos hm] + have hrank : ((cP j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank y ≤ + (P j β).val := by + have hr := hbounds.1 y + have hreq : ((cP j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank y = + (separatedHsum hXpwo (placed j) (hsepP j)).cantorBendixsonRank y := by + rw [hcP_coe j] + rw [hreq] + exact hr + calc ((NatOrdinal.of (((cP j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank y)) : + WithBot NatOrdinal) ≤ (NatOrdinal.of ((P j β).val) : WithBot NatOrdinal) := + WithBot.coe_le_coe.mpr (NatOrdinal.of.monotone hrank) + _ = (P j β : WithBot NatOrdinal) := by rw [NatOrdinal.of_val] + · rw [if_neg hm] + exact bot_le + -- Step E: the final cofactors correct every truncation to the floor. + refine ⟨fun j ↦ ctop j + cP j, ?_, ?_, ?_⟩ + · intro j y hy + rw [map_add] + exact ((ν).map_add_le_max _ _).trans (max_le (hctopb j y hy) (hcPb j y hy)) + · intro habs + exact (hβτ habs).elim + · intro y hy + have hres_eq : u - ∑ j, (ctop j + cP j) * q j = + R - ∑ j, cP j * q j := by + rw [hR_def, Finset.sum_congr rfl fun j _ ↦ add_mul (ctop j) (cP j) (q j), + Finset.sum_add_distrib] + ring + rw [hres_eq, map_sub, map_sum] + have hEc : ∀ j, ν (translatedTruncLE y (cP j * q j) - + translatedTruncLE y (cP j) * q j) < (τ : WithBot NatOrdinal) := fun j ↦ + degree_translatedTruncLE_mul_sub_mul_lt_forall (cP j) (q j) + (P j β) (σQ j) τ (by simpa only [translatedTruncLE_zero] using hcPb j 0 le_rfl) + (fun z hz ↦ hcPb j z hz.le) (fun z hz ↦ (hW j).degree_translatedTruncLE_lt hz) + (hPsep' j β hτβ hβμ) y + by_cases hyC : ∃ x : ↥Xset, y ∈ C x + · obtain ⟨x, hyx⟩ := hyC + have hRloc := hloc x y hyx + have hcPloc : ∀ j, ν (translatedTruncLE y (cP j) - + translatedTruncLE (y - (x : G)) (cp x j)) = ⊥ := fun j ↦ + degree_translatedTruncLE_separatedHsum_sub_piece_eq_bot hXpwo C hCopen hCconv + (placed j) (hplC j) hCord (hsepP j) x (x : G) hyx (cp x j) (hplaced j x) + (cP j) (hcP_coe j) + have hEin (j : κ') := + degree_translatedTruncLE_mul_sub_mul_lt_of_eq_zero_or_bounds + (cp x j) (q j) (P j (bx x)) (σQ j) τ (bx x) + (fun h ↦ hcp0 x h j) + (by simpa only [translatedTruncLE_zero] using hcpb x j 0 le_rfl) + (fun z hz ↦ hcpb x j z hz.le) + (fun z hz ↦ (hW j).degree_translatedTruncLE_lt hz) + (fun h ↦ hPsep' j (bx x) h ((hbx_lt x).le.trans hβμ)) (y - (x : G)) + have hkey := translatedTruncLE_sub_sum_eq_local_errors y (y - (x : G)) R (ux x) + (cp x) cP q + rw [hkey] + apply degree_add_add_sum_le + · rw [degree_reverse_sub_eq_bot hRloc] + exact bot_le + · exact degree_translatedTruncLE_le_of_nonpositive (hcpres x) (y - (x : G)) + · intro j + apply degree_add_add_le (hEin j).le + · rw [degree_mul_eq_bot_of_left + (b := q j) (degree_reverse_sub_eq_bot (hcPloc j))] + exact bot_le + · exact (degree_reverse_sub_lt (hEc j)).le + · have hyR := degree_translatedTruncLE_eq_bot_of_notMem_closedSupport (b := R) (by + intro hm + exact hyC (Set.mem_iUnion.mp (hCcov hm))) + have hXclosed : closure Xset = Xset := + (isClosed_iff_accPt.mpr fun z hz ↦ (hXdisc z hz).elim).closure_eq + have hyPieces : ∀ x : ↥Xset, y ∉ C x := fun x hyx ↦ hyC ⟨x, hyx⟩ + have hyX : y ∉ Xset := fun h ↦ hyC (Set.mem_iUnion.mp (hXpieces h)) + have hyCenters : y ∉ closure (Set.range (fun x : ↥Xset ↦ (x : G))) := + notMem_closure_range_subtype_coe hXclosed hyX + have hycP := + pieceFamily.degree_translatedTruncLE_eq_bot_of_notMem hyPieces hyCenters + apply degree_translatedTruncLE_sub_sum_le_of_eq_bot + (G := G) (K := K) (J := κ') (R := R) (c := cP) + (q := q) (y := y) (τ := τ) hyR hEc + simpa only [pieceFamily] using hycP + + +open Classical in +/-- **The graded conclusion of the cofactor construction.** Under the hypotheses at the top degree +`μ`, the homogeneous class of `u` in degree `μ` lies in the ideal of the associated graded ring +generated by the classes of the evaluated generators. The cofactors exhibit this membership, and +the resulting residual has degree at most `τ < μ`, hence represents zero in degree `μ`. -/ +theorem homogeneousClass_mem_span_of_locallyIdeal + [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + [LinearOrder κ] [WellFoundedLT κ] [Finite κ'] + (U : κ → AddSubgroup G) + (hUmono : ∀ {i j : κ}, i ≤ j → (U j : Set G) ⊆ (U i : Set G)) + (hUopen : ∀ i, IsOpen (U i : Set G)) + (hUconv : ∀ i, (U i : Set G).OrdConnected) + (hUbase : ∀ ε : G, 0 < ε → ∃ i, (U i : Set G) ⊆ Ioo (-ε) ε) + {wt : ι → NatOrdinal.{u}} {V : ι → Nonpositive G K} + (xg : ι → (ν).AssociatedGraded) + (hV : ∀ i, Represents (V i) (wt i) (xg i)) + (hVbounds : ∀ i, HasLowerTruncationDegree (V i) (wt i)) + (α : NatOrdinal.{u}) + (hgen : ∀ β : NatOrdinal.{u}, β < α → ∀ y ∈ DirectSum.rangeLof K (ν).Component β, + ∃ F : MvPolynomial ι K, IsWeightedHomogeneous wt F β ∧ aeval xg F = y) + (hinj : ∀ (β : NatOrdinal.{u}) (F : MvPolynomial ι K), β < α → + IsWeightedHomogeneous wt F β → aeval xg F = 0 → F = 0) + (Q : κ' → MvPolynomial ι K) (σQ : κ' → NatOrdinal.{u}) + (hQ : ∀ j, IsWeightedHomogeneous wt (Q j) (σQ j)) + (τ μ : NatOrdinal.{u}) (hτμ : τ < μ) (hμα : μ < α) + (P : κ' → NatOrdinal.{u} → NatOrdinal.{u}) + (hP : ∀ j β, τ < β → β ≤ μ → P j β + σQ j = β) + (hPsep : ∀ j θ, θ < σQ j → P j μ + θ < τ) + (u : Nonpositive G K) (eu : (ν).AssociatedGraded) (heu : Represents u μ eu) + (hu : ∀ y : G, y ≤ 0 → ν (translatedTruncLE y u) ≤ μ) + (hp : ∀ y : G, y ≤ 0 → ∃ F : MvPolynomial ι K, + (∀ d ∈ F.support, (Finsupp.weight wt) d < α) ∧ + ν (translatedTruncLE y u - aeval V F) = ⊥ ∧ + MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q)) : + eu ∈ Ideal.span (Set.range fun j ↦ aeval xg (Q j)) := by + classical + letI := Fintype.ofFinite κ' + obtain ⟨c, hcb, -, hres⟩ := exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal + U hUmono hUopen hUconv hUbase xg hV hVbounds α hgen hinj Q σQ hQ τ μ hτμ hμα P hP hPsep + μ le_rfl u hu hp + have hcrep : ∀ j, Represents (c j) (P j μ) + ((ν).homogeneousMk (P j μ) ⟨c j, ((ν).mem_filtrationLE_iff (P j μ) (c j)).mpr + (by simpa only [translatedTruncLE_zero] using hcb j 0 le_rfl)⟩) := + fun j ↦ represents_iff.mpr + ⟨by simpa only [translatedTruncLE_zero] using hcb j 0 le_rfl, rfl⟩ + have hQrep : ∀ j, Represents (aeval V (Q j)) (σQ j) (aeval xg (Q j)) := + fun j ↦ represents_aeval xg hV (hQ j) + have hterm : ∀ j, Represents (c j * aeval V (Q j)) μ + ((ν).homogeneousMk (P j μ) ⟨c j, ((ν).mem_filtrationLE_iff (P j μ) (c j)).mpr + (by simpa only [translatedTruncLE_zero] using hcb j 0 le_rfl)⟩ * aeval xg (Q j)) := + fun j ↦ (hcrep j).mul (hP j μ (lt_of_lt_of_le hτμ le_rfl) le_rfl).symm (hQrep j) + have hsumrep := represents_sum (s := (Finset.univ : Finset κ')) (m := μ) + fun j _ ↦ hterm j + have hzero : Represents (u - ∑ j, c j * aeval V (Q j)) μ 0 := by + apply represents_of_degree_lt + have hle := hres 0 le_rfl + rw [translatedTruncLE_zero] at hle + exact hle.trans_lt (WithBot.coe_lt_coe.mpr hτμ) + have hsplit : u = (u - ∑ j, c j * aeval V (Q j)) + ∑ j, c j * aeval V (Q j) := by abel + have hurep : Represents u μ (0 + ∑ j, (ν).homogeneousMk (P j μ) + ⟨c j, ((ν).mem_filtrationLE_iff (P j μ) (c j)).mpr + (by simpa only [translatedTruncLE_zero] using hcb j 0 le_rfl)⟩ * aeval xg (Q j)) := by + rw [hsplit] + exact hzero.add hsumrep + rw [heu.unique hurep, zero_add] + exact Ideal.sum_mem _ fun j _ ↦ Ideal.mul_mem_left _ _ (Ideal.subset_span ⟨j, rfl⟩) + +open Classical in +/-- **Ideal membership from proper translated truncations.** Suppose `ν u ≤ μ` and every +translated truncation at a strictly negative cutoff has degree below `μ`. If those truncations are +locally congruent to +evaluated polynomials with ideal high part, there are cofactors of the prescribed degrees whose +combination with the evaluated generators corrects the series to degree at most `τ + 1`. The +hypothesis is never used at the cutoff zero, where it would assert the conclusion: the closed +support is partitioned inside the strictly negative region, every piece is treated by the +well-founded cofactor construction at its own strictly smaller rank, and the translated local +cofactors combine with strict local stages, so the resulting cofactors keep their degrees at zero. +-/ +@[blueprint "lem:well-founded-cofactor-construction" + (phase := "Algebraic independence in graded rings") + (title := "Cofactors from local data by well-founded induction") + (statement := /-- + Let $K$ be a field of characteristic zero and let $G$ be a complete + densely ordered abelian group with a decreasing well-founded neighbourhood + basis $(U_i)$ of open convex additive subgroups. Let $b_i$ represent + homogeneous classes $x_i$ of degrees $w_i$ in the Cantor--Bendixson + associated graded ring, with + \[ + \nu(b_i)\le w_i, + \qquad \nu(b_i^{\vert y}) rfl + rw [hzero] at hz + have hzs := TopologicalSpace.Closeds.cantorBendixson_le _ _ hz + rw [mem_closedSupport, HahnSeries.support_zero, closure_empty] at hzs + exact hzs + · obtain ⟨hzs, hzr⟩ := ((placed j x).mem_support_derivative_iff z (P j μ).val).mp hz + have h1 : (placed j x).cantorBendixsonRank z ≤ + (translate (x : G) ((cp x j : Nonpositive G K) : HahnSeries G K)).cantorBendixsonRank z := + cantorBendixsonRank_le_of_support_subset (by + rw [hplaced j x, support_setRestrict] + exact inter_subset_left) z + have h2 : (translate (x : G) ((cp x j : Nonpositive G K) : + HahnSeries G K)).cantorBendixsonRank z = + ((cp x j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank (z - (x : G)) := by + have := cantorBendixsonRank_translate ((cp x j : Nonpositive G K) : HahnSeries G K) + (x : G) (z - (x : G)) + rw [show (x : G) + (z - (x : G)) = z by abel] at this + exact this + have h3 : ((cp x j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank (z - (x : G)) ≤ + (P j (bx x)).val := by + by_cases hm : z - (x : G) ∈ + ((cp x j : Nonpositive G K) : HahnSeries G K).closedSupport + · have hz0 : z - (x : G) ≤ 0 := closure_minimal (cp x j).property isClosed_Iic + ((mem_closedSupport _ _).mp hm) + have hprof := hcpb x j (z - (x : G)) hz0 + rw [degree_translatedTruncLE_eq, if_pos hm, WithBot.coe_le_coe] at hprof + have hval := NatOrdinal.of.symm.monotone hprof + change NatOrdinal.val (NatOrdinal.of _) ≤ NatOrdinal.val _ at hval + rwa [NatOrdinal.val_of] at hval + · rw [cantorBendixsonRank_eq, TopologicalSpace.Closeds.cantorBendixsonRank_of_notMem _ _ hm] + exact zero_le (a := (P j (bx x)).val) + have h4 : (P j (bx x)).val < (P j μ).val := by + have hlt := hPlt j (bx x) μ (lt_of_not_ge hbxτ) (hbx_lt x) le_rfl + have h := NatOrdinal.of.symm.strictMono hlt + change NatOrdinal.val _ < NatOrdinal.val _ at h + exact h + exact absurd hzr (not_le_of_gt (((h1.trans_eq h2).trans h3).trans_lt h4)) + have hclcen : closure (Set.range (fun x : ↥Xset ↦ (x : G))) ⊆ + Set.range (fun x : ↥Xset ↦ (x : G)) ∪ {0} := by + intro z hz + have hz0 : z ≤ 0 := by + apply closure_minimal _ isClosed_Iic hz + rintro p ⟨x, rfl⟩ + exact (hXneg x).le + rcases eq_or_lt_of_le hz0 with hz0' | hzneg + · exact Or.inr (Set.mem_singleton_iff.mpr hz0') + · refine Or.inl ?_ + rw [closure_eq_self_union_derivedSet] at hz + rcases hz with h | h + · exact h + · exfalso + have hrange : Set.range (fun x : ↥Xset ↦ (x : G)) = Xset := Subtype.range_coe + rw [hrange] at h + exact hXdisc z hzneg (mem_derivedSet.mp h) + have hcPbt : ∀ j, ∀ z : G, ν (translatedTruncLE z (cP j)) ≤ (P j μ : WithBot NatOrdinal) := by + intro j z + have hbounds := cantorBendixsonRank_separatedHsum_le_of_stage_empty hXpwo C + (fun x ↦ (x : G)) (placed j) (hplC j) (hplle j) hCmem hCopen hCdisj hCord (hsepP j) + (P j μ).val (hstageP j) 0 hclcen + rw [degree_translatedTruncLE_eq] + by_cases hm : z ∈ ((cP j : Nonpositive G K) : HahnSeries G K).closedSupport + · rw [if_pos hm] + have hrank : ((cP j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank z ≤ + (P j μ).val := by + have hr := hbounds z + have hreq : ((cP j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank z = + (separatedHsum hXpwo (placed j) (hsepP j)).cantorBendixsonRank z := by + rw [hcP_coe j] + rw [hreq] + exact hr + calc ((NatOrdinal.of (((cP j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank z)) : + WithBot NatOrdinal) ≤ (NatOrdinal.of ((P j μ).val) : WithBot NatOrdinal) := + WithBot.coe_le_coe.mpr (NatOrdinal.of.monotone hrank) + _ = (P j μ : WithBot NatOrdinal) := by rw [NatOrdinal.of_val] + · rw [if_neg hm] + exact bot_le + have hcPb : ∀ j, ν (cP j) ≤ P j μ := fun j ↦ by + simpa only [translatedTruncLE_zero] using hcPbt j 0 + -- The residual is at most the floor at every proper cutoff. + have hres : ∀ y : G, y < 0 → + ν (translatedTruncLE y (u - ∑ j, cP j * aeval V (Q j))) ≤ (τ : WithBot NatOrdinal) := by + intro y hy + rw [map_sub, map_sum] + have hEc : ∀ j, ν (translatedTruncLE y (cP j * aeval V (Q j)) - + translatedTruncLE y (cP j) * aeval V (Q j)) < (τ : WithBot NatOrdinal) := fun j ↦ + degree_translatedTruncLE_mul_sub_mul_lt_forall (cP j) (aeval V (Q j)) + (P j μ) (σQ j) τ (hcPb j) + (fun z _ ↦ hcPbt j z) + (fun z hz ↦ (hW j).degree_translatedTruncLE_lt hz) + (hPsep' j μ hτμ le_rfl) y + by_cases hyC : ∃ x : ↥Xset, y ∈ C x + · obtain ⟨x, hyx⟩ := hyC + have hRloc := hloc x y hyx + have hcPloc : ∀ j, ν (translatedTruncLE y (cP j) - + translatedTruncLE (y - (x : G)) (cp x j)) = ⊥ := fun j ↦ + degree_translatedTruncLE_separatedHsum_sub_piece_eq_bot hXpwo C hCopen hCconv + (placed j) (hplC j) hCord (hsepP j) x (x : G) hyx (cp x j) (hplaced j x) + (cP j) (hcP_coe j) + have hEin (j : κ') := + degree_translatedTruncLE_mul_sub_mul_lt_of_eq_zero_or_bounds + (cp x j) (aeval V (Q j)) (P j (bx x)) (σQ j) τ (bx x) + (fun h ↦ hcp0 x h j) + (by simpa only [translatedTruncLE_zero] using hcpb x j 0 le_rfl) + (fun z hz ↦ hcpb x j z hz.le) + (fun z hz ↦ (hW j).degree_translatedTruncLE_lt hz) + (fun h ↦ hPsep' j (bx x) h (hbx_lt x).le) (y - (x : G)) + have hkey := translatedTruncLE_sub_sum_eq_local_errors y (y - (x : G)) u (ux x) + (cp x) cP (fun j ↦ aeval V (Q j)) + rw [hkey] + apply degree_add_add_sum_le + · rw [degree_reverse_sub_eq_bot hRloc] + exact bot_le + · exact degree_translatedTruncLE_le_of_nonpositive (hcpres x) (y - (x : G)) + · intro j + apply degree_add_add_le (hEin j).le + · rw [degree_mul_eq_bot_of_left + (b := aeval V (Q j)) (degree_reverse_sub_eq_bot (hcPloc j))] + exact bot_le + · exact (degree_reverse_sub_lt (hEc j)).le + · have hyu := degree_translatedTruncLE_eq_bot_of_notMem_closedSupport (b := u) (by + intro hm + exact hyC (Set.mem_iUnion.mp (hCcov ⟨hm, hy⟩))) + have hyPieces : ∀ x : ↥Xset, y ∉ C x := fun x hyx ↦ hyC ⟨x, hyx⟩ + have hyCenters : y ∉ closure (Set.range (fun x : ↥Xset ↦ (x : G))) := by + intro h + rcases hclcen h with h' | h' + · exact hyC (Set.mem_iUnion.mp (hCcov ⟨(hXs (by + rw [← Subtype.range_coe (s := Xset)]; exact h')).1, hy⟩)) + · exact absurd (Set.mem_singleton_iff.mp h') (ne_of_lt hy) + have hycP := + pieceFamily.degree_translatedTruncLE_eq_bot_of_notMem hyPieces hyCenters + apply degree_translatedTruncLE_sub_sum_le_of_eq_bot + (G := G) (K := K) (J := κ') (R := u) (c := cP) + (q := fun j ↦ aeval V (Q j)) (y := y) (τ := τ) hyu hEc + simpa only [pieceFamily] using hycP + exact ⟨cP, hcPb, degree_le_add_one_of_forall_neg_le _ τ hres⟩ + +open Classical in +/-- **The proper-cutoff graded ideal membership.** Suppose `ν u ≤ μ` and every translated +truncation at a strictly negative cutoff has degree below `μ`. If those truncations are locally +congruent to evaluated polynomials with ideal high part, the homogeneous class represented by `u` +in degree `μ` lies in the ideal generated by the classes of the evaluated generators. The +hypothesis is never used at the cutoff zero, where it would assert the conclusion. + +This is the ideal-lifting conclusion used when the degree is a limit ordinal: the construction +produces cofactors whose classes exhibit the membership, and the corrected residual, of degree at +most one above the floor, represents zero in degree `μ`. -/ +@[blueprint "lem:local-ideal-membership-associated-graded" + (phase := "Algebraic independence in graded rings") + (title := "Local ideal membership in the associated graded ring") + (statement := /-- + Under all the hypotheses of + \ref{lem:well-founded-cofactor-construction}, suppose in addition that + $\tau\oplus1<\mu$. If $u$ represents a homogeneous class $\bar u$ of + degree $\mu$, then + \[ + \bar u\in\bigl(Q_j(x):j\bigr) + \] + in the Cantor--Bendixson associated graded ring. + -/) + (proof := /-- + By \ref{lem:well-founded-cofactor-construction}, choose cofactors $c_j$ of + degree at most $P_j(\mu)$ whose residual has degree at most + $\tau\oplus1<\mu$. The degree-$\mu$ class of the residual is therefore + zero. Multiplication of represented homogeneous classes and + $P_j(\mu)\oplus\sigma_j=\mu$ identify the remaining degree-$\mu$ class with + $\sum_j[c_j]Q_j(x)$. + -/)] +theorem homogeneousClass_mem_span_of_properly_locallyIdeal + [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + [LinearOrder κ] [WellFoundedLT κ] [Finite κ'] + (U : κ → AddSubgroup G) + (hUmono : ∀ {i j : κ}, i ≤ j → (U j : Set G) ⊆ (U i : Set G)) + (hUopen : ∀ i, IsOpen (U i : Set G)) + (hUconv : ∀ i, (U i : Set G).OrdConnected) + (hUbase : ∀ ε : G, 0 < ε → ∃ i, (U i : Set G) ⊆ Ioo (-ε) ε) + {wt : ι → NatOrdinal.{u}} {V : ι → Nonpositive G K} + (xg : ι → (ν).AssociatedGraded) + (hV : ∀ i, Represents (V i) (wt i) (xg i)) + (hVbounds : ∀ i, HasLowerTruncationDegree (V i) (wt i)) + (α : NatOrdinal.{u}) + (hgen : ∀ β : NatOrdinal.{u}, β < α → ∀ y ∈ DirectSum.rangeLof K (ν).Component β, + ∃ F : MvPolynomial ι K, IsWeightedHomogeneous wt F β ∧ aeval xg F = y) + (hinj : ∀ (β : NatOrdinal.{u}) (F : MvPolynomial ι K), β < α → + IsWeightedHomogeneous wt F β → aeval xg F = 0 → F = 0) + (Q : κ' → MvPolynomial ι K) (σQ : κ' → NatOrdinal.{u}) + (hQ : ∀ j, IsWeightedHomogeneous wt (Q j) (σQ j)) + (τ μ : NatOrdinal.{u}) (hτμ : (τ + 1 : NatOrdinal) < μ) (hμα : μ < α) + (P : κ' → NatOrdinal.{u} → NatOrdinal.{u}) + (hP : ∀ j β, τ < β → β ≤ μ → P j β + σQ j = β) + (hPsep : ∀ j θ, θ < σQ j → P j μ + θ < τ) + (u : Nonpositive G K) (htruncationBounds : HasLowerTruncationDegree u μ) + (eu : (ν).AssociatedGraded) (heu : Represents u μ eu) + (hp : ∀ y : G, y < 0 → ∃ F : MvPolynomial ι K, + (∀ d ∈ F.support, (Finsupp.weight wt) d < α) ∧ + ν (translatedTruncLE y u - aeval V F) = ⊥ ∧ + MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q)) : + eu ∈ Ideal.span (Set.range fun j ↦ aeval xg (Q j)) := by + classical + letI := Fintype.ofFinite κ' + have hτlt : τ < μ := lt_of_le_of_lt (le_of_lt (lt_add_one τ)) hτμ + obtain ⟨c, hcb, hres⟩ := exists_cofactors_degree_le_add_one_of_properly_locallyIdeal + U hUmono hUopen hUconv hUbase xg hV hVbounds α hgen hinj Q σQ hQ τ μ hτlt hμα P hP hPsep + u htruncationBounds hp + have hcrep : ∀ j, Represents (c j) (P j μ) + ((ν).homogeneousMk (P j μ) ⟨c j, ((ν).mem_filtrationLE_iff (P j μ) (c j)).mpr (hcb j)⟩) := + fun j ↦ represents_iff.mpr ⟨hcb j, rfl⟩ + have hQrep : ∀ j, Represents (aeval V (Q j)) (σQ j) (aeval xg (Q j)) := + fun j ↦ represents_aeval xg hV (hQ j) + have hterm : ∀ j, Represents (c j * aeval V (Q j)) μ + ((ν).homogeneousMk (P j μ) ⟨c j, ((ν).mem_filtrationLE_iff (P j μ) (c j)).mpr (hcb j)⟩ * + aeval xg (Q j)) := + fun j ↦ (hcrep j).mul (hP j μ hτlt le_rfl).symm (hQrep j) + have hsumrep := represents_sum (s := (Finset.univ : Finset κ')) (m := μ) fun j _ ↦ hterm j + have hzero : Represents (u - ∑ j, c j * aeval V (Q j)) μ 0 := + represents_of_degree_lt (hres.trans_lt (WithBot.coe_lt_coe.mpr hτμ)) + have hsplit : u = (u - ∑ j, c j * aeval V (Q j)) + ∑ j, c j * aeval V (Q j) := by abel + have hurep : Represents u μ (0 + ∑ j, (ν).homogeneousMk (P j μ) + ⟨c j, ((ν).mem_filtrationLE_iff (P j μ) (c j)).mpr (hcb j)⟩ * aeval xg (Q j)) := by + rw [hsplit] + exact hzero.add hsumrep + rw [heu.unique hurep, zero_add] + exact Ideal.sum_mem _ fun j _ ↦ Ideal.mul_mem_left _ _ (Ideal.subset_span ⟨j, rfl⟩) + +open Classical in +/-- **The polynomial syzygy.** If the class of a weighted homogeneous polynomial lies in the ideal +generated by the classes of finitely many weighted homogeneous generators, then the polynomial is +itself that combination of the generators, with cofactors weighted homogeneous of the +complementary degrees. Homogeneous ideal decomposition splits the class into graded cofactors, +generation names each cofactor by a polynomial, and injectivity below the degree returns the +identity to the polynomial ring. -/ +@[blueprint "lem:homogeneous-ideal-membership-polynomial-syzygy" + (phase := "Algebraic independence in graded rings") + (title := "Polynomial syzygies from homogeneous ideal membership") + (statement := /-- + Let $x_i$ be homogeneous elements of a graded $K$-algebra. Assume + homogeneous polynomial evaluation at $(x_i)$ is generating and injective + below $\alpha$. Let $A$ and the finitely many $Q_j$ be + weighted-homogeneous of degrees $m<\alpha$ and $\sigma_j$. If + \[ + A(x)\in\bigl(Q_j(x):j\bigr), + \] + then there are polynomials $C_j$ such that + \[ + A=\sum_jC_jQ_j, + \] + and $C_j$ is weighted-homogeneous of degree $\beta$ whenever + $\beta\oplus\sigma_j=m$. + -/) + (proof := /-- + By \ref{thm:cantor-bendixson-value-multiplicative}, the + Cantor--Bendixson degree defines the associated graded ring in which the + ideal is formed. By \ref{lem:homogeneous-element-of-generated-ideal}, + homogeneous ideal + membership writes $A(x)$ as a sum of the $Q_j(x)$ with homogeneous + cofactors of complementary degrees. Homogeneous + generation below $\alpha$ represents each cofactor by a polynomial of the + same degree. The resulting polynomial combination and $A$ have the same + evaluation and are homogeneous of degree $m$; injectivity in that degree + makes them equal. + -/)] +theorem exists_eq_sum_mul_of_class_mem_span + {ι : Type w} {κ' : Type w} [Fintype κ'] {wt : ι → NatOrdinal.{u}} + (xg : ι → (ν).AssociatedGraded) + (hxg : ∀ i, xg i ∈ DirectSum.rangeLof K (ν).Component (wt i)) + {α : NatOrdinal.{u}} + (hgen : ∀ β : NatOrdinal.{u}, β < α → ∀ y ∈ DirectSum.rangeLof K (ν).Component β, + ∃ F : MvPolynomial ι K, IsWeightedHomogeneous wt F β ∧ aeval xg F = y) + (hinj : ∀ (β : NatOrdinal.{u}) (F : MvPolynomial ι K), β < α → + IsWeightedHomogeneous wt F β → aeval xg F = 0 → F = 0) + (Q : κ' → MvPolynomial ι K) (σQ : κ' → NatOrdinal.{u}) + (hQ : ∀ j, IsWeightedHomogeneous wt (Q j) (σQ j)) + {A : MvPolynomial ι K} {m : NatOrdinal.{u}} (hm : m < α) + (hA : IsWeightedHomogeneous wt A m) + (hmem : aeval xg A ∈ Ideal.span (Set.range fun j ↦ aeval xg (Q j))) : + ∃ c : κ' → MvPolynomial ι K, + (∀ j β, β + σQ j = m → IsWeightedHomogeneous wt (c j) β) ∧ + A = ∑ j, c j * Q j := by + classical + have hQmem : ∀ j, aeval xg (Q j) ∈ DirectSum.rangeLof K (ν).Component (σQ j) := fun j ↦ + OrdinalGraded.aeval_mem_of_forall_mem hxg (hQ j) + have hAmem : aeval xg A ∈ DirectSum.rangeLof K (ν).Component m := + OrdinalGraded.aeval_mem_of_forall_mem hxg hA + obtain ⟨u, hu, hu0, husum⟩ := OrdinalGraded.exists_eq_sum_mul_of_mem_span + (𝒜 := DirectSum.rangeLof K (ν).Component) hQmem hAmem hmem + -- Name each graded cofactor by a homogeneous polynomial. + have hname : ∀ j : κ', ∃ p : MvPolynomial ι K, + (∀ β, β + σQ j = m → IsWeightedHomogeneous wt p β) ∧ aeval xg p = u j ∧ + ((¬ ∃ β, β + σQ j = m) → p = 0) := by + intro j + by_cases hβ : ∃ β, β + σQ j = m + · obtain ⟨β, hβm⟩ := hβ + have hβlt : β < α := by + refine lt_of_le_of_lt ?_ hm + rw [← hβm] + have h0 : β + 0 ≤ β + σQ j := add_le_add le_rfl (zero_le (a := σQ j)) + rwa [add_zero] at h0 + obtain ⟨p, hphom, hpval⟩ := hgen β hβlt (u j) (hu j β hβm) + refine ⟨p, fun β' hβ' ↦ ?_, hpval, fun hno ↦ absurd ⟨β, hβm⟩ hno⟩ + have hββ : β' = β := add_right_cancel (hβ'.trans hβm.symm) + rw [hββ] + exact hphom + · exact ⟨0, fun β hβm ↦ absurd ⟨β, hβm⟩ hβ, + by rw [map_zero, hu0 j hβ], fun _ ↦ rfl⟩ + choose c hchom hcval hczero using hname + refine ⟨c, hchom, ?_⟩ + -- The two sides have the same class, and injectivity identifies them. + have hsumhom : IsWeightedHomogeneous wt (∑ j, c j * Q j) m := by + rw [← MvPolynomial.mem_weightedHomogeneousSubmodule] + refine Submodule.sum_mem _ fun j _ ↦ ?_ + by_cases hβ : ∃ β, β + σQ j = m + · obtain ⟨β, hβm⟩ := hβ + have h := (hchom j β hβm).mul (hQ j) + rw [hβm] at h + rw [MvPolynomial.mem_weightedHomogeneousSubmodule] + exact h + · rw [hczero j hβ, zero_mul] + exact Submodule.zero_mem _ + have hclass : aeval xg A = aeval xg (∑ j, c j * Q j) := by + rw [map_sum, husum] + exact Finset.sum_congr rfl fun j _ ↦ by + rw [map_mul, hcval j, mul_comm] + have hdiff : IsWeightedHomogeneous wt (A - ∑ j, c j * Q j) m := by + rw [← MvPolynomial.mem_weightedHomogeneousSubmodule] at hA hsumhom ⊢ + exact Submodule.sub_mem _ hA hsumhom + have := hinj m (A - ∑ j, c j * Q j) hm hdiff (by rw [map_sub, hclass, sub_self]) + exact sub_eq_zero.mp this + +/-- **From the local ideal condition to a polynomial identity.** If at every proper cutoff the +truncation of an evaluated homogeneous polynomial is represented by a polynomial whose part in +degrees at or above `τ` lies in the ideal of the generators, then the polynomial itself is a +combination of the generators, with each cofactor homogeneous of the complementary degree. + +This composes the lift-back, which turns the local condition into membership of the graded class, +with the polynomial syzygy, which returns that membership to an identity in the polynomial ring. It +is the step from the analysis to an actual relation among the partial derivatives. -/ +theorem exists_eq_sum_mul_of_forall_componentsGE_mem + [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + {κ : Type x} [LinearOrder κ] [WellFoundedLT κ] {ι : Type w} {κ' : Type w} [Fintype κ'] + (U : κ → AddSubgroup G) + (hUmono : ∀ {i j : κ}, i ≤ j → (U j : Set G) ⊆ (U i : Set G)) + (hUopen : ∀ i, IsOpen (U i : Set G)) + (hUconv : ∀ i, (U i : Set G).OrdConnected) + (hUbase : ∀ ε : G, 0 < ε → ∃ i, (U i : Set G) ⊆ Set.Ioo (-ε) ε) + {wt : ι → NatOrdinal.{u}} {V : ι → Nonpositive G K} + (xg : ι → (ν).AssociatedGraded) + (hV : ∀ i, Represents (V i) (wt i) (xg i)) + (hVbounds : ∀ i, HasLowerTruncationDegree (V i) (wt i)) + (α : NatOrdinal.{u}) + (hgen : ∀ β : NatOrdinal.{u}, β < α → ∀ y ∈ DirectSum.rangeLof K (ν).Component β, + ∃ F : MvPolynomial ι K, IsWeightedHomogeneous wt F β ∧ aeval xg F = y) + (hinj : ∀ (β : NatOrdinal.{u}) (F : MvPolynomial ι K), β < α → + IsWeightedHomogeneous wt F β → aeval xg F = 0 → F = 0) + (Q : κ' → MvPolynomial ι K) (σQ : κ' → NatOrdinal.{u}) + (hQ : ∀ j, IsWeightedHomogeneous wt (Q j) (σQ j)) + (τ μ : NatOrdinal.{u}) (hτμ : (τ + 1 : NatOrdinal) < μ) (hμα : μ < α) + (P : κ' → NatOrdinal.{u} → NatOrdinal.{u}) + (hP : ∀ j β, τ < β → β ≤ μ → P j β + σQ j = β) + (hPsep : ∀ j θ, θ < σQ j → P j μ + θ < τ) + {Θ : MvPolynomial ι K} (hΘ : IsWeightedHomogeneous wt Θ μ) + (htruncationBounds : HasLowerTruncationDegree (aeval V Θ) μ) + (hp : ∀ y : G, y < 0 → ∃ F : MvPolynomial ι K, + (∀ d ∈ F.support, (Finsupp.weight wt) d < α) ∧ + ν (translatedTruncLE y (aeval V Θ) - aeval V F) = ⊥ ∧ + MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q)) : + ∃ c : κ' → MvPolynomial ι K, + (∀ j β, β + σQ j = μ → IsWeightedHomogeneous wt (c j) β) ∧ + Θ = ∑ j, c j * Q j := by + have hmem := homogeneousClass_mem_span_of_properly_locallyIdeal U hUmono hUopen hUconv hUbase + xg hV hVbounds α hgen hinj Q σQ hQ τ μ hτμ hμα P hP hPsep (aeval V Θ) htruncationBounds + (aeval xg Θ) (represents_aeval xg hV hΘ) hp + exact exists_eq_sum_mul_of_class_mem_span xg (fun i ↦ (hV i).mem_rangeLof) hgen hinj Q σQ hQ + hμα hΘ hmem + +/-- **From the local ideal condition to a polynomial identity, from window data.** The same +conclusion as above, with the cofactor degrees produced from window bounds at the generator degrees +rather than supplied. + +Each generator degree must precede the polynomial's degree in the algebraic order, and its window +bound must hold at the exponent of its last Cantor term. Those are conditions on natural ordinals +alone, and they are what the classification of the generators establishes. -/ +theorem exists_eq_sum_mul_of_forall_componentsGE_mem_of_windows + [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + {κ : Type x} [LinearOrder κ] [WellFoundedLT κ] {ι : Type w} {κ' : Type w} [Fintype κ'] + (U : κ → AddSubgroup G) + (hUmono : ∀ {i j : κ}, i ≤ j → (U j : Set G) ⊆ (U i : Set G)) + (hUopen : ∀ i, IsOpen (U i : Set G)) + (hUconv : ∀ i, (U i : Set G).OrdConnected) + (hUbase : ∀ ε : G, 0 < ε → ∃ i, (U i : Set G) ⊆ Set.Ioo (-ε) ε) + {wt : ι → NatOrdinal.{u}} {V : ι → Nonpositive G K} + (xg : ι → (ν).AssociatedGraded) + (hV : ∀ i, Represents (V i) (wt i) (xg i)) + (hVbounds : ∀ i, HasLowerTruncationDegree (V i) (wt i)) + (α : NatOrdinal.{u}) + (hgen : ∀ β : NatOrdinal.{u}, β < α → ∀ y ∈ DirectSum.rangeLof K (ν).Component β, + ∃ F : MvPolynomial ι K, IsWeightedHomogeneous wt F β ∧ aeval xg F = y) + (hinj : ∀ (β : NatOrdinal.{u}) (F : MvPolynomial ι K), β < α → + IsWeightedHomogeneous wt F β → aeval xg F = 0 → F = 0) + (Q : κ' → MvPolynomial ι K) (σQ ρQ : κ' → NatOrdinal.{u}) + (hQ : ∀ j, IsWeightedHomogeneous wt (Q j) (σQ j)) + (τ μ : NatOrdinal.{u}) (hτμ : (τ + 1 : NatOrdinal) < μ) (hμα : μ < α) + (hσ : ∀ j, σQ j ≠ 0) (hgrade : ∀ j, ρQ j + σQ j = μ) + (hwin : ∀ j, ∀ ε : NatOrdinal.{u}, NatOrdinal.leastTerm (σQ j) = ω^ ε → + NatOrdinal.partGE ε μ ≤ τ) + {Θ : MvPolynomial ι K} (hΘ : IsWeightedHomogeneous wt Θ μ) + (htruncationBounds : HasLowerTruncationDegree (aeval V Θ) μ) + (hp : ∀ y : G, y < 0 → ∃ F : MvPolynomial ι K, + (∀ d ∈ F.support, (Finsupp.weight wt) d < α) ∧ + ν (translatedTruncLE y (aeval V Θ) - aeval V F) = ⊥ ∧ + MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q)) : + ∃ c : κ' → MvPolynomial ι K, + (∀ j β, β + σQ j = μ → IsWeightedHomogeneous wt (c j) β) ∧ + Θ = ∑ j, c j * Q j := by + obtain ⟨P, hP, hPsep⟩ := + NatOrdinal.exists_cofactorDegree_of_forall_partGE_le σQ ρQ τ μ hσ hgrade hwin + exact exists_eq_sum_mul_of_forall_componentsGE_mem U hUmono hUopen hUconv hUbase xg hV hVbounds + α hgen hinj Q σQ hQ τ μ hτμ hμα P hP hPsep hΘ htruncationBounds hp + +/-- **From an eventual local ideal condition to a polynomial identity.** It is enough that the +local ideal representatives exist at every negative cutoff sufficiently close to zero. Cutting the +evaluated homogeneous polynomial to its strict tail above the neighbourhood bound preserves its +represented class, its degree upper bound, and the strict degree drop at negative cutoffs; below +the cut every translated truncation is zero, so the proper-cutoff cofactor construction applies to +that tail. -/ +@[blueprint "lem:eventual-local-ideal-membership-gives-syzygy" + (phase := "Algebraic independence in graded rings") + (title := "Local-to-global principle for homogeneous ideal membership") + (statement := /-- + Let $K$ be a field of characteristic zero and let $G$ be a complete + densely ordered abelian group with a decreasing well-founded neighbourhood + basis $(U_i)$ of open convex additive subgroups. Let $b_i$ represent + homogeneous classes $x_i$ of degrees $w_i$ in the Cantor--Bendixson + associated graded ring, with + \[ + \nu(b_i)\le w_i, + \qquad \nu(b_i^{\vert y}) (cantorBendixsonDegreeValuation (G := G) (R := R)) + +private def successorDerivation (α : NatOrdinal.{u}) : + (ν).Component (α + 1) →+ Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded := + (Filter.Germ.mapLinear (DirectSum.of (ν).Component α).toIntLinearMap).toAddMonoidHom.comp + (cantorBendixsonLayerDeriv α) + +private theorem successorDerivation_componentMk (α : NatOrdinal.{u}) + (b : (ν).filtrationLE (α + 1)) : + successorDerivation α ((ν).componentMk (α + 1) b) = + ((fun γ ↦ DirectSum.of (ν).Component α + (cantorBendixsonDerivAt α (b : Nonpositive G R) γ)) : + Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) := by + rw [successorDerivation, AddMonoidHom.comp_apply, LinearMap.toAddMonoidHom_coe, + cantorBendixsonLayerDeriv_componentMk, Filter.Germ.mapLinear_coe] + rfl + +private theorem remove_one_add_one {α : NatOrdinal.{u}} (h : 0 < α.constantCoeff) : + α.removeNat 1 + 1 = α := by + simpa only [Nat.cast_one] using NatOrdinal.removeNat_add_natCast h + +open Classical in +/-- The truncation map included in the graded ring, zero on zero and limit grades. -/ +def cantorBendixsonHomogeneousDerivation (α : NatOrdinal.{u}) : + (ν).Component α →+ Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded := + if h : 0 < α.constantCoeff then + (successorDerivation (α.removeNat 1)).comp + (AddEquiv.cast (M := (ν).Component) (remove_one_add_one h).symm).toAddMonoidHom + else 0 + +/-- The homogeneous map vanishes when the finite Cantor coefficient is zero. -/ +theorem cantorBendixsonHomogeneousDerivation_limit (α : NatOrdinal.{u}) + (hα : α.constantCoeff = 0) : + cantorBendixsonHomogeneousDerivation (G := G) (R := R) α = 0 := by + rw [cantorBendixsonHomogeneousDerivation, dif_neg (by simp [hα])] + +private theorem successorDerivation_cast {α β : NatOrdinal.{u}} + (h : α = β) (e : β + 1 = α + 1) : + (successorDerivation (G := G) (R := R) α).comp + (AddEquiv.cast (M := (ν).Component) e).toAddMonoidHom = successorDerivation β := by + subst β + rfl + +private theorem cantorBendixsonHomogeneousDerivation_succ (α : NatOrdinal.{u}) : + cantorBendixsonHomogeneousDerivation (G := G) (R := R) (α + 1) = + successorDerivation α := by + have hc : 0 < (α + 1).constantCoeff := by + have he := NatOrdinal.constantCoeff_add_natCast α 1 + simp only [Nat.cast_one] at he + rw [he] + exact Nat.zero_lt_succ _ + rw [cantorBendixsonHomogeneousDerivation, dif_pos hc] + have he : (α + 1).removeNat 1 = α := by + apply add_right_cancel (b := (1 : NatOrdinal)) + simpa only [Nat.cast_one] using NatOrdinal.removeNat_add_natCast hc + exact successorDerivation_cast he _ + +/-- The additive extension of the homogeneous truncation maps to the associated graded ring. -/ +def cantorBendixsonGradedDerivation : + (ν).AssociatedGraded →+ Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded := + DirectSum.toAddMonoid (cantorBendixsonHomogeneousDerivation (G := G) (R := R)) + +/-- On a homogeneous inclusion, the graded derivation is the homogeneous truncation map. -/ +theorem cantorBendixsonGradedDerivation_of (α : NatOrdinal.{u}) (a : (ν).Component α) : + cantorBendixsonGradedDerivation (DirectSum.of (ν).Component α a) = + cantorBendixsonHomogeneousDerivation α a := by + rw [cantorBendixsonGradedDerivation, DirectSum.toAddMonoid_of] + +/-- A successor representative is sent to its translated truncation classes near zero. -/ +@[blueprint "lem:cantor-bendixson-derivation-successor-formula" + (phase := "Algebraic independence in graded rings") + (title := "The successor formula for the Cantor--Bendixson derivation") + (statement := /-- + Let $\nu$ be the Cantor--Bendixson degree on + $R((G^{\leq0}))$, and let $\partial_{\mathrm{CB}}$ be the additive map + from $\operatorname{gr}_\nu$ to functions + $G\to\operatorname{gr}_\nu$ modulo equality on a left neighbourhood of + $0$. If $\nu(b)\leq\alpha+1$, then + \[ + \partial_{\mathrm{CB}}\bigl(\operatorname{in}_{\alpha+1}(b)\bigr) + = + \left[\gamma\longmapsto + \operatorname{in}_{\alpha}\bigl(b^{\mid\gamma}\bigr)\right]_{\gamma\to0^-}, + \] + where $b^{\mid\gamma}$ is the translated truncation of $b$ at $\gamma$. + -/) + (proof := /-- + By \ref{thm:cantor-bendixson-value-multiplicative}, the + Cantor--Bendixson degree defines the multiplicative filtration and + associated graded ring used here. On the component of degree + $\alpha+1$, the map + $\partial_{\mathrm{CB}}$ is defined by taking the degree-$\alpha$ class + of each translated truncation. Including those classes in the associated + graded ring gives the displayed equality. + -/)] +theorem cantorBendixsonGradedDerivation_homogeneousMk_succ {δ : NatOrdinal.{u}} + (α : NatOrdinal.{u}) (hδ : δ = α + 1) (b : (ν).filtrationLE δ) : + cantorBendixsonGradedDerivation ((ν).homogeneousMk δ b) = + ((fun γ ↦ DirectSum.of (ν).Component α + (cantorBendixsonDerivAt α (b : Nonpositive G R) γ)) : + Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) := by + subst δ + rw [(ν).homogeneousMk_apply, cantorBendixsonGradedDerivation_of, + cantorBendixsonHomogeneousDerivation_succ, successorDerivation_componentMk] + +/-- Zero and limit homogeneous representatives have zero derivative. -/ +theorem cantorBendixsonGradedDerivation_homogeneousMk_limit (α : NatOrdinal.{u}) + (hα : α.constantCoeff = 0) (b : (ν).filtrationLE α) : + cantorBendixsonGradedDerivation ((ν).homogeneousMk α b) = 0 := by + rw [(ν).homogeneousMk_apply, cantorBendixsonGradedDerivation_of, + cantorBendixsonHomogeneousDerivation_limit _ hα, AddMonoidHom.zero_apply] + +/-- The Leibniz rule holds on every pair of homogeneous representatives. -/ +theorem cantorBendixsonGradedDerivation_mul_homogeneous (α β : NatOrdinal.{u}) + (b : (ν).filtrationLE α) (c : (ν).filtrationLE β) : + cantorBendixsonGradedDerivation ((ν).homogeneousMk α b * (ν).homogeneousMk β c) = + cantorBendixsonGradedDerivation ((ν).homogeneousMk α b) * + ((ν).homogeneousMk β c : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) + + ((ν).homogeneousMk α b : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) * + cantorBendixsonGradedDerivation ((ν).homogeneousMk β c) := by + let LeibnizAt : (ν).AssociatedGraded → (ν).AssociatedGraded → Prop := fun x y ↦ + cantorBendixsonGradedDerivation (x * y) = + cantorBendixsonGradedDerivation x * + (y : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) + + (x : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) * + cantorBendixsonGradedDerivation y + change LeibnizAt ((ν).homogeneousMk α b) ((ν).homogeneousMk β c) + have succ_succ (α β : NatOrdinal.{u}) + (b : (ν).filtrationLE (α + 1)) (c : (ν).filtrationLE (β + 1)) : + LeibnizAt ((ν).homogeneousMk (α + 1) b) ((ν).homogeneousMk (β + 1) c) := by + dsimp only [LeibnizAt] + rw [(ν).homogeneousMk_mul, + cantorBendixsonGradedDerivation_homogeneousMk_succ (α + β + 1) (by ac_rfl), + cantorBendixsonGradedDerivation_homogeneousMk_succ α rfl, + cantorBendixsonGradedDerivation_homogeneousMk_succ β rfl] + simp only [(ν).coe_mulFiltrationLE] + exact Filter.EventuallyEq.germ_eq (eventually_homogeneousDerivAt_mul_succ α β b c) + have succ_limit (α β : NatOrdinal.{u}) (hβ : β.constantCoeff = 0) + (b : (ν).filtrationLE (α + 1)) (c : (ν).filtrationLE β) : + LeibnizAt ((ν).homogeneousMk (α + 1) b) ((ν).homogeneousMk β c) := by + dsimp only [LeibnizAt] + rw [(ν).homogeneousMk_mul, + cantorBendixsonGradedDerivation_homogeneousMk_succ (α + β) (by ac_rfl), + cantorBendixsonGradedDerivation_homogeneousMk_succ α rfl, + cantorBendixsonGradedDerivation_homogeneousMk_limit β hβ, mul_zero, add_zero] + simp only [(ν).coe_mulFiltrationLE] + exact Filter.EventuallyEq.germ_eq (eventually_homogeneousDerivAt_mul_limit α β hβ b c) + have succ (α β : NatOrdinal.{u}) + (b : (ν).filtrationLE (α + 1)) (c : (ν).filtrationLE β) : + LeibnizAt ((ν).homogeneousMk (α + 1) b) ((ν).homogeneousMk β c) := by + by_cases hβ : β.constantCoeff = 0 + · exact succ_limit α β hβ b c + · obtain ⟨β', rfl⟩ : ∃ β', β = β' + 1 := + ⟨β.removeNat 1, (remove_one_add_one (Nat.pos_of_ne_zero hβ)).symm⟩ + exact succ_succ α β' b c + dsimp only [LeibnizAt] + by_cases hα : α.constantCoeff = 0 + · by_cases hβ : β.constantCoeff = 0 + · have hs : (α + β).constantCoeff = 0 := by + rw [NatOrdinal.constantCoeff_add, hα, hβ, zero_add] + rw [(ν).homogeneousMk_mul, cantorBendixsonGradedDerivation_homogeneousMk_limit _ hs, + cantorBendixsonGradedDerivation_homogeneousMk_limit _ hα, + cantorBendixsonGradedDerivation_homogeneousMk_limit _ hβ, + zero_mul, mul_zero, add_zero] + · obtain ⟨β', rfl⟩ : ∃ β', β = β' + 1 := + ⟨β.removeNat 1, (remove_one_add_one (Nat.pos_of_ne_zero hβ)).symm⟩ + have h := succ β' α c b + rw [mul_comm ((ν).homogeneousMk α b) ((ν).homogeneousMk (β' + 1) c), h] + rw [add_comm] + congr 1 <;> exact mul_comm _ _ + · obtain ⟨α', rfl⟩ : ∃ α', α = α' + 1 := + ⟨α.removeNat 1, (remove_one_add_one (Nat.pos_of_ne_zero hα)).symm⟩ + exact succ α' β b c + +private theorem const_add (x y : (ν).AssociatedGraded) : + ((x + y : (ν).AssociatedGraded) : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) = + (x : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) + + (y : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) := rfl + +private theorem const_zero : + ((0 : (ν).AssociatedGraded) : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) = 0 := rfl + +/-- The graded truncation map satisfies the Leibniz rule, using constant function germs. -/ +@[blueprint "lem:cantor-bendixson-derivation-leibniz" + (phase := "Algebraic independence in graded rings") + (title := "The Leibniz rule for the Cantor--Bendixson derivation") + (statement := /-- + For all $x,y\in\operatorname{gr}_\nu$, + \[ + \partial_{\mathrm{CB}}(xy) + =\partial_{\mathrm{CB}}(x)y+x\partial_{\mathrm{CB}}(y), + \] + where elements of $\operatorname{gr}_\nu$ on the right are regarded as + constant functions near $0$. + -/) + (proof := /-- + Decompose $x$ and $y$ into homogeneous components. On successor + components, \ref{lem:cantor-bendixson-derivation-successor-formula} + turns the identity into the translated-truncation product formula. The + derivative vanishes on components whose constant Cantor coefficient is + zero. Additivity then gives the formula for arbitrary $x$ and $y$. + -/)] +theorem cantorBendixsonGradedDerivation_mul (x y : (ν).AssociatedGraded) : + cantorBendixsonGradedDerivation (x * y) = + cantorBendixsonGradedDerivation x * + (y : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) + + (x : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) * + cantorBendixsonGradedDerivation y := by + induction x using DirectSum.induction_on with + | zero => simp [const_zero] + | of α a => + induction y using DirectSum.induction_on with + | zero => simp [const_zero] + | of β b => + induction a using MaxAddDegree.componentInductionOn with + | H a => + induction b using MaxAddDegree.componentInductionOn with + | H b => + simpa only [(ν).homogeneousMk_apply] using + cantorBendixsonGradedDerivation_mul_homogeneous α β a b + | add y z hy hz => + rw [mul_add, map_add, hy, hz, map_add, const_add, mul_add, mul_add] + abel + | add x z hx hz => + rw [add_mul, map_add, hx, hz, map_add, const_add, add_mul, add_mul] + abel + +/-- Restriction of the graded derivation to each successor homogeneous component is injective. -/ +theorem cantorBendixsonGradedDerivation_injective_on_successor (α : NatOrdinal.{u}) : + Function.Injective (fun a : (ν).Component (α + 1) ↦ + cantorBendixsonGradedDerivation (DirectSum.of (ν).Component (α + 1) a)) := by + intro a b hab + simp only [cantorBendixsonGradedDerivation_of, + cantorBendixsonHomogeneousDerivation_succ] at hab + apply cantorBendixsonLayerDeriv_injective α + apply Filter.Germ.mapLinear_injective (DirectSum.of (ν).Component α).toIntLinearMap + (DirectSum.of_injective α) + exact hab + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationIdeal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationIdeal.lean new file mode 100644 index 0000000000..1b822ea7ab --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationIdeal.lean @@ -0,0 +1,335 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Scalar +public import + LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Successor ideal integration for the Cantor–Bendixson derivation + +Prescribed homogeneous coefficient germs on one exact Cantor–Bendixson rank can be integrated at +arbitrary cofinality. This module combines that construction with homogeneous ideal +decomposition and the injective successor derivation. +-/ + +public noncomputable section + +open Set Filter Topology +open scoped DirectSum NatOrdinal + +universe u v w + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [Field K] [CharZero K] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := K)) + +/-- A finite pointwise sum represents the sum of the corresponding filter germs. -/ +theorem germ_coe_sum {ι : Type w} [Fintype ι] (g : ι → G → (ν).AssociatedGraded) : + ((fun γ ↦ ∑ i, g i γ : G → (ν).AssociatedGraded) : + Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) = + ∑ i, ((g i : G → (ν).AssociatedGraded) : + Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) := by + have hfun : (fun γ ↦ ∑ i, g i γ : G → (ν).AssociatedGraded) = ∑ i, g i := by + ext γ + simp only [Finset.sum_apply] + rw [hfun] + exact map_sum (Filter.Germ.coeRingHom (𝓝[<] (0 : G))) g Finset.univ + +/-- The graded derivative vanishes on a homogeneous element whose grade has zero finite Cantor +coefficient. -/ +theorem cantorBendixsonGradedDerivation_eq_zero_of_constantCoeff_eq_zero + {c : NatOrdinal.{u}} (hc : c.constantCoeff = 0) {q : (ν).AssociatedGraded} + (hq : q ∈ DirectSum.rangeLof K (ν).Component c) : + cantorBendixsonGradedDerivation q = 0 := by + obtain ⟨a, ha⟩ := (DirectSum.mem_rangeLof_iff K (ν).Component c q).mp hq + rw [DirectSum.lof_eq_of] at ha + rw [← ha, cantorBendixsonGradedDerivation_of, + cantorBendixsonHomogeneousDerivation_limit c hc, AddMonoidHom.zero_apply] + +open Classical in +/-- A homogeneous function prescribed on the exact-rank points of a successor representative is +the graded derivative of a homogeneous class. The product with a fixed homogeneous element has +the expected successor grade. -/ +@[blueprint "lem:prescribed-cantor-bendixson-derivative-exact-rank" + (phase := "Algebraic independence in graded rings") + (title := "Prescribing the Cantor--Bendixson derivative on one exact-rank set") + (statement := /-- + Let $q\in\operatorname{gr}_\nu$ be homogeneous of degree $c$, and let a + series $p$ have Cantor--Bendixson degree at most $\delta+1$. Prescribe at + every point of exact rank $\delta$ in + $\overline{\operatorname{supp}(p)}$ a homogeneous class $a_\gamma$ whose + degree $\beta$ satisfies $\beta+c=\delta$, taking $a_\gamma=0$ when no + such $\beta$ exists. Then there is $z\in\operatorname{gr}_\nu$ such that + $qz$ is homogeneous of degree $\delta+1$ and the Cantor--Bendixson + derivative of $z$ agrees near $0$ with $a_\gamma$ on that exact-rank set + and is zero away from it. + -/) + (proof := /-- + If no $\beta$ satisfies $\beta+c=\delta$, take $z=0$. Otherwise, all + prescribed values have the same degree $\beta$. Choose component + representatives and place them on pairwise separated left intervals + ending at the exact-rank points of $p$. Their Hahn sum has degree at most + $\beta+1$ and has the prescribed translated-truncation classes. Its + degree-$(\beta+1)$ class is $z$; the graded product has degree + $c+(\beta+1)=\delta+1$, and + \ref{lem:cantor-bendixson-derivation-successor-formula} gives the required + near-zero equality. + -/)] +theorem exists_grading_mul_and_derivation_eq_rankLevel + {δ c : NatOrdinal.{u}} {q : (ν).AssociatedGraded} + (hq : q ∈ DirectSum.rangeLof K (ν).Component c) + (p : Nonpositive G K) (hp : ν p ≤ (δ + 1 : NatOrdinal)) + (a : {x // x ∈ (p : HahnSeries G K).closedSupport ∧ + (p : HahnSeries G K).closedSupport.cantorBendixsonRank + (p : HahnSeries G K).closedSupport_isPWO x = δ.val} → (ν).AssociatedGraded) + (ha : ∀ i β, β + c = δ → + a i ∈ DirectSum.rangeLof K (ν).Component β) + (ha0 : ∀ i, (¬ ∃ β, β + c = δ) → a i = 0) : + ∃ z : (ν).AssociatedGraded, + q * z ∈ DirectSum.rangeLof K (ν).Component (δ + 1) ∧ + cantorBendixsonGradedDerivation z = + ((fun γ ↦ if h : γ ∈ (p : HahnSeries G K).closedSupport ∧ + (p : HahnSeries G K).closedSupport.cantorBendixsonRank + (p : HahnSeries G K).closedSupport_isPWO γ = δ.val then + a ⟨γ, h⟩ else 0) : + Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) := by + classical + by_cases hβ : ∃ β, β + c = δ + · obtain ⟨β, hβ⟩ := hβ + have hcomponent : ∀ i, ∃ b : (ν).Component β, + DirectSum.of (ν).Component β b = a i := by + intro i + obtain ⟨b, hb⟩ := (DirectSum.mem_rangeLof_iff K (ν).Component β (a i)).mp + (ha i β hβ) + exact ⟨b, by simpa only [DirectSum.lof_eq_of] using hb⟩ + choose b hb using hcomponent + obtain ⟨s, hs, -, hderiv⟩ := exists_prescribed_components_on_rankLevel δ β p hp b + let z : (ν).AssociatedGraded := + (ν).homogeneousMk (β + 1) + ⟨s, ((ν).mem_filtrationLE_iff (β + 1) s).mpr hs⟩ + refine ⟨z, ?_, ?_⟩ + · have hz : z ∈ DirectSum.rangeLof K (ν).Component (β + 1) := by + dsimp only [z] + rw [(ν).homogeneousMk_apply] + exact DirectSum.of_mem_rangeLof K (ν).Component (β + 1) _ + have hmul := SetLike.mul_mem_graded hq hz + have hgrade : c + (β + 1) = δ + 1 := by + rw [← hβ] + ac_rfl + rwa [hgrade] at hmul + · rw [show z = (ν).homogeneousMk (β + 1) + ⟨s, ((ν).mem_filtrationLE_iff (β + 1) s).mpr hs⟩ from rfl, + cantorBendixsonGradedDerivation_homogeneousMk_succ β rfl] + calc + ((fun γ ↦ DirectSum.of (ν).Component β + (cantorBendixsonDerivAt β s γ)) : + Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) = + Filter.Germ.mapLinear (DirectSum.of (ν).Component β).toIntLinearMap + (cantorBendixsonLayerDeriv β + ((ν).componentMk (β + 1) + ⟨s, ((ν).mem_filtrationLE_iff (β + 1) s).mpr hs⟩)) := by + rw [cantorBendixsonLayerDeriv_componentMk, Filter.Germ.mapLinear_coe] + rfl + _ = Filter.Germ.mapLinear (DirectSum.of (ν).Component β).toIntLinearMap + (((fun γ ↦ if h : γ ∈ (p : HahnSeries G K).closedSupport ∧ + (p : HahnSeries G K).closedSupport.cantorBendixsonRank + (p : HahnSeries G K).closedSupport_isPWO γ = δ.val then + b ⟨γ, h⟩ else 0) : + Filter.Germ (𝓝[<] (0 : G)) ((ν).Component β))) := + congrArg _ hderiv + _ = _ := by + rw [Filter.Germ.mapLinear_coe, Filter.Germ.coe_eq] + exact Filter.Eventually.of_forall fun γ ↦ by + by_cases hγ : γ ∈ (p : HahnSeries G K).closedSupport ∧ + (p : HahnSeries G K).closedSupport.cantorBendixsonRank + (p : HahnSeries G K).closedSupport_isPWO γ = δ.val + · simp only [dif_pos hγ, Function.comp_apply] + change DirectSum.of (ν).Component β (b ⟨γ, hγ⟩) = a ⟨γ, hγ⟩ + exact hb ⟨γ, hγ⟩ + · simp only [dif_neg hγ, Function.comp_apply, map_zero] + · refine ⟨0, ?_, ?_⟩ + · rw [mul_zero] + exact zero_mem _ + · rw [map_zero, ← Filter.Germ.coe_zero, Filter.Germ.coe_eq] + exact Filter.Eventually.of_forall fun γ ↦ by + by_cases hγ : γ ∈ (p : HahnSeries G K).closedSupport ∧ + (p : HahnSeries G K).closedSupport.cantorBendixsonRank + (p : HahnSeries G K).closedSupport_isPWO γ = δ.val + · simp only [Pi.zero_apply, dif_pos hγ, ha0 ⟨γ, hγ⟩ hβ] + · simp only [Pi.zero_apply, dif_neg hγ] + +open Classical in +/-- Ideal membership of a successor homogeneous class follows from pointwise ideal membership +of its Cantor–Bendixson derivative germ. -/ +@[blueprint "lem:successor-ideal-membership-from-cantor-bendixson-derivative" + (phase := "Algebraic independence in graded rings") + (title := "The derivative criterion for successor ideal membership") + (statement := /-- + Let $(q_j)$ be a finite homogeneous family in $\operatorname{gr}_\nu$, of + degrees $c_j$ with zero constant Cantor coefficient. Let $x$ be + homogeneous of degree $\delta+1$. If the Cantor--Bendixson derivative of + $x$ is represented near $0$ by a function $f$ satisfying + \[ + f(\gamma)\in(q_j:j)\qquad\text{for every }\gamma\in G, + \] + then $x\in(q_j:j)$. + -/) + (proof := /-- + Decompose each $f(\gamma)$ homogeneously in the generators $q_j$ using + \ref{lem:homogeneous-element-of-generated-ideal}. On the exact-rank set + of a representative of $x$, apply + \ref{lem:prescribed-cantor-bendixson-derivative-exact-rank} to each + coefficient. The resulting classes $z_j$ make + $y=\sum_jq_jz_j$ homogeneous of degree $\delta+1$ and give $x$ and $y$ + the same Cantor--Bendixson derivative near $0$. The derivative is + injective in successor degree, so $x=y\in(q_j:j)$. Products are + differentiated using + \ref{lem:cantor-bendixson-derivation-leibniz}. + -/)] +theorem mem_span_of_cantorBendixsonGradedDerivation_eq_coe + {ι : Type w} [Finite ι] + {q : ι → (ν).AssociatedGraded} {c : ι → NatOrdinal.{u}} + (hq : ∀ j, q j ∈ DirectSum.rangeLof K (ν).Component (c j)) + (hc : ∀ j, (c j).constantCoeff = 0) + {δ : NatOrdinal.{u}} {x : (ν).AssociatedGraded} + (hx : x ∈ DirectSum.rangeLof K (ν).Component (δ + 1)) + {f : G → (ν).AssociatedGraded} + (hf : ∀ γ, f γ ∈ Ideal.span (Set.range q)) + (hD : cantorBendixsonGradedDerivation x = + (f : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded)) : + x ∈ Ideal.span (Set.range q) := by + classical + letI := Fintype.ofFinite ι + obtain ⟨xδ, hxδ⟩ := + (DirectSum.mem_rangeLof_iff K (ν).Component (δ + 1) x).mp hx + rw [DirectSum.lof_eq_of] at hxδ + rw [← hxδ] + induction xδ using MaxAddDegree.componentInductionOn with + | H p => + have hp : ν (p : Nonpositive G K) ≤ (δ + 1 : NatOrdinal) := + ((ν).mem_filtrationLE_iff (δ + 1) _).mp p.property + have hDrep : cantorBendixsonGradedDerivation + (DirectSum.of (ν).Component (δ + 1) ((ν).componentMk (δ + 1) p)) = + ((fun γ ↦ DirectSum.of (ν).Component δ + (cantorBendixsonDerivAt δ (p : Nonpositive G K) γ)) : + Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) := by + rw [← (ν).homogeneousMk_apply, + cantorBendixsonGradedDerivation_homogeneousMk_succ δ rfl] + have hD' : cantorBendixsonGradedDerivation + (DirectSum.of (ν).Component (δ + 1) ((ν).componentMk (δ + 1) p)) = + (f : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) := by + rw [hxδ] + exact hD + have hevent : ∀ᶠ γ in 𝓝[<] (0 : G), + DirectSum.of (ν).Component δ + (cantorBendixsonDerivAt δ (p : Nonpositive G K) γ) = f γ := by + rw [hDrep] at hD' + exact Filter.Germ.coe_eq.mp hD' + let good : Set G := {γ | DirectSum.of (ν).Component δ + (cantorBendixsonDerivAt δ (p : Nonpositive G K) γ) = f γ} + have hgood : ∀ᶠ γ in 𝓝[<] (0 : G), γ ∈ good := hevent + let I := {γ // γ ∈ (p : HahnSeries G K).closedSupport ∧ + (p : HahnSeries G K).closedSupport.cantorBendixsonRank + (p : HahnSeries G K).closedSupport_isPWO γ = δ.val} + let a : I → (ν).AssociatedGraded := fun i ↦ + if (i : G) ∈ good then f i else 0 + have haGrade : ∀ i, a i ∈ DirectSum.rangeLof K (ν).Component δ := by + intro i + by_cases hi : (i : G) ∈ good + · change (if (i : G) ∈ good then f i else 0) ∈ + DirectSum.rangeLof K (ν).Component δ + rw [if_pos hi, ← hi] + exact DirectSum.of_mem_rangeLof K (ν).Component δ _ + · change (if (i : G) ∈ good then f i else 0) ∈ + DirectSum.rangeLof K (ν).Component δ + rw [if_neg hi] + exact zero_mem _ + have haIdeal : ∀ i, a i ∈ Ideal.span (Set.range q) := by + intro i + by_cases hi : (i : G) ∈ good + · change (if (i : G) ∈ good then f i else 0) ∈ Ideal.span (Set.range q) + rw [if_pos hi] + exact hf i + · change (if (i : G) ∈ good then f i else 0) ∈ Ideal.span (Set.range q) + rw [if_neg hi] + exact Ideal.zero_mem _ + have hdec := fun i ↦ OrdinalGraded.exists_eq_sum_mul_of_mem_span + (𝒜 := DirectSum.rangeLof K (ν).Component) hq (haGrade i) (haIdeal i) + choose u hu hu0 hsum using hdec + have hreal := fun j ↦ exists_grading_mul_and_derivation_eq_rankLevel + (hq j) (p : Nonpositive G K) hp (fun i ↦ u i j) + (fun i β hβ ↦ hu i j β hβ) (fun i hnone ↦ hu0 i j hnone) + choose z hz hDz using hreal + let y : (ν).AssociatedGraded := ∑ j, q j * z j + have hy : y ∈ DirectSum.rangeLof K (ν).Component (δ + 1) := by + exact sum_mem fun j _ ↦ hz j + have hDy : cantorBendixsonGradedDerivation y = + ((fun γ ↦ ∑ j, q j * + (if h : γ ∈ (p : HahnSeries G K).closedSupport ∧ + (p : HahnSeries G K).closedSupport.cantorBendixsonRank + (p : HahnSeries G K).closedSupport_isPWO γ = δ.val then + u ⟨γ, h⟩ j else 0)) : + Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) := by + dsimp only [y] + rw [map_sum, germ_coe_sum] + refine Finset.sum_congr rfl fun j _ ↦ ?_ + rw [cantorBendixsonGradedDerivation_mul, + cantorBendixsonGradedDerivation_eq_zero_of_constantCoeff_eq_zero + (hc j) (hq j), zero_mul, zero_add, hDz j] + rfl + have hDxy : cantorBendixsonGradedDerivation + (DirectSum.of (ν).Component (δ + 1) ((ν).componentMk (δ + 1) p)) = + cantorBendixsonGradedDerivation y := by + rw [hDrep, hDy, Filter.Germ.coe_eq] + filter_upwards [hgood, eventually_degree_translatedTruncLE_le + (p : Nonpositive G K) δ hp] with γ hγgood hγdegree + by_cases hγ : γ ∈ (p : HahnSeries G K).closedSupport ∧ + (p : HahnSeries G K).closedSupport.cantorBendixsonRank + (p : HahnSeries G K).closedSupport_isPWO γ = δ.val + · simp only [dif_pos hγ] + calc + DirectSum.of (ν).Component δ + (cantorBendixsonDerivAt δ (p : Nonpositive G K) γ) = + f γ := hγgood + _ = a ⟨γ, hγ⟩ := by + change f γ = if γ ∈ good then f γ else 0 + rw [if_pos hγgood] + _ = ∑ j, q j * u ⟨γ, hγ⟩ j := hsum ⟨γ, hγ⟩ + · simp only [dif_neg hγ, mul_zero, Finset.sum_const_zero] + have hzero : cantorBendixsonDerivAt δ (p : Nonpositive G K) γ = 0 := by + by_contra hne + have hs := (cantorBendixsonDerivAt_ne_zero_iff δ + (p : Nonpositive G K) γ hγdegree).mp hne + apply hγ + refine ⟨hs.1, ?_⟩ + simpa only [cantorBendixsonRank_eq] using hs.2 + rw [hzero, map_zero] + obtain ⟨yδ, hyδ⟩ := + (DirectSum.mem_rangeLof_iff K (ν).Component (δ + 1) y).mp hy + rw [DirectSum.lof_eq_of] at hyδ + have hcomp : (ν).componentMk (δ + 1) p = yδ := by + apply cantorBendixsonGradedDerivation_injective_on_successor δ + calc + cantorBendixsonGradedDerivation + (DirectSum.of (ν).Component (δ + 1) ((ν).componentMk (δ + 1) p)) = + cantorBendixsonGradedDerivation y := hDxy + _ = cantorBendixsonGradedDerivation + (DirectSum.of (ν).Component (δ + 1) yδ) := + congrArg cantorBendixsonGradedDerivation hyδ.symm + rw [hcomp, hyδ] + exact Ideal.sum_mem _ fun j _ ↦ + Ideal.mul_mem_right _ _ (Ideal.subset_span ⟨j, rfl⟩) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationSet.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationSet.lean new file mode 100644 index 0000000000..51aca68be1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationSet.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationIdeal +public import + LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolationOnSets + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Prescribing a derivative germ on a discrete set of exponents + +The graded derivative of a class of successor degree is the germ of a function supported on the +exact-rank level of a representative. Conversely a function supported on any discrete set of +nonpositive exponents, with homogeneous values of one fixed degree, is such a germ. + +This is the integration theorem for a discrete set of cutoffs, stated in the associated graded +ring rather than in one component, which is the form required by the syzygy induction. +-/ + +universe u v w + +open scoped NatOrdinal Topology + +open Filter Set HahnSeries + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [Field K] [CharZero K] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := K)) + +open Classical in +/-- **A function supported on a discrete set is a derivative germ.** Prescribed homogeneous values +of degree `ρ` at the points of a discrete set of nonpositive exponents, whose closure adds nothing +near zero, are the graded derivative of a class of degree `ρ + 1`. -/ +@[blueprint "lem:prescribed-cantor-bendixson-derivative-discrete-set" + (phase := "Algebraic independence in graded rings") + (title := "Prescribing the Cantor--Bendixson derivative on a discrete set") + (statement := /-- + Let $K$ be a field of characteristic zero and $G$ a nontrivial complete + ordered abelian group with compatible additive uniformity and order + topology. Write $\nu$ for the Cantor--Bendixson degree on + $K((G^{\leq 0}))$. Suppose $S\subseteq G^{\leq0}$ is partially well + ordered and discrete, and that $\overline S\subseteq S$ on some left + neighbourhood of $0$. If every $a(\gamma)$ is homogeneous of degree + $\rho$ in $\operatorname{gr}_\nu$, then there is a homogeneous + $s\in\operatorname{gr}_\nu$ of degree $\rho+1$ whose + Cantor--Bendixson derivative agrees near $0$ with + \[ + \gamma\longmapsto + \begin{cases}a(\gamma),&\gamma\in S,\\0,&\gamma\notin S. + \end{cases} + \] + -/) + (proof := /-- + Regard each prescribed value as an element of the degree-$\rho$ + component. Discreteness supplies pairwise separated left intervals about + the points of $S$. Place a representative of $a(\gamma)$ in the interval + ending at $\gamma$ and sum the resulting Hahn series. Partial + well-ordering makes the family summable. Because the closure of $S$ adds + no points near $0$, translated truncation at a point of $S$ recovers the + prescribed class and gives zero elsewhere. The resulting series has + degree at most $\rho+1$, and its degree-$(\rho+1)$ class is the required + $s$ by + \ref{lem:cantor-bendixson-derivation-successor-formula}. + -/)] +theorem exists_derivation_eq_of_isDiscrete (ρ : NatOrdinal.{u}) (S : Set G) + (hSneg : S ⊆ Iic 0) (hSpwo : (Set.univ : Set ↥S).IsPWO) (hSdisc : IsDiscrete S) + (hnear : ∀ᶠ γ in 𝓝[<] (0 : G), γ ∈ closure S → γ ∈ S) + (a : G → (ν).AssociatedGraded) + (ha : ∀ γ, a γ ∈ DirectSum.rangeLof K (ν).Component ρ) : + ∃ s : (ν).AssociatedGraded, s ∈ DirectSum.rangeLof K (ν).Component (ρ + 1) ∧ + cantorBendixsonGradedDerivation s = + ((fun γ ↦ if γ ∈ S then a γ else 0) : + Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) := by + classical + -- the prescribed values, as elements of the component + have hcomp : ∀ i : ↥S, ∃ y : (ν).Component ρ, + DirectSum.of (ν).Component ρ y = a (i : G) := by + intro i + obtain ⟨y, hy⟩ := (DirectSum.mem_rangeLof_iff K (ν).Component ρ (a (i : G))).mp (ha (i : G)) + exact ⟨y, by simpa only [DirectSum.lof_eq_of] using hy⟩ + choose y hy using hcomp + obtain ⟨c, hc, -, hderiv⟩ := + exists_prescribed_components_on_set_of_isDiscrete ρ S hSneg hSpwo hSdisc hnear y + refine ⟨(ν).homogeneousMk (ρ + 1) ⟨c, ((ν).mem_filtrationLE_iff (ρ + 1) c).mpr hc⟩, ?_, ?_⟩ + · rw [(ν).homogeneousMk_apply] + exact DirectSum.of_mem_rangeLof K (ν).Component (ρ + 1) _ + · rw [cantorBendixsonGradedDerivation_homogeneousMk_succ ρ rfl] + calc + ((fun γ ↦ DirectSum.of (ν).Component ρ (cantorBendixsonDerivAt ρ c γ)) : + Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) = + Filter.Germ.mapLinear (DirectSum.of (ν).Component ρ).toIntLinearMap + (cantorBendixsonLayerDeriv ρ + ((ν).componentMk (ρ + 1) + ⟨c, ((ν).mem_filtrationLE_iff (ρ + 1) c).mpr hc⟩)) := by + rw [cantorBendixsonLayerDeriv_componentMk, Filter.Germ.mapLinear_coe] + rfl + _ = Filter.Germ.mapLinear (DirectSum.of (ν).Component ρ).toIntLinearMap + (((fun γ ↦ if h : γ ∈ S then y ⟨γ, h⟩ else 0) : + Filter.Germ (𝓝[<] (0 : G)) ((ν).Component ρ))) := congrArg _ hderiv + _ = _ := by + rw [Filter.Germ.mapLinear_coe, Filter.Germ.coe_eq] + refine Filter.Eventually.of_forall fun γ ↦ ?_ + by_cases hγ : γ ∈ S + · simp only [dif_pos hγ, if_pos hγ, Function.comp_apply] + exact hy ⟨γ, hγ⟩ + · simp only [dif_neg hγ, if_neg hγ, Function.comp_apply, map_zero] + +end HahnSeries.Nonpositive + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Derivative.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Derivative.lean new file mode 100644 index 0000000000..3067d86243 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Derivative.lean @@ -0,0 +1,441 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Graded +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTermSup +public import Mathlib.Order.Filter.Germ.Basic +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood + +/-! +# Translated truncation from degree `α + 1` to degree `α` + +Translated weak truncation induces an additive map from the homogeneous component of degree +`α + 1` to germs, at negative cutoffs approaching zero, of the component of degree `α`. +The strict drop in Cantor–Bendixson rank makes the map independent of representatives. Local rank +reconstruction proves injectivity: eventual disappearance in the lower component forces the +original representative into the strict filtration. + +The exponent group retains its ordered uniform structure, assumed Cauchy complete, in any +universe; no Archimedean or countability hypothesis is imposed. The map is additive here. Scalar +linearity and a product rule are separate assertions, not consequences of injectivity alone. +-/ + +public noncomputable section +open Set Filter Topology +open scoped NatOrdinal +universe u v +namespace HahnSeries.Nonpositive +variable {G : Type u} {R : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [CommRing R] + +/-- Weak truncation at a cutoff, translated to exponent zero, as an additive endomorphism. -/ +def translatedTruncLE (γ : G) : Nonpositive G R →+ Nonpositive G R where + toFun b := ⟨translate (-γ) (truncLE γ (b : HahnSeries G R)), support_translated_truncLE _ _⟩ + map_zero' := by apply Subtype.ext; simp + map_add' b c := by + apply Subtype.ext + change translate (-γ) (truncLE γ ((b : HahnSeries G R) + (c : HahnSeries G R))) = _ + rw [truncLE_add, map_add] + rfl + +/-- The underlying Hahn series of the translated weak truncation. -/ +@[simp] +theorem coe_translatedTruncLE (γ : G) (b : Nonpositive G R) : + (translatedTruncLE γ b : HahnSeries G R) = translate (-γ) (truncLE γ b) := (rfl) + +/-- At cutoff zero the translated weak truncation is the identity. -/ +@[simp] +theorem translatedTruncLE_zero (b : Nonpositive G R) : translatedTruncLE (0 : G) b = b := by + apply Subtype.ext + rw [coe_translatedTruncLE, neg_zero, translate_zero_apply, + truncLE_eq_self_of_support_subset_Iic b.property] + +variable [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [NoZeroDivisors R] [CharZero R] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := R)) + +private theorem degree_lt_succ_iff (d : WithBot NatOrdinal.{u}) (α : NatOrdinal.{u}) : + d < (↑(α + 1) : WithBot NatOrdinal) ↔ d ≤ α := by + cases d using WithBot.recBotCoe with + | bot => simp + | coe d => + rw [WithBot.coe_lt_coe, WithBot.coe_le_coe] + exact Order.lt_add_one_iff + +open Classical in +/-- The degree of a translated weak truncation is the Cantor–Bendixson rank at its cutoff, and +bottom away from the closed support. -/ +theorem degree_translatedTruncLE_eq (b : Nonpositive G R) (γ : G) : + ν (translatedTruncLE γ b) = + if γ ∈ (b : HahnSeries G R).closedSupport then + (NatOrdinal.of ((b : HahnSeries G R).cantorBendixsonRank γ) : WithBot NatOrdinal) + else ⊥ := by + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + coe_translatedTruncLE, HahnSeries.cantorBendixsonValue_translated_truncLE] + by_cases hm : γ ∈ (b : HahnSeries G R).closedSupport + · simp only [if_pos hm, NatOrdinal.of_omega0_opow, NatOrdinal.cantorDegree_wpow] + · simp only [if_neg hm, NatOrdinal.of_zero, NatOrdinal.cantorDegree_zero] + +/-- Translated truncations have degree strictly below any bound for the original degree, +at all sufficiently close negative cutoffs. -/ +theorem eventually_degree_translatedTruncLE_lt (b : Nonpositive G R) (α : NatOrdinal.{u}) + (hb : ν b ≤ α) : + ∀ᶠ γ in 𝓝[<] (0 : G), ν (translatedTruncLE γ b) < α := by + classical + by_cases hmem : 0 ∈ (b : HahnSeries G R).closedSupport + · have hbr : NatOrdinal.of ((b : HahnSeries G R).cantorBendixsonRank 0) ≤ α := by + rwa [cantorBendixsonDegreeValuation_of_mem _ hmem, WithBot.coe_le_coe] at hb + have hv : (b : HahnSeries G R).cantorBendixsonValue ≠ 0 := by + rw [cantorBendixsonValue_of_mem _ ((mem_closedSupport _ _).mp hmem)] + exact Ordinal.opow_ne_zero _ Ordinal.omega0_ne_zero + have hcut := ((b : HahnSeries G R).eventually_value_translated_truncLE_lt hv).filter_mono + (nhdsWithin_le_nhds (s := Iio (0 : G))) + filter_upwards [hcut, self_mem_nhdsWithin] with γ hγ hγ0 + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + NatOrdinal.cantorDegree_lt_coe_iff, coe_translatedTruncLE] + have h := NatOrdinal.of.strictMono (hγ (ne_of_lt hγ0)) + rw [cantorBendixsonValue_of_mem _ ((mem_closedSupport _ _).mp hmem), + NatOrdinal.of_omega0_opow] at h + exact h.trans_le (NatOrdinal.wpow_le_wpow.mpr hbr) + · have hnh : ((b : HahnSeries G R).closedSupport : Set G)ᶜ ∈ 𝓝 (0 : G) := + (b : HahnSeries G R).closedSupport.isClosed.isOpen_compl.mem_nhds hmem + filter_upwards [nhdsWithin_le_nhds hnh] with γ hγ + change γ ∉ (b : HahnSeries G R).closedSupport at hγ + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + coe_translatedTruncLE, cantorBendixsonValue_translated_truncLE, if_neg hγ, + NatOrdinal.of_zero, NatOrdinal.cantorDegree_zero] + exact WithBot.bot_lt_coe α + +/-- A successor-degree representative has translated truncations in the preceding weak +filtration near zero. -/ +theorem eventually_degree_translatedTruncLE_le (b : Nonpositive G R) (α : NatOrdinal.{u}) + (hb : ν b ≤ (α + 1 : NatOrdinal)) : + ∀ᶠ γ in 𝓝[<] (0 : G), ν (translatedTruncLE γ b) ≤ α := + (eventually_degree_translatedTruncLE_lt b (α + 1) hb).mono fun _ h ↦ + (degree_lt_succ_iff _ _).mp h + +/-- Vanishing of the lower-rank truncations forces a successor representative into the +strict filtration. -/ +theorem degree_lt_succ_of_eventually_translatedTruncLE_lt (b : Nonpositive G R) + (α : NatOrdinal.{u}) (hb : ν b ≤ (α + 1 : NatOrdinal)) + (hcut : ∀ᶠ γ in 𝓝[<] (0 : G), ν (translatedTruncLE γ b) < α) : + ν b < (α + 1 : NatOrdinal) := by + classical + by_contra hlt + have he : ν b = (α + 1 : NatOrdinal) := hb.antisymm (not_lt.mp hlt) + have hmem : 0 ∈ (b : HahnSeries G R).closedSupport := by + by_contra hn + have hz : ν b = ⊥ := by + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + cantorBendixsonValue_of_notMem _ (by simpa only [mem_closedSupport] using hn), + NatOrdinal.of_zero, NatOrdinal.cantorDegree_zero] + rw [hz] at he + exact WithBot.bot_ne_coe he + have hr : (b : HahnSeries G R).cantorBendixsonRank 0 = α.val + 1 := by + rw [cantorBendixsonDegreeValuation_of_mem _ hmem, WithBot.coe_eq_coe] at he + have h := congrArg NatOrdinal.val he + simpa only [NatOrdinal.val_of, NatOrdinal.val_add_one] using h + have hv : (b : HahnSeries G R).cantorBendixsonValue = + Ordinal.omega0 ^ (α.val + 1) := by + rw [cantorBendixsonValue_of_mem _ ((mem_closedSupport _ _).mp hmem), hr] + have h := cantorBendixsonValue_reconstruction (b : HahnSeries G R) 0 b.property + α.val 0 1 zero_lt_one hv (by + filter_upwards [hcut] with γ hγ heγ + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + coe_translatedTruncLE, heγ, NatOrdinal.of_omega0_opow, NatOrdinal.of_val, + NatOrdinal.cantorDegree_wpow] at hγ + exact (lt_irrefl _ hγ).elim) + rw [cantorBendixsonValue_zero, zero_add, Ordinal.opow_one] at h + exact (not_le_of_gt Ordinal.omega0_pos) h + +open Classical in +/-- The lower homogeneous class of the translated truncation, with zero outside its domain. +For a successor-filtered input this convention is immaterial in the left filter germ. -/ +def cantorBendixsonDerivAt (α : NatOrdinal.{u}) (b : Nonpositive G R) (γ : G) : (ν).Component α := + if h : ν (translatedTruncLE γ b) ≤ α then + (ν).componentMk α ⟨translatedTruncLE γ b, ((ν).mem_filtrationLE_iff _ _).mpr h⟩ + else 0 + +/-- Within the lower weak filtration, the derivative value is the homogeneous quotient class. -/ +theorem cantorBendixsonDerivAt_eq (α : NatOrdinal.{u}) (b : Nonpositive G R) (γ : G) + (h : ν (translatedTruncLE γ b) ≤ α) : + cantorBendixsonDerivAt α b γ = + (ν).componentMk α ⟨translatedTruncLE γ b, ((ν).mem_filtrationLE_iff _ _).mpr h⟩ := by + rw [cantorBendixsonDerivAt, dif_pos h] + +/-- Under the successor-filtration bound, the pointwise derivative is nonzero exactly at the +points of the representative's closed support having the prescribed Cantor–Bendixson rank. -/ +theorem cantorBendixsonDerivAt_ne_zero_iff (α : NatOrdinal.{u}) + (b : Nonpositive G R) (γ : G) (h : ν (translatedTruncLE γ b) ≤ α) : + cantorBendixsonDerivAt α b γ ≠ 0 ↔ + γ ∈ (b : HahnSeries G R).closedSupport ∧ + (b : HahnSeries G R).cantorBendixsonRank γ = α.val := by + classical + rw [cantorBendixsonDerivAt_eq α b γ h, ne_eq, (ν).componentMk_eq_zero_iff, + not_lt] + have hdegree := degree_translatedTruncLE_eq b γ + rw [hdegree] + by_cases hm : γ ∈ (b : HahnSeries G R).closedSupport + · rw [if_pos hm, WithBot.coe_le_coe] + constructor + · intro hle + refine ⟨hm, ?_⟩ + have heq : NatOrdinal.of ((b : HahnSeries G R).cantorBendixsonRank γ) = α := + le_antisymm (by simpa only [hdegree, if_pos hm, WithBot.coe_le_coe] using h) hle + have := congrArg NatOrdinal.val heq + simpa only [NatOrdinal.val_of] using this + · rintro ⟨_, hr⟩ + rw [hr, NatOrdinal.of_val] + · rw [if_neg hm] + exact ⟨fun hbot ↦ ((not_le_of_gt (WithBot.bot_lt_coe α)) hbot).elim, + fun hmem ↦ (hm hmem.1).elim⟩ + +/-- A derivative-stage point has exact rank when its translated truncation lies in the +corresponding weak filtration. -/ +theorem cantorBendixsonRank_eq_of_mem_derivative_of_degree_translatedTruncLE_le + (α : NatOrdinal.{u}) (b : Nonpositive G R) (γ : G) + (hm : γ ∈ (b : HahnSeries G R).closedSupport) + (hr : α.val ≤ (b : HahnSeries G R).cantorBendixsonRank γ) + (h : ν (translatedTruncLE γ b) ≤ α) : + (b : HahnSeries G R).cantorBendixsonRank γ = α.val := by + have hzero : 0 ∈ (translatedTruncLE γ b : Nonpositive G R).1.closedSupport := by + have ht := ((truncLE γ (b : HahnSeries G R)).mem_closedSupport_translate (-γ) γ).mpr + ((b : HahnSeries G R).mem_closedSupport_truncLE γ |>.mpr hm) + simpa only [coe_translatedTruncLE, neg_add_cancel] using ht + rw [cantorBendixsonDegreeValuation_of_mem (translatedTruncLE γ b) hzero, + WithBot.coe_le_coe] at h + have hval := NatOrdinal.of.symm.monotone h + change NatOrdinal.val + (NatOrdinal.of ((translatedTruncLE γ b : Nonpositive G R).1.cantorBendixsonRank 0)) ≤ + NatOrdinal.val α at hval + rw [NatOrdinal.val_of] at hval + have hsr : ((translatedTruncLE γ b : Nonpositive G R).1).cantorBendixsonRank 0 = + (b : HahnSeries G R).cantorBendixsonRank γ := by + simpa only [coe_translatedTruncLE] using + (b : HahnSeries G R).cantorBendixsonRank_translated_truncLE γ + rw [hsr] at hval + exact hval.antisymm hr + +private theorem eventually_derivAt_add (α : NatOrdinal.{u}) (b c : Nonpositive G R) + (hb : ν b ≤ (α + 1 : NatOrdinal)) (hc : ν c ≤ (α + 1 : NatOrdinal)) : + ∀ᶠ γ in 𝓝[<] (0 : G), cantorBendixsonDerivAt α (b + c) γ = + cantorBendixsonDerivAt α b γ + cantorBendixsonDerivAt α c γ := by + have hbc : ν (b + c) ≤ (α + 1 : NatOrdinal) := + ((ν).map_add_le_max b c).trans (max_le hb hc) + filter_upwards [eventually_degree_translatedTruncLE_le b α hb, + eventually_degree_translatedTruncLE_le c α hc, + eventually_degree_translatedTruncLE_le (b + c) α hbc] with γ hbg hcg hbcg + rw [cantorBendixsonDerivAt_eq _ _ _ hbg, cantorBendixsonDerivAt_eq _ _ _ hcg, + cantorBendixsonDerivAt_eq _ _ _ hbcg, ← map_add] + apply congrArg ((ν).componentMk α) + apply Subtype.ext + exact map_add (translatedTruncLE γ) b c + +private def filtrationDeriv (α : NatOrdinal.{u}) : + (ν).filtrationLE (α + 1) →+ Filter.Germ (𝓝[<] (0 : G)) ((ν).Component α) where + toFun b := ((fun γ ↦ cantorBendixsonDerivAt α (b : Nonpositive G R) γ) : + Filter.Germ (𝓝[<] (0 : G)) ((ν).Component α)) + map_zero' := by + rw [← Filter.Germ.coe_zero, Filter.Germ.coe_eq] + apply Filter.Eventually.of_forall + intro γ + have hzero : ν (translatedTruncLE γ 0) ≤ α := by simp + change cantorBendixsonDerivAt α 0 γ = 0 + rw [cantorBendixsonDerivAt_eq _ _ _ hzero, + (ν).componentMk_eq_zero_iff] + change ν (translatedTruncLE γ 0) < α + simp + map_add' b c := by + rw [← Filter.Germ.coe_add, Filter.Germ.coe_eq] + exact eventually_derivAt_add α (b : Nonpositive G R) (c : Nonpositive G R) + (((ν).mem_filtrationLE_iff _ _).mp b.property) + (((ν).mem_filtrationLE_iff _ _).mp c.property) + +private theorem lowerFiltration_le_filtrationDeriv_ker (α : NatOrdinal.{u}) : + (ν).lowerFiltration (α + 1) ≤ (filtrationDeriv (G := G) (R := R) α).ker := by + intro b hb + change (filtrationDeriv α) b = 0 + change ((fun γ ↦ cantorBendixsonDerivAt α (b : Nonpositive G R) γ) : + Filter.Germ (𝓝[<] (0 : G)) ((ν).Component α)) = 0 + rw [← Filter.Germ.coe_zero, Filter.Germ.coe_eq] + have hble : ν (b : Nonpositive G R) ≤ α := + (degree_lt_succ_iff _ _).mp (((ν).mem_lowerFiltration_iff _ _).mp hb) + filter_upwards [eventually_degree_translatedTruncLE_lt (b : Nonpositive G R) α hble] + with γ hγ + change cantorBendixsonDerivAt α (b : Nonpositive G R) γ = 0 + rw [cantorBendixsonDerivAt_eq _ _ _ hγ.le, (ν).componentMk_eq_zero_iff] + exact hγ + +/-- Translated weak truncation induces an additive map from each successor homogeneous +component to left filter germs in the preceding component. -/ +def cantorBendixsonLayerDeriv (α : NatOrdinal.{u}) : + (ν).Component (α + 1) →+ Filter.Germ (𝓝[<] (0 : G)) ((ν).Component α) := + QuotientAddGroup.lift ((ν).lowerFiltration (α + 1)) (filtrationDeriv α) + (lowerFiltration_le_filtrationDeriv_ker α) + +/-- The map from degree `α + 1` to degree `α` is represented by translated truncation of any +representative. -/ +theorem cantorBendixsonLayerDeriv_componentMk (α : NatOrdinal.{u}) + (b : (ν).filtrationLE (α + 1)) : + cantorBendixsonLayerDeriv α ((ν).componentMk (α + 1) b) = + ((fun γ ↦ cantorBendixsonDerivAt α (b : Nonpositive G R) γ) : + Filter.Germ (𝓝[<] (0 : G)) ((ν).Component α)) := by + rw [cantorBendixsonLayerDeriv, ← (ν).coe_component_eq_componentMk] + rfl + +/-- A successor homogeneous class is detected by its translated truncations near zero. -/ +theorem cantorBendixsonLayerDeriv_injective (α : NatOrdinal.{u}) : + Function.Injective (cantorBendixsonLayerDeriv (G := G) (R := R) α) := by + rw [injective_iff_map_eq_zero] + intro x hx + induction x using MaxAddDegree.componentInductionOn with + | H b => + rw [cantorBendixsonLayerDeriv_componentMk, ← Filter.Germ.coe_zero, + Filter.Germ.coe_eq] at hx + apply ((ν).componentMk_eq_zero_iff _ _).mpr + have hb := ((ν).mem_filtrationLE_iff _ _).mp b.property + apply degree_lt_succ_of_eventually_translatedTruncLE_lt (b : Nonpositive G R) α hb + filter_upwards [hx, eventually_degree_translatedTruncLE_le (b : Nonpositive G R) α hb] + with γ hγ hbound + change cantorBendixsonDerivAt α (b : Nonpositive G R) γ = 0 at hγ + rw [cantorBendixsonDerivAt_eq _ _ _ hbound, (ν).componentMk_eq_zero_iff] at hγ + exact hγ + +/-- **Exact lower-rank attainment.** If a series has degree exactly `α` at zero, then every +degree below `α` is attained exactly by its translated truncations at negative cutoffs +arbitrarily close to zero. Points of each lower exact rank are dense in the corresponding +derivative, and zero lies in that derivative without belonging to the level, so the level +accumulates at zero. No cofinal sequence of cutoffs is chosen. -/ +theorem exists_lt_and_degree_translatedTruncLE_eq (b : Nonpositive G R) (α ρ : NatOrdinal.{u}) + (hb : ν b = (α : WithBot NatOrdinal)) (hρα : ρ < α) {l : G} (hl : l < 0) : + ∃ γ : G, l < γ ∧ γ < 0 ∧ ν (translatedTruncLE γ b) = (ρ : WithBot NatOrdinal) := by + classical + have hmem : (0 : G) ∈ (b : HahnSeries G R).closedSupport := by + by_contra hn + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + cantorBendixsonValue_of_notMem _ (by simpa only [mem_closedSupport] using hn), + NatOrdinal.of_zero, NatOrdinal.cantorDegree_zero] at hb + exact WithBot.bot_ne_coe hb + have hrank : (b : HahnSeries G R).cantorBendixsonRank 0 = α.val := by + rw [cantorBendixsonDegreeValuation_of_mem b hmem, WithBot.coe_eq_coe] at hb + have h := congrArg NatOrdinal.val hb + simpa only [NatOrdinal.val_of] using h + have hρval : ρ.val < α.val := NatOrdinal.of.symm.strictMono hρα + have hrank' : ρ.val ≤ (b : HahnSeries G R).closedSupport.cantorBendixsonRank + (b : HahnSeries G R).closedSupport_isPWO 0 := by + rw [← cantorBendixsonRank_eq, hrank] + exact hρval.le + have h0mem : (0 : G) ∈ + ((b : HahnSeries G R).closedSupport.cantorBendixson ρ.val : Set G) := + ((b : HahnSeries G R).closedSupport.mem_cantorBendixson_iff + (b : HahnSeries G R).closedSupport_isPWO 0 ρ.val).mpr ⟨hmem, hrank'⟩ + have hclosure := (b : HahnSeries G R).closedSupport.closure_rank_level_eq + (b : HahnSeries G R).closedSupport_isPWO ρ.val + have h0cl : (0 : G) ∈ closure {x : G | x ∈ (b : HahnSeries G R).closedSupport ∧ + (b : HahnSeries G R).closedSupport.cantorBendixsonRank + (b : HahnSeries G R).closedSupport_isPWO x = ρ.val} := by + rw [hclosure] + exact h0mem + obtain ⟨p, hp⟩ := exists_ne (0 : G) + obtain ⟨e, he⟩ : ∃ e : G, 0 < e := by + rcases lt_or_gt_of_ne hp with h | h + · exact ⟨-p, neg_pos.mpr h⟩ + · exact ⟨p, h⟩ + obtain ⟨γ, hγmem, hγlevel⟩ := mem_closure_iff.mp h0cl (Ioo l e) isOpen_Ioo ⟨hl, he⟩ + have hγ0 : γ ≤ 0 := closure_minimal b.property isClosed_Iic + ((mem_closedSupport _ _).mp hγlevel.1) + have hrank0 : (b : HahnSeries G R).closedSupport.cantorBendixsonRank + (b : HahnSeries G R).closedSupport_isPWO 0 = α.val := + ((b : HahnSeries G R).cantorBendixsonRank_eq 0).symm.trans hrank + have hγne : γ ≠ 0 := by + intro h0 + rw [h0] at hγlevel + exact absurd (hrank0.symm.trans hγlevel.2) (ne_of_gt hρval) + refine ⟨γ, hγmem.1, lt_of_le_of_ne hγ0 hγne, ?_⟩ + rw [degree_translatedTruncLE_eq, if_pos hγlevel.1, cantorBendixsonRank_eq, hγlevel.2, + NatOrdinal.of_val] + +/-- Below a degree that is a limit ordinal, no eventual bound on the truncation degrees holds: +attainment at the +successor of any proposed bound refutes it. -/ +theorem not_forall_degree_translatedTruncLE_le (b : Nonpositive G R) (α β : NatOrdinal.{u}) + (hb : ν b = (α : WithBot NatOrdinal)) (hβα : (β + 1 : NatOrdinal) < α) {l : G} (hl : l < 0) : + ¬ ∀ γ : G, l < γ → γ < 0 → ν (translatedTruncLE γ b) ≤ (β : WithBot NatOrdinal) := by + intro hbound + obtain ⟨γ, hlγ, hγ0, hγeq⟩ := + exists_lt_and_degree_translatedTruncLE_eq b α (β + 1) hb hβα hl + have hle := hbound γ hlγ hγ0 + rw [hγeq, WithBot.coe_le_coe] at hle + exact absurd hle (not_le_of_gt (lt_add_one β)) + +/-- **Proper cutoffs bound the degree at zero.** If every translated truncation at a strictly +negative cutoff has degree at most `τ`, then the series has degree at most `τ + 1`. The stage +`τ + 1` of the closed support meets only zero, so the next stage is empty. -/ +theorem degree_le_add_one_of_forall_neg_le (b : Nonpositive G R) (τ : NatOrdinal.{u}) + (h : ∀ y : G, y < 0 → ν (translatedTruncLE y b) ≤ (τ : WithBot NatOrdinal)) : + ν b ≤ ((τ + 1 : NatOrdinal) : WithBot NatOrdinal) := by + classical + have hstage : ((b : HahnSeries G R).closedSupport.cantorBendixson (τ.val + 1) : Set G) ⊆ + {0} := by + intro z hz + obtain ⟨hzs, hzr⟩ := ((b : HahnSeries G R).mem_support_derivative_iff z (τ.val + 1)).mp hz + have hz0 : z ≤ 0 := closure_minimal b.property isClosed_Iic hzs + rcases eq_or_lt_of_le hz0 with hz0' | hzneg + · exact Set.mem_singleton_iff.mpr hz0' + · exfalso + have hmem : z ∈ (b : HahnSeries G R).closedSupport := (mem_closedSupport _ _).mpr hzs + have hd := h z hzneg + rw [degree_translatedTruncLE_eq, if_pos hmem, WithBot.coe_le_coe] at hd + have hval := NatOrdinal.of.symm.monotone hd + change NatOrdinal.val (NatOrdinal.of ((b : HahnSeries G R).cantorBendixsonRank z)) ≤ + NatOrdinal.val τ at hval + rw [NatOrdinal.val_of] at hval + exact absurd hzr (not_le_of_gt (lt_of_le_of_lt hval (lt_add_one τ.val))) + have hnext : ((b : HahnSeries G R).closedSupport.cantorBendixson ((τ.val + 1) + 1) : + Set G) = ∅ := by + rw [TopologicalSpace.Closeds.cantorBendixson_add_one] + apply Set.eq_empty_iff_forall_notMem.mpr + intro z hz + rw [TopologicalSpace.Closeds.coe_derived, mem_derivedSet] at hz + exact (Set.finite_singleton (0 : G)).not_infinite + (Set.Infinite.of_accPt (hz.mono (Filter.principal_mono.mpr hstage))) + by_cases hm : 0 ∈ (b : HahnSeries G R).closedSupport + · rw [cantorBendixsonDegreeValuation_of_mem b hm, WithBot.coe_le_coe] + have hrank : (b : HahnSeries G R).cantorBendixsonRank 0 ≤ τ.val + 1 := by + rw [cantorBendixsonRank_eq] + apply TopologicalSpace.Closeds.cantorBendixsonRank_le_of_notMem _ _ 0 + rw [hnext] + exact Set.notMem_empty 0 + have h := NatOrdinal.of.monotone hrank + rw [← NatOrdinal.val_add_one, NatOrdinal.of_val] at h + exact h + · rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + cantorBendixsonValue_of_notMem _ (by simpa only [mem_closedSupport] using hm), + NatOrdinal.of_zero, NatOrdinal.cantorDegree_zero] + exact bot_le + +/-- **No uniform degree bound below a nonzero degree.** Let a series have degree exactly `lam`, +and let `sigma` be zero or have every Cantor term at least the last Cantor term of `lam`. Then no +bound strictly below `lam ⊕ sigma` dominates `ν(u^{|γ}) ⊕ sigma` on any left interval: the +ordinal approach lemma produces a degree below `lam` whose shift already reaches the proposed +bound, and exact lower-rank attainment realizes that degree at a cutoff inside the interval. + +This is the obstruction used when the leading-coefficient degree has the required least term. -/ +theorem not_forall_add_lt_of_degree_eq (b : Nonpositive G R) (lam sigma bound : NatOrdinal.{u}) + (hb : ν b = (lam : WithBot NatOrdinal)) (hlam : lam ≠ 0) + (hsigma : sigma = 0 ∨ NatOrdinal.leastTerm lam ≤ NatOrdinal.leastTerm sigma) + (hbound : bound < lam + sigma) {l : G} (hl : l < 0) : + ¬ ∀ γ : G, l < γ → γ < 0 → + ∀ ρ : NatOrdinal.{u}, ν (translatedTruncLE γ b) = (ρ : WithBot NatOrdinal) → + ρ + sigma < bound := by + intro hforall + obtain ⟨ρ, hρlam, hρbound⟩ := + NatOrdinal.exists_lt_le_add_of_lastCantorTerm_le hlam hsigma hbound + obtain ⟨γ, hlγ, hγ0, hγeq⟩ := exists_lt_and_degree_translatedTruncLE_eq b lam ρ hb hρlam hl + exact absurd (hforall γ hlγ hγ0 ρ hγeq) (not_lt.mpr hρbound) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Germ.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Germ.lean new file mode 100644 index 0000000000..a87a19a85e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Germ.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module +public import + LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValueMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalOrder +public import Mathlib.RingTheory.Valuation.Basic +public import Mathlib.RingTheory.Ideal.Quotient.Basic + +/-! +# Germs at zero and the Cantor–Bendixson valuation + +The Cantor–Bendixson value on nonpositive Hahn series is a Mathlib valuation with natural ordinal +values. Its support ideal consists exactly of series bounded strictly below exponent zero; +quotienting by that ideal therefore gives the ring of germs at zero. The valuation's prime +support makes this quotient a domain. + +The ordered exponent group is assumed Cauchy complete. The characteristic-zero domain hypotheses +are those of the multiplicativity theorem. A domain conclusion alone does not assert factor +primality or polynomiality of the germ ring. +-/ + +public noncomputable section +open Set +universe u v +namespace HahnSeries.Nonpositive +variable {G : Type u} {R : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [CommRing R] [NoZeroDivisors R] [CharZero R] + +/-- The natural-ordinal valuation given by the Cantor–Bendixson rank at zero. -/ +def cantorBendixsonValuation : Valuation (Nonpositive G R) NatOrdinal.{u} where + toFun b := NatOrdinal.of (b : HahnSeries G R).cantorBendixsonValue + map_zero' := congrArg NatOrdinal.of cantorBendixsonValue_zero + map_one' := by + apply congrArg NatOrdinal.of + exact cantorBendixsonValue_of_finite_of_coeff_ne_zero (1 : HahnSeries G R) + (by rw [support_one]; exact finite_singleton _) (by simp) + map_mul' b c := cantorBendixsonValue_mul _ _ b.property c.property + map_add_le_max' b c := by + rcases le_max_iff.mp ((b : HahnSeries G R).cantorBendixsonValue_add_le c) with h | h + · exact le_max_of_le_left (NatOrdinal.of.monotone h) + · exact le_max_of_le_right (NatOrdinal.of.monotone h) + +/-- Evaluation agrees with the Cantor–Bendixson value of the Hahn series. -/ +@[simp] +theorem cantorBendixsonValuation_apply (b : Nonpositive G R) : + cantorBendixsonValuation b = NatOrdinal.of (b : HahnSeries G R).cantorBendixsonValue := (rfl) + +/-- Vanishing in the valuation support means being bounded strictly below zero. -/ +theorem mem_cantorBendixsonValuation_supp (b : Nonpositive G R) : + b ∈ (cantorBendixsonValuation (G := G) (R := R)).supp ↔ + ∃ c < (0 : G), (b : HahnSeries G R).support ⊆ Iic c := by + rw [Valuation.mem_supp_iff, cantorBendixsonValuation_apply] + exact cantorBendixsonValue_eq_zero_iff_support_bounded_lt _ b.property + +/-- Two germs agree exactly when their representatives agree above some negative bound. -/ +theorem cantorBendixson_germ_eq_iff (b c : Nonpositive G R) : + Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp b = + Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp c ↔ + ∃ e < (0 : G), ∀ g > e, (b : HahnSeries G R).coeff g = (c : HahnSeries G R).coeff g := by + rw [Ideal.Quotient.eq, mem_cantorBendixsonValuation_supp] + constructor + · rintro ⟨e, he, hbc⟩ + refine ⟨e, he, fun g hg ↦ ?_⟩ + have hz : ((b - c : Nonpositive G R) : HahnSeries G R).coeff g = 0 := by + by_contra hn + exact (not_le_of_gt hg) (hbc hn) + change ((b : HahnSeries G R) - (c : HahnSeries G R)).coeff g = 0 at hz + simpa only [coeff_sub, sub_eq_zero] using hz + · rintro ⟨e, he, hbc⟩ + refine ⟨e, he, fun g hg ↦ ?_⟩ + apply le_of_not_gt + intro hge + have hz := hbc g hge + apply hg + change ((b : HahnSeries G R) - (c : HahnSeries G R)).coeff g = 0 + simpa only [coeff_sub, sub_eq_zero] using hz + +/-- A series representing a unit germ has nonzero coefficient at exponent zero. -/ +theorem constantCoeff_ne_zero_of_isUnit_cantorBendixson_germ + {b : Nonpositive G R} + (hb : IsUnit + (Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp b)) : + constantCoeff b ≠ 0 := by + let J := (cantorBendixsonValuation (G := G) (R := R)).supp + obtain ⟨q, hbq, _⟩ := isUnit_iff_exists.mp hb + obtain ⟨c, rfl⟩ := Ideal.Quotient.mk_surjective q + have heq : Ideal.Quotient.mk J (b * c) = Ideal.Quotient.mk J 1 := by + simpa only [map_mul, map_one] using hbq + obtain ⟨e, he, hcoeff⟩ := (cantorBendixson_germ_eq_iff (b * c) 1).mp heq + have hbc : constantCoeff b * constantCoeff c = 1 := by + have hbc' := hcoeff 0 he + rw [show ((b * c : Nonpositive G R) : HahnSeries G R).coeff 0 = + (b : HahnSeries G R).coeff 0 * (c : HahnSeries G R).coeff 0 from + coeff_zero_mul b c] at hbc' + simpa only [constantCoeff_apply, Subring.coe_one, HahnSeries.coeff_one, if_pos] using hbc' + intro hb0 + rw [hb0, zero_mul] at hbc + exact zero_ne_one hbc + +/-- The germ quotient by series bounded strictly below zero is a domain. -/ +theorem cantorBendixson_germ_isDomain : + IsDomain (Nonpositive G R ⧸ (cantorBendixsonValuation (G := G) (R := R)).supp) := + inferInstance + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/GlobalCofactors.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/GlobalCofactors.lean new file mode 100644 index 0000000000..1cda31db2d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/GlobalCofactors.lean @@ -0,0 +1,158 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Boundary +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation + +/-! +# Global cofactors from local data of fixed rank + +Consider a nonpositive Hahn series whose translated truncation at every nonpositive cutoff, +including zero, has degree at most `β`. Its exact rank-`β` cutoffs accumulate nowhere. Suppose a +finite family of homogeneous lifts is given, each with a degree bound and strictly smaller proper +translated truncations, and at every exact rank-`β` cutoff local cofactors are prescribed that +correct the truncation below degree `β`. Interpolating those local cofactors produces global +cofactors with the same pointwise degree bounds, whose combination with the lifts corrects the +series below degree `β` at every nonpositive cutoff simultaneously. The subtracted term is an exact +finite combination of the lifts, so this step preserves membership in the ideal they generate. +-/ + +public noncomputable section + +open Set Filter Topology +open scoped NatOrdinal + +universe u v w + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {R : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [CommRing R] [NoZeroDivisors R] [CharZero R] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := R)) + +open Classical in +/-- Local cofactors at every exact top-rank cutoff interpolate to global cofactors. They keep the +prescribed pointwise degree bounds, and subtracting their products with the generators leaves a +series whose translated truncations have degree strictly below `β` at every nonpositive cutoff, +including zero. -/ +theorem exists_forall_degree_translatedTruncLE_sub_sum_mul_lt (β : NatOrdinal.{u}) + {ι : Type w} [Fintype ι] (V : ι → Nonpositive G R) (ρ σ : ι → NatOrdinal.{u}) + (hgrade : ∀ j, ρ j + σ j ≤ β) + (hV : ∀ j, ν (V j) ≤ σ j) + (hVcut : ∀ j, ∀ x : G, x < 0 → ν (translatedTruncLE x (V j)) < σ j) + (u : Nonpositive G R) + (hu : ∀ x : G, x ≤ 0 → ν (translatedTruncLE x u) ≤ β) + (w : {x // x ∈ (u : HahnSeries G R).closedSupport ∧ + (u : HahnSeries G R).closedSupport.cantorBendixsonRank + (u : HahnSeries G R).closedSupport_isPWO x = β.val} → ι → Nonpositive G R) + (hw : ∀ i j, ν (w i j) ≤ ρ j) + (hcorr : ∀ i : {x // x ∈ (u : HahnSeries G R).closedSupport ∧ + (u : HahnSeries G R).closedSupport.cantorBendixsonRank + (u : HahnSeries G R).closedSupport_isPWO x = β.val}, + ν (translatedTruncLE (i : G) u - ∑ j, w i j * V j) < β) : + ∃ c : ι → Nonpositive G R, + (∀ j, ∀ x : G, x ≤ 0 → ν (translatedTruncLE x (c j)) ≤ ρ j) ∧ + ∀ x : G, x ≤ 0 → ν (translatedTruncLE x (u - ∑ j, c j * V j)) < β := by + classical + have hassemble : ∀ j : ι, ∃ c : Nonpositive G R, + (∀ i : {x // x ∈ (u : HahnSeries G R).closedSupport ∧ + (u : HahnSeries G R).closedSupport.cantorBendixsonRank + (u : HahnSeries G R).closedSupport_isPWO x = β.val}, + ν (translatedTruncLE (i : G) c - w i j) = ⊥) ∧ + ∀ y : G, y ≤ 0 → + ¬(y ∈ (u : HahnSeries G R).closedSupport ∧ + (u : HahnSeries G R).closedSupport.cantorBendixsonRank + (u : HahnSeries G R).closedSupport_isPWO y = β.val) → + ν (translatedTruncLE y c) < ρ j := fun j ↦ + exists_prescribed_truncations_on_topRankLevel β (ρ j) u hu (fun i ↦ w i j) (fun i ↦ hw i j) + choose c hcenter hnon using hassemble + have hcb : ∀ j, ∀ x : G, x ≤ 0 → ν (translatedTruncLE x (c j)) ≤ ρ j := by + intro j x hx + by_cases hxl : x ∈ (u : HahnSeries G R).closedSupport ∧ + (u : HahnSeries G R).closedSupport.cantorBendixsonRank + (u : HahnSeries G R).closedSupport_isPWO x = β.val + · have hsplit : translatedTruncLE x (c j) = + (translatedTruncLE x (c j) - w ⟨x, hxl⟩ j) + w ⟨x, hxl⟩ j := by abel + rw [hsplit] + refine ((ν).map_add_le_max _ _).trans (max_le ?_ (hw ⟨x, hxl⟩ j)) + rw [hcenter j ⟨x, hxl⟩] + exact bot_le + · exact (hnon j x hx hxl).le + have hbot : (⊥ : WithBot NatOrdinal.{u}) < (β : WithBot NatOrdinal) := WithBot.bot_lt_coe β + have hsep : ∀ j, ∀ θ, θ < σ j → ρ j + θ < β := by + intro j θ hθ + calc + ρ j + θ < ρ j + σ j := add_lt_add_of_le_of_lt le_rfl hθ + _ ≤ β := hgrade j + have hsep' : ∀ j, ∀ θ, θ < ρ j → σ j + θ < β := by + intro j θ hθ + calc + σ j + θ < σ j + ρ j := add_lt_add_of_le_of_lt le_rfl hθ + _ ≤ β := by rw [add_comm]; exact hgrade j + have hbound : ∀ j, ∀ x : G, x ≤ 0 → + ν (translatedTruncLE x (c j * V j) - translatedTruncLE x (c j) * V j) < β := by + intro j x hx + rcases eq_or_lt_of_le hx with hx0 | hxneg + · subst hx0 + simp only [translatedTruncLE_zero, sub_self, (ν).map_zero] + exact hbot + · apply degree_translatedTruncLE_mul_sub_mul_lt_of_pointwise_bounds (c j) (V j) + (ρ j) (σ j) β ?_ ?_ (hVcut j) (hsep j) hxneg + · simpa only [translatedTruncLE_zero] using hcb j 0 le_rfl + · exact fun y hy ↦ hcb j y hy.le + refine ⟨c, hcb, ?_⟩ + intro x hx + by_cases hxl : x ∈ (u : HahnSeries G R).closedSupport ∧ + (u : HahnSeries G R).closedSupport.cantorBendixsonRank + (u : HahnSeries G R).closedSupport_isPWO x = β.val + · have hkey : translatedTruncLE x (u - ∑ j, c j * V j) = + (translatedTruncLE x u - ∑ j, w ⟨x, hxl⟩ j * V j) + - (∑ j, (translatedTruncLE x (c j * V j) - translatedTruncLE x (c j) * V j)) + - (∑ j, (translatedTruncLE x (c j) - w ⟨x, hxl⟩ j) * V j) := by + rw [map_sub, map_sum] + simp only [sub_mul] + rw [Finset.sum_sub_distrib, Finset.sum_sub_distrib] + abel + rw [hkey] + refine ((ν).map_sub_le_max _ _).trans_lt (max_lt (((ν).map_sub_le_max _ _).trans_lt + (max_lt (hcorr ⟨x, hxl⟩) ?_)) ?_) + · exact (ν).map_sum_lt_of_forall_lt _ _ hbot fun j _ ↦ hbound j x hx + · apply (ν).map_sum_lt_of_forall_lt _ _ hbot + intro j _ + apply lt_of_le_of_lt _ hbot + have hmul := (ν).map_mul_le_add (translatedTruncLE x (c j) - w ⟨x, hxl⟩ j) (V j) + rw [hcenter j ⟨x, hxl⟩, WithBot.bot_add] at hmul + exact hmul + · have hu' : ν (translatedTruncLE x u) < β := by + by_cases hxm : x ∈ (u : HahnSeries G R).closedSupport + · refine lt_of_le_of_ne (hu x hx) ?_ + rw [degree_translatedTruncLE_eq, if_pos hxm] + intro he + apply hxl + refine ⟨hxm, ?_⟩ + have hval := congrArg NatOrdinal.val (WithBot.coe_injective he) + rw [NatOrdinal.val_of, cantorBendixsonRank_eq] at hval + exact hval + · rw [degree_translatedTruncLE_eq, if_neg hxm] + exact hbot + rw [map_sub, map_sum] + refine ((ν).map_sub_le_max _ _).trans_lt (max_lt hu' ?_) + apply (ν).map_sum_lt_of_forall_lt _ _ hbot + intro j _ + have hsplit : translatedTruncLE x (c j * V j) = + (translatedTruncLE x (c j * V j) - translatedTruncLE x (c j) * V j) + + translatedTruncLE x (c j) * V j := by abel + rw [hsplit] + refine ((ν).map_add_le_max _ _).trans_lt (max_lt (hbound j x hx) ?_) + rw [mul_comm] + exact degree_mul_lt_of_le_of_lt_of_separated (V j) (translatedTruncLE x (c j)) + (σ j) (ρ j) β (hV j) (hnon j x hx hxl) (hsep' j) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Graded.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Graded.lean new file mode 100644 index 0000000000..ca96090627 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Graded.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Germ +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Degree + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# The associated graded domain of the Cantor–Bendixson degree + +Taking Cantor degree of the Cantor–Bendixson valuation gives an additive degree with natural +ordinal addition. At zero in the closed support this degree is exactly the support's +Cantor--Bendixson rank; away from the closed support it is bottom. Its kernel is the ideal +of series bounded strictly below zero. + +The associated graded ring has no zero divisors by multiplicativity. The initial form of +one is nonzero, so this is a domain rather than a possibly trivial graded ring. The +construction retains the full ordered exponent group, assumed Cauchy complete, and the +hypotheses on the characteristic-zero coefficient domain. It supplies a graded domain, not a +polynomial presentation. +-/ + +public noncomputable section +open Set +open scoped NatOrdinal +universe u v +namespace HahnSeries.Nonpositive +variable {G : Type u} {R : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [CommRing R] [NoZeroDivisors R] [CharZero R] + +/-- The Cantor degree of the Cantor–Bendixson valuation, with bottom on series bounded below +zero. -/ +def cantorBendixsonDegreeValuation : MaxAddDegree (Nonpositive G R) NatOrdinal.{u} where + toFun b := NatOrdinal.cantorDegree (cantorBendixsonValuation b) + map_zero' := by rw [map_zero, NatOrdinal.cantorDegree_zero] + map_one_le_zero' := by + rw [map_one] + rw [NatOrdinal.cantorDegree_eq_ordinalCantorDegree, NatOrdinal.val_one] + exact Ordinal.cantorDegree_one.le + map_neg' b := by rw [Valuation.map_neg] + map_add_le_max' b c := by + simp only [NatOrdinal.cantorDegree_eq_ordinalCantorDegree] + rcases le_max_iff.mp (cantorBendixsonValuation.map_add b c) with h | h + · exact le_max_of_le_left (Ordinal.cantorDegree_mono h) + · exact le_max_of_le_right (Ordinal.cantorDegree_mono h) + map_mul_le_add' b c := by + rw [map_mul, NatOrdinal.cantorDegree_mul] + +/-- Evaluation uses the Cantor degree of the Cantor–Bendixson value. -/ +@[simp] +theorem cantorBendixsonDegreeValuation_apply (b : Nonpositive G R) : + cantorBendixsonDegreeValuation b = + NatOrdinal.cantorDegree (cantorBendixsonValuation b) := (rfl) + +/-- The Cantor--Bendixson degree is multiplicative. -/ +@[blueprint "thm:cantor-bendixson-degree-multiplicative" + (phase := "Cantor–Bendixson ranks of supports") + (title := "Multiplicativity of the Cantor--Bendixson degree") + (statement := /-- + Let $R$ be a characteristic-zero domain and let $G$ be a nontrivial + ordered abelian group equipped with a compatible additive uniformity and + its order topology. Assume that $G$ is Cauchy complete. For all + $b,c\in R((G^{\le0}))$, + \[ + \deg\bigl(V_{\mathrm{CB}}(bc)\bigr) + =\deg\bigl(V_{\mathrm{CB}}(b)\bigr) + \oplus\deg\bigl(V_{\mathrm{CB}}(c)\bigr), + \] + where $\deg$ is Cantor degree, with value $-\infty$ at $0$, and + $\oplus$ is Hessenberg's natural sum. + -/) + (proof := /-- + Take Cantor degree in + \ref{thm:cantor-bendixson-value-multiplicative}. Cantor degree sends + Hessenberg's natural product to Hessenberg's natural sum. + -/)] +theorem cantorBendixsonDegreeValuation_mul (b c : Nonpositive G R) : + cantorBendixsonDegreeValuation (b * c) = + cantorBendixsonDegreeValuation b + cantorBendixsonDegreeValuation c := by + simp only [cantorBendixsonDegreeValuation_apply, map_mul, NatOrdinal.cantorDegree_mul] + +instance : (cantorBendixsonDegreeValuation (G := G) (R := R)).IsMultiplicative := by + constructor + exact cantorBendixsonDegreeValuation_mul + +/-- At a closed-support point zero, the degree is precisely its Cantor--Bendixson rank. -/ +theorem cantorBendixsonDegreeValuation_of_mem (b : Nonpositive G R) + (hb : 0 ∈ (b : HahnSeries G R).closedSupport) : + cantorBendixsonDegreeValuation b = + (NatOrdinal.of ((b : HahnSeries G R).cantorBendixsonRank 0) : WithBot NatOrdinal) := by + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + cantorBendixsonValue_of_mem _ ((mem_closedSupport _ _).mp hb), + NatOrdinal.of_omega0_opow, NatOrdinal.cantorDegree_wpow] + +/-- The bottom degree is exactly the ideal defining germs at zero. -/ +theorem cantorBendixsonDegreeValuation_eq_bot_iff (b : Nonpositive G R) : + cantorBendixsonDegreeValuation b = ⊥ ↔ + ∃ c < (0 : G), (b : HahnSeries G R).support ⊆ Iic c := by + rw [cantorBendixsonDegreeValuation_apply, NatOrdinal.cantorDegree_eq_bot, + ← Valuation.mem_supp_iff, mem_cantorBendixsonValuation_supp] + +/-- The associated graded ring for the Cantor–Bendixson degree is a domain. -/ +theorem cantorBendixson_associatedGraded_isDomain : + IsDomain + (cantorBendixsonDegreeValuation (G := G) (R := R)).AssociatedGraded := by + let ν := cantorBendixsonDegreeValuation (G := G) (R := R) + have h1 : ν 1 ≠ ⊥ := by + rw [cantorBendixsonDegreeValuation_apply, map_one, ne_eq, NatOrdinal.cantorDegree_eq_bot] + exact one_ne_zero + letI : Nontrivial ν.AssociatedGraded := + ⟨⟨ν.initialForm 1, 0, ν.initialForm_ne_zero_of_ne_bot h1⟩⟩ + exact NoZeroDivisors.to_isDomain ν.AssociatedGraded + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LeadingCoefficient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LeadingCoefficient.lean new file mode 100644 index 0000000000..4ac9be0420 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LeadingCoefficient.lean @@ -0,0 +1,244 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalEvaluation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationPolynomial +public import + LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.ScalarLeadingCoefficientAtLimitOrdinal + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Leading coefficients when the degree is a limit ordinal + +The polynomial of each proper translated truncation is read through the finite convolution +formula. Its highest coefficient in a maximal variable is the polynomial of the corresponding +truncation of the leading coefficient. The uniform degree drop for the evaluated relation then +contradicts the degrees of sufficiently late translated truncations of that coefficient. + +If the leading coefficient is a scalar, the coefficient one below the top instead combines with +the derivative contribution from the leading power. That branch is proved separately and joined +to the nonconstant branch here. +-/ + +universe u v w + +open scoped NatOrdinal Topology + +open Filter MvPolynomial HahnSeries HahnSeries.Nonpositive + +public noncomputable section + +namespace HahnSeries.Germ + +variable {G : Type u} {K : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [Field K] [CharZero K] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := K)) + +variable {ι : Type w} {wt : ι → NatOrdinal.{u}} + {xg : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded} +variable (σ : LiftFamily wt xg) +variable (hx : OrdinalGraded.IsMinimalSystem + (DirectSum.rangeLof K (cantorBendixsonDegreeValuation (G := G) (R := K)).Component) wt xg) + +include hx in +open Classical in +/-- A homogeneous relation is impossible when its leading coefficient has nonzero weighted +degree and the least Cantor term of that degree precedes the least term of the maximal weight. -/ +theorem false_of_aeval_eq_zero_of_leastTerm_le_of_ne_zero + (hσ : LiftFamily.HasLowerTruncationDegrees σ) {α : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + {F : MvPolynomial ι K} (hF : IsWeightedHomogeneous wt F α) + (hF0 : aeval xg F = 0) {B₀ : ι} (hB₀ : B₀ ∈ F.vars) + (hmax : ∀ i ∈ F.vars, wt i ≤ wt B₀) (hg : wt B₀ < α) + {degHD : NatOrdinal.{u}} (hdegHD : degHD + degreeOf B₀ F • wt B₀ = α) + (hdegHD0 : degHD ≠ 0) + (hcase : NatOrdinal.leastTerm degHD ≤ NatOrdinal.leastTerm (wt B₀)) : False := by + classical + obtain ⟨D, hDdef⟩ : ∃ D, degreeOf B₀ F = D := ⟨_, rfl⟩ + rw [hDdef] at hdegHD + have hD : 1 ≤ D := by + rw [← hDdef] + exact Nat.one_le_iff_ne_zero.mpr (mem_vars_iff_degreeOf_ne_zero.mp hB₀) + have hFkmem : ∀ k, xCoeff B₀ k F ∈ supported K {B₀}ᶜ := fun k ↦ + xCoeff_mem_supported B₀ k F + have hFkvars : ∀ k, ∀ i ∈ (xCoeff B₀ k F).vars, wt i ≤ wt B₀ := fun k i hi ↦ + hmax i (vars_xCoeff_subset B₀ k F hi) + have hαk : ∀ k ≤ D, (degHD + (D - k) • wt B₀) + k • wt B₀ = α := by + intro k hk + rw [add_assoc, ← add_nsmul, Nat.sub_add_cancel hk] + exact hdegHD + have hFkhom : ∀ k ≤ D, + IsWeightedHomogeneous wt (xCoeff B₀ k F) (degHD + (D - k) • wt B₀) := + fun k hk ↦ xCoeff_isWeightedHomogeneous' B₀ wt hF k (hαk k hk) + have hαklt : ∀ k, 1 ≤ k → k ≤ D → degHD + (D - k) • wt B₀ < α := by + intro k hk1 hk + rw [← hαk k hk] + exact lt_add_of_pos_right _ + (pos_iff_ne_zero.mpr (NatOrdinal.nsmul_ne_zero_of_ne_zero (hx.ne_zero B₀) hk1)) + have hFne : F ≠ 0 := by + rintro rfl + simp at hB₀ + have hFD : xCoeff B₀ D F ≠ 0 := by + rw [← hDdef] + exact xCoeff_degreeOf_ne_zero B₀ hFne + have hFDhom : IsWeightedHomogeneous wt (xCoeff B₀ D F) degHD := by + have h := hFkhom D le_rfl + rwa [Nat.sub_self, zero_smul, add_zero] at h + have hdegHDlt : degHD < α := by + have h := hαklt D hD le_rfl + rwa [Nat.sub_self, zero_smul, add_zero] at h + have hfree : LiftFamily.FreeOfVariable σ hx α B₀ + (aeval σ.lift (xCoeff B₀ D F)) degHD := + LiftFamily.FreeOfVariable.aeval (σ := σ) (hx := hx) hσ hinj hg hFDhom hdegHDlt + (hFkmem D) (hFkvars D) + have hterm : ∀ k ≤ D, HasLowerTruncationDegree + (σ.lift B₀ ^ k * aeval σ.lift (xCoeff B₀ k F)) + (k • wt B₀ + (degHD + (D - k) • wt B₀)) := by + intro k hk + exact (((LiftFamily.hasLowerTruncationDegrees_iff σ).mp hσ B₀).pow k).mul rfl + (σ.hasLowerTruncationDegree_aeval hσ (hFkhom k hk)) + have hGexp : aeval σ.lift F = ∑ k ∈ Finset.range (D + 1), + σ.lift B₀ ^ k * aeval σ.lift (xCoeff B₀ k F) := by + conv_lhs => rw [← sum_xCoeff_mul_X_pow B₀ F] + rw [hDdef, map_sum] + refine Finset.sum_congr rfl fun k _ ↦ ?_ + rw [map_mul, map_pow, aeval_X, mul_comm] + have hα0 : α ≠ 0 := ne_of_gt ((zero_le : (0 : NatOrdinal) ≤ wt B₀).trans_lt hg) + obtain ⟨bound, hboundα, hcuts⟩ := + exists_lt_forall_degree_translatedTruncLE_lt σ hα0 hF hF0 + obtain ⟨l, hl0, hcuts'⟩ := eventually_nhdsLT_iff_exists.mp hcuts + have hcoeffD : ∀ γ : G, γ < 0 → + xCoeff B₀ D (σ.pol hx α (translatedTruncLE γ (aeval σ.lift F))) = + σ.pol hx α (translatedTruncLE γ (aeval σ.lift (xCoeff B₀ D F))) := by + intro γ hγ + rw [hGexp, map_sum, σ.pol_sum hx hinj _ _ (fun k hk ↦ by + have hkD : k ≤ D := Nat.lt_succ_iff.mp (Finset.mem_range.mp hk) + have hdrop := (hterm k hkD).degree_translatedTruncLE_lt hγ + rwa [add_comm (k • wt B₀), hαk k hkD] at hdrop), map_sum] + rw [Finset.sum_range_succ, Finset.sum_eq_zero (fun k hk ↦ ?_), zero_add] + · exact (LiftFamily.FreeOfVariable.xCoeff_pol_translatedTruncLE_lift_pow_mul + (σ := σ) (hx := hx) hσ hinj hg hfree D (by + rw [add_comm] + exact hdegHD.le) hγ).2 + · have hkD : k < D := Finset.mem_range.mp hk + have hkD' : k ≤ D := hkD.le + rcases Nat.eq_zero_or_pos k with rfl | hk1 + · have hF0hom : IsWeightedHomogeneous wt (xCoeff B₀ 0 F) α := by + have h := hFkhom 0 hkD' + rw [Nat.sub_zero, hdegHD] at h + exact h + rw [pow_zero, one_mul, xCoeff_of_mem_supported B₀ + (LiftFamily.FreeOfVariable.pol_translatedTruncLE_aeval_mem_supported + (σ := σ) (hx := hx) hσ hinj hg hF0hom (hFkmem 0) (hFkvars 0) hγ) D, + if_neg (Nat.ne_of_gt hD)] + · have hfreeK := LiftFamily.FreeOfVariable.aeval (σ := σ) (hx := hx) hσ hinj hg + (hFkhom k hkD') (hαklt k hk1 hkD') (hFkmem k) (hFkvars k) + exact (LiftFamily.FreeOfVariable.xCoeff_pol_translatedTruncLE_lift_pow_mul + (σ := σ) (hx := hx) hσ hinj hg hfreeK k (by + rw [add_comm] + exact (hαk k hkD').le) hγ).1 D hkD + have hdegree : ν (aeval σ.lift (xCoeff B₀ D F)) = + (degHD : WithBot NatOrdinal) := by + have hrep := σ.represents_aeval hFDhom + have hgrade : aeval xg (xCoeff B₀ D F) ≠ 0 := by + intro hzero + exact hFD (((OrdinalGraded.injectiveAt_iff degHD).mp (hinj degHD hdegHDlt)) + (xCoeff B₀ D F) hFDhom hzero) + exact hrep.degree_eq hgrade + have hsep : D • wt B₀ = 0 ∨ + NatOrdinal.leastTerm degHD ≤ NatOrdinal.leastTerm (D • wt B₀) := by + right + rw [NatOrdinal.leastTerm_nsmul (hx.ne_zero B₀) hD] + exact hcase + apply σ.false_of_forall_weightedTotalDegree_pol_add_lt hx hdegree hdegHD0 hsep + (by rw [hdegHD]; exact hboundα) hl0 + · intro γ hlγ hγ hp0 + rw [← hcoeffD γ hγ] at hp0 ⊢ + exact LiftFamily.weightedTotalDegree_xCoeff_add_nsmul_lt + (σ.pol_weight_lt_of_degree_lt hx hboundα.le (hcuts' γ hlγ hγ)) B₀ D hp0 + · exact hdegHDlt + +include hx in +/-- A homogeneous relation is impossible when its leading coefficient in a maximal variable is +scalar, or its least Cantor term is no greater than that of the variable's weight. -/ +@[blueprint "lem:cantor-bendixson-leading-coefficient" + (phase := "Algebraic independence in graded rings") + (title := "Leading-coefficient obstruction for homogeneous relations") + (statement := /-- + Let $K$ be a field of characteristic zero and $G$ a nontrivial complete + ordered abelian group with compatible additive uniformity and order + topology. Let $x_i$ be a minimal homogeneous generating system for the + associated graded ring of the degree filtration, of weights $w_i$. Choose + series $b_i$ representing $x_i$ such that + \[ + \deg(b_i)\le w_i, + \qquad \deg(b_i^{\vert y}) (cantorBendixsonDegreeValuation (G := G) (R := K)) + +/-- Every homogeneous class is the class of a series in the corresponding weight filtration. -/ +theorem exists_represents {m : NatOrdinal.{u}} {e : (ν).AssociatedGraded} + (he : e ∈ DirectSum.rangeLof K (ν).Component m) : + ∃ b : Nonpositive G K, Represents b m e := by + obtain ⟨a, ha⟩ := (DirectSum.mem_rangeLof_iff K (ν).Component m e).mp he + rw [DirectSum.lof_eq_of] at ha + induction a using MaxAddDegree.componentInductionOn with + | H p => + refine ⟨(p : Nonpositive G K), represents_iff.mpr + ⟨((ν).mem_filtrationLE_iff m _).mp p.2, ?_⟩⟩ + rw [← ha, MaxAddDegree.homogeneousMk_apply] + +/-- A series bounded strictly below zero has bottom degree. -/ +theorem degree_eq_bot_of_support_subset_Iic {b : Nonpositive G K} {c : G} (hc : c < 0) + (hb : (b : HahnSeries G K).support ⊆ Set.Iic c) : ν b = ⊥ := by + have hclosed : (0 : G) ∉ closure (b : HahnSeries G K).support := by + intro h0 + exact absurd (isClosed_Iic.closure_subset_iff.mpr hb h0) (not_le.mpr hc) + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + cantorBendixsonValue_of_notMem _ hclosed, NatOrdinal.of_zero, NatOrdinal.cantorDegree_zero] + +open Classical in +/-- **Every homogeneous class has a representative with the required truncation bounds.** +Cutting a representative below a negative bound leaves the class unchanged, because the discarded +part is bounded strictly below zero and so has bottom degree. Choose the bound past which every +proper translated truncation already drops. Above it, the chosen drop applies; at or below it, the +truncation is empty. -/ +theorem exists_representative_hasLowerTruncationDegree + {m : NatOrdinal.{u}} {e : (ν).AssociatedGraded} + (he : e ∈ DirectSum.rangeLof K (ν).Component m) : + ∃ b : Nonpositive G K, Represents b m e ∧ HasLowerTruncationDegree b m := by + obtain ⟨a, ha⟩ := (DirectSum.mem_rangeLof_iff K (ν).Component m e).mp he + rw [DirectSum.lof_eq_of] at ha + obtain ⟨d, hd⟩ : ∃ d : G, d < 0 := exists_lt (0 : G) + obtain ⟨w, c, hw, -, hc0, hwa, hdrop⟩ := exists_representative_with_lower_truncation_degree m a hd + -- the part of `w` strictly above the cutoff + obtain ⟨b, hbdef⟩ : ∃ b : Nonpositive G K, + (b : HahnSeries G K) = truncGT c (w : HahnSeries G K) := + ⟨⟨truncGT c (w : HahnSeries G K), fun g hg ↦ w.property (support_truncGT_subset c _ hg)⟩, rfl⟩ + -- what was cut off is bounded strictly below zero + have hcut : ∀ γ : G, c < γ → γ ≤ 0 → + ν (translatedTruncLE γ (w - b)) = ⊥ := by + intro γ hcγ hγ + refine degree_eq_bot_of_support_subset_Iic (c := c - γ) (by + simpa using sub_neg.mpr hcγ) ?_ + intro g hg + have hg' : g + γ ∈ ((w : HahnSeries G K) - (b : HahnSeries G K)).support := by + have hcoe : ((translatedTruncLE γ (w - b) : Nonpositive G K) : HahnSeries G K) = + translate (-γ) (truncLE γ ((w : HahnSeries G K) - (b : HahnSeries G K))) := + coe_translatedTruncLE γ (w - b) + rw [hcoe, mem_support, HahnSeries.coeff_translate, HahnSeries.coeff_truncLE] at hg + split_ifs at hg with hle + · exact (mem_support _ _).mpr (by simpa using hg) + · exact absurd rfl hg + have hcoeff : ((w : HahnSeries G K) - (b : HahnSeries G K)).coeff (g + γ) ≠ 0 := + (mem_support _ _).mp hg' + rw [HahnSeries.coeff_sub, hbdef, HahnSeries.coeff_truncGT] at hcoeff + have hle : g + γ ≤ c := by + by_contra hn + rw [if_pos (not_le.mp hn), sub_self] at hcoeff + exact hcoeff rfl + simpa using sub_le_sub_right hle γ + have hsub : ν ((w : Nonpositive G K) - b) = ⊥ := by + have h := hcut 0 hc0 le_rfl + rwa [translatedTruncLE_zero] at h + have hbw : ν b ≤ m := by + have heq := degree_eq_of_degree_sub_eq_bot hsub + rwa [heq] at hw + refine ⟨b, represents_iff.mpr ⟨hbw, ?_⟩, hasLowerTruncationDegree_iff.mpr ⟨hbw, fun y hy ↦ ?_⟩⟩ + · rw [← ha, ← hwa] + refine (MaxAddDegree.homogeneousMk_apply _ _ _).trans ?_ + congr 1 + refine ((ν).componentMk_eq_componentMk_iff m _ _).mpr ?_ + rw [show ((b : Nonpositive G K) : Nonpositive G K) - (w : Nonpositive G K) = + -((w : Nonpositive G K) - b) by ring, (ν).map_neg, hsub] + exact bot_lt_iff_ne_bot.mpr (by simp) + · by_cases hyc : c < y + · have hdiff := hcut y hyc hy.le + have heq := degree_eq_of_degree_sub_eq_bot (a := translatedTruncLE y (w : Nonpositive G K)) + (b := translatedTruncLE y b) (by rw [← map_sub]; exact hdiff) + rw [← heq] + exact hdrop y hyc hy + · have hzero : translatedTruncLE y b = 0 := by + apply Subtype.ext + ext g + have hcoe : ((translatedTruncLE y b : Nonpositive G K) : HahnSeries G K) = + translate (-y) (truncLE y (b : HahnSeries G K)) := coe_translatedTruncLE y b + rw [hcoe, HahnSeries.coeff_translate, HahnSeries.coeff_truncLE, hbdef, + HahnSeries.coeff_truncGT] + split_ifs with h1 h2 + · exact absurd h2 (not_lt.mpr (le_trans (by simpa using h1) (not_lt.mp hyc))) + · rfl + · rfl + rw [hzero, (ν).map_zero] + exact bot_lt_iff_ne_bot.mpr (by simp) + +variable {ι : Type w} + +/-- Series representing a family of homogeneous classes, each in its own degree. -/ +abbrev LiftFamily (wt : ι → NatOrdinal.{u}) + (x : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded) := + MaxAddDegree.LiftFamily (cantorBendixsonDegreeValuation (G := G) (R := K)) wt x + +variable {wt : ι → NatOrdinal.{u}} + {x : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded} + +/-- Lifts exist for every family of homogeneous classes. -/ +theorem nonempty_liftFamily (hmem : ∀ i, x i ∈ DirectSum.rangeLof K (ν).Component (wt i)) : + Nonempty (LiftFamily wt x) := by + choose b hb using fun i ↦ exists_represents (hmem i) + exact ⟨⟨b, hb⟩⟩ + +namespace LiftFamily + +variable (σ : LiftFamily wt x) + +/-- Evaluating a weighted homogeneous polynomial at the lifts lifts the evaluation at the +classes. -/ +theorem represents_aeval {F : MvPolynomial ι K} {β : NatOrdinal.{u}} + (hF : IsWeightedHomogeneous wt F β) : + Represents (aeval σ.lift F) β (aeval x F) := + Nonpositive.represents_aeval x σ.represents hF + +/-- A relation evaluates at the lifts to a series of degree strictly below its own. -/ +theorem degree_aeval_lt_of_aeval_eq_zero {F : MvPolynomial ι K} {β : NatOrdinal.{u}} + (hF : IsWeightedHomogeneous wt F β) (h : aeval x F = 0) : + ν (aeval σ.lift F) < (β : WithBot NatOrdinal.{u}) := + Represents.degree_lt_of_eq_zero (h ▸ σ.represents_aeval hF) + +/-- Every representative satisfies the degree and proper-truncation bounds assigned to its +class. -/ +def HasLowerTruncationDegrees (σ : LiftFamily wt x) : Prop := + ∀ i, Nonpositive.HasLowerTruncationDegree (σ.lift i) (wt i) + +theorem hasLowerTruncationDegrees_iff (σ : LiftFamily wt x) : + HasLowerTruncationDegrees σ ↔ ∀ i, Nonpositive.HasLowerTruncationDegree (σ.lift i) (wt i) := + Iff.rfl + +/-- Evaluating a weighted homogeneous polynomial preserves the assigned lower-truncation +degree. -/ +theorem hasLowerTruncationDegree_aeval (hσ : HasLowerTruncationDegrees σ) + {F : MvPolynomial ι K} {β : NatOrdinal.{u}} (hF : IsWeightedHomogeneous wt F β) : + Nonpositive.HasLowerTruncationDegree (aeval σ.lift F) β := + Nonpositive.hasLowerTruncationDegree_aeval ((hasLowerTruncationDegrees_iff σ).mp hσ) hF + +/-- A polynomial all of whose monomials have weight below `α` evaluates at the lifts to a series of +degree below `α`. -/ +theorem degree_aeval_lt {F : MvPolynomial ι K} {α : NatOrdinal.{u}} + (hF : ∀ d ∈ F.support, Finsupp.weight wt d < α) : + ν (aeval σ.lift F) < (α : WithBot NatOrdinal.{u}) := + Nonpositive.degree_aeval_lt_of_forall_weight_lt x σ.represents hF + +end LiftFamily + +/-- Every family of homogeneous classes has representatives of the assigned lower-truncation +degrees. -/ +theorem exists_liftFamily_hasLowerTruncationDegrees + (hmem : ∀ i, x i ∈ DirectSum.rangeLof K (ν).Component (wt i)) : + ∃ σ : LiftFamily wt x, LiftFamily.HasLowerTruncationDegrees σ := by + choose b hb hbounds using fun i ↦ exists_representative_hasLowerTruncationDegree (hmem i) + exact ⟨⟨b, hb⟩, hbounds⟩ + +end HahnSeries.Nonpositive + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Lifts.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Lifts.lean new file mode 100644 index 0000000000..9929db9b20 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Lifts.lean @@ -0,0 +1,393 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Scalar +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.TruncationIntegerPartPrimal +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeRepresentatives +public import Mathlib.RingTheory.MvPolynomial.WeightedHomogeneous +import Mathlib.Algebra.MvPolynomial.CommRing + +/-! +# Representatives in the associated graded ring of the Cantor–Bendixson degree + +A nonpositive Hahn series represents a homogeneous class in the associated graded ring of the +Cantor–Bendixson degree +when it lies in the weight filtration and its class is that element. Evaluating a weighted +homogeneous polynomial at lifts of homogeneous classes is again such a lift: the evaluation lies +in the filtration of the weighted degree, and its class is the evaluation at the classes in the +associated graded ring. + +Consequently, whenever every homogeneous class of degree below `α` is a homogeneous polynomial in +prescribed classes, every series of degree below `α` agrees, up to a series bounded strictly +below zero, with the evaluation at the lifts of a polynomial all of whose monomials have weight +below `α`. The construction removes leading homogeneous classes along a strictly decreasing +sequence of degrees, so no countability, cofinality, or support-order hypothesis enters. +-/ + +public noncomputable section + +open Set MvPolynomial +open scoped NatOrdinal DirectSum + +universe u v w + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [Field K] [CharZero K] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := K)) + +/-- A nonpositive series representing a homogeneous class of specified degree. -/ +abbrev Represents (b : Nonpositive G K) (m : NatOrdinal.{u}) (e : (ν).AssociatedGraded) : Prop := + (ν).Represents b m e + +theorem represents_iff {b : Nonpositive G K} {m : NatOrdinal.{u}} + {e : (ν).AssociatedGraded} : + Represents b m e ↔ + ∃ h : ν b ≤ m, (ν).homogeneousMk m ⟨b, ((ν).mem_filtrationLE_iff m b).mpr h⟩ = e := + MaxAddDegree.represents_iff + +theorem Represents.degree_le {b : Nonpositive G K} {m : NatOrdinal.{u}} + {e : (ν).AssociatedGraded} (h : Represents b m e) : ν b ≤ m := + MaxAddDegree.Represents.degree_le h + +/-- The zero series lifts the zero class in every degree. -/ +theorem represents_zero (m : NatOrdinal.{u}) : + Represents (0 : Nonpositive G K) m 0 := + (ν).represents_zero m + +/-- The identity series lifts the identity class in degree zero. -/ +theorem represents_one : Represents (1 : Nonpositive G K) 0 1 := + (ν).represents_one + +/-- A constant series lifts the corresponding scalar class in degree zero. -/ +theorem represents_algebraMap (k : K) : + Represents (algebraMap K (Nonpositive G K) k) 0 (algebraMap K (ν).AssociatedGraded k) := by + refine ⟨by rw [algebraMap_apply]; exact degree_C_le k, ?_⟩ + rw [cantorBendixson_algebraMap_apply, cantorBendixsonLayerScalarHom_apply, + (ν).homogeneousMk_apply] + exact congrArg (DirectSum.of (ν).Component 0) + (congrArg ((ν).componentMk 0) (Subtype.ext (algebraMap_apply k))) + +/-- Lifts add: the sum of two lifts in a common degree lifts the sum of the classes. -/ +theorem Represents.add {a b : Nonpositive G K} {m : NatOrdinal.{u}} + {e f : (ν).AssociatedGraded} (ha : Represents a m e) (hb : Represents b m f) : + Represents (a + b) m (e + f) := + MaxAddDegree.Represents.add ha hb + +/-- Lifts multiply: the product of two lifts, at the sum of the degrees, lifts the product of +the classes. -/ +theorem Represents.mul {a b : Nonpositive G K} {m n p : NatOrdinal.{u}} + {e f : (ν).AssociatedGraded} (hp : p = m + n) + (ha : Represents a m e) (hb : Represents b n f) : + Represents (a * b) p (e * f) := + MaxAddDegree.Represents.mul hp ha hb + +/-- Powers of a lift, at multiples of the degree, lift the powers of the class. -/ +theorem Represents.pow {b : Nonpositive G K} {m : NatOrdinal.{u}} {e : (ν).AssociatedGraded} + (hb : Represents b m e) (n : ℕ) : Represents (b ^ n) (n • m) (e ^ n) := + MaxAddDegree.Represents.pow hb n + +/-- A finite product of lifts, at the sum of the degrees, lifts the product of the classes. -/ +theorem represents_prod {ι' : Type w} {s : Finset ι'} {a : ι' → Nonpositive G K} + {m : ι' → NatOrdinal.{u}} {e : ι' → (ν).AssociatedGraded} + (h : ∀ i ∈ s, Represents (a i) (m i) (e i)) : + Represents (∏ i ∈ s, a i) (∑ i ∈ s, m i) (∏ i ∈ s, e i) := + (ν).represents_prod h + +/-- A finite sum of lifts in a common degree lifts the sum of the classes. -/ +theorem represents_sum {ι' : Type w} {s : Finset ι'} {a : ι' → Nonpositive G K} + {m : NatOrdinal.{u}} {e : ι' → (ν).AssociatedGraded} + (h : ∀ i ∈ s, Represents (a i) m (e i)) : + Represents (∑ i ∈ s, a i) m (∑ i ∈ s, e i) := + (ν).represents_sum h + +/-- Two lifts of one class in a common degree differ by a series of strictly smaller degree. -/ +theorem Represents.degree_sub_lt {a b : Nonpositive G K} {m : NatOrdinal.{u}} + {e : (ν).AssociatedGraded} (ha : Represents a m e) (hb : Represents b m e) : + ν (a - b) < m := + MaxAddDegree.Represents.degree_sub_lt ha hb + +/-- A series of degree strictly below `m` lifts the zero class in degree `m`. -/ +theorem represents_of_degree_lt {b : Nonpositive G K} {m : NatOrdinal.{u}} + (h : ν b < (m : WithBot NatOrdinal)) : Represents b m 0 := + (ν).represents_zero_of_degree_lt h + +/-- A series lifts at most one class in each degree. -/ +theorem Represents.unique {b : Nonpositive G K} {m : NatOrdinal.{u}} + {e f : (ν).AssociatedGraded} (he : Represents b m e) (hf : Represents b m f) : e = f := + MaxAddDegree.Represents.unique he hf + +/-- A lift of a nonzero class has degree exactly the class degree. -/ +theorem Represents.degree_eq {b : Nonpositive G K} {m : NatOrdinal.{u}} + {e : (ν).AssociatedGraded} (h : Represents b m e) (he : e ≠ 0) : + ν b = (m : WithBot NatOrdinal) := + MaxAddDegree.Represents.degree_eq h he + +variable {ι : Type w} {wt : ι → NatOrdinal.{u}} {V : ι → Nonpositive G K} + +/-- Evaluating a weighted homogeneous polynomial at lifts of homogeneous classes lifts the +evaluation at the classes: it lies in the filtration of the weighted degree, and its class is +the evaluation in the associated graded ring. -/ +theorem represents_aeval (x : ι → (ν).AssociatedGraded) + (hV : ∀ i, Represents (V i) (wt i) (x i)) + {F : MvPolynomial ι K} {β : NatOrdinal.{u}} (hF : IsWeightedHomogeneous wt F β) : + Represents (aeval V F) β (aeval x F) := + (ν).represents_aeval represents_algebraMap hV hF + +/-- The evaluation of a polynomial all of whose monomials have weight strictly below `α` has +degree strictly below `α`. -/ +theorem degree_aeval_lt_of_forall_weight_lt (x : ι → (ν).AssociatedGraded) + (hV : ∀ i, Represents (V i) (wt i) (x i)) + {F : MvPolynomial ι K} {α : NatOrdinal.{u}} + (hF : ∀ d ∈ F.support, (Finsupp.weight wt) d < α) : + ν (aeval V F) < (α : WithBot NatOrdinal) := + (ν).degree_aeval_lt_of_forall_weight_lt represents_algebraMap hV hF + +/-- Evaluation of a polynomial with weights at most `β` lifts the evaluation of its top weighted +homogeneous component. -/ +theorem represents_aeval_weightedHomogeneousComponent (x : ι → (ν).AssociatedGraded) + (hV : ∀ i, Represents (V i) (wt i) (x i)) + {F : MvPolynomial ι K} {β : NatOrdinal.{u}} + (hw : ∀ d ∈ F.support, (Finsupp.weight wt) d ≤ β) : + Represents (aeval V F) β (aeval x (weightedHomogeneousComponent wt β F)) := + (ν).represents_aeval_weightedHomogeneousComponent represents_algebraMap hV hw + +/-- Evaluation at the lifts has degree exactly `β` whenever the evaluation of the top weighted +homogeneous component does not vanish in the associated graded ring. -/ +theorem degree_aeval_eq_of_aeval_weightedHomogeneousComponent_ne_zero + (x : ι → (ν).AssociatedGraded) (hV : ∀ i, Represents (V i) (wt i) (x i)) + {F : MvPolynomial ι K} {β : NatOrdinal.{u}} + (hw : ∀ d ∈ F.support, (Finsupp.weight wt) d ≤ β) + (hne : aeval x (weightedHomogeneousComponent wt β F) ≠ 0) : + ν (aeval V F) = (β : WithBot NatOrdinal) := + (represents_aeval_weightedHomogeneousComponent x hV hw).degree_eq hne + +/-- Under injectivity of the graded evaluation below `α`, a polynomial with weights below `α` +whose evaluation at the lifts is bounded strictly below zero is the zero polynomial. This is the +uniqueness of the polynomial of a series modulo bounded series. -/ +theorem eq_zero_of_forall_weight_lt_of_degree_aeval_eq_bot + (x : ι → (ν).AssociatedGraded) (hV : ∀ i, Represents (V i) (wt i) (x i)) + {α : NatOrdinal.{u}} + (hinj : ∀ (β : NatOrdinal.{u}) (F : MvPolynomial ι K), β < α → + IsWeightedHomogeneous wt F β → aeval x F = 0 → F = 0) + {F : MvPolynomial ι K} (hw : ∀ d ∈ F.support, (Finsupp.weight wt) d < α) + (hbot : ν (aeval V F) = ⊥) : F = 0 := by + classical + suffices H : ∀ β : NatOrdinal.{u}, ∀ F : MvPolynomial ι K, + (∀ d ∈ F.support, (Finsupp.weight wt) d < α) → + (∀ d ∈ F.support, (Finsupp.weight wt) d ≤ β) → + ν (aeval V F) = ⊥ → F = 0 from + H (F.support.sup (Finsupp.weight wt)) F hw (fun _ hd ↦ Finset.le_sup hd) hbot + intro β + induction β using WellFoundedLT.induction with + | _ β ih => + intro F hw hβ hbot + have hcomp0 : weightedHomogeneousComponent wt β F = 0 := by + by_cases hzero : weightedHomogeneousComponent wt β F = 0 + · exact hzero + · obtain ⟨d, hd⟩ := MvPolynomial.ne_zero_iff.mp hzero + rw [coeff_weightedHomogeneousComponent] at hd + by_cases hdw : (Finsupp.weight wt) d = β + · rw [if_pos hdw] at hd + have hβα : β < α := hdw ▸ hw d (MvPolynomial.mem_support_iff.mpr hd) + have hrep := represents_aeval_weightedHomogeneousComponent x hV hβ + have hrep0 : Represents (aeval V F) β 0 := + represents_of_degree_lt (by rw [hbot]; exact WithBot.bot_lt_coe β) + exact absurd (hinj β _ hβα + (weightedHomogeneousComponent_isWeightedHomogeneous (w := wt) (n := β) (φ := F)) + (hrep.unique hrep0)) hzero + · rw [if_neg hdw] at hd + exact absurd rfl hd + have hlt : ∀ d ∈ F.support, (Finsupp.weight wt) d < β := by + intro d hd + refine lt_of_le_of_ne (hβ d hd) fun he ↦ ?_ + have := congrArg (MvPolynomial.coeff d) hcomp0 + rw [coeff_weightedHomogeneousComponent, if_pos he, MvPolynomial.coeff_zero] at this + exact MvPolynomial.mem_support_iff.mp hd this + rcases eq_or_ne β 0 with rfl | hβ0 + · rw [MvPolynomial.eq_zero_iff] + intro d + by_contra hd + exact absurd (hlt d (MvPolynomial.mem_support_iff.mpr hd)) + (not_lt_of_ge (zero_le (a := (Finsupp.weight wt) d))) + · have hsuplt : F.support.sup (Finsupp.weight wt) < β := + Finset.sup_lt_iff (pos_of_ne_zero hβ0) |>.mpr hlt + exact ih _ hsuplt F hw (fun _ hd ↦ Finset.le_sup hd) hbot + +/-- Under injectivity of the graded evaluation below `α`, every monomial weight of a polynomial +is bounded by the degree of its evaluation at the lifts. -/ +theorem forall_weight_le_degree_aeval_of_injective + (x : ι → (ν).AssociatedGraded) (hV : ∀ i, Represents (V i) (wt i) (x i)) + {α : NatOrdinal.{u}} + (hinj : ∀ (β : NatOrdinal.{u}) (F : MvPolynomial ι K), β < α → + IsWeightedHomogeneous wt F β → aeval x F = 0 → F = 0) + {F : MvPolynomial ι K} (hw : ∀ d ∈ F.support, (Finsupp.weight wt) d < α) : + ∀ d ∈ F.support, (((Finsupp.weight wt) d : NatOrdinal) : WithBot NatOrdinal) ≤ + ν (aeval V F) := by + classical + suffices H : ∀ β : NatOrdinal.{u}, ∀ F : MvPolynomial ι K, + (∀ d ∈ F.support, (Finsupp.weight wt) d < α) → + (∀ d ∈ F.support, (Finsupp.weight wt) d ≤ β) → + ∀ d ∈ F.support, (((Finsupp.weight wt) d : NatOrdinal) : WithBot NatOrdinal) ≤ + ν (aeval V F) from + H (F.support.sup (Finsupp.weight wt)) F hw (fun _ hd ↦ Finset.le_sup hd) + intro β + induction β using WellFoundedLT.induction with + | _ β ih => + intro F hw hβ d hd + by_cases hzero : weightedHomogeneousComponent wt β F = 0 + · have hlt : ∀ e ∈ F.support, (Finsupp.weight wt) e < β := by + intro e he + refine lt_of_le_of_ne (hβ e he) fun heq ↦ ?_ + have hcz := congrArg (MvPolynomial.coeff e) hzero + rw [coeff_weightedHomogeneousComponent, if_pos heq, MvPolynomial.coeff_zero] at hcz + exact MvPolynomial.mem_support_iff.mp he hcz + rcases eq_or_ne β 0 with rfl | hβ0 + · exact absurd (hlt d hd) (not_lt_of_ge (zero_le (a := (Finsupp.weight wt) d))) + · exact ih (F.support.sup (Finsupp.weight wt)) + (Finset.sup_lt_iff (pos_of_ne_zero hβ0) |>.mpr hlt) F hw + (fun _ he ↦ Finset.le_sup he) d hd + · obtain ⟨e, he⟩ := MvPolynomial.ne_zero_iff.mp hzero + rw [coeff_weightedHomogeneousComponent] at he + by_cases hew : (Finsupp.weight wt) e = β + · have hβα : β < α := hew ▸ hw e (MvPolynomial.mem_support_iff.mpr (by + rwa [if_pos hew] at he)) + have haev : aeval x (weightedHomogeneousComponent wt β F) ≠ 0 := fun h ↦ + hzero (hinj β _ hβα + (weightedHomogeneousComponent_isWeightedHomogeneous (w := wt) (n := β) (φ := F)) h) + rw [(represents_aeval_weightedHomogeneousComponent x hV hβ).degree_eq haev] + exact WithBot.coe_le_coe.mpr (hβ d hd) + · rw [if_neg hew] at he + exact absurd rfl he + +open Classical in +/-- The polynomial of a series modulo bounded series, at arbitrary cofinality. If every +homogeneous class of degree below `α` is a homogeneous polynomial in prescribed classes, then +every series of degree below `α` agrees, up to a series bounded strictly below zero, with the +evaluation at the lifts of a polynomial all of whose monomials have weight below `α`. -/ +theorem exists_forall_weight_lt_and_degree_sub_aeval_eq_bot + (x : ι → (ν).AssociatedGraded) (hV : ∀ i, Represents (V i) (wt i) (x i)) + (α : NatOrdinal.{u}) + (hgen : ∀ β : NatOrdinal.{u}, β < α → ∀ y ∈ DirectSum.rangeLof K (ν).Component β, + ∃ F : MvPolynomial ι K, IsWeightedHomogeneous wt F β ∧ aeval x F = y) + (u : Nonpositive G K) (hu : ν u < (α : WithBot NatOrdinal)) : + ∃ F : MvPolynomial ι K, + (∀ d ∈ F.support, (((Finsupp.weight wt) d : NatOrdinal) : WithBot NatOrdinal) ≤ ν u) ∧ + (∀ d ∈ F.support, (Finsupp.weight wt) d < α) ∧ + ν (u - aeval V F) = ⊥ := by + classical + suffices H : ∀ b : WithBot NatOrdinal.{u}, b < (α : WithBot NatOrdinal) → + ∀ u : Nonpositive G K, ν u = b → + ∃ F : MvPolynomial ι K, + (∀ d ∈ F.support, (((Finsupp.weight wt) d : NatOrdinal) : WithBot NatOrdinal) ≤ ν u) ∧ + (∀ d ∈ F.support, (Finsupp.weight wt) d < α) ∧ + ν (u - aeval V F) = ⊥ from H (ν u) hu u rfl + intro b + induction b using WellFoundedLT.induction with + | _ b ih => + intro hbα u hb + cases b with + | bot => + refine ⟨0, by simp, by simp, ?_⟩ + rw [map_zero, sub_zero, hb] + | coe β => + have hβα : β < α := WithBot.coe_lt_coe.mp hbα + have hle : ν u ≤ β := hb.le + obtain ⟨Fβ, hFβhom, hFβval⟩ := hgen β hβα (DirectSum.of (ν).Component β + ((ν).componentMk β ⟨u, ((ν).mem_filtrationLE_iff β u).mpr hle⟩)) + (DirectSum.of_mem_rangeLof K (ν).Component β _) + have hrepu : Represents u β (DirectSum.of (ν).Component β + ((ν).componentMk β ⟨u, ((ν).mem_filtrationLE_iff β u).mpr hle⟩)) := + ⟨hle, (ν).homogeneousMk_apply β _⟩ + have hrepF : Represents (aeval V Fβ) β (DirectSum.of (ν).Component β + ((ν).componentMk β ⟨u, ((ν).mem_filtrationLE_iff β u).mpr hle⟩)) := by + rw [← hFβval] + exact represents_aeval x hV hFβhom + have hdrop : ν (u - aeval V Fβ) < (β : WithBot NatOrdinal) := + hrepu.degree_sub_lt hrepF + obtain ⟨F', hF'd, hF'w, hF'⟩ := ih (ν (u - aeval V Fβ)) hdrop (hdrop.trans hbα) + (u - aeval V Fβ) rfl + refine ⟨Fβ + F', ?_, ?_, ?_⟩ + · intro d hd + rcases Finset.mem_union.mp (MvPolynomial.support_add hd) with hd | hd + · rw [hFβhom (MvPolynomial.mem_support_iff.mp hd), hb] + · exact (hF'd d hd).trans (hdrop.le.trans hb.ge) + · intro d hd + rcases Finset.mem_union.mp (MvPolynomial.support_add hd) with hd | hd + · rw [hFβhom (MvPolynomial.mem_support_iff.mp hd)] + exact hβα + · exact hF'w d hd + · rw [map_add, show u - (aeval V Fβ + aeval V F') = + u - aeval V Fβ - aeval V F' by ring] + exact hF' + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [CharZero K] in +/-- Translated weak truncation is linear over the coefficient field. -/ +theorem translatedTruncLE_smul (γ : G) (k : K) (b : Nonpositive G K) : + translatedTruncLE γ (k • b) = k • translatedTruncLE γ b := by + apply Subtype.ext + rw [coe_translatedTruncLE, coe_smul, coe_smul, coe_translatedTruncLE] + ext g + rw [HahnSeries.coeff_smul, coeff_translate, coeff_translate, HahnSeries.coeff_truncLE, + HahnSeries.coeff_truncLE, HahnSeries.coeff_smul] + by_cases h : g - -γ ≤ γ + · rw [if_pos h, if_pos h] + · rw [if_neg h, if_neg h, smul_zero] + +/-- A lift of the zero class has degree strictly below the class degree. -/ +theorem Represents.degree_lt_of_eq_zero {b : Nonpositive G K} {m : NatOrdinal.{u}} + (h : Represents b m 0) : ν b < (m : WithBot NatOrdinal) := + MaxAddDegree.Represents.degree_lt_of_eq_zero h + +/-- A degree strictly below a nonzero bound admits a natural-ordinal witness. -/ +theorem exists_le_of_degree_lt {b : Nonpositive G K} {m : NatOrdinal.{u}} + (h : ν b < (m : WithBot NatOrdinal)) (hm : m ≠ 0) : + ∃ m₀ : NatOrdinal.{u}, m₀ < m ∧ ν b ≤ (m₀ : WithBot NatOrdinal) := by + by_cases hbot : ν b = ⊥ + · exact ⟨0, pos_iff_ne_zero.mpr hm, by rw [hbot]; exact bot_le⟩ + · obtain ⟨d, hd⟩ := WithBot.ne_bot_iff_exists.mp hbot + rw [← hd] at h ⊢ + exact ⟨d, WithBot.coe_lt_coe.mp h, le_rfl⟩ + +/-- **Lifting a series congruence back to a polynomial identity.** Under injectivity of the graded +evaluation below `α`, two weighted homogeneous polynomials of a common degree below `α` whose +evaluations at the lifts differ by a series of strictly smaller degree are equal. This is how a +relation established among series is returned to the polynomial ring. -/ +theorem eq_of_degree_sub_aeval_lt {ι : Type w} {wt : ι → NatOrdinal.{u}} {V : ι → Nonpositive G K} + (xg : ι → (ν).AssociatedGraded) (hV : ∀ i, Represents (V i) (wt i) (xg i)) + {α : NatOrdinal.{u}} + (hinj : ∀ (β : NatOrdinal.{u}) (F : MvPolynomial ι K), β < α → + IsWeightedHomogeneous wt F β → aeval xg F = 0 → F = 0) + {A B : MvPolynomial ι K} {m : NatOrdinal.{u}} (hm : m < α) + (hA : IsWeightedHomogeneous wt A m) (hB : IsWeightedHomogeneous wt B m) + (h : ν (aeval V A - aeval V B) < (m : WithBot NatOrdinal)) : + A = B := by + have hAB : IsWeightedHomogeneous wt (A - B) m := by + rw [← MvPolynomial.mem_weightedHomogeneousSubmodule] at hA hB ⊢ + exact Submodule.sub_mem _ hA hB + have hcoe : aeval V (A - B) = aeval V A - aeval V B := map_sub _ _ _ + have hzero : Represents (aeval V (A - B)) m 0 := by + rw [hcoe] + exact represents_of_degree_lt h + have hrep : Represents (aeval V (A - B)) m (aeval xg (A - B)) := represents_aeval xg hV hAB + have hclass : aeval xg (A - B) = 0 := hrep.unique hzero + have := hinj m (A - B) hm hAB hclass + exact sub_eq_zero.mp this + +/-- The class a series lifts lies in the corresponding homogeneous component. -/ +theorem Represents.mem_rangeLof {b : Nonpositive G K} {m : NatOrdinal.{u}} + {e : (ν).AssociatedGraded} (h : Represents b m e) : + e ∈ DirectSum.rangeLof K (ν).Component m := by + obtain ⟨hd, he⟩ := h + rw [← he, (ν).homogeneousMk_apply] + exact DirectSum.of_mem_rangeLof K (ν).Component m _ + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalEvaluation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalEvaluation.lean new file mode 100644 index 0000000000..80e37a67a1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalEvaluation.lean @@ -0,0 +1,302 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalRelationAtCutoff +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalExpansion +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.RemainderBound + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Injectivity when the degree is a limit ordinal + +Evaluation at a minimal system is injective when the degree is a nonzero limit ordinal, provided +it is injective in every smaller degree. + +Suppose not, and take a relation of that degree. Choose a variable of maximal degree. If the +leading coefficient is scalar, or its last Cantor term is no later than the last term of the +maximal weight, the leading-coefficient hypothesis gives a contradiction. Otherwise, translated +truncations of the evaluated relation and the nonlinear terms in the convolution formula admit +uniform smaller-degree bounds. Linearity of the maximal variable and the partial-derivative +identities then give the contradiction. +-/ + +universe u v w + +open scoped NatOrdinal Topology + +open Filter MvPolynomial HahnSeries HahnSeries.Nonpositive + +public noncomputable section + +namespace HahnSeries.Germ + +variable {G : Type u} {K : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [Field K] [CharZero K] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := K)) + +variable {ι : Type w} {wt : ι → NatOrdinal.{u}} + {xg : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded} +variable (σ : LiftFamily wt xg) + +/-- **The truncations of a relation drop below a degree short of the limit.** The evaluated +relation has degree strictly below the limit, truncation does not raise the degree, and a limit +leaves room for a strict bound in between. -/ +theorem exists_lt_forall_degree_translatedTruncLE_lt {α : NatOrdinal.{u}} (hα0 : α ≠ 0) + {F : MvPolynomial ι K} (hF : IsWeightedHomogeneous wt F α) + (h0 : aeval xg F = 0) : + ∃ α₁ : NatOrdinal.{u}, α₁ < α ∧ + ∀ᶠ γ in 𝓝[<] (0 : G), + ν (translatedTruncLE γ (aeval σ.lift F)) < (α₁ : WithBot NatOrdinal) := by + have hlt := σ.degree_aeval_lt_of_aeval_eq_zero hF h0 + obtain ⟨α₁, hle, hα₁⟩ : ∃ α₁ : NatOrdinal.{u}, + ν (aeval σ.lift F) ≤ (α₁ : WithBot NatOrdinal.{u}) ∧ α₁ < α := by + cases hb : ν (aeval σ.lift F) with + | bot => exact ⟨0, bot_le, pos_iff_ne_zero.mpr hα0⟩ + | coe g => + refine ⟨g, le_rfl, ?_⟩ + rw [hb] at hlt + exact WithBot.coe_lt_coe.mp hlt + exact ⟨α₁, hα₁, eventually_degree_translatedTruncLE_lt _ α₁ hle⟩ + +variable (hx : OrdinalGraded.IsMinimalSystem + (DirectSum.rangeLof K (cantorBendixsonDegreeValuation (G := G) (R := K)).Component) wt xg) +variable {α : NatOrdinal.{u}} +include hx + +/-- Evaluation is injective when the degree is a nonzero limit ordinal. + +Injectivity below the degree enters through three mathematical obligations: exclusion by the +leading coefficient, linearity of a maximal variable, and the partial-derivative identities. -/ +@[blueprint "lem:cantor-bendixson-limit-ordinal-evaluation" + (phase := "Algebraic independence in graded rings") + (title := "Injectivity of evaluation when the degree is a limit ordinal") + (statement := /-- + Let $K$ be a field of characteristic zero and $G$ a nontrivial complete + ordered abelian group equipped with a compatible additive uniformity whose + topology is the order topology. Let $x_i$ be a minimal + homogeneous generating system for the associated graded ring of the + degree filtration, with weights $w_i$, and choose series $b_i$ + representing $x_i$ in degree $w_i$. Let $\alpha\ne0$ have zero constant + Cantor coefficient. + + Assume first that the following leading-coefficient case is impossible. + If $0\ne F\in K[X_i:i\in I]$ is weighted homogeneous of degree $\alpha$, + $F(x)=0$, $X_{B_0}$ has maximal weight among the variables of $F$, and + \[ + \Delta+D w_{B_0}=\alpha, + \qquad D=\deg_{B_0}F, + \] + where $w_{B_0}<\alpha$, then $\Delta=0$ or the last Cantor term of + $\Delta$ being at most the last Cantor term of $w_{B_0}$ gives a + contradiction. + + In the complementary case, suppose the following two conclusions hold + whenever ordinals $\beta,\lambda_0,\alpha_1$ and data + $F,B_0,\Delta,D$ satisfy all of these conditions: + $F\ne0$ is weighted homogeneous of degree $\alpha$ and $F(x)=0$; every + variable $X_i$ of $F$ has $w_i<\alpha$ and zero constant Cantor + coefficient; $X_{B_0}$ has maximal weight; $\Delta+D w_{B_0}=\alpha$; + $\Delta\ne0$ and every Cantor term of $\Delta$ is at least + $\omega^\beta$; the last Cantor term of $w_{B_0}$ is below + $\omega^\beta$; $\lambda_0<\alpha_{<\beta}$; + \[ + \alpha_1\le\alpha_{\ge\beta}\oplus\lambda_0, + \qquad \alpha_1\le\alpha; + \] + near $0$, every translated truncation of $F(b)$ has degree below + $\alpha_1$; and every convolution term $\rho$ using at least two + translated truncations satisfies + $\rho<\alpha_{\ge\beta}\oplus\lambda_0$. + + The two required conclusions are: + + 1. $D=1$. + 2. If $X_{B'}$ occurs in $F$ and + $(w_{B'})_{<\beta}\oplus\eta=\lambda_0$ for some $\eta$, then there + are a finite set $S$ and polynomials $U_B$ such that + \[ + \partial_{B'}F=\sum_{B\in S}(\partial_BF)U_B, + \qquad \partial_{B_0}U_B=0\quad(B\in S), + \] + and every $B\in S$ occurs in $F$ and satisfies either + $(w_B)_{<\beta}=\alpha_{<\beta}$, or + \[ + 0\ne(w_B)_{<\beta}\ne\alpha_{<\beta},\qquad + \nexists\eta,\ (w_B)_{<\beta}\oplus\eta=\lambda_0, + \qquad w_{B'} (cantorBendixsonDegreeValuation (G := G) (R := K)) + +variable {ι : Type w} {wt : ι → NatOrdinal.{u}} + {xg : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded} +variable (σ : LiftFamily wt xg) + +/-- A relation whose degree is a limit ordinal, a variable of maximal degree, a cutoff below every +term of the leading coefficient's degree, and uniform bounds for translated truncations and the +Leibniz remainder. -/ +structure LimitOrdinalRelationAtCutoff (α : NatOrdinal.{u}) where + /-- The relation. -/ + F : MvPolynomial ι K + hom : IsWeightedHomogeneous wt F α + eval_zero : aeval xg F = 0 + ne_zero : F ≠ 0 + vars_lt : ∀ i ∈ F.vars, wt i < α + vars_limit : ∀ i ∈ F.vars, (wt i).constantCoeff = 0 + /-- A variable of maximal degree. -/ + B₀ : ι + mem : B₀ ∈ F.vars + max : ∀ i ∈ F.vars, wt i ≤ wt B₀ + /-- A cutoff exponent `β` such that every term of `deg H_D` is at least `ω^β`. -/ + β : NatOrdinal + /-- The degree `α ⊖ (δ ⊙ D)` of `H_D`, the coefficient of `X_{B₀}^D` in `F`. -/ + degHD : NatOrdinal + hdegHD : degHD + degreeOf B₀ F • wt B₀ = α + degHD_terms : ∀ t ∈ degHD.val.additivePrincipalTerms, (ω^ β).val ≤ t + degHD_ne_zero : degHD ≠ 0 + /-- The degree `δ = deg B₀` has a term below `ω^β`. -/ + term_lt : NatOrdinal.leastTerm (wt B₀) < ω^ β + /-- The bound `λ₀`: the terms of the remainder of the Leibniz rule have degree below + `α_{≥β} ⊕ λ₀`, and the translated truncations of `F(b_𝓑)` have ordinal value below `ω^{α₁}` + with `α₁ ≤ α_{≥β} ⊕ λ₀`. -/ + lam₀ : NatOrdinal + lam₀_lt : lam₀ < NatOrdinal.partLT β α + α₁ : NatOrdinal + α₁_le : α₁ ≤ NatOrdinal.partGE β α + lam₀ + α₁_le_α : α₁ ≤ α + truncation_lt : ∀ᶠ γ in 𝓝[<] (0 : G), + cantorBendixsonDegreeValuation (translatedTruncLE γ (aeval σ.lift F)) < + (α₁ : WithBot NatOrdinal) + remainder_lt : ∀ d ∈ F.support, ∀ (k : ℕ) (ρ : NatOrdinal), 2 ≤ k → TermDegree wt d k ρ → + ρ < NatOrdinal.partGE β α + lam₀ + +namespace LimitOrdinalRelationAtCutoff + +variable {σ} {α : NatOrdinal.{u}} (S : LimitOrdinalRelationAtCutoff σ α) +variable (hx : OrdinalGraded.IsMinimalSystem + (DirectSum.rangeLof K + (cantorBendixsonDegreeValuation (G := G) (R := K)).Component) wt xg) + +/-- The part `α_{≥β}` of `α` at or above `β`. -/ +def αGE : NatOrdinal := NatOrdinal.partGE S.β α + +/-- The part `α_{<β}` of `α` below `β`. -/ +def αLT : NatOrdinal := NatOrdinal.partLT S.β α + +/-- The part `(deg B)_{<β}` of the degree of a variable `B` below `β`. -/ +def degLT (i : ι) : NatOrdinal := NatOrdinal.partLT S.β (wt i) + +/-- `H := ∂F/∂X_{B₀}`, the partial derivative of `F` at its variable of maximal degree. -/ +def H : MvPolynomial ι K := pderiv S.B₀ S.F + +/-- The part of `deg B` below `β` equals the part of `α` below `β`. -/ +def LowDegreePartEq (i : ι) : Prop := S.degLT i = S.αLT + +/-- The part of `deg B` below `β` precedes `λ₀` in the algebraic order. -/ +def LowDegreePartAlgebraicLE (i : ι) : Prop := NatOrdinal.AlgebraicLE (S.degLT i) S.lam₀ + +theorem αGE_def : S.αGE = NatOrdinal.partGE S.β α := (rfl) +theorem αLT_def : S.αLT = NatOrdinal.partLT S.β α := (rfl) +theorem degLT_def (i : ι) : S.degLT i = NatOrdinal.partLT S.β (wt i) := (rfl) +theorem H_def : S.H = pderiv S.B₀ S.F := (rfl) +theorem lowDegreePartEq_iff (i : ι) : S.LowDegreePartEq i ↔ S.degLT i = S.αLT := (Iff.rfl) +theorem lowDegreePartAlgebraicLE_iff (i : ι) : + S.LowDegreePartAlgebraicLE i ↔ NatOrdinal.AlgebraicLE (S.degLT i) S.lam₀ := (Iff.rfl) + +theorem αGE_add_αLT : S.αGE + S.αLT = α := NatOrdinal.partGE_add_partLT _ _ + +theorem partGE_add_degLT (i : ι) : NatOrdinal.partGE S.β (wt i) + S.degLT i = wt i := + NatOrdinal.partGE_add_partLT _ _ + +theorem degLT_lt_wpow (i : ι) : S.degLT i < ω^ S.β := NatOrdinal.partLT_lt _ _ + +theorem αLT_lt_wpow : S.αLT < ω^ S.β := NatOrdinal.partLT_lt _ _ + +theorem lam₀_lt_wpow : S.lam₀ < ω^ S.β := S.lam₀_lt.trans S.αLT_lt_wpow + +theorem partGE_αGE_add_lam₀ : + NatOrdinal.partGE S.β (NatOrdinal.partGE S.β α + S.lam₀) = + NatOrdinal.partGE S.β α := by + rw [NatOrdinal.partGE_add, NatOrdinal.partGE_partGE, + NatOrdinal.partGE_eq_zero_of_lt S.lam₀_lt_wpow, add_zero] + +theorem partLT_αGE_add_lam₀ : + NatOrdinal.partLT S.β (NatOrdinal.partGE S.β α + S.lam₀) = S.lam₀ := by + have := NatOrdinal.partGE_add_partLT S.β (NatOrdinal.partGE S.β α + S.lam₀) + rw [S.partGE_αGE_add_lam₀] at this + exact add_left_cancel this + +theorem partLT_degHD : NatOrdinal.partLT S.β S.degHD = 0 := + NatOrdinal.partLT_eq_zero_of_forall_le S.degHD_terms + +theorem αLT_eq_nsmul_degLT : S.αLT = degreeOf S.B₀ S.F • S.degLT S.B₀ := by + have h : NatOrdinal.partLT S.β α = + NatOrdinal.partLT S.β (S.degHD + degreeOf S.B₀ S.F • wt S.B₀) := + congrArg _ S.hdegHD.symm + rw [αLT, h, NatOrdinal.partLT_add, S.partLT_degHD, zero_add, NatOrdinal.partLT_nsmul] + rfl + +/-- In every monomial of `F` the parts below `β` add up to `α_{<β}`. -/ +theorem sum_degLT_eq_αLT {d : ι →₀ ℕ} (hd : d ∈ S.F.support) : + ∑ i ∈ d.support, d i • S.degLT i = S.αLT := by + simpa [degLT, αLT, Finsupp.weight_apply, Finsupp.sum] using + (S.hom.map_weight (NatOrdinal.partLTAddMonoidHom S.β) (mem_support_iff.mp hd)) + +/-- In every monomial of `F` the parts at or above `β` add up to `α_{≥β}`. -/ +theorem sum_partGE_eq_αGE {d : ι →₀ ℕ} (hd : d ∈ S.F.support) : + ∑ i ∈ d.support, d i • NatOrdinal.partGE S.β (wt i) = S.αGE := by + simpa [αGE, Finsupp.weight_apply, Finsupp.sum] using + (S.hom.map_weight (NatOrdinal.partGEAddMonoidHom S.β) (mem_support_iff.mp hd)) + +variable (hxms : OrdinalGraded.IsMinimalSystem + (DirectSum.rangeLof K (cantorBendixsonDegreeValuation (G := G) (R := K)).Component) wt xg) +include hx + +theorem β_ne_zero : S.β ≠ 0 := by + intro h + have hbad := S.term_lt + rw [h, NatOrdinal.wpow_zero] at hbad + exact absurd (NatOrdinal.one_le_leastTerm (hx.ne_zero S.B₀)) (not_le.mpr hbad) + +/-- For every variable `B` of `F`, `(deg B)_{<β}` has finite part `0`. -/ +theorem degLT_constantCoeff {i : ι} (hi : i ∈ S.F.vars) : (S.degLT i).constantCoeff = 0 := by + rw [degLT, NatOrdinal.constantCoeff_partLT (S.β_ne_zero hx)] + exact S.vars_limit i hi + +/-- If `(deg B)_{<β} ≠ 0`, the last term of its Cantor normal form is `ω^e` with `e ≠ 0`. -/ +theorem exists_leastTerm_degLT {i : ι} (hi : i ∈ S.F.vars) (h : S.degLT i ≠ 0) : + ∃ e, e ≠ 0 ∧ NatOrdinal.leastTerm (S.degLT i) = ω^ e := by + obtain ⟨e, he⟩ := NatOrdinal.exists_leastTerm_eq_wpow h + refine ⟨e, fun he0 ↦ ?_, he⟩ + rw [he0, NatOrdinal.wpow_zero, ← NatOrdinal.removeLeastTerm_add_one_eq_self_iff] at he + have := S.degLT_constantCoeff hx hi + rw [← he, show (1 : NatOrdinal) = ((1 : ℕ) : NatOrdinal) by rw [Nat.cast_one], + NatOrdinal.constantCoeff_add_natCast] at this + omega + +/-- `(deg B₀)_{<β} ≠ 0`: the variable of maximal degree has a term below `ω^β`. -/ +theorem degLT_B₀_ne_zero : S.degLT S.B₀ ≠ 0 := by + obtain ⟨e, he⟩ := NatOrdinal.exists_leastTerm_eq_wpow (hx.ne_zero S.B₀) + have hlt : e < S.β := by + have := S.term_lt + rwa [he, NatOrdinal.wpow_lt_wpow] at this + exact NatOrdinal.partLT_ne_zero_of_leastTerm_lt (hx.ne_zero S.B₀) he hlt + +theorem αLT_ne_zero : S.αLT ≠ 0 := by + rw [S.αLT_eq_nsmul_degLT] + exact NatOrdinal.nsmul_ne_zero_of_ne_zero (S.degLT_B₀_ne_zero hx) + (Nat.one_le_iff_ne_zero.mpr (mem_vars_iff_degreeOf_ne_zero.mp S.mem)) + +theorem αLT_constantCoeff : S.αLT.constantCoeff = 0 := by + rw [S.αLT_eq_nsmul_degLT, NatOrdinal.constantCoeff_nsmul, S.degLT_constantCoeff hx S.mem, + mul_zero] + +/-! ### `X_{B₀}` occurs linearly in `F` -/ + +omit hx in +/-- `(deg B₀)_{<β} = α_{<β}`, given that `X_{B₀}` occurs linearly in `F`. + +Linearity is the one step that ordinal arithmetic does not supply. It is the +linear-maximality argument, which each setting proves by its own truncation analysis, so it enters +here as a hypothesis. -/ +theorem degLT_B₀ (hD : degreeOf S.B₀ S.F = 1) : S.degLT S.B₀ = S.αLT := by + rw [S.αLT_eq_nsmul_degLT, hD, one_smul] + +omit hx in +theorem lowDegreePartEq_B₀ (hD : degreeOf S.B₀ S.F = 1) : S.LowDegreePartEq S.B₀ := S.degLT_B₀ hD + +omit hx in +theorem degHD_add (hD : degreeOf S.B₀ S.F = 1) : S.degHD + wt S.B₀ = α := by + have := S.hdegHD + rwa [hD, one_smul] at this + +omit hx in +/-- `H = ∂F/∂X_{B₀}` is homogeneous of degree `α ⊖ δ`. -/ +theorem H_hom (hD : degreeOf S.B₀ S.F = 1) : IsWeightedHomogeneous wt S.H S.degHD := + isWeightedHomogeneous_pderiv wt S.hom S.B₀ (S.degHD_add hD) + +omit hx in +theorem H_ne_zero : S.H ≠ 0 := pderiv_ne_zero_of_mem_vars S.mem + +omit hx in +/-- Every monomial of `F` contains `X_{B₀}` at most once. -/ +theorem apply_B₀_le_one {d : ι →₀ ℕ} (hD : degreeOf S.B₀ S.F = 1) (hd : d ∈ S.F.support) : + d S.B₀ ≤ 1 := by + have := monomial_le_degreeOf S.B₀ hd + rwa [hD] at this + +omit hx in +/-- Every variable `B` of `H` has `(deg B)_{<β} = 0`. -/ +theorem degLT_eq_zero_of_mem_vars_H {i : ι} (hD : degreeOf S.B₀ S.F = 1) (hi : i ∈ S.H.vars) : + S.degLT i = 0 := by + classical + obtain ⟨d', hd', hid'⟩ := (mem_vars_iff_mem_support i).mp hi + obtain ⟨d, hd, hdv, rfl⟩ := exists_mem_support_of_mem_support_pderiv hd' + have hd1 : d S.B₀ = 1 := + le_antisymm (S.apply_B₀_le_one hD hd) (Nat.one_le_iff_ne_zero.mpr hdv) + -- `i ≠ B₀`, since `B₀` occurs once + have hi0 : i ≠ S.B₀ := by + rintro rfl + rw [Finsupp.mem_support_iff, Finsupp.tsub_apply, Finsupp.single_eq_same, hd1] at hid' + exact hid' rfl + have hid : i ∈ d.support := by + rw [Finsupp.mem_support_iff] at hid' ⊢ + rw [Finsupp.tsub_apply, Finsupp.single_apply, if_neg hi0.symm, Nat.sub_zero] at hid' + exact hid' + -- the parts below `β` of `d` add up to `α_{<β} = (deg B₀)_{<β}`, and `B₀` contributes all of it + have hsum := S.sum_degLT_eq_αLT hd + have hB₀d : S.B₀ ∈ d.support := Finsupp.mem_support_iff.mpr hdv + rw [← Finset.add_sum_erase _ _ hB₀d, hd1, one_smul, S.degLT_B₀ hD] at hsum + have hrest : ∑ j ∈ d.support.erase S.B₀, d j • S.degLT j = 0 := add_eq_left.mp hsum + rw [Finset.sum_eq_zero_iff_of_nonneg (fun j _ ↦ zero_le)] at hrest + have := hrest i (Finset.mem_erase.mpr ⟨hi0, hid⟩) + rcases (smul_eq_zero.mp this) with h | h + · exact absurd h (Finsupp.mem_support_iff.mp hid) + · exact h + +/-! ### Two factors with nonzero parts below `β` -/ + +omit hx in +/-- **The bound on a term of the remainder with two truncated factors.** If `d' · X_i · X_j` is a +monomial of `F`, then `(deg d')_{<β} ⊕ ρᵢ ⊕ ρⱼ ≤ λ₀` for all `ρᵢ < S.degLT i`, +`ρⱼ < S.degLT j`. -/ +theorem pair_bound {d' : ι →₀ ℕ} {i j : ι} + (hd : d' + Finsupp.single i 1 + Finsupp.single j 1 ∈ S.F.support) {ρᵢ ρⱼ : NatOrdinal} + (hρᵢ : ρᵢ < S.degLT i) (hρⱼ : ρⱼ < S.degLT j) : + NatOrdinal.partLT S.β (Finsupp.weight wt d') + ρᵢ + ρⱼ ≤ S.lam₀ := + MvPolynomial.pair_bound_of_forall_termDegree_lt S.hom S.lam₀_lt S.remainder_lt hd hρᵢ hρⱼ + +/-! ### Low-degree parts and the generators considered at a variable -/ + +/-- A variable has a proper low-degree part outside the algebraic bound when its part below the +cutoff is nonzero, differs from the low part of `α`, and does not precede the bound in the +algebraic order. -/ +def HasProperLowDegreePartNotAlgebraicLE (i : ι) : Prop := + i ∈ S.F.vars ∧ S.degLT i ≠ 0 ∧ ¬ S.LowDegreePartEq i ∧ ¬ S.LowDegreePartAlgebraicLE i + +omit hx in +theorem hasProperLowDegreePartNotAlgebraicLE_iff (i : ι) : + S.HasProperLowDegreePartNotAlgebraicLE i ↔ + i ∈ S.F.vars ∧ S.degLT i ≠ 0 ∧ ¬ S.LowDegreePartEq i ∧ + ¬ S.LowDegreePartAlgebraicLE i := Iff.rfl + +omit hx in +/-- For every variable `B` of `F`, `(deg B)_{<β} ≼ α_{<β}` in the algebraic order. -/ +theorem degLT_algebraicLE_αLT {i : ι} (hi : i ∈ S.F.vars) : + NatOrdinal.AlgebraicLE (S.degLT i) S.αLT := by + classical + obtain ⟨d, hd, hid⟩ := (mem_vars_iff_mem_support i).mp hi + have hsum := S.sum_degLT_eq_αLT hd + rw [← Finset.add_sum_erase _ _ hid] at hsum + have h1 : d i • S.degLT i = S.degLT i + (d i - 1) • S.degLT i := by + conv_lhs => rw [show d i = d i - 1 + 1 from + (Nat.sub_add_cancel (Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hid))).symm] + rw [succ_nsmul'] + rw [h1, add_assoc] at hsum + rw [← hsum] + exact NatOrdinal.algebraicLE_add_right _ _ + +omit hx in +/-- A monomial containing `X_i` twice is `d' · X_i · X_i`. -/ +theorem exists_eq_add_single_add_single_self {d : ι →₀ ℕ} {i : ι} (h : 2 ≤ d i) : + ∃ d' : ι →₀ ℕ, d = d' + Finsupp.single i 1 + Finsupp.single i 1 := by + classical + refine ⟨d - Finsupp.single i 1 - Finsupp.single i 1, ?_⟩ + have h1 : Finsupp.single i 1 ≤ d - Finsupp.single i 1 := by + rw [Finsupp.single_le_iff, Finsupp.tsub_apply, Finsupp.single_eq_same] + omega + have h2 : Finsupp.single i 1 ≤ d := Finsupp.single_le_iff.mpr (by omega) + rw [tsub_add_cancel_of_le h1, tsub_add_cancel_of_le h2] + +omit hx in +/-- A monomial containing distinct variables `X_i` and `X_u` is `d' · X_i · X_u`. -/ +theorem exists_eq_add_single_add_single {d : ι →₀ ℕ} {i u : ι} (hi : i ∈ d.support) + (hu : u ∈ d.support) (hui : u ≠ i) : + ∃ d' : ι →₀ ℕ, d = d' + Finsupp.single i 1 + Finsupp.single u 1 := by + classical + refine ⟨d - Finsupp.single i 1 - Finsupp.single u 1, ?_⟩ + have hdi : 1 ≤ d i := Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hi) + have hdu : 1 ≤ d u := Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hu) + have h1 : Finsupp.single u 1 ≤ d - Finsupp.single i 1 := by + rw [Finsupp.single_le_iff, Finsupp.tsub_apply, Finsupp.single_apply, if_neg (Ne.symm hui)] + omega + have h2 : Finsupp.single i 1 ≤ d := Finsupp.single_le_iff.mpr hdi + rw [add_right_comm, tsub_add_cancel_of_le h1, tsub_add_cancel_of_le h2] + +omit hx in +/-- For a monomial `d' · X_i · X_u` of `F`, its three low-degree parts sum to `α_{<β}`. -/ +theorem partLT_weight_add_degLT_add_degLT {d' : ι →₀ ℕ} {i u : ι} + (hd : d' + Finsupp.single i 1 + Finsupp.single u 1 ∈ S.F.support) : + NatOrdinal.partLT S.β (Finsupp.weight wt d') + S.degLT i + S.degLT u = S.αLT := by + rw [S.αLT_def, S.degLT_def, S.degLT_def] + exact MvPolynomial.partLT_weight_add_partLT_add_partLT S.hom hd + +/-- A variable whose proper low-degree part does not precede `λ₀` occurs with exponent `1` in every +monomial of `F` that contains it. -/ +theorem apply_eq_one_of_hasProperLowDegreePartNotAlgebraicLE {i : ι} + (hi : S.HasProperLowDegreePartNotAlgebraicLE i) {d : ι →₀ ℕ} + (hd : d ∈ S.F.support) (hid : i ∈ d.support) : d i = 1 := by + obtain ⟨hiv, ht, -, hdiff⟩ := hi + by_contra hne + have h2 : 2 ≤ d i := by + have := Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hid) + omega + obtain ⟨d', rfl⟩ := exists_eq_add_single_add_single_self h2 + obtain ⟨e, he, hte⟩ := S.exists_leastTerm_degLT hx hiv ht + have hμ := S.partLT_weight_add_degLT_add_degLT hd + have hlμ : S.lam₀ < S.αLT := S.lam₀_lt + exact hdiff ((S.lowDegreePartAlgebraicLE_iff i).mpr + (NatOrdinal.algebraicLE_of_forall_add_add_le ht ht hte hte he (hμ ▸ hlμ) + fun ρ₁ ρ₂ hρ₁ hρ₂ ↦ S.pair_bound hd hρ₁ hρ₂)) + +/-- If a nonzero low-degree factor occurs with a variable whose proper low-degree part does not +precede `λ₀`, its last Cantor exponent is larger and detects the same high window in `λ₀` and +`α_{<β}`. -/ +theorem lt_and_partGE_eq_of_hasProperLowDegreePartNotAlgebraicLE {i : ι} + (hi : S.HasProperLowDegreePartNotAlgebraicLE i) {d : ι →₀ ℕ} + (hd : d ∈ S.F.support) (hid : i ∈ d.support) {u : ι} (hud : u ∈ d.support) + (hui : u ≠ i) (htu : S.degLT u ≠ 0) {eᵢ eᵤ : NatOrdinal} + (heᵢ : NatOrdinal.leastTerm (S.degLT i) = ω^ eᵢ) + (heᵤ : NatOrdinal.leastTerm (S.degLT u) = ω^ eᵤ) : + eᵢ < eᵤ ∧ NatOrdinal.partGE eᵤ S.lam₀ = NatOrdinal.partGE eᵤ S.αLT := by + obtain ⟨hiv, hti, -, hdiff⟩ := id hi + have hdiff' : ¬ NatOrdinal.AlgebraicLE (S.degLT i) S.lam₀ := + fun h ↦ hdiff ((S.lowDegreePartAlgebraicLE_iff i).mpr h) + have hlμ : S.lam₀ < S.αLT := S.lam₀_lt + have he0 : eᵢ ≠ 0 := by + obtain ⟨e', he', hte'⟩ := S.exists_leastTerm_degLT hx hiv hti + rw [heᵢ, NatOrdinal.wpow_inj] at hte' + exact fun h ↦ he' (hte' ▸ h) + obtain ⟨d', rfl⟩ := exists_eq_add_single_add_single hid hud hui + have hμ := S.partLT_weight_add_degLT_add_degLT hd + have hall : ∀ ρ₁ ρ₂ : NatOrdinal, ρ₁ < S.degLT i → ρ₂ < S.degLT u → + NatOrdinal.partLT S.β (Finsupp.weight wt d') + ρ₁ + ρ₂ ≤ S.lam₀ := + fun ρ₁ ρ₂ hρ₁ hρ₂ ↦ S.pair_bound hd hρ₁ hρ₂ + rw [← hμ] + exact NatOrdinal.lt_and_partGE_eq_of_not_algebraicLE hti htu heᵢ heᵤ he0 (hμ ▸ hlμ) hall + hdiff' + +omit hx in +/-- The last term of a finite sum of nonzero natural ordinals is the last term of a summand. -/ +theorem exists_leastTerm_sum_eq {ι' : Type*} {s : Finset ι'} (hs : s.Nonempty) + (f : ι' → NatOrdinal) (hf : ∀ i ∈ s, f i ≠ 0) : + ∃ i ∈ s, NatOrdinal.leastTerm (∑ j ∈ s, f j) = NatOrdinal.leastTerm (f i) := by + classical + induction hs using Finset.Nonempty.cons_induction with + | singleton a => exact ⟨a, Finset.mem_singleton_self a, by rw [Finset.sum_singleton]⟩ + | cons a s ha hs ih => + obtain ⟨i, hi, hi'⟩ := ih fun j hj ↦ hf j (Finset.mem_cons_of_mem hj) + have hsum : ∑ j ∈ s, f j ≠ 0 := by + have hle : f i ≤ ∑ j ∈ s, f j := Finset.single_le_sum (fun j _ ↦ zero_le) hi + exact (lt_of_lt_of_le (pos_iff_ne_zero.mpr (hf i (Finset.mem_cons_of_mem hi))) hle).ne' + rw [Finset.sum_cons, NatOrdinal.leastTerm_add (hf a (Finset.mem_cons_self a s)) hsum] + rcases min_choice (NatOrdinal.leastTerm (f a)) + (NatOrdinal.leastTerm (∑ j ∈ s, f j)) with h | h + · exact ⟨a, Finset.mem_cons_self a s, h⟩ + · exact ⟨i, Finset.mem_cons_of_mem hi, h.trans hi'⟩ + +/-- For a variable whose proper low-degree part does not precede `λ₀`, the last Cantor exponent of +its complementary low degree detects the same high window in `λ₀` and `α_{<β}`. -/ +theorem partGE_lam₀_eq_of_hasProperLowDegreePartNotAlgebraicLE {i : ι} + (hi : S.HasProperLowDegreePartNotAlgebraicLE i) {c ε : NatOrdinal} + (hc : c + S.degLT i = S.αLT) (hε : NatOrdinal.leastTerm c = ω^ ε) : + NatOrdinal.partGE ε S.lam₀ = NatOrdinal.partGE ε S.αLT := by + classical + obtain ⟨hiv, hti, htop, -⟩ := id hi + obtain ⟨d, hd, hid⟩ := (mem_vars_iff_mem_support i).mp hiv + have hd1 := S.apply_eq_one_of_hasProperLowDegreePartNotAlgebraicLE hx hi hd hid + have hsum := S.sum_degLT_eq_αLT hd + rw [← Finset.add_sum_erase _ _ hid, hd1, one_smul, add_comm] at hsum + have hc' : ∑ j ∈ d.support.erase i, d j • S.degLT j = c := + add_right_cancel (hsum.trans hc.symm) + set s := (d.support.erase i).filter fun j ↦ S.degLT j ≠ 0 with hsdef + have hcs : ∑ j ∈ s, d j • S.degLT j = c := by + rw [← hc', hsdef, Finset.sum_filter] + refine Finset.sum_congr rfl fun j _ ↦ ?_ + split_ifs with h + · rfl + · rw [not_not.mp h, smul_zero] + have hc0 : c ≠ 0 := by + rintro rfl + rw [zero_add] at hc + exact htop ((S.lowDegreePartEq_iff i).mpr hc) + have hs : s.Nonempty := by + rw [Finset.nonempty_iff_ne_empty] + intro h + rw [h, Finset.sum_empty] at hcs + exact hc0 hcs.symm + have hsne : ∀ j ∈ s, d j • S.degLT j ≠ 0 := fun j hj ↦ by + obtain ⟨hj, htj⟩ := Finset.mem_filter.mp hj + exact NatOrdinal.nsmul_ne_zero_of_ne_zero htj + (Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp (Finset.mem_erase.mp hj).2)) + obtain ⟨u, hus, hu⟩ := exists_leastTerm_sum_eq hs _ hsne + obtain ⟨hu', htu⟩ := Finset.mem_filter.mp hus + obtain ⟨hui, hud⟩ := Finset.mem_erase.mp hu' + rw [hcs, hε, NatOrdinal.leastTerm_nsmul htu + (Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hud))] at hu + obtain ⟨eᵢ, -, heᵢ⟩ := S.exists_leastTerm_degLT hx hiv hti + exact + (S.lt_and_partGE_eq_of_hasProperLowDegreePartNotAlgebraicLE + hx hi hd hid hud hui htu heᵢ hu.symm).2 + +/-- A variable contributes to the derivative at `v'` when its low-degree part equals `α_{<β}`, or +when it has strictly larger degree and its proper low-degree part does not precede `λ₀`. -/ +def ContributesToPartialDerivativeAt (v' v : ι) : Prop := + v ∈ S.F.vars ∧ (S.LowDegreePartEq v ∨ (S.HasProperLowDegreePartNotAlgebraicLE v ∧ wt v' < wt v)) + +omit hx in +theorem contributesToPartialDerivativeAt_iff (v' v : ι) : + S.ContributesToPartialDerivativeAt v' v ↔ + v ∈ S.F.vars ∧ + (S.LowDegreePartEq v ∨ (S.HasProperLowDegreePartNotAlgebraicLE v ∧ wt v' < wt v)) := + Iff.rfl + +omit hx in +theorem finite_setOf_contributesToPartialDerivativeAt (v' : ι) : + Finite {v // S.ContributesToPartialDerivativeAt v' v} := + (S.F.vars.finite_toSet.subset fun v + (hv : S.ContributesToPartialDerivativeAt v' v) ↦ hv.1).to_subtype + +/-! ### The configuration does not occur -/ + +/-- The packaged polynomial and cutoff hypotheses imply the partial-derivative contradiction. -/ +theorem false_of_lowDegreePartAlgebraicLE_decomposition (hD : degreeOf S.B₀ S.F = 1) + (hpartials : ∀ v', v' ∈ S.F.vars → S.LowDegreePartAlgebraicLE v' → + ∃ (s : Finset ι) (U : ι → MvPolynomial ι K), + (∀ v ∈ s, S.ContributesToPartialDerivativeAt v' v) ∧ + (∀ v ∈ s, pderiv S.B₀ (U v) = 0) ∧ + pderiv v' S.F = ∑ v ∈ s, pderiv v S.F * U v) : + False := by + classical + refine MvPolynomial.false_of_pderiv_eq_sum_of_partLT_ne_zero (lam₀ := S.lam₀) S.hom + (le_of_eq hD) (S.degLT_B₀ hD) (S.H_hom hD) S.H_ne_zero S.degHD_ne_zero fun v' hv' hdiff ↦ ?_ + have hdiff' : S.LowDegreePartAlgebraicLE v' := hdiff + obtain ⟨s, U, hs, hU, heq⟩ := hpartials v' hv' hdiff' + refine ⟨s, U, fun v hv h0 ↦ ?_, hU, heq⟩ + rcases ((S.contributesToPartialDerivativeAt_iff v' v).mp (hs v hv)).2 with htop | ⟨hL, -⟩ + · exact S.αLT_ne_zero hx (by rw [← (S.lowDegreePartEq_iff v).mp htop]; exact h0) + · exact ((S.hasProperLowDegreePartNotAlgebraicLE_iff v).mp hL).2.1 h0 + +end LimitOrdinalRelationAtCutoff + +end HahnSeries.Germ + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LinearMaximal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LinearMaximal.lean new file mode 100644 index 0000000000..d98e58b155 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LinearMaximal.lean @@ -0,0 +1,218 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalRelationAtCutoff +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationExpansion + +/-! +# Linear occurrence of a maximal variable + +The differentiated truncation expansion makes all sufficiently high components of the maximal +partial derivative vanish. If that variable occurred at least twice, ordinal separation would +put the cutoff strictly below the derivative's degree. A sufficiently late translated truncation +then has degree above the cutoff, contradicting the vanishing. +-/ + +universe u v w + +open scoped NatOrdinal Topology + +open Filter MvPolynomial HahnSeries HahnSeries.Nonpositive + +public noncomputable section + +namespace HahnSeries.Germ + +variable {G : Type u} {K : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [Field K] [CharZero K] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := K)) + +variable {ι : Type w} {wt : ι → NatOrdinal.{u}} + {xg : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded} +variable {σ : LiftFamily wt xg} {α : NatOrdinal.{u}} + +namespace LimitOrdinalRelationAtCutoff + +variable (S : LimitOrdinalRelationAtCutoff σ α) +variable (hx : OrdinalGraded.IsMinimalSystem + (DirectSum.rangeLof K (cantorBendixsonDegreeValuation (G := G) (R := K)).Component) wt xg) + +include hx in +/-- Under the cutoff bounds used when the degree is a limit ordinal, a maximal variable occurs +linearly. -/ +@[blueprint "lem:linear-occurrence" + (phase := "Algebraic independence in graded rings") + (title := "Maximal-variable linearity for the Cantor--Bendixson degree") + (statement := /-- + Let $K$ be a field of characteristic zero and $G$ a nontrivial complete + ordered abelian group with compatible additive uniformity and order + topology. Let $x_i$ be a minimal homogeneous generating system for the + associated graded ring of the degree filtration, of weights $w_i$. Choose + series $b_i$ representing $x_i$ such that + \[ + \deg(b_i)\le w_i, + \qquad \deg(b_i^{\vert y}) rw [← NatOrdinal.partGE_add_partLT S.β h] + rw [hhLT] + exact add_lt_add_right hslt _ + have hτα : S.αGE + S.lam₀ ≤ τ + g := by + have htpart : t = NatOrdinal.partLT S.β g := by + rw [htdef, S.degLT_def, hgdef] + have hpart : S.αGE = NatOrdinal.partGE S.β h + NatOrdinal.partGE S.β g := by + have hcongr := congrArg (NatOrdinal.partGE S.β) hhg + rw [NatOrdinal.partGE_add] at hcongr + exact S.αGE_def.trans hcongr.symm + have heq : τ + g = S.αGE + (s + t) := by + calc + τ + g = (NatOrdinal.partGE S.β h + s) + + (NatOrdinal.partGE S.β g + NatOrdinal.partLT S.β g) := by + rw [hτdef, NatOrdinal.partGE_add_partLT] + _ = S.αGE + (s + t) := by rw [hpart, htpart]; abel + rw [heq] + exact add_le_add_right ((lt_add_one S.lam₀).le.trans hs) _ + obtain ⟨l, hl, htrunc⟩ := eventually_nhdsLT_iff_exists.mp S.truncation_lt + have hzero : ∀ γ : G, l < γ → γ < 0 → + componentsGE wt τ (σ.pol hx α + (translatedTruncLE γ (aeval σ.lift Θ))) = 0 := by + intro γ hγ hγ0 + have hτα' : NatOrdinal.partGE S.β α + S.lam₀ ≤ τ + wt S.B₀ := by + rwa [← S.αGE_def, ← hgdef] + have hmem := σ.componentsGE_pol_translatedTruncLE_aeval_pderiv_mem hx hσ hinj S.hom + S.vars_lt S.α₁_le S.α₁_le_α hγ0 (htrunc γ hγ hγ0) S.remainder_lt S.B₀ + (τ := τ) hτα' + rw [← hΘdef] at hmem + have hempty : IsEmpty {j : ι // j ∈ S.F.vars ∧ wt S.B₀ < wt j} := + ⟨fun j ↦ absurd j.2.2 (not_lt.mpr (S.max j.1 j.2.1))⟩ + rwa [Set.range_eq_empty, Ideal.span_empty, Ideal.mem_bot] at hmem + have hbound : τ < h + 0 := by simpa only [add_zero] using hτh + have hh0 : h ≠ 0 := ne_of_gt (zero_le.trans_lt hτh) + apply σ.false_of_forall_weightedTotalDegree_pol_add_lt hx hdegree hh0 + (Or.inl rfl) hbound hl + · intro γ hγ hγ0 hp0 + have hdeglt : weightedTotalDegree wt + (σ.pol hx α (translatedTruncLE γ (aeval σ.lift Θ))) < τ := by + obtain ⟨d, hd, hsup⟩ := Finset.exists_mem_eq_sup _ (support_nonempty.mpr hp0) + (Finsupp.weight wt) + rw [weightedTotalDegree, hsup] + by_contra hnot + have hle : τ ≤ Finsupp.weight wt d := not_lt.mp hnot + have hcoeff := congrArg (MvPolynomial.coeff d) (hzero γ hγ hγ0) + rw [coeff_componentsGE, if_pos hle, MvPolynomial.coeff_zero] at hcoeff + exact mem_support_iff.mp hd hcoeff + simpa only [add_zero] using hdeglt + · exact hhα + +end LimitOrdinalRelationAtCutoff + +end HahnSeries.Germ + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LowerTruncationDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LowerTruncationDegree.lean new file mode 100644 index 0000000000..00c7a47a38 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LowerTruncationDegree.lean @@ -0,0 +1,959 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Lifts +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.PairBounds +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Boundary +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Convolution +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Separation +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood + +/-! +# Lower translated truncations and homogeneous evaluations + +The condition studied here is that a nonpositive series has degree at most `m`, while every proper +translated truncation has degree strictly below `m`. It is preserved by constants, sums, products, +and powers: the finite convolution identity writes a proper truncation of a product as a finite sum +of translated truncation products, and in each summand at least one factor is proper, so every +summand drops. Consequently a weighted homogeneous polynomial evaluated at series satisfying the +corresponding bounds satisfies them at the weighted degree. These estimates are used for the +boundary terms and the cofactors associated with homogeneous ideal generators when the degree is +a limit ordinal. +-/ + +public noncomputable section + +open Set MvPolynomial +open scoped NatOrdinal + +universe u v w + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [Field K] [CharZero K] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := K)) + +/-- The degree is at most `m`, and every proper translated truncation has degree strictly below +`m`. -/ +def HasLowerTruncationDegree (b : Nonpositive G K) (m : NatOrdinal.{u}) : Prop := + ν b ≤ m ∧ ∀ y : G, y < 0 → ν (translatedTruncLE y b) < m + +theorem hasLowerTruncationDegree_iff {b : Nonpositive G K} {m : NatOrdinal.{u}} : + HasLowerTruncationDegree b m ↔ + ν b ≤ m ∧ ∀ y : G, y < 0 → ν (translatedTruncLE y b) < m := + (Iff.rfl) + +theorem HasLowerTruncationDegree.degree_le {b : Nonpositive G K} {m : NatOrdinal.{u}} + (h : HasLowerTruncationDegree b m) : ν b ≤ m := + h.1 + +theorem HasLowerTruncationDegree.degree_translatedTruncLE_lt + {b : Nonpositive G K} {m : NatOrdinal.{u}} + (h : HasLowerTruncationDegree b m) {y : G} (hy : y < 0) : ν (translatedTruncLE y b) < m := + h.2 y hy + +/-- If a series satisfies the bounds at `m`, then every nonpositive translated truncation has +degree at most `m`. -/ +theorem HasLowerTruncationDegree.degree_translatedTruncLE_le + {b : Nonpositive G K} {m : NatOrdinal.{u}} + (h : HasLowerTruncationDegree b m) {y : G} (hy : y ≤ 0) : ν (translatedTruncLE y b) ≤ m := by + rcases eq_or_lt_of_le hy with hy0 | hyneg + · subst hy0 + rw [translatedTruncLE_zero] + exact h.1 + · exact (h.2 y hyneg).le + +/-- The zero series satisfies the bounds at every degree. -/ +theorem hasLowerTruncationDegree_zero (m : NatOrdinal.{u}) : + HasLowerTruncationDegree (0 : Nonpositive G K) m := by + constructor + · rw [(ν).map_zero] + exact bot_le + · intro y _ + rw [map_zero, (ν).map_zero] + exact WithBot.bot_lt_coe m + +/-- A constant series satisfies the bounds at degree zero. -/ +theorem hasLowerTruncationDegree_algebraMap (k : K) : + HasLowerTruncationDegree (algebraMap K (Nonpositive G K) k) 0 := by + constructor + · rw [algebraMap_apply] + exact degree_C_le k + · intro y hy + rw [degree_translatedTruncLE_eq, if_neg ?_] + · exact WithBot.bot_lt_coe 0 + · intro hmem + have hclos := (mem_closedSupport _ _).mp hmem + have hsub : ((algebraMap K (Nonpositive G K) k : Nonpositive G K) : + HahnSeries G K).support ⊆ {0} := by + rw [algebraMap_apply, coe_C, HahnSeries.C_apply] + exact HahnSeries.support_single_subset + have hy0 : y ∈ ({0} : Set G) := + closure_minimal hsub isClosed_singleton hclos + exact hy.ne (mem_singleton_iff.mp hy0) + +/-- The identity series satisfies the bounds at degree zero. -/ +theorem hasLowerTruncationDegree_one : HasLowerTruncationDegree (1 : Nonpositive G K) 0 := by + have h := hasLowerTruncationDegree_algebraMap (G := G) (K := K) 1 + rwa [map_one] at h + +/-- Sums preserve the bounds at a common degree. -/ +theorem HasLowerTruncationDegree.add {a b : Nonpositive G K} {m : NatOrdinal.{u}} + (ha : HasLowerTruncationDegree a m) (hb : HasLowerTruncationDegree b m) : + HasLowerTruncationDegree (a + b) m := by + constructor + · exact ((ν).map_add_le_max a b).trans (max_le ha.1 hb.1) + · intro y hy + rw [map_add] + exact ((ν).map_add_le_max _ _).trans_lt (max_lt (ha.2 y hy) (hb.2 y hy)) + +/-- If two series satisfy the bounds at `m` and `n`, their product satisfies them at `m + n`: in +the finite convolution of a proper product truncation, every summand has a proper factor. -/ +theorem HasLowerTruncationDegree.mul {a b : Nonpositive G K} {m n p : NatOrdinal.{u}} + (hp : p = m + n) (ha : HasLowerTruncationDegree a m) + (hb : HasLowerTruncationDegree b n) : HasLowerTruncationDegree (a * b) p := by + subst hp + constructor + · exact ((ν).map_mul_le_add a b).trans (by + rw [WithBot.coe_add] + exact add_le_add ha.1 hb.1) + · intro y hy + classical + have herr : ν (translatedTruncLE y (a * b) - + ∑ q ∈ (a : HahnSeries G K).closedSupportAddFiber (b : HahnSeries G K) y, + translatedTruncLE q.1 a * translatedTruncLE q.2 b) = ⊥ := by + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply] + have hcoe : ((translatedTruncLE y (a * b) - + ∑ q ∈ (a : HahnSeries G K).closedSupportAddFiber (b : HahnSeries G K) y, + translatedTruncLE q.1 a * translatedTruncLE q.2 b : Nonpositive G K) : + HahnSeries G K) = + translate (-y) (truncLE y ((a : HahnSeries G K) * (b : HahnSeries G K))) - + ∑ q ∈ (a : HahnSeries G K).closedSupportAddFiber (b : HahnSeries G K) y, + translate (-q.1) (truncLE q.1 (a : HahnSeries G K)) * + translate (-q.2) (truncLE q.2 (b : HahnSeries G K)) := by + simp only [AddSubgroupClass.coe_sub, AddSubmonoidClass.coe_finsetSum, + Subring.coe_mul, coe_translatedTruncLE] + rw [hcoe, (a : HahnSeries G K).cantorBendixsonValue_convolution_error + (b : HahnSeries G K) y, NatOrdinal.of_zero, NatOrdinal.cantorDegree_zero] + have hsum : ν (∑ q ∈ (a : HahnSeries G K).closedSupportAddFiber (b : HahnSeries G K) y, + translatedTruncLE q.1 a * translatedTruncLE q.2 b) < (m + n : NatOrdinal) := by + apply (ν).map_sum_lt_of_forall_lt _ _ (WithBot.bot_lt_coe _) + intro q hq + obtain ⟨hq1, hq2, hqsum⟩ := ((a : HahnSeries G K).mem_closedSupportAddFiber + (b : HahnSeries G K) y q).mp hq + have hq1le : q.1 ≤ 0 := closure_minimal a.property isClosed_Iic + ((mem_closedSupport _ _).mp hq1) + have hq2le : q.2 ≤ 0 := closure_minimal b.property isClosed_Iic + ((mem_closedSupport _ _).mp hq2) + have hone : q.1 < 0 ∨ q.2 < 0 := by + rcases lt_or_eq_of_le hq1le with hq1neg | hq1zero + · exact Or.inl hq1neg + · refine Or.inr ?_ + have hq2y : q.2 = y := by + rw [← hqsum, hq1zero, zero_add] + exact hq2y ▸ hy + rcases hone with hq1neg | hq2neg + · rw [mul_comm] + exact degree_mul_lt_of_le_of_lt_of_separated (translatedTruncLE q.2 b) + (translatedTruncLE q.1 a) n m (m + n) (hb.degree_translatedTruncLE_le hq2le) + (ha.2 q.1 hq1neg) (fun θ hθ ↦ by + rw [add_comm m n] + exact add_lt_add_of_le_of_lt le_rfl hθ) + · exact degree_mul_lt_of_le_of_lt_of_separated (translatedTruncLE q.1 a) + (translatedTruncLE q.2 b) m n (m + n) (ha.degree_translatedTruncLE_le hq1le) + (hb.2 q.2 hq2neg) (fun θ hθ ↦ add_lt_add_of_le_of_lt le_rfl hθ) + have hsplit : translatedTruncLE y (a * b) = + (translatedTruncLE y (a * b) - + ∑ q ∈ (a : HahnSeries G K).closedSupportAddFiber (b : HahnSeries G K) y, + translatedTruncLE q.1 a * translatedTruncLE q.2 b) + + ∑ q ∈ (a : HahnSeries G K).closedSupportAddFiber (b : HahnSeries G K) y, + translatedTruncLE q.1 a * translatedTruncLE q.2 b := by + abel + rw [hsplit] + exact ((ν).map_add_le_max _ _).trans_lt + (max_lt (by rw [herr]; exact WithBot.bot_lt_coe _) hsum) + +/-- If a series satisfies the bounds at `m`, its `n`th power satisfies them at `n • m`. -/ +theorem HasLowerTruncationDegree.pow {b : Nonpositive G K} {m : NatOrdinal.{u}} + (hb : HasLowerTruncationDegree b m) (n : ℕ) : HasLowerTruncationDegree (b ^ n) (n • m) := by + induction n with + | zero => + rw [pow_zero, zero_smul] + exact hasLowerTruncationDegree_one + | succ n ih => + rw [pow_succ] + exact ih.mul (succ_nsmul m n) hb + +/-- A finite product satisfies the bounds at the sum of the assigned degrees. -/ +theorem hasLowerTruncationDegree_prod {ι' : Type w} {s : Finset ι'} {a : ι' → Nonpositive G K} + {m : ι' → NatOrdinal.{u}} (h : ∀ i ∈ s, HasLowerTruncationDegree (a i) (m i)) : + HasLowerTruncationDegree (∏ i ∈ s, a i) (∑ i ∈ s, m i) := by + classical + induction s using Finset.cons_induction with + | empty => + rw [Finset.prod_empty, Finset.sum_empty] + exact hasLowerTruncationDegree_one + | cons i s hi ih => + rw [Finset.prod_cons] + exact (h i (Finset.mem_cons_self i s)).mul (Finset.sum_cons hi) + (ih fun j hj ↦ h j (Finset.mem_cons_of_mem hj)) + +variable {ι : Type w} {wt : ι → NatOrdinal.{u}} {V : ι → Nonpositive G K} + +/-- A weighted homogeneous polynomial evaluated at series satisfying the assigned bounds also +satisfies the bounds at its weight. -/ +theorem hasLowerTruncationDegree_aeval (hV : ∀ i, HasLowerTruncationDegree (V i) (wt i)) + {F : MvPolynomial ι K} {β : NatOrdinal.{u}} (hF : IsWeightedHomogeneous wt F β) : + HasLowerTruncationDegree (aeval V F) β := by + classical + induction hF using IsWeightedHomogeneous.induction_on with + | zero => + rw [map_zero] + exact hasLowerTruncationDegree_zero β + | add p q hp hq ihp ihq => + rw [map_add] + exact ihp.add ihq + | monomial d r hr => + rw [← hr, aeval_monomial, Finsupp.weight_apply, Finsupp.sum, Finsupp.prod] + exact (hasLowerTruncationDegree_algebraMap r).mul (zero_add _).symm + (hasLowerTruncationDegree_prod fun i _ ↦ (hV i).pow (d i)) + +/-- **The uniform polynomial window.** If every homogeneous class of degree below `α` is a +homogeneous polynomial in the prescribed classes, then every proper translated truncation of the +evaluation of a weighted homogeneous polynomial of degree `β` at such representatives is +congruent, +modulo series bounded strictly below zero, to the evaluation of a polynomial all of whose +monomial weights are strictly below `β`. The bound is uniform in the cutoff: it does not degrade +as the cutoff approaches zero, and no cofinal sequence of cutoffs is chosen. -/ +theorem exists_forall_weight_lt_and_degree_translatedTruncLE_sub_aeval_eq_bot + (xg : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded) + (hVrep : ∀ i, Represents (V i) (wt i) (xg i)) + (hV : ∀ i, HasLowerTruncationDegree (V i) (wt i)) + (α : NatOrdinal.{u}) + (hgen : ∀ β : NatOrdinal.{u}, β < α → + ∀ y ∈ DirectSum.rangeLof K + (cantorBendixsonDegreeValuation (G := G) (R := K)).Component β, + ∃ F : MvPolynomial ι K, IsWeightedHomogeneous wt F β ∧ MvPolynomial.aeval xg F = y) + {F : MvPolynomial ι K} {β : NatOrdinal.{u}} (hF : IsWeightedHomogeneous wt F β) + (hβα : β < α) {γ : G} (hγ : γ < 0) : + ∃ F' : MvPolynomial ι K, (∀ d ∈ F'.support, (Finsupp.weight wt) d < β) ∧ + ν (translatedTruncLE γ (aeval V F) - aeval V F') = ⊥ := by + have hdrop : ν (translatedTruncLE γ (aeval V F)) < (β : WithBot NatOrdinal) := + (hasLowerTruncationDegree_aeval hV hF).degree_translatedTruncLE_lt hγ + obtain ⟨F', hF'd, -, hF'bot⟩ := + exists_forall_weight_lt_and_degree_sub_aeval_eq_bot xg hVrep α hgen + (translatedTruncLE γ (aeval V F)) (hdrop.trans (WithBot.coe_lt_coe.mpr hβα)) + refine ⟨F', fun d hd ↦ ?_, hF'bot⟩ + exact WithBot.coe_lt_coe.mp ((hF'd d hd).trans_lt hdrop) + +private theorem degree_mul_le_of_lt_of_lt_of_bound {p q : Nonpositive G K} + {σ₁ σ₂ B : NatOrdinal.{u}} (hp : ν p < (σ₁ : WithBot NatOrdinal)) + (hq : ν q < (σ₂ : WithBot NatOrdinal)) + (hB : ∀ θ₁ θ₂ : NatOrdinal.{u}, θ₁ < σ₁ → θ₂ < σ₂ → θ₁ + θ₂ ≤ B) : + ν (p * q) ≤ (B : WithBot NatOrdinal) := by + have hmul := (ν).map_mul_le_add p q + cases hp' : ν p using WithBot.recBotCoe with + | bot => + rw [hp', WithBot.bot_add] at hmul + exact hmul.trans bot_le + | coe θ₁ => + cases hq' : ν q using WithBot.recBotCoe with + | bot => + rw [hq', WithBot.add_bot] at hmul + exact hmul.trans bot_le + | coe θ₂ => + rw [hp', hq', ← WithBot.coe_add] at hmul + refine hmul.trans (WithBot.coe_le_coe.mpr (hB θ₁ θ₂ ?_ ?_)) + · rwa [hp', WithBot.coe_lt_coe] at hp + · rwa [hq', WithBot.coe_lt_coe] at hq + +/-- **The uniform two-truncation window.** For series satisfying the bounds at nonzero degrees, +the Leibniz remainder of a product -- the finite convolution with both boundary terms removed -- +is bounded by a single degree strictly below the product degree, uniformly in the cutoff. Every +interior term of the convolution truncates both factors, so its degree is a natural sum with both +summands lowered, and the ordinal two-summand bound is uniform. -/ +theorem exists_lt_forall_degree_leibnizRemainder_le + {a b : Nonpositive G K} {σ₁ σ₂ : NatOrdinal.{u}} + (ha : HasLowerTruncationDegree a σ₁) (hb : HasLowerTruncationDegree b σ₂) + (hσ₁ : σ₁ ≠ 0) (hσ₂ : σ₂ ≠ 0) : + ∃ μ' : NatOrdinal.{u}, μ' < σ₁ + σ₂ ∧ ∀ γ : G, γ < 0 → + ν (translatedTruncLE γ (a * b) - translatedTruncLE γ a * b - + a * translatedTruncLE γ b) ≤ (μ' : WithBot NatOrdinal) := by + classical + obtain ⟨e₁, he₁⟩ := NatOrdinal.exists_leastTerm_eq_wpow hσ₁ + obtain ⟨e₂, he₂⟩ := NatOrdinal.exists_leastTerm_eq_wpow hσ₂ + obtain ⟨B, hBlt, hBbound⟩ := + NatOrdinal.exists_lt_forall_add_add_le (O := 0) hσ₁ hσ₂ he₁ he₂ + have hBbound' : ∀ θ₁ θ₂ : NatOrdinal.{u}, θ₁ < σ₁ → θ₂ < σ₂ → θ₁ + θ₂ ≤ B := by + intro θ₁ θ₂ h₁ h₂ + have := hBbound θ₁ θ₂ h₁ h₂ + rwa [zero_add] at this + refine ⟨B, by rwa [zero_add] at hBlt, fun γ hγ ↦ ?_⟩ + have hremValue := HahnSeries.cantorBendixsonValue_leibnizRemainder_lt_of_forall + (a : HahnSeries G K) (b : HahnSeries G K) a.property b.property hγ + (ρ := (ω^ (B + 1)).val) (NatOrdinal.wpow_pos (B + 1)) (fun x y _ hx _ hy _ ↦ by + have hprod : ν (translatedTruncLE x a * translatedTruncLE y b) < + ((B + 1 : NatOrdinal) : WithBot NatOrdinal) := + (degree_mul_le_of_lt_of_lt_of_bound (ha.degree_translatedTruncLE_lt hx) + (hb.degree_translatedTruncLE_lt hy) hBbound').trans_lt + (WithBot.coe_lt_coe.mpr (lt_add_one B)) + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + NatOrdinal.cantorDegree_lt_coe_iff] at hprod + exact NatOrdinal.of.lt_iff_lt.mp + (by simpa only [coe_translatedTruncLE, Subring.coe_mul, NatOrdinal.of_val] using hprod)) + have hrem : ν (translatedTruncLE γ (a * b) - translatedTruncLE γ a * b - + a * translatedTruncLE γ b) < ((B + 1 : NatOrdinal) : WithBot NatOrdinal) := by + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + NatOrdinal.cantorDegree_lt_coe_iff] + change NatOrdinal.of (((translatedTruncLE γ (a * b) : Nonpositive G K) : HahnSeries G K) - + (translatedTruncLE γ a : Nonpositive G K) * b - + (a : HahnSeries G K) * translatedTruncLE γ b).cantorBendixsonValue < ω^ (B + 1) + exact NatOrdinal.of.lt_iff_lt.mpr (by + simpa only [coe_translatedTruncLE, Subring.coe_mul, NatOrdinal.val_wpow] using hremValue) + cases hv : ν (translatedTruncLE γ (a * b) - translatedTruncLE γ a * b - + a * translatedTruncLE γ b) using WithBot.recBotCoe with + | bot => exact bot_le + | coe d => + rw [hv, WithBot.coe_lt_coe] at hrem + exact WithBot.coe_le_coe.mpr (Order.lt_add_one_iff.mp hrem) + +/-! ### Congruence modulo series bounded strictly below zero -/ + +theorem degree_mul_eq_bot_of_left {a b : Nonpositive G K} (ha : ν a = ⊥) : ν (a * b) = ⊥ := by + have := (ν).map_mul_le_add a b + rw [ha, WithBot.bot_add] at this + exact le_bot_iff.mp this + +theorem degree_mul_eq_bot_of_right {a b : Nonpositive G K} (hb : ν b = ⊥) : ν (a * b) = ⊥ := by + have := (ν).map_mul_le_add a b + rw [hb, WithBot.add_bot] at this + exact le_bot_iff.mp this + +/-- Congruence modulo series bounded strictly below zero is multiplicative. -/ +theorem degree_sub_eq_bot_mul {a a' b b' : Nonpositive G K} + (ha : ν (a - a') = ⊥) (hb : ν (b - b') = ⊥) : ν (a * b - a' * b') = ⊥ := by + have hsplit : a * b - a' * b' = a * (b - b') + (a - a') * b' := by ring + rw [hsplit] + refine le_bot_iff.mp (((ν).map_add_le_max _ _).trans ?_) + rw [degree_mul_eq_bot_of_right hb, degree_mul_eq_bot_of_left ha, max_self] + +/-- Congruence modulo series bounded strictly below zero is additive over finite sums. -/ +theorem degree_sub_eq_bot_sum {ι' : Type w} (s : Finset ι') (f g : ι' → Nonpositive G K) + (h : ∀ i ∈ s, ν (f i - g i) = ⊥) : + ν ((∑ i ∈ s, f i) - ∑ i ∈ s, g i) = ⊥ := by + classical + rw [← Finset.sum_sub_distrib] + exact le_bot_iff.mp ((ν).map_sum_le_of_forall_le _ _ ⊥ fun i hi ↦ (h i hi).le) + +/-- The finite convolution identity in degree form: a translated truncation of a product agrees, +modulo series bounded strictly below zero, with the finite sum over the closed-support fiber of +the products of translated truncations. -/ +theorem degree_translatedTruncLE_mul_sub_sum_eq_bot (b d : Nonpositive G K) (γ : G) : + ν (translatedTruncLE γ (b * d) - + ∑ q ∈ (b : HahnSeries G K).closedSupportAddFiber (d : HahnSeries G K) γ, + translatedTruncLE q.1 b * translatedTruncLE q.2 d) = ⊥ := by + classical + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply] + have hcoe : ((translatedTruncLE γ (b * d) - + ∑ q ∈ (b : HahnSeries G K).closedSupportAddFiber (d : HahnSeries G K) γ, + translatedTruncLE q.1 b * translatedTruncLE q.2 d : Nonpositive G K) : + HahnSeries G K) = + translate (-γ) (truncLE γ ((b : HahnSeries G K) * (d : HahnSeries G K))) - + ∑ q ∈ (b : HahnSeries G K).closedSupportAddFiber (d : HahnSeries G K) γ, + translate (-q.1) (truncLE q.1 (b : HahnSeries G K)) * + translate (-q.2) (truncLE q.2 (d : HahnSeries G K)) := by + simp only [AddSubgroupClass.coe_sub, AddSubmonoidClass.coe_finsetSum, + Subring.coe_mul, coe_translatedTruncLE] + rw [hcoe, (b : HahnSeries G K).cantorBendixsonValue_convolution_error + (d : HahnSeries G K) γ, NatOrdinal.of_zero, NatOrdinal.cantorDegree_zero] + +variable {ι : Type w} {wt : ι → NatOrdinal.{u}} {V : ι → Nonpositive G K} + +/-- **The convolution polynomial identity.** If polynomials represent the translated truncations +of two factors at every cutoff, then the convolution sum of those polynomials over the +closed-support fiber represents the translated truncation of the product. No canonical choice of +representing polynomial is needed: any choices work, because congruence modulo series bounded +strictly below zero is a ring congruence. -/ +theorem degree_translatedTruncLE_mul_sub_aeval_sum_eq_bot + (b d : Nonpositive G K) (γ : G) + (Fb Fd : G → MvPolynomial ι K) + (hFb : ∀ x : G, ν (translatedTruncLE x b - aeval V (Fb x)) = ⊥) + (hFd : ∀ y : G, ν (translatedTruncLE y d - aeval V (Fd y)) = ⊥) : + ν (translatedTruncLE γ (b * d) - + aeval V (∑ q ∈ (b : HahnSeries G K).closedSupportAddFiber (d : HahnSeries G K) γ, + Fb q.1 * Fd q.2)) = ⊥ := by + classical + set S := (b : HahnSeries G K).closedSupportAddFiber (d : HahnSeries G K) γ with hS + have hterm : ∀ q ∈ S, ν (translatedTruncLE q.1 b * translatedTruncLE q.2 d - + aeval V (Fb q.1 * Fd q.2)) = ⊥ := by + intro q _ + rw [map_mul] + exact degree_sub_eq_bot_mul (hFb q.1) (hFd q.2) + have hsum : ν ((∑ q ∈ S, translatedTruncLE q.1 b * translatedTruncLE q.2 d) - + ∑ q ∈ S, aeval V (Fb q.1 * Fd q.2)) = ⊥ := + degree_sub_eq_bot_sum S _ _ hterm + have hsplit : translatedTruncLE γ (b * d) - + aeval V (∑ q ∈ S, Fb q.1 * Fd q.2) = + (translatedTruncLE γ (b * d) - + ∑ q ∈ S, translatedTruncLE q.1 b * translatedTruncLE q.2 d) + + ((∑ q ∈ S, translatedTruncLE q.1 b * translatedTruncLE q.2 d) - + ∑ q ∈ S, aeval V (Fb q.1 * Fd q.2)) := by + rw [map_sum] + abel + rw [hsplit] + refine le_bot_iff.mp (((ν).map_add_le_max _ _).trans ?_) + rw [degree_translatedTruncLE_mul_sub_sum_eq_bot b d γ, hsum, max_self] + +/-- **The power Leibniz rule with a uniform remainder.** For a series of nonzero lower-truncation +degree, +the translated truncation of a power differs from the expected single-truncation term by a +remainder bounded by a fixed degree strictly below the power degree, uniformly in the cutoff. +Each step of the induction uses the two-factor window and absorbs the previous remainder. -/ +theorem exists_lt_forall_degree_pow_leibniz_le {a : Nonpositive G K} {m : NatOrdinal.{u}} + (ha : HasLowerTruncationDegree a m) (hm : m ≠ 0) (n : ℕ) : + ∃ lam : NatOrdinal.{u}, lam < (n + 1) • m ∧ ∀ γ : G, γ < 0 → + ν (translatedTruncLE γ (a ^ (n + 1)) - + (n + 1 : ℕ) • (translatedTruncLE γ a * a ^ n)) ≤ (lam : WithBot NatOrdinal) := by + induction n with + | zero => + refine ⟨0, ?_, fun γ _ ↦ ?_⟩ + · simpa only [zero_add, one_smul] using pos_iff_ne_zero.mpr hm + · simp only [zero_add, pow_one, pow_zero, mul_one, one_smul, sub_self] + rw [(ν).map_zero] + exact bot_le + | succ n ih => + obtain ⟨lam, hlam, hbound⟩ := ih + have hpow : HasLowerTruncationDegree (a ^ (n + 1)) ((n + 1) • m) := ha.pow (n + 1) + have hne : ((n + 1) • m : NatOrdinal) ≠ 0 := by + intro h0 + have hle : m ≤ (n + 1) • m := by + have h1 : (1 : ℕ) • m ≤ (n + 1) • m := + nsmul_le_nsmul_left (zero_le (a := m)) (by omega) + simpa only [one_smul] using h1 + exact hm (le_antisymm (h0 ▸ hle) (zero_le (a := m))) + obtain ⟨B, hBlt, hBbound⟩ := + exists_lt_forall_degree_leibnizRemainder_le ha hpow hm hne + have hsucc : (n + 1 + 1) • m = m + (n + 1) • m := by + rw [succ_nsmul, add_comm] + refine ⟨max B (m + lam), ?_, fun γ hγ ↦ ?_⟩ + · rw [hsucc] + exact max_lt hBlt (add_lt_add_of_le_of_lt le_rfl hlam) + · have hsplit : translatedTruncLE γ (a ^ (n + 1 + 1)) - + (n + 1 + 1 : ℕ) • (translatedTruncLE γ a * a ^ (n + 1)) = + (translatedTruncLE γ (a * a ^ (n + 1)) - + translatedTruncLE γ a * a ^ (n + 1) - a * translatedTruncLE γ (a ^ (n + 1))) + + a * (translatedTruncLE γ (a ^ (n + 1)) - + (n + 1 : ℕ) • (translatedTruncLE γ a * a ^ n)) := by + have hpowsucc : a ^ (n + 1 + 1) = a * a ^ (n + 1) := by ring + have hmulsmul : a * ((n + 1 : ℕ) • (translatedTruncLE γ a * a ^ n)) = + (n + 1 : ℕ) • (translatedTruncLE γ a * a ^ (n + 1)) := by + rw [mul_smul_comm] + congr 1 + rw [pow_succ] + ring + rw [hpowsucc, mul_sub, hmulsmul, succ_nsmul, add_smul, one_smul] + abel + rw [hsplit] + refine ((ν).map_add_le_max _ _).trans (max_le ?_ ?_) + · exact (hBbound γ hγ).trans (WithBot.coe_le_coe.mpr (le_max_left _ _)) + · refine ((ν).map_mul_le_add a _).trans ?_ + refine (add_le_add ha.degree_le (hbound γ hγ)).trans ?_ + rw [← WithBot.coe_add] + exact WithBot.coe_le_coe.mpr (le_max_right _ _) + +/-! ### The monomial Leibniz expansion -/ + +open Finsupp in +/-- **The monomial Leibniz expansion with a uniform remainder.** The translated truncation of a +monomial evaluated at series satisfying the assigned bounds differs from the sum of its evaluated +partial derivatives against the truncated variables by a remainder bounded by a fixed degree +strictly below the monomial degree, uniformly in the cutoff. The induction peels one power block +at a time, using the two-factor window to separate it and the power rule inside it. -/ +theorem exists_lt_forall_degree_monomial_leibniz_le + (hV : ∀ i, HasLowerTruncationDegree (V i) (wt i)) (hwt : ∀ i, wt i ≠ 0) (t : Finset ι) : + ∀ d : ι →₀ ℕ, d ≠ 0 → d.support ⊆ t → + ∃ lam : NatOrdinal.{u}, lam < Finsupp.weight wt d ∧ ∀ γ : G, γ < 0 → + ν (translatedTruncLE γ (aeval V (MvPolynomial.monomial d (1 : K))) - + ∑ i ∈ t, aeval V (MvPolynomial.pderiv i (MvPolynomial.monomial d (1 : K))) * + translatedTruncLE γ (V i)) ≤ (lam : WithBot NatOrdinal) := by + classical + intro d + induction d using Finsupp.induction with + | zero => exact fun h ↦ absurd rfl h + | @single_add i b d' hi hb ih => + intro _ hsupp + have hit : i ∈ t := by + apply hsupp + rw [Finsupp.support_add_eq (by + rw [Finsupp.support_single i hb] + exact Finset.disjoint_singleton_left.mpr hi)] + exact Finset.mem_union_left _ (by + rw [Finsupp.support_single i hb] + exact Finset.mem_singleton_self i) + have hweight : Finsupp.weight wt (Finsupp.single i b + d') = + b • wt i + Finsupp.weight wt d' := by + rw [map_add, Finsupp.weight_single] + obtain ⟨n, rfl⟩ : ∃ n, b = n + 1 := ⟨b - 1, by omega⟩ + -- The monomial splits into a power block and the rest. + have hsplit : (MvPolynomial.monomial (Finsupp.single i (n + 1) + d') (1 : K)) = + MvPolynomial.X i ^ (n + 1) * MvPolynomial.monomial d' (1 : K) := + MvPolynomial.monomial_single_add + have hpowBounds : HasLowerTruncationDegree (V i ^ (n + 1)) ((n + 1) • wt i) := + (hV i).pow (n + 1) + have hpowne : ((n + 1) • wt i : NatOrdinal) ≠ 0 := by + intro h0 + have hle : wt i ≤ (n + 1) • wt i := by + have h1 : (1 : ℕ) • wt i ≤ (n + 1) • wt i := + nsmul_le_nsmul_left (zero_le (a := wt i)) (by omega) + simpa only [one_smul] using h1 + exact hwt i (le_antisymm (h0 ▸ hle) (zero_le (a := wt i))) + -- The evaluated partial derivatives of the power block. + have hpderivPow : ∀ j : ι, aeval V (MvPolynomial.pderiv j + (MvPolynomial.X i ^ (n + 1) : MvPolynomial ι K)) = + if j = i then (n + 1 : ℕ) • (V i ^ n) else 0 := by + intro j + rw [MvPolynomial.pderiv_pow, MvPolynomial.pderiv_X] + by_cases hji : j = i + · subst hji + rw [Pi.single_eq_same, if_pos rfl, mul_one, map_mul, map_pow, MvPolynomial.aeval_X, + map_natCast, Nat.add_sub_cancel, nsmul_eq_mul] + · rw [Pi.single_eq_of_ne (Ne.symm hji), if_neg hji, mul_zero, map_zero] + have hA : aeval V (MvPolynomial.monomial (Finsupp.single i (n + 1) + d') (1 : K)) = + V i ^ (n + 1) * aeval V (MvPolynomial.monomial d' (1 : K)) := by + rw [hsplit, map_mul, map_pow, MvPolynomial.aeval_X] + -- The evaluated partial derivatives of the whole monomial split by the Leibniz rule. + have hsum : ∀ γ : G, + ∑ j ∈ t, aeval V (MvPolynomial.pderiv j + (MvPolynomial.monomial (Finsupp.single i (n + 1) + d') (1 : K))) * + translatedTruncLE γ (V j) = + ((n + 1 : ℕ) • (V i ^ n) * aeval V (MvPolynomial.monomial d' (1 : K))) * + translatedTruncLE γ (V i) + + V i ^ (n + 1) * + ∑ j ∈ t, aeval V (MvPolynomial.pderiv j (MvPolynomial.monomial d' (1 : K))) * + translatedTruncLE γ (V j) := by + intro γ + have hterm : ∀ j ∈ t, aeval V (MvPolynomial.pderiv j + (MvPolynomial.monomial (Finsupp.single i (n + 1) + d') (1 : K))) * + translatedTruncLE γ (V j) = + (if j = i then ((n + 1 : ℕ) • (V i ^ n) * + aeval V (MvPolynomial.monomial d' (1 : K))) * translatedTruncLE γ (V i) else 0) + + V i ^ (n + 1) * (aeval V (MvPolynomial.pderiv j + (MvPolynomial.monomial d' (1 : K))) * translatedTruncLE γ (V j)) := by + intro j _ + have e1 : aeval V (MvPolynomial.pderiv j (MvPolynomial.X i ^ (n + 1)) * + MvPolynomial.monomial d' (1 : K)) = + (if j = i then (n + 1 : ℕ) • (V i ^ n) else 0) * + aeval V (MvPolynomial.monomial d' (1 : K)) := by + rw [map_mul, hpderivPow j] + have e2 : aeval V ((MvPolynomial.X i ^ (n + 1) : MvPolynomial ι K) * + MvPolynomial.pderiv j (MvPolynomial.monomial d' (1 : K))) = + V i ^ (n + 1) * aeval V (MvPolynomial.pderiv j + (MvPolynomial.monomial d' (1 : K))) := by + rw [map_mul, map_pow, MvPolynomial.aeval_X] + rw [hsplit, MvPolynomial.pderiv_mul, map_add, e1, e2, add_mul] + congr 1 + · by_cases hji : j = i + · rw [if_pos hji, if_pos hji, hji] + · rw [if_neg hji, if_neg hji, zero_mul, zero_mul] + · ring + rw [Finset.sum_congr rfl hterm, Finset.sum_add_distrib, ← Finset.mul_sum, + Finset.sum_ite_eq' t i (fun _ ↦ ((n + 1 : ℕ) • (V i ^ n) * + aeval V (MvPolynomial.monomial d' (1 : K))) * translatedTruncLE γ (V i)), + if_pos hit] + obtain ⟨lamA, hlamA, hboundA⟩ := + exists_lt_forall_degree_pow_leibniz_le (hV i) (hwt i) n + by_cases hd0 : d' = 0 + · subst hd0 + refine ⟨lamA, ?_, fun γ hγ ↦ ?_⟩ + · rw [hweight, map_zero, add_zero] + exact hlamA + · have hone : aeval V (MvPolynomial.monomial (0 : ι →₀ ℕ) (1 : K)) = 1 := by + simp + have hinner : ∑ j ∈ t, aeval V (MvPolynomial.pderiv j + (MvPolynomial.monomial (0 : ι →₀ ℕ) (1 : K))) * translatedTruncLE γ (V j) = 0 := by + refine Finset.sum_eq_zero fun j _ ↦ ?_ + rw [MvPolynomial.monomial_zero', MvPolynomial.pderiv_C, map_zero, zero_mul] + have hgoal : translatedTruncLE γ + (aeval V (MvPolynomial.monomial (Finsupp.single i (n + 1) + 0) (1 : K))) - + ∑ j ∈ t, aeval V (MvPolynomial.pderiv j + (MvPolynomial.monomial (Finsupp.single i (n + 1) + 0) (1 : K))) * + translatedTruncLE γ (V j) = + translatedTruncLE γ (V i ^ (n + 1)) - + (n + 1 : ℕ) • (translatedTruncLE γ (V i) * V i ^ n) := by + rw [hsum γ, hA, hone, hinner] + ring_nf + rw [hgoal] + exact hboundA γ hγ + · obtain ⟨lamB, hlamB, hboundB⟩ := ih hd0 (fun j hj ↦ hsupp (by + rw [Finsupp.support_add_eq (by + rw [Finsupp.support_single i hb] + exact Finset.disjoint_singleton_left.mpr hi)] + exact Finset.mem_union_right _ hj)) + have hBhom : IsWeightedHomogeneous wt (MvPolynomial.monomial d' (1 : K)) + (Finsupp.weight wt d') := + MvPolynomial.isWeightedHomogeneous_monomial wt d' 1 rfl + have hBBounds : HasLowerTruncationDegree (aeval V (MvPolynomial.monomial d' (1 : K))) + (Finsupp.weight wt d') := hasLowerTruncationDegree_aeval hV hBhom + have hBne : Finsupp.weight wt d' ≠ 0 := by + intro h0 + obtain ⟨j, hj⟩ := Finsupp.support_nonempty_iff.mpr hd0 + have hle : wt j ≤ Finsupp.weight wt d' := + Finsupp.le_weight_of_ne_zero (w := wt) (fun _ ↦ zero_le (a := wt _)) + (Finsupp.mem_support_iff.mp hj) + exact hwt j (le_antisymm (h0 ▸ hle) (zero_le (a := wt j))) + obtain ⟨Bwin, hBwin, hboundWin⟩ := + exists_lt_forall_degree_leibnizRemainder_le hpowBounds hBBounds hpowne hBne + refine ⟨max Bwin (max (lamA + Finsupp.weight wt d') ((n + 1) • wt i + lamB)), ?_, + fun γ hγ ↦ ?_⟩ + · rw [hweight] + exact max_lt hBwin (max_lt (add_lt_add_of_lt_of_le hlamA le_rfl) + (add_lt_add_of_le_of_lt le_rfl hlamB)) + · have hdecomp : translatedTruncLE γ + (aeval V (MvPolynomial.monomial (Finsupp.single i (n + 1) + d') (1 : K))) - + ∑ j ∈ t, aeval V (MvPolynomial.pderiv j + (MvPolynomial.monomial (Finsupp.single i (n + 1) + d') (1 : K))) * + translatedTruncLE γ (V j) = + (translatedTruncLE γ (V i ^ (n + 1) * + aeval V (MvPolynomial.monomial d' (1 : K))) - + translatedTruncLE γ (V i ^ (n + 1)) * + aeval V (MvPolynomial.monomial d' (1 : K)) - + V i ^ (n + 1) * translatedTruncLE γ + (aeval V (MvPolynomial.monomial d' (1 : K)))) + + ((translatedTruncLE γ (V i ^ (n + 1)) - + (n + 1 : ℕ) • (translatedTruncLE γ (V i) * V i ^ n)) * + aeval V (MvPolynomial.monomial d' (1 : K)) + + V i ^ (n + 1) * (translatedTruncLE γ + (aeval V (MvPolynomial.monomial d' (1 : K))) - + ∑ j ∈ t, aeval V (MvPolynomial.pderiv j + (MvPolynomial.monomial d' (1 : K))) * translatedTruncLE γ (V j))) := by + rw [hsum γ, hA] + ring + rw [hdecomp] + refine ((ν).map_add_le_max _ _).trans (max_le ?_ ?_) + · exact (hboundWin γ hγ).trans (WithBot.coe_le_coe.mpr (le_max_left _ _)) + · refine ((ν).map_add_le_max _ _).trans (max_le ?_ ?_) + · refine ((ν).map_mul_le_add _ _).trans ?_ + refine (add_le_add (hboundA γ hγ) hBBounds.degree_le).trans ?_ + rw [← WithBot.coe_add] + exact WithBot.coe_le_coe.mpr ((le_max_left _ _).trans (le_max_right _ _)) + · refine ((ν).map_mul_le_add _ _).trans ?_ + refine (add_le_add hpowBounds.degree_le (hboundB γ hγ)).trans ?_ + rw [← WithBot.coe_add] + exact WithBot.coe_le_coe.mpr ((le_max_right _ _).trans (le_max_right _ _)) + +/-- Scaling by a coefficient does not raise the degree. -/ +theorem degree_smul_le (k : K) (b : Nonpositive G K) : ν (k • b) ≤ ν b := by + have hsm : k • b = C k * b := by + rw [← algebraMap_apply, Algebra.smul_def] + rw [hsm] + refine ((ν).map_mul_le_add _ _).trans ?_ + have h0 : ν (C k : Nonpositive G K) ≤ (0 : NatOrdinal) := degree_C_le k + calc ν (C k : Nonpositive G K) + ν b ≤ ((0 : NatOrdinal) : WithBot NatOrdinal) + ν b := + add_le_add h0 le_rfl + _ = ν b := by + cases hb : ν b using WithBot.recBotCoe with + | bot => rw [WithBot.add_bot] + | coe d => rw [← WithBot.coe_add, zero_add] + +open Finsupp in +/-- **The homogeneous Leibniz expansion with a uniform remainder.** For a weighted homogeneous +polynomial of nonzero degree evaluated at series satisfying the assigned bounds, the translated +truncation differs from the sum of the evaluated partial derivatives against the truncated +variables by a remainder bounded by a fixed degree strictly below the polynomial degree, +uniformly in the cutoff. Each monomial contributes its own bound and the finitely many bounds are +taken together. + +This is the analytic input required by the differentiated relation when the degree is a limit +ordinal. -/ +theorem exists_lt_forall_degree_homogeneous_leibniz_le + (hV : ∀ i, HasLowerTruncationDegree (V i) (wt i)) (hwt : ∀ i, wt i ≠ 0) (t : Finset ι) + {F : MvPolynomial ι K} {c : NatOrdinal.{u}} (hF : IsWeightedHomogeneous wt F c) + (hc : c ≠ 0) (hFt : ∀ d ∈ F.support, d.support ⊆ t) : + ∃ lam : NatOrdinal.{u}, lam < c ∧ ∀ γ : G, γ < 0 → + ν (translatedTruncLE γ (aeval V F) - + ∑ i ∈ t, aeval V (MvPolynomial.pderiv i F) * translatedTruncLE γ (V i)) ≤ + (lam : WithBot NatOrdinal) := by + classical + -- Each monomial of `F` has weight `c`, hence is nonzero, and contributes its own bound. + have hmon : ∀ d ∈ F.support, d ≠ 0 ∧ Finsupp.weight wt d = c := by + intro d hd + have hw : Finsupp.weight wt d = c := hF (MvPolynomial.mem_support_iff.mp hd) + refine ⟨fun h0 ↦ ?_, hw⟩ + rw [h0, map_zero] at hw + exact hc hw.symm + have hchoice : ∀ d ∈ F.support, ∃ lam : NatOrdinal.{u}, lam < c ∧ ∀ γ : G, γ < 0 → + ν (translatedTruncLE γ (aeval V (MvPolynomial.monomial d (1 : K))) - + ∑ i ∈ t, aeval V (MvPolynomial.pderiv i (MvPolynomial.monomial d (1 : K))) * + translatedTruncLE γ (V i)) ≤ (lam : WithBot NatOrdinal) := by + intro d hd + obtain ⟨hd0, hw⟩ := hmon d hd + obtain ⟨lam, hlam, hbound⟩ := + exists_lt_forall_degree_monomial_leibniz_le hV hwt t d hd0 (hFt d hd) + exact ⟨lam, hw ▸ hlam, hbound⟩ + choose lamOf hlamOf hboundOf using hchoice + set L : {d // d ∈ F.support} → NatOrdinal.{u} := fun d ↦ lamOf d.1 d.2 with hL + refine ⟨F.support.attach.sup L, ?_, fun γ hγ ↦ ?_⟩ + · refine Finset.sup_lt_iff (pos_iff_ne_zero.mpr hc) |>.mpr ?_ + intro d _ + exact hlamOf d.1 d.2 + · have hFsum : F = ∑ d ∈ F.support.attach, + MvPolynomial.C (MvPolynomial.coeff d.1 F) * MvPolynomial.monomial d.1 (1 : K) := by + conv_lhs => rw [F.as_sum] + rw [← Finset.sum_attach F.support + (fun d ↦ MvPolynomial.monomial d (MvPolynomial.coeff d F))] + refine Finset.sum_congr rfl fun d _ ↦ ?_ + rw [MvPolynomial.C_mul_monomial, mul_one] + have hleft : translatedTruncLE γ (aeval V F) = + ∑ d ∈ F.support.attach, MvPolynomial.coeff d.1 F • + translatedTruncLE γ (aeval V (MvPolynomial.monomial d.1 (1 : K))) := by + conv_lhs => rw [hFsum] + rw [map_sum, map_sum] + refine Finset.sum_congr rfl fun d _ ↦ ?_ + rw [map_mul, MvPolynomial.aeval_C, ← Algebra.smul_def, translatedTruncLE_smul] + have hright : ∑ i ∈ t, aeval V (MvPolynomial.pderiv i F) * translatedTruncLE γ (V i) = + ∑ d ∈ F.support.attach, MvPolynomial.coeff d.1 F • + ∑ i ∈ t, aeval V (MvPolynomial.pderiv i + (MvPolynomial.monomial d.1 (1 : K))) * translatedTruncLE γ (V i) := by + have hinner : ∀ i ∈ t, aeval V (MvPolynomial.pderiv i F) * translatedTruncLE γ (V i) = + ∑ d ∈ F.support.attach, MvPolynomial.coeff d.1 F • + (aeval V (MvPolynomial.pderiv i (MvPolynomial.monomial d.1 (1 : K))) * + translatedTruncLE γ (V i)) := by + intro i _ + conv_lhs => rw [hFsum] + rw [map_sum, map_sum, Finset.sum_mul] + refine Finset.sum_congr rfl fun d _ ↦ ?_ + rw [MvPolynomial.pderiv_C_mul, map_mul, MvPolynomial.aeval_C, ← Algebra.smul_def, + smul_mul_assoc] + rw [Finset.sum_congr rfl hinner, Finset.sum_comm] + exact Finset.sum_congr rfl fun d _ ↦ (Finset.smul_sum).symm + rw [hleft, hright, ← Finset.sum_sub_distrib] + have hcongr : ∀ d ∈ F.support.attach, + MvPolynomial.coeff d.1 F • translatedTruncLE γ + (aeval V (MvPolynomial.monomial d.1 (1 : K))) - + MvPolynomial.coeff d.1 F • ∑ i ∈ t, aeval V (MvPolynomial.pderiv i + (MvPolynomial.monomial d.1 (1 : K))) * translatedTruncLE γ (V i) = + MvPolynomial.coeff d.1 F • + (translatedTruncLE γ (aeval V (MvPolynomial.monomial d.1 (1 : K))) - + ∑ i ∈ t, aeval V (MvPolynomial.pderiv i + (MvPolynomial.monomial d.1 (1 : K))) * translatedTruncLE γ (V i)) := + fun d _ ↦ (smul_sub _ _ _).symm + rw [Finset.sum_congr rfl hcongr] + refine (ν).map_sum_le_of_forall_le _ _ _ fun d _ ↦ ?_ + refine (degree_smul_le _ _).trans ?_ + exact (hboundOf d.1 d.2 γ hγ).trans + (WithBot.coe_le_coe.mpr (Finset.le_sup (f := L) (Finset.mem_attach _ d))) + +/-- **The differentiated relation.** If a weighted homogeneous polynomial of nonzero degree +evaluates to zero in the associated graded ring, then at all sufficiently late negative cutoffs +the sum of its evaluated partial derivatives against the truncated variables has degree bounded +by a single degree strictly below the polynomial degree. + +The evaluated relation itself has degree strictly below the polynomial degree, so its truncations +eventually drop below a fixed bound; the Leibniz expansion contributes its own fixed bound; and +the two combine. This is the analytic condition required for a relation whose degree is a limit +ordinal, at a chosen cutoff. -/ +theorem exists_lt_forall_degree_differentiatedRelation_le + (xg : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded) + (hVrep : ∀ i, Represents (V i) (wt i) (xg i)) + (hV : ∀ i, HasLowerTruncationDegree (V i) (wt i)) (hwt : ∀ i, wt i ≠ 0) (t : Finset ι) + {F : MvPolynomial ι K} {c : NatOrdinal.{u}} (hF : IsWeightedHomogeneous wt F c) + (hc : c ≠ 0) (hFt : ∀ d ∈ F.support, d.support ⊆ t) + (hrel : MvPolynomial.aeval xg F = 0) : + ∃ lam : NatOrdinal.{u}, lam < c ∧ ∃ l : G, l < 0 ∧ ∀ γ : G, l < γ → γ < 0 → + ν (∑ i ∈ t, aeval V (MvPolynomial.pderiv i F) * translatedTruncLE γ (V i)) ≤ + (lam : WithBot NatOrdinal) := by + classical + -- The evaluated relation is a lift of the zero class, hence has degree below `c`. + have hrep : Represents (aeval V F) c 0 := by + have h := represents_aeval xg hVrep hF + rwa [hrel] at h + obtain ⟨c₀, hc₀lt, hc₀le⟩ := exists_le_of_degree_lt hrep.degree_lt_of_eq_zero hc + -- Its truncations eventually drop below that degree. + obtain ⟨l, hl, hcut⟩ := eventually_nhdsLT_iff_exists.mp + (eventually_degree_translatedTruncLE_lt (aeval V F) c₀ hc₀le) + obtain ⟨lam₁, hlam₁, hbound₁⟩ := + exists_lt_forall_degree_homogeneous_leibniz_le hV hwt t hF hc hFt + refine ⟨max c₀ lam₁, max_lt hc₀lt hlam₁, l, hl, fun γ hlγ hγ0 ↦ ?_⟩ + have hsplit : ∑ i ∈ t, aeval V (MvPolynomial.pderiv i F) * translatedTruncLE γ (V i) = + translatedTruncLE γ (aeval V F) - + (translatedTruncLE γ (aeval V F) - + ∑ i ∈ t, aeval V (MvPolynomial.pderiv i F) * translatedTruncLE γ (V i)) := by + abel + rw [hsplit] + refine ((ν).map_sub_le_max _ _).trans (max_le ?_ ?_) + · exact (hcut γ hlγ hγ0).le.trans (WithBot.coe_le_coe.mpr (le_max_left _ _)) + · exact (hbound₁ γ hγ0).trans (WithBot.coe_le_coe.mpr (le_max_right _ _)) + +/-! ### Separation data for the cofactor construction -/ + +open Classical in +/-- **The differentiated relation in polynomial form.** Replacing each truncated variable by a +polynomial that represents it turns the differentiated relation into a statement about a single +evaluated polynomial: a combination of the partial derivatives of the relation, with cofactors +whose monomials have weight strictly below that of the variable they multiply, evaluates to +something of degree bounded strictly below the degree of the relation. + +The hypotheses on the representatives make every proper truncation drop strictly below its own +weight; the substitution is exact modulo series bounded strictly below zero, which the degree +bound absorbs. This is the form in which the relation can be compared against the graded pieces +of the polynomial ring. -/ +theorem exists_lt_forall_degree_polynomialDifferentiatedRelation_le + (xg : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded) + (hVrep : ∀ i, Represents (V i) (wt i) (xg i)) + (hV : ∀ i, HasLowerTruncationDegree (V i) (wt i)) (hwt : ∀ i, wt i ≠ 0) (t : Finset ι) + {F : MvPolynomial ι K} {c : NatOrdinal.{u}} (hF : IsWeightedHomogeneous wt F c) + (hc : c ≠ 0) (hFt : ∀ d ∈ F.support, d.support ⊆ t) + (hrel : MvPolynomial.aeval xg F = 0) (hwtle : ∀ i ∈ t, wt i ≤ c) + (hgen : ∀ β : NatOrdinal.{u}, β < c → ∀ y ∈ DirectSum.rangeLof K (ν).Component β, + ∃ P : MvPolynomial ι K, IsWeightedHomogeneous wt P β ∧ MvPolynomial.aeval xg P = y) : + ∃ lam : NatOrdinal.{u}, lam < c ∧ ∃ l : G, l < 0 ∧ ∀ γ : G, l < γ → γ < 0 → + ∃ P : ι → MvPolynomial ι K, + (∀ i ∈ t, ∀ d ∈ (P i).support, Finsupp.weight wt d < wt i) ∧ + ν (aeval V (∑ i ∈ t, MvPolynomial.pderiv i F * P i)) ≤ (lam : WithBot NatOrdinal) := by + classical + obtain ⟨lam, hlam, l, hl, hbound⟩ := + exists_lt_forall_degree_differentiatedRelation_le xg hVrep hV hwt t hF hc hFt hrel + refine ⟨lam, hlam, l, hl, fun γ hlγ hγ0 ↦ ?_⟩ + -- a polynomial representing each truncated variable, of weight below that variable's + have hrep : ∀ i ∈ t, ∃ Q : MvPolynomial ι K, + (∀ d ∈ Q.support, Finsupp.weight wt d < wt i) ∧ + ν (translatedTruncLE γ (V i) - aeval V Q) = ⊥ := by + intro i hi + have hlt : ν (translatedTruncLE γ (V i)) < (wt i : WithBot NatOrdinal) := + ((hasLowerTruncationDegree_iff).mp (hV i)).2 γ hγ0 + obtain ⟨Q, -, hQw, hQ⟩ := + exists_forall_weight_lt_and_degree_sub_aeval_eq_bot xg hVrep (wt i) + (fun β hβ y hy ↦ hgen β (lt_of_lt_of_le hβ (hwtle i hi)) y hy) + (translatedTruncLE γ (V i)) hlt + exact ⟨Q, hQw, hQ⟩ + choose Q hQw hQ using hrep + refine ⟨fun i ↦ if hi : i ∈ t then Q i hi else 0, fun i hi ↦ by + simpa only [dif_pos hi] using hQw i hi, ?_⟩ + -- substituting is exact modulo series bounded strictly below zero + have hsub : ν ((∑ i ∈ t, aeval V (MvPolynomial.pderiv i F) * translatedTruncLE γ (V i)) - + ∑ i ∈ t, aeval V (MvPolynomial.pderiv i F) * + aeval V (if hi : i ∈ t then Q i hi else 0)) = ⊥ := by + refine degree_sub_eq_bot_sum t _ _ fun i hi ↦ ?_ + rw [dif_pos hi] + exact degree_sub_eq_bot_mul (by simp) (hQ i hi) + have hval : aeval V (∑ i ∈ t, MvPolynomial.pderiv i F * + (if hi : i ∈ t then Q i hi else 0)) = + ∑ i ∈ t, aeval V (MvPolynomial.pderiv i F) * + aeval V (if hi : i ∈ t then Q i hi else 0) := by + rw [map_sum] + exact Finset.sum_congr rfl fun i _ ↦ map_mul _ _ _ + rw [hval] + have hsplit : (∑ i ∈ t, aeval V (MvPolynomial.pderiv i F) * + aeval V (if hi : i ∈ t then Q i hi else 0)) = + (∑ i ∈ t, aeval V (MvPolynomial.pderiv i F) * translatedTruncLE γ (V i)) - + ((∑ i ∈ t, aeval V (MvPolynomial.pderiv i F) * translatedTruncLE γ (V i)) - + ∑ i ∈ t, aeval V (MvPolynomial.pderiv i F) * + aeval V (if hi : i ∈ t then Q i hi else 0)) := by ring + rw [hsplit] + refine ((ν).map_sub_le_max _ _).trans ?_ + rw [hsub] + exact max_le (hbound γ hlγ hγ0) bot_le + +/-- **The syzygy carried by the differentiated relation.** With evaluation injective in every +degree below that of the relation, the combination of partial derivatives produced above has all +its monomials of weight bounded strictly below the degree of the relation: in every degree between +that bound and the relation's own, the partial derivatives of the relation satisfy a syzygy. + +The weight bound on the combination is forced by the shapes of its factors -- a monomial of +`∂F/∂X_i` weighs the relation's degree less that of `X_i`, and its cofactor weighs less than `X_i` +-- and injectivity then turns the degree bound on the evaluation into a bound on the weights +themselves. -/ +theorem exists_lt_forall_weight_le_polynomialSyzygy + (xg : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded) + (hVrep : ∀ i, Represents (V i) (wt i) (xg i)) + (hV : ∀ i, HasLowerTruncationDegree (V i) (wt i)) (hwt : ∀ i, wt i ≠ 0) (t : Finset ι) + {F : MvPolynomial ι K} {c : NatOrdinal.{u}} (hF : IsWeightedHomogeneous wt F c) + (hc : c ≠ 0) (hFt : ∀ d ∈ F.support, d.support ⊆ t) + (hrel : MvPolynomial.aeval xg F = 0) (hwtle : ∀ i ∈ t, wt i ≤ c) + (hgen : ∀ β : NatOrdinal.{u}, β < c → ∀ y ∈ DirectSum.rangeLof K (ν).Component β, + ∃ P : MvPolynomial ι K, IsWeightedHomogeneous wt P β ∧ MvPolynomial.aeval xg P = y) + (hinj : ∀ (β : NatOrdinal.{u}) (P : MvPolynomial ι K), β < c → + IsWeightedHomogeneous wt P β → MvPolynomial.aeval xg P = 0 → P = 0) : + ∃ lam : NatOrdinal.{u}, lam < c ∧ ∃ l : G, l < 0 ∧ ∀ γ : G, l < γ → γ < 0 → + ∃ P : ι → MvPolynomial ι K, + (∀ i ∈ t, ∀ d ∈ (P i).support, Finsupp.weight wt d < wt i) ∧ + ∀ d ∈ (∑ i ∈ t, MvPolynomial.pderiv i F * P i).support, + Finsupp.weight wt d ≤ lam := by + classical + obtain ⟨lam, hlam, l, hl, hb⟩ := + exists_lt_forall_degree_polynomialDifferentiatedRelation_le xg hVrep hV hwt t hF hc hFt hrel + hwtle hgen + refine ⟨lam, hlam, l, hl, fun γ hlγ hγ0 ↦ ?_⟩ + obtain ⟨P, hPw, hPd⟩ := hb γ hlγ hγ0 + refine ⟨P, hPw, fun d hd ↦ ?_⟩ + -- every monomial of the combination weighs less than the relation + have hSw : ∀ d ∈ (∑ i ∈ t, MvPolynomial.pderiv i F * P i).support, + Finsupp.weight wt d < c := by + intro d' hd' + obtain ⟨i, hi, hmem⟩ := Finset.mem_biUnion.mp (MvPolynomial.support_sum hd') + obtain ⟨d₁, hd₁, d₂, hd₂, rfl⟩ := Finset.mem_add.mp (MvPolynomial.support_mul _ _ hmem) + obtain ⟨e₀, he₀, hwe⟩ := MvPolynomial.exists_add_eq_weight_of_mem_support_pderiv wt hd₁ + rw [map_add] + calc Finsupp.weight wt d₁ + Finsupp.weight wt d₂ + < Finsupp.weight wt d₁ + wt i := by + exact add_lt_add_of_le_of_lt le_rfl (hPw i hi d₂ hd₂) + _ = Finsupp.weight wt e₀ := hwe + _ = c := hF (MvPolynomial.mem_support_iff.mp he₀) + have hle := forall_weight_le_degree_aeval_of_injective xg hVrep hinj hSw d hd + exact_mod_cast hle.trans hPd + +omit [CharZero K] in +/-- **Syzygy propagation.** At every degree above the bound the syzygy provides, the part of +`(∂F/∂X_{v'}) · P_{v'}` in that degree and higher lies in the ideal generated by the remaining +partial derivatives of the relation. + +The whole combination has no monomials that high, so the term at `v'` is the negative of the rest, +and the rest is visibly a combination of the other partial derivatives. Those are homogeneous, so +passing to the part in high degrees keeps the membership. -/ +theorem componentsGE_mul_mem_span_of_polynomialSyzygy + {t : Finset ι} {F : MvPolynomial ι K} {c : NatOrdinal.{u}} + (hF : IsWeightedHomogeneous wt F c) {P : ι → MvPolynomial ι K} {lam : NatOrdinal.{u}} + (hS : ∀ d ∈ (∑ i ∈ t, MvPolynomial.pderiv i F * P i).support, + Finsupp.weight wt d ≤ lam) + (v' : ι) (hv' : v' ∈ t) {τ : NatOrdinal.{u}} (hτ : lam < τ) : + MvPolynomial.componentsGE wt τ (MvPolynomial.pderiv v' F * P v') ∈ + Ideal.span (Set.range fun j : {j : ι // j ∈ t ∧ j ≠ v'} ↦ MvPolynomial.pderiv j.1 F) := by + classical + -- the whole combination has nothing that high + have hzero : MvPolynomial.componentsGE wt τ (∑ i ∈ t, MvPolynomial.pderiv i F * P i) = 0 := + MvPolynomial.componentsGE_eq_zero_of_forall_lt wt fun d hd ↦ (hS d hd).trans_lt hτ + rw [← Finset.add_sum_erase _ _ hv', MvPolynomial.componentsGE_add] at hzero + have hneg : MvPolynomial.componentsGE wt τ (MvPolynomial.pderiv v' F * P v') = + -MvPolynomial.componentsGE wt τ + (∑ i ∈ t.erase v', MvPolynomial.pderiv i F * P i) := by + rw [eq_neg_iff_add_eq_zero] + exact hzero + rw [hneg] + refine neg_mem ?_ + -- the remaining partial derivatives are homogeneous + have hhom : ∀ j : {j : ι // j ∈ t ∧ j ≠ v'}, + ∃ β, IsWeightedHomogeneous wt (MvPolynomial.pderiv j.1 F) β := by + intro j + by_cases h : ∃ β, β + wt j.1 = c + · obtain ⟨β, hβ⟩ := h + exact ⟨β, MvPolynomial.isWeightedHomogeneous_pderiv wt hF j.1 hβ⟩ + · exact ⟨0, by + rw [MvPolynomial.pderiv_eq_zero_of_isWeightedHomogeneous wt hF j.1 h] + exact MvPolynomial.isWeightedHomogeneous_zero _ _ _⟩ + choose β hβ using hhom + haveI : Finite {j : ι // j ∈ t ∧ j ≠ v'} := + (t.finite_toSet.subset fun j (hj : j ∈ t ∧ j ≠ v') ↦ hj.1).to_subtype + refine MvPolynomial.componentsGE_mem_span wt hβ ?_ τ + refine Ideal.sum_mem _ fun i hi ↦ ?_ + exact Ideal.mul_mem_right _ _ + (Ideal.subset_span ⟨⟨i, Finset.mem_of_mem_erase hi, Finset.ne_of_mem_erase hi⟩, rfl⟩) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Multiplication.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Multiplication.lean new file mode 100644 index 0000000000..ad1c69a593 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Multiplication.lean @@ -0,0 +1,187 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Additive +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonAddition +public import Mathlib.RingTheory.HahnSeries.Multiplication +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive + +/-! +# Upper bounds on Cantor–Bendixson values of Hahn products + +In an ordered uniform exponent group that is Cauchy complete, every derivative point of a product +support lifts to a pair in the closed factor supports with a sufficient natural sum of ranks. For +nonpositive supports the only pair summing to zero is `(0, 0)`, giving submultiplicativity of the +value. +This is an upper bound only; coefficient cancellation is not excluded. +-/ + +public noncomputable section + +open Set Topology TopologicalSpace +open scoped Pointwise + +universe u v + +namespace HahnSeries + +variable {G : Type u} {R : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + +section Semiring + +variable [NonUnitalNonAssocSemiring R] + +/-- The closed support of a product is contained in the sum of the closed supports. -/ +theorem closedSupport_mul_subset_add (b d : HahnSeries G R) : + ((b * d).closedSupport : Set G) ⊆ (b.closedSupport : Set G) + (d.closedSupport : Set G) := by + rw [coe_closedSupport, coe_closedSupport, coe_closedSupport, + ← b.isPWO_support.closure_add_eq d.isPWO_support] + exact closure_mono support_mul_subset + +/-- A product derivative point lifts to closed-support summands whose ranks bound its stage. -/ +theorem exists_cantorBendixsonRank_add_ge_of_mem_mul_derivative (b d : HahnSeries G R) + (o : Ordinal.{u}) {z : G} (hz : z ∈ ((b * d).closedSupport.cantorBendixson o : Set G)) : + ∃ x ∈ b.closedSupport, ∃ y ∈ d.closedSupport, x + y = z ∧ + o ≤ (NatOrdinal.of (b.cantorBendixsonRank x) + + NatOrdinal.of (d.cantorBendixsonRank y)).val := by + let s : Closeds G := ⟨(b.closedSupport : Set G) + (d.closedSupport : Set G), + b.closedSupport_isPWO.isClosed_add d.closedSupport_isPWO + b.closedSupport.isClosed d.closedSupport.isClosed⟩ + have hsub : (b * d).closedSupport ≤ s := b.closedSupport_mul_subset_add d + have hm : z ∈ (s.cantorBendixson o : Set G) := + Closeds.cantorBendixson_mono hsub o hz + simpa only [cantorBendixsonRank_eq, mem_setOf_eq] using + b.closedSupport.cantorBendixson_add_subset d.closedSupport + b.closedSupport_isPWO d.closedSupport_isPWO o hm + +/-- For nonpositive supports, the product rank at zero is bounded by the natural sum. -/ +theorem cantorBendixsonRank_mul_le (b d : HahnSeries G R) + (hb : b.support ⊆ Iic 0) (hd : d.support ⊆ Iic 0) + (h : 0 ∈ closure (b * d).support) : + 0 ∈ closure b.support ∧ 0 ∈ closure d.support ∧ + (b * d).cantorBendixsonRank 0 ≤ + (NatOrdinal.of (b.cantorBendixsonRank 0) + + NatOrdinal.of (d.cantorBendixsonRank 0)).val := by + have hm := ((b * d).mem_support_derivative_iff 0 ((b * d).cantorBendixsonRank 0)).mpr ⟨h, le_rfl⟩ + obtain ⟨x, hx, y, hy, hxy, hr⟩ := b.exists_cantorBendixsonRank_add_ge_of_mem_mul_derivative d _ hm + have hx0 : x ≤ 0 := closure_minimal hb isClosed_Iic ((b.mem_closedSupport x).mp hx) + have hy0 : y ≤ 0 := closure_minimal hd isClosed_Iic ((d.mem_closedSupport y).mp hy) + have hxge : 0 ≤ x := by simpa only [hxy, add_zero] using add_le_add_right hy0 x + have hxe : x = 0 := hx0.antisymm hxge + subst x + have hye : y = 0 := by simpa only [zero_add] using hxy + subst y + exact ⟨(b.mem_closedSupport 0).mp hx, (d.mem_closedSupport 0).mp hy, hr⟩ + +/-- The value of a product with nonpositive supports is bounded by the natural product. -/ +@[blueprint "lem:cantor-bendixson-value-product-upper-bound" + (phase := "Cantor–Bendixson ranks of supports") + (title := "Product upper bound for the Cantor--Bendixson value") + (statement := /-- + Let $R$ be a semiring, not necessarily unital or associative, and let $G$ + be a nontrivial ordered abelian group equipped with a compatible additive + uniformity and its order topology. Assume that $G$ is Cauchy complete. If + $b,d\in R((G^{\le0}))$, then + \[ + V_{\mathrm{CB}}(bd) + \le V_{\mathrm{CB}}(b)\odot V_{\mathrm{CB}}(d), + \] + where $\odot$ is Hessenberg's natural product. + -/) + (proof := /-- + By \ref{def:cantor-bendixson-value}, the assertion is trivial if $0$ is + outside the closed support of $bd$; otherwise its value is $\omega$ to + the rank there. The closed support of $bd$ is contained in the sum of + the closed supports of $b$ and $d$. By + \ref{lem:cantor-bendixson-derivative-of-sum}, a point of rank $\alpha$ in + this sum lifts to $x$ and $y$ whose ranks have natural sum at least + $\alpha$. Nonpositivity and $x+y=0$ force $x=y=0$. Exponentiating the + resulting rank inequality by $\omega$ turns natural sum into natural + product and gives the bound. + -/)] +theorem cantorBendixsonValue_mul_le (b d : HahnSeries G R) + (hb : b.support ⊆ Iic 0) (hd : d.support ⊆ Iic 0) : + NatOrdinal.of (b * d).cantorBendixsonValue ≤ + NatOrdinal.of b.cantorBendixsonValue * NatOrdinal.of d.cantorBendixsonValue := by + by_cases hm : 0 ∈ closure (b * d).support + · obtain ⟨hb0, hd0, hr⟩ := b.cantorBendixsonRank_mul_le d hb hd hm + rw [(b * d).cantorBendixsonValue_of_mem hm, b.cantorBendixsonValue_of_mem hb0, + d.cantorBendixsonValue_of_mem hd0, NatOrdinal.of_omega0_opow, + NatOrdinal.of_omega0_opow, NatOrdinal.of_omega0_opow, ← NatOrdinal.wpow_add] + exact NatOrdinal.wpow_le_wpow.mpr hr + · rw [(b * d).cantorBendixsonValue_of_notMem hm] + exact zero_le + +end Semiring + +section Ring + +variable [Ring R] + +/-- A nonnegative integer power is bounded by the natural power of the original value. -/ +theorem cantorBendixsonValue_pow_le (b : HahnSeries G R) (hb : b.support ⊆ Iic 0) (m : ℕ) : + NatOrdinal.of (b ^ m).cantorBendixsonValue ≤ + NatOrdinal.of b.cantorBendixsonValue ^ m := by + induction m with + | zero => + rw [pow_zero, pow_zero] + have hf : (1 : HahnSeries G R).support.Finite := + (finite_singleton _).subset support_single_subset + by_cases hc : (1 : HahnSeries G R).coeff 0 = 0 + · rw [cantorBendixsonValue_of_finite_of_coeff_eq_zero _ hf hc] + exact zero_le + · rw [cantorBendixsonValue_of_finite_of_coeff_ne_zero _ hf hc] + exact le_rfl + | succ m ih => + rw [pow_succ, pow_succ] + exact (cantorBendixsonValue_mul_le _ _ + ((nonpositiveSubring G R).pow_mem hb m) hb).trans (mul_le_mul_left ih _) + + +omit [IsUniformAddGroup G] [Nontrivial G] [CompleteSpace G] in +/-- Multiplication by a nonzero ordinary scalar preserves the value. -/ +theorem cantorBendixsonValue_single_zero_mul [NoZeroDivisors R] + (b : HahnSeries G R) {a : R} (ha : a ≠ 0) : + (single 0 a * b).cantorBendixsonValue = b.cantorBendixsonValue := by + apply cantorBendixsonValue_congr_support + ext x + simp only [mem_support, coeff_single_zero_mul, mul_ne_zero_iff] + exact ⟨And.right, fun hx ↦ ⟨ha, hx⟩⟩ + +/-- A nonpositive factor of value zero makes the product value zero. -/ +theorem cantorBendixsonValue_mul_eq_zero_of_left (b d : HahnSeries G R) + (hb : b.support ⊆ Iic 0) (hd : d.support ⊆ Iic 0) + (hz : b.cantorBendixsonValue = 0) : (b * d).cantorBendixsonValue = 0 := by + have h := b.cantorBendixsonValue_mul_le d hb hd + rw [hz, NatOrdinal.of_zero, zero_mul] at h + exact le_antisymm h zero_le + +/-- A nonpositive factor of value one preserves the other factor's value. -/ +theorem cantorBendixsonValue_mul_of_left_eq_one [NoZeroDivisors R] (b d : HahnSeries G R) + (hb : b.support ⊆ Iic 0) (hd : d.support ⊆ Iic 0) + (hone : b.cantorBendixsonValue = 1) : + (b * d).cantorBendixsonValue = d.cantorBendixsonValue := by + obtain ⟨hcoeff, hz⟩ := (b.cantorBendixsonValue_eq_one_iff).mp hone + have he : (b - single 0 (b.coeff 0)).support ⊆ Iic (0 : G) := by + intro x hx + rcases support_sub_subset _ _ hx with hx | hx + · exact hb hx + · exact (support_single_subset hx : x = 0) ▸ le_rfl + have herr := (b - single 0 (b.coeff 0)).cantorBendixsonValue_mul_eq_zero_of_left d he hd hz + rw [sub_mul] at herr + exact (cantorBendixsonValue_eq_of_sub_value_eq_zero _ _ herr).trans + (d.cantorBendixsonValue_single_zero_mul hcoeff) + +end Ring + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Obligations.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Obligations.lean new file mode 100644 index 0000000000..f354477655 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Obligations.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SyzygyIntegration +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermFinitePartIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSuccessorStep + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Integration for the Cantor–Bendixson derivation + +The polynomiality induction over an arbitrary filter takes the integration statements as +hypotheses, because the abstract lowering-derivation interface does not supply them. The +Cantor–Bendixson setting proves them by integrating prescribed homogeneous classes along cofinal +cutoffs, and this file matches those statements to the forms required by the induction. + +The only work is the passage between a degree with positive finite part and its predecessor: the +induction states the hypothesis for a degree whose finite part is positive, and the +Cantor–Bendixson theorem states it for a successor. +-/ + +universe u v w + +open scoped NatOrdinal Topology + +open Filter MvPolynomial HahnSeries HahnSeries.Nonpositive + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [Field K] [CharZero K] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := K)) + +/-- Ideal membership from the Cantor–Bendixson derivative germ. A degree with positive finite part +is a successor, so the predecessor form of the integration theorem applies. -/ +theorem hasIdealIntegration {ι' : Type w} [Finite ι'] {q : ι' → (ν).AssociatedGraded} + {c : ι' → NatOrdinal.{u}} + (hq : ∀ j, q j ∈ DirectSum.rangeLof K (ν).Component (c j)) + (hc : ∀ j, (c j).constantCoeff = 0) + {b : NatOrdinal.{u}} (hb : 0 < b.constantCoeff) + {y : (ν).AssociatedGraded} (hy : y ∈ DirectSum.rangeLof K (ν).Component b) + {f : G → (ν).AssociatedGraded} (hf : ∀ t, f t ∈ Ideal.span (Set.range q)) + (hD : cantorBendixsonGradedDerivation y = + (f : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded)) : + y ∈ Ideal.span (Set.range q) := by + have hsucc : b.removeNat 1 + 1 = b := by + have hstep := NatOrdinal.removeNat_add_natCast (a := b) (n := 1) hb + rwa [Nat.cast_one] at hstep + refine mem_span_of_cantorBendixsonGradedDerivation_eq_coe hq hc (δ := b.removeNat 1) ?_ hf hD + rwa [hsucc] + +/-- The ideal-integration theorem for the Cantor–Bendixson derivation. -/ +theorem hasIdealIntegrationDerivation {ι' : Type w} [Finite ι'] + {q : ι' → (ν).AssociatedGraded} {c : ι' → NatOrdinal.{u}} + (hq : ∀ j, q j ∈ DirectSum.rangeLof K (ν).Component (c j)) + (hc : ∀ j, (c j).constantCoeff = 0) + {b : NatOrdinal.{u}} (hb : 0 < b.constantCoeff) + {y : (ν).AssociatedGraded} (hy : y ∈ DirectSum.rangeLof K (ν).Component b) + {f : G → (ν).AssociatedGraded} (hf : ∀ t, f t ∈ Ideal.span (Set.range q)) + (hD : cantorBendixsonDerivation y = + (f : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded)) : + y ∈ Ideal.span (Set.range q) := + hasIdealIntegration hq hc hb hy hf (cantorBendixsonDerivation_apply y ▸ hD) + +/-- The successor step for the Cantor–Bendixson derivation. -/ +@[blueprint "lem:cantor-bendixson-successor-step" + (phase := "Algebraic independence in graded rings") + (title := "Successor step for Cantor--Bendixson homogeneous evaluation") + (statement := /-- + Let $K$ be a field of characteristic zero, and let $G$ be a nontrivial + ordered abelian group with compatible additive uniformity and order + topology. Assume that $G$ is Cauchy complete, and let $\nu$ be the + Cantor--Bendixson degree on + $K((G^{\le0}))$. Let $(x_i)$ be a minimal homogeneous generating system + of $\operatorname{gr}_\nu$, with weights $w_i$. If the coefficient of + $1=\omega^0$ in the Cantor normal form of $\delta$ is positive and + homogeneous evaluation at $(x_i)$ is injective in every degree below + $\delta$, then it is injective in degree $\delta$. + -/) + (proof := /-- + Suppose a nonzero weighted-homogeneous polynomial $F$ of degree $\delta$ + evaluates to zero. The chain rule for the Cantor--Bendixson lowering + derivation makes the derivative values of each relevant partial derivative + pointwise combinations of the distinguished partial derivatives. By + \ref{lem:successor-ideal-membership-from-cantor-bendixson-derivative}, + these pointwise combinations give ideal membership. Then + \ref{lem:weighted-euler-identity} places $F$ in that ideal. + + By \ref{lem:successor-relation-decomposition}, choose a + finite family of relevant partial derivatives. Their polynomial syzygies + have a finite generating family by \ref{lem:syzygies-finite-variables}. + Homogeneous ideal decomposition expresses every remaining partial + derivative in the chosen family, producing a homogeneous coefficient tuple + whose evaluation is a syzygy. + \ref{lem:simultaneous-cantor-bendixson-derivative-representatives} + supplies representatives that define a polynomial derivation. By + \ref{lem:polynomial-vector-field-lowers-degree}, it lowers the constant + Cantor coefficient. Apply the induction hypothesis to the resulting + lower-degree syzygies, express them in the finite generating family, and + choose homogeneous polynomial representatives by \ref{lem:generate}. + This expresses the evaluated cofactor tuple as a combination of evaluated + syzygies. Consequently its linear part lies in the square of the + positive-degree ideal, contradicting the defining independence of a + minimal homogeneous generating system modulo that square. + -/)] +theorem injectiveAt_of_forall_lt + {ι : Type w} {wt : ι → NatOrdinal.{u}} {x : ι → (ν).AssociatedGraded} + (hx : OrdinalGraded.IsMinimalSystem + (DirectSum.rangeLof K (ν).Component) wt x) + {δ : NatOrdinal.{u}} (hδ : 0 < δ.constantCoeff) + (hinj : ∀ β < δ, OrdinalGraded.InjectiveAt K wt x β) : + OrdinalGraded.InjectiveAt K wt x δ := + OrdinalGraded.injectiveAt_of_forall_lt hx + cantorBendixson_isLoweringDerivation cantorBendixson_gradeZeroScalars + hasIdealIntegrationDerivation + (fun lam ↦ hasSyzygyIntegration lam) hδ hinj + +end HahnSeries.Nonpositive + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/OrderedIntervalCantorBendixson.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/OrderedIntervalCantorBendixson.lean new file mode 100644 index 0000000000..edf8387287 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/OrderedIntervalCantorBendixson.lean @@ -0,0 +1,193 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderedIntervalSum +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Translation +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedIntervalFamily + +/-! +# Cantor–Bendixson rank of sums over ordered intervals + +Hahn series supported on ordered disjoint intervals can be summed over a partially well-ordered +index of arbitrary cofinality. If the `o`-th derivative of every component is supported at its +center, the `o`-th derivative of the summed support is carried by the closure of the centers. +Local reconstruction then bounds its rank by one successor of `o`. +-/ + +open Set Filter Topology TopologicalSpace + +universe u v w + +public noncomputable section + +namespace HahnSeries + +variable {Γ : Type u} {R : Type v} {ι : Type w} + [LinearOrder Γ] [LinearOrder ι] + +section AddCommMonoid + +variable [AddCommMonoid R] + +/-- The Hahn sum of a family supported in ordered disjoint half-open intervals. -/ +def orderedIntervalHsum (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦Γ⟧) (cut center : ι → Γ) + (hsupp : ∀ i, (f i).support ⊆ Ioc (cut i) (center i)) + (hord : ∀ i j, i < j → center i ≤ cut j) : R⟦Γ⟧ := + (orderedIntervalSummableFamily hι f cut center hsupp hord).hsum + +/-- Ordered interval sums have exactly the union of their component supports. -/ +theorem support_orderedIntervalHsum (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦Γ⟧) (cut center : ι → Γ) + (hsupp : ∀ i, (f i).support ⊆ Ioc (cut i) (center i)) + (hord : ∀ i j, i < j → center i ≤ cut j) : + (orderedIntervalHsum hι f cut center hsupp hord).support = ⋃ i, (f i).support := by + exact support_hsum_orderedIntervalSummableFamily hι f cut center hsupp hord + +end AddCommMonoid + +section AddCommGroup + +variable [AddCommGroup Γ] [IsOrderedAddMonoid Γ] [AddCommGroup R] + +/-- At one interval center, translated weak truncation of the assembled sum differs from that +component only below the interval's left endpoint. -/ +theorem support_translatedTruncLE_orderedIntervalHsum_sub_component_subset + (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦Γ⟧) (cut center : ι → Γ) + (hsupp : ∀ i, (f i).support ⊆ Ioc (cut i) (center i)) + (hord : ∀ i j, i < j → center i ≤ cut j) (i : ι) : + (translate (-center i) (truncLE (center i) + (orderedIntervalHsum hι f cut center hsupp hord)) - + translate (-center i) (f i)).support ⊆ Iic (cut i - center i) := by + intro g hg + rw [mem_support] at hg + apply le_of_not_gt + intro hcgi + apply hg + let x := center i + g + have hx : g - -center i = x := by simp only [x, sub_neg_eq_add, add_comm] + have hxic : cut i < x := by + have h := (sub_lt_iff_lt_add).mp hcgi + simpa only [x, add_comm] using h + rw [coeff_sub, coeff_translate, coeff_translate, hx] + by_cases hg0 : g ≤ 0 + · have hxle : x ≤ center i := by + change center i + g ≤ center i + simpa only [add_zero, add_comm] using add_le_add_left hg0 (center i) + have hcoeff : + (orderedIntervalHsum hι f cut center hsupp hord).coeff x = (f i).coeff x := by + rw [orderedIntervalHsum, SummableFamily.coeff_hsum] + calc + ∑ᶠ j, ((orderedIntervalSummableFamily hι f cut center hsupp hord) j).coeff x = + ((orderedIntervalSummableFamily hι f cut center hsupp hord) i).coeff x := by + apply finsum_eq_single + intro j hji + rw [orderedIntervalSummableFamily_apply] + by_contra hj + have hxj : x ∈ (f j).support := (mem_support _ _).mpr hj + rcases lt_or_gt_of_ne hji with hji | hij + · exact (not_lt_of_ge (hsupp j hxj).2) + ((hord j i hji).trans_lt hxic) + · exact (not_lt_of_ge (hxle.trans (hord i j hij))) (hsupp j hxj).1 + _ = (f i).coeff x := congrArg (fun q : R⟦Γ⟧ ↦ q.coeff x) + (orderedIntervalSummableFamily_apply hι f cut center hsupp hord i) + rw [HahnSeries.coeff_truncLE, if_pos hxle, hcoeff, sub_self] + · have hnot : ¬x ≤ center i := by + change ¬center i + g ≤ center i + exact not_le_of_gt (by + simpa only [add_zero, add_comm] using add_lt_add_left (not_le.mp hg0) (center i)) + have hfi : (f i).coeff x = 0 := by + by_contra h + exact hnot (hsupp i ((mem_support _ _).mpr h)).2 + rw [HahnSeries.coeff_truncLE, if_neg hnot, hfi, sub_zero] + +end AddCommGroup + +variable [AddCommMonoid R] [TopologicalSpace Γ] [OrderTopology Γ] [NoMinOrder Γ] [NoMaxOrder Γ] + +/-- A derivative stage of an ordered interval sum is supported on the closure of its centers when +the same stage of every component is supported at its own center. -/ +theorem cantorBendixson_orderedIntervalHsum_subset_closure_range + (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦Γ⟧) (cut center : ι → Γ) + (hsupp : ∀ i, (f i).support ⊆ Ioc (cut i) (center i)) + (hord : ∀ i j, i < j → center i ≤ cut j) + (o : Ordinal.{u}) + (hstage : ∀ i, ((f i).closedSupport.cantorBendixson o : Set Γ) ⊆ {center i}) : + ((orderedIntervalHsum hι f cut center hsupp hord).closedSupport.cantorBendixson o : + Set Γ) ⊆ closure (Set.range center) := by + let b := orderedIntervalHsum hι f cut center hsupp hord + have hbsupp : b.support = ⋃ i, (f i).support := + support_orderedIntervalHsum hι f cut center hsupp hord + have hbclosed : b.closedSupport = + (⟨closure (⋃ i, (f i).support), isClosed_closure⟩ : Closeds Γ) := by + apply Closeds.ext + simp only [coe_closedSupport, hbsupp] + rfl + rw [hbclosed] + have hstage' : ∀ i, + ((⟨closure (f i).support, isClosed_closure⟩ : Closeds Γ).cantorBendixson o : + Set Γ) ⊆ {center i} := by + intro i + have he : (f i).closedSupport = + (⟨closure (f i).support, isClosed_closure⟩ : Closeds Γ) := by + apply Closeds.ext + simp only [coe_closedSupport] + rfl + rw [← he] + exact hstage i + exact cantorBendixson_ordered_iUnion_subset_closure_range + (fun i ↦ (f i).support) cut center hsupp hord o hstage' + +/-- If the `o`-th derivative of every interval component is supported at its center and the +centers are carried by the `r`-th derivative of `t`, then absence from the next two stages after +`r` bounds the Cantor–Bendixson rank of the assembled support by `o + 1`. -/ +theorem cantorBendixsonRank_orderedIntervalHsum_le_add_one_of_centerStage + (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦Γ⟧) (cut center : ι → Γ) + (hsupp : ∀ i, (f i).support ⊆ Ioc (cut i) (center i)) + (hord : ∀ i j, i < j → center i ≤ cut j) + (o r : Ordinal.{u}) (t : Closeds Γ) + (hstage : ∀ i, ((f i).closedSupport.cantorBendixson o : Set Γ) ⊆ {center i}) + (hcenter : closure (Set.range center) ⊆ (t.cantorBendixson r : Set Γ)) + (x : Γ) (ht : x ∉ (t.cantorBendixson ((r + 1) + 1) : Set Γ)) : + (orderedIntervalHsum hι f cut center hsupp hord).cantorBendixsonRank x ≤ o + 1 := by + let b := orderedIntervalHsum hι f cut center hsupp hord + have hderiv : (b.closedSupport.cantorBendixson o : Set Γ) ⊆ + closure (Set.range center) := by + exact cantorBendixson_orderedIntervalHsum_subset_closure_range + hι f cut center hsupp hord o hstage + change b.cantorBendixsonRank x ≤ o + 1 + rw [cantorBendixsonRank_eq] + apply TopologicalSpace.Closeds.cantorBendixsonRank_le_add_one_of_rankLevel_mapsTo_stage + b.closedSupport t b.closedSupport_isPWO isOpen_univ (by simp) o r + · intro y _ hy hyrank + apply hcenter + apply hderiv + exact (b.closedSupport.cantorBendixsonRank_eq_iff b.closedSupport_isPWO hy o).mp + hyrank |>.1 + · exact ht + +/-- If the `o`-th derivative of every interval component is supported at its center and the +centers are carried by the `o`-th derivative of `t`, then absence from the next two stages of `t` +bounds the Cantor–Bendixson rank of the assembled support by `o + 1`. -/ +theorem cantorBendixsonRank_orderedIntervalHsum_le_add_one + (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦Γ⟧) (cut center : ι → Γ) + (hsupp : ∀ i, (f i).support ⊆ Ioc (cut i) (center i)) + (hord : ∀ i j, i < j → center i ≤ cut j) + (o : Ordinal.{u}) (t : Closeds Γ) + (hstage : ∀ i, ((f i).closedSupport.cantorBendixson o : Set Γ) ⊆ {center i}) + (hcenter : closure (Set.range center) ⊆ (t.cantorBendixson o : Set Γ)) + (x : Γ) (ht : x ∉ (t.cantorBendixson ((o + 1) + 1) : Set Γ)) : + (orderedIntervalHsum hι f cut center hsupp hord).cantorBendixsonRank x ≤ o + 1 := by + exact cantorBendixsonRank_orderedIntervalHsum_le_add_one_of_centerStage + hι f cut center hsupp hord o o t hstage hcenter x ht + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativeIndices.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativeIndices.lean new file mode 100644 index 0000000000..0c87b85110 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativeIndices.lean @@ -0,0 +1,352 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalRelationAtCutoff +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan + +/-! +# Indices contributing to a partial derivative + +This file contains the ordinal bookkeeping for partial derivatives at a variable whose part of the +degree below `β` precedes `λ₀` in the algebraic order. It identifies the cofactor degrees and proves +the inequalities needed by the well-founded cofactor construction. The arguments depend only on +the ordinal data of a relation whose degree is a limit ordinal and on the chosen cutoff, not on the +exponent group. +-/ + +universe u v w + +open scoped NatOrdinal Topology + +open MvPolynomial HahnSeries HahnSeries.Nonpositive DirectSum OrdinalGraded + +public noncomputable section + +namespace HahnSeries.Germ + +section Dropping + +variable {σ : Type*} {K : Type v} [Field K] (wt : σ → NatOrdinal) + +/-- If generators outside a subtype contribute to no degree in `[τ, h)`, they may be removed +from an ideal-membership statement for the components at or above `τ`. -/ +theorem componentsGE_mem_span_subtype {ι : Type w} [Finite ι] + {q : ι → MvPolynomial σ K} {c : ι → NatOrdinal} + (hq : ∀ j, IsWeightedHomogeneous wt (q j) (c j)) {P : MvPolynomial σ K} + {τ h : NatOrdinal} (hP : componentsGE wt τ P ∈ Ideal.span (Set.range q)) + (hdeg : ∀ d ∈ P.support, Finsupp.weight wt d < h) (A : ι → Prop) + (hdrop : ∀ j, ¬ A j → ∀ e, τ ≤ e → e < h → ¬ ∃ β, β + c j = e) : + componentsGE wt τ P ∈ Ideal.span (Set.range fun j : {j // A j} ↦ q j.1) := by + classical + cases nonempty_fintype ι + letI := weightedGradedAlgebra K wt + have hdec : ∀ (R : MvPolynomial σ K) (e : NatOrdinal), + (DirectSum.decompose (weightedHomogeneousSubmodule K wt) R e : MvPolynomial σ K) = + weightedHomogeneousComponent wt e R := fun R e ↦ by + rw [← decompose'_apply] + rfl + rw [componentsGE_eq_sum_weightedHomogeneousComponent] + refine Ideal.sum_mem _ fun e he ↦ ?_ + obtain ⟨he', hτe⟩ := Finset.mem_filter.mp he + obtain ⟨d, hd, rfl⟩ := Finset.mem_image.mp he' + have heh : Finsupp.weight wt d < h := hdeg d hd + have hmem : weightedHomogeneousComponent wt (Finsupp.weight wt d) P ∈ + Ideal.span (Set.range q) := + weightedHomogeneousComponent_mem_span_of_componentsGE_mem wt hq hP hτe + obtain ⟨a, -, ha0, hsum⟩ := exists_decompose_eq_sum_mul_of_mem_span + (𝒜 := weightedHomogeneousSubmodule K wt) + (fun j ↦ (mem_weightedHomogeneousSubmodule _ _ _ _).mpr (hq j)) hmem + (Finsupp.weight wt d) + rw [hdec] at hsum + have hcomp : weightedHomogeneousComponent wt (Finsupp.weight wt d) + (weightedHomogeneousComponent wt (Finsupp.weight wt d) P) = + weightedHomogeneousComponent wt (Finsupp.weight wt d) P := by + rw [weightedHomogeneousComponent_of_mem + (weightedHomogeneousComponent_mem wt P _), if_pos rfl] + rw [← hcomp, hsum] + rw [← Finset.sum_filter_add_sum_filter_not Finset.univ A] + have hzero : ∑ j ∈ Finset.univ.filter (fun j ↦ ¬ A j), q j * a j = 0 := + Finset.sum_eq_zero fun j hj ↦ by + rw [ha0 j (hdrop j (Finset.mem_filter.mp hj).2 _ hτe heh), mul_zero] + rw [hzero, add_zero] + exact Ideal.sum_mem _ fun j hj ↦ Ideal.mul_mem_right _ _ + (Ideal.subset_span ⟨⟨j, (Finset.mem_filter.mp hj).2⟩, rfl⟩) + +end Dropping + +variable {G : Type u} {K : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [Field K] [CharZero K] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := K)) + +variable {ι : Type w} {wt : ι → NatOrdinal.{u}} + {xg : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded} +namespace LimitOrdinalRelationAtCutoff + +variable {σ : LiftFamily wt xg} {α : NatOrdinal.{u}} + (S : HahnSeries.Germ.LimitOrdinalRelationAtCutoff σ α) +variable (hx : OrdinalGraded.IsMinimalSystem + (DirectSum.rangeLof K (cantorBendixsonDegreeValuation (G := G) (R := K)).Component) wt xg) + +include S hx + +/-- The relation degree has zero finite part. -/ +theorem α_constantCoeff : α.constantCoeff = 0 := by + have h := congrArg NatOrdinal.constantCoeff S.hdegHD + rw [NatOrdinal.constantCoeff_add, NatOrdinal.constantCoeff_nsmul, S.vars_limit _ S.mem, + mul_zero, add_zero] at h + rw [← h, ← NatOrdinal.partGE_eq_self_of_forall_le S.degHD_terms, + NatOrdinal.constantCoeff_partGE (S.β_ne_zero hx)] + +section Cofactor + +variable {v : ι} (hv : v ∈ S.F.vars) {c : NatOrdinal} (hc : c + wt v = α) +include hv hc + +omit hx in +/-- The degree of the partial derivative at a variable of `F` is nonzero. -/ +theorem cdeg_ne_zero : c ≠ 0 := by + rintro rfl + rw [zero_add] at hc + exact (S.vars_lt v hv).ne hc + +omit hv in +/-- The degree of a partial derivative has zero finite part. -/ +theorem cdeg_constantCoeff : c.constantCoeff = 0 := by + have h := congrArg NatOrdinal.constantCoeff hc + rw [NatOrdinal.constantCoeff_add, S.α_constantCoeff hx] at h + omega + +omit hx hv in +/-- The partial derivative at `v` is homogeneous of complementary degree `c`. -/ +theorem pderiv_hom : IsWeightedHomogeneous wt (pderiv v S.F) c := + isWeightedHomogeneous_pderiv wt S.hom v hc + +omit hx hv in +theorem partLT_cdeg_add_degLT : NatOrdinal.partLT S.β c + S.degLT v = S.αLT := by + have e : NatOrdinal.partLT S.β α = NatOrdinal.partLT S.β (c + wt v) := congrArg _ hc.symm + rw [S.αLT_def, e, NatOrdinal.partLT_add, S.degLT_def] + +omit hx hv in +theorem partGE_cdeg_add : + NatOrdinal.partGE S.β c + NatOrdinal.partGE S.β (wt v) = S.αGE := by + have e : NatOrdinal.partGE S.β α = NatOrdinal.partGE S.β (c + wt v) := congrArg _ hc.symm + rw [S.αGE_def, e, NatOrdinal.partGE_add] + +omit hx hv in +theorem partLT_cdeg_eq_zero_of_lowDegreePartEq (htop : S.LowDegreePartEq v) : + NatOrdinal.partLT S.β c = 0 := by + have h := S.partLT_cdeg_add_degLT hc + rw [(S.lowDegreePartEq_iff v).mp htop] at h + exact add_eq_right.mp h + +omit hx hv in +theorem partGE_cdeg_eq_self_of_lowDegreePartEq (htop : S.LowDegreePartEq v) : + NatOrdinal.partGE S.β c = c := by + have h := NatOrdinal.partGE_add_partLT S.β c + rwa [S.partLT_cdeg_eq_zero_of_lowDegreePartEq hc htop, add_zero] at h + +omit hx hv in +theorem partLT_cdeg_ne_zero (htop : ¬ S.LowDegreePartEq v) : NatOrdinal.partLT S.β c ≠ 0 := by + intro h + have h' := S.partLT_cdeg_add_degLT hc + rw [h, zero_add] at h' + exact htop ((S.lowDegreePartEq_iff v).mpr h') + +end Cofactor + +section Tau + +variable {v' : ι} {h : NatOrdinal} (hh : h + wt v' = α) {lam' : NatOrdinal} + (hlam' : S.degLT v' + lam' = S.lam₀) +include hlam' + +omit hx in +theorem lam'_lt_wpow : lam' < ω^ S.β := + (le_add_of_nonneg_left zero_le).trans_lt (hlam' ▸ S.lam₀_lt_wpow) + +omit hx in +theorem partGE_τ (h : NatOrdinal) : + NatOrdinal.partGE S.β (NatOrdinal.partGE S.β h + lam') = + NatOrdinal.partGE S.β h := by + rw [NatOrdinal.partGE_add, NatOrdinal.partGE_partGE, + NatOrdinal.partGE_eq_zero_of_lt (S.lam'_lt_wpow hlam'), add_zero] + +omit hx in +theorem partLT_τ (h : NatOrdinal) : + NatOrdinal.partLT S.β (NatOrdinal.partGE S.β h + lam') = lam' := by + have h' := NatOrdinal.partGE_add_partLT S.β (NatOrdinal.partGE S.β h + lam') + rw [S.partGE_τ hlam' h] at h' + exact add_left_cancel h' + +include hh + +omit hx hlam' in +theorem partLT_h_add_degLT : NatOrdinal.partLT S.β h + S.degLT v' = S.αLT := + S.partLT_cdeg_add_degLT hh + +omit hx in +theorem lam'_lt_partLT_h : lam' < NatOrdinal.partLT S.β h := by + have h1 := S.partLT_h_add_degLT hh + have h2 : S.degLT v' + lam' < S.degLT v' + NatOrdinal.partLT S.β h := by + rw [hlam', add_comm _ (NatOrdinal.partLT S.β h), h1] + rw [S.αLT_def] + exact S.lam₀_lt + exact lt_of_add_lt_add_left h2 + +/-- The cutoff attached to `v'` lies at least two successor steps below its partial degree. -/ +theorem τ_add_one_lt : NatOrdinal.partGE S.β h + lam' + 1 < h := by + have hlt := S.lam'_lt_partLT_h hh hlam' + have hcc : (NatOrdinal.partLT S.β h).constantCoeff = 0 := by + rw [NatOrdinal.constantCoeff_partLT (S.β_ne_zero hx)] + have h' := congrArg NatOrdinal.constantCoeff hh + rw [NatOrdinal.constantCoeff_add, S.α_constantCoeff hx] at h' + omega + have h1 : lam' + 1 < NatOrdinal.partLT S.β h := by + refine lt_of_le_of_ne (Order.add_one_le_of_lt hlt) fun heq ↦ ?_ + have h' := congrArg NatOrdinal.constantCoeff heq + rw [hcc, show lam' + 1 = lam' + ((1 : ℕ) : NatOrdinal) by rw [Nat.cast_one], + NatOrdinal.constantCoeff_add_natCast] at h' + omega + conv_rhs => rw [← NatOrdinal.partGE_add_partLT S.β h] + rw [add_assoc] + exact add_lt_add_right h1 _ + +omit hx in +theorem αGE_add_lam₀_eq : S.αGE + S.lam₀ = NatOrdinal.partGE S.β h + lam' + wt v' := by + have e : NatOrdinal.partGE S.β α = NatOrdinal.partGE S.β (h + wt v') := + congrArg _ hh.symm + rw [← hlam', S.αGE_def, e, NatOrdinal.partGE_add] + conv_rhs => rw [← S.partGE_add_degLT v'] + abel + +omit hx hh in +theorem partGE_eq_of_τ_le {e : NatOrdinal} + (hτe : NatOrdinal.partGE S.β h + lam' ≤ e) (heh : e < h) : + NatOrdinal.partGE S.β e = NatOrdinal.partGE S.β h := + le_antisymm (NatOrdinal.partGE_mono heh.le) (by + have h' := NatOrdinal.partGE_mono (β := S.β) hτe + rwa [S.partGE_τ hlam' h] at h') + +end Tau + +section PartialDerivativeIndices + +variable {v : ι} (hv : v ∈ S.F.vars) {c : NatOrdinal} (hc : c + wt v = α) + {v' : ι} {h : NatOrdinal} (hh : h + wt v' = α) {lam' : NatOrdinal} + (hlam' : S.degLT v' + lam' = S.lam₀) +include hv hc hh hlam' + +omit hx hh hlam' in +theorem partGE_le_τ_of_lowDegreePartEq (htop : S.LowDegreePartEq v) {ε : NatOrdinal} + (hε : NatOrdinal.leastTerm c = ω^ ε) (h : NatOrdinal) : + NatOrdinal.partGE ε h ≤ NatOrdinal.partGE S.β h + lam' := by + have hβε : S.β ≤ ε := by + have h1 := NatOrdinal.wpow_le_leastTerm_partGE (β := S.β) (a := c) + (by rw [S.partGE_cdeg_eq_self_of_lowDegreePartEq hc htop]; exact S.cdeg_ne_zero hv hc) + rw [S.partGE_cdeg_eq_self_of_lowDegreePartEq hc htop, hε, NatOrdinal.wpow_le_wpow] at h1 + exact h1 + exact (NatOrdinal.partGE_le_partGE_of_le hβε h).trans (le_add_of_nonneg_right zero_le) + +omit hv in +theorem partGE_le_τ_of_hasProperLowDegreePartNotAlgebraicLE + (hL : S.HasProperLowDegreePartNotAlgebraicLE v) {ε : NatOrdinal} + (hε : NatOrdinal.leastTerm (NatOrdinal.partLT S.β c) = ω^ ε) : + NatOrdinal.partGE ε h ≤ NatOrdinal.partGE S.β h + lam' := by + have hεβ : ε ≤ S.β := by + have h1 := NatOrdinal.leastTerm_le + (S.partLT_cdeg_ne_zero hc ((S.hasProperLowDegreePartNotAlgebraicLE_iff v).mp hL).2.2.1) + rw [hε] at h1 + exact (NatOrdinal.wpow_lt_wpow.mp (h1.trans_lt (NatOrdinal.partLT_lt _ _))).le + have h5 := S.partGE_lam₀_eq_of_hasProperLowDegreePartNotAlgebraicLE + hx hL (S.partLT_cdeg_add_degLT hc) hε + have hlamε : NatOrdinal.partGE ε lam' = + NatOrdinal.partGE ε (NatOrdinal.partLT S.β h) := by + have e1 := congrArg (NatOrdinal.partGE ε) hlam' + have e2 := congrArg (NatOrdinal.partGE ε) (S.partLT_h_add_degLT hh) + rw [NatOrdinal.partGE_add] at e1 e2 + rw [h5, ← e2, add_comm (NatOrdinal.partGE ε (NatOrdinal.partLT S.β h))] at e1 + exact add_left_cancel e1 + calc + NatOrdinal.partGE ε h = NatOrdinal.partGE ε (NatOrdinal.partGE S.β h) + + NatOrdinal.partGE ε (NatOrdinal.partLT S.β h) := by + conv_lhs => rw [← NatOrdinal.partGE_add_partLT S.β h] + rw [NatOrdinal.partGE_add] + _ = NatOrdinal.partGE S.β h + NatOrdinal.partGE ε lam' := by + rw [NatOrdinal.partGE_partGE_of_ge hεβ, hlamε] + _ ≤ NatOrdinal.partGE S.β h + lam' := add_le_add_right (NatOrdinal.partGE_le _ _) _ + +omit hx hv hh in +theorem not_algebraicLE_of_lowDegreePartEq_of_not (htop : S.LowDegreePartEq v) + (hdrop : ¬ NatOrdinal.AlgebraicLE c h) {e : NatOrdinal} + (hτe : NatOrdinal.partGE S.β h + lam' ≤ e) (heh : e < h) : + ¬ NatOrdinal.AlgebraicLE c e := by + intro hce + apply hdrop + have h1 := hce.partGE S.β + rw [S.partGE_eq_of_τ_le hlam' hτe heh, + S.partGE_cdeg_eq_self_of_lowDegreePartEq hc htop] at h1 + exact h1.trans (NatOrdinal.algebraicLE_partGE _ _) + +omit hv in +theorem not_algebraicLE_of_hasProperLowDegreePartNotAlgebraicLE_of_not + (hL : S.HasProperLowDegreePartNotAlgebraicLE v) + (hdrop : ¬ NatOrdinal.AlgebraicLE c h) {e : NatOrdinal} + (hτe : NatOrdinal.partGE S.β h + lam' ≤ e) (heh : e < h) : + ¬ NatOrdinal.AlgebraicLE c e := by + intro hce + apply hdrop + have hGE := S.partGE_eq_of_τ_le hlam' hτe heh + have h1 : NatOrdinal.AlgebraicLE (NatOrdinal.partGE S.β c) + (NatOrdinal.partGE S.β h) := by + have h' := hce.partGE S.β + rwa [hGE] at h' + set s := NatOrdinal.partLT S.β e with hsdef + have hlamεs : lam' ≤ s := by + have h2 : NatOrdinal.partGE S.β h + lam' ≤ NatOrdinal.partGE S.β h + s := by + calc + NatOrdinal.partGE S.β h + lam' ≤ e := hτe + _ = NatOrdinal.partGE S.β e + NatOrdinal.partLT S.β e := + (NatOrdinal.partGE_add_partLT S.β e).symm + _ = NatOrdinal.partGE S.β h + s := by rw [hGE] + exact le_of_add_le_add_left h2 + have hsh : s < NatOrdinal.partLT S.β h := + NatOrdinal.partLT_lt_of_lt_of_partGE_eq heh hGE + obtain ⟨ε, hε⟩ := NatOrdinal.exists_leastTerm_eq_wpow + (S.partLT_cdeg_ne_zero hc ((S.hasProperLowDegreePartNotAlgebraicLE_iff v).mp hL).2.2.1) + have h5 := S.partGE_lam₀_eq_of_hasProperLowDegreePartNotAlgebraicLE + hx hL (S.partLT_cdeg_add_degLT hc) hε + have hlamε : NatOrdinal.partGE ε lam' = + NatOrdinal.partGE ε (NatOrdinal.partLT S.β h) := by + have e1 := congrArg (NatOrdinal.partGE ε) hlam' + have e2 := congrArg (NatOrdinal.partGE ε) (S.partLT_h_add_degLT hh) + rw [NatOrdinal.partGE_add] at e1 e2 + rw [h5, ← e2, add_comm (NatOrdinal.partGE ε (NatOrdinal.partLT S.β h))] at e1 + exact add_left_cancel e1 + have hs : NatOrdinal.partGE ε s = NatOrdinal.partGE ε (NatOrdinal.partLT S.β h) := + le_antisymm (NatOrdinal.partGE_mono hsh.le) + (hlamε ▸ NatOrdinal.partGE_mono hlamεs) + have h2 : NatOrdinal.AlgebraicLE (NatOrdinal.partLT S.β c) + (NatOrdinal.partLT S.β h) := by + have h3 := (hce.partLT S.β).partGE ε + rw [NatOrdinal.partGE_eq_self_of_leastTerm_eq + (S.partLT_cdeg_ne_zero hc + ((S.hasProperLowDegreePartNotAlgebraicLE_iff v).mp hL).2.2.1) hε, + ← hsdef, hs] at h3 + exact h3.trans (NatOrdinal.algebraicLE_partGE _ _) + exact NatOrdinal.algebraicLE_of_partGE_of_partLT h1 h2 + +end PartialDerivativeIndices + +end LimitOrdinalRelationAtCutoff + +end HahnSeries.Germ + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativesAtLimitOrdinal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativesAtLimitOrdinal.lean new file mode 100644 index 0000000000..af0c17fcfc --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativesAtLimitOrdinal.lean @@ -0,0 +1,365 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativeIndices +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationExpansion +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CofactorInduction + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Partial-derivative identities when the degree is a limit ordinal + +When the Cantor terms below a cutoff in one variable's weight add to the chosen ordinal bound, its +partial derivative is generated by partial derivatives at explicitly determined variables. The +differentiated truncation expansion gives ideal membership near zero. A decreasing neighbourhood +basis of open convex subgroups turns that eventual condition into a polynomial identity, and strong +induction on the finite set of larger variables eliminates intervening partial derivatives. +-/ + +universe u v w x + +open scoped NatOrdinal Topology + +open Filter MvPolynomial HahnSeries HahnSeries.Nonpositive + +public noncomputable section + +namespace HahnSeries.Germ + +variable {G : Type u} {K : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [Field K] [CharZero K] [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := K)) + +variable {κ : Type x} [LinearOrder κ] [WellFoundedLT κ] +variable (Ubase : κ → AddSubgroup G) +variable (hUmono : ∀ {i j : κ}, i ≤ j → (Ubase j : Set G) ⊆ (Ubase i : Set G)) +variable (hUopen : ∀ i, IsOpen (Ubase i : Set G)) +variable (hUconv : ∀ i, (Ubase i : Set G).OrdConnected) +variable (hUbase : ∀ ε : G, 0 < ε → ∃ i, (Ubase i : Set G) ⊆ Set.Ioo (-ε) ε) + +variable {ι : Type w} {wt : ι → NatOrdinal.{u}} + {xg : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded} +variable {σ : LiftFamily wt xg} {α : NatOrdinal.{u}} (S : LimitOrdinalRelationAtCutoff σ α) +variable (hx : OrdinalGraded.IsMinimalSystem + (DirectSum.rangeLof K (cantorBendixsonDegreeValuation (G := G) (R := K)).Component) wt xg) +variable (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) +variable (hσ : LiftFamily.HasLowerTruncationDegrees σ) + +namespace LimitOrdinalRelationAtCutoff + +include Ubase hUmono hUopen hUconv hUbase S hx hinj hσ + +/-- A partial derivative satisfying the cutoff equation is a finite combination of the designated +partial derivatives, with every cofactor independent of the maximal variable. -/ +@[blueprint "lem:limit-ordinal-partial-derivative-decomposition" + (phase := "Algebraic independence in graded rings") + (title := "Partial-derivative decomposition when the degree is a limit ordinal") + (statement := /-- + Let $K$ be a field of characteristic zero and let $G$ be a nontrivial, + densely ordered abelian group without endpoints, equipped with a compatible + additive uniformity and order topology. Assume that $G$ is Cauchy + complete. Let + $(U_i)_{i\in J}$ be a decreasing family of open convex additive subgroups, + indexed by a well-founded linear order, such that for every $\varepsilon>0$ + some $U_i$ is contained in $(-\varepsilon,\varepsilon)$. + + Let $x_i$ be a minimal homogeneous generating system for the associated + graded ring of the degree filtration, of weights $w_i$. Choose series + $b_i$ representing $x_i$ such that + \[ + \deg(b_i)\le w_i, + \qquad \deg(b_i^{\vert y}) + intro v' hv' hn hdiff + set Θ := pderiv v' S.F with hΘdef + rcases eq_or_ne Θ 0 with hΘ0 | hΘ0 + · exact ⟨∅, fun _ ↦ 0, fun v hv ↦ absurd hv (Finset.notMem_empty v), + fun v hv ↦ absurd hv (Finset.notMem_empty v), by rw [hΘ0, Finset.sum_empty]⟩ + obtain ⟨h, hh⟩ := exists_add_wt_eq_of_mem_vars S.hom hv' + have hhα : h < α := by + rw [← hh] + exact lt_add_of_pos_right _ (pos_iff_ne_zero.mpr (hx.ne_zero v')) + have hΘhom : IsWeightedHomogeneous wt Θ h := by + rw [hΘdef] + exact S.pderiv_hom hh + obtain ⟨lam', + hlam'⟩ := NatOrdinal.algebraicLE_iff.mp ((S.lowDegreePartAlgebraicLE_iff v').mp hdiff) + set τ := NatOrdinal.partGE S.β h + lam' with hτdef + have hτ : NatOrdinal.partGE S.β α + S.lam₀ ≤ τ + wt v' := by + have heq := S.αGE_add_lam₀_eq hh hlam' + rw [S.αGE_def, ← hτdef] at heq + exact heq.le + have habove : ∀ j ∈ S.F.vars, wt v' < wt j → + pderiv j S.F ∈ + Ideal.span (Set.range fun v : {v // S.ContributesToPartialDerivativeAt v' v} ↦ + pderiv v.1 S.F) := by + intro j hj hlt + by_cases htop : S.LowDegreePartEq j + · exact Ideal.subset_span + ⟨⟨j, (S.contributesToPartialDerivativeAt_iff v' j).mpr ⟨hj, Or.inl htop⟩⟩, rfl⟩ + by_cases hL : S.HasProperLowDegreePartNotAlgebraicLE j + · exact Ideal.subset_span + ⟨⟨j, (S.contributesToPartialDerivativeAt_iff v' j).mpr ⟨hj, Or.inr ⟨hL, hlt⟩⟩⟩, rfl⟩ + have hdj : S.LowDegreePartAlgebraicLE j := by + by_contra hnd + rcases eq_or_ne (S.degLT j) 0 with ht | ht + · exact hnd ((S.lowDegreePartAlgebraicLE_iff j).mpr (by + rw [ht] + exact NatOrdinal.algebraicLE_zero _)) + · exact hL ((S.hasProperLowDegreePartNotAlgebraicLE_iff j).mpr ⟨hj, ht, htop, hnd⟩) + have hcard : (S.F.vars.filter fun v ↦ wt j < wt v).card < n := by + rw [← hn] + refine Finset.card_lt_card + (Finset.ssubset_iff_subset_ne.mpr ⟨fun v hv ↦ ?_, fun heq ↦ ?_⟩) + · obtain ⟨hv1, hv2⟩ := Finset.mem_filter.mp hv + exact Finset.mem_filter.mpr ⟨hv1, hlt.trans hv2⟩ + · have hjmem : j ∈ S.F.vars.filter fun v ↦ wt v' < wt v := + Finset.mem_filter.mpr ⟨hj, hlt⟩ + rw [← heq, Finset.mem_filter] at hjmem + exact lt_irrefl _ hjmem.2 + obtain ⟨s, C, hs, -, heq⟩ := ih _ hcard j hj rfl hdj + rw [heq] + refine Ideal.sum_mem _ fun v hv ↦ + Ideal.mul_mem_right _ _ (Ideal.subset_span ⟨⟨v, ?_⟩, rfl⟩) + obtain ⟨hvF, hvkind⟩ := (S.contributesToPartialDerivativeAt_iff j v).mp (hs v hv) + exact (S.contributesToPartialDerivativeAt_iff v' v).mpr + ⟨hvF, hvkind.elim Or.inl fun h' ↦ Or.inr ⟨h'.1, hlt.trans h'.2⟩⟩ + have hlocalAbove : ∀ᶠ γ in 𝓝[<] (0 : G), + componentsGE wt τ (σ.pol hx α + (translatedTruncLE γ (aeval σ.lift Θ))) ∈ + Ideal.span (Set.range fun v : {v // S.ContributesToPartialDerivativeAt v' v} ↦ + pderiv v.1 S.F) := by + filter_upwards [S.truncation_lt, self_mem_nhdsWithin] with γ hrel hγ + have hmem := σ.componentsGE_pol_translatedTruncLE_aeval_pderiv_mem hx hσ hinj S.hom + S.vars_lt S.α₁_le S.α₁_le_α hγ hrel S.remainder_lt v' hτ + rw [← hΘdef] at hmem + refine Ideal.span_le.mpr ?_ hmem + rintro _ ⟨j, rfl⟩ + exact habove j.1 j.2.1 j.2.2 + haveI : Finite {v // S.ContributesToPartialDerivativeAt v' v} := + S.finite_setOf_contributesToPartialDerivativeAt v' + have hcd : ∀ v : {v // S.ContributesToPartialDerivativeAt v' v}, ∃ c, c + wt v.1 = α := + fun v ↦ exists_add_wt_eq_of_mem_vars S.hom + ((S.contributesToPartialDerivativeAt_iff v' v).mp v.2).1 + choose cd hcd using hcd + have hqG : ∀ v : {v // S.ContributesToPartialDerivativeAt v' v}, + IsWeightedHomogeneous wt (pderiv v.1 S.F) (cd v) := + fun v ↦ S.pderiv_hom (hcd v) + let A : {v // S.ContributesToPartialDerivativeAt v' v} → Prop := + fun v ↦ NatOrdinal.AlgebraicLE (wt v') (wt v.1) + have hAiff : ∀ v, A v ↔ NatOrdinal.AlgebraicLE (wt v') (wt v.1) := fun _ ↦ Iff.rfl + haveI : Finite {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} := + Finite.of_injective (fun v ↦ v.1) Subtype.val_injective + have hbA : ∀ v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, + ∃ b, b + wt v' = wt v.1.1 := fun v ↦ by + obtain ⟨c, hc⟩ := NatOrdinal.algebraicLE_iff.mp ((hAiff v.1).mp v.2) + exact ⟨c, by rw [add_comm]; exact hc⟩ + choose b hb using hbA + have hbc : ∀ v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, + b v + cd v.1 = h := by + intro v + have h1 : b v + cd v.1 + wt v' = h + wt v' := by + rw [add_right_comm, hb v, add_comm, hcd v.1, hh] + exact add_right_cancel h1 + have hnotA : ∀ v : {v // S.ContributesToPartialDerivativeAt v' v}, ¬ A v → + ¬ NatOrdinal.AlgebraicLE (cd v) h := by + intro v hA hce + obtain ⟨b', hb'⟩ := NatOrdinal.algebraicLE_iff.mp hce + refine hA ((hAiff v).mpr (NatOrdinal.algebraicLE_iff.mpr ⟨b', ?_⟩)) + have h1 : cd v + (b' + wt v') = cd v + wt v.1 := by + rw [← add_assoc, hb', hh, hcd v] + rw [add_comm] + exact add_left_cancel h1 + have hlocal : ∀ᶠ γ in 𝓝[<] (0 : G), + componentsGE wt τ (σ.pol hx α + (translatedTruncLE γ (aeval σ.lift Θ))) ∈ + Ideal.span (Set.range fun v : + {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} ↦ pderiv v.1.1 S.F) := by + filter_upwards [hlocalAbove, self_mem_nhdsWithin] with γ hmem hγ + refine componentsGE_mem_span_subtype wt hqG (h := h) hmem ?_ A + (fun v hA e hτe heh ⟨β', hβ'⟩ ↦ ?_) + · exact σ.pol_weight_lt_of_degree_lt hx hhα.le + ((σ.hasLowerTruncationDegree_aeval hσ hΘhom).degree_translatedTruncLE_lt hγ) + · have hce : NatOrdinal.AlgebraicLE (cd v) e := + NatOrdinal.algebraicLE_iff.mpr ⟨β', by rw [add_comm]; exact hβ'⟩ + rw [hτdef] at hτe + rcases ((S.contributesToPartialDerivativeAt_iff v' v).mp v.2).2 with htop | ⟨hL, -⟩ + · exact S.not_algebraicLE_of_lowDegreePartEq_of_not (hcd v) hlam' htop + (hnotA v hA) hτe heh hce + · exact S.not_algebraicLE_of_hasProperLowDegreePartNotAlgebraicLE_of_not + hx (hcd v) hh hlam' hL (hnotA v hA) hτe heh hce + have hτh : τ + 1 < h := hτdef ▸ S.τ_add_one_lt hx hh hlam' + have hwin : ∀ v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, + ∀ ε : NatOrdinal, NatOrdinal.leastTerm (cd v.1) = ω^ ε → + NatOrdinal.partGE ε h ≤ τ := by + intro v ε hε + rw [hτdef] + obtain ⟨hvF, hvkind⟩ := (S.contributesToPartialDerivativeAt_iff v' v.1).mp v.1.2 + rcases hvkind with htop | ⟨hL, -⟩ + · exact S.partGE_le_τ_of_lowDegreePartEq hvF (hcd v.1) htop hε h + · have hne := S.partLT_cdeg_ne_zero (hcd v.1) + ((S.hasProperLowDegreePartNotAlgebraicLE_iff _).mp hL).2.2.1 + rw [NatOrdinal.leastTerm_eq_leastTerm_partLT hne] at hε + exact S.partGE_le_τ_of_hasProperLowDegreePartNotAlgebraicLE hx (hcd v.1) hh hlam' hL hε + have hp : ∀ᶠ γ in 𝓝[<] (0 : G), ∃ P : MvPolynomial ι K, + (∀ d ∈ P.support, Finsupp.weight wt d < α) ∧ + ν (translatedTruncLE γ (aeval σ.lift Θ) - aeval σ.lift P) = ⊥ ∧ + componentsGE wt τ P ∈ + Ideal.span (Set.range fun v : + {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} ↦ pderiv v.1.1 S.F) := by + filter_upwards [hlocal, self_mem_nhdsWithin] with γ hmem hγ + have hdeg := (σ.hasLowerTruncationDegree_aeval hσ hΘhom).degree_translatedTruncLE_lt hγ + refine ⟨σ.pol hx α (translatedTruncLE γ (aeval σ.lift Θ)), + σ.pol_weight_lt hx _ _, ?_, hmem⟩ + exact σ.degree_sub_aeval_pol_eq_bot hx (hdeg.trans (WithBot.coe_lt_coe.mpr hhα)) + have hgen : ∀ β : NatOrdinal.{u}, β < α → + ∀ z ∈ DirectSum.rangeLof K (ν).Component β, + ∃ P : MvPolynomial ι K, IsWeightedHomogeneous wt P β ∧ aeval xg P = z := + fun β _ ↦ hx.exists_aeval_eq cantorBendixson_gradeZeroScalars β + have hinj' : ∀ (β : NatOrdinal.{u}) (P : MvPolynomial ι K), β < α → + IsWeightedHomogeneous wt P β → aeval xg P = 0 → P = 0 := by + intro β P hβα + exact ((OrdinalGraded.injectiveAt_iff β).mp (hinj β hβα)) P + cases nonempty_fintype {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} + obtain ⟨C, hChom, hΘeq⟩ := + exists_eq_sum_mul_of_eventually_componentsGE_mem_of_windows Ubase hUmono hUopen hUconv + hUbase xg σ.represents ((σ.hasLowerTruncationDegrees_iff).mp hσ) α hgen hinj' + (fun v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} ↦ pderiv v.1.1 S.F) + (fun v ↦ cd v.1) b (fun v ↦ hqG v.1) τ h hτh hhα + (fun v ↦ S.cdeg_ne_zero + ((S.contributesToPartialDerivativeAt_iff v' v.1.1).mp v.1.2).1 (hcd v.1)) + hbc hwin hΘhom + (σ.hasLowerTruncationDegree_aeval hσ hΘhom) hp + have hCB₀ : ∀ v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, + pderiv S.B₀ (C v) = 0 := by + intro v + have hbg : b v < wt S.B₀ := by + have h1 : b v < wt v.1.1 := by + rw [← hb v] + exact lt_add_of_pos_right _ (pos_iff_ne_zero.mpr (hx.ne_zero v')) + exact h1.trans_le (S.max _ ((S.contributesToPartialDerivativeAt_iff v' v.1.1).mp v.1.2).1) + exact LiftFamily.pderiv_eq_zero_of_degreeLT_le + ((LiftFamily.degreeLT_iff).mpr + (fun d hd ↦ (hChom v (b v) (hbc v)) (mem_support_iff.mp hd) ▸ hbg)) le_rfl + have hindex : Function.Injective + (fun v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} ↦ v.1.1) := + fun v w hvw ↦ Subtype.ext (Subtype.ext hvw) + refine ⟨Finset.univ.image + (fun v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} ↦ v.1.1), + fun i ↦ if hi : ∃ v : + {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, v.1.1 = i then + C (Classical.choose hi) else 0, ?_, ?_, ?_⟩ + · intro i hi + obtain ⟨v, -, rfl⟩ := Finset.mem_image.mp hi + exact v.1.2 + · intro i hi + obtain ⟨v, -, rfl⟩ := Finset.mem_image.mp hi + beta_reduce + rw [dif_pos (⟨v, rfl⟩ : + ∃ w : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, w.1.1 = v.1.1)] + exact hCB₀ _ + · rw [hΘeq, Finset.sum_image fun v _ w _ h ↦ hindex h] + refine Finset.sum_congr rfl fun v _ ↦ ?_ + beta_reduce + rw [dif_pos (⟨v, rfl⟩ : + ∃ w : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, w.1.1 = v.1.1)] + have hchoice : Classical.choose + (⟨v, rfl⟩ : ∃ w : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, + w.1.1 = v.1.1) = v := hindex (Classical.choose_spec + (⟨v, rfl⟩ : ∃ w : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, + w.1.1 = v.1.1)) + rw [hchoice, mul_comm] + +end LimitOrdinalRelationAtCutoff + +end HahnSeries.Germ + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Power.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Power.lean new file mode 100644 index 0000000000..347f5d9248 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Power.lean @@ -0,0 +1,270 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Leibniz + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPrincipal + +/-! +# Power remainders for the Cantor–Bendixson value + +The product rule for a positive power is valid up to a remainder of strictly smaller value. +The induction also bounds the value of each translated partial product. This supplies the +interior convolution estimates without assuming multiplicativity or knowing the principal +factor of a product. + +The multiplicity is a natural-number scalar in the series ring. The estimates hold in every +characteristic over a commutative coefficient ring. Nonvanishing of this scalar, which is needed +when the main term is to survive cancellation, is a separate assertion. + +In the proofs, V reads the Cantor–Bendixson value in NatOrdinal, and T denotes translated weak +truncation. Products of values are natural ordinal products, while products of series are Hahn +products. The final canonical principal factors determine the comparison hypothesis. +-/ + +public noncomputable section + +open Set Filter Topology + +universe u v + +namespace HahnSeries + +private theorem small_values_mul_lt (B C : Ordinal.AdditivePrincipalAboveOne.{u}) + {a c : NatOrdinal.{u}} (hp : B.principalFactor ≤ C.principalFactor) + (ha : a < NatOrdinal.of B.val) (hc : c < NatOrdinal.of C.val) : + a * c < NatOrdinal.of B.residualFactor * NatOrdinal.of C.val := by + have ha' : a.val < B.residualFactor * B.principalFactor := by + rw [B.residualFactor_mul_principalFactor] + exact ha + have hc' : c.val < C.residualFactor * C.principalFactor := by + rw [C.residualFactor_mul_principalFactor] + exact hc + obtain ⟨x, hx, hxa⟩ := (Ordinal.lt_mul_iff_of_isSuccLimit + B.principalFactor_isInfiniteMultiplicativelyPrincipal.isSuccLimit).mp ha' + obtain ⟨y, hy, hyc⟩ := (Ordinal.lt_mul_iff_of_isSuccLimit + C.principalFactor_isInfiniteMultiplicativelyPrincipal.isSuccLimit).mp hc' + have hρB : 0 < NatOrdinal.of B.residualFactor := + pos_iff_ne_zero.mpr B.residualFactor_isAdditivelyPrincipal.ne_zero + have hρC : 0 < NatOrdinal.of C.residualFactor := + pos_iff_ne_zero.mpr C.residualFactor_isAdditivelyPrincipal.ne_zero + have hfinal := NatOrdinal.naturalMul_mul_lt_of_lt + (ρ₁ := NatOrdinal.of B.residualFactor) (ρ₂ := NatOrdinal.of C.residualFactor) + (π₁ := NatOrdinal.of B.principalFactor) (π₂ := NatOrdinal.of C.principalFactor) + (α₁ := NatOrdinal.of x) (α₂ := NatOrdinal.of y) + C.principalFactor_isMultiplicativelyPrincipal hp hx hy (mul_pos hρB hρC) + rw [mul_assoc, C.naturalResidual_mul_naturalPrincipal] at hfinal + exact (mul_le_mul' (NatOrdinal.of.le_iff_le.mpr hxa.le) + (NatOrdinal.of.le_iff_le.mpr hyc.le)).trans_lt hfinal + +variable {G : Type u} {R : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + +section Ring + +variable [Ring R] + +/-- The product-rule error for a positive power times another Hahn series, using weak truncation. -/ +def leibnizPowerRemainder (b d : HahnSeries G R) (m : ℕ) (γ : G) : HahnSeries G R := + translate (-γ) (truncLE γ (b ^ (m + 1) * d)) - + (m + 1) • (translate (-γ) (truncLE γ b) * (b ^ m * d)) - + b ^ (m + 1) * translate (-γ) (truncLE γ d) + +/-- The power remainder is the translated product truncation minus its two product-rule terms. -/ +theorem leibnizPowerRemainder_eq (b d : HahnSeries G R) (m : ℕ) (γ : G) : + leibnizPowerRemainder b d m γ = + translate (-γ) (truncLE γ (b ^ (m + 1) * d)) - + (m + 1) • (translate (-γ) (truncLE γ b) * (b ^ m * d)) - + b ^ (m + 1) * translate (-γ) (truncLE γ d) := (rfl) + +/-- Nonpositive inputs give a power remainder with nonpositive support. -/ +theorem support_leibnizPowerRemainder (b d : HahnSeries G R) + (hb : b.support ⊆ Iic 0) (hd : d.support ⊆ Iic 0) (m : ℕ) (γ : G) : + (leibnizPowerRemainder b d m γ).support ⊆ Iic 0 := by + rw [leibnizPowerRemainder_eq] + apply (nonpositiveSubring G R).sub_mem + · apply (nonpositiveSubring G R).sub_mem + · exact support_translated_truncLE _ _ + · apply (nonpositiveSubring G R).nsmul_mem + exact (nonpositiveSubring G R).mul_mem (support_translated_truncLE _ _) + ((nonpositiveSubring G R).mul_mem ((nonpositiveSubring G R).pow_mem hb m) hd) + · exact (nonpositiveSubring G R).mul_mem ((nonpositiveSubring G R).pow_mem hb (m + 1)) + (support_translated_truncLE _ _) + +end Ring + +variable [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] + [Nontrivial G] [CompleteSpace G] [CommRing R] + +local notation "V" => (fun b : HahnSeries G R ↦ NatOrdinal.of (cantorBendixsonValue b)) +local notation:max "T" x:arg "," c:arg => translate (-c) (truncLE c x) + +private theorem partial_product_truncation_bound (b c : HahnSeries G R) + (hb : b.support ⊆ Iic 0) (hc : c.support ⊆ Iic 0) + (B C : Ordinal.AdditivePrincipalAboveOne.{u}) + (hB : b.cantorBendixsonValue = B.val) (hC : c.cantorBendixsonValue = C.val) + (hp : B.principalFactor ≤ C.principalFactor) (m : ℕ) + (hP : ∀ᶠ γ in 𝓝[<] (0 : G), V (leibnizPowerRemainder b c m γ) < + NatOrdinal.of B.val ^ m * NatOrdinal.of B.residualFactor * NatOrdinal.of C.val) : + ∀ᶠ γ in 𝓝[<] (0 : G), ∀ t : NatOrdinal.{u}, t < NatOrdinal.of B.val → + t * V (T (b ^ (m + 1) * c), γ) < + NatOrdinal.of B.val ^ (m + 1) * NatOrdinal.of B.residualFactor * NatOrdinal.of C.val := by + have hb0 : b.cantorBendixsonValue ≠ 0 := by rw [hB]; exact B.2.1.ne_zero + have hc0 : c.cantorBendixsonValue ≠ 0 := by rw [hC]; exact C.2.1.ne_zero + filter_upwards [hP, + (b.eventually_value_translated_truncLE_lt hb0).filter_mono nhdsWithin_le_nhds, + (c.eventually_value_translated_truncLE_lt hc0).filter_mono nhdsWithin_le_nhds, + self_mem_nhdsWithin] with γ hP hbγ hcγ hγ t ht + have hbt : V (T b, γ) < NatOrdinal.of B.val := + NatOrdinal.of.lt_iff_lt.mpr (by simpa only [hB] using hbγ (ne_of_lt hγ)) + have hct : V (T c, γ) < NatOrdinal.of C.val := + NatOrdinal.of.lt_iff_lt.mpr (by simpa only [hC] using hcγ (ne_of_lt hγ)) + let v := NatOrdinal.of B.val + let w := NatOrdinal.of C.val + let r := NatOrdinal.of B.residualFactor + have hv : 0 < v := pos_iff_ne_zero.mpr B.2.1.ne_zero + have hw : 0 < w := pos_iff_ne_zero.mpr C.2.1.ne_zero + have hr : 0 < r := pos_iff_ne_zero.mpr B.residualFactor_isAdditivelyPrincipal.ne_zero + have hpows (n : ℕ) : (b ^ n).support ⊆ Iic (0 : G) := + (nonpositiveSubring G R).pow_mem hb n + have hpv (n : ℕ) : V (b ^ n) ≤ v ^ n := by + simpa only [hB] using b.cantorBendixsonValue_pow_le hb n + have hpc : V (b ^ m * c) ≤ v ^ m * w := by + have h := (b ^ m).cantorBendixsonValue_mul_le c (hpows m) hc + rw [hC] at h + exact h.trans (mul_le_mul_left (hpv m) _) + have hA : V ((m + 1) • (T b, γ * (b ^ m * c))) ≤ V (T b, γ) * (v ^ m * w) := + (cantorBendixsonValue_nsmul_le _ _).trans + ((cantorBendixsonValue_mul_le _ _ (b.support_translated_truncLE γ) + ((nonpositiveSubring G R).mul_mem (hpows m) hc)).trans (mul_le_mul_right hpc _)) + have hD : V (b ^ (m + 1) * T c, γ) ≤ v ^ (m + 1) * V (T c, γ) := + (cantorBendixsonValue_mul_le _ _ (hpows (m + 1)) (c.support_translated_truncLE γ)).trans + (mul_le_mul_left (hpv (m + 1)) _) + have hval : V (T (b ^ (m + 1) * c), γ) ≤ + max (max (V (T b, γ) * (v ^ m * w)) (v ^ (m + 1) * V (T c, γ))) + (v ^ m * r * w) := by + have he : T (b ^ (m + 1) * c), γ = + (m + 1) • (T b, γ * (b ^ m * c)) + b ^ (m + 1) * T c, γ + + leibnizPowerRemainder b c m γ := by + rw [leibnizPowerRemainder_eq] + abel + rw [he] + exact (cantorBendixsonValue_add_le _ _).trans + (max_le_max ((cantorBendixsonValue_add_le _ _).trans (max_le_max hA hD)) hP.le) + have h1 : t * (V (T b, γ) * (v ^ m * w)) < v ^ (m + 1) * r * w := by + calc + _ = (t * V (T b, γ)) * (v ^ m * w) := by ring + _ < (r * v) * (v ^ m * w) := + mul_lt_mul_of_pos_right (small_values_mul_lt B B le_rfl ht hbt) + (mul_pos (pow_pos hv m) hw) + _ = _ := by ring + have h2 : t * (v ^ (m + 1) * V (T c, γ)) < v ^ (m + 1) * r * w := by + calc + _ = v ^ (m + 1) * (t * V (T c, γ)) := by ring + _ < v ^ (m + 1) * (r * w) := + mul_lt_mul_of_pos_left (small_values_mul_lt B C hp ht hct) (pow_pos hv (m + 1)) + _ = _ := by ring + have h3 : t * (v ^ m * r * w) < v ^ (m + 1) * r * w := by + calc + _ < v * (v ^ m * r * w) := + mul_lt_mul_of_pos_right ht (mul_pos (mul_pos (pow_pos hv m) hr) hw) + _ = _ := by ring + have hmono : Monotone fun x : NatOrdinal.{u} ↦ t * x := fun _ _ h ↦ mul_le_mul_right h t + apply (mul_le_mul_right hval t).trans_lt + rw [hmono.map_max, hmono.map_max] + exact max_lt (max_lt h1 h2) h3 + +/-- The power-product remainder is eventually below the natural product of the remaining +powers, the first value's residual factor, and the second value. -/ +theorem eventually_cantorBendixsonValue_leibnizPowerRemainder_lt (b c : HahnSeries G R) + (hb : b.support ⊆ Iic 0) (hc : c.support ⊆ Iic 0) + (B C : Ordinal.AdditivePrincipalAboveOne.{u}) + (hB : b.cantorBendixsonValue = B.val) (hC : c.cantorBendixsonValue = C.val) + (hp : B.principalFactor ≤ C.principalFactor) (m : ℕ) : + ∀ᶠ γ in 𝓝[<] (0 : G), NatOrdinal.of (leibnizPowerRemainder b c m γ).cantorBendixsonValue < + NatOrdinal.of B.val ^ m * NatOrdinal.of B.residualFactor * NatOrdinal.of C.val := by + induction m with + | zero => + simpa only [leibnizPowerRemainder_eq, zero_add, pow_one, pow_zero, one_mul, one_nsmul] + using b.eventually_cantorBendixsonValue_leibnizRemainder_lt c hb hc B C hB hC hp + | succ m ih => + have hQ := partial_product_truncation_bound b c hb hc B C hB hC hp m ih + have hb0 : b.cantorBendixsonValue ≠ 0 := by rw [hB]; exact B.2.1.ne_zero + have hcut := (b.eventually_value_translated_truncLE_lt hb0).filter_mono + (nhdsWithin_le_nhds (s := Iio (0 : G))) + obtain ⟨η, hη, hηall⟩ := eventually_nhdsLT_iff_exists.mp (hQ.and (ih.and hcut)) + let d := b ^ (m + 1) * c + have hd : d.support ⊆ Iic (0 : G) := + (nonpositiveSubring G R).mul_mem ((nonpositiveSubring G R).pow_mem hb (m + 1)) hc + let v := NatOrdinal.of B.val + let w := NatOrdinal.of C.val + let r := NatOrdinal.of B.residualFactor + have hv : 0 < v := pos_iff_ne_zero.mpr B.2.1.ne_zero + have hw : 0 < w := pos_iff_ne_zero.mpr C.2.1.ne_zero + have hr : 0 < r := pos_iff_ne_zero.mpr B.residualFactor_isAdditivelyPrincipal.ne_zero + have hbound : 0 < v ^ (m + 1) * r * w := mul_pos (mul_pos (pow_pos hv _) hr) hw + filter_upwards [Ioo_mem_nhdsLT hη] with γ hγ + have herr : V (T (b * d), γ - T b, γ * d - b * T d, γ) < v ^ (m + 1) * r * w := by + apply cantorBendixsonValue_leibnizRemainder_lt_of_forall b d hb hd hγ.2 hbound + intro x y hγx hx hγy hy _ + have htx : V (T b, x) < v := by + apply NatOrdinal.of.lt_iff_lt.mpr + rw [← hB] + exact (hηall x (hγ.1.trans hγx) hx).2.2 hx.ne + exact (cantorBendixsonValue_mul_le _ _ (b.support_translated_truncLE x) + (d.support_translated_truncLE y)).trans_lt + ((hηall y (hγ.1.trans hγy) hy).1 _ htx) + have hprev : V (b * leibnizPowerRemainder b c m γ) < v ^ (m + 1) * r * w := by + have hmul := b.cantorBendixsonValue_mul_le (leibnizPowerRemainder b c m γ) hb + (support_leibnizPowerRemainder b c hb hc m γ) + rw [hB] at hmul + apply hmul.trans_lt + calc + _ < v * (v ^ m * r * w) := + mul_lt_mul_of_pos_left (hηall γ hγ.1 hγ.2).2.1 hv + _ = _ := by ring + have he : leibnizPowerRemainder b c (m + 1) γ = + b * leibnizPowerRemainder b c m γ + + (T (b * d), γ - T b, γ * d - b * T d, γ) := by + rw [leibnizPowerRemainder_eq, leibnizPowerRemainder_eq] + have hpow : b ^ (m + 1 + 1) * c = b * d := by dsimp only [d]; ring + rw [hpow] + dsimp only [d] + simp only [nsmul_eq_mul, Nat.cast_add, Nat.cast_one] + ring + rw [he] + exact (cantorBendixsonValue_add_le _ _).trans_lt (max_lt hprev herr) + +/-- The pure-power remainder has the corresponding strict bound, including exponent one. -/ +theorem eventually_cantorBendixsonValue_powerRemainder_lt (b : HahnSeries G R) + (hb : b.support ⊆ Iic 0) (B : Ordinal.AdditivePrincipalAboveOne.{u}) + (hB : b.cantorBendixsonValue = B.val) (m : ℕ) : + ∀ᶠ γ in 𝓝[<] (0 : G), + NatOrdinal.of (translate (-γ) (truncLE γ (b ^ (m + 1))) - + (m + 1) • (translate (-γ) (truncLE γ b) * b ^ m)).cantorBendixsonValue < + NatOrdinal.of B.val ^ m * NatOrdinal.of B.residualFactor := by + cases m with + | zero => + apply Filter.Eventually.of_forall + intro γ + simp only [zero_add, pow_one, pow_zero, mul_one, one_nsmul, sub_self, + cantorBendixsonValue_zero, NatOrdinal.of_zero, one_mul] + exact pos_iff_ne_zero.mpr B.residualFactor_isAdditivelyPrincipal.ne_zero + | succ m => + filter_upwards [eventually_cantorBendixsonValue_leibnizPowerRemainder_lt + b b hb hb B B hB hB le_rfl m] with γ hγ + have he : T (b ^ (m + 1 + 1)), γ - (m + 1 + 1) • (T b, γ * b ^ (m + 1)) = + leibnizPowerRemainder b b m γ := by + rw [leibnizPowerRemainder_eq, ← pow_succ] + simp only [nsmul_eq_mul, Nat.cast_add, Nat.cast_one] + ring + rw [he] + convert hγ using 1 + ring + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PrincipalSeries.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PrincipalSeries.lean new file mode 100644 index 0000000000..341fd0ca94 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PrincipalSeries.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ClosedPWO + +/-! +# Cantor–Bendixson rank of a principal real Hahn series + +For a principal series of Hahn degree `α`, the endpoint zero of its closed support has +Cantor–Bendixson rank `α`. Thus its Cantor–Bendixson value is the same `ω ^ α` that occurs in +the support-order definition of degree. +-/ + +open Set +open scoped HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +open HahnSeries + +variable {K : Type v} [Field K] + +/-- A principal real Hahn series of degree `α` has Cantor–Bendixson rank `α` at zero. -/ +theorem IsPrincipal.cantorBendixsonRank_zero_eq_of_degree_eq + {p : Nonpositive ℝ K} (hp : IsPrincipal p) {a : NatOrdinal} + (hdegree : (p : K⟦ℝ⟧).degree = (a : WithBot NatOrdinal)) : + (p : K⟦ℝ⟧).cantorBendixsonRank 0 = a.val := by + rcases eq_or_ne a 0 with rfl | ha + · have hpconst := hp.eq_C_constantCoeff_of_degree_zero hdegree + apply (p : K⟦ℝ⟧).cantorBendixsonRank_of_finite + rw [hpconst, coe_C] + exact (finite_singleton 0).subset HahnSeries.support_single_subset + · have hapos : 0 < a := pos_iff_ne_zero.mpr ha + have hcoeff := hp.constantCoeff_eq_zero_of_degree_pos hdegree hapos + have hzero : 0 ∉ (p : K⟦ℝ⟧).support := by + intro hmem + rw [constantCoeff_apply] at hcoeff + exact (HahnSeries.mem_support _ _).mp hmem hcoeff + have hlub : IsLUB (p : K⟦ℝ⟧).support 0 := + (supportSup_eq_coe_iff.mp hp.supportSup_eq_zero).2 + have htype := hp.supportOrderType_eq_wpow_of_degree_eq hdegree + let S : TopologicalSpace.Closeds ℝ := + ⟨closure (p : K⟦ℝ⟧).support, isClosed_closure⟩ + let hS : (S : Set ℝ).IsPWO := (p : K⟦ℝ⟧).isPWO_support.closure + have hsets : ((p : K⟦ℝ⟧).closedSupport : Set ℝ) = (S : Set ℝ) := + (p : K⟦ℝ⟧).coe_closedSupport + rw [cantorBendixsonRank_eq] + calc + (p : K⟦ℝ⟧).closedSupport.cantorBendixsonRank + (p : K⟦ℝ⟧).closedSupport_isPWO 0 = + S.cantorBendixsonRank hS 0 := + (p : K⟦ℝ⟧).closedSupport.cantorBendixsonRank_congr_on_open S + (p : K⟦ℝ⟧).closedSupport_isPWO hS isOpen_univ + (by simpa only [inter_univ] using hsets) (mem_univ 0) + _ = a.val := by + apply Set.IsPWO.cantorBendixsonRank_closure_eq_of_orderType_eq_opow + (p : K⟦ℝ⟧).isPWO_support hlub hzero + · exact NatOrdinal.val.injective.ne ha + · simpa only [HahnSeries.supportOrderType_eq_setOrderType, + NatOrdinal.val_wpow] using htype + +/-- A principal real Hahn series of degree `α` has Cantor–Bendixson value `ω ^ α`. -/ +theorem IsPrincipal.cantorBendixsonValue_eq_wpow_of_degree_eq + {p : Nonpositive ℝ K} (hp : IsPrincipal p) {a : NatOrdinal} + (hdegree : (p : K⟦ℝ⟧).degree = (a : WithBot NatOrdinal)) : + (p : K⟦ℝ⟧).cantorBendixsonValue = (Ordinal.omega0 ^ a.val) := by + have hmem : 0 ∈ closure (p : K⟦ℝ⟧).support := by + have hlub : IsLUB (p : K⟦ℝ⟧).support 0 := + (supportSup_eq_coe_iff.mp hp.supportSup_eq_zero).2 + exact hlub.mem_closure (HahnSeries.support_nonempty_iff.mpr (by simpa using hp.ne_zero)) + rw [(p : K⟦ℝ⟧).cantorBendixsonValue_of_mem hmem, + hp.cantorBendixsonRank_zero_eq_of_degree_eq hdegree] + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Scalar.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Scalar.lean new file mode 100644 index 0000000000..c838edda8b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Scalar.lean @@ -0,0 +1,376 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivation +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Residue +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.InternalGrading +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermChainRule +import Mathlib.Tactic.Abel + +/-! +# Coefficients in the associated graded ring of the Cantor–Bendixson degree + +For a coefficient field `K`, constant Hahn series have degree zero. Projection to the +zero homogeneous component is a bijective ring homomorphism: a degree-zero representative +differs from its ordinary coefficient by a series bounded strictly below zero. This identifies +the zero component with `K`, gives every component its canonical vector-space structure, and +makes the associated graded ring a graded `K`-algebra. + +The additive truncation map is linear for this action and satisfies the Leibniz rule, so it is a +derivation from the associated graded ring to germs of associated-graded-valued functions. It +vanishes on components indexed by limit ordinals and is injective from degree `α + 1` to degree `α`. +The exponent group remains arbitrary, complete, and ordered; no real-exponent reduction is used. +-/ + +public noncomputable section +open Set Filter Topology +open scoped DirectSum NatOrdinal +universe u v w +namespace HahnSeries.Nonpositive +variable {G : Type u} {K : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [Field K] [CharZero K] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := K)) + +/-- A nonzero constant series has degree exactly zero. -/ +theorem degree_C_of_ne (k : K) (hk : k ≠ 0) : + ν (C k) = (0 : NatOrdinal) := by + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + coe_C, cantorBendixsonValue_of_finite_of_coeff_ne_zero (HahnSeries.C k) + ((finite_singleton (0 : G)).subset support_single_subset) (by simpa using hk), + NatOrdinal.of_one, NatOrdinal.cantorDegree_eq_ordinalCantorDegree, + NatOrdinal.val_one, Ordinal.cantorDegree_one, WithBot.coe_zero] + +/-- Every constant series has degree at most zero. -/ +theorem degree_C_le (k : K) : ν (C k) ≤ (0 : NatOrdinal) := by + by_cases hk : k = 0 + · subst k + simp + · rw [degree_C_of_ne k hk] + +private def constantToNonpositiveDegree (k : K) : (ν).nonpositiveSubring := + ⟨C k, ((ν).mem_nonpositiveSubring_iff _).mpr (by + by_cases hk : k = 0 + · subst k + simp + · rw [degree_C_of_ne k hk] + exact le_rfl)⟩ + +private theorem constantToNonpositiveDegree_zero : + constantToNonpositiveDegree (G := G) (K := K) 0 = 0 := by + apply Subtype.ext + exact map_zero C + +private theorem constantToNonpositiveDegree_add (k l : K) : + constantToNonpositiveDegree (G := G) (k + l) = + constantToNonpositiveDegree k + constantToNonpositiveDegree l := by + apply Subtype.ext + exact map_add C k l + +private theorem constantToNonpositiveDegree_one : + constantToNonpositiveDegree (G := G) (K := K) 1 = 1 := by + apply Subtype.ext + exact map_one C + +private theorem constantToNonpositiveDegree_mul (k l : K) : + constantToNonpositiveDegree (G := G) (k * l) = + constantToNonpositiveDegree k * constantToNonpositiveDegree l := by + apply Subtype.ext + exact map_mul C k l + +private def constantToNonpositiveDegreeHom : K →+* (ν).nonpositiveSubring where + toFun := constantToNonpositiveDegree + map_zero' := constantToNonpositiveDegree_zero + map_add' := constantToNonpositiveDegree_add + map_one' := constantToNonpositiveDegree_one + map_mul' := constantToNonpositiveDegree_mul + +/-- The coefficient field mapped isomorphically to the grade-zero component. -/ +def cantorBendixsonLayerScalarHom : K →+* (ν).ResidueRing := + (ν).residueMap.comp constantToNonpositiveDegreeHom + +/-- A coefficient maps to the grade-zero class of its constant Hahn series. -/ +theorem cantorBendixsonLayerScalarHom_apply (k : K) : + cantorBendixsonLayerScalarHom (G := G) k = + (ν).componentMk 0 ⟨C k, ((ν).mem_filtrationLE_iff _ _).mpr (by + by_cases hk : k = 0 + · subst k + simp + · rw [degree_C_of_ne k hk])⟩ := by + rw [cantorBendixsonLayerScalarHom, RingHom.comp_apply, (ν).residueMap_apply] + apply congrArg ((ν).componentMk 0) + apply Subtype.ext + rw [(ν).coe_nonpositiveEquivFiltrationLEZero] + rfl + +/-- Distinct coefficients give distinct grade-zero classes. -/ +theorem cantorBendixsonLayerScalarHom_injective : + Function.Injective (cantorBendixsonLayerScalarHom (G := G) (K := K)) := by + intro k l hkl + have hsub : cantorBendixsonLayerScalarHom (G := G) (k - l) = 0 := by + rw [map_sub, hkl, sub_self] + rw [cantorBendixsonLayerScalarHom_apply, (ν).componentMk_eq_zero_iff] at hsub + by_contra hne + rw [degree_C_of_ne _ (sub_ne_zero.mpr hne)] at hsub + exact (lt_irrefl (0 : WithBot NatOrdinal)) hsub + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] + [CompleteSpace G] [CharZero K] in +private theorem coe_C_eq_single (k : K) : + ((C k : Nonpositive G K) : HahnSeries G K) = HahnSeries.single 0 k := by + ext g + simp [coe_C] + +/-- Every grade-zero class has a unique constant representative modulo strict lower degree. -/ +theorem cantorBendixsonLayerScalarHom_surjective : + Function.Surjective (cantorBendixsonLayerScalarHom (G := G) (K := K)) := by + intro a + induction a using QuotientAddGroup.induction_on with + | H b => + let k := constantCoeff (b : Nonpositive G K) + refine ⟨k, ?_⟩ + rw [cantorBendixsonLayerScalarHom_apply, (ν).coe_component_eq_componentMk] + apply ((ν).componentMk_eq_componentMk_iff _ _ _).mpr + change ν (C k - (b : Nonpositive G K)) < (0 : NatOrdinal) + have hb := ((ν).mem_filtrationLE_iff _ _).mp b.property + have hv : (b : HahnSeries G K).cantorBendixsonValue = 0 ∨ + (b : HahnSeries G K).cantorBendixsonValue = 1 := by + by_cases hm : 0 ∈ (b : HahnSeries G K).closedSupport + · right + have hr : (b : HahnSeries G K).cantorBendixsonRank 0 = 0 := by + rw [cantorBendixsonDegreeValuation_of_mem _ hm, WithBot.coe_le_coe] at hb + exact le_zero_iff.mp hb + rw [cantorBendixsonValue_of_mem _ ((mem_closedSupport _ _).mp hm), hr, + Ordinal.opow_zero] + · left + exact cantorBendixsonValue_of_notMem _ + (by simpa only [mem_closedSupport] using hm) + rcases hv with hv | hv + · have hk : k = 0 := by + dsimp [k] + rw [constantCoeff_apply] + apply not_ne_iff.mp + intro hn + have hmem : 0 ∈ (b : HahnSeries G K).support := hn + rw [cantorBendixsonValue_of_mem _ (subset_closure hmem)] at hv + exact Ordinal.opow_ne_zero _ Ordinal.omega0_ne_zero hv + rw [hk, map_zero, zero_sub, (ν).map_neg, + cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, hv, + NatOrdinal.of_zero, NatOrdinal.cantorDegree_zero] + exact WithBot.bot_lt_coe 0 + · have hz := (cantorBendixsonValue_eq_one_iff (b : HahnSeries G K)).mp hv |>.2 + rw [show C k - (b : Nonpositive G K) = + -((b : Nonpositive G K) - C k) by abel, (ν).map_neg, + cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply] + change NatOrdinal.cantorDegree + (NatOrdinal.of (((b : HahnSeries G K) - (C k : Nonpositive G K)).cantorBendixsonValue)) < 0 + have hz' : ((b : HahnSeries G K) - (C k : Nonpositive G K)).cantorBendixsonValue = 0 := by + simpa only [coe_C_eq_single, k, constantCoeff_apply] using hz + rw [hz', NatOrdinal.of_zero, NatOrdinal.cantorDegree_zero] + exact WithBot.bot_lt_coe 0 + +/-- Every homogeneous component is a vector space over the coefficient field. -/ +noncomputable instance cantorBendixsonComponentModule (α : NatOrdinal.{u}) : + Module K ((ν).Component α) := + Module.compHom ((ν).Component α) (cantorBendixsonLayerScalarHom (G := G) (K := K)) + +/-- The componentwise coefficient action on the associated graded ring. -/ +instance cantorBendixsonGAlgebra : DirectSum.GAlgebra K (ν).Component where + toFun := (cantorBendixsonLayerScalarHom (G := G) (K := K)).toAddMonoidHom + map_one := map_one (cantorBendixsonLayerScalarHom (G := G) (K := K)) + map_mul k l := by + change GradedMonoid.mk 0 (cantorBendixsonLayerScalarHom (G := G) (k * l)) = _ + rw [map_mul] + exact GradedMonoid.mk_zero_smul _ _ + commutes _ x := DirectSum.GCommSemiring.mul_comm _ x + smul_def k x := GradedMonoid.mk_zero_smul + (cantorBendixsonLayerScalarHom (G := G) k) x.2 + +/-- The associated graded ring as an algebra over its coefficient field. -/ +instance cantorBendixsonAlgebra : Algebra K (ν).AssociatedGraded := inferInstance + +/-- Coefficients embed in grade zero. -/ +@[simp] +theorem cantorBendixson_algebraMap_apply (k : K) : + algebraMap K (ν).AssociatedGraded k = + DirectSum.of (ν).Component 0 (cantorBendixsonLayerScalarHom (G := G) k) := + DirectSum.algebraMap_apply K (ν).Component k + +/-- The graded derivation vanishes on the coefficient field. -/ +theorem cantorBendixsonGradedDerivation_algebraMap (k : K) : + cantorBendixsonGradedDerivation + (algebraMap K (ν).AssociatedGraded k) = 0 := by + rw [cantorBendixson_algebraMap_apply, cantorBendixsonGradedDerivation_of, + cantorBendixsonHomogeneousDerivation_limit 0 NatOrdinal.constantCoeff_zero, + AddMonoidHom.zero_apply] + +private def cantorBendixsonDerivationLinearMap : + (ν).AssociatedGraded →ₗ[K] + Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded where + toFun := cantorBendixsonGradedDerivation + map_add' := map_add cantorBendixsonGradedDerivation + map_smul' k x := by + rw [Algebra.smul_def, cantorBendixsonGradedDerivation_mul, + cantorBendixsonGradedDerivation_algebraMap, zero_mul, zero_add] + generalize cantorBendixsonGradedDerivation x = f + induction f using Filter.Germ.inductionOn with + | h f => + rw [← Filter.Germ.coe_smul] + exact Filter.EventuallyEq.germ_eq (Filter.Eventually.of_forall fun γ ↦ by + change algebraMap K (ν).AssociatedGraded k * f γ = k • f γ + rw [Algebra.smul_def]) + +private theorem cantorBendixsonDerivationLinearMap_apply (x : (ν).AssociatedGraded) : + cantorBendixsonDerivationLinearMap x = cantorBendixsonGradedDerivation x := (rfl) + +private theorem germ_smul_eq_const_mul + (x : (ν).AssociatedGraded) + (f : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) : + x • f = (x : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) * f := by + induction f using Filter.Germ.inductionOn with + | h f => rfl + +/-- The translated-truncation map as a derivation on the associated graded ring. -/ +def cantorBendixsonDerivation : + Derivation K (ν).AssociatedGraded + (Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded) := + Derivation.mk' cantorBendixsonDerivationLinearMap fun x y => by + rw [cantorBendixsonDerivationLinearMap_apply, + cantorBendixsonGradedDerivation_mul] + rw [germ_smul_eq_const_mul, germ_smul_eq_const_mul] + ac_rfl + +/-- The derivation has the same values as the additive translated-truncation map. -/ +@[simp] +theorem cantorBendixsonDerivation_apply (x : (ν).AssociatedGraded) : + cantorBendixsonDerivation x = cantorBendixsonGradedDerivation x := (rfl) + +/-- The derivation is injective on every successor homogeneous component. -/ +theorem cantorBendixsonDerivation_injective_on_successor (α : NatOrdinal.{u}) : + Function.Injective (fun a : (ν).Component (α + 1) ↦ + cantorBendixsonDerivation + (DirectSum.of (ν).Component (α + 1) a)) := + cantorBendixsonGradedDerivation_injective_on_successor α + +/-- The Cantor–Bendixson derivation lowers successor degrees, vanishes on degrees that are limit +ordinals, and is +injective on successor grades. -/ +theorem cantorBendixson_isLoweringDerivation : + GermPolynomial.IsLoweringDerivation + (DirectSum.rangeLof K (ν).Component) + (cantorBendixsonDerivation (G := G) (K := K)) where + mem_lower {α} hα {x} hx := by + obtain ⟨a, rfl⟩ := (DirectSum.mem_rangeLof_iff K (ν).Component α x).mp hx + rw [DirectSum.lof_eq_of] + have hsucc : α.removeNat 1 + 1 = α := by + simpa only [Nat.cast_one] using NatOrdinal.removeNat_add_natCast hα + let a' : (ν).Component (α.removeNat 1 + 1) := + AddEquiv.cast (M := (ν).Component) hsucc.symm a + have ha' : DirectSum.of (ν).Component (α.removeNat 1 + 1) a' = + DirectSum.of (ν).Component α a := by + apply DirectSum.of_eq_of_gradedMonoid_eq + apply Sigma.ext hsucc + change a' ≍ a + exact cast_heq (congrArg (ν).Component hsucc.symm) a + rw [← ha', GermPolynomial.mem_germSubmodule_iff] + have hf : cantorBendixsonDerivation + (DirectSum.of (ν).Component (α.removeNat 1 + 1) a') = + Filter.Germ.map (DirectSum.of (ν).Component (α.removeNat 1)) + (cantorBendixsonLayerDeriv (α.removeNat 1) a') := by + induction a' using MaxAddDegree.componentInductionOn with + | H b => + change cantorBendixsonGradedDerivation + (DirectSum.of (ν).Component (α.removeNat 1 + 1) + ((ν).componentMk (α.removeNat 1 + 1) b)) = _ + rw [← (ν).homogeneousMk_apply, + cantorBendixsonGradedDerivation_homogeneousMk_succ _ rfl, + cantorBendixsonLayerDeriv_componentMk] + rfl + rw [hf] + induction cantorBendixsonLayerDeriv (α.removeNat 1) a' using Filter.Germ.inductionOn with + | h f => + rw [Filter.Germ.map_coe, Filter.Germ.liftPred_coe] + exact Filter.Eventually.of_forall fun t ↦ + DirectSum.of_mem_rangeLof K (ν).Component _ (f t) + eq_zero {α} hα {x} hx := by + obtain ⟨a, rfl⟩ := (DirectSum.mem_rangeLof_iff K (ν).Component α x).mp hx + rw [DirectSum.lof_eq_of] + change cantorBendixsonGradedDerivation (DirectSum.of (ν).Component α a) = 0 + rw [cantorBendixsonGradedDerivation_of, + cantorBendixsonHomogeneousDerivation_limit α hα, AddMonoidHom.zero_apply] + injective {α} hα {x} hx hx0 := by + obtain ⟨a, rfl⟩ := (DirectSum.mem_rangeLof_iff K (ν).Component α x).mp hx + rw [DirectSum.lof_eq_of] at hx0 ⊢ + have hsucc : α.removeNat 1 + 1 = α := by + simpa only [Nat.cast_one] using NatOrdinal.removeNat_add_natCast hα + let a' : (ν).Component (α.removeNat 1 + 1) := + AddEquiv.cast (M := (ν).Component) hsucc.symm a + have ha' : DirectSum.of (ν).Component (α.removeNat 1 + 1) a' = + DirectSum.of (ν).Component α a := by + apply DirectSum.of_eq_of_gradedMonoid_eq + apply Sigma.ext hsucc + change a' ≍ a + exact cast_heq (congrArg (ν).Component hsucc.symm) a + rw [← ha'] at hx0 ⊢ + have ha0 : a' = 0 := + cantorBendixsonDerivation_injective_on_successor (α.removeNat 1) (by simpa using hx0) + rw [ha0, map_zero] + +/-- The internal grade-zero component consists exactly of coefficient scalars. -/ +theorem cantorBendixson_gradeZeroScalars : + GermPolynomial.GradeZeroScalars (DirectSum.rangeLof K (ν).Component) := by + rw [GermPolynomial.gradeZeroScalars_iff] + intro x hx + obtain ⟨a, rfl⟩ := + (DirectSum.mem_rangeLof_iff K (ν).Component 0 x).mp hx + rw [DirectSum.lof_eq_of] + obtain ⟨k, hk⟩ := cantorBendixsonLayerScalarHom_surjective (G := G) (K := K) a + refine ⟨k, ?_⟩ + rw [cantorBendixson_algebraMap_apply, hk] + +/-- Every minimal homogeneous system in the finite-degree components is algebraically +independent over the coefficient field. -/ +theorem cantorBendixson_minimalSystem_aeval_injective + {ι : Type w} (wt : ι → ℕ) (x : ι → (ν).AssociatedGraded) + (hx : GermPolynomial.IsMinimalSystem + (DirectSum.rangeLof K (ν).Component) wt x) : + Function.Injective (MvPolynomial.aeval x : + MvPolynomial ι K →ₐ[K] (ν).AssociatedGraded) := by + classical + letI : Nontrivial ((ν).Component 0) := + Function.Injective.nontrivial + (cantorBendixsonLayerScalarHom_injective (G := G) (K := K)) + letI : Nontrivial (ν).AssociatedGraded := + Function.Injective.nontrivial (DirectSum.of_injective 0) + have hc := hx.isHomogeneousCoordinates cantorBendixson_gradeZeroScalars + exact hc.aeval_injective cantorBendixson_isLoweringDerivation + +/-- An ordinal minimal system generates the associated graded ring of the Cantor–Bendixson +degree. -/ +theorem cantorBendixson_ordinalMinimalSystem_aeval_surjective + {ι : Type w} (wt : ι → NatOrdinal.{u}) + (x : ι → (ν).AssociatedGraded) + (hx : OrdinalGraded.IsMinimalSystem + (DirectSum.rangeLof K (ν).Component) wt x) : + Function.Surjective (MvPolynomial.aeval x : + MvPolynomial ι K →ₐ[K] (ν).AssociatedGraded) := + hx.aeval_surjective cantorBendixson_gradeZeroScalars + +/-- Every ordinal minimal system has pointwise polynomial representatives for the +Cantor–Bendixson derivative of each generator. -/ +theorem cantorBendixson_ordinalMinimalSystem_exists_derivativeRep + {ι : Type w} (wt : ι → NatOrdinal.{u}) + (x : ι → (ν).AssociatedGraded) + (hx : OrdinalGraded.IsMinimalSystem + (DirectSum.rangeLof K (ν).Component) wt x) : + ∃ g : ι → G → MvPolynomial ι K, + OrdinalGraded.DerivativeRep wt x + (cantorBendixsonDerivation (G := G) (K := K)) g := + OrdinalGraded.IsMinimalSystem.exists_derivativeRep hx cantorBendixson_isLoweringDerivation + cantorBendixson_gradeZeroScalars + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/ScalarLeadingCoefficientAtLimitOrdinal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/ScalarLeadingCoefficientAtLimitOrdinal.lean new file mode 100644 index 0000000000..d00aecef4f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/ScalarLeadingCoefficientAtLimitOrdinal.lean @@ -0,0 +1,238 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalEvaluation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationPolynomial +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.OrdinalGenerators + +/-! +# Scalar leading coefficients when the degree is a limit ordinal + +When the leading coefficient in a maximal variable is a nonzero scalar, the coefficient one +below the top combines with the derivative contribution from the leading power. The resulting +nonzero homogeneous polynomial has the maximal variable's weight. The finite convolution formula +then contradicts the degrees of sufficiently late translated truncations. +-/ + +universe u v w + +open scoped NatOrdinal Topology + +open Filter MvPolynomial HahnSeries HahnSeries.Nonpositive + +public noncomputable section + +namespace HahnSeries.Germ + +variable {G : Type u} {K : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [Field K] [CharZero K] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := K)) + +variable {ι : Type w} {wt : ι → NatOrdinal.{u}} + {xg : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded} +variable (σ : LiftFamily wt xg) +variable (hx : OrdinalGraded.IsMinimalSystem + (DirectSum.rangeLof K (cantorBendixsonDegreeValuation (G := G) (R := K)).Component) wt xg) + +include hx in +open Classical in +/-- The first limit configuration is impossible when its leading coefficient has weighted degree +zero. -/ +theorem false_of_aeval_eq_zero_of_leadingCoefficientDegree_eq_zero + (hσ : LiftFamily.HasLowerTruncationDegrees σ) {α : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + {F : MvPolynomial ι K} (hF : IsWeightedHomogeneous wt F α) + (hF0 : aeval xg F = 0) {B₀ : ι} (hB₀ : B₀ ∈ F.vars) + (hmax : ∀ i ∈ F.vars, wt i ≤ wt B₀) (hg : wt B₀ < α) + {degHD : NatOrdinal.{u}} (hdegHD : degHD + degreeOf B₀ F • wt B₀ = α) + (hdegHD0 : degHD = 0) : False := by + classical + obtain ⟨D, hDdef⟩ : ∃ D, degreeOf B₀ F = D := ⟨_, rfl⟩ + rw [hDdef, hdegHD0, zero_add] at hdegHD + have hD : 1 ≤ D := by + rw [← hDdef] + exact Nat.one_le_iff_ne_zero.mpr (mem_vars_iff_degreeOf_ne_zero.mp hB₀) + have hD2 : 2 ≤ D := by + by_contra h + have hD1 : D = 1 := by omega + rw [hD1, one_smul] at hdegHD + exact hg.ne hdegHD + obtain ⟨D', rfl⟩ : ∃ D', D = D' + 1 := ⟨D - 1, by omega⟩ + have hD'1 : 1 ≤ D' := by omega + have hFkmem : ∀ k, xCoeff B₀ k F ∈ supported K {B₀}ᶜ := fun k ↦ + xCoeff_mem_supported B₀ k F + have hFkvars : ∀ k, ∀ i ∈ (xCoeff B₀ k F).vars, wt i ≤ wt B₀ := fun k i hi ↦ + hmax i (vars_xCoeff_subset B₀ k F hi) + have hαk : ∀ k ≤ D' + 1, ((D' + 1 - k) • wt B₀) + k • wt B₀ = α := by + intro k hk + rw [← add_nsmul, Nat.sub_add_cancel hk] + exact hdegHD + have hFkhom : ∀ k ≤ D' + 1, + IsWeightedHomogeneous wt (xCoeff B₀ k F) ((D' + 1 - k) • wt B₀) := + fun k hk ↦ xCoeff_isWeightedHomogeneous' B₀ wt hF k (hαk k hk) + have hFne : F ≠ 0 := by + rintro rfl + simp at hB₀ + have hFD : xCoeff B₀ (D' + 1) F ≠ 0 := by + rw [← hDdef] + exact xCoeff_degreeOf_ne_zero B₀ hFne + have hFDhom : IsWeightedHomogeneous wt (xCoeff B₀ (D' + 1) F) 0 := by + have h := hFkhom (D' + 1) le_rfl + rwa [Nat.sub_self, zero_smul] at h + have hFDC : xCoeff B₀ (D' + 1) F = + MvPolynomial.C (MvPolynomial.coeff 0 (xCoeff B₀ (D' + 1) F)) := + OrdinalGraded.eq_C_of_isWeightedHomogeneous_zero hx.ne_zero hFDhom + let c := MvPolynomial.coeff 0 (xCoeff B₀ (D' + 1) F) + have hc0 : c ≠ 0 := fun hc ↦ hFD (by + rw [hFDC] + change MvPolynomial.C c = 0 + rw [hc, map_zero]) + have hDc : ((D' + 1 : ℕ) : K) * c ≠ 0 := + mul_ne_zero (Nat.cast_ne_zero.mpr (by omega)) hc0 + let hpoly := xCoeff B₀ D' F + + MvPolynomial.C (((D' + 1 : ℕ) : K) * c) * X B₀ + have hFD'hom : IsWeightedHomogeneous wt (xCoeff B₀ D' F) (wt B₀) := by + have h := hFkhom D' (by omega) + rwa [Nat.add_sub_cancel_left, one_smul] at h + have hhhom : IsWeightedHomogeneous wt hpoly (wt B₀) := by + refine hFD'hom.add ?_ + have h := (isWeightedHomogeneous_C wt (((D' + 1 : ℕ) : K) * c)).mul + (isWeightedHomogeneous_X K wt B₀) + rwa [zero_add] at h + have hhne : hpoly ≠ 0 := by + intro h + have hc := congrArg (MvPolynomial.coeff (Finsupp.single B₀ 1)) h + rw [MvPolynomial.coeff_add, MvPolynomial.coeff_C_mul, MvPolynomial.coeff_X, + if_pos rfl, mul_one, MvPolynomial.coeff_zero] at hc + have hleft : MvPolynomial.coeff (Finsupp.single B₀ 1) (xCoeff B₀ D' F) = 0 := by + by_contra hne + exact (mem_supported.mp (hFkmem D')) + ((mem_vars_iff_mem_support B₀).mpr + ⟨Finsupp.single B₀ 1, mem_support_iff.mpr hne, by simp⟩) rfl + rw [hleft, zero_add] at hc + exact hDc hc + have hdegree : ν (aeval σ.lift hpoly) = (wt B₀ : WithBot NatOrdinal) := by + have hrep := σ.represents_aeval hhhom + have hgrade : aeval xg hpoly ≠ 0 := by + intro hzero + exact hhne (((OrdinalGraded.injectiveAt_iff (wt B₀)).mp (hinj _ hg)) + hpoly hhhom hzero) + exact hrep.degree_eq hgrade + have hterm : ∀ k ≤ D' + 1, HasLowerTruncationDegree + (σ.lift B₀ ^ k * aeval σ.lift (xCoeff B₀ k F)) + (k • wt B₀ + (D' + 1 - k) • wt B₀) := by + intro k hk + exact (((LiftFamily.hasLowerTruncationDegrees_iff σ).mp hσ B₀).pow k).mul rfl + (σ.hasLowerTruncationDegree_aeval hσ (hFkhom k hk)) + have hGexp : aeval σ.lift F = ∑ k ∈ Finset.range (D' + 2), + σ.lift B₀ ^ k * aeval σ.lift (xCoeff B₀ k F) := by + conv_lhs => rw [← sum_xCoeff_mul_X_pow B₀ F] + rw [hDdef, map_sum] + refine Finset.sum_congr rfl fun k _ ↦ ?_ + rw [map_mul, map_pow, aeval_X, mul_comm] + have hα0 : α ≠ 0 := ne_of_gt ((zero_le : (0 : NatOrdinal) ≤ wt B₀).trans_lt hg) + obtain ⟨bound, hboundα, hcuts⟩ := + exists_lt_forall_degree_translatedTruncLE_lt σ hα0 hF hF0 + obtain ⟨l, hl0, hcuts'⟩ := eventually_nhdsLT_iff_exists.mp hcuts + have hcoeffD' : ∀ γ : G, γ < 0 → + xCoeff B₀ D' (σ.pol hx α (translatedTruncLE γ (aeval σ.lift F))) = + σ.pol hx α (translatedTruncLE γ (aeval σ.lift hpoly)) := by + intro γ hγ + rw [hGexp, map_sum, σ.pol_sum hx hinj _ _ (fun k hk ↦ by + have hkD : k ≤ D' + 1 := Nat.lt_succ_iff.mp (Finset.mem_range.mp hk) + have hdrop := (hterm k hkD).degree_translatedTruncLE_lt hγ + rwa [add_comm, hαk k hkD] at hdrop), map_sum] + rw [Finset.sum_range_succ, Finset.sum_range_succ, + Finset.sum_eq_zero (fun k hk ↦ ?_), zero_add] + · have hfreeD' := LiftFamily.FreeOfVariable.aeval (σ := σ) (hx := hx) hσ hinj hg + hFD'hom hg (hFkmem D') (hFkvars D') + rw [(LiftFamily.FreeOfVariable.xCoeff_pol_translatedTruncLE_lift_pow_mul + (σ := σ) (hx := hx) hσ hinj hg hfreeD' D' (by + rw [add_comm] + rw [← hdegHD, succ_nsmul, add_comm]) hγ).2] + have htopterm : σ.lift B₀ ^ (D' + 1) * + aeval σ.lift (xCoeff B₀ (D' + 1) F) = c • σ.lift B₀ ^ (D' + 1) := by + rw [hFDC, aeval_C, Algebra.smul_def] + change σ.lift B₀ ^ (D' + 1) * algebraMap K (Nonpositive G K) c = + algebraMap K (Nonpositive G K) c * σ.lift B₀ ^ (D' + 1) + exact mul_comm _ _ + have hpowdrop : ν (translatedTruncLE γ (σ.lift B₀ ^ (D' + 1))) < + (α : WithBot NatOrdinal) := by + have h := (((LiftFamily.hasLowerTruncationDegrees_iff σ).mp hσ B₀).pow + (D' + 1)).degree_translatedTruncLE_lt hγ + rwa [hdegHD] at h + rw [htopterm, translatedTruncLE_smul, σ.pol_smul hx hinj c hpowdrop] + rw [(xCoeff B₀ D').map_smul, LiftFamily.FreeOfVariable.xCoeff_pol_translatedTruncLE_lift_pow + (σ := σ) (hx := hx) hσ hinj hg D' hdegHD.le hγ] + rw [smul_eq_C_mul, nsmul_eq_mul, ← C_eq_coe_nat] + have hC : (MvPolynomial.C c : MvPolynomial ι K) * + MvPolynomial.C ((D' + 1 : ℕ) : K) = + MvPolynomial.C (((D' + 1 : ℕ) : K) * c) := by + rw [← map_mul, mul_comm c] + rw [← mul_assoc, hC] + rw [show aeval σ.lift hpoly = aeval σ.lift (xCoeff B₀ D' F) + + (((D' + 1 : ℕ) : K) * c) • σ.lift B₀ by + rw [map_add, map_mul, aeval_C, aeval_X, Algebra.smul_def, + HahnSeries.Nonpositive.algebraMap_apply]] + rw [map_add, translatedTruncLE_smul, σ.pol_add hx hinj, + σ.pol_smul hx hinj, smul_eq_C_mul] + all_goals first + | have hdrop := + HasLowerTruncationDegree.degree_translatedTruncLE_lt + ((LiftFamily.hasLowerTruncationDegrees_iff σ).mp hσ B₀) hγ + exact hdrop.trans (WithBot.coe_lt_coe.mpr hg) + | exact + (σ.hasLowerTruncationDegree_aeval hσ hFD'hom).degree_translatedTruncLE_lt hγ + |>.trans + (WithBot.coe_lt_coe.mpr hg) + | have hdrop := + HasLowerTruncationDegree.degree_translatedTruncLE_lt + ((LiftFamily.hasLowerTruncationDegrees_iff σ).mp hσ B₀) hγ + exact (degree_smul_le _ _).trans_lt (hdrop.trans (WithBot.coe_lt_coe.mpr hg)) + · have hkD' : k < D' := Finset.mem_range.mp hk + have hkD : k ≤ D' + 1 := by omega + rcases Nat.eq_zero_or_pos k with rfl | hk1 + · have hF0hom : IsWeightedHomogeneous wt (xCoeff B₀ 0 F) α := by + have h := hFkhom 0 hkD + rw [Nat.sub_zero, hdegHD] at h + exact h + rw [pow_zero, one_mul, xCoeff_of_mem_supported B₀ + (LiftFamily.FreeOfVariable.pol_translatedTruncLE_aeval_mem_supported + (σ := σ) (hx := hx) hσ hinj hg hF0hom (hFkmem 0) (hFkvars 0) hγ) D', + if_neg (Nat.ne_of_gt hD'1)] + · have hmk : (D' + 1 - k) • wt B₀ < α := by + rw [← hαk k hkD] + exact lt_add_of_pos_right _ + (pos_iff_ne_zero.mpr (NatOrdinal.nsmul_ne_zero_of_ne_zero (hx.ne_zero B₀) hk1)) + have hfreeK := LiftFamily.FreeOfVariable.aeval (σ := σ) (hx := hx) hσ hinj hg + (hFkhom k hkD) hmk (hFkmem k) (hFkvars k) + exact (LiftFamily.FreeOfVariable.xCoeff_pol_translatedTruncLE_lift_pow_mul + (σ := σ) (hx := hx) hσ hinj hg hfreeK k (by + rw [add_comm] + exact (hαk k hkD).le) hγ).1 D' hkD' + have hsep : D' • wt B₀ = 0 ∨ + NatOrdinal.leastTerm (wt B₀) ≤ NatOrdinal.leastTerm (D' • wt B₀) := by + right + rw [NatOrdinal.leastTerm_nsmul (hx.ne_zero B₀) hD'1] + apply σ.false_of_forall_weightedTotalDegree_pol_add_lt hx + (lam := wt B₀) (sigma := D' • wt B₀) (bound := bound) + hdegree (hx.ne_zero B₀) hsep (by + have ha : α = wt B₀ + D' • wt B₀ := by + rw [← hdegHD, succ_nsmul, add_comm] + exact hboundα.trans_eq ha) hl0 + · intro γ hlγ hγ hp0 + rw [← hcoeffD' γ hγ] at hp0 ⊢ + exact LiftFamily.weightedTotalDegree_xCoeff_add_nsmul_lt + (σ.pol_weight_lt_of_degree_lt hx hboundα.le (hcuts' γ hlγ hγ)) B₀ D' hp0 + · exact hg + +end HahnSeries.Germ + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SeparatedPieceCantorBendixson.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SeparatedPieceCantorBendixson.lean new file mode 100644 index 0000000000..8ce7700117 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SeparatedPieceCantorBendixson.lean @@ -0,0 +1,274 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedPieceSum +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivative +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SeparatedPieceFamily +import Mathlib.Topology.DerivedSet + +/-! +# Cantor–Bendixson ranks of sums on separated pieces + +Hahn series carried by pairwise disjoint ordered open convex pieces, each bounded above by a +center inside its own piece, combine into one Hahn sum. Inside a piece the weak truncation of the +sum differs from the truncation of that piece only at or below any piece element under the cutoff, +so their local germs agree. When the centers accumulate nowhere, the Cantor–Bendixson ranks of the +summed supports are bounded by the piece stages: no successor loss occurs anywhere, including at +zero. This supplies the rank bound used by the well-founded cofactor induction at arbitrary +cofinality. +-/ + +public noncomputable section + +open Set Filter Topology TopologicalSpace +open scoped NatOrdinal + +universe u v w + +namespace HahnSeries + +variable {G : Type u} {K : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + +section Locality + +variable [AddCommGroup K] + +omit [AddCommGroup G] [IsOrderedAddMonoid G] in +/-- Inside a piece, the weak truncation of the sum differs from the truncation of that piece +only at or below any element of the piece below the cutoff. -/ +theorem support_truncLE_separatedHsum_sub_piece_subset + {X : Type w} [LinearOrder X] (hX : (Set.univ : Set X).IsPWO) + (C : X → Set G) (f : X → K⟦G⟧) + (hfC : ∀ x, (f x).support ⊆ C x) + (hord : ∀ x y : X, x < y → ∀ a ∈ C x, ∀ b ∈ C y, a < b) + (hsep : ∀ i j, i < j → ∀ a ∈ (f i).support, ∀ b ∈ (f j).support, a < b) + (x : X) {y : G} (hy : y ∈ C x) {c : G} (hc : c ∈ C x) : + (truncLE y (separatedHsum hX f hsep) - truncLE y (f x)).support ⊆ Iic c := by + intro g hg + rw [mem_support] at hg + by_contra hgc + apply hg + rw [HahnSeries.coeff_sub, HahnSeries.coeff_truncLE, HahnSeries.coeff_truncLE] + by_cases hgy : g ≤ y + · rw [if_pos hgy, if_pos hgy, coeff_separatedHsum_eq hX f hsep x g ?_, sub_self] + intro j hji hgj + have hgCj : g ∈ C j := hfC j hgj + rcases lt_or_gt_of_ne hji with hj | hj + · exact hgc ((hord j x hj g hgCj c hc).le) + · exact absurd (hord x j hj y hy g hgCj) (not_lt.mpr hgy) + · rw [if_neg hgy, if_neg hgy, sub_self] + +omit [AddCommGroup G] [IsOrderedAddMonoid G] in +/-- Removing the part of a series outside a convex piece changes its weak truncations only at or +below any piece element, provided the removed support lies entirely below the piece. -/ +theorem support_truncLE_sub_truncLE_setRestrict_subset + (C : Set G) [DecidablePred (· ∈ C)] (b : K⟦G⟧) (y : G) {c : G} + (hb : ∀ p ∈ b.support, p ∉ C → p ≤ y → p ≤ c) : + (truncLE y b - truncLE y (setRestrict C b)).support ⊆ Iic c := by + intro g hg + rw [mem_support] at hg + by_contra hgc + apply hg + rw [HahnSeries.coeff_sub, HahnSeries.coeff_truncLE, HahnSeries.coeff_truncLE, + coeff_setRestrict] + by_cases hgy : g ≤ y + · rw [if_pos hgy, if_pos hgy] + by_cases hgC : g ∈ C + · rw [if_pos hgC, sub_self] + · rw [if_neg hgC] + have hgb : g ∉ b.support := fun hgb ↦ hgc (hb g hgb hgC hgy) + rw [not_not.mp fun h ↦ hgb ((mem_support _ _).mpr h), sub_zero] + · rw [if_neg hgy, if_neg hgy, sub_self] + +open Classical in +/-- Inside a piece, translating the difference between the truncated sum and the truncated +source moves its support below the corresponding translated piece element. -/ +theorem support_translate_truncLE_separatedHsum_sub_source_subset + {X : Type w} [LinearOrder X] (hX : (Set.univ : Set X).IsPWO) + (C : X → Set G) (f : X → K⟦G⟧) + (hfC : ∀ x, (f x).support ⊆ C x) + (hord : ∀ x y : X, x < y → ∀ a ∈ C x, ∀ b ∈ C y, a < b) + (hsep : ∀ i j, i < j → ∀ a ∈ (f i).support, ∀ b ∈ (f j).support, a < b) + (x : X) {y c : G} (hy : y ∈ C x) (hc : c ∈ C x) + (b : K⟦G⟧) (hpiece : f x = setRestrict (C x) b) + (hb : ∀ p ∈ b.support, p ∉ C x → p ≤ y → p ≤ c) : + (translate (-y) (truncLE y (separatedHsum hX f hsep)) - + translate (-y) (truncLE y b)).support ⊆ Iic (c - y) := by + rw [← map_sub, support_translate] + rintro _ ⟨q, hq, rfl⟩ + have hsplit : truncLE y (separatedHsum hX f hsep) - truncLE y b = + (truncLE y (separatedHsum hX f hsep) - truncLE y (f x)) - + (truncLE y b - truncLE y (setRestrict (C x) b)) := by + rw [hpiece] + exact (sub_sub_sub_cancel_right _ _ _).symm + have hq1 := support_truncLE_separatedHsum_sub_piece_subset hX C f hfC hord hsep x hy hc + have hq2 := support_truncLE_sub_truncLE_setRestrict_subset (C x) b y hb + rw [hsplit, sub_eq_add_neg] at hq + rcases support_add_subset _ _ hq with h | h + · exact mem_Iic.mpr (by + have := hq1 h + simpa only [mem_Iic, sub_eq_add_neg, add_comm] using sub_le_sub_right this y) + · rw [support_neg] at h + exact mem_Iic.mpr (by + have := hq2 h + simpa only [mem_Iic, sub_eq_add_neg, add_comm] using sub_le_sub_right this y) + +end Locality + +section ConvexClosure + +variable [TopologicalSpace G] [OrderTopology G] + +omit [AddCommGroup G] [IsOrderedAddMonoid G] in +/-- The closure of a partially well-ordered subset of a convex piece bounded by a piece element +stays inside the piece: well-ordered sets accumulate only from below. -/ +theorem closure_subset_of_isPWO_of_ordConnected {C : Set G} (hC : C.OrdConnected) + {s : Set G} (hs : s.IsPWO) (hsC : s ⊆ C) + {x : G} (hx : x ∈ C) (hsx : ∀ p ∈ s, p ≤ x) : + closure s ⊆ C := by + intro z hz + have hzx : z ≤ x := closure_minimal (fun p hp ↦ hsx p hp) isClosed_Iic hz + obtain ⟨p, hps, hpz⟩ := ((mem_closure_iff_frequently.mp hz).and_eventually + (hs.eventually_le z)).exists + exact hC.out (hsC hps) hx ⟨hpz hps, hzx⟩ + +end ConvexClosure + +section Rank + +variable [TopologicalSpace G] [OrderTopology G] [NoMinOrder G] [NoMaxOrder G] [AddCommGroup K] + +omit [AddCommGroup G] [IsOrderedAddMonoid G] in +/-- With nowhere-accumulating centers, the Cantor–Bendixson ranks of the summed supports are +bounded by the piece stages: at most the stage everywhere, and strictly below it away from the +centers. -/ +theorem cantorBendixsonRank_separatedHsum_bounds + {X : Type w} [LinearOrder X] (hX : (Set.univ : Set X).IsPWO) + (C : X → Set G) (cen : X → G) (f : X → K⟦G⟧) + (hfC : ∀ x, (f x).support ⊆ C x) + (hfle : ∀ x, ∀ p ∈ (f x).support, p ≤ cen x) + (hcen : ∀ x, cen x ∈ C x) + (hCopen : ∀ x, IsOpen (C x)) + (hdisj : ∀ x y : X, x ≠ y → Disjoint (C x) (C y)) + (hord : ∀ x y : X, x < y → ∀ a ∈ C x, ∀ b ∈ C y, a < b) + (hsep : ∀ i j, i < j → ∀ a ∈ (f i).support, ∀ b ∈ (f j).support, a < b) + (hdiscrete : ∀ z : G, ¬ AccPt z (𝓟 (Set.range cen))) + (o : Ordinal.{u}) + (hstage : ∀ x, (((f x).closedSupport).cantorBendixson o : Set G) ⊆ {cen x}) : + (∀ z : G, (separatedHsum hX f hsep).cantorBendixsonRank z ≤ o) ∧ + ∀ z : G, z ∉ Set.range cen → + z ∉ (((separatedHsum hX f hsep).closedSupport).cantorBendixson o : Set G) := by + classical + have hclosure : closure (Set.range cen) = Set.range cen := by + rw [closure_eq_self_union_derivedSet] + have hder : derivedSet (Set.range cen) = ∅ := by + ext z + simp only [mem_derivedSet, Set.mem_empty_iff_false, iff_false] + exact hdiscrete z + rw [hder, Set.union_empty] + have hstage' : ∀ x, ((⟨closure (f x).support, isClosed_closure⟩ : + Closeds G).cantorBendixson o : Set G) ⊆ {cen x} := by + intro x + have he : (f x).closedSupport = (⟨closure (f x).support, isClosed_closure⟩ : Closeds G) := by + apply Closeds.ext + simp only [coe_closedSupport] + rfl + rw [← he] + exact hstage x + have hsupp : (separatedHsum hX f hsep).support = ⋃ x, (f x).support := + support_separatedHsum hX f hsep + have hbclosed : (separatedHsum hX f hsep).closedSupport = + (⟨closure (⋃ x, (f x).support), isClosed_closure⟩ : Closeds G) := by + apply Closeds.ext + simp only [coe_closedSupport, hsupp] + rfl + have hderiv : (((separatedHsum hX f hsep).closedSupport).cantorBendixson o : Set G) ⊆ + Set.range cen := by + rw [hbclosed, ← hclosure] + exact cantorBendixson_separated_iUnion_subset_closure_range + (fun x ↦ (f x).support) C cen (fun x ↦ hfC x) (fun x ↦ hfle x) hcen hCopen + (fun x y hxy ↦ hdisj x y hxy) hord o hstage' + have hnext : (((separatedHsum hX f hsep).closedSupport).cantorBendixson (o + 1) : + Set G) = ∅ := by + rw [Closeds.cantorBendixson_add_one] + apply Set.eq_empty_iff_forall_notMem.mpr + intro z hz + rw [Closeds.coe_derived, mem_derivedSet] at hz + exact hdiscrete z (hz.mono (Filter.principal_mono.mpr hderiv)) + refine ⟨?_, ?_⟩ + · intro z + rw [cantorBendixsonRank_eq] + exact Closeds.cantorBendixsonRank_le_of_notMem _ _ z (by + rw [hnext] + exact Set.notMem_empty z) + · intro z hz hmem + exact hz (hderiv hmem) + +omit [AddCommGroup G] [IsOrderedAddMonoid G] in +/-- **Sums with strict local stages.** If every piece already has an empty stage `o` and the +centers accumulate only at points outside the open region carrying them, then the assembled stage +`o` is carried by that boundary accumulation alone, and the assembled Cantor–Bendixson rank is at +most `o` everywhere. In particular the assembled degree at a boundary accumulation point does not +gain the successor that a nonstrict local bound would cost. -/ +theorem cantorBendixsonRank_separatedHsum_le_of_stage_empty + {X : Type w} [LinearOrder X] (hX : (Set.univ : Set X).IsPWO) + (C : X → Set G) (cen : X → G) (f : X → K⟦G⟧) + (hfC : ∀ x, (f x).support ⊆ C x) + (hfle : ∀ x, ∀ p ∈ (f x).support, p ≤ cen x) + (hcen : ∀ x, cen x ∈ C x) + (hCopen : ∀ x, IsOpen (C x)) + (hdisj : ∀ x y : X, x ≠ y → Disjoint (C x) (C y)) + (hord : ∀ x y : X, x < y → ∀ a ∈ C x, ∀ b ∈ C y, a < b) + (hsep : ∀ i j, i < j → ∀ a ∈ (f i).support, ∀ b ∈ (f j).support, a < b) + (o : Ordinal.{u}) + (hstage : ∀ x, (((f x).closedSupport).cantorBendixson o : Set G) = ∅) + (z₀ : G) (hcl : closure (Set.range cen) ⊆ Set.range cen ∪ {z₀}) : + ∀ z : G, (separatedHsum hX f hsep).cantorBendixsonRank z ≤ o := by + classical + have hstage' : ∀ x, ((⟨closure (f x).support, isClosed_closure⟩ : + Closeds G).cantorBendixson o : Set G) = ∅ := by + intro x + have he : (f x).closedSupport = (⟨closure (f x).support, isClosed_closure⟩ : Closeds G) := by + apply Closeds.ext + simp only [coe_closedSupport] + rfl + rw [← he] + exact hstage x + have hsupp : (separatedHsum hX f hsep).support = ⋃ x, (f x).support := + support_separatedHsum hX f hsep + have hbclosed : (separatedHsum hX f hsep).closedSupport = + (⟨closure (⋃ x, (f x).support), isClosed_closure⟩ : Closeds G) := by + apply Closeds.ext + simp only [coe_closedSupport, hsupp] + rfl + have hderiv : (((separatedHsum hX f hsep).closedSupport).cantorBendixson o : Set G) ⊆ + {z₀} := by + rw [hbclosed] + intro z hz + have hz' := cantorBendixson_separated_iUnion_subset_of_stage_empty + (fun x ↦ (f x).support) C cen (fun x ↦ hfC x) (fun x ↦ hfle x) hcen hCopen + (fun x y hxy ↦ hdisj x y hxy) hord o hstage' hz + rcases hcl hz'.1 with h | h + · exact absurd h hz'.2 + · exact h + have hnext : (((separatedHsum hX f hsep).closedSupport).cantorBendixson (o + 1) : + Set G) = ∅ := by + rw [Closeds.cantorBendixson_add_one] + apply Set.eq_empty_iff_forall_notMem.mpr + intro z hz + rw [Closeds.coe_derived, mem_derivedSet] at hz + have hacc := hz.mono (Filter.principal_mono.mpr hderiv) + exact (Set.finite_singleton z₀).not_infinite (Set.Infinite.of_accPt hacc) + intro z + rw [cantorBendixsonRank_eq] + exact Closeds.cantorBendixsonRank_le_of_notMem _ _ z (by + rw [hnext] + exact Set.notMem_empty z) + +end Rank + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SuccessorLeibniz.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SuccessorLeibniz.lean new file mode 100644 index 0000000000..349c318899 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SuccessorLeibniz.lean @@ -0,0 +1,198 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Leibniz +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart +import Mathlib.Tactic.Abel + +/-! +# Product rule for translated truncations of homogeneous representatives + +The finite convolution remainder has strictly smaller Cantor–Bendixson rank than the homogeneous +component immediately below a successor product. When both grades are successors, both +translated truncation terms survive in that component. If the second grade has zero finite +Cantor coefficient (including grade zero), its term vanishes there. + +These are eventual equalities in the associated graded ring, retaining arbitrary complete +ordered exponent groups. They use the Cantor–Bendixson convolution bound, not the real-exponent +ordinal-value product theorem. +-/ + +public noncomputable section +open Set Filter Topology +open scoped NatOrdinal +universe u v +namespace HahnSeries.Nonpositive +variable {G : Type u} {R : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [CommRing R] [NoZeroDivisors R] [CharZero R] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := R)) + +private theorem value_le_wpow_of_degree_le (b : Nonpositive G R) (α : NatOrdinal.{u}) + (hb : ν b ≤ α) : cantorBendixsonValuation b ≤ ω^ α := by + by_cases hm : 0 ∈ (b : HahnSeries G R).closedSupport + · rw [cantorBendixsonDegreeValuation_of_mem _ hm, WithBot.coe_le_coe] at hb + rw [cantorBendixsonValuation_apply, + cantorBendixsonValue_of_mem _ ((mem_closedSupport _ _).mp hm), + NatOrdinal.of_omega0_opow] + exact NatOrdinal.wpow_le_wpow.mpr hb + · rw [cantorBendixsonValuation_apply, + cantorBendixsonValue_of_notMem _ (by simpa only [mem_closedSupport] using hm), + NatOrdinal.of_zero] + exact zero_le + +/-- The translated product remainder lies strictly below the lowered product degree near zero. -/ +theorem eventually_degree_leibnizRemainder_lt (b c : Nonpositive G R) + (α β : NatOrdinal.{u}) (hb : ν b ≤ (α + 1 : NatOrdinal)) (hc : ν c ≤ β) : + ∀ᶠ γ in 𝓝[<] (0 : G), + ν (translatedTruncLE γ (b * c) - translatedTruncLE γ b * c - + b * translatedTruncLE γ c) < (α + β : NatOrdinal) := by + have h := eventually_cantorBendixsonValue_leibnizRemainder_lt_of_le_wpow + (b : HahnSeries G R) c b.property c.property α β + (by simpa only [cantorBendixsonValuation_apply] using value_le_wpow_of_degree_le b _ hb) + (by simpa only [cantorBendixsonValuation_apply] using value_le_wpow_of_degree_le c _ hc) + filter_upwards [h] with γ hγ + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + NatOrdinal.cantorDegree_lt_coe_iff] + change NatOrdinal.of (((translatedTruncLE γ (b * c) : HahnSeries G R) - + (translatedTruncLE γ b : HahnSeries G R) * c - + (b : HahnSeries G R) * translatedTruncLE γ c)).cantorBendixsonValue < _ + simpa only [coe_translatedTruncLE, Subring.coe_mul] using hγ + +private theorem homogeneousMk_eq_add_of_sub_sub_lt (δ : NatOrdinal.{u}) + (a b c : (ν).filtrationLE δ) + (h : ν ((a : Nonpositive G R) - b - c) < δ) : + (ν).homogeneousMk δ a = (ν).homogeneousMk δ b + (ν).homogeneousMk δ c := by + rw [← map_add, (ν).homogeneousMk_apply, (ν).homogeneousMk_apply] + apply congrArg (DirectSum.of (ν).Component δ) + apply ((ν).componentMk_eq_componentMk_iff _ _ _).mpr + simpa only [AddSubgroup.coe_add, sub_add_eq_sub_sub] using h + +private theorem homogeneousMk_congr {α β : NatOrdinal.{u}} (h : α = β) + (a : (ν).filtrationLE α) (b : (ν).filtrationLE β) + (hab : (a : Nonpositive G R) = b) : + (ν).homogeneousMk α a = (ν).homogeneousMk β b := by + subst β + exact congrArg ((ν).homogeneousMk α) (Subtype.ext hab) + +/-- Both successor factors contribute to the homogeneous product rule near zero. -/ +theorem eventually_homogeneousDerivAt_mul_succ (α β : NatOrdinal.{u}) + (b : (ν).filtrationLE (α + 1)) (c : (ν).filtrationLE (β + 1)) : + ∀ᶠ γ in 𝓝[<] (0 : G), + DirectSum.of (ν).Component (α + β + 1) + (cantorBendixsonDerivAt (α + β + 1) ((b : Nonpositive G R) * c) γ) = + DirectSum.of (ν).Component α (cantorBendixsonDerivAt α b γ) * + (ν).homogeneousMk (β + 1) c + + (ν).homogeneousMk (α + 1) b * + DirectSum.of (ν).Component β (cantorBendixsonDerivAt β c γ) := by + have hb := ((ν).mem_filtrationLE_iff _ _).mp b.property + have hc := ((ν).mem_filtrationLE_iff _ _).mp c.property + have hbc : ν ((b : Nonpositive G R) * c) ≤ (α + β + 1 + 1 : NatOrdinal) := by + have h := MaxAddDegree.degree_mul_le_add hb hc + simpa only [← WithBot.coe_add, add_assoc, add_left_comm, add_comm] using h + filter_upwards [eventually_degree_translatedTruncLE_le (b : Nonpositive G R) α hb, + eventually_degree_translatedTruncLE_le (c : Nonpositive G R) β hc, + eventually_degree_translatedTruncLE_le ((b : Nonpositive G R) * (c : Nonpositive G R)) + (α + β + 1) hbc, + eventually_degree_leibnizRemainder_lt (b : Nonpositive G R) (c : Nonpositive G R) + α (β + 1) hb hc] + with γ hbg hcg hbcg hrem + rw [cantorBendixsonDerivAt_eq _ _ _ hbg, cantorBendixsonDerivAt_eq _ _ _ hcg, + cantorBendixsonDerivAt_eq _ _ _ hbcg, ← (ν).homogeneousMk_apply, + ← (ν).homogeneousMk_apply, ← (ν).homogeneousMk_apply, + (ν).homogeneousMk_mul, (ν).homogeneousMk_mul] + let x : (ν).filtrationLE (α + β + 1) := + ⟨translatedTruncLE γ (b : Nonpositive G R) * (c : Nonpositive G R), + ((ν).mem_filtrationLE_iff _ _).mpr (by + simpa only [← WithBot.coe_add, add_assoc] using MaxAddDegree.degree_mul_le_add hbg hc)⟩ + let y : (ν).filtrationLE (α + β + 1) := + ⟨(b : Nonpositive G R) * translatedTruncLE γ (c : Nonpositive G R), + ((ν).mem_filtrationLE_iff _ _).mpr (by + simpa only [← WithBot.coe_add, add_assoc, add_left_comm, add_comm] using + MaxAddDegree.degree_mul_le_add hb hcg)⟩ + have hx : (ν).homogeneousMk (α + (β + 1)) + ((ν).mulFiltrationLE ⟨translatedTruncLE γ (b : Nonpositive G R), + ((ν).mem_filtrationLE_iff _ _).mpr hbg⟩ c) = + (ν).homogeneousMk (α + β + 1) x := + homogeneousMk_congr (by ac_rfl) _ _ (by rw [(ν).coe_mulFiltrationLE]) + have hy : (ν).homogeneousMk (α + 1 + β) + ((ν).mulFiltrationLE b ⟨translatedTruncLE γ (c : Nonpositive G R), + ((ν).mem_filtrationLE_iff _ _).mpr hcg⟩) = + (ν).homogeneousMk (α + β + 1) y := + homogeneousMk_congr (by ac_rfl) _ _ (by rw [(ν).coe_mulFiltrationLE]) + rw [hx, hy] + apply homogeneousMk_eq_add_of_sub_sub_lt + simpa only [add_assoc] using hrem + +private theorem add_succ_lt_add_of_constantCoeff_eq_zero + (α : NatOrdinal.{u}) {β β' : NatOrdinal.{u}} + (hβ : β.constantCoeff = 0) (hlt : β' < β) : α + 1 + β' < α + β := by + have h := ((NatOrdinal.isSuccPrelimit_iff_constantCoeff_eq_zero β).mpr hβ).add_one_lt hlt + simpa only [add_assoc, add_left_comm, add_comm] using add_lt_add_left h α + +/-- A factor with zero finite Cantor coefficient contributes no term in the lowered degree. -/ +theorem eventually_degree_mul_translatedTruncLE_lt_limit (α β : NatOrdinal.{u}) + (hβ : β.constantCoeff = 0) (b c : Nonpositive G R) + (hb : ν b ≤ (α + 1 : NatOrdinal)) (hc : ν c ≤ β) : + ∀ᶠ γ in 𝓝[<] (0 : G), + ν (b * translatedTruncLE γ c) < (α + β : NatOrdinal) := by + filter_upwards [eventually_degree_translatedTruncLE_lt c β hc] with γ hγ + have hm := (ν).map_mul_le_add b (translatedTruncLE γ c) + cases he : ν (translatedTruncLE γ c) using WithBot.recBotCoe with + | bot => + rw [he, WithBot.add_bot] at hm + exact hm.trans_lt (WithBot.bot_lt_coe _) + | coe β' => + have hlt : β' < β := by simpa only [he, WithBot.coe_lt_coe] using hγ + apply hm.trans_lt + have hle := add_le_add hb (le_rfl : (↑β' : WithBot NatOrdinal) ≤ ↑β') + rw [he] + apply hle.trans_lt + rw [← WithBot.coe_add, WithBot.coe_lt_coe] + exact add_succ_lt_add_of_constantCoeff_eq_zero α hβ hlt + +/-- If the second grade is zero or a limit, only the first truncation term survives. -/ +theorem eventually_homogeneousDerivAt_mul_limit (α β : NatOrdinal.{u}) + (hβ : β.constantCoeff = 0) + (b : (ν).filtrationLE (α + 1)) (c : (ν).filtrationLE β) : + ∀ᶠ γ in 𝓝[<] (0 : G), + DirectSum.of (ν).Component (α + β) + (cantorBendixsonDerivAt (α + β) ((b : Nonpositive G R) * (c : Nonpositive G R)) γ) = + DirectSum.of (ν).Component α (cantorBendixsonDerivAt α b γ) * + (ν).homogeneousMk β c := by + have hb := ((ν).mem_filtrationLE_iff _ _).mp b.property + have hc := ((ν).mem_filtrationLE_iff _ _).mp c.property + have hbc : ν ((b : Nonpositive G R) * (c : Nonpositive G R)) ≤ (α + β + 1 : NatOrdinal) := by + have h := MaxAddDegree.degree_mul_le_add hb hc + simpa only [← WithBot.coe_add, add_assoc, add_left_comm, add_comm] using h + filter_upwards [eventually_degree_translatedTruncLE_le (b : Nonpositive G R) α hb, + eventually_degree_translatedTruncLE_le ((b : Nonpositive G R) * (c : Nonpositive G R)) + (α + β) hbc, + eventually_degree_leibnizRemainder_lt (b : Nonpositive G R) (c : Nonpositive G R) + α β hb hc, + eventually_degree_mul_translatedTruncLE_lt_limit α β hβ + (b : Nonpositive G R) (c : Nonpositive G R) hb hc] + with γ hbg hbcg hrem hlimit + rw [cantorBendixsonDerivAt_eq _ _ _ hbg, cantorBendixsonDerivAt_eq _ _ _ hbcg, + ← (ν).homogeneousMk_apply, ← (ν).homogeneousMk_apply, (ν).homogeneousMk_mul, + (ν).homogeneousMk_apply, (ν).homogeneousMk_apply] + apply congrArg (DirectSum.of (ν).Component (α + β)) + apply ((ν).componentMk_eq_componentMk_iff _ _ _).mpr + rw [(ν).coe_mulFiltrationLE] + change ν (translatedTruncLE γ ((b : Nonpositive G R) * (c : Nonpositive G R)) - + translatedTruncLE γ (b : Nonpositive G R) * (c : Nonpositive G R)) < (α + β : NatOrdinal) + have hs : translatedTruncLE γ ((b : Nonpositive G R) * (c : Nonpositive G R)) - + translatedTruncLE γ (b : Nonpositive G R) * (c : Nonpositive G R) = + (translatedTruncLE γ ((b : Nonpositive G R) * (c : Nonpositive G R)) - + translatedTruncLE γ (b : Nonpositive G R) * (c : Nonpositive G R) - + (b : Nonpositive G R) * translatedTruncLE γ (c : Nonpositive G R)) + + (b : Nonpositive G R) * translatedTruncLE γ (c : Nonpositive G R) := by abel + rw [hs] + exact ((ν).map_add_le_max _ _).trans_lt (max_lt hrem hlimit) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SyzygyIntegration.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SyzygyIntegration.lean new file mode 100644 index 0000000000..874dbce57d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SyzygyIntegration.lean @@ -0,0 +1,210 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSyzygy +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationSet +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LiftFamily +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonRankLevels +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.FinitePWOUnion + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Successor syzygy integration for the Cantor–Bendixson derivation + +The abstract successor induction asks for a pointwise representative of the derivative of a +finite homogeneous tuple, supported on one set on which arbitrary homogeneous functions can be +integrated. For the Cantor–Bendixson derivation the set is the finite union, above a common negative +cutoff, of the exact-rank levels of representatives of the tuple entries. + +That union is discrete and partially well ordered. Near zero its closure adds no points, so the +integration theorem for discrete cutoff sets realizes arbitrary homogeneous values on it. Tuple +coordinates with no positive forced degree have zero derivative and need no level. +-/ + +universe u v w + +open scoped NatOrdinal Topology + +open Filter Set HahnSeries + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [Field K] [CharZero K] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := K)) + +/-- Successor syzygy integration for the Cantor–Bendixson derivation. -/ +@[blueprint "lem:simultaneous-cantor-bendixson-derivative-representatives" + (phase := "Algebraic independence in graded rings") + (title := "Simultaneous Cantor--Bendixson derivatives of homogeneous tuples") + (statement := /-- + Let $B$ be finite, let $\lambda_b$ be ordinal weights, and let $(u_b)$ be + homogeneous of total degree $d$, where the constant Cantor coefficient of + $d$ is positive. There are a set $S\subseteq G$ and functions + $D_b:G\to\operatorname{gr}_\nu$ such that: + \begin{enumerate} + \item the derivative of $u_b$ agrees near $0$ with $D_b$; + \item for every $\gamma$, $(D_b(\gamma))_b$ is homogeneous of total + degree $d'$, where $d'+1=d$; + \item every $D_b$ vanishes outside $S$; + \item for every homogeneous function $a:G\to\operatorname{gr}_\nu$ of + degree $\rho$, some homogeneous class of degree $\rho+1$ has derivative + equal near $0$ to $a$ on $S$ and to zero outside $S$. + \end{enumerate} + -/) + (proof := /-- + Choose a series representative for each active coordinate of the tuple. + Its derivative is supported near $0$ on one exact-rank set. By + \ref{lem:discrete-finite-union-cantor-bendixson-rank-sets}, after one + common negative cutoff the union $S$ of these finitely many sets is + discrete. The pointwise derivative tuple has predecessor degree $d'$ and + vanishes outside $S$; the operator used here is a derivation by + \ref{lem:cantor-bendixson-derivation-leibniz}. The union is partially + well ordered and agrees near $0$ with its closure, so + \ref{lem:prescribed-cantor-bendixson-derivative-discrete-set} realizes + every homogeneous prescription on $S$ in degree one higher. + -/)] +theorem hasSyzygyIntegration {B : Type w} [Finite B] (lam : B → NatOrdinal.{u}) : + OrdinalGraded.HasSyzygyIntegration + (DirectSum.rangeLof K (ν).Component) cantorBendixsonDerivation lam (T := G) := by + classical + rw [OrdinalGraded.hasSyzygyIntegration_iff] + intro d hd u hu + let active : Set B := {b | ∃ β, β + lam b = d ∧ 0 < β.constantCoeff} + have hdegree : ∀ b : ↥active, ∃ β, β + lam b = d ∧ 0 < β.constantCoeff := + fun b ↦ b.property + choose β hβ hβpos using hdegree + have hlift : ∀ b : ↥active, ∃ p : Nonpositive G K, Represents p (β b) (u b) := + fun b ↦ exists_represents (hu.mem (hβ b)) + choose p hp using hlift + let ρ : ↥active → NatOrdinal.{u} := fun b ↦ (β b).removeNat 1 + have hρsucc : ∀ b, ρ b + 1 = β b := fun b ↦ by + simpa only [ρ, Nat.cast_one] using NatOrdinal.removeNat_add_natCast (hβpos b) + obtain ⟨η, hη0, hdisc⟩ := exists_isDiscrete_iUnion_rankLevelSet p ρ (fun b ↦ by + rw [hρsucc] + exact hp b |>.degree_le) + let S : Set G := ⋃ b : ↥active, rankLevelSet (p b) (ρ b) ∩ Ioo η 0 + let D : B → G → (ν).AssociatedGraded := fun b γ ↦ + if hb : b ∈ active then + if γ ∈ S then DirectSum.of (ν).Component (ρ ⟨b, hb⟩) + (cantorBendixsonDerivAt (ρ ⟨b, hb⟩) (p ⟨b, hb⟩) γ) else 0 + else 0 + refine ⟨S, D, ?_, ?_, ?_, ?_⟩ + · intro b + by_cases hb : b ∈ active + · let b' : ↥active := ⟨b, hb⟩ + obtain ⟨hpdeg, hpu⟩ := represents_iff.mp (hp b') + rw [← hpu, cantorBendixsonDerivation_apply, + cantorBendixsonGradedDerivation_homogeneousMk_succ (ρ b') (hρsucc b').symm] + rw [Filter.Germ.coe_eq] + have hIoo : ∀ᶠ γ in nhdsWithin (0 : G) (Iio 0), γ ∈ Ioo η 0 := + eventually_nhdsLT_iff_exists.mpr ⟨η, hη0, fun γ hγη hγ0 ↦ ⟨hγη, hγ0⟩⟩ + filter_upwards [hIoo, + eventually_degree_translatedTruncLE_le (p b') (ρ b') (by + rw [hρsucc] + exact hpdeg)] with γ hγI hγdeg + simp only [D, dif_pos hb] + by_cases hne : cantorBendixsonDerivAt (ρ b') (p b') γ ≠ 0 + · rw [if_pos] + refine mem_iUnion_of_mem b' ⟨?_, hγI⟩ + rw [mem_rankLevelSet_iff, ← cantorBendixsonRank_eq] + exact (cantorBendixsonDerivAt_ne_zero_iff _ _ _ hγdeg).mp hne + · have hz : cantorBendixsonDerivAt (ρ b') (p b') γ = 0 := not_ne_iff.mp hne + rw [hz, map_zero] + split <;> rfl + · have hDzero : D b = 0 := by + funext γ + simp only [D, dif_neg hb, Pi.zero_apply] + rw [hDzero, Filter.Germ.coe_zero] + by_cases hex : ∃ β, β + lam b = d + · obtain ⟨β', hβ'⟩ := hex + have hβ'zero : β'.constantCoeff = 0 := by + by_contra hn + exact hb ⟨β', hβ', pos_iff_ne_zero.mpr hn⟩ + rw [cantorBendixsonDerivation_apply] + exact cantorBendixsonGradedDerivation_eq_zero_of_constantCoeff_eq_zero + hβ'zero (hu.mem hβ') + · rw [hu.eq_zero hex, map_zero] + · intro γ + rw [OrdinalGraded.isHomogeneousTuple_iff] + intro b + refine ⟨fun κ hκ ↦ ?_, fun hn ↦ ?_⟩ + · by_cases hb : b ∈ active + · let b' : ↥active := ⟨b, hb⟩ + have hρ : ρ b' = κ := by + apply add_right_cancel (b := lam b) + have hleft : ρ b' + lam b = d.removeNat 1 := by + rw [← NatOrdinal.removeNat_add_right (β b') (lam b) (hβpos b'), hβ] + exact hleft.trans hκ.symm + simp only [D, dif_pos hb] + split + · rw [← hρ] + exact DirectSum.of_mem_rangeLof K (ν).Component (ρ b') _ + · exact zero_mem _ + · simp only [D, dif_neg hb] + exact zero_mem _ + · by_cases hb : b ∈ active + · exact (hn ⟨ρ ⟨b, hb⟩, by + rw [← NatOrdinal.removeNat_add_right (β ⟨b, hb⟩) (lam b) (hβpos ⟨b, hb⟩), hβ]⟩).elim + · simp only [D, dif_neg hb] + · intro b γ hγ + simp only [D] + split <;> rfl + · intro τ a ha + have hSneg : S ⊆ Iic (0 : G) := by + rintro γ hγ + obtain ⟨b, hb⟩ := mem_iUnion.mp hγ + exact hb.2.2.le + have hSpwo : (Set.univ : Set ↥S).IsPWO := by + have hunion : S.IsPWO := Set.IsPWO.iUnion_of_finite + (fun b : ↥active ↦ rankLevelSet (p b) (ρ b) ∩ Ioo η 0) (fun b ↦ + (p b : HahnSeries G K).closedSupport_isPWO.mono fun γ hγ ↦ + ((mem_rankLevelSet_iff (p := p b) (α := ρ b)).mp hγ.1).1) + rw [Set.isPWO_iff_exists_monotone_subseq] + intro f _ + obtain ⟨g, hg⟩ := hunion.exists_monotone_subseq fun n ↦ (f n).2 + exact ⟨g, fun i j hij ↦ Subtype.coe_le_coe.mp (hg hij)⟩ + have hnear : ∀ᶠ γ in nhdsWithin (0 : G) (Iio 0), γ ∈ closure S → γ ∈ S := by + change ∀ᶠ γ in nhdsWithin (0 : G) (Iio 0), + γ ∈ closure (⋃ b : ↥active, rankLevelSet (p b) (ρ b) ∩ Ioo η 0) → + γ ∈ ⋃ b : ↥active, rankLevelSet (p b) (ρ b) ∩ Ioo η 0 + rw [closure_iUnion_of_finite] + have hall : ∀ᶠ γ in nhdsWithin (0 : G) (Iio 0), ∀ b : ↥active, + γ ∈ closure (rankLevelSet (p b) (ρ b) ∩ Ioo η 0) → + γ ∈ rankLevelSet (p b) (ρ b) ∩ Ioo η 0 := by + rw [Filter.eventually_all] + intro b + have hIoo : ∀ᶠ γ in nhdsWithin (0 : G) (Iio 0), γ ∈ Ioo η 0 := + eventually_nhdsLT_iff_exists.mpr + ⟨η, hη0, fun γ hγη hγ0 ↦ ⟨hγη, hγ0⟩⟩ + filter_upwards [eventually_mem_rankLevelSet_of_mem_closure (p b) (ρ b) (by + rw [hρsucc] + exact hp b |>.degree_le), + hIoo] with γ hrank hγIoo hclose + exact ⟨hrank (closure_mono inter_subset_left hclose), hγIoo⟩ + filter_upwards [hall] with γ hγ hclose + obtain ⟨b, hb⟩ := mem_iUnion.mp hclose + exact mem_iUnion_of_mem b (hγ b hb) + obtain ⟨s, hs, hderiv⟩ := exists_derivation_eq_of_isDiscrete τ S hSneg hSpwo + (by simpa only [S] using hdisc) hnear a ha + refine ⟨s, hs, fun γ ↦ if γ ∈ S then a γ else 0, ?_, ?_, ?_⟩ + · rw [cantorBendixsonDerivation_apply] + exact hderiv + · intro γ hγ + simp only [if_pos hγ] + · intro γ hγ + simp only [if_neg hγ] + +end HahnSeries.Nonpositive + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolation.lean new file mode 100644 index 0000000000..b643d66939 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolation.lean @@ -0,0 +1,530 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.OrderedIntervalCantorBendixson +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivative +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood + +/-! +# Interpolation of translated truncations + +The series `translateTruncGT w c center` translates the strict upper truncation of `w` to a chosen +center. Its support lies in one half-open interval. If every proper translated truncation of `w` +inside that interval has degree below `α`, then the `α`-th derivative of the translated support is +contained in the singleton consisting of its center. +-/ + +open Set Filter Topology TopologicalSpace +open scoped NatOrdinal + +universe u v w + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {R : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [CommRing R] + +/-- Place the exponents above `c` of `w` at `center`. -/ +def translateTruncGT (w : Nonpositive G R) (c center : G) : R⟦G⟧ := + translate center (truncGT c (w : HahnSeries G R)) + +/-- A translated strict upper truncation is supported in its designated half-open interval. -/ +theorem support_translateTruncGT_subset (w : Nonpositive G R) (c center : G) : + (translateTruncGT w c center).support ⊆ Ioc (center + c) center := by + rw [translateTruncGT, support_translate, support_truncGT] + rintro x ⟨y, ⟨hy, hcy⟩, rfl⟩ + exact ⟨by simpa [add_comm] using add_lt_add_left hcy center, + by simpa using add_le_add_left (w.property hy) center⟩ + +variable [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] + [CompleteSpace G] [NoZeroDivisors R] [CharZero R] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := R)) + +/-- If every proper translated truncation above `c` has degree below `α`, then the `α`-th +derivative of the translated strict upper truncation is supported at its center. -/ +theorem cantorBendixson_translateTruncGT_subset_singleton + (w : Nonpositive G R) (c center : G) (α : NatOrdinal.{u}) + (hcut : ∀ η, c < η → η < 0 → ν (translatedTruncLE η w) < α) : + ((translateTruncGT w c center).closedSupport.cantorBendixson α.val : Set G) ⊆ {center} := by + intro y hy + have hys : y ∈ (translateTruncGT w c center).closedSupport := + (translateTruncGT w c center).closedSupport.cantorBendixson_le α.val hy + have hybounds : y ∈ Icc (center + c) center := + closure_minimal + ((support_translateTruncGT_subset w c center).trans Ioc_subset_Icc_self) isClosed_Icc + ((mem_closedSupport _ _).mp hys) + by_cases hyc : y = center + · exact hyc ▸ Set.mem_singleton center + have hleft : center + c ∉ (translateTruncGT w c center).closedSupport := by + intro hm + have hm' : c ∈ (truncGT c (w : HahnSeries G R)).closedSupport := by + apply ((truncGT c (w : HahnSeries G R)).mem_closedSupport_translate center c).mp + exact hm + exact (w : HahnSeries G R).notMem_closedSupport_truncGT c hm' + have hlefty : center + c < y := lt_of_le_of_ne hybounds.1 fun he ↦ + hleft (he ▸ hys) + let η := -center + y + have hcη : c < η := by + dsimp only [η] + have h := add_lt_add_left hlefty (-center) + simpa [add_assoc, add_comm, add_left_comm] using h + have hη0 : η < 0 := by + dsimp only [η] + have h := add_lt_add_left (lt_of_le_of_ne hybounds.2 hyc) (-center) + simpa [add_assoc, add_comm, add_left_comm] using h + have hyη : center + η = y := by simp only [η, add_neg_cancel_left] + have hrank : (translateTruncGT w c center).cantorBendixsonRank y = + (w : HahnSeries G R).cantorBendixsonRank η := by + rw [translateTruncGT, ← hyη, (truncGT c (w : HahnSeries G R)).cantorBendixsonRank_translate, + (w : HahnSeries G R).cantorBendixsonRank_truncGT_of_lt hcη] + have hyrank : α.val ≤ (translateTruncGT w c center).cantorBendixsonRank y := + ((translateTruncGT w c center).mem_support_derivative_iff y α.val).mp hy |>.2 + have hηmem : η ∈ (w : HahnSeries G R).closedSupport := by + have hm : η ∈ (truncGT c (w : HahnSeries G R)).closedSupport := by + apply ((truncGT c (w : HahnSeries G R)).mem_closedSupport_translate center η).mp + rw [hyη] + exact hys + apply (mem_closedSupport _ _).mpr + exact closure_mono (support_truncGT_subset c (w : HahnSeries G R)) + ((mem_closedSupport _ _).mp hm) + have hzero : 0 ∈ (translatedTruncLE η w : Nonpositive G R).1.closedSupport := by + have hm := ((truncLE η (w : HahnSeries G R)).mem_closedSupport_translate (-η) η).mpr + ((w : HahnSeries G R).mem_closedSupport_truncLE η |>.mpr hηmem) + apply (mem_closedSupport _ _).mpr + rw [coe_translatedTruncLE] + exact (mem_closedSupport _ _).mp (by simpa only [neg_add_cancel] using hm) + have hdegree := hcut η hcη hη0 + rw [cantorBendixsonDegreeValuation_of_mem (translatedTruncLE η w) hzero, + WithBot.coe_lt_coe] at hdegree + have hsr : ((translatedTruncLE η w : Nonpositive G R).1).cantorBendixsonRank 0 = + (w : HahnSeries G R).cantorBendixsonRank η := by + simpa only [coe_translatedTruncLE] using + (w : HahnSeries G R).cantorBendixsonRank_translated_truncLE η + rw [hsr] at hdegree + exact ((not_le_of_gt (NatOrdinal.of.lt_iff_lt.mp hdegree)) (hrank ▸ hyrank)).elim + +/-- Every homogeneous class has a representative and a negative cutoff above any fixed negative +lower bound such that all proper translated truncations above the cutoff have lower degree. -/ +theorem exists_representative_with_lower_truncation_degree (α : NatOrdinal.{u}) + (a : (cantorBendixsonDegreeValuation (G := G) (R := R)).Component α) + {d : G} (hd : d < 0) : + ∃ w : Nonpositive G R, ∃ c : G, + ∃ hw : cantorBendixsonDegreeValuation w ≤ α, + d ≤ c ∧ c < 0 ∧ + (cantorBendixsonDegreeValuation (G := G) (R := R)).componentMk α + ⟨w, ((cantorBendixsonDegreeValuation (G := G) (R := R)).mem_filtrationLE_iff α w).mpr + hw⟩ = a ∧ + ∀ η, c < η → η < 0 → + cantorBendixsonDegreeValuation (translatedTruncLE η w) < α := by + induction a using MaxAddDegree.componentInductionOn with + | H b => + have hb : cantorBendixsonDegreeValuation (b : Nonpositive G R) ≤ α := + ((cantorBendixsonDegreeValuation (G := G) (R := R)).mem_filtrationLE_iff α + (b : Nonpositive G R)).mp b.property + obtain ⟨l, hl, hcut⟩ := eventually_nhdsLT_iff_exists.mp + (eventually_degree_translatedTruncLE_lt (b : Nonpositive G R) α hb) + let c := max l d + have hdc : d ≤ c := le_max_right _ _ + have hc0 : c < 0 := max_lt hl hd + refine ⟨(b : Nonpositive G R), c, hb, hdc, hc0, ?_, ?_⟩ + · rfl + · intro η hcη hη0 + exact hcut η ((le_max_left l d).trans_lt hcη) hη0 + +variable {ι : Type w} [LinearOrder ι] + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [NoZeroDivisors R] [CharZero R] in +/-- At one center, the translated weak truncation of the entire ordered interval sum differs from +the source of that translated strict upper truncation only at or below its cutoff. -/ +theorem support_translatedTruncLE_orderedIntervalHsum_sub_source_subset + (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦G⟧) (cut center : ι → G) + (hsupp : ∀ i, (f i).support ⊆ Ioc (cut i) (center i)) + (hord : ∀ i j, i < j → center i ≤ cut j) + (i : ι) (w : Nonpositive G R) (c : G) + (hcut : cut i = center i + c) (hfi : f i = translateTruncGT w c (center i)) : + (translate (-center i) (truncLE (center i) + (orderedIntervalHsum hι f cut center hsupp hord)) - (w : HahnSeries G R)).support ⊆ + Iic c := by + have hown : translate (-center i) (f i) = truncGT c (w : HahnSeries G R) := by + rw [hfi, translateTruncGT, translate_neg_apply] + have hfirst : (translate (-center i) (truncLE (center i) + (orderedIntervalHsum hι f cut center hsupp hord)) - + translate (-center i) (f i)).support ⊆ Iic c := by + have h := HahnSeries.support_translatedTruncLE_orderedIntervalHsum_sub_component_subset + hι f cut center hsupp hord i + rw [hcut] at h + simpa only [add_sub_cancel_left] using h + have hsecond : (translate (-center i) (f i) - (w : HahnSeries G R)).support ⊆ Iic c := by + rw [hown] + have he : truncGT c (w : HahnSeries G R) - (w : HahnSeries G R) = + -truncLE c (w : HahnSeries G R) := by + calc + truncGT c (w : HahnSeries G R) - (w : HahnSeries G R) = + truncGT c (w : HahnSeries G R) - + (truncLE c (w : HahnSeries G R) + truncGT c (w : HahnSeries G R)) := + (congrArg (fun z : HahnSeries G R ↦ truncGT c (w : HahnSeries G R) - z) + (truncLE_add_truncGT c (w : HahnSeries G R))).symm + _ = -truncLE c (w : HahnSeries G R) := by abel + rw [he, support_neg, support_truncLE] + exact inter_subset_right + have he : translate (-center i) (truncLE (center i) + (orderedIntervalHsum hι f cut center hsupp hord)) - (w : HahnSeries G R) = + (translate (-center i) (truncLE (center i) + (orderedIntervalHsum hι f cut center hsupp hord)) - translate (-center i) (f i)) + + (translate (-center i) (f i) - (w : HahnSeries G R)) := by + abel + rw [he] + exact (support_add_subset _ _).trans (union_subset hfirst hsecond) + +/-- At its center, one translated strict upper truncation represents the translated truncation of +the entire ordered sum in the same homogeneous component. All other intervals and the discarded +lower part contribute only a series bounded strictly below zero. -/ +theorem componentMk_centered_orderedIntervalHsum_eq + (α : NatOrdinal.{u}) (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦G⟧) (cut center : ι → G) + (hsupp : ∀ i, (f i).support ⊆ Ioc (cut i) (center i)) + (hord : ∀ i j, i < j → center i ≤ cut j) + (i : ι) (w : Nonpositive G R) (c : G) + (hc : c < 0) (hcut : cut i = center i + c) + (hfi : f i = translateTruncGT w c (center i)) + (hw : ν w ≤ α) : + let q : Nonpositive G R := + ⟨translate (-center i) (truncLE (center i) + (orderedIntervalHsum hι f cut center hsupp hord)), support_translated_truncLE _ _⟩ + ∃ hq : ν q ≤ α, + (ν).componentMk α ⟨q, ((ν).mem_filtrationLE_iff α q).mpr hq⟩ = + (ν).componentMk α ⟨w, ((ν).mem_filtrationLE_iff α w).mpr hw⟩ := by + dsimp only + let q : Nonpositive G R := + ⟨translate (-center i) (truncLE (center i) + (orderedIntervalHsum hι f cut center hsupp hord)), support_translated_truncLE _ _⟩ + have herr : ((q : HahnSeries G R) - (w : HahnSeries G R)).support ⊆ Iic c := + support_translatedTruncLE_orderedIntervalHsum_sub_source_subset + hι f cut center hsupp hord i w c hcut hfi + let e : Nonpositive G R := + ⟨(q : HahnSeries G R) - w, herr.trans (Iic_subset_Iic.mpr hc.le)⟩ + have hedeg : ν e = ⊥ := (cantorBendixsonDegreeValuation_eq_bot_iff e).mpr ⟨c, hc, herr⟩ + have hqe : q = e + w := by + apply Subtype.ext + change (q : HahnSeries G R) = ((q : HahnSeries G R) - w) + w + abel + have hq : ν q ≤ α := by + rw [hqe] + exact ((ν).map_add_le_max e w).trans (max_le (by rw [hedeg]; exact bot_le) hw) + refine ⟨hq, ((ν).componentMk_eq_componentMk_iff α _ _).mpr ?_⟩ + change ν e < α + rw [hedeg] + exact WithBot.bot_lt_coe α + +open Classical in +/-- Prescribed homogeneous classes on one exact rank level can be assembled at arbitrary +cofinality into a successor-filtered Hahn series. Its translated truncation at every rank-level +center has the prescribed lower homogeneous class. -/ +theorem exists_prescribed_components_on_rankLevel (α β : NatOrdinal.{u}) + (p : Nonpositive G R) (hp : ν p ≤ (α + 1 : NatOrdinal)) + (a : {x // x ∈ (p : HahnSeries G R).closedSupport ∧ + (p : HahnSeries G R).closedSupport.cantorBendixsonRank + (p : HahnSeries G R).closedSupport_isPWO x = α.val} → (ν).Component β) : + ∃ b : Nonpositive G R, ∃ hb : ν b ≤ (β + 1 : NatOrdinal), + (∀ i : {x // x ∈ (p : HahnSeries G R).closedSupport ∧ + (p : HahnSeries G R).closedSupport.cantorBendixsonRank + (p : HahnSeries G R).closedSupport_isPWO x = α.val}, + ∃ hi : ν (translatedTruncLE (i : G) b) ≤ β, + (ν).componentMk β + ⟨translatedTruncLE (i : G) b, + ((ν).mem_filtrationLE_iff β _).mpr hi⟩ = a i) ∧ + cantorBendixsonLayerDeriv β + ((ν).componentMk (β + 1) + ⟨b, ((ν).mem_filtrationLE_iff (β + 1) b).mpr hb⟩) = + ((fun γ ↦ if h : γ ∈ (p : HahnSeries G R).closedSupport ∧ + (p : HahnSeries G R).closedSupport.cantorBendixsonRank + (p : HahnSeries G R).closedSupport_isPWO γ = α.val then + a ⟨γ, h⟩ else 0) : + Filter.Germ (𝓝[<] (0 : G)) ((ν).Component β)) := by + classical + let I := {x // x ∈ (p : HahnSeries G R).closedSupport ∧ + (p : HahnSeries G R).closedSupport.cantorBendixsonRank + (p : HahnSeries G R).closedSupport_isPWO x = α.val} + have hI : (Set.univ : Set I).IsPWO := + (p : HahnSeries G R).closedSupport.rankLevel_univ_isPWO + (p : HahnSeries G R).closedSupport_isPWO α.val + obtain ⟨z, hzlt, _, hzord⟩ := + (p : HahnSeries G R).closedSupport.exists_rankLevel_leftCuts + (p : HahnSeries G R).closedSupport_isPWO α.val + have hd (i : I) : z i - (i : G) < 0 := sub_neg.mpr (hzlt i) + choose w c hw hdc hc hcomp hproper using fun i : I ↦ + exists_representative_with_lower_truncation_degree β (a i) (hd i) + let center : I → G := fun i ↦ i + let cut : I → G := fun i ↦ (i : G) + c i + let f : I → R⟦G⟧ := fun i ↦ translateTruncGT (w i) (c i) (i : G) + have hsupp : ∀ i, (f i).support ⊆ Ioc (cut i) (center i) := by + intro i + exact support_translateTruncGT_subset (w i) (c i) i + have hord : ∀ i j : I, i < j → center i ≤ cut j := by + intro i j hij + have hzj : z j ≤ (j : G) + c j := by + calc + z j = (j : G) + (z j - (j : G)) := by abel + _ ≤ (j : G) + c j := by + simpa only [add_comm] using add_le_add_left (hdc j) (j : G) + exact (hzord i j hij).trans hzj + let B : R⟦G⟧ := orderedIntervalHsum hI f cut center hsupp hord + have hBsupport : B.support ⊆ Iic 0 := by + change (orderedIntervalHsum hI f cut center hsupp hord).support ⊆ Iic 0 + rw [support_orderedIntervalHsum] + intro g hg + rw [Set.mem_iUnion] at hg + obtain ⟨i, hgi⟩ := hg + exact (hsupp i hgi).2.trans (closure_minimal p.property isClosed_Iic + ((mem_closedSupport _ _).mp i.property.1)) + let b : Nonpositive G R := ⟨B, hBsupport⟩ + have hstage : ∀ i, ((f i).closedSupport.cantorBendixson β.val : Set G) ⊆ + {center i} := by + intro i + exact cantorBendixson_translateTruncGT_subset_singleton (w i) (c i) i β (hproper i) + have hcenter : closure (Set.range center) ⊆ + ((p : HahnSeries G R).closedSupport.cantorBendixson α.val : Set G) := by + have hrange : Set.range center = + {x | x ∈ (p : HahnSeries G R).closedSupport ∧ + (p : HahnSeries G R).closedSupport.cantorBendixsonRank + (p : HahnSeries G R).closedSupport_isPWO x = α.val} := by + ext x + constructor + · rintro ⟨i, rfl⟩ + exact i.property + · intro hx + exact ⟨⟨x, hx⟩, rfl⟩ + rw [hrange, + (p : HahnSeries G R).closedSupport.closure_rank_level_eq + (p : HahnSeries G R).closedSupport_isPWO α.val] + have hpRank : (p : HahnSeries G R).cantorBendixsonRank 0 ≤ α.val + 1 := by + by_cases hm : 0 ∈ (p : HahnSeries G R).closedSupport + · rw [cantorBendixsonDegreeValuation_of_mem p hm, WithBot.coe_le_coe] at hp + have h := NatOrdinal.of.symm.monotone hp + change NatOrdinal.val (NatOrdinal.of ((p : HahnSeries G R).cantorBendixsonRank 0)) ≤ + NatOrdinal.val (α + 1) at h + simpa only [NatOrdinal.val_of, NatOrdinal.val_add_one] using h + · rw [cantorBendixsonRank_eq, + (p : HahnSeries G R).closedSupport.cantorBendixsonRank_of_notMem + (p : HahnSeries G R).closedSupport_isPWO hm] + exact zero_le + have hpnext : 0 ∉ + ((p : HahnSeries G R).closedSupport.cantorBendixson + ((α.val + 1) + 1) : Set G) := by + intro hm + have hr := ((p : HahnSeries G R).mem_support_derivative_iff 0 _).mp hm |>.2 + exact (not_le_of_gt (hpRank.trans_lt (lt_add_one _))) hr + have hBrank : B.cantorBendixsonRank 0 ≤ β.val + 1 := by + exact cantorBendixsonRank_orderedIntervalHsum_le_add_one_of_centerStage + hI f cut center hsupp hord β.val α.val + (p : HahnSeries G R).closedSupport hstage hcenter 0 hpnext + have hb : ν b ≤ (β + 1 : NatOrdinal) := by + by_cases hm : 0 ∈ (b : HahnSeries G R).closedSupport + · rw [cantorBendixsonDegreeValuation_of_mem b hm, WithBot.coe_le_coe] + have h := NatOrdinal.of.monotone hBrank + have hbB : (b : HahnSeries G R) = B := rfl + rw [hbB] + exact h.trans_eq (by rw [← NatOrdinal.val_add_one, NatOrdinal.of_val]) + · rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + cantorBendixsonValue_of_notMem _ (by simpa only [mem_closedSupport] using hm), + NatOrdinal.of_zero, NatOrdinal.cantorDegree_zero] + exact bot_le + have hpoint : ∀ i : I, ∃ hi : ν (translatedTruncLE (i : G) b) ≤ β, + (ν).componentMk β + ⟨translatedTruncLE (i : G) b, ((ν).mem_filtrationLE_iff β _).mpr hi⟩ = a i := by + intro i + have hlocal := componentMk_centered_orderedIntervalHsum_eq β hI f cut center hsupp hord + i (w i) (c i) (hc i) rfl rfl (hw i) + dsimp only [b, B] at hlocal + obtain ⟨hi, heq⟩ := hlocal + let q : Nonpositive G R := + ⟨translate (-(i : G)) (truncLE (i : G) + (orderedIntervalHsum hI f cut center hsupp hord)), support_translated_truncLE _ _⟩ + have hqt : q = translatedTruncLE (i : G) b := by + apply Subtype.ext + rw [coe_translatedTruncLE] + rw [← hqt] + exact ⟨hi, heq.trans (hcomp i)⟩ + have hBderiv : (B.closedSupport.cantorBendixson β.val : Set G) ⊆ + closure (Set.range center) := by + exact cantorBendixson_orderedIntervalHsum_subset_closure_range + hI f cut center hsupp hord β.val hstage + have hgerm : cantorBendixsonLayerDeriv β + ((ν).componentMk (β + 1) + ⟨b, ((ν).mem_filtrationLE_iff (β + 1) b).mpr hb⟩) = + ((fun γ ↦ if h : γ ∈ (p : HahnSeries G R).closedSupport ∧ + (p : HahnSeries G R).closedSupport.cantorBendixsonRank + (p : HahnSeries G R).closedSupport_isPWO γ = α.val then + a ⟨γ, h⟩ else 0) : + Filter.Germ (𝓝[<] (0 : G)) ((ν).Component β)) := by + rw [cantorBendixsonLayerDeriv_componentMk, Filter.Germ.coe_eq] + filter_upwards [eventually_degree_translatedTruncLE_le p α hp, + eventually_degree_translatedTruncLE_le b β hb] with γ hpγ hbγ + by_cases hs : γ ∈ (p : HahnSeries G R).closedSupport ∧ + (p : HahnSeries G R).closedSupport.cantorBendixsonRank + (p : HahnSeries G R).closedSupport_isPWO γ = α.val + · rw [dif_pos hs, cantorBendixsonDerivAt_eq β b γ hbγ] + exact (hpoint ⟨γ, hs⟩).choose_spec + · rw [dif_neg hs] + by_contra hne + have hbexact := (cantorBendixsonDerivAt_ne_zero_iff β b γ hbγ).mp hne + have hbB : (b : HahnSeries G R) = B := rfl + have hbclosed : γ ∈ B.closedSupport := by + rw [← hbB] + exact hbexact.1 + have hbmem : γ ∈ (B.closedSupport.cantorBendixson β.val : Set G) := by + apply (B.mem_support_derivative_iff γ β.val).mpr + refine ⟨(mem_closedSupport _ _).mp hbclosed, ?_⟩ + simpa only [cantorBendixsonRank_eq, hbB] using hbexact.2.ge + have hpmem := ((p : HahnSeries G R).mem_support_derivative_iff γ α.val).mp + (hcenter (hBderiv hbmem)) + apply hs + refine ⟨(mem_closedSupport _ _).mpr hpmem.1, ?_⟩ + rw [← cantorBendixsonRank_eq] + exact cantorBendixsonRank_eq_of_mem_derivative_of_degree_translatedTruncLE_le + α p γ ((mem_closedSupport _ _).mpr hpmem.1) hpmem.2 hpγ + exact ⟨b, hb, hpoint, hgerm⟩ + +open Classical in +/-- Prescribed nonpositive series at every exact top-rank point assemble with literal pointwise +degree bounds. When every translated truncation of `p`, including the one at cutoff zero, has +degree at most `β`, the exact rank-`β` points of its closed support accumulate nowhere, so the +assembly loses no stage at any cutoff. The assembled series matches each prescription at its +center up to a series bounded strictly below zero, and its translated truncation at every other +nonpositive cutoff, including zero, has degree strictly below `ρ`. -/ +theorem exists_prescribed_truncations_on_topRankLevel (β ρ : NatOrdinal.{u}) + (p : Nonpositive G R) + (hp : ∀ x : G, x ≤ 0 → ν (translatedTruncLE x p) ≤ β) + (w : {x // x ∈ (p : HahnSeries G R).closedSupport ∧ + (p : HahnSeries G R).closedSupport.cantorBendixsonRank + (p : HahnSeries G R).closedSupport_isPWO x = β.val} → Nonpositive G R) + (hw : ∀ i, ν (w i) ≤ ρ) : + ∃ c : Nonpositive G R, + (∀ i : {x // x ∈ (p : HahnSeries G R).closedSupport ∧ + (p : HahnSeries G R).closedSupport.cantorBendixsonRank + (p : HahnSeries G R).closedSupport_isPWO x = β.val}, + ν (translatedTruncLE (i : G) c - w i) = ⊥) ∧ + ∀ y : G, y ≤ 0 → + ¬(y ∈ (p : HahnSeries G R).closedSupport ∧ + (p : HahnSeries G R).closedSupport.cantorBendixsonRank + (p : HahnSeries G R).closedSupport_isPWO y = β.val) → + ν (translatedTruncLE y c) < ρ := by + classical + let I := {x // x ∈ (p : HahnSeries G R).closedSupport ∧ + (p : HahnSeries G R).closedSupport.cantorBendixsonRank + (p : HahnSeries G R).closedSupport_isPWO x = β.val} + have hI : (Set.univ : Set I).IsPWO := + (p : HahnSeries G R).closedSupport.rankLevel_univ_isPWO + (p : HahnSeries G R).closedSupport_isPWO β.val + obtain ⟨z, hzlt, -, hzord⟩ := + (p : HahnSeries G R).closedSupport.exists_rankLevel_leftCuts + (p : HahnSeries G R).closedSupport_isPWO β.val + have hcuts : ∀ i : I, ∃ ci : G, z i - (i : G) ≤ ci ∧ ci < 0 ∧ + ∀ η, ci < η → η < 0 → ν (translatedTruncLE η (w i)) < ρ := by + intro i + obtain ⟨l, hl, hcut⟩ := eventually_nhdsLT_iff_exists.mp + (eventually_degree_translatedTruncLE_lt (w i) ρ (hw i)) + refine ⟨max l (z i - (i : G)), le_max_right _ _, + max_lt hl (sub_neg.mpr (hzlt i)), fun η hlη hη0 ↦ ?_⟩ + exact hcut η ((le_max_left _ _).trans_lt hlη) hη0 + choose cc hdc hcneg hccut using hcuts + let center : I → G := fun i ↦ i + let cut : I → G := fun i ↦ (i : G) + cc i + let f : I → R⟦G⟧ := fun i ↦ translateTruncGT (w i) (cc i) (i : G) + have hsupp : ∀ i, (f i).support ⊆ Ioc (cut i) (center i) := fun i ↦ + support_translateTruncGT_subset (w i) (cc i) i + have hord : ∀ i j : I, i < j → center i ≤ cut j := by + intro i j hij + have hzj : z j ≤ (j : G) + cc j := by + calc + z j = (j : G) + (z j - (j : G)) := by abel + _ ≤ (j : G) + cc j := by + simpa only [add_comm] using add_le_add_left (hdc j) (j : G) + exact (hzord i j hij).trans hzj + let B : R⟦G⟧ := orderedIntervalHsum hI f cut center hsupp hord + have hBsupport : B.support ⊆ Iic 0 := by + change (orderedIntervalHsum hI f cut center hsupp hord).support ⊆ Iic 0 + rw [support_orderedIntervalHsum] + intro g hg + rw [Set.mem_iUnion] at hg + obtain ⟨i, hgi⟩ := hg + exact (hsupp i hgi).2.trans (closure_minimal p.property isClosed_Iic + ((mem_closedSupport _ _).mp i.property.1)) + let c : Nonpositive G R := ⟨B, hBsupport⟩ + refine ⟨c, ?_, ?_⟩ + · intro i + have herr := support_translatedTruncLE_orderedIntervalHsum_sub_source_subset + hI f cut center hsupp hord i (w i) (cc i) rfl rfl + apply (cantorBendixsonDegreeValuation_eq_bot_iff _).mpr + refine ⟨cc i, hcneg i, ?_⟩ + have hcoe : ((translatedTruncLE (i : G) c - w i : Nonpositive G R) : HahnSeries G R) = + translate (-(i : G)) (truncLE (i : G) B) - (w i : HahnSeries G R) := by + rw [AddSubgroupClass.coe_sub, coe_translatedTruncLE] + rw [hcoe] + exact herr + · intro y hy0 hyn + have hstage : ∀ i, ((f i).closedSupport.cantorBendixson ρ.val : Set G) ⊆ {center i} := + fun i ↦ cantorBendixson_translateTruncGT_subset_singleton (w i) (cc i) i ρ (hccut i) + have hderiv : ((orderedIntervalHsum hI f cut center hsupp hord).closedSupport.cantorBendixson + ρ.val : Set G) ⊆ closure (Set.range center) := + cantorBendixson_orderedIntervalHsum_subset_closure_range hI f cut center hsupp hord + ρ.val hstage + have hrange : Set.range center = {x : G | x ∈ (p : HahnSeries G R).closedSupport ∧ + (p : HahnSeries G R).closedSupport.cantorBendixsonRank + (p : HahnSeries G R).closedSupport_isPWO x = β.val} := by + ext x + constructor + · rintro ⟨i, rfl⟩ + exact i.property + · intro hx + exact ⟨⟨x, hx⟩, rfl⟩ + have hlevel : ∀ x : G, + x ∈ ((p : HahnSeries G R).closedSupport.cantorBendixson β.val : Set G) → + x ∈ (p : HahnSeries G R).closedSupport ∧ + (p : HahnSeries G R).closedSupport.cantorBendixsonRank + (p : HahnSeries G R).closedSupport_isPWO x = β.val := by + intro x hx + obtain ⟨hxs, hxr⟩ := ((p : HahnSeries G R).closedSupport.mem_cantorBendixson_iff + (p : HahnSeries G R).closedSupport_isPWO x β.val).mp hx + have hx0 : x ≤ 0 := closure_minimal p.property isClosed_Iic + ((mem_closedSupport _ _).mp hxs) + have hd := hp x hx0 + rw [degree_translatedTruncLE_eq, if_pos hxs, WithBot.coe_le_coe] at hd + have hval := NatOrdinal.of.symm.monotone hd + change NatOrdinal.val (NatOrdinal.of ((p : HahnSeries G R).cantorBendixsonRank x)) ≤ + NatOrdinal.val β at hval + rw [NatOrdinal.val_of, cantorBendixsonRank_eq] at hval + exact ⟨hxs, le_antisymm hval hxr⟩ + have hclosure : closure (Set.range center) ⊆ + {x : G | x ∈ (p : HahnSeries G R).closedSupport ∧ + (p : HahnSeries G R).closedSupport.cantorBendixsonRank + (p : HahnSeries G R).closedSupport_isPWO x = β.val} := by + rw [hrange, (p : HahnSeries G R).closedSupport.closure_rank_level_eq + (p : HahnSeries G R).closedSupport_isPWO β.val] + exact hlevel + have hcB : (c : HahnSeries G R) = orderedIntervalHsum hI f cut center hsupp hord := rfl + have hyd : y ∉ ((c : HahnSeries G R).closedSupport.cantorBendixson ρ.val : Set G) := by + rw [hcB] + exact fun hyd ↦ hyn (hclosure (hderiv hyd)) + rw [degree_translatedTruncLE_eq] + by_cases hym : y ∈ (c : HahnSeries G R).closedSupport + · rw [if_pos hym] + have hrlt : (c : HahnSeries G R).cantorBendixsonRank y < ρ.val := by + by_contra hge + exact hyd (((c : HahnSeries G R).mem_support_derivative_iff y ρ.val).mpr + ⟨(mem_closedSupport _ _).mp hym, not_lt.mp hge⟩) + rw [WithBot.coe_lt_coe, ← NatOrdinal.of_val ρ] + exact NatOrdinal.of.lt_iff_lt.mpr hrlt + · rw [if_neg hym] + exact WithBot.bot_lt_coe ρ + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolationOnSets.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolationOnSets.lean new file mode 100644 index 0000000000..0b205c0418 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolationOnSets.lean @@ -0,0 +1,197 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import + LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation + +/-! +# Interpolation of translated truncations on a set + +The construction places a prescribed homogeneous class at each point of an exact-rank set. +Nothing requires those points to come from a single series: the proof only uses that they are +partially well ordered, sit at or below zero, admit ordered disjoint left cuts, and are carried by +some derivative stage of a closed set at which the origin has already dropped out. + +This file gives the interpolation theorem over such a set. The level of one series is one case; +finite unions of levels give the version needed for a family of prescriptions. + +The one condition that is not merely structural is that the set be recovered from its closure near +zero: a point of the closure that is not in the set must not occur arbitrarily close to zero. For a +rank level that holds because the truncations eventually drop, and it is what stops the assembled +derivative from being nonzero away from the prescribed points. +-/ + +universe u v w + +open scoped NatOrdinal Topology + +open Filter Set TopologicalSpace HahnSeries + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {R : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [CommRing R] [NoZeroDivisors R] [CharZero R] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := R)) + +open Classical in +/-- Prescribed homogeneous classes on a partially well ordered, nonpositive, left-separated set +carried by a derivative stage assemble into one class a degree higher whose derivative germ is the +prescribed function, provided the set is recovered from its closure near zero. -/ +theorem exists_prescribed_components_on_set (β : NatOrdinal.{u}) (S : Set G) + (hSneg : S ⊆ Iic 0) + (hSpwo : (Set.univ : Set ↥S).IsPWO) + (z : ↥S → G) (hzlt : ∀ i : ↥S, z i < (i : G)) + (hzord : ∀ i j : ↥S, (i : G) < (j : G) → (i : G) ≤ z j) + (t : Closeds G) (r : Ordinal.{u}) + (hcarry : closure S ⊆ (t.cantorBendixson r : Set G)) + (hdrop : (0 : G) ∉ (t.cantorBendixson ((r + 1) + 1) : Set G)) + (hnear : ∀ᶠ γ in 𝓝[<] (0 : G), γ ∈ closure S → γ ∈ S) + (a : ↥S → (ν).Component β) : + ∃ b : Nonpositive G R, ∃ hb : ν b ≤ (β + 1 : NatOrdinal), + (∀ i : ↥S, ∃ hi : ν (translatedTruncLE (i : G) b) ≤ β, + (ν).componentMk β + ⟨translatedTruncLE (i : G) b, ((ν).mem_filtrationLE_iff β _).mpr hi⟩ = a i) ∧ + cantorBendixsonLayerDeriv β + ((ν).componentMk (β + 1) ⟨b, ((ν).mem_filtrationLE_iff (β + 1) b).mpr hb⟩) = + ((fun γ ↦ if h : γ ∈ S then a ⟨γ, h⟩ else 0) : + Filter.Germ (𝓝[<] (0 : G)) ((ν).Component β)) := by + classical + have hd (i : ↥S) : z i - (i : G) < 0 := sub_neg.mpr (hzlt i) + choose w c hw hdc hc hcomp hproper using fun i : ↥S ↦ + exists_representative_with_lower_truncation_degree β (a i) (hd i) + set center : ↥S → G := fun i ↦ i with hcenterdef + set cut : ↥S → G := fun i ↦ (i : G) + c i with hcutdef + set f : ↥S → R⟦G⟧ := fun i ↦ translateTruncGT (w i) (c i) (i : G) with hfdef + have hsupp : ∀ i, (f i).support ⊆ Ioc (cut i) (center i) := fun i ↦ + support_translateTruncGT_subset (w i) (c i) i + have hord : ∀ i j : ↥S, i < j → center i ≤ cut j := by + intro i j hij + have hzj : z j ≤ (j : G) + c j := by + calc + z j = (j : G) + (z j - (j : G)) := by abel + _ ≤ (j : G) + c j := by simpa only [add_comm] using add_le_add_left (hdc j) (j : G) + exact (hzord i j hij).trans hzj + set B : R⟦G⟧ := orderedIntervalHsum hSpwo f cut center hsupp hord with hBdef + have hBsupport : B.support ⊆ Iic 0 := by + rw [hBdef, support_orderedIntervalHsum] + intro g hg + rw [Set.mem_iUnion] at hg + obtain ⟨i, hgi⟩ := hg + exact (hsupp i hgi).2.trans (hSneg i.property) + set b : Nonpositive G R := ⟨B, hBsupport⟩ with hbdef + have hstage : ∀ i, ((f i).closedSupport.cantorBendixson β.val : Set G) ⊆ {center i} := fun i ↦ + cantorBendixson_translateTruncGT_subset_singleton (w i) (c i) i β (hproper i) + have hrange : Set.range center = S := by + ext x + exact ⟨by rintro ⟨i, rfl⟩; exact i.property, fun hx ↦ ⟨⟨x, hx⟩, rfl⟩⟩ + have hcenter : closure (Set.range center) ⊆ (t.cantorBendixson r : Set G) := by + rw [hrange]; exact hcarry + have hBrank : B.cantorBendixsonRank 0 ≤ β.val + 1 := + cantorBendixsonRank_orderedIntervalHsum_le_add_one_of_centerStage + hSpwo f cut center hsupp hord β.val r t hstage hcenter 0 hdrop + have hb : ν b ≤ (β + 1 : NatOrdinal) := by + by_cases hm : 0 ∈ (b : HahnSeries G R).closedSupport + · rw [cantorBendixsonDegreeValuation_of_mem b hm, WithBot.coe_le_coe] + have h := NatOrdinal.of.monotone hBrank + have hbB : (b : HahnSeries G R) = B := rfl + rw [hbB] + exact h.trans_eq (by rw [← NatOrdinal.val_add_one, NatOrdinal.of_val]) + · rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + cantorBendixsonValue_of_notMem _ (by simpa only [mem_closedSupport] using hm), + NatOrdinal.of_zero, NatOrdinal.cantorDegree_zero] + exact bot_le + have hpoint : ∀ i : ↥S, ∃ hi : ν (translatedTruncLE (i : G) b) ≤ β, + (ν).componentMk β + ⟨translatedTruncLE (i : G) b, ((ν).mem_filtrationLE_iff β _).mpr hi⟩ = a i := by + intro i + have hlocal := componentMk_centered_orderedIntervalHsum_eq β hSpwo f cut center hsupp hord + i (w i) (c i) (hc i) rfl rfl (hw i) + dsimp only [hbdef, hBdef] at hlocal + obtain ⟨hi, heq⟩ := hlocal + set q : Nonpositive G R := + ⟨translate (-(i : G)) (truncLE (i : G) + (orderedIntervalHsum hSpwo f cut center hsupp hord)), support_translated_truncLE _ _⟩ + with hqdef + have hqt : q = translatedTruncLE (i : G) b := by + apply Subtype.ext + rw [coe_translatedTruncLE] + rw [← hqt] + exact ⟨hi, heq.trans (hcomp i)⟩ + have hBderiv : (B.closedSupport.cantorBendixson β.val : Set G) ⊆ closure (Set.range center) := + cantorBendixson_orderedIntervalHsum_subset_closure_range + hSpwo f cut center hsupp hord β.val hstage + refine ⟨b, hb, hpoint, ?_⟩ + rw [cantorBendixsonLayerDeriv_componentMk, Filter.Germ.coe_eq] + filter_upwards [eventually_degree_translatedTruncLE_le b β hb, hnear] with γ hbγ hnearγ + by_cases hs : γ ∈ S + · rw [dif_pos hs, cantorBendixsonDerivAt_eq β b γ hbγ] + exact (hpoint ⟨γ, hs⟩).choose_spec + · rw [dif_neg hs] + by_contra hne + have hbexact := (cantorBendixsonDerivAt_ne_zero_iff β b γ hbγ).mp hne + have hbB : (b : HahnSeries G R) = B := rfl + have hbclosed : γ ∈ B.closedSupport := by rw [← hbB]; exact hbexact.1 + have hbmem : γ ∈ (B.closedSupport.cantorBendixson β.val : Set G) := by + apply (B.mem_support_derivative_iff γ β.val).mpr + refine ⟨(mem_closedSupport _ _).mp hbclosed, ?_⟩ + simpa only [cantorBendixsonRank_eq, hbB] using hbexact.2.ge + exact hs (hnearγ (by rw [← hrange]; exact hBderiv hbmem)) + +open Classical in +/-- **Interpolation over a discrete set of centers.** A discrete set whose closure adds nothing +near zero carries its own derivative bookkeeping. Its accumulation points avoid a neighbourhood of +zero, so zero is not an accumulation point of them, and the second derivative stage of its closure +misses zero. Prescribed classes at its points therefore assemble with no further hypotheses. -/ +theorem exists_prescribed_components_on_set_of_isDiscrete (β : NatOrdinal.{u}) (S : Set G) + (hSneg : S ⊆ Iic 0) (hSpwo : (Set.univ : Set ↥S).IsPWO) (hSdisc : IsDiscrete S) + (hnear : ∀ᶠ γ in 𝓝[<] (0 : G), γ ∈ closure S → γ ∈ S) + (a : ↥S → (ν).Component β) : + ∃ b : Nonpositive G R, ∃ hb : ν b ≤ (β + 1 : NatOrdinal), + (∀ i : ↥S, ∃ hi : ν (translatedTruncLE (i : G) b) ≤ β, + (ν).componentMk β + ⟨translatedTruncLE (i : G) b, ((ν).mem_filtrationLE_iff β _).mpr hi⟩ = a i) ∧ + cantorBendixsonLayerDeriv β + ((ν).componentMk (β + 1) ⟨b, ((ν).mem_filtrationLE_iff (β + 1) b).mpr hb⟩) = + ((fun γ ↦ if h : γ ∈ S then a ⟨γ, h⟩ else 0) : + Filter.Germ (𝓝[<] (0 : G)) ((ν).Component β)) := by + classical + obtain ⟨z, hzlt, -, hzord⟩ := TopologicalSpace.Closeds.exists_leftCuts_of_isDiscrete S hSdisc + obtain ⟨η, hη, hcut⟩ := eventually_nhdsLT_iff_exists.mp hnear + set t : Closeds G := ⟨closure S, isClosed_closure⟩ with htdef + have hcarry : closure S ⊆ (t.cantorBendixson (0 : Ordinal.{u}) : Set G) := by + rw [TopologicalSpace.Closeds.cantorBendixson_zero] + exact subset_rfl + -- the accumulation points of the centers avoid a whole left neighbourhood of zero + have hacc : ∀ γ : G, η < γ → γ < 0 → γ ∉ derivedSet S := by + intro γ hηγ hγ0 hγ + have hγS : γ ∈ S := hcut γ hηγ hγ0 (derivedSet_subset_closure S hγ) + rw [isDiscrete_iff_nhdsNE] at hSdisc + exact (mem_derivedSet.mp hγ).ne (hSdisc γ hγS) + have hderived : ((t.derived : Closeds G) : Set G) = derivedSet S := by + rw [TopologicalSpace.Closeds.coe_derived] + exact derivedSet_closure S + have hdrop : (0 : G) ∉ (t.cantorBendixson ((0 : Ordinal.{u}) + 1 + 1) : Set G) := by + rw [TopologicalSpace.Closeds.cantorBendixson_add_one, + TopologicalSpace.Closeds.cantorBendixson_add_one, + TopologicalSpace.Closeds.cantorBendixson_zero, + TopologicalSpace.Closeds.coe_derived, mem_derivedSet, accPt_iff_nhds] + intro hacc0 + obtain ⟨y, hy, hyne⟩ := hacc0 (Ioi η) ((isOpen_Ioi).mem_nhds hη) + have hyd : y ∈ derivedSet S := by rw [← hderived]; exact hy.2 + have hyle : y ≤ 0 := + closure_minimal hSneg isClosed_Iic (derivedSet_subset_closure S hyd) + exact hacc y hy.1 (lt_of_le_of_ne hyle hyne) hyd + exact exists_prescribed_components_on_set β S hSneg hSpwo z hzlt hzord t 0 hcarry hdrop hnear a + +end HahnSeries.Nonpositive + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Truncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Truncation.lean new file mode 100644 index 0000000000..1182ca82f5 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Truncation.lean @@ -0,0 +1,274 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValue + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Translation +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonReconstruction +public import Mathlib.Topology.Algebra.Group.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood + +/-! +# Cantor–Bendixson ranks under translated truncation + +A weak lower truncation preserves the closed support locally at its cutoff, since a well-ordered +support has a gap immediately to the right. Translation preserves point ranks. Consequently, +the value of the translated weak truncation at `c` reads the original point rank at `c`, +with value zero exactly when `c` is outside the original closed support. + +The reconstruction statement lifts local lower bounds on exact-rank points to a lower bound +at the target point. Truncation uses `i ≤ c`, retaining the cutoff coefficient, and translation +by `-c` sends that exponent to zero. No multiplication identity is assumed. +-/ + +public noncomputable section + +open Set Filter Topology TopologicalSpace + +universe u v + +namespace HahnSeries + +variable {G : Type u} {R : Type v} [LinearOrder G] [TopologicalSpace G] + [OrderTopology G] + +section Zero + +variable [Zero R] + +/-- Weak lower truncation preserves the closed support in a neighborhood of its cutoff. -/ +theorem closedSupport_truncLE_locally_eq (b : HahnSeries G R) (c : G) : + ∃ U : Set G, IsOpen U ∧ c ∈ U ∧ + ((truncLE c b).closedSupport : Set G) ∩ U = (b.closedSupport : Set G) ∩ U := by + obtain ⟨U, hU, hUo, hcU⟩ := mem_nhds_iff.mp (b.isPWO_support.eventually_le c) + refine ⟨U, hUo, hcU, ?_⟩ + rw [coe_closedSupport, coe_closedSupport] + apply hUo.closure_congr + rw [support_truncLE] + ext y + exact ⟨fun h ↦ ⟨h.1.1, h.2⟩, fun h ↦ ⟨⟨h.1, hU h.2 h.1⟩, h.2⟩⟩ + +/-- Weak lower truncation preserves the Cantor–Bendixson rank at its cutoff. -/ +theorem cantorBendixsonRank_truncLE (b : HahnSeries G R) (c : G) : + (truncLE c b).cantorBendixsonRank c = b.cantorBendixsonRank c := by + obtain ⟨U, hU, hc, he⟩ := b.closedSupport_truncLE_locally_eq c + rw [cantorBendixsonRank_eq, cantorBendixsonRank_eq] + exact (truncLE c b).closedSupport.cantorBendixsonRank_congr_on_open b.closedSupport + (truncLE c b).closedSupport_isPWO b.closedSupport_isPWO hU he hc + +/-- A strict upper truncation preserves the closed support locally at every point strictly above +its cutoff. -/ +theorem closedSupport_truncGT_locally_eq_of_lt (b : HahnSeries G R) {c x : G} + (hcx : c < x) : + ∃ U : Set G, IsOpen U ∧ x ∈ U ∧ + ((truncGT c b).closedSupport : Set G) ∩ U = (b.closedSupport : Set G) ∩ U := by + refine ⟨Ioi c, isOpen_Ioi, hcx, ?_⟩ + rw [coe_closedSupport, coe_closedSupport] + apply isOpen_Ioi.closure_congr + rw [support_truncGT] + ext y + simp only [mem_inter_iff, mem_setOf_eq, mem_Ioi] + tauto + +/-- A strict upper truncation preserves Cantor–Bendixson rank strictly above its cutoff. -/ +theorem cantorBendixsonRank_truncGT_of_lt (b : HahnSeries G R) {c x : G} (hcx : c < x) : + (truncGT c b).cantorBendixsonRank x = b.cantorBendixsonRank x := by + obtain ⟨U, hU, hx, he⟩ := b.closedSupport_truncGT_locally_eq_of_lt hcx + rw [cantorBendixsonRank_eq, cantorBendixsonRank_eq] + exact (truncGT c b).closedSupport.cantorBendixsonRank_congr_on_open b.closedSupport + (truncGT c b).closedSupport_isPWO b.closedSupport_isPWO hU he hx + +/-- The strict cutoff itself is outside the closed support of a strict upper truncation. -/ +theorem notMem_closedSupport_truncGT (b : HahnSeries G R) (c : G) : + c ∉ (truncGT c b).closedSupport := by + rw [mem_closedSupport] + intro hc + obtain ⟨U, hU, hUopen, hcU⟩ := mem_nhds_iff.mp (b.isPWO_support.eventually_le c) + obtain ⟨y, hyU, hy⟩ := mem_closure_iff.mp hc U hUopen hcU + rw [support_truncGT] at hy + exact (not_le_of_gt hy.2) (hU hyU hy.1) + +/-- The cutoff belongs to the truncated closed support exactly when it belongs to the original. -/ +theorem mem_closedSupport_truncLE (b : HahnSeries G R) (c : G) : + c ∈ (truncLE c b).closedSupport ↔ c ∈ b.closedSupport := by + obtain ⟨U, _, hc, he⟩ := b.closedSupport_truncLE_locally_eq c + exact ⟨fun h ↦ ((Set.ext_iff.mp he c).mp ⟨h, hc⟩).1, + fun h ↦ ((Set.ext_iff.mp he c).mpr ⟨h, hc⟩).1⟩ + +/-- Local bounds at points of exact rank reconstruct a Cantor–Bendixson rank bound at the target. -/ +theorem cantorBendixsonRank_reconstruction (b d : HahnSeries G R) + {U : Set G} (hU : IsOpen U) {x : G} (hxU : x ∈ U) + (a c r : Ordinal.{u}) (hx : x ∈ closure b.support) (hr : a + r ≤ b.cantorBendixsonRank x) + (hlevel : ∀ y ∈ U, y ∈ closure b.support → b.cantorBendixsonRank y = a → + y ∈ closure d.support ∧ c ≤ d.cantorBendixsonRank y) : + x ∈ closure d.support ∧ c + r ≤ d.cantorBendixsonRank x := by + apply (d.mem_support_derivative_iff x (c + r)).mp + apply b.closedSupport.cantorBendixson_reconstruction d.closedSupport + b.closedSupport_isPWO hU a c r _ ⟨(b.mem_support_derivative_iff x _).mpr ⟨hx, hr⟩, hxU⟩ + intro y hyU hys hy + apply (d.mem_support_derivative_iff y c).mpr + exact hlevel y hyU ((b.mem_closedSupport y).mp hys) ((b.cantorBendixsonRank_eq y).trans hy) + +end Zero + +section Translation + +variable [AddCommGroup G] [IsOrderedAddMonoid G] [IsTopologicalAddGroup G] [AddMonoid R] + +omit [TopologicalSpace G] [OrderTopology G] [IsTopologicalAddGroup G] in +/-- A translated weak lower truncation always has nonpositive support. -/ +theorem support_translated_truncLE (b : HahnSeries G R) (c : G) : + (translate (-c) (truncLE c b)).support ⊆ Iic 0 := by + rw [support_translate] + rintro x ⟨y, hy, rfl⟩ + rw [support_truncLE] at hy + simpa only [mem_Iic, neg_add_cancel] using add_le_add_right hy.2 (-c) + +/-- Translating the exponents and the target point together preserves Cantor–Bendixson rank. -/ +theorem cantorBendixsonRank_translate (b : HahnSeries G R) (a x : G) : + (translate a b).cantorBendixsonRank (a + x) = b.cantorBendixsonRank x := by + rw [cantorBendixsonRank_eq, cantorBendixsonRank_eq] + apply (Homeomorph.addLeft a).cantorBendixsonRank_eq b.closedSupport (translate a b).closedSupport + b.closedSupport_isPWO (translate a b).closedSupport_isPWO + rw [coe_closedSupport, coe_closedSupport, support_translate] + exact (Homeomorph.addLeft a).image_closure _ + +omit [OrderTopology G] in +/-- Translation transports membership in the closed support. -/ +theorem mem_closedSupport_translate (b : HahnSeries G R) (a x : G) : + a + x ∈ (translate a b).closedSupport ↔ x ∈ b.closedSupport := by + rw [mem_closedSupport, mem_closedSupport, support_translate] + have he : (a + ·) '' closure b.support = closure ((a + ·) '' b.support) := + (Homeomorph.addLeft a).image_closure b.support + rw [← he] + constructor + · rintro ⟨y, hy, he⟩ + exact (add_left_cancel he : y = x) ▸ hy + · exact fun hx ↦ ⟨x, hx, rfl⟩ + +/-- The rank at zero after translated weak truncation is the original rank at the cutoff. -/ +theorem cantorBendixsonRank_translated_truncLE (b : HahnSeries G R) (c : G) : + (translate (-c) (truncLE c b)).cantorBendixsonRank 0 = b.cantorBendixsonRank c := by + simpa only [neg_add_cancel] using + ((truncLE c b).cantorBendixsonRank_translate (-c) c).trans (b.cantorBendixsonRank_truncLE c) + +open Classical in +/-- The translated weak truncation value reads the Cantor–Bendixson rank at the cutoff. -/ +theorem cantorBendixsonValue_translated_truncLE (b : HahnSeries G R) (c : G) : + (translate (-c) (truncLE c b)).cantorBendixsonValue = + if c ∈ b.closedSupport then Ordinal.omega0 ^ b.cantorBendixsonRank c else 0 := by + have hm : (0 : G) ∈ (translate (-c) (truncLE c b)).closedSupport ↔ c ∈ b.closedSupport := by + simpa only [neg_add_cancel] using + ((truncLE c b).mem_closedSupport_translate (-c) c).trans (b.mem_closedSupport_truncLE c) + by_cases hc : c ∈ b.closedSupport + · rw [if_pos hc, cantorBendixsonValue_of_mem _ ((mem_closedSupport _ _).mp (hm.mpr hc)), + cantorBendixsonRank_translated_truncLE] + · rw [if_neg hc] + apply cantorBendixsonValue_of_notMem + intro hh + exact hc (hm.mp ((mem_closedSupport _ _).mpr hh)) + +/-- Nearby proper translated truncations have strictly smaller value when the value is nonzero. -/ +theorem eventually_value_translated_truncLE_lt (b : HahnSeries G R) + (hb : b.cantorBendixsonValue ≠ 0) : + ∀ᶠ c in 𝓝 (0 : G), c ≠ 0 → + (translate (-c) (truncLE c b)).cantorBendixsonValue < b.cantorBendixsonValue := by + classical + have hb0 : 0 ∈ closure b.support := + not_not.mp (mt (b.cantorBendixsonValue_eq_zero_iff).mpr hb) + filter_upwards [b.closedSupport.cantorBendixsonRank_locally_lt b.closedSupport_isPWO 0] + with c hc hne + rw [b.cantorBendixsonValue_translated_truncLE, b.cantorBendixsonValue_of_mem hb0] + by_cases hmem : c ∈ b.closedSupport + · rw [if_pos hmem] + apply (Ordinal.opow_lt_opow_iff_right Ordinal.one_lt_omega0).mpr + simpa only [cantorBendixsonRank_eq] using hc hmem hne + · rw [if_neg hmem] + exact Ordinal.opow_pos _ Ordinal.omega0_pos + +variable [Nontrivial G] + +/-- Bounds at translated cutoffs of an exact lower rank reconstruct the ordinary rank sum at zero. +Only an eventual left-neighborhood bound is required; no product formula is assumed. -/ +@[blueprint "lem:cantor-bendixson-rank-reconstruction" + (phase := "Cantor–Bendixson ranks of supports") + (title := "Reconstruction from translated truncations of fixed rank") + (statement := /-- + Let $R$ be an additive monoid, let $G$ be a nontrivial ordered + topological abelian group with its order topology, and let + $b,d\in R((G))$. Suppose + $\operatorname{supp}(b)\subseteq G^{\le0}$. + Let $a,c,r$ be ordinals with $r>0$ and + \[ + V_{\mathrm{CB}}(b)=\omega^{a+r}. + \] + Suppose that, for every $\gamma<0$ sufficiently close to $0$, + \[ + V_{\mathrm{CB}}(b^{\vert\gamma})=\omega^a + \quad\Longrightarrow\quad + V_{\mathrm{CB}}(d^{\vert\gamma})\ge\omega^c. + \] + Then + \[ + V_{\mathrm{CB}}(d)\ge\omega^{c+r}. + \] + -/) + (proof := /-- + By \ref{def:cantor-bendixson-value}, the hypothesis on $b$ says that $0$ + has Cantor--Bendixson rank $a+r$ in its closed support. At every nearby + point of exact rank $a$, the translated-truncation hypothesis places that + point in the $c$-th derivative of the closed support of $d$. + Cantor--Bendixson + reconstruction therefore places $0$ in its $(c+r)$-th derivative, which + is the stated value bound. + -/)] +theorem cantorBendixsonValue_reconstruction (b d : HahnSeries G R) (hb : b.support ⊆ Iic 0) + (a c r : Ordinal.{u}) (hr : 0 < r) + (hbv : b.cantorBendixsonValue = Ordinal.omega0 ^ (a + r)) + (hlevel : ∀ᶠ γ in 𝓝[<] (0 : G), + (translate (-γ) (truncLE γ b)).cantorBendixsonValue = Ordinal.omega0 ^ a → + Ordinal.omega0 ^ c ≤ (translate (-γ) (truncLE γ d)).cantorBendixsonValue) : + Ordinal.omega0 ^ (c + r) ≤ d.cantorBendixsonValue := by + classical + have hb0 : 0 ∈ closure b.support := by + by_contra h + rw [b.cantorBendixsonValue_of_notMem h] at hbv + exact (Ordinal.opow_ne_zero _ Ordinal.omega0_ne_zero) hbv.symm + have hbr : b.cantorBendixsonRank 0 = a + r := by + rw [b.cantorBendixsonValue_of_mem hb0] at hbv + exact (Ordinal.opow_right_inj Ordinal.one_lt_omega0).mp hbv + obtain ⟨l, hl, hlevel⟩ := eventually_nhdsLT_iff_exists.mp hlevel + obtain ⟨hd0, hdr⟩ := b.cantorBendixsonRank_reconstruction d isOpen_Ioi hl a c r hb0 + (le_of_eq hbr.symm) (by + intro y hy hys hyr + have hy0 : y ≤ 0 := closure_minimal hb isClosed_Iic hys + have hyne : y ≠ 0 := by + intro he + subst y + rw [hbr] at hyr + exact (ne_of_gt (lt_add_of_pos_right _ hr)) hyr + have hylt : y < 0 := lt_of_le_of_ne hy0 hyne + have hval : (translate (-y) (truncLE y b)).cantorBendixsonValue = + Ordinal.omega0 ^ a := by + rw [b.cantorBendixsonValue_translated_truncLE, if_pos ((b.mem_closedSupport y).mpr hys), + hyr] + have h := hlevel y hy hylt hval + rw [d.cantorBendixsonValue_translated_truncLE] at h + by_cases hym : y ∈ d.closedSupport + · rw [if_pos hym] at h + exact ⟨(d.mem_closedSupport y).mp hym, + (Ordinal.opow_le_opow_iff_right Ordinal.one_lt_omega0).mp h⟩ + · rw [if_neg hym] at h + exact ((Ordinal.opow_pos _ Ordinal.omega0_pos).not_ge h).elim) + rw [d.cantorBendixsonValue_of_mem hd0] + exact Ordinal.opow_le_opow_right Ordinal.omega0_pos hdr + +end Translation + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationExpansion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationExpansion.lean new file mode 100644 index 0000000000..5589dc25b5 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationExpansion.lean @@ -0,0 +1,633 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationPolynomial +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.TermDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# The translated-truncation Leibniz expansion in representing polynomials + +The finite closed-support convolution formula expands a proper translated truncation of a +monomial in series representatives satisfying the assigned degree and proper-truncation bounds. +Its two boundary terms +give the usual first-order Leibniz sum; every interior term contains at least two proper +truncations. This file records the resulting polynomial identity and tracks the weight of every +remainder monomial by `TermDegree`. +-/ + +universe u v w + +open scoped NatOrdinal Topology + +open MvPolynomial HahnSeries + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [Field K] [CharZero K] + +local notation "ν" => (cantorBendixsonDegreeValuation (G := G) (R := K)) + +variable {ι : Type w} {wt : ι → NatOrdinal.{u}} + {xg : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded} + +namespace LiftFamily + +variable (σ : LiftFamily wt xg) +variable (hx : OrdinalGraded.IsMinimalSystem + (DirectSum.rangeLof K (cantorBendixsonDegreeValuation (G := G) (R := K)).Component) wt xg) + +/-- Every monomial of a polynomial has weight strictly below the given ordinal. -/ +def DegreeLT (wt : ι → NatOrdinal.{u}) (P : MvPolynomial ι K) (α : NatOrdinal.{u}) : Prop := + ∀ d ∈ P.support, Finsupp.weight wt d < α + +omit [CharZero K] in +theorem degreeLT_iff {P : MvPolynomial ι K} {α : NatOrdinal.{u}} : + DegreeLT wt P α ↔ ∀ d ∈ P.support, Finsupp.weight wt d < α := + Iff.rfl + +variable (wt) in +/-- A polynomial remainder for a monomial: every monomial has the degree of an expansion term +with at least two truncated factors. -/ +def IsRemainder (d : ι →₀ ℕ) (E : MvPolynomial ι K) : Prop := + ∀ d' ∈ E.support, ∃ k, 2 ≤ k ∧ TermDegree wt d k (Finsupp.weight wt d') + +omit [CharZero K] in +theorem isRemainder_zero (d : ι →₀ ℕ) : + IsRemainder wt d (0 : MvPolynomial ι K) := by + intro d' hd' + rw [MvPolynomial.support_zero] at hd' + exact absurd hd' (Finset.notMem_empty d') + +omit [CharZero K] in +theorem IsRemainder.add {d : ι →₀ ℕ} {E E' : MvPolynomial ι K} + (hE : IsRemainder wt d E) (hE' : IsRemainder wt d E') : + IsRemainder wt d (E + E') := by + classical + intro d' hd' + rcases Finset.mem_union.mp (support_add hd') with h | h + · exact hE d' h + · exact hE' d' h + +omit [CharZero K] in +theorem IsRemainder.sum {κ : Type*} {d : ι →₀ ℕ} (s : Finset κ) + (E : κ → MvPolynomial ι K) (hE : ∀ j ∈ s, IsRemainder wt d (E j)) : + IsRemainder wt d (∑ j ∈ s, E j) := by + classical + induction s using Finset.induction_on with + | empty => + rw [Finset.sum_empty] + exact isRemainder_zero d + | insert a s ha ih => + rw [Finset.sum_insert ha] + exact (hE a (Finset.mem_insert_self a s)).add + (ih fun j hj ↦ hE j (Finset.mem_insert_of_mem hj)) + +/-- Multiplication by an untruncated variable preserves the number of truncated factors. -/ +theorem IsRemainder.mul_X {d : ι →₀ ℕ} {E : MvPolynomial ι K} + (hE : IsRemainder wt d E) (i : ι) : + IsRemainder wt (d + Finsupp.single i 1) (E * X i) := by + classical + intro d' hd' + obtain ⟨d₁, hd₁, d₂, hd₂, hw⟩ := exists_add_eq_weight_of_mem_support_mul (wt := wt) hd' + obtain ⟨k, hk, hT⟩ := hE d₁ hd₁ + rw [X, support_monomial, if_neg one_ne_zero, Finset.mem_singleton] at hd₂ + subst d₂ + rw [Finsupp.weight_single, one_smul] at hw + exact ⟨k, hk, hw ▸ TermDegree.untrunc i hT⟩ + +omit [CharZero K] in +/-- Multiplying an expansion with a truncated factor by another proper truncation produces a +remainder with at least two truncated factors. -/ +theorem isRemainder_mul_of_degreeLT {d : ι →₀ ℕ} {P Q : MvPolynomial ι K} + (hP : ∀ d' ∈ P.support, ∃ k, 1 ≤ k ∧ TermDegree wt d k (Finsupp.weight wt d')) + {i : ι} (hQ : DegreeLT wt Q (wt i)) : + IsRemainder wt (d + Finsupp.single i 1) (P * Q) := by + classical + intro d' hd' + obtain ⟨d₁, hd₁, d₂, hd₂, hw⟩ := exists_add_eq_weight_of_mem_support_mul (wt := wt) hd' + obtain ⟨k, hk, hT⟩ := hP d₁ hd₁ + exact ⟨k + 1, by omega, + hw ▸ TermDegree.trunc i ((degreeLT_iff).mp hQ d₂ hd₂) hT⟩ + +omit [CharZero K] in +/-- The first-order expansion terms of a monomial have exactly one designated truncated factor. -/ +theorem forall_termDegree_sum_mul_pderiv_monomial (d : ι →₀ ℕ) + (T : ι → MvPolynomial ι K) (hT : ∀ j ∈ d.support, DegreeLT wt (T j) (wt j)) : + ∀ d' ∈ (∑ j ∈ d.support, T j * pderiv j (monomial d (1 : K))).support, + ∃ k, 1 ≤ k ∧ TermDegree wt d k (Finsupp.weight wt d') := by + classical + intro d' hd' + obtain ⟨j, hj, hd'j⟩ := Finset.mem_biUnion.mp (support_sum hd') + obtain ⟨d₁, hd₁, d₂, hd₂, hw⟩ := exists_add_eq_weight_of_mem_support_mul (wt := wt) hd'j + rw [pderiv_monomial, support_monomial] at hd₂ + split_ifs at hd₂ with hzero + · exact absurd hd₂ (Finset.notMem_empty d₂) + · rw [Finset.mem_singleton] at hd₂ + subst d₂ + have hdj : d - Finsupp.single j 1 + Finsupp.single j 1 = d := + Finsupp.sub_add_single_one_cancel (Finsupp.mem_support_iff.mp hj) + refine ⟨1, le_rfl, ?_⟩ + have hterm := TermDegree.trunc_left j ((degreeLT_iff).mp (hT j hj) d₁ hd₁) + (termDegree_weight wt (d - Finsupp.single j 1)) + rw [add_comm (Finsupp.single j 1), hdj] at hterm + rwa [← hw] + +omit [CharZero K] in +/-- Splitting one variable from a monomial. -/ +theorem monomial_add_single_one (d : ι →₀ ℕ) (i : ι) : + monomial (d + Finsupp.single i 1) (1 : K) = monomial d 1 * X i := by + rw [X, monomial_mul, mul_one] + +omit [CharZero K] in +/-- The first-order Leibniz sum after splitting one variable from a monomial. -/ +theorem sum_mul_pderiv_monomial_add_single (d : ι →₀ ℕ) (i : ι) + (T : ι → MvPolynomial ι K) : + ∑ j ∈ (d + Finsupp.single i 1).support, + T j * pderiv j (monomial (d + Finsupp.single i 1) 1) = + (∑ j ∈ d.support, T j * pderiv j (monomial d (1 : K))) * X i + + T i * monomial d 1 := by + classical + have hmem : i ∈ (d + Finsupp.single i 1).support := by + rw [Finsupp.mem_support_iff, Finsupp.add_apply, Finsupp.single_eq_same] + omega + have hsub : d.support ⊆ (d + Finsupp.single i 1).support := fun j hj ↦ by + rw [Finsupp.mem_support_iff] at hj ⊢ + rw [Finsupp.add_apply] + omega + simp only [monomial_add_single_one, pderiv_mul, mul_add, Finset.sum_add_distrib] + congr 1 + · rw [Finset.sum_mul, ← Finset.sum_subset hsub] + · exact Finset.sum_congr rfl fun j _ ↦ by ring + · intro j _ hj + rw [pderiv_monomial, Finsupp.notMem_support_iff.mp hj, Nat.cast_zero, mul_zero, + monomial_zero, zero_mul, mul_zero] + · rw [Finset.sum_eq_single i] + · rw [pderiv_X_self, mul_one] + · intro j _ hji + rw [pderiv_X_of_ne (Ne.symm hji), mul_zero, mul_zero] + · intro h + exact absurd hmem h + +omit [CharZero K] in +/-- Split a finite sum at two distinct members. -/ +private theorem sum_eq_add_add_sum_erase {κ : Type*} [DecidableEq κ] + {S : Finset κ} {a b : κ} (ha : a ∈ S) (hb : b ∈ S) (hne : b ≠ a) + (f : κ → MvPolynomial ι K) : + ∑ q ∈ S, f q = f a + f b + ∑ q ∈ (S.erase a).erase b, f q := by + rw [add_assoc, Finset.add_sum_erase _ _ (Finset.mem_erase.mpr ⟨hne, hb⟩), + Finset.add_sum_erase _ _ ha] + +include hx in +/-- The translated-truncation Leibniz expansion for a monomial. At every negative cutoff, the +representing polynomial of a translated truncation is its first-order Leibniz sum plus a +remainder whose monomials contain at least two truncated factors. -/ +theorem exists_pol_translatedTruncLE_aeval_monomial + (hσ : HasLowerTruncationDegrees σ) {α : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + (d : ι →₀ ℕ) (hd : Finsupp.weight wt d ≤ α) + (hvars : ∀ i ∈ d.support, wt i < α) {γ : G} (hγ : γ < 0) : + ∃ E : MvPolynomial ι K, IsRemainder wt d E ∧ + σ.pol hx α (translatedTruncLE γ (aeval σ.lift (monomial d (1 : K)))) = + ∑ j ∈ d.support, σ.pol hx α (translatedTruncLE γ (σ.lift j)) * + pderiv j (monomial d 1) + E := by + classical + suffices h : ∀ n : ℕ, ∀ d : ι →₀ ℕ, Finsupp.degree d = n → + Finsupp.weight wt d ≤ α → (∀ i ∈ d.support, wt i < α) → + ∀ {γ : G}, γ < 0 → + ∃ E : MvPolynomial ι K, IsRemainder wt d E ∧ + σ.pol hx α (translatedTruncLE γ (aeval σ.lift (monomial d (1 : K)))) = + ∑ j ∈ d.support, σ.pol hx α (translatedTruncLE γ (σ.lift j)) * + pderiv j (monomial d 1) + E by + exact h _ d rfl hd hvars hγ + intro n + induction n using Nat.strong_induction_on with + | _ n ih => + intro d hdn hd hvars γ hγ + rcases eq_or_ne d 0 with rfl | hd0 + · refine ⟨0, isRemainder_zero 0, ?_⟩ + have htr : translatedTruncLE γ (1 : Nonpositive G K) = 0 := + FreeOfVariable.translatedTruncLE_one hγ + have hone : aeval σ.lift (monomial (0 : ι →₀ ℕ) (1 : K)) = + (1 : Nonpositive G K) := by simp + rw [hone, htr, σ.pol_eq_zero_of_degree_eq_bot hx (by rw [(ν).map_zero]), + Finsupp.support_zero, Finset.sum_empty, add_zero] + · obtain ⟨i, hi⟩ := Finsupp.support_nonempty_iff.mpr hd0 + set d' := d - Finsupp.single i 1 with hd'def + have hdd' : d' + Finsupp.single i 1 = d := + Finsupp.sub_add_single_one_cancel (Finsupp.mem_support_iff.mp hi) + have hwd : Finsupp.weight wt d' + wt i = Finsupp.weight wt d := by + rw [← hdd', map_add, Finsupp.weight_single, one_smul] + have hdeg : Finsupp.degree d' < n := by + rw [← hdn, ← hdd', map_add, Finsupp.degree_single] + omega + have hwi : wt i < α := hvars i hi + have hwd'α : Finsupp.weight wt d' < α := by + have hlt : Finsupp.weight wt d' < Finsupp.weight wt d' + wt i := + lt_add_of_pos_right _ (pos_iff_ne_zero.mpr (hx.ne_zero i)) + exact hlt.trans_le (hwd ▸ hd) + have hsub : d'.support ⊆ d.support := by + rw [hd'def] + exact Finsupp.support_tsub + have ih' : ∀ {y : G}, y < 0 → + ∃ E : MvPolynomial ι K, IsRemainder wt d' E ∧ + σ.pol hx α (translatedTruncLE y (aeval σ.lift (monomial d' (1 : K)))) = + ∑ j ∈ d'.support, σ.pol hx α (translatedTruncLE y (σ.lift j)) * + pderiv j (monomial d' 1) + E := + ih _ hdeg d' rfl hwd'α.le (fun j hj ↦ hvars j (hsub hj)) + set a : Nonpositive G K := aeval σ.lift (monomial d' (1 : K)) with hadef + have ha : HasLowerTruncationDegree a (Finsupp.weight wt d') := by + rw [hadef] + exact σ.hasLowerTruncationDegree_aeval hσ + (isWeightedHomogeneous_monomial wt d' 1 rfl) + have hb : HasLowerTruncationDegree (σ.lift i) (wt i) := + (hasLowerTruncationDegrees_iff σ).mp hσ i + have hconv := σ.pol_translatedTruncLE_mul_boundary hx hinj ha hb hwd'α hwi + (hwd ▸ hd) hγ + set S := insert (0, γ) (insert (γ, 0) + ((a : HahnSeries G K).closedSupportAddFiber (σ.lift i : HahnSeries G K) γ)) with hS + set f : G × G → MvPolynomial ι K := fun q ↦ + σ.pol hx α (translatedTruncLE q.1 a) * + σ.pol hx α (translatedTruncLE q.2 (σ.lift i)) with hf + have h0S : (0, γ) ∈ S := Finset.mem_insert_self _ _ + have hγS : (γ, 0) ∈ S := Finset.mem_insert_of_mem (Finset.mem_insert_self _ _) + have hne : (γ, 0) ≠ (0, γ) := fun h ↦ hγ.ne (congrArg Prod.fst h) + have hsplit : ∑ q ∈ S, f q = f (0, γ) + f (γ, 0) + + ∑ q ∈ (S.erase (0, γ)).erase (γ, 0), f q := + sum_eq_add_add_sum_erase h0S hγS hne f + have hf0 : f (0, γ) = monomial d' 1 * + σ.pol hx α (translatedTruncLE γ (σ.lift i)) := by + change σ.pol hx α (translatedTruncLE 0 a) * + σ.pol hx α (translatedTruncLE γ (σ.lift i)) = _ + rw [translatedTruncLE_zero, hadef, + σ.pol_aeval hx hinj (fun e he ↦ by + rw [support_monomial, if_neg one_ne_zero, Finset.mem_singleton] at he + rwa [he])] + have hfγ : f (γ, 0) = + σ.pol hx α (translatedTruncLE γ a) * X i := by + change σ.pol hx α (translatedTruncLE γ a) * + σ.pol hx α (translatedTruncLE 0 (σ.lift i)) = _ + rw [translatedTruncLE_zero, σ.pol_lift hx hinj hwi] + have hinterior : ∀ q ∈ (S.erase (0, γ)).erase (γ, 0), + q.1 < 0 ∧ q.2 < 0 := by + intro q hq + have hqneγ : q ≠ (γ, 0) := (Finset.mem_erase.mp hq).1 + have hqne0 : q ≠ (0, γ) := + (Finset.mem_erase.mp (Finset.mem_erase.mp hq).2).1 + have hqmemS : q ∈ S := (Finset.mem_erase.mp (Finset.mem_erase.mp hq).2).2 + have hqmem : q ∈ (a : HahnSeries G K).closedSupportAddFiber + (σ.lift i : HahnSeries G K) γ := by + rw [hS] at hqmemS + rcases Finset.mem_insert.mp hqmemS with hqeq | hqmemS + · exact (hqne0 hqeq).elim + rcases Finset.mem_insert.mp hqmemS with hqeq | hqmemS + · exact (hqneγ hqeq).elim + · exact hqmemS + obtain ⟨hq1mem, hq2mem, hsum⟩ := + ((a : HahnSeries G K).mem_closedSupportAddFiber + (σ.lift i : HahnSeries G K) γ q).mp hqmem + have hq1le : q.1 ≤ 0 := closure_minimal a.property isClosed_Iic + ((mem_closedSupport _ _).mp hq1mem) + have hq2le : q.2 ≤ 0 := closure_minimal (σ.lift i).property isClosed_Iic + ((mem_closedSupport _ _).mp hq2mem) + have hq1ne : q.1 ≠ 0 := fun hq10 ↦ hqne0 (Prod.ext hq10 (by + simpa [hq10] using hsum)) + have hq2ne : q.2 ≠ 0 := fun hq20 ↦ hqneγ (Prod.ext (by + simpa [hq20] using hsum) hq20) + exact ⟨lt_of_le_of_ne hq1le hq1ne, lt_of_le_of_ne hq2le hq2ne⟩ + choose Eq hEqrem hEq using fun q (hq : q ∈ (S.erase (0, γ)).erase (γ, 0)) ↦ + ih' (hinterior q hq).1 + set R : MvPolynomial ι K := ∑ q ∈ (S.erase (0, γ)).erase (γ, 0), + f q with hRdef + have hR : IsRemainder wt d R := by + rw [← hdd', hRdef] + refine IsRemainder.sum _ _ fun q hq ↦ ?_ + change IsRemainder wt (d' + Finsupp.single i 1) + (σ.pol hx α (translatedTruncLE q.1 a) * + σ.pol hx α (translatedTruncLE q.2 (σ.lift i))) + rw [hEq q hq] + have hleft : IsRemainder (K := K) wt (d' + Finsupp.single i 1) + ((∑ j ∈ d'.support, σ.pol hx α (translatedTruncLE q.1 (σ.lift j)) * + pderiv j (monomial d' 1)) * + σ.pol hx α (translatedTruncLE q.2 (σ.lift i))) := by + exact isRemainder_mul_of_degreeLT (wt := wt) + (forall_termDegree_sum_mul_pderiv_monomial (wt := wt) d' _ fun j hj ↦ + fun e he ↦ σ.pol_weight_lt_of_degree_lt hx (hvars j (hsub hj)).le + (((hasLowerTruncationDegrees_iff σ).mp hσ j).degree_translatedTruncLE_lt + (hinterior q hq).1) e he) + (fun e he ↦ σ.pol_weight_lt_of_degree_lt hx hwi.le + (hb.degree_translatedTruncLE_lt (hinterior q hq).2) e he) + have hright : IsRemainder (K := K) wt (d' + Finsupp.single i 1) + (Eq q hq * σ.pol hx α (translatedTruncLE q.2 (σ.lift i))) := by + exact isRemainder_mul_of_degreeLT (wt := wt) + (fun e he ↦ by + obtain ⟨k, hk, hterm⟩ := hEqrem q hq e he + exact ⟨k, by omega, hterm⟩) + (fun e he ↦ σ.pol_weight_lt_of_degree_lt hx hwi.le + (hb.degree_translatedTruncLE_lt (hinterior q hq).2) e he) + rw [add_mul] + exact hleft.add hright + obtain ⟨E', hE', hEq'⟩ := ih' hγ + refine ⟨E' * X i + R, (hdd' ▸ hE'.mul_X i).add hR, ?_⟩ + have hprod : a * σ.lift i = aeval σ.lift (monomial d (1 : K)) := by + rw [hadef, ← hdd', monomial_add_single_one, map_mul, aeval_X] + rw [← hprod, hconv, hsplit, hf0, hfγ, hEq', ← hdd', + sum_mul_pderiv_monomial_add_single, hRdef] + ring + +include hx in +/-- The translated-truncation Leibniz expansion for a polynomial. At every negative cutoff, the +representing polynomial of a translated truncation is its first-order Leibniz sum plus a +remainder coming from at least two truncated factors of a monomial of the original polynomial. -/ +theorem exists_pol_translatedTruncLE_aeval + (hσ : HasLowerTruncationDegrees σ) {α : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + (H : MvPolynomial ι K) (hH : ∀ d ∈ H.support, Finsupp.weight wt d ≤ α) + (hvars : ∀ i ∈ H.vars, wt i < α) {γ : G} (hγ : γ < 0) : + ∃ E : MvPolynomial ι K, + (∀ d' ∈ E.support, ∃ d ∈ H.support, ∃ k, 2 ≤ k ∧ + TermDegree wt d k (Finsupp.weight wt d')) ∧ + σ.pol hx α (translatedTruncLE γ (aeval σ.lift H)) = + ∑ j ∈ H.vars, σ.pol hx α (translatedTruncLE γ (σ.lift j)) * pderiv j H + E := by + classical + have hmono : ∀ d ∈ H.support, + ∃ E : MvPolynomial ι K, IsRemainder wt d E ∧ + σ.pol hx α (translatedTruncLE γ (aeval σ.lift (monomial d (1 : K)))) = + ∑ j ∈ d.support, σ.pol hx α (translatedTruncLE γ (σ.lift j)) * + pderiv j (monomial d 1) + E := fun d hd ↦ + σ.exists_pol_translatedTruncLE_aeval_monomial hx hσ hinj d (hH d hd) + (fun i hi ↦ hvars i ((mem_vars_iff_mem_support i).mpr ⟨d, hd, hi⟩)) hγ + choose E hE hEq using hmono + have hmonomialBounds : ∀ d ∈ H.support, + HasLowerTruncationDegree (aeval σ.lift (monomial d (1 : K))) (Finsupp.weight wt d) := + fun d _ ↦ σ.hasLowerTruncationDegree_aeval hσ (isWeightedHomogeneous_monomial wt d 1 rfl) + have hdegree : ∀ d ∈ H.support, + ν (translatedTruncLE γ (aeval σ.lift (monomial d (1 : K)))) < + (α : WithBot NatOrdinal) := fun d hd ↦ + (hmonomialBounds d hd).degree_translatedTruncLE_lt hγ |>.trans_le + (WithBot.coe_le_coe.mpr (hH d hd)) + refine ⟨∑ d ∈ H.support.attach, MvPolynomial.C (MvPolynomial.coeff d.1 H) * E d.1 d.2, + ?_, ?_⟩ + · intro d' hd' + obtain ⟨d, _, hd'd⟩ := Finset.mem_biUnion.mp (support_sum hd') + have hd'E : d' ∈ (E d.1 d.2).support := by + rw [C_mul'] at hd'd + exact support_smul hd'd + obtain ⟨k, hk, hterm⟩ := hE d.1 d.2 d' hd'E + exact ⟨d.1, d.2, k, hk, hterm⟩ + have hmonomial : ∀ d, monomial d (MvPolynomial.coeff d H) = + MvPolynomial.C (MvPolynomial.coeff d H) * monomial d (1 : K) := fun d ↦ by + rw [C_mul_monomial, mul_one] + have hleft : σ.pol hx α (translatedTruncLE γ (aeval σ.lift H)) = + ∑ d ∈ H.support.attach, + MvPolynomial.C (MvPolynomial.coeff d.1 H) * + σ.pol hx α (translatedTruncLE γ (aeval σ.lift (monomial d.1 (1 : K)))) := by + conv_lhs => rw [H.as_sum] + rw [map_sum, map_sum, ← Finset.sum_attach H.support] + have hterm : ∀ d ∈ H.support.attach, + translatedTruncLE γ (aeval σ.lift + (monomial d.1 (MvPolynomial.coeff d.1 H))) = + MvPolynomial.coeff d.1 H • translatedTruncLE γ + (aeval σ.lift (monomial d.1 (1 : K))) := by + intro d _ + rw [hmonomial, map_mul, aeval_C, ← Algebra.smul_def, translatedTruncLE_smul] + rw [Finset.sum_congr rfl hterm, + σ.pol_sum hx hinj _ _ (fun d hd ↦ by + exact (degree_smul_le _ _).trans_lt (hdegree d.1 d.2))] + refine Finset.sum_congr rfl fun d _ ↦ ?_ + rw [σ.pol_smul hx hinj _ (hdegree d.1 d.2), C_mul'] + rw [hleft] + have hsub : ∀ d ∈ H.support, d.support ⊆ H.vars := fun d hd j hj ↦ + (mem_vars_iff_mem_support j).mpr ⟨d, hd, hj⟩ + have hsupp : ∀ d : ι →₀ ℕ, ∀ j, j ∉ d.support → + pderiv j (monomial d (1 : K)) = 0 := fun d j hj ↦ by + rw [pderiv_monomial, Finsupp.notMem_support_iff.mp hj, Nat.cast_zero, mul_zero, + monomial_zero] + have hpd : ∀ j, pderiv j H = + ∑ d ∈ H.support.attach, MvPolynomial.C (MvPolynomial.coeff d.1 H) * + pderiv j (monomial d.1 1) := fun j ↦ by + conv_lhs => rw [H.as_sum, map_sum, ← Finset.sum_attach H.support] + exact Finset.sum_congr rfl fun d _ ↦ by rw [hmonomial, pderiv_C_mul] + rw [Finset.sum_congr rfl (fun d _ ↦ congrArg + (MvPolynomial.C (MvPolynomial.coeff d.1 H) * ·) (hEq d.1 d.2))] + simp only [mul_add, Finset.sum_add_distrib] + congr 1 + simp only [hpd, Finset.mul_sum] + rw [Finset.sum_comm] + refine Finset.sum_congr rfl fun d _ ↦ ?_ + have heq : ∑ j ∈ d.1.support, + σ.pol hx α (translatedTruncLE γ (σ.lift j)) * pderiv j (monomial d.1 1) = + ∑ j ∈ H.vars, + σ.pol hx α (translatedTruncLE γ (σ.lift j)) * pderiv j (monomial d.1 1) := + Finset.sum_subset (hsub d.1 d.2) fun j _ hj ↦ by + rw [hsupp d.1 j hj, mul_zero] + rw [← Finset.mul_sum] + conv_lhs => rw [heq] + rw [Finset.mul_sum] + exact Finset.sum_congr rfl fun j _ ↦ by + exact mul_left_comm + (MvPolynomial.C (MvPolynomial.coeff d.1 H)) + (σ.pol hx α (translatedTruncLE γ (σ.lift j))) _ + +include hx in +/-- The differentiated translated-truncation Leibniz expansion. Differentiating the expansion of `F` +and comparing it with the expansion of `∂F/∂X_v` expresses the latter using the partials of `F` +and two `TermDegree`-controlled remainders. -/ +theorem exists_pol_translatedTruncLE_aeval_pderiv + (hσ : HasLowerTruncationDegrees σ) {α : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + (F : MvPolynomial ι K) (hF : ∀ d ∈ F.support, Finsupp.weight wt d ≤ α) + (hvars : ∀ i ∈ F.vars, wt i < α) (v : ι) {γ : G} (hγ : γ < 0) : + ∃ E E' : MvPolynomial ι K, + (∀ d' ∈ E.support, ∃ d ∈ F.support, ∃ k, 2 ≤ k ∧ + TermDegree wt d k (Finsupp.weight wt d')) ∧ + (∀ d' ∈ E'.support, ∃ d ∈ (pderiv v F).support, ∃ k, 2 ≤ k ∧ + TermDegree wt d k (Finsupp.weight wt d')) ∧ + σ.pol hx α (translatedTruncLE γ (aeval σ.lift (pderiv v F))) = + pderiv v (σ.pol hx α (translatedTruncLE γ (aeval σ.lift F))) - + ∑ j ∈ F.vars, + pderiv v (σ.pol hx α (translatedTruncLE γ (σ.lift j))) * pderiv j F - + pderiv v E + E' := by + classical + have hΘ : ∀ d ∈ (pderiv v F).support, Finsupp.weight wt d ≤ α := fun d' hd' ↦ by + obtain ⟨d, hd, hw⟩ := exists_add_eq_weight_of_mem_support_pderiv wt hd' + exact (NatOrdinal.le_add_right.trans hw.le).trans (hF d hd) + have hvarsΘ : ∀ i ∈ (pderiv v F).vars, wt i < α := + fun i hi ↦ hvars i (vars_pderiv_subset v F hi) + obtain ⟨E, hE, hexpF⟩ := + σ.exists_pol_translatedTruncLE_aeval hx hσ hinj F hF hvars hγ + obtain ⟨E', hE', hexpΘ⟩ := + σ.exists_pol_translatedTruncLE_aeval hx hσ hinj (pderiv v F) hΘ hvarsΘ hγ + refine ⟨E, E', hE, hE', ?_⟩ + set T : ι → MvPolynomial ι K := fun j ↦ + σ.pol hx α (translatedTruncLE γ (σ.lift j)) with hTdef + have hdF : pderiv v (σ.pol hx α (translatedTruncLE γ (aeval σ.lift F))) = + ∑ j ∈ F.vars, pderiv v (T j) * pderiv j F + + ∑ j ∈ F.vars, T j * pderiv j (pderiv v F) + pderiv v E := by + rw [hexpF, map_add, map_sum, ← Finset.sum_add_distrib] + congr 1 + exact Finset.sum_congr rfl fun j _ ↦ by rw [pderiv_mul, pderiv_pderiv_comm] + have hexpΘ' : σ.pol hx α (translatedTruncLE γ (aeval σ.lift (pderiv v F))) = + ∑ j ∈ F.vars, T j * pderiv j (pderiv v F) + E' := by + rw [hexpΘ] + congr 1 + exact Finset.sum_subset (vars_pderiv_subset v F) fun j _ hj ↦ by + rw [pderiv_eq_zero_of_notMem_vars hj, mul_zero] + rw [hexpΘ', hdF] + ring + +omit [CharZero K] in +/-- A monomial of a partial derivative regains a monomial of the original polynomial after +restoring the differentiated variable. -/ +theorem add_single_mem_support_of_mem_support_pderiv {i : ι} + {P : MvPolynomial ι K} {d' : ι →₀ ℕ} (hd' : d' ∈ (pderiv i P).support) : + d' + Finsupp.single i 1 ∈ P.support := by + obtain ⟨d, hd, hdi, rfl⟩ := exists_mem_support_of_mem_support_pderiv hd' + rwa [tsub_add_cancel_of_le + (Finsupp.single_le_iff.mpr (Nat.one_le_iff_ne_zero.mpr hdi))] + +omit [CharZero K] in +/-- A polynomial whose monomials have degree below `g ≤ wt v` has zero derivative at `v`. -/ +theorem pderiv_eq_zero_of_degreeLT_le {P : MvPolynomial ι K} {g : NatOrdinal.{u}} + (hP : DegreeLT wt P g) {v : ι} (hg : g ≤ wt v) : pderiv v P = 0 := by + by_contra h + obtain ⟨d', hd'⟩ := support_nonempty.mpr h + have hmem := add_single_mem_support_of_mem_support_pderiv hd' + have hlt := hP _ hmem + rw [map_add, Finsupp.weight_single, one_smul] at hlt + have hle : wt v ≤ Finsupp.weight wt d' + wt v := by + rw [add_comm] + exact NatOrdinal.le_add_right + exact absurd (hg.trans hle) (not_le.mpr hlt) + +include hx in +/-- **Local ideal membership for a truncated partial derivative.** If the represented +translated truncation of `F` and all two-truncation remainder terms lie below `α''`, then above +any `τ` with `α'' ≤ τ + wt v'`, the truncated partial derivative lies in the ideal generated by +partials at variables of strictly larger weight. -/ +@[blueprint "lem:local-jacobian-ideal-membership" + (phase := "Algebraic independence in graded rings") + (title := "Local Jacobian ideal membership for translated partial derivatives") + (statement := /-- + Let $F$ be weighted homogeneous of degree $\alpha$, evaluated at series + $b_i$ representing a minimal homogeneous generating system of weights + $w_i$. Assume + \[ + \deg(b_i)\le w_i, + \qquad \deg(b_i^{\vert y}) (cantorBendixsonDegreeValuation (G := G) (R := K)) + +variable {ι : Type w} {wt : ι → NatOrdinal.{u}} + {xg : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded} + +namespace LiftFamily + +variable (σ : LiftFamily wt xg) +variable (hx : OrdinalGraded.IsMinimalSystem + (DirectSum.rangeLof K (cantorBendixsonDegreeValuation (G := G) (R := K)).Component) wt xg) + +include hx in +/-- A series of degree below `α` has a polynomial representative modulo series bounded away from +zero, with every monomial weight bounded by the degree of the series. -/ +theorem exists_polynomial {α : NatOrdinal.{u}} (u : Nonpositive G K) + (hu : ν u < (α : WithBot NatOrdinal)) : + ∃ F : MvPolynomial ι K, + (∀ d ∈ F.support, (((Finsupp.weight wt) d : NatOrdinal) : WithBot NatOrdinal) ≤ ν u) ∧ + (∀ d ∈ F.support, Finsupp.weight wt d < α) ∧ + ν (u - aeval σ.lift F) = ⊥ := + exists_forall_weight_lt_and_degree_sub_aeval_eq_bot xg σ.represents α + (fun β _ y hy ↦ OrdinalGraded.IsMinimalSystem.exists_aeval_eq hx + cantorBendixson_gradeZeroScalars β y hy) u hu + +/-- The polynomial representing `u` modulo series bounded away from zero, among polynomials with +monomial weights below `α`; it is zero when `u` does not have degree below `α`. -/ +def pol (α : NatOrdinal.{u}) (u : Nonpositive G K) : MvPolynomial ι K := by + by_cases hu : ν u < (α : WithBot NatOrdinal) + · exact Classical.choose (σ.exists_polynomial hx u hu) + · exact 0 + +include hx in +/-- Every monomial of the chosen polynomial has weight below its cutoff. -/ +theorem pol_weight_lt (α : NatOrdinal.{u}) (u : Nonpositive G K) : + ∀ d ∈ (σ.pol hx α u).support, Finsupp.weight wt d < α := by + classical + unfold pol + split_ifs with hu + · exact (Classical.choose_spec (σ.exists_polynomial hx u hu)).2.1 + · simp + +include hx in +/-- Every monomial weight is bounded by the degree of the represented series. -/ +theorem pol_weight_le_degree {α : NatOrdinal.{u}} {u : Nonpositive G K} + (hu : ν u < (α : WithBot NatOrdinal)) : + ∀ d ∈ (σ.pol hx α u).support, + (((Finsupp.weight wt) d : NatOrdinal) : WithBot NatOrdinal) ≤ ν u := by + classical + unfold pol + rw [dif_pos hu] + exact (Classical.choose_spec (σ.exists_polynomial hx u hu)).1 + +include hx in +/-- The chosen polynomial evaluates to the original series modulo series bounded away from zero. -/ +theorem degree_sub_aeval_pol_eq_bot {α : NatOrdinal.{u}} {u : Nonpositive G K} + (hu : ν u < (α : WithBot NatOrdinal)) : + ν (u - aeval σ.lift (σ.pol hx α u)) = ⊥ := by + classical + unfold pol + rw [dif_pos hu] + exact (Classical.choose_spec (σ.exists_polynomial hx u hu)).2.2 + +include hx in +/-- Below `α`, graded injectivity makes the polynomial representative unique. -/ +theorem pol_eq_of_degree_sub_aeval_eq_bot {α : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + {u : Nonpositive G K} (hu : ν u < (α : WithBot NatOrdinal)) + {F : MvPolynomial ι K} (hF : ∀ d ∈ F.support, Finsupp.weight wt d < α) + (h : ν (u - aeval σ.lift F) = ⊥) : σ.pol hx α u = F := by + classical + rw [← sub_eq_zero] + have hinj' : ∀ β < α, ∀ P : MvPolynomial ι K, + IsWeightedHomogeneous wt P β → aeval xg P = 0 → P = 0 := by + intro β hβα + rw [← OrdinalGraded.injectiveAt_iff] + exact hinj β hβα + apply eq_zero_of_forall_weight_lt_of_degree_aeval_eq_bot xg σ.represents + (fun β P hβα hP hP0 ↦ hinj' β hβα P hP hP0) (fun d hd ↦ by + have hdne : MvPolynomial.coeff d (σ.pol hx α u - F) ≠ 0 := mem_support_iff.mp hd + rw [MvPolynomial.coeff_sub ι] at hdne + by_cases hdpol : d ∈ (σ.pol hx α u).support + · exact σ.pol_weight_lt hx α u d hdpol + · have hdpol0 := notMem_support_iff.mp hdpol + rw [hdpol0, zero_sub, neg_ne_zero] at hdne + exact hF d (mem_support_iff.mpr hdne)) + rw [map_sub] + have hpol := σ.degree_sub_aeval_pol_eq_bot hx hu + have hsplit : aeval σ.lift (σ.pol hx α u) - aeval σ.lift F = + -(u - aeval σ.lift (σ.pol hx α u)) + (u - aeval σ.lift F) := by ring + rw [hsplit] + refine le_bot_iff.mp (((ν).map_add_le_max _ _).trans ?_) + rw [(ν).map_neg, hpol, h, max_self] + +include hx in +/-- The polynomial of a series of degree below `α' ≤ α` has every monomial weight below `α'`. -/ +theorem pol_weight_lt_of_degree_lt {α α' : NatOrdinal.{u}} (hα' : α' ≤ α) + {u : Nonpositive G K} (hu : ν u < (α' : WithBot NatOrdinal)) : + ∀ d ∈ (σ.pol hx α u).support, Finsupp.weight wt d < α' := by + intro d hd + exact WithBot.coe_lt_coe.mp ((σ.pol_weight_le_degree hx + (hu.trans_le (WithBot.coe_le_coe.mpr hα'))) d hd |>.trans_lt hu) + +include hx in +/-- Evaluation of a polynomial of weights below `α` is recovered by `pol`. -/ +theorem pol_aeval {α : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + {F : MvPolynomial ι K} (hF : ∀ d ∈ F.support, Finsupp.weight wt d < α) : + σ.pol hx α (aeval σ.lift F) = F := by + apply σ.pol_eq_of_degree_sub_aeval_eq_bot hx hinj + (σ.degree_aeval_lt hF) hF + rw [sub_self, (ν).map_zero] + +include hx in +/-- `pol` is additive on series below the cutoff. -/ +theorem pol_add {α : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + {u v : Nonpositive G K} (hu : ν u < (α : WithBot NatOrdinal)) + (hv : ν v < (α : WithBot NatOrdinal)) : + σ.pol hx α (u + v) = σ.pol hx α u + σ.pol hx α v := by + have huv : ν (u + v) < (α : WithBot NatOrdinal) := + ((ν).map_add_le_max u v).trans_lt (max_lt hu hv) + apply σ.pol_eq_of_degree_sub_aeval_eq_bot hx hinj huv (fun d hd ↦ by + have hdne : MvPolynomial.coeff d (σ.pol hx α u + σ.pol hx α v) ≠ 0 := + mem_support_iff.mp hd + rw [MvPolynomial.coeff_add] at hdne + by_cases hdu : d ∈ (σ.pol hx α u).support + · exact σ.pol_weight_lt hx α u d hdu + · have hdu0 := notMem_support_iff.mp hdu + rw [hdu0, zero_add] at hdne + exact σ.pol_weight_lt hx α v d (mem_support_iff.mpr hdne)) + have hu' := σ.degree_sub_aeval_pol_eq_bot hx hu + have hv' := σ.degree_sub_aeval_pol_eq_bot hx hv + rw [map_add] + have hsplit : u + v - (aeval σ.lift (σ.pol hx α u) + + aeval σ.lift (σ.pol hx α v)) = + (u - aeval σ.lift (σ.pol hx α u)) + + (v - aeval σ.lift (σ.pol hx α v)) := by ring + rw [hsplit] + refine le_bot_iff.mp (((ν).map_add_le_max _ _).trans ?_) + rw [hu', hv', max_self] + +include hx in +/-- `pol` commutes with finite sums of series below the cutoff. -/ +theorem pol_sum {α : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + {κ : Type*} (s : Finset κ) (f : κ → Nonpositive G K) + (h : ∀ i ∈ s, ν (f i) < (α : WithBot NatOrdinal)) : + σ.pol hx α (∑ i ∈ s, f i) = ∑ i ∈ s, σ.pol hx α (f i) := by + classical + induction s using Finset.induction_on with + | empty => + rw [Finset.sum_empty, Finset.sum_empty] + exact σ.pol_aeval hx hinj (F := 0) (by simp) + | @insert a s ha ih => + rw [Finset.sum_insert ha, Finset.sum_insert ha, + σ.pol_add hx hinj (h a (Finset.mem_insert_self a s)) + ((ν).map_sum_lt_of_forall_lt s f (WithBot.bot_lt_coe α) + fun i hi ↦ h i (Finset.mem_insert_of_mem hi)), + ih fun i hi ↦ h i (Finset.mem_insert_of_mem hi)] + +include hx in +/-- `pol` commutes with scalar multiplication on series below the cutoff. -/ +theorem pol_smul {α : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + (k : K) {u : Nonpositive G K} (hu : ν u < (α : WithBot NatOrdinal)) : + σ.pol hx α (k • u) = k • σ.pol hx α u := by + have hku : ν (k • u) < (α : WithBot NatOrdinal) := + (degree_smul_le k u).trans_lt hu + apply σ.pol_eq_of_degree_sub_aeval_eq_bot hx hinj hku + · intro d hd + have hdne : MvPolynomial.coeff d (k • σ.pol hx α u) ≠ 0 := + mem_support_iff.mp hd + rw [MvPolynomial.coeff_smul] at hdne + exact σ.pol_weight_lt hx α u d + (mem_support_iff.mpr fun hzero ↦ hdne (by rw [hzero, smul_zero])) + · rw [map_smul] + have herror := σ.degree_sub_aeval_pol_eq_bot hx hu + have heq : k • u - k • aeval σ.lift (σ.pol hx α u) = + k • (u - aeval σ.lift (σ.pol hx α u)) := by module + rw [heq] + exact le_bot_iff.mp ((degree_smul_le k _).trans_eq herror) + +omit [CharZero K] in +open Classical in +/-- If a polynomial has all monomial weights below `bound`, then a nonzero coefficient of +`X B₀ ^ k` has weight, after restoring that power, below `bound`. -/ +theorem weightedTotalDegree_xCoeff_add_nsmul_lt + {Q : MvPolynomial ι K} {bound : NatOrdinal.{u}} + (hQ : ∀ d ∈ Q.support, Finsupp.weight wt d < bound) + (B₀ : ι) (k : ℕ) (h : xCoeff B₀ k Q ≠ 0) : + weightedTotalDegree wt (xCoeff B₀ k Q) + k • wt B₀ < bound := by + classical + obtain ⟨d, hd, hsup⟩ := Finset.exists_mem_eq_sup _ (support_nonempty.mpr h) + (Finsupp.weight wt) + have hmem : d + Finsupp.single B₀ k ∈ (xCoeff B₀ k Q * X B₀ ^ k).support := by + rw [mem_support_iff, X_pow_eq_monomial, coeff_mul_monomial', if_pos le_add_self, + add_tsub_cancel_right, mul_one] + exact mem_support_iff.mp hd + have hlt := hQ _ (support_xCoeff_mul_X_pow_subset B₀ k Q hmem) + rw [map_add, Finsupp.weight_single] at hlt + rwa [weightedTotalDegree, hsup] + +include hx in +/-- The chosen polynomial of a series of non-bottom degree is nonzero. -/ +theorem pol_ne_zero_of_degree_eq {α ρ : NatOrdinal.{u}} {u : Nonpositive G K} + (hu : ν u = (ρ : WithBot NatOrdinal)) (hρα : ρ < α) : σ.pol hx α u ≠ 0 := by + intro hzero + have hsub := σ.degree_sub_aeval_pol_eq_bot hx (hu.trans_lt (WithBot.coe_lt_coe.mpr hρα)) + rw [hzero, map_zero, sub_zero, hu] at hsub + exact WithBot.coe_ne_bot hsub + +include hx in +/-- A series of bottom degree has zero representing polynomial. -/ +theorem pol_eq_zero_of_degree_eq_bot {α : NatOrdinal.{u}} {u : Nonpositive G K} + (hu : ν u = ⊥) : σ.pol hx α u = 0 := by + classical + unfold pol + rw [dif_pos (by rw [hu]; exact WithBot.bot_lt_coe α)] + have hspec := Classical.choose_spec (σ.exists_polynomial hx u + (by rw [hu]; exact WithBot.bot_lt_coe α)) + apply MvPolynomial.eq_zero_iff.mpr + intro d + by_contra hd + have hdmem := mem_support_iff.mpr hd + exact WithBot.not_coe_le_bot _ ((hspec.1 d hdmem).trans_eq hu) + +include hx in +/-- At exact non-bottom degree `ρ`, the chosen polynomial has weighted total degree `ρ`. -/ +theorem weightedTotalDegree_pol_eq_of_degree_eq {α ρ : NatOrdinal.{u}} + {u : Nonpositive G K} (hu : ν u = (ρ : WithBot NatOrdinal)) (hρα : ρ < α) : + weightedTotalDegree wt (σ.pol hx α u) = ρ := by + have hne := σ.pol_ne_zero_of_degree_eq hx hu hρα + obtain ⟨d, hd, hsup⟩ := Finset.exists_mem_eq_sup _ (support_nonempty.mpr hne) + (Finsupp.weight wt) + have hle : weightedTotalDegree wt (σ.pol hx α u) ≤ ρ := by + rw [weightedTotalDegree, hsup] + exact WithBot.coe_le_coe.mp (σ.pol_weight_le_degree hx + (hu.trans_lt (WithBot.coe_lt_coe.mpr hρα)) d hd |>.trans_eq hu) + refine le_antisymm hle ?_ + by_contra hnot + have hlt : weightedTotalDegree wt (σ.pol hx α u) < ρ := lt_of_not_ge hnot + have heval : ν (aeval σ.lift (σ.pol hx α u)) < (ρ : WithBot NatOrdinal) := + σ.degree_aeval_lt (fun d' hd' ↦ by + exact (le_weightedTotalDegree wt hd').trans_lt hlt) + have hsub := σ.degree_sub_aeval_pol_eq_bot hx + (hu.trans_lt (WithBot.coe_lt_coe.mpr hρα)) + have hdegree := degree_eq_of_degree_sub_eq_bot hsub + rw [hu] at hdegree + exact heval.ne (hdegree.symm) + +include hx in +/-- A fixed upper bound on the chosen polynomials of proper truncations contradicts exact degree +and the approach theorem for Cantor–Bendixson ranks whenever the shifted degree exceeds it. -/ +theorem false_of_forall_weightedTotalDegree_pol_add_lt {α lam sigma bound : NatOrdinal.{u}} + {u : Nonpositive G K} (hu : ν u = (lam : WithBot NatOrdinal)) (hlam : lam ≠ 0) + (hσ : sigma = 0 ∨ NatOrdinal.leastTerm lam ≤ NatOrdinal.leastTerm sigma) + (hbound : bound < lam + sigma) {l : G} (hl : l < 0) + (hwin : ∀ γ : G, l < γ → γ < 0 → σ.pol hx α (translatedTruncLE γ u) ≠ 0 → + weightedTotalDegree wt (σ.pol hx α (translatedTruncLE γ u)) + sigma < bound) + (hlamα : lam < α) : False := by + obtain ⟨ρ, hρlam, hρbound⟩ := + NatOrdinal.exists_lt_le_add_of_lastCantorTerm_le hlam hσ hbound + obtain ⟨γ, hlγ, hγ0, hγeq⟩ := exists_lt_and_degree_translatedTruncLE_eq + u lam ρ hu hρlam hl + have hρα : ρ < α := hρlam.trans hlamα + have hp0 := σ.pol_ne_zero_of_degree_eq hx hγeq hρα + have hdeg := σ.weightedTotalDegree_pol_eq_of_degree_eq hx hγeq hρα + exact absurd (hwin γ hlγ hγ0 hp0) (not_lt.mpr (hdeg ▸ hρbound)) + +include hx in +/-- Multiplication of represented polynomials computes the polynomial of a product when the +product polynomial still has all weights below the cutoff. -/ +theorem pol_mul {α : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + {u v : Nonpositive G K} (hu : ν u < (α : WithBot NatOrdinal)) + (hv : ν v < (α : WithBot NatOrdinal)) + (hprod : ∀ d ∈ (σ.pol hx α u * σ.pol hx α v).support, Finsupp.weight wt d < α) : + ν (u * v) < (α : WithBot NatOrdinal) ∧ + σ.pol hx α (u * v) = σ.pol hx α u * σ.pol hx α v := by + have hcongr := degree_sub_eq_bot_mul + (σ.degree_sub_aeval_pol_eq_bot hx hu) (σ.degree_sub_aeval_pol_eq_bot hx hv) + rw [← map_mul] at hcongr + have heval : ν (aeval σ.lift (σ.pol hx α u * σ.pol hx α v)) < + (α : WithBot NatOrdinal) := σ.degree_aeval_lt hprod + have hdegree : ν (u * v) = ν (aeval σ.lift (σ.pol hx α u * σ.pol hx α v)) := + degree_eq_of_degree_sub_eq_bot hcongr + refine ⟨hdegree ▸ heval, ?_⟩ + exact σ.pol_eq_of_degree_sub_aeval_eq_bot hx hinj (hdegree ▸ heval) hprod hcongr + +include hx in +/-- The finite Cantor–Bendixson convolution formula in the representing polynomial ring. -/ +theorem pol_translatedTruncLE_mul {α m n : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + {a b : Nonpositive G K} (ha : Nonpositive.HasLowerTruncationDegree a m) + (hb : Nonpositive.HasLowerTruncationDegree b n) + (hm : m < α) (hn : n < α) (hmn : m + n ≤ α) {γ : G} (hγ : γ < 0) : + σ.pol hx α (translatedTruncLE γ (a * b)) = + ∑ q ∈ (a : HahnSeries G K).closedSupportAddFiber (b : HahnSeries G K) γ, + σ.pol hx α (translatedTruncLE q.1 a) * σ.pol hx α (translatedTruncLE q.2 b) := by + classical + set S := (a : HahnSeries G K).closedSupportAddFiber (b : HahnSeries G K) γ with hS + have hq : ∀ q ∈ S, q.1 ≤ 0 ∧ q.2 ≤ 0 ∧ (q.1 < 0 ∨ q.2 < 0) := by + intro q hq + obtain ⟨hq1, hq2, hsum⟩ := ((a : HahnSeries G K).mem_closedSupportAddFiber + (b : HahnSeries G K) γ q).mp hq + have hq1le : q.1 ≤ 0 := closure_minimal a.property isClosed_Iic + ((mem_closedSupport _ _).mp hq1) + have hq2le : q.2 ≤ 0 := closure_minimal b.property isClosed_Iic + ((mem_closedSupport _ _).mp hq2) + refine ⟨hq1le, hq2le, ?_⟩ + rcases lt_or_eq_of_le hq1le with hq1neg | hq1zero + · exact Or.inl hq1neg + · right + have : q.2 = γ := by rw [← hsum, hq1zero, zero_add] + exact this ▸ hγ + have hterm : ∀ q ∈ S, ∀ d ∈ + (σ.pol hx α (translatedTruncLE q.1 a) * + σ.pol hx α (translatedTruncLE q.2 b)).support, + Finsupp.weight wt d < α := by + intro q hqS d hd + obtain ⟨d₁, hd₁, d₂, hd₂, rfl⟩ := Finset.mem_add.mp + (MvPolynomial.support_mul _ _ hd) + rw [map_add] + obtain ⟨hq1le, hq2le, hproper⟩ := hq q hqS + rcases hproper with hq1neg | hq2neg + · have h1 := σ.pol_weight_lt_of_degree_lt hx hm.le + (ha.degree_translatedTruncLE_lt hq1neg) d₁ hd₁ + have h2 := σ.pol_weight_le_degree hx + ((ha.degree_translatedTruncLE_lt hq1neg).trans + (WithBot.coe_lt_coe.mpr hm)) d₁ hd₁ + have h2' := σ.pol_weight_le_degree hx + ((hb.degree_translatedTruncLE_le hq2le).trans_lt + (WithBot.coe_lt_coe.mpr hn)) d₂ hd₂ + have h2n : Finsupp.weight wt d₂ ≤ n := + WithBot.coe_le_coe.mp (h2'.trans (hb.degree_translatedTruncLE_le hq2le)) + exact (add_lt_add_of_lt_of_le h1 h2n).trans_le hmn + · have h1m : Finsupp.weight wt d₁ ≤ m := WithBot.coe_le_coe.mp + ((σ.pol_weight_le_degree hx + ((ha.degree_translatedTruncLE_le hq1le).trans_lt + (WithBot.coe_lt_coe.mpr hm)) d₁ hd₁).trans + (ha.degree_translatedTruncLE_le hq1le)) + have h2 := σ.pol_weight_lt_of_degree_lt hx hn.le + (hb.degree_translatedTruncLE_lt hq2neg) d₂ hd₂ + exact (add_lt_add_of_le_of_lt h1m h2).trans_le hmn + have hsumw : ∀ d ∈ (∑ q ∈ S, + σ.pol hx α (translatedTruncLE q.1 a) * + σ.pol hx α (translatedTruncLE q.2 b)).support, + Finsupp.weight wt d < α := by + intro d hd + obtain ⟨q, hqS, hdq⟩ := Finset.mem_biUnion.mp (MvPolynomial.support_sum hd) + exact hterm q hqS d hdq + have hdeg : ν (translatedTruncLE γ (a * b)) < (α : WithBot NatOrdinal) := + ((ha.mul rfl hb).degree_translatedTruncLE_lt hγ).trans_le + (WithBot.coe_le_coe.mpr hmn) + have haall : ∀ q : G, ν (translatedTruncLE q a) < (α : WithBot NatOrdinal) := by + intro q + rcases le_total q 0 with hq | hq + · exact (ha.degree_translatedTruncLE_le hq).trans_lt (WithBot.coe_lt_coe.mpr hm) + · by_cases hq0 : q = 0 + · subst q + rw [translatedTruncLE_zero] + exact ha.degree_le.trans_lt (WithBot.coe_lt_coe.mpr hm) + rw [degree_translatedTruncLE_of_pos (lt_of_le_of_ne hq (Ne.symm hq0))] + exact WithBot.bot_lt_coe α + have hball : ∀ q : G, ν (translatedTruncLE q b) < (α : WithBot NatOrdinal) := by + intro q + rcases le_total q 0 with hq | hq + · exact (hb.degree_translatedTruncLE_le hq).trans_lt (WithBot.coe_lt_coe.mpr hn) + · by_cases hq0 : q = 0 + · subst q + rw [translatedTruncLE_zero] + exact hb.degree_le.trans_lt (WithBot.coe_lt_coe.mpr hn) + rw [degree_translatedTruncLE_of_pos (lt_of_le_of_ne hq (Ne.symm hq0))] + exact WithBot.bot_lt_coe α + apply σ.pol_eq_of_degree_sub_aeval_eq_bot hx hinj hdeg hsumw + simpa only [hS, map_sum, map_mul] using + degree_translatedTruncLE_mul_sub_aeval_sum_eq_bot a b γ + (fun q ↦ σ.pol hx α (translatedTruncLE q a)) + (fun q ↦ σ.pol hx α (translatedTruncLE q b)) + (fun q ↦ σ.degree_sub_aeval_pol_eq_bot hx (haall q)) + (fun q ↦ σ.degree_sub_aeval_pol_eq_bot hx (hball q)) + +include hx in +/-- The convolution identity remains true after adjoining the two boundary pairs `(0, γ)` and +`(γ, 0)`: a missing boundary point contributes a bottom-degree truncation and hence zero. -/ +theorem pol_translatedTruncLE_mul_boundary {α m n : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + {a b : Nonpositive G K} (ha : Nonpositive.HasLowerTruncationDegree a m) + (hb : Nonpositive.HasLowerTruncationDegree b n) + (hm : m < α) (hn : n < α) (hmn : m + n ≤ α) {γ : G} (hγ : γ < 0) : + σ.pol hx α (translatedTruncLE γ (a * b)) = + ∑ q ∈ insert (0, γ) (insert (γ, 0) + ((a : HahnSeries G K).closedSupportAddFiber (b : HahnSeries G K) γ)), + σ.pol hx α (translatedTruncLE q.1 a) * σ.pol hx α (translatedTruncLE q.2 b) := by + rw [σ.pol_translatedTruncLE_mul hx hinj ha hb hm hn hmn hγ] + classical + refine Finset.sum_subset (by + intro q hq + exact Finset.mem_insert_of_mem (Finset.mem_insert_of_mem hq)) ?_ + intro q hq hqnot + rcases Finset.mem_insert.mp hq with hq | hq + · subst q + have hnot : ¬(0 ∈ (a : HahnSeries G K).closedSupport ∧ + γ ∈ (b : HahnSeries G K).closedSupport) := by + intro h + exact hqnot ((a : HahnSeries G K).mem_closedSupportAddFiber + (b : HahnSeries G K) γ (0, γ) |>.mpr ⟨h.1, h.2, zero_add γ⟩) + by_cases h0a : 0 ∈ (a : HahnSeries G K).closedSupport + · have hγb : γ ∉ (b : HahnSeries G K).closedSupport := fun h ↦ hnot ⟨h0a, h⟩ + have hbot : ν (translatedTruncLE γ b) = ⊥ := by + rw [degree_translatedTruncLE_eq, if_neg hγb] + rw [σ.pol_eq_zero_of_degree_eq_bot hx hbot, mul_zero] + · have hbot : ν a = ⊥ := by + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + cantorBendixsonValue_of_notMem (a : HahnSeries G K) + (by simpa only [mem_closedSupport] using h0a), NatOrdinal.of_zero, + NatOrdinal.cantorDegree_zero] + rw [translatedTruncLE_zero, σ.pol_eq_zero_of_degree_eq_bot hx hbot, zero_mul] + · rcases Finset.mem_insert.mp hq with hq | hq + · subst q + have hnot : ¬(γ ∈ (a : HahnSeries G K).closedSupport ∧ + 0 ∈ (b : HahnSeries G K).closedSupport) := by + intro h + exact hqnot ((a : HahnSeries G K).mem_closedSupportAddFiber + (b : HahnSeries G K) γ (γ, 0) |>.mpr ⟨h.1, h.2, add_zero γ⟩) + by_cases hγa : γ ∈ (a : HahnSeries G K).closedSupport + · have h0b : 0 ∉ (b : HahnSeries G K).closedSupport := fun h ↦ hnot ⟨hγa, h⟩ + have hbot : ν b = ⊥ := by + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + cantorBendixsonValue_of_notMem (b : HahnSeries G K) + (by simpa only [mem_closedSupport] using h0b), NatOrdinal.of_zero, + NatOrdinal.cantorDegree_zero] + rw [translatedTruncLE_zero, σ.pol_eq_zero_of_degree_eq_bot hx hbot, mul_zero] + · have hbot : ν (translatedTruncLE γ a) = ⊥ := by + rw [degree_translatedTruncLE_eq, if_neg hγa] + rw [σ.pol_eq_zero_of_degree_eq_bot hx hbot, zero_mul] + · exact absurd hq hqnot + +include hx in +/-- The polynomial representing an untruncated lifted generator is its variable. -/ +theorem pol_lift {α : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + {i : ι} (hi : wt i < α) : σ.pol hx α (σ.lift i) = X i := by + rw [← (aeval_X (R := K) σ.lift i)] + apply σ.pol_aeval hx hinj + intro d hd + rw [support_X, Finset.mem_singleton] at hd + rwa [hd, Finsupp.weight_single, one_smul] + +include hx in +/-- The polynomial representing a power of a lifted generator is the corresponding variable +power, while its weight stays below the cutoff. -/ +theorem pol_lift_pow {α : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + {i : ι} (e : ℕ) (he : e • wt i < α) : + σ.pol hx α (σ.lift i ^ e) = X i ^ e := by + classical + have hpow : σ.lift i ^ e = aeval σ.lift (X i ^ e : MvPolynomial ι K) := by + rw [map_pow, aeval_X] + rw [hpow] + apply σ.pol_aeval hx hinj + intro d hd + rw [X_pow_eq_monomial, support_monomial, if_neg one_ne_zero, + Finset.mem_singleton] at hd + rw [hd, Finsupp.weight_single] + exact he + +include hx in +/-- A proper truncation of a lifted generator does not involve any variable of at least its +weight. -/ +theorem pol_translatedTruncLE_lift_mem_supported {α : NatOrdinal.{u}} + (hσ : HasLowerTruncationDegrees σ) {i B₀ : ι} (hi : wt i < α) (hle : wt i ≤ wt B₀) + {γ : G} (hγ : γ < 0) : + σ.pol hx α (translatedTruncLE γ (σ.lift i)) ∈ supported K {B₀}ᶜ := by + apply mem_supported_of_forall_weight_lt B₀ wt + intro d hd + exact (σ.pol_weight_lt_of_degree_lt hx hi.le + (((hasLowerTruncationDegrees_iff σ).mp hσ i).degree_translatedTruncLE_lt hγ) d hd).trans_le hle + +variable (α : NatOrdinal.{u}) (B₀ : ι) in +/-- A series satisfying the degree and proper-truncation bounds whose polynomial, and the +polynomial of every proper truncation, omit `X_{B₀}`. -/ +structure FreeOfVariable (u : Nonpositive G K) (m : NatOrdinal.{u}) : Prop where + lowerTruncationDegree : Nonpositive.HasLowerTruncationDegree u m + degree_lt : m < α + pol_mem : σ.pol hx α u ∈ supported K {B₀}ᶜ + trunc_mem : ∀ {γ : G}, γ < 0 → + σ.pol hx α (translatedTruncLE γ u) ∈ supported K {B₀}ᶜ + +namespace FreeOfVariable + +variable {σ hx} + +/-- The polynomial at any nonpositive cutoff omits the distinguished variable. -/ +theorem pol_trunc_mem_nonpos {α : NatOrdinal.{u}} {B₀ : ι} {u : Nonpositive G K} + {m : NatOrdinal.{u}} (hu : FreeOfVariable σ hx α B₀ u m) {γ : G} (hγ : γ ≤ 0) : + σ.pol hx α (translatedTruncLE γ u) ∈ supported K {B₀}ᶜ := by + rcases eq_or_lt_of_le hγ with rfl | hγ + · rw [translatedTruncLE_zero] + exact hu.pol_mem + · exact hu.trunc_mem hγ + +/-- A lifted generator distinct from `B₀` and of no greater weight is free of `B₀`. -/ +theorem lift (hσ : HasLowerTruncationDegrees σ) {α : NatOrdinal.{u}} {B₀ i : ι} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + (hi : i ≠ B₀) (hile : wt i ≤ wt B₀) (hB₀ : wt B₀ < α) : + FreeOfVariable σ hx α B₀ (σ.lift i) (wt i) where + lowerTruncationDegree := (hasLowerTruncationDegrees_iff σ).mp hσ i + degree_lt := hile.trans_lt hB₀ + pol_mem := by + rw [σ.pol_lift hx hinj (hile.trans_lt hB₀)] + exact X_mem_supported.mpr hi + trunc_mem := fun hγ ↦ + σ.pol_translatedTruncLE_lift_mem_supported hx hσ (hile.trans_lt hB₀) hile hγ + +/-- Sums of series free of `B₀` at a common degree remain free. -/ +theorem add {α : NatOrdinal.{u}} {B₀ : ι} {a b : Nonpositive G K} {m : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + (ha : FreeOfVariable σ hx α B₀ a m) (hb : FreeOfVariable σ hx α B₀ b m) : + FreeOfVariable σ hx α B₀ (a + b) m where + lowerTruncationDegree := ha.lowerTruncationDegree.add hb.lowerTruncationDegree + degree_lt := ha.degree_lt + pol_mem := by + rw [σ.pol_add hx hinj + (ha.lowerTruncationDegree.degree_le.trans_lt (WithBot.coe_lt_coe.mpr ha.degree_lt)) + (hb.lowerTruncationDegree.degree_le.trans_lt (WithBot.coe_lt_coe.mpr hb.degree_lt))] + exact Subalgebra.add_mem _ ha.pol_mem hb.pol_mem + trunc_mem := by + intro γ hγ + rw [map_add, σ.pol_add hx hinj + (ha.lowerTruncationDegree.degree_translatedTruncLE_lt hγ |>.trans + (WithBot.coe_lt_coe.mpr ha.degree_lt)) + (hb.lowerTruncationDegree.degree_translatedTruncLE_lt hγ |>.trans + (WithBot.coe_lt_coe.mpr hb.degree_lt))] + exact Subalgebra.add_mem _ (ha.trunc_mem hγ) (hb.trunc_mem hγ) + +/-- Scalar multiples of a series free of `B₀` remain free. -/ +theorem smul {α : NatOrdinal.{u}} {B₀ : ι} (k : K) {a : Nonpositive G K} + {m : NatOrdinal.{u}} (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + (ha : FreeOfVariable σ hx α B₀ a m) : FreeOfVariable σ hx α B₀ (k • a) m where + lowerTruncationDegree := by + rw [Nonpositive.hasLowerTruncationDegree_iff] + constructor + · exact (degree_smul_le k a).trans ha.lowerTruncationDegree.degree_le + · intro γ hγ + rw [translatedTruncLE_smul] + exact (degree_smul_le k _).trans_lt + (ha.lowerTruncationDegree.degree_translatedTruncLE_lt hγ) + degree_lt := ha.degree_lt + pol_mem := by + rw [σ.pol_smul hx hinj k + (ha.lowerTruncationDegree.degree_le.trans_lt (WithBot.coe_lt_coe.mpr ha.degree_lt))] + exact Subalgebra.smul_mem _ ha.pol_mem k + trunc_mem := by + intro γ hγ + rw [translatedTruncLE_smul, σ.pol_smul hx hinj k + (ha.lowerTruncationDegree.degree_translatedTruncLE_lt hγ |>.trans + (WithBot.coe_lt_coe.mpr ha.degree_lt))] + exact Subalgebra.smul_mem _ (ha.trunc_mem hγ) k + +/-- The zero series is free at every degree below `α`. -/ +theorem zero {α : NatOrdinal.{u}} {B₀ : ι} {m : NatOrdinal.{u}} (hm : m < α) : + FreeOfVariable σ hx α B₀ (0 : Nonpositive G K) m where + lowerTruncationDegree := hasLowerTruncationDegree_zero m + degree_lt := hm + pol_mem := by + rw [σ.pol_eq_zero_of_degree_eq_bot hx (by rw [(ν).map_zero])] + exact Subalgebra.zero_mem _ + trunc_mem := by + intro γ _ + rw [map_zero, σ.pol_eq_zero_of_degree_eq_bot hx (by rw [(ν).map_zero])] + exact Subalgebra.zero_mem _ + +open Classical in +/-- The identity series is free of every variable when `0 < α`. -/ +theorem one {α : NatOrdinal.{u}} {B₀ : ι} (hα : 0 < α) + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) : + FreeOfVariable σ hx α B₀ (1 : Nonpositive G K) 0 where + lowerTruncationDegree := hasLowerTruncationDegree_one + degree_lt := hα + pol_mem := by + have hone : σ.pol hx α (1 : Nonpositive G K) = 1 := by + rw [← map_one (MvPolynomial.aeval (R := K) σ.lift)] + exact σ.pol_aeval hx hinj (F := 1) (by + intro d hd + have hdne : MvPolynomial.coeff d (1 : MvPolynomial ι K) ≠ 0 := + mem_support_iff.mp hd + rw [MvPolynomial.coeff_one] at hdne + split_ifs at hdne with hd0 + · subst d + simpa only [map_zero] using hα + · exact absurd rfl hdne) + rw [hone] + exact Subalgebra.one_mem _ + trunc_mem := by + intro γ hγ + have hzero : translatedTruncLE γ (1 : Nonpositive G K) = 0 := by + apply Subtype.ext + ext g + rw [coe_translatedTruncLE, HahnSeries.coeff_translate, HahnSeries.coeff_truncLE, + show ((1 : Nonpositive G K) : HahnSeries G K) = HahnSeries.C 1 by rfl, + HahnSeries.C_apply, HahnSeries.coeff_single] + split_ifs with hle heq + · exact absurd (heq ▸ hle) (not_le.mpr hγ) + · rfl + · rfl + rw [hzero, σ.pol_eq_zero_of_degree_eq_bot hx (by rw [(ν).map_zero])] + exact Subalgebra.zero_mem _ + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [CharZero K] in +/-- A proper translated truncation of the identity series is zero. -/ +theorem translatedTruncLE_one {γ : G} (hγ : γ < 0) : + translatedTruncLE γ (1 : Nonpositive G K) = 0 := by + apply Subtype.ext + ext g + rw [coe_translatedTruncLE, HahnSeries.coeff_translate, HahnSeries.coeff_truncLE, + show ((1 : Nonpositive G K) : HahnSeries G K) = HahnSeries.C 1 by rfl, + HahnSeries.C_apply, HahnSeries.coeff_single] + split_ifs with hle heq + · exact absurd (heq ▸ hle) (not_le.mpr hγ) + · rfl + · rfl + +/-- A finite sum of series free of `B₀` at a common degree remains free. -/ +theorem sum {α : NatOrdinal.{u}} {B₀ : ι} {κ : Type*} {m : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + (hm : m < α) (s : Finset κ) (f : κ → Nonpositive G K) + (h : ∀ i ∈ s, FreeOfVariable σ hx α B₀ (f i) m) : + FreeOfVariable σ hx α B₀ (∑ i ∈ s, f i) m := by + classical + induction s using Finset.induction_on with + | empty => simpa using zero (σ := σ) (hx := hx) (B₀ := B₀) hm + | @insert a s ha ih => + rw [Finset.sum_insert ha] + exact (h a (Finset.mem_insert_self a s)).add hinj + (ih fun i hi ↦ h i (Finset.mem_insert_of_mem hi)) + +/-- Products of series free of `B₀` remain free when their degree sum stays below `α`. -/ +theorem mul {α : NatOrdinal.{u}} {B₀ : ι} {a b : Nonpositive G K} {m n : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + (ha : FreeOfVariable σ hx α B₀ a m) (hb : FreeOfVariable σ hx α B₀ b n) + (hmn : m + n < α) : FreeOfVariable σ hx α B₀ (a * b) (m + n) where + lowerTruncationDegree := ha.lowerTruncationDegree.mul rfl hb.lowerTruncationDegree + degree_lt := hmn + pol_mem := by + classical + have hprod : ∀ d ∈ (σ.pol hx α a * σ.pol hx α b).support, + Finsupp.weight wt d < α := by + intro d hd + obtain ⟨d₁, hd₁, d₂, hd₂, rfl⟩ := Finset.mem_add.mp + (MvPolynomial.support_mul _ _ hd) + rw [map_add] + have h1m : Finsupp.weight wt d₁ ≤ m := WithBot.coe_le_coe.mp + ((σ.pol_weight_le_degree hx + (ha.lowerTruncationDegree.degree_le.trans_lt + (WithBot.coe_lt_coe.mpr ha.degree_lt)) d₁ hd₁).trans + ha.lowerTruncationDegree.degree_le) + have h2n : Finsupp.weight wt d₂ ≤ n := WithBot.coe_le_coe.mp + ((σ.pol_weight_le_degree hx + (hb.lowerTruncationDegree.degree_le.trans_lt + (WithBot.coe_lt_coe.mpr hb.degree_lt)) d₂ hd₂).trans + hb.lowerTruncationDegree.degree_le) + exact (add_le_add h1m h2n).trans_lt hmn + have haα : ν a < (α : WithBot NatOrdinal) := + ha.lowerTruncationDegree.degree_le.trans_lt (WithBot.coe_lt_coe.mpr ha.degree_lt) + have hbα : ν b < (α : WithBot NatOrdinal) := + hb.lowerTruncationDegree.degree_le.trans_lt (WithBot.coe_lt_coe.mpr hb.degree_lt) + rw [(σ.pol_mul hx hinj haα hbα hprod).2] + exact Subalgebra.mul_mem _ ha.pol_mem hb.pol_mem + trunc_mem := by + intro γ hγ + rw [σ.pol_translatedTruncLE_mul hx hinj ha.lowerTruncationDegree hb.lowerTruncationDegree + ha.degree_lt hb.degree_lt hmn.le hγ] + refine Subalgebra.sum_mem _ fun q hq ↦ Subalgebra.mul_mem _ ?_ ?_ + · exact ha.pol_trunc_mem_nonpos (closure_minimal a.property isClosed_Iic + ((mem_closedSupport _ _).mp (((a : HahnSeries G K).mem_closedSupportAddFiber + (b : HahnSeries G K) γ q).mp hq).1)) + · exact hb.pol_trunc_mem_nonpos (closure_minimal b.property isClosed_Iic + ((mem_closedSupport _ _).mp (((a : HahnSeries G K).mem_closedSupportAddFiber + (b : HahnSeries G K) γ q).mp hq).2.1)) + +/-- Powers of a free series remain free when their weighted degree stays below `α`. -/ +theorem pow {α : NatOrdinal.{u}} {B₀ : ι} {a : Nonpositive G K} {m : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + (ha : FreeOfVariable σ hx α B₀ a m) (n : ℕ) (hn : n • m < α) : + FreeOfVariable σ hx α B₀ (a ^ n) (n • m) := by + induction n with + | zero => + classical + rw [pow_zero, zero_smul] + refine ⟨hasLowerTruncationDegree_one, hn, ?_, ?_⟩ + · have hone : σ.pol hx α (1 : Nonpositive G K) = 1 := by + rw [← map_one (aeval (R := K) σ.lift)] + exact σ.pol_aeval hx hinj (F := 1) (by + intro d hd + have hdne : MvPolynomial.coeff d (1 : MvPolynomial ι K) ≠ 0 := + mem_support_iff.mp hd + rw [MvPolynomial.coeff_one] at hdne + split_ifs at hdne with hd0 + · subst d + simpa only [map_zero, zero_smul] using hn + · exact absurd rfl hdne) + rw [hone] + exact Subalgebra.one_mem _ + · intro γ hγ + have hzero : translatedTruncLE γ (1 : Nonpositive G K) = 0 := by + apply Subtype.ext + ext g + rw [coe_translatedTruncLE, HahnSeries.coeff_translate, HahnSeries.coeff_truncLE, + show ((1 : Nonpositive G K) : HahnSeries G K) = HahnSeries.C 1 by rfl, + HahnSeries.C_apply, HahnSeries.coeff_single] + split_ifs with hle heq + · exact absurd (heq ▸ hle) (not_le.mpr hγ) + · rfl + · rfl + rw [hzero, σ.pol_eq_zero_of_degree_eq_bot hx (by rw [(ν).map_zero])] + exact Subalgebra.zero_mem _ + | succ n ih => + rw [pow_succ] + have hsucc : (n + 1) • m = n • m + m := by + rw [add_nsmul, one_nsmul] + rw [hsucc] at hn ⊢ + have hn' : n • m < α := by + exact NatOrdinal.le_add_right.trans_lt hn + apply (ih hn').mul hinj ha + exact hn + +/-- A finite product of free series is free when the sum of their degrees stays below `α`. -/ +theorem prod {α : NatOrdinal.{u}} {B₀ : ι} {κ : Type*} (hα : 0 < α) + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + (s : Finset κ) (f : κ → Nonpositive G K) (m : κ → NatOrdinal.{u}) + (h : ∀ i ∈ s, FreeOfVariable σ hx α B₀ (f i) (m i)) + (hsum : ∑ i ∈ s, m i < α) : + FreeOfVariable σ hx α B₀ (∏ i ∈ s, f i) (∑ i ∈ s, m i) := by + classical + induction s using Finset.induction_on with + | empty => + rw [Finset.prod_empty, Finset.sum_empty] + exact (hasLowerTruncationDegree_one |> fun hp ↦ + ⟨hp, hα, by + have hone : σ.pol hx α (1 : Nonpositive G K) = 1 := by + rw [← map_one (aeval (R := K) σ.lift)] + exact σ.pol_aeval hx hinj (F := 1) (by + intro d hd + have hdne : MvPolynomial.coeff d (1 : MvPolynomial ι K) ≠ 0 := + mem_support_iff.mp hd + rw [MvPolynomial.coeff_one] at hdne + split_ifs at hdne with hd0 + · subst d + simpa only [map_zero] using hα + · exact absurd rfl hdne) + rw [hone] + exact Subalgebra.one_mem _, fun {γ} hγ ↦ by + have hzero : translatedTruncLE γ (1 : Nonpositive G K) = 0 := by + apply Subtype.ext + ext g + rw [coe_translatedTruncLE, HahnSeries.coeff_translate, + HahnSeries.coeff_truncLE, + show ((1 : Nonpositive G K) : HahnSeries G K) = HahnSeries.C 1 by rfl, + HahnSeries.C_apply, HahnSeries.coeff_single] + split_ifs with hle heq + · exact absurd (heq ▸ hle) (not_le.mpr hγ) + · rfl + · rfl + rw [hzero, σ.pol_eq_zero_of_degree_eq_bot hx (by rw [(ν).map_zero])] + exact Subalgebra.zero_mem _⟩) + | @insert a s ha ih => + rw [Finset.prod_insert ha, Finset.sum_insert ha] + have hs : ∑ i ∈ s, m i < α := by + rw [Finset.sum_insert ha] at hsum + exact NatOrdinal.le_add_left.trans_lt hsum + rw [Finset.sum_insert ha] at hsum + exact (h a (Finset.mem_insert_self a s)).mul hinj + (ih (fun i hi ↦ h i (Finset.mem_insert_of_mem hi)) hs) hsum + +/-- Evaluating a monomial not involving `B₀`, in variables of weight at most `wt B₀`, gives a +series free of `B₀`. -/ +theorem aeval_monomial (hσ : HasLowerTruncationDegrees σ) {α : NatOrdinal.{u}} {B₀ : ι} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + (hB₀ : wt B₀ < α) (d : ι →₀ ℕ) (hd : d B₀ = 0) + (hle : ∀ i ∈ d.support, wt i ≤ wt B₀) (hdegree : Finsupp.weight wt d < α) : + FreeOfVariable σ hx α B₀ + (aeval σ.lift (monomial d (1 : K))) (Finsupp.weight wt d) := by + rw [MvPolynomial.aeval_monomial, map_one, one_mul, Finsupp.prod] + rw [Finsupp.weight_apply, Finsupp.sum] at hdegree ⊢ + apply prod (zero_le.trans_lt hdegree) hinj d.support (fun i ↦ σ.lift i ^ d i) + (fun i ↦ d i • wt i) + · intro i hi + have hiB₀ : i ≠ B₀ := fun h ↦ (Finsupp.mem_support_iff.mp hi) (h ▸ hd) + have hiterm : d i • wt i < α := (Finset.single_le_sum + (f := fun i ↦ d i • wt i) (fun _ _ ↦ zero_le) hi).trans_lt hdegree + exact (lift hσ hinj hiB₀ (hle i hi) hB₀).pow hinj (d i) hiterm + · exact hdegree + +/-- Evaluating a homogeneous polynomial which omits `B₀` and uses no heavier variable gives a +series free of `B₀`. -/ +theorem aeval (hσ : HasLowerTruncationDegrees σ) {α : NatOrdinal.{u}} {B₀ : ι} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + (hB₀ : wt B₀ < α) {F : MvPolynomial ι K} {m : NatOrdinal.{u}} + (hF : IsWeightedHomogeneous wt F m) (hm : m < α) + (hmem : F ∈ supported K {B₀}ᶜ) (hle : ∀ i ∈ F.vars, wt i ≤ wt B₀) : + FreeOfVariable σ hx α B₀ (aeval σ.lift F) m := by + classical + conv => rw [F.as_sum] + rw [map_sum] + apply sum hinj hm F.support + intro d hd + have hdw : Finsupp.weight wt d = m := hF (mem_support_iff.mp hd) + have hd0 : d B₀ = 0 := by + by_contra h0 + have hv : B₀ ∈ F.vars := + (mem_vars_iff_mem_support B₀).mpr ⟨d, hd, Finsupp.mem_support_iff.mpr h0⟩ + exact (mem_supported.mp hmem) hv rfl + have hwt : ∀ i ∈ d.support, wt i ≤ wt B₀ := fun i hi ↦ + hle i ((mem_vars_iff_mem_support i).mpr ⟨d, hd, hi⟩) + have hmono : (monomial d (MvPolynomial.coeff d F) : MvPolynomial ι K) = + MvPolynomial.C (MvPolynomial.coeff d F) * monomial d 1 := by + rw [C_mul_monomial, mul_one] + rw [hmono, map_mul, aeval_C, Algebra.algebraMap_eq_smul_one, smul_mul_assoc, one_mul] + rw [← hdw] + exact (aeval_monomial (σ := σ) (hx := hx) hσ hinj hB₀ d hd0 hwt + (hdw ▸ hm)).smul (MvPolynomial.coeff d F) hinj + +/-- Multiplying a free series by a power of the distinguished lift is represented by the +corresponding variable power. -/ +theorem pol_lift_pow_mul (hσ : HasLowerTruncationDegrees σ) {α : NatOrdinal.{u}} {B₀ : ι} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + {u : Nonpositive G K} {m : NatOrdinal.{u}} (hu : FreeOfVariable σ hx α B₀ u m) + (e : ℕ) (he : e • wt B₀ + m < α) : + σ.pol hx α (σ.lift B₀ ^ e * u) = X B₀ ^ e * σ.pol hx α u := by + classical + have hpow : Nonpositive.HasLowerTruncationDegree (σ.lift B₀ ^ e) (e • wt B₀) := + ((hasLowerTruncationDegrees_iff σ).mp hσ B₀).pow e + have hpowα : ν (σ.lift B₀ ^ e) < (α : WithBot NatOrdinal) := + hpow.degree_le.trans_lt (WithBot.coe_lt_coe.mpr (NatOrdinal.le_add_right.trans_lt he)) + have huα : ν u < (α : WithBot NatOrdinal) := + hu.lowerTruncationDegree.degree_le.trans_lt (WithBot.coe_lt_coe.mpr hu.degree_lt) + have hprod : ∀ d ∈ (σ.pol hx α (σ.lift B₀ ^ e) * σ.pol hx α u).support, + Finsupp.weight wt d < α := by + intro d hd + obtain ⟨d₁, hd₁, d₂, hd₂, rfl⟩ := Finset.mem_add.mp + (MvPolynomial.support_mul _ _ hd) + rw [map_add] + have h1 : Finsupp.weight wt d₁ ≤ e • wt B₀ := WithBot.coe_le_coe.mp + ((σ.pol_weight_le_degree hx hpowα d₁ hd₁).trans hpow.degree_le) + have h2 : Finsupp.weight wt d₂ ≤ m := WithBot.coe_le_coe.mp + ((σ.pol_weight_le_degree hx huα d₂ hd₂).trans hu.lowerTruncationDegree.degree_le) + exact (add_le_add h1 h2).trans_lt he + rw [(σ.pol_mul hx hinj hpowα huα hprod).2, + σ.pol_lift_pow hx hinj e (NatOrdinal.le_add_right.trans_lt he)] + +omit [CharZero K] in +/-- Split a finite sum at two distinct members. -/ +private theorem sum_eq_add_add_sum_erase {κ : Type*} [DecidableEq κ] + {S : Finset κ} {a b : κ} (ha : a ∈ S) (hb : b ∈ S) (hne : b ≠ a) + (f : κ → MvPolynomial ι K) : + ∑ q ∈ S, f q = f a + f b + ∑ q ∈ (S.erase a).erase b, f q := by + rw [add_assoc, Finset.add_sum_erase _ _ (Finset.mem_erase.mpr ⟨hne, hb⟩), + Finset.add_sum_erase _ _ ha] + +open Classical in +/-- For `u` free of `B₀`, the polynomial of a proper truncation of `lift B₀ ^ e * u` has no +coefficient above `e`, and its coefficient at `e` is the polynomial of the same truncation of +`u`. -/ +theorem xCoeff_pol_translatedTruncLE_lift_pow_mul + (hσ : HasLowerTruncationDegrees σ) {α : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + {B₀ : ι} {u : Nonpositive G K} {m : NatOrdinal.{u}} + (hB₀ : wt B₀ < α) (hu : FreeOfVariable σ hx α B₀ u m) (e : ℕ) + (he : e • wt B₀ + m ≤ α) {γ : G} (hγ : γ < 0) : + (∀ k, e < k → + xCoeff B₀ k (σ.pol hx α (translatedTruncLE γ (σ.lift B₀ ^ e * u))) = 0) ∧ + xCoeff B₀ e (σ.pol hx α (translatedTruncLE γ (σ.lift B₀ ^ e * u))) = + σ.pol hx α (translatedTruncLE γ u) := by + classical + induction e generalizing γ with + | zero => + rw [pow_zero, one_mul] + exact ⟨fun k hk ↦ by + rw [xCoeff_of_mem_supported B₀ (hu.trunc_mem hγ) k, if_neg (Nat.ne_of_gt hk)], + by rw [xCoeff_of_mem_supported B₀ (hu.trunc_mem hγ) 0, if_pos rfl]⟩ + | succ e ih => + have hg0 : wt B₀ ≠ 0 := hx.ne_zero B₀ + have hstep : e • wt B₀ + m < (e + 1) • wt B₀ + m := by + rw [succ_nsmul, add_right_comm] + exact lt_add_of_pos_right _ (pos_iff_ne_zero.mpr hg0) + have he' : e • wt B₀ + m < α := hstep.trans_le he + have ih' := ih he'.le hγ + have hright : Nonpositive.HasLowerTruncationDegree + (σ.lift B₀ ^ e * u) (e • wt B₀ + m) := + (((hasLowerTruncationDegrees_iff σ).mp hσ B₀).pow e).mul rfl + hu.lowerTruncationDegree + have hconv := σ.pol_translatedTruncLE_mul_boundary hx hinj + ((hasLowerTruncationDegrees_iff σ).mp hσ B₀) hright hB₀ he' (by + rw [← add_assoc, add_comm (wt B₀), ← succ_nsmul] + exact he) hγ + set S := insert (0, γ) (insert (γ, 0) + ((σ.lift B₀ : HahnSeries G K).closedSupportAddFiber + ((σ.lift B₀ ^ e * u : Nonpositive G K) : HahnSeries G K) γ)) with hS + set f : G × G → MvPolynomial ι K := fun q ↦ + σ.pol hx α (translatedTruncLE q.1 (σ.lift B₀)) * + σ.pol hx α (translatedTruncLE q.2 (σ.lift B₀ ^ e * u)) with hf + have h0S : (0, γ) ∈ S := Finset.mem_insert_self _ _ + have hγS : (γ, 0) ∈ S := Finset.mem_insert_of_mem (Finset.mem_insert_self _ _) + have hne : (γ, 0) ≠ (0, γ) := fun h ↦ hγ.ne (congrArg Prod.fst h) + have hsplit : ∑ q ∈ S, f q = f (0, γ) + f (γ, 0) + + ∑ q ∈ (S.erase (0, γ)).erase (γ, 0), f q := + sum_eq_add_add_sum_erase h0S hγS hne f + have hpowmul := hu.pol_lift_pow_mul hσ hinj e he' + have hf0 : f (0, γ) = X B₀ * σ.pol hx α + (translatedTruncLE γ (σ.lift B₀ ^ e * u)) := by + rw [hf] + change σ.pol hx α (translatedTruncLE 0 (σ.lift B₀)) * + σ.pol hx α (translatedTruncLE γ (σ.lift B₀ ^ e * u)) = _ + rw [translatedTruncLE_zero, σ.pol_lift hx hinj hB₀] + have hfγ : f (γ, 0) = σ.pol hx α (translatedTruncLE γ (σ.lift B₀)) * + (X B₀ ^ e * σ.pol hx α u) := by + rw [hf] + change σ.pol hx α (translatedTruncLE γ (σ.lift B₀)) * + σ.pol hx α (translatedTruncLE 0 (σ.lift B₀ ^ e * u)) = _ + rw [translatedTruncLE_zero, hpowmul] + have hinterior : ∀ q ∈ (S.erase (0, γ)).erase (γ, 0), + q.1 < 0 ∧ q.2 < 0 ∧ + σ.pol hx α (translatedTruncLE q.1 (σ.lift B₀)) ∈ supported K {B₀}ᶜ := by + intro q hq + have hqneγ : q ≠ (γ, 0) := (Finset.mem_erase.mp hq).1 + have hqne0 : q ≠ (0, γ) := (Finset.mem_erase.mp + (Finset.mem_erase.mp hq).2).1 + have hqmemS : q ∈ S := (Finset.mem_erase.mp + (Finset.mem_erase.mp hq).2).2 + have hqmem : q ∈ (σ.lift B₀ : HahnSeries G K).closedSupportAddFiber + ((σ.lift B₀ ^ e * u : Nonpositive G K) : HahnSeries G K) γ := by + rw [hS] at hqmemS + rcases Finset.mem_insert.mp hqmemS with hqeq | hqmemS + · exact (hqne0 hqeq).elim + rcases Finset.mem_insert.mp hqmemS with hqeq | hqmemS + · exact (hqneγ hqeq).elim + · exact hqmemS + obtain ⟨hq1mem, hq2mem, hsum⟩ := + ((σ.lift B₀ : HahnSeries G K).mem_closedSupportAddFiber + ((σ.lift B₀ ^ e * u : Nonpositive G K) : HahnSeries G K) γ q).mp hqmem + have hq1le : q.1 ≤ 0 := closure_minimal (σ.lift B₀).property isClosed_Iic + ((mem_closedSupport _ _).mp hq1mem) + have hq2le : q.2 ≤ 0 := closure_minimal (σ.lift B₀ ^ e * u).property isClosed_Iic + ((mem_closedSupport _ _).mp hq2mem) + have hq1ne : q.1 ≠ 0 := fun hq10 ↦ hqne0 (Prod.ext hq10 (by + simpa [hq10] using hsum)) + have hq2ne : q.2 ≠ 0 := fun hq20 ↦ hqneγ (Prod.ext (by + simpa [hq20] using hsum) hq20) + have hq1neg : q.1 < 0 := lt_of_le_of_ne hq1le hq1ne + have hq2neg : q.2 < 0 := lt_of_le_of_ne hq2le hq2ne + exact ⟨hq1neg, hq2neg, + σ.pol_translatedTruncLE_lift_mem_supported hx hσ hB₀ le_rfl hq1neg⟩ + have hfhigh : ∀ q ∈ (S.erase (0, γ)).erase (γ, 0), ∀ k, e < k → + xCoeff B₀ k (f q) = 0 := by + intro q hq k hk + have hiq := ih he'.le (hinterior q hq).2.1 + rw [hf, xCoeff_mul_of_mem_supported B₀ (hinterior q hq).2.2 k, + hiq.1 k hk, mul_zero] + have hexp : σ.lift B₀ ^ (e + 1) * u = + σ.lift B₀ * (σ.lift B₀ ^ e * u) := by ring + rw [hexp, hconv, hsplit, hf0, hfγ] + refine ⟨fun k hk ↦ ?_, ?_⟩ + · rw [map_add, map_add, map_sum, + Finset.sum_eq_zero fun q hq ↦ hfhigh q hq k (by omega)] + obtain ⟨k', rfl⟩ : ∃ k', k = k' + 1 := ⟨k - 1, by omega⟩ + rw [xCoeff_succ_X_mul, ih'.1 k' (by omega), ← mul_assoc, + show σ.pol hx α (translatedTruncLE γ (σ.lift B₀)) * X B₀ ^ e * + σ.pol hx α u = + (σ.pol hx α (translatedTruncLE γ (σ.lift B₀)) * σ.pol hx α u) * + X B₀ ^ e by ring, + xCoeff_mul_X_pow B₀ (Subalgebra.mul_mem _ + (σ.pol_translatedTruncLE_lift_mem_supported hx hσ hB₀ le_rfl hγ) + hu.pol_mem) (k' + 1) e, if_neg (by omega), add_zero, add_zero] + · rw [map_add, map_add, map_sum, + Finset.sum_eq_zero fun q hq ↦ hfhigh q hq (e + 1) (Nat.lt_succ_self e), + xCoeff_succ_X_mul, ih'.2, ← mul_assoc, + show σ.pol hx α (translatedTruncLE γ (σ.lift B₀)) * X B₀ ^ e * + σ.pol hx α u = + (σ.pol hx α (translatedTruncLE γ (σ.lift B₀)) * σ.pol hx α u) * + X B₀ ^ e by ring, + xCoeff_mul_X_pow B₀ (Subalgebra.mul_mem _ + (σ.pol_translatedTruncLE_lift_mem_supported hx hσ hB₀ le_rfl hγ) + hu.pol_mem) (e + 1) e, if_neg (Nat.succ_ne_self e), add_zero, add_zero] + +/-- A proper truncation of the evaluation of a top-degree homogeneous polynomial which omits +`B₀` and uses no heavier variable still has a representing polynomial which omits `B₀`. -/ +theorem pol_translatedTruncLE_aeval_mem_supported + (hσ : HasLowerTruncationDegrees σ) {α : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + {B₀ : ι} (hB₀ : wt B₀ < α) {F : MvPolynomial ι K} + (hF : IsWeightedHomogeneous wt F α) (hmem : F ∈ supported K {B₀}ᶜ) + (hle : ∀ i ∈ F.vars, wt i ≤ wt B₀) {γ : G} (hγ : γ < 0) : + σ.pol hx α (translatedTruncLE γ (MvPolynomial.aeval σ.lift F)) ∈ + supported K {B₀}ᶜ := by + classical + have hα0 : α ≠ 0 := ne_of_gt ((zero_le : (0 : NatOrdinal) ≤ wt B₀).trans_lt hB₀) + have hterm : ∀ d ∈ F.support, + σ.pol hx α (translatedTruncLE γ + (MvPolynomial.aeval σ.lift (monomial d (MvPolynomial.coeff d F)))) ∈ + supported K {B₀}ᶜ := by + intro d hd + have hdw : Finsupp.weight wt d = α := hF (mem_support_iff.mp hd) + have hd0 : d B₀ = 0 := by + by_contra h0 + exact (mem_supported.mp hmem) ((mem_vars_iff_mem_support B₀).mpr + ⟨d, hd, Finsupp.mem_support_iff.mpr h0⟩) rfl + have hdne : d ≠ 0 := by + rintro rfl + rw [map_zero] at hdw + exact hα0 hdw.symm + obtain ⟨i, hi⟩ := Finsupp.support_nonempty_iff.mpr hdne + have hi0 : d i ≠ 0 := Finsupp.mem_support_iff.mp hi + have hiB₀ : i ≠ B₀ := fun h ↦ hi0 (h ▸ hd0) + have hiwt : wt i ≤ wt B₀ := + hle i ((mem_vars_iff_mem_support i).mpr ⟨d, hd, hi⟩) + set d' := d - Finsupp.single i 1 with hd' + have hdd' : d = Finsupp.single i 1 + d' := by + rw [hd', add_comm, tsub_add_cancel_of_le] + intro j + rw [Finsupp.single_apply] + split_ifs with hji + · subst j + exact Nat.pos_of_ne_zero hi0 + · exact Nat.zero_le _ + have hweight : wt i + Finsupp.weight wt d' = α := by + rw [← hdw, hdd', map_add, Finsupp.weight_single, one_smul] + have hiα : wt i < α := hiwt.trans_lt hB₀ + have hd'α : Finsupp.weight wt d' < α := by + rw [← hweight] + exact lt_add_of_pos_left _ (pos_iff_ne_zero.mpr (hx.ne_zero i)) + have hd'0 : d' B₀ = 0 := by + rw [hd', Finsupp.tsub_apply, hd0, zero_tsub] + have hd'wt : ∀ j ∈ d'.support, wt j ≤ wt B₀ := fun j hj ↦ + hle j ((mem_vars_iff_mem_support j).mpr ⟨d, hd, Finsupp.support_tsub hj⟩) + have hfreei := FreeOfVariable.lift (σ := σ) (hx := hx) hσ hinj hiB₀ hiwt hB₀ + have hfreed := FreeOfVariable.aeval_monomial (σ := σ) (hx := hx) hσ hinj hB₀ + d' hd'0 hd'wt hd'α + have hsplit : MvPolynomial.aeval σ.lift (monomial d (1 : K)) = + σ.lift i * MvPolynomial.aeval σ.lift (monomial d' (1 : K)) := by + rw [hdd', add_comm, monomial_add_single, pow_one, map_mul, aeval_X, mul_comm] + have hconv := σ.pol_translatedTruncLE_mul hx hinj hfreei.lowerTruncationDegree + hfreed.lowerTruncationDegree + hiα hd'α hweight.le hγ + have hone : σ.pol hx α (translatedTruncLE γ + (MvPolynomial.aeval σ.lift (monomial d (1 : K)))) ∈ supported K {B₀}ᶜ := by + rw [hsplit, hconv] + refine Subalgebra.sum_mem _ fun q hq ↦ Subalgebra.mul_mem _ ?_ ?_ + · exact hfreei.pol_trunc_mem_nonpos (closure_minimal (σ.lift i).property isClosed_Iic + ((mem_closedSupport _ _).mp (((σ.lift i : HahnSeries G K).mem_closedSupportAddFiber + ((MvPolynomial.aeval σ.lift (monomial d' (1 : K)) : Nonpositive G K) : + HahnSeries G K) γ q).mp + hq).1)) + · exact hfreed.pol_trunc_mem_nonpos + (closure_minimal (MvPolynomial.aeval σ.lift (monomial d' (1 : K))).property + isClosed_Iic + ((mem_closedSupport _ _).mp (((σ.lift i : HahnSeries G K).mem_closedSupportAddFiber + ((MvPolynomial.aeval σ.lift (monomial d' (1 : K)) : Nonpositive G K) : + HahnSeries G K) γ q).mp + hq).2.1)) + have hmono : (monomial d (MvPolynomial.coeff d F) : MvPolynomial ι K) = + MvPolynomial.C (MvPolynomial.coeff d F) * monomial d (1 : K) := by + rw [C_mul_monomial, mul_one] + rw [hmono, map_mul, aeval_C, Algebra.algebraMap_eq_smul_one, smul_mul_assoc, one_mul, + translatedTruncLE_smul, σ.pol_smul hx hinj] + · exact Subalgebra.smul_mem _ hone _ + · exact (σ.hasLowerTruncationDegree_aeval hσ + (isWeightedHomogeneous_monomial wt d (1 : K) hdw)).degree_translatedTruncLE_lt hγ + have hexp : MvPolynomial.aeval σ.lift F = ∑ d ∈ F.support, + MvPolynomial.aeval σ.lift (monomial d (MvPolynomial.coeff d F)) := by + conv_lhs => rw [F.as_sum] + rw [map_sum] + rw [hexp, map_sum, σ.pol_sum hx hinj _ _ (fun d hd ↦ by + have hp := σ.hasLowerTruncationDegree_aeval hσ (isWeightedHomogeneous_monomial wt d + (MvPolynomial.coeff d F) (hF (mem_support_iff.mp hd))) + exact hp.degree_translatedTruncLE_lt hγ)] + exact Subalgebra.sum_mem _ fun d hd ↦ hterm d hd + +open Classical in +/-- The coefficient one below the top in a proper truncation of `lift B₀ ^ (e + 1)` is +`(e + 1)` times the polynomial of the truncated lift. -/ +theorem xCoeff_pol_translatedTruncLE_lift_pow + (hσ : HasLowerTruncationDegrees σ) {α : NatOrdinal.{u}} + (hinj : ∀ β < α, OrdinalGraded.InjectiveAt K wt xg β) + {B₀ : ι} (hB₀ : wt B₀ < α) (e : ℕ) + (he : (e + 1) • wt B₀ ≤ α) {γ : G} (hγ : γ < 0) : + xCoeff B₀ e (σ.pol hx α (translatedTruncLE γ (σ.lift B₀ ^ (e + 1)))) = + (e + 1 : ℕ) • σ.pol hx α (translatedTruncLE γ (σ.lift B₀)) := by + classical + induction e generalizing γ with + | zero => + rw [zero_add, pow_one, xCoeff_of_mem_supported B₀ + (σ.pol_translatedTruncLE_lift_mem_supported hx hσ hB₀ le_rfl hγ) 0, + if_pos rfl, one_smul] + | succ e ih => + have hg0 : wt B₀ ≠ 0 := hx.ne_zero B₀ + have hstep : (e + 1) • wt B₀ < (e + 1 + 1) • wt B₀ := by + rw [succ_nsmul] + exact lt_add_of_pos_right _ (pos_iff_ne_zero.mpr hg0) + have he' : (e + 1) • wt B₀ < α := hstep.trans_le he + have hα0 : 0 < α := (zero_le : (0 : NatOrdinal) ≤ wt B₀).trans_lt hB₀ + have hone := FreeOfVariable.one (σ := σ) (hx := hx) hα0 hinj (B₀ := B₀) + have hright : Nonpositive.HasLowerTruncationDegree + (σ.lift B₀ ^ (e + 1)) ((e + 1) • wt B₀) := + ((hasLowerTruncationDegrees_iff σ).mp hσ B₀).pow (e + 1) + have hconv := σ.pol_translatedTruncLE_mul_boundary hx hinj + ((hasLowerTruncationDegrees_iff σ).mp hσ B₀) hright hB₀ he' (by + rw [add_comm, ← succ_nsmul] + exact he) hγ + set S := insert (0, γ) (insert (γ, 0) + ((σ.lift B₀ : HahnSeries G K).closedSupportAddFiber + ((σ.lift B₀ ^ (e + 1) : Nonpositive G K) : HahnSeries G K) γ)) with hS + set f : G × G → MvPolynomial ι K := fun q ↦ + σ.pol hx α (translatedTruncLE q.1 (σ.lift B₀)) * + σ.pol hx α (translatedTruncLE q.2 (σ.lift B₀ ^ (e + 1))) with hf + have h0S : (0, γ) ∈ S := Finset.mem_insert_self _ _ + have hγS : (γ, 0) ∈ S := Finset.mem_insert_of_mem (Finset.mem_insert_self _ _) + have hne : (γ, 0) ≠ (0, γ) := fun h ↦ hγ.ne (congrArg Prod.fst h) + have hsplit : ∑ q ∈ S, f q = f (0, γ) + f (γ, 0) + + ∑ q ∈ (S.erase (0, γ)).erase (γ, 0), f q := + sum_eq_add_add_sum_erase h0S hγS hne f + have hf0 : f (0, γ) = X B₀ * + σ.pol hx α (translatedTruncLE γ (σ.lift B₀ ^ (e + 1))) := by + rw [hf] + change σ.pol hx α (translatedTruncLE 0 (σ.lift B₀)) * _ = _ + rw [translatedTruncLE_zero, σ.pol_lift hx hinj hB₀] + have hfγ : f (γ, 0) = σ.pol hx α (translatedTruncLE γ (σ.lift B₀)) * + X B₀ ^ (e + 1) := by + rw [hf] + change σ.pol hx α (translatedTruncLE γ (σ.lift B₀)) * + σ.pol hx α (translatedTruncLE 0 (σ.lift B₀ ^ (e + 1))) = _ + rw [translatedTruncLE_zero, σ.pol_lift_pow hx hinj (e + 1) he'] + have hinterior : ∀ q ∈ (S.erase (0, γ)).erase (γ, 0), + q.1 < 0 ∧ q.2 < 0 ∧ + σ.pol hx α (translatedTruncLE q.1 (σ.lift B₀)) ∈ supported K {B₀}ᶜ := by + intro q hq + have hqneγ : q ≠ (γ, 0) := (Finset.mem_erase.mp hq).1 + have hqne0 : q ≠ (0, γ) := (Finset.mem_erase.mp + (Finset.mem_erase.mp hq).2).1 + have hqmemS : q ∈ S := (Finset.mem_erase.mp + (Finset.mem_erase.mp hq).2).2 + have hqmem : q ∈ (σ.lift B₀ : HahnSeries G K).closedSupportAddFiber + ((σ.lift B₀ ^ (e + 1) : Nonpositive G K) : HahnSeries G K) γ := by + rw [hS] at hqmemS + rcases Finset.mem_insert.mp hqmemS with hqeq | hqmemS + · exact (hqne0 hqeq).elim + rcases Finset.mem_insert.mp hqmemS with hqeq | hqmemS + · exact (hqneγ hqeq).elim + · exact hqmemS + obtain ⟨hq1mem, hq2mem, hsum⟩ := + ((σ.lift B₀ : HahnSeries G K).mem_closedSupportAddFiber + ((σ.lift B₀ ^ (e + 1) : Nonpositive G K) : HahnSeries G K) γ q).mp hqmem + have hq1le : q.1 ≤ 0 := closure_minimal (σ.lift B₀).property isClosed_Iic + ((mem_closedSupport _ _).mp hq1mem) + have hq2le : q.2 ≤ 0 := closure_minimal (σ.lift B₀ ^ (e + 1)).property isClosed_Iic + ((mem_closedSupport _ _).mp hq2mem) + have hq1ne : q.1 ≠ 0 := fun hq10 ↦ hqne0 (Prod.ext hq10 (by + simpa [hq10] using hsum)) + have hq2ne : q.2 ≠ 0 := fun hq20 ↦ hqneγ (Prod.ext (by + simpa [hq20] using hsum) hq20) + have hq1neg : q.1 < 0 := lt_of_le_of_ne hq1le hq1ne + have hq2neg : q.2 < 0 := lt_of_le_of_ne hq2le hq2ne + exact ⟨hq1neg, hq2neg, + σ.pol_translatedTruncLE_lift_mem_supported hx hσ hB₀ le_rfl hq1neg⟩ + have hfzero : ∀ q ∈ (S.erase (0, γ)).erase (γ, 0), + xCoeff B₀ (e + 1) (f q) = 0 := by + intro q hq + have htopq := FreeOfVariable.xCoeff_pol_translatedTruncLE_lift_pow_mul + (σ := σ) (hx := hx) hσ hinj hB₀ hone (e + 1) (by simpa using he'.le) + (hinterior q hq).2.1 + rw [mul_one] at htopq + have hpone : σ.pol hx α (translatedTruncLE q.2 (1 : Nonpositive G K)) = 0 := by + rw [FreeOfVariable.translatedTruncLE_one (hinterior q hq).2.1, + σ.pol_eq_zero_of_degree_eq_bot hx (by rw [(ν).map_zero])] + rw [hf, xCoeff_mul_of_mem_supported B₀ (hinterior q hq).2.2 (e + 1), + htopq.2, hpone, mul_zero] + have hexp : σ.lift B₀ ^ (e + 1 + 1) = + σ.lift B₀ * σ.lift B₀ ^ (e + 1) := by ring + rw [hexp, hconv, hsplit, hf0, hfγ, map_add, map_add, map_sum, + Finset.sum_eq_zero hfzero, add_zero, xCoeff_succ_X_mul, ih he'.le hγ, + xCoeff_mul_X_pow B₀ + (σ.pol_translatedTruncLE_lift_mem_supported hx hσ hB₀ le_rfl hγ) + (e + 1) (e + 1), if_pos rfl] + exact (succ_nsmul _ (e + 1)).symm + +end FreeOfVariable + +end LiftFamily + +end HahnSeries.Nonpositive + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart.lean new file mode 100644 index 0000000000..b5d8593f8b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart.lean @@ -0,0 +1,31 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Assumptions +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalFiniteClassReduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalIntegerPartSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalPrimalityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalProposition922 +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ClassTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassReduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IntegerPartSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IrreducibilityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.LimitTailPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.PrimalityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduced +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedCharacterization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.SplitTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationPrimality + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Assumptions.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Assumptions.lean new file mode 100644 index 0000000000..81cca9e771 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Assumptions.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ArchimedeanSplitting +public import Mathlib.Algebra.Order.Module.Archimedean +public import Mathlib.Data.Real.Embedding + +/-! +# LM24 assumptions at an Archimedean class + +This module records assumptions `(A1)_σ` and `(A2)_σ` from LM24, Theorem 9.0.1. Assumption +`(A1)_σ` says that the chosen complement at a nonzero class is isomorphic, as an ordered +additive group, to `ℝ`. Assumption `(A2)_σ` is the paper's cofinality or degenerate-inner-group +disjunction. Both full predicates retain the paper's zero-class clause; their finite-class +specializations remove precisely that clause. + +The elimination theorem supplies the fraction-field conclusion of LM24, Proposition 2.4.5 for +the cardinal-bounded inner truncation integer part. It does not replace `(A2)_σ` by that +conclusion: both the printed assumption and its consequence remain visible in the public API. +-/ + +universe u v + +public noncomputable section + +open Cardinal + +namespace LM24 + +variable {K : Type*} {G : Type u} {R : Type v} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] + +/-! ### Assumption `(A1)_σ` -/ + +/-- LM24 assumption `(A1)_σ`: the chosen stratum at `σ` is order-additively isomorphic to +`ℝ`, or `σ` is the class of zero. Mathlib orders Archimedean classes oppositely to LM24, so +the zero class is `⊤`. -/ +def AssumptionA1 (u : HahnEmbedding.ArchimedeanStrata K G) + (σ : ArchimedeanClass G) : Prop := + σ = ⊤ ∨ + ∃ c : FiniteArchimedeanClass G, + FiniteArchimedeanClass.withTopOrderIso G c = σ ∧ + Nonempty (u.stratum c ≃+o ℝ) + +/-- The defining zero-class/isomorphic-stratum disjunction for `(A1)_σ`. -/ +theorem assumptionA1_iff (u : HahnEmbedding.ArchimedeanStrata K G) + (σ : ArchimedeanClass G) : + AssumptionA1 u σ ↔ + σ = ⊤ ∨ + ∃ c : FiniteArchimedeanClass G, + FiniteArchimedeanClass.withTopOrderIso G c = σ ∧ + Nonempty (u.stratum c ≃+o ℝ) := + (Iff.rfl) + +/-- The nonzero-class specialization of LM24 assumption `(A1)_σ`. -/ +def AssumptionA1AtFiniteClass (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) : Prop := + Nonempty (u.stratum c ≃+o ℝ) + +/-- The defining ordered-additive isomorphism for `(A1)_σ` at a nonzero class. -/ +theorem assumptionA1AtFiniteClass_iff (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) : + AssumptionA1AtFiniteClass u c ↔ Nonempty (u.stratum c ≃+o ℝ) := + (Iff.rfl) + +/-! ### Assumption `(A2)_σ` -/ + +/-- LM24 assumption `(A2)_σ`: the inner exponent group has cofinality at least `κ`, or it +is zero and `Frac(Z) = R`, or `σ` is the class of zero. -/ +def AssumptionA2 (κ : Cardinal.{u}) (Z : Subring R) (σ : ArchimedeanClass G) : Prop := + κ ≤ Order.cof ↥(ArchimedeanClass.ballAddSubgroup σ) ∨ + (Subsingleton ↥(ArchimedeanClass.ballAddSubgroup σ) ∧ + Subring.fracSubring Z = ⊤) ∨ σ = ⊤ + +/-- The defining disjunction for `(A2)_σ`. -/ +theorem assumptionA2_iff (κ : Cardinal.{u}) (Z : Subring R) (σ : ArchimedeanClass G) : + AssumptionA2 κ Z σ ↔ + κ ≤ Order.cof ↥(ArchimedeanClass.ballAddSubgroup σ) ∨ + (Subsingleton ↥(ArchimedeanClass.ballAddSubgroup σ) ∧ + Subring.fracSubring Z = ⊤) ∨ σ = ⊤ := + (Iff.rfl) + +/-- The nonzero-class specialization of LM24 assumption `(A2)_σ`. -/ +def AssumptionA2AtFiniteClass (κ : Cardinal.{u}) (Z : Subring R) + (σ : FiniteArchimedeanClass G) : Prop := + κ ≤ Order.cof ↥(FiniteArchimedeanClass.ball K σ) ∨ + (Subsingleton ↥(FiniteArchimedeanClass.ball K σ) ∧ Subring.fracSubring Z = ⊤) + +/-- The defining disjunction for `(A2)_σ` at a nonzero Archimedean class. -/ +theorem assumptionA2AtFiniteClass_iff (κ : Cardinal.{u}) (Z : Subring R) + (σ : FiniteArchimedeanClass G) : + AssumptionA2AtFiniteClass (K := K) κ Z σ ↔ + κ ≤ Order.cof ↥(FiniteArchimedeanClass.ball K σ) ∨ + (Subsingleton ↥(FiniteArchimedeanClass.ball K σ) ∧ Subring.fracSubring Z = ⊤) := + (Iff.rfl) + +/-- The cofinality clause implies the bounded inner fraction-field equality. -/ +theorem fracSubring_cardSuppLTTruncationIntegerPart_eq_top_of_assumptionA2AtFiniteClass + {κ : Cardinal.{u}} [Fact (ℵ₀ < κ)] (Z : Subring R) (σ : FiniteArchimedeanClass G) + (hA2 : AssumptionA2AtFiniteClass (K := K) κ Z σ) : + Subring.fracSubring + (HahnSeries.cardSuppLTTruncationIntegerPart + (G := ↥(FiniteArchimedeanClass.ball K σ)) (R := R) (κ := κ) Z) = ⊤ := by + rcases (assumptionA2AtFiniteClass_iff (K := K) κ Z σ).mp hA2 with hcof | ⟨hzero, hfrac⟩ + · exact HahnSeries.fracSubring_cardSuppLTTruncationIntegerPart_eq_top_of_le_cof Z hcof + · letI : Subsingleton ↥(FiniteArchimedeanClass.ball K σ) := hzero + exact HahnSeries.fracSubring_cardSuppLTTruncationIntegerPart_eq_top_of_subsingleton Z hfrac + +end LM24 diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalFiniteClassReduction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalFiniteClassReduction.lean new file mode 100644 index 0000000000..8a34c5c2f1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalFiniteClassReduction.lean @@ -0,0 +1,154 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation + +/-! +# Finite-class reduction in a bounded Hahn integer part + +LM24's open truncation and reduction at an Archimedean class preserve a cardinal-bounded Hahn +integer part. When the open truncation is nonzero, their product is the original series. +-/ + +public noncomputable section + +open Cardinal FiniteArchimedeanClass +open scoped HahnSeries + +namespace HahnSeries.Nonpositive + +variable {K G R : Type*} {κ : Cardinal} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] [Fact (ℵ₀ < κ)] + +private theorem support_tau_subset (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧).support ⊆ (x : R⟦G⟧).support := by + intro g hg + by_cases hball : g ∈ ball K c + · rw [HahnSeries.mem_support, coeff_tau_of_mem c x hball] at hg + exact hg + · rw [HahnSeries.mem_support, coeff_tau_of_not_mem c x hball] at hg + exact (hg rfl).elim + +/-- The open truncation `τ_σ(x)`, regarded as an element of the bounded integer part. -/ +def tauIntegerPart (c : FiniteArchimedeanClass G) (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z := + ⟨⟨((tau (K := K) c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) : + Nonpositive G R) : R⟦G⟧), + (HahnSeries.cardSupp_mono (support_tau_subset c _)).trans_lt + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z x)⟩, by + rw [mem_cardSuppLTTruncationIntegerPart] + refine ⟨support_subset _, ?_⟩ + rw [coeff_tau_of_mem c _ (zero_mem _), + CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] + exact ((mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp x.2).2⟩ + +@[simp] +theorem toNonpositive_tauIntegerPart (c : FiniteArchimedeanClass G) (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z (tauIntegerPart (K := K) c Z x) = + tau (K := K) c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) := by + apply Subtype.ext + rw [CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] + rfl + +/-- The coefficient at zero of LM24's reduction is one when the open truncation is nonzero. -/ +theorem coeff_zero_rho_of_tau_ne_zero (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) (x : Nonpositive G R) (htau : tau (K := K) c x ≠ 0) : + ((rho u c x : Nonpositive G R) : R⟦G⟧).coeff 0 = 1 := by + rw [rho_of_tau_ne_zero u c x htau] + exact coeff_zero_reductionQuotient u c x _ + +/-- LM24's reduction `ρ_σ(x)`, regarded as an element of the bounded integer part. -/ +def rhoIntegerPart (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (hT : T (K := K) c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) = + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) + (htau : tau (K := K) c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) ≠ 0) : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z := by + refine ⟨(x : CardSuppLTField (G := G) (R := R) (κ := κ)) / + (tauIntegerPart (K := K) c Z x : CardSuppLTField (G := G) (R := R) (κ := κ)), ?_⟩ + have hτ : ((tauIntegerPart (K := K) c Z x : + CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧) ≠ 0 := by + intro h + apply htau + apply Subtype.ext + exact h + have hq : (((x : CardSuppLTField (G := G) (R := R) (κ := κ)) / + (tauIntegerPart (K := K) c Z x : CardSuppLTField (G := G) (R := R) (κ := κ)) : + CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧) = + ((rho u c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) : + Nonpositive G R) : R⟦G⟧) := by + have hmul := reductionQuotient_mul_tau u c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) + (fun hzero ↦ htau ((tauBall_eq_zero_iff c _).mp hzero)) + rw [← rho_of_tau_ne_zero u c _ htau, hT] at hmul + have hmul' := congrArg (fun q : Nonpositive G R ↦ (q : R⟦G⟧)) hmul + simp only [Subring.coe_mul] at hmul' + rw [Subfield.coe_div, div_eq_iff hτ] + change ((x : CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧) = + ((rho u c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) : + Nonpositive G R) : R⟦G⟧) * + ((tau (K := K) c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) : + Nonpositive G R) : R⟦G⟧) + rw [hmul', CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] + rw [mem_cardSuppLTTruncationIntegerPart, hq] + refine ⟨support_subset _, ?_⟩ + rw [coeff_zero_rho_of_tau_ne_zero u c _ htau] + exact Z.one_mem + +theorem toNonpositive_rhoIntegerPart (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (hT : T (K := K) c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) = + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) + (htau : tau (K := K) c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) ≠ 0) : + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z (rhoIntegerPart u c Z x hT htau) = + rho u c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) := by + apply Subtype.ext + rw [CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] + have hτ : ((tauIntegerPart (K := K) c Z x : + CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧) ≠ 0 := by + intro h + apply htau + apply Subtype.ext + exact h + have hmul := reductionQuotient_mul_tau u c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) + (fun hzero ↦ htau ((tauBall_eq_zero_iff c _).mp hzero)) + rw [← rho_of_tau_ne_zero u c _ htau, hT] at hmul + have hmul' := congrArg (fun q : Nonpositive G R ↦ (q : R⟦G⟧)) hmul + simp only [Subring.coe_mul] at hmul' + change (((x : CardSuppLTField (G := G) (R := R) (κ := κ)) / + (tauIntegerPart (K := K) c Z x : CardSuppLTField (G := G) (R := R) (κ := κ)) : + CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧) = _ + rw [Subfield.coe_div, div_eq_iff hτ] + change ((x : CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧) = + ((rho u c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) : + Nonpositive G R) : R⟦G⟧) * + ((tau (K := K) c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) : + Nonpositive G R) : R⟦G⟧) + rw [hmul', CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] + +/-- The factorisation `x = ρ_σ(x) τ_σ(x)` inside the bounded integer part. -/ +theorem rhoIntegerPart_mul_tauIntegerPart (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (hT : T (K := K) c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) = + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) + (htau : tau (K := K) c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) ≠ 0) : + rhoIntegerPart u c Z x hT htau * tauIntegerPart (K := K) c Z x = x := by + apply CardSuppLTTruncationIntegerPart.toNonpositiveRingHom_injective Z + rw [map_mul, toNonpositive_rhoIntegerPart, toNonpositive_tauIntegerPart, + rho_of_tau_ne_zero u c _ htau, reductionQuotient_mul_tau, hT] + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalIntegerPartSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalIntegerPartSplitting.lean new file mode 100644 index 0000000000..a3574f7788 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalIntegerPartSplitting.lean @@ -0,0 +1,433 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalPrimalityTransfer +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CoefficientMap +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring.Hom.OfInjectiveComp + +/-! +# Cardinal-bounded leading-class integer-part splitting + +This module restricts LM24, Fact 2.4.2(5) to Hahn series with support cardinality less than +`κ`. The forward split always respects the bound on every inner coefficient. For the inverse, +regularity of `κ` ensures that flattening the countable outer support over the Archimedean +stratum, whose coefficients each have support smaller than `κ`, again has support smaller than +`κ`. + +The regularity hypothesis records the exact set-sized cardinal closure used here. It is not folded +into the printed statement of LM24, where the intended omnific Hahn field has a proper-class +exponent group and every individual support remains a set. +-/ + +public noncomputable section + +open Cardinal FiniteArchimedeanClass + +namespace HahnSeries.Nonpositive + +variable {K G R : Type*} {κ : Cardinal} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] [Fact (ℵ₀ < κ)] + +/-- Embed the bounded inner Hahn field into the full inner Hahn field. -/ +def cardSuppLTInnerFieldSubtypeRingHom (c : FiniteArchimedeanClass G) : + CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ) →+* R⟦ball K c⟧ := + (cardSuppLTSubfield (ball K c) R κ).subtype + +/-- Forget the cardinal bound on every coefficient of an outer nonpositive Hahn series. -/ +def forgetCardSuppLTInnerCoefficients + (c : FiniteArchimedeanClass G) (u : HahnEmbedding.ArchimedeanStrata K G) : + Nonpositive (u.stratum c) + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ)) →+* + Nonpositive (u.stratum c) R⟦ball K c⟧ := + coefficientMapRingHom (cardSuppLTInnerFieldSubtypeRingHom c) + +/-- Forgetting bounded inner coefficients preserves their underlying Hahn series. -/ +@[simp] +theorem coeff_forgetCardSuppLTInnerCoefficients + (c : FiniteArchimedeanClass G) (u : HahnEmbedding.ArchimedeanStrata K G) + (y : Nonpositive (u.stratum c) + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))) (s : u.stratum c) : + (((forgetCardSuppLTInnerCoefficients c u y : Nonpositive + (u.stratum c) R⟦ball K c⟧) : (R⟦ball K c⟧)⟦u.stratum c⟧).coeff s) = + ((y : (CardSuppLTField (G := ↥(ball K c)) (R := R) + (κ := κ))⟦u.stratum c⟧).coeff s : R⟦ball K c⟧) := by + rw [forgetCardSuppLTInnerCoefficients, coe_coefficientMapRingHom, + HahnSeries.coefficientMapRingHom_coeff] + rfl + +/-- Forget the inner cardinal bounds on a split truncation integer part. -/ +def forgetSplitCardSuppLTIntegerPartRingHom + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) : + truncationIntegerPart (u.stratum c) + (cardSuppLTTruncationIntegerPart (G := ↥(ball K c)) (R := R) (κ := κ) Z) →+* + truncationIntegerPart (u.stratum c) + (innerIntegerPartSubring (K := K) (G := G) c Z) where + toFun y := ⟨forgetCardSuppLTInnerCoefficients (K := K) (R := R) (κ := κ) c u y, by + rw [mem_truncationIntegerPart] + rw [mem_innerIntegerPartSubring_iff] + have hy := (mem_truncationIntegerPart (Γ := u.stratum c) + (R := CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))).mp y.2 + rw [coeff_forgetCardSuppLTInnerCoefficients (K := K) (R := R) (κ := κ)] + exact (mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp hy⟩ + map_one' := Subtype.ext (map_one + (forgetCardSuppLTInnerCoefficients (K := K) (R := R) (κ := κ) c u)) + map_mul' x y := Subtype.ext (map_mul + (forgetCardSuppLTInnerCoefficients (K := K) (R := R) (κ := κ) c u) + (x : Nonpositive (u.stratum c) + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))) y) + map_zero' := Subtype.ext (map_zero + (forgetCardSuppLTInnerCoefficients (K := K) (R := R) (κ := κ) c u)) + map_add' x y := Subtype.ext (map_add + (forgetCardSuppLTInnerCoefficients (K := K) (R := R) (κ := κ) c u) + (x : Nonpositive (u.stratum c) + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))) y) + +/-- Forgetting the target bound acts by forgetting every inner coefficient. -/ +@[simp] +theorem coe_forgetSplitCardSuppLTIntegerPartRingHom + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (y : truncationIntegerPart (u.stratum c) + (cardSuppLTTruncationIntegerPart (G := ↥(ball K c)) (R := R) (κ := κ) Z)) : + ((forgetSplitCardSuppLTIntegerPartRingHom u c Z y : + truncationIntegerPart (u.stratum c) (innerIntegerPartSubring c Z)) : + Nonpositive (u.stratum c) R⟦ball K c⟧) = + forgetCardSuppLTInnerCoefficients (K := K) (R := R) (κ := κ) c u + (y : Nonpositive (u.stratum c) + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))) := + (rfl) + +/-- Forgetting bounds after the bounded split recovers the full integer-part split. -/ +theorem forget_splitTruncationCardSuppLTIntegerPart + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + forgetSplitCardSuppLTIntegerPartRingHom u c Z + (splitTruncationCardSuppLTIntegerPart u c Z b) = + splitIntegerPartRingHom u c Z + (CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom Z b) := by + apply Subtype.ext + rw [coe_forgetSplitCardSuppLTIntegerPartRingHom, coe_splitIntegerPartRingHom] + rw [coe_splitTruncationCardSuppLTIntegerPart] + rw [CardSuppLTTruncationIntegerPart.coe_toTruncationIntegerPartRingHom] + apply Subtype.ext + apply HahnSeries.ext + funext s + rw [coeff_forgetCardSuppLTInnerCoefficients] + exact coe_coeff_splitTruncationCardSuppLT u c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b) s + +/-- Forgetting bounded inner coefficients is injective on the split integer part. -/ +theorem forgetSplitCardSuppLTIntegerPartRingHom_injective + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) : + Function.Injective + (forgetSplitCardSuppLTIntegerPartRingHom (K := K) (R := R) (κ := κ) u c Z) := by + intro x y hxy + apply Subtype.ext + apply Subtype.ext + apply HahnSeries.ext + funext s + apply Subtype.ext + have hcoeff := congrArg (fun q : truncationIntegerPart (u.stratum c) + (innerIntegerPartSubring (K := K) (G := G) c Z) ↦ + ((q : Nonpositive (u.stratum c) R⟦ball K c⟧) : + (R⟦ball K c⟧)⟦u.stratum c⟧).coeff s) hxy + simpa only [coe_forgetSplitCardSuppLTIntegerPartRingHom (K := K) (R := R) (κ := κ), + coeff_forgetCardSuppLTInnerCoefficients (K := K) (R := R) (κ := κ)] using hcoeff + +/-- The leading-class split as a ring homomorphism on cardinal-bounded integer parts. -/ +def splitCardSuppLTIntegerPartRingHom + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z →+* + truncationIntegerPart (u.stratum c) + (cardSuppLTTruncationIntegerPart (G := ↥(ball K c)) (R := R) (κ := κ) Z) := + RingHom.ofInjectiveComp _ (forgetSplitCardSuppLTIntegerPartRingHom_injective u c Z) + ((splitIntegerPartRingHom u c Z).comp + (CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom Z)) + (splitTruncationCardSuppLTIntegerPart u c Z) + (forget_splitTruncationCardSuppLTIntegerPart u c Z) + +/-- The bounded split ring homomorphism applies by the bounded split construction. -/ +@[simp] +theorem splitCardSuppLTIntegerPartRingHom_apply + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + splitCardSuppLTIntegerPartRingHom u c Z b = + splitTruncationCardSuppLTIntegerPart u c Z b := + RingHom.ofInjectiveComp_apply _ _ _ _ _ b + +/-- The bounded fixed integer part is the preimage of the full fixed integer part under the +bound-forgetting homomorphism. -/ +def cardSuppLTFixedIntegerPartSubring + (c : FiniteArchimedeanClass G) (Z : Subring R) : + Subring (cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) := + (fixedIntegerPartSubring (K := K) (G := G) (R := R) c Z).comap + (CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom Z) + +/-- Forget the cardinal bound on a bounded fixed integer-part element. -/ +def forgetCardSuppLTFixedIntegerPartRingHom + (c : FiniteArchimedeanClass G) (Z : Subring R) : + cardSuppLTFixedIntegerPartSubring (K := K) (κ := κ) c Z →+* + fixedIntegerPartSubring (K := K) (G := G) (R := R) c Z where + toFun x := ⟨CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom Z + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z), x.2⟩ + map_one' := by + apply Subtype.ext + change CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom + (G := G) (R := R) (κ := κ) Z (1 : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) = 1 + rw [map_one] + map_mul' x y := by + apply Subtype.ext + change CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom Z + ((x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) * + (y : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z)) = _ + rw [map_mul] + rfl + map_zero' := by + apply Subtype.ext + change CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom + (G := G) (R := R) (κ := κ) Z (0 : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) = 0 + rw [map_zero] + map_add' x y := by + apply Subtype.ext + change CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom Z + ((x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + + (y : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z)) = _ + rw [map_add] + rfl + +/-- Forgetting a bounded fixed element uses the underlying bound-forgetting homomorphism. -/ +@[simp] +theorem coe_forgetCardSuppLTFixedIntegerPartRingHom + (c : FiniteArchimedeanClass G) (Z : Subring R) + (x : cardSuppLTFixedIntegerPartSubring (K := K) (κ := κ) c Z) : + (forgetCardSuppLTFixedIntegerPartRingHom c Z x : truncationIntegerPart G Z) = + CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom Z + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) := + (rfl) + +/-- Forgetting the bound is injective on bounded fixed integer-part elements. -/ +theorem forgetCardSuppLTFixedIntegerPartRingHom_injective + (c : FiniteArchimedeanClass G) (Z : Subring R) : + Function.Injective + (forgetCardSuppLTFixedIntegerPartRingHom (K := K) (κ := κ) c Z) := by + intro x y hxy + apply Subtype.ext + apply Subtype.ext + apply Subtype.ext + have hraw := congrArg (fun q : fixedIntegerPartSubring + (K := K) (G := G) (R := R) c Z ↦ + (((q : truncationIntegerPart G Z) : Nonpositive G R) : R⟦G⟧)) hxy + simpa only [coe_forgetCardSuppLTFixedIntegerPartRingHom, + CardSuppLTTruncationIntegerPart.coe_toTruncationIntegerPartRingHom, + CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] using hraw + +/-- Restrict the bounded split homomorphism to the bounded fixed integer part. -/ +def splitCardSuppLTFixedIntegerPartRingHom + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) : + cardSuppLTFixedIntegerPartSubring (K := K) (κ := κ) c Z →+* + truncationIntegerPart (u.stratum c) + (cardSuppLTTruncationIntegerPart (G := ↥(ball K c)) (R := R) (κ := κ) Z) := + (splitCardSuppLTIntegerPartRingHom u c Z).comp + (cardSuppLTFixedIntegerPartSubring (K := K) (κ := κ) c Z).subtype + +/-- The fixed bounded split is the unrestricted bounded split of the underlying element. -/ +@[simp] +theorem splitCardSuppLTFixedIntegerPartRingHom_apply + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (x : cardSuppLTFixedIntegerPartSubring (K := K) (κ := κ) c Z) : + splitCardSuppLTFixedIntegerPartRingHom u c Z x = + splitCardSuppLTIntegerPartRingHom u c Z + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) := + (rfl) + +/-- Forgetting bounds commutes with the fixed integer-part split. -/ +theorem forget_splitCardSuppLTFixedIntegerPartRingHom + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (x : cardSuppLTFixedIntegerPartSubring (K := K) (κ := κ) c Z) : + forgetSplitCardSuppLTIntegerPartRingHom u c Z + (splitCardSuppLTFixedIntegerPartRingHom u c Z x) = + splitFixedIntegerPartRingHom u c Z + (forgetCardSuppLTFixedIntegerPartRingHom c Z x) := by + rw [splitCardSuppLTFixedIntegerPartRingHom_apply, splitCardSuppLTIntegerPartRingHom_apply, + forget_splitTruncationCardSuppLTIntegerPart] + apply Subtype.ext + rw [coe_splitFixedIntegerPartRingHom, coe_splitIntegerPartRingHom] + rw [coe_forgetCardSuppLTFixedIntegerPartRingHom, + CardSuppLTTruncationIntegerPart.coe_toTruncationIntegerPartRingHom] + +/-- The full unsplit of a bounded outer integer-part element still has support smaller than a +regular `κ`. -/ +theorem cardSupp_unsplit_forgetSplitCardSuppLTIntegerPart_lt + [Fact κ.IsRegular] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (y : truncationIntegerPart (u.stratum c) + (cardSuppLTTruncationIntegerPart (G := ↥(ball K c)) (R := R) (κ := κ) Z)) : + ((((unsplitIntegerPart u c Z + (forgetSplitCardSuppLTIntegerPartRingHom u c Z y) : + truncationIntegerPart G Z) : Nonpositive G R) : R⟦G⟧).cardSupp) < κ := by + let yBounded : Nonpositive (u.stratum c) + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ)) := y + let yFull : Nonpositive (u.stratum c) R⟦ball K c⟧ := + forgetCardSuppLTInnerCoefficients c u yBounded + have houter : ((yFull : (R⟦ball K c⟧)⟦u.stratum c⟧).cardSupp) < κ := + (HahnSeries.cardSupp_le_aleph0_of_archimedean + (yFull : (R⟦ball K c⟧)⟦u.stratum c⟧)).trans_lt (Fact.out : ℵ₀ < κ) + have hcoeff : ∀ s, + (((yFull : (R⟦ball K c⟧)⟦u.stratum c⟧).coeff s).cardSupp) < κ := by + intro s + dsimp only [yFull] + rw [coeff_forgetCardSuppLTInnerCoefficients] + exact ((yBounded : + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))⟦u.stratum c⟧).coeff s).2 + have hflat : (HahnSeries.iterateRingEquiv + (yFull : (R⟦ball K c⟧)⟦u.stratum c⟧)).cardSupp < κ := + HahnSeries.cardSupp_iterateRingEquiv_lt_of_isRegular Fact.out + (yFull : (R⟦ball K c⟧)⟦u.stratum c⟧) houter hcoeff + let zClosed := (HahnSeries.archimedeanSplitRingEquiv u c).symm + (yFull : (R⟦ball K c⟧)⟦u.stratum c⟧) + have hsplit : HahnSeries.archimedeanSplitRingEquiv u c zClosed = + (yFull : (R⟦ball K c⟧)⟦u.stratum c⟧) := + (HahnSeries.archimedeanSplitRingEquiv u c).apply_symm_apply _ + have hiterate := iterateRingEquiv_archimedeanSplitRingEquiv u c zClosed + rw [hsplit] at hiterate + have hzClosed : zClosed.cardSupp < κ := by + rw [← HahnSeries.cardSupp_embDomainRingEquiv + (HahnEmbedding.ArchimedeanStrata.closedBallEquivStratumLexBall u c) zClosed] + rw [← hiterate] + exact hflat + rw [coe_unsplitIntegerPart] + rw [HahnSeries.cardSupp_embDomain] + exact hzClosed + +/-- Unsplit a bounded outer integer-part element and retain the support-cardinality witness. -/ +def unsplitCardSuppLTIntegerPart + [Fact κ.IsRegular] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (y : truncationIntegerPart (u.stratum c) + (cardSuppLTTruncationIntegerPart (G := ↥(ball K c)) (R := R) (κ := κ) Z)) : + cardSuppLTFixedIntegerPartSubring (K := K) (κ := κ) c Z := by + let xFull := unsplitIntegerPart u c Z + (forgetSplitCardSuppLTIntegerPartRingHom u c Z y) + let xBounded : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z := + ⟨⟨((xFull : truncationIntegerPart G Z) : Nonpositive G R), + cardSupp_unsplit_forgetSplitCardSuppLTIntegerPart_lt u c Z y⟩, + by + rw [mem_cardSuppLTTruncationIntegerPart] + exact ⟨support_subset ((xFull : truncationIntegerPart G Z) : Nonpositive G R), + (mem_truncationIntegerPart (Γ := G) (R := R)).mp + (xFull : truncationIntegerPart G Z).2⟩⟩ + refine ⟨xBounded, ?_⟩ + change CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom Z xBounded ∈ + fixedIntegerPartSubring (K := K) (G := G) (R := R) c Z + have hx : CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom Z xBounded = + (xFull : truncationIntegerPart G Z) := by + apply Subtype.ext + rw [CardSuppLTTruncationIntegerPart.coe_toTruncationIntegerPartRingHom] + apply Subtype.ext + rw [CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] + rw [hx] + exact xFull.2 + +/-- Forgetting the source bound after bounded unsplitting recovers the full unsplit. -/ +theorem forget_unsplitCardSuppLTIntegerPart + [Fact κ.IsRegular] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (y : truncationIntegerPart (u.stratum c) + (cardSuppLTTruncationIntegerPart (G := ↥(ball K c)) (R := R) (κ := κ) Z)) : + forgetCardSuppLTFixedIntegerPartRingHom c Z + (unsplitCardSuppLTIntegerPart u c Z y) = + unsplitIntegerPart u c Z + (forgetSplitCardSuppLTIntegerPartRingHom u c Z y) := by + apply Subtype.ext + rw [coe_forgetCardSuppLTFixedIntegerPartRingHom] + apply Subtype.ext + rw [CardSuppLTTruncationIntegerPart.coe_toTruncationIntegerPartRingHom] + apply Subtype.ext + rw [CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] + rfl + +/-- For regular `κ`, the bounded fixed integer part is equivalent to the outer integer part over +the bounded inner coefficient integer part. -/ +def splitCardSuppLTFixedIntegerPartRingEquiv + [Fact κ.IsRegular] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) : + cardSuppLTFixedIntegerPartSubring (K := K) (κ := κ) c Z ≃+* + truncationIntegerPart (u.stratum c) + (cardSuppLTTruncationIntegerPart (G := ↥(ball K c)) (R := R) (κ := κ) Z) where + toFun := splitCardSuppLTFixedIntegerPartRingHom u c Z + invFun := unsplitCardSuppLTIntegerPart u c Z + left_inv x := by + apply forgetCardSuppLTFixedIntegerPartRingHom_injective c Z + rw [forget_unsplitCardSuppLTIntegerPart, + forget_splitCardSuppLTFixedIntegerPartRingHom] + rw [← splitFixedIntegerPartRingEquiv_apply, + ← splitFixedIntegerPartRingEquiv_symm_apply] + exact (splitFixedIntegerPartRingEquiv u c Z).left_inv _ + right_inv y := by + apply forgetSplitCardSuppLTIntegerPartRingHom_injective u c Z + rw [forget_splitCardSuppLTFixedIntegerPartRingHom, + forget_unsplitCardSuppLTIntegerPart] + rw [← splitFixedIntegerPartRingEquiv_apply, + ← splitFixedIntegerPartRingEquiv_symm_apply] + exact (splitFixedIntegerPartRingEquiv u c Z).right_inv _ + map_mul' := (splitCardSuppLTFixedIntegerPartRingHom u c Z).map_mul + map_add' := (splitCardSuppLTFixedIntegerPartRingHom u c Z).map_add + +/-- The bounded fixed equivalence applies by the bounded split ring homomorphism. -/ +@[simp] +theorem splitCardSuppLTFixedIntegerPartRingEquiv_apply + [Fact κ.IsRegular] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (x : cardSuppLTFixedIntegerPartSubring (K := K) (κ := κ) c Z) : + splitCardSuppLTFixedIntegerPartRingEquiv u c Z x = + splitCardSuppLTFixedIntegerPartRingHom u c Z x := + (rfl) + +/-- The inverse bounded fixed equivalence is the bounded unsplit construction. -/ +@[simp] +theorem splitCardSuppLTFixedIntegerPartRingEquiv_symm_apply + [Fact κ.IsRegular] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (y : truncationIntegerPart (u.stratum c) + (cardSuppLTTruncationIntegerPart (G := ↥(ball K c)) (R := R) (κ := κ) Z)) : + (splitCardSuppLTFixedIntegerPartRingEquiv u c Z).symm y = + unsplitCardSuppLTIntegerPart u c Z y := + (rfl) + +/-- Membership in the bounded fixed integer part is invariance under the closed-class cut. -/ +theorem mem_cardSuppLTFixedIntegerPartSubring_iff + (c : FiniteArchimedeanClass G) (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + x ∈ cardSuppLTFixedIntegerPartSubring (K := K) c Z ↔ + T (K := K) c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) = + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x := by + change CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom Z x ∈ + fixedIntegerPartSubring (K := K) (G := G) (R := R) c Z ↔ _ + rw [mem_fixedIntegerPartSubring_iff] + rw [CardSuppLTTruncationIntegerPart.coe_toTruncationIntegerPartRingHom] + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalPrimalityTransfer.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalPrimalityTransfer.lean new file mode 100644 index 0000000000..3bf7ef6a49 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalPrimalityTransfer.lean @@ -0,0 +1,144 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Assumptions +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IntegerPartSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.TruncationIntegerPartPrimal + +/-! +# Local primality transfer for cardinal-bounded Hahn series + +This module applies LM24, Lemma 9.2.1 after the leading-class split has been bundled over the +bounded inner Hahn field. In the zero-residue branch, the exact nonzero-class specialization of +`(A2)_σ` supplies the fraction-field equality. In the residue-one branch no form of `(A2)_σ` is +used. + +The remaining step toward LM24, Proposition 9.2.2 is the bounded restriction of the source-side +fixed-ring equivalence. It is kept separate from this local residue calculation. +-/ + +public noncomputable section + +open Cardinal FiniteArchimedeanClass + +namespace HahnSeries.Nonpositive + +variable {K G R : Type*} {κ : Cardinal} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] [Fact (ℵ₀ < κ)] + +/-- The bounded split truncation in the outer integer part whose coefficient subring is the +bounded inner truncation integer part. -/ +def splitTruncationCardSuppLTIntegerPart + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + truncationIntegerPart (u.stratum c) + (cardSuppLTTruncationIntegerPart (G := ↥(ball K c)) (R := R) (κ := κ) Z) := by + let bFull := CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom Z b + let bNP := CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b + let hb := CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b + let y := splitTruncationCardSuppLT u c bNP hb + refine ⟨y, ?_⟩ + rw [mem_truncationIntegerPart] + rw [← constantCoeff_apply] + rw [show constantCoeff y = constantCoeff (splitTruncationCardSuppLT u c bNP hb) from rfl] + rw [mem_cardSuppLTTruncationIntegerPart] + constructor + · rw [coe_constantCoeff_splitTruncationCardSuppLT] + have htau := tauBall_mem_innerIntegerPartSubring (K := K) (G := G) c Z bFull + rw [CardSuppLTTruncationIntegerPart.coe_toTruncationIntegerPartRingHom] at htau + exact (mem_innerIntegerPartSubring_iff (K := K) c Z _).mp htau |>.1 + · rw [coe_constantCoeff_splitTruncationCardSuppLT, + coeff_zero_tauBall (K := K)] + rw [show (bNP : R⟦G⟧) = + (b : CardSuppLTField (G := G) (R := R) (κ := κ)) by + exact CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom Z b] + exact (mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp b.2 |>.2 + +/-- The bounded split integer-part element has the underlying bounded split truncation. -/ +@[simp] +theorem coe_splitTruncationCardSuppLTIntegerPart + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + ((splitTruncationCardSuppLTIntegerPart u c Z b : + truncationIntegerPart (u.stratum c) + (cardSuppLTTruncationIntegerPart (G := ↥(ball K c)) (R := R) (κ := κ) Z)) : + Nonpositive (u.stratum c) + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))) = + splitTruncationCardSuppLT u c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b) := + (rfl) + +/-- In the residue-one branch, primality in the split bounded integer part is ambient primality. -/ +theorem isPrimal_splitTruncationCardSuppLTIntegerPart_iff_of_tau_eq_one + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (htau : tauBall (K := K) c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) = 1) : + IsPrimal (splitTruncationCardSuppLTIntegerPart u c Z b) ↔ + IsPrimal (splitTruncationCardSuppLT u c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b)) := by + apply isPrimal_truncationIntegerPart_iff_of_constantCoeff_eq_one + (cardSuppLTTruncationIntegerPart (G := ↥(ball K c)) (R := R) (κ := κ) Z) + rw [constantCoeffAlgHom_apply] + apply Subtype.ext + rw [show ((splitTruncationCardSuppLTIntegerPart u c Z b : + Nonpositive (u.stratum c) + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))) : + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))⟦u.stratum c⟧).coeff 0 = + ((splitTruncationCardSuppLT u c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b) : + Nonpositive (u.stratum c) + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))) : + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))⟦u.stratum c⟧).coeff 0 from rfl] + rw [coe_coeff_splitTruncationCardSuppLT] + rw [← constantCoeff_apply, constantCoeff_splitTruncation, htau] + rfl + +/-- In the residue-zero branch, `(A2)_σ` identifies primality in the split bounded integer part +with ambient primality. -/ +theorem isPrimal_splitTruncationCardSuppLTIntegerPart_iff_of_tau_eq_zero + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (hA2 : LM24.AssumptionA2AtFiniteClass (K := K) κ Z c) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (htau : tauBall (K := K) c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) = 0) : + IsPrimal (splitTruncationCardSuppLTIntegerPart u c Z b) ↔ + IsPrimal (splitTruncationCardSuppLT u c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b)) := by + apply isPrimal_truncationIntegerPart_iff_of_constantCoeff_eq_zero + (cardSuppLTTruncationIntegerPart (G := ↥(ball K c)) (R := R) (κ := κ) Z) + (LM24.fracSubring_cardSuppLTTruncationIntegerPart_eq_top_of_assumptionA2AtFiniteClass + Z c hA2) + rw [constantCoeffAlgHom_apply] + apply Subtype.ext + rw [show ((splitTruncationCardSuppLTIntegerPart u c Z b : + Nonpositive (u.stratum c) + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))) : + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))⟦u.stratum c⟧).coeff 0 = + ((splitTruncationCardSuppLT u c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b) : + Nonpositive (u.stratum c) + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))) : + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))⟦u.stratum c⟧).coeff 0 from rfl] + rw [coe_coeff_splitTruncationCardSuppLT] + rw [← constantCoeff_apply, constantCoeff_splitTruncation] + exact htau + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalProposition922.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalProposition922.lean new file mode 100644 index 0000000000..b3f46f276e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalProposition922.lean @@ -0,0 +1,588 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalIntegerPartSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.PrimalityTransfer + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# LM24 Proposition 9.2.2 for cardinal-bounded Hahn fields + +This module proves the set-sized, cardinal-bounded form of LM24, Proposition 9.2.2. Closed-class +truncation preserves the bound directly. Its divisibility-localization converse stays bounded +because a quotient of two `< κ`-supported Hahn series again has support smaller than the +uncountable cardinal `κ`. + +The bounded fixed-ring equivalence used later requires regularity of `κ`; that hypothesis records +the countable-union closure needed to flatten arbitrary bounded inner coefficients. The +hypothesis `(A2)_σ` is needed only in the zero-residue branch. +-/ + +public noncomputable section + +open Cardinal FiniteArchimedeanClass + +namespace HahnSeries.Nonpositive + +variable {K G R : Type*} {κ : Cardinal} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] [Fact (ℵ₀ < κ)] + +/-- Closed-class truncation does not increase support cardinality. -/ +theorem cardSupp_T_le (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + ((T (K := K) c x : Nonpositive G R) : R⟦G⟧).cardSupp ≤ (x : R⟦G⟧).cardSupp := + HahnSeries.cardSupp_mono (support_T_subset c x) + +/-- Closed-class truncation restricted to a cardinal-bounded truncation integer part. -/ +def TCardSuppLTIntegerPartRingHom + (c : FiniteArchimedeanClass G) (Z : Subring R) : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z →+* + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z where + toFun x := by + let xNP := CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x + let tx := T (K := K) c xNP + refine ⟨⟨(tx : R⟦G⟧), (cardSupp_T_le c xNP).trans_lt + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z x)⟩, ?_⟩ + rw [mem_cardSuppLTTruncationIntegerPart] + constructor + · exact support_subset tx + · rw [show (tx : R⟦G⟧).coeff 0 = (xNP : R⟦G⟧).coeff 0 by + exact coeff_T_of_mem c xNP (zero_mem _)] + rw [CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] + exact (mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp x.2 |>.2 + map_one' := by + apply Subtype.ext + apply Subtype.ext + change (((T (K := K) c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z (1 : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z)) : + Nonpositive G R) : R⟦G⟧)) = 1 + rw [map_one, map_one] + rfl + map_mul' x y := by + apply Subtype.ext + apply Subtype.ext + change (((T (K := K) c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z (x * y)) : + Nonpositive G R) : R⟦G⟧)) = _ + rw [map_mul, map_mul] + rfl + map_zero' := by + apply Subtype.ext + apply Subtype.ext + change (((T (K := K) c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z (0 : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z)) : + Nonpositive G R) : R⟦G⟧)) = 0 + rw [map_zero, map_zero] + rfl + map_add' x y := by + apply Subtype.ext + apply Subtype.ext + change (((T (K := K) c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z (x + y)) : + Nonpositive G R) : R⟦G⟧)) = _ + rw [map_add, map_add] + rfl + +/-- The bounded truncation homomorphism has the expected underlying nonpositive series. -/ +@[simp] +theorem toNonpositive_TCardSuppLTIntegerPartRingHom + (c : FiniteArchimedeanClass G) (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z + (TCardSuppLTIntegerPartRingHom (K := K) c Z x) = + T (K := K) c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) := by + apply Subtype.ext + rw [CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] + rfl + +/-- Forgetting the cardinal bound commutes with closed-class truncation. -/ +theorem toTruncationIntegerPart_TCardSuppLTIntegerPartRingHom + (c : FiniteArchimedeanClass G) (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom Z + (TCardSuppLTIntegerPartRingHom (K := K) c Z x) = + TIntegerPartRingHom (K := K) c Z + (CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom Z x) := by + apply Subtype.ext + rw [coe_TIntegerPartRingHom, + CardSuppLTTruncationIntegerPart.coe_toTruncationIntegerPartRingHom] + rw [toNonpositive_TCardSuppLTIntegerPartRingHom] + rw [CardSuppLTTruncationIntegerPart.coe_toTruncationIntegerPartRingHom] + +/-- A bounded integer-part element is fixed by bounded truncation exactly when its underlying +nonpositive series is fixed. -/ +theorem TCardSuppLTIntegerPartRingHom_eq_iff + (c : FiniteArchimedeanClass G) (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + TCardSuppLTIntegerPartRingHom (K := K) c Z x = x ↔ + T (K := K) c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) = + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x := by + constructor + · intro h + have h' := congrArg + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom + (G := G) (R := R) (κ := κ) Z) h + rwa [toNonpositive_TCardSuppLTIntegerPartRingHom] at h' + · intro h + apply CardSuppLTTruncationIntegerPart.toNonpositiveRingHom_injective Z + rwa [toNonpositive_TCardSuppLTIntegerPartRingHom] + +/-- Bounded closed-class truncation is idempotent. -/ +@[simp] +theorem TCardSuppLTIntegerPartRingHom_TCardSuppLTIntegerPartRingHom + (c : FiniteArchimedeanClass G) (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + TCardSuppLTIntegerPartRingHom (K := K) c Z + (TCardSuppLTIntegerPartRingHom (K := K) c Z x) = + TCardSuppLTIntegerPartRingHom (K := K) c Z x := by + apply (TCardSuppLTIntegerPartRingHom_eq_iff c Z _).mpr + rw [toNonpositive_TCardSuppLTIntegerPartRingHom] + exact T_T c (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) + +/-- Divisibility by a nonzero fixed bounded integer-part element can be tested after closed-class +truncation, with the quotient remaining cardinal-bounded. -/ +theorem dvd_iff_dvd_TCardSuppLTIntegerPart_of_fixed + (c : FiniteArchimedeanClass G) (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (hb0 : CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b ≠ 0) + (hbFixed : T (K := K) c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) = + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + b ∣ x ↔ b ∣ TCardSuppLTIntegerPartRingHom (K := K) c Z x := by + let f := CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom + (G := G) (R := R) (κ := κ) Z + have hbFixedBounded : TCardSuppLTIntegerPartRingHom (K := K) c Z b = b := + (TCardSuppLTIntegerPartRingHom_eq_iff c Z b).mpr hbFixed + constructor + · rintro ⟨q, hq⟩ + refine ⟨TCardSuppLTIntegerPartRingHom (K := K) c Z q, ?_⟩ + calc + TCardSuppLTIntegerPartRingHom (K := K) c Z x = + TCardSuppLTIntegerPartRingHom (K := K) c Z (b * q) := congrArg _ hq + _ = TCardSuppLTIntegerPartRingHom (K := K) c Z b * + TCardSuppLTIntegerPartRingHom (K := K) c Z q := map_mul _ _ _ + _ = b * TCardSuppLTIntegerPartRingHom (K := K) c Z q := by rw [hbFixedBounded] + · intro h + have hFullT0 : f b ∣ f (TCardSuppLTIntegerPartRingHom (K := K) c Z x) := + map_dvd f h + have hFullT : f b ∣ TIntegerPartRingHom (K := K) c Z (f x) := by + rw [← toTruncationIntegerPart_TCardSuppLTIntegerPartRingHom] + exact hFullT0 + have hbFull0 : (f b : Nonpositive G R) ≠ 0 := by + rw [CardSuppLTTruncationIntegerPart.coe_toTruncationIntegerPartRingHom] + exact hb0 + have hbFullFixed : T (K := K) c (f b : Nonpositive G R) = f b := by + rw [CardSuppLTTruncationIntegerPart.coe_toTruncationIntegerPartRingHom] + exact hbFixed + have hFull : f b ∣ f x := + (dvd_iff_dvd_TIntegerPart_of_fixed c Z (f b) hbFull0 hbFullFixed (f x)).mpr hFullT + obtain ⟨q, hq⟩ := hFull + let bRaw : R⟦G⟧ := CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b + let xRaw : R⟦G⟧ := CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x + let qRaw : R⟦G⟧ := (q : Nonpositive G R) + have hbRaw0 : bRaw ≠ 0 := by + intro hzero + apply hb0 + exact Subtype.ext hzero + have hprod : xRaw = bRaw * qRaw := by + have hraw := congrArg (fun z : truncationIntegerPart G Z ↦ + ((z : Nonpositive G R) : R⟦G⟧)) hq + have hfx : (((f x : truncationIntegerPart G Z) : Nonpositive G R) : R⟦G⟧) = + xRaw := by + calc + _ = (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x : R⟦G⟧) := + congrArg Subtype.val + (CardSuppLTTruncationIntegerPart.coe_toTruncationIntegerPartRingHom Z x) + _ = xRaw := rfl + have hfb : (((f b : truncationIntegerPart G Z) : Nonpositive G R) : R⟦G⟧) = + bRaw := by + calc + _ = (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b : R⟦G⟧) := + congrArg Subtype.val + (CardSuppLTTruncationIntegerPart.coe_toTruncationIntegerPartRingHom Z b) + _ = bRaw := rfl + have hmul : ((((f b) * q : truncationIntegerPart G Z) : Nonpositive G R) : R⟦G⟧) = + (((f b : truncationIntegerPart G Z) : Nonpositive G R) : R⟦G⟧) * qRaw := + (rfl) + rw [hfx, hmul, hfb] at hraw + exact hraw + have hqDiv : qRaw = xRaw / bRaw := (eq_div_iff hbRaw0).mpr (by + calc + qRaw * bRaw = bRaw * qRaw := mul_comm _ _ + _ = xRaw := hprod.symm) + have hbCard : bRaw.cardSupp < κ := by + exact CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b + have hxCard : xRaw.cardSupp < κ := by + exact CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z x + have hqCard : qRaw.cardSupp < κ := by + rw [hqDiv] + exact (HahnSeries.cardSupp_div_le xRaw bRaw).trans_lt + (Cardinal.mul_lt_of_lt (Fact.out : ℵ₀ < κ).le hxCard + (max_lt (Fact.out : ℵ₀ < κ) hbCard)) + let qBounded : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z := + ⟨⟨qRaw, hqCard⟩, by + rw [mem_cardSuppLTTruncationIntegerPart] + exact ⟨support_subset (q : Nonpositive G R), + (mem_truncationIntegerPart (Γ := G) (R := R)).mp q.2⟩⟩ + refine ⟨qBounded, ?_⟩ + apply Subtype.ext + apply Subtype.ext + have hxval : ((x : CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧) = + xRaw := + (CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom Z x).symm + have hbval : ((b : CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧) = + bRaw := + (CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom Z b).symm + have hqval : ((qBounded : CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧) = + qRaw := + (rfl) + have hmul : (((b * qBounded : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧) = + ((b : CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧) * + ((qBounded : CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧) := + (rfl) + rw [hxval, hmul, hbval, hqval] + exact hprod + +/-- Membership in the bounded fixed subring can be stated using the bundled bounded truncation +homomorphism. -/ +theorem mem_cardSuppLTFixedIntegerPartSubring_iff_TCardSuppLT + (c : FiniteArchimedeanClass G) (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + x ∈ cardSuppLTFixedIntegerPartSubring (K := K) c Z ↔ + TCardSuppLTIntegerPartRingHom (K := K) c Z x = x := + (mem_cardSuppLTFixedIntegerPartSubring_iff c Z x).trans + (TCardSuppLTIntegerPartRingHom_eq_iff c Z x).symm + +/-- A nonconstant bounded integer-part element, regarded in the bounded subring fixed at its +leading Archimedean class. -/ +def leadingCardSuppLTFixedIntegerPartElement + (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (horder : ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b : + Nonpositive G R) : R⟦G⟧).order ≠ 0) : + cardSuppLTFixedIntegerPartSubring (K := K) (κ := κ) + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) Z := + ⟨b, (mem_cardSuppLTFixedIntegerPartSubring_iff _ Z b).mpr + (T_leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder)⟩ + +/-- The leading bounded fixed element has the original bounded integer-part element as value. -/ +@[simp] +theorem coe_leadingCardSuppLTFixedIntegerPartElement + (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (horder : ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b : + Nonpositive G R) : R⟦G⟧).order ≠ 0) : + (leadingCardSuppLTFixedIntegerPartElement (K := K) Z b horder : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) = b := + (rfl) + +/-- Primality of a nonzero nonconstant bounded integer-part element is unchanged when restricted +to the bounded subring fixed by truncation at its leading class. -/ +theorem isPrimal_leadingCardSuppLTFixedIntegerPartElement_iff + (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (hb0 : CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b ≠ 0) + (horder : ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b : + Nonpositive G R) : R⟦G⟧).order ≠ 0) : + IsPrimal (leadingCardSuppLTFixedIntegerPartElement (K := K) Z b horder) ↔ + IsPrimal b := by + let sigma := leadingClass + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder + let t := TCardSuppLTIntegerPartRingHom (K := K) (R := R) (κ := κ) sigma Z + have hbFixed : t b = b := + (TCardSuppLTIntegerPartRingHom_eq_iff sigma Z b).mpr + (T_leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) + constructor + · intro h x y hdvd + obtain ⟨q, hq⟩ := hdvd + have hdivLocal : leadingCardSuppLTFixedIntegerPartElement (K := K) Z b horder ∣ + ⟨t x, (mem_cardSuppLTFixedIntegerPartSubring_iff_TCardSuppLT sigma Z _).mpr + (TCardSuppLTIntegerPartRingHom_TCardSuppLTIntegerPartRingHom sigma Z x)⟩ * + ⟨t y, (mem_cardSuppLTFixedIntegerPartSubring_iff_TCardSuppLT sigma Z _).mpr + (TCardSuppLTIntegerPartRingHom_TCardSuppLTIntegerPartRingHom sigma Z y)⟩ := by + refine ⟨⟨t q, (mem_cardSuppLTFixedIntegerPartSubring_iff_TCardSuppLT sigma Z _).mpr + (TCardSuppLTIntegerPartRingHom_TCardSuppLTIntegerPartRingHom sigma Z q)⟩, ?_⟩ + apply Subtype.ext + change t x * t y = b * t q + rw [← map_mul] + rw [show x * y = b * q from hq] + rw [map_mul, hbFixed] + obtain ⟨b₁, b₂, h₁, h₂, hprod⟩ := h hdivLocal + have hprodSource : b = + (b₁ : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) * + (b₂ : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) := + congrArg Subtype.val hprod + have hb₁Ne : CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z + (b₁ : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) ≠ 0 := by + intro hz + apply hb0 + rw [show CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b = + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z + ((b₁ : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) * + (b₂ : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z)) by + exact congrArg _ hprodSource] + rw [map_mul, hz, zero_mul] + have hb₂Ne : CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z + (b₂ : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) ≠ 0 := by + intro hz + apply hb0 + rw [show CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b = + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z + ((b₁ : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) * + (b₂ : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z)) by + exact congrArg _ hprodSource] + rw [map_mul, hz, mul_zero] + have hfix₁ := (mem_cardSuppLTFixedIntegerPartSubring_iff sigma Z _).mp b₁.2 + have hfix₂ := (mem_cardSuppLTFixedIntegerPartSubring_iff sigma Z _).mp b₂.2 + have hiff₁ := dvd_iff_dvd_TCardSuppLTIntegerPart_of_fixed sigma Z b₁ hb₁Ne hfix₁ x + have hiff₂ := dvd_iff_dvd_TCardSuppLTIntegerPart_of_fixed sigma Z b₂ hb₂Ne hfix₂ y + have hmap₁ := map_dvd (cardSuppLTFixedIntegerPartSubring (K := K) (κ := κ) sigma Z).subtype h₁ + have hmap₂ := map_dvd (cardSuppLTFixedIntegerPartSubring (K := K) (κ := κ) sigma Z).subtype h₂ + exact ⟨_, _, hiff₁.mpr hmap₁, hiff₂.mpr hmap₂, hprodSource⟩ + · intro h x y hdvd + have hdvdSource : b ∣ + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) * y := + map_dvd (cardSuppLTFixedIntegerPartSubring + (K := K) (κ := κ) sigma Z).subtype hdvd + obtain ⟨b₁, b₂, h₁, h₂, hprod⟩ := h hdvdSource + have hb₁Mem : t b₁ = b₁ := + (TCardSuppLTIntegerPartRingHom_eq_iff sigma Z b₁).mpr (by + apply T_leadingClass_of_dvd + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) hb0 horder + exact map_dvd (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom + (G := G) (R := R) (κ := κ) Z) + (hprod.symm ▸ dvd_mul_right b₁ b₂)) + have hb₂Mem : t b₂ = b₂ := + (TCardSuppLTIntegerPartRingHom_eq_iff sigma Z b₂).mpr (by + apply T_leadingClass_of_dvd + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) hb0 horder + exact map_dvd (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom + (G := G) (R := R) (κ := κ) Z) + (hprod.symm ▸ dvd_mul_left b₂ b₁)) + have hb₁Ne : b₁ ≠ 0 := by + intro hz + apply hb0 + rw [show b = b₁ * b₂ from hprod, hz, zero_mul, map_zero] + have hb₂Ne : b₂ ≠ 0 := by + intro hz + apply hb0 + rw [show b = b₁ * b₂ from hprod, hz, mul_zero, map_zero] + have hq₁Mem : t h₁.choose = h₁.choose := by + apply mul_left_cancel₀ hb₁Ne + calc + b₁ * t h₁.choose = t b₁ * t h₁.choose := by rw [hb₁Mem] + _ = t (b₁ * h₁.choose) := (map_mul t b₁ h₁.choose).symm + _ = t (x : cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z) := congrArg t h₁.choose_spec.symm + _ = (x : cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z) := + (mem_cardSuppLTFixedIntegerPartSubring_iff_TCardSuppLT sigma Z _).mp x.2 + _ = b₁ * h₁.choose := h₁.choose_spec + have hq₂Mem : t h₂.choose = h₂.choose := by + apply mul_left_cancel₀ hb₂Ne + calc + b₂ * t h₂.choose = t b₂ * t h₂.choose := by rw [hb₂Mem] + _ = t (b₂ * h₂.choose) := (map_mul t b₂ h₂.choose).symm + _ = t (y : cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z) := congrArg t h₂.choose_spec.symm + _ = (y : cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z) := + (mem_cardSuppLTFixedIntegerPartSubring_iff_TCardSuppLT sigma Z _).mp y.2 + _ = b₂ * h₂.choose := h₂.choose_spec + refine ⟨⟨b₁, (mem_cardSuppLTFixedIntegerPartSubring_iff_TCardSuppLT sigma Z _).mpr hb₁Mem⟩, + ⟨b₂, (mem_cardSuppLTFixedIntegerPartSubring_iff_TCardSuppLT sigma Z _).mpr hb₂Mem⟩, + ?_, ?_, ?_⟩ + · exact ⟨⟨h₁.choose, + (mem_cardSuppLTFixedIntegerPartSubring_iff_TCardSuppLT sigma Z _).mpr hq₁Mem⟩, + Subtype.ext h₁.choose_spec⟩ + · exact ⟨⟨h₂.choose, + (mem_cardSuppLTFixedIntegerPartSubring_iff_TCardSuppLT sigma Z _).mpr hq₂Mem⟩, + Subtype.ext h₂.choose_spec⟩ + · exact Subtype.ext hprod + +/-- Splitting the leading bounded fixed element gives the bounded split truncation integer-part +element. -/ +theorem splitCardSuppLTFixedIntegerPartRingEquiv_leadingElement + [Fact κ.IsRegular] + (u : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (horder : ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b : + Nonpositive G R) : R⟦G⟧).order ≠ 0) : + splitCardSuppLTFixedIntegerPartRingEquiv u + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) Z + (leadingCardSuppLTFixedIntegerPartElement (K := K) Z b horder) = + splitTruncationCardSuppLTIntegerPart u + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) Z b := by + rw [splitCardSuppLTFixedIntegerPartRingEquiv_apply, + splitCardSuppLTFixedIntegerPartRingHom_apply, + splitCardSuppLTIntegerPartRingHom_apply, + coe_leadingCardSuppLTFixedIntegerPartElement] + +/-- In the residue-one branch of LM24, Proposition 9.2.2, bounded source primality is equivalent +to ambient primality of the bounded split truncation, without `(A2)_σ`. -/ +theorem isPrimal_iff_isPrimal_splitTruncationCardSuppLT_of_tau_eq_one + [Fact κ.IsRegular] + (u : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (hb0 : CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b ≠ 0) + (horder : ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b : + Nonpositive G R) : R⟦G⟧).order ≠ 0) + (htau : tauBall (K := K) + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) = 1) : + IsPrimal b ↔ + IsPrimal (splitTruncationCardSuppLT u + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b)) := by + let sigma := leadingClass + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder + let bFixed := leadingCardSuppLTFixedIntegerPartElement (K := K) Z b horder + let e := splitCardSuppLTFixedIntegerPartRingEquiv (R := R) (κ := κ) u sigma Z + calc + IsPrimal b ↔ IsPrimal bFixed := + (isPrimal_leadingCardSuppLTFixedIntegerPartElement_iff Z b hb0 horder).symm + _ ↔ IsPrimal (e bFixed) := (RingEquiv.isPrimal_iff e bFixed).symm + _ ↔ IsPrimal (splitTruncationCardSuppLTIntegerPart u sigma Z b) := by + rw [show e bFixed = splitTruncationCardSuppLTIntegerPart u sigma Z b by + exact splitCardSuppLTFixedIntegerPartRingEquiv_leadingElement u Z b horder] + _ ↔ IsPrimal (splitTruncationCardSuppLT u sigma + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b)) := + isPrimal_splitTruncationCardSuppLTIntegerPart_iff_of_tau_eq_one + u sigma Z b htau + +/-- In the residue-zero branch of LM24, Proposition 9.2.2, exact assumption `(A2)_σ` supplies the +bounded inner fraction-field equality. -/ +theorem isPrimal_iff_isPrimal_splitTruncationCardSuppLT_of_tau_eq_zero + [Fact κ.IsRegular] + (u : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (hb0 : CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b ≠ 0) + (horder : ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b : + Nonpositive G R) : R⟦G⟧).order ≠ 0) + (hA2 : LM24.AssumptionA2AtFiniteClass (K := K) κ Z + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder)) + (htau : tauBall (K := K) + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) = 0) : + IsPrimal b ↔ + IsPrimal (splitTruncationCardSuppLT u + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b)) := by + let sigma := leadingClass + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder + let bFixed := leadingCardSuppLTFixedIntegerPartElement (K := K) Z b horder + let e := splitCardSuppLTFixedIntegerPartRingEquiv (R := R) (κ := κ) u sigma Z + calc + IsPrimal b ↔ IsPrimal bFixed := + (isPrimal_leadingCardSuppLTFixedIntegerPartElement_iff Z b hb0 horder).symm + _ ↔ IsPrimal (e bFixed) := (RingEquiv.isPrimal_iff e bFixed).symm + _ ↔ IsPrimal (splitTruncationCardSuppLTIntegerPart u sigma Z b) := by + rw [show e bFixed = splitTruncationCardSuppLTIntegerPart u sigma Z b by + exact splitCardSuppLTFixedIntegerPartRingEquiv_leadingElement u Z b horder] + _ ↔ IsPrimal (splitTruncationCardSuppLT u sigma + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b)) := + isPrimal_splitTruncationCardSuppLTIntegerPart_iff_of_tau_eq_zero + u sigma Z hA2 b htau + +/-- The set-sized cardinal-bounded core of LM24, Proposition 9.2.2, with `(A2)_σ` required only +when reduction places the leading residue in the zero branch. -/ +@[blueprint "fact:leading-class-primality-transfer" + (phase := "Finitely many Archimedean classes") + (title := "Primality transfer at the leading Archimedean class") + (statement := /-- + Let $\kappa$ be an uncountable regular cardinal, $K$ an Archimedean ordered + division ring, $G$ a linearly ordered abelian group and ordered $K$-module, + $R$ a field, and $Z$ a subring of $R$; choose the Archimedean splitting of + $G$. Let $b\in Z+R((G^{<0}))_\kappa$ be nonzero and reduced, with nonzero + lowest exponent, and set $\sigma=[v(b)]$ and + $L_\sigma=R((G_{\prec\sigma}))_\kappa$. If $(A2)_\sigma$ holds whenever the + coefficient of exponent $0$ in $\iota_\sigma(b)$ is zero, then $b$ is primal + in $Z+R((G^{<0}))_\kappa$ if and only if $\iota_\sigma(b)$ is primal in + $L_\sigma((H_\sigma^{\le 0}))$. This is the set-sized $\kappa$-bounded form + of [LM24, Prop. 9.2.2]. + -/) + (proof := /-- + First restrict to the subring fixed by $T_\sigma$; this does not change the + primality of $b$. The splitting $\iota_\sigma$ identifies that subring with + $S_\sigma+L_\sigma((H_\sigma^{<0}))$. Reducedness says that the + coefficient of exponent $0$ is either $0$ or $1$. In the coefficient-one + branch it is a unit, so the transfer lemma applies directly. In the + coefficient-zero branch, the cofinal alternative in $(A2)_\sigma$ and + \ref{thm:bounded-hahn-integer-part-fraction-field} give + $\operatorname{Frac}(S_\sigma)=L_\sigma$; the degenerate alternative gives + the same equality directly. The transfer lemma therefore applies in both + cases. Transport primality back through the splitting. Regularity makes + the split and unsplit support bounds compatible, while uncountability keeps + quotient supports below $\kappa$. + -/)] +theorem isPrimal_iff_isPrimal_splitTruncationCardSuppLT_of_isReduced_if_A2 + [Fact κ.IsRegular] + (u : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (hb0 : CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b ≠ 0) + (horder : ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b : + Nonpositive G R) : R⟦G⟧).order ≠ 0) + (hbReduced : IsReduced (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b)) + (hA2 : tauBall (K := K) + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) = 0 → + LM24.AssumptionA2AtFiniteClass (K := K) κ Z + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder)) : + IsPrimal b ↔ + IsPrimal (splitTruncationCardSuppLT u + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b)) := by + rcases (isReduced_iff_tau_leadingClass_eq_zero_or_one (K := K) + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) hb0 horder).mp hbReduced with + htau | htau + · have htauBall : tauBall (K := K) + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) = 0 := + (tauBall_eq_zero_iff _ _).mpr htau + exact isPrimal_iff_isPrimal_splitTruncationCardSuppLT_of_tau_eq_zero + u Z b hb0 horder (hA2 htauBall) htauBall + · have htauBall : tauBall (K := K) + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) = 1 := + tauBall_eq_one_of_tau_eq_one _ _ htau + exact isPrimal_iff_isPrimal_splitTruncationCardSuppLT_of_tau_eq_one + u Z b hb0 horder htauBall + +/-- The unconditional-`(A2)_σ` specialization of the set-sized, `κ`-bounded form of LM24, +Proposition 9.2.2. -/ +theorem isPrimal_iff_isPrimal_splitTruncationCardSuppLT_of_isReduced + [Fact κ.IsRegular] + (u : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (hb0 : CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b ≠ 0) + (horder : ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b : + Nonpositive G R) : R⟦G⟧).order ≠ 0) + (hbReduced : IsReduced (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b)) + (hA2 : LM24.AssumptionA2AtFiniteClass (K := K) κ Z + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder)) : + IsPrimal b ↔ + IsPrimal (splitTruncationCardSuppLT u + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b)) := + isPrimal_iff_isPrimal_splitTruncationCardSuppLT_of_isReduced_if_A2 + u Z b hb0 horder hbReduced (fun _ ↦ hA2) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalSplitting.lean new file mode 100644 index 0000000000..d1ae765920 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/CardinalSplitting.lean @@ -0,0 +1,282 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.SplitTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IterateOrderType + +/-! +# Cardinal bounds under leading-class splitting + +This module proves the forward support bounds needed to restrict LM24's leading-class Hahn +splitting to `κ`-bounded series. Closed-class restriction cannot enlarge support. Flattening the +split series recovers a reindexing of that restriction, so both its outer support and every inner +coefficient support have cardinality no larger than the original support. +-/ + +public noncomputable section + +open Cardinal FiniteArchimedeanClass + +namespace HahnSeries.Nonpositive + +variable {K G R : Type*} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] + +/-- Restricting the closed-class truncation cannot increase support order type. -/ +theorem supportOrderType_TClosed_le (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + (TClosed (K := K) c x).supportOrderType ≤ (x : R⟦G⟧).supportOrderType := by + rw [TClosed_eq] + exact (HahnSeries.supportOrderType_restrictDomain_le (closedBallOrderEmbedding c) + ((T (K := K) c x : Nonpositive G R) : R⟦G⟧)).trans + (HahnSeries.supportOrderType_mono (support_T_subset c x)) + +/-- Closed-class restriction does not increase support cardinality. -/ +theorem cardSupp_TClosed_le (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + (TClosed (K := K) c x).cardSupp ≤ (x : R⟦G⟧).cardSupp := by + rw [cardSupp, cardSupp] + let f : ↥(TClosed (K := K) c x).support → ↥(x : R⟦G⟧).support := fun g ↦ + ⟨g.1.1, by + rw [mem_support] + have hg := (mem_support _ _).mp g.2 + rw [TClosed_coeff, coeff_T_of_mem c x g.1.2] at hg + exact hg⟩ + apply Cardinal.mk_le_of_injective (f := f) + intro a b h + dsimp only [f] at h + have hv : a.1.1 = b.1.1 := + congrArg (fun z : ↥(x : R⟦G⟧).support ↦ z.1) h + exact Subtype.ext (Subtype.ext hv) + +/-- Flattening the Archimedean split is its ordered reindexing of the closed-ball series. -/ +theorem iterateRingEquiv_archimedeanSplitRingEquiv + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : R⟦closedBall K c⟧) : + HahnSeries.iterateRingEquiv (HahnSeries.archimedeanSplitRingEquiv u c x) = + HahnSeries.embDomainRingEquiv + (HahnEmbedding.ArchimedeanStrata.closedBallEquivStratumLexBall u c) x := by + ext p + rw [show p = toLex ((ofLex p).1, (ofLex p).2) by simp] + rw [HahnSeries.iterateRingEquiv_coeff, + HahnSeries.archimedeanSplitRingEquiv_coeff] + let q := HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c + (toLex ((ofLex p).1, (ofLex p).2)) + let e := HahnEmbedding.ArchimedeanStrata.closedBallEquivStratumLexBall u c + have hp : toLex ((ofLex p).1, (ofLex p).2) = e q := by + simp [q, e] + rw [hp, HahnSeries.embDomainRingEquiv_coeff] + simp [q, e] + +/-- The outer support of an Archimedean split is no larger than the unsplit support. -/ +theorem cardSupp_archimedeanSplitRingEquiv_outer_le + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : R⟦closedBall K c⟧) : + (HahnSeries.archimedeanSplitRingEquiv u c x).cardSupp ≤ x.cardSupp := by + calc + _ ≤ (HahnSeries.iterateRingEquiv + (HahnSeries.archimedeanSplitRingEquiv u c x)).cardSupp := + HahnSeries.cardSupp_outer_le_cardSupp_iterateRingEquiv _ + _ = x.cardSupp := by + rw [iterateRingEquiv_archimedeanSplitRingEquiv] + exact HahnSeries.cardSupp_embDomainRingEquiv _ _ + +/-- The split truncation's outer support order type is no larger than the original support order +type. -/ +theorem supportOrderType_splitTruncation_le + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + ((splitTruncation u c x : Nonpositive (u.stratum c) R⟦ball K c⟧) : + (R⟦ball K c⟧)⟦u.stratum c⟧).supportOrderType ≤ + (x : R⟦G⟧).supportOrderType := by + rw [coe_splitTruncation] + calc + (HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x)).supportOrderType ≤ + (HahnSeries.iterateRingEquiv + (HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x))).supportOrderType := + HahnSeries.supportOrderType_outer_le_iterateRingEquiv _ + _ = (HahnSeries.embDomainRingEquiv + (HahnEmbedding.ArchimedeanStrata.closedBallEquivStratumLexBall u c) + (TClosed c x)).supportOrderType := by + rw [iterateRingEquiv_archimedeanSplitRingEquiv] + _ = (TClosed (K := K) c x).supportOrderType := + HahnSeries.supportOrderType_embDomainRingEquiv _ _ + _ ≤ (x : R⟦G⟧).supportOrderType := supportOrderType_TClosed_le c x + +/-- Leading-class splitting cannot increase LM24 degree. -/ +theorem degree_splitTruncation_le + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + HahnSeries.degree + ((splitTruncation u c x : Nonpositive (u.stratum c) R⟦ball K c⟧) : + (R⟦ball K c⟧)⟦u.stratum c⟧) ≤ + HahnSeries.degree (x : R⟦G⟧) := by + rw [HahnSeries.degree_eq_cantorDegree, HahnSeries.degree_eq_cantorDegree] + exact Ordinal.cantorDegree_mono (supportOrderType_splitTruncation_le u c x) + +/-- Every inner coefficient support of an Archimedean split is no larger than the unsplit +support. -/ +theorem cardSupp_archimedeanSplitRingEquiv_coeff_le + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : R⟦closedBall K c⟧) (s : u.stratum c) : + ((HahnSeries.archimedeanSplitRingEquiv u c x).coeff s).cardSupp ≤ x.cardSupp := by + calc + _ ≤ (HahnSeries.iterateRingEquiv + (HahnSeries.archimedeanSplitRingEquiv u c x)).cardSupp := + HahnSeries.cardSupp_coeff_le_cardSupp_iterateRingEquiv _ s + _ = x.cardSupp := by + rw [iterateRingEquiv_archimedeanSplitRingEquiv] + exact HahnSeries.cardSupp_embDomainRingEquiv _ _ + +/-- The split truncation's outer support is no larger than the original support. -/ +theorem cardSupp_splitTruncation_outer_le + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + ((splitTruncation u c x : Nonpositive (u.stratum c) R⟦ball K c⟧) : + (R⟦ball K c⟧)⟦u.stratum c⟧).cardSupp ≤ (x : R⟦G⟧).cardSupp := by + rw [coe_splitTruncation] + exact (cardSupp_archimedeanSplitRingEquiv_outer_le u c (TClosed c x)).trans + (cardSupp_TClosed_le c x) + +/-- Every coefficient of the split truncation has support no larger than the original support. -/ +theorem cardSupp_splitTruncation_coeff_le + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) (s : u.stratum c) : + ((((splitTruncation u c x : Nonpositive (u.stratum c) R⟦ball K c⟧) : + (R⟦ball K c⟧)⟦u.stratum c⟧).coeff s).cardSupp) ≤ (x : R⟦G⟧).cardSupp := by + rw [coe_splitTruncation] + exact (cardSupp_archimedeanSplitRingEquiv_coeff_le u c (TClosed c x) s).trans + (cardSupp_TClosed_le c x) + +/-- The split truncation with each inner coefficient bundled in the `κ`-bounded Hahn field. -/ +def splitTruncationCardSuppLT {κ : Cardinal} + [Fact (ℵ₀ < κ)] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) (hx : (x : R⟦G⟧).cardSupp < κ) : + Nonpositive (u.stratum c) + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ)) := by + let y := splitTruncation u c x + let y' : (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))⟦u.stratum c⟧ := + { coeff := fun s ↦ ⟨(y : (R⟦ball K c⟧)⟦u.stratum c⟧).coeff s, + (cardSupp_splitTruncation_coeff_le u c x s).trans_lt hx⟩ + isPWO_support' := by + have heq : Function.support (fun s ↦ + (⟨(y : (R⟦ball K c⟧)⟦u.stratum c⟧).coeff s, + (cardSupp_splitTruncation_coeff_le u c x s).trans_lt hx⟩ : + CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))) = + (y : (R⟦ball K c⟧)⟦u.stratum c⟧).support := by + ext s + rw [HahnSeries.mem_support] + constructor + · intro h hzero + apply h + apply Subtype.ext + exact hzero + · intro h hzero + apply h + exact congrArg Subtype.val hzero + rw [heq] + exact (y : (R⟦ball K c⟧)⟦u.stratum c⟧).isPWO_support } + exact ⟨y', by + intro s hs + have hs' : s ∈ (y : (R⟦ball K c⟧)⟦u.stratum c⟧).support := by + rw [HahnSeries.mem_support] at hs ⊢ + intro hzero + apply hs + apply Subtype.ext + exact hzero + exact support_subset y hs'⟩ + +/-- Coercing a coefficient of the bounded split truncation recovers the corresponding full +inner Hahn coefficient. -/ +@[simp] +theorem coe_coeff_splitTruncationCardSuppLT {κ : Cardinal} + [Fact (ℵ₀ < κ)] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) (hx : (x : R⟦G⟧).cardSupp < κ) (s : u.stratum c) : + ((((splitTruncationCardSuppLT u c x hx : Nonpositive (u.stratum c) + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))) : + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))⟦u.stratum c⟧).coeff s : + R⟦ball K c⟧)) = + ((splitTruncation u c x : Nonpositive (u.stratum c) R⟦ball K c⟧) : + (R⟦ball K c⟧)⟦u.stratum c⟧).coeff s := by + rfl + +/-- Bundling the inner coefficients with their cardinal bounds does not change the outer +support. -/ +theorem support_splitTruncationCardSuppLT {κ : Cardinal} + [Fact (ℵ₀ < κ)] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) (hx : (x : R⟦G⟧).cardSupp < κ) : + ((splitTruncationCardSuppLT u c x hx : Nonpositive (u.stratum c) + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))) : + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))⟦u.stratum c⟧).support = + ((splitTruncation u c x : Nonpositive (u.stratum c) R⟦ball K c⟧) : + (R⟦ball K c⟧)⟦u.stratum c⟧).support := by + ext s + rw [HahnSeries.mem_support, HahnSeries.mem_support] + constructor + · intro hs hs0 + apply hs + apply Subtype.ext + exact hs0 + · intro hs hs0 + apply hs + exact congrArg Subtype.val hs0 + +/-- The bounded split truncation has the same outer support order type as the unrestricted +split. -/ +theorem supportOrderType_splitTruncationCardSuppLT {κ : Cardinal} + [Fact (ℵ₀ < κ)] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) (hx : (x : R⟦G⟧).cardSupp < κ) : + ((splitTruncationCardSuppLT u c x hx : Nonpositive (u.stratum c) + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))) : + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))⟦u.stratum c⟧).supportOrderType = + ((splitTruncation u c x : Nonpositive (u.stratum c) R⟦ball K c⟧) : + (R⟦ball K c⟧)⟦u.stratum c⟧).supportOrderType := by + rw [HahnSeries.supportOrderType_eq_setOrderType, + HahnSeries.supportOrderType_eq_setOrderType] + exact Set.IsPWO.orderType_congr _ _ + (support_splitTruncationCardSuppLT u c x hx) + +/-- Cardinal-bounded leading-class splitting cannot increase LM24 degree. -/ +theorem degree_splitTruncationCardSuppLT_le {κ : Cardinal} + [Fact (ℵ₀ < κ)] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) (hx : (x : R⟦G⟧).cardSupp < κ) : + HahnSeries.degree + ((splitTruncationCardSuppLT u c x hx : Nonpositive (u.stratum c) + (CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ))) : + (CardSuppLTField (G := ↥(ball K c)) (R := R) + (κ := κ))⟦u.stratum c⟧) ≤ + HahnSeries.degree (x : R⟦G⟧) := by + rw [HahnSeries.degree_eq_cantorDegree, HahnSeries.degree_eq_cantorDegree, + supportOrderType_splitTruncationCardSuppLT] + exact Ordinal.cantorDegree_mono (supportOrderType_splitTruncation_le u c x) + +/-- The bounded split truncation's constant coefficient is the bounded open-class +truncation. -/ +theorem coe_constantCoeff_splitTruncationCardSuppLT {κ : Cardinal} + [Fact (ℵ₀ < κ)] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) (hx : (x : R⟦G⟧).cardSupp < κ) : + ((constantCoeff (R := CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ)) + (splitTruncationCardSuppLT u c x hx) : + CardSuppLTField (G := ↥(ball K c)) (R := R) (κ := κ)) : R⟦ball K c⟧) = + tauBall c x := by + rw [constantCoeff_apply, coe_coeff_splitTruncationCardSuppLT] + rw [← constantCoeff_apply] + exact constantCoeff_splitTruncation u c x + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ClassTruncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ClassTruncation.lean new file mode 100644 index 0000000000..05c70f2013 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ClassTruncation.lean @@ -0,0 +1,269 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Truncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import Mathlib.Algebra.Order.Module.Archimedean + +/-! +# Truncation by an Archimedean class + +For a finite Archimedean class `c`, LM24, Definition 8.1.1 retains either the closed ball at `c` +or its open ball. On series supported at nonpositive exponents these coefficient restrictions are +ring homomorphisms: if `i, j ≤ 0`, then `i + j` lies in either ball exactly when both `i` and `j` +do. The reverse implication uses the convexity encoded by the Archimedean-class order and fails +for unrestricted Hahn series because opposite exponents can cancel. + +These are LM24's `T_σ` and `τ_σ`, with Mathlib's reversed ordering of Archimedean classes. +-/ + +public noncomputable section + +namespace HahnSeries.Nonpositive + +open FiniteArchimedeanClass + +variable {K G R : Type*} +variable [Ring K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] + +section Ring + +variable [Ring R] + +private theorem add_ne_zero_of_nonpos {i j : G} (hi : i ≤ 0) (hj : j ≤ 0) + (hij : i ≠ 0 ∨ j ≠ 0) : i + j ≠ 0 := by + intro hzero + have hi0 : i = 0 := le_antisymm hi (by + have heq : i = -j := eq_neg_of_add_eq_zero_left hzero + rw [heq] + exact neg_nonneg.mpr hj) + have hj0 : j = 0 := le_antisymm hj (by + have heq : j = -i := eq_neg_of_add_eq_zero_right hzero + rw [heq] + exact neg_nonneg.mpr hi) + exact hij.elim (fun h ↦ h hi0) (fun h ↦ h hj0) + +private theorem mk_add_le_left {i j : G} (hi : i ≤ 0) (hj : j ≤ 0) : + ArchimedeanClass.mk (i + j) ≤ ArchimedeanClass.mk i := by + have hsum : i + j ≤ i := by + have := add_le_add_left hj i + simpa using this + simpa using ArchimedeanClass.min_le_mk_of_le_of_le hsum hi + +private theorem mk_add_le_right {i j : G} (hi : i ≤ 0) (hj : j ≤ 0) : + ArchimedeanClass.mk (i + j) ≤ ArchimedeanClass.mk j := by + rw [add_comm] + exact mk_add_le_left hj hi + +private theorem mem_closedBall_add_iff (c : FiniteArchimedeanClass G) + {i j : G} (hi : i ≤ 0) (hj : j ≤ 0) : + i + j ∈ closedBall K c ↔ i ∈ closedBall K c ∧ j ∈ closedBall K c := by + constructor + · intro hij + constructor + · exact (FiniteArchimedeanClass.mem_closedBall_iff K).mpr fun hi0 ↦ + ((FiniteArchimedeanClass.mem_closedBall_iff K).mp hij + (add_ne_zero_of_nonpos hi hj (Or.inl hi0))).trans (mk_add_le_left hi hj) + · exact (FiniteArchimedeanClass.mem_closedBall_iff K).mpr fun hj0 ↦ + ((FiniteArchimedeanClass.mem_closedBall_iff K).mp hij + (add_ne_zero_of_nonpos hi hj (Or.inr hj0))).trans (mk_add_le_right hi hj) + · exact fun h ↦ add_mem h.1 h.2 + +private theorem mem_ball_add_iff (c : FiniteArchimedeanClass G) + {i j : G} (hi : i ≤ 0) (hj : j ≤ 0) : + i + j ∈ ball K c ↔ i ∈ ball K c ∧ j ∈ ball K c := by + constructor + · intro hij + constructor + · exact (FiniteArchimedeanClass.mem_ball_iff K).mpr fun hi0 ↦ + ((FiniteArchimedeanClass.mem_ball_iff K).mp hij + (add_ne_zero_of_nonpos hi hj (Or.inl hi0))).trans_le (mk_add_le_left hi hj) + · exact (FiniteArchimedeanClass.mem_ball_iff K).mpr fun hj0 ↦ + ((FiniteArchimedeanClass.mem_ball_iff K).mp hij + (add_ne_zero_of_nonpos hi hj (Or.inr hj0))).trans_le (mk_add_le_right hi hj) + · exact fun h ↦ add_mem h.1 h.2 + +private theorem filter_mul (p : G → Prop) [DecidablePred p] + (hpadd : ∀ {i j : G}, i ≤ 0 → j ≤ 0 → (p (i + j) ↔ p i ∧ p j)) + (x y : Nonpositive G R) : + HahnSeries.filter p ((x * y : Nonpositive G R) : R⟦G⟧) = + HahnSeries.filter p (x : R⟦G⟧) * HahnSeries.filter p (y : R⟦G⟧) := by + change HahnSeries.filter p ((x : R⟦G⟧) * (y : R⟦G⟧)) = _ + ext g + rw [HahnSeries.coeff_filter, HahnSeries.coeff_mul, HahnSeries.coeff_mul] + by_cases hg : p g + · rw [if_pos hg] + apply Finset.sum_congr + · ext ij + simp only [Finset.mem_addAntidiagonal, HahnSeries.support_filter] + constructor + · rintro ⟨hi, hj, hij⟩ + have hp := (hpadd (support_subset x hi) (support_subset y hj)).mp (hij ▸ hg) + exact ⟨⟨hi, hp.1⟩, ⟨hj, hp.2⟩, hij⟩ + · rintro ⟨⟨hi, _⟩, ⟨hj, _⟩, hij⟩ + exact ⟨hi, hj, hij⟩ + · intro ij hij + rw [HahnSeries.coeff_filter, HahnSeries.coeff_filter] + rw [Finset.mem_addAntidiagonal] at hij + rw [HahnSeries.support_filter, HahnSeries.support_filter] at hij + simp [hij.1.2, hij.2.1.2] + · rw [if_neg hg] + apply (Finset.sum_eq_zero fun ij hij ↦ ?_).symm + rw [Finset.mem_addAntidiagonal] at hij + rw [HahnSeries.support_filter] at hij + rw [HahnSeries.support_filter] at hij + have hpij := (hpadd (support_subset x hij.1.1) (support_subset y hij.2.1.1)).mpr + ⟨hij.1.2, hij.2.1.2⟩ + rw [hij.2.2] at hpij + exact (hg hpij).elim + +private def classTruncation (p : G → Prop) [DecidablePred p] + (hp0 : p 0) (hpadd : ∀ {i j : G}, i ≤ 0 → j ≤ 0 → (p (i + j) ↔ p i ∧ p j)) : + Nonpositive G R →+* Nonpositive G R where + toFun x := ⟨HahnSeries.filter p (x : R⟦G⟧), + (HahnSeries.support_filter_subset p (x : R⟦G⟧)).trans (support_subset x)⟩ + map_zero' := by ext; simp + map_one' := by ext g; by_cases hg : g = 0 <;> simp [hg, hp0] + map_add' x y := by + apply Subtype.ext + exact HahnSeries.filter_add p (x : R⟦G⟧) (y : R⟦G⟧) + map_mul' x y := by + apply Subtype.ext + exact filter_mul p hpadd x y + +/-- LM24's `T_σ`: retain coefficients whose exponents lie in the closed ball at `c`. -/ +def T (c : FiniteArchimedeanClass G) : Nonpositive G R →+* Nonpositive G R := + by + classical + exact classTruncation (fun g ↦ g ∈ closedBall K c) (zero_mem _) + (fun hi hj ↦ mem_closedBall_add_iff c hi hj) + +/-- LM24's `τ_σ`: retain coefficients whose exponents lie in the open ball at `c`. -/ +def tau (c : FiniteArchimedeanClass G) : Nonpositive G R →+* Nonpositive G R := + by + classical + exact classTruncation (fun g ↦ g ∈ ball K c) (zero_mem _) + (fun hi hj ↦ mem_ball_add_iff c hi hj) + +/-- The finite Archimedean class of the lowest exponent of a series whose lowest exponent is +nonzero. Constant series require the separate zero Archimedean class. -/ +def leadingClass (x : Nonpositive G R) (horder : (x : R⟦G⟧).order ≠ 0) : + FiniteArchimedeanClass G := + FiniteArchimedeanClass.mk (x : R⟦G⟧).order horder + +/-- The underlying Archimedean class of `leadingClass`. -/ +@[simp] +theorem leadingClass_val (x : Nonpositive G R) (horder : (x : R⟦G⟧).order ≠ 0) : + (leadingClass x horder).val = ArchimedeanClass.mk (x : R⟦G⟧).order := + (rfl) + +theorem coeff_T_of_mem (c : FiniteArchimedeanClass G) (x : Nonpositive G R) {g : G} + (hg : g ∈ closedBall K c) : + ((T (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff g = (x : R⟦G⟧).coeff g := by + classical + change (HahnSeries.filter (fun g ↦ g ∈ closedBall K c) (x : R⟦G⟧)).coeff g = _ + rw [HahnSeries.coeff_filter, if_pos hg] + +theorem coeff_T_of_not_mem (c : FiniteArchimedeanClass G) (x : Nonpositive G R) {g : G} + (hg : g ∉ closedBall K c) : + ((T (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff g = 0 := by + classical + change (HahnSeries.filter (fun g ↦ g ∈ closedBall K c) (x : R⟦G⟧)).coeff g = 0 + rw [HahnSeries.coeff_filter, if_neg hg] + +/-- Closed-class truncation cannot introduce a new support exponent. -/ +theorem support_T_subset (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + ((T (K := K) c x : Nonpositive G R) : R⟦G⟧).support ⊆ (x : R⟦G⟧).support := by + classical + change (HahnSeries.filter (fun g ↦ g ∈ closedBall K c) (x : R⟦G⟧)).support ⊆ _ + exact HahnSeries.support_filter_subset _ _ + +theorem coeff_tau_of_mem (c : FiniteArchimedeanClass G) (x : Nonpositive G R) {g : G} + (hg : g ∈ ball K c) : + ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff g = (x : R⟦G⟧).coeff g := by + classical + change (HahnSeries.filter (fun g ↦ g ∈ ball K c) (x : R⟦G⟧)).coeff g = _ + rw [HahnSeries.coeff_filter, if_pos hg] + +theorem coeff_tau_of_not_mem (c : FiniteArchimedeanClass G) (x : Nonpositive G R) {g : G} + (hg : g ∉ ball K c) : + ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff g = 0 := by + classical + change (HahnSeries.filter (fun g ↦ g ∈ ball K c) (x : R⟦G⟧)).coeff g = 0 + rw [HahnSeries.coeff_filter, if_neg hg] + +/-- Closed truncation at the class of the lowest nonzero exponent retains the whole series. -/ +theorem T_leadingClass (x : Nonpositive G R) (horder : (x : R⟦G⟧).order ≠ 0) : + T (K := K) (leadingClass x horder) x = x := by + apply Subtype.ext + ext g + by_cases hcoeff : (x : R⟦G⟧).coeff g = 0 + · by_cases hg : g ∈ closedBall K (leadingClass x horder) + · rw [coeff_T_of_mem _ x hg, hcoeff] + · rw [coeff_T_of_not_mem _ x hg, hcoeff] + · rw [coeff_T_of_mem] + apply (FiniteArchimedeanClass.mem_closedBall_iff K).mpr + intro hg + apply (FiniteArchimedeanClass.mk_le_mk horder hg).mpr + have horderLe : (x : R⟦G⟧).order ≤ g := + HahnSeries.order_le_of_coeff_ne_zero hcoeff + have hgNonpos : g ≤ 0 := support_subset x ((HahnSeries.mem_support _ _).mpr hcoeff) + simpa using ArchimedeanClass.min_le_mk_of_le_of_le horderLe hgNonpos + +/-- Closed-class truncation is idempotent. -/ +@[simp] +theorem T_T (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + T (K := K) c (T (K := K) c x) = T (K := K) c x := by + apply Subtype.ext + ext g + by_cases hg : g ∈ closedBall K c + · rw [coeff_T_of_mem c (T (K := K) c x) hg] + · rw [coeff_T_of_not_mem c (T (K := K) c x) hg, + coeff_T_of_not_mem c x hg] + +/-- Open-class truncation is idempotent. -/ +@[simp] +theorem tau_tau (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + tau (K := K) c (tau (K := K) c x) = tau (K := K) c x := by + apply Subtype.ext + ext g + by_cases hg : g ∈ ball K c + · rw [coeff_tau_of_mem c (tau (K := K) c x) hg] + · rw [coeff_tau_of_not_mem c (tau (K := K) c x) hg, + coeff_tau_of_not_mem c x hg] + +/-- Applying the closed cut after the open cut leaves the open cut. -/ +@[simp] +theorem T_tau (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + T (K := K) c (tau (K := K) c x) = tau (K := K) c x := by + apply Subtype.ext + ext g + by_cases hg : g ∈ closedBall K c + · rw [coeff_T_of_mem c (tau (K := K) c x) hg] + · have hball : g ∉ ball K c := fun h ↦ + hg ((FiniteArchimedeanClass.ball_lt_closedBall (K := K)).le h) + rw [coeff_T_of_not_mem c (tau (K := K) c x) hg, + coeff_tau_of_not_mem c x hball] + +/-- Applying the open cut after the closed cut leaves the open cut. -/ +@[simp] +theorem tau_T (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + tau (K := K) c (T (K := K) c x) = tau (K := K) c x := by + apply Subtype.ext + ext g + by_cases hg : g ∈ ball K c + · rw [coeff_tau_of_mem c (T (K := K) c x) hg, + coeff_T_of_mem c x ((FiniteArchimedeanClass.ball_lt_closedBall (K := K)).le hg), + coeff_tau_of_mem c x hg] + · rw [coeff_tau_of_not_mem c (T (K := K) c x) hg, + coeff_tau_of_not_mem c x hg] + +end Ring + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassPrimality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassPrimality.lean new file mode 100644 index 0000000000..2c37dd6b5c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassPrimality.lean @@ -0,0 +1,283 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalFiniteClassReduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassReduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexQuotientSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEmbedding +public import Mathlib.Data.Set.Card + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationResidue +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Primality for finite support-class sets + +Under LM24 conditions `(A1)`--`(A3)`, every cardinal-bounded Hahn integer-part series whose +support meets only finitely many Archimedean classes is primal. +-/ + +public noncomputable section + +open Cardinal FiniteArchimedeanClass +open scoped HahnSeries + +namespace HahnSeries.Nonpositive + +variable {K G R : Type*} {κ : Cardinal} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] [Fact (ℵ₀ < κ)] +variable (Z : Subring R) + +/-- If order-zero elements and reduced elements with nonzero order are primal, every bounded +integer-part element meeting only finitely many Archimedean classes is primal. -/ +theorem isPrimal_of_supportArchimedeanClasses_finite_of_reduced [CharZero R] + (u : HahnEmbedding.ArchimedeanStrata K G) + (hzero : ∀ y : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z, + ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z y : + Nonpositive G R) : R⟦G⟧).order = 0 → IsPrimal y) + (hreduced : ∀ y : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z, + ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z y : + Nonpositive G R) : R⟦G⟧).order ≠ 0 → + IsReduced (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z y) → IsPrimal y) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (hfinite : (supportArchimedeanClasses + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x)).Finite) : IsPrimal x := by + let classes := fun y : cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z ↦ + supportArchimedeanClasses (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z y) + have hind : ∀ n : ℕ, ∀ y : cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z, + (classes y).ncard = n → (classes y).Finite → IsPrimal y := by + intro n + induction n using Nat.strong_induction_on with + | h n ih => + intro y hn hyFinite + let yN := CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z y + by_cases horder : (yN : R⟦G⟧).order = 0 + · exact hzero y horder + have hyN0 : yN ≠ 0 := by + intro hyzero + apply horder + rw [hyzero, Subring.coe_zero, HahnSeries.order_zero] + let c := leadingClass yN horder + have hT : T (K := K) c yN = yN := T_leadingClass yN horder + by_cases htau : tau (K := K) c yN = 0 + · exact hreduced y horder + ((isReduced_iff_tau_leadingClass_eq_zero_or_one yN hyN0 horder).mpr + (Or.inl htau)) + let r := rhoIntegerPart u c Z y hT htau + let t := tauIntegerPart (K := K) c Z y + have hfac : r * t = y := rhoIntegerPart_mul_tauIntegerPart u c Z y hT htau + have hrReduced : IsReduced + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z r) := by + rw [toNonpositive_rhoIntegerPart u c Z y hT htau] + exact isReduced_rho_leadingClass_of_tau_ne_zero u yN hyN0 horder htau + have hrPrimal : IsPrimal r := by + by_cases hrOrder : ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z r : + Nonpositive G R) : R⟦G⟧).order = 0 + · exact hzero r hrOrder + · exact hreduced r hrOrder hrReduced + have htClasses : classes t = + supportArchimedeanClasses (tau (K := K) c yN) := by + apply congrArg supportArchimedeanClasses + exact toNonpositive_tauIntegerPart c Z y + have htFinite : (classes t).Finite := by + rw [htClasses] + exact hyFinite.subset (supportArchimedeanClasses_tau_subset c yN) + have htCount : (classes t).ncard < n := by + rw [htClasses, ← hn] + exact Set.ncard_lt_ncard + (supportArchimedeanClasses_tau_ssubset yN hyN0 horder) hyFinite + have htPrimal : IsPrimal t := ih (classes t).ncard htCount t rfl htFinite + rw [← hfac] + exact hrPrimal.mul htPrimal + exact hind (classes x).ncard x rfl hfinite + + +/-- The finite-class part of the Hahn integer ring is pre-Schreier under the corresponding +Archimedean hypotheses and the pre-Schreier condition on the coefficient subring. -/ +@[blueprint "thm:finite-support-classes-primality" + (phase := "Finitely many Archimedean classes") + (title := "Primality for finitely many Archimedean support classes") + (statement := /-- + Let $K$ be an Archimedean ordered division ring, $G$ an ordered $K$-vector + space, $R$ a field of characteristic zero, $\kappa>\aleph_0$ a regular + cardinal, and $Z\subseteq R$ a pre-Schreier subring. At every nonzero + Archimedean class $\sigma$, choose an additive complement $H_\sigma$ to + $G_{\prec\sigma}$ in $G_{\preceq\sigma}$ that is order additively + isomorphic to $\mathbb R$. Assume that $G_{\prec\sigma}$ either has + cofinality at least $\kappa$, or is zero and every element of $R$ is a + fraction of elements of $Z$. Every element of + $Z+R((G^{<0}))_\kappa$ whose support meets only finitely many Archimedean + classes is primal. + -/) + (proof := /-- + Induct on the number of Archimedean classes met by the support. At the + leading class, split the series into its reduced factor and its strict + lower-class factor. The reduced factor is primal by + \ref{cor:reduced-hahn-integer-part-primal}; the other factor meets strictly + fewer classes and is primal by induction. A product of primal elements is + primal. + -/)] +theorem isPrimal_of_supportArchimedeanClasses_finite [CharZero R] + [Fact κ.IsRegular] [DecompositionMonoid Z] + (u : HahnEmbedding.ArchimedeanStrata K G) + (hA1 : ∀ c : FiniteArchimedeanClass G, Nonempty (u.stratum c ≃+o ℝ)) + (hA2 : ∀ c : FiniteArchimedeanClass G, + LM24.AssumptionA2AtFiniteClass (K := K) κ Z c) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (hfinite : (supportArchimedeanClasses + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x)).Finite) : IsPrimal x := by + apply isPrimal_of_supportArchimedeanClasses_finite_of_reduced Z u + · exact CardSuppLTTruncationIntegerPart.isPrimal_of_order_eq_zero Z + · intro y hyOrder hyReduced + have hy0 : CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z y ≠ 0 := by + intro hyzero + apply hyOrder + rw [hyzero, Subring.coe_zero, HahnSeries.order_zero] + let c := leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z y) hyOrder + exact isPrimal_of_isReduced_of_leadingClass_orderIso_real + u Z y hy0 hyOrder hyReduced (hA2 c) + (Classical.choice (hA1 c)) + · exact hfinite + +end HahnSeries.Nonpositive + +namespace HahnSeries.CardSuppLTTruncationIntegerPart + +open Cardinal + +variable {G R : Type*} {κ : Cardinal} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Field R] [Fact (ℵ₀ < κ)] + +/-- Viewing a bounded Hahn integer-part series as nonpositive does not change the +Archimedean classes met by its support. -/ +theorem supportArchimedeanClasses_toNonpositiveRingHom + (Z : Subring R) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + HahnSeries.Nonpositive.supportArchimedeanClasses (toNonpositiveRingHom Z x) = + ArchimedeanClass.mk '' (x : HahnSeries G R).support := by + ext c + rw [HahnSeries.Nonpositive.mem_supportArchimedeanClasses] + constructor + · rintro ⟨g, hg, rfl⟩ + exact ⟨g, by simpa only [coe_toNonpositiveRingHom] using hg, rfl⟩ + · rintro ⟨g, hg, rfl⟩ + exact ⟨g, by simpa only [coe_toNonpositiveRingHom] using hg, rfl⟩ + +/-- Finite-class primality in an ambient exponent group descends to every convex exponent +subgroup. -/ +private theorem isPrimal_addSubgroup_of_ambient_finiteClasses + (Z : Subring R) + (hfinite : ∀ x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z, + (ArchimedeanClass.mk '' (x : HahnSeries G R).support).Finite → IsPrimal x) + (P : AddSubgroup G) (hP : (P : Set G).OrdConnected) + (a : cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) + (ha : (ArchimedeanClass.mk '' (a : HahnSeries P R).support).Finite) : IsPrimal a := by + let inc : P →+ G := P.subtype + have hinci : Function.Injective inc := Subtype.val_injective + have hinco : ∀ x y : P, inc x ≤ inc y ↔ x ≤ y := fun _ _ ↦ Iff.rfl + let A := mapDomain inc hinci hinco Z a + have hAfinite : (ArchimedeanClass.mk '' (A : HahnSeries G R).support).Finite := by + have hsupport : (A : HahnSeries G R).support = inc '' (a : HahnSeries P R).support := by + rw [coe_mapDomain] + exact HahnSeries.support_embDomain _ _ + rw [hsupport] + let e : P →+o G := + { toFun := inc + map_zero' := map_zero inc + map_add' := map_add inc + monotone' := fun _ _ h ↦ h } + let ac : ArchimedeanClass P → ArchimedeanClass G := ArchimedeanClass.orderHom e + have heq : ArchimedeanClass.mk '' (inc '' (a : HahnSeries P R).support) = + ac '' (ArchimedeanClass.mk '' (a : HahnSeries P R).support) := by + ext c + constructor + · rintro ⟨_, ⟨p, hp, rfl⟩, rfl⟩ + exact ⟨ArchimedeanClass.mk p, ⟨p, hp, rfl⟩, + ArchimedeanClass.orderHom_mk e p⟩ + · rintro ⟨_, ⟨p, hp, rfl⟩, rfl⟩ + exact ⟨inc p, ⟨p, hp, rfl⟩, (ArchimedeanClass.orderHom_mk e p).symm⟩ + rw [heq] + exact ha.image ac + apply isPrimal_of_isPrimal_mapDomain inc hinci hinco Z + · have hrange : Set.range inc = (P : Set G) := by + ext x + constructor + · rintro ⟨p, rfl⟩ + exact p.2 + · exact fun hx ↦ ⟨⟨x, hx⟩, rfl⟩ + rw [hrange] + exact hP + exact hfinite A hAfinite + +/-- The common-tail coefficient of a series is primal when its remaining support classes form +a finite block and finite-class primality is known in the ambient exponent group. -/ +theorem isPrimal_restrictDomain_tailSubmodule_of_ambient_finiteClasses + [Module ℚ G] [PosSMulMono ℚ G] + (Z : Subring R) + (hfinite : ∀ y : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z, + (ArchimedeanClass.mk '' (y : HahnSeries G R).support).Finite → IsPrimal y) + (T₀ T₁ : Set (ArchimedeanClass G)) + (hT₀gt : ∀ a ∈ T₀, ∃ b ∈ T₀, a < b) (hT₁ : T₁.Finite) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (hxclasses : ArchimedeanClass.mk '' (x : HahnSeries G R).support ⊆ T₀ ∪ T₁) : + let P := FiniteArchimedeanClass.tailSubmodule ℚ + {c : FiniteArchimedeanClass G | c.1 ∈ T₀} + IsPrimal (restrictDomain P.toAddSubgroup.subtype Subtype.val_injective + (fun _ _ ↦ Iff.rfl) Z x) := by + let P := FiniteArchimedeanClass.tailSubmodule ℚ + {c : FiniteArchimedeanClass G | c.1 ∈ T₀} + apply isPrimal_addSubgroup_of_ambient_finiteClasses Z hfinite P.toAddSubgroup + (inferInstance : P.toAddSubgroup.IsConvex).ordConnected + have hfinite' := + HahnSeries.supportArchimedeanClasses_coeff_zero_convexQuotientSplitRingEquiv_finite + (K := ℚ) T₀ T₁ hT₀gt hT₁ (x : HahnSeries G R) hxclasses + rw [HahnSeries.coeff_zero_convexQuotientSplitRingEquiv] at hfinite' + have hre : ((restrictDomain P.toAddSubgroup.subtype Subtype.val_injective + (fun _ _ ↦ Iff.rfl) Z x : + cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) : HahnSeries P R) = + HahnSeries.restrictDomain (HahnSeries.submoduleOrderEmbedding P) + (x : HahnSeries G R) := by + ext p + rw [coe_restrictDomain, HahnSeries.restrictDomain_coeff, + HahnSeries.restrictDomain_coeff] + congr 1 + exact HahnSeries.submoduleOrderEmbedding_apply P p |>.symm + rw [hre] + exact hfinite' + +/-- The constant coefficient after regrouping along the common tail is primal when finite-class +primality holds in the ambient exponent group. -/ +theorem isPrimal_coeff_zero_convexQuotientSplitRingEquiv_of_ambient_finiteClasses + [Module ℚ G] [PosSMulMono ℚ G] [Fact κ.IsRegular] + (Z : Subring R) + (hfinite : ∀ y : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z, + (ArchimedeanClass.mk '' (y : HahnSeries G R).support).Finite → IsPrimal y) + (T₀ T₁ : Set (ArchimedeanClass G)) + (hT₀gt : ∀ a ∈ T₀, ∃ b ∈ T₀, a < b) (hT₁ : T₁.Finite) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (hxclasses : ArchimedeanClass.mk '' (x : HahnSeries G R).support ⊆ T₀ ∪ T₁) : + let T : Set (FiniteArchimedeanClass G) := {c | c.1 ∈ T₀} + let P := FiniteArchimedeanClass.tailSubmodule ℚ T + let S := cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z + let E := cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z + IsPrimal (⟨(E x : (CardSuppLTField (G := P) (R := R) (κ := κ))⟦ + G ⧸ P⟧).coeff 0, + ((mem_cardSuppLTTruncationIntegerPart (Z := S)).mp (E x).2).2⟩ : S) := by + dsimp only + rw [CardSuppLTTruncationIntegerPart.coeff_zero_convexQuotientSplitRingEquiv] + exact isPrimal_restrictDomain_tailSubmodule_of_ambient_finiteClasses + Z hfinite T₀ T₁ hT₀gt hT₁ x hxclasses + +end HahnSeries.CardSuppLTTruncationIntegerPart diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassReduction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassReduction.lean new file mode 100644 index 0000000000..bfef13ed2c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassReduction.lean @@ -0,0 +1,218 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedCharacterization +public import Mathlib.Data.Set.Finite.Basic + +/-! +# Removing the leading support class + +The finite-product calculation preceding LM24, Definition 8.4.2 repeatedly separates the leading +reduction from the open truncation. The open truncation has a strictly smaller set of support +classes. In the nonzero-truncation case the reduction has closed truncation equal to itself and +open truncation equal to one, so it is reduced in the sense of LM24, Definition 8.2.6. + +Support classes include the zero class `⊤`. Mathlib orders Archimedean classes oppositely to LM24; +the open truncation at the leading class therefore retains the strictly greater Mathlib classes. +-/ + +public noncomputable section + +open FiniteArchimedeanClass +open scoped HahnSeries + +namespace HahnSeries.Nonpositive + +variable {K G R : Type*} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] + +section Ring + +variable [Ring R] + +/-- The Archimedean classes met by the support, including the zero class when zero is in the +support. This is a set of classes, not a set of exponents. -/ +def supportArchimedeanClasses (x : Nonpositive G R) : Set (ArchimedeanClass G) := + ArchimedeanClass.mk '' (x : R⟦G⟧).support + +/-- A class meets the support exactly when it contains an exponent with nonzero coefficient. -/ +theorem mem_supportArchimedeanClasses (x : Nonpositive G R) (c : ArchimedeanClass G) : + c ∈ supportArchimedeanClasses x ↔ + ∃ g ∈ (x : R⟦G⟧).support, ArchimedeanClass.mk g = c := + (Iff.rfl) + +/-- The zero series meets no Archimedean class. -/ +@[simp] +theorem supportArchimedeanClasses_zero : + supportArchimedeanClasses (0 : Nonpositive G R) = ∅ := by + ext c + simp [mem_supportArchimedeanClasses] + +/-- Open-class truncation cannot introduce a support class. -/ +theorem supportArchimedeanClasses_tau_subset (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + supportArchimedeanClasses (tau (K := K) c x) ⊆ supportArchimedeanClasses x := by + rintro _ ⟨g, hg, rfl⟩ + refine ⟨g, ?_, rfl⟩ + by_cases hball : g ∈ ball K c + · rw [HahnSeries.mem_support, coeff_tau_of_mem c x hball] at hg + exact hg + · rw [HahnSeries.mem_support, coeff_tau_of_not_mem c x hball] at hg + exact (hg rfl).elim + +/-- A nonzero series meets its leading Archimedean class. -/ +theorem leadingClass_mem_supportArchimedeanClasses (x : Nonpositive G R) (hx : x ≠ 0) + (horder : (x : R⟦G⟧).order ≠ 0) : + (leadingClass x horder).val ∈ supportArchimedeanClasses x := by + refine ⟨(x : R⟦G⟧).order, ?_, (leadingClass_val x horder).symm⟩ + exact (HahnSeries.mem_support _ _).mpr + (HahnSeries.coeff_order_eq_zero.not.mpr fun h ↦ hx (Subtype.ext h)) + +/-- Open truncation at the leading class removes that class from the support. -/ +theorem leadingClass_not_mem_supportArchimedeanClasses_tau (x : Nonpositive G R) + (horder : (x : R⟦G⟧).order ≠ 0) : + (leadingClass x horder).val ∉ + supportArchimedeanClasses (tau (K := K) (leadingClass x horder) x) := by + rintro ⟨g, hg, hclass⟩ + have hgCoeff : + ((tau (K := K) (leadingClass x horder) x : Nonpositive G R) : R⟦G⟧).coeff g ≠ 0 := + (HahnSeries.mem_support _ _).mp hg + have hgBall : g ∈ ball K (leadingClass x horder) := by + by_contra hnot + exact hgCoeff (coeff_tau_of_not_mem (K := K) (leadingClass x horder) x hnot) + have hg0 : g ≠ 0 := by + intro hgzero + subst g + exact (leadingClass x horder).prop hclass.symm + have hlt := (FiniteArchimedeanClass.mem_ball_iff K).mp hgBall hg0 + exact (ne_of_lt hlt) (Subtype.ext hclass.symm) + +/-- The open truncation at a nonconstant series' leading class has strictly fewer support +classes, in the sense of strict set inclusion. -/ +theorem supportArchimedeanClasses_tau_ssubset (x : Nonpositive G R) (hx : x ≠ 0) + (horder : (x : R⟦G⟧).order ≠ 0) : + supportArchimedeanClasses (tau (K := K) (leadingClass x horder) x) ⊂ + supportArchimedeanClasses x := by + refine Set.ssubset_iff_subset_ne.mpr + ⟨supportArchimedeanClasses_tau_subset (leadingClass x horder) x, ?_⟩ + intro heq + exact leadingClass_not_mem_supportArchimedeanClasses_tau x horder + (heq ▸ leadingClass_mem_supportArchimedeanClasses x hx horder) + +/-- A nonzero series contained in a closed class ball with open truncation one is reduced. -/ +theorem isReduced_of_T_eq_self_of_tau_eq_one (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) (hx : x ≠ 0) (hT : T (K := K) c x = x) + (htau : tau (K := K) c x = 1) : IsReduced x := by + refine isReduced_of_support_inter_support_sub_one_subset hx c.val ?_ + rintro g ⟨hg, hgSub⟩ + have hg0 : g ≠ 0 := by + intro hzero + subst g + have hcoeff := congrArg (fun y : Nonpositive G R ↦ (y : R⟦G⟧).coeff 0) htau + rw [coeff_tau_of_mem (K := K) c x (zero_mem _)] at hcoeff + have hsubCoeff := (HahnSeries.mem_support _ _).mp hgSub + change (((x : R⟦G⟧) - 1).coeff 0) ≠ 0 at hsubCoeff + rw [HahnSeries.coeff_sub, HahnSeries.coeff_one, hcoeff] at hsubCoeff + simp at hsubCoeff + have hgClosed : g ∈ closedBall K c := by + by_contra hnot + have hcoeff := (HahnSeries.mem_support _ _).mp hg + rw [← hT, coeff_T_of_not_mem (K := K) c x hnot] at hcoeff + exact hcoeff rfl + have hgNotBall : g ∉ ball K c := by + intro hball + have hcoeff := congrArg (fun y : Nonpositive G R ↦ (y : R⟦G⟧).coeff g) htau + rw [coeff_tau_of_mem (K := K) c x hball] at hcoeff + change (x : R⟦G⟧).coeff g = (1 : R⟦G⟧).coeff g at hcoeff + rw [HahnSeries.coeff_one, if_neg hg0] at hcoeff + exact (HahnSeries.mem_support _ _).mp hg hcoeff + have hle := (FiniteArchimedeanClass.mem_closedBall_iff K).mp hgClosed hg0 + have hnlt : ¬ c < FiniteArchimedeanClass.mk g hg0 := fun hlt ↦ + hgNotBall ((FiniteArchimedeanClass.mem_ball_iff K).mpr fun _ ↦ hlt) + exact congrArg Subtype.val (le_antisymm (not_lt.mp hnlt) hle) + +/-- A reduced series meets at most its reduced class and the zero class, hence finitely many +Archimedean classes even when its support is infinite. -/ +theorem IsReduced.supportArchimedeanClasses_finite {x : Nonpositive G R} (hx : IsReduced x) : + (supportArchimedeanClasses x).Finite := by + obtain ⟨_, c, hc⟩ := hx.elim + apply ((Set.finite_singleton c).insert ⊤).subset + rintro _ ⟨g, hg, rfl⟩ + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + by_cases hg0 : g = 0 + · left + rw [hg0, ArchimedeanClass.mk_zero] + · right + apply hc + refine ⟨hg, ?_⟩ + rw [HahnSeries.mem_support] + change ((x : R⟦G⟧) - 1).coeff g ≠ 0 + rw [HahnSeries.coeff_sub, HahnSeries.coeff_one, if_neg hg0, sub_zero] + exact (HahnSeries.mem_support _ _).mp hg + +end Ring + +section Field + +variable [Field R] + +/-- A reduction with nonzero open truncation is fixed by the closed truncation. -/ +theorem T_rho_of_tau_ne_zero (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) (x : Nonpositive G R) + (htau : tau (K := K) c x ≠ 0) : + T (K := K) c (rho u c x) = rho u c x := by + apply mul_right_cancel₀ htau + calc + T (K := K) c (rho u c x) * tau (K := K) c x = + T (K := K) c (rho u c x) * T (K := K) c (tau (K := K) c x) := by rw [T_tau] + _ = T (K := K) c (rho u c x * tau (K := K) c x) := (map_mul _ _ _).symm + _ = T (K := K) c (T (K := K) c x) := by + rw [rho_of_tau_ne_zero u c x htau, reductionQuotient_mul_tau] + _ = T (K := K) c x := T_T c x + _ = rho u c x * tau (K := K) c x := by + rw [rho_of_tau_ne_zero u c x htau, reductionQuotient_mul_tau] + +/-- A reduction with nonzero open truncation has open truncation one. -/ +theorem tau_rho_of_tau_ne_zero (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) (x : Nonpositive G R) + (htau : tau (K := K) c x ≠ 0) : + tau (K := K) c (rho u c x) = 1 := by + apply mul_right_cancel₀ htau + calc + tau (K := K) c (rho u c x) * tau (K := K) c x = + tau (K := K) c (rho u c x * tau (K := K) c x) := by + simpa only [tau_tau] using + ((tau (K := K) c).map_mul (rho u c x) (tau (K := K) c x)).symm + _ = tau (K := K) c (T (K := K) c x) := by + rw [rho_of_tau_ne_zero u c x htau, reductionQuotient_mul_tau] + _ = tau (K := K) c x := tau_T c x + _ = 1 * tau (K := K) c x := (one_mul _).symm + +/-- The leading reduction of a nonzero, nonconstant series is reduced when the open truncation +is nonzero, as in LM24, Proposition 8.2.5. -/ +theorem isReduced_rho_leadingClass_of_tau_ne_zero + (u : HahnEmbedding.ArchimedeanStrata K G) (x : Nonpositive G R) (hx : x ≠ 0) + (horder : (x : R⟦G⟧).order ≠ 0) + (htau : tau (K := K) (leadingClass x horder) x ≠ 0) : + IsReduced (rho u (leadingClass x horder) x) := by + have hrho0 : rho u (leadingClass x horder) x ≠ 0 := by + intro hrho + have hfac := reductionQuotient_mul_tau u (leadingClass x horder) x + (fun hzero ↦ htau ((tauBall_eq_zero_iff (leadingClass x horder) x).mp hzero)) + rw [← rho_of_tau_ne_zero u (leadingClass x horder) x htau, + hrho, zero_mul, T_leadingClass] at hfac + exact hx hfac.symm + exact isReduced_of_T_eq_self_of_tau_eq_one (leadingClass x horder) + (rho u (leadingClass x horder) x) hrho0 + (T_rho_of_tau_ne_zero u (leadingClass x horder) x htau) + (tau_rho_of_tau_ne_zero u (leadingClass x horder) x htau) + +end Field + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/IntegerPartSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/IntegerPartSplitting.lean new file mode 100644 index 0000000000..368b2dfa7f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/IntegerPartSplitting.lean @@ -0,0 +1,328 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.SplitTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationPrimality + +/-! +# Splitting a leading-class Hahn-series integer part + +This module formalizes LM24, Fact 2.4.2(5). The elements of the truncation integer part fixed by +the closed-class cut are identified with an outer truncation integer part whose coefficient +subring is the embedded inner truncation integer part. Keeping that exact coefficient subring is +essential: replacing it by the whole inner Hahn field loses the source integer-part condition. +-/ + +open FiniteArchimedeanClass + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {K G R : Type*} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] + +def fixedIntegerPartSubring (c : FiniteArchimedeanClass G) (Z : Subring R) : + Subring (truncationIntegerPart G Z) := + (truncationSubring (K := K) (R := R) c).comap + (truncationIntegerPart G Z).subtype + +/-- Membership in the fixed integer-part subring is exactly invariance under closed-class +truncation of the underlying nonpositive Hahn series. -/ +theorem mem_fixedIntegerPartSubring_iff (c : FiniteArchimedeanClass G) (Z : Subring R) + (x : truncationIntegerPart G Z) : + x ∈ fixedIntegerPartSubring (K := K) (G := G) (R := R) c Z ↔ + T (K := K) c (x : Nonpositive G R) = x := by + change (x : Nonpositive G R) ∈ truncationSubring (K := K) (R := R) c ↔ _ + exact mem_truncationSubring_iff c (x : Nonpositive G R) + +theorem coeff_zero_tauBall (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + (tauBall (K := K) c x).coeff 0 = (x : R⟦G⟧).coeff 0 := by + rw [tauBall_coeff] + exact coeff_tau_of_mem c x (Submodule.zero_mem _) + +def innerIntegerPartSubring (c : FiniteArchimedeanClass G) (Z : Subring R) : + Subring R⟦ball K c⟧ := + (truncationIntegerPart (ball K c) Z).map + (nonpositiveSubring (ball K c) R).subtype + +/-- Membership in the embedded inner integer part means nonpositive support and constant +coefficient in `Z`. -/ +theorem mem_innerIntegerPartSubring_iff (c : FiniteArchimedeanClass G) (Z : Subring R) + (x : R⟦ball K c⟧) : + x ∈ innerIntegerPartSubring (K := K) (G := G) c Z ↔ + x.support ⊆ Set.Iic 0 ∧ x.coeff 0 ∈ Z := by + constructor + · intro hx + obtain ⟨y, hy, hxy⟩ := Subring.mem_map.mp hx + rw [← hxy] + exact ⟨support_subset y, (mem_truncationIntegerPart (R := R) (Γ := ball K c)).mp hy⟩ + · rintro ⟨hsupport, hcoeff⟩ + let y : Nonpositive (ball K c) R := ⟨x, hsupport⟩ + apply Subring.mem_map.mpr + exact ⟨y, (mem_truncationIntegerPart (R := R) (Γ := ball K c)).mpr hcoeff, rfl⟩ + +theorem tauBall_mem_innerIntegerPartSubring + (c : FiniteArchimedeanClass G) (Z : Subring R) + (x : truncationIntegerPart G Z) : + tauBall (K := K) c (x : Nonpositive G R) ∈ innerIntegerPartSubring c Z := by + apply Subring.mem_map.mpr + let y : Nonpositive (ball K c) R := ⟨tauBall c x, ?_⟩ + · refine ⟨y, ?_, rfl⟩ + rw [mem_truncationIntegerPart] + rw [show (y : R⟦ball K c⟧).coeff 0 = (tauBall c x).coeff 0 by rfl] + rw [coeff_zero_tauBall] + exact (mem_truncationIntegerPart (Γ := G) (R := R)).mp x.2 + · intro b hb + rw [HahnSeries.mem_support] at hb + rw [tauBall_coeff] at hb + change (HahnSeries.coeff + (((tau (K := K) c (x : Nonpositive G R) : Nonpositive G R) : R⟦G⟧)) + (b : G) ≠ 0) at hb + rw [coeff_tau_of_mem c (x : Nonpositive G R) b.2] at hb + exact Subtype.coe_le_coe.mp (support_subset (x : Nonpositive G R) hb) + +def splitRawRingHom + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + : Nonpositive G R →+* (R⟦ball K c⟧)⟦u.stratum c⟧ := + (HahnSeries.archimedeanSplitRingEquiv u c).toRingHom.comp (TClosedRingHom c) + +@[simp] +theorem splitRawRingHom_apply + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + splitRawRingHom u c x = HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x) := by + rw [splitRawRingHom, RingHom.comp_apply, RingEquiv.toRingHom_eq_coe, + TClosedRingHom_apply] + rfl + +def splitIntegerPartRingHom + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) : truncationIntegerPart G Z →+* + truncationIntegerPart (u.stratum c) + (innerIntegerPartSubring (K := K) (G := G) c Z) where + toFun x := ⟨⟨splitRawRingHom u c (x : Nonpositive G R), by + rw [splitRawRingHom_apply] + exact support_archimedeanSplitRingEquiv_TClosed_subset u c + (x : Nonpositive G R)⟩, by + rw [mem_truncationIntegerPart] + change (splitRawRingHom u c (x : Nonpositive G R)).coeff 0 ∈ + innerIntegerPartSubring (K := K) (G := G) c Z + rw [splitRawRingHom_apply, coeff_zero_archimedeanSplitRingEquiv_TClosed] + exact tauBall_mem_innerIntegerPartSubring c Z x⟩ + map_one' := by + apply Subtype.ext + apply Subtype.ext + exact map_one (splitRawRingHom u c) + map_mul' x y := by + apply Subtype.ext + apply Subtype.ext + exact map_mul (splitRawRingHom u c) (x : Nonpositive G R) y + map_zero' := by + apply Subtype.ext + apply Subtype.ext + exact map_zero (splitRawRingHom u c) + map_add' x y := by + apply Subtype.ext + apply Subtype.ext + exact map_add (splitRawRingHom u c) (x : Nonpositive G R) y + +/-- The integer-part split has the underlying nonpositive split truncation. -/ +@[simp] +theorem coe_splitIntegerPartRingHom + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) (x : truncationIntegerPart G Z) : + ((splitIntegerPartRingHom u c Z x : + truncationIntegerPart (u.stratum c) (innerIntegerPartSubring c Z)) : + Nonpositive (u.stratum c) R⟦ball K c⟧) = + splitTruncation u c (x : Nonpositive G R) := by + apply Subtype.ext + rw [coe_splitTruncation] + change splitRawRingHom u c (x : Nonpositive G R) = _ + rw [splitRawRingHom_apply] + +def splitFixedIntegerPartRingHom + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) : + fixedIntegerPartSubring (K := K) (G := G) (R := R) c Z →+* + truncationIntegerPart (u.stratum c) + (innerIntegerPartSubring (K := K) (G := G) c Z) := + (splitIntegerPartRingHom u c Z).comp + (fixedIntegerPartSubring (K := K) (G := G) (R := R) c Z).subtype + +@[simp] +theorem coe_splitFixedIntegerPartRingHom + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) (x : fixedIntegerPartSubring (K := K) (G := G) (R := R) c Z) : + ((splitFixedIntegerPartRingHom u c Z x : + truncationIntegerPart (u.stratum c) (innerIntegerPartSubring c Z)) : + Nonpositive (u.stratum c) R⟦ball K c⟧) = + splitTruncation u c (x : Nonpositive G R) := + by + apply Subtype.ext + rw [coe_splitTruncation] + change (splitRawRingHom u c (x : Nonpositive G R)) = _ + rw [splitRawRingHom_apply] + +def unsplitIntegerPart + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (y : truncationIntegerPart (u.stratum c) + (innerIntegerPartSubring (K := K) (G := G) c Z)) : + fixedIntegerPartSubring (K := K) (G := G) (R := R) c Z := by + let yOuter : Nonpositive (u.stratum c) R⟦ball K c⟧ := y + have hyZeroInner : (((yOuter : (R⟦ball K c⟧)⟦u.stratum c⟧).coeff 0).support ⊆ + Set.Iic 0) := by + have hyMem : (yOuter : (R⟦ball K c⟧)⟦u.stratum c⟧).coeff 0 ∈ + innerIntegerPartSubring (K := K) (G := G) c Z := + (mem_truncationIntegerPart (Γ := u.stratum c) (R := R⟦ball K c⟧)).mp y.2 + obtain ⟨z, hz, hzy⟩ := Subring.mem_map.mp hyMem + rw [← hzy] + exact support_subset z + let zClosed := (HahnSeries.archimedeanSplitRingEquiv u c).symm + (yOuter : (R⟦ball K c⟧)⟦u.stratum c⟧) + let z : Nonpositive G R := + ⟨HahnSeries.embDomain (closedBallOrderEmbedding (K := K) c) zClosed, by + rw [mem_nonpositiveSubring] + rw [HahnSeries.support_embDomain] + rintro _ ⟨g, hg, rfl⟩ + rw [closedBallOrderEmbedding_apply] + exact Subtype.coe_le_coe.mpr + (support_archimedeanSplitRingEquiv_symm_subset_Iic u c + (yOuter : (R⟦ball K c⟧)⟦u.stratum c⟧) + (support_subset yOuter) hyZeroInner hg)⟩ + have hzeroEmbedding : closedBallOrderEmbedding (K := K) c (0 : closedBall K c) = 0 := by + rw [closedBallOrderEmbedding_apply] + rfl + have hzCoeff : (z : R⟦G⟧).coeff 0 ∈ Z := by + have hyMem : (yOuter : (R⟦ball K c⟧)⟦u.stratum c⟧).coeff 0 ∈ + innerIntegerPartSubring (K := K) (G := G) c Z := + (mem_truncationIntegerPart (Γ := u.stratum c) (R := R⟦ball K c⟧)).mp y.2 + obtain ⟨w, hw, hwy⟩ := Subring.mem_map.mp hyMem + rw [mem_truncationIntegerPart] at hw + change (HahnSeries.embDomain (closedBallOrderEmbedding (K := K) c) zClosed).coeff 0 ∈ Z + rw [← hzeroEmbedding] + rw [HahnSeries.embDomain_coeff] + have hcoeff := congrArg (fun q : (R⟦ball K c⟧)⟦u.stratum c⟧ ↦ + (q.coeff 0).coeff 0) + ((HahnSeries.archimedeanSplitRingEquiv u c).apply_symm_apply (yOuter : _)) + rw [HahnSeries.archimedeanSplitRingEquiv_coeff] at hcoeff + rw [show HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c + (toLex (0, 0)) = 0 by simp] at hcoeff + change ((HahnSeries.archimedeanSplitRingEquiv u c).symm + (yOuter : (R⟦ball K c⟧)⟦u.stratum c⟧)).coeff 0 ∈ Z + rw [hcoeff, ← hwy] + exact hw + refine ⟨⟨z, (mem_truncationIntegerPart (Γ := G) (R := R)).mpr hzCoeff⟩, ?_⟩ + apply (mem_truncationSubring_iff c z).mpr + apply Subtype.ext + ext g + by_cases hg : g ∈ closedBall K c + · rw [coeff_T_of_mem c z hg] + · rw [coeff_T_of_not_mem c z hg] + symm + apply HahnSeries.embDomain_notin_range + exact fun ⟨h, hh⟩ ↦ hg (by + rw [closedBallOrderEmbedding_apply] at hh + exact hh ▸ h.2) + +@[simp] +theorem coe_unsplitIntegerPart + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (y : truncationIntegerPart (u.stratum c) + (innerIntegerPartSubring (K := K) (G := G) c Z)) : + (((unsplitIntegerPart u c Z y : truncationIntegerPart G Z) : Nonpositive G R) : + R⟦G⟧) = + HahnSeries.embDomain (closedBallOrderEmbedding (K := K) c) + ((HahnSeries.archimedeanSplitRingEquiv u c).symm + (y : (R⟦ball K c⟧)⟦u.stratum c⟧)) := + by + rfl + +theorem TClosed_of_fixed (c : FiniteArchimedeanClass G) (x : Nonpositive G R) + (hx : T (K := K) c x = x) : + TClosed (K := K) c x = + HahnSeries.restrictDomain (closedBallOrderEmbedding (K := K) c) (x : R⟦G⟧) := by + ext g + rw [TClosed_coeff, hx, HahnSeries.restrictDomain_coeff, + closedBallOrderEmbedding_apply] + +-- Checking both inverses traverses the full nested subtype and Hahn-series equivalence stack. +def splitFixedIntegerPartRingEquiv + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) : + fixedIntegerPartSubring (K := K) (G := G) (R := R) c Z ≃+* + truncationIntegerPart (u.stratum c) + (innerIntegerPartSubring (K := K) (G := G) c Z) where + toFun := splitFixedIntegerPartRingHom u c Z + invFun := unsplitIntegerPart u c Z + left_inv x := by + apply Subtype.ext + apply Subtype.ext + apply Subtype.ext + dsimp only [unsplitIntegerPart] + change HahnSeries.embDomain (closedBallOrderEmbedding (K := K) c) + ((HahnSeries.archimedeanSplitRingEquiv u c).symm + (((splitFixedIntegerPartRingHom u c Z x : _) : + Nonpositive (u.stratum c) R⟦ball K c⟧) : + (R⟦ball K c⟧)⟦u.stratum c⟧)) = (x : R⟦G⟧) + rw [coe_splitFixedIntegerPartRingHom] + rw [coe_splitTruncation] + rw [RingEquiv.symm_apply_apply, embDomain_TClosed] + exact congrArg Subtype.val ((mem_truncationSubring_iff c (x : Nonpositive G R)).mp x.2) + right_inv y := by + apply Subtype.ext + rw [coe_splitFixedIntegerPartRingHom] + apply Subtype.ext + rw [coe_splitTruncation] + rw [TClosed_of_fixed c (unsplitIntegerPart u c Z y : Nonpositive G R) + ((mem_truncationSubring_iff c _).mp (unsplitIntegerPart u c Z y).2)] + rw [coe_unsplitIntegerPart] + change HahnSeries.archimedeanSplitRingEquiv u c + (HahnSeries.restrictDomain (closedBallOrderEmbedding (K := K) c) + (HahnSeries.embDomain (closedBallOrderEmbedding (K := K) c) + ((HahnSeries.archimedeanSplitRingEquiv u c).symm + (y : (R⟦ball K c⟧)⟦u.stratum c⟧)))) = + (y : (R⟦ball K c⟧)⟦u.stratum c⟧) + rw [HahnSeries.restrictDomain_embDomain, RingEquiv.apply_symm_apply] + map_mul' := (splitFixedIntegerPartRingHom u c Z).map_mul + map_add' := (splitFixedIntegerPartRingHom u c Z).map_add + +/-- The fixed integer-part equivalence applies by the split ring homomorphism. -/ +@[simp] +theorem splitFixedIntegerPartRingEquiv_apply + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) (x : fixedIntegerPartSubring (K := K) (G := G) (R := R) c Z) : + splitFixedIntegerPartRingEquiv u c Z x = splitFixedIntegerPartRingHom u c Z x := + (rfl) + +/-- The inverse fixed integer-part equivalence is the explicit unsplit construction. -/ +@[simp] +theorem splitFixedIntegerPartRingEquiv_symm_apply + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (y : truncationIntegerPart (u.stratum c) + (innerIntegerPartSubring (K := K) (G := G) c Z)) : + (splitFixedIntegerPartRingEquiv u c Z).symm y = unsplitIntegerPart u c Z y := + (rfl) + +theorem coe_splitFixedIntegerPartRingEquiv + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) (x : fixedIntegerPartSubring (K := K) (G := G) (R := R) c Z) : + ((splitFixedIntegerPartRingEquiv u c Z x : + truncationIntegerPart (u.stratum c) (innerIntegerPartSubring c Z)) : + Nonpositive (u.stratum c) R⟦ball K c⟧) = + splitTruncation u c (x : Nonpositive G R) := by + change ((splitFixedIntegerPartRingHom u c Z x : _) : + Nonpositive (u.stratum c) R⟦ball K c⟧) = _ + exact coe_splitFixedIntegerPartRingHom u c Z x + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/IrreducibilityTransfer.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/IrreducibilityTransfer.lean new file mode 100644 index 0000000000..47768842bd --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/IrreducibilityTransfer.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.PrimalityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Monomial + +/-! +# Irreducibility transfer from a leading Archimedean class + +This module formalizes the residue-one irreducibility transfer used in LM24, +Proposition 8.3.6(5). If a nonconstant integer-part element has open truncation one and its +leading split is irreducible, then the original element is irreducible. + +Every factor of the element is fixed by truncation at its leading class. The fixed integer-part +subring is ring-equivalent to the split integer part. Finally, an ambient unit occurring in a +factorisation with constant coefficient one is already a unit of that integer part. +-/ + +public noncomputable section + +namespace HahnSeries.Nonpositive + +open FiniteArchimedeanClass + +variable {K G R : Type*} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] + +private theorem irreducible_truncationIntegerPart_of_irreducible_of_constantCoeff_eq_one + {S : Subring R} {b : truncationIntegerPart G S} + (hirr : Irreducible (b : Nonpositive G R)) + (hconstant : constantCoeff (b : Nonpositive G R) = 1) : + Irreducible b := by + rw [irreducible_iff] + refine ⟨fun hunit ↦ hirr.not_isUnit + ((truncationIntegerPart G S).subtype.isUnit_map hunit), ?_⟩ + intro c d hfactor + have hfactorAmbient : (b : Nonpositive G R) = c * d := + congrArg Subtype.val hfactor + rcases hirr.isUnit_or_isUnit hfactorAmbient with hcUnit | hdUnit + · left + have hcoeffProduct : + constantCoeff (c : Nonpositive G R) * + constantCoeff (d : Nonpositive G R) = 1 := by + calc + _ = constantCoeff ((c : Nonpositive G R) * (d : Nonpositive G R)) := + (map_mul (constantCoeff (Γ := G) (R := R)) + (c : Nonpositive G R) (d : Nonpositive G R)).symm + _ = constantCoeff (b : Nonpositive G R) := by rw [hfactorAmbient] + _ = 1 := hconstant + let dConstant : truncationIntegerPart G S := + ⟨C (constantCoeff (d : Nonpositive G R)), by + rw [mem_truncationIntegerPart] + simpa [constantCoeff_apply] using + (mem_truncationIntegerPart (R := R) (Γ := G)).mp d.2⟩ + apply isUnit_iff_exists.mpr + refine ⟨dConstant, ?_⟩ + have hprod : c * dConstant = 1 := by + apply Subtype.ext + change (c : Nonpositive G R) * C (constantCoeff (d : Nonpositive G R)) = 1 + rw [eq_C_constantCoeff_of_isUnit hcUnit, ← map_mul, hcoeffProduct, map_one] + exact ⟨hprod, by simpa [mul_comm] using hprod⟩ + · right + have hcoeffProduct : + constantCoeff (c : Nonpositive G R) * + constantCoeff (d : Nonpositive G R) = 1 := by + calc + _ = constantCoeff ((c : Nonpositive G R) * (d : Nonpositive G R)) := + (map_mul (constantCoeff (Γ := G) (R := R)) + (c : Nonpositive G R) (d : Nonpositive G R)).symm + _ = constantCoeff (b : Nonpositive G R) := by rw [hfactorAmbient] + _ = 1 := hconstant + let cConstant : truncationIntegerPart G S := + ⟨C (constantCoeff (c : Nonpositive G R)), by + rw [mem_truncationIntegerPart] + simpa [constantCoeff_apply] using + (mem_truncationIntegerPart (R := R) (Γ := G)).mp c.2⟩ + apply isUnit_iff_exists.mpr + refine ⟨cConstant, ?_⟩ + have hprod : d * cConstant = 1 := by + apply Subtype.ext + change (d : Nonpositive G R) * C (constantCoeff (c : Nonpositive G R)) = 1 + rw [eq_C_constantCoeff_of_isUnit hdUnit, ← map_mul, mul_comm, + hcoeffProduct, map_one] + exact ⟨hprod, by simpa [mul_comm] using hprod⟩ + +/-- In the residue-one branch, irreducibility of the ambient split series implies +irreducibility in its split integer part. -/ +theorem irreducible_splitTruncationIntegerPart_of_tau_eq_one + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (S : Subring R⟦ball K c⟧) (x : Nonpositive G R) + (htau : tauBall c x = 1) + (hirr : Irreducible (splitTruncation u c x)) : + Irreducible + (splitTruncationIntegerPart u c S x (htau.symm ▸ S.one_mem)) := by + have hirr' : Irreducible + (splitTruncationIntegerPart u c S x (htau.symm ▸ S.one_mem) : + Nonpositive (u.stratum c) R⟦ball K c⟧) := by + rw [coe_splitTruncationIntegerPart] + exact hirr + apply irreducible_truncationIntegerPart_of_irreducible_of_constantCoeff_eq_one hirr' + rw [coe_splitTruncationIntegerPart, constantCoeff_splitTruncation, htau] + +/-- Irreducibility in the leading fixed integer-part subring implies irreducibility in the full +integer part. -/ +theorem irreducible_of_irreducible_leadingFixedIntegerPartElement + (Z : Subring R) (b : truncationIntegerPart G Z) + (hb0 : (b : Nonpositive G R) ≠ 0) + (horder : ((b : Nonpositive G R) : R⟦G⟧).order ≠ 0) + (hirr : Irreducible + (leadingFixedIntegerPartElement (K := K) Z b horder)) : + Irreducible b := by + rw [irreducible_iff] + refine ⟨?_, ?_⟩ + · intro hunit + have hunitAmbient : IsUnit (b : Nonpositive G R) := + (truncationIntegerPart G Z).subtype.isUnit_map hunit + have hsupport := support_eq_singleton_zero_of_isUnit hunitAmbient + have hbOrderMem : ((b : Nonpositive G R) : R⟦G⟧).order ∈ + ((b : Nonpositive G R) : R⟦G⟧).support := by + rw [HahnSeries.mem_support] + exact HahnSeries.coeff_order_eq_zero.not.mpr + (fun h ↦ hb0 (Subtype.ext h)) + rw [hsupport, Set.mem_singleton_iff] at hbOrderMem + exact horder hbOrderMem + · intro c d hfactor + have hcDvd : (c : Nonpositive G R) ∣ (b : Nonpositive G R) := + ⟨d, congrArg Subtype.val hfactor⟩ + have hdDvd : (d : Nonpositive G R) ∣ (b : Nonpositive G R) := + ⟨c, by simpa [mul_comm] using congrArg Subtype.val hfactor⟩ + have hcFixed := T_leadingClass_of_dvd (K := K) + (b : Nonpositive G R) hb0 horder hcDvd + have hdFixed := T_leadingClass_of_dvd (K := K) + (b : Nonpositive G R) hb0 horder hdDvd + let cFixed : fixedIntegerPartSubring (K := K) (G := G) (R := R) + (leadingClass (b : Nonpositive G R) horder) Z := + ⟨c, (mem_fixedIntegerPartSubring_iff _ Z c).mpr hcFixed⟩ + let dFixed : fixedIntegerPartSubring (K := K) (G := G) (R := R) + (leadingClass (b : Nonpositive G R) horder) Z := + ⟨d, (mem_fixedIntegerPartSubring_iff _ Z d).mpr hdFixed⟩ + have hfactorFixed : + leadingFixedIntegerPartElement (K := K) Z b horder = + cFixed * dFixed := by + apply Subtype.ext + rw [coe_leadingFixedIntegerPartElement] + simpa [cFixed, dFixed] using hfactor + rcases hirr.isUnit_or_isUnit hfactorFixed with hcUnit | hdUnit + · exact Or.inl + ((fixedIntegerPartSubring (K := K) (G := G) (R := R) + (leadingClass (b : Nonpositive G R) horder) Z).subtype.isUnit_map hcUnit) + · exact Or.inr + ((fixedIntegerPartSubring (K := K) (G := G) (R := R) + (leadingClass (b : Nonpositive G R) horder) Z).subtype.isUnit_map hdUnit) + +/-- LM24, Proposition 8.3.6(5), residue-one case: if the leading split of a nonzero, +nonconstant integer-part element is irreducible, then the original element is irreducible. -/ +theorem irreducible_of_irreducible_splitTruncation_of_tau_eq_one + (u : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : truncationIntegerPart G Z) (hb0 : (b : Nonpositive G R) ≠ 0) + (horder : ((b : Nonpositive G R) : R⟦G⟧).order ≠ 0) + (htau : tauBall (K := K) (leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R) = 1) + (hirr : Irreducible + (splitTruncation u (leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R))) : + Irreducible b := by + let sigma := leadingClass (b : Nonpositive G R) horder + let bFixed := leadingFixedIntegerPartElement (K := K) Z b horder + let e := splitFixedIntegerPartRingEquiv u sigma Z + let S := innerIntegerPartSubring (K := K) (G := G) sigma Z + have hsplitIrr : Irreducible + (splitTruncationIntegerPart u sigma S (b : Nonpositive G R) + (htau.symm ▸ S.one_mem)) := + irreducible_splitTruncationIntegerPart_of_tau_eq_one u sigma S b htau hirr + have heq : e bFixed = + splitTruncationIntegerPart u sigma S (b : Nonpositive G R) + (htau.symm ▸ S.one_mem) := by + rw [show e bFixed = splitTruncationIntegerPart u sigma S + (b : Nonpositive G R) + (tauBall_mem_innerIntegerPartSubring sigma Z b) by + exact splitFixedIntegerPartRingEquiv_leadingFixedIntegerPartElement + u Z b horder] + have hfixedIrr : Irreducible bFixed := by + have hmapped := hsplitIrr.map e.symm + rw [← heq] at hmapped + simpa using hmapped + exact irreducible_of_irreducible_leadingFixedIntegerPartElement + Z b hb0 horder hfixedIrr + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/LimitTailPrimality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/LimitTailPrimality.lean new file mode 100644 index 0000000000..c91965d920 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/LimitTailPrimality.lean @@ -0,0 +1,255 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportArchimedeanClasses +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ClosedClassRefinementTransport + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Primality from common-tail quotients + +The induction rank is the order type of the Archimedean classes met by the non-zero support. A +supplied theorem handles the case in which this set is finite. At every infinite rank, the classes +split into a non-zero limit initial segment and a finite final segment. Cauchy completeness of the +quotient by the common tail below the limit segment, together with primality for every series whose +support meets only finitely many Archimedean classes and the hypothesis that the κ-bounded integer +part on the common tail has the required fraction field, gives an exact refinement at a class met by +the support. Factoring off the resulting divisor strictly lowers the rank, so ordinal induction +proves that every element is primal. +-/ + +public noncomputable section + +open Cardinal FiniteArchimedeanClass +open HahnSeries.CardSuppLTTruncationIntegerPart +open scoped HahnSeries + +universe u v + +namespace HahnSeries.CardSuppLTTruncationIntegerPart + +/-- The common-tail hypotheses extend finite-class primality to every cardinal-bounded Hahn +integer-part series. -/ +@[blueprint "thm:limit-tail-primality" + (phase := "Refinement over Archimedean classes") + (title := "Transfinite extension of finite-class primality") + (statement := /-- + Let $G$ be an ordered rational vector space, $R$ a field of characteristic + zero, $\kappa>\aleph_0$ a regular cardinal, and $Z\subseteq R$ a subring. + Assume that every element of $Z+R((G^{<0}))_\kappa$ meeting only finitely + many Archimedean classes is primal. For every nonempty set $T$ of nonzero + Archimedean classes with no least member in the magnitude order and + cardinality less than $\kappa$, assume that the quotient by the common tail + below $T$ is Cauchy complete for its additive uniformity and that the + bounded Hahn field on the common tail is the fraction field of its bounded + Hahn integer part. Then every element of + $Z+R((G^{<0}))_\kappa$ is primal. + -/) + (proof := /-- + Induct on the order type of the nonzero Archimedean support classes. The + finite case is the hypothesis. Otherwise split the class set into a limit + initial segment and a finite final segment. By + \ref{thm:support-class-refinement}, an equation $ad=bc$ has an exact + refinement at a quotient class met by the support of $a$. + By \ref{lem:support-class-factorisation}, factoring off the corresponding + retained block leaves a cofactor with strictly smaller support-class order + type. The induction hypothesis makes that cofactor primal, while + \ref{lem:closed-class-refinement-transport} transports the quotient + refinement to the ambient integer part. These two refinements prove that + $a$ is primal. + -/)] +theorem isPrimal_of_finite_classes_and_limit_tail_conditions + {G : Type u} {R : Type v} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module ℚ G] [PosSMulMono ℚ G] + [Field R] [CharZero R] + {κ : Cardinal} [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + (Z : Subring R) + (hfinite : ∀ y : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z, + (ArchimedeanClass.mk '' (y : HahnSeries G R).support).Finite → IsPrimal y) + (hcomplete : ∀ (T : Set (FiniteArchimedeanClass G)), T.Nonempty → + (∀ c ∈ T, ∃ d ∈ T, c < d) → + (#T < κ) → + Nonempty (CompleteSpace (FiniteArchimedeanClass.TailQuotient T))) + (htailfrac : ∀ (T : Set (FiniteArchimedeanClass G)), T.Nonempty → + (∀ c ∈ T, ∃ d ∈ T, c < d) → + (#T < κ) → + Subring.fracSubring (HahnSeries.cardSuppLTTruncationIntegerPart + (G := FiniteArchimedeanClass.tailSubmodule ℚ T) + (R := R) (κ := κ) Z) = ⊤) + (a : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z) : IsPrimal a := by + classical + let S := HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z + let toN := toNonpositiveRingHom (G := G) (R := R) (κ := κ) Z + let rank : S → Ordinal := fun x ↦ + (HahnSeries.Nonpositive.isPWO_nonzeroSupportArchimedeanClasses (toN x)).orderType + have hind : ∀ o : Ordinal, ∀ x : S, rank x = o → IsPrimal x := by + intro o + induction o using WellFoundedLT.induction with + | ind o ih => + intro x hxrank + by_cases hx0 : x = 0 + · rw [hx0] + exact isPrimal_zero + let xN := toN x + rcases xN.isPWO_supportArchimedeanClasses.finite_or_exists_limit_initial_finite_final + with hfiniteClasses | ⟨T₀, T₁, hT₀pwo, _hT₁pwo, hT₀sub, _hT₁sub, _hbefore, + hT₀limit, hT₁finite, hclasses⟩ + · apply hfinite x + simpa only [xN, toN, coe_toNonpositiveRingHom] using hfiniteClasses + · have hT₀gt : ∀ c ∈ T₀, ∃ d ∈ T₀, c < d := fun c hc ↦ + hT₀pwo.exists_gt_of_isSuccLimit_orderType hT₀limit hc + have hxclasses : ArchimedeanClass.mk '' (x : HahnSeries G R).support = T₀ ∪ T₁ := by + simpa only [xN, toN, coe_toNonpositiveRingHom] using hclasses + let T : Set (FiniteArchimedeanClass G) := {c | c.1 ∈ T₀} + have hTne : T.Nonempty := by + have hT₀ne : T₀.Nonempty := by + by_contra hne + rw [Set.not_nonempty_iff_eq_empty] at hne + exact hT₀limit.ne_bot (hT₀pwo.orderType_eq_zero.mpr hne) + obtain ⟨c, hc⟩ := hT₀ne + obtain ⟨d, _hd, hcd⟩ := hT₀gt c hc + exact ⟨⟨c, ne_top_of_lt hcd⟩, hc⟩ + letI : Nonempty T := + ⟨⟨Classical.choose hTne, Classical.choose_spec hTne⟩⟩ + have hTgt : ∀ c ∈ T, ∃ d ∈ T, c < d := by + intro c hc + obtain ⟨d, hd, hcd⟩ := hT₀gt c.1 hc + obtain ⟨e, _he, hde⟩ := hT₀gt d hd + exact ⟨⟨d, ne_top_of_lt hde⟩, hd, hcd⟩ + have hTcard : #T < κ := by + calc + #T = #(Subtype.val '' T) := (Cardinal.mk_image_eq Subtype.val_injective).symm + _ ≤ #T₀ := Cardinal.mk_le_mk_of_subset fun _ h ↦ by + obtain ⟨c, hc, rfl⟩ := h + exact hc + _ ≤ #(ArchimedeanClass.mk '' (x : HahnSeries G R).support) := + Cardinal.mk_le_mk_of_subset fun c hc ↦ by + rw [hxclasses] + exact Or.inl hc + _ ≤ #(x : HahnSeries G R).support := Cardinal.mk_image_le + _ < κ := x.1.2 + letI : CompleteSpace (FiniteArchimedeanClass.TailQuotient T) := + Classical.choice (hcomplete T hTne hTgt hTcard) + let P := FiniteArchimedeanClass.tailSubmodule ℚ T + intro b c hdiv + obtain ⟨d, hprod⟩ := hdiv + have heq : x * d = b * c := hprod.symm + obtain ⟨q, hqocc, e, f, g, h, hxe, _hde, hbe, hce⟩ := + exists_closed_class_refinement_at_support_class Z hfinite + T₀ T₁ hT₀gt hT₁finite x d b c heq hxclasses + (htailfrac T hTne hTgt hTcard) + have hqocc' : q.1 ∈ ArchimedeanClass.mk '' + (Submodule.Quotient.mk (p := P) '' (x : HahnSeries G R).support) := by + obtain ⟨z, hz, hzq⟩ := hqocc + have hsupp := HahnSeries.support_convexQuotientSplitRingEquiv P + (x : HahnSeries G R) + rw [hsupp] at hz + obtain ⟨r, hr, hzr⟩ := hz + exact ⟨z, ⟨r, hr, hzr⟩, hzq⟩ + let C : AddSubgroup G := + (FiniteArchimedeanClass.closedBallAddSubgroup q).comap P.mkQ.toAddMonoidHom + have hfilter0 : HahnSeries.filter (· ∈ C) (x : HahnSeries G R) ≠ 0 := by + obtain ⟨z, ⟨r, hr, hqr⟩, hzq⟩ := hqocc' + intro hzero + have hcoeff := congrArg (fun y : HahnSeries G R ↦ y.coeff r) hzero + rw [HahnSeries.coeff_filter, if_pos] at hcoeff + · exact (HahnSeries.mem_support _ _).mp hr hcoeff + · change P.mkQ r ∈ FiniteArchimedeanClass.closedBallAddSubgroup q + apply FiniteArchimedeanClass.mem_closedBallAddSubgroup_iff.mpr + intro _hr0 + change q.1 ≤ ArchimedeanClass.mk (P.mkQ r) + change P.mkQ r = z at hqr + rw [hqr, hzq] + obtain ⟨t, w, ht, hfac, hrank⟩ := + exists_factor_with_smaller_support_class_orderType + Z T q x hqocc' hfilter0 + have ht' : t = restrictToAddSubgroup Z C x := by + apply Subtype.ext + apply Subtype.ext + exact ht.trans (coe_restrictToAddSubgroup Z C x).symm + have ht0 : t ≠ 0 := fun htzero ↦ hx0 (by rw [hfac, htzero, zero_mul]) + obtain ⟨eA, fA, htef, heb, hfc⟩ := + exists_factor_refinement_of_closed_class_refinement + P Z q x b c t ht' ht0 e f g h hxe hbe hce + have hw : IsPrimal w := by + apply ih (rank w) + · rw [← hxrank] + exact hrank + · rfl + exact exists_primalRefinement_of_factor_refinement + hx0 heq hfac htef heb hfc hw + exact hind (rank a) a rfl + +/-- Conditions `(A1)`--`(A3)` at finite Archimedean classes, together with the two +common-tail hypotheses at limit families, make every element of the bounded Hahn integer part +primal. -/ +@[blueprint "thm:hahn-integer-part-primality" + (phase := "Refinement over Archimedean classes") + (title := "Primality under finite-class and common-tail hypotheses") + (statement := /-- + Let $G$ be an ordered rational vector space, $R$ a field of characteristic + zero, $\kappa>\aleph_0$ a regular cardinal, and $Z\subseteq R$ a + pre-Schreier subring. At every nonzero Archimedean class, choose an + additive complement to the strict inner ball that is order additively + isomorphic to $\mathbb R$. Assume that each strict inner ball either has + cofinality at least $\kappa$, or is zero and every element of $R$ is a + fraction of elements of $Z$. + + For every nonempty set $T$ of fewer than $\kappa$ nonzero Archimedean + classes having no least member in the magnitude order, let $H_T$ be the + rational subspace of exponents lying beyond every class in $T$. Assume + that $G/H_T$ is Cauchy complete for its additive uniformity and that the + bounded Hahn field on $H_T$ is the fraction field of its bounded Hahn + integer part. Then every element of + $Z+R((G^{<0}))_\kappa$ is primal. + -/) + (proof := /-- + By \ref{thm:finite-support-classes-primality}, assumptions + $(A1)_\sigma$--$(A3)$ make every series meeting finitely many Archimedean + classes primal. Apply \ref{thm:limit-tail-primality} to extend this result + to arbitrary support-class order type. + -/)] +theorem isPrimal_of_finite_class_assumptions_and_limit_tail_conditions + {G : Type u} {R : Type v} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module ℚ G] [IsOrderedModule ℚ G] + [Field R] [CharZero R] + {κ : Cardinal} [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + (Z : Subring R) [DecompositionMonoid Z] + (s : HahnEmbedding.ArchimedeanStrata ℚ G) + (hA1 : ∀ c : FiniteArchimedeanClass G, LM24.AssumptionA1AtFiniteClass s c) + (hA2 : ∀ c : FiniteArchimedeanClass G, + LM24.AssumptionA2AtFiniteClass (K := ℚ) κ Z c) + (hcomplete : ∀ (T : Set (FiniteArchimedeanClass G)), T.Nonempty → + (∀ c ∈ T, ∃ d ∈ T, c < d) → + (#T < κ) → + Nonempty (CompleteSpace (FiniteArchimedeanClass.TailQuotient T))) + (htailfrac : ∀ (T : Set (FiniteArchimedeanClass G)), T.Nonempty → + (∀ c ∈ T, ∃ d ∈ T, c < d) → + (#T < κ) → + Subring.fracSubring (HahnSeries.cardSuppLTTruncationIntegerPart + (G := FiniteArchimedeanClass.tailSubmodule ℚ T) + (R := R) (κ := κ) Z) = ⊤) + (a : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z) : IsPrimal a := by + apply isPrimal_of_finite_classes_and_limit_tail_conditions Z + · intro y hy + apply HahnSeries.Nonpositive.isPrimal_of_supportArchimedeanClasses_finite + Z s (fun c ↦ (LM24.assumptionA1AtFiniteClass_iff s c).mp (hA1 c)) hA2 y + rw [supportArchimedeanClasses_toNonpositiveRingHom] + exact hy + · exact hcomplete + · exact htailfrac + +end HahnSeries.CardSuppLTTruncationIntegerPart diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/PrimalityTransfer.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/PrimalityTransfer.lean new file mode 100644 index 0000000000..d907b3a8b2 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/PrimalityTransfer.lean @@ -0,0 +1,339 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IntegerPartSplitting + +/-! +# Primality transfer at the leading Archimedean class + +This module assembles the generic set-level core of LM24, Proposition 9.2.2. A nonzero +nonconstant element of a Hahn-series truncation integer part is primal exactly when its split +leading truncation is primal in the ambient outer nonpositive Hahn ring, provided the element is +reduced and the embedded inner integer part generates the coefficient Hahn field. The latter is +the exact fraction-field input used in the zero-residue branch of the paper. + +The source localization is carried out inside the truncation integer part, not merely inside the +ambient nonpositive Hahn ring. In particular, the quotient constructed when divisibility is +tested after closed-class truncation is proved to retain its coefficient at exponent zero in the +source coefficient subring. +-/ + +open FiniteArchimedeanClass + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {K G R : Type*} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] + +/-- Closed-class truncation restricted to a truncation integer part. It preserves the +coefficient at exponent zero and hence the coefficient-subring condition. -/ +def TIntegerPartRingHom (c : FiniteArchimedeanClass G) (Z : Subring R) : + truncationIntegerPart G Z →+* truncationIntegerPart G Z where + toFun x := ⟨T (K := K) c (x : Nonpositive G R), by + rw [mem_truncationIntegerPart] + rw [coeff_T_of_mem c (x : Nonpositive G R) (zero_mem _)] + exact (mem_truncationIntegerPart (R := R) (Γ := G)).mp x.2⟩ + map_one' := Subtype.ext (map_one (T (K := K) c)) + map_mul' x y := Subtype.ext ((T (K := K) c).map_mul + (x : Nonpositive G R) (y : Nonpositive G R)) + map_zero' := Subtype.ext (map_zero (T (K := K) c)) + map_add' x y := Subtype.ext ((T (K := K) c).map_add + (x : Nonpositive G R) (y : Nonpositive G R)) + +/-- The integer-part truncation ring homomorphism agrees with closed-class truncation on the +underlying nonpositive Hahn series. -/ +@[simp] +theorem coe_TIntegerPartRingHom (c : FiniteArchimedeanClass G) (Z : Subring R) + (x : truncationIntegerPart G Z) : + (TIntegerPartRingHom (K := K) c Z x : Nonpositive G R) = + T (K := K) c (x : Nonpositive G R) := + (rfl) + +/-- Divisibility by a nonzero fixed integer-part element can be tested after closed-class +truncation, with the quotient witness remaining in the same integer part. -/ +theorem dvd_iff_dvd_TIntegerPart_of_fixed (c : FiniteArchimedeanClass G) + (Z : Subring R) (b : truncationIntegerPart G Z) (hb0 : (b : Nonpositive G R) ≠ 0) + (hbFixed : T (K := K) c (b : Nonpositive G R) = b) + (x : truncationIntegerPart G Z) : + b ∣ x ↔ b ∣ TIntegerPartRingHom (K := K) c Z x := by + constructor + · rintro ⟨q, hq⟩ + refine ⟨TIntegerPartRingHom (K := K) c Z q, ?_⟩ + apply Subtype.ext + change T (K := K) c (x : Nonpositive G R) = + (b : Nonpositive G R) * T (K := K) c (q : Nonpositive G R) + rw [show (x : Nonpositive G R) = b * q by exact congrArg Subtype.val hq] + rw [map_mul, hbFixed] + · intro h + have hAmbientT : (b : Nonpositive G R) ∣ T (K := K) c (x : Nonpositive G R) := by + simpa using map_dvd (truncationIntegerPart G Z).subtype h + have hAmbient : (b : Nonpositive G R) ∣ (x : Nonpositive G R) := + (dvd_iff_dvd_T_of_fixed c (b : Nonpositive G R) hb0 hbFixed x).mpr hAmbientT + obtain ⟨q, hq⟩ := hAmbient + obtain ⟨qT, hqT⟩ := h + have hqTFixed : T (K := K) c q = (qT : Nonpositive G R) := by + apply mul_left_cancel₀ hb0 + calc + (b : Nonpositive G R) * T (K := K) c q = + T (K := K) c b * T (K := K) c q := by rw [hbFixed] + _ = T (K := K) c ((b : Nonpositive G R) * q) := + ((T (K := K) c).map_mul (b : Nonpositive G R) q).symm + _ = T (K := K) c (x : Nonpositive G R) := by rw [hq] + _ = (b : Nonpositive G R) * (qT : Nonpositive G R) := + congrArg Subtype.val hqT + let q' : truncationIntegerPart G Z := ⟨q, by + rw [mem_truncationIntegerPart] + rw [← coeff_T_of_mem (K := K) c q (zero_mem _), hqTFixed] + exact (mem_truncationIntegerPart (R := R) (Γ := G)).mp qT.2⟩ + refine ⟨q', ?_⟩ + apply Subtype.ext + exact hq + +/-- A nonconstant integer-part element, regarded in the subring fixed by truncation at its +leading Archimedean class. -/ +def leadingFixedIntegerPartElement (Z : Subring R) (b : truncationIntegerPart G Z) + (horder : ((b : Nonpositive G R) : R⟦G⟧).order ≠ 0) : + fixedIntegerPartSubring (K := K) (G := G) (R := R) + (leadingClass (b : Nonpositive G R) horder) Z := + ⟨b, (mem_fixedIntegerPartSubring_iff _ Z b).mpr + (T_leadingClass (b : Nonpositive G R) horder)⟩ + +/-- The leading fixed integer-part element has the original integer-part element as its value. -/ +@[simp] +theorem coe_leadingFixedIntegerPartElement (Z : Subring R) + (b : truncationIntegerPart G Z) + (horder : ((b : Nonpositive G R) : R⟦G⟧).order ≠ 0) : + (leadingFixedIntegerPartElement (K := K) Z b horder : truncationIntegerPart G Z) = b := + (rfl) + +/-- Primality of a nonzero nonconstant integer-part element is unchanged when it is restricted +to the integer-part subring fixed by truncation at its leading class. -/ +theorem isPrimal_leadingFixedIntegerPartElement_iff (Z : Subring R) + (b : truncationIntegerPart G Z) (hb0 : (b : Nonpositive G R) ≠ 0) + (horder : ((b : Nonpositive G R) : R⟦G⟧).order ≠ 0) : + IsPrimal (leadingFixedIntegerPartElement (K := K) Z b horder) ↔ IsPrimal b := by + let sigma := leadingClass (b : Nonpositive G R) horder + constructor + · intro h x y hdvd + obtain ⟨q, hq⟩ := hdvd + have hdivLocal : leadingFixedIntegerPartElement (K := K) Z b horder ∣ + ⟨TIntegerPartRingHom (K := K) sigma Z x, + (mem_fixedIntegerPartSubring_iff sigma Z _).mpr (by + exact T_T sigma (x : Nonpositive G R))⟩ * + ⟨TIntegerPartRingHom (K := K) sigma Z y, + (mem_fixedIntegerPartSubring_iff sigma Z _).mpr (by + exact T_T sigma (y : Nonpositive G R))⟩ := by + refine ⟨⟨TIntegerPartRingHom (K := K) sigma Z q, + (mem_fixedIntegerPartSubring_iff sigma Z _).mpr (by + exact T_T sigma (q : Nonpositive G R))⟩, ?_⟩ + apply Subtype.ext + apply Subtype.ext + change T (K := K) sigma (x : Nonpositive G R) * T (K := K) sigma y = + (b : Nonpositive G R) * T (K := K) sigma q + rw [← map_mul] + rw [show (x : Nonpositive G R) * y = b * q by exact congrArg Subtype.val hq] + rw [map_mul, T_leadingClass (b : Nonpositive G R) horder] + obtain ⟨b₁, b₂, h₁, h₂, hprod⟩ := h hdivLocal + have hprodSource : b = (b₁ : truncationIntegerPart G Z) * b₂ := by + simpa using congrArg Subtype.val hprod + have hb₁Ne : (b₁ : Nonpositive G R) ≠ 0 := by + intro hz + apply hb0 + rw [show (b : Nonpositive G R) = b₁ * b₂ by + exact congrArg Subtype.val hprodSource] + rw [hz, zero_mul] + have hb₂Ne : (b₂ : Nonpositive G R) ≠ 0 := by + intro hz + apply hb0 + rw [show (b : Nonpositive G R) = b₁ * b₂ by + exact congrArg Subtype.val hprodSource] + rw [hz, mul_zero] + refine ⟨(b₁ : truncationIntegerPart G Z), (b₂ : truncationIntegerPart G Z), ?_, ?_, ?_⟩ + · refine (dvd_iff_dvd_TIntegerPart_of_fixed (K := K) (R := R) sigma Z b₁ hb₁Ne + ((mem_fixedIntegerPartSubring_iff sigma Z _).mp b₁.2) x).mpr ?_ + exact map_dvd + (fixedIntegerPartSubring (K := K) (G := G) (R := R) sigma Z).subtype h₁ + · refine (dvd_iff_dvd_TIntegerPart_of_fixed (K := K) (R := R) sigma Z b₂ hb₂Ne + ((mem_fixedIntegerPartSubring_iff sigma Z _).mp b₂.2) y).mpr ?_ + exact map_dvd + (fixedIntegerPartSubring (K := K) (G := G) (R := R) sigma Z).subtype h₂ + · exact hprodSource + · intro h x y hdvd + have hdvdSource : b ∣ (x : truncationIntegerPart G Z) * + (y : truncationIntegerPart G Z) := + map_dvd (fixedIntegerPartSubring (K := K) (G := G) (R := R) sigma Z).subtype hdvd + obtain ⟨b₁, b₂, h₁, h₂, hprod⟩ := h hdvdSource + have hb₁Mem : T (K := K) sigma (b₁ : Nonpositive G R) = b₁ := by + apply T_leadingClass_of_dvd (b : Nonpositive G R) hb0 horder + exact map_dvd (truncationIntegerPart G Z).subtype + (hprod.symm ▸ dvd_mul_right b₁ b₂) + have hb₂Mem : T (K := K) sigma (b₂ : Nonpositive G R) = b₂ := by + apply T_leadingClass_of_dvd (b : Nonpositive G R) hb0 horder + exact map_dvd (truncationIntegerPart G Z).subtype + (hprod.symm ▸ dvd_mul_left b₂ b₁) + have hb₁Ne : (b₁ : Nonpositive G R) ≠ 0 := by + intro hz + apply hb0 + rw [show (b : Nonpositive G R) = b₁ * b₂ by exact congrArg Subtype.val hprod] + rw [hz, zero_mul] + have hb₂Ne : (b₂ : Nonpositive G R) ≠ 0 := by + intro hz + apply hb0 + rw [show (b : Nonpositive G R) = b₁ * b₂ by exact congrArg Subtype.val hprod] + rw [hz, mul_zero] + have hq₁Mem : T (K := K) sigma (h₁.choose : Nonpositive G R) = h₁.choose := by + apply mul_left_cancel₀ hb₁Ne + calc + (b₁ : Nonpositive G R) * T (K := K) sigma h₁.choose = + T (K := K) sigma b₁ * T (K := K) sigma h₁.choose := by rw [hb₁Mem] + _ = T (K := K) sigma + ((b₁ : Nonpositive G R) * (h₁.choose : Nonpositive G R)) := + ((T (K := K) sigma).map_mul (b₁ : Nonpositive G R) + (h₁.choose : Nonpositive G R)).symm + _ = T (K := K) sigma (x : Nonpositive G R) := by + rw [← show (x : Nonpositive G R) = + (b₁ : Nonpositive G R) * (h₁.choose : Nonpositive G R) by + exact congrArg Subtype.val h₁.choose_spec] + _ = (x : Nonpositive G R) := (mem_fixedIntegerPartSubring_iff sigma Z _).mp x.2 + _ = (b₁ : Nonpositive G R) * (h₁.choose : Nonpositive G R) := + congrArg Subtype.val h₁.choose_spec + have hq₂Mem : T (K := K) sigma (h₂.choose : Nonpositive G R) = h₂.choose := by + apply mul_left_cancel₀ hb₂Ne + calc + (b₂ : Nonpositive G R) * T (K := K) sigma h₂.choose = + T (K := K) sigma b₂ * T (K := K) sigma h₂.choose := by rw [hb₂Mem] + _ = T (K := K) sigma + ((b₂ : Nonpositive G R) * (h₂.choose : Nonpositive G R)) := + ((T (K := K) sigma).map_mul (b₂ : Nonpositive G R) + (h₂.choose : Nonpositive G R)).symm + _ = T (K := K) sigma (y : Nonpositive G R) := by + rw [← show (y : Nonpositive G R) = + (b₂ : Nonpositive G R) * (h₂.choose : Nonpositive G R) by + exact congrArg Subtype.val h₂.choose_spec] + _ = (y : Nonpositive G R) := (mem_fixedIntegerPartSubring_iff sigma Z _).mp y.2 + _ = (b₂ : Nonpositive G R) * (h₂.choose : Nonpositive G R) := + congrArg Subtype.val h₂.choose_spec + refine ⟨⟨b₁, (mem_fixedIntegerPartSubring_iff sigma Z _).mpr hb₁Mem⟩, + ⟨b₂, (mem_fixedIntegerPartSubring_iff sigma Z _).mpr hb₂Mem⟩, ?_, ?_, ?_⟩ + · exact ⟨⟨h₁.choose, (mem_fixedIntegerPartSubring_iff sigma Z _).mpr hq₁Mem⟩, + Subtype.ext h₁.choose_spec⟩ + · exact ⟨⟨h₂.choose, (mem_fixedIntegerPartSubring_iff sigma Z _).mpr hq₂Mem⟩, + Subtype.ext h₂.choose_spec⟩ + · exact Subtype.ext hprod + +/-- Splitting the leading fixed integer-part element gives its split truncation in the exact +embedded inner integer part. -/ +theorem splitFixedIntegerPartRingEquiv_leadingFixedIntegerPartElement + (u : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : truncationIntegerPart G Z) + (horder : ((b : Nonpositive G R) : R⟦G⟧).order ≠ 0) : + splitFixedIntegerPartRingEquiv u (leadingClass (b : Nonpositive G R) horder) Z + (leadingFixedIntegerPartElement (K := K) Z b horder) = + splitTruncationIntegerPart u (leadingClass (b : Nonpositive G R) horder) + (innerIntegerPartSubring (K := K) (G := G) + (leadingClass (b : Nonpositive G R) horder) Z) + (b : Nonpositive G R) + (tauBall_mem_innerIntegerPartSubring + (leadingClass (b : Nonpositive G R) horder) Z b) := by + apply Subtype.ext + rw [coe_splitFixedIntegerPartRingEquiv, coe_splitTruncationIntegerPart] + rw [show (leadingFixedIntegerPartElement (K := K) Z b horder : + truncationIntegerPart G Z) = b from coe_leadingFixedIntegerPartElement Z b horder] + +/-- In the residue-one branch, source primality is equivalent to ambient primality of the split +truncation without any fraction-field hypothesis. -/ +theorem isPrimal_iff_isPrimal_splitTruncation_of_tau_eq_one + (u : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : truncationIntegerPart G Z) (hb0 : (b : Nonpositive G R) ≠ 0) + (horder : ((b : Nonpositive G R) : R⟦G⟧).order ≠ 0) + (htau : tauBall (K := K) (leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R) = 1) : + IsPrimal b ↔ + IsPrimal (splitTruncation u (leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R)) := by + let sigma := leadingClass (b : Nonpositive G R) horder + let bFixed := leadingFixedIntegerPartElement (K := K) Z b horder + let e := splitFixedIntegerPartRingEquiv u sigma Z + let S := innerIntegerPartSubring (K := K) (G := G) sigma Z + calc + IsPrimal b ↔ IsPrimal bFixed := + (isPrimal_leadingFixedIntegerPartElement_iff (K := K) Z b hb0 horder).symm + _ ↔ IsPrimal (e bFixed) := (RingEquiv.isPrimal_iff e bFixed).symm + _ ↔ IsPrimal (splitTruncationIntegerPart u sigma S (b : Nonpositive G R) + (htau.symm ▸ S.one_mem)) := by + rw [show e bFixed = splitTruncationIntegerPart u sigma S (b : Nonpositive G R) + (tauBall_mem_innerIntegerPartSubring sigma Z b) by + exact splitFixedIntegerPartRingEquiv_leadingFixedIntegerPartElement u Z b horder] + _ ↔ IsPrimal (splitTruncation u sigma (b : Nonpositive G R)) := + isPrimal_splitTruncationIntegerPart_iff_of_tau_eq_one u sigma S + (b : Nonpositive G R) htau + +/-- In the residue-zero branch, source primality is equivalent to ambient primality of the split +truncation when the embedded inner integer part generates the coefficient Hahn field. -/ +theorem isPrimal_iff_isPrimal_splitTruncation_of_tau_eq_zero + (u : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : truncationIntegerPart G Z) (hb0 : (b : Nonpositive G R) ≠ 0) + (horder : ((b : Nonpositive G R) : R⟦G⟧).order ≠ 0) + (hfrac : Subring.fracSubring + (innerIntegerPartSubring (K := K) (G := G) + (leadingClass (b : Nonpositive G R) horder) Z) = ⊤) + (htau : tauBall (K := K) (leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R) = 0) : + IsPrimal b ↔ + IsPrimal (splitTruncation u (leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R)) := by + let sigma := leadingClass (b : Nonpositive G R) horder + let bFixed := leadingFixedIntegerPartElement (K := K) Z b horder + let e := splitFixedIntegerPartRingEquiv u sigma Z + let S := innerIntegerPartSubring (K := K) (G := G) sigma Z + calc + IsPrimal b ↔ IsPrimal bFixed := + (isPrimal_leadingFixedIntegerPartElement_iff (K := K) Z b hb0 horder).symm + _ ↔ IsPrimal (e bFixed) := (RingEquiv.isPrimal_iff e bFixed).symm + _ ↔ IsPrimal (splitTruncationIntegerPart u sigma S (b : Nonpositive G R) + (htau.symm ▸ S.zero_mem)) := by + rw [show e bFixed = splitTruncationIntegerPart u sigma S (b : Nonpositive G R) + (tauBall_mem_innerIntegerPartSubring sigma Z b) by + exact splitFixedIntegerPartRingEquiv_leadingFixedIntegerPartElement u Z b horder] + _ ↔ IsPrimal (splitTruncation u sigma (b : Nonpositive G R)) := + isPrimal_splitTruncationIntegerPart_iff_of_tau_eq_zero u sigma S hfrac + (b : Nonpositive G R) htau + +/-- Set-level primality transfer from LM24, Proposition 9.2.2. Generation of the coefficient Hahn +field by the embedded inner integer part is required only when the leading residue is zero. -/ +theorem isPrimal_iff_isPrimal_splitTruncation_of_isReduced + (u : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : truncationIntegerPart G Z) (hb0 : (b : Nonpositive G R) ≠ 0) + (horder : ((b : Nonpositive G R) : R⟦G⟧).order ≠ 0) + (hbReduced : IsReduced (b : Nonpositive G R)) + (hfrac : tauBall (K := K) (leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R) = 0 → + Subring.fracSubring (innerIntegerPartSubring (K := K) (G := G) + (leadingClass (b : Nonpositive G R) horder) Z) = ⊤) : + IsPrimal b ↔ + IsPrimal (splitTruncation u (leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R)) := by + rcases (isReduced_iff_tau_leadingClass_eq_zero_or_one (K := K) + (b : Nonpositive G R) hb0 horder).mp hbReduced with htau | htau + · have htauBall : tauBall (K := K) (leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R) = 0 := + (tauBall_eq_zero_iff (leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R)).mpr htau + exact isPrimal_iff_isPrimal_splitTruncation_of_tau_eq_zero u Z b hb0 horder + (hfrac htauBall) htauBall + · have htauBall : tauBall (K := K) (leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R) = 1 := by + exact tauBall_eq_one_of_tau_eq_one (leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R) htau + exact isPrimal_iff_isPrimal_splitTruncation_of_tau_eq_one u Z b hb0 horder htauBall + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Reduced.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Reduced.lean new file mode 100644 index 0000000000..fb59231c19 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Reduced.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import Mathlib.Algebra.Order.Archimedean.Class + +/-! +# Reduced Hahn series + +LM24, Definition 8.2.6 calls a nonzero series reduced when the intersection of its support with +the support after subtracting one lies in a single Archimedean class. We retain the zero class: +`ArchimedeanClass.mk 0 = ⊤`. This matters when the constant coefficient is neither zero nor one, +and distinguishes the printed definition from the incorrect variant that inspects only nonzero +exponents. +-/ + +public section + +namespace HahnSeries.Nonpositive + +variable {G R : Type*} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Ring R] + +/-- LM24, Definition 8.2.6: a nonzero nonpositive Hahn series whose support and shifted support +intersect in one Archimedean class. The class may be the zero class `⊤`. -/ +def IsReduced (b : Nonpositive G R) : Prop := + b ≠ 0 ∧ ∃ c : ArchimedeanClass G, + (b : R⟦G⟧).support ∩ ((b - 1 : Nonpositive G R) : R⟦G⟧).support ⊆ + {x | ArchimedeanClass.mk x = c} + +/-- Elimination rule for reducedness. -/ +theorem IsReduced.elim {b : Nonpositive G R} (hb : IsReduced b) : + b ≠ 0 ∧ ∃ c : ArchimedeanClass G, + (b : R⟦G⟧).support ∩ ((b - 1 : Nonpositive G R) : R⟦G⟧).support ⊆ + {x | ArchimedeanClass.mk x = c} := + hb + +/-- Introduction rule for reducedness. -/ +theorem isReduced_of_support_inter_support_sub_one_subset {b : Nonpositive G R} + (hb : b ≠ 0) (c : ArchimedeanClass G) + (hsupport : + (b : R⟦G⟧).support ∩ ((b - 1 : Nonpositive G R) : R⟦G⟧).support ⊆ + {x | ArchimedeanClass.mk x = c}) : + IsReduced b := + ⟨hb, c, hsupport⟩ + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ReducedCharacterization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ReducedCharacterization.lean new file mode 100644 index 0000000000..b22af6dda5 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ReducedCharacterization.lean @@ -0,0 +1,192 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduced + +/-! +# Reducedness and leading-class reduction + +This module proves the nonconstant case of LM24, Proposition 8.2.5 `(4) ↔ (5)`. For a +nonpositive Hahn series whose lowest exponent is nonzero, reducedness is equivalent to its +open truncation at the lowest exponent's Archimedean class being zero or one. The proof treats +the exponent zero explicitly: it belongs to both supports exactly when the constant coefficient +is neither zero nor one. +-/ + +public noncomputable section + +namespace HahnSeries.Nonpositive + +open FiniteArchimedeanClass + +variable {K G R : Type*} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] + +private theorem coeff_sub_one_of_ne_zero (x : Nonpositive G R) {g : G} (hg : g ≠ 0) : + ((x - 1 : Nonpositive G R) : R⟦G⟧).coeff g = (x : R⟦G⟧).coeff g := by + change ((x : R⟦G⟧) - 1).coeff g = _ + rw [HahnSeries.coeff_sub, HahnSeries.coeff_one, if_neg hg, sub_zero] + +private theorem leadingClass_le_mk_of_mem_support (x : Nonpositive G R) + (horder : (x : R⟦G⟧).order ≠ 0) {g : G} (hg : g ∈ (x : R⟦G⟧).support) + (hg0 : g ≠ 0) : + leadingClass x horder ≤ FiniteArchimedeanClass.mk g hg0 := by + rw [show leadingClass x horder = FiniteArchimedeanClass.mk + (x : R⟦G⟧).order horder by apply Subtype.ext; simp] + apply (FiniteArchimedeanClass.mk_le_mk horder hg0).mpr + have horderLe : (x : R⟦G⟧).order ≤ g := + HahnSeries.order_le_of_coeff_ne_zero ((HahnSeries.mem_support _ _).mp hg) + have hgNonpos : g ≤ 0 := support_subset x hg + simpa using ArchimedeanClass.min_le_mk_of_le_of_le horderLe hgNonpos + +private theorem tau_eq_zero_of_support_nonzero_class + (x : Nonpositive G R) (horder : (x : R⟦G⟧).order ≠ 0) + (hcoeffZero : (x : R⟦G⟧).coeff 0 = 0) + (hclass : ∀ g ∈ (x : R⟦G⟧).support, ∀ hg0 : g ≠ 0, + FiniteArchimedeanClass.mk g hg0 = leadingClass x horder) : + tau (K := K) (leadingClass x horder) x = 0 := by + apply Subtype.ext + ext g + by_cases hg0 : g = 0 + · subst g + rw [coeff_tau_of_mem] + · exact hcoeffZero + · exact zero_mem _ + by_cases hg : g ∈ (x : R⟦G⟧).support + · rw [coeff_tau_of_not_mem] + · simp + · intro hball + have hlt := (FiniteArchimedeanClass.mem_ball_iff K).mp hball hg0 + rw [hclass g hg hg0] at hlt + exact lt_irrefl _ hlt + · have hcoeff : (x : R⟦G⟧).coeff g = 0 := + not_ne_iff.mp ((HahnSeries.mem_support _ _).not.mp hg) + by_cases hball : g ∈ ball K (leadingClass x horder) + · rw [coeff_tau_of_mem _ _ hball, hcoeff]; simp + · rw [coeff_tau_of_not_mem _ _ hball]; simp + +private theorem tau_eq_C_constantCoeff_of_support_nonzero_class + (x : Nonpositive G R) (horder : (x : R⟦G⟧).order ≠ 0) + (hclass : ∀ g ∈ (x : R⟦G⟧).support, ∀ hg0 : g ≠ 0, + FiniteArchimedeanClass.mk g hg0 = leadingClass x horder) : + tau (K := K) (leadingClass x horder) x = C ((x : R⟦G⟧).coeff 0) := by + apply Subtype.ext + ext g + by_cases hg0 : g = 0 + · subst g + rw [coeff_tau_of_mem] + · simp + · exact zero_mem _ + · rw [coe_C] + change ((tau (K := K) (leadingClass x horder) x : Nonpositive G R) : + R⟦G⟧).coeff g = (HahnSeries.single 0 ((x : R⟦G⟧).coeff 0)).coeff g + rw [HahnSeries.coeff_single, if_neg hg0] + by_cases hg : g ∈ (x : R⟦G⟧).support + · rw [coeff_tau_of_not_mem] + intro hball + have hlt := (FiniteArchimedeanClass.mem_ball_iff K).mp hball hg0 + rw [hclass g hg hg0] at hlt + exact lt_irrefl _ hlt + · have hcoeff : (x : R⟦G⟧).coeff g = 0 := + not_ne_iff.mp ((HahnSeries.mem_support _ _).not.mp hg) + by_cases hball : g ∈ ball K (leadingClass x horder) + · rw [coeff_tau_of_mem _ _ hball, hcoeff] + · rw [coeff_tau_of_not_mem _ _ hball] + +/-- LM24, Proposition 8.2.5 `(4) ↔ (5)` for a series with nonzero lowest exponent. -/ +theorem isReduced_iff_tau_leadingClass_eq_zero_or_one + (x : Nonpositive G R) (hx : x ≠ 0) (horder : (x : R⟦G⟧).order ≠ 0) : + IsReduced x ↔ + tau (K := K) (leadingClass x horder) x = 0 ∨ + tau (K := K) (leadingClass x horder) x = 1 := by + constructor + · intro hReduced + obtain ⟨_, d, hd⟩ := hReduced.elim + have horderSupport : (x : R⟦G⟧).order ∈ (x : R⟦G⟧).support := by + exact (HahnSeries.mem_support _ _).mpr + (HahnSeries.coeff_order_eq_zero.not.mpr (fun h ↦ hx (Subtype.ext h))) + have horderSubSupport : + (x : R⟦G⟧).order ∈ ((x - 1 : Nonpositive G R) : R⟦G⟧).support := by + rw [HahnSeries.mem_support, coeff_sub_one_of_ne_zero x horder] + exact HahnSeries.coeff_order_eq_zero.not.mpr (fun h ↦ hx (Subtype.ext h)) + have hdLeading : ArchimedeanClass.mk (x : R⟦G⟧).order = d := + hd ⟨horderSupport, horderSubSupport⟩ + have hclass : ∀ g ∈ (x : R⟦G⟧).support, ∀ hg0 : g ≠ 0, + FiniteArchimedeanClass.mk g hg0 = leadingClass x horder := by + intro g hg hg0 + apply Subtype.ext + rw [FiniteArchimedeanClass.val_mk, leadingClass_val] + exact (hd ⟨hg, by + rw [HahnSeries.mem_support, coeff_sub_one_of_ne_zero x hg0] + exact (HahnSeries.mem_support _ _).mp hg⟩).trans hdLeading.symm + have hconstant : (x : R⟦G⟧).coeff 0 = 0 ∨ (x : R⟦G⟧).coeff 0 = 1 := by + by_contra hnot + push Not at hnot + have hzeroSupport : 0 ∈ (x : R⟦G⟧).support := + (HahnSeries.mem_support _ _).mpr hnot.1 + have hzeroSubSupport : + 0 ∈ ((x - 1 : Nonpositive G R) : R⟦G⟧).support := by + rw [HahnSeries.mem_support] + change (((x : R⟦G⟧) - 1).coeff 0) ≠ 0 + rw [HahnSeries.coeff_sub, HahnSeries.coeff_one, if_pos rfl] + exact sub_ne_zero.mpr hnot.2 + have htop : (⊤ : ArchimedeanClass G) = d := hd ⟨hzeroSupport, hzeroSubSupport⟩ + exact (FiniteArchimedeanClass.mk (x : R⟦G⟧).order horder).prop + (hdLeading.trans htop.symm) + rcases hconstant with hzero | hone + · exact Or.inl (tau_eq_zero_of_support_nonzero_class x horder hzero hclass) + · right + rw [tau_eq_C_constantCoeff_of_support_nonzero_class x horder hclass, hone] + exact map_one C + · intro htau + refine isReduced_of_support_inter_support_sub_one_subset hx + (ArchimedeanClass.mk (x : R⟦G⟧).order) ?_ + intro g hg + have hgSupport := hg.1 + have hg0 : g ≠ 0 := by + intro hzero + subst g + rcases htau with htau | htau + · have hcoeff := congrArg + (fun y : Nonpositive G R ↦ (y : R⟦G⟧).coeff 0) htau + rw [coeff_tau_of_mem _ _ (zero_mem _)] at hcoeff + exact ((HahnSeries.mem_support _ _).mp hgSupport) hcoeff + · have hcoeff := congrArg + (fun y : Nonpositive G R ↦ (y : R⟦G⟧).coeff 0) htau + rw [coeff_tau_of_mem _ _ (zero_mem _)] at hcoeff + change (x : R⟦G⟧).coeff 0 = (1 : R⟦G⟧).coeff 0 at hcoeff + simp only [HahnSeries.coeff_one] at hcoeff + have hsubCoeff := (HahnSeries.mem_support _ _).mp hg.2 + change (((x : R⟦G⟧) - 1).coeff 0) ≠ 0 at hsubCoeff + rw [HahnSeries.coeff_sub, HahnSeries.coeff_one, hcoeff] at hsubCoeff + simp at hsubCoeff + have hle := leadingClass_le_mk_of_mem_support x horder hgSupport hg0 + have hnlt : ¬ leadingClass x horder < FiniteArchimedeanClass.mk g hg0 := by + intro hlt + have hball : g ∈ ball K (leadingClass x horder) := + (FiniteArchimedeanClass.mem_ball_iff K).mpr fun _ ↦ hlt + rcases htau with htau | htau + · have hcoeff := congrArg + (fun y : Nonpositive G R ↦ (y : R⟦G⟧).coeff g) htau + rw [coeff_tau_of_mem _ _ hball] at hcoeff + exact ((HahnSeries.mem_support _ _).mp hgSupport) hcoeff + · have hcoeff := congrArg + (fun y : Nonpositive G R ↦ (y : R⟦G⟧).coeff g) htau + rw [coeff_tau_of_mem _ _ hball] at hcoeff + change (x : R⟦G⟧).coeff g = (1 : R⟦G⟧).coeff g at hcoeff + simp only [HahnSeries.coeff_one, if_neg hg0] at hcoeff + exact ((HahnSeries.mem_support _ _).mp hgSupport) hcoeff + have heq : leadingClass x horder = FiniteArchimedeanClass.mk g hg0 := + le_antisymm hle (not_lt.mp hnlt) + have hval := congrArg Subtype.val heq + simpa using hval.symm + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ReducedDivisibility.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ReducedDivisibility.lean new file mode 100644 index 0000000000..7a0a9d3623 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ReducedDivisibility.lean @@ -0,0 +1,115 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedCharacterization + +/-! +# Divisibility after LM24 reduction + +This module proves the reduction-algebra core of LM24, Proposition 8.2.8. At the leading class +of a reduced nonconstant series `b`, divisibility of the closed truncation `T(c)` by `b` is +equivalent to divisibility of `rho(c)` by `b`. Proposition 8.2.1, which identifies divisibility +of `c` with divisibility of `T(c)`, is the remaining ambient-series bridge. +-/ + +public noncomputable section + +namespace HahnSeries.Nonpositive + +open FiniteArchimedeanClass HahnEmbedding + +variable {K G R : Type*} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] + +private theorem reductionQuotient_dvd_T + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) (htau : tau (K := K) c x ≠ 0) : + reductionQuotient u c x + (fun hzero ↦ htau ((tauBall_eq_zero_iff c x).mp hzero)) ∣ + T (K := K) c x := by + refine ⟨tau (K := K) c x, ?_⟩ + exact (reductionQuotient_mul_tau u c x + (fun hzero ↦ htau ((tauBall_eq_zero_iff c x).mp hzero))).symm + +/-- LM24's reduction always divides the corresponding closed-class truncation. -/ +theorem rho_dvd_T (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + rho u c x ∣ T (K := K) c x := by + by_cases htau : tau (K := K) c x = 0 + · rw [rho_of_tau_eq_zero u c x htau] + · rw [rho_of_tau_ne_zero u c x htau] + exact reductionQuotient_dvd_T u c x htau + +/-- The reduction-algebra core of LM24, Proposition 8.2.8. For a reduced nonconstant `b`, +divisibility of `T(c)` by `b` is equivalent to divisibility of `rho(c)` by `b`. -/ +theorem dvd_T_iff_dvd_rho_leadingClass + (u : HahnEmbedding.ArchimedeanStrata K G) (b : Nonpositive G R) (hb0 : b ≠ 0) + (horder : (b : R⟦G⟧).order ≠ 0) (hbReduced : IsReduced b) + (c : Nonpositive G R) : + b ∣ T (K := K) (leadingClass b horder) c ↔ + b ∣ rho u (leadingClass b horder) c := by + let sigma := leadingClass b horder + have hTb : T (K := K) sigma b = b := T_leadingClass b horder + have htaub : tau (K := K) sigma b = 0 ∨ tau (K := K) sigma b = 1 := + (isReduced_iff_tau_leadingClass_eq_zero_or_one b hb0 horder).mp hbReduced + constructor + · rintro ⟨e, hce⟩ + have hTe : T (K := K) sigma e = e := by + apply mul_left_cancel₀ hb0 + calc + b * T (K := K) sigma e = + T (K := K) sigma b * T (K := K) sigma e := by rw [hTb] + _ = T (K := K) sigma (b * e) := + ((T (K := K) sigma).map_mul b e).symm + _ = T (K := K) sigma (T (K := K) sigma c) := by rw [hce] + _ = T (K := K) sigma c := T_T sigma c + _ = b * e := hce + have htauMul : tau (K := K) sigma c = + tau (K := K) sigma b * tau (K := K) sigma e := by + calc + tau (K := K) sigma c = + tau (K := K) sigma (T (K := K) sigma c) := (tau_T sigma c).symm + _ = tau (K := K) sigma (b * e) := by rw [hce] + _ = tau (K := K) sigma b * tau (K := K) sigma e := + (tau (K := K) sigma).map_mul b e + by_cases htauc : tau (K := K) sigma c = 0 + · rw [rho_of_tau_eq_zero u sigma c htauc] + exact ⟨e, hce⟩ + · have htaue : tau (K := K) sigma e ≠ 0 := by + intro he + apply htauc + rw [htauMul, he, mul_zero] + have htaubOne : tau (K := K) sigma b = 1 := htaub.resolve_left (by + intro hb + apply htauc + rw [htauMul, hb, zero_mul]) + have htaucEq : tau (K := K) sigma c = tau (K := K) sigma e := by + rw [htauMul, htaubOne, one_mul] + rw [rho_of_tau_ne_zero u sigma c htauc] + let qC := reductionQuotient u sigma c + (fun hzero ↦ htauc ((tauBall_eq_zero_iff sigma c).mp hzero)) + let qE := reductionQuotient u sigma e + (fun hzero ↦ htaue ((tauBall_eq_zero_iff sigma e).mp hzero)) + refine ⟨qE, ?_⟩ + apply mul_right_cancel₀ htauc + have hqC : qC * tau (K := K) sigma c = T (K := K) sigma c := + reductionQuotient_mul_tau u sigma c _ + have hqE : qE * tau (K := K) sigma e = T (K := K) sigma e := + reductionQuotient_mul_tau u sigma e _ + calc + qC * tau (K := K) sigma c = T (K := K) sigma c := hqC + _ = b * e := hce + _ = b * T (K := K) sigma e := by rw [hTe] + _ = b * (qE * tau (K := K) sigma e) := by rw [hqE] + _ = (b * qE) * tau (K := K) sigma c := by rw [mul_assoc, htaucEq] + · intro hdiv + exact dvd_trans hdiv (rho_dvd_T u sigma c) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ReducedPrimality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ReducedPrimality.lean new file mode 100644 index 0000000000..1088bf9822 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ReducedPrimality.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Primality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalProposition922 +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveDomainEquiv +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CharZero + +/-! +# Primality of reduced Hahn integer-part series + +LM24's reduction at the leading Archimedean class transfers primality from a real-exponent Hahn +series to a reduced element of a cardinal-bounded Hahn integer part. Polynomiality of the +real-exponent series ring supplies this primality without a finite-degree hypothesis. +-/ + +public noncomputable section + +open Cardinal FiniteArchimedeanClass +open scoped HahnSeries + +namespace HahnSeries.Nonpositive + +variable {G K : Type*} +variable [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] [Field K] [CharZero K] + +/-- A nonpositive Hahn series whose exponent group is order-isomorphic to `ℝ` is primal. -/ +theorem isPrimal_of_orderIso_real (e : G ≃+o ℝ) (a : Nonpositive G K) : IsPrimal a := + (RingEquiv.isPrimal_iff (embDomainRingEquiv e) a).mp + (Berarducci.isPrimal (embDomainRingEquiv e a)) + +end HahnSeries.Nonpositive + +namespace HahnSeries.Nonpositive + +variable {K G R : Type*} {κ : Cardinal} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] [CharZero R] [Fact (ℵ₀ < κ)] + +/-- A nonzero reduced bounded Hahn integer-part series is primal under the leading-class +Archimedean hypotheses. -/ +@[blueprint "cor:reduced-hahn-integer-part-primal" + (phase := "Finitely many Archimedean classes") + (title := "Primality of reduced bounded Hahn integer-part series") + (statement := /-- + Let $K$ be an Archimedean ordered division ring, $G$ an ordered + $K$-vector space, $R$ a field of characteristic $0$, $\kappa>\aleph_0$ a + regular cardinal, and $Z\subseteq R$ a subring. For every nonzero + Archimedean class $\tau$ of $G$, fix a complement $H_\tau$ of + $G_{\prec\tau}$ in $G_{\preceq\tau}$, and write + $L_\tau:=R((G_{\prec\tau}))_\kappa$. Let + $b\in Z+R((G^{<0}))_\kappa$ be reduced, with nonzero underlying series and + nonzero order, and let $\sigma$ be its leading Archimedean class. If + $H_\sigma\simeq\mathbb R$ as ordered additive groups, and either + $G_{\prec\sigma}$ has cofinality at least $\kappa$ or + $G_{\prec\sigma}=\{0\}$ and every element of $R$ is a fraction of elements + of $Z$, then $b$ is primal in $Z+R((G^{<0}))_\kappa$. + -/) + (proof := /-- + By \ref{fact:leading-class-primality-transfer}, primality of $b$ is equivalent + to primality of $\iota_\sigma(T_\sigma b)$ in + $L_\sigma((H_\sigma^{\le 0}))$. Transport the exponent group through + $H_\sigma\simeq\mathbb R$. By \ref{thm:hahn-series-primality}, the + transported series is primal in + $L_\sigma((\mathbb R^{\le 0}))$, so the equivalence transfers primality back + to $b$. + -/)] +theorem isPrimal_of_isReduced_of_leadingClass_orderIso_real + [Fact κ.IsRegular] + (u : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (hb0 : CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b ≠ 0) + (horder : ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b : + Nonpositive G R) : R⟦G⟧).order ≠ 0) + (hbReduced : IsReduced (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b)) + (hA2 : LM24.AssumptionA2AtFiniteClass (K := K) κ Z + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder)) + (e : u.stratum + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) ≃+o ℝ) : + IsPrimal b := + (isPrimal_iff_isPrimal_splitTruncationCardSuppLT_of_isReduced + u Z b hb0 horder hbReduced hA2).mpr (isPrimal_of_orderIso_real e _) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Reduction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Reduction.lean new file mode 100644 index 0000000000..6031ebceda --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Reduction.lean @@ -0,0 +1,564 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ArchimedeanSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ClassTruncation +public import Mathlib.RingTheory.HahnSeries.Summable + +/-! +# Reduction at an Archimedean class + +LM24, Definition 8.2.4 divides the closed-class truncation `T_σ(x)` by the open-class +truncation `τ_σ(x)` when the latter is nonzero. This module establishes the structural facts +needed for that division. Under the iterated Hahn-series presentation `ι_σ`, `τ_σ(x)` is a +coefficient-series scalar, while `T_σ(x)` has only nonpositive outer exponents. + +The scalar statement is essential: the inverse of a negative monomial has positive exponent, so +the quotient cannot be justified by claiming that the full nonpositive Hahn-series ring is closed +under inversion. +-/ + +public noncomputable section + +namespace HahnSeries.Nonpositive + +open FiniteArchimedeanClass HahnEmbedding + +variable {K G R : Type*} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] + +/-- The ordered inclusion of a closed Archimedean ball into the ambient exponent group. -/ +def closedBallOrderEmbedding (c : FiniteArchimedeanClass G) : closedBall K c ↪o G where + toFun := (↑) + inj' := Subtype.val_injective + map_rel_iff' := Iff.rfl + +@[simp] +theorem closedBallOrderEmbedding_apply (c : FiniteArchimedeanClass G) + (g : closedBall K c) : closedBallOrderEmbedding c g = (g : G) := + (rfl) + +/-- The ordered inclusion of an open Archimedean ball into the ambient exponent group. -/ +def ballOrderEmbedding (c : FiniteArchimedeanClass G) : ball K c ↪o G where + toFun := (↑) + inj' := Subtype.val_injective + map_rel_iff' := Iff.rfl + +@[simp] +theorem ballOrderEmbedding_apply (c : FiniteArchimedeanClass G) (g : ball K c) : + ballOrderEmbedding c g = (g : G) := + (rfl) + +/-- The closed-class truncation, with its exponent domain restricted to the closed ball. -/ +def TClosed (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : R⟦closedBall K c⟧ := + HahnSeries.restrictDomain (closedBallOrderEmbedding c) + ((T (K := K) c x : Nonpositive G R) : R⟦G⟧) + +/-- The closed-class truncation is exponent-domain restriction of the ambient truncation. -/ +theorem TClosed_eq (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + TClosed (K := K) c x = + HahnSeries.restrictDomain (closedBallOrderEmbedding c) + ((T (K := K) c x : Nonpositive G R) : R⟦G⟧) := + (rfl) + +@[simp] +theorem TClosed_coeff (c : FiniteArchimedeanClass G) (x : Nonpositive G R) + (g : closedBall K c) : + (TClosed (K := K) c x).coeff g = + ((T (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff g := by + rw [TClosed, HahnSeries.restrictDomain_coeff] + rfl + +/-- The open-class truncation, with its exponent domain restricted to the open ball. -/ +def tauBall (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : R⟦ball K c⟧ := + HahnSeries.restrictDomain (ballOrderEmbedding c) + ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧) + +@[simp] +theorem tauBall_coeff (c : FiniteArchimedeanClass G) (x : Nonpositive G R) + (g : ball K c) : + (tauBall (K := K) c x).coeff g = + ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff g := by + rw [tauBall, HahnSeries.restrictDomain_coeff] + rfl + +/-- The open-class truncation, regarded as a series on the containing closed ball. -/ +def tauClosed (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + R⟦closedBall K c⟧ := + HahnSeries.restrictDomain (closedBallOrderEmbedding c) + ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧) + +/-- Under the Archimedean splitting, the open-class truncation is a scalar coefficient series. -/ +theorem archimedeanSplitRingEquiv_tauClosed + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + HahnSeries.archimedeanSplitRingEquiv u c (tauClosed c x) = + HahnSeries.C (tauBall c x) := by + ext s b + rw [HahnSeries.archimedeanSplitRingEquiv_coeff] + rw [tauClosed, HahnSeries.restrictDomain_coeff] + by_cases hs : s = 0 + · subst s + change ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff + (HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c + (toLex (0, b)) : G) = _ + rw [HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall_apply] + have hcoe0 : ((0 : u.stratum c) : G) = 0 := rfl + rw [show (ofLex (toLex ((0 : u.stratum c), b))).1 = 0 by rfl, + show (ofLex (toLex ((0 : u.stratum c), b))).2 = b by rfl, hcoe0, zero_add] + exact + (show ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff (b : G) = + ((HahnSeries.C (tauBall c x)).coeff 0).coeff b by + rw [coeff_tau_of_mem (K := K) c x b.2] + rw [HahnSeries.C_apply, HahnSeries.coeff_single_same] + rw [tauBall, HahnSeries.restrictDomain_coeff] + change (x : R⟦G⟧).coeff (b : G) = + ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff (b : G) + exact (coeff_tau_of_mem (K := K) c x b.2).symm) + · have hnotmem : + (HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c + (toLex (s, b)) : G) ∉ ball K c := by + intro hmem + have hsball : (s : G) ∈ ball K c := by + rw [HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall_apply] at hmem + simpa using sub_mem hmem b.2 + have hzero : (s : G) = 0 := + Submodule.disjoint_def.mp (u.disjoint_ball_stratum c) (s : G) hsball s.2 + exact hs (Subtype.ext hzero) + change ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff + (HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c + (toLex (s, b)) : G) = _ + rw [coeff_tau_of_not_mem (K := K) c x hnotmem] + simp [hs] + +/-- The outer constant coefficient of the split closed-class truncation is the open-class +truncation. This is LM24's identity `π(ισ(Tσ(x))) = τσ(x)`. -/ +theorem coeff_zero_archimedeanSplitRingEquiv_TClosed + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + (HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x)).coeff 0 = + tauBall c x := by + ext b + rw [HahnSeries.archimedeanSplitRingEquiv_coeff] + rw [TClosed, HahnSeries.restrictDomain_coeff] + change ((T (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff + (HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c + (toLex (0, b)) : G) = _ + rw [HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall_apply] + have hcoe0 : ((0 : u.stratum c) : G) = 0 := rfl + simp only [ofLex_toLex, hcoe0, zero_add] + rw [coeff_T_of_mem (K := K) c x + ((FiniteArchimedeanClass.ball_lt_closedBall (K := K)).le b.2)] + rw [tauBall, HahnSeries.restrictDomain_coeff] + exact (coeff_tau_of_mem (K := K) c x b.2).symm + +/-- The split closed-class truncation has no positive outer exponent. -/ +theorem support_archimedeanSplitRingEquiv_TClosed_subset + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + (HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x)).support ⊆ Set.Iic 0 := by + intro s hs + rw [HahnSeries.mem_support] at hs + obtain ⟨b, hb⟩ : ∃ b : ball K c, + ((HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x)).coeff s).coeff b ≠ 0 := by + by_contra hall + push Not at hall + apply hs + ext b + exact hall b + rw [HahnSeries.archimedeanSplitRingEquiv_coeff] at hb + rw [TClosed, HahnSeries.restrictDomain_coeff] at hb + change ((T (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff + (HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c + (toLex (s, b))) ≠ 0 at hb + rw [coeff_T_of_mem (K := K) c x + (HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c + (toLex (s, b))).2] at hb + have hnonpos := support_subset x hb + rw [HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall_apply] at hnonpos + simp only [ofLex_toLex] at hnonpos + change ((s : G) + (b : G)) ≤ 0 at hnonpos + have hlex : toLex (s, b) ≤ 0 := by + apply (HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c).map_le_map_iff'.mp + apply Subtype.coe_le_coe.mp + convert hnonpos using 1 <;> + simp [HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall_apply] + rcases Prod.Lex.le_iff.mp hlex with hsle | ⟨hszero, _⟩ + · exact hsle.le + · simpa using hszero.le + +private theorem support_div_C_subset {A H : Type*} [Field A] + [AddCommGroup H] [LinearOrder H] [IsOrderedAddMonoid H] + (x : A⟦H⟧) (a : A) : + (x / (HahnSeries.C a : A⟦H⟧)).support ⊆ x.support := by + intro h hh + rw [div_eq_mul_inv, ← map_inv₀ HahnSeries.C] at hh + obtain ⟨i, hi, j, hj, hij⟩ := HahnSeries.support_mul_subset hh + have hj0 : j = 0 := HahnSeries.support_single_subset hj + have hih : i = h := by simpa [hj0] using hij + simpa [hih] using hi + +/-- Dividing the split closed-class truncation by the open-class scalar does not introduce +positive outer exponents. -/ +theorem support_archimedeanSplitRingEquiv_TClosed_div_C_subset + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + ((HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x)) / + (HahnSeries.C (tauBall c x) : + (R⟦ball K c⟧)⟦u.stratum c⟧)).support ⊆ Set.Iic 0 := + (support_div_C_subset _ _).trans (support_archimedeanSplitRingEquiv_TClosed_subset u c x) + +/-- In the nonzero branch of LM24's reduction, the outer-zero coefficient of the quotient is +one. This rules out positive infinitesimal exponents at the only outer boundary where the outer +support condition alone would be insufficient. -/ +theorem coeff_zero_archimedeanSplitRingEquiv_TClosed_div_C + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) (htau : tauBall (K := K) c x ≠ 0) : + (((HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x)) / + (HahnSeries.C (tauBall c x) : + (R⟦ball K c⟧)⟦u.stratum c⟧)).coeff 0) = 1 := by + rw [div_eq_mul_inv] + rw [HahnSeries.C_apply, HahnSeries.inv_single] + simp only [neg_zero] + rw [HahnSeries.coeff_mul_single_zero] + rw [coeff_zero_archimedeanSplitRingEquiv_TClosed] + exact mul_inv_cancel₀ htau + +private def splitQuotient (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + (R⟦ball K c⟧)⟦u.stratum c⟧ := + HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x) / + HahnSeries.C (tauBall c x) + +/-- If an iterated Hahn series has no positive outer exponents and its coefficient at outer +exponent zero has no positive inner exponents, then its image back on the closed Archimedean ball +has no positive exponents. -/ +theorem support_archimedeanSplitRingEquiv_symm_subset_Iic + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (y : (R⟦ball K c⟧)⟦u.stratum c⟧) + (hyOuter : y.support ⊆ Set.Iic 0) + (hyZero : (y.coeff 0).support ⊆ Set.Iic 0) : + ((HahnSeries.archimedeanSplitRingEquiv u c).symm y).support ⊆ Set.Iic 0 := by + intro g hg + let p := HahnEmbedding.ArchimedeanStrata.closedBallEquivStratumLexBall u c g + let s : u.stratum c := (ofLex p).1 + let b : ball K c := (ofLex p).2 + have hsplitBack : + HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c p = g := + ArchimedeanStrata.stratumLexBallEquivClosedBall_closedBallEquivStratumLexBall + u c g + have hcoeff : (y.coeff s).coeff b ≠ 0 := by + have h := congrArg (fun z : (R⟦ball K c⟧)⟦u.stratum c⟧ ↦ + (z.coeff s).coeff b) + ((HahnSeries.archimedeanSplitRingEquiv u c).apply_symm_apply y) + rw [HahnSeries.archimedeanSplitRingEquiv_coeff] at h + rw [show HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c + (toLex (s, b)) = g by + change HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c p = g + exact hsplitBack] at h + exact fun hzero ↦ hg (h.trans hzero) + have hsupp : s ∈ y.support := by + rw [HahnSeries.mem_support] + intro hzero + exact hcoeff (congrArg (fun z : R⟦ball K c⟧ ↦ z.coeff b) hzero) + have hsnonpos : s ≤ 0 := hyOuter hsupp + rcases hsnonpos.eq_or_lt with hs0 | hsneg + · have hbzero : b ≤ 0 := by + apply hyZero + rw [HahnSeries.mem_support] + simpa [hs0] using hcoeff + have hpnonpos : p ≤ 0 := by + apply Prod.Lex.le_iff.mpr + exact Or.inr ⟨hs0, hbzero⟩ + rw [← hsplitBack, ← + (HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c).map_zero] + apply + (HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c).map_le_map_iff'.mpr + exact hpnonpos + · have hpneg : p < 0 := Prod.Lex.lt_iff.mpr (Or.inl hsneg) + have hgneg : g < 0 := by + rw [← hsplitBack] + apply lt_of_not_ge + intro hge + rw [← + (HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c).map_zero] at hge + let e := HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c + have hpge : 0 ≤ p := by + exact e.map_le_map_iff'.mp hge + exact (not_le_of_gt hpneg) hpge + exact hgneg.le + +private theorem support_splitQuotient_symm_subset + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) (htau : tauBall (K := K) c x ≠ 0) : + ((HahnSeries.archimedeanSplitRingEquiv u c).symm + (splitQuotient u c x)).support ⊆ Set.Iic 0 := by + apply support_archimedeanSplitRingEquiv_symm_subset_Iic u c + · exact support_archimedeanSplitRingEquiv_TClosed_div_C_subset u c x + · change + ((((HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x)) / + HahnSeries.C (tauBall c x)).coeff 0).support ⊆ Set.Iic 0) + rw [coeff_zero_archimedeanSplitRingEquiv_TClosed_div_C u c x htau] + intro b hb + exact (HahnSeries.support_single_subset hb).le + +/-- The nonzero quotient branch in LM24, Definition 8.2.4, as a nonpositive Hahn series. -/ +def reductionQuotient (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) (x : Nonpositive G R) + (htau : tauBall (K := K) c x ≠ 0) : Nonpositive G R := + ⟨HahnSeries.embDomain (closedBallOrderEmbedding c) + ((HahnSeries.archimedeanSplitRingEquiv u c).symm (splitQuotient u c x)), by + change (HahnSeries.embDomain (closedBallOrderEmbedding c) + ((HahnSeries.archimedeanSplitRingEquiv u c).symm + (splitQuotient u c x))).support ⊆ Set.Iic 0 + rw [HahnSeries.support_embDomain] + rintro _ ⟨g, hg, rfl⟩ + exact support_splitQuotient_symm_subset u c x htau hg⟩ + +/-- In the nonzero branch of LM24's reduction, the coefficient at the exponent zero is one: the +outer-zero coefficient of the split quotient is the constant one. -/ +theorem coeff_zero_reductionQuotient (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) (x : Nonpositive G R) + (htau : tauBall (K := K) c x ≠ 0) : + ((reductionQuotient u c x htau : Nonpositive G R) : R⟦G⟧).coeff 0 = 1 := by + change (HahnSeries.embDomain (closedBallOrderEmbedding c) + ((HahnSeries.archimedeanSplitRingEquiv u c).symm (splitQuotient u c x))).coeff 0 = 1 + have h0 : (0 : G) = closedBallOrderEmbedding (K := K) c 0 := by + rw [closedBallOrderEmbedding_apply]; rfl + rw [h0, HahnSeries.embDomain_coeff] + have hsplit := HahnSeries.archimedeanSplitRingEquiv_coeff u c + ((HahnSeries.archimedeanSplitRingEquiv u c).symm (splitQuotient u c x)) 0 0 + rw [RingEquiv.apply_symm_apply] at hsplit + have hzero : HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall u c + (toLex ((0 : u.stratum c), (0 : ball K c))) = 0 := by + apply Subtype.ext + rw [HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall_apply] + simp + rw [hzero] at hsplit + rw [← hsplit] + change ((HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x) / + HahnSeries.C (tauBall c x)).coeff 0).coeff 0 = 1 + rw [coeff_zero_archimedeanSplitRingEquiv_TClosed_div_C u c x htau] + rw [HahnSeries.coeff_one, if_pos rfl] + +/-- LM24's `ρ_σ`: divide the closed-class truncation by the open-class truncation when the +latter is nonzero, and otherwise retain the closed-class truncation. -/ +def rho (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : Nonpositive G R := + by + classical + exact if htau : tauBall (K := K) c x = 0 then T (K := K) c x + else reductionQuotient u c x htau + +/-- The open-ball restriction vanishes exactly when the original open-class truncation does. -/ +theorem tauBall_eq_zero_iff (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + tauBall (K := K) c x = 0 ↔ tau (K := K) c x = 0 := by + constructor + · intro hzero + apply Subtype.ext + ext g + by_cases hg : g ∈ ball K c + · have hcoeff := congrArg (fun y : R⟦ball K c⟧ ↦ + y.coeff ⟨g, hg⟩) hzero + rw [tauBall, HahnSeries.restrictDomain_coeff] at hcoeff + change ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff g = 0 at hcoeff + exact hcoeff + · rw [coeff_tau_of_not_mem (K := K) c x hg] + simp + · intro hzero + ext b + rw [tauBall, HahnSeries.restrictDomain_coeff] + change ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff (b : G) = 0 + rw [hzero] + simp + +/-- Restricting an open-class truncation equal to one to its open ball yields one. -/ +theorem tauBall_eq_one_of_tau_eq_one (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) (htau : tau (K := K) c x = 1) : + tauBall (K := K) c x = 1 := by + ext b + rw [tauBall, HahnSeries.restrictDomain_coeff] + change ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff (b : G) = _ + rw [htau] + simp + +/-- In the zero branch, LM24's reduction is the closed-class truncation. -/ +theorem rho_of_tau_eq_zero (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) (x : Nonpositive G R) + (htau : tau (K := K) c x = 0) : + rho u c x = T (K := K) c x := by + rw [rho] + split + · rfl + · rename_i hne + exact (hne ((tauBall_eq_zero_iff c x).mpr htau)).elim + +/-- In the nonzero branch, LM24's reduction uses the quotient constructed through the +Archimedean splitting. -/ +theorem rho_of_tau_ne_zero (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) (x : Nonpositive G R) + (htau : tau (K := K) c x ≠ 0) : + rho u c x = reductionQuotient u c x + (fun hzero ↦ htau ((tauBall_eq_zero_iff c x).mp hzero)) := by + rw [rho] + split + · rename_i hzero + exact (htau ((tauBall_eq_zero_iff c x).mp hzero)).elim + · rfl + +theorem support_T_subset_range (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + ((T (K := K) c x : Nonpositive G R) : R⟦G⟧).support ⊆ + Set.range (closedBallOrderEmbedding (K := K) c) := by + intro g hg + have hmem : g ∈ closedBall K c := by + by_contra hnot + exact hg (coeff_T_of_not_mem (K := K) c x hnot) + exact ⟨⟨g, hmem⟩, rfl⟩ + +private theorem support_tau_subset_range (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧).support ⊆ + Set.range (closedBallOrderEmbedding (K := K) c) := by + intro g hg + have hmem : g ∈ closedBall K c := by + by_contra hnot + have hnotBall : g ∉ ball K c := fun hball ↦ + hnot ((FiniteArchimedeanClass.ball_lt_closedBall (K := K)).le hball) + exact hg (coeff_tau_of_not_mem (K := K) c x hnotBall) + exact ⟨⟨g, hmem⟩, rfl⟩ + +theorem embDomain_TClosed (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + HahnSeries.embDomain (closedBallOrderEmbedding (K := K) c) (TClosed (K := K) c x) = + ((T (K := K) c x : Nonpositive G R) : R⟦G⟧) := + HahnSeries.embDomain_restrictDomain _ _ (support_T_subset_range c x) + +/-- The closed-class truncation with its exponent domain restricted, as a ring homomorphism. -/ +def TClosedRingHom (c : FiniteArchimedeanClass G) : + Nonpositive G R →+* R⟦closedBall K c⟧ where + toFun := TClosed c + map_zero' := by + ext g + rw [TClosed, HahnSeries.restrictDomain_coeff, map_zero] + rfl + map_one' := by + ext g + rw [TClosed, HahnSeries.restrictDomain_coeff, map_one] + change (1 : R⟦G⟧).coeff (g : G) = (1 : R⟦closedBall K c⟧).coeff g + simp + map_add' x y := by + ext g + rw [TClosed, HahnSeries.restrictDomain_coeff, map_add] + change (((T (K := K) c x : Nonpositive G R) : R⟦G⟧) + + ((T (K := K) c y : Nonpositive G R) : R⟦G⟧)).coeff (g : G) = _ + rw [HahnSeries.coeff_add, HahnSeries.coeff_add] + rw [TClosed, TClosed, HahnSeries.restrictDomain_coeff, + HahnSeries.restrictDomain_coeff] + rfl + map_mul' x y := by + apply (HahnSeries.embDomain_injective + (R := R) (f := closedBallOrderEmbedding (K := K) c)) + rw [HahnSeries.embDomain_mul (f := closedBallOrderEmbedding (K := K) c) + (fun _ _ ↦ rfl)] + change HahnSeries.embDomain (closedBallOrderEmbedding (K := K) c) + (TClosed (K := K) c (x * y)) = _ + rw [embDomain_TClosed] + rw [map_mul] + change ((T (K := K) c x : Nonpositive G R) : R⟦G⟧) * + ((T (K := K) c y : Nonpositive G R) : R⟦G⟧) = _ + rw [← embDomain_TClosed, ← embDomain_TClosed] + +@[simp] +theorem TClosedRingHom_apply (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + TClosedRingHom (K := K) c x = TClosed c x := + (rfl) + +private theorem embDomain_tauClosed (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + HahnSeries.embDomain (closedBallOrderEmbedding (K := K) c) (tauClosed (K := K) c x) = + ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧) := + HahnSeries.embDomain_restrictDomain _ _ (support_tau_subset_range c x) + +/-- The nonzero reduction quotient multiplied by the open-class truncation recovers the +closed-class truncation. This is the defining quotient identity from LM24, Definition 8.2.4. -/ +theorem reductionQuotient_mul_tau (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) (x : Nonpositive G R) + (htau : tauBall (K := K) c x ≠ 0) : + reductionQuotient u c x htau * tau (K := K) c x = T (K := K) c x := by + apply Subtype.ext + change HahnSeries.embDomain (closedBallOrderEmbedding c) + ((HahnSeries.archimedeanSplitRingEquiv u c).symm (splitQuotient u c x)) * + ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧) = + ((T (K := K) c x : Nonpositive G R) : R⟦G⟧) + rw [← embDomain_tauClosed (K := K) c x, ← embDomain_TClosed (K := K) c x] + rw [← HahnSeries.embDomain_mul (f := closedBallOrderEmbedding (K := K) c) + (fun _ _ ↦ rfl)] + apply congrArg (HahnSeries.embDomain (closedBallOrderEmbedding (K := K) c)) + apply (HahnSeries.archimedeanSplitRingEquiv u c).injective + rw [map_mul, RingEquiv.apply_symm_apply] + rw [archimedeanSplitRingEquiv_tauClosed] + change splitQuotient u c x * HahnSeries.C (tauBall c x) = + HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x) + rw [splitQuotient, div_eq_mul_inv, mul_assoc] + let a : (R⟦ball K c⟧)⟦u.stratum c⟧ := HahnSeries.C (tauBall c x) + have hC : a ≠ 0 := HahnSeries.C_ne_zero htau + have hinv : a⁻¹ * a = 1 := by + rw [mul_comm] + exact Field.mul_inv_cancel a hC + change HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x) * (a⁻¹ * a) = _ + rw [hinv, mul_one] + +/-- At a class containing the whole series, a nonzero fixed point of `rho` has open truncation +zero or one. This is the fixed-class core of LM24, Proposition 8.2.5 (3) iff (4). -/ +theorem rho_eq_self_iff_tau_eq_zero_or_one + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) (hx : x ≠ 0) (hT : T (K := K) c x = x) : + rho u c x = x ↔ tau (K := K) c x = 0 ∨ tau (K := K) c x = 1 := by + constructor + · intro hrho + by_cases htau : tau (K := K) c x = 0 + · exact Or.inl htau + · right + have hmul := reductionQuotient_mul_tau u c x + (fun hzero ↦ htau ((tauBall_eq_zero_iff c x).mp hzero)) + rw [← rho_of_tau_ne_zero u c x htau, hrho, hT] at hmul + exact mul_left_cancel₀ hx (hmul.trans (mul_one x).symm) + · rintro (htau | htau) + · rw [rho_of_tau_eq_zero u c x htau, hT] + · have htauNe : tau (K := K) c x ≠ 0 := by rw [htau]; exact one_ne_zero + have hmul := reductionQuotient_mul_tau u c x + (fun hzero ↦ htauNe ((tauBall_eq_zero_iff c x).mp hzero)) + have hmul' : reductionQuotient u c x + (fun hzero ↦ htauNe ((tauBall_eq_zero_iff c x).mp hzero)) = x := by + have hone : reductionQuotient u c x + (fun hzero ↦ htauNe ((tauBall_eq_zero_iff c x).mp hzero)) * 1 = + reductionQuotient u c x + (fun hzero ↦ htauNe ((tauBall_eq_zero_iff c x).mp hzero)) := + mul_one _ + exact hone.symm.trans ((congrArg + (fun t : Nonpositive G R ↦ reductionQuotient u c x + (fun hzero ↦ htauNe ((tauBall_eq_zero_iff c x).mp hzero)) * t) + htau.symm).trans (hmul.trans hT)) + exact (rho_of_tau_ne_zero u c x htauNe).trans hmul' + +/-- At the class of a nonzero, nonconstant series' lowest exponent, LM24's reduction fixes the +series exactly when its open-class truncation is zero or one. This is Proposition 8.2.5 +`(3) ↔ (4)` away from the separate constant-series case. -/ +theorem rho_leadingClass_eq_self_iff_tau_eq_zero_or_one + (u : HahnEmbedding.ArchimedeanStrata K G) (x : Nonpositive G R) (hx : x ≠ 0) + (horder : (x : R⟦G⟧).order ≠ 0) : + rho u (leadingClass x horder) x = x ↔ + tau (K := K) (leadingClass x horder) x = 0 ∨ + tau (K := K) (leadingClass x horder) x = 1 := + rho_eq_self_iff_tau_eq_zero_or_one u (leadingClass x horder) x hx + (T_leadingClass x horder) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement.lean new file mode 100644 index 0000000000..56fab8e44e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement.lean @@ -0,0 +1,18 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalGermRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalTruncationClosedClass +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ClosedClassRefinementTransport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CompleteGermRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ConvexRestrictionFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.FiniteGermError +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.LimitTailRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.TruncationIntegerPartFractionField + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CardinalGermRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CardinalGermRefinement.lean new file mode 100644 index 0000000000..46d5c9e205 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CardinalGermRefinement.lean @@ -0,0 +1,330 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CompleteGermRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEmbedding +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SmallClosedSubspace +public import Mathlib.RingTheory.HahnSeries.Cardinal +public import Mathlib.SetTheory.Cardinal.Regular + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Cardinal-bounded germ refinement + +Four cardinal-bounded generalised power series and a cardinal-bounded positive coinitial family +lie in one Cauchy-complete closed rational subspace. Germ refinement inside that subspace produces +factors with well-ordered support. Although the subspace itself may be large, density of the +original rational span bounds each such support by the prescribed cardinal. +-/ + +open Cardinal Set +open scoped HahnSeries + +universe u v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {C : Type u} {K : Type v} +variable [AddCommGroup C] [LinearOrder C] [IsOrderedAddMonoid C] + [UniformSpace C] [IsUniformAddGroup C] [OrderTopology C] [Nontrivial C] [CompleteSpace C] + [Field K] [CharZero K] + +private theorem exists_mapDomain_germ_eq + {D : Type u} + [AddCommGroup D] [LinearOrder D] [IsOrderedAddMonoid D] + [UniformSpace D] [IsUniformAddGroup D] [OrderTopology D] [Nontrivial D] [CompleteSpace D] + (inc : D →+ C) (hinc : Function.Injective inc) + (hincOrder : ∀ x y : D, inc x ≤ inc y ↔ x ≤ y) + (x y : Nonpositive D K) + (hxy : ∃ r < (0 : D), ∀ q > r, + (x : HahnSeries D K).coeff q = (y : HahnSeries D K).coeff q) : + ∃ r < (0 : C), ∀ q > r, + (mapDomain inc hinc hincOrder x : HahnSeries C K).coeff q = + (mapDomain inc hinc hincOrder y : HahnSeries C K).coeff q := by + let JD := (cantorBendixsonValuation (G := D) (R := K)).supp + let JC := (cantorBendixsonValuation (G := C) (R := K)).supp + have mapMemSupp (z : Nonpositive D K) (hz : z ∈ JD) : + mapDomain inc hinc hincOrder z ∈ JC := by + rw [mem_cantorBendixsonValuation_supp] at hz ⊢ + obtain ⟨r, hr, hzr⟩ := hz + refine ⟨inc r, ?_, ?_⟩ + · have hle : inc r ≤ inc 0 := (hincOrder r 0).mpr hr.le + rw [map_zero] at hle + exact lt_of_le_of_ne hle (fun h ↦ hr.ne (hinc (by simpa using h))) + rw [support_mapDomain] + rintro _ ⟨q, hq, rfl⟩ + exact (hincOrder q r).mpr (hzr hq) + apply cantorBendixson_germ_eq_iff _ _ |>.mp + apply Ideal.Quotient.eq.mpr + change mapDomain inc hinc hincOrder x - mapDomain inc hinc hincOrder y ∈ JC + rw [← map_sub] + exact mapMemSupp _ + (Ideal.Quotient.eq.mp (cantorBendixson_germ_eq_iff x y |>.mpr hxy)) + +private theorem mapDomain_refinement + {D : Type u} + [AddCommGroup D] [LinearOrder D] [IsOrderedAddMonoid D] + [UniformSpace D] [IsUniformAddGroup D] [OrderTopology D] [Nontrivial D] [CompleteSpace D] + (inc : D →+ C) (hinc : Function.Injective inc) + (hincOrder : ∀ x y : D, inc x ≤ inc y ↔ x ≤ y) + (a b c d e f g h : Nonpositive D K) + (hea : ∃ r < (0 : D), ∀ q > r, + (a : HahnSeries D K).coeff q = (e * f : Nonpositive D K).1.coeff q) + (heb : ∃ r < (0 : D), ∀ q > r, + (b : HahnSeries D K).coeff q = (g * h : Nonpositive D K).1.coeff q) + (hec : ∃ r < (0 : D), ∀ q > r, + (c : HahnSeries D K).coeff q = (e * g : Nonpositive D K).1.coeff q) + (hed : ∃ r < (0 : D), ∀ q > r, + (d : HahnSeries D K).coeff q = (f * h : Nonpositive D K).1.coeff q) : + (∃ r < (0 : C), ∀ q > r, + (mapDomain inc hinc hincOrder a : HahnSeries C K).coeff q = + (mapDomain inc hinc hincOrder (e * f) : HahnSeries C K).coeff q) ∧ + (∃ r < (0 : C), ∀ q > r, + (mapDomain inc hinc hincOrder b : HahnSeries C K).coeff q = + (mapDomain inc hinc hincOrder (g * h) : HahnSeries C K).coeff q) ∧ + (∃ r < (0 : C), ∀ q > r, + (mapDomain inc hinc hincOrder c : HahnSeries C K).coeff q = + (mapDomain inc hinc hincOrder (e * g) : HahnSeries C K).coeff q) ∧ + ∃ r < (0 : C), ∀ q > r, + (mapDomain inc hinc hincOrder d : HahnSeries C K).coeff q = + (mapDomain inc hinc hincOrder (f * h) : HahnSeries C K).coeff q := + ⟨exists_mapDomain_germ_eq inc hinc hincOrder a (e * f) hea, + exists_mapDomain_germ_eq inc hinc hincOrder b (g * h) heb, + exists_mapDomain_germ_eq inc hinc hincOrder c (e * g) hec, + exists_mapDomain_germ_eq inc hinc hincOrder d (f * h) hed⟩ + +private theorem exists_cardinal_refinement_mapDomain + {D : Type u} {κ : Cardinal.{u}} + [AddCommGroup D] [LinearOrder D] [IsOrderedAddMonoid D] + [UniformSpace D] [IsUniformAddGroup D] [OrderTopology D] [Nontrivial D] [CompleteSpace D] + (inc : D →+ C) (hinc : Function.Injective inc) + (hincOrder : ∀ x y : D, inc x ≤ inc y ↔ x ≤ y) + (hDsupport : ∀ z : Nonpositive D K, + (z : HahnSeries D K).cardSupp < κ) + (a b c d : Nonpositive C K) (a₀ b₀ c₀ d₀ e₀ f₀ g₀ h₀ : Nonpositive D K) + (ha₀ : mapDomain inc hinc hincOrder a₀ = a) + (hb₀ : mapDomain inc hinc hincOrder b₀ = b) + (hc₀ : mapDomain inc hinc hincOrder c₀ = c) + (hd₀ : mapDomain inc hinc hincOrder d₀ = d) + (hea : ∃ r < (0 : D), ∀ q > r, + (a₀ : HahnSeries D K).coeff q = (e₀ * f₀ : Nonpositive D K).1.coeff q) + (heb : ∃ r < (0 : D), ∀ q > r, + (b₀ : HahnSeries D K).coeff q = (g₀ * h₀ : Nonpositive D K).1.coeff q) + (hec : ∃ r < (0 : D), ∀ q > r, + (c₀ : HahnSeries D K).coeff q = (e₀ * g₀ : Nonpositive D K).1.coeff q) + (hed : ∃ r < (0 : D), ∀ q > r, + (d₀ : HahnSeries D K).coeff q = (f₀ * h₀ : Nonpositive D K).1.coeff q) : + ∃ e f g h : Nonpositive C K, + (∃ r < (0 : C), ∀ q > r, + (a : HahnSeries C K).coeff q = (e * f : Nonpositive C K).1.coeff q) ∧ + (∃ r < (0 : C), ∀ q > r, + (b : HahnSeries C K).coeff q = (g * h : Nonpositive C K).1.coeff q) ∧ + (∃ r < (0 : C), ∀ q > r, + (c : HahnSeries C K).coeff q = (e * g : Nonpositive C K).1.coeff q) ∧ + (∃ r < (0 : C), ∀ q > r, + (d : HahnSeries C K).coeff q = (f * h : Nonpositive C K).1.coeff q) ∧ + (e : HahnSeries C K).cardSupp < κ ∧ + (f : HahnSeries C K).cardSupp < κ ∧ + (g : HahnSeries C K).cardSupp < κ ∧ + (h : HahnSeries C K).cardSupp < κ := by + let e := mapDomain inc hinc hincOrder e₀ + let f := mapDomain inc hinc hincOrder f₀ + let g := mapDomain inc hinc hincOrder g₀ + let h := mapDomain inc hinc hincOrder h₀ + have cardMap (z : Nonpositive D K) : + (mapDomain inc hinc hincOrder z : HahnSeries C K).cardSupp < κ := by + rw [HahnSeries.cardSupp, support_mapDomain] + exact Cardinal.mk_image_le.trans_lt (by + simpa only [HahnSeries.cardSupp] using hDsupport z) + obtain ⟨hea', heb', hec', hed'⟩ := + mapDomain_refinement inc hinc hincOrder a₀ b₀ c₀ d₀ e₀ f₀ g₀ h₀ hea heb hec hed + refine ⟨e, f, g, h, ?_, ?_, ?_, ?_, cardMap e₀, cardMap f₀, cardMap g₀, cardMap h₀⟩ + · simpa only [ha₀, map_mul] using hea' + · simpa only [hb₀, map_mul] using heb' + · simpa only [hc₀, map_mul] using hec' + · simpa only [hd₀, map_mul] using hed' + +variable [Module ℚ C] [PosSMulMono ℚ C] [DenselyOrdered C] + [NoMaxOrder (FiniteArchimedeanClass C)] + +/-- Cauchy-complete germ refinement preserves a cardinal support bound. -/ +@[blueprint "thm:cardinal-bounded-germ-refinement" + (phase := "Refinement over Archimedean classes") + (title := "Cardinal-bounded refinement modulo series bounded away from zero") + (statement := /-- + Let $C$ be an ordered rational vector space that is Cauchy complete for its + additive uniformity and whose nonzero Archimedean classes have no least + element in the magnitude order. Let $K$ be a field of characteristic zero + and let $\kappa>\aleph_0$. If $C$ has a positive coinitial subset of + cardinality less than $\kappa$, then every equation $ab=cd$ among four + $\kappa$-bounded series in $K((C^{\le 0}))$ admits a four-factor refinement + modulo series bounded strictly below zero whose four factors are also + $\kappa$-bounded. + -/) + (proof := /-- + Put the supports of $a,b,c,d$ and the chosen positive coinitial set into + one closed rational subspace $C_0$. + The coinitial set remains positive and coinitial in $C_0$; hence $C_0$ is + nontrivial, has no endpoints, and its nonzero Archimedean classes have no + least element in the magnitude order. As a closed subspace of $C$, it is + Cauchy complete for its additive uniformity, and its induced order topology + and rational vector-space structure satisfy the remaining hypotheses of + \ref{thm:complete-hahn-germ-refinement}. Apply that theorem over $C_0$, + and then map the four factors back to $C$. Each factor has well-ordered + support in $C_0$. By + \ref{lem:well-ordered-subset-closed-rational-span-cardinality}, such a + support has cardinality less than $\kappa$. + -/)] +theorem exists_cardinal_germ_refinement + {κ : Cardinal.{u}} [Fact (ℵ₀ < κ)] + (E : Set C) (hEcard : #E < κ) + (hEcoinitial : ∀ y : C, 0 < y → ∃ x ∈ E, 0 < x ∧ x ≤ y) + (a b c d : Nonpositive C K) + (ha : (a : HahnSeries C K).cardSupp < κ) + (hb : (b : HahnSeries C K).cardSupp < κ) + (hc : (c : HahnSeries C K).cardSupp < κ) + (hd : (d : HahnSeries C K).cardSupp < κ) + (habcd : a * b = c * d) : + ∃ e f g h : Nonpositive C K, + (∃ r < (0 : C), ∀ q > r, + (a : HahnSeries C K).coeff q = (e * f : Nonpositive C K).1.coeff q) ∧ + (∃ r < (0 : C), ∀ q > r, + (b : HahnSeries C K).coeff q = (g * h : Nonpositive C K).1.coeff q) ∧ + (∃ r < (0 : C), ∀ q > r, + (c : HahnSeries C K).coeff q = (e * g : Nonpositive C K).1.coeff q) ∧ + (∃ r < (0 : C), ∀ q > r, + (d : HahnSeries C K).coeff q = (f * h : Nonpositive C K).1.coeff q) ∧ + (e : HahnSeries C K).cardSupp < κ ∧ + (f : HahnSeries C K).cardSupp < κ ∧ + (g : HahnSeries C K).cardSupp < κ ∧ + (h : HahnSeries C K).cardSupp < κ := by + let S : Set C := + (a : HahnSeries C K).support ∪ (b : HahnSeries C K).support ∪ + (c : HahnSeries C K).support ∪ (d : HahnSeries C K).support ∪ E + have hκ : ℵ₀ ≤ κ := (Fact.out : ℵ₀ < κ).le + have hS : #S < κ := by + have ha' : #(a : HahnSeries C K).support < κ := by + simpa only [HahnSeries.cardSupp] using ha + have hb' : #(b : HahnSeries C K).support < κ := by + simpa only [HahnSeries.cardSupp] using hb + have hc' : #(c : HahnSeries C K).support < κ := by + simpa only [HahnSeries.cardSupp] using hc + have hd' : #(d : HahnSeries C K).support < κ := by + simpa only [HahnSeries.cardSupp] using hd + exact (Cardinal.mk_union_le _ _).trans_lt (Cardinal.add_lt_of_lt hκ + ((Cardinal.mk_union_le _ _).trans_lt (Cardinal.add_lt_of_lt hκ + ((Cardinal.mk_union_le _ _).trans_lt (Cardinal.add_lt_of_lt hκ + ((Cardinal.mk_union_le _ _).trans_lt (Cardinal.add_lt_of_lt hκ ha' hb')) hc')) hd')) + hEcard) + let C₀ := (Submodule.span ℚ S).topologicalClosure + let inc : C₀ →+ C := C₀.subtype + have hinc : Function.Injective inc := Subtype.val_injective + have hincOrder : ∀ x y : C₀, inc x ≤ inc y ↔ x ≤ y := fun _ _ ↦ Iff.rfl + have hcoinitial : ∀ y : C, 0 < y → ∃ x : C₀, 0 < (x : C) ∧ (x : C) ≤ y := by + intro y hy + obtain ⟨x, hxE, hx, hxy⟩ := hEcoinitial y hy + have hxS : x ∈ S := by + exact Or.inr hxE + exact ⟨⟨x, (Submodule.span ℚ S).le_topologicalClosure + (Submodule.subset_span hxS)⟩, hx, hxy⟩ + let y : C := Classical.choose (exists_ne (0 : C)) + have hy : y ≠ 0 := Classical.choose_spec (exists_ne (0 : C)) + have habsy : 0 < |y| := abs_pos.mpr hy + have hSne : S.Nonempty := by + obtain ⟨x, hxE, -⟩ := hEcoinitial |y| habsy + exact ⟨x, Or.inr hxE⟩ + letI : NoMaxOrder (FiniteArchimedeanClass C₀) := + AddSubgroup.finiteArchimedeanClass_noMax_of_pos_coinitial C₀.toAddSubgroup hcoinitial + letI : NoMinOrder C₀ := ⟨fun x ↦ by + obtain ⟨z, hz, -⟩ := hcoinitial |y| habsy + exact ⟨x - z, sub_lt_self x hz⟩⟩ + letI : NoMaxOrder C₀ := ⟨fun x ↦ by + obtain ⟨z, hz, -⟩ := hcoinitial |y| habsy + exact ⟨x + z, lt_add_of_pos_right x hz⟩⟩ + letI : OrderTopology C₀ := by + apply induced_orderTopology' (fun z : C₀ ↦ (z : C)) (fun {_ _} ↦ Iff.rfl) + · intro x y hyx + obtain ⟨z, hzpos, hzle⟩ := hcoinitial ((x : C) - y) (sub_pos.mpr hyx) + refine ⟨x - z, sub_lt_self x hzpos, ?_⟩ + simpa [sub_le_iff_le_add] using sub_le_sub_left hzle (x : C) + · intro x y hxy + obtain ⟨z, hzpos, hzle⟩ := hcoinitial (y - (x : C)) (sub_pos.mpr hxy) + refine ⟨x + z, lt_add_of_pos_right x hzpos, ?_⟩ + change (x : C) + (z : C) ≤ y + rw [add_comm] + exact le_sub_iff_add_le.mp hzle + letI : PosSMulMono ℚ C₀ := { + smul_le_smul_of_nonneg_left := fun {q} hq {_ _} hxy ↦ + smul_le_smul_of_nonneg_left (α := ℚ) (β := C) hxy hq } + letI : PosSMulStrictMono ℚ C₀ := + PosSMulMono.toPosSMulStrictMono (α := ℚ) (β := C₀) + letI : DenselyOrdered C₀ := by + constructor + intro x y hxy + refine ⟨(2 : ℚ)⁻¹ • (x + y), ?_, ?_⟩ + · calc + x = (2 : ℚ)⁻¹ • (x + x) := by rw [smul_add, ← add_smul]; norm_num + _ < (2 : ℚ)⁻¹ • (x + y) := smul_lt_smul_of_pos_left + (add_lt_add_left hxy x |>.trans_eq (add_comm _ _)) (by norm_num) + · calc + (2 : ℚ)⁻¹ • (x + y) < (2 : ℚ)⁻¹ • (y + y) := + smul_lt_smul_of_pos_left + (by simpa [add_comm] using add_lt_add_left hxy y) (by norm_num) + _ = y := by rw [smul_add, ← add_smul]; norm_num + letI : IsUniformAddGroup C₀ := C₀.toAddSubgroup.isUniformAddGroup + letI : Nontrivial C₀ := by + obtain ⟨z, hz, -⟩ := hcoinitial |y| habsy + exact ⟨⟨0, z, ne_of_lt hz⟩⟩ + have haRange : (a : HahnSeries C K).support ⊆ Set.range inc := by + intro q hq + exact ⟨⟨q, (Submodule.span ℚ S).le_topologicalClosure + (Submodule.subset_span (Or.inl (Or.inl (Or.inl (Or.inl hq)))))⟩, rfl⟩ + have hbRange : (b : HahnSeries C K).support ⊆ Set.range inc := by + intro q hq + exact ⟨⟨q, (Submodule.span ℚ S).le_topologicalClosure + (Submodule.subset_span (Or.inl (Or.inl (Or.inl (Or.inr hq)))))⟩, rfl⟩ + have hcRange : (c : HahnSeries C K).support ⊆ Set.range inc := by + intro q hq + exact ⟨⟨q, (Submodule.span ℚ S).le_topologicalClosure + (Submodule.subset_span (Or.inl (Or.inl (Or.inr hq))))⟩, rfl⟩ + have hdRange : (d : HahnSeries C K).support ⊆ Set.range inc := by + intro q hq + exact ⟨⟨q, (Submodule.span ℚ S).le_topologicalClosure + (Submodule.subset_span (Or.inl (Or.inr hq)))⟩, rfl⟩ + let a₀ := restrictDomain inc hinc hincOrder a + let b₀ := restrictDomain inc hinc hincOrder b + let c₀ := restrictDomain inc hinc hincOrder c + let d₀ := restrictDomain inc hinc hincOrder d + have habcd₀ : a₀ * b₀ = c₀ * d₀ := by + apply mapDomain_injective inc hinc hincOrder + rw [map_mul, map_mul, mapDomain_restrictDomain inc hinc hincOrder a haRange, + mapDomain_restrictDomain inc hinc hincOrder b hbRange, + mapDomain_restrictDomain inc hinc hincOrder c hcRange, + mapDomain_restrictDomain inc hinc hincOrder d hdRange, habcd] + obtain ⟨e₀, f₀, g₀, h₀, hea, heb, hec, hed⟩ := + exists_germ_refinement_of_complete_exponent_group a₀ b₀ c₀ d₀ habcd₀ + have ha₀ : mapDomain inc hinc hincOrder a₀ = a := + mapDomain_restrictDomain inc hinc hincOrder a haRange + have hb₀ : mapDomain inc hinc hincOrder b₀ = b := + mapDomain_restrictDomain inc hinc hincOrder b hbRange + have hc₀ : mapDomain inc hinc hincOrder c₀ = c := + mapDomain_restrictDomain inc hinc hincOrder c hcRange + have hd₀ : mapDomain inc hinc hincOrder d₀ = d := + mapDomain_restrictDomain inc hinc hincOrder d hdRange + have hC₀support (z : Nonpositive C₀ K) : + (z : HahnSeries C₀ K).cardSupp < κ := by + rw [HahnSeries.cardSupp] + exact Submodule.mk_lt_of_isPWO_topologicalClosure_span S hS hSne + (z : HahnSeries C₀ K).support (z : HahnSeries C₀ K).isPWO_support + exact exists_cardinal_refinement_mapDomain inc hinc hincOrder hC₀support + a b c d a₀ b₀ c₀ d₀ e₀ f₀ g₀ h₀ ha₀ hb₀ hc₀ hd₀ hea heb hec hed + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CardinalTruncationClosedClass.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CardinalTruncationClosedClass.lean new file mode 100644 index 0000000000..a6fab39ae8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CardinalTruncationClosedClass.lean @@ -0,0 +1,353 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationResidue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.FiniteGermError + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Closed-class restrictions of cardinal-bounded Hahn series + +Restriction to a closed Archimedean ball preserves a support-cardinality bound. Since the ball +contains zero, it also preserves the constant coefficient and hence every truncation integer part +defined by a coefficient subring. +-/ + +public noncomputable section + +open scoped HahnSeries + +universe u v + +namespace HahnSeries + +variable {G : Type u} {L : Type v} {κ : Cardinal.{u}} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Field L] [Fact (Cardinal.aleph0 < κ)] + +namespace CardSuppLTNonpositive + +/-- Package a nonpositive Hahn series with an explicit support-cardinality bound. -/ +def ofNonpositive (x : Nonpositive G L) (hx : (x : L⟦G⟧).cardSupp < κ) : + CardSuppLTNonpositive (G := G) (L := L) (κ := κ) := + ⟨⟨x, (mem_cardSuppLTSubfield (Γ := G) (R := L) (κ := κ)).mpr hx⟩, by + rw [mem_cardSuppLTTruncationIntegerPart] + exact ⟨x.2, Subring.mem_top _⟩⟩ + +/-- Forgetting the cardinal-bound package recovers the original nonpositive series. -/ +@[simp] +theorem coe_ofNonpositive (x : Nonpositive G L) (hx : (x : L⟦G⟧).cardSupp < κ) : + ((ofNonpositive x hx : CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) : + L⟦G⟧) = (x : L⟦G⟧) := + (rfl) + +/-- Forgetting the support bound from a packaged nonpositive series recovers that series. -/ +@[simp] +theorem toNonpositiveRingHom_ofNonpositive + (x : Nonpositive G L) (hx : (x : L⟦G⟧).cardSupp < κ) : + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom (⊤ : Subring L) + (ofNonpositive x hx) = x := by + apply Subtype.ext + rw [CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] + exact coe_ofNonpositive x hx + +/-- Forgetting a residue-subring presentation gives the same nonpositive series as forgetting +the original truncation integer part. -/ +@[simp] +theorem toNonpositiveRingHom_truncationIntegerPartEquivResidueSubring + (S : Subring L) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := L) (κ := κ) S) : + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom (⊤ : Subring L) + ((truncationIntegerPartEquivResidueSubring S x : + Subring.residueSubring constantCoeffAlgHom S) : + CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) = + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom S x := by + apply Subtype.ext + rw [CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom, + coe_truncationIntegerPartEquivResidueSubring, + CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] + +/-- Restrict a cardinal-bounded nonpositive series to a closed Archimedean ball. -/ +def closedClassRestrict (q : FiniteArchimedeanClass G) + (x : CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) : + CardSuppLTNonpositive (G := G) (L := L) (κ := κ) := by + let xN := CardSuppLTTruncationIntegerPart.toNonpositiveRingHom (⊤ : Subring L) x + let xr := Nonpositive.closedClassRestrict q xN + have hxcard : (x : L⟦G⟧).cardSupp < κ := + (mem_cardSuppLTSubfield (Γ := G) (R := L) (κ := κ)).mp x.1.2 + have hxNcard : (xN : L⟦G⟧).cardSupp < κ := by + simpa only [xN, CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] using hxcard + exact ⟨⟨xr, (mem_cardSuppLTSubfield (Γ := G) (R := L) (κ := κ)).mpr + ((cardSupp_mono (Nonpositive.support_closedClassRestrict_subset q xN)).trans_lt + hxNcard)⟩, by + rw [mem_cardSuppLTTruncationIntegerPart] + exact ⟨xr.2, Subring.mem_top _⟩⟩ + +/-- Forgetting the cardinal bound exposes the ordinary closed-class restriction. -/ +@[simp] +theorem coe_closedClassRestrict (q : FiniteArchimedeanClass G) + (x : CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) : + ((closedClassRestrict q x : CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) : + L⟦G⟧) = + (Nonpositive.closedClassRestrict q + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom (⊤ : Subring L) x) : + Nonpositive G L) := + (rfl) + +/-- Forgetting only the cardinal bound commutes with closed-class restriction. -/ +theorem toNonpositiveRingHom_closedClassRestrict (q : FiniteArchimedeanClass G) + (x : CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) : + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom (⊤ : Subring L) + (closedClassRestrict q x) = + Nonpositive.closedClassRestrict q + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom (⊤ : Subring L) x) := by + apply Subtype.ext + rw [CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] + exact coe_closedClassRestrict q x + +/-- Closed-class restriction is multiplicative on cardinal-bounded nonpositive series. -/ +theorem closedClassRestrict_mul (q : FiniteArchimedeanClass G) + (x y : CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) : + closedClassRestrict q (x * y) = + closedClassRestrict q x * closedClassRestrict q y := by + apply CardSuppLTTruncationIntegerPart.toNonpositiveRingHom_injective + (⊤ : Subring L) + rw [map_mul, toNonpositiveRingHom_closedClassRestrict, + toNonpositiveRingHom_closedClassRestrict, toNonpositiveRingHom_closedClassRestrict, + map_mul, Nonpositive.closedClassRestrict_mul] + +/-- Restriction at a class met by the support of a bounded nonpositive series is nonzero. -/ +theorem closedClassRestrict_ne_zero_of_mem_image_mk_support + (q : FiniteArchimedeanClass G) + (x : CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) + (hq : q.1 ∈ ArchimedeanClass.mk '' (x : L⟦G⟧).support) : + closedClassRestrict q x ≠ 0 := by + intro hzero + have hzero' : Nonpositive.closedClassRestrict q + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom (⊤ : Subring L) x) = 0 := by + apply Subtype.ext + exact congrArg (fun z : CardSuppLTNonpositive (G := G) (L := L) (κ := κ) ↦ + (z : L⟦G⟧)) hzero + apply Nonpositive.closedClassRestrict_ne_zero_of_mem_image_mk_support + (c := q) + (b := CardSuppLTTruncationIntegerPart.toNonpositiveRingHom (⊤ : Subring L) x) + · simpa only [CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] using hq + · exact hzero' + +end CardSuppLTNonpositive + +namespace CardSuppLTTruncationIntegerPart + +/-- Restriction to a closed Archimedean ball preserves a cardinal-bounded truncation integer +part. -/ +def closedClassRestrict (S : Subring L) (q : FiniteArchimedeanClass G) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := L) (κ := κ) S) : + cardSuppLTTruncationIntegerPart (G := G) (R := L) (κ := κ) S := by + let xN := toNonpositiveRingHom S x + let xr := Nonpositive.closedClassRestrict q xN + have hxcard : (x : L⟦G⟧).cardSupp < κ := + (mem_cardSuppLTSubfield (Γ := G) (R := L) (κ := κ)).mp x.1.2 + have hxNcard : (xN : L⟦G⟧).cardSupp < κ := by + simpa only [xN, coe_toNonpositiveRingHom] using hxcard + have hxmem := (mem_cardSuppLTTruncationIntegerPart (Z := S)).mp x.2 + exact ⟨⟨xr, (mem_cardSuppLTSubfield (Γ := G) (R := L) (κ := κ)).mpr + ((cardSupp_mono (Nonpositive.support_closedClassRestrict_subset q xN)).trans_lt + hxNcard)⟩, by + rw [mem_cardSuppLTTruncationIntegerPart] + refine ⟨xr.2, ?_⟩ + rw [Nonpositive.closedClassRestrict_coeff, if_pos] + · simpa only [xN, coe_toNonpositiveRingHom] using hxmem.2 + · exact (FiniteArchimedeanClass.closedBallAddSubgroup q).zero_mem⟩ + +/-- Forgetting the bound and residue condition exposes the ordinary closed-class restriction. -/ +@[simp] +theorem coe_closedClassRestrict (S : Subring L) (q : FiniteArchimedeanClass G) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := L) (κ := κ) S) : + ((closedClassRestrict S q x : + cardSuppLTTruncationIntegerPart (G := G) (R := L) (κ := κ) S) : L⟦G⟧) = + (Nonpositive.closedClassRestrict q (toNonpositiveRingHom S x) : Nonpositive G L) := + (rfl) + +/-- Forgetting only the cardinal bound and residue condition commutes with closed-class +restriction. -/ +theorem toNonpositiveRingHom_closedClassRestrict (S : Subring L) + (q : FiniteArchimedeanClass G) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := L) (κ := κ) S) : + toNonpositiveRingHom S (closedClassRestrict S q x) = + Nonpositive.closedClassRestrict q (toNonpositiveRingHom S x) := by + apply Subtype.ext + rw [coe_toNonpositiveRingHom] + exact coe_closedClassRestrict S q x + +/-- Restriction at a class met by the support of a cardinal-bounded integer part is nonzero. -/ +theorem closedClassRestrict_ne_zero_of_mem_image_mk_support + (S : Subring L) (q : FiniteArchimedeanClass G) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := L) (κ := κ) S) + (hq : q.1 ∈ ArchimedeanClass.mk '' (x : L⟦G⟧).support) : + closedClassRestrict S q x ≠ 0 := by + intro hzero + have hzero' : Nonpositive.closedClassRestrict q (toNonpositiveRingHom S x) = 0 := by + rw [← toNonpositiveRingHom_closedClassRestrict] + simpa only [map_zero] using congrArg (toNonpositiveRingHom S) hzero + apply Nonpositive.closedClassRestrict_ne_zero_of_mem_image_mk_support + (c := q) (b := toNonpositiveRingHom S x) + · simpa only [coe_toNonpositiveRingHom] using hq + · exact hzero' + +/-- Closed-class restriction is multiplicative in every cardinal-bounded truncation integer +part. -/ +theorem closedClassRestrict_mul (S : Subring L) (q : FiniteArchimedeanClass G) + (x y : cardSuppLTTruncationIntegerPart (G := G) (R := L) (κ := κ) S) : + closedClassRestrict S q (x * y) = + closedClassRestrict S q x * closedClassRestrict S q y := by + apply toNonpositiveRingHom_injective S + rw [map_mul, toNonpositiveRingHom_closedClassRestrict, + toNonpositiveRingHom_closedClassRestrict, toNonpositiveRingHom_closedClassRestrict, + map_mul, Nonpositive.closedClassRestrict_mul] + +/-- An exact closed-class refinement by bounded nonpositive factors can be normalized inside a +cardinal-bounded truncation integer part. -/ +@[blueprint "lem:closed-class-refinement-normalization" + (phase := "Refinement over Archimedean classes") + (title := "Normalization of a closed-class refinement in a Hahn integer part") + (statement := /-- + Let $S\subseteq L$ be a subring of a field, let $q$ be a nonzero + Archimedean class of an ordered exponent group, and let + $a,b,c,d\in S+L((G^{<0}))_\kappa$ satisfy $ab=cd$. Assume the constant + coefficient of $a$ is primal in $S$, every element of $L$ is a fraction of + elements of $S$, and the closed-class restriction $a_q$ is nonzero. + + If the restrictions of $a,b,c,d$ admit a four-factor refinement by + $\kappa$-bounded nonpositive Hahn series, then they admit such a refinement + by elements of $S+L((G^{<0}))_\kappa$. + -/) + (proof := /-- + Regard the bounded Hahn integer part as the inverse image of $S$ under the + constant-coefficient homomorphism on bounded nonpositive series. The + primality of the constant coefficient of $a$ and the fraction-field + hypothesis allow a common scalar adjustment of the four ambient factors + so that all four constant coefficients lie in $S$. Transport the adjusted + refinement back through this residue-subring presentation. + -/)] +theorem exists_refinement_closedClassRestrict_of_ambient + (S : Subring L) (q : FiniteArchimedeanClass G) + (a b c d : cardSuppLTTruncationIntegerPart + (G := G) (R := L) (κ := κ) S) + (haS : IsPrimal (⟨(a : L⟦G⟧).coeff 0, + ((mem_cardSuppLTTruncationIntegerPart (Z := S)).mp a.2).2⟩ : S)) + (hfrac : Subring.fracSubring S = ⊤) + (ha0 : closedClassRestrict S q a ≠ 0) (habcd : a * b = c * d) + (e f g h : Nonpositive G L) + (hecard : (e : L⟦G⟧).cardSupp < κ) + (hfcard : (f : L⟦G⟧).cardSupp < κ) + (hgcard : (g : L⟦G⟧).cardSupp < κ) + (hhcard : (h : L⟦G⟧).cardSupp < κ) + (ha : Nonpositive.closedClassRestrict q (toNonpositiveRingHom S a) = + Nonpositive.closedClassRestrict q e * Nonpositive.closedClassRestrict q f) + (hb : Nonpositive.closedClassRestrict q (toNonpositiveRingHom S b) = + Nonpositive.closedClassRestrict q g * Nonpositive.closedClassRestrict q h) + (hc : Nonpositive.closedClassRestrict q (toNonpositiveRingHom S c) = + Nonpositive.closedClassRestrict q e * Nonpositive.closedClassRestrict q g) + (hd : Nonpositive.closedClassRestrict q (toNonpositiveRingHom S d) = + Nonpositive.closedClassRestrict q f * Nonpositive.closedClassRestrict q h) : + ∃ E F H₁ H₂ : cardSuppLTTruncationIntegerPart + (G := G) (R := L) (κ := κ) S, + closedClassRestrict S q a = E * F ∧ + closedClassRestrict S q b = H₁ * H₂ ∧ + closedClassRestrict S q c = E * H₁ ∧ + closedClassRestrict S q d = F * H₂ := by + let eb := CardSuppLTNonpositive.closedClassRestrict q + (CardSuppLTNonpositive.ofNonpositive e hecard) + let fb := CardSuppLTNonpositive.closedClassRestrict q + (CardSuppLTNonpositive.ofNonpositive f hfcard) + let gb := CardSuppLTNonpositive.closedClassRestrict q + (CardSuppLTNonpositive.ofNonpositive g hgcard) + let hbnd := CardSuppLTNonpositive.closedClassRestrict q + (CardSuppLTNonpositive.ofNonpositive h hhcard) + have hea : ((CardSuppLTNonpositive.truncationIntegerPartEquivResidueSubring S + (closedClassRestrict S q a) : + Subring.residueSubring CardSuppLTNonpositive.constantCoeffAlgHom S) : + CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) = eb * fb := by + apply CardSuppLTTruncationIntegerPart.toNonpositiveRingHom_injective + (⊤ : Subring L) + rw [map_mul, + CardSuppLTNonpositive.toNonpositiveRingHom_truncationIntegerPartEquivResidueSubring, + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom_closedClassRestrict, + CardSuppLTNonpositive.toNonpositiveRingHom_closedClassRestrict, + CardSuppLTNonpositive.toNonpositiveRingHom_closedClassRestrict, + CardSuppLTNonpositive.toNonpositiveRingHom_ofNonpositive, + CardSuppLTNonpositive.toNonpositiveRingHom_ofNonpositive] + exact ha + have heb : ((CardSuppLTNonpositive.truncationIntegerPartEquivResidueSubring S + (closedClassRestrict S q b) : + Subring.residueSubring CardSuppLTNonpositive.constantCoeffAlgHom S) : + CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) = gb * hbnd := by + apply CardSuppLTTruncationIntegerPart.toNonpositiveRingHom_injective + (⊤ : Subring L) + rw [map_mul, + CardSuppLTNonpositive.toNonpositiveRingHom_truncationIntegerPartEquivResidueSubring, + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom_closedClassRestrict, + CardSuppLTNonpositive.toNonpositiveRingHom_closedClassRestrict, + CardSuppLTNonpositive.toNonpositiveRingHom_closedClassRestrict, + CardSuppLTNonpositive.toNonpositiveRingHom_ofNonpositive, + CardSuppLTNonpositive.toNonpositiveRingHom_ofNonpositive] + exact hb + have hec : ((CardSuppLTNonpositive.truncationIntegerPartEquivResidueSubring S + (closedClassRestrict S q c) : + Subring.residueSubring CardSuppLTNonpositive.constantCoeffAlgHom S) : + CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) = eb * gb := by + apply CardSuppLTTruncationIntegerPart.toNonpositiveRingHom_injective + (⊤ : Subring L) + rw [map_mul, + CardSuppLTNonpositive.toNonpositiveRingHom_truncationIntegerPartEquivResidueSubring, + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom_closedClassRestrict, + CardSuppLTNonpositive.toNonpositiveRingHom_closedClassRestrict, + CardSuppLTNonpositive.toNonpositiveRingHom_closedClassRestrict, + CardSuppLTNonpositive.toNonpositiveRingHom_ofNonpositive, + CardSuppLTNonpositive.toNonpositiveRingHom_ofNonpositive] + exact hc + have hed : ((CardSuppLTNonpositive.truncationIntegerPartEquivResidueSubring S + (closedClassRestrict S q d) : + Subring.residueSubring CardSuppLTNonpositive.constantCoeffAlgHom S) : + CardSuppLTNonpositive (G := G) (L := L) (κ := κ)) = fb * hbnd := by + apply CardSuppLTTruncationIntegerPart.toNonpositiveRingHom_injective + (⊤ : Subring L) + rw [map_mul, + CardSuppLTNonpositive.toNonpositiveRingHom_truncationIntegerPartEquivResidueSubring, + CardSuppLTTruncationIntegerPart.toNonpositiveRingHom_closedClassRestrict, + CardSuppLTNonpositive.toNonpositiveRingHom_closedClassRestrict, + CardSuppLTNonpositive.toNonpositiveRingHom_closedClassRestrict, + CardSuppLTNonpositive.toNonpositiveRingHom_ofNonpositive, + CardSuppLTNonpositive.toNonpositiveRingHom_ofNonpositive] + exact hd + have haS' : IsPrimal + (⟨((closedClassRestrict S q a : + cardSuppLTTruncationIntegerPart (G := G) (R := L) (κ := κ) S) : + L⟦G⟧).coeff 0, + ((mem_cardSuppLTTruncationIntegerPart (Z := S)).mp + (closedClassRestrict S q a).2).2⟩ : S) := by + have hcoeff : + ((closedClassRestrict S q a : + cardSuppLTTruncationIntegerPart (G := G) (R := L) (κ := κ) S) : + L⟦G⟧).coeff 0 = (a : L⟦G⟧).coeff 0 := by + rw [coe_closedClassRestrict, Nonpositive.closedClassRestrict_coeff, if_pos] + · exact congrArg (fun z : L⟦G⟧ ↦ z.coeff 0) (coe_toNonpositiveRingHom S a) + · exact (FiniteArchimedeanClass.closedBallAddSubgroup q).zero_mem + convert haS using 1 + apply Subtype.ext + exact hcoeff + have heq : closedClassRestrict S q a * closedClassRestrict S q b = + closedClassRestrict S q c * closedClassRestrict S q d := by + rw [← closedClassRestrict_mul, ← closedClassRestrict_mul, + habcd] + exact CardSuppLTNonpositive.exists_refinement_truncationIntegerPart_of_ambient + S haS' hfrac ha0 heq hea heb hec hed + +end CardSuppLTTruncationIntegerPart + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/ClosedClassRefinementTransport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/ClosedClassRefinementTransport.lean new file mode 100644 index 0000000000..a91f4dfe1b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/ClosedClassRefinementTransport.lean @@ -0,0 +1,398 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalTruncationClosedClass +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEmbedding +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexQuotientSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanBall +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ConvexRestrictionFactorization + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Transporting refinement from a closed quotient class + +Closed-class restriction after convex quotient regrouping is ambient restriction to the preimage +of that class ball. This identifies exact quotient refinements with retained ambient factors and +allows truncation-divisibility to lift the two required divisibilities. +-/ + +public noncomputable section + +open scoped HahnSeries + +universe u v w + +namespace HahnSeries.CardSuppLTTruncationIntegerPart + +private theorem eq_symm_mul_symm_of_map_eq_mul + {A B : Type*} [Semiring A] [Semiring B] (E : A ≃+* B) + {t : A} {e f : B} (h : E t = e * f) : t = E.symm e * E.symm f := by + apply E.injective + have he : E (E.symm e) = e := E.apply_symm_apply e + have hf : E (E.symm f) = f := E.apply_symm_apply f + exact h.trans ((congrArg₂ (· * ·) he.symm hf.symm).trans (E.map_mul _ _).symm) + +variable {G : Type u} {R : Type v} {K : Type w} {κ : Cardinal.{u}} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Field K] [Module K G] [Field R] +variable [Fact (Cardinal.aleph0 < κ)] [Fact κ.IsRegular] + +/-- Restriction to a closed quotient class is ambient restriction to the preimage of its closed +ball. -/ +@[blueprint "lem:quotient-regrouping-closed-ball-restriction" + (phase := "Refinement over Archimedean classes") + (title := "Closed-ball restriction under quotient regrouping") + (statement := /-- + Let $P$ be a convex subspace of an ordered vector space $G$, and regroup a + bounded Hahn series first by exponents in $G/P$ and then by exponents in + $P$. For an Archimedean class $q$ of $G/P$, restriction of the regrouped + series to the closed ball of $q$ is the regrouping of the original series + restricted to the inverse image of that ball in $G$. + -/) + (proof := /-- + Compare the coefficient at an outer exponent $\bar g\in G/P$ and an inner + exponent $p\in P$. If $\bar g$ lies in the closed ball of $q$, both sides + have the coefficient of the unique exponent of $G$ represented by + $(\bar g,p)$; otherwise both coefficients are zero. + -/)] +theorem convexQuotientSplit_filter_eq_closed_class_restrict + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (Z : Subring R) + (q : FiniteArchimedeanClass (G ⧸ P)) + (x t : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (ht : (t : R⟦G⟧) = @HahnSeries.filter R G _ _ + (· ∈ (FiniteArchimedeanClass.closedBallAddSubgroup q).comap + P.mkQ.toAddMonoidHom) (Classical.decPred _) (x : R⟦G⟧)) : + cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z t = + closedClassRestrict + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) q + (cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z x) := by + classical + let D := FiniteArchimedeanClass.closedBallAddSubgroup q + apply Subtype.ext + apply Subtype.ext + ext z p + have hsplit : convexQuotientSplitRingEquiv P (t : R⟦G⟧) = + HahnSeries.filter (· ∈ D) (convexQuotientSplitRingEquiv P (x : R⟦G⟧)) := by + rw [ht] + exact convexQuotientSplitRingEquiv_filter_comap P D (x : R⟦G⟧) + have hz := congrArg (fun y : (R⟦P⟧)⟦G ⧸ P⟧ ↦ (y.coeff z).coeff p) hsplit + rw [HahnSeries.coeff_filter] at hz + have htcoeff := congrArg + (fun y : (R⟦P⟧)⟦G ⧸ P⟧ ↦ (y.coeff z).coeff p) + (boundedOuterCoefficientInclusion_split P t.1) + rw [boundedOuterCoefficientInclusion_coeff] at htcoeff + rw [coe_cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv] + rw [htcoeff] + rw [CardSuppLTTruncationIntegerPart.coe_closedClassRestrict, + Nonpositive.closedClassRestrict_coeff] + by_cases hzD : z ∈ D + · rw [if_pos hzD] + change ((convexQuotientSplitRingEquiv P (t : R⟦G⟧)).coeff z).coeff p = _ + have hxcoeff := congrArg + (fun y : (R⟦P⟧)⟦G ⧸ P⟧ ↦ (y.coeff z).coeff p) + (boundedOuterCoefficientInclusion_split P x.1) + rw [boundedOuterCoefficientInclusion_coeff] at hxcoeff + rw [CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] + rw [coe_cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv] + rw [hxcoeff] + simpa only [D, if_pos hzD] using hz + · rw [if_neg hzD] + change ((convexQuotientSplitRingEquiv P (t : R⟦G⟧)).coeff z).coeff p = 0 + simpa only [D, if_neg hzD, HahnSeries.coeff_zero] using hz + +private theorem ambient_factorization_of_closed_class_factorization + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (Z : Subring R) + (q : FiniteArchimedeanClass (G ⧸ P)) + (a t : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (ht : t = restrictToAddSubgroup Z + ((FiniteArchimedeanClass.closedBallAddSubgroup q).comap P.mkQ.toAddMonoidHom) a) + (ht0 : t ≠ 0) + (e f : cardSuppLTTruncationIntegerPart (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ) + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z)) + (ha : closedClassRestrict + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) q + (cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z a) = e * f) : + let E := cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z + E t = e * f ∧ t = E.symm e * E.symm f ∧ e ≠ 0 ∧ f ≠ 0 := by + let E := cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z + have hEt : E t = e * f := by + rw [convexQuotientSplit_filter_eq_closed_class_restrict P Z q a t] + · exact ha + · simp only [ht, coe_restrictToAddSubgroup] + have htef : t = E.symm e * E.symm f := eq_symm_mul_symm_of_map_eq_mul E hEt + have he0 : e ≠ 0 := fun he ↦ ht0 (by simp only [htef, he, map_zero, zero_mul]) + have hf0 : f ≠ 0 := fun hf ↦ ht0 (by simp only [htef, hf, map_zero, mul_zero]) + exact ⟨hEt, htef, he0, hf0⟩ + +private theorem nonpositive_factor_supports_subset_closed_ball + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (Z : Subring R) + (q : FiniteArchimedeanClass (G ⧸ P)) + (a t : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (ht : t = restrictToAddSubgroup Z + ((FiniteArchimedeanClass.closedBallAddSubgroup q).comap P.mkQ.toAddMonoidHom) a) + (e f : cardSuppLTTruncationIntegerPart (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ) + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z)) + (hEt : cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z t = e * f) + (he0 : e ≠ 0) (hf0 : f ≠ 0) : + let InnerPart := cardSuppLTTruncationIntegerPart + (G := P) (R := R) (κ := κ) Z + let eN := toNonpositiveRingHom InnerPart e + let fN := toNonpositiveRingHom InnerPart f + let D := FiniteArchimedeanClass.closedBallAddSubgroup q + (eN : (CardSuppLTField (G := P) (R := R) (κ := κ))⟦G ⧸ P⟧).support ⊆ + (D : Set (G ⧸ P)) ∧ + (fN : (CardSuppLTField (G := P) (R := R) (κ := κ))⟦G ⧸ P⟧).support ⊆ + (D : Set (G ⧸ P)) := by + let E := cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z + let InnerPart := cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z + let eN := toNonpositiveRingHom InnerPart e + let fN := toNonpositiveRingHom InnerPart f + let D := FiniteArchimedeanClass.closedBallAddSubgroup q + have heN0 : eN ≠ 0 := by + intro heN + apply he0 + exact toNonpositiveRingHom_injective InnerPart (heN.trans (map_zero _).symm) + have hfN0 : fN ≠ 0 := by + intro hfN + apply hf0 + exact toNonpositiveRingHom_injective InnerPart (hfN.trans (map_zero _).symm) + have hprodD : ((eN * fN : Nonpositive (G ⧸ P) + (CardSuppLTField (G := P) (R := R) (κ := κ))) : + (CardSuppLTField (G := P) (R := R) (κ := κ))⟦G ⧸ P⟧).support ⊆ + (D : Set (G ⧸ P)) := by + have hraw : eN * fN = toNonpositiveRingHom InnerPart (E t) := by + let F := toNonpositiveRingHom + (G := G ⧸ P) (R := CardSuppLTField (G := P) (R := R) (κ := κ)) + (κ := κ) InnerPart + change F e * F f = F (E t) + exact (F.map_mul e f).symm.trans (congrArg F hEt.symm) + rw [hraw, coe_toNonpositiveRingHom, + support_cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv] + apply support_convexQuotientSplitRingEquiv_subset_iff P D (t : R⟦G⟧) |>.mpr + intro z hz + rw [ht, coe_restrictToAddSubgroup, HahnSeries.support_filter] at hz + exact hz.2 + exact Nonpositive.support_subset_convex_of_mul_support_subset + (FiniteArchimedeanClass.closedBall_ordConnected q) heN0 hfN0 hprodD + +private theorem support_symm_subset_comap_of_nonpositive_support_subset + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (Z : Subring R) + (D : AddSubgroup (G ⧸ P)) + (x : cardSuppLTTruncationIntegerPart (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ) + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z)) + (hx : ((toNonpositiveRingHom + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) x : + Nonpositive (G ⧸ P) (CardSuppLTField (G := P) (R := R) (κ := κ))) : + (CardSuppLTField (G := P) (R := R) (κ := κ))⟦G ⧸ P⟧).support ⊆ D) : + ((cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z).symm x : R⟦G⟧).support ⊆ + (D.comap P.mkQ.toAddMonoidHom : Set G) := by + let E := cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z + let xA := E.symm x + let InnerPart := cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z + let xN := toNonpositiveRingHom InnerPart x + apply support_convexQuotientSplitRingEquiv_subset_iff P D (xA : R⟦G⟧) |>.mp + have hxEq : E xA = x := E.apply_symm_apply x + have hsupp : (convexQuotientSplitRingEquiv P (xA : R⟦G⟧)).support = + (xN : (CardSuppLTField (G := P) (R := R) (κ := κ))⟦G ⧸ P⟧).support := by + rw [← support_cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z xA, + hxEq, coe_toNonpositiveRingHom] + rw [hsupp] + exact hx + +private theorem ambient_factor_dvd_of_closed_class_factorization + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (Z : Subring R) + (q : FiniteArchimedeanClass (G ⧸ P)) + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (y z : cardSuppLTTruncationIntegerPart (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ) + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z)) + (hxy : closedClassRestrict + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) q + (cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z x) = y * z) + (hy0 : y ≠ 0) + (hySupp : ((cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z).symm y : R⟦G⟧).support ⊆ + ((FiniteArchimedeanClass.closedBallAddSubgroup q).comap + P.mkQ.toAddMonoidHom : Set G)) : + (cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z).symm y ∣ x := by + classical + let E := cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z + let D := FiniteArchimedeanClass.closedBallAddSubgroup q + let C : AddSubgroup G := D.comap P.mkQ.toAddMonoidHom + let yA := E.symm y + let zA := E.symm z + let xC := restrictToAddSubgroup Z C x + have hEx : E xC = y * z := by + rw [convexQuotientSplit_filter_eq_closed_class_restrict P Z q x xC] + · exact hxy + · simp only [xC, C, D, coe_restrictToAddSubgroup] + have hxC : xC = yA * zA := eq_symm_mul_symm_of_map_eq_mul E hEx + have hC : (C : Set G).OrdConnected := + (FiniteArchimedeanClass.closedBall_ordConnected q).preimage_mono + (fun _ _ huv ↦ ConvexQuotient.mk_le_mk huv) + have hyA0 : yA ≠ 0 := by + intro hyA0 + apply hy0 + rw [← E.apply_symm_apply y, show E.symm y = 0 from hyA0, map_zero] + apply dvd_of_restriction_factorization Z hC yA zA x hySupp hyA0 + have hraw := congrArg (fun w : cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z ↦ (w : R⟦G⟧)) hxC + calc + HahnSeries.filter (· ∈ C) (x : R⟦G⟧) = (xC : R⟦G⟧) := by + exact (coe_restrictToAddSubgroup Z C x).symm + _ = ((yA * zA : cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z) : R⟦G⟧) := hraw + _ = (yA : R⟦G⟧) * (zA : R⟦G⟧) := rfl + +private theorem ambient_factors_supported_of_closed_class_factorization + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (Z : Subring R) + (q : FiniteArchimedeanClass (G ⧸ P)) + (a t : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (ht : t = restrictToAddSubgroup Z + ((FiniteArchimedeanClass.closedBallAddSubgroup q).comap P.mkQ.toAddMonoidHom) a) + (ht0 : t ≠ 0) + (e f : cardSuppLTTruncationIntegerPart (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ) + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z)) + (ha : closedClassRestrict + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) q + (cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z a) = e * f) : + let E := cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z + let D := FiniteArchimedeanClass.closedBallAddSubgroup q + let C : AddSubgroup G := D.comap P.mkQ.toAddMonoidHom + let eA := E.symm e + let fA := E.symm f + t = eA * fA ∧ e ≠ 0 ∧ f ≠ 0 ∧ + (eA : R⟦G⟧).support ⊆ (C : Set G) ∧ + (fA : R⟦G⟧).support ⊆ (C : Set G) := by + classical + let E := + cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv (R := R) (κ := κ) P Z + let D := FiniteArchimedeanClass.closedBallAddSubgroup q + let C : AddSubgroup G := D.comap P.mkQ.toAddMonoidHom + let eA := E.symm e + let fA := E.symm f + have hfactor := ambient_factorization_of_closed_class_factorization + P Z q a t ht ht0 e f ha + dsimp only at hfactor + obtain ⟨hEt, htef, he0, hf0⟩ := hfactor + have hsupp := nonpositive_factor_supports_subset_closed_ball + P Z q a t ht e f hEt he0 hf0 + dsimp only at hsupp + have heSupp : (eA : R⟦G⟧).support ⊆ (C : Set G) := + support_symm_subset_comap_of_nonpositive_support_subset P Z D e hsupp.1 + have hfSupp : (fA : R⟦G⟧).support ⊆ (C : Set G) := + support_symm_subset_comap_of_nonpositive_support_subset P Z D f hsupp.2 + exact ⟨htef, he0, hf0, heSupp, hfSupp⟩ + +private theorem ambient_factors_dvd_of_closed_class_factorizations + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (Z : Subring R) + (q : FiniteArchimedeanClass (G ⧸ P)) + (c d : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (e f g h : cardSuppLTTruncationIntegerPart (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ) + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z)) + (hc : closedClassRestrict + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) q + (cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z c) = e * g) + (hd : closedClassRestrict + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) q + (cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z d) = f * h) + (he0 : e ≠ 0) (hf0 : f ≠ 0) + (heSupp : ((cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z).symm e : R⟦G⟧).support ⊆ + ((FiniteArchimedeanClass.closedBallAddSubgroup q).comap + P.mkQ.toAddMonoidHom : Set G)) + (hfSupp : ((cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z).symm f : R⟦G⟧).support ⊆ + ((FiniteArchimedeanClass.closedBallAddSubgroup q).comap + P.mkQ.toAddMonoidHom : Set G)) : + (cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z).symm e ∣ c ∧ + (cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z).symm f ∣ d := by + constructor + · exact ambient_factor_dvd_of_closed_class_factorization + P Z q c e g hc he0 heSupp + · exact ambient_factor_dvd_of_closed_class_factorization + P Z q d f h hd hf0 hfSupp + +/-- An exact quotient-class refinement transports to a factorisation of the retained ambient +block, with the two factors dividing the corresponding ambient right-hand factors. -/ +@[blueprint "lem:closed-class-refinement-transport" + (phase := "Refinement over Archimedean classes") + (title := "Transport of refinement from a quotient Archimedean class") + (statement := /-- + Let $P$ be a convex subspace of an ordered vector space $G$, let $q$ be a + nonzero Archimedean class of $G/P$, and let $t\ne0$ be the restriction of + $a$ to the inverse image of the closed ball of $q$. If the closed-ball + restrictions of $a,c,d$ in the iterated Hahn field factor as + \[ + a_q=ef,\qquad c_q=eg,\qquad d_q=fh, + \] + then there are $e_A,f_A\in Z+R((G^{<0}))_\kappa$ such that + $t=e_Af_A$, $e_A\mid c$, and $f_A\mid d$. + -/) + (proof := /-- + By \ref{lem:quotient-regrouping-closed-ball-restriction}, the Hahn-field + isomorphism obtained by regrouping exponents along $P$ identifies + closed-ball restriction in $G/P$ with restriction to its inverse image in + $G$. Transport $e$ and $f$ back through this isomorphism. + Since their product is supported in the retained convex subgroup, + \ref{lem:convex-support-of-factors} confines both supports there. Apply + \ref{lem:divisibility-from-convex-restriction} to the restricted + factorisations of $c$ and $d$ to obtain $e_A\mid c$ and $f_A\mid d$ in the + ambient integer part. + -/)] +theorem exists_factor_refinement_of_closed_class_refinement + (P : Submodule K G) [P.toAddSubgroup.IsConvex] (Z : Subring R) + (q : FiniteArchimedeanClass (G ⧸ P)) + (a c d t : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (ht : t = restrictToAddSubgroup Z + ((FiniteArchimedeanClass.closedBallAddSubgroup q).comap P.mkQ.toAddMonoidHom) a) + (ht0 : t ≠ 0) + (e f g h : cardSuppLTTruncationIntegerPart (G := G ⧸ P) + (R := CardSuppLTField (G := P) (R := R) (κ := κ)) (κ := κ) + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z)) + (ha : closedClassRestrict + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) q + (cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z a) = e * f) + (hc : closedClassRestrict + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) q + (cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z c) = e * g) + (hd : closedClassRestrict + (cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) q + (cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z d) = f * h) : + ∃ eA fA : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z, + t = eA * fA ∧ eA ∣ c ∧ fA ∣ d := by + classical + let E := + cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv (R := R) (κ := κ) P Z + let eA := E.symm e + let fA := E.symm f + have hfactor := + ambient_factors_supported_of_closed_class_factorization P Z q a t ht ht0 e f ha + dsimp only at hfactor + obtain ⟨htef, he0, hf0, heSupp, hfSupp⟩ := hfactor + have hdvd := + ambient_factors_dvd_of_closed_class_factorizations + P Z q c d e f g h hc hd he0 hf0 heSupp hfSupp + exact ⟨eA, fA, htef, hdvd.1, hdvd.2⟩ + +end HahnSeries.CardSuppLTTruncationIntegerPart diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CompleteGermRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CompleteGermRefinement.lean new file mode 100644 index 0000000000..f6a577590a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CompleteGermRefinement.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.CompleteGermOfCauchyComplete + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Refinement of a complete generalised-power-series germ ring + +The polynomial presentation of the quotient by series bounded strictly below zero gives +four-factor refinement in that quotient. +-/ + +open Set +open scoped HahnSeries + +universe u v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + [NoMaxOrder (FiniteArchimedeanClass G)] + [Field K] [CharZero K] + +/-- An ordered exponent group that is Cauchy complete and has no smallest nonzero magnitude has +four-factor refinement modulo series bounded away from zero. -/ +@[blueprint "thm:complete-hahn-germ-refinement" + (phase := "Refinement over Archimedean classes") + (title := "Four-factor refinement in the germ ring over a Cauchy-complete exponent group") + (statement := /-- + Under the hypotheses of + \ref{thm:complete-hahn-germ-polynomial-algebra}, if + $a,b,c,d\in K((G^{\le 0}))$ and $ab=cd$, then there are + $e,f,g,h\in K((G^{\le 0}))$ such that, modulo series whose support is + bounded strictly below zero, + \[ + a=ef,\qquad b=gh,\qquad c=eg,\qquad d=fh. + \] + -/) + (proof := /-- + By \ref{thm:complete-hahn-germ-polynomial-algebra}, the germ ring is a + polynomial ring over $K$, hence is a unique factorisation domain and has + the refinement property. Refine the four images in the quotient and + choose series representing the four factors. + -/)] +theorem exists_germ_refinement_of_complete_exponent_group + (a b c d : Nonpositive G K) (habcd : a * b = c * d) : + ∃ e f g h : Nonpositive G K, + (∃ r < (0 : G), ∀ q > r, + (a : HahnSeries G K).coeff q = (e * f : Nonpositive G K).1.coeff q) ∧ + (∃ r < (0 : G), ∀ q > r, + (b : HahnSeries G K).coeff q = (g * h : Nonpositive G K).1.coeff q) ∧ + (∃ r < (0 : G), ∀ q > r, + (c : HahnSeries G K).coeff q = (e * g : Nonpositive G K).1.coeff q) ∧ + (∃ r < (0 : G), ∀ q > r, + (d : HahnSeries G K).coeff q = (f * h : Nonpositive G K).1.coeff q) := by + let J := (cantorBendixsonValuation (G := G) (R := K)).supp + obtain ⟨ι, ⟨equiv⟩⟩ := exists_mvPolynomial_algEquiv_germ (G := G) (K := K) + letI : DecompositionMonoid (Nonpositive G K ⧸ J) := + MulEquiv.decompositionMonoid equiv.symm.toMulEquiv + have hrefinement : HasFourFactorRefinement (Nonpositive G K ⧸ J) := + hasFourFactorRefinement_of_decompositionMonoid + obtain ⟨qe, qf, qg, qh, heq, hfq, hgq, hhq⟩ := hrefinement.refine + (show Ideal.Quotient.mk J a * Ideal.Quotient.mk J b = + Ideal.Quotient.mk J c * Ideal.Quotient.mk J d by + simpa only [map_mul] using congrArg (Ideal.Quotient.mk J) habcd) + obtain ⟨e, rfl⟩ := Ideal.Quotient.mk_surjective qe + obtain ⟨f, rfl⟩ := Ideal.Quotient.mk_surjective qf + obtain ⟨g, rfl⟩ := Ideal.Quotient.mk_surjective qg + obtain ⟨h, rfl⟩ := Ideal.Quotient.mk_surjective qh + refine ⟨e, f, g, h, ?_, ?_, ?_, ?_⟩ + · exact cantorBendixson_germ_eq_iff a (e * f) |>.mp heq + · exact cantorBendixson_germ_eq_iff b (g * h) |>.mp hfq + · exact cantorBendixson_germ_eq_iff c (e * g) |>.mp hgq + · exact cantorBendixson_germ_eq_iff d (f * h) |>.mp hhq +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/ConvexRestrictionFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/ConvexRestrictionFactorization.lean new file mode 100644 index 0000000000..6102778947 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/ConvexRestrictionFactorization.lean @@ -0,0 +1,349 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupSupport +public import Mathlib.Algebra.Group.Subgroup.Order +public import Mathlib.Algebra.Order.Archimedean.Class +public import Mathlib.Order.Interval.Set.OrdConnected + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Divisibility descends from a convex restriction + +A divisor supported in a convex subgroup of the exponents divides a series as soon as it divides +the convex restriction: the discarded part has all its exponents nonpositive and outside the +subgroup, so multiplying it by the inverse of the divisor keeps every exponent nonpositive and +outside the subgroup, hence away from zero. The cofactor therefore stays in the integral part. + +This is the step by which a refinement obtained after restricting at a support class is +transported back to the original divisibility. +-/ + +public noncomputable section + +open scoped HahnSeries + +namespace HahnSeries.ConvexRestriction + +variable {G K : Type*} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Field K] + +private theorem add_nonpos_of_mem_of_nonpos_of_not_mem {C : AddSubgroup G} + (hC : (C : Set G).OrdConnected) {a b : G} + (ha : a ∈ C) (hb : b ≤ 0) (hbC : b ∉ C) : a + b ≤ 0 := by + by_contra h + have hab : 0 < a + b := lt_of_not_ge h + apply hbC + have hba : 0 < b + a := by simpa only [add_comm] using hab + exact hC.out (C.neg_mem ha) C.zero_mem ⟨(neg_lt_iff_pos_add.mpr hba).le, hb⟩ + +/-- Adding an exponent in a convex subgroup to one outside it preserves the outside exponent's +Archimedean class. -/ +private theorem archimedeanClass_add_eq_right_of_mem_of_not_mem {C : AddSubgroup G} + (hC : (C : Set G).OrdConnected) {i j : G} (hi : i ∈ C) (hj : j ∉ C) : + ArchimedeanClass.mk (i + j) = ArchimedeanClass.mk j := by + apply ArchimedeanClass.mk_add_eq_mk_right + rw [ArchimedeanClass.mk_lt_mk] + intro n + apply lt_of_not_ge + intro hji + have habsi : |i| ∈ C := abs_mem_iff.mpr hi + have hni : n • |i| ∈ C := C.nsmul_mem habsi n + have habsj : |j| ∈ C := hC.out C.zero_mem hni ⟨abs_nonneg j, hji⟩ + exact hj (abs_mem_iff.mp habsj) + +open Classical in +/-- **Truncation-divisibility.** A nonzero divisor supported in a convex subgroup divides a +series with nonpositive support as soon as it divides the convex restriction, and the cofactor +stays in the integral part: nonpositive support with constant coefficient in the coefficient +subring. The discarded part has all exponents outside the subgroup, so dividing it by the +subgroup-supported divisor keeps every exponent nonpositive and nonzero. -/ +private theorem exists_integral_cofactor {C : AddSubgroup G} + (hC : (C : Set G).OrdConnected) (Z : Subring K) + {q c w : K⟦G⟧} (hq : q.support ⊆ (C : Set G)) (hq0 : q ≠ 0) + (hc : c.support ⊆ Set.Iic 0) + (hw : w.support ⊆ Set.Iic 0) (hw0 : w.coeff 0 ∈ Z) + (heq : HahnSeries.filter (· ∈ C) c = q * w) : + ∃ w' : K⟦G⟧, w'.support ⊆ Set.Iic 0 ∧ w'.coeff 0 ∈ Z ∧ c = q * w' := by + classical + set r : K⟦G⟧ := HahnSeries.filter (fun g ↦ g ∉ C) c with hr + have hsplit : HahnSeries.filter (· ∈ C) c + r = c := HahnSeries.filter_add_filter_not _ c + have hrsupp : ∀ g ∈ r.support, g ≤ 0 ∧ g ∉ C := by + intro g hg + rw [hr, HahnSeries.support_filter] at hg + exact ⟨hc hg.1, hg.2⟩ + -- The inverse of the divisor stays supported in the subgroup. + have hone : (1 : K⟦G⟧).support ⊆ (C : Set G) := by + intro g hg + have hg0 : g = 0 := by + simpa only [HahnSeries.support_one, Set.mem_singleton_iff] using hg + exact hg0 ▸ C.zero_mem + have hinv : (q⁻¹ : K⟦G⟧).support ⊆ (C : Set G) := + HahnSeries.support_subset_of_mul_eq (f := (1 : K⟦G⟧)) hq hq0 hone + (mul_inv_cancel₀ hq0).symm + -- The discarded part divided by the divisor keeps nonpositive, nonzero exponents. + have hprod : ∀ g ∈ ((q⁻¹ : K⟦G⟧) * r).support, g ≤ 0 ∧ g ∉ C := by + intro g hg + obtain ⟨a, ha, b, hb, rfl⟩ := HahnSeries.support_mul_subset hg + obtain ⟨hb0, hbC⟩ := hrsupp b hb + refine ⟨add_nonpos_of_mem_of_nonpos_of_not_mem hC (hinv ha) hb0 hbC, ?_⟩ + intro hab + exact hbC (by simpa using C.sub_mem hab (hinv ha)) + refine ⟨w + q⁻¹ * r, ?_, ?_, ?_⟩ + · intro g hg + rcases HahnSeries.support_add_subset _ _ hg with h | h + · exact hw h + · exact (hprod g h).1 + · have hzero : ((q⁻¹ : K⟦G⟧) * r).coeff 0 = 0 := by + by_contra hne + exact (hprod 0 ((HahnSeries.mem_support _ _).mpr hne)).2 C.zero_mem + rw [HahnSeries.coeff_add, hzero, add_zero] + exact hw0 + · rw [mul_add, ← heq, ← mul_assoc, mul_inv_cancel₀ hq0, one_mul, hsplit] + +open Classical in +/-- **The class-block factorisation.** An integral series with a nonzero convex restriction is +that restriction times an integral series whose constant coefficient is one and whose remaining +exponents all lie outside the subgroup. An induction over support classes can therefore split an +integral series into blocks and, with primality of each block, conclude primality of the whole by +`IsPrimal.mul`. -/ +private theorem exists_complementary_factor {C : AddSubgroup G} + (hC : (C : Set G).OrdConnected) {b : K⟦G⟧} (hb : b.support ⊆ Set.Iic 0) + (hne : HahnSeries.filter (· ∈ C) b ≠ 0) : + ∃ w : K⟦G⟧, w.support ⊆ Set.Iic 0 ∧ w.coeff 0 = 1 ∧ + (∀ g ∈ w.support, g ≠ 0 → g ∉ C) ∧ + (∀ g ∈ w.support, g ≠ 0 → + ArchimedeanClass.mk g ∈ ArchimedeanClass.mk '' b.support) ∧ + b = HahnSeries.filter (· ∈ C) b * w := by + classical + set q : K⟦G⟧ := HahnSeries.filter (· ∈ C) b with hq_def + set r : K⟦G⟧ := HahnSeries.filter (fun g ↦ g ∉ C) b with hr_def + have hsplit : q + r = b := HahnSeries.filter_add_filter_not _ b + have hqC : q.support ⊆ (C : Set G) := by + intro g hg + rw [hq_def, HahnSeries.support_filter] at hg + exact hg.2 + have hrsupp : ∀ g ∈ r.support, g ≤ 0 ∧ g ∉ C := by + intro g hg + rw [hr_def, HahnSeries.support_filter] at hg + exact ⟨hb hg.1, hg.2⟩ + have hone : (1 : K⟦G⟧).support ⊆ (C : Set G) := by + intro g hg + have hg0 : g = 0 := by + simpa only [HahnSeries.support_one, Set.mem_singleton_iff] using hg + exact hg0 ▸ C.zero_mem + have hinv : (q⁻¹ : K⟦G⟧).support ⊆ (C : Set G) := + HahnSeries.support_subset_of_mul_eq (f := (1 : K⟦G⟧)) hqC hne hone + (mul_inv_cancel₀ hne).symm + have hprod : ∀ g ∈ ((q⁻¹ : K⟦G⟧) * r).support, g ≤ 0 ∧ g ∉ C := by + intro g hg + obtain ⟨a, ha, c', hc', rfl⟩ := HahnSeries.support_mul_subset hg + obtain ⟨hc0, hcC⟩ := hrsupp c' hc' + refine ⟨add_nonpos_of_mem_of_nonpos_of_not_mem hC (hinv ha) hc0 hcC, ?_⟩ + intro hab + exact hcC (by simpa using C.sub_mem hab (hinv ha)) + have hzero : ((q⁻¹ : K⟦G⟧) * r).coeff 0 = 0 := by + by_contra hnz + exact (hprod 0 ((HahnSeries.mem_support _ _).mpr hnz)).2 C.zero_mem + refine ⟨1 + q⁻¹ * r, ?_, ?_, ?_, ?_, ?_⟩ + · intro g hg + rcases HahnSeries.support_add_subset _ _ hg with h | h + · have hg0 : g = 0 := by + simpa only [HahnSeries.support_one, Set.mem_singleton_iff] using h + exact hg0 ▸ Set.mem_Iic.mpr le_rfl + · exact Set.mem_Iic.mpr (hprod g h).1 + · rw [HahnSeries.coeff_add, HahnSeries.coeff_one, if_pos rfl, hzero, add_zero] + · intro g hg hg0 + rcases HahnSeries.support_add_subset _ _ hg with h | h + · exact absurd (by + simpa only [HahnSeries.support_one, Set.mem_singleton_iff] using h) hg0 + · exact (hprod g h).2 + · intro g hg hg0 + rcases HahnSeries.support_add_subset _ _ hg with h | h + · exact absurd (by + simpa only [HahnSeries.support_one, Set.mem_singleton_iff] using h) hg0 + · obtain ⟨i, hi, j, hj, hij⟩ := HahnSeries.support_mul_subset h + have hiC : i ∈ C := hinv hi + have hjr : j ∈ r.support := hj + have hjb : j ∈ b.support := by + rw [hr_def, HahnSeries.support_filter] at hjr + exact hjr.1 + have hjC : j ∉ C := (hrsupp j hj).2 + refine ⟨j, hjb, ?_⟩ + rw [← hij] + exact (archimedeanClass_add_eq_right_of_mem_of_not_mem hC hiC hjC).symm + · rw [mul_add, mul_one, ← mul_assoc, mul_inv_cancel₀ hne, one_mul, hsplit] + +end HahnSeries.ConvexRestriction + +namespace HahnSeries.CardSuppLTTruncationIntegerPart + +open Cardinal + +variable {G K : Type*} {κ : Cardinal} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Field K] [Fact (aleph0 < κ)] + +/-- Restrict a bounded truncation-integer-part series to an exponent subgroup. -/ +def restrictToAddSubgroup (Z : Subring K) (C : AddSubgroup G) + (x : HahnSeries.cardSuppLTTruncationIntegerPart (G := G) (R := K) (κ := κ) Z) : + HahnSeries.cardSuppLTTruncationIntegerPart (G := G) (R := K) (κ := κ) Z := by + classical + let xf : HahnSeries.CardSuppLTField (G := G) (R := K) (κ := κ) := + ⟨HahnSeries.filter (· ∈ C) (x : K⟦G⟧), + (HahnSeries.mem_cardSuppLTSubfield (Γ := G) (R := K) (κ := κ)).mpr + ((HahnSeries.cardSupp_mono (HahnSeries.support_filter_subset _ _)).trans_lt x.1.2)⟩ + have hxmem := (HahnSeries.mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp x.2 + exact ⟨xf, by + rw [HahnSeries.mem_cardSuppLTTruncationIntegerPart] + refine ⟨(HahnSeries.support_filter_subset _ _).trans hxmem.1, ?_⟩ + change (HahnSeries.filter (· ∈ C) (x : K⟦G⟧)).coeff 0 ∈ Z + rw [HahnSeries.coeff_filter, if_pos C.zero_mem] + exact hxmem.2⟩ + +open Classical in +/-- The subgroup restriction package has the expected underlying Hahn series. -/ +@[simp] +theorem coe_restrictToAddSubgroup (Z : Subring K) (C : AddSubgroup G) + (x : HahnSeries.cardSuppLTTruncationIntegerPart (G := G) (R := K) (κ := κ) Z) : + (restrictToAddSubgroup Z C x : K⟦G⟧) = HahnSeries.filter (· ∈ C) (x : K⟦G⟧) := + (rfl) + +open Classical in +/-- A nonzero bounded integer-part factor supported in a convex subgroup divides an ambient +bounded integer-part series as soon as it factors the convex restriction. -/ +@[blueprint "lem:divisibility-from-convex-restriction" + (phase := "Refinement over Archimedean classes") + (title := "Divisibility from a convex restriction") + (statement := /-- + Let $C$ be a convex subgroup of an ordered abelian group $G$, and let + $q,w,x\in Z+K((G^{<0}))_\kappa$. Suppose $q\ne0$, + $\operatorname{supp}(q)\subseteq C$, and + \[ + x_{\vert C}=qw. + \] + Then $q\mid x$ in $Z+K((G^{<0}))_\kappa$. + -/) + (proof := /-- + Divide $x$ by $q$ in the bounded Hahn field. On $C$ the quotient is $w$. + Outside $C$, convexity and nonpositivity keep every exponent of the + quotient strictly negative; the constant coefficient is therefore the + constant coefficient of $w$ and lies in $Z$. Hence the quotient belongs + to the bounded Hahn integer part. + -/)] +theorem dvd_of_restriction_factorization + (Z : Subring K) {C : AddSubgroup G} (hC : (C : Set G).OrdConnected) + (q w x : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := K) (κ := κ) Z) + (hqsupp : (q : K⟦G⟧).support ⊆ (C : Set G)) (hq0 : q ≠ 0) + (heq : HahnSeries.filter (· ∈ C) (x : K⟦G⟧) = (q * w : K⟦G⟧)) : + q ∣ x := by + have hqraw : (q : K⟦G⟧) ≠ 0 := fun h ↦ hq0 (Subtype.ext (Subtype.ext h)) + have hxmem := (HahnSeries.mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp x.2 + have hwmem := (HahnSeries.mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp w.2 + obtain ⟨v, hv, hv0, hxv⟩ := + HahnSeries.ConvexRestriction.exists_integral_cofactor hC Z hqsupp hqraw + hxmem.1 hwmem.1 hwmem.2 heq + let vf : HahnSeries.CardSuppLTField (G := G) (R := K) (κ := κ) := + (x : HahnSeries.CardSuppLTField (G := G) (R := K) (κ := κ)) / + (q : HahnSeries.CardSuppLTField (G := G) (R := K) (κ := κ)) + have hvraw : (vf : K⟦G⟧) = v := by + change (x : K⟦G⟧) / (q : K⟦G⟧) = v + rw [hxv, mul_comm, mul_div_assoc, div_self hqraw, mul_one] + let vI : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := K) (κ := κ) Z := ⟨vf, by + rw [HahnSeries.mem_cardSuppLTTruncationIntegerPart, hvraw] + exact ⟨hv, hv0⟩⟩ + refine ⟨vI, ?_⟩ + apply Subtype.ext + change (x : HahnSeries.CardSuppLTField (G := G) (R := K) (κ := κ)) = + (q : HahnSeries.CardSuppLTField (G := G) (R := K) (κ := κ)) * vf + have hqfield : (q : HahnSeries.CardSuppLTField (G := G) (R := K) (κ := κ)) ≠ 0 := + fun h ↦ hq0 (Subtype.ext h) + rw [mul_comm, div_mul_cancel₀ _ hqfield] + +open Classical in +/-- Factor a bounded truncation-integer-part series by its nonzero restriction to a convex +exponent subgroup. The complementary factor remains bounded, has constant coefficient one, and +all its nonzero support exponents lie outside the subgroup in classes met by the original +support. -/ +@[blueprint "lem:factorisation-by-convex-restriction" + (phase := "Refinement over Archimedean classes") + (title := "Factorisation by a convex restriction") + (statement := /-- + Let $C$ be a convex subgroup of an ordered abelian group $G$, and let + $b\in Z+K((G^{<0}))_\kappa$ have nonzero restriction $t=b_{\vert C}$. + Then + \[ + b=tw + \] + for some $w\in Z+K((G^{<0}))_\kappa$ with constant coefficient $1$. + Every nonzero exponent in $\operatorname{supp}(w)$ lies outside $C$, and + its Archimedean class is met by $\operatorname{supp}(b)$. + -/) + (proof := /-- + Divide $b$ by its nonzero restriction $t$ in the bounded Hahn field. The + quotient has constant coefficient $1$. Convexity separates the discarded + support from $C$; the Hahn inverse expansion shows that each class appearing + in the quotient already appears in the support of $b$. Thus the quotient + remains in the bounded Hahn integer part and has the stated support. + -/)] +theorem exists_factorization_by_restriction + (Z : Subring K) {C : AddSubgroup G} (hC : (C : Set G).OrdConnected) + (b : HahnSeries.cardSuppLTTruncationIntegerPart (G := G) (R := K) (κ := κ) Z) + (hne : HahnSeries.filter (· ∈ C) (b : K⟦G⟧) ≠ 0) : + ∃ t w : HahnSeries.cardSuppLTTruncationIntegerPart (G := G) (R := K) (κ := κ) Z, + (t : K⟦G⟧) = HahnSeries.filter (· ∈ C) (b : K⟦G⟧) ∧ + b = t * w ∧ + (w : K⟦G⟧).coeff 0 = 1 ∧ + (∀ g ∈ (w : K⟦G⟧).support, g ≠ 0 → g ∉ C) ∧ + (∀ g ∈ (w : K⟦G⟧).support, g ≠ 0 → + ArchimedeanClass.mk g ∈ ArchimedeanClass.mk '' (b : K⟦G⟧).support) := by + have hbmem := (HahnSeries.mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp b.2 + obtain ⟨wraw, hws, hw0, hwC, hwocc, hfac⟩ := + HahnSeries.ConvexRestriction.exists_complementary_factor hC hbmem.1 hne + let tf : HahnSeries.CardSuppLTField (G := G) (R := K) (κ := κ) := + ⟨HahnSeries.filter (· ∈ C) (b : K⟦G⟧), + (HahnSeries.mem_cardSuppLTSubfield (Γ := G) (R := K) (κ := κ)).mpr + ((HahnSeries.cardSupp_mono (HahnSeries.support_filter_subset _ _)).trans_lt b.1.2)⟩ + have ht0 : (tf : K⟦G⟧).coeff 0 = (b : K⟦G⟧).coeff 0 := by + rw [HahnSeries.coeff_filter, if_pos C.zero_mem] + let t : HahnSeries.cardSuppLTTruncationIntegerPart (G := G) (R := K) (κ := κ) Z := + ⟨tf, by + rw [HahnSeries.mem_cardSuppLTTruncationIntegerPart] + exact ⟨(HahnSeries.support_filter_subset _ _).trans hbmem.1, ht0 ▸ hbmem.2⟩⟩ + have htfield0 : (t : HahnSeries.CardSuppLTField (G := G) (R := K) (κ := κ)) ≠ 0 := by + intro ht + apply hne + exact congrArg (fun z : HahnSeries.CardSuppLTField + (G := G) (R := K) (κ := κ) ↦ (z : K⟦G⟧)) ht + let wf : HahnSeries.CardSuppLTField (G := G) (R := K) (κ := κ) := + (b : HahnSeries.CardSuppLTField (G := G) (R := K) (κ := κ)) / + (t : HahnSeries.CardSuppLTField (G := G) (R := K) (κ := κ)) + have hwraw : (wf : K⟦G⟧) = wraw := by + change (b : K⟦G⟧) / (t : K⟦G⟧) = wraw + rw [hfac, mul_comm, mul_div_assoc, div_self] + · exact mul_one _ + · intro ht + apply htfield0 + exact Subtype.ext ht + let w : HahnSeries.cardSuppLTTruncationIntegerPart (G := G) (R := K) (κ := κ) Z := + ⟨wf, by + rw [HahnSeries.mem_cardSuppLTTruncationIntegerPart, hwraw] + exact ⟨hws, hw0 ▸ Z.one_mem⟩⟩ + refine ⟨t, w, rfl, ?_, ?_, ?_, ?_⟩ + · apply Subtype.ext + change (b : HahnSeries.CardSuppLTField (G := G) (R := K) (κ := κ)) = + (t : HahnSeries.CardSuppLTField (G := G) (R := K) (κ := κ)) * wf + rw [mul_comm, div_mul_cancel₀ _ htfield0] + · simpa only [w, hwraw] using hw0 + · simpa only [w, hwraw] using hwC + · simpa only [w, hwraw] using hwocc + +end HahnSeries.CardSuppLTTruncationIntegerPart diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/FiniteGermError.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/FiniteGermError.lean new file mode 100644 index 0000000000..39159ee370 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/FiniteGermError.lean @@ -0,0 +1,337 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Germ +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportArchimedeanClasses +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement + +/-! +# Killing finitely many Hahn-series germ errors at one Archimedean class + +An error that vanishes as a germ at zero is supported below some strictly negative exponent. +Its Archimedean classes are therefore bounded above by the class of that exponent. Restriction +to the closed ball at any strictly later finite Archimedean class kills the error exactly. + +For finitely many germ errors, one class works simultaneously. If `T` is a cofinal set of finite +classes, first take a common upper bound for the finitely many error bounds, then move strictly +above it and into `T`. This is the finite-error restriction used in the Conway limit step; it +does not choose a compatible infinite family of restrictions. +-/ + +open Set + +universe u v + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {R : Type v} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [CommRing R] + +public noncomputable section + +open Classical in +/-- The four errors measuring whether chosen representatives satisfy the four refinement +equations before passing to the quotient by series bounded strictly below zero. -/ +def fourFactorErrors (a b c d e f g h : Nonpositive G R) : Finset (Nonpositive G R) := + {a - e * f, b - g * h, c - e * g, d - f * h} + +/-- Equality of the four refinement equations in the germ quotient puts every representative +error in the valuation support ideal. -/ +theorem fourFactorErrors_mem_supp + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] + [CompleteSpace G] [NoMinOrder G] [NoZeroDivisors R] [CharZero R] + {a b c d e f g h : Nonpositive G R} + (ha : Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp a = + Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp (e * f)) + (hb : Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp b = + Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp (g * h)) + (hc : Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp c = + Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp (e * g)) + (hd : Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp d = + Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp (f * h)) : + ∀ z ∈ fourFactorErrors a b c d e f g h, + z ∈ (cantorBendixsonValuation (G := G) (R := R)).supp := by + intro z hz + simp only [fourFactorErrors, Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl | rfl | rfl + · exact Ideal.Quotient.eq.mp ha + · exact Ideal.Quotient.eq.mp hb + · exact Ideal.Quotient.eq.mp hc + · exact Ideal.Quotient.eq.mp hd + +open Classical in +/-- Restriction of a nonpositive Hahn series to the closed ball at a finite Archimedean class. -/ +def closedClassRestrict (c : FiniteArchimedeanClass G) + (b : Nonpositive G R) : Nonpositive G R := + ⟨HahnSeries.filter (· ∈ FiniteArchimedeanClass.closedBallAddSubgroup c) + (b : HahnSeries G R), (HahnSeries.support_filter_subset _ _).trans b.property⟩ + +open Classical in +/-- The coefficient formula for restriction to a closed Archimedean ball. -/ +@[simp] +theorem closedClassRestrict_coeff (c : FiniteArchimedeanClass G) (b : Nonpositive G R) (g : G) : + ((closedClassRestrict c b : Nonpositive G R) : HahnSeries G R).coeff g = + if g ∈ FiniteArchimedeanClass.closedBallAddSubgroup c then + (b : HahnSeries G R).coeff g else 0 := by + rw [closedClassRestrict, HahnSeries.coeff_filter] + +/-- Closed-class restriction cannot introduce a new support exponent. -/ +theorem support_closedClassRestrict_subset (c : FiniteArchimedeanClass G) + (b : Nonpositive G R) : + ((closedClassRestrict c b : Nonpositive G R) : HahnSeries G R).support ⊆ + (b : HahnSeries G R).support := by + intro g hg + rw [HahnSeries.mem_support] at hg ⊢ + rw [closedClassRestrict_coeff] at hg + split at hg + · exact hg + · exact (hg rfl).elim + +/-- Restriction at an Archimedean class met by the support is nonzero. -/ +theorem closedClassRestrict_ne_zero_of_mem_image_mk_support + (c : FiniteArchimedeanClass G) (b : Nonpositive G R) + (hc : c.1 ∈ ArchimedeanClass.mk '' (b : HahnSeries G R).support) : + closedClassRestrict c b ≠ 0 := by + classical + obtain ⟨g, hg, hgc⟩ := hc + intro hzero + have hcoeff := congrArg (fun x : Nonpositive G R ↦ (x : HahnSeries G R).coeff g) hzero + rw [closedClassRestrict_coeff, if_pos] at hcoeff + · exact (HahnSeries.mem_support _ _).mp hg hcoeff + · apply (FiniteArchimedeanClass.mem_closedBallAddSubgroup_iff).mpr + intro hg0 + change c.1 ≤ ArchimedeanClass.mk g + rw [hgc] + +/-- Restriction to a closed Archimedean ball preserves subtraction. -/ +theorem closedClassRestrict_sub (c : FiniteArchimedeanClass G) (a b : Nonpositive G R) : + closedClassRestrict c (a - b) = closedClassRestrict c a - closedClassRestrict c b := by + classical + apply Subtype.ext + ext g + change (HahnSeries.filter (· ∈ FiniteArchimedeanClass.closedBallAddSubgroup c) + ((a - b : Nonpositive G R) : HahnSeries G R)).coeff g = + ((closedClassRestrict c a : Nonpositive G R) : HahnSeries G R).coeff g - + ((closedClassRestrict c b : Nonpositive G R) : HahnSeries G R).coeff g + rw [HahnSeries.coeff_filter] + change (if g ∈ FiniteArchimedeanClass.closedBallAddSubgroup c then + ((a : HahnSeries G R) - (b : HahnSeries G R)).coeff g else 0) = _ + rw [HahnSeries.coeff_sub] + change _ = + (HahnSeries.filter (· ∈ FiniteArchimedeanClass.closedBallAddSubgroup c) + (a : HahnSeries G R)).coeff g - + (HahnSeries.filter (· ∈ FiniteArchimedeanClass.closedBallAddSubgroup c) + (b : HahnSeries G R)).coeff g + rw [HahnSeries.coeff_filter, HahnSeries.coeff_filter] + split_ifs <;> simp_all + +/-- Restriction to a closed Archimedean ball preserves multiplication of nonpositive series. -/ +theorem closedClassRestrict_mul (c : FiniteArchimedeanClass G) (a b : Nonpositive G R) : + closedClassRestrict c (a * b) = closedClassRestrict c a * closedClassRestrict c b := by + classical + apply Subtype.ext + ext g + rw [closedClassRestrict, HahnSeries.coeff_filter] + change (if g ∈ FiniteArchimedeanClass.closedBallAddSubgroup c then + ((a : HahnSeries G R) * (b : HahnSeries G R)).coeff g else 0) = _ + rw [HahnSeries.coeff_mul] + change _ = ((HahnSeries.filter + (· ∈ FiniteArchimedeanClass.closedBallAddSubgroup c) (a : HahnSeries G R)) * + HahnSeries.filter (· ∈ FiniteArchimedeanClass.closedBallAddSubgroup c) + (b : HahnSeries G R)).coeff g + rw [HahnSeries.coeff_mul] + let C := FiniteArchimedeanClass.closedBallAddSubgroup c + have hC : (C : Set G).OrdConnected := by + constructor + intro x hx y hy z hz + change x ∈ FiniteArchimedeanClass.closedBallAddSubgroup c at hx + change y ∈ FiniteArchimedeanClass.closedBallAddSubgroup c at hy + change z ∈ FiniteArchimedeanClass.closedBallAddSubgroup c + rw [FiniteArchimedeanClass.mem_closedBallAddSubgroup_iff] at hx hy ⊢ + intro hz0 + have hx' : c.1 ≤ ArchimedeanClass.mk x := by + by_cases hx0 : x = 0 + · simp [hx0] + · exact hx hx0 + have hy' : c.1 ≤ ArchimedeanClass.mk y := by + by_cases hy0 : y = 0 + · simp [hy0] + · exact hy hy0 + exact (le_min hx' hy').trans + (ArchimedeanClass.min_le_mk_of_le_of_le hz.1 hz.2) + have hsub : Finset.addAntidiagonal + (HahnSeries.filter (· ∈ C) (a : HahnSeries G R)).isPWO_support + (HahnSeries.filter (· ∈ C) (b : HahnSeries G R)).isPWO_support g ⊆ + Finset.addAntidiagonal (a : HahnSeries G R).isPWO_support + (b : HahnSeries G R).isPWO_support g := by + intro p hp + rw [Finset.mem_addAntidiagonal] at hp ⊢ + exact ⟨HahnSeries.support_filter_subset _ _ hp.1, + HahnSeries.support_filter_subset _ _ hp.2.1, hp.2.2⟩ + by_cases hg : g ∈ C + · rw [if_pos hg] + refine Finset.sum_congr ?_ ?_ + · apply Finset.Subset.antisymm _ hsub + intro p hp + rw [Finset.mem_addAntidiagonal] at hp ⊢ + have hp1le : p.1 ≤ 0 := a.property hp.1 + have hp2le : p.2 ≤ 0 := b.property hp.2.1 + have hgp1 : g ≤ p.1 := by + rw [← hp.2.2] + simpa using add_le_add_left hp2le p.1 + have hp1C : p.1 ∈ C := hC.out hg C.zero_mem ⟨hgp1, hp1le⟩ + have hp2C : p.2 ∈ C := by simpa [← hp.2.2] using C.sub_mem hg hp1C + exact ⟨by simpa only [HahnSeries.support_filter, Set.mem_setOf_eq] using + And.intro hp.1 hp1C, + by simpa only [HahnSeries.support_filter, Set.mem_setOf_eq] using + And.intro hp.2.1 hp2C, hp.2.2⟩ + · intro p hp + rw [Finset.mem_addAntidiagonal, HahnSeries.support_filter, + HahnSeries.support_filter] at hp + simp only [HahnSeries.coeff_filter, if_pos hp.1.2, if_pos hp.2.1.2] + · rw [if_neg hg] + refine (Finset.sum_eq_zero fun p hp ↦ ?_).symm + rw [Finset.mem_addAntidiagonal, HahnSeries.support_filter, + HahnSeries.support_filter] at hp + exact (hg (hp.2.2 ▸ C.add_mem hp.1.2 hp.2.1.2)).elim + +/-- Restriction at a class strictly above the class of a negative support bound is zero. -/ +theorem closedClassRestrict_eq_zero_of_support_subset_Iic + {e : G} (he : e < 0) {c : FiniteArchimedeanClass G} + (hec : FiniteArchimedeanClass.mk e he.ne < c) {b : Nonpositive G R} + (hb : (b : HahnSeries G R).support ⊆ Iic e) : + closedClassRestrict c b = 0 := by + classical + apply Subtype.ext + ext g + rw [closedClassRestrict, HahnSeries.coeff_filter] + split_ifs with hg + · by_contra hcoeff + have hgs : g ∈ (b : HahnSeries G R).support := HahnSeries.mem_support _ _ |>.mpr hcoeff + have hg0 : g ≠ 0 := fun h ↦ (not_le_of_gt he) (h ▸ hb hgs) + have hcg := (FiniteArchimedeanClass.mem_closedBallAddSubgroup_iff).mp hg hg0 + have hge := ArchimedeanClass.mk_le_mk_of_le_of_nonpos (hb hgs) he.le + exact (not_le_of_gt hec) (hcg.trans hge) + · rfl + +/-- One class in a cofinal set kills any finite family of explicitly bounded germ errors. -/ +theorem exists_closedClassRestrict_eq_zero_of_finset + [Nontrivial G] [NoMaxOrder (FiniteArchimedeanClass G)] + {s : Finset (Nonpositive G R)} + (e : Nonpositive G R → G) (he : ∀ b ∈ s, e b < 0) + (hbe : ∀ b ∈ s, (b : HahnSeries G R).support ⊆ Iic (e b)) + {T : Set (FiniteArchimedeanClass G)} (hT : IsCofinal T) : + ∃ c ∈ T, ∀ b ∈ s, closedClassRestrict c b = 0 := by + classical + let f : s → FiniteArchimedeanClass G := fun b ↦ + FiniteArchimedeanClass.mk (e b) (he b b.2).ne + obtain ⟨a, ha⟩ := Finset.exists_le (Finset.univ.image f) + obtain ⟨a', haa'⟩ := exists_gt a + obtain ⟨d, hdT, ha'd⟩ := hT a' + refine ⟨d, hdT, fun b hb ↦ ?_⟩ + have hba : FiniteArchimedeanClass.mk (e b) (he b hb).ne ≤ a := + ha _ (Finset.mem_image.mpr ⟨⟨b, hb⟩, Finset.mem_univ _, rfl⟩) + exact closedClassRestrict_eq_zero_of_support_subset_Iic (he b hb) + (hba.trans_lt (haa'.trans_le ha'd)) (hbe b hb) + +/-- One class in a cofinal set kills any finite family of errors that vanish in the +quotient by series bounded strictly below zero. -/ +theorem exists_closedClassRestrict_eq_zero_of_finset_mem_supp + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] + [CompleteSpace G] [NoMinOrder G] [NoMaxOrder (FiniteArchimedeanClass G)] + [NoZeroDivisors R] [CharZero R] + {s : Finset (Nonpositive G R)} + (hs : ∀ b ∈ s, b ∈ (cantorBendixsonValuation (G := G) (R := R)).supp) + {T : Set (FiniteArchimedeanClass G)} (hT : IsCofinal T) : + ∃ c ∈ T, ∀ b ∈ s, closedClassRestrict c b = 0 := by + classical + choose e he hbe using fun b : s ↦ + (mem_cantorBendixsonValuation_supp (b : Nonpositive G R)).mp (hs b.1 b.2) + let f : s → FiniteArchimedeanClass G := fun b ↦ + FiniteArchimedeanClass.mk (e b) (he b).ne + obtain ⟨a, ha⟩ := Finset.exists_le (Finset.univ.image f) + obtain ⟨a', haa'⟩ := exists_gt a + obtain ⟨d, hdT, ha'd⟩ := hT a' + refine ⟨d, hdT, fun b hb ↦ ?_⟩ + let b' : s := ⟨b, hb⟩ + have hba : FiniteArchimedeanClass.mk (e b') (he b').ne ≤ a := + ha _ (Finset.mem_image.mpr ⟨b', Finset.mem_univ _, rfl⟩) + exact closedClassRestrict_eq_zero_of_support_subset_Iic (he b') + (hba.trans_lt (haa'.trans_le ha'd)) (hbe b') + +/-- Four refinement equations holding as germs hold exactly after restricting all representatives +at one sufficiently late class from any cofinal family. -/ +theorem exists_closedClassRestrict_fourFactor_eq + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] + [CompleteSpace G] [NoMinOrder G] [NoMaxOrder (FiniteArchimedeanClass G)] + [NoZeroDivisors R] [CharZero R] + {a b c d e f g h : Nonpositive G R} + (ha : Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp a = + Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp (e * f)) + (hb : Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp b = + Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp (g * h)) + (hc : Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp c = + Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp (e * g)) + (hd : Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp d = + Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp (f * h)) + {T : Set (FiniteArchimedeanClass G)} (hT : IsCofinal T) : + ∃ q ∈ T, + closedClassRestrict q a = closedClassRestrict q (e * f) ∧ + closedClassRestrict q b = closedClassRestrict q (g * h) ∧ + closedClassRestrict q c = closedClassRestrict q (e * g) ∧ + closedClassRestrict q d = closedClassRestrict q (f * h) := by + obtain ⟨q, hqT, hq⟩ := exists_closedClassRestrict_eq_zero_of_finset_mem_supp + (fourFactorErrors_mem_supp ha hb hc hd) hT + refine ⟨q, hqT, ?_, ?_, ?_, ?_⟩ + · have := hq (a - e * f) (by simp [fourFactorErrors]) + rw [closedClassRestrict_sub, sub_eq_zero] at this + exact this + · have := hq (b - g * h) (by simp [fourFactorErrors]) + rw [closedClassRestrict_sub, sub_eq_zero] at this + exact this + · have := hq (c - e * g) (by simp [fourFactorErrors]) + rw [closedClassRestrict_sub, sub_eq_zero] at this + exact this + · have := hq (d - f * h) (by simp [fourFactorErrors]) + rw [closedClassRestrict_sub, sub_eq_zero] at this + exact this + +/-- Four-factor refinement in the germ quotient yields an exact refinement after one sufficiently +late closed-class restriction. -/ +theorem exists_closedClassRestrict_refinement + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] + [CompleteSpace G] [NoMinOrder G] [NoMaxOrder (FiniteArchimedeanClass G)] + [NoZeroDivisors R] [CharZero R] + (hrefine : HasFourFactorRefinement + (Nonpositive G R ⧸ (cantorBendixsonValuation (G := G) (R := R)).supp)) + {a b c d : Nonpositive G R} (habcd : a * b = c * d) + {T : Set (FiniteArchimedeanClass G)} (hT : IsCofinal T) : + ∃ q ∈ T, ∃ e f g h : Nonpositive G R, + closedClassRestrict q a = closedClassRestrict q e * closedClassRestrict q f ∧ + closedClassRestrict q b = closedClassRestrict q g * closedClassRestrict q h ∧ + closedClassRestrict q c = closedClassRestrict q e * closedClassRestrict q g ∧ + closedClassRestrict q d = closedClassRestrict q f * closedClassRestrict q h := by + let J := (cantorBendixsonValuation (G := G) (R := R)).supp + have hquot : Ideal.Quotient.mk J a * Ideal.Quotient.mk J b = + Ideal.Quotient.mk J c * Ideal.Quotient.mk J d := by + simpa only [map_mul] using congrArg (Ideal.Quotient.mk J) habcd + obtain ⟨e', f', g', h', ha, hb, hc, hd⟩ := hrefine.refine hquot + obtain ⟨e, rfl⟩ := Ideal.Quotient.mk_surjective e' + obtain ⟨f, rfl⟩ := Ideal.Quotient.mk_surjective f' + obtain ⟨g, rfl⟩ := Ideal.Quotient.mk_surjective g' + obtain ⟨h, rfl⟩ := Ideal.Quotient.mk_surjective h' + obtain ⟨q, hqT, hqa, hqb, hqc, hqd⟩ := + exists_closedClassRestrict_fourFactor_eq ha hb hc hd hT + refine ⟨q, hqT, e, f, g, h, ?_, ?_, ?_, ?_⟩ + · rwa [closedClassRestrict_mul] at hqa + · rwa [closedClassRestrict_mul] at hqb + · rwa [closedClassRestrict_mul] at hqc + · rwa [closedClassRestrict_mul] at hqd + +end + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/LimitTailRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/LimitTailRefinement.lean new file mode 100644 index 0000000000..18253a8e80 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/LimitTailRefinement.lean @@ -0,0 +1,286 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.LimitTailQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalGermRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexQuotientSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.FiniteGermError + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Cauchy-complete common-tail quotients + +A family of finite Archimedean classes determines a common convex tail and an ordered rational +quotient. This file gives that quotient its order topology and proves refinement when the quotient +is Cauchy complete for its additive uniformity. The resulting refinement is exact after +restriction at a coinitial family of quotient Archimedean classes in the magnitude order. +-/ + +open Cardinal Set + +universe u + +public noncomputable section + + + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type*} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module ℚ G] [PosSMulMono ℚ G] + [Field K] [CharZero K] + +/-- Cauchy completeness of a common-tail quotient gives cardinal-bounded local refinement. -/ +@[blueprint "thm:complete-tail-quotient-refinement" + (phase := "Refinement over Archimedean classes") + (title := "Exact refinement over a Cauchy-complete common-tail quotient") + (statement := /-- + Let $T$ be a nonempty set of nonzero Archimedean classes with no least + member in the magnitude order, and let $C$ be the quotient of the exponent + group by the common tail below $T$. Assume that $C$ is Cauchy complete for + its additive uniformity and that $T$ has cardinality less than $\kappa$. + For every equation $ab=cd$ among four $\kappa$-bounded series in + $K((C^{\le0}))$ and every set $U$ of nonzero Archimedean classes of $C$ + coinitial in the magnitude order, there is $q\in U$ and a $\kappa$-bounded + four-factor refinement whose four equations hold exactly after restriction + to the closed ball of $q$. + -/) + (proof := /-- + Positive representatives of the classes in $T$ give a positive coinitial + subset of $C$ of cardinality less than $\kappa$. Apply + \ref{thm:cardinal-bounded-germ-refinement}; each of its four equations has + an error supported strictly below zero. Coinitiality of $U$ in the + magnitude order supplies a class $q$ smaller in magnitude than all four + errors, so closed-ball restriction makes the four equations exact + simultaneously. + -/)] +theorem exists_closed_class_refinement_of_complete_tail_quotient + {κ : Cardinal.{u}} [Fact (ℵ₀ < κ)] + (T : Set (FiniteArchimedeanClass G)) [Nonempty T] + (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) + [CompleteSpace (FiniteArchimedeanClass.TailQuotient T)] + (hTcard : #T < κ) + (a b c d : Nonpositive (FiniteArchimedeanClass.TailQuotient T) K) + (ha : (a : HahnSeries (FiniteArchimedeanClass.TailQuotient T) K).cardSupp < κ) + (hb : (b : HahnSeries (FiniteArchimedeanClass.TailQuotient T) K).cardSupp < κ) + (hc : (c : HahnSeries (FiniteArchimedeanClass.TailQuotient T) K).cardSupp < κ) + (hd : (d : HahnSeries (FiniteArchimedeanClass.TailQuotient T) K).cardSupp < κ) + (habcd : a * b = c * d) + {U : Set (FiniteArchimedeanClass (FiniteArchimedeanClass.TailQuotient T))} + (hU : IsCofinal U) : + ∃ q ∈ U, ∃ e f g h : Nonpositive (FiniteArchimedeanClass.TailQuotient T) K, + closedClassRestrict q a = closedClassRestrict q e * closedClassRestrict q f ∧ + closedClassRestrict q b = closedClassRestrict q g * closedClassRestrict q h ∧ + closedClassRestrict q c = closedClassRestrict q e * closedClassRestrict q g ∧ + closedClassRestrict q d = closedClassRestrict q f * closedClassRestrict q h ∧ + (e : HahnSeries (FiniteArchimedeanClass.TailQuotient T) K).cardSupp < κ ∧ + (f : HahnSeries (FiniteArchimedeanClass.TailQuotient T) K).cardSupp < κ ∧ + (g : HahnSeries (FiniteArchimedeanClass.TailQuotient T) K).cardSupp < κ ∧ + (h : HahnSeries (FiniteArchimedeanClass.TailQuotient T) K).cardSupp < κ := by + let C := FiniteArchimedeanClass.TailQuotient T + let scale : T → C := fun c ↦ + Submodule.Quotient.mk (FiniteArchimedeanClass.positiveRepresentative c.1) + have hscalePos (c : T) : 0 < scale c := by + rw [← Submodule.Quotient.mk_zero] + apply ConvexQuotient.mk_lt_mk_iff.mpr + refine ⟨FiniteArchimedeanClass.positiveRepresentative_pos c.1, ?_⟩ + intro hmem + have htail : FiniteArchimedeanClass.positiveRepresentative c.1 ∈ + FiniteArchimedeanClass.tailKernel T := by + rw [← FiniteArchimedeanClass.tailSubmodule_toAddSubgroup ℚ T] + simpa using hmem + exact FiniteArchimedeanClass.positiveRepresentative_not_mem_tailKernel hT c htail + letI : Nontrivial C := by + let c : T := Classical.arbitrary T + exact ⟨⟨0, scale c, (hscalePos c).ne⟩⟩ + letI : NoMaxOrder (FiniteArchimedeanClass C) := + FiniteArchimedeanClass.quotient_noMax_of_eq_tailKernel T + (FiniteArchimedeanClass.tailSubmodule ℚ T).toAddSubgroup + (FiniteArchimedeanClass.tailSubmodule_toAddSubgroup ℚ T) hT + have hEcard : #(Set.range scale) < κ := Cardinal.mk_range_le.trans_lt hTcard + have hEcoinitial : ∀ y : C, 0 < y → + ∃ x ∈ Set.range scale, 0 < x ∧ x ≤ y := by + intro y hy + obtain ⟨c, hcy⟩ := + FiniteArchimedeanClass.exists_tailQuotient_positiveRepresentative_le (T := T) hy + exact ⟨scale c, Set.mem_range_self c, hscalePos c, hcy⟩ + obtain ⟨e, f, g, h, hea, heb, hec, hed, hecard, hfcard, hgcard, hhcard⟩ := + exists_cardinal_germ_refinement + (Set.range scale) hEcard hEcoinitial a b c d ha hb hc hd habcd + obtain ⟨q, hqU, hqa, hqb, hqc, hqd⟩ := exists_closedClassRestrict_fourFactor_eq + (cantorBendixson_germ_eq_iff a (e * f) |>.mpr hea) + (cantorBendixson_germ_eq_iff b (g * h) |>.mpr heb) + (cantorBendixson_germ_eq_iff c (e * g) |>.mpr hec) + (cantorBendixson_germ_eq_iff d (f * h) |>.mpr hed) hU + refine ⟨q, hqU, e, f, g, h, ?_, ?_, ?_, ?_, hecard, hfcard, hgcard, hhcard⟩ + · rwa [closedClassRestrict_mul] at hqa + · rwa [closedClassRestrict_mul] at hqb + · rwa [closedClassRestrict_mul] at hqc + · rwa [closedClassRestrict_mul] at hqd + +end HahnSeries.Nonpositive + +namespace HahnSeries + +variable {G : Type u} {R : Type*} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module ℚ G] [PosSMulMono ℚ G] + [Semiring R] + +/-- A quotient class met by the support bounds a strict initial segment of the original support +classes. -/ +@[blueprint "lem:tail-quotient-class-bounds-support-classes" + (phase := "Refinement over Archimedean classes") + (title := "Support classes beyond a quotient Archimedean ball") + (statement := /-- + Let $T$ be a family of nonzero Archimedean classes of an ordered rational + vector space $G$, and let $q$ be a nonzero Archimedean class of the quotient + by the common tail below $T$. Suppose $q$ is met by the image of a set + $S\subseteq G$. If every nonzero element of $W\subseteq G$ maps outside + the closed ball of $q$ and has an Archimedean class met by $S$, then there + is a nonzero class $c$ met by $S$ such that every class met by $W$ is + strictly below $c$ and is met by $S$. + -/) + (proof := /-- + Choose $y\in S$ whose image has class $q$. For $g\in W\setminus\{0\}$, + being outside the closed ball of $q$ says that the quotient class of $g$ is + strictly larger in magnitude than that of $y$. The common-tail quotient + reflects this strict comparison to the original Archimedean-class order, + so the class of $g$ lies strictly below the class of $y$. + -/)] +theorem exists_nonzeroSupportClass_bound_tailQuotient + (T : Set (FiniteArchimedeanClass G)) + (q : FiniteArchimedeanClass (FiniteArchimedeanClass.TailQuotient T)) + (S W : Set G) + (hqocc : q.1 ∈ ArchimedeanClass.mk '' + (Submodule.Quotient.mk (p := FiniteArchimedeanClass.tailSubmodule ℚ T) '' S)) + (hW : ∀ g ∈ W, g ≠ 0 → + Submodule.Quotient.mk g ∉ FiniteArchimedeanClass.closedBallAddSubgroup q) + (hWocc : ∀ g ∈ W, g ≠ 0 → + ArchimedeanClass.mk g ∈ ArchimedeanClass.mk '' S) : + ∃ c ∈ ArchimedeanClass.mk '' (S \ {0}), + ArchimedeanClass.mk '' (W \ {0}) ⊆ + (ArchimedeanClass.mk '' (S \ {0})) ∩ Set.Iio c := by + obtain ⟨yq, ⟨y, hyS, rfl⟩, hyq⟩ := hqocc + have hy0 : y ≠ 0 := by + intro hy + subst y + have hqtop : q.1 = ⊤ := by + rw [← hyq] + exact ArchimedeanClass.mk_eq_top_iff.mpr (Submodule.Quotient.mk_zero _) + exact q.2 hqtop + refine ⟨ArchimedeanClass.mk y, ⟨y, ⟨hyS, by simpa using hy0⟩, rfl⟩, ?_⟩ + rintro _ ⟨g, ⟨hgW, hg0⟩, rfl⟩ + rw [Set.mem_singleton_iff] at hg0 + obtain ⟨z, hzS, hzg⟩ := hWocc g hgW hg0 + have hz0 : z ≠ 0 := by + intro hz + subst z + rw [ArchimedeanClass.mk_zero] at hzg + exact hg0 (ArchimedeanClass.mk_eq_top_iff.mp hzg.symm) + refine ⟨⟨z, ⟨hzS, by simpa using hz0⟩, hzg⟩, ?_⟩ + have hgq : ArchimedeanClass.mk + (Submodule.Quotient.mk g : FiniteArchimedeanClass.TailQuotient T) < + ArchimedeanClass.mk + (Submodule.Quotient.mk y : FiniteArchimedeanClass.TailQuotient T) := by + apply ArchimedeanClass.mk_lt_of_not_mem_closedBallAddSubgroup + intro hmem + apply hW g hgW hg0 + apply FiniteArchimedeanClass.mem_closedBallAddSubgroup_iff.mpr + intro hgq0 + change q.1 ≤ ArchimedeanClass.mk + (Submodule.Quotient.mk g : FiniteArchimedeanClass.TailQuotient T) + rw [← hyq] + exact ArchimedeanClass.mem_closedBallAddSubgroup_iff.mp hmem + exact FiniteArchimedeanClass.archimedeanClass_mk_lt_of_tailQuotient_mk_lt T hgq + +/-- If the support meets every class of a limit block, its nonzero outer classes after tail +regrouping are cofinal in the tail quotient. -/ +theorem isCofinal_supportArchimedeanClasses_convexQuotientSplit + (T₀ T₁ : Set (ArchimedeanClass G)) + (hT₀gt : ∀ a ∈ T₀, ∃ b ∈ T₀, a < b) + (x : HahnSeries G R) + (hxclasses : ArchimedeanClass.mk '' x.support = T₀ ∪ T₁) : + let T : Set (FiniteArchimedeanClass G) := {c | c.1 ∈ T₀} + let P := FiniteArchimedeanClass.tailSubmodule ℚ T + let y := convexQuotientSplitRingEquiv P x + IsCofinal {q : FiniteArchimedeanClass (FiniteArchimedeanClass.TailQuotient T) | + q.1 ∈ ArchimedeanClass.mk '' y.support} := by + dsimp only + intro q + induction q using FiniteArchimedeanClass.ind with + | mk z hz => + obtain ⟨c, hcz⟩ := FiniteArchimedeanClass.exists_tailQuotient_positiveRepresentative_le + (T := {c : FiniteArchimedeanClass G | c.1 ∈ T₀}) (abs_pos.mpr hz) + obtain ⟨d, hdT₀, hcd⟩ := hT₀gt c.1 c.2 + obtain ⟨e, heT₀, hde⟩ := hT₀gt d hdT₀ + obtain ⟨f, _hfT₀, hef⟩ := hT₀gt e heT₀ + have hdOcc : d ∈ ArchimedeanClass.mk '' x.support := by + rw [hxclasses] + exact Or.inl hdT₀ + obtain ⟨g, hg, hgd⟩ := hdOcc + let P := FiniteArchimedeanClass.tailSubmodule ℚ + {c : FiniteArchimedeanClass G | c.1 ∈ T₀} + let qp : (FiniteArchimedeanClass.TailQuotient + {c : FiniteArchimedeanClass G | c.1 ∈ T₀}) × P := + ofLex ((Submodule.quotientLexEquiv P).symm g) + let zq : FiniteArchimedeanClass.TailQuotient + {c : FiniteArchimedeanClass G | c.1 ∈ T₀} := qp.1 + let p : P := qp.2 + have hzqmk : Submodule.Quotient.mk g = zq := by + have hrepr : Submodule.quotientLexEquiv P (toLex qp) = g := by + change Submodule.quotientLexEquiv P + ((Submodule.quotientLexEquiv P).symm g) = g + exact (Submodule.quotientLexEquiv P).apply_symm_apply g + rw [← hrepr, Submodule.quotientLexEquiv_apply, + Submodule.mk_quotientProdLinearEquiv] + rfl + have hzq0 : zq ≠ 0 := by + intro hzq + have hgP : g ∈ P := by + rw [← Submodule.Quotient.mk_eq_zero P, hzqmk, hzq] + have heleg : e ≤ ArchimedeanClass.mk g := + FiniteArchimedeanClass.mem_tailKernel_iff.mp + ((FiniteArchimedeanClass.mem_tailSubmodule_iff (K := ℚ)).mp hgP) + ⟨⟨e, ne_top_of_lt hef⟩, heT₀⟩ + rw [hgd] at heleg + exact (not_le_of_gt hde) heleg + have hzqsupp : zq ∈ (convexQuotientSplitRingEquiv P x).support := by + rw [mem_support] + intro hzero + have hcoeff := congrArg (fun s : R⟦P⟧ ↦ s.coeff p) hzero + rw [convexQuotientSplitRingEquiv_coeff] at hcoeff + have hlex : Submodule.quotientLexEquiv P (toLex (zq, p)) = g := by + change Submodule.quotientLexEquiv P (toLex qp) = g + exact (Submodule.quotientLexEquiv P).apply_symm_apply g + rw [hlex] at hcoeff + exact (mem_support _ _).mp hg hcoeff + refine ⟨FiniteArchimedeanClass.mk zq hzq0, ?_, ?_⟩ + · exact ⟨zq, hzqsupp, rfl⟩ + · change ArchimedeanClass.mk z ≤ ArchimedeanClass.mk zq + rw [ArchimedeanClass.mk_le_mk] + have habs : |zq| ≤ |z| := calc + |zq| = (Submodule.Quotient.mk |g| : FiniteArchimedeanClass.TailQuotient + {c : FiniteArchimedeanClass G | c.1 ∈ T₀}) := by + rw [← hzqmk] + exact FiniteArchimedeanClass.tailQuotient_abs + {c : FiniteArchimedeanClass G | c.1 ∈ T₀} g + _ ≤ (Submodule.Quotient.mk (FiniteArchimedeanClass.positiveRepresentative c.1) : + FiniteArchimedeanClass.TailQuotient + {c : FiniteArchimedeanClass G | c.1 ∈ T₀}) := by + apply ConvexQuotient.mk_le_mk + have hcg : c.1 < ArchimedeanClass.mk g := hcd.trans_eq hgd.symm + have hdom := ArchimedeanClass.mk_lt_mk.mp + (FiniteArchimedeanClass.mk_positiveRepresentative c.1 ▸ hcg) 1 + simpa only [one_nsmul, + abs_of_pos (FiniteArchimedeanClass.positiveRepresentative_pos c.1)] using hdom.le + _ ≤ |z| := hcz + exact ⟨1, by simpa only [one_nsmul] using habs⟩ + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassFactorization.lean new file mode 100644 index 0000000000..50089a9a70 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassFactorization.lean @@ -0,0 +1,125 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.LimitTailRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ConvexRestrictionFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanBall + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Factoring at a support class in a tail quotient + +After regrouping along a common tail, a class met by the support determines a nonzero convex +restriction. Factoring off that restriction leaves an integral cofactor whose nonzero support +classes have strictly smaller order type. +-/ + +public noncomputable section + +open Cardinal +open scoped HahnSeries + +universe u v + +namespace HahnSeries.CardSuppLTTruncationIntegerPart + +open Classical in +/-- Factoring at a tail-quotient class met by the support strictly lowers the order type of the +nonzero support classes of the complementary factor. -/ +@[blueprint "lem:support-class-factorisation" + (phase := "Refinement over Archimedean classes") + (title := "Factorisation at a quotient Archimedean class") + (statement := /-- + Let $T$ be a set of nonzero Archimedean classes of an ordered rational + vector space $G$, and let $q$ be a nonzero Archimedean class of the quotient + of $G$ by the common tail below $T$. Suppose the support of + $b\in Z+R((G^{<0}))_\kappa$ meets $q$ and the restriction $t$ of $b$ to + the inverse image of the closed ball of $q$ is nonzero. Then + \[ + b=tw, + \] + where the order type of the nonzero Archimedean support classes of $w$ is + strictly smaller than that of $b$. + -/) + (proof := /-- + By \ref{lem:factorisation-by-convex-restriction}, the retained restriction + gives a factorisation $b=tw$, and every nonzero class met by $w$ is also met + by $b$. The quotient class $q$ and + \ref{lem:tail-quotient-class-bounds-support-classes} bound all those classes + strictly below one class met by $b$. The strict order-type inequality + follows from \ref{lem:support-class-order-type-strict-decrease}. + -/)] +theorem exists_factor_with_smaller_support_class_orderType + {G : Type u} {R : Type v} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module ℚ G] [PosSMulMono ℚ G] + [Field R] + {κ : Cardinal} [Fact (ℵ₀ < κ)] + (Z : Subring R) + (T : Set (FiniteArchimedeanClass G)) + (q : FiniteArchimedeanClass (FiniteArchimedeanClass.TailQuotient T)) + (b : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z) + (hqocc : q.1 ∈ ArchimedeanClass.mk '' + (Submodule.Quotient.mk (p := FiniteArchimedeanClass.tailSubmodule ℚ T) '' + (b : HahnSeries G R).support)) + (hne : HahnSeries.filter + (· ∈ (FiniteArchimedeanClass.closedBallAddSubgroup q).comap + (FiniteArchimedeanClass.tailSubmodule ℚ T).mkQ.toAddMonoidHom) + (b : HahnSeries G R) ≠ 0) : + ∃ t w : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z, + (t : HahnSeries G R) = HahnSeries.filter + (· ∈ (FiniteArchimedeanClass.closedBallAddSubgroup q).comap + (FiniteArchimedeanClass.tailSubmodule ℚ T).mkQ.toAddMonoidHom) + (b : HahnSeries G R) ∧ + b = t * w ∧ + (HahnSeries.Nonpositive.isPWO_nonzeroSupportArchimedeanClasses + (toNonpositiveRingHom Z w)).orderType < + (HahnSeries.Nonpositive.isPWO_nonzeroSupportArchimedeanClasses + (toNonpositiveRingHom Z b)).orderType := by + classical + let P := FiniteArchimedeanClass.tailSubmodule ℚ T + let C : AddSubgroup G := + (FiniteArchimedeanClass.closedBallAddSubgroup q).comap P.mkQ.toAddMonoidHom + letI : C.IsConvex := by + constructor + exact (FiniteArchimedeanClass.closedBall_ordConnected q).preimage_mono + (fun _ _ h ↦ ConvexQuotient.mk_le_mk h) + obtain ⟨t, w, ht, hfac, _hw0, hwC, hwocc⟩ := + exists_factorization_by_restriction Z + (inferInstance : C.IsConvex).ordConnected b hne + refine ⟨t, w, ht, hfac, ?_⟩ + let bN := toNonpositiveRingHom Z b + let wN := toNonpositiveRingHom Z w + obtain ⟨c, hc, hsub⟩ := + HahnSeries.exists_nonzeroSupportClass_bound_tailQuotient + T q (b : HahnSeries G R).support (w : HahnSeries G R).support hqocc + (by + intro g hg hg0 + exact hwC g hg hg0) + hwocc + have hc' : c ∈ bN.nonzeroSupportArchimedeanClasses := by + rw [HahnSeries.Nonpositive.mem_nonzeroSupportArchimedeanClasses_iff] + obtain ⟨g, ⟨hg, hg0⟩, hgc⟩ := hc + exact ⟨g, by simpa only [bN, coe_toNonpositiveRingHom] using hg, + by simpa only [Set.mem_singleton_iff] using hg0, hgc⟩ + apply HahnSeries.Nonpositive.orderType_nonzeroSupportArchimedeanClasses_lt bN wN hc' + intro d hd + rw [HahnSeries.Nonpositive.mem_nonzeroSupportArchimedeanClasses_iff] at hd + obtain ⟨g, hg, hg0, hgd⟩ := hd + have hg' : g ∈ (w : HahnSeries G R).support := by + simpa only [wN, coe_toNonpositiveRingHom] using hg + have hd' := hsub ⟨g, ⟨hg', by simpa only [Set.mem_singleton_iff] using hg0⟩, hgd⟩ + refine ⟨?_, hd'.2⟩ + rw [HahnSeries.Nonpositive.mem_nonzeroSupportArchimedeanClasses_iff] + obtain ⟨z, ⟨hz, hz0⟩, hzd⟩ := hd'.1 + exact ⟨z, by simpa only [bN, coe_toNonpositiveRingHom] using hz, + by simpa only [Set.mem_singleton_iff] using hz0, hzd⟩ + +end HahnSeries.CardSuppLTTruncationIntegerPart diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassRefinement.lean new file mode 100644 index 0000000000..e4bfae3692 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassRefinement.lean @@ -0,0 +1,360 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalTruncationClosedClass +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEmbedding +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CharZero +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.LimitTailRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassPrimality + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Exact refinement at a support class in a Hahn tail quotient + +Cauchy completeness gives refinement modulo series bounded away from zero in the common-tail +quotient. +Cofinality selects an outer support class where the four equations become exact. Finite-class +primality normalizes the inner residues. The normalization takes place when the bounded Hahn field +on the common tail is the fraction field of its bounded Hahn integer part. +-/ + +public noncomputable section + +open Cardinal FiniteArchimedeanClass +open scoped HahnSeries + +universe u v + +namespace HahnSeries.CardSuppLTTruncationIntegerPart + +private theorem mk_finiteArchimedeanClasses_lt + {G : Type u} {R : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Field R] {κ : Cardinal} [Fact (ℵ₀ < κ)] {Z : Subring R} + (a : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z) + (T₀ : Set (ArchimedeanClass G)) + (hT₀ : T₀ ⊆ ArchimedeanClass.mk '' (a : HahnSeries G R).support) : + #{q : FiniteArchimedeanClass G | q.1 ∈ T₀} < κ := by + let T : Set (FiniteArchimedeanClass G) := {q | q.1 ∈ T₀} + have supportRep_exists (q : T) : ∃ g : (a : HahnSeries G R).support, + ArchimedeanClass.mk (g : G) = q.1.1 := by + obtain ⟨g, hg, hgq⟩ := hT₀ q.2 + exact ⟨⟨g, hg⟩, hgq⟩ + let supportRep (q : T) : (a : HahnSeries G R).support := + Classical.choose (supportRep_exists q) + have supportRep_spec (q : T) : + ArchimedeanClass.mk (supportRep q : G) = q.1.1 := + Classical.choose_spec (supportRep_exists q) + have supportRep_injective : Function.Injective supportRep := by + intro q r hqr + apply Subtype.ext + apply Subtype.ext + exact (supportRep_spec q).symm.trans + ((congrArg (fun z : (a : HahnSeries G R).support ↦ + ArchimedeanClass.mk (z : G)) hqr).trans (supportRep_spec r)) + exact (Cardinal.mk_le_of_injective supportRep_injective).trans_lt a.1.2 + +/-- A bounded nonpositive four-factor refinement after restriction to one closed +Archimedean class in a specified family. -/ +private def HasNonpositiveClosedClassRefinement + {G : Type u} {K : Type v} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Field K] {κ : Cardinal} [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + (S : Subring K) (U : Set (FiniteArchimedeanClass G)) + (a b c d : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := K) (κ := κ) S) : Prop := + ∃ q ∈ U, ∃ e f g h : HahnSeries.Nonpositive G K, + HahnSeries.Nonpositive.closedClassRestrict q + (HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom S a) = + HahnSeries.Nonpositive.closedClassRestrict q e * + HahnSeries.Nonpositive.closedClassRestrict q f ∧ + HahnSeries.Nonpositive.closedClassRestrict q + (HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom S b) = + HahnSeries.Nonpositive.closedClassRestrict q g * + HahnSeries.Nonpositive.closedClassRestrict q h ∧ + HahnSeries.Nonpositive.closedClassRestrict q + (HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom S c) = + HahnSeries.Nonpositive.closedClassRestrict q e * + HahnSeries.Nonpositive.closedClassRestrict q g ∧ + HahnSeries.Nonpositive.closedClassRestrict q + (HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom S d) = + HahnSeries.Nonpositive.closedClassRestrict q f * + HahnSeries.Nonpositive.closedClassRestrict q h ∧ + (e : HahnSeries G K).cardSupp < κ ∧ + (f : HahnSeries G K).cardSupp < κ ∧ + (g : HahnSeries G K).cardSupp < κ ∧ + (h : HahnSeries G K).cardSupp < κ + +/-- A bounded Hahn-integer-part equation over a complete tail quotient admits a bounded +nonpositive refinement after restriction to a coinitial closed class. -/ +private theorem exists_nonpositive_closed_class_refinement_of_complete_tail_quotient + {G : Type u} {K : Type v} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module ℚ G] [PosSMulMono ℚ G] + [Field K] [CharZero K] + {κ : Cardinal} [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + (T : Set (FiniteArchimedeanClass G)) [Nonempty T] + (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) + [CompleteSpace (FiniteArchimedeanClass.TailQuotient T)] + (hTcard : #T < κ) + (S : Subring K) + (a b c d : HahnSeries.cardSuppLTTruncationIntegerPart + (G := FiniteArchimedeanClass.TailQuotient T) (R := K) (κ := κ) S) + (habcd : a * b = c * d) + {U : Set (FiniteArchimedeanClass (FiniteArchimedeanClass.TailQuotient T))} + (hU : IsCofinal U) : + HasNonpositiveClosedClassRefinement S U a b c d := by + let toN := HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom + (G := FiniteArchimedeanClass.TailQuotient T) (R := K) (κ := κ) S + have hnonpositive : toN a * toN b = toN c * toN d := by + simpa only [map_mul] using congrArg toN habcd + have cardSupp_toN_lt (x : HahnSeries.cardSuppLTTruncationIntegerPart + (G := FiniteArchimedeanClass.TailQuotient T) (R := K) (κ := κ) S) : + ((toN x : HahnSeries.Nonpositive + (FiniteArchimedeanClass.TailQuotient T) K) : + HahnSeries (FiniteArchimedeanClass.TailQuotient T) K).cardSupp < κ := by + have hx := (HahnSeries.mem_cardSuppLTSubfield + (Γ := FiniteArchimedeanClass.TailQuotient T) (R := K) (κ := κ)).mp x.1.2 + simpa only [toN, + HahnSeries.CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] using hx + rw [HasNonpositiveClosedClassRefinement] + exact HahnSeries.Nonpositive.exists_closed_class_refinement_of_complete_tail_quotient + T hT hTcard (toN a) (toN b) (toN c) (toN d) + (cardSupp_toN_lt a) (cardSupp_toN_lt b) (cardSupp_toN_lt c) (cardSupp_toN_lt d) + hnonpositive hU + +/-- Regrouping an equation along a limit tail produces a bounded nonpositive refinement at a +support class of the first factor. -/ +private theorem exists_nonpositive_refinement_at_support_class + {G : Type u} {R : Type v} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module ℚ G] [PosSMulMono ℚ G] + [Field R] [CharZero R] + {κ : Cardinal} [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + (Z : Subring R) + (T₀ T₁ : Set (ArchimedeanClass G)) + (hT₀gt : ∀ a ∈ T₀, ∃ b ∈ T₀, a < b) + (a b c d : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z) + (habcd : a * b = c * d) + (haclasses : ArchimedeanClass.mk '' (a : HahnSeries G R).support = T₀ ∪ T₁) + [Nonempty {q : FiniteArchimedeanClass G | q.1 ∈ T₀}] + [CompleteSpace (FiniteArchimedeanClass.TailQuotient + {q : FiniteArchimedeanClass G | q.1 ∈ T₀})] : + let T : Set (FiniteArchimedeanClass G) := {q | q.1 ∈ T₀} + let P := FiniteArchimedeanClass.tailSubmodule ℚ T + let S := HahnSeries.cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z + let E := HahnSeries.cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z + let U : Set (FiniteArchimedeanClass (FiniteArchimedeanClass.TailQuotient T)) := + {q | q.1 ∈ ArchimedeanClass.mk '' + (HahnSeries.convexQuotientSplitRingEquiv P (a : HahnSeries G R)).support} + HasNonpositiveClosedClassRefinement S U (E a) (E b) (E c) (E d) := by + classical + let T : Set (FiniteArchimedeanClass G) := {q | q.1 ∈ T₀} + let P := FiniteArchimedeanClass.tailSubmodule ℚ T + let InnerField := HahnSeries.CardSuppLTField (G := P) (R := R) (κ := κ) + let S := HahnSeries.cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z + let E := HahnSeries.cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z + let A := E a + let B := E b + let C := E c + let D := E d + have hABCD : A * B = C * D := by + simpa only [A, B, C, D, map_mul] using congrArg E habcd + have hT : ∀ x ∈ T, ∃ y ∈ T, x < y := by + intro x hx + obtain ⟨y, hy, hxy⟩ := hT₀gt x.1 hx + obtain ⟨z, hz, hyz⟩ := hT₀gt y hy + exact ⟨⟨y, ne_top_of_lt hyz⟩, hy, hxy⟩ + let U : Set (FiniteArchimedeanClass (FiniteArchimedeanClass.TailQuotient T)) := + {q | q.1 ∈ ArchimedeanClass.mk '' + (HahnSeries.convexQuotientSplitRingEquiv P (a : HahnSeries G R)).support} + have hU : IsCofinal U := HahnSeries.isCofinal_supportArchimedeanClasses_convexQuotientSplit + T₀ T₁ hT₀gt (a : HahnSeries G R) haclasses + have hTcard : #T < κ := by + apply mk_finiteArchimedeanClasses_lt (Z := Z) a T₀ + intro q hq + rw [haclasses] + exact Or.inl hq + exact exists_nonpositive_closed_class_refinement_of_complete_tail_quotient + T hT hTcard S A B C D hABCD hU + +/-- The first factor has the primal residue and nonvanishing closed-class restrictions needed +to normalize refinements over a specified family of classes. -/ +private def HasClosedClassNormalization + {G : Type u} {K : Type v} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Field K] {κ : Cardinal} [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + (S : Subring K) (U : Set (FiniteArchimedeanClass G)) + (a b c d : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := K) (κ := κ) S) : Prop := + a * b = c * d ∧ + IsPrimal (⟨(a : K⟦G⟧).coeff 0, + ((HahnSeries.mem_cardSuppLTTruncationIntegerPart (Z := S)).mp a.2).2⟩ : S) ∧ + Subring.fracSubring S = ⊤ ∧ + ∀ q ∈ U, closedClassRestrict S q a ≠ 0 + +/-- The normalization hypotheses turn every bounded nonpositive closed-class refinement into one +inside the cardinal-bounded Hahn integer part. -/ +private theorem exists_integer_part_refinement_of_nonpositive_refinement + {G : Type u} {K : Type v} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Field K] {κ : Cardinal} [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + (S : Subring K) (U : Set (FiniteArchimedeanClass G)) + (a b c d : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := K) (κ := κ) S) + (href : HasNonpositiveClosedClassRefinement S U a b c d) + (hnorm : HasClosedClassNormalization S U a b c d) : + ∃ q ∈ U, ∃ E F H₁ H₂ : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := K) (κ := κ) S, + closedClassRestrict S q a = E * F ∧ + closedClassRestrict S q b = H₁ * H₂ ∧ + closedClassRestrict S q c = E * H₁ ∧ + closedClassRestrict S q d = F * H₂ := by + rw [HasNonpositiveClosedClassRefinement] at href + rw [HasClosedClassNormalization] at hnorm + obtain ⟨habcd, haS, hfrac, hnonzero⟩ := hnorm + obtain ⟨q, hq, e, f, g, h, hea, heb, hec, hed, hecard, hfcard, hgcard, hhcard⟩ := href + obtain ⟨E, F, H₁, H₂, hEA, hEB, hEC, hED⟩ := + exists_refinement_closedClassRestrict_of_ambient + S q a b c d haS hfrac (hnonzero q hq) habcd e f g h + hecard hfcard hgcard hhcard hea heb hec hed + exact ⟨q, hq, E, F, H₁, H₂, hEA, hEB, hEC, hED⟩ + +/-- Regrouping along the common tail supplies the normalization hypotheses at every support class +of the first factor. -/ +private theorem has_closed_class_normalization_at_support_classes + {G : Type u} {R : Type v} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module ℚ G] [PosSMulMono ℚ G] + [Field R] [CharZero R] + {κ : Cardinal} [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + (Z : Subring R) + (hfinite : ∀ y : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z, + (ArchimedeanClass.mk '' (y : HahnSeries G R).support).Finite → IsPrimal y) + (T₀ T₁ : Set (ArchimedeanClass G)) + (hT₀gt : ∀ a ∈ T₀, ∃ b ∈ T₀, a < b) (hT₁ : T₁.Finite) + (a b c d : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z) + (habcd : a * b = c * d) + (haclasses : ArchimedeanClass.mk '' (a : HahnSeries G R).support = T₀ ∪ T₁) + (htailfrac : + Subring.fracSubring (HahnSeries.cardSuppLTTruncationIntegerPart + (G := FiniteArchimedeanClass.tailSubmodule ℚ + {q : FiniteArchimedeanClass G | q.1 ∈ T₀}) + (R := R) (κ := κ) Z) = ⊤) : + let T : Set (FiniteArchimedeanClass G) := {q | q.1 ∈ T₀} + let P := FiniteArchimedeanClass.tailSubmodule ℚ T + let S := HahnSeries.cardSuppLTTruncationIntegerPart + (G := P) (R := R) (κ := κ) Z + let E := HahnSeries.cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z + let U : Set (FiniteArchimedeanClass (FiniteArchimedeanClass.TailQuotient T)) := + {q | q.1 ∈ ArchimedeanClass.mk '' + (HahnSeries.convexQuotientSplitRingEquiv P (a : HahnSeries G R)).support} + HasClosedClassNormalization S U (E a) (E b) (E c) (E d) := by + let T : Set (FiniteArchimedeanClass G) := {q | q.1 ∈ T₀} + let P := FiniteArchimedeanClass.tailSubmodule ℚ T + let InnerField := HahnSeries.CardSuppLTField (G := P) (R := R) (κ := κ) + let S := HahnSeries.cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z + let E := HahnSeries.cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z + let A := E a + let B := E b + let C := E c + let D := E d + rw [HasClosedClassNormalization] + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa only [A, B, C, D, map_mul] using congrArg E habcd + · exact isPrimal_coeff_zero_convexQuotientSplitRingEquiv_of_ambient_finiteClasses + Z hfinite T₀ T₁ hT₀gt hT₁ a haclasses.le + · exact htailfrac + · intro q hq + apply closedClassRestrict_ne_zero_of_mem_image_mk_support S q A + rw [HahnSeries.support_cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv] + exact hq + +/-- Select an outer class met by the support and refine all four closed-class restrictions. -/ +@[blueprint "thm:support-class-refinement" + (phase := "Refinement over Archimedean classes") + (title := "Refinement at a quotient Archimedean class") + (statement := /-- + Let $a,b,c,d\in Z+R((G^{<0}))_\kappa$ satisfy $ab=cd$. Suppose that the + Archimedean classes met by the support of $a$ are $T_0\cup T_1$, where + $T_1$ is finite, and $T_0$ contains a non-zero class and has no greatest + element. Assume primality for every series whose support meets only + finitely many Archimedean classes. Assume that the quotient by the common + tail below $T_0$ is Cauchy complete for its additive uniformity, and that + the $\kappa$-bounded Hahn field on the common tail is the fraction field of + its corresponding $\kappa$-bounded integer part. Then some Archimedean + class of the quotient met by the support of $a$ admits an exact four-factor + refinement of the restrictions of $a,b,c,d$ to its closed Archimedean ball. + -/) + (proof := /-- + Regroup each series as a series on the common-tail quotient. The support + classes of $a$ are cofinal there, so + \ref{thm:complete-tail-quotient-refinement} gives an exact refinement at + one class met by that support. Primality of the inner constant term and + its descent to the convex common tail use + \ref{lem:convex-support-of-factors}: every nonzero factor of a series + supported in that tail is supported there. This primality together with + the common-tail fraction-field hypothesis supplies the hypotheses of + \ref{lem:closed-class-refinement-normalization}, which normalises the four + quotient factors inside the bounded Hahn integer part. + -/)] +theorem exists_closed_class_refinement_at_support_class + {G : Type u} {R : Type v} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module ℚ G] [PosSMulMono ℚ G] + [Field R] [CharZero R] + {κ : Cardinal} [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + (Z : Subring R) + (hfinite : ∀ y : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z, + (ArchimedeanClass.mk '' (y : HahnSeries G R).support).Finite → IsPrimal y) + (T₀ T₁ : Set (ArchimedeanClass G)) + (hT₀gt : ∀ a ∈ T₀, ∃ b ∈ T₀, a < b) (hT₁ : T₁.Finite) + (a b c d : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z) + (habcd : a * b = c * d) + (haclasses : ArchimedeanClass.mk '' (a : HahnSeries G R).support = T₀ ∪ T₁) + [Nonempty {q : FiniteArchimedeanClass G | q.1 ∈ T₀}] + [CompleteSpace (FiniteArchimedeanClass.TailQuotient + {q : FiniteArchimedeanClass G | q.1 ∈ T₀})] + (htailfrac : + Subring.fracSubring (HahnSeries.cardSuppLTTruncationIntegerPart + (G := FiniteArchimedeanClass.tailSubmodule ℚ + {q : FiniteArchimedeanClass G | q.1 ∈ T₀}) + (R := R) (κ := κ) Z) = ⊤) : + let T : Set (FiniteArchimedeanClass G) := {q | q.1 ∈ T₀} + let P := FiniteArchimedeanClass.tailSubmodule ℚ T + let S := HahnSeries.cardSuppLTTruncationIntegerPart + (G := P) (R := R) (κ := κ) Z + let E := HahnSeries.cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv + (R := R) (κ := κ) P Z + ∃ q : FiniteArchimedeanClass (FiniteArchimedeanClass.TailQuotient T), + q.1 ∈ ArchimedeanClass.mk '' + (HahnSeries.convexQuotientSplitRingEquiv P (a : HahnSeries G R)).support ∧ + ∃ e f g h : HahnSeries.cardSuppLTTruncationIntegerPart + (G := FiniteArchimedeanClass.TailQuotient T) + (R := HahnSeries.CardSuppLTField (G := P) (R := R) (κ := κ)) + (κ := κ) S, + closedClassRestrict S q (E a) = e * f ∧ + closedClassRestrict S q (E b) = g * h ∧ + closedClassRestrict S q (E c) = e * g ∧ + closedClassRestrict S q (E d) = f * h := by + apply exists_integer_part_refinement_of_nonpositive_refinement + · exact exists_nonpositive_refinement_at_support_class + Z T₀ T₁ hT₀gt a b c d habcd haclasses + · exact has_closed_class_normalization_at_support_classes + Z hfinite T₀ T₁ hT₀gt hT₁ a b c d habcd haclasses htailfrac + +end HahnSeries.CardSuppLTTruncationIntegerPart diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/TruncationIntegerPartFractionField.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/TruncationIntegerPartFractionField.lean new file mode 100644 index 0000000000..e802dcf8d7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/TruncationIntegerPartFractionField.lean @@ -0,0 +1,296 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CompleteGermRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.TruncationIntegerPartPrimal + +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ArchimedeanBallBase +import Mathlib.RingTheory.MvPolynomial.IrreducibleQuadratic +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# The fraction-field condition for truncation integer parts + +Let `K` be a field of characteristic zero, let `G` be an ordered exponent group that is Cauchy +complete with no least nonzero Archimedean magnitude, and let `Z` be a subring of `K`. If the +generalised-power-series integer part `Z + K((G^{<0}))` has the refinement property, then `K` is +the fraction field of `Z`. + +The proof uses the polynomial presentation of the germ ring. A cofinal series shows that the +polynomial algebra has a variable. Translating a representative of that variable by its constant +coefficient gives an irreducible germ with constant coefficient zero. Primality of this series in +the integer part, applied to its scalar multiples by `x` and `x⁻¹`, writes every `x : K` as a +fraction of elements of `Z`. +-/ + +open Set +open scoped HahnSeries + +universe u v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + [NoMaxOrder (FiniteArchimedeanClass G)] + [Field K] [CharZero K] + +private def cofinalNegativeExponent (i : ArchimedeanClass.CofinalIndex G) : G := + -|ArchimedeanClass.CofinalIndex.representative i| + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] + [CompleteSpace G] [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + [NoMaxOrder (FiniteArchimedeanClass G)] in +private theorem cofinalNegativeExponent_lt_zero (i : ArchimedeanClass.CofinalIndex G) : + cofinalNegativeExponent i < 0 := by + apply neg_lt_zero.mpr + apply abs_pos.mpr + exact ArchimedeanClass.CofinalIndex.representative_ne_zero i + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] + [CompleteSpace G] [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + [NoMaxOrder (FiniteArchimedeanClass G)] in +private theorem cofinalNegativeExponent_strictMono : + StrictMono (cofinalNegativeExponent (G := G)) := by + intro i j hij + apply neg_lt_neg + have hclass : + ArchimedeanClass.mk (ArchimedeanClass.CofinalIndex.representative i) < + ArchimedeanClass.mk (ArchimedeanClass.CofinalIndex.representative j) := by + simpa only [ArchimedeanClass.CofinalIndex.mk_representative] using + ArchimedeanClass.CofinalIndex.underlyingClass_lt_of_lt hij + simpa using (ArchimedeanClass.mk_lt_mk.mp hclass 1) + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] + [CompleteSpace G] [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + [NoMaxOrder (FiniteArchimedeanClass G)] in +private theorem cofinalNegativeExponent_isPWO : + (Set.range (cofinalNegativeExponent (G := G))).IsPWO := by + rw [show Set.range (cofinalNegativeExponent (G := G)) = + cofinalNegativeExponent (G := G) '' Set.univ by ext; simp] + exact (Set.IsPWO.of_linearOrder + (Set.univ : Set (ArchimedeanClass.CofinalIndex G))).image_of_monotone + cofinalNegativeExponent_strictMono.monotone + +private def cofinalGermSeries : HahnSeries G K := by + classical + exact HahnSeries.mk + (fun g => if g ∈ Set.range (cofinalNegativeExponent (G := G)) then 1 else 0) + (by + rw [show Function.support + (fun g => if g ∈ Set.range (cofinalNegativeExponent (G := G)) then + (1 : K) else 0) = Set.range (cofinalNegativeExponent (G := G)) by + ext g + simp [Function.mem_support]] + exact cofinalNegativeExponent_isPWO) + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] + [CompleteSpace G] [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + [NoMaxOrder (FiniteArchimedeanClass G)] in +private theorem support_cofinalGermSeries : + (cofinalGermSeries (G := G) (K := K)).support = + Set.range (cofinalNegativeExponent (G := G)) := by + classical + ext g + simp [cofinalGermSeries] + +private def cofinalGermNonpositive : Nonpositive G K := + ⟨cofinalGermSeries (G := G) (K := K), by + intro g hg + rw [support_cofinalGermSeries] at hg + obtain ⟨i, rfl⟩ := hg + exact (cofinalNegativeExponent_lt_zero i).le⟩ + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] + [CompleteSpace G] [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + [NoMaxOrder (FiniteArchimedeanClass G)] in +private theorem constantCoeff_cofinalGermNonpositive : + constantCoeff (cofinalGermNonpositive (G := G) (K := K)) = 0 := by + classical + rw [constantCoeff_apply] + change (cofinalGermSeries (G := G) (K := K)).coeff 0 = 0 + rw [cofinalGermSeries] + change (if 0 ∈ Set.range (cofinalNegativeExponent (G := G)) then 1 else 0) = 0 + rw [if_neg] + rintro ⟨i, hi⟩ + exact (cofinalNegativeExponent_lt_zero i).ne hi + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] + [CompleteSpace G] [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + [NoMaxOrder (FiniteArchimedeanClass G)] in +private theorem cofinalIndex_exists_ge (c : FiniteArchimedeanClass G) : + ∃ i : ArchimedeanClass.CofinalIndex G, + c ≤ ArchimedeanClass.CofinalIndex.archimedeanClass i := by + have hcof := ArchimedeanClass.CofinalIndex.isCofinal_range_archimedeanClass (G := G) + obtain ⟨d, ⟨i, rfl⟩, hci⟩ := hcof c + exact ⟨i, hci⟩ + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] + [CompleteSpace G] [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] in +private theorem exists_cofinalNegativeExponent_gt (e : G) (he : e < 0) : + ∃ i : ArchimedeanClass.CofinalIndex G, + e < cofinalNegativeExponent (G := G) i := by + obtain ⟨i, hi⟩ := ArchimedeanClass.exists_cofinalBallBase_subset_Ioo (-e) (neg_pos.mpr he) + obtain ⟨d, hid⟩ := + exists_gt (ArchimedeanClass.CofinalIndex.archimedeanClass i) + obtain ⟨j, hdj⟩ := cofinalIndex_exists_ge (G := G) d + have hijClass : ArchimedeanClass.CofinalIndex.archimedeanClass i < + ArchimedeanClass.CofinalIndex.archimedeanClass j := hid.trans_le hdj + have hij : i < j := + ArchimedeanClass.CofinalIndex.lt_iff_archimedeanClass_lt.mpr hijClass + have hjball : cofinalNegativeExponent (G := G) j ∈ + ArchimedeanClass.cofinalBallBase i := by + apply (ArchimedeanClass.mem_cofinalBallBase_iff i _).mpr + simpa [cofinalNegativeExponent, + ArchimedeanClass.CofinalIndex.mk_representative] using + ArchimedeanClass.CofinalIndex.underlyingClass_lt_of_lt hij + have hjinterval := hi hjball + exact ⟨j, by simpa using hjinterval.1⟩ + +omit [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] in +private theorem cofinalGermNonpositive_germ_ne_zero : + Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := K)).supp + (cofinalGermNonpositive (G := G) (K := K)) ≠ 0 := by + intro hzero + have heq : Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := K)).supp + (cofinalGermNonpositive (G := G) (K := K)) = + Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := K)).supp 0 := by + simpa using hzero + obtain ⟨e, he, hcoeff⟩ := + (cantorBendixson_germ_eq_iff (cofinalGermNonpositive (G := G) (K := K)) 0).mp heq + obtain ⟨i, hei⟩ := exists_cofinalNegativeExponent_gt (G := G) e he + have h := hcoeff (cofinalNegativeExponent (G := G) i) hei + simp [cofinalGermNonpositive, cofinalGermSeries] at h + +omit [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + [NoMaxOrder (FiniteArchimedeanClass G)] in +private theorem cofinalGermNonpositive_germ_not_isUnit : + ¬ IsUnit (Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := K)).supp + (cofinalGermNonpositive (G := G) (K := K))) := by + intro hunit + exact (constantCoeff_ne_zero_of_isUnit_cantorBendixson_germ hunit) + constantCoeff_cofinalGermNonpositive + +/-- There is a series with zero constant coefficient whose germ at zero is irreducible. -/ +@[blueprint "lem:irreducible-zero-constant-germ" + (phase := "Refinement over Archimedean classes") + (title := "An irreducible germ with zero constant coefficient") + (statement := /-- + Let $K$ be a field of characteristic zero and let $G$ be a nontrivial, + densely ordered abelian group with no least or greatest element and no + least nonzero Archimedean magnitude. Assume that $G$ is Cauchy complete + for its additive uniformity. + Then some series $p\in K((G^{\le0}))$ has constant coefficient zero and + irreducible image in the germ ring at zero. + -/) + (proof := /-- + Choose a well-ordered support cofinal at $0$ that meets a cofinal family + of nonzero Archimedean classes. The resulting series has a nonzero, + nonunit germ. Hence \ref{thm:complete-hahn-germ-polynomial-algebra} has + a nonempty index set. Choose a + polynomial variable $X_i$ and a series $p$ representing it. Subtracting + the constant coefficient $r$ of $p$ gives a representative with constant + coefficient zero and germ corresponding to $X_i-r$, which is irreducible. + -/)] +theorem exists_irreducible_cantorBendixson_germ_with_constantCoeff_zero : + ∃ p : Nonpositive G K, + constantCoeff p = 0 ∧ + Irreducible + (Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := K)).supp p) := by + let J := (cantorBendixsonValuation (G := G) (R := K)).supp + obtain ⟨ι, ⟨equiv⟩⟩ := exists_mvPolynomial_algEquiv_germ (G := G) (K := K) + have hι : Nonempty ι := by + by_contra h + letI : IsEmpty ι := not_nonempty_iff.mp h + let q : MvPolynomial ι K := + equiv.symm (Ideal.Quotient.mk J (cofinalGermNonpositive (G := G) (K := K))) + have hq0 : q ≠ 0 := by + intro hq + apply cofinalGermNonpositive_germ_ne_zero (G := G) (K := K) + have heq := congrArg equiv hq + simpa only [q, equiv.apply_symm_apply, map_zero] using heq + have hqcoeff : q.coeff 0 ≠ 0 := by + intro hcoeff + apply hq0 + rw [MvPolynomial.eq_C_of_isEmpty q, hcoeff, map_zero] + have hqunit : IsUnit q := by + rw [MvPolynomial.eq_C_of_isEmpty q] + exact (isUnit_iff_ne_zero.mpr hqcoeff).map MvPolynomial.C + apply cofinalGermNonpositive_germ_not_isUnit (G := G) (K := K) + simpa [q] using hqunit.map equiv.toMulEquiv + let i : ι := hι.some + obtain ⟨p, hp⟩ := Ideal.Quotient.mk_surjective (equiv (MvPolynomial.X i)) + let r : K := constantCoeff p + let p₀ : Nonpositive G K := p - C r + have hp₀coeff : constantCoeff p₀ = 0 := by + simp [p₀, r] + have hpoly : Irreducible (MvPolynomial.X i - MvPolynomial.C r) := by + simpa [sub_eq_add_neg] using + (MvPolynomial.irreducible_mul_X_add (1 : MvPolynomial ι K) + (-MvPolynomial.C r) i (by simp) (by simp) (by simp) isRelPrime_one_left) + have hgerm : + Ideal.Quotient.mk J p₀ = equiv (MvPolynomial.X i - MvPolynomial.C r) := by + have hconst : Ideal.Quotient.mk J (C r) = equiv (MvPolynomial.C r) := by + change Ideal.Quotient.mk J (algebraMap K (Nonpositive G K) r) = + equiv (algebraMap K (MvPolynomial ι K) r) + rw [Ideal.Quotient.mk_algebraMap] + exact (equiv.commutes r).symm + dsimp [p₀] + rw [map_sub, hp, hconst, map_sub] + refine ⟨p₀, hp₀coeff, ?_⟩ + rw [hgerm] + exact hpoly.map equiv.toMulEquiv + +/-- If `Z + K((G^{<0}))` has the refinement property, then `K` is the fraction field of `Z`. -/ +@[blueprint "thm:refinement-forces-coefficient-fraction-field" + (phase := "Refinement over Archimedean classes") + (title := "Refinement forces $K=\\operatorname{Frac}(Z)$") + (statement := /-- + Let $K$ be a field of characteristic zero and let $G$ satisfy the + hypotheses of \ref{lem:irreducible-zero-constant-germ}. If + \[ + Z+K((G^{<0})) + \] + has the refinement property for a subring $Z\subseteq K$, then + $K=\operatorname{Frac}(Z)$. + -/) + (proof := /-- + Identify the integer part with the inverse image of $Z$ under the + constant-coefficient map. By + \ref{lem:irreducible-zero-constant-germ}, it contains a series $p$ whose + constant coefficient is zero and whose germ is irreducible. Every + representative of a unit germ has nonzero constant coefficient, and the + refinement property makes $p$ primal. The scalar argument in + \ref{lem:primal-zero-residue-fraction-field} therefore gives + $K=\operatorname{Frac}(Z)$. + -/)] +theorem fracSubring_eq_top_of_hasFourFactorRefinement_truncationIntegerPart + (Z : Subring K) (h : HasFourFactorRefinement (truncationIntegerPart G Z)) : + Subring.fracSubring Z = ⊤ := by + let pi := constantCoeffAlgHom (G := G) (L := K) + let J := (cantorBendixsonValuation (G := G) (R := K)).supp + let phi : Nonpositive G K →+* Nonpositive G K ⧸ J := Ideal.Quotient.mk J + let e := truncationIntegerPartEquivResidueSubring (G := G) (L := K) Z + have hrefinement : HasFourFactorRefinement (Subring.residueSubring pi Z) := + h.map_mulEquiv e.toMulEquiv + obtain ⟨p, hpcoeff, hpIrr⟩ := + exists_irreducible_cantorBendixson_germ_with_constantCoeff_zero (G := G) (K := K) + have hpπ : pi p = 0 := by + simpa [pi, constantCoeffAlgHom_apply] using hpcoeff + exact Subring.fracSubring_eq_top_of_isPrimal_of_irreducible_map phi + (p := p) (S := Z) (π := pi) hpπ + (by simpa [phi, J] using hpIrr) + (fun a ha ↦ by + simpa [pi, phi, J, constantCoeffAlgHom_apply] using + (constantCoeff_ne_zero_of_isUnit_cantorBendixson_germ ha)) + (hrefinement.isPrimal ⟨p, by simp [hpπ]⟩) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/SplitTruncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/SplitTruncation.lean new file mode 100644 index 0000000000..4576ddc057 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/SplitTruncation.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.TruncationIntegerPartPrimal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedCharacterization + +/-! +# The LM24 split truncation + +At an Archimedean class `c`, the closed truncation becomes an iterated Hahn series whose outer +exponent group is the chosen stratum and whose coefficient field is the Hahn field on the open +ball. Its outer support is nonpositive, and its outer constant coefficient is exactly the open +truncation. This packages the object denoted by `ισ(Tσ(x))` in LM24, Proposition 9.2.2. +-/ + +public noncomputable section + +namespace HahnSeries.Nonpositive + +open FiniteArchimedeanClass + +variable {K G R : Type*} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] + +/-- The split closed-class truncation as a nonpositive Hahn series in the stratum exponent. -/ +def splitTruncation (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + Nonpositive (u.stratum c) R⟦ball K c⟧ := + ⟨HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x), + support_archimedeanSplitRingEquiv_TClosed_subset u c x⟩ + +@[simp] +theorem coe_splitTruncation (u : HahnEmbedding.ArchimedeanStrata K G) + (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : + (splitTruncation u c x : (R⟦ball K c⟧)⟦u.stratum c⟧) = + HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x) := + (rfl) + +/-- The constant coefficient of the split truncation is the open-class truncation. -/ +theorem constantCoeff_splitTruncation + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + constantCoeff (splitTruncation u c x) = tauBall c x := + by + rw [constantCoeff_apply, coe_splitTruncation] + exact coeff_zero_archimedeanSplitRingEquiv_TClosed u c x + +/-- The split truncation in the coefficient-subring integer part selected by its open +truncation. -/ +def splitTruncationIntegerPart + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (S : Subring R⟦ball K c⟧) (x : Nonpositive G R) (htau : tauBall c x ∈ S) : + truncationIntegerPart (u.stratum c) S := + ⟨splitTruncation u c x, by + rw [mem_truncationIntegerPart, ← constantCoeff_apply, constantCoeff_splitTruncation] + exact htau⟩ + +theorem coe_splitTruncationIntegerPart_hahn + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (S : Subring R⟦ball K c⟧) (x : Nonpositive G R) (htau : tauBall c x ∈ S) : + ((splitTruncationIntegerPart u c S x htau : + Nonpositive (u.stratum c) R⟦ball K c⟧) : + (R⟦ball K c⟧)⟦u.stratum c⟧) = + HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x) := + (rfl) + +@[simp] +theorem coe_splitTruncationIntegerPart + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (S : Subring R⟦ball K c⟧) (x : Nonpositive G R) (htau : tauBall c x ∈ S) : + (splitTruncationIntegerPart u c S x htau : + Nonpositive (u.stratum c) R⟦ball K c⟧) = splitTruncation u c x := + (rfl) + +/-- If the open truncation is one, primality of the split truncation in the corresponding +coefficient-subring integer part is exactly its ambient primality. -/ +theorem isPrimal_splitTruncationIntegerPart_iff_of_tau_eq_one + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (S : Subring R⟦ball K c⟧) (x : Nonpositive G R) (htau : tauBall c x = 1) : + IsPrimal (splitTruncationIntegerPart u c S x (htau.symm ▸ S.one_mem)) ↔ + IsPrimal (splitTruncation u c x) := by + apply isPrimal_truncationIntegerPart_iff_of_constantCoeff_eq_one + rw [constantCoeffAlgHom_apply, coe_splitTruncationIntegerPart, ← constantCoeff_apply, + constantCoeff_splitTruncation, htau] + +/-- If the open truncation is zero and the fraction field generated by the coefficient subring +is the whole coefficient Hahn field, primality of the split truncation in the integer part is +exactly its ambient primality. -/ +theorem isPrimal_splitTruncationIntegerPart_iff_of_tau_eq_zero + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (S : Subring R⟦ball K c⟧) (hfrac : Subring.fracSubring S = ⊤) + (x : Nonpositive G R) (htau : tauBall c x = 0) : + IsPrimal (splitTruncationIntegerPart u c S x (htau.symm ▸ S.zero_mem)) ↔ + IsPrimal (splitTruncation u c x) := by + apply isPrimal_truncationIntegerPart_iff_of_constantCoeff_eq_zero S hfrac + rw [constantCoeffAlgHom_apply, coe_splitTruncationIntegerPart, ← constantCoeff_apply, + constantCoeff_splitTruncation, htau] + +/-- For a reduced nonconstant series, the split truncation is primal in its +coefficient-subring integer part exactly when it is primal in the ambient split nonpositive Hahn +ring, provided the coefficient subring generates the whole coefficient field. This is the local +Lemma 9.2.1 step in LM24, Proposition 9.2.2. -/ +theorem isPrimal_splitTruncationIntegerPart_iff_of_isReduced + (u : HahnEmbedding.ArchimedeanStrata K G) (b : Nonpositive G R) (hb0 : b ≠ 0) + (horder : (b : R⟦G⟧).order ≠ 0) (hbReduced : IsReduced b) + (S : Subring R⟦ball K (leadingClass b horder)⟧) + (hfrac : Subring.fracSubring S = ⊤) + (htauMem : tauBall (leadingClass b horder) b ∈ S) : + IsPrimal (splitTruncationIntegerPart u (leadingClass b horder) S b htauMem) ↔ + IsPrimal (splitTruncation u (leadingClass b horder) b) := by + rcases (isReduced_iff_tau_leadingClass_eq_zero_or_one (K := K) b hb0 horder).mp + hbReduced with + htau | htau + · have htauBall : tauBall (leadingClass b horder) b = 0 := + (tauBall_eq_zero_iff (leadingClass b horder) b).mpr htau + convert isPrimal_splitTruncationIntegerPart_iff_of_tau_eq_zero + u (leadingClass b horder) S hfrac b htauBall using 1 + · have htauBall : tauBall (K := K) (leadingClass b horder) b = 1 := by + exact tauBall_eq_one_of_tau_eq_one (leadingClass b horder) b htau + convert isPrimal_splitTruncationIntegerPart_iff_of_tau_eq_one + u (leadingClass b horder) S b htauBall using 1 + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests.lean new file mode 100644 index 0000000000..54cad67def --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests.lean @@ -0,0 +1,23 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Assumptions +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Basic +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalPrimalityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalProposition922 +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ClassTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.FiniteClassReduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.IntegerPartSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.PrimalityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduced +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ReducedCharacterization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ReducedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.SplitTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.TruncationDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.TruncationPrimality + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Assumptions.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Assumptions.lean new file mode 100644 index 0000000000..449062909d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Assumptions.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Assumptions + +/-! +# API checks for LM24 assumptions `(A1)_σ` and `(A2)_σ` + +This separately compiled client exercises both clauses of `(A1)_σ` and all three clauses of +`(A2)_σ`. The finite-class checks keep the real-stratum, cofinality, and degenerate +fraction-field alternatives distinct; the full-class checks confirm that the class of zero is +accepted independently. +-/ + +universe u v + +public noncomputable section + +open Cardinal + +namespace Tests + +theorem assumptionA1_zero_class + {K : Type*} {G : Type u} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] + (s : HahnEmbedding.ArchimedeanStrata K G) : + LM24.AssumptionA1 s (⊤ : ArchimedeanClass G) := by + rw [LM24.assumptionA1_iff] + exact Or.inl rfl + +theorem assumptionA1_finite_of_orderAddMonoidIso_real + {K : Type*} {G : Type u} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] + (s : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (e : s.stratum c ≃+o ℝ) : + LM24.AssumptionA1AtFiniteClass s c := by + rw [LM24.assumptionA1AtFiniteClass_iff] + exact ⟨e⟩ + +theorem assumptionA2_zero_class + {G : Type u} {R : Type v} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Field R] + (κ : Cardinal.{u}) (Z : Subring R) : + LM24.AssumptionA2 κ Z (⊤ : ArchimedeanClass G) := by + rw [LM24.assumptionA2_iff] + exact Or.inr (Or.inr rfl) + +theorem assumptionA2_finite_of_cofinality + {K : Type*} {G : Type u} {R : Type v} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (κ : Cardinal.{u}) (Z : Subring R) (σ : FiniteArchimedeanClass G) + (hcof : κ ≤ Order.cof ↥(FiniteArchimedeanClass.ball K σ)) : + LM24.AssumptionA2AtFiniteClass (K := K) κ Z σ := by + rw [LM24.assumptionA2AtFiniteClass_iff] + exact Or.inl hcof + +theorem assumptionA2_finite_of_zero_inner_group + {K : Type*} {G : Type u} {R : Type v} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (κ : Cardinal.{u}) (Z : Subring R) (σ : FiniteArchimedeanClass G) + (hzero : Subsingleton ↥(FiniteArchimedeanClass.ball K σ)) + (hfrac : Subring.fracSubring Z = ⊤) : + LM24.AssumptionA2AtFiniteClass (K := K) κ Z σ := by + rw [LM24.assumptionA2AtFiniteClass_iff] + exact Or.inr ⟨hzero, hfrac⟩ + +theorem assumptionA2_finite_fraction_consequence + {K : Type*} {G : Type u} {R : Type v} {κ : Cardinal.{u}} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] [Fact (ℵ₀ < κ)] + (Z : Subring R) (σ : FiniteArchimedeanClass G) + (hA2 : LM24.AssumptionA2AtFiniteClass (K := K) κ Z σ) : + Subring.fracSubring + (HahnSeries.cardSuppLTTruncationIntegerPart + (G := ↥(FiniteArchimedeanClass.ball K σ)) (R := R) (κ := κ) Z) = ⊤ := + LM24.fracSubring_cardSuppLTTruncationIntegerPart_eq_top_of_assumptionA2AtFiniteClass + Z σ hA2 + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Basic.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Basic.lean new file mode 100644 index 0000000000..240f4b0289 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Basic.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import Mathlib.Algebra.Order.Ring.Rat + +/-! +# Tests for nonpositive Hahn series and their integer parts + +The examples distinguish nonpositive support and integral constant coefficient from the nearby +unrestricted conditions. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries + +/-- A monomial with positive exponent does not belong to the nonpositive Hahn subring. -/ +theorem positiveMonomial_not_mem_nonpositiveSubring : + HahnSeries.single (1 : ℚ) (1 : ℚ) ∉ nonpositiveSubring ℚ ℚ := by + rw [mem_nonpositiveSubring] + intro h + have hsupport : (1 : ℚ) ∈ (HahnSeries.single (1 : ℚ) (1 : ℚ)).support := by + simp + exact (by norm_num : ¬(1 : ℚ) ≤ 0) (h hsupport) + +/-- A nonconstant rational Hahn series with integral constant coefficient. -/ +def nonconstantIntegerPartSeries : Nonpositive ℚ ℚ := + Nonpositive.C (Γ := ℚ) (R := ℚ) 2 + + Nonpositive.single (Γ := ℚ) (R := ℚ) (-1) 3 (by norm_num) + +theorem nonconstantIntegerPartSeries_coeff_neg_one : + (nonconstantIntegerPartSeries : HahnSeries ℚ ℚ).coeff (-1) = 3 := by + simp [nonconstantIntegerPartSeries] + +theorem nonconstantIntegerPartSeries_constantCoeff : + Nonpositive.constantCoeff (Γ := ℚ) (R := ℚ) nonconstantIntegerPartSeries = 2 := by + simp [nonconstantIntegerPartSeries] + +theorem nonconstantIntegerPartSeries_mem_truncationIntegerPart : + nonconstantIntegerPartSeries ∈ truncationIntegerPart ℚ (⊥ : Subring ℚ) := by + simp [nonconstantIntegerPartSeries] + +theorem nonconstantIntegerPartSeries_add_self_mem_truncationIntegerPart : + nonconstantIntegerPartSeries + nonconstantIntegerPartSeries ∈ + truncationIntegerPart ℚ (⊥ : Subring ℚ) := + (truncationIntegerPart ℚ (⊥ : Subring ℚ)).add_mem + nonconstantIntegerPartSeries_mem_truncationIntegerPart + nonconstantIntegerPartSeries_mem_truncationIntegerPart + +theorem nonconstantIntegerPartSeries_mul_self_mem_truncationIntegerPart : + nonconstantIntegerPartSeries * nonconstantIntegerPartSeries ∈ + truncationIntegerPart ℚ (⊥ : Subring ℚ) := + (truncationIntegerPart ℚ (⊥ : Subring ℚ)).mul_mem + nonconstantIntegerPartSeries_mem_truncationIntegerPart + nonconstantIntegerPartSeries_mem_truncationIntegerPart + +theorem nonconstantIntegerPartSeries_add_self_constantCoeff : + Nonpositive.constantCoeff (Γ := ℚ) (R := ℚ) + (nonconstantIntegerPartSeries + nonconstantIntegerPartSeries) = 4 := by + rw [map_add, nonconstantIntegerPartSeries_constantCoeff] + norm_num + +theorem nonconstantIntegerPartSeries_mul_self_constantCoeff : + Nonpositive.constantCoeff (Γ := ℚ) (R := ℚ) + (nonconstantIntegerPartSeries * nonconstantIntegerPartSeries) = 4 := by + rw [map_mul, nonconstantIntegerPartSeries_constantCoeff] + norm_num + +/-- A nonpositive rational Hahn series whose constant coefficient is not integral. -/ +def nonintegralConstantSeries : Nonpositive ℚ ℚ := + Nonpositive.C (Γ := ℚ) (R := ℚ) (1 / 2) + + Nonpositive.single (Γ := ℚ) (R := ℚ) (-1) 3 (by norm_num) + +theorem nonintegralConstantSeries_not_mem_truncationIntegerPart : + nonintegralConstantSeries ∉ truncationIntegerPart ℚ (⊥ : Subring ℚ) := by + norm_num [nonintegralConstantSeries, Subring.mem_bot] + intro z hz + have hz2 := congrArg (fun q : ℚ => q * 2) hz + norm_num at hz2 + norm_cast at hz2 + omega + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/CardinalPrimalityTransfer.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/CardinalPrimalityTransfer.lean new file mode 100644 index 0000000000..eba13579ad --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/CardinalPrimalityTransfer.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalPrimalityTransfer + +/-! +# API checks for cardinal-bounded local primality transfer + +This separately compiled client exercises both reduced-residue branches after the leading-class +split. The zero branch consumes the exact finite-class form of `(A2)_σ`; the one branch does not. +-/ + +universe u v + +public noncomputable section + +open Cardinal FiniteArchimedeanClass + +namespace Tests + +open HahnSeries HahnSeries.Nonpositive + +theorem cardinalPrimalityTransfer_residue_one + {K : Type*} {G : Type u} {R : Type v} {κ : Cardinal.{u}} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] [Fact (ℵ₀ < κ)] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (htau : tauBall (K := K) c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) = 1) : + IsPrimal (splitTruncationCardSuppLTIntegerPart u c Z b) ↔ + IsPrimal (splitTruncationCardSuppLT u c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b)) := + isPrimal_splitTruncationCardSuppLTIntegerPart_iff_of_tau_eq_one u c Z b htau + +theorem cardinalPrimalityTransfer_residue_zero + {K : Type*} {G : Type u} {R : Type v} {κ : Cardinal.{u}} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] [Fact (ℵ₀ < κ)] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) (hA2 : LM24.AssumptionA2AtFiniteClass (K := K) κ Z c) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (htau : tauBall (K := K) c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) = 0) : + IsPrimal (splitTruncationCardSuppLTIntegerPart u c Z b) ↔ + IsPrimal (splitTruncationCardSuppLT u c + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b)) := + isPrimal_splitTruncationCardSuppLTIntegerPart_iff_of_tau_eq_zero + u c Z hA2 b htau + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/CardinalProposition922.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/CardinalProposition922.lean new file mode 100644 index 0000000000..d7afaef8a2 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/CardinalProposition922.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalProposition922 + +/-! +# API checks for cardinal-bounded LM24 Proposition 9.2.2 + +The reduced transfer requires `(A2)_σ` only at the leading Archimedean class. The bounded +fixed-ring equivalence exposes both directions under the explicit regularity hypothesis. +-/ + +universe u v + +public noncomputable section + +open Cardinal FiniteArchimedeanClass + +namespace Tests + +open HahnSeries HahnSeries.Nonpositive + +theorem cardinalProposition922 + {K : Type*} {G : Type u} {R : Type v} {κ : Cardinal.{u}} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + (u : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (hb0 : CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b ≠ 0) + (horder : ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b : + Nonpositive G R) : R⟦G⟧).order ≠ 0) + (hbReduced : IsReduced (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b)) + (hA2 : LM24.AssumptionA2AtFiniteClass (K := K) κ Z + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder)) : + IsPrimal b ↔ + IsPrimal (splitTruncationCardSuppLT u + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b)) := + isPrimal_iff_isPrimal_splitTruncationCardSuppLT_of_isReduced + u Z b hb0 horder hbReduced hA2 + +theorem cardinalProposition922_A2_only_if_zero + {K : Type*} {G : Type u} {R : Type v} {κ : Cardinal.{u}} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + (u : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (hb0 : CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b ≠ 0) + (horder : ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b : + Nonpositive G R) : R⟦G⟧).order ≠ 0) + (hbReduced : IsReduced (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b)) + (hA2 : tauBall (K := K) + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) = 0 → + LM24.AssumptionA2AtFiniteClass (K := K) κ Z + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder)) : + IsPrimal b ↔ + IsPrimal (splitTruncationCardSuppLT u + (leadingClass (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b)) := + isPrimal_iff_isPrimal_splitTruncationCardSuppLT_of_isReduced_if_A2 + u Z b hb0 horder hbReduced hA2 + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ClassTruncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ClassTruncation.lean new file mode 100644 index 0000000000..4e7fbf6cec --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ClassTruncation.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ClassTruncation + +/-! +# API checks for Archimedean-class truncations + +In the Archimedean exponent group `ℚ`, the class of `-1` is the unique nonzero class. At that +class, `T` keeps the boundary monomial while `tau` removes it. This distinguishes LM24's weak and +strict class cuts; an ordinary exponent truncation at the representative `-1` would not provide +the same class-invariant interface. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries FiniteArchimedeanClass + +def rationalClass : FiniteArchimedeanClass ℚ := + FiniteArchimedeanClass.mk (-1 : ℚ) (by norm_num) + +def rationalBoundarySeries : Nonpositive ℚ ℤ := + Nonpositive.single (-1) 5 (by norm_num) + +theorem negOne_mem_closedBall : (-1 : ℚ) ∈ closedBall ℚ rationalClass := by + rw [FiniteArchimedeanClass.mem_closedBall_iff] + intro h + simp [rationalClass] + +theorem negOne_not_mem_ball : (-1 : ℚ) ∉ ball ℚ rationalClass := by + rw [FiniteArchimedeanClass.mem_ball_iff] + simp only [not_forall] + exact ⟨by norm_num, by simp [rationalClass]⟩ + +theorem classTruncation_boundary_coefficients : + ((Nonpositive.T (K := ℚ) rationalClass rationalBoundarySeries : + Nonpositive ℚ ℤ) : ℤ⟦ℚ⟧).coeff (-1) = 5 ∧ + ((Nonpositive.tau (K := ℚ) rationalClass rationalBoundarySeries : + Nonpositive ℚ ℤ) : ℤ⟦ℚ⟧).coeff (-1) = 0 := by + constructor + · rw [Nonpositive.coeff_T_of_mem _ _ negOne_mem_closedBall] + simp [rationalBoundarySeries] + · rw [Nonpositive.coeff_tau_of_not_mem _ _ negOne_not_mem_ball] + +/-- The leading-class API retains a nonconstant boundary monomial. -/ +theorem T_rationalBoundarySeries_leadingClass : + Nonpositive.T (K := ℚ) + (Nonpositive.leadingClass rationalBoundarySeries (by + rw [rationalBoundarySeries, Nonpositive.coe_single, + HahnSeries.order_single (by norm_num)] + norm_num)) + rationalBoundarySeries = rationalBoundarySeries := + Nonpositive.T_leadingClass rationalBoundarySeries (by + rw [rationalBoundarySeries, Nonpositive.coe_single, + HahnSeries.order_single (by norm_num)] + norm_num) + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/FiniteClassReduction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/FiniteClassReduction.lean new file mode 100644 index 0000000000..10655a489d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/FiniteClassReduction.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassReduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OneRow + +/-! +# Checks for finite support classes + +These clients distinguish the support-class set from two nearby wrong definitions: discarding +the zero class, and asking that the support itself be finite. The series `2 + t⁻¹` meets both the +zero and nonzero real classes. Berarducci's row has infinite support but meets just one class. +The zero-series check is only an interface boundary check. +-/ + +public noncomputable section + +open HahnSeries HahnSeries.Nonpositive +open scoped HahnSeries + +namespace Tests.FiniteClassReduction + +/-- Zero meets no class, rather than meeting the zero class. -/ +theorem zero_support_classes : supportArchimedeanClasses (0 : Nonpositive ℝ ℝ) = ∅ := + supportArchimedeanClasses_zero + +/-- A nonzero ordinary constant meets the zero class. -/ +theorem constant_support_classes : + supportArchimedeanClasses (Nonpositive.single (0 : ℝ) (3 : ℝ) le_rfl) = {⊤} := by + ext c + simp [mem_supportArchimedeanClasses, eq_comm] + +/-- The two-class fixture `2 + t⁻¹`. -/ +def twoClassSeries : Nonpositive ℝ ℝ := + Nonpositive.single 0 2 le_rfl + Nonpositive.single (-1) 1 (by norm_num) + +/-- The zero exponent contributes a second class even though all nonzero real exponents are +Archimedean-equivalent. -/ +theorem twoClass_support_classes : + supportArchimedeanClasses twoClassSeries = {ArchimedeanClass.mk (-1 : ℝ), ⊤} := by + have hs : (twoClassSeries : ℝ⟦ℝ⟧).support = {0, -1} := by + ext g + by_cases hg0 : g = 0 <;> by_cases hg1 : g = -1 <;> + simp [HahnSeries.mem_support, twoClassSeries, hg0, hg1] + ext c + rw [mem_supportArchimedeanClasses, hs] + simp [eq_comm, or_comm] + +/-- Berarducci's row has infinitely many exponents. -/ +theorem oneRow_support_infinite : + (Berarducci.OneRow.withoutConstant (K := ℝ) : ℝ⟦ℝ⟧).support.Infinite := by + rw [Berarducci.OneRow.withoutConstant_support] + exact Set.infinite_range_of_injective Berarducci.OneRow.exponentEmbedding.injective + +/-- The same infinite support meets just one Archimedean class. -/ +theorem oneRow_support_classes : + supportArchimedeanClasses (Berarducci.OneRow.withoutConstant (K := ℝ)) = + {ArchimedeanClass.mk (-1 : ℝ)} := by + ext c + rw [mem_supportArchimedeanClasses, Set.mem_singleton_iff] + constructor + · rintro ⟨g, hg, rfl⟩ + have hg0 : g ≠ 0 := by + intro hzero + subst g + exact (HahnSeries.mem_support _ _).mp hg Berarducci.OneRow.withoutConstant_coeff_zero + exact ArchimedeanClass.mk_eq_mk_of_archimedean hg0 (by norm_num) + · rintro rfl + refine ⟨-1, ?_, rfl⟩ + rw [HahnSeries.mem_support] + have hcoeff := Berarducci.OneRow.withoutConstant_coeff_exponent (K := ℝ) 0 + norm_num [Berarducci.OneRow.exponent_apply] at hcoeff + rw [hcoeff] + exact one_ne_zero + +end Tests.FiniteClassReduction diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/IntegerPartSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/IntegerPartSplitting.lean new file mode 100644 index 0000000000..a812101974 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/IntegerPartSplitting.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IntegerPartSplitting + +/-! +# API checks for LM24 integer-part splitting + +This separately compiled client checks the exact source and target rings in LM24, +Fact 2.4.2(5), and verifies that the equivalence sends a fixed source series to its split +truncation. The nested coefficient subring excludes the nearby wrong target using the whole +inner Hahn field. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries FiniteArchimedeanClass + +theorem integerPartSplitting_apply + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (x : Nonpositive.fixedIntegerPartSubring (K := K) (G := G) (R := R) c Z) : + ((Nonpositive.splitFixedIntegerPartRingEquiv u c Z x : + truncationIntegerPart (u.stratum c) + (Nonpositive.innerIntegerPartSubring (K := K) (G := G) c Z)) : + Nonpositive (u.stratum c) R⟦ball K c⟧) = + Nonpositive.splitTruncation u c (x : Nonpositive G R) := + Nonpositive.coe_splitFixedIntegerPartRingEquiv u c Z x + +theorem integerPartSplitting_round_trip + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (Z : Subring R) + (y : truncationIntegerPart (u.stratum c) + (Nonpositive.innerIntegerPartSubring (K := K) (G := G) c Z)) : + Nonpositive.splitFixedIntegerPartRingEquiv u c Z + ((Nonpositive.splitFixedIntegerPartRingEquiv u c Z).symm y) = y := + (Nonpositive.splitFixedIntegerPartRingEquiv u c Z).apply_symm_apply y + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/PrimalityTransfer.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/PrimalityTransfer.lean new file mode 100644 index 0000000000..2fc7e045b0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/PrimalityTransfer.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.PrimalityTransfer + +/-! +# API checks for leading-class primality transfer + +This separately compiled client exercises both residue branches of the generic set-level core of +LM24, Proposition 9.2.2. The residue-one branch needs no fraction-field hypothesis; the +residue-zero branch requires exactly that the embedded inner integer part generate the coefficient +Hahn field. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries FiniteArchimedeanClass + +theorem primalityTransfer_residue_one + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (u : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : truncationIntegerPart G Z) (hb0 : (b : Nonpositive G R) ≠ 0) + (horder : ((b : Nonpositive G R) : R⟦G⟧).order ≠ 0) + (htau : Nonpositive.tauBall (K := K) + (Nonpositive.leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R) = 1) : + IsPrimal b ↔ + IsPrimal (Nonpositive.splitTruncation u + (Nonpositive.leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R)) := + Nonpositive.isPrimal_iff_isPrimal_splitTruncation_of_tau_eq_one + u Z b hb0 horder htau + +theorem primalityTransfer_residue_zero + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (u : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : truncationIntegerPart G Z) (hb0 : (b : Nonpositive G R) ≠ 0) + (horder : ((b : Nonpositive G R) : R⟦G⟧).order ≠ 0) + (hfrac : Subring.fracSubring + (Nonpositive.innerIntegerPartSubring (K := K) (G := G) + (Nonpositive.leadingClass (b : Nonpositive G R) horder) Z) = ⊤) + (htau : Nonpositive.tauBall (K := K) + (Nonpositive.leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R) = 0) : + IsPrimal b ↔ + IsPrimal (Nonpositive.splitTruncation u + (Nonpositive.leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R)) := + Nonpositive.isPrimal_iff_isPrimal_splitTruncation_of_tau_eq_zero + u Z b hb0 horder hfrac htau + +theorem primalityTransfer_reduced + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (u : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : truncationIntegerPart G Z) (hb0 : (b : Nonpositive G R) ≠ 0) + (horder : ((b : Nonpositive G R) : R⟦G⟧).order ≠ 0) + (hbReduced : Nonpositive.IsReduced (b : Nonpositive G R)) + (hfrac : Nonpositive.tauBall (K := K) + (Nonpositive.leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R) = 0 → + Subring.fracSubring (Nonpositive.innerIntegerPartSubring (K := K) (G := G) + (Nonpositive.leadingClass (b : Nonpositive G R) horder) Z) = ⊤) : + IsPrimal b ↔ + IsPrimal (Nonpositive.splitTruncation u + (Nonpositive.leadingClass (b : Nonpositive G R) horder) + (b : Nonpositive G R)) := + Nonpositive.isPrimal_iff_isPrimal_splitTruncation_of_isReduced + u Z b hb0 horder hbReduced hfrac + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Reduced.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Reduced.lean new file mode 100644 index 0000000000..f4f5df3aca --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Reduced.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduced +public import Mathlib.Algebra.Order.Group.Int + +/-! +# API checks for LM24 reducedness + +The constant series `3` is reduced because the relevant intersection is supported only at zero. +The two-term series `2 + t⁻¹` is not reduced: both zero and `-1` occur in the support before and +after subtracting one, but zero and a nonzero exponent have different Archimedean classes. This is +the Hahn-series analogue of LM24, Example 8.2.7's non-reduced omnific integer `ω + 2`. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries + +/-- The constant nonpositive integer Hahn series `3`. -/ +def reducedConstant : Nonpositive ℤ ℤ := Nonpositive.single 0 3 le_rfl + +theorem reducedConstant_isReduced : Nonpositive.IsReduced reducedConstant := by + refine Nonpositive.isReduced_of_support_inter_support_sub_one_subset ?_ ⊤ ?_ + · intro hzero + have hcoeff := congrArg (fun x : Nonpositive ℤ ℤ ↦ (x : ℤ⟦ℤ⟧).coeff 0) hzero + rw [show (reducedConstant : ℤ⟦ℤ⟧) = HahnSeries.single 0 3 by + exact Nonpositive.coe_single 0 3 le_rfl] at hcoeff + rw [HahnSeries.coeff_single_same] at hcoeff + norm_num at hcoeff + · rintro x ⟨hx, _⟩ + have hx0 : x = 0 := by + apply support_single_subset (R := ℤ) + rw [show (reducedConstant : ℤ⟦ℤ⟧) = HahnSeries.single 0 3 by + exact Nonpositive.coe_single 0 3 le_rfl] at hx + exact hx + simp [hx0] + +/-- The nonpositive Hahn series `2 + t⁻¹`. -/ +def nonreducedTwoClass : Nonpositive ℤ ℤ := + Nonpositive.single 0 2 le_rfl + Nonpositive.single (-1) 1 (by omega) + +theorem nonreducedTwoClass_not_isReduced : ¬Nonpositive.IsReduced nonreducedTwoClass := by + intro h + obtain ⟨_, c, hc⟩ := h.elim + have hzero : ArchimedeanClass.mk (0 : ℤ) = c := hc ⟨by + rw [HahnSeries.mem_support] + rw [show (nonreducedTwoClass : ℤ⟦ℤ⟧) = + HahnSeries.single 0 2 + HahnSeries.single (-1) 1 by + simp [nonreducedTwoClass]] + simp, by + rw [HahnSeries.mem_support] + rw [show ((nonreducedTwoClass - 1 : Nonpositive ℤ ℤ) : ℤ⟦ℤ⟧) = + (HahnSeries.single 0 2 + HahnSeries.single (-1) 1) - 1 by + simp [nonreducedTwoClass]] + simp⟩ + have hneg : ArchimedeanClass.mk (-1 : ℤ) = c := hc ⟨by + rw [HahnSeries.mem_support] + rw [show (nonreducedTwoClass : ℤ⟦ℤ⟧) = + HahnSeries.single 0 2 + HahnSeries.single (-1) 1 by + simp [nonreducedTwoClass]] + simp, by + rw [HahnSeries.mem_support] + rw [show ((nonreducedTwoClass - 1 : Nonpositive ℤ ℤ) : ℤ⟦ℤ⟧) = + (HahnSeries.single 0 2 + HahnSeries.single (-1) 1) - 1 by + simp [nonreducedTwoClass]] + simp⟩ + have hcTop : c = ⊤ := hzero.symm.trans ArchimedeanClass.mk_zero + have hnegTop : ArchimedeanClass.mk (-1 : ℤ) = ⊤ := hneg.trans hcTop + have := ArchimedeanClass.mk_eq_top_iff.mp hnegTop + omega + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ReducedCharacterization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ReducedCharacterization.lean new file mode 100644 index 0000000000..b24b784b43 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ReducedCharacterization.lean @@ -0,0 +1,96 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedCharacterization + +/-! +# API checks for the leading-class characterization of reducedness + +The boundary monomial `5t⁻¹` exercises the `tau = 0` branch. The series `1 + 5t⁻¹` +exercises the `tau = 1` branch. Both are nonconstant and reduced, so together they certify the +two alternatives in LM24, Proposition 8.2.5 `(4) ↔ (5)` through the public API. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries + +def reducedZeroTauSeries : Nonpositive ℚ ℚ := + Nonpositive.single (-1) 5 (by norm_num) + +def reducedOneTauSeries : Nonpositive ℚ ℚ := + 1 + reducedZeroTauSeries + +private theorem reducedZeroTauSeries_ne_zero : reducedZeroTauSeries ≠ 0 := by + intro h + have hcoeff := congrArg (fun x : Nonpositive ℚ ℚ ↦ (x : ℚ⟦ℚ⟧).coeff (-1)) h + simp [reducedZeroTauSeries] at hcoeff + +private theorem reducedZeroTauSeries_order : + (reducedZeroTauSeries : ℚ⟦ℚ⟧).order = -1 := by + rw [reducedZeroTauSeries, Nonpositive.coe_single, HahnSeries.order_single (by norm_num)] + +private theorem reducedOneTauSeries_ne_zero : reducedOneTauSeries ≠ 0 := by + intro h + have hcoeff := congrArg (fun x : Nonpositive ℚ ℚ ↦ (x : ℚ⟦ℚ⟧).coeff (-1)) h + simp [reducedOneTauSeries, reducedZeroTauSeries] at hcoeff + +private theorem reducedOneTauSeries_order : + (reducedOneTauSeries : ℚ⟦ℚ⟧).order = -1 := by + have htop : (reducedOneTauSeries : ℚ⟦ℚ⟧).orderTop = (-1 : ℚ) := by + apply HahnSeries.orderTop_eq_of_le + · rw [HahnSeries.mem_support] + simp [reducedOneTauSeries, reducedZeroTauSeries] + · intro g hg + have hgNonpos := Nonpositive.support_subset reducedOneTauSeries hg + by_contra hnot + have hgLt : g < (-1 : ℚ) := lt_of_not_ge hnot + have hgZero : g ≠ 0 := by linarith + have hgNegOne : g ≠ -1 := by linarith + rw [HahnSeries.mem_support] at hg + simp [reducedOneTauSeries, reducedZeroTauSeries, hgZero, hgNegOne] at hg + exact WithTop.coe_injective + ((HahnSeries.order_eq_orderTop_of_ne_zero (fun h ↦ + reducedOneTauSeries_ne_zero (Subtype.ext h))).trans htop) + +theorem reducedZeroTauSeries_characterization : + Nonpositive.IsReduced reducedZeroTauSeries ↔ + Nonpositive.tau (K := ℚ) + (Nonpositive.leadingClass reducedZeroTauSeries (by + rw [reducedZeroTauSeries_order] + norm_num)) + reducedZeroTauSeries = 0 ∨ + Nonpositive.tau (K := ℚ) + (Nonpositive.leadingClass reducedZeroTauSeries (by + rw [reducedZeroTauSeries_order] + norm_num)) + reducedZeroTauSeries = 1 := + Nonpositive.isReduced_iff_tau_leadingClass_eq_zero_or_one + reducedZeroTauSeries reducedZeroTauSeries_ne_zero (by + rw [reducedZeroTauSeries_order] + norm_num) + +theorem reducedOneTauSeries_characterization : + Nonpositive.IsReduced reducedOneTauSeries ↔ + Nonpositive.tau (K := ℚ) + (Nonpositive.leadingClass reducedOneTauSeries (by + rw [reducedOneTauSeries_order] + norm_num)) + reducedOneTauSeries = 0 ∨ + Nonpositive.tau (K := ℚ) + (Nonpositive.leadingClass reducedOneTauSeries (by + rw [reducedOneTauSeries_order] + norm_num)) + reducedOneTauSeries = 1 := + Nonpositive.isReduced_iff_tau_leadingClass_eq_zero_or_one + reducedOneTauSeries reducedOneTauSeries_ne_zero (by + rw [reducedOneTauSeries_order] + norm_num) + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ReducedDivisibility.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ReducedDivisibility.lean new file mode 100644 index 0000000000..a394429d5d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ReducedDivisibility.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedDivisibility + +/-! +# API checks for reduced divisibility + +This separately compiled client checks both public conclusions needed from the reduction-algebra +core of LM24, Proposition 8.2.8: `rho(c)` divides `T(c)`, and for a reduced nonconstant divisor +`b`, divisibility of `T(c)` by `b` is equivalent to divisibility of `rho(c)` by `b`. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries + +theorem rho_dvd_closed_truncation + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (u : HahnEmbedding.ArchimedeanStrata K G) (sigma : FiniteArchimedeanClass G) + (c : Nonpositive G R) : + Nonpositive.rho u sigma c ∣ Nonpositive.T (K := K) sigma c := + Nonpositive.rho_dvd_T u sigma c + +theorem reduced_divisor_dvd_closed_iff_dvd_rho + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (u : HahnEmbedding.ArchimedeanStrata K G) (b : Nonpositive G R) (hb0 : b ≠ 0) + (horder : (b : R⟦G⟧).order ≠ 0) (hbReduced : Nonpositive.IsReduced b) + (c : Nonpositive G R) : + b ∣ Nonpositive.T (K := K) (Nonpositive.leadingClass b horder) c ↔ + b ∣ Nonpositive.rho u (Nonpositive.leadingClass b horder) c := + Nonpositive.dvd_T_iff_dvd_rho_leadingClass u b hb0 horder hbReduced c + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Reduction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Reduction.lean new file mode 100644 index 0000000000..10baa445b0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Reduction.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ClassTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduction + +/-! +# API checks for LM24 reduction + +The zero-`τ` check uses the nonzero boundary monomial from the class-truncation certificate: +`T` retains it while `τ` removes it, so `ρ` must take the zero branch. The nonzero-`τ` check is +polymorphic and verifies that `ρ` selects the quotient construction whenever the open truncation +is nonzero. These checks distinguish both clauses of LM24, Definition 8.2.4. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries FiniteArchimedeanClass + +def rationalBoundaryFieldSeries : Nonpositive ℚ ℚ := + Nonpositive.single (-1) 5 (by norm_num) + +theorem rho_rationalBoundarySeries_eq_T + (u : HahnEmbedding.ArchimedeanStrata ℚ ℚ) : + Nonpositive.rho u rationalClass rationalBoundaryFieldSeries = + Nonpositive.T (K := ℚ) rationalClass rationalBoundaryFieldSeries := by + apply Nonpositive.rho_of_tau_eq_zero + apply Subtype.ext + ext g + by_cases hg : g = -1 + · subst g + rw [Nonpositive.coeff_tau_of_not_mem _ _ negOne_not_mem_ball] + simp + · have hcoeff : (rationalBoundaryFieldSeries : ℚ⟦ℚ⟧).coeff g = 0 := by + rw [rationalBoundaryFieldSeries, Nonpositive.coe_single] + simp [hg] + by_cases hball : g ∈ ball ℚ rationalClass + · rw [Nonpositive.coeff_tau_of_mem _ _ hball, hcoeff] + rfl + · rw [Nonpositive.coeff_tau_of_not_mem _ _ hball] + rfl + +theorem rho_eq_reductionQuotient_of_tau_ne_zero + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) (htau : Nonpositive.tau (K := K) c x ≠ 0) : + Nonpositive.rho u c x = Nonpositive.reductionQuotient u c x + (fun hzero ↦ htau ((Nonpositive.tauBall_eq_zero_iff c x).mp hzero)) := + Nonpositive.rho_of_tau_ne_zero u c x htau + +/-- The fixed-class characterization in LM24, Proposition 8.2.5. -/ +theorem rho_fixed_at_containing_class_iff + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) (hx : x ≠ 0) (hT : Nonpositive.T (K := K) c x = x) : + Nonpositive.rho u c x = x ↔ + Nonpositive.tau (K := K) c x = 0 ∨ Nonpositive.tau (K := K) c x = 1 := + Nonpositive.rho_eq_self_iff_tau_eq_zero_or_one u c x hx hT + +/-- LM24, Proposition 8.2.5 `(3) ↔ (4)` at the leading class. -/ +theorem rho_fixed_at_leading_class_iff + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (u : HahnEmbedding.ArchimedeanStrata K G) (x : Nonpositive G R) (hx : x ≠ 0) + (horder : (x : R⟦G⟧).order ≠ 0) : + Nonpositive.rho u (Nonpositive.leadingClass x horder) x = x ↔ + Nonpositive.tau (K := K) (Nonpositive.leadingClass x horder) x = 0 ∨ + Nonpositive.tau (K := K) (Nonpositive.leadingClass x horder) x = 1 := + Nonpositive.rho_leadingClass_eq_self_iff_tau_eq_zero_or_one u x hx horder + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/SplitTruncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/SplitTruncation.lean new file mode 100644 index 0000000000..4bf6f4a0f7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/SplitTruncation.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.SplitTruncation + +/-! +# API checks for the LM24 split truncation + +This separately compiled client checks the constant-coefficient interface used by LM24, +Proposition 9.2.2. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries FiniteArchimedeanClass + +theorem splitTruncation_constantCoeff + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + Nonpositive.constantCoeff (Nonpositive.splitTruncation u c x) = + Nonpositive.tauBall c x := + Nonpositive.constantCoeff_splitTruncation u c x + +theorem splitTruncation_primality_at_one + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (S : Subring R⟦ball K c⟧) (x : Nonpositive G R) + (htau : Nonpositive.tauBall c x = 1) : + IsPrimal (Nonpositive.splitTruncationIntegerPart u c S x + (htau.symm ▸ S.one_mem)) ↔ + IsPrimal (Nonpositive.splitTruncation u c x) := + Nonpositive.isPrimal_splitTruncationIntegerPart_iff_of_tau_eq_one u c S x htau + +theorem splitTruncation_primality_at_zero + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) + (S : Subring R⟦ball K c⟧) (hfrac : Subring.fracSubring S = ⊤) + (x : Nonpositive G R) (htau : Nonpositive.tauBall c x = 0) : + IsPrimal (Nonpositive.splitTruncationIntegerPart u c S x + (htau.symm ▸ S.zero_mem)) ↔ + IsPrimal (Nonpositive.splitTruncation u c x) := + Nonpositive.isPrimal_splitTruncationIntegerPart_iff_of_tau_eq_zero + u c S hfrac x htau + +theorem reduced_splitTruncation_primality + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (u : HahnEmbedding.ArchimedeanStrata K G) (b : Nonpositive G R) (hb0 : b ≠ 0) + (horder : (b : R⟦G⟧).order ≠ 0) (hbReduced : Nonpositive.IsReduced b) + (S : Subring R⟦ball K (Nonpositive.leadingClass b horder)⟧) + (hfrac : Subring.fracSubring S = ⊤) + (htauMem : Nonpositive.tauBall (Nonpositive.leadingClass b horder) b ∈ S) : + IsPrimal (Nonpositive.splitTruncationIntegerPart u + (Nonpositive.leadingClass b horder) S b htauMem) ↔ + IsPrimal (Nonpositive.splitTruncation u (Nonpositive.leadingClass b horder) b) := + Nonpositive.isPrimal_splitTruncationIntegerPart_iff_of_isReduced + u b hb0 horder hbReduced S hfrac htauMem + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/TruncationDivisibility.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/TruncationDivisibility.lean new file mode 100644 index 0000000000..1d648a5fbd --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/TruncationDivisibility.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationDivisibility + +/-! +# API checks for LM24 truncation divisibility + +This separately compiled client certifies Proposition 8.2.1 at the leading class and the full +nonconstant reduced case of Proposition 8.2.8 through their public APIs. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries + +theorem leading_truncation_fixes_divisor + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (b : Nonpositive G R) (hb0 : b ≠ 0) (horder : (b : R⟦G⟧).order ≠ 0) + {a : Nonpositive G R} (ha : a ∣ b) : + Nonpositive.T (K := K) (Nonpositive.leadingClass b horder) a = a := + Nonpositive.T_leadingClass_of_dvd b hb0 horder ha + +theorem dvd_iff_dvd_leading_truncation + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (b : Nonpositive G R) (hb0 : b ≠ 0) (horder : (b : R⟦G⟧).order ≠ 0) + (c : Nonpositive G R) : + b ∣ c ↔ b ∣ Nonpositive.T (K := K) (Nonpositive.leadingClass b horder) c := + Nonpositive.dvd_iff_dvd_T_leadingClass b hb0 horder c + +theorem reduced_dvd_iff_dvd_leading_reduction + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (u : HahnEmbedding.ArchimedeanStrata K G) (b : Nonpositive G R) (hb0 : b ≠ 0) + (horder : (b : R⟦G⟧).order ≠ 0) (hbReduced : Nonpositive.IsReduced b) + (c : Nonpositive G R) : + b ∣ c ↔ b ∣ Nonpositive.rho u (Nonpositive.leadingClass b horder) c := + Nonpositive.dvd_iff_dvd_rho_leadingClass u b hb0 horder hbReduced c + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/TruncationPrimality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/TruncationPrimality.lean new file mode 100644 index 0000000000..f1810f547b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/TruncationPrimality.lean @@ -0,0 +1,32 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationPrimality + +/-! +# API checks for primality in a leading-class truncation ring + +This separately compiled client checks the source-side localization step used in LM24, +Proposition 9.2.2. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries + +theorem primality_in_leading_truncation_subring + {K G R : Type*} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (b : Nonpositive G R) (hb0 : b ≠ 0) (horder : (b : R⟦G⟧).order ≠ 0) : + IsPrimal (Nonpositive.leadingTruncationElement (K := K) b horder) ↔ IsPrimal b := + Nonpositive.isPrimal_leadingTruncationElement_iff b hb0 horder + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/TruncationDivisibility.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/TruncationDivisibility.lean new file mode 100644 index 0000000000..b15d3ba701 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/TruncationDivisibility.lean @@ -0,0 +1,218 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedDivisibility + +/-! +# Divisibility and leading-class truncation + +This module formalizes LM24, Proposition 8.2.1 at the leading class of a nonconstant +nonpositive Hahn series. The discarded tail is divisible by the original series: restrict the +divisor to its closed Archimedean ball, invert it in that Hahn field, and embed the inverse back. +If `x` is a discarded negative exponent and `y` belongs to the embedded inverse, then the class +of `x` strictly dominates that of `y`; consequently `x < -y` and `x + y < 0`. +-/ + +public noncomputable section + +namespace HahnSeries.Nonpositive + +open FiniteArchimedeanClass + +variable {K G R : Type*} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] + +private def closedBallEmbedding (c : FiniteArchimedeanClass G) : closedBall K c ↪o G where + toFun := (↑) + inj' := Subtype.val_injective + map_rel_iff' := Iff.rfl + +private theorem support_T_subset_closedBall (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + ((T (K := K) c x : Nonpositive G R) : R⟦G⟧).support ⊆ closedBall K c := by + intro g hg + by_contra hnot + exact hg (coeff_T_of_not_mem (K := K) c x hnot) + +private theorem support_sub_T_disjoint_closedBall (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + (((x - T (K := K) c x : Nonpositive G R) : R⟦G⟧).support) ∩ + closedBall K c = ∅ := by + apply Set.eq_empty_iff_forall_notMem.mpr + intro g hg + rw [Set.mem_inter_iff] at hg + obtain ⟨hgSupport, hgClosed⟩ := hg + rw [HahnSeries.mem_support] at hgSupport + change (((x : R⟦G⟧) - (T (K := K) c x : Nonpositive G R)).coeff g) ≠ 0 at hgSupport + rw [HahnSeries.coeff_sub, coeff_T_of_mem (K := K) c x hgClosed, + sub_self] at hgSupport + exact hgSupport rfl + +private theorem support_embeddedClosedBallInverse_add_tail_subset_Iio + (c : FiniteArchimedeanClass G) (b x : Nonpositive G R) : + ((HahnSeries.embDomain (closedBallEmbedding (K := K) c) + (HahnSeries.restrictDomain (closedBallEmbedding (K := K) c) (b : R⟦G⟧))⁻¹) * + ((x - T (K := K) c x : Nonpositive G R) : R⟦G⟧)).support ⊆ Set.Iio 0 := by + intro g hg + obtain ⟨y, hy, z, hz, rfl⟩ := HahnSeries.support_mul_subset hg + obtain ⟨y', _, hy'⟩ := HahnSeries.support_embDomain_subset hy + subst y + have hyClosed : (y' : G) ∈ closedBall K c := y'.2 + have hzTail : z ∉ closedBall K c := by + intro hzClosed + have hdisjoint := support_sub_T_disjoint_closedBall (K := K) c x + have : z ∈ (((x - T (K := K) c x : Nonpositive G R) : R⟦G⟧).support) ∩ + closedBall K c := ⟨hz, hzClosed⟩ + rw [hdisjoint] at this + exact this + have hzNonpos : z ≤ 0 := support_subset (x - T (K := K) c x) hz + have hz0 : z ≠ 0 := fun h ↦ hzTail (h ▸ zero_mem _) + by_cases hy0 : (y' : G) = 0 + · change (y' : G) + z < 0 + simpa [hy0] using lt_of_le_of_ne hzNonpos hz0 + have hclassZ : ArchimedeanClass.mk z < c.val := by + have hnotle : ¬ c ≤ FiniteArchimedeanClass.mk z hz0 := by + intro hle + exact hzTail ((FiniteArchimedeanClass.mem_closedBall_iff K).mpr fun _ ↦ hle) + exact not_le.mp hnotle + have hclassY : c.val ≤ ArchimedeanClass.mk (y' : G) := by + exact (FiniteArchimedeanClass.mem_closedBall_iff K).mp hyClosed hy0 + have hzyClass : ArchimedeanClass.mk z < ArchimedeanClass.mk (-(y' : G)) := by + rw [ArchimedeanClass.mk_neg] + exact hclassZ.trans_le hclassY + have hzy : z < -(y' : G) := + ArchimedeanClass.lt_of_mk_lt_mk_of_nonpos hzyClass hzNonpos + change (y' : G) + z < 0 + have := add_lt_add_left hzy (y' : G) + simpa [add_comm] using this + +/-- Every divisor of a nonzero nonconstant series is supported in the closed ball at the +dividend's leading Archimedean class. Equivalently, truncation at that class fixes the divisor. +This is the factor-control observation used in the first paragraph of LM24, Proposition 9.2.2. -/ +theorem T_leadingClass_of_dvd (b : Nonpositive G R) (hb0 : b ≠ 0) + (horder : (b : R⟦G⟧).order ≠ 0) {a : Nonpositive G R} (ha : a ∣ b) : + T (K := K) (leadingClass b horder) a = a := by + obtain ⟨q, hb⟩ := ha + have ha0 : a ≠ 0 := by + intro hzero + apply hb0 + rw [hb, hzero, zero_mul] + have hq0 : q ≠ 0 := by + intro hzero + apply hb0 + rw [hb, hzero, mul_zero] + apply Subtype.ext + ext g + by_cases hcoeff : (a : R⟦G⟧).coeff g = 0 + · by_cases hg : g ∈ closedBall K (leadingClass b horder) + · rw [coeff_T_of_mem _ a hg, hcoeff] + · rw [coeff_T_of_not_mem _ a hg, hcoeff] + · rw [coeff_T_of_mem] + apply (FiniteArchimedeanClass.mem_closedBall_iff K).mpr + intro hg0 + apply Subtype.coe_le_coe.mp + rw [leadingClass_val, FiniteArchimedeanClass.val_mk] + have haOrderNonpos : (a : R⟦G⟧).order ≤ 0 := by + exact support_subset a + ((HahnSeries.mem_support _ _).mpr (HahnSeries.coeff_order_eq_zero.not.mpr + (fun h ↦ ha0 (Subtype.ext h)))) + have hqOrderNonpos : (q : R⟦G⟧).order ≤ 0 := by + exact support_subset q + ((HahnSeries.mem_support _ _).mpr (HahnSeries.coeff_order_eq_zero.not.mpr + (fun h ↦ hq0 (Subtype.ext h)))) + have hsumLe : (a : R⟦G⟧).order + (q : R⟦G⟧).order ≤ + (a : R⟦G⟧).order := by + simpa using add_le_add_left hqOrderNonpos (a : R⟦G⟧).order + have haOrderLe : (a : R⟦G⟧).order ≤ g := + HahnSeries.order_le_of_coeff_ne_zero hcoeff + have hgNonpos : g ≤ 0 := + support_subset a ((HahnSeries.mem_support _ _).mpr hcoeff) + have horderMul : ((a * q : Nonpositive G R) : R⟦G⟧).order = + (a : R⟦G⟧).order + (q : R⟦G⟧).order := by + exact HahnSeries.order_mul (fun h ↦ ha0 (Subtype.ext h)) + (fun h ↦ hq0 (Subtype.ext h)) + rw [hb, horderMul] + have hsumNonzero : (a : R⟦G⟧).order + (q : R⟦G⟧).order ≠ 0 := by + rw [← horderMul, ← hb] + exact horder + simpa [ArchimedeanClass.mk_eq_top_iff.not.mpr hsumNonzero] using + ArchimedeanClass.min_le_mk_of_le_of_le (hsumLe.trans haOrderLe) hgNonpos + +/-- Divisibility by a nonzero series fixed by a closed-class truncation can be tested after that +truncation. The inverse is formed in the Hahn field on the closed ball and embedded back. -/ +theorem dvd_iff_dvd_T_of_fixed (sigma : FiniteArchimedeanClass G) + (b : Nonpositive G R) (hb0 : b ≠ 0) (hbFixed : T (K := K) sigma b = b) + (c : Nonpositive G R) : + b ∣ c ↔ b ∣ T (K := K) sigma c := by + let f := closedBallEmbedding (K := K) sigma + let br : R⟦closedBall K sigma⟧ := HahnSeries.restrictDomain f (b : R⟦G⟧) + have hbSupport : (b : R⟦G⟧).support ⊆ Set.range f := by + rw [← hbFixed] + intro g hg + exact ⟨⟨g, support_T_subset_closedBall (K := K) sigma b hg⟩, rfl⟩ + have hembBr : HahnSeries.embDomain f br = (b : R⟦G⟧) := + HahnSeries.embDomain_restrictDomain f (b : R⟦G⟧) hbSupport + have hbr0 : br ≠ 0 := by + intro hzero + apply hb0 + apply Subtype.ext + rw [← hembBr, hzero] + exact HahnSeries.embDomain_zero + let qFull : R⟦G⟧ := HahnSeries.embDomain f br⁻¹ + have hbq : (b : R⟦G⟧) * qFull = 1 := by + rw [← hembBr] + change HahnSeries.embDomain f br * HahnSeries.embDomain f br⁻¹ = 1 + rw [← HahnSeries.embDomain_mul] + · rw [mul_inv_cancel₀ hbr0, HahnSeries.embDomain_one] + rfl + · intro x y + rfl + constructor + · rintro ⟨e, hce⟩ + refine ⟨T (K := K) sigma e, ?_⟩ + calc + T (K := K) sigma c = T (K := K) sigma (b * e) := by rw [hce] + _ = T (K := K) sigma b * T (K := K) sigma e := + (T (K := K) sigma).map_mul b e + _ = b * T (K := K) sigma e := by rw [hbFixed] + · rintro ⟨e, hTe⟩ + let tail : Nonpositive G R := c - T (K := K) sigma c + let qTail : Nonpositive G R := ⟨qFull * (tail : R⟦G⟧), by + intro g hg + exact (support_embeddedClosedBallInverse_add_tail_subset_Iio sigma b c hg).le⟩ + refine ⟨e + qTail, ?_⟩ + apply Subtype.ext + change (c : R⟦G⟧) = + (b : R⟦G⟧) * ((e : R⟦G⟧) + qFull * (tail : R⟦G⟧)) + rw [mul_add, ← mul_assoc, hbq, one_mul] + change (c : R⟦G⟧) = (b : R⟦G⟧) * (e : R⟦G⟧) + + ((c : R⟦G⟧) - (T (K := K) sigma c : Nonpositive G R)) + have hTeCoe : ((T (K := K) sigma c : Nonpositive G R) : R⟦G⟧) = + (b : R⟦G⟧) * (e : R⟦G⟧) := congrArg Subtype.val hTe + rw [← hTeCoe] + abel + +/-- LM24, Proposition 8.2.1 at the lowest nonzero exponent's Archimedean class. -/ +theorem dvd_iff_dvd_T_leadingClass (b : Nonpositive G R) (hb0 : b ≠ 0) + (horder : (b : R⟦G⟧).order ≠ 0) (c : Nonpositive G R) : + b ∣ c ↔ b ∣ T (K := K) (leadingClass b horder) c := + dvd_iff_dvd_T_of_fixed (leadingClass b horder) b hb0 (T_leadingClass b horder) c + +/-- LM24, Proposition 8.2.8 for a reduced series with nonzero lowest exponent: reduction at its +leading Archimedean class preserves exactly the multiples of the series. -/ +theorem dvd_iff_dvd_rho_leadingClass + (u : HahnEmbedding.ArchimedeanStrata K G) (b : Nonpositive G R) (hb0 : b ≠ 0) + (horder : (b : R⟦G⟧).order ≠ 0) (hbReduced : IsReduced b) + (c : Nonpositive G R) : + b ∣ c ↔ b ∣ rho u (leadingClass b horder) c := + (dvd_iff_dvd_T_leadingClass b hb0 horder c).trans + (dvd_T_iff_dvd_rho_leadingClass u b hb0 horder hbReduced c) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/TruncationPrimality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/TruncationPrimality.lean new file mode 100644 index 0000000000..877993c08f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/TruncationPrimality.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationDivisibility + +/-! +# Primality in a leading-class truncation ring + +The fixed points of a closed Archimedean-class truncation form a subring. At the leading class +of a nonzero nonconstant series, every divisor of that series belongs to this subring. Hence the +series is primal in the full nonpositive Hahn ring exactly when it is primal in the fixed-point +subring. This is the source-side localization step in LM24, Proposition 9.2.2. +-/ + +public noncomputable section + +namespace HahnSeries.Nonpositive + +open FiniteArchimedeanClass + +variable {K G R : Type*} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] + +/-- Nonpositive Hahn series fixed by closed truncation at `c`. -/ +def truncationSubring (c : FiniteArchimedeanClass G) : Subring (Nonpositive G R) := + RingHom.range (T (K := K) c) + +/-- Membership in the truncation subring is exactly being fixed by the truncation. -/ +theorem mem_truncationSubring_iff (c : FiniteArchimedeanClass G) + (x : Nonpositive G R) : + x ∈ truncationSubring (K := K) (R := R) c ↔ T (K := K) c x = x := by + constructor + · rintro ⟨y, rfl⟩ + exact T_T c y + · intro hx + exact ⟨x, hx⟩ + +/-- A nonzero nonconstant series, regarded in its leading-class truncation subring. -/ +def leadingTruncationElement (b : Nonpositive G R) + (horder : (b : R⟦G⟧).order ≠ 0) : + truncationSubring (K := K) (R := R) (leadingClass b horder) := + ⟨b, (mem_truncationSubring_iff (leadingClass b horder) b).mpr + (T_leadingClass b horder)⟩ + +@[simp] +theorem coe_leadingTruncationElement (b : Nonpositive G R) + (horder : (b : R⟦G⟧).order ≠ 0) : + (leadingTruncationElement (K := K) b horder : Nonpositive G R) = b := + (rfl) + +/-- Primality of a nonzero nonconstant series is unchanged when it is restricted to its +leading-class truncation subring. -/ +theorem isPrimal_leadingTruncationElement_iff + (b : Nonpositive G R) (hb0 : b ≠ 0) + (horder : (b : R⟦G⟧).order ≠ 0) : + IsPrimal (leadingTruncationElement (K := K) b horder) ↔ IsPrimal b := by + constructor + · intro h c d hdvd + have hdivT : b ∣ T (K := K) (leadingClass b horder) (c * d) := + (dvd_iff_dvd_T_leadingClass b hb0 horder (c * d)).mp hdvd + have hdivLocal : leadingTruncationElement (K := K) b horder ∣ + ⟨T (K := K) (leadingClass b horder) c, + ⟨c, rfl⟩⟩ * + ⟨T (K := K) (leadingClass b horder) d, + ⟨d, rfl⟩⟩ := by + obtain ⟨q, hq⟩ := hdivT + have hqFixed : T (K := K) (leadingClass b horder) q = q := by + apply mul_left_cancel₀ hb0 + calc + b * T (K := K) (leadingClass b horder) q = + T (K := K) (leadingClass b horder) b * + T (K := K) (leadingClass b horder) q := by + rw [T_leadingClass b horder] + _ = T (K := K) (leadingClass b horder) (b * q) := by rw [map_mul] + _ = T (K := K) (leadingClass b horder) + (T (K := K) (leadingClass b horder) (c * d)) := by rw [hq] + _ = T (K := K) (leadingClass b horder) (c * d) := T_T _ _ + _ = b * q := hq + refine ⟨⟨T (K := K) (leadingClass b horder) q, + ⟨q, rfl⟩⟩, ?_⟩ + apply Subtype.ext + change T (K := K) (leadingClass b horder) c * + T (K := K) (leadingClass b horder) d = + b * T (K := K) (leadingClass b horder) q + rw [← map_mul, hq, hqFixed] + obtain ⟨b₁, b₂, h₁, h₂, hprod⟩ := h hdivLocal + refine ⟨(b₁ : Nonpositive G R), (b₂ : Nonpositive G R), ?_, ?_, ?_⟩ + · have hb₁Ne : (b₁ : Nonpositive G R) ≠ 0 := by + intro hb₁Zero + have hb₁Zero' : b₁ = 0 := Subtype.ext hb₁Zero + apply hb0 + have hzero := congrArg Subtype.val hprod + rw [hb₁Zero', zero_mul] at hzero + exact hzero + apply (dvd_iff_dvd_T_of_fixed (leadingClass b horder) b₁.1 hb₁Ne + ((mem_truncationSubring_iff _ _).mp b₁.2) c).mpr + exact map_dvd (truncationSubring (K := K) (R := R) + (leadingClass b horder)).subtype h₁ + · have hb₂Ne : (b₂ : Nonpositive G R) ≠ 0 := by + intro hb₂Zero + have hb₂Zero' : b₂ = 0 := Subtype.ext hb₂Zero + apply hb0 + have hzero := congrArg Subtype.val hprod + rw [hb₂Zero', mul_zero] at hzero + exact hzero + apply (dvd_iff_dvd_T_of_fixed (leadingClass b horder) b₂.1 hb₂Ne + ((mem_truncationSubring_iff _ _).mp b₂.2) d).mpr + exact map_dvd (truncationSubring (K := K) (R := R) + (leadingClass b horder)).subtype h₂ + · exact congrArg Subtype.val hprod + · intro h c d hdvd + have hdvdAmbient : b ∣ (c : Nonpositive G R) * (d : Nonpositive G R) := + map_dvd (truncationSubring (K := K) (R := R) + (leadingClass b horder)).subtype hdvd + obtain ⟨b₁, b₂, h₁, h₂, hprod⟩ := h hdvdAmbient + have hb₁Mem : b₁ ∈ truncationSubring (K := K) (R := R) (leadingClass b horder) := + (mem_truncationSubring_iff _ _).mpr (T_leadingClass_of_dvd b hb0 horder + (hprod.symm ▸ dvd_mul_right b₁ b₂)) + have hb₂Mem : b₂ ∈ truncationSubring (K := K) (R := R) (leadingClass b horder) := + (mem_truncationSubring_iff _ _).mpr (T_leadingClass_of_dvd b hb0 horder + (hprod.symm ▸ dvd_mul_left b₂ b₁)) + have hb₁Ne : b₁ ≠ 0 := by + intro hz + apply hb0 + rw [hprod, hz, zero_mul] + have hb₂Ne : b₂ ≠ 0 := by + intro hz + apply hb0 + rw [hprod, hz, mul_zero] + have hq₁Mem : h₁.choose ∈ + truncationSubring (K := K) (R := R) (leadingClass b horder) := by + apply (mem_truncationSubring_iff _ _).mpr + apply mul_left_cancel₀ hb₁Ne + calc + b₁ * T (K := K) (leadingClass b horder) h₁.choose = + T (K := K) (leadingClass b horder) (b₁ * h₁.choose) := by + rw [map_mul, (mem_truncationSubring_iff _ _).mp hb₁Mem] + _ = T (K := K) (leadingClass b horder) c := by rw [← h₁.choose_spec] + _ = c := (mem_truncationSubring_iff _ _).mp c.2 + _ = b₁ * h₁.choose := h₁.choose_spec + have hq₂Mem : h₂.choose ∈ + truncationSubring (K := K) (R := R) (leadingClass b horder) := by + apply (mem_truncationSubring_iff _ _).mpr + apply mul_left_cancel₀ hb₂Ne + calc + b₂ * T (K := K) (leadingClass b horder) h₂.choose = + T (K := K) (leadingClass b horder) (b₂ * h₂.choose) := by + rw [map_mul, (mem_truncationSubring_iff _ _).mp hb₂Mem] + _ = T (K := K) (leadingClass b horder) d := by rw [← h₂.choose_spec] + _ = d := (mem_truncationSubring_iff _ _).mp d.2 + _ = b₂ * h₂.choose := h₂.choose_spec + refine ⟨⟨b₁, hb₁Mem⟩, ⟨b₂, hb₂Mem⟩, ?_, ?_, ?_⟩ + · exact ⟨⟨h₁.choose, hq₁Mem⟩, Subtype.ext h₁.choose_spec⟩ + · exact ⟨⟨h₂.choose, hq₂Mem⟩, Subtype.ext h₂.choose_spec⟩ + · exact Subtype.ext hprod + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Iterate.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Iterate.lean new file mode 100644 index 0000000000..4038db4366 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Iterate.lean @@ -0,0 +1,171 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.RingTheory.HahnSeries.Multiplication +public import Mathlib.RingTheory.HahnSeries.Cardinal +public import Mathlib.Algebra.Order.Monoid.Prod +public import Mathlib.SetTheory.Cardinal.Regular +import Mathlib.Algebra.BigOperators.Group.Finset.Sigma + +/-! +# Iterated Hahn series as Hahn series on a lexicographic product + +Mathlib's `HahnSeries.iterateEquiv` identifies an iterated Hahn series with a Hahn series whose +exponent group is a lexicographic product, but provides only an equivalence of the underlying +types. This file proves that flattening preserves addition and multiplication and packages the +identification as a ring equivalence. + +The outer exponent is the dominant coordinate. Multiplicativity reindexes the nested finite sums +over the outer and inner additive antidiagonals by the single additive antidiagonal in the +lexicographic product. +-/ + +public section + +namespace HahnSeries + +open Finset + +variable {R Γ Γ' : Type*} +variable [Semiring R] +variable [AddCommMonoid Γ] [LinearOrder Γ] [IsOrderedCancelAddMonoid Γ] +variable [AddCommMonoid Γ'] [LinearOrder Γ'] [IsOrderedCancelAddMonoid Γ'] + +omit [AddCommMonoid Γ] [IsOrderedCancelAddMonoid Γ] + [AddCommMonoid Γ'] [IsOrderedCancelAddMonoid Γ'] in +private theorem ofIterate_add (x y : R⟦Γ'⟧⟦Γ⟧) : + ofIterate (x + y) = ofIterate x + ofIterate y := by + ext g + simp [ofIterate] + +private theorem ofIterate_mul (x y : R⟦Γ'⟧⟦Γ⟧) : + ofIterate (x * y) = ofIterate x * ofIterate y := by + ext g + rcases g with ⟨g, g'⟩ + simp only [ofIterate, coeff_mul] + rw [coeff_sum] + simp only [coeff_mul] + rw [Finset.sum_sigma'] + apply Finset.sum_bij + (fun z _ ↦ (toLex (z.1.1, z.2.1), toLex (z.1.2, z.2.2))) + · intro z hz + rw [Finset.mem_sigma] at hz + rw [Finset.mem_addAntidiagonal] at hz + rw [Finset.mem_addAntidiagonal] at hz + rw [Finset.mem_addAntidiagonal] + exact ⟨hz.2.1, hz.2.2.1, Prod.ext hz.1.2.2 hz.2.2.2⟩ + · intro z₁ hz₁ z₂ hz₂ heq + have hbase : z₁.1 = z₂.1 := + Prod.ext (congrArg (fun z ↦ (ofLex z.1).1) heq) + (congrArg (fun z ↦ (ofLex z.2).1) heq) + have hfiber : z₁.2 = z₂.2 := + Prod.ext (congrArg (fun z ↦ (ofLex z.1).2) heq) + (congrArg (fun z ↦ (ofLex z.2).2) heq) + exact Sigma.ext hbase (heq_of_eq hfiber) + · intro z hz + rw [Finset.mem_addAntidiagonal] at hz + refine ⟨⟨((ofLex z.1).1, (ofLex z.2).1), ((ofLex z.1).2, (ofLex z.2).2)⟩, ?_, ?_⟩ + · rw [Finset.mem_sigma, Finset.mem_addAntidiagonal, Finset.mem_addAntidiagonal] + exact ⟨⟨ne_zero_of_coeff_ne_zero hz.1, ne_zero_of_coeff_ne_zero hz.2.1, + congrArg Prod.fst hz.2.2⟩, hz.1, hz.2.1, congrArg Prod.snd hz.2.2⟩ + · rfl + · intro z hz + rfl + +/-- The equivalence between iterated Hahn series and Hahn series on the lexicographic product, +as a ring equivalence. The outer exponent is the dominant coordinate. -/ +noncomputable def iterateRingEquiv : R⟦Γ'⟧⟦Γ⟧ ≃+* R⟦Γ ×ₗ Γ'⟧ := + { iterateEquiv with + map_add' := ofIterate_add + map_mul' := ofIterate_mul } + +@[simp] +theorem iterateRingEquiv_coeff (x : R⟦Γ'⟧⟦Γ⟧) (g : Γ) (g' : Γ') : + (iterateRingEquiv x).coeff (toLex (g, g')) = (x.coeff g).coeff g' := (rfl) + +section Cardinal + +open Cardinal + +universe u v + +variable {S : Type v} {Λ Λ' : Type u} +variable [Semiring S] +variable [AddCommMonoid Λ] [LinearOrder Λ] [IsOrderedCancelAddMonoid Λ] +variable [AddCommMonoid Λ'] [LinearOrder Λ'] [IsOrderedCancelAddMonoid Λ'] + +/-- The outer support of an iterated Hahn series is no larger than the support of its +flattening. -/ +theorem cardSupp_outer_le_cardSupp_iterateRingEquiv (x : S⟦Λ'⟧⟦Λ⟧) : + x.cardSupp ≤ (iterateRingEquiv x).cardSupp := by + rw [cardSupp, cardSupp] + let f : (Λ ×ₗ Λ') → Λ := fun p ↦ (ofLex p).1 + have hsubset : x.support ⊆ f '' (iterateRingEquiv x).support := by + intro g hg + have hg0 : x.coeff g ≠ 0 := (mem_support x g).mp hg + have hfun : (x.coeff g).coeff ≠ 0 := coeff_fun_eq_zero_iff.not.mpr hg0 + obtain ⟨g', hg'⟩ := Function.ne_iff.mp hfun + refine ⟨toLex (g, g'), ?_, rfl⟩ + rw [mem_support, iterateRingEquiv_coeff] + exact hg' + exact (Cardinal.mk_le_mk_of_subset hsubset).trans Cardinal.mk_image_le + +/-- Each coefficient support of an iterated Hahn series is no larger than the support of its +flattening. -/ +theorem cardSupp_coeff_le_cardSupp_iterateRingEquiv (x : S⟦Λ'⟧⟦Λ⟧) (g : Λ) : + (x.coeff g).cardSupp ≤ (iterateRingEquiv x).cardSupp := by + rw [cardSupp, cardSupp] + let f : Λ' → (Λ ×ₗ Λ') := fun g' ↦ toLex (g, g') + have hsubset : f '' (x.coeff g).support ⊆ (iterateRingEquiv x).support := by + rintro _ ⟨g', hg', rfl⟩ + rw [mem_support, iterateRingEquiv_coeff] + exact (mem_support (x.coeff g) g').mp hg' + have hf : Function.Injective f := by + intro a b h + exact congrArg (fun p : Λ ×ₗ Λ' ↦ (ofLex p).2) h + rw [← Cardinal.mk_image_eq hf] + exact Cardinal.mk_le_mk_of_subset hsubset + +/-- If `κ` is regular, flattening preserves the bound `< κ` when both the outer support and +all coefficient supports satisfy that bound. -/ +theorem cardSupp_iterateRingEquiv_lt_of_isRegular {κ : Cardinal.{u}} + (hκ : κ.IsRegular) (x : S⟦Λ'⟧⟦Λ⟧) (houter : x.cardSupp < κ) + (hcoeff : ∀ g, (x.coeff g).cardSupp < κ) : + (iterateRingEquiv x).cardSupp < κ := by + let t : ↥x.support → Set (Λ ×ₗ Λ') := fun g ↦ + (fun g' ↦ toLex (g.1, g')) '' (x.coeff g.1).support + have hsupport : (iterateRingEquiv x).support = ⋃ g, t g := by + ext p + constructor + · intro hp + have hp' : (x.coeff (ofLex p).1).coeff (ofLex p).2 ≠ 0 := by + have hpCoeff := (mem_support _ _).mp hp + rw [show p = toLex ((ofLex p).1, (ofLex p).2) by simp] at hpCoeff + rwa [iterateRingEquiv_coeff] at hpCoeff + have hg : (ofLex p).1 ∈ x.support := by + rw [mem_support] + exact ne_zero_of_coeff_ne_zero hp' + rw [Set.mem_iUnion] + refine ⟨⟨(ofLex p).1, hg⟩, ?_⟩ + exact ⟨(ofLex p).2, (mem_support _ _).mpr hp', by simp⟩ + · rw [Set.mem_iUnion] + rintro ⟨g, b, hb, rfl⟩ + rw [mem_support, iterateRingEquiv_coeff] + exact (mem_support _ _).mp hb + rw [cardSupp, hsupport] + apply (Cardinal.card_iUnion_lt_iff_forall_of_isRegular hκ houter).mpr + intro g + let f : Λ' → (Λ ×ₗ Λ') := fun g' ↦ toLex (g.1, g') + have hf : Function.Injective f := by + intro a b h + exact congrArg (fun p : Λ ×ₗ Λ' ↦ (ofLex p).2) h + rw [show t g = f '' (x.coeff g.1).support from rfl, Cardinal.mk_image_eq hf] + exact hcoeff g.1 + +end Cardinal + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IterateOrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IterateOrderType.lean new file mode 100644 index 0000000000..920d338263 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IterateOrderType.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Iterate +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType + +/-! +# Support order type of iterated Hahn series + +Flattening an iterated Hahn series orders its support lexicographically, with the outer exponent +dominant. Choosing one nonzero inner coefficient over each outer support point therefore embeds +the outer support into the flattened support. In particular, flattening cannot decrease the +ordinary support order type contributed by the outer series. +-/ + +public noncomputable section + +open Ordinal + +namespace HahnSeries + +universe u v + +variable {R : Type v} {Γ Γ' : Type u} +variable [Semiring R] +variable [AddCommMonoid Γ] [LinearOrder Γ] [IsOrderedCancelAddMonoid Γ] +variable [AddCommMonoid Γ'] [LinearOrder Γ'] [IsOrderedCancelAddMonoid Γ'] + +/-- The outer support order type of an iterated Hahn series is no larger than the support order +type of its flattening. -/ +theorem supportOrderType_outer_le_iterateRingEquiv (x : R⟦Γ'⟧⟦Γ⟧) : + x.supportOrderType ≤ (iterateRingEquiv x).supportOrderType := by + let inner : ↑x.support → Γ' := fun g ↦ Classical.choose + (Function.ne_iff.mp (coeff_fun_eq_zero_iff.not.mpr ((mem_support x g).mp g.2))) + have hinner (g : ↑x.support) : (x.coeff g.1).coeff (inner g) ≠ 0 := + Classical.choose_spec + (Function.ne_iff.mp (coeff_fun_eq_zero_iff.not.mpr ((mem_support x g).mp g.2))) + let f : ↑x.support → ↑(iterateRingEquiv x).support := fun g ↦ + ⟨toLex (g.1, inner g), by + rw [mem_support, iterateRingEquiv_coeff] + exact hinner g⟩ + have hf : StrictMono f := by + intro a b hab + change toLex (a.1, inner a) < toLex (b.1, inner b) + rw [Prod.Lex.toLex_lt_toLex] + exact Or.inl hab + letI : WellFoundedLT ↑x.support := ⟨x.isPWO_support.isWF⟩ + letI : WellFoundedLT ↑(iterateRingEquiv x).support := + ⟨(iterateRingEquiv x).isPWO_support.isWF⟩ + rw [supportOrderType_eq_setOrderType, supportOrderType_eq_setOrderType] + calc + x.isPWO_support.orderType = typeLT ↑x.support := + x.isPWO_support.orderType_eq_typeLT_of_orderIso (OrderIso.refl ↑x.support) + _ ≤ typeLT ↑(iterateRingEquiv x).support := + (OrderEmbedding.ofStrictMono f hf).ltEmbedding.ordinal_type_le + _ = (iterateRingEquiv x).isPWO_support.orderType := + ((iterateRingEquiv x).isPWO_support.orderType_eq_typeLT_of_orderIso + (OrderIso.refl ↑(iterateRingEquiv x).support)).symm + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/LimitTailQuotient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/LimitTailQuotient.lean new file mode 100644 index 0000000000..7accd10c7b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/LimitTailQuotient.lean @@ -0,0 +1,145 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ConvexQuotientSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedAddGroup +public import Mathlib.Algebra.Algebra.Rat +public import Mathlib.Algebra.Order.Module.Rat +public import Mathlib.Topology.Algebra.IsUniformGroup.Basic + +/-! +# Ordered common-tail quotients + +A family of finite Archimedean classes determines a common convex rational subspace. Its quotient +is ordered by representatives and carries its order topology and right uniformity. These are the +explicit Hahn exponent quotients used in the limit hypothesis of the standalone Conway theorem. +-/ + +open Set + +universe u + +public noncomputable section + +namespace FiniteArchimedeanClass + +variable {G : Type u} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module ℚ G] [PosSMulMono ℚ G] + +/-- The ordered rational quotient by the common tail of a family of finite Archimedean +classes. -/ +abbrev TailQuotient (T : Set (FiniteArchimedeanClass G)) := G ⧸ tailSubmodule ℚ T + +noncomputable instance tailQuotientLinearOrder (T : Set (FiniteArchimedeanClass G)) : + LinearOrder (TailQuotient T) := + ConvexQuotient.instLinearOrder (H := (tailSubmodule ℚ T).toAddSubgroup) + +instance tailQuotientIsOrderedAddMonoid (T : Set (FiniteArchimedeanClass G)) : + IsOrderedAddMonoid (TailQuotient T) := + ConvexQuotient.instIsOrderedAddMonoid (H := (tailSubmodule ℚ T).toAddSubgroup) + +instance tailQuotientPosSMulMono (T : Set (FiniteArchimedeanClass G)) : + PosSMulMono ℚ (TailQuotient T) where + smul_le_smul_of_nonneg_left q hq x y hxy := by + change ∃ a b : G, Submodule.Quotient.mk a = x ∧ + Submodule.Quotient.mk b = y ∧ a ≤ b at hxy + obtain ⟨a, b, ha, hb, hab⟩ := hxy + change ∃ a b : G, Submodule.Quotient.mk a = q • x ∧ + Submodule.Quotient.mk b = q • y ∧ a ≤ b + refine ⟨q • a, q • b, ?_, ?_, smul_le_smul_of_nonneg_left hab hq⟩ + · simpa only [Submodule.Quotient.mk_smul] using congrArg (q • ·) ha + · simpa only [Submodule.Quotient.mk_smul] using congrArg (q • ·) hb + +instance tailQuotientPosSMulStrictMono (T : Set (FiniteArchimedeanClass G)) : + PosSMulStrictMono ℚ (TailQuotient T) := PosSMulMono.toPosSMulStrictMono + +noncomputable instance tailQuotientTopologicalSpace (T : Set (FiniteArchimedeanClass G)) : + TopologicalSpace (TailQuotient T) := Preorder.topology (TailQuotient T) + +instance tailQuotientOrderTopology (T : Set (FiniteArchimedeanClass G)) : + OrderTopology (TailQuotient T) := ⟨rfl⟩ + +instance tailQuotientDenselyOrdered (T : Set (FiniteArchimedeanClass G)) : + DenselyOrdered (TailQuotient T) := by + constructor + intro a b hab + refine ⟨(2 : ℚ)⁻¹ • (a + b), ?_, ?_⟩ + · calc + a = (2 : ℚ)⁻¹ • (a + a) := by rw [smul_add, ← add_smul]; norm_num + _ < (2 : ℚ)⁻¹ • (a + b) := smul_lt_smul_of_pos_left + (add_lt_add_left hab a |>.trans_eq (add_comm _ _)) (by norm_num) + · calc + (2 : ℚ)⁻¹ • (a + b) < (2 : ℚ)⁻¹ • (b + b) := + smul_lt_smul_of_pos_left + (by simpa [add_comm] using add_lt_add_left hab b) (by norm_num) + _ = b := by rw [smul_add, ← add_smul]; norm_num + +instance tailQuotientIsTopologicalAddGroup (T : Set (FiniteArchimedeanClass G)) : + IsTopologicalAddGroup (TailQuotient T) where + toContinuousAdd := continuousAdd_of_orderTopology (TailQuotient T) + toContinuousNeg := continuousNeg_of_orderTopology (TailQuotient T) + +noncomputable instance tailQuotientUniformSpace (T : Set (FiniteArchimedeanClass G)) : + UniformSpace (TailQuotient T) := + IsTopologicalAddGroup.rightUniformSpace (TailQuotient T) + +instance tailQuotientIsUniformAddGroup (T : Set (FiniteArchimedeanClass G)) : + IsUniformAddGroup (TailQuotient T) := isUniformAddGroup_of_addCommGroup + +/-- Absolute value commutes with projection to a rational tail quotient. -/ +theorem tailQuotient_abs (T : Set (FiniteArchimedeanClass G)) (x : G) : + |(Submodule.Quotient.mk x : TailQuotient T)| = Submodule.Quotient.mk |x| := by + rcases le_total 0 x with hx | hx + · have hxq : (0 : TailQuotient T) ≤ Submodule.Quotient.mk x := by + rw [← Submodule.Quotient.mk_zero] + exact ConvexQuotient.mk_le_mk hx + rw [abs_of_nonneg hx, abs_of_nonneg hxq] + · have hxq : (Submodule.Quotient.mk x : TailQuotient T) ≤ 0 := by + rw [← Submodule.Quotient.mk_zero] + exact ConvexQuotient.mk_le_mk hx + rw [abs_of_nonpos hx, abs_of_nonpos hxq, ← Submodule.Quotient.mk_neg] + +/-- A strict class comparison in a rational tail quotient reflects to representatives. -/ +theorem archimedeanClass_mk_lt_of_tailQuotient_mk_lt + (T : Set (FiniteArchimedeanClass G)) {x y : G} + (h : ArchimedeanClass.mk (Submodule.Quotient.mk x : TailQuotient T) < + ArchimedeanClass.mk (Submodule.Quotient.mk y : TailQuotient T)) : + ArchimedeanClass.mk x < ArchimedeanClass.mk y := by + rw [ArchimedeanClass.mk_lt_mk] at h ⊢ + intro n + have hn := h n + have hn' : (Submodule.Quotient.mk (n • |y|) : TailQuotient T) < + Submodule.Quotient.mk |x| := by + have heq : (Submodule.Quotient.mk (n • |y|) : TailQuotient T) = + n • Submodule.Quotient.mk |y| := by + change QuotientAddGroup.mk' _ (n • |y|) = n • QuotientAddGroup.mk' _ |y| + exact map_nsmul (QuotientAddGroup.mk' _) n |y| + rw [heq] + simpa only [tailQuotient_abs] using hn + exact ConvexQuotient.lt_of_mk_lt_mk hn' + +/-- Canonical representatives of a limit family are coinitial in its rational tail quotient. -/ +theorem exists_tailQuotient_positiveRepresentative_le + {T : Set (FiniteArchimedeanClass G)} + {x : TailQuotient T} (hx : 0 < x) : + ∃ c : T, (Submodule.Quotient.mk (positiveRepresentative c.1) : TailQuotient T) ≤ x := by + induction x using Submodule.Quotient.induction_on with + | H x => + have hxq : (Submodule.Quotient.mk (0 : G) : TailQuotient T) < + Submodule.Quotient.mk x := by + simpa using hx + have hx0 : 0 < x := ConvexQuotient.lt_of_mk_lt_mk hxq + have hxP : x ∉ tailSubmodule ℚ T := by + simpa using (ConvexQuotient.mk_lt_mk_iff.mp hxq).2 + rw [mem_tailSubmodule_iff, mem_tailKernel_iff] at hxP + push Not at hxP + obtain ⟨c, hxc⟩ := hxP + refine ⟨c, ConvexQuotient.mk_le_mk ?_⟩ + apply (ArchimedeanClass.lt_of_mk_lt_mk_of_nonneg ?_ hx0.le).le + rwa [mk_positiveRepresentative] + +end FiniteArchimedeanClass diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Monomial.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Monomial.lean new file mode 100644 index 0000000000..22d1815588 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Monomial.lean @@ -0,0 +1,173 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive + +import Mathlib.Algebra.GroupWithZero.Divisibility + +/-! +# Monomials in a nonpositive Hahn-series ring + +A monomial is a nonzero scalar multiple of a single group monomial. This is the notion used +throughout LM24 and, in particular, in Section 6.5. The support-singleton characterization is +intrinsic and avoids exposing the proof that the exponent is nonpositive. + +The unit lemmas record a boundary specific to the nonpositive ring: every unit has support +exactly `{0}`, and hence a nonzero monomial is a unit precisely when its exponent is zero. +-/ + +open scoped HahnSeries + +universe u v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type v} + [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] + [Field K] + +/-- A nonzero scalar multiple of one group monomial. -/ +def IsMonomial (b : Nonpositive G K) : Prop := + ∃ (g : G) (k : K) (hg : g ≤ 0), k ≠ 0 ∧ b = single g k hg + +/-- Characterization of a monomial by an exponent, a nonzero coefficient, and a single Hahn +monomial. -/ +theorem isMonomial_iff {b : Nonpositive G K} : + IsMonomial b ↔ + ∃ (g : G) (k : K) (hg : g ≤ 0), k ≠ 0 ∧ b = single g k hg := + Iff.rfl + +/-- A nonpositive Hahn series is a monomial exactly when its support is a singleton. -/ +theorem isMonomial_iff_support_eq_singleton {b : Nonpositive G K} : + IsMonomial b ↔ ∃ g : G, (b : K⟦G⟧).support = {g} := by + constructor + · rintro ⟨g, k, hg, hk, rfl⟩ + exact ⟨g, by simp [coe_single, hk]⟩ + · rintro ⟨g, hsupport⟩ + have hgmem : g ∈ (b : K⟦G⟧).support := by simp [hsupport] + have hg : g ≤ 0 := support_subset b hgmem + have hk : (b : K⟦G⟧).coeff g ≠ 0 := by + rwa [HahnSeries.mem_support] at hgmem + refine ⟨g, (b : K⟦G⟧).coeff g, hg, hk, ?_⟩ + apply Subtype.ext + ext h + by_cases hh : h = g + · subst h + simp [coe_single] + · have hhmem : h ∉ (b : K⟦G⟧).support := by simp [hsupport, hh] + rw [HahnSeries.mem_support, not_ne_iff] at hhmem + simp [coe_single, hh, hhmem] + +/-- A monomial is nonzero. -/ +theorem IsMonomial.ne_zero {b : Nonpositive G K} (hb : IsMonomial b) : b ≠ 0 := by + rw [isMonomial_iff_support_eq_singleton] at hb + obtain ⟨g, hg⟩ := hb + intro hzero + subst b + simp at hg + +/-- A monomial has finite support. -/ +theorem IsMonomial.support_finite {b : Nonpositive G K} (hb : IsMonomial b) : + (b : K⟦G⟧).support.Finite := by + obtain ⟨g, hg⟩ := isMonomial_iff_support_eq_singleton.mp hb + rw [hg] + exact Set.finite_singleton g + +/-- Every unit of the nonpositive Hahn-series ring has support exactly `{0}`. -/ +theorem support_eq_singleton_zero_of_isUnit {b : Nonpositive G K} (hb : IsUnit b) : + (b : K⟦G⟧).support = {0} := by + obtain ⟨u, rfl⟩ := hb + let c : Nonpositive G K := ↑u⁻¹ + have hbNe : (↑u : Nonpositive G K) ≠ 0 := IsUnit.ne_zero u.isUnit + have hcNe : c ≠ 0 := IsUnit.ne_zero (u⁻¹).isUnit + have hbNe' : ((↑u : Nonpositive G K) : K⟦G⟧) ≠ 0 := + fun h ↦ hbNe (Subtype.ext h) + have hcNe' : (c : K⟦G⟧) ≠ 0 := fun h ↦ hcNe (Subtype.ext h) + have hproduct : (↑u : Nonpositive G K) * c = 1 := by + simp [c] + have horder := congrArg HahnSeries.order (congrArg Subtype.val hproduct) + have horder' : (↑u : K⟦G⟧).order + (c : K⟦G⟧).order = 0 := by + simpa [HahnSeries.order_mul hbNe' hcNe'] using horder + have hbOrderMem : (↑u : K⟦G⟧).order ∈ (↑u : K⟦G⟧).support := by + rw [HahnSeries.mem_support] + exact HahnSeries.coeff_order_eq_zero.not.mpr hbNe' + have hcOrderMem : (c : K⟦G⟧).order ∈ (c : K⟦G⟧).support := by + rw [HahnSeries.mem_support] + exact HahnSeries.coeff_order_eq_zero.not.mpr hcNe' + have hbOrderNonpos := support_subset (↑u : Nonpositive G K) hbOrderMem + have hcOrderNonpos := support_subset c hcOrderMem + have hbOrderZero : (↑u : K⟦G⟧).order = 0 := + eq_zero_of_add_nonneg_left hbOrderNonpos hcOrderNonpos horder'.ge + apply Set.Subset.antisymm + · intro g hg + rw [Set.mem_singleton_iff] + apply le_antisymm (support_subset (↑u : Nonpositive G K) hg) + rw [← hbOrderZero] + rw [HahnSeries.mem_support] at hg + exact HahnSeries.order_le_of_coeff_ne_zero hg + · intro g hg + rw [Set.mem_singleton_iff] at hg + subst g + simpa [hbOrderZero] using hbOrderMem + +/-- Every unit is the constant series determined by its coefficient at zero. -/ +theorem eq_C_constantCoeff_of_isUnit {b : Nonpositive G K} (hb : IsUnit b) : + b = C (constantCoeff b) := by + have hsupport := support_eq_singleton_zero_of_isUnit hb + apply Subtype.ext + apply HahnSeries.coeff_injective + funext g + by_cases hg : g = 0 + · subst g + simp [constantCoeff_apply] + · have hgNotMem : g ∉ (b : K⟦G⟧).support := by + rw [hsupport] + simpa using hg + rw [HahnSeries.mem_support, not_ne_iff] at hgNotMem + simp [hg, hgNotMem] + +/-- Every unit of the nonpositive Hahn-series ring is a monomial. -/ +theorem isMonomial_of_isUnit {b : Nonpositive G K} (hb : IsUnit b) : + IsMonomial b := + isMonomial_iff_support_eq_singleton.mpr + ⟨0, support_eq_singleton_zero_of_isUnit hb⟩ + +/-- A unit with constant coefficient one is the multiplicative identity. -/ +theorem eq_one_of_isUnit_of_constantCoeff_eq_one {b : Nonpositive G K} + (hbUnit : IsUnit b) (hbConstant : constantCoeff b = 1) : b = 1 := by + have hsupport := support_eq_singleton_zero_of_isUnit hbUnit + apply Subtype.ext + apply HahnSeries.coeff_injective + funext g + by_cases hg : g = 0 + · subst g + simpa [constantCoeff_apply] using hbConstant + · have hgNotMem : g ∉ (b : K⟦G⟧).support := by + rw [hsupport] + simpa using hg + rw [HahnSeries.mem_support, not_ne_iff] at hgNotMem + simp [hg, hgNotMem] + +/-- A nonzero monomial in the nonpositive ring is a unit exactly at exponent zero. -/ +theorem isUnit_single_iff {g : G} {k : K} (hk : k ≠ 0) (hg : g ≤ 0) : + IsUnit (single g k hg) ↔ g = 0 := by + constructor + · intro hunit + have hsupport := support_eq_singleton_zero_of_isUnit hunit + rw [coe_single, HahnSeries.support_single_of_ne hk] at hsupport + exact Set.singleton_injective hsupport + · rintro rfl + have hconstant : single (0 : G) k le_rfl = (C : K →+* Nonpositive G K) k := by + apply Subtype.ext + rw [coe_single, coe_C] + rfl + rw [hconstant] + exact (isUnit_iff_ne_zero.mpr hk).map C + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Multiplicativity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Multiplicativity.lean new file mode 100644 index 0000000000..bf1181c308 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Multiplicativity.lean @@ -0,0 +1,572 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm + +/-! +# Multiplicativity of support order type and degree + +LM24, Fact 3.4.1 imports Berarducci's theorem that support order type is multiplicative on +weakly principal nonpositive real Hahn series. The predicate +`OrderTypeMultiplicativeOnWeaklyPrincipal` records that exact mathematical law. Its proof in +characteristic zero is in `ConwayRefinement.HahnSeries.OrdinalValue.OrderTypeMultiplicativity`. + +The repaired `degree_truncLE_mul_lt` formalizes LM24, Lemma 3.4.2. The printed statement omits +`c ≠ 0`: its first support condition holds vacuously for `c = 0`, whereas the asserted strict +inequality then reads `⊥ < ⊥`. The additional hypothesis is necessary and is already implicit in +the printed proof when it chooses an exponent strictly below the support of `c`. + +Assuming the Berarducci law, `degree_mul_of_orderTypeMultiplicativeOnWeaklyPrincipal` proves +LM24, Proposition 3.4.3. Its proof uses the principal head decomposition from Proposition 3.3.7 +and the repaired truncation lemma. In the branch where a remainder has smaller degree, the proof +uses the strict upper bound with the degree of the original factor; this repairs the repeated +right-hand side in the displayed inequality on published page 30. + +Mathlib contains no corresponding Hahn-series multiplicativity theorem. +CombinatorialGames supplies `NatOrdinal.wpow_add`, which is used to show that the natural product +of two powers of `ω` is again a power of `ω`. The order-type law itself remains precisely the +Berarducci prerequisite imported by LM24. +-/ + +universe v + +public noncomputable section + +namespace HahnSeries + +open Ordinal + +variable {R : Type v} [Ring R] + +private theorem naturalMul_isAdditivelyPrincipal {a b : Ordinal} + (ha : a.IsAdditivelyPrincipal) (hb : b.IsAdditivelyPrincipal) : + (NatOrdinal.of a * NatOrdinal.of b).val.IsAdditivelyPrincipal := by + obtain ⟨e, rfl⟩ := Ordinal.isAdditivelyPrincipal_iff.mp ha + obtain ⟨f, rfl⟩ := Ordinal.isAdditivelyPrincipal_iff.mp hb + apply Ordinal.isAdditivelyPrincipal_iff.mpr + refine ⟨(NatOrdinal.of e + NatOrdinal.of f).val, ?_⟩ + have he : NatOrdinal.of (Ordinal.omega0 ^ e) = + (ω^ (NatOrdinal.of e) : NatOrdinal) := by + apply NatOrdinal.val.injective + simp only [NatOrdinal.val_of, NatOrdinal.val_wpow] + have hf : NatOrdinal.of (Ordinal.omega0 ^ f) = + (ω^ (NatOrdinal.of f) : NatOrdinal) := by + apply NatOrdinal.val.injective + simp only [NatOrdinal.val_of, NatOrdinal.val_wpow] + rw [he, hf, ← NatOrdinal.wpow_add, NatOrdinal.val_wpow] + +/-- A Hahn series whose support order type is strictly below a weakly principal support has +strictly smaller degree. -/ +theorem degree_lt_of_supportOrderType_lt_of_isWeaklyPrincipal + {x y : R⟦ℝ⟧} (hx : IsWeaklyPrincipal x) + (hyx : y.supportOrderType < x.supportOrderType) : + y.degree < x.degree := by + obtain ⟨e, he⟩ := + Ordinal.isAdditivelyPrincipal_iff.mp (isWeaklyPrincipal_iff.mp hx) + rw [he] at hyx + rw [degree_eq_cantorDegree, degree_eq_cantorDegree, he] + have hpower : Ordinal.cantorDegree (Ordinal.omega0 ^ e) = NatOrdinal.of e := by + rw [Ordinal.cantorDegree_of_ne_zero + (Ordinal.opow_ne_zero e Ordinal.omega0_ne_zero), + Ordinal.log_opow Ordinal.one_lt_omega0] + by_cases hy : y = 0 + · rw [hy, supportOrderType_zero, Ordinal.cantorDegree_zero, hpower] + exact WithBot.bot_lt_coe _ + rw [Ordinal.cantorDegree_of_ne_zero (supportOrderType_eq_zero.not.mpr hy), hpower, + WithBot.coe_lt_coe, NatOrdinal.of_lt_iff] + exact (Ordinal.lt_opow_iff_log_lt Ordinal.one_lt_omega0 + (supportOrderType_eq_zero.not.mpr hy)).mp hyx + +namespace Nonpositive + +variable {K : Type v} [Field K] + +/-- Support order type is multiplicative, using Hessenberg multiplication, on weakly principal +nonpositive real Hahn series over `K`. This is the exact law imported as LM24, Fact 3.4.1. + +The predicate is meaningful over any field. Its proof from Berarducci's result retains the +characteristic-zero hypothesis in LM24's ambient assumptions. -/ +def OrderTypeMultiplicativeOnWeaklyPrincipal (K : Type v) [Field K] : Prop := + ∀ b c : Nonpositive ℝ K, + IsWeaklyPrincipal (b : K⟦ℝ⟧) → + IsWeaklyPrincipal (c : K⟦ℝ⟧) → + ((b * c : Nonpositive ℝ K) : K⟦ℝ⟧).supportOrderType = + (NatOrdinal.of (b : K⟦ℝ⟧).supportOrderType * + NatOrdinal.of (c : K⟦ℝ⟧).supportOrderType).val + +/-- Characterization of multiplicativity on weakly principal series. -/ +theorem orderTypeMultiplicativeOnWeaklyPrincipal_iff : + OrderTypeMultiplicativeOnWeaklyPrincipal K ↔ + ∀ b c : Nonpositive ℝ K, + IsWeaklyPrincipal (b : K⟦ℝ⟧) → + IsWeaklyPrincipal (c : K⟦ℝ⟧) → + ((b * c : Nonpositive ℝ K) : K⟦ℝ⟧).supportOrderType = + (NatOrdinal.of (b : K⟦ℝ⟧).supportOrderType * + NatOrdinal.of (c : K⟦ℝ⟧).supportOrderType).val := + Iff.rfl + +/-- Apply support-order-type multiplicativity to two weakly principal series. -/ +theorem OrderTypeMultiplicativeOnWeaklyPrincipal.supportOrderType_mul + (h : OrderTypeMultiplicativeOnWeaklyPrincipal K) + {b c : Nonpositive ℝ K} + (hb : IsWeaklyPrincipal (b : K⟦ℝ⟧)) + (hc : IsWeaklyPrincipal (c : K⟦ℝ⟧)) : + ((b * c : Nonpositive ℝ K) : K⟦ℝ⟧).supportOrderType = + (NatOrdinal.of (b : K⟦ℝ⟧).supportOrderType * + NatOrdinal.of (c : K⟦ℝ⟧).supportOrderType).val := + (orderTypeMultiplicativeOnWeaklyPrincipal_iff.mp h) b c hb hc + +/-- Under support-order-type multiplicativity, degree is multiplicative on weakly principal +series. -/ +theorem OrderTypeMultiplicativeOnWeaklyPrincipal.degree_mul + (h : OrderTypeMultiplicativeOnWeaklyPrincipal K) + {b c : Nonpositive ℝ K} + (hb : IsWeaklyPrincipal (b : K⟦ℝ⟧)) + (hc : IsWeaklyPrincipal (c : K⟦ℝ⟧)) : + ((b * c : Nonpositive ℝ K) : K⟦ℝ⟧).degree = + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + rw [degree_eq_cantorDegree, h.supportOrderType_mul hb hc, + ← NatOrdinal.cantorDegree_eq_ordinalCantorDegree, + NatOrdinal.cantorDegree_mul, NatOrdinal.cantorDegree_of, + NatOrdinal.cantorDegree_of, ← degree_eq_cantorDegree, + ← degree_eq_cantorDegree] + +/-- Under support-order-type multiplicativity, the product of weakly principal series is weakly +principal. -/ +theorem OrderTypeMultiplicativeOnWeaklyPrincipal.isWeaklyPrincipal_mul + (h : OrderTypeMultiplicativeOnWeaklyPrincipal K) + {b c : Nonpositive ℝ K} + (hb : IsWeaklyPrincipal (b : K⟦ℝ⟧)) + (hc : IsWeaklyPrincipal (c : K⟦ℝ⟧)) : + IsWeaklyPrincipal ((b * c : Nonpositive ℝ K) : K⟦ℝ⟧) := by + rw [isWeaklyPrincipal_iff, h.supportOrderType_mul hb hc] + exact naturalMul_isAdditivelyPrincipal + (isWeaklyPrincipal_iff.mp hb) (isWeaklyPrincipal_iff.mp hc) + +private theorem truncLE_eq_zero_of_support_subset_Ioi + {x : K⟦ℝ⟧} {a : ℝ} (h : x.support ⊆ Set.Ioi a) : + truncLE a x = 0 := by + rw [← support_eq_empty_iff, support_truncLE] + ext i + simp only [Set.mem_setOf_eq, Set.mem_empty_iff_false, iff_false, not_and] + exact fun hi hia ↦ (not_lt_of_ge hia) (h hi) + +private theorem support_mul_subset_Ici_add + {b c : K⟦ℝ⟧} {x y : ℝ} + (hb : b.support ⊆ Set.Ici x) (hc : c.support ⊆ Set.Ici y) : + (b * c).support ⊆ Set.Ici (x + y) := by + intro z hz + obtain ⟨i, hi, j, hj, rfl⟩ := support_mul_subset hz + have hxi : x ≤ i := hb hi + have hyj : y ≤ j := hc hj + exact add_le_add hxi hyj + +private theorem support_mul_subset_Ioi_add + {b c : K⟦ℝ⟧} {x y : ℝ} + (hb : b.support ⊆ Set.Ioi x) (hc : c.support ⊆ Set.Ioi y) : + (b * c).support ⊆ Set.Ioi (x + y) := by + intro z hz + obtain ⟨i, hi, j, hj, rfl⟩ := support_mul_subset hz + have hxi : x < i := hb hi + have hyj : y < j := hc hj + exact add_lt_add hxi hyj + +/-- The strict-support case of the repaired LM24, Lemma 3.4.2. The nonzero hypothesis is necessary +because strict support containment is vacuous for the zero series. -/ +theorem degree_truncLE_mul_lt_of_isPrincipal_of_support_subset_Ioi + {b c : Nonpositive ℝ K} {x : ℝ} + (hb : IsPrincipal b) (hcne : c ≠ 0) + (hc : (c : K⟦ℝ⟧).support ⊆ Set.Ioi x) : + (truncLE x ((b * c : Nonpositive ℝ K) : K⟦ℝ⟧)).degree < + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + have hcne' : (c : K⟦ℝ⟧) ≠ 0 := by simpa using hcne + have horderMem : (c : K⟦ℝ⟧).order ∈ (c : K⟦ℝ⟧).support := + (mem_support _ _).mpr (coeff_order_eq_zero.not.mpr hcne') + have hxorder : x < (c : K⟦ℝ⟧).order := hc horderMem + let y : ℝ := (x + (c : K⟦ℝ⟧).order) / 2 + have hxy : x < y := by + dsimp [y] + linarith + have hyorder : y < (c : K⟦ℝ⟧).order := by + dsimp [y] + linarith + have hcAboveY : (c : K⟦ℝ⟧).support ⊆ Set.Ioi y := by + intro i hi + exact hyorder.trans_le + (order_le_of_coeff_ne_zero ((mem_support _ _).mp hi)) + let a : ℝ := x - y + let d : K⟦ℝ⟧ := truncLE a (b : K⟦ℝ⟧) + let e : K⟦ℝ⟧ := truncGT a (b : K⟦ℝ⟧) + have ha : a < 0 := by + dsimp [a] + linarith + have hbLUB : IsLUB (b : K⟦ℝ⟧).support 0 := + (supportSup_eq_coe_iff.mp hb.supportSup_eq_zero).2 + obtain ⟨g, hg, hag, _⟩ := hbLUB.exists_between ha + have hdne : d ≠ (b : K⟦ℝ⟧) := by + intro hdb + have hcoeff := congrArg (fun z : K⟦ℝ⟧ ↦ z.coeff g) hdb + have hzero : d.coeff g = 0 := + coeff_truncLE_of_lt hag (b : K⟦ℝ⟧) + exact (mem_support _ _).mp hg (hcoeff.symm.trans hzero) + have hecAbove : (e * (c : K⟦ℝ⟧)).support ⊆ Set.Ioi x := by + intro z hz + obtain ⟨i, hi, j, hj, hij⟩ := support_mul_subset hz + rw [support_truncGT] at hi + have hji : y < j := hcAboveY hj + have hia : a < i := hi.2 + change x < z + rw [← hij] + dsimp [a] at hia + linarith + have htruncProduct : + truncLE x ((b * c : Nonpositive ℝ K) : K⟦ℝ⟧) = + truncLE x (d * (c : K⟦ℝ⟧)) := by + change truncLE x ((b : K⟦ℝ⟧) * (c : K⟦ℝ⟧)) = _ + calc + truncLE x ((b : K⟦ℝ⟧) * (c : K⟦ℝ⟧)) = + truncLE x ((d + e) * (c : K⟦ℝ⟧)) := by + rw [truncLE_add_truncGT a (b : K⟦ℝ⟧)] + _ = truncLE x (d * (c : K⟦ℝ⟧) + e * (c : K⟦ℝ⟧)) := by + rw [add_mul] + _ = truncLE x (d * (c : K⟦ℝ⟧)) + + truncLE x (e * (c : K⟦ℝ⟧)) := truncLE_add _ _ _ + _ = truncLE x (d * (c : K⟦ℝ⟧)) := by + rw [truncLE_eq_zero_of_support_subset_Ioi hecAbove, add_zero] + rw [htruncProduct] + calc + (truncLE x (d * (c : K⟦ℝ⟧))).degree ≤ + (d * (c : K⟦ℝ⟧)).degree := + degree_truncLE_le _ _ + _ ≤ d.degree + (c : K⟦ℝ⟧).degree := degree_mul_le _ _ + _ < (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + rw [WithBot.add_lt_add_iff_right (degree_eq_bot.not.mpr hcne')] + exact degree_lt_of_supportOrderType_lt_of_isWeaklyPrincipal + hb.isWeaklyPrincipal (supportOrderType_truncLE_lt a hdne) + +private theorem degree_truncLE_le_zero_of_support_subset_Ici + {c : K⟦ℝ⟧} {x : ℝ} (hc : c.support ⊆ Set.Ici x) : + (truncLE x c).degree ≤ 0 := by + have hsupport : (truncLE x c).support ⊆ {x} := by + rw [support_truncLE] + rintro i ⟨hi, hix⟩ + exact Set.mem_singleton_iff.mpr (le_antisymm hix (hc hi)) + have hfinite : (truncLE x c).support.Finite := + Set.finite_singleton x |>.subset hsupport + by_cases hzero : truncLE x c = 0 + · simp [hzero] + · rw [(degree_eq_zero.mpr ⟨hzero, hfinite⟩)] + +/-- The weak-support, positive-degree case of the repaired LM24, Lemma 3.4.2. -/ +theorem degree_truncLE_mul_lt_of_isPrincipal_of_support_subset_Ici_of_degree_pos + {b c : Nonpositive ℝ K} {x : ℝ} + (hb : IsPrincipal b) (hc : (c : K⟦ℝ⟧).support ⊆ Set.Ici x) + (hcDegree : 0 < (c : K⟦ℝ⟧).degree) : + (truncLE x ((b * c : Nonpositive ℝ K) : K⟦ℝ⟧)).degree < + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + let cLower : Nonpositive ℝ K := + ⟨truncLE x (c : K⟦ℝ⟧), + (mem_nonpositiveSubring (x := truncLE x (c : K⟦ℝ⟧))).mpr + ((support_truncLE_subset x (c : K⟦ℝ⟧)).trans (support_subset c))⟩ + let cUpper : Nonpositive ℝ K := + ⟨truncGT x (c : K⟦ℝ⟧), + (mem_nonpositiveSubring (x := truncGT x (c : K⟦ℝ⟧))).mpr + ((support_truncGT_subset x (c : K⟦ℝ⟧)).trans (support_subset c))⟩ + have hcLowerDegree : (cLower : K⟦ℝ⟧).degree ≤ 0 := + degree_truncLE_le_zero_of_support_subset_Ici hc + have hcUpperNe : cUpper ≠ 0 := by + intro hzero + have hzero' : truncGT x (c : K⟦ℝ⟧) = 0 := + congrArg Subtype.val hzero + have hcEq : (c : K⟦ℝ⟧) = (cLower : K⟦ℝ⟧) := by + calc + (c : K⟦ℝ⟧) = + truncLE x (c : K⟦ℝ⟧) + truncGT x (c : K⟦ℝ⟧) := + (truncLE_add_truncGT x (c : K⟦ℝ⟧)).symm + _ = (cLower : K⟦ℝ⟧) := by rw [hzero', add_zero] + exact (not_lt_of_ge (hcEq ▸ hcLowerDegree)) hcDegree + have hcUpperSupport : (cUpper : K⟦ℝ⟧).support ⊆ Set.Ioi x := by + rw [show (cUpper : K⟦ℝ⟧) = truncGT x (c : K⟦ℝ⟧) from rfl, + support_truncGT] + exact fun _ hi ↦ hi.2 + have hcUpperDegree : + (cUpper : K⟦ℝ⟧).degree ≤ (c : K⟦ℝ⟧).degree := + degree_mono_support (support_truncGT_subset x (c : K⟦ℝ⟧)) + have hLower : + (truncLE x ((b : K⟦ℝ⟧) * (cLower : K⟦ℝ⟧))).degree < + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + calc + (truncLE x ((b : K⟦ℝ⟧) * (cLower : K⟦ℝ⟧))).degree ≤ + ((b : K⟦ℝ⟧) * (cLower : K⟦ℝ⟧)).degree := + degree_truncLE_le _ _ + _ ≤ (b : K⟦ℝ⟧).degree + (cLower : K⟦ℝ⟧).degree := + degree_mul_le _ _ + _ < (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + rw [WithBot.add_lt_add_iff_left + (degree_eq_bot.not.mpr (by simpa using hb.ne_zero))] + exact hcLowerDegree.trans_lt hcDegree + have hUpper : + (truncLE x ((b : K⟦ℝ⟧) * (cUpper : K⟦ℝ⟧))).degree < + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + exact (degree_truncLE_mul_lt_of_isPrincipal_of_support_subset_Ioi + hb hcUpperNe hcUpperSupport).trans_le + (add_le_add_right hcUpperDegree _) + have hProduct : + (b : K⟦ℝ⟧) * (c : K⟦ℝ⟧) = + (b : K⟦ℝ⟧) * (cLower : K⟦ℝ⟧) + + (b : K⟦ℝ⟧) * (cUpper : K⟦ℝ⟧) := by + rw [show (c : K⟦ℝ⟧) = + (cLower : K⟦ℝ⟧) + (cUpper : K⟦ℝ⟧) from + (truncLE_add_truncGT x (c : K⟦ℝ⟧)).symm, mul_add] + change (truncLE x ((b : K⟦ℝ⟧) * (c : K⟦ℝ⟧))).degree < _ + calc + (truncLE x ((b : K⟦ℝ⟧) * (c : K⟦ℝ⟧))).degree = + (truncLE x ((b : K⟦ℝ⟧) * (cLower : K⟦ℝ⟧) + + (b : K⟦ℝ⟧) * (cUpper : K⟦ℝ⟧))).degree := + congrArg degree (congrArg (truncLE x) hProduct) + _ = (truncLE x ((b : K⟦ℝ⟧) * (cLower : K⟦ℝ⟧)) + + truncLE x ((b : K⟦ℝ⟧) * (cUpper : K⟦ℝ⟧))).degree := by + rw [truncLE_add] + _ ≤ max + (truncLE x ((b : K⟦ℝ⟧) * (cLower : K⟦ℝ⟧))).degree + (truncLE x ((b : K⟦ℝ⟧) * (cUpper : K⟦ℝ⟧))).degree := + degree_add_le _ _ + _ < (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := + max_lt hLower hUpper + +/-- Repaired LM24, Lemma 3.4.2. If `b` is principal, `c` is nonzero, and the support of `c` is +strictly above `x`, or is weakly above `x` with positive degree, then the degree of the weak lower +truncation of `b * c` is strictly below the natural sum of the factor degrees. -/ +theorem degree_truncLE_mul_lt + {b c : Nonpositive ℝ K} {x : ℝ} + (hb : IsPrincipal b) (hcne : c ≠ 0) + (hc : (c : K⟦ℝ⟧).support ⊆ Set.Ioi x ∨ + (c : K⟦ℝ⟧).support ⊆ Set.Ici x ∧ + 0 < (c : K⟦ℝ⟧).degree) : + (truncLE x ((b * c : Nonpositive ℝ K) : K⟦ℝ⟧)).degree < + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + rcases hc with hc | ⟨hc, hcDegree⟩ + · exact degree_truncLE_mul_lt_of_isPrincipal_of_support_subset_Ioi + hb hcne hc + · exact + degree_truncLE_mul_lt_of_isPrincipal_of_support_subset_Ici_of_degree_pos + hb hc hcDegree + +private theorem degree_truncLE_principal_mul_remainder_lt + {p r c : Nonpositive ℝ K} {x : ℝ} + (hp : IsPrincipal p) (hcne : c ≠ 0) + (hrSupport : (r : K⟦ℝ⟧).support ⊆ Set.Ici x) + (hrDegree : (r : K⟦ℝ⟧).degree ≤ (c : K⟦ℝ⟧).degree) + (hrStrict : (c : K⟦ℝ⟧).degree = 0 → + (r : K⟦ℝ⟧).support ⊆ Set.Ioi x) : + (truncLE x ((p * r : Nonpositive ℝ K) : K⟦ℝ⟧)).degree < + (p : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + rcases hrDegree.lt_or_eq with hrDegree | hrDegree + · calc + (truncLE x ((p * r : Nonpositive ℝ K) : K⟦ℝ⟧)).degree ≤ + ((p : K⟦ℝ⟧) * (r : K⟦ℝ⟧)).degree := + degree_truncLE_le _ _ + _ ≤ (p : K⟦ℝ⟧).degree + (r : K⟦ℝ⟧).degree := + degree_mul_le _ _ + _ < (p : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + rw [WithBot.add_lt_add_iff_left + (degree_eq_bot.not.mpr (by simpa using hp.ne_zero))] + exact hrDegree + · have hrne : r ≠ 0 := by + intro hzero + have hcDegreeBot : (c : K⟦ℝ⟧).degree = ⊥ := by + rw [← hrDegree, hzero] + exact degree_zero + exact hcne (by + apply Subtype.ext + exact degree_eq_bot.mp hcDegreeBot) + have hcne' : (c : K⟦ℝ⟧) ≠ 0 := by simpa using hcne + rcases (zero_le_degree_of_ne_zero hcne').eq_or_lt with + hcDegree | hcDegree + · have h := degree_truncLE_mul_lt hp hrne + (Or.inl (hrStrict hcDegree.symm)) + simpa [hrDegree] using h + · have h := degree_truncLE_mul_lt hp hrne + (Or.inr ⟨hrSupport, hrDegree ▸ hcDegree⟩) + simpa [hrDegree] using h + +/-- The weak lower truncation at `x + y` of a product of two head decompositions +`translate x b₁ + b'` and `translate y c₁ + c'`. The head term `translate (x + y) (b₁ * c₁)` +survives the truncation unchanged, since `b₁ * c₁` is nonpositive; the two cross terms are +truncated at the shifted cutoffs `y` and `x`; the remainder product is truncated at `x + y`. -/ +private theorem truncLE_add_mul_add_of_head_decomposition + (b₁ b' c₁ c' : Nonpositive ℝ K) (x y : ℝ) : + truncLE (x + y) ((translate x (b₁ : K⟦ℝ⟧) + (b' : K⟦ℝ⟧)) * + (translate y (c₁ : K⟦ℝ⟧) + (c' : K⟦ℝ⟧))) = + translate (x + y) ((b₁ * c₁ : Nonpositive ℝ K) : K⟦ℝ⟧) + + (translate x (truncLE y ((b₁ * c' : Nonpositive ℝ K) : K⟦ℝ⟧)) + + (translate y (truncLE x ((c₁ * b' : Nonpositive ℝ K) : K⟦ℝ⟧)) + + truncLE (x + y) ((b' * c' : Nonpositive ℝ K) : K⟦ℝ⟧))) := by + have hHeadProduct : + translate x (b₁ : K⟦ℝ⟧) * translate y (c₁ : K⟦ℝ⟧) = + translate (x + y) ((b₁ * c₁ : Nonpositive ℝ K) : K⟦ℝ⟧) := + translate_mul_translate x y (b₁ : K⟦ℝ⟧) (c₁ : K⟦ℝ⟧) + have hSecondProduct : + translate x (b₁ : K⟦ℝ⟧) * (c' : K⟦ℝ⟧) = + translate x ((b₁ * c' : Nonpositive ℝ K) : K⟦ℝ⟧) := by + simpa using translate_mul_translate + x 0 (b₁ : K⟦ℝ⟧) (c' : K⟦ℝ⟧) + have hThirdProduct : + (b' : K⟦ℝ⟧) * translate y (c₁ : K⟦ℝ⟧) = + translate y ((c₁ * b' : Nonpositive ℝ K) : K⟦ℝ⟧) := by + rw [mul_comm] + simpa using translate_mul_translate + y 0 (c₁ : K⟦ℝ⟧) (b' : K⟦ℝ⟧) + have hHeadTrunc : + truncLE (x + y) (translate (x + y) ((b₁ * c₁ : Nonpositive ℝ K) : K⟦ℝ⟧)) = + translate (x + y) ((b₁ * c₁ : Nonpositive ℝ K) : K⟦ℝ⟧) := by + rw [truncLE_translate, _root_.sub_self] + rw [truncLE_eq_self_of_support_subset_Iic (support_subset (b₁ * c₁))] + have hSecondTrunc : + truncLE (x + y) (translate x ((b₁ * c' : Nonpositive ℝ K) : K⟦ℝ⟧)) = + translate x (truncLE y ((b₁ * c' : Nonpositive ℝ K) : K⟦ℝ⟧)) := by + rw [truncLE_translate] + simp only [add_sub_cancel_left] + have hThirdTrunc : + truncLE (x + y) (translate y ((c₁ * b' : Nonpositive ℝ K) : K⟦ℝ⟧)) = + translate y (truncLE x ((c₁ * b' : Nonpositive ℝ K) : K⟦ℝ⟧)) := by + rw [truncLE_translate] + simp only [add_sub_cancel_right] + rw [add_mul, mul_add, mul_add, hHeadProduct, hSecondProduct, hThirdProduct, + truncLE_add, truncLE_add, truncLE_add, hHeadTrunc, hSecondTrunc, hThirdTrunc] + simp only [add_assoc] + rfl + +/-- The remainder-times-remainder term of the head expansion has degree strictly below the sum of +the factor degrees. When that sum is positive, the truncation of a series supported weakly above +the cutoff has degree at most `0`. When both degrees are `0`, both remainders are supported +strictly above their cutoffs, so the truncated product vanishes and its degree is `⊥`. -/ +private theorem degree_truncLE_remainder_mul_remainder_lt + {b c b' c' : Nonpositive ℝ K} {x y : ℝ} (hbne : b ≠ 0) (hcne : c ≠ 0) + (hb'Support : (b' : K⟦ℝ⟧).support ⊆ Set.Ici x) + (hc'Support : (c' : K⟦ℝ⟧).support ⊆ Set.Ici y) + (hb'Strict : (b : K⟦ℝ⟧).degree = 0 → (b' : K⟦ℝ⟧).support ⊆ Set.Ioi x) + (hc'Strict : (c : K⟦ℝ⟧).degree = 0 → (c' : K⟦ℝ⟧).support ⊆ Set.Ioi y) : + (truncLE (x + y) ((b' * c' : Nonpositive ℝ K) : K⟦ℝ⟧)).degree < + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + have hbne' : (b : K⟦ℝ⟧) ≠ 0 := by simpa using hbne + have hcne' : (c : K⟦ℝ⟧) ≠ 0 := by simpa using hcne + have hFourthSupport : + ((b' : K⟦ℝ⟧) * (c' : K⟦ℝ⟧)).support ⊆ Set.Ici (x + y) := + support_mul_subset_Ici_add hb'Support hc'Support + have hFourthDegreeLe : + (truncLE (x + y) ((b' : K⟦ℝ⟧) * (c' : K⟦ℝ⟧))).degree ≤ 0 := + degree_truncLE_le_zero_of_support_subset_Ici hFourthSupport + have hsumDegreeNonnegative : + 0 ≤ (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := + add_nonneg (zero_le_degree_of_ne_zero hbne') (zero_le_degree_of_ne_zero hcne') + change (truncLE (x + y) ((b' : K⟦ℝ⟧) * (c' : K⟦ℝ⟧))).degree < _ + rcases hsumDegreeNonnegative.eq_or_lt with hzero | hpos + · obtain ⟨db, hdb⟩ := WithBot.ne_bot_iff_exists.mp + (degree_eq_bot.not.mpr hbne') + obtain ⟨dc, hdc⟩ := WithBot.ne_bot_iff_exists.mp + (degree_eq_bot.not.mpr hcne') + have hsum : db + dc = 0 := by + apply WithBot.coe_injective + simpa [WithBot.coe_add, hdb, hdc] using hzero.symm + have hdegrees := NatOrdinal.add_eq_zero_iff.mp hsum + have hbDegree : (b : K⟦ℝ⟧).degree = 0 := + hdb.symm.trans + (congrArg ((↑·) : NatOrdinal → WithBot NatOrdinal) hdegrees.1) + have hcDegree : (c : K⟦ℝ⟧).degree = 0 := + hdc.symm.trans + (congrArg ((↑·) : NatOrdinal → WithBot NatOrdinal) hdegrees.2) + have hstrictSupport : + ((b' : K⟦ℝ⟧) * (c' : K⟦ℝ⟧)).support ⊆ Set.Ioi (x + y) := + support_mul_subset_Ioi_add + (hb'Strict hbDegree) (hc'Strict hcDegree) + rw [truncLE_eq_zero_of_support_subset_Ioi hstrictSupport, degree_zero, + ← hzero] + exact WithBot.bot_lt_coe 0 + · exact hFourthDegreeLe.trans_lt hpos + +/-- In the head expansion of `b * c`, the three terms other than the head have degree strictly +below the sum of the factor degrees: each cross term is a principal head times a remainder, +bounded by the repaired truncation lemma, and the remainder product is handled separately. -/ +private theorem degree_head_expansion_remainder_lt + {b c b₁ b' c₁ c' : Nonpositive ℝ K} {x y : ℝ} (hbne : b ≠ 0) (hcne : c ≠ 0) + (hb₁Principal : IsPrincipal b₁) (hc₁Principal : IsPrincipal c₁) + (hb'Support : (b' : K⟦ℝ⟧).support ⊆ Set.Ici x) + (hc'Support : (c' : K⟦ℝ⟧).support ⊆ Set.Ici y) + (hb₁Degree : (b₁ : K⟦ℝ⟧).degree = (b : K⟦ℝ⟧).degree) + (hc₁Degree : (c₁ : K⟦ℝ⟧).degree = (c : K⟦ℝ⟧).degree) + (hb'Degree : (b' : K⟦ℝ⟧).degree ≤ (b : K⟦ℝ⟧).degree) + (hc'Degree : (c' : K⟦ℝ⟧).degree ≤ (c : K⟦ℝ⟧).degree) + (hb'Strict : (b : K⟦ℝ⟧).degree = 0 → (b' : K⟦ℝ⟧).support ⊆ Set.Ioi x) + (hc'Strict : (c : K⟦ℝ⟧).degree = 0 → (c' : K⟦ℝ⟧).support ⊆ Set.Ioi y) : + (translate x (truncLE y ((b₁ * c' : Nonpositive ℝ K) : K⟦ℝ⟧)) + + (translate y (truncLE x ((c₁ * b' : Nonpositive ℝ K) : K⟦ℝ⟧)) + + truncLE (x + y) ((b' * c' : Nonpositive ℝ K) : K⟦ℝ⟧))).degree < + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + have hSecondDegree : + (translate x (truncLE y ((b₁ * c' : Nonpositive ℝ K) : K⟦ℝ⟧))).degree < + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + rw [degree_translate, ← hb₁Degree] + exact degree_truncLE_principal_mul_remainder_lt + hb₁Principal hcne hc'Support hc'Degree hc'Strict + have hThirdDegree : + (translate y (truncLE x ((c₁ * b' : Nonpositive ℝ K) : K⟦ℝ⟧))).degree < + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + rw [degree_translate, ← hc₁Degree, add_comm] + exact degree_truncLE_principal_mul_remainder_lt + hc₁Principal hbne hb'Support hb'Degree hb'Strict + have hFourthDegree := + degree_truncLE_remainder_mul_remainder_lt hbne hcne hb'Support hc'Support + hb'Strict hc'Strict + exact (degree_add_le _ _).trans_lt + (max_lt hSecondDegree ((degree_add_le _ _).trans_lt (max_lt hThirdDegree hFourthDegree))) + +/-- Assuming the Berarducci weakly-principal order-type law, degree is multiplicative on all +nonpositive real Hahn series. This is LM24, Proposition 3.4.3, with Hessenberg addition on the +degrees and its absorbing bottom convention at zero. -/ +theorem degree_mul_of_orderTypeMultiplicativeOnWeaklyPrincipal + (h : OrderTypeMultiplicativeOnWeaklyPrincipal K) + (b c : Nonpositive ℝ K) : + ((b * c : Nonpositive ℝ K) : K⟦ℝ⟧).degree = + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + obtain rfl | hbne := eq_or_ne b 0 + · simp + obtain rfl | hcne := eq_or_ne c 0 + · simp + obtain ⟨b₁, x, b', hb₁Principal, hbEq, hb'Support, hb₁Degree, + hb'Degree, hb'Strict⟩ := exists_principal_head_decomposition hbne + obtain ⟨c₁, y, c', hc₁Principal, hcEq, hc'Support, hc₁Degree, + hc'Degree, hc'Strict⟩ := exists_principal_head_decomposition hcne + have hExpansion : + truncLE (x + y) ((b : K⟦ℝ⟧) * (c : K⟦ℝ⟧)) = + translate (x + y) ((b₁ * c₁ : Nonpositive ℝ K) : K⟦ℝ⟧) + + (translate x (truncLE y ((b₁ * c' : Nonpositive ℝ K) : K⟦ℝ⟧)) + + (translate y (truncLE x ((c₁ * b' : Nonpositive ℝ K) : K⟦ℝ⟧)) + + truncLE (x + y) ((b' * c' : Nonpositive ℝ K) : K⟦ℝ⟧))) := by + rw [hbEq, hcEq] + exact truncLE_add_mul_add_of_head_decomposition b₁ b' c₁ c' x y + have hHeadDegree : + (translate (x + y) ((b₁ * c₁ : Nonpositive ℝ K) : K⟦ℝ⟧)).degree = + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + rw [degree_translate, + h.degree_mul hb₁Principal.isWeaklyPrincipal hc₁Principal.isWeaklyPrincipal, + hb₁Degree, hc₁Degree] + have hRemainderDegree := degree_head_expansion_remainder_lt hbne hcne hb₁Principal + hc₁Principal hb'Support hc'Support hb₁Degree hc₁Degree hb'Degree hc'Degree + hb'Strict hc'Strict + have hTruncDegree : + (truncLE (x + y) ((b : K⟦ℝ⟧) * (c : K⟦ℝ⟧))).degree = + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree := by + rw [hExpansion] + exact (degree_add_eq_left_of_lt (hHeadDegree.symm ▸ hRemainderDegree)).trans hHeadDegree + change ((b : K⟦ℝ⟧) * (c : K⟦ℝ⟧)).degree = + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree + exact le_antisymm (degree_mul_le _ _) (hTruncDegree ▸ degree_truncLE_le _ _) + +end Nonpositive + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Negative.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Negative.lean new file mode 100644 index 0000000000..cb7358f897 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Negative.lean @@ -0,0 +1,256 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import Mathlib.Algebra.Group.Pointwise.Set.Basic +public import Mathlib.RingTheory.Ideal.Maps + +/-! +# Hahn series with strictly negative support + +This file defines the series denoted by `K((G^{<0}))` in LM24, Section 2.1. Inside the ring of +nonpositive Hahn series, they are exactly the kernel of the constant-coefficient homomorphism. +This realizes them simultaneously as a two-sided ideal and as a nonunital ring. + +For a coefficient subring `Z`, the truncation integer part is proved to have the source +presentation `Z + K((G^{<0}))`. The Lean definition remains the intrinsic pullback along the +constant-coefficient homomorphism; the presentation theorem supplies the exact printed form +without replacing the carrier by a chosen pair of summands. +-/ + +open scoped Pointwise + +universe u v + +public noncomputable section + +namespace HahnSeries + +variable (Γ : Type u) (R : Type v) +variable [AddCommGroup Γ] [PartialOrder Γ] [IsOrderedAddMonoid Γ] [Ring R] + +/-- The ideal of nonpositive Hahn series with zero constant coefficient. Its elements are exactly +the Hahn series with strictly negative support. -/ +def negativeIdeal : Ideal (Nonpositive Γ R) := + RingHom.ker (Nonpositive.constantCoeff (Γ := Γ) (R := R)) + +/-- Membership in `negativeIdeal` means that every support exponent is strictly negative. -/ +@[simp] +theorem mem_negativeIdeal {x : Nonpositive Γ R} : + x ∈ negativeIdeal Γ R ↔ (x : R⟦Γ⟧).support ⊆ Set.Iio 0 := by + rw [negativeIdeal, RingHom.mem_ker, Nonpositive.constantCoeff_apply] + constructor + · intro hx g hg + have hg_nonpos := Nonpositive.support_subset x hg + have hg_ne : g ≠ 0 := by + intro hg0 + subst g + exact (HahnSeries.mem_support (x : R⟦Γ⟧) 0).mp hg hx + exact lt_of_le_of_ne hg_nonpos hg_ne + · intro hx + by_contra h0 + exact (hx ((HahnSeries.mem_support (x : R⟦Γ⟧) 0).mpr h0)).ne rfl + +/-- Strictly negative Hahn series, represented as the subtype of `negativeIdeal`. -/ +abbrev Negative := ↥(negativeIdeal Γ R) + +instance negativeIdealIsTwoSided : (negativeIdeal Γ R).IsTwoSided := by + change (RingHom.ker (Nonpositive.constantCoeff (Γ := Γ) (R := R))).IsTwoSided + infer_instance + +namespace Negative + +variable {Γ R} + +/-- A strictly negative Hahn series has zero constant coefficient. -/ +theorem constantCoeff_eq_zero (x : Negative Γ R) : + Nonpositive.constantCoeff (Γ := Γ) (R := R) x = 0 := + RingHom.mem_ker.mp x.2 + +/-- The coefficient at exponent zero of a strictly negative Hahn series is zero. -/ +@[simp] +theorem coeff_zero (x : Negative Γ R) : (x : R⟦Γ⟧).coeff 0 = 0 := by + rw [← Nonpositive.constantCoeff_apply] + exact constantCoeff_eq_zero x + +/-- The support of a strictly negative Hahn series is contained in `Set.Iio 0`. -/ +theorem support_subset (x : Negative Γ R) : + (x : R⟦Γ⟧).support ⊆ Set.Iio 0 := + (mem_negativeIdeal (Γ := Γ) (R := R)).mp x.2 + +/-- A single monomial with strictly negative exponent, regarded as a strictly negative Hahn +series. -/ +def single (g : Γ) (r : R) (hg : g < 0) : Negative Γ R := + ⟨Nonpositive.single g r hg.le, by + rw [negativeIdeal, RingHom.mem_ker, Nonpositive.constantCoeff_apply, + Nonpositive.coe_single] + exact HahnSeries.coeff_single_of_ne hg.ne'⟩ + +@[simp] +theorem coe_single (g : Γ) (r : R) (hg : g < 0) : + (single g r hg : R⟦Γ⟧) = HahnSeries.single g r := + Nonpositive.coe_single g r hg.le + +end Negative + +namespace Nonpositive + +/-- Remove the constant coefficient from a nonpositive Hahn series. -/ +def negativePart : Nonpositive Γ R →+ Negative Γ R where + toFun x := ⟨x - C (constantCoeff x), by + rw [negativeIdeal, RingHom.mem_ker] + simp⟩ + map_zero' := by ext; simp + map_add' x y := by + apply Subtype.ext + change x + y - C (constantCoeff (x + y)) = + (x - C (constantCoeff x)) + (y - C (constantCoeff y)) + rw [map_add, map_add] + abel + +@[simp] +theorem coe_negativePart (x : Nonpositive Γ R) : + (negativePart Γ R x : Nonpositive Γ R) = x - C (constantCoeff x) := + (rfl) + +/-- The support of the strictly negative part is the intersection of the original support with +the strict negative cone. -/ +theorem support_negativePart (x : Nonpositive Γ R) : + ((negativePart Γ R x : Negative Γ R) : R⟦Γ⟧).support = + (x : R⟦Γ⟧).support ∩ Set.Iio 0 := by + ext g + rw [HahnSeries.mem_support] + by_cases hg : g = 0 + · subst g + simp + · have hnegativePart := congrArg Subtype.val (coe_negativePart Γ R x) + have hsub := map_sub (nonpositiveSubring Γ R).subtype x (C (constantCoeff x)) + rw [hnegativePart] + change + (((nonpositiveSubring Γ R).subtype (x - C (constantCoeff x))).coeff g ≠ 0) ↔ + g ∈ (x : R⟦Γ⟧).support ∩ Set.Iio 0 + rw [hsub, HahnSeries.coeff_sub] + simp only [Subring.coe_subtype] + rw [coe_C] + change + ((x : R⟦Γ⟧).coeff g - + (HahnSeries.C (constantCoeff x) : R⟦Γ⟧).coeff g ≠ 0) ↔ + g ∈ (x : R⟦Γ⟧).support ∩ Set.Iio 0 + rw [HahnSeries.C_apply, HahnSeries.coeff_single_of_ne hg, sub_zero, + Set.mem_inter_iff, Set.mem_Iio] + rw [HahnSeries.mem_support] + constructor + · intro hx + exact ⟨hx, lt_of_le_of_ne (support_subset x hx) hg⟩ + · exact fun hx ↦ hx.1 + +/-- A nonpositive Hahn series is the sum of its constant term and its strictly negative part. -/ +theorem constant_add_negativePart (x : Nonpositive Γ R) : + C (constantCoeff x) + (negativePart Γ R x : Nonpositive Γ R) = x := by + rw [coe_negativePart] + abel + +/-- The strictly negative part of a constant series is zero. -/ +@[simp] +theorem negativePart_C (r : R) : + negativePart Γ R (C (Γ := Γ) (R := R) r) = 0 := by + apply Subtype.ext + rw [coe_negativePart] + simp + +/-- Removing the constant coefficient from a strictly negative series leaves it unchanged. -/ +@[simp] +theorem negativePart_coe (x : Negative Γ R) : + negativePart Γ R (x : Nonpositive Γ R) = x := by + apply Subtype.ext + rw [coe_negativePart, Negative.constantCoeff_eq_zero] + simp + +end Nonpositive + +/-- The image in the nonpositive Hahn ring of a subring of the coefficient ring. -/ +def constantSubring (Z : Subring R) : Subring (Nonpositive Γ R) := + Z.map (Nonpositive.C (Γ := Γ) (R := R)) + +/-- Membership in the constant copy of `Z` means equality with the constant series attached to +some element of `Z`. -/ +theorem mem_constantSubring {Z : Subring R} {x : Nonpositive Γ R} : + x ∈ constantSubring Γ R Z ↔ + ∃ z : Z, Nonpositive.C (Γ := Γ) (R := R) z = x := by + constructor + · rintro ⟨r, hr, rfl⟩ + exact ⟨⟨r, hr⟩, rfl⟩ + · rintro ⟨z, rfl⟩ + exact Subring.mem_map.mpr ⟨z, z.2, rfl⟩ + +/-- A nonpositive Hahn series belongs to the truncation integer part exactly when it is the sum +of a constant series from `Z` and a strictly negative Hahn series. -/ +theorem mem_truncationIntegerPart_iff_exists_add_negative {Z : Subring R} + {x : Nonpositive Γ R} : + x ∈ truncationIntegerPart Γ Z ↔ + ∃ z : Z, ∃ n : Negative Γ R, + x = Nonpositive.C (Γ := Γ) (R := R) z + (n : Nonpositive Γ R) := by + constructor + · intro hx + have hz : Nonpositive.constantCoeff x ∈ Z := by + rw [Nonpositive.constantCoeff_apply] + exact (mem_truncationIntegerPart (Γ := Γ) (R := R)).mp hx + let z : Z := ⟨Nonpositive.constantCoeff x, hz⟩ + exact ⟨z, Nonpositive.negativePart Γ R x, by + exact (Nonpositive.constant_add_negativePart Γ R x).symm⟩ + · rintro ⟨z, n, rfl⟩ + rw [mem_truncationIntegerPart, ← Nonpositive.constantCoeff_apply, map_add] + rw [Negative.constantCoeff_eq_zero] + simp + +/-- The expression of a nonpositive Hahn series as a constant series from `Z` plus a strictly +negative series is unique. -/ +theorem constant_add_negative_eq_iff {Z : Subring R} {z z' : Z} {n n' : Negative Γ R} : + Nonpositive.C (Γ := Γ) (R := R) z + (n : Nonpositive Γ R) = + Nonpositive.C (Γ := Γ) (R := R) z' + (n' : Nonpositive Γ R) ↔ + z = z' ∧ n = n' := by + constructor + · intro h + have hz : (z : R) = z' := by + calc + (z : R) = Nonpositive.constantCoeff (Γ := Γ) (R := R) + (Nonpositive.C (Γ := Γ) (R := R) z + n) := by + rw [map_add, Negative.constantCoeff_eq_zero] + simp + _ = Nonpositive.constantCoeff (Γ := Γ) (R := R) + (Nonpositive.C (Γ := Γ) (R := R) z' + n') := congrArg _ h + _ = (z' : R) := by + rw [map_add, Negative.constantCoeff_eq_zero] + simp + have hzz : z = z' := Subtype.ext hz + subst z' + exact ⟨rfl, Subtype.ext (add_left_cancel h)⟩ + · rintro ⟨rfl, rfl⟩ + rfl + +/-- The carrier of a truncation integer part is the pointwise sum of the constant copy of `Z` +and the ideal of strictly negative Hahn series. This is the equality +`Z + K((G^{<0}))` used in LM24. -/ +theorem coe_truncationIntegerPart_eq_constantSubring_add_negativeIdeal (Z : Subring R) : + (truncationIntegerPart Γ Z : Set (Nonpositive Γ R)) = + (constantSubring Γ R Z : Set (Nonpositive Γ R)) + + (negativeIdeal Γ R : Set (Nonpositive Γ R)) := by + ext x + rw [Set.mem_add] + constructor + · intro hx + rcases (mem_truncationIntegerPart_iff_exists_add_negative + (Γ := Γ) (R := R)).mp hx with ⟨z, n, rfl⟩ + exact ⟨Nonpositive.C (Γ := Γ) (R := R) z, + (mem_constantSubring (Γ := Γ) (R := R)).mpr ⟨z, rfl⟩, n, n.2, rfl⟩ + · rintro ⟨c, hc, n, hn, rfl⟩ + rcases (mem_constantSubring (Γ := Γ) (R := R)).mp hc with ⟨z, rfl⟩ + exact (mem_truncationIntegerPart_iff_exists_add_negative + (Γ := Γ) (R := R)).mpr + ⟨z, ⟨n, hn⟩, rfl⟩ + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NegativeMonomialIdeal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NegativeMonomialIdeal.lean new file mode 100644 index 0000000000..af849c0219 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NegativeMonomialIdeal.lean @@ -0,0 +1,147 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportSupremum +public import Mathlib.RingTheory.Ideal.Span + +/-! +# The ideal generated by negative monomials + +For a coefficient field `K`, `HahnSeries.Nonpositive.negativeMonomialIdeal K` is the ideal +generated by the monomials `t^x` with `x < 0` in the nonpositive real Hahn-series ring. This is +Berarducci's ideal `J`, used as the cited prerequisite for LM24, Proposition 3.5.1. The paper's +description “generated by the monomials” is represented literally by `Ideal.span`. + +Membership has the intrinsic characterization + +``` +b ∈ negativeMonomialIdeal K ↔ supportSup b < 0. +``` + +The reverse implication factors `b` as the monomial at its support supremum times its normalized +translate. This characterization also records an important boundary: a series may have zero +constant coefficient and support supremum zero, and therefore need not belong to `J`. + +This module defines `J` and proves its membership API. Berarducci, Corollary 9.8 proves primeness +over a characteristic-zero field; that theorem is formalized in +`ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue`. The definition and the +lemmas below remain valid over any field. + +The definition uses `Ideal.span`; the intrinsic membership theorem is the main interface for +working with the ideal. +-/ + +universe v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {K : Type v} [Field K] + +/-- The coefficient-one monomials at strictly negative real exponents. -/ +def negativeMonomials (K : Type v) [Field K] : Set (Nonpositive ℝ K) := + Set.range fun x : Set.Iio (0 : ℝ) => single x 1 x.2.le + +/-- The ideal generated by the strictly negative monomials in the nonpositive real Hahn ring. -/ +def negativeMonomialIdeal (K : Type v) [Field K] : Ideal (Nonpositive ℝ K) := + Ideal.span (negativeMonomials K) + +theorem negativeMonomialIdeal_def : + negativeMonomialIdeal K = Ideal.span (negativeMonomials K) := + (rfl) + +theorem mem_negativeMonomials_iff {m : Nonpositive ℝ K} : + m ∈ negativeMonomials K ↔ ∃ x : Set.Iio (0 : ℝ), single x.1 1 x.2.le = m := + (Iff.rfl) + +/-- A coefficient-one monomial at a strictly negative exponent belongs to the negative-monomial +ideal. -/ +theorem single_one_mem_negativeMonomialIdeal {x : ℝ} (hx : x < 0) : + single x (1 : K) hx.le ∈ negativeMonomialIdeal K := by + apply Ideal.subset_span + exact ⟨⟨x, hx⟩, rfl⟩ + +private def supportSupLTZeroIdeal (K : Type v) [Field K] : + Ideal (Nonpositive ℝ K) where + carrier := {b | supportSup b < 0} + zero_mem' := by simp + add_mem' := by + intro b c hb hc + exact (supportSup_add_le b c).trans_lt (max_lt hb hc) + smul_mem' := by + intro b c hc + change supportSup (b * c) < 0 + calc + supportSup (b * c) ≤ supportSup b + supportSup c := + supportSup_mul_le b c + _ ≤ 0 + supportSup c := by + simpa [add_comm] using + (add_le_add_right (supportSup_le_zero b) (supportSup c)) + _ = supportSup c := zero_add _ + _ < 0 := hc + +private theorem negativeMonomialIdeal_le_supportSupLTZeroIdeal : + negativeMonomialIdeal K ≤ supportSupLTZeroIdeal K := by + rw [negativeMonomialIdeal, Ideal.span_le] + rintro _ ⟨x, rfl⟩ + change supportSup (single (x : ℝ) (1 : K) x.2.le) < 0 + rw [supportSup_single one_ne_zero] + exact WithBot.coe_lt_coe.mpr x.2 + +private theorem mem_negativeMonomialIdeal_of_supportSup_lt_zero + {b : Nonpositive ℝ K} (hb : supportSup b < 0) : + b ∈ negativeMonomialIdeal K := by + by_cases hbzero : b = 0 + · rw [hbzero] + exact (negativeMonomialIdeal K).zero_mem + have hsup : sSup (b : K⟦ℝ⟧).support < 0 := by + rw [supportSup_of_ne hbzero] at hb + exact WithBot.coe_lt_coe.mp hb + have hgenerator : + single (sSup (b : K⟦ℝ⟧).support) (1 : K) hsup.le ∈ + negativeMonomialIdeal K := + single_one_mem_negativeMonomialIdeal hsup + have hfactor : + single (sSup (b : K⟦ℝ⟧).support) (1 : K) hsup.le * normalize b = b := by + apply Subtype.ext + simpa only [Subring.coe_mul, coe_single, + HahnSeries.single_one_mul_eq_translate] using + translate_csSup_normalize b + rw [← hfactor] + exact Ideal.mul_mem_right (normalize b) (negativeMonomialIdeal K) hgenerator + +/-- A nonpositive real Hahn series belongs to the negative-monomial ideal exactly when its +support supremum is strictly negative. -/ +theorem mem_negativeMonomialIdeal_iff_supportSup_lt_zero + {b : Nonpositive ℝ K} : + b ∈ negativeMonomialIdeal K ↔ supportSup b < 0 := by + constructor + · exact fun hb => negativeMonomialIdeal_le_supportSupLTZeroIdeal hb + · exact mem_negativeMonomialIdeal_of_supportSup_lt_zero + +/-- A series with support supremum zero does not belong to the negative-monomial ideal. -/ +theorem not_mem_negativeMonomialIdeal_of_supportSup_eq_zero + {b : Nonpositive ℝ K} (hb : supportSup b = 0) : + b ∉ negativeMonomialIdeal K := by + rw [mem_negativeMonomialIdeal_iff_supportSup_lt_zero, hb] + exact lt_irrefl 0 + +/-- The negative-monomial ideal is proper. This does not assert that it is prime. -/ +theorem negativeMonomialIdeal_ne_top : negativeMonomialIdeal K ≠ ⊤ := by + intro htop + have hone : (1 : Nonpositive ℝ K) ∈ negativeMonomialIdeal K := by + rw [htop] + trivial + rw [mem_negativeMonomialIdeal_iff_supportSup_lt_zero] at hone + have honeEq : single 0 (1 : K) le_rfl = (1 : Nonpositive ℝ K) := by + apply Subtype.ext + simp + rw [← honeEq, supportSup_single one_ne_zero] at hone + exact (lt_irrefl (0 : WithBot ℝ)) hone + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Nonpositive.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Nonpositive.lean new file mode 100644 index 0000000000..f3ff43a6eb --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Nonpositive.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.RingTheory.HahnSeries.Multiplication + +/-! +# Hahn series with nonpositive support + +This file constructs the subring of Hahn series supported on the nonpositive cone of a partially +ordered additive commutative group. On this subring, evaluation at exponent zero is a ring +homomorphism. Pulling a coefficient subring back along that homomorphism gives an intrinsic model +of a truncation integer part. + +For a linearly ordered exponent group and a coefficient field, the construction is the ring used +in LM24, Section 2.1, especially Remark 2.1.2. Mathlib's `IsPWO` support condition then agrees with +the paper's well-ordered-support convention, so `K((G^{≤ 0}))` is represented without reversing +the order on `G`. The declarations below generalize the coefficient field to a ring and the linear +order to a partial order because the constructions and proofs require only those assumptions. +-/ + +universe u v + +public noncomputable section + +namespace HahnSeries + +variable (Γ : Type u) (R : Type v) +variable [AddCommGroup Γ] [PartialOrder Γ] [IsOrderedAddMonoid Γ] [Ring R] + +/-- The subring of Hahn series whose support consists of nonpositive exponents. -/ +@[expose] def nonpositiveSubring : Subring R⟦Γ⟧ where + carrier := {x | x.support ⊆ Set.Iic 0} + zero_mem' := by simp + one_mem' := by + intro g hg + have hg0 : g = 0 := support_single_subset hg + simp [hg0] + add_mem' := fun {x y} hx hy => by + intro g hg + rcases support_add_subset x y hg with hg | hg + · exact hx hg + · exact hy hg + neg_mem' := fun {x} hx => (support_neg_subset x).trans hx + mul_mem' := fun {x y} hx hy => by + intro g hg + obtain ⟨i, hi, j, hj, rfl⟩ := support_mul_subset hg + exact add_nonpos (hx hi) (hy hj) + +/-- Membership in `nonpositiveSubring` means that every support exponent is at most zero. -/ +@[simp] +theorem mem_nonpositiveSubring {x : R⟦Γ⟧} : + x ∈ nonpositiveSubring Γ R ↔ x.support ⊆ Set.Iic 0 := + (Iff.rfl) + +/-- The type of Hahn series supported in the nonpositive exponents. -/ +abbrev Nonpositive := ↥(nonpositiveSubring Γ R) + +namespace Nonpositive + +variable {Γ R} + +/-- The support of a nonpositive Hahn series is contained in `Set.Iic 0`. -/ +theorem support_subset (x : Nonpositive Γ R) : + (x : R⟦Γ⟧).support ⊆ Set.Iic 0 := + x.2 + +/-- A constant Hahn series, regarded as a nonpositive Hahn series. -/ +def C : R →+* Nonpositive Γ R := + (HahnSeries.C : R →+* R⟦Γ⟧).codRestrict (nonpositiveSubring Γ R) fun r g hg => by + have hg0 : g = 0 := support_single_subset hg + simp [hg0] + +@[simp] +theorem coe_C (r : R) : ((C : R →+* Nonpositive Γ R) r : R⟦Γ⟧) = HahnSeries.C r := + (rfl) + +/-- A single monomial with nonpositive exponent, regarded as a nonpositive Hahn series. -/ +def single (g : Γ) (r : R) (hg : g ≤ 0) : Nonpositive Γ R := + ⟨HahnSeries.single g r, fun i hi => by + rw [eq_of_mem_support_single hi] + exact hg⟩ + +@[simp] +theorem coe_single (g : Γ) (r : R) (hg : g ≤ 0) : + (single g r hg : R⟦Γ⟧) = HahnSeries.single g r := + (rfl) + +private theorem eq_zero_of_mem_addAntidiagonal_zero {x y : Nonpositive Γ R} {ij : Γ × Γ} + (hij : ij ∈ Finset.addAntidiagonal (x : R⟦Γ⟧).isPWO_support + (y : R⟦Γ⟧).isPWO_support 0) : + ij = (0, 0) := by + rcases Finset.mem_addAntidiagonal.mp hij with ⟨hi, hj, hij⟩ + have hi_zero := eq_zero_of_add_nonneg_left (support_subset x hi) (support_subset y hj) hij.ge + have hj_zero := eq_zero_of_add_nonneg_right (support_subset x hi) (support_subset y hj) hij.ge + exact Prod.ext hi_zero hj_zero + +/-- The coefficient at exponent zero of a product of nonpositive Hahn series is the product of +their coefficients at exponent zero. -/ +@[simp] +theorem coeff_zero_mul (x y : Nonpositive Γ R) : + ((x : R⟦Γ⟧) * (y : R⟦Γ⟧)).coeff 0 = + (x : R⟦Γ⟧).coeff 0 * (y : R⟦Γ⟧).coeff 0 := by + rw [HahnSeries.coeff_mul] + by_cases hx : (x : R⟦Γ⟧).coeff 0 = 0 + · rw [hx, zero_mul] + apply Finset.sum_eq_zero + intro ij hij + rw [eq_zero_of_mem_addAntidiagonal_zero hij] + simp [hx] + · by_cases hy : (y : R⟦Γ⟧).coeff 0 = 0 + · rw [hy, mul_zero] + apply Finset.sum_eq_zero + intro ij hij + rw [eq_zero_of_mem_addAntidiagonal_zero hij] + simp [hy] + · apply Finset.sum_eq_single (0, 0) + · intro ij hij hne + exact (hne (eq_zero_of_mem_addAntidiagonal_zero hij)).elim + · simp [Finset.mem_addAntidiagonal, HahnSeries.mem_support, hx, hy] + +/-- Evaluation at exponent zero as a ring homomorphism on nonpositive Hahn series. -/ +def constantCoeff : Nonpositive Γ R →+* R where + toFun x := (x : R⟦Γ⟧).coeff 0 + map_zero' := HahnSeries.coeff_zero + map_one' := by simp + map_add' x y := HahnSeries.coeff_add + map_mul' := coeff_zero_mul + +/-- Evaluating `constantCoeff` returns the coefficient at exponent zero. -/ +@[simp] +theorem constantCoeff_apply (x : Nonpositive Γ R) : + constantCoeff x = (x : R⟦Γ⟧).coeff 0 := + (rfl) + +end Nonpositive + +/-- The subring of nonpositive Hahn series whose coefficient at exponent zero lies in `Z`. -/ +def truncationIntegerPart (Γ : Type u) {R : Type v} [AddCommGroup Γ] [PartialOrder Γ] + [IsOrderedAddMonoid Γ] [Ring R] (Z : Subring R) : Subring (Nonpositive Γ R) := + Z.comap Nonpositive.constantCoeff + +/-- Membership in a truncation integer part is membership of the constant coefficient in `Z`. -/ +@[simp] +theorem mem_truncationIntegerPart {Z : Subring R} {x : Nonpositive Γ R} : + x ∈ truncationIntegerPart Γ Z ↔ (x : R⟦Γ⟧).coeff 0 ∈ Z := + (Iff.rfl) + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NonpositiveCoefficientMap.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NonpositiveCoefficientMap.lean new file mode 100644 index 0000000000..e14c2e1fbe --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NonpositiveCoefficientMap.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportSupremum + +/-! +# Coefficient extension of nonpositive Hahn series + +Applying a ring homomorphism to every coefficient of a Hahn series supported on the nonpositive +cone leaves the support inside that cone, so it induces a ring homomorphism between the +corresponding subrings. When the coefficient map is injective, in particular for an extension of +fields, the support is preserved exactly: a coefficient vanishes after the map precisely when it +vanished before. Constants are carried to constants. + +Two support computations used alongside the coefficient extension are recorded here as well. The +support supremum is monotone under inclusion of supports, across two coefficient rings, and +subtracting the constant term deletes exactly the exponent zero from the support. +-/ + +universe v w + +open scoped HahnSeries + +public noncomputable section + +namespace HahnSeries.Nonpositive + +/-- Support inclusion is monotone for the support supremum, across coefficient rings. -/ +theorem supportSup_mono {K₁ : Type v} {K₂ : Type w} [Field K₁] [Field K₂] + {u : HahnSeries.Nonpositive ℝ K₁} {v : HahnSeries.Nonpositive ℝ K₂} + (h : (u : K₁⟦ℝ⟧).support ⊆ (v : K₂⟦ℝ⟧).support) : supportSup u ≤ supportSup v := by + by_cases hu : u = 0 + · simp [hu] + · have hu' : (u : K₁⟦ℝ⟧) ≠ 0 := by simpa using hu + have hune := HahnSeries.support_nonempty_iff.mpr hu' + have hvne : ((v : K₂⟦ℝ⟧)).support.Nonempty := hune.mono h + have hv : v ≠ 0 := by intro hz; rw [hz] at hvne; simp at hvne + rw [supportSup_of_ne hu, supportSup_of_ne hv, WithBot.coe_le_coe] + exact csSup_le_csSup (bddAbove_support v) hune h + +/-- Removing the constant term deletes exactly the exponent zero from the support. -/ +theorem support_sub_C_constantCoeff {K₁ : Type v} [Field K₁] + (b : HahnSeries.Nonpositive ℝ K₁) : + ((b - HahnSeries.Nonpositive.C (HahnSeries.Nonpositive.constantCoeff b) : + HahnSeries.Nonpositive ℝ K₁) : K₁⟦ℝ⟧).support = (b : K₁⟦ℝ⟧).support \ {0} := by + ext x + simp only [Set.mem_sdiff, Set.mem_singleton_iff, HahnSeries.mem_support] + rcases eq_or_ne x 0 with rfl | hx + · simp [HahnSeries.Nonpositive.coe_C, HahnSeries.C_apply, + HahnSeries.Nonpositive.constantCoeff_apply] + · simp [HahnSeries.Nonpositive.coe_C, HahnSeries.C_apply, + HahnSeries.Nonpositive.constantCoeff_apply, hx] + +variable {K : Type v} {E : Type w} [Field K] [Field E] + +/-- Coefficientwise extension of a nonpositive Hahn series along a ring homomorphism. -/ +def nonpositiveCoefficientMap (f : K →+* E) : + HahnSeries.Nonpositive ℝ K →+* HahnSeries.Nonpositive ℝ E where + toFun u := ⟨(u : K⟦ℝ⟧).map (f : K →+* E), by + refine (HahnSeries.mem_nonpositiveSubring ℝ E).mpr fun x hx ↦ + HahnSeries.Nonpositive.support_subset u ?_ + rw [HahnSeries.mem_support] at hx ⊢ + intro hzero + exact hx (show f ((u : K⟦ℝ⟧).coeff x) = 0 by rw [hzero, map_zero])⟩ + map_one' := Subtype.ext (HahnSeries.map_one (f : K →+* E).toMonoidWithZeroHom) + map_mul' u v := Subtype.ext (HahnSeries.map_mul (f : K →+* E).toNonUnitalRingHom) + map_zero' := Subtype.ext (HahnSeries.map_zero (f : K →+* E).toMonoidWithZeroHom.toZeroHom) + map_add' u v := Subtype.ext (HahnSeries.map_add (f : K →+* E).toAddMonoidHom) + +/-- The coefficient extension acts coefficientwise. -/ +theorem coe_nonpositiveCoefficientMap (f : K →+* E) + (u : HahnSeries.Nonpositive ℝ K) (x : ℝ) : + ((nonpositiveCoefficientMap f u : HahnSeries.Nonpositive ℝ E) : E⟦ℝ⟧).coeff x = + f (((u : K⟦ℝ⟧)).coeff x) := + (rfl) + +/-- Coefficient extension along a field embedding preserves the support. -/ +theorem support_nonpositiveCoefficientMap (f : K →+* E) + (u : HahnSeries.Nonpositive ℝ K) : + ((nonpositiveCoefficientMap f u : HahnSeries.Nonpositive ℝ E) : E⟦ℝ⟧).support = + ((u : K⟦ℝ⟧)).support := by + ext x + simp only [HahnSeries.mem_support, coe_nonpositiveCoefficientMap] + exact ⟨fun h hz ↦ h (by rw [hz, map_zero]), fun h hz ↦ h (f.injective (by simpa using hz))⟩ + +/-- Coefficient extension carries a constant to the constant with extended value. -/ +theorem nonpositiveCoefficientMap_C (f : K →+* E) (k : K) : + nonpositiveCoefficientMap f (HahnSeries.Nonpositive.C k) = + HahnSeries.Nonpositive.C (f k) := by + apply Subtype.ext + ext x + rw [coe_nonpositiveCoefficientMap, HahnSeries.Nonpositive.coe_C, + HahnSeries.Nonpositive.coe_C, HahnSeries.C_apply, HahnSeries.C_apply] + rcases eq_or_ne x 0 with rfl | hx + · simp + · simp [hx] + +end HahnSeries.Nonpositive + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NonpositiveDomainEquiv.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NonpositiveDomainEquiv.lean new file mode 100644 index 0000000000..cf0149c34d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NonpositiveDomainEquiv.lean @@ -0,0 +1,96 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEquiv +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType + +/-! +# Reindexing nonpositive Hahn series along an exponent equivalence + +An ordered additive equivalence of exponent groups induces a ring equivalence of their +nonpositive Hahn-series rings. Since the exponent types may live in different universes, support +order types are compared after lifting both ordinals to a common universe. + +This is the exponent-domain transport needed when LM24 assumption `(A1)_σ` identifies an +Archimedean stratum with the additive ordered group of real numbers. +-/ + +public noncomputable section + +namespace HahnSeries.Nonpositive + +universe u v w + +variable {G : Type u} {H : Type v} {K : Type w} +variable [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] +variable [LinearOrder H] [AddCommGroup H] [IsOrderedAddMonoid H] +variable [CommRing K] + +/-- Reindex nonpositive Hahn series along an ordered additive equivalence of exponent groups. -/ +def embDomainRingEquiv (e : G ≃+o H) : Nonpositive G K ≃+* Nonpositive H K where + toFun x := ⟨HahnSeries.embDomainRingEquiv e x, by + rw [HahnSeries.mem_nonpositiveSubring] + intro h hh + rw [HahnSeries.support_embDomainRingEquiv] at hh + obtain ⟨g, hg, rfl⟩ := hh + change e g ≤ 0 + simpa only [map_zero] using e.strictMono.monotone (support_subset x hg)⟩ + invFun x := ⟨HahnSeries.embDomainRingEquiv e.symm x, by + rw [HahnSeries.mem_nonpositiveSubring] + intro g hg + rw [HahnSeries.support_embDomainRingEquiv] at hg + obtain ⟨h, hh, rfl⟩ := hg + change e.symm h ≤ 0 + simpa only [map_zero] using e.symm.strictMono.monotone (support_subset x hh)⟩ + left_inv x := by + apply Subtype.ext + ext g + have h := HahnSeries.embDomainRingEquiv_coeff e.symm + (HahnSeries.embDomainRingEquiv e (x : K⟦G⟧)) (e g) + rw [e.symm_apply_apply, HahnSeries.embDomainRingEquiv_coeff] at h + exact h + right_inv x := by + apply Subtype.ext + ext h + have hh := HahnSeries.embDomainRingEquiv_coeff e + (HahnSeries.embDomainRingEquiv e.symm (x : K⟦H⟧)) (e.symm h) + rw [e.apply_symm_apply, HahnSeries.embDomainRingEquiv_coeff] at hh + exact hh + map_mul' x y := by + apply Subtype.ext + exact map_mul (HahnSeries.embDomainRingEquiv e) (x : K⟦G⟧) y + map_add' x y := by + apply Subtype.ext + exact map_add (HahnSeries.embDomainRingEquiv e) (x : K⟦G⟧) y + +/-- The underlying Hahn series is the unrestricted exponent-domain equivalence. -/ +@[simp] +theorem coe_embDomainRingEquiv (e : G ≃+o H) (x : Nonpositive G K) : + (embDomainRingEquiv e x : K⟦H⟧) = HahnSeries.embDomainRingEquiv e x := + (rfl) + +/-- Reindexing identifies supports as ordered sets, so their order types agree after lifting. -/ +theorem lift_supportOrderType_embDomainRingEquiv (e : G ≃+o H) + (x : Nonpositive G K) : + Ordinal.lift.{u, v} + (HahnSeries.supportOrderType (embDomainRingEquiv e x : K⟦H⟧)) = + Ordinal.lift.{v, u} (HahnSeries.supportOrderType (x : K⟦G⟧)) := by + letI : WellFoundedLT (x : K⟦G⟧).support := ⟨(x : K⟦G⟧).isWF_support⟩ + letI : WellFoundedLT (embDomainRingEquiv e x : K⟦H⟧).support := + ⟨(embDomainRingEquiv e x : K⟦H⟧).isWF_support⟩ + let supportEquiv : (embDomainRingEquiv e x : K⟦H⟧).support ≃o + (x : K⟦G⟧).support := + (OrderIso.setCongr _ (e '' (x : K⟦G⟧).support) (by + rw [coe_embDomainRingEquiv, HahnSeries.support_embDomainRingEquiv])).trans + (StrictMonoOn.orderIso e (x : K⟦G⟧).support + (e.strictMono.strictMonoOn (x : K⟦G⟧).support)).symm + rw [HahnSeries.supportOrderType_eq_typeLT (OrderIso.refl _), + HahnSeries.supportOrderType_eq_typeLT (OrderIso.refl _)] + exact supportEquiv.toRelIsoLT.ordinal_lift_type_eq + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NormalForm.lean new file mode 100644 index 0000000000..7e15308615 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NormalForm.lean @@ -0,0 +1,499 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportSupremum +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.WeakNormalForm + +/-! +# Principal series and normal forms of real Hahn series + +This module formalizes the principal-series clause of LM24, Definition 3.3.1, and the normal forms +of Definition 3.3.6 and Proposition 3.3.7. A principal series is a weakly principal series in the +nonpositive real Hahn ring whose support supremum is zero. + +A normal-form term stores a principal coefficient `b` and a real exponent `x`; its represented +series is the exponent translate `b t^x`. A normal form has nondecreasing exponents, nonincreasing +coefficient support order types, and strictly separated translated supports. The definition +stores pairwise support separation and proves its equivalence to the adjacent chain printed in +LM24. The zero series has the empty normal form. + +Repeated exponents are deliberately allowed. In particular, the uniqueness proof never infers a +strict inequality from the exponent ordering. It recovers a term's exponent as the real supremum +of the represented support and then recovers its coefficient by inverse translation. This is +compatible with LM24, Remark 3.3.10 and does not infer strict increase from a nondecreasing +sequence of exponents. + +The existence theorem starts with the already-proved weak normal form. Each weak block is still +supported in the nonpositive cone, so translating it by the negative of its support supremum gives +a principal coefficient. The proof is generalized from field coefficients to ring coefficients; +no multiplicative property of the coefficients is used. + +The construction reuses `List.pmap`, `List.Pairwise.pmap`, and the weak-normal-form API rather than +introducing a second decomposition algorithm. +-/ + +universe v + +public noncomputable section + +namespace HahnSeries + +variable {R : Type v} [Ring R] + +namespace Nonpositive + +/-- An LM24 principal series is weakly principal and has support supremum zero. -/ +def IsPrincipal (x : Nonpositive ℝ R) : Prop := + IsWeaklyPrincipal (x : R⟦ℝ⟧) ∧ supportSup x = 0 + +/-- Characterization of an LM24 principal series. -/ +theorem isPrincipal_iff {x : Nonpositive ℝ R} : + IsPrincipal x ↔ IsWeaklyPrincipal (x : R⟦ℝ⟧) ∧ supportSup x = 0 := + Iff.rfl + +theorem IsPrincipal.isWeaklyPrincipal {x : Nonpositive ℝ R} (hx : IsPrincipal x) : + IsWeaklyPrincipal (x : R⟦ℝ⟧) := + (isPrincipal_iff.mp hx).1 + +theorem IsPrincipal.supportSup_eq_zero {x : Nonpositive ℝ R} (hx : IsPrincipal x) : + supportSup x = 0 := + (isPrincipal_iff.mp hx).2 + +/-- A principal series is nonzero. -/ +theorem IsPrincipal.ne_zero {x : Nonpositive ℝ R} (hx : IsPrincipal x) : x ≠ 0 := by + have hx' := hx.isWeaklyPrincipal.ne_zero + simpa using hx' + +/-- Normalizing a weakly principal nonpositive series gives a principal series. -/ +theorem isPrincipal_normalize {x : Nonpositive ℝ R} + (hx : IsWeaklyPrincipal (x : R⟦ℝ⟧)) : IsPrincipal (normalize x) := by + rw [isPrincipal_iff] + constructor + · rw [isWeaklyPrincipal_iff, supportOrderType_normalize] + exact isWeaklyPrincipal_iff.mp hx + · apply supportSup_normalize + simpa using hx.ne_zero + +/-- A nonzero constant Hahn series is principal. -/ +theorem isPrincipal_C {r : R} (hr : r ≠ 0) : + IsPrincipal ((C : R →+* Nonpositive ℝ R) r) := by + have hsupport : + (((C : R →+* Nonpositive ℝ R) r : Nonpositive ℝ R) : + R⟦ℝ⟧).support = {0} := by + rw [coe_C, HahnSeries.C_apply, HahnSeries.support_single_of_ne hr] + have hne : (C : R →+* Nonpositive ℝ R) r ≠ 0 := by + intro hzero + have hcoeff := congrArg + (fun x : Nonpositive ℝ R ↦ (x : R⟦ℝ⟧).coeff 0) hzero + apply hr + simpa [coe_C] using hcoeff + rw [isPrincipal_iff] + constructor + · rw [HahnSeries.isWeaklyPrincipal_iff] + rw [coe_C, HahnSeries.C_apply, HahnSeries.supportOrderType_single hr] + simpa using Ordinal.isAdditivelyPrincipal_omega0_opow 0 + · apply supportSup_eq_coe_iff.mpr + refine ⟨hne, ?_⟩ + rw [hsupport] + exact isLUB_singleton + +/-- The multiplicative identity of a nontrivial nonpositive real Hahn-series ring is principal. -/ +theorem isPrincipal_one [Nontrivial R] : + IsPrincipal (1 : Nonpositive ℝ R) := by + rw [← map_one (C : R →+* Nonpositive ℝ R)] + exact isPrincipal_C one_ne_zero + +end Nonpositive + +namespace NormalForm + +/-- A coefficient-exponent pair occurring in a real Hahn-series normal form. Principality of the +coefficient is a clause of `HahnSeries.IsNormalForm`, not data stored in this structure. -/ +@[ext] +structure Term (R : Type v) [Ring R] where + coefficient : Nonpositive ℝ R + exponent : ℝ + +namespace Term + +/-- The Hahn series represented by a normal-form term. -/ +def series (t : Term R) : R⟦ℝ⟧ := + translate t.exponent t.coefficient + +/-- A normal-form term represents the translate of its coefficient by its exponent. -/ +theorem series_eq_translate (t : Term R) : + t.series = translate t.exponent t.coefficient := + (rfl) + +@[simp] +theorem coeff_series (t : Term R) (g : ℝ) : + t.series.coeff g = (t.coefficient : R⟦ℝ⟧).coeff (g - t.exponent) := by + rw [series_eq_translate, coeff_translate] + +/-- Normalize a nonpositive Hahn series and record its original real support supremum. -/ +def ofNonpositive (x : Nonpositive ℝ R) : Term R where + coefficient := x.normalize + exponent := sSup (x : R⟦ℝ⟧).support + +@[simp] +theorem coefficient_ofNonpositive (x : Nonpositive ℝ R) : + (ofNonpositive x).coefficient = x.normalize := + (rfl) + +@[simp] +theorem exponent_ofNonpositive (x : Nonpositive ℝ R) : + (ofNonpositive x).exponent = sSup (x : R⟦ℝ⟧).support := + (rfl) + +/-- Normalizing a nonpositive series and translating it back recovers the original series. -/ +@[simp] +theorem series_ofNonpositive (x : Nonpositive ℝ R) : + (ofNonpositive x).series = x := + Nonpositive.translate_csSup_normalize x + +theorem coefficient_ofNonpositive_isPrincipal {x : Nonpositive ℝ R} + (hx : IsWeaklyPrincipal (x : R⟦ℝ⟧)) : + Nonpositive.IsPrincipal (ofNonpositive x).coefficient := + Nonpositive.isPrincipal_normalize hx + +/-- A term with principal coefficient represents a nonzero series. -/ +theorem series_ne_zero {t : Term R} (ht : Nonpositive.IsPrincipal t.coefficient) : + t.series ≠ 0 := by + intro hzero + apply ht.ne_zero + apply Subtype.ext + exact (translate t.exponent).injective (hzero.trans (map_zero _).symm) + +/-- The support of a normal-form term is bounded above by its exponent. -/ +theorem bddAbove_support (t : Term R) : BddAbove t.series.support := by + refine ⟨t.exponent, ?_⟩ + rw [series, support_translate] + rintro _ ⟨g, hg, rfl⟩ + simpa using add_le_add_left (Nonpositive.support_subset t.coefficient hg) t.exponent + +/-- For a principal coefficient, the exponent is the supremum of the represented support. -/ +theorem csSup_support_series (t : Term R) (ht : Nonpositive.IsPrincipal t.coefficient) : + sSup t.series.support = t.exponent := by + rw [series, csSup_support_translate] + · have hsup := ht.supportSup_eq_zero + rw [Nonpositive.supportSup_of_ne ht.ne_zero] at hsup + norm_cast at hsup + simp [hsup] + · simpa using ht.ne_zero + · exact Nonpositive.bddAbove_support t.coefficient + +/-- Principal normal-form terms representing the same Hahn series are equal. -/ +theorem eq_of_series_eq {s t : Term R} + (hs : Nonpositive.IsPrincipal s.coefficient) + (ht : Nonpositive.IsPrincipal t.coefficient) (hseries : s.series = t.series) : + s = t := by + have hexponent : s.exponent = t.exponent := by + calc + s.exponent = sSup s.series.support := (csSup_support_series s hs).symm + _ = sSup t.series.support := congrArg (fun x : R⟦ℝ⟧ ↦ sSup x.support) hseries + _ = t.exponent := csSup_support_series t ht + have hcoefficient : (s.coefficient : R⟦ℝ⟧) = t.coefficient := by + apply (translate s.exponent).injective + simpa only [series, hexponent] using hseries + apply Term.ext + · exact Subtype.ext hcoefficient + · exact hexponent + +end Term + +end NormalForm + +/-- Supremum is monotone across two nonzero, strictly separated real supports when the upper +support is bounded above. -/ +theorem csSup_support_le_of_supportBelow {x y : R⟦ℝ⟧} + (hx : x ≠ 0) (hy : y ≠ 0) (hybdd : BddAbove y.support) + (hxy : SupportBelow x y) : + sSup x.support ≤ sSup y.support := by + obtain ⟨j, hj⟩ := support_nonempty_iff.mpr hy + apply (csSup_le (support_nonempty_iff.mpr hx) fun i hi ↦ (hxy.lt hi hj).le).trans + exact le_csSup hybdd hj + +/-- The five clauses defining an LM24 real Hahn-series normal form. -/ +def IsNormalForm (x : R⟦ℝ⟧) (terms : List (NormalForm.Term R)) : Prop := + (terms.map NormalForm.Term.series).sum = x ∧ + (terms.map NormalForm.Term.exponent).SortedLE ∧ + (∀ t ∈ terms, Nonpositive.IsPrincipal t.coefficient) ∧ + (terms.map (fun t ↦ (t.coefficient : R⟦ℝ⟧).supportOrderType)).SortedGE ∧ + (terms.map NormalForm.Term.series).Pairwise SupportBelow + +/-- Characterization by represented sum, exponents, principal coefficients, order types, and +translated supports. -/ +theorem isNormalForm_iff {x : R⟦ℝ⟧} {terms : List (NormalForm.Term R)} : + IsNormalForm x terms ↔ + (terms.map NormalForm.Term.series).sum = x ∧ + (terms.map NormalForm.Term.exponent).SortedLE ∧ + (∀ t ∈ terms, Nonpositive.IsPrincipal t.coefficient) ∧ + (terms.map (fun t ↦ (t.coefficient : R⟦ℝ⟧).supportOrderType)).SortedGE ∧ + (terms.map NormalForm.Term.series).Pairwise SupportBelow := + Iff.rfl + +/-- Source-form characterization using the adjacent support chain printed in LM24, Definition +3.3.6. Principality makes every represented term nonzero, so the chain is pairwise separated. -/ +theorem isNormalForm_iff_isChain {x : R⟦ℝ⟧} {terms : List (NormalForm.Term R)} : + IsNormalForm x terms ↔ + (terms.map NormalForm.Term.series).sum = x ∧ + (terms.map NormalForm.Term.exponent).SortedLE ∧ + (∀ t ∈ terms, Nonpositive.IsPrincipal t.coefficient) ∧ + (terms.map (fun t ↦ (t.coefficient : R⟦ℝ⟧).supportOrderType)).SortedGE ∧ + (terms.map NormalForm.Term.series).IsChain SupportBelow := by + rw [isNormalForm_iff] + constructor + · rintro ⟨hsum, hexponents, hprincipal, htypes, hpair⟩ + exact ⟨hsum, hexponents, hprincipal, htypes, hpair.isChain⟩ + · rintro ⟨hsum, hexponents, hprincipal, htypes, hchain⟩ + refine ⟨hsum, hexponents, hprincipal, htypes, ?_⟩ + apply pairwise_supportBelow_of_isChain + · intro b hb + obtain ⟨t, ht, rfl⟩ := List.mem_map.mp hb + exact NormalForm.Term.series_ne_zero (hprincipal t ht) + · exact hchain + +/-- Forgetting coefficient normalization turns an LM24 normal form into its weak normal form. -/ +theorem IsNormalForm.isWeakNormalForm {x : R⟦ℝ⟧} {terms : List (NormalForm.Term R)} + (h : IsNormalForm x terms) : + IsWeakNormalForm x (terms.map NormalForm.Term.series) := by + obtain ⟨hsum, _, hprincipal, htypes, hpair⟩ := isNormalForm_iff.mp h + rw [isWeakNormalForm_iff] + refine ⟨hsum, ?_, ?_, hpair⟩ + · intro b hb + obtain ⟨t, ht, rfl⟩ := List.mem_map.mp hb + rw [isWeaklyPrincipal_iff, NormalForm.Term.series, supportOrderType_translate] + exact isWeaklyPrincipal_iff.mp (hprincipal t ht).isWeaklyPrincipal + · convert htypes using 1 + rw [List.map_map] + apply List.map_congr_left + intro t ht + simp [NormalForm.Term.series] + +private theorem bddAbove_support_normalTerm_sum (terms : List (NormalForm.Term R)) : + BddAbove (terms.map NormalForm.Term.series).sum.support := by + induction terms with + | nil => simp + | cons t terms ih => + simp only [List.map_cons, List.sum_cons] + obtain ⟨a, ha⟩ := NormalForm.Term.bddAbove_support t + obtain ⟨b, hb⟩ := ih + refine ⟨max a b, ?_⟩ + intro g hg + rcases support_add_subset t.series (terms.map NormalForm.Term.series).sum hg with hg | hg + · exact (ha hg).trans (le_max_left _ _) + · exact (hb hg).trans (le_max_right _ _) + +/-- Every series admitting a finite LM24 normal form has support bounded above. -/ +theorem IsNormalForm.bddAbove_support {x : R⟦ℝ⟧} {terms : List (NormalForm.Term R)} + (h : IsNormalForm x terms) : BddAbove x.support := by + have hbdd := bddAbove_support_normalTerm_sum terms + rw [(isNormalForm_iff.mp h).1] at hbdd + exact hbdd + +private theorem normalTerms_eq_of_series_eq {terms other : List (NormalForm.Term R)} + (hterms : ∀ t ∈ terms, Nonpositive.IsPrincipal t.coefficient) + (hother : ∀ t ∈ other, Nonpositive.IsPrincipal t.coefficient) + (hseries : terms.map NormalForm.Term.series = other.map NormalForm.Term.series) : + terms = other := by + induction terms generalizing other with + | nil => simpa using hseries + | cons t terms ih => + cases other with + | nil => simp at hseries + | cons s other => + simp only [List.map_cons, List.cons.injEq] at hseries + have hts : t = s := NormalForm.Term.eq_of_series_eq + (hterms t (by simp)) (hother s (by simp)) hseries.1 + subst s + rw [List.cons.injEq] + exact ⟨rfl, ih (fun t ht ↦ hterms t (by simp [ht])) + (fun s hs ↦ hother s (by simp [hs])) hseries.2⟩ + +/-- Two LM24 normal forms of the same real Hahn series are equal. -/ +theorem IsNormalForm.unique {x : R⟦ℝ⟧} {terms other : List (NormalForm.Term R)} + (hterms : IsNormalForm x terms) (hother : IsNormalForm x other) : + terms = other := by + obtain ⟨_, _, htermsPrincipal, _, _⟩ := isNormalForm_iff.mp hterms + obtain ⟨_, _, hotherPrincipal, _, _⟩ := isNormalForm_iff.mp hother + apply normalTerms_eq_of_series_eq htermsPrincipal hotherPrincipal + exact hterms.isWeakNormalForm.unique hother.isWeakNormalForm + +/-- Every nonpositive real Hahn series has an LM24 normal form. This is the existence part of +LM24, Proposition 3.3.7. -/ +theorem exists_isNormalForm (x : Nonpositive ℝ R) : + ∃ terms : List (NormalForm.Term R), IsNormalForm x terms := by + obtain ⟨blocks, hblocks⟩ := exists_isWeakNormalForm (x : R⟦ℝ⟧) + obtain ⟨hsum, hprincipal, htypes, hpair⟩ := isWeakNormalForm_iff.mp hblocks + have hnonpositive : ∀ b ∈ blocks, b.support ⊆ Set.Iic (0 : ℝ) := by + intro b hb + have hbsub := support_subset_list_sum_of_mem hpair hb + rw [hsum] at hbsub + exact hbsub.trans (Nonpositive.support_subset x) + have hblockData : ∀ b ∈ blocks, b ∈ blocks ∧ b.support ⊆ Set.Iic (0 : ℝ) := + fun b hb ↦ ⟨hb, hnonpositive b hb⟩ + let terms : List (NormalForm.Term R) := blocks.pmap + (fun b hb ↦ NormalForm.Term.ofNonpositive + ⟨b, (mem_nonpositiveSubring (x := b)).mpr hb.2⟩) hblockData + have hseries : terms.map NormalForm.Term.series = blocks := by + simp [terms, List.map_pmap] + refine ⟨terms, isNormalForm_iff.mpr ⟨?_, ?_, ?_, ?_, ?_⟩⟩ + · rw [hseries] + exact hsum + · rw [List.sortedLE_iff_pairwise] + simp only [terms, List.map_pmap] + apply hpair.pmap hblockData + intro b hb c hc hbc + apply csSup_support_le_of_supportBelow + · exact (hprincipal b hb.1).ne_zero + · exact (hprincipal c hc.1).ne_zero + · exact ⟨0, hc.2⟩ + · exact hbc + · intro t ht + simp only [terms, List.mem_pmap] at ht + obtain ⟨b, hb, rfl⟩ := ht + exact NormalForm.Term.coefficient_ofNonpositive_isPrincipal (hprincipal b hb) + · convert htypes using 1 + simp only [terms, List.map_pmap, NormalForm.Term.coefficient_ofNonpositive, + Nonpositive.supportOrderType_normalize] + apply List.pmap_eq_map + · rwa [hseries] + +/-- Every nonpositive real Hahn series has exactly one LM24 normal form. This is LM24, +Proposition 3.3.7. -/ +theorem existsUnique_isNormalForm (x : Nonpositive ℝ R) : + ∃! terms : List (NormalForm.Term R), IsNormalForm x terms := by + obtain ⟨terms, hterms⟩ := exists_isNormalForm x + exact ⟨terms, hterms, fun other hother ↦ (hterms.unique hother).symm⟩ + +private theorem degree_list_sum_le {l : List R⟦ℝ⟧} {d : WithBot NatOrdinal} + (h : ∀ x ∈ l, x.degree ≤ d) : l.sum.degree ≤ d := by + induction l with + | nil => simp + | cons x xs ih => + rw [List.sum_cons] + exact (degree_add_le x xs.sum).trans + (max_le (h x (by simp)) (ih fun y hy ↦ h y (by simp [hy]))) + +/-- A nonzero nonpositive real Hahn series has a principal leading term and a remainder supported +weakly above its exponent. The leading coefficient has the degree of the original series, and the +remainder has no larger degree. When that degree is zero, the remainder support is strictly above +the leading exponent. + +This is the head decomposition extracted from the normal form in LM24, Proposition 3.3.7. The +last clause uses only the source-valid strictness at degree zero and does not assume that all +normal-form exponents are distinct. -/ +theorem exists_principal_head_decomposition + {b : Nonpositive ℝ R} (hbne : b ≠ 0) : + ∃ b₁ : Nonpositive ℝ R, ∃ x : ℝ, ∃ b' : Nonpositive ℝ R, + Nonpositive.IsPrincipal b₁ ∧ + (b : R⟦ℝ⟧) = translate x (b₁ : R⟦ℝ⟧) + (b' : R⟦ℝ⟧) ∧ + (b' : R⟦ℝ⟧).support ⊆ Set.Ici x ∧ + (b₁ : R⟦ℝ⟧).degree = (b : R⟦ℝ⟧).degree ∧ + (b' : R⟦ℝ⟧).degree ≤ (b : R⟦ℝ⟧).degree ∧ + ((b : R⟦ℝ⟧).degree = 0 → + (b' : R⟦ℝ⟧).support ⊆ Set.Ioi x) := by + obtain ⟨terms, hterms⟩ := exists_isNormalForm b + obtain ⟨hsum, _, hprincipal, htypes, hpair⟩ := isNormalForm_iff.mp hterms + cases terms with + | nil => + simp only [List.map_nil, List.sum_nil] at hsum + exact (hbne (Subtype.ext hsum.symm)).elim + | cons t terms => + simp only [List.map_cons, List.sum_cons] at hsum + simp only [List.map_cons] at hpair htypes + rw [List.pairwise_cons] at hpair + have htPrincipal : Nonpositive.IsPrincipal t.coefficient := + hprincipal t (by simp) + have htBelow : + SupportBelow t.series (terms.map NormalForm.Term.series).sum := + supportBelow_list_sum hpair.1 + have hsupportSum : + (t.series + (terms.map NormalForm.Term.series).sum).support = + t.series.support ∪ (terms.map NormalForm.Term.series).sum.support := + support_add_eq_union_of_supportBelow _ _ htBelow + have htailSubset : + (terms.map NormalForm.Term.series).sum.support ⊆ + (b : R⟦ℝ⟧).support := by + rw [← hsum, hsupportSum] + exact Set.subset_union_right + let b' : Nonpositive ℝ R := + ⟨(terms.map NormalForm.Term.series).sum, + (mem_nonpositiveSubring + (x := (terms.map NormalForm.Term.series).sum)).mpr + (htailSubset.trans (Nonpositive.support_subset b))⟩ + have hb'Support : (b' : R⟦ℝ⟧).support ⊆ Set.Ici t.exponent := by + intro j hj + rw [← NormalForm.Term.csSup_support_series t htPrincipal] + apply csSup_le + (support_nonempty_iff.mpr (NormalForm.Term.series_ne_zero htPrincipal)) + intro i hi + exact (htBelow.lt hi hj).le + have htypesPair := List.sortedGE_iff_pairwise.mp htypes + rw [List.pairwise_cons] at htypesPair + have htailTermDegree : + ∀ s ∈ terms, + s.series.degree ≤ (t.coefficient : R⟦ℝ⟧).degree := by + intro s hs + rw [NormalForm.Term.series, degree_translate] + rw [degree_eq_cantorDegree, degree_eq_cantorDegree] + exact Ordinal.cantorDegree_mono (htypesPair.1 + (s.coefficient : R⟦ℝ⟧).supportOrderType + (List.mem_map.mpr ⟨s, hs, rfl⟩)) + have htailDegree : + (b' : R⟦ℝ⟧).degree ≤ (t.coefficient : R⟦ℝ⟧).degree := by + exact degree_list_sum_le (by + intro y hy + obtain ⟨s, hs, rfl⟩ := List.mem_map.mp hy + exact htailTermDegree s hs) + have hheadSupportSubset : + t.series.support ⊆ (b : R⟦ℝ⟧).support := by + rw [← hsum, hsupportSum] + exact Set.subset_union_left + have hheadDegree : + (t.coefficient : R⟦ℝ⟧).degree = (b : R⟦ℝ⟧).degree := by + apply le_antisymm + · calc + (t.coefficient : R⟦ℝ⟧).degree = t.series.degree := by + rw [NormalForm.Term.series, degree_translate] + _ ≤ (b : R⟦ℝ⟧).degree := degree_mono_support hheadSupportSubset + · calc + (b : R⟦ℝ⟧).degree = + (t.series + (b' : R⟦ℝ⟧)).degree := + congrArg degree hsum.symm + _ ≤ max t.series.degree (b' : R⟦ℝ⟧).degree := + degree_add_le _ _ + _ ≤ (t.coefficient : R⟦ℝ⟧).degree := max_le + (by rw [NormalForm.Term.series, degree_translate]) + htailDegree + have hb'Degree : + (b' : R⟦ℝ⟧).degree ≤ (b : R⟦ℝ⟧).degree := + htailDegree.trans hheadDegree.le + have hb'Strict : + (b : R⟦ℝ⟧).degree = 0 → + (b' : R⟦ℝ⟧).support ⊆ Set.Ioi t.exponent := by + intro hbDegree j hj + have htDegree : (t.coefficient : R⟦ℝ⟧).degree = 0 := + hheadDegree.trans hbDegree + have htFinite := (degree_eq_zero.mp htDegree).2 + have htNonempty : (t.coefficient : R⟦ℝ⟧).support.Nonempty := + support_nonempty_iff.mpr (by simpa using htPrincipal.ne_zero) + have htSup : sSup (t.coefficient : R⟦ℝ⟧).support = 0 := by + have hsup := htPrincipal.supportSup_eq_zero + rw [Nonpositive.supportSup_of_ne htPrincipal.ne_zero] at hsup + exact WithBot.coe_eq_coe.mp hsup + have hzero : 0 ∈ (t.coefficient : R⟦ℝ⟧).support := by + rw [← htSup] + exact htNonempty.csSup_mem htFinite + have hexponent : t.exponent ∈ t.series.support := by + rw [NormalForm.Term.series, support_translate] + exact ⟨0, hzero, by simp⟩ + exact htBelow.lt hexponent hj + exact ⟨t.coefficient, t.exponent, b', htPrincipal, + hsum.symm, hb'Support, hheadDegree, hb'Degree, hb'Strict⟩ + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrderType.lean new file mode 100644 index 0000000000..cb8e9bc348 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrderType.lean @@ -0,0 +1,552 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Truncation +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Degree +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Archimedean +public import Mathlib.RingTheory.HahnSeries.Multiplication + +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Sumset + +/-! +# Support order type and degree of a Hahn series + +LM24 orders the support of a generalized power series by increasing exponent. Accordingly, +`HahnSeries.supportOrderType` is the ordinal type of the strict order `<` on the support; no order +reversal occurs in this module. For a linearly ordered exponent type, Mathlib's `IsPWO` support +condition is equivalent to the well-foundedness needed for this ordinal type. + +If the exponent type belongs to `Type u`, the order type and degree belong to `Ordinal.{u}` and +`WithBot NatOrdinal.{u}`, independently of the universe of the coefficients. The degree uses +LM24's convention: a nonzero series has the leading Cantor exponent of its support order type, +whereas the zero series has degree `⊥`. + +These definitions formalize LM24, Sections 1.2, 1.5, 2.2, and 3.1. Multiplicativity is a later +theorem and is not built into the definitions. + +The support-decomposition theorems use the strict lower-to-upper relation +`HahnSeries.SupportBelow` and the generic support lemmas in +`ConwayRefinement.HahnSeries.SeparatedSupport`. +-/ + +universe u v + +public noncomputable section + +namespace HahnSeries + +open Ordinal + +variable {R : Type v} {G : Type u} [LinearOrder G] + +section ZeroCoefficients + +variable [Zero R] + +/-- The ordinary ordinal order type of a Hahn series support, ordered by increasing exponent. -/ +def supportOrderType (x : R⟦G⟧) : Ordinal.{u} := + x.isPWO_support.orderType + +/-- Support order type is the generic order type of the partially well-ordered support. -/ +theorem supportOrderType_eq_setOrderType (x : R⟦G⟧) : + supportOrderType x = x.isPWO_support.orderType := + (rfl) + +/-- Compute `supportOrderType` from an order isomorphism out of the support. -/ +theorem supportOrderType_eq_typeLT {x : R⟦G⟧} {A : Type u} [LinearOrder A] + [WellFoundedLT A] (e : x.support ≃o A) : + supportOrderType x = typeLT A := + x.isPWO_support.orderType_eq_typeLT_of_orderIso e + +/-- Compute `supportOrderType` from a relation isomorphism to an arbitrary well-order. -/ +theorem supportOrderType_eq_type_of_relIso {x : R⟦G⟧} {A : Type u} + {r : A → A → Prop} [IsWellOrder A r] + (e : Subrel (· < · : G → G → Prop) (· ∈ x.support) ≃r r) : + supportOrderType x = Ordinal.type r := + x.isPWO_support.orderType_eq_type_of_relIso e + +@[simp] +theorem supportOrderType_eq_zero {x : R⟦G⟧} : supportOrderType x = 0 ↔ x = 0 := by + rw [supportOrderType, Set.IsPWO.orderType_eq_zero] + exact support_eq_empty_iff + +@[simp] +theorem supportOrderType_zero : supportOrderType (0 : R⟦G⟧) = 0 := + supportOrderType_eq_zero.mpr rfl + +/-- A nonzero single-term Hahn series has ordinary support order type one. -/ +theorem supportOrderType_single {a : G} {r : R} (hr : r ≠ 0) : + (HahnSeries.single a r).supportOrderType = 1 := by + have hsupport : (HahnSeries.single a r).support = {a} := + HahnSeries.support_single_of_ne hr + let singletonOrderIso : ({a} : Set G) ≃o PUnit := + { toEquiv := Equiv.Set.singleton a + map_rel_iff' := by simp } + let e : (HahnSeries.single a r).support ≃o PUnit := + (OrderIso.setCongr _ {a} hsupport).trans singletonOrderIso + rw [supportOrderType_eq_typeLT e] + exact Ordinal.type_eq_one_of_unique _ + +/-- Inclusion of supports cannot decrease their ordinary ordinal order type. -/ +theorem supportOrderType_mono {x y : R⟦G⟧} (h : x.support ⊆ y.support) : + supportOrderType x ≤ supportOrderType y := + Set.IsPWO.orderType_mono x.isPWO_support y.isPWO_support h + +/-- A Hahn series has finite support exactly when its support order type is below `ω`. -/ +theorem support_finite_iff_supportOrderType_lt_omega {x : R⟦G⟧} : + x.support.Finite ↔ supportOrderType x < Ordinal.omega0 := + x.isPWO_support.finite_iff_orderType_lt_omega + +/-- The leading Cantor exponent of the support order type, with value `⊥` at zero. -/ +def degree (x : R⟦G⟧) : WithBot NatOrdinal.{u} := + Ordinal.cantorDegree x.supportOrderType + +/-- Degree is the leading Cantor exponent of the support order type. -/ +theorem degree_eq_cantorDegree (x : R⟦G⟧) : + degree x = Ordinal.cantorDegree x.supportOrderType := + (rfl) + +@[simp] +theorem degree_eq_bot {x : R⟦G⟧} : degree x = ⊥ ↔ x = 0 := by + rw [degree, Ordinal.cantorDegree_eq_bot, supportOrderType_eq_zero] + +@[simp] +theorem degree_zero : degree (0 : R⟦G⟧) = ⊥ := + degree_eq_bot.mpr rfl + +/-- Degree zero is equivalent to nonzero finite support. -/ +@[simp] +theorem degree_eq_zero {x : R⟦G⟧} : + degree x = (0 : WithBot NatOrdinal) ↔ x ≠ 0 ∧ x.support.Finite := by + rw [degree, Ordinal.cantorDegree_eq_zero] + constructor + · rintro ⟨hot, hlt⟩ + exact ⟨supportOrderType_eq_zero.not.mp hot, + support_finite_iff_supportOrderType_lt_omega.mpr hlt⟩ + · rintro ⟨hx, hfinite⟩ + exact ⟨supportOrderType_eq_zero.not.mpr hx, + support_finite_iff_supportOrderType_lt_omega.mp hfinite⟩ + +/-- The degree of a nonzero Hahn series is nonnegative. -/ +theorem zero_le_degree_of_ne_zero {x : R⟦G⟧} (hx : x ≠ 0) : + 0 ≤ x.degree := by + rw [degree_eq_cantorDegree, + Ordinal.cantorDegree_of_ne_zero (supportOrderType_eq_zero.not.mpr hx)] + exact WithBot.coe_le_coe.mpr bot_le + +/-- Degree is at most zero exactly for finite-support Hahn series, including the zero series. -/ +@[simp] +theorem degree_le_zero_iff {x : R⟦G⟧} : + degree x ≤ 0 ↔ x.support.Finite := by + constructor + · intro hdegree + by_cases hx : x = 0 + · simp [hx] + · have hzero : 0 ≤ degree x := zero_le_degree_of_ne_zero hx + have hxDegree : degree x = 0 := le_antisymm hdegree hzero + exact (degree_eq_zero.mp hxDegree).2 + · intro hfinite + by_cases hx : x = 0 + · simp [hx] + · rw [degree_eq_zero.mpr ⟨hx, hfinite⟩] + +/-- A Hahn series has positive degree exactly when its support is infinite. -/ +theorem degree_pos_iff_support_infinite {x : R⟦G⟧} : + 0 < degree x ↔ x.support.Infinite := by + rw [← not_le, degree_le_zero_iff] + exact Set.not_finite + +/-- Degree is strictly below zero exactly at the zero Hahn series. -/ +@[simp] +theorem degree_lt_zero_iff {x : R⟦G⟧} : + degree x < 0 ↔ x = 0 := by + constructor + · intro hdegree + by_contra hx + exact (not_lt_of_ge (zero_le_degree_of_ne_zero hx)) hdegree + · rintro rfl + simp + +/-- This is LM24's maximum characterization of the degree of a nonzero Hahn series. -/ +theorem coe_le_degree_iff {x : R⟦G⟧} {a : Ordinal.{u}} (hx : x ≠ 0) : + (NatOrdinal.of a : WithBot NatOrdinal) ≤ degree x ↔ + Ordinal.omega0 ^ a ≤ supportOrderType x := by + exact Ordinal.coe_le_cantorDegree_iff (supportOrderType_eq_zero.not.mpr hx) + +/-- A degree lies strictly below `α` exactly when the support order type lies strictly below +`ω^α`. -/ +theorem degree_lt_coe_iff_supportOrderType_lt_wpow (x : R⟦G⟧) + (α : NatOrdinal) : + degree x < (α : WithBot NatOrdinal) ↔ + supportOrderType x < (ω^ α).val := by + by_cases hx : x = 0 + · subst x + rw [degree_zero, supportOrderType_zero] + constructor + · intro _ + exact NatOrdinal.val.strictMono (NatOrdinal.wpow_pos α) + · intro _ + exact WithBot.bot_lt_coe α + · rw [← not_le, ← not_le] + apply not_congr + simpa only [NatOrdinal.of_val, NatOrdinal.val_wpow] using + coe_le_degree_iff (x := x) (a := α.val) hx + +/-- Inclusion of supports cannot decrease degree. -/ +theorem degree_mono_support {x y : R⟦G⟧} (h : x.support ⊆ y.support) : + degree x ≤ degree y := + Ordinal.cantorDegree_mono (supportOrderType_mono h) + +/-- Weak lower truncation cannot increase degree. This strengthens the final consequence following +LM24, Definition 3.2.2 by removing its unnecessary properness hypothesis. -/ +theorem degree_truncLE_le (c : G) (x : R⟦G⟧) : + (truncLE c x).degree ≤ x.degree := + degree_mono_support (support_truncLE_subset c x) + +end ZeroCoefficients + +section Addition + +variable [AddMonoid R] + +/-- A Hahn series has support order type `a + b` exactly when it is a sum whose first support lies +strictly below its second support and whose summands have support order types `a` and `b`. This is +LM24, Proposition 3.2.1, generalized from field coefficients and a fixed cardinal support bound to +additive-monoid coefficients and unrestricted Hahn series. The constructed summands have supports +contained in the original support, so the result restricts to the source's support regime. -/ +theorem supportOrderType_eq_add_iff (x : R⟦G⟧) (a b : Ordinal.{u}) : + x.supportOrderType = a + b ↔ + ∃ y z : R⟦G⟧, + SupportBelow y z ∧ + y.supportOrderType = a ∧ + z.supportOrderType = b ∧ + x = y + z := by + classical + constructor + · intro htype + rw [supportOrderType_eq_setOrderType] at htype + obtain ⟨s, t, hs, ht, hsx, htx, hst, hsa, htb, hunion⟩ := + (x.isPWO_support.orderType_eq_add_iff a b).mp htype + let y : R⟦G⟧ := filter (· ∈ s) x + let z : R⟦G⟧ := filter (· ∈ t) x + have hsy : y.support = s := by + change (filter (· ∈ s) x).support = s + rw [support_filter] + ext i + constructor + · exact fun hi ↦ hi.2 + · exact fun hi ↦ ⟨hsx hi, hi⟩ + have htz : z.support = t := by + change (filter (· ∈ t) x).support = t + rw [support_filter] + ext i + constructor + · exact fun hi ↦ hi.2 + · exact fun hi ↦ ⟨htx hi, hi⟩ + have hsum : x = y + z := by + ext i + by_cases hi : i ∈ x.support + · rw [hunion] at hi + rcases hi with his | hit + · have hit' : i ∉ t := by + intro hit + exact (hst i his i hit).false + change x.coeff i = + (filter (· ∈ s) x).coeff i + (filter (· ∈ t) x).coeff i + simp [his, hit'] + · have his' : i ∉ s := by + intro his + exact (hst i his i hit).false + change x.coeff i = + (filter (· ∈ s) x).coeff i + (filter (· ∈ t) x).coeff i + simp [his', hit] + · have hcoeff : x.coeff i = 0 := not_ne_iff.mp hi + have his : i ∉ s := fun his ↦ hi (hsx his) + have hit : i ∉ t := fun hit ↦ hi (htx hit) + change x.coeff i = + (filter (· ∈ s) x).coeff i + (filter (· ∈ t) x).coeff i + simp [his, hit, hcoeff] + refine ⟨y, z, ?_, ?_, ?_, hsum⟩ + · rw [supportBelow_iff] + simpa only [hsy, htz] using hst + · calc + y.supportOrderType = y.isPWO_support.orderType := + supportOrderType_eq_setOrderType y + _ = hs.orderType := Set.IsPWO.orderType_congr _ _ hsy + _ = a := hsa + · calc + z.supportOrderType = z.isPWO_support.orderType := + supportOrderType_eq_setOrderType z + _ = ht.orderType := Set.IsPWO.orderType_congr _ _ htz + _ = b := htb + · rintro ⟨y, z, hyz, hya, hzb, rfl⟩ + have hsupport : (y + z).support = y.support ∪ z.support := + support_add_eq_union_of_supportBelow y z hyz + rw [supportOrderType_eq_setOrderType] + apply ((y + z).isPWO_support.orderType_eq_add_iff a b).mpr + refine ⟨y.support, z.support, y.isPWO_support, z.isPWO_support, ?_, ?_, ?_, + ?_, ?_, hsupport⟩ + · rw [hsupport] + exact Set.subset_union_left + · rw [hsupport] + exact Set.subset_union_right + · intro i hi j hj + exact hyz.lt hi hj + · exact (supportOrderType_eq_setOrderType y).symm.trans hya + · exact (supportOrderType_eq_setOrderType z).symm.trans hzb + +/-- A decomposition from `supportOrderType_eq_add_iff` is uniquely determined by the order type of +its lower summand. This is the uniqueness used when LM24 iterates Proposition 3.2.1. -/ +theorem add_decomposition_unique {x₀ x₁ y₀ y₁ : R⟦G⟧} + (hx : SupportBelow x₀ x₁) + (hy : SupportBelow y₀ y₁) + (htype : x₀.supportOrderType = y₀.supportOrderType) + (hsum : x₀ + x₁ = y₀ + y₁) : + x₀ = y₀ ∧ x₁ = y₁ := by + have hxSupport : (x₀ + x₁).support = x₀.support ∪ x₁.support := + support_add_eq_union_of_supportBelow x₀ x₁ hx + have hySupport : (x₀ + x₁).support = y₀.support ∪ y₁.support := + (congrArg support hsum).trans (support_add_eq_union_of_supportBelow y₀ y₁ hy) + have htype' : x₀.isPWO_support.orderType = y₀.isPWO_support.orderType := by + rw [← supportOrderType_eq_setOrderType, ← supportOrderType_eq_setOrderType] + exact htype + obtain ⟨hlower, hupper⟩ := + Set.IsPWO.orderType_split_unique x₀.isPWO_support y₀.isPWO_support + (fun _ hi _ hj ↦ hx.lt hi hj) (fun _ hi _ hj ↦ hy.lt hi hj) + hxSupport hySupport htype' + constructor + · ext i + by_cases hi : i ∈ x₀.support + · have hi' : i ∈ y₀.support := hlower ▸ hi + have hx₁ : x₁.coeff i = 0 := by + rw [← not_ne_iff, ← mem_support] + intro hi₁ + exact (hx.lt hi hi₁).false + have hy₁ : y₁.coeff i = 0 := by + rw [← not_ne_iff, ← mem_support] + intro hi₁ + exact (hy.lt hi' hi₁).false + have hcoeff := congrArg (fun z : R⟦G⟧ => z.coeff i) hsum + simpa [hx₁, hy₁] using hcoeff + · have hi' : i ∉ y₀.support := by + rw [← hlower] + exact hi + exact (not_ne_iff.mp hi).trans (not_ne_iff.mp hi').symm + · ext i + by_cases hi : i ∈ x₁.support + · have hi' : i ∈ y₁.support := hupper ▸ hi + have hx₀ : x₀.coeff i = 0 := by + rw [← not_ne_iff, ← mem_support] + intro hi₀ + exact (hx.lt hi₀ hi).false + have hy₀ : y₀.coeff i = 0 := by + rw [← not_ne_iff, ← mem_support] + intro hi₀ + exact (hy.lt hi₀ hi').false + have hcoeff := congrArg (fun z : R⟦G⟧ => z.coeff i) hsum + simpa [hx₀, hy₀] using hcoeff + · have hi' : i ∉ y₁.support := by + rw [← hupper] + exact hi + exact (not_ne_iff.mp hi).trans (not_ne_iff.mp hi').symm + +/-- The support order type of a pairwise support-separated finite sum is the ordinary ordinal sum +of the support order types, in list order. -/ +theorem supportOrderType_list_sum {l : List R⟦G⟧} (hpair : l.Pairwise SupportBelow) : + l.sum.supportOrderType = (l.map supportOrderType).sum := by + induction l with + | nil => simp + | cons x xs ih => + rw [List.pairwise_cons] at hpair + have hbelow : SupportBelow x xs.sum := supportBelow_list_sum hpair.1 + have hadd := (supportOrderType_eq_add_iff (x + xs.sum) + x.supportOrderType xs.sum.supportOrderType).mpr + ⟨x, xs.sum, hbelow, rfl, rfl, rfl⟩ + simp only [List.sum_cons, List.map_cons, hadd, ih hpair.2] + +/-- The support order type splits at a strict lower and weak upper truncation. This is the first +order-type equality following LM24, Definition 3.2.2. -/ +theorem supportOrderType_eq_truncLT_add_truncGE (c : G) (x : R⟦G⟧) : + x.supportOrderType = + (truncLT c x).supportOrderType + (truncGE c x).supportOrderType := by + apply (supportOrderType_eq_add_iff x _ _).mpr + refine ⟨truncLT c x, truncGE c x, ?_, rfl, rfl, ?_⟩ + · rw [supportBelow_iff] + intro i hi j hj + rw [support_truncLT] at hi + rw [support_truncGE] at hj + exact hi.2.trans_le hj.2 + · exact (truncLT_add_truncGE c x).symm + +/-- The support order type splits at a weak lower and strict upper truncation. This is the second +order-type equality following LM24, Definition 3.2.2. -/ +theorem supportOrderType_eq_truncLE_add_truncGT (c : G) (x : R⟦G⟧) : + x.supportOrderType = + (truncLE c x).supportOrderType + (truncGT c x).supportOrderType := by + apply (supportOrderType_eq_add_iff x _ _).mpr + refine ⟨truncLE c x, truncGT c x, ?_, rfl, rfl, ?_⟩ + · rw [supportBelow_iff] + intro i hi j hj + rw [support_truncLE] at hi + rw [support_truncGT] at hj + exact hi.2.trans_lt hj.2 + · exact (truncLE_add_truncGT c x).symm + +/-- A proper weak lower truncation has strictly smaller support order type. This is the strict +inequality following LM24, Definition 3.2.2. -/ +theorem supportOrderType_truncLE_lt (c : G) {x : R⟦G⟧} (h : truncLE c x ≠ x) : + (truncLE c x).supportOrderType < x.supportOrderType := by + have hupper : truncGT c x ≠ 0 := by + intro hzero + apply h + calc + truncLE c x = truncLE c x + truncGT c x := by rw [hzero, add_zero] + _ = x := truncLE_add_truncGT c x + rw [supportOrderType_eq_truncLE_add_truncGT c x] + exact lt_add_of_pos_right _ + (pos_iff_ne_zero.mpr (supportOrderType_eq_zero.not.mpr hupper)) + +/-- The order type of the support of a sum is at most the Hessenberg sum of the two support order +types. This is LM24, Proposition 3.1.1(1), generalized from a field of coefficients. -/ +theorem supportOrderType_add_le_naturalAdd (x y : R⟦G⟧) : + supportOrderType (x + y) ≤ + (NatOrdinal.of x.supportOrderType + NatOrdinal.of y.supportOrderType).val := by + calc + supportOrderType (x + y) = (x + y).isPWO_support.orderType := + supportOrderType_eq_setOrderType (x + y) + _ ≤ (x.isPWO_support.union y.isPWO_support).orderType := + Set.IsPWO.orderType_mono (x + y).isPWO_support + (x.isPWO_support.union y.isPWO_support) (support_add_subset x y) + _ ≤ (NatOrdinal.of x.supportOrderType + + NatOrdinal.of y.supportOrderType).val := by + simpa only [← supportOrderType_eq_setOrderType] using + Set.IsPWO.orderType_union_le_naturalAdd x.isPWO_support y.isPWO_support + +/-- The degree of a sum is at most the maximum of the two degrees. This is LM24, +Corollary 3.1.2(1), generalized from a field of coefficients. -/ +theorem degree_add_le (x y : R⟦G⟧) : + degree (x + y) ≤ max (degree x) (degree y) := by + calc + degree (x + y) = Ordinal.cantorDegree (x + y).supportOrderType := + degree_eq_cantorDegree (x + y) + _ ≤ Ordinal.cantorDegree + (NatOrdinal.of x.supportOrderType + NatOrdinal.of y.supportOrderType).val := + Ordinal.cantorDegree_mono (supportOrderType_add_le_naturalAdd x y) + _ = NatOrdinal.cantorDegree + (NatOrdinal.of x.supportOrderType + NatOrdinal.of y.supportOrderType) := + (NatOrdinal.cantorDegree_eq_ordinalCantorDegree _).symm + _ = max (degree x) (degree y) := by + rw [NatOrdinal.cantorDegree_add, NatOrdinal.cantorDegree_of, + NatOrdinal.cantorDegree_of, degree_eq_cantorDegree, + degree_eq_cantorDegree] + +end Addition + +section AddGroup + +variable [AddGroup R] + +/-- Negation preserves ordinary support order type. -/ +@[simp] +theorem supportOrderType_neg (x : R⟦G⟧) : + (-x).supportOrderType = x.supportOrderType := by + calc + (-x).supportOrderType = (-x).isPWO_support.orderType := + supportOrderType_eq_setOrderType (-x) + _ = x.isPWO_support.orderType := + Set.IsPWO.orderType_congr _ _ support_neg + _ = x.supportOrderType := (supportOrderType_eq_setOrderType x).symm + +/-- Negation preserves degree. -/ +@[simp] +theorem degree_neg (x : R⟦G⟧) : (-x).degree = x.degree := by + rw [degree_eq_cantorDegree, degree_eq_cantorDegree, supportOrderType_neg] + +/-- Adding a series of strictly smaller degree does not change the larger degree. -/ +theorem degree_add_eq_left_of_lt {x y : R⟦G⟧} + (h : y.degree < x.degree) : (x + y).degree = x.degree := by + apply le_antisymm + · calc + (x + y).degree ≤ max x.degree y.degree := degree_add_le x y + _ = x.degree := max_eq_left h.le + · apply le_of_not_gt + intro hsum + have hreverse := degree_add_le (x + y) (-y) + rw [degree_neg, add_neg_cancel_right] at hreverse + exact (not_lt_of_ge hreverse) (max_lt hsum h) + +end AddGroup + +section Multiplication + +variable [AddCommMonoid G] [IsOrderedCancelAddMonoid G] +variable [NonUnitalNonAssocSemiring R] + +/-- The order type of the support of a product is at most the Hessenberg product of the two support +order types. This is LM24, Proposition 3.1.1(2), generalized from an ordered abelian exponent group +and a field of coefficients. -/ +theorem supportOrderType_mul_le_naturalMul (x y : R⟦G⟧) : + supportOrderType (x * y) ≤ + (NatOrdinal.of x.supportOrderType * NatOrdinal.of y.supportOrderType).val := by + calc + supportOrderType (x * y) = (x * y).isPWO_support.orderType := + supportOrderType_eq_setOrderType (x * y) + _ ≤ (x.isPWO_support.add y.isPWO_support).orderType := + Set.IsPWO.orderType_mono (x * y).isPWO_support + (x.isPWO_support.add y.isPWO_support) support_mul_subset + _ ≤ (NatOrdinal.of x.supportOrderType * + NatOrdinal.of y.supportOrderType).val := by + simpa only [← supportOrderType_eq_setOrderType] using + Set.IsPWO.orderType_add_le_naturalMul x.isPWO_support y.isPWO_support + +/-- The degree of a product is at most the Hessenberg sum of the two degrees. This is LM24, +Corollary 3.1.2(2), generalized from an ordered abelian exponent group and a field of +coefficients. -/ +theorem degree_mul_le (x y : R⟦G⟧) : + degree (x * y) ≤ degree x + degree y := by + calc + degree (x * y) = Ordinal.cantorDegree (x * y).supportOrderType := + degree_eq_cantorDegree (x * y) + _ ≤ Ordinal.cantorDegree + (NatOrdinal.of x.supportOrderType * NatOrdinal.of y.supportOrderType).val := + Ordinal.cantorDegree_mono (supportOrderType_mul_le_naturalMul x y) + _ = NatOrdinal.cantorDegree + (NatOrdinal.of x.supportOrderType * NatOrdinal.of y.supportOrderType) := + (NatOrdinal.cantorDegree_eq_ordinalCantorDegree _).symm + _ = degree x + degree y := by + rw [NatOrdinal.cantorDegree_mul, NatOrdinal.cantorDegree_of, + NatOrdinal.cantorDegree_of, degree_eq_cantorDegree, + degree_eq_cantorDegree] + +end Multiplication + + +section Archimedean + +variable [AddCommGroup G] [IsOrderedAddMonoid G] [Archimedean G] [Zero R] + +/-- Over an Archimedean exponent group every support is countable, so every support order type +is below `ω₁`. -/ +theorem supportOrderType_lt_omega_one (x : R⟦G⟧) : supportOrderType x < ω₁ := + x.isPWO_support.orderType_lt_omega_one_of_countable + x.isPWO_support.countable_of_archimedean + +/-- Over an Archimedean exponent group every degree is a countable ordinal. -/ +theorem degree_lt_omega_one (x : R⟦G⟧) : + degree x < (NatOrdinal.of ω₁ : WithBot NatOrdinal.{u}) := by + rw [degree_eq_cantorDegree] + by_cases h0 : supportOrderType x = 0 + · rw [h0, Ordinal.cantorDegree_zero] + exact WithBot.bot_lt_coe _ + · rw [Ordinal.cantorDegree_of_ne_zero h0, WithBot.coe_lt_coe, NatOrdinal.of_lt_iff] + exact (Ordinal.log_le_self _ _).trans_lt (supportOrderType_lt_omega_one x) + +end Archimedean + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrderedIntervalSum.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrderedIntervalSum.lean new file mode 100644 index 0000000000..fc03a170a4 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrderedIntervalSum.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.IncreasingSequenceUnion +public import Mathlib.RingTheory.HahnSeries.Summable + +/-! +# Hahn sums over ordered disjoint intervals + +A family of Hahn series supported in half-open intervals is summable when its index is partially +well ordered and every earlier interval lies below every later interval. The index may have +arbitrary cofinality. +-/ + +universe u v w + +open Set + +public noncomputable section + +namespace HahnSeries + +variable {Γ : Type u} {R : Type v} {ι : Type w} + [LinearOrder Γ] [AddCommMonoid R] [LinearOrder ι] + +/-- Hahn series supported in an ordered family of disjoint half-open intervals form a summable +family. -/ +def orderedIntervalSummableFamily (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦Γ⟧) (cut center : ι → Γ) + (hsupp : ∀ i, (f i).support ⊆ Ioc (cut i) (center i)) + (hord : ∀ i j, i < j → center i ≤ cut j) : SummableFamily Γ R ι where + toFun := f + isPWO_iUnion_support' := + Set.IsPWO.iUnion_of_ordered_index hι (fun i ↦ (f i).support) + (fun i ↦ (f i).isPWO_support) fun i j hij x hx y hy ↦ by + exact (hsupp i hx).2.trans_lt ((hord i j hij).trans_lt (hsupp j hy).1) + finite_co_support' x := by + refine Set.Subsingleton.finite fun i hi j hj ↦ ?_ + by_contra hne + have hix : x ∈ (f i).support := (mem_support _ _).mpr hi + have hjx : x ∈ (f j).support := (mem_support _ _).mpr hj + rcases lt_or_gt_of_ne hne with hij | hji + · exact (not_lt_of_ge (hsupp i hix).2) + ((hord i j hij).trans_lt (hsupp j hjx).1) + · exact (not_lt_of_ge (hsupp j hjx).2) + ((hord j i hji).trans_lt (hsupp i hix).1) + +/-- The ordered-interval family evaluates to the original series at each index. -/ +@[simp] +theorem orderedIntervalSummableFamily_apply (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦Γ⟧) (cut center : ι → Γ) + (hsupp : ∀ i, (f i).support ⊆ Ioc (cut i) (center i)) + (hord : ∀ i j, i < j → center i ≤ cut j) (i : ι) : + orderedIntervalSummableFamily hι f cut center hsupp hord i = f i := (rfl) + +/-- Ordered disjoint intervals prevent coefficient cancellation, so the support of the Hahn sum is +exactly the union of the component supports. -/ +theorem support_hsum_orderedIntervalSummableFamily (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦Γ⟧) (cut center : ι → Γ) + (hsupp : ∀ i, (f i).support ⊆ Ioc (cut i) (center i)) + (hord : ∀ i j, i < j → center i ≤ cut j) : + (orderedIntervalSummableFamily hι f cut center hsupp hord).hsum.support = + ⋃ i, (f i).support := by + apply Set.Subset.antisymm SummableFamily.support_hsum_subset + intro g hg + rw [Set.mem_iUnion] at hg + obtain ⟨i, hi⟩ := hg + rw [mem_support] at hi ⊢ + rw [SummableFamily.coeff_hsum, finsum_eq_single _ i] + · exact hi + · intro j hji + have hj : g ∉ (f j).support := by + intro hj + rcases lt_or_gt_of_ne hji with hji | hij + · exact (not_lt_of_ge (hsupp j hj).2) + ((hord j i hji).trans_lt (hsupp i hi).1) + · exact (not_lt_of_ge (hsupp i hi).2) + ((hord i j hij).trans_lt (hsupp j hj).1) + simpa only [orderedIntervalSummableFamily_apply, mem_support, not_not] using hj + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue.lean new file mode 100644 index 0000000000..7b2b2fa6ed --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CoefficientMap +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ComplexityDecrease +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionList +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPoint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPointExistence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.FormalExpression +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermValueCut +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Irreducibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.LeibnizRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.MainLemma +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OneRow +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrderTypeMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueConstantMul +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSubmultiplicative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueValuation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PowerRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponent +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubring +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFraction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFractionAlgebraic +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringLocalization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringMonoidAlgebra +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringScalarRedistributionProof +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PurePowerRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPoint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointCofinality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointTail +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointWellOrdered +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.TruncationDrop + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence.lean new file mode 100644 index 0000000000..eb21aeb1dd --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.BaseChange +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonGrading +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRank +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRepresentatives +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CombinedCofactors +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAt +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAtInjective +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivationIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.IdealFromTruncations +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.InductionOverDegrees +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LeadingCoefficient +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Lifts +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LimitOrdinalRelationAtCutoff +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LinearMaximal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LowDegreeParts +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LoweringDerivation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OmegaSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OrdinalValueCutoffs +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PartialDerivativeIndices +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Partials +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Pieces +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Polynomiality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalGraded +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalIdealGE +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductCondition +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductValues +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.RealPartials +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SeriesTruncations +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Shift +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorLeibniz +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorSupportBound +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SumAlongCutoffs +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SupportLoweringPieces +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Syzygy +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationExpansion +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationPolynomial +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationsIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.UnboundedTruncations + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/BaseChange.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/BaseChange.lean new file mode 100644 index 0000000000..ba68e08d33 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/BaseChange.lean @@ -0,0 +1,415 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CoefficientMap +public import Mathlib.LinearAlgebra.FiniteDimensional.Defs +public import Mathlib.RingTheory.TensorProduct.Basic +public import Mathlib.LinearAlgebra.Basis.Defs + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSupport +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedMap +import Mathlib.LinearAlgebra.DirectSum.TensorProduct +import Mathlib.LinearAlgebra.TensorProduct.Basis +import Mathlib.LinearAlgebra.FreeModule.Basic +import Mathlib.Algebra.Ring.Hom.InjSurj +import Mathlib.Algebra.CharP.Algebra +import Mathlib.RingTheory.TensorProduct.Maps +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFraction + +/-! +# Coefficient base change for the spaces `P_α` + +The ordinal value of a nonpositive series is determined by its support, so it is monotone under +inclusion of supports even when the two series have different coefficient fields +(`Berarducci.ordinalValue_le_of_support_subset`). A `K`-linear map `λ : E → F` between extensions +of `K`, applied coefficientwise, can only shrink the support, and preserves it when `λ` is +injective; so it does not increase the ordinal value, and preserves it when `λ` is injective. +Coefficient extension along the structure map `K → E` is the injective case, and a coordinate +functional along a `K`-basis of `E` is the general case. + +Coefficient extension therefore preserves the ordinal-value degree and induces the graded ring +homomorphism `P̂ → P̂^(E)` of associated graded rings. For every field extension `E / K` the +induced map `E ⊗[K] P_α → P_α^(E)` is injective: a vanishing expansion along a `K`-basis of `E` has +vanishing coordinates, one by one. Assembling the homogeneous components gives an injective +`E`-algebra map +`E ⊗[K] P̂ → P̂^(E)`, multiplicative because the ring homomorphism `P̂ → P̂^(E)` is, so `E ⊗[K] P̂` +is a domain. This is the input to the geometric integrality of the quotient `P̂/I`. + +Degrees are `NatOrdinal`, so the degree of a product is the natural sum `⊕` of the degrees, and +the finite-degree part `P̂_{<ω}` is the part supported below `ω`. +-/ + +universe v w w' + +open scoped DirectSum HahnSeries NatOrdinal TensorProduct + +public noncomputable section + +namespace Berarducci + +open Berarducci + +open HahnSeries.Nonpositive + +variable {K : Type v} {E : Type w} [Field K] [Field E] + +/-! ### Coefficientwise linear maps and the ordinal value -/ + +section LinearCoefficientMap + +variable {F : Type w'} [Field F] [Algebra K E] [Algebra K F] + +/-- Coefficientwise application of a `K`-linear map `λ : E → F` between extensions of `K`. -/ +def nonpositiveLinearCoeffMap (lam : E →ₗ[K] F) : + HahnSeries.Nonpositive ℝ E →+ HahnSeries.Nonpositive ℝ F where + toFun u := ⟨(u : E⟦ℝ⟧).map (lam : E →+ F), by + refine (HahnSeries.mem_nonpositiveSubring ℝ F).mpr fun x hx ↦ + HahnSeries.Nonpositive.support_subset u ?_ + rw [HahnSeries.mem_support] at hx ⊢ + intro hzero + exact hx (show lam ((u : E⟦ℝ⟧).coeff x) = 0 by rw [hzero, map_zero])⟩ + map_zero' := Subtype.ext (HahnSeries.map_zero (lam : E →ₗ[K] F).toAddMonoidHom.toZeroHom) + map_add' u v := Subtype.ext (HahnSeries.map_add (lam : E →ₗ[K] F).toAddMonoidHom) + +@[simp] +theorem coe_nonpositiveLinearCoeffMap (lam : E →ₗ[K] F) (u : HahnSeries.Nonpositive ℝ E) + (x : ℝ) : + ((nonpositiveLinearCoeffMap lam u : HahnSeries.Nonpositive ℝ F) : F⟦ℝ⟧).coeff x = + lam ((u : E⟦ℝ⟧).coeff x) := + (rfl) + +/-- A coefficientwise linear map does not enlarge the support. -/ +theorem support_nonpositiveLinearCoeffMap_subset (lam : E →ₗ[K] F) + (u : HahnSeries.Nonpositive ℝ E) : + ((nonpositiveLinearCoeffMap lam u : HahnSeries.Nonpositive ℝ F) : F⟦ℝ⟧).support ⊆ + (u : E⟦ℝ⟧).support := by + intro x hx + rw [HahnSeries.mem_support] at hx ⊢ + intro hzero + exact hx (by rw [coe_nonpositiveLinearCoeffMap, hzero, map_zero]) + +/-- A coefficientwise injective linear map preserves the support. -/ +theorem support_nonpositiveLinearCoeffMap_of_injective (lam : E →ₗ[K] F) + (hlam : Function.Injective lam) (u : HahnSeries.Nonpositive ℝ E) : + ((nonpositiveLinearCoeffMap lam u : HahnSeries.Nonpositive ℝ F) : F⟦ℝ⟧).support = + (u : E⟦ℝ⟧).support := by + ext x + rw [HahnSeries.mem_support, HahnSeries.mem_support, coe_nonpositiveLinearCoeffMap] + exact (LinearMap.map_eq_zero_iff lam hlam).not + +/-- A coefficientwise `K`-linear map between extensions of `K` does not increase the ordinal +value. -/ +theorem ordinalValue_nonpositiveLinearCoeffMap_le (lam : E →ₗ[K] F) + (u : HahnSeries.Nonpositive ℝ E) : + ordinalValue (nonpositiveLinearCoeffMap lam u) ≤ ordinalValue u := + ordinalValue_le_of_support_subset _ _ (support_nonpositiveLinearCoeffMap_subset lam u) + +/-- A coefficientwise injective `K`-linear map between extensions of `K` preserves the ordinal +value. -/ +theorem ordinalValue_nonpositiveLinearCoeffMap_of_injective (lam : E →ₗ[K] F) + (hlam : Function.Injective lam) (u : HahnSeries.Nonpositive ℝ E) : + ordinalValue (nonpositiveLinearCoeffMap lam u) = ordinalValue u := + le_antisymm (ordinalValue_nonpositiveLinearCoeffMap_le lam u) + (ordinalValue_le_of_support_subset _ _ + (support_nonpositiveLinearCoeffMap_of_injective lam hlam u).superset) + +end LinearCoefficientMap + +/-- An extension field of a field of characteristic zero has characteristic zero. -/ +theorem charZero_of_algebra (L : Type v) [Field L] [CharZero L] (F : Type w) [Field F] + [Algebra L F] : CharZero F := + charZero_of_injective_algebraMap (algebraMap L F).injective + +/-! ### Base change of the spaces `P_α` and `P̂` + +The componentwise and ring base changes are defined for any fields `K ⊆ E`: they are the component +maps of the associated graded rings along coefficient extension, which rest only on the degree +structure of `ordinalValueDegreeValuation`. Characteristic zero of `E` enters for the domain +property of `P̂^(E)`, hence for injectivity of `ε` and for `E ⊗[K] P̂` being a domain. -/ + +section Layer + +/-- Coefficient extension preserves the ordinal-value degree exactly. -/ +private theorem ordinalValueDegreeValuation_nonpositiveCoefficientMap (f : K →+* E) + (x : HahnSeries.Nonpositive ℝ K) : + ordinalValueDegreeValuation E (nonpositiveCoefficientMap f x) = + ordinalValueDegreeValuation K x := by + rw [ordinalValueDegreeValuation_apply, ordinalValueDegreeValuation_apply] + have hov := ordinalValue_nonpositiveCoefficientMap f x + have key : ∀ α : NatOrdinal, + ordinalValueDegree (nonpositiveCoefficientMap f x) ≤ (α : WithBot NatOrdinal) ↔ + ordinalValueDegree x ≤ (α : WithBot NatOrdinal) := by + intro α + rw [ordinalValueDegree_le_coe_iff, ordinalValueDegree_le_coe_iff, hov] + have hbot : ordinalValueDegree (nonpositiveCoefficientMap f x) = ⊥ ↔ + ordinalValueDegree x = ⊥ := by + rw [ordinalValueDegree_eq_bot_iff, ordinalValueDegree_eq_bot_iff, ← ordinalValue_eq_zero_iff, + ← ordinalValue_eq_zero_iff, hov] + refine le_antisymm ?_ ?_ + · cases hxd : ordinalValueDegree x with + | bot => rw [hbot.mpr hxd] + | coe α => exact (key α).mpr (le_of_eq hxd) + · cases hyd : ordinalValueDegree (nonpositiveCoefficientMap f x) with + | bot => rw [hbot.mp hyd] + | coe β => exact (key β).mp (le_of_eq hyd) + +/-- The additive coefficient-extension map on `P_α`: the associated-graded +component map of the degree-preserving ring homomorphism `nonpositiveCoefficientMap f`. -/ +def principalComponentCoefficientExtendAddHom (f : K →+* E) (alpha : NatOrdinal) : + PrincipalComponent K alpha →+ PrincipalComponent E alpha := + (ordinalValueDegreeValuation K).componentMap (ordinalValueDegreeValuation E) + (nonpositiveCoefficientMap f) + (fun x ↦ (ordinalValueDegreeValuation_nonpositiveCoefficientMap f x).le) alpha + +/-- The additive component map sends the class of a representative to the class of its image. -/ +theorem principalComponentCoefficientExtendAddHom_principalComponentMk (f : K →+* E) + (alpha : NatOrdinal) (b : HahnSeries.Nonpositive ℝ K) + (hb : ordinalValue b < ω^ (alpha + 1)) : + principalComponentCoefficientExtendAddHom f alpha + (principalComponentMk alpha b hb) = + principalComponentMk alpha (nonpositiveCoefficientMap f b) + (by rw [ordinalValue_nonpositiveCoefficientMap]; exact hb) := by + rw [principalComponentCoefficientExtendAddHom, principalComponentMk_eq_componentMk, + MaxAddDegree.componentMap_componentMk, principalComponentMk_eq_componentMk] + congr 1 + apply Subtype.ext + rw [MaxAddDegree.coe_mapFiltrationLE] + +variable (K E) in +/-- Coefficient extension on `P_α`, semilinear along the algebra map: the +associated-graded component map of coefficient extension. -/ +def principalComponentCoefficientExtend [Algebra K E] (alpha : NatOrdinal) : + PrincipalComponent K alpha →ₛₗ[algebraMap K E] PrincipalComponent E alpha where + toFun := principalComponentCoefficientExtendAddHom (algebraMap K E) alpha + map_add' := map_add _ + map_smul' k x := by + obtain ⟨b, hb, rfl⟩ := exists_principalComponentMk alpha x + rw [smul_principalComponentMk, principalComponentCoefficientExtendAddHom_principalComponentMk, + principalComponentCoefficientExtendAddHom_principalComponentMk, smul_principalComponentMk] + congr 1 + rw [map_mul, nonpositiveCoefficientMap_C] + +variable (K E) in +/-- The scalar-extended component map `E ⊗[K] P_α →ₗ[E] P_α^(E)`. -/ +def principalComponentBaseChange [Algebra K E] (alpha : NatOrdinal) : + E ⊗[K] PrincipalComponent K alpha →ₗ[E] PrincipalComponent E alpha := by + letI : Module K (PrincipalComponent E alpha) := + Module.compHom (PrincipalComponent E alpha) (algebraMap K E) + haveI : IsScalarTower K E (PrincipalComponent E alpha) := + ⟨fun k e y ↦ by + change ((k • e : E)) • y = (algebraMap K E k) • (e • y) + rw [Algebra.smul_def, mul_smul]⟩ + exact LinearMap.liftBaseChange E + { toFun := principalComponentCoefficientExtend K E alpha + map_add' := fun x y ↦ map_add _ x y + map_smul' := fun k x ↦ + (principalComponentCoefficientExtend K E alpha).map_smul' k x } + +/-- A coefficientwise basis functional picks out one summand of a basis decomposition. -/ +private theorem nonpositiveLinearCoeffMap_C_mul [Algebra K E] {ι : Type*} [DecidableEq ι] + (bE : Module.Basis ι K E) (i j : ι) (v : HahnSeries.Nonpositive ℝ K) : + nonpositiveLinearCoeffMap (bE.coord j) + (HahnSeries.Nonpositive.C (bE i) * nonpositiveCoefficientMap (algebraMap K E) v) = + if i = j then v else 0 := by + apply Subtype.ext + ext x + rw [coe_nonpositiveLinearCoeffMap, Subring.coe_mul, HahnSeries.Nonpositive.coe_C, + HahnSeries.C_mul_eq_smul, HahnSeries.coeff_smul, coe_nonpositiveCoefficientMap, + smul_eq_mul, mul_comm, ← Algebra.smul_def, map_smul, Module.Basis.coord_apply, + Module.Basis.repr_self, + Finsupp.single_apply] + by_cases h : i = j <;> simp [h] + +/-- A finite sum stays inside a principal filtration level. -/ +private theorem ordinalValue_finsetSum_lt {ι : Type*} {K' : Type*} [Field K'] + (alpha : NatOrdinal) (g : ι → HahnSeries.Nonpositive ℝ K') + (hg : ∀ i, ordinalValue (g i) < ω^ (alpha + 1)) (t : Finset ι) : + ordinalValue (∑ i ∈ t, g i) < ω^ (alpha + 1) := by + classical + induction t using Finset.induction with + | empty => + rw [Finset.sum_empty, + ordinalValue_of_mem_negativeMonomialIdeal + (HahnSeries.Nonpositive.negativeMonomialIdeal K').zero_mem] + exact NatOrdinal.wpow_pos _ + | insert i t hi ih => + rw [Finset.sum_insert hi] + exact lt_of_le_of_lt (ordinalValue_add_le_max _ _) (max_lt (hg i) ih) + +/-- The class of a finite sum is the sum of the classes. -/ +private theorem principalComponentMk_sum {ι : Type*} + (alpha : NatOrdinal) (g : ι → HahnSeries.Nonpositive ℝ K) + (hg : ∀ i, ordinalValue (g i) < ω^ (alpha + 1)) (t : Finset ι) + (hsum : ordinalValue (∑ i ∈ t, g i) < ω^ (alpha + 1)) : + principalComponentMk alpha (∑ i ∈ t, g i) hsum = + ∑ i ∈ t, principalComponentMk alpha (g i) (hg i) := by + simp only [principalComponentMk_eq_componentMk] + rw [← map_sum] + congr 1 + apply Subtype.ext + rw [AddSubmonoidClass.coe_finsetSum] + +/-- The scalar-extended component map on a pure tensor. -/ +@[simp] +theorem principalComponentBaseChange_tmul [Algebra K E] + (alpha : NatOrdinal) (e : E) + (x : PrincipalComponent K alpha) : + principalComponentBaseChange K E alpha (e ⊗ₜ[K] x) = + e • principalComponentCoefficientExtend K E alpha x := + (rfl) + +variable (K E) in +/-- Base change on each homogeneous component is injective for every field extension `E / K`: the +coordinates of a +vanishing expansion along a `K`-basis of `E` vanish one by one. -/ +theorem principalComponentBaseChange_injective [Algebra K E] + (alpha : NatOrdinal) : + Function.Injective (principalComponentBaseChange K E alpha) := by + classical + rw [injective_iff_map_eq_zero] + intro z hz + let bE := Module.Free.chooseBasis K E + obtain ⟨c, rfl⟩ := TensorProduct.eq_repr_basis_left bE z + choose b hb hbx using fun i ↦ exists_principalComponentMk alpha (c i) + have hprod : ∀ i, ordinalValue (HahnSeries.Nonpositive.C (bE i) * + nonpositiveCoefficientMap (algebraMap K E) (b i)) < ω^ (alpha + 1) := fun i ↦ by + simpa only [zero_add] using ordinalValue_mul_lt_wpow_add_one + (ordinalValue_C_lt_wpow_one (bE i)) + (by rw [ordinalValue_nonpositiveCoefficientMap]; exact hb i) + have hsum := ordinalValue_finsetSum_lt alpha _ hprod c.support + have himg : principalComponentBaseChange K E alpha (c.sum fun i n ↦ bE i ⊗ₜ[K] n) = + principalComponentMk alpha + (∑ i ∈ c.support, HahnSeries.Nonpositive.C (bE i) * + nonpositiveCoefficientMap (algebraMap K E) (b i)) hsum := by + rw [Finsupp.sum, map_sum, principalComponentMk_sum alpha _ hprod _ hsum] + refine Finset.sum_congr rfl fun i _ ↦ ?_ + rw [← hbx i, principalComponentBaseChange_tmul] + change (bE i) • principalComponentCoefficientExtendAddHom + (algebraMap K E) alpha _ = _ + rw [principalComponentCoefficientExtendAddHom_principalComponentMk, smul_principalComponentMk] + rw [himg, principalComponentMk_eq_zero_iff] at hz + have hzero : ∀ j, c j = 0 := by + intro j + by_cases hj : j ∈ c.support + · rw [← hbx j, principalComponentMk_eq_zero_iff] + refine lt_of_le_of_lt (le_of_eq ?_) (lt_of_le_of_lt + (ordinalValue_nonpositiveLinearCoeffMap_le (bE.coord j) _) hz) + rw [map_sum] + rw [Finset.sum_congr rfl fun i (_ : i ∈ c.support) ↦ + nonpositiveLinearCoeffMap_C_mul bE i j (b i)] + rw [Finset.sum_ite_eq' c.support j b, if_pos hj] + · exact Finsupp.notMem_support_iff.mp hj + have hc : c = 0 := Finsupp.ext hzero + rw [hc, Finsupp.sum_zero_index] + +/-! ### The graded base change `E ⊗[K] P̂ → P̂^(E)` -/ + +variable (E) in +/-- The semilinear component map on the class of a representative. -/ +theorem principalComponentCoefficientExtend_principalComponentMk [Algebra K E] + (alpha : NatOrdinal) + (b : HahnSeries.Nonpositive ℝ K) (hb : ordinalValue b < ω^ (alpha + 1)) : + principalComponentCoefficientExtend K E alpha (principalComponentMk alpha b hb) = + principalComponentMk alpha (nonpositiveCoefficientMap (algebraMap K E) b) + (by rw [ordinalValue_nonpositiveCoefficientMap]; exact hb) := + principalComponentCoefficientExtendAddHom_principalComponentMk (algebraMap K E) alpha b hb + +variable (K E) in +/-- The graded base change `E ⊗[K] P̂ → P̂^(E)`, as an `E`-linear map: the direct sum of the +componentwise base changes. -/ +def principalSubringBaseChangeLinear [Algebra K E] : + E ⊗[K] PrincipalSubring K →ₗ[E] PrincipalSubring E := + (DirectSum.lmap fun alpha ↦ principalComponentBaseChange K E alpha).comp + (TensorProduct.directSumRight K E E (PrincipalComponent K)).toLinearMap + +/-- The graded base change on a pure tensor of a homogeneous element. -/ +theorem principalSubringBaseChangeLinear_tmul_of [Algebra K E] + (e : E) (alpha : NatOrdinal) + (A : PrincipalComponent K alpha) : + principalSubringBaseChangeLinear K E + (e ⊗ₜ[K] DirectSum.of (PrincipalComponent K) alpha A) = + e • DirectSum.of (PrincipalComponent E) alpha + (principalComponentCoefficientExtend K E alpha A) := by + rw [principalSubringBaseChangeLinear, LinearMap.comp_apply, LinearEquiv.coe_coe, + ← DirectSum.lof_eq_of K, TensorProduct.directSumRight_tmul_lof, DirectSum.lmap_lof, + principalComponentBaseChange_tmul, LinearMap.map_smul, DirectSum.lof_eq_of] + +variable (K E) in +/-- The graded base change is injective, because base change on each homogeneous component is. -/ +theorem principalSubringBaseChangeLinear_injective [Algebra K E] : + Function.Injective (principalSubringBaseChangeLinear K E) := + ((DirectSum.lmap_injective _).mpr fun alpha ↦ + principalComponentBaseChange_injective K E alpha).comp + (TensorProduct.directSumRight K E E (PrincipalComponent K)).injective + +variable (K E) in +/-- Coefficient extension `P̂ → P̂^(E)` as a graded ring homomorphism: the associated-graded map +of the degree-preserving ring homomorphism `nonpositiveCoefficientMap (algebraMap K E)`. On the +homogeneous component `P_α` it is `principalComponentCoefficientExtend K E α`. -/ +def principalSubringCoefficientExtend [Algebra K E] : PrincipalSubring K →+* PrincipalSubring E := + (ordinalValueDegreeValuation K).associatedGradedMap (ordinalValueDegreeValuation E) + (nonpositiveCoefficientMap (algebraMap K E)) + fun x ↦ (ordinalValueDegreeValuation_nonpositiveCoefficientMap (algebraMap K E) x).le + +/-- Coefficient extension of `P̂` on a homogeneous element. -/ +theorem principalSubringCoefficientExtend_of [Algebra K E] + (alpha : NatOrdinal) + (A : PrincipalComponent K alpha) : + principalSubringCoefficientExtend K E (DirectSum.of (PrincipalComponent K) alpha A) = + DirectSum.of (PrincipalComponent E) alpha (principalComponentCoefficientExtend K E alpha A) := + MaxAddDegree.associatedGradedMap_of _ _ _ _ alpha A + +/-- The graded base change on a pure tensor: `e ⊗ A ↦ e • ε(A)`. -/ +theorem principalSubringBaseChangeLinear_tmul [Algebra K E] + (e : E) (A : PrincipalSubring K) : + principalSubringBaseChangeLinear K E (e ⊗ₜ[K] A) = + e • principalSubringCoefficientExtend K E A := by + induction A using DirectSum.induction_on with + | zero => rw [TensorProduct.tmul_zero, map_zero, map_zero, smul_zero] + | of alpha A => + rw [principalSubringBaseChangeLinear_tmul_of, + principalSubringCoefficientExtend_of] + | add x y hx hy => rw [TensorProduct.tmul_add, map_add, hx, hy, map_add, smul_add] + +variable (K E) in +/-- Coefficient extension as an `E`-algebra map `E ⊗[K] P̂ → P̂^(E)`, the paper's map `ε`; +it is injective when `E` has characteristic zero (`principalSubringBaseChange_injective`). -/ +def principalSubringBaseChange [Algebra K E] : + E ⊗[K] PrincipalSubring K →ₐ[E] PrincipalSubring E := + Algebra.TensorProduct.algHomOfLinearMapTensorProduct (principalSubringBaseChangeLinear K E) + (fun e f A B ↦ by + rw [principalSubringBaseChangeLinear_tmul, principalSubringBaseChangeLinear_tmul, + principalSubringBaseChangeLinear_tmul, map_mul, smul_mul_smul_comm]) + (by rw [principalSubringBaseChangeLinear_tmul, map_one, one_smul]) + +theorem principalSubringBaseChange_tmul_of [Algebra K E] + (e : E) (alpha : NatOrdinal) + (A : PrincipalComponent K alpha) : + principalSubringBaseChange K E + (e ⊗ₜ[K] DirectSum.of (PrincipalComponent K) alpha A) = + e • DirectSum.of (PrincipalComponent E) alpha + (principalComponentCoefficientExtend K E alpha A) := + principalSubringBaseChangeLinear_tmul_of e alpha A + +variable (K E) in +theorem principalSubringBaseChange_injective [Algebra K E] : + Function.Injective (principalSubringBaseChange K E) := + principalSubringBaseChangeLinear_injective K E + +variable (K E) in +/-- `E ⊗[K] P̂` is a domain, being a subring of the domain `P̂^(E)`. -/ +theorem isDomain_tensor_principalSubring [Algebra K E] [CharZero E] : + IsDomain (E ⊗[K] PrincipalSubring K) := + haveI : IsDomain (PrincipalSubring E) := principalSubringIsDomain + Function.Injective.isDomain (principalSubringBaseChange K E).toRingHom + (principalSubringBaseChange_injective K E) + +end Layer + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CantorBendixsonGrading.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CantorBendixsonGrading.lean new file mode 100644 index 0000000000..fb6af9ce95 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CantorBendixsonGrading.lean @@ -0,0 +1,184 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Scalar +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRank + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# The subring $\widehat{\mathrm P}$ and Cantor–Bendixson degree + +For real exponents, Berarducci's ordinal value is `omega` raised to the Cantor–Bendixson rank of +zero in the closed support, so its Cantor degree is that rank. Consequently `P̂` +is canonically isomorphic to the associated graded algebra of the Cantor–Bendixson degree. The +isomorphism preserves every homogeneous component and therefore carries minimal homogeneous +generating systems to minimal generating systems. +-/ + +universe v w + +open scoped DirectSum HahnSeries NatOrdinal + +open Berarducci HahnSeries + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] [CharZero K] + +omit [CharZero K] in +private theorem principalSubring_algebraMap_eq_initialForm (k : K) : + algebraMap K (PrincipalSubring K) k = + (ordinalValueDegreeValuation K).initialForm (HahnSeries.Nonpositive.C k) := by + by_cases hk : k = 0 + · subst k + simp + · rw [principalSubring_algebraMap_apply, principalComponentScalarHom_apply, + principalComponentMk_eq_componentMk, ← MaxAddDegree.homogeneousMk_apply] + apply MaxAddDegree.homogeneousMk_eq_initialForm_of_degree_eq + rw [ordinalValueDegreeValuation_apply] + simpa only [WithBot.coe_zero] using ordinalValueDegree_C_of_ne (K := K) hk + +private theorem cantorBendixson_algebraMap_eq_initialForm (k : K) : + algebraMap K + (HahnSeries.Nonpositive.cantorBendixsonDegreeValuation + (G := ℝ) (R := K)).AssociatedGraded k = + (HahnSeries.Nonpositive.cantorBendixsonDegreeValuation + (G := ℝ) (R := K)).initialForm (HahnSeries.Nonpositive.C k) := by + by_cases hk : k = 0 + · subst k + simp + · rw [HahnSeries.Nonpositive.cantorBendixson_algebraMap_apply, + HahnSeries.Nonpositive.cantorBendixsonLayerScalarHom_apply, + ← MaxAddDegree.homogeneousMk_apply] + apply MaxAddDegree.homogeneousMk_eq_initialForm_of_degree_eq + exact HahnSeries.Nonpositive.degree_C_of_ne k hk + +/-- The subring `P̂` is canonically the associated graded algebra defined by the +Cantor–Bendixson degree. -/ +@[expose, blueprint "lem:principal-subring-cantor-bendixson" + (phase := "Principal RV-elements") + (title := "Cantor--Bendixson grading of $\\widehat{\\mathrm P}$") + (statement := /-- + Let $\widehat{\mathrm P}$ be the subring of principal elements of + $\widehat{\mathrm{RV}}$, equivalently the associated graded $K$-algebra + for $\deg_J$. Define + \[ + \delta_{\mathrm{CB}}(b)= + \begin{cases} + -\infty, & 0\notin\mathrm{cl}(\operatorname{supp}(b)),\\ + \operatorname{rk}_{\mathrm{CB},\mathrm{cl}(\operatorname{supp}(b))}(0), + & 0\in\mathrm{cl}(\operatorname{supp}(b)). + \end{cases} + \] + There is a canonical isomorphism of $K$-algebras + \[ + \widehat{\mathrm P}\simeq_K + \operatorname{gr}_{\delta_{\mathrm{CB}}}K((\mathbb R^{\le0})). + \] + -/) + (proof := /-- + The subring $\widehat{\mathrm P}$ is the associated graded algebra for $\deg_J$. + \ref{lem:ordinal-value-degree-is-cantor-bendixson-rank} identifies + $\deg_J$ with $\delta_{\mathrm{CB}}$, so the identity on series induces a + ring isomorphism between the associated graded algebras. Both scalar + embeddings send $k\in K$ to the initial form of the constant series $k$; + hence this is an isomorphism of $K$-algebras. + -/)] +def principalSubringCantorBendixsonAlgEquiv : PrincipalSubring K ≃ₐ[K] + (HahnSeries.Nonpositive.cantorBendixsonDegreeValuation + (G := ℝ) (R := K)).AssociatedGraded where + toRingEquiv := (ordinalValueDegreeValuation K).associatedGradedCongr + (ordinalValueDegreeValuation_eq_cantorBendixsonDegreeValuation (K := K)) + commutes' k := by + rw [principalSubring_algebraMap_eq_initialForm, cantorBendixson_algebraMap_eq_initialForm] + exact MaxAddDegree.associatedGradedCongr_initialForm _ _ + +/-- The underlying map is transport along equality of the two degree functions. -/ +theorem principalSubringCantorBendixsonAlgEquiv_apply (x : PrincipalSubring K) : + principalSubringCantorBendixsonAlgEquiv x = + (ordinalValueDegreeValuation K).associatedGradedCongr + (ordinalValueDegreeValuation_eq_cantorBendixsonDegreeValuation (K := K)) x := + rfl + +/-- The canonical equivalence preserves each homogeneous component. -/ +theorem principalSubringCantorBendixsonAlgEquiv_mem_grading + (n : NatOrdinal) (x : PrincipalSubring K) : + x ∈ principalGrading K n ↔ + principalSubringCantorBendixsonAlgEquiv x ∈ DirectSum.rangeLof K + (HahnSeries.Nonpositive.cantorBendixsonDegreeValuation + (G := ℝ) (R := K)).Component n := by + let ν := ordinalValueDegreeValuation K + let δ := HahnSeries.Nonpositive.cantorBendixsonDegreeValuation (G := ℝ) (R := K) + let hν : ν = δ := ordinalValueDegreeValuation_eq_cantorBendixsonDegreeValuation + constructor + · intro hx + obtain ⟨a, ha⟩ := (DirectSum.mem_rangeLof_iff K ν.Component n x).mp hx + rw [DirectSum.lof_eq_of] at ha + subst x + rw [show principalSubringCantorBendixsonAlgEquiv (DirectSum.of ν.Component n a) = + ν.associatedGradedCongr hν (DirectSum.of ν.Component n a) by rfl, + ν.associatedGradedCongr_of hν n a] + exact DirectSum.of_mem_rangeLof K δ.Component n (ν.componentCongr hν n a) + · intro hx + obtain ⟨a, ha⟩ := (DirectSum.mem_rangeLof_iff K δ.Component n + (principalSubringCantorBendixsonAlgEquiv x)).mp hx + rw [DirectSum.lof_eq_of] at ha + have hxa : x = DirectSum.of ν.Component n ((ν.componentCongr hν n).symm a) := by + apply (principalSubringCantorBendixsonAlgEquiv (K := K)).injective + rw [← ha] + change DirectSum.of δ.Component n a = + ν.associatedGradedCongr hν + (DirectSum.of ν.Component n ((ν.componentCongr hν n).symm a)) + rw [ν.associatedGradedCongr_of] + congr 2 + exact (ν.componentCongr hν n).apply_symm_apply a |>.symm + rw [hxa] + exact DirectSum.of_mem_rangeLof K ν.Component n _ + +variable {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +/-- Evaluation commutes with the canonical graded-algebra equivalence. -/ +theorem principalSubringCantorBendixsonAlgEquiv_aeval (F : MvPolynomial ι K) : + principalSubringCantorBendixsonAlgEquiv (MvPolynomial.aeval x F) = + MvPolynomial.aeval (fun i ↦ principalSubringCantorBendixsonAlgEquiv (x i)) F := by + change principalSubringCantorBendixsonAlgEquiv.toAlgHom (MvPolynomial.aeval x F) = _ + rw [← AlgHom.comp_apply, MvPolynomial.comp_aeval] + congr 1 + +/-- Degreewise injectivity is preserved by the canonical graded-algebra equivalence. -/ +theorem principalSubringCantorBendixson_injectiveAt_iff (n : NatOrdinal) : + OrdinalGraded.InjectiveAt K wt x n ↔ + OrdinalGraded.InjectiveAt K wt + (fun i ↦ principalSubringCantorBendixsonAlgEquiv (x i)) n := by + constructor + · intro h + rw [OrdinalGraded.injectiveAt_iff] at h ⊢ + intro F hF hzero + apply h F hF + apply principalSubringCantorBendixsonAlgEquiv.injective + rw [map_zero, principalSubringCantorBendixsonAlgEquiv_aeval, hzero] + · intro h + rw [OrdinalGraded.injectiveAt_iff] at h ⊢ + intro F hF hzero + apply h F hF + rw [← principalSubringCantorBendixsonAlgEquiv_aeval, hzero, map_zero] + +/-- A minimal system in `P̂` remains minimal in the equivalent graded algebra. -/ +theorem minimalSystem_cantorBendixson + (hx : OrdinalGraded.IsMinimalSystem (principalGrading K) wt x) : + OrdinalGraded.IsMinimalSystem + (DirectSum.rangeLof K (HahnSeries.Nonpositive.cantorBendixsonDegreeValuation + (G := ℝ) (R := K)).Component) + wt (fun i ↦ principalSubringCantorBendixsonAlgEquiv (x i)) := + hx.map_algEquiv principalSubringCantorBendixsonAlgEquiv + principalSubringCantorBendixsonAlgEquiv_mem_grading + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CantorBendixsonRank.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CantorBendixsonRank.lean new file mode 100644 index 0000000000..a65cdfa466 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CantorBendixsonRank.lean @@ -0,0 +1,222 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Graded +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueValuation +public import Mathlib.Topology.Instances.Real.Lemmas + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Additive +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ClosedPWO +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval + +/-! +# A topological formula for Berarducci's ordinal value + +For a nonpositive real generalised power series, Berarducci's ordinal value is `omega` raised to +the Cantor–Bendixson rank of exponent zero in the closed support. A sufficiently short negative +support tail has order type equal to the ordinal value, and its strict supremum zero has the +corresponding point rank. The zero and one values are the bounded and constant germs. +-/ + +open Set +open scoped HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace Berarducci + +open HahnSeries + +variable {K : Type v} [Field K] + +private theorem cantorBendixsonValue_eq_zero_of_mem_negativeMonomialIdeal + {b : Series K} (hb : b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K) : + (b : K⟦ℝ⟧).cantorBendixsonValue = 0 := by + rw [(b : K⟦ℝ⟧).cantorBendixsonValue_eq_zero_iff_support_bounded_lt + (HahnSeries.Nonpositive.support_subset b)] + have hsup := + HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero.mp hb + by_cases hb0 : b = 0 + · subst b + exact ⟨-1, by norm_num, by simp⟩ + · rw [HahnSeries.Nonpositive.supportSup_of_ne hb0] at hsup + refine ⟨sSup (b : K⟦ℝ⟧).support, WithBot.coe_lt_coe.mp hsup, fun x hx ↦ ?_⟩ + exact le_csSup (HahnSeries.Nonpositive.bddAbove_support b) hx + +private theorem cantorBendixsonValue_eq_one_of_ordinalValue_eq_one + {b : Series K} (hb : ordinalValue b = 1) : + (b : K⟦ℝ⟧).cantorBendixsonValue = 1 := by + rw [HahnSeries.cantorBendixsonValue_eq_one_iff] + obtain ⟨hbNear, hbJ⟩ := ordinalValue_eq_one_iff.mp hb + have hcoeff : HahnSeries.Nonpositive.constantCoeff b ≠ 0 := by + intro hzero + apply hbJ + have h := mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem.mp hbNear + simpa [hzero] using h + refine ⟨by simpa [HahnSeries.Nonpositive.constantCoeff_apply] using hcoeff, ?_⟩ + have hJ := mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem.mp hbNear + have hcb := cantorBendixsonValue_eq_zero_of_mem_negativeMonomialIdeal hJ + have heq : + ((b - HahnSeries.Nonpositive.C (HahnSeries.Nonpositive.constantCoeff b) : Series K) : + K⟦ℝ⟧) = (b : K⟦ℝ⟧) - HahnSeries.single 0 ((b : K⟦ℝ⟧).coeff 0) := by + ext x + simp [HahnSeries.Nonpositive.coe_C, HahnSeries.Nonpositive.constantCoeff_apply] + rwa [heq] at hcb + +/-- Berarducci's ordinal value is zero off the closed support at zero and otherwise equals +`omega` raised to the Cantor–Bendixson rank there. -/ +@[blueprint "lem:ordinal-value-cantor-bendixson" + (phase := "Cantor–Bendixson ranks of supports") + (title := "Cantor--Bendixson formula for the ordinal value") + (statement := /-- + Let $b\in K((\mathbb R^{\le 0}))$. If zero does not belong to the closed + support of $b$, then $v_J(b)=0$; otherwise + \[ + v_J(b)= + \omega^{\operatorname{rk}_{\mathrm{CB},\mathrm{cl}(\operatorname{supp}(b))}(0)}. + \] + -/) + (proof := /-- + By \ref{def:cantor-bendixson-value}, the right-hand side is zero off the + closed support at $0$ and otherwise records its Cantor--Bendixson rank. + For $v_J(b)=0$ or $1$ the assertion is the definition of $J$ and of the + congruence class modulo $J+K$. If $v_J(b)=\omega^\alpha>1$, then + \ref{fact:ordinal-value-support-tail} gives $\eta<0$ for which + $\operatorname{supp}(b)\cap(\eta,0)$ has order type $\omega^\alpha$. Zero + is its strict supremum, so + \ref{lem:cantor-bendixson-rank-of-strict-supremum} gives rank $\alpha$ at + zero in the closure of this tail. The closed support of $b$ agrees with that + closure on a neighbourhood of zero. Cantor--Bendixson rank is local with + respect to closed sets, so it has the same value in the closed support. + -/)] +theorem ordinalValue_eq_cantorBendixsonValue (b : Series K) : + (ordinalValue b).val = (b : K⟦ℝ⟧).cantorBendixsonValue := by + rcases lt_trichotomy (ordinalValue b) 1 with hzero | hone | hlarge + · have hvalue : ordinalValue b = 0 := Order.lt_one_iff.mp hzero + have hbJ := ordinalValue_eq_zero_iff.mp hvalue + rw [hvalue, cantorBendixsonValue_eq_zero_of_mem_negativeMonomialIdeal hbJ] + simp + · rw [hone, cantorBendixsonValue_eq_one_of_ordinalValue_eq_one hone] + simp + · rcases ordinalValue_eq_zero_or_isAdditivelyPrincipal b with hzero | hprincipal + · exact absurd hzero (ne_of_gt (zero_lt_one.trans hlarge)) + obtain ⟨a, ha⟩ := Ordinal.isAdditivelyPrincipal_iff.mp hprincipal + let α : NatOrdinal := NatOrdinal.of a + have hvalue : ordinalValue b = ω^ α := by + apply NatOrdinal.val.injective + simpa only [α, NatOrdinal.val_wpow, NatOrdinal.val_of] using ha + obtain ⟨η, hη, htype⟩ := + exists_negativeSupportTail_orderType_eq_ordinalValue b hlarge + let T : Set ℝ := negativeSupportTail b η + let hT : T.IsPWO := + (b : K⟦ℝ⟧).isPWO_support.mono (negativeSupportTail_subset_support b η) + have hTLUB : IsLUB T 0 := + isLUB_negativeSupportTail_zero_of_one_lt_ordinalValue b hlarge hη + have hT0 : (0 : ℝ) ∉ T := fun h ↦ (mem_negativeSupportTail_iff.mp h).2.2.false + have hα0 : α.val ≠ 0 := by + intro hα + have hone' : ordinalValue b = 1 := by + rw [hvalue] + apply NatOrdinal.val.injective + simp [hα] + exact hlarge.ne' hone' + have hrankT : + TopologicalSpace.Closeds.cantorBendixsonRank + (⟨closure T, isClosed_closure⟩ : TopologicalSpace.Closeds ℝ) + hT.closure 0 = α.val := by + apply Set.IsPWO.cantorBendixsonRank_closure_eq_of_orderType_eq_opow + hT hTLUB hT0 hα0 + simpa only [T, hT, hvalue, NatOrdinal.val_wpow] using htype + have hlocal : + ((b : K⟦ℝ⟧).closedSupport : Set ℝ) ∩ Set.Ioi η = + closure T ∩ Set.Ioi η := by + apply Set.Subset.antisymm + · intro x hx + refine ⟨?_, hx.2⟩ + have hx' : x ∈ closure (b : K⟦ℝ⟧).support ∩ Set.Ioi η := by + simpa only [HahnSeries.coe_closedSupport] using hx + have hx'' := isOpen_Ioi.closure_inter hx' + apply closure_minimal (s := (b : K⟦ℝ⟧).support ∩ Set.Ioi η) + (t := closure T) ?_ isClosed_closure hx'' + rintro y ⟨hy, hηy⟩ + have hy0 : y ≤ 0 := HahnSeries.Nonpositive.support_subset b hy + rcases eq_or_lt_of_le hy0 with rfl | hyneg + · obtain ⟨z, hz, -, -⟩ := hTLUB.exists_between hη + exact hTLUB.mem_closure ⟨z, hz⟩ + · apply subset_closure + exact mem_negativeSupportTail_iff.mpr ⟨hy, hηy, hyneg⟩ + · intro x hx + refine ⟨?_, hx.2⟩ + exact (HahnSeries.mem_closedSupport _ _).mpr + (closure_mono (negativeSupportTail_subset_support b η) hx.1) + have hrank : (b : K⟦ℝ⟧).cantorBendixsonRank 0 = α.val := by + rw [HahnSeries.cantorBendixsonRank_eq] + exact ((b : K⟦ℝ⟧).closedSupport.cantorBendixsonRank_congr_on_open + ⟨closure T, isClosed_closure⟩ (b : K⟦ℝ⟧).closedSupport_isPWO hT.closure + isOpen_Ioi hlocal (by simpa using hη)).trans hrankT + have hbne : b ≠ 0 := by + intro hb0 + subst b + simp at hlarge + have hmem : 0 ∈ closure (b : K⟦ℝ⟧).support := + (isLUB_support_zero_of_ordinalValue_ne_zero (b := b) + (ne_of_gt (zero_lt_one.trans hlarge))).mem_closure + (HahnSeries.support_nonempty_iff.mpr fun hcoe ↦ hbne (Subtype.ext hcoe)) + rw [(b : K⟦ℝ⟧).cantorBendixsonValue_of_mem hmem, hrank, hvalue] + simp + +variable [CharZero K] + +/-- The Cantor degree of Berarducci's ordinal value is the Cantor–Bendixson rank at zero. -/ +@[blueprint "lem:ordinal-value-degree-is-cantor-bendixson-rank" + (phase := "Cantor–Bendixson ranks of supports") + (title := "Cantor--Bendixson formula for $\\deg_J$") + (statement := /-- + Let $b\in K((\mathbb R^{\le0}))$, and let $\deg_J(b)$ be the Cantor degree + of $v_J(b)$, with value $-\infty$ when $v_J(b)=0$. Then + \[ + \deg_J(b)= + \begin{cases} + -\infty, & 0\notin\mathrm{cl}(\operatorname{supp}(b)),\\ + \operatorname{rk}_{\mathrm{CB},\mathrm{cl}(\operatorname{supp}(b))}(0), + & 0\in\mathrm{cl}(\operatorname{supp}(b)). + \end{cases} + \] + -/) + (proof := /-- + By \ref{thm:cantor-bendixson-value-multiplicative}, taking Cantor degree of + $V_{\mathrm{CB}}$ gives the multiplicative degree on the right. Apply + Cantor degree to \ref{lem:ordinal-value-cantor-bendixson}. The Cantor degree + of $0$ is $-\infty$, and the Cantor degree of $\omega^\alpha$ is $\alpha$. + -/)] +theorem ordinalValueDegree_eq_cantorBendixsonDegree (b : Series K) : + ordinalValueDegree b = + HahnSeries.Nonpositive.cantorBendixsonDegreeValuation (G := ℝ) (R := K) b := by + rw [ordinalValueDegree_eq_cantorDegree, + HahnSeries.Nonpositive.cantorBendixsonDegreeValuation_apply, + HahnSeries.Nonpositive.cantorBendixsonValuation_apply, + NatOrdinal.cantorDegree_eq_ordinalCantorDegree, + NatOrdinal.cantorDegree_eq_ordinalCantorDegree] + exact congrArg Ordinal.cantorDegree (by + simpa only [NatOrdinal.val_of] using ordinalValue_eq_cantorBendixsonValue b) + +/-- The two max-additive degrees on nonpositive real generalised power series are equal. -/ +theorem ordinalValueDegreeValuation_eq_cantorBendixsonDegreeValuation : + ordinalValueDegreeValuation K = + HahnSeries.Nonpositive.cantorBendixsonDegreeValuation (G := ℝ) (R := K) := by + apply MaxAddDegree.ext + intro b + rw [ordinalValueDegreeValuation_apply] + exact ordinalValueDegree_eq_cantorBendixsonDegree (K := K) b + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CantorBendixsonRepresentatives.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CantorBendixsonRepresentatives.lean new file mode 100644 index 0000000000..9e9d36d4bb --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CantorBendixsonRepresentatives.lean @@ -0,0 +1,121 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LiftFamily +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonGrading +public import + LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Principal representatives for the Cantor–Bendixson degree + +The canonical identification of the two degree functions leaves the representing Hahn series +unchanged. Thus representatives for `P̂` give representatives for the associated graded ring +defined by the Cantor–Bendixson degree, and the series remain principal. +-/ + +universe v w + +open scoped HahnSeries NatOrdinal + +open Berarducci HahnSeries + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] [CharZero K] +variable {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +namespace Lifts + +/-- Reinterpret principal-subring lifts in the equivalent Cantor–Bendixson graded algebra. -/ +@[expose] def cantorBendixson (σ : Lifts wt x) : HahnSeries.Nonpositive.LiftFamily wt + (fun i ↦ principalSubringCantorBendixsonAlgEquiv (x i)) where + lift := σ.lift + represents i := by + simpa only [principalSubringCantorBendixsonAlgEquiv_apply] using + (σ.represents i).congr + (ordinalValueDegreeValuation_eq_cantorBendixsonDegreeValuation (K := K)) + +@[simp] +theorem cantorBendixson_lift (σ : Lifts wt x) (i : ι) : σ.cantorBendixson.lift i = σ.lift i := + rfl + +omit [CharZero K] in +/-- The generic and real translated truncations are the same Hahn series. -/ +theorem translatedTruncLE_eq_translatedTruncation (b : Series K) (y : ℝ) : + HahnSeries.Nonpositive.translatedTruncLE y b = + translatedTruncation ((b : Series K) : K⟦ℝ⟧) y := by + apply Subtype.ext + rw [HahnSeries.Nonpositive.coe_translatedTruncLE, + Berarducci.coe_translatedTruncation] + +/-- Principal real Hahn-series representatives remain principal under the graded-algebra +equivalence. -/ +@[blueprint "lem:principal-representatives-cantor-bendixson" + (phase := "Principal RV-elements") + (title := "Principal series representatives for the Cantor--Bendixson grading") + (statement := /-- + Let $K$ be a field of characteristic zero. For each $i\in I$, let + $x_i\in\mathrm P_{w_i}\subseteq\widehat{\mathrm P}$ and choose a principal + series $b_i$ of degree $w_i$ representing $x_i$. Let + $\delta_{\mathrm{CB}}$ be the Cantor--Bendixson degree identified with + $\deg_J$ by + \ref{lem:ordinal-value-degree-is-cantor-bendixson-rank}, and identify + $\widehat{\mathrm P}$ with + $\operatorname{gr}_{\delta_{\mathrm{CB}}} + K((\mathbb R^{\le0}))$ + by \ref{lem:principal-subring-cantor-bendixson}. + + The same series $b_i$ represent the images of the $x_i$ under this + isomorphism, and, for every $i\in I$, + \[ + \delta_{\mathrm{CB}}(b_i)=w_i,\qquad + \delta_{\mathrm{CB}}(b_i^{|\gamma})γ_k - γ_{k+1}} t^{γ_{k+1}}` (`combinedCofactor`). Then the support of the `j`-th +combined cofactor has order type at most `ω^{e j}`, its translated truncations at cutoffs `ζ < 0` +have ordinal value below `ω^{e j}` and vanish at cutoffs `ζ ≤ γ_0`, and — under the separation +condition (n) for `(e j, c j, τ)`, `e j ⊕ θ < τ` for every `θ < c j`, where the translated +truncations of `v j` at cutoffs `ζ < 0` have ordinal value below `ω^{c j}` — the series +`E - ∑_j (combined cofactor)_j * v j` has translated truncations of ordinal value below `ω^(τ+1)` +at every cutoff in `(γ_0, 0)`. + +For `ζ ∈ (γ_k, γ_{k+1}]` and `ξ := ζ - γ_{k+1}`: `E^{|ζ} ≡ (piece (γ k) (γ (k+1)) E)^{|ξ}` and +the translated truncation of the `j`-th combined cofactor at `ζ` is `(w k j)^{|ξ}`, both modulo +`J`; and the translated truncation of each product differs from the translated truncation of its +first factor times the second factor by a series of ordinal value below `ω^τ`. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- A point of `(γ 0, 0)` lies in an interval `(γ k, γ (k+1)]` of a strictly increasing sequence +with supremum `0`. -/ +theorem exists_lt_le_succ_of_strictMono {γ : ℕ → ℝ} (hcof : ∀ η < (0 : ℝ), ∃ k, η < γ k) {ζ : ℝ} + (h0 : γ 0 < ζ) (hζ : ζ < 0) : + ∃ k, γ k < ζ ∧ ζ ≤ γ (k + 1) := by + classical + have hex : ∃ n, ζ ≤ γ n := by + obtain ⟨n, hn⟩ := hcof ζ hζ + exact ⟨n, hn.le⟩ + have hpos : Nat.find hex ≠ 0 := by + intro h + have := Nat.find_spec hex + rw [h] at this + exact absurd this (not_le.mpr h0) + refine ⟨Nat.find hex - 1, ?_, ?_⟩ + · have := Nat.find_min hex (m := Nat.find hex - 1) (by omega) + exact not_le.mp this + · have := Nat.find_spec hex + rwa [Nat.sub_add_cancel (by omega : 1 ≤ Nat.find hex)] + +section CombinedCofactors + +variable {ι' : Type w} [Fintype ι'] (E : Series K) (γ : ℕ → ℝ) (hγ : StrictMono γ) + (hneg : ∀ k, γ k < 0) (hcof : ∀ η < (0 : ℝ), ∃ k, η < γ k) (w : ℕ → ι' → Series K) + +/-- The intervals `(γ k, γ (k+1)]` as the intervals `(γ_k + c_k, γ_k]` of the sum (m) of +`SumAlongCutoffs.lean`, with cutoffs `γ (k+1)` and `c_k := γ k - γ (k+1)`: the condition +`γ_k ≤ γ_{k+1} + c_{k+1}` of (m) holds. -/ +theorem pieces_le_add_sub (k : ℕ) : γ (k + 1) ≤ γ (k + 1 + 1) + (γ (k + 1) - γ (k + 1 + 1)) := by + linarith + +include hγ hneg in +/-- The `j`-th combined cofactor `∑_k (w_{kj})_{>γ_k - γ_{k+1}} t^{γ_{k+1}}`: the sum (m) along the +cutoffs `γ_{k+1}` with the cofactors `w k j` of the pieces as terms. -/ +def combinedCofactor (j : ι') : Series K := + sumAlongCutoffsSeries (fun k ↦ w k j) (fun k ↦ γ k - γ (k + 1)) (fun k ↦ γ (k + 1)) + (fun _ _ h ↦ hγ (by omega)) (pieces_le_add_sub γ) (fun k ↦ hneg (k + 1)) + +include hγ hneg + +omit [Fintype ι'] in +/-- At cutoffs `ζ ≤ γ 0`, the translated truncations of the combined cofactor vanish. -/ +theorem translatedTruncation_combinedCofactor_eq_zero (j : ι') {ζ : ℝ} (hζ : ζ ≤ γ 0) : + translatedTruncation ((combinedCofactor γ hγ hneg w j : Series K) : K⟦ℝ⟧) ζ = 0 := + translatedTruncation_sumAlongCutoffsSeries_eq_zero _ _ _ _ _ _ + (by linarith [hγ (Nat.lt_succ_self 0)]) + (by linarith) + +omit [Fintype ι'] in +/-- On the `k`-th interval, the translated truncations of the combined cofactor are those of +`w k j`, modulo `J`: at `γ (k+1) + ξ` for `γ k - γ (k+1) < ξ ≤ 0`, it is `(w k j)^{|ξ}`. -/ +theorem translatedTruncation_combinedCofactor_sub_mem (j : ι') (k : ℕ) {ξ : ℝ} + (hξ : γ k - γ (k + 1) < ξ) (hξ0 : ξ ≤ 0) : + translatedTruncation ((combinedCofactor γ hγ hneg w j : Series K) : K⟦ℝ⟧) (γ (k + 1) + ξ) - + translatedTruncation (w k j : K⟦ℝ⟧) ξ ∈ Nonpositive.negativeMonomialIdeal K := + translatedTruncation_sumAlongCutoffsSeries_sub_mem _ _ _ _ _ _ k hξ hξ0 + +variable {e : ι' → NatOrdinal} + (hw : ∀ k j, ((w k j : Series K) : K⟦ℝ⟧).supportOrderType < (ω^ (e j)).val) +include hw + +omit [Fintype ι'] in +/-- The support of the combined cofactor has order type at most `ω^{e j}`. -/ +theorem supportOrderType_combinedCofactor_le (j : ι') : + ((combinedCofactor γ hγ hneg w j : Series K) : K⟦ℝ⟧).supportOrderType ≤ (ω^ (e j)).val := + supportOrderType_sumAlongCutoffsSeries_le _ _ _ _ _ _ fun k ↦ hw k j + +omit [Fintype ι'] in +/-- Every translated truncation of the combined cofactor has ordinal value below `ω^(e j + 1)`. -/ +theorem ordinalValue_translatedTruncation_combinedCofactor_lt_add_one (j : ι') (ζ : ℝ) : + ordinalValue (translatedTruncation ((combinedCofactor γ hγ hneg w j : Series K) : K⟦ℝ⟧) ζ) < + ω^ (e j + 1) := by + refine (ordinalValue_translatedTruncation_le_of_supportOrderType _ ζ).trans_lt ?_ + rw [← NatOrdinal.of_val (ω^ (e j + 1)), NatOrdinal.of.lt_iff_lt] + exact (supportOrderType_combinedCofactor_le γ hγ hneg w hw j).trans_lt + (NatOrdinal.val.lt_iff_lt.mpr (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one _))) + +include hcof + +omit [Fintype ι'] in +/-- **The translated truncations of the combined cofactor at cutoffs `ζ < 0` have ordinal value +below `ω^{e j}`.** -/ +theorem ordinalValue_translatedTruncation_combinedCofactor_lt (j : ι') {ζ : ℝ} (hζ : ζ < 0) : + ordinalValue (translatedTruncation ((combinedCofactor γ hγ hneg w j : Series K) : K⟦ℝ⟧) ζ) < + ω^ (e j) := by + rcases le_or_gt ζ (γ 0) with h0 | h0 + · rw [translatedTruncation_combinedCofactor_eq_zero γ hγ hneg w j h0, ordinalValue_zero] + exact NatOrdinal.wpow_pos _ + obtain ⟨k, hk1, hk2⟩ := exists_lt_le_succ_of_strictMono hcof h0 hζ + have hmem := translatedTruncation_combinedCofactor_sub_mem γ hγ hneg w j k + (ξ := ζ - γ (k + 1)) (by linarith) (by linarith) + rw [show γ (k + 1) + (ζ - γ (k + 1)) = ζ by ring] at hmem + rw [ordinalValue_eq_of_sub_mem_negativeMonomialIdeal hmem] + exact ordinalValue_translatedTruncation_lt_of_supportOrderType_lt (hw k j) _ + +variable {v : ι' → Series K} {c : ι' → NatOrdinal} {τ : NatOrdinal} + (hv : ∀ j, ∀ β : ℝ, β < 0 → ordinalValue (translatedTruncation (v j : K⟦ℝ⟧) β) < ω^ (c j)) + (hsep : ∀ j, ∀ θ, θ < c j → e j + θ < τ) + (hres : ∀ k, ∀ ξ : ℝ, γ k - γ (k + 1) < ξ → ξ ≤ 0 → + ordinalValue (translatedTruncation + ((piece (γ k) (γ (k + 1)) (E : K⟦ℝ⟧) - ∑ j, w k j * v j : Series K) : K⟦ℝ⟧) ξ) < + ω^ (τ + 1)) +include hv hsep hres + +/-- **Combining the cofactors of the pieces.** At every cutoff `ζ ∈ (γ 0, 0)`, the translated +truncation of `E - ∑_j (combined cofactor)_j * v j` has ordinal value below `ω^(τ+1)`. -/ +theorem ordinalValue_translatedTruncation_sub_sum_combinedCofactor_mul_lt {ζ : ℝ} (h0 : γ 0 < ζ) + (hζ : ζ < 0) : + ordinalValue (translatedTruncation + ((E - ∑ j, combinedCofactor γ hγ hneg w j * v j : Series K) : K⟦ℝ⟧) ζ) < ω^ (τ + 1) := by + classical + obtain ⟨k, hk1, hk2⟩ := exists_lt_le_succ_of_strictMono hcof h0 hζ + set ξ : ℝ := ζ - γ (k + 1) with hξdef + have hξ : γ k - γ (k + 1) < ξ := by rw [hξdef]; linarith + have hξ0 : ξ ≤ 0 := by rw [hξdef]; linarith + have hζξ : γ (k + 1) + ξ = ζ := by rw [hξdef]; ring + set C : ι' → Series K := combinedCofactor γ hγ hneg w with hCdef + set Dk : Series K := piece (γ k) (γ (k + 1)) (E : K⟦ℝ⟧) with hDkdef + -- the two translated truncations, expanded + have hX : translatedTruncation ((E - ∑ j, C j * v j : Series K) : K⟦ℝ⟧) ζ = + translatedTruncation (E : K⟦ℝ⟧) ζ - + ∑ j, translatedTruncation ((C j * v j : Series K) : K⟦ℝ⟧) ζ := by + rw [← translatedTruncationAddMonoidHom_apply, AddSubgroupClass.coe_sub, map_sub, + AddSubmonoidClass.coe_finsetSum, map_sum] + simp only [translatedTruncationAddMonoidHom_apply] + have hY : translatedTruncation ((Dk - ∑ j, w k j * v j : Series K) : K⟦ℝ⟧) ξ = + translatedTruncation (Dk : K⟦ℝ⟧) ξ - + ∑ j, translatedTruncation ((w k j * v j : Series K) : K⟦ℝ⟧) ξ := by + rw [← translatedTruncationAddMonoidHom_apply, AddSubgroupClass.coe_sub, map_sub, + AddSubmonoidClass.coe_finsetSum, map_sum] + simp only [translatedTruncationAddMonoidHom_apply] + have hYlt := hres k ξ hξ hξ0 + rw [hY] at hYlt + rw [hX] + -- the difference of the two expansions + set A := translatedTruncation (E : K⟦ℝ⟧) ζ + set A' := translatedTruncation (Dk : K⟦ℝ⟧) ξ + set P : ι' → Series K := fun j ↦ translatedTruncation ((C j * v j : Series K) : K⟦ℝ⟧) ζ + set Q : ι' → Series K := fun j ↦ translatedTruncation ((C j : Series K) : K⟦ℝ⟧) ζ * v j + set R : ι' → Series K := fun j ↦ translatedTruncation (w k j : K⟦ℝ⟧) ξ * v j + set P' : ι' → Series K := fun j ↦ translatedTruncation ((w k j * v j : Series K) : K⟦ℝ⟧) ξ + have hsplit : A - ∑ j, P j = (A' - ∑ j, P' j) + + ((A - A') - ∑ j, (P j - Q j) - ∑ j, (Q j - R j) + ∑ j, (P' j - R j)) := by + simp only [Finset.sum_sub_distrib] + abel + rw [hsplit] + refine (ordinalValue_add_le_max _ _).trans_lt (max_lt hYlt ?_) + refine lt_of_lt_of_le ?_ (NatOrdinal.wpow_le_wpow.mpr (lt_add_one τ).le) + -- each of the four differences has ordinal value below `ω^τ` + have hτpos : (0 : NatOrdinal) < ω^ τ := NatOrdinal.wpow_pos τ + have hAA' : ordinalValue (A - A') < ω^ τ := by + have := translatedTruncation_window_sub_mem (γ k) (γ (k + 1)) (E : K⟦ℝ⟧) hξ hξ0 + rw [hζξ] at this + rw [← ordinalValue_neg, neg_sub, ordinalValue_of_mem_negativeMonomialIdeal this] + exact hτpos + have hPQ : ∀ j, ordinalValue (P j - Q j) < ω^ τ := fun j ↦ + ordinalValue_translatedTruncation_mul_sub_mul_lt + (fun β _ ↦ ordinalValue_translatedTruncation_combinedCofactor_lt_add_one γ hγ hneg w hw j β) + (hv j) (hsep j) hζ + have hQR : ∀ j, ordinalValue (Q j - R j) < ω^ τ := fun j ↦ by + have hmem := translatedTruncation_combinedCofactor_sub_mem γ hγ hneg w j k hξ hξ0 + rw [hζξ] at hmem + have : Q j - R j ∈ Nonpositive.negativeMonomialIdeal K := by + rw [show Q j - R j = (translatedTruncation ((C j : Series K) : K⟦ℝ⟧) ζ - + translatedTruncation (w k j : K⟦ℝ⟧) ξ) * v j by simp only [Q, R]; ring] + exact Ideal.mul_mem_right _ _ hmem + rw [ordinalValue_of_mem_negativeMonomialIdeal this] + exact hτpos + have hP'R : ∀ j, ordinalValue (P' j - R j) < ω^ τ := fun j ↦ by + rcases lt_or_eq_of_le hξ0 with hξlt | hξ0' + · exact ordinalValue_translatedTruncation_mul_sub_mul_lt + (fun β _ ↦ (ordinalValue_translatedTruncation_lt_of_supportOrderType_lt (hw k j) β).trans + (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one _))) + (hv j) (hsep j) hξlt + · simp only [P', R, hξ0', translatedTruncation_zero, sub_self, ordinalValue_zero] + exact hτpos + have hsum : ∀ (f : ι' → Series K), (∀ j, ordinalValue (f j) < ω^ τ) → + ordinalValue (∑ j, f j) < ω^ τ := fun f hf ↦ + ordinalValue_sum_lt _ _ hτpos fun j _ ↦ hf j + refine (ordinalValue_add_le_max _ _).trans_lt (max_lt ?_ (hsum _ hP'R)) + rw [sub_eq_add_neg] + refine (ordinalValue_add_le_max _ _).trans_lt + (max_lt ?_ (by rw [ordinalValue_neg]; exact hsum _ hQR)) + rw [sub_eq_add_neg] + exact (ordinalValue_add_le_max _ _).trans_lt + (max_lt hAA' (by rw [ordinalValue_neg]; exact hsum _ hPQ)) + +end CombinedCofactors + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivAt.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivAt.lean new file mode 100644 index 0000000000..a9ac2afc4a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivAt.lean @@ -0,0 +1,293 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponent +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.TruncationDrop +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus.Pointwise +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSubmultiplicative + +/-! +# The map `∂ : P_{α+1} → Fun_{0⁻}(P_α)` + +The paper's `∂ : P_{α+1} → Fun_{0⁻}(P_α)` (eq:derivation). Let `u ∈ J_{ω^(α+2)}`. By the +truncation drop, the translated truncations `u^{|γ}` lie in `J_{ω^(α+1)}` for all `γ < 0` +sufficiently close to `0`, so `γ ↦ u^{|γ} + J_{ω^α}` is a function at `0⁻` with values in `P_α`. +If `u ∈ J_{ω^(α+1)}`, the same lemma with `β = α` makes this function zero. Since translated +truncation is `K`-linear in `u`, this defines the `K`-linear map +`∂(u + J_{ω^(α+1)}) := (γ ↦ u^{|γ} + J_{ω^α})`. + +In Lean the component of successor degree is indexed by `α` itself (`0 < α.constantCoeff`) and the +component one degree below it by `α.removeNat 1`, written `α⁻` in these docstrings: +`principalComponentDerivAt K α hα` is +`∂` on `P_{α+1}` in the paper's indexing and `P_α → Fun_{0⁻}(P_{α⁻})` in Lean's. The value +`derivAt α u γ` is `∂(u)(γ)`, set to zero at the `γ` where `u^{|γ} ∉ J_{ω^α}`; the function at +`0⁻` does not depend on those values. +-/ + +open Filter Topology +open scoped HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace Berarducci + +open Berarducci HahnSeries + +variable {K : Type v} [Field K] + +private theorem removeOne_add_one (alpha : NatOrdinal) + (halpha : 0 < alpha.constantCoeff) : + alpha.removeNat 1 + 1 = alpha := + by simpa using NatOrdinal.removeNat_add_natCast halpha + +/-- `∂(u)(γ)`, the class of the translated truncation `u^{|γ}` in `P_α` (paper eq:derivation); +in Lean's indexing it lies in `P_{α⁻}`, the component indexed by the predecessor of the successor +`α`. At the `γ` where +`u^{|γ} ∉ J_{ω^α}` the value is set to zero; the function at `0⁻` is independent of those +values. -/ +def derivAt (alpha : NatOrdinal) + (b : Series K) (gamma : ℝ) : + PrincipalComponent K (alpha.removeNat 1) := + if h : ordinalValue (translatedTruncation (b : K⟦ℝ⟧) gamma) < + ω^ (alpha.removeNat 1 + 1) then + principalComponentMk (alpha.removeNat 1) + (translatedTruncation (b : K⟦ℝ⟧) gamma) h + else + 0 + +/-- On its domain, `derivAt` is the class of the translated truncation. -/ +theorem derivAt_eq (alpha : NatOrdinal) + (b : Series K) (gamma : ℝ) + (h : ordinalValue (translatedTruncation (b : K⟦ℝ⟧) gamma) < + ω^ (alpha.removeNat 1 + 1)) : + derivAt alpha b gamma = + principalComponentMk (alpha.removeNat 1) + (translatedTruncation (b : K⟦ℝ⟧) gamma) h := by + simp only [derivAt, dif_pos h] + +/-- A series in `J_{ω^(α+1)}` has translated truncations in `J_{ω^α} = J_{ω^(α⁻+1)}` near zero +(truncation drop with `β = α`). -/ +theorem eventually_derivAt_bound (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) + (b : Series K) (hb : ordinalValue b < ω^ (alpha + 1)) : + ∀ᶠ gamma in 𝓝[<] (0 : ℝ), + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) gamma) < + ω^ (alpha.removeNat 1 + 1) := by + have h := eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one + alpha b hb + simpa only [removeOne_add_one alpha halpha] using h + +/-- For all `γ < 0` sufficiently close to `0`, `∂(u)(γ)` is the class of the translated +truncation `u^{|γ}` in `P_{α⁻}`, the component indexed by the predecessor of `α`. -/ +theorem eventually_derivAt_eq_principalComponentMk + (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) + (b : Series K) (hb : ordinalValue b < ω^ (alpha + 1)) : + ∀ᶠ gamma in 𝓝[<] (0 : ℝ), + ∃ hgamma : ordinalValue (translatedTruncation (b : K⟦ℝ⟧) gamma) < + ω^ (alpha.removeNat 1 + 1), + derivAt alpha b gamma = + principalComponentMk (alpha.removeNat 1) + (translatedTruncation (b : K⟦ℝ⟧) gamma) hgamma := by + filter_upwards [eventually_derivAt_bound alpha halpha b hb] with + gamma hgamma + exact ⟨hgamma, derivAt_eq alpha b gamma hgamma⟩ + +/-- The quotient projection to `P_α` preserves addition. -/ +theorem principalComponentMk_add (alpha : NatOrdinal) + (b c : Series K) + (hb : ordinalValue b < ω^ (alpha + 1)) + (hc : ordinalValue c < ω^ (alpha + 1)) + (hbc : ordinalValue (b + c) < ω^ (alpha + 1)) : + principalComponentMk alpha (b + c) hbc = + principalComponentMk alpha b hb + + principalComponentMk alpha c hc := by + let w := ordinalValueDegreeValuation K + rw [principalComponentMk_eq_componentMk, principalComponentMk_eq_componentMk, + principalComponentMk_eq_componentMk] + change w.componentMk alpha ⟨b + c, _⟩ = + w.componentMk alpha ⟨b, _⟩ + w.componentMk alpha ⟨c, _⟩ + rw [← map_add] + apply congrArg (w.componentMk alpha) + rfl + +private theorem eventually_derivAt_add + (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) + (b c : Series K) + (hb : ordinalValue b < ω^ (alpha + 1)) + (hc : ordinalValue c < ω^ (alpha + 1)) : + ∀ᶠ gamma in 𝓝[<] (0 : ℝ), + derivAt alpha (b + c) gamma = + derivAt alpha b gamma + + derivAt alpha c gamma := by + have hbc : ordinalValue (b + c) < ω^ (alpha + 1) := + (ordinalValue_add_le_max b c).trans_lt (max_lt hb hc) + filter_upwards [eventually_derivAt_bound alpha halpha b hb, + eventually_derivAt_bound alpha halpha c hc, + eventually_derivAt_bound alpha halpha (b + c) hbc] with + gamma hbg hcg hbcg + rw [derivAt_eq alpha b gamma hbg, + derivAt_eq alpha c gamma hcg, + derivAt_eq alpha (b + c) gamma hbcg] + have hseries : translatedTruncation ((b + c : Series K) : K⟦ℝ⟧) gamma = + translatedTruncation (b : K⟦ℝ⟧) gamma + translatedTruncation (c : K⟦ℝ⟧) gamma := + translatedTruncation_add (b : K⟦ℝ⟧) (c : K⟦ℝ⟧) gamma + have hsum : ordinalValue + (translatedTruncation (b : K⟦ℝ⟧) gamma + translatedTruncation (c : K⟦ℝ⟧) gamma) < + ω^ (alpha.removeNat 1 + 1) := by + rwa [← hseries] + convert principalComponentMk_add (alpha.removeNat 1) + (translatedTruncation (b : K⟦ℝ⟧) gamma) + (translatedTruncation (c : K⟦ℝ⟧) gamma) hbg hcg hsum using 1 + simp only [hseries] + +variable (K) in +/-- `u ↦ ∂(u)` as an additive map on the ideal `J_{ω^(α+1)}`, valued in `Fun_{0⁻}(P_{α⁻})`. -/ +private def filtrationDerivAt (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) : + (ordinalValueDegreeValuation K).filtrationLE alpha →+ + FunAtZeroMinus (PrincipalComponent K (alpha.removeNat 1)) where + toFun b := (derivAt (K := K) alpha b : + FunAtZeroMinus (PrincipalComponent K (alpha.removeNat 1))) + map_zero' := (FunAtZeroMinus.coe_eq_zero_iff _).mpr <| + Filter.Eventually.of_forall fun gamma ↦ by + have hzero : ordinalValue (translatedTruncation (0 : K⟦ℝ⟧) gamma) < + ω^ (alpha.removeNat 1 + 1) := by + rw [translatedTruncation_zero_input, ordinalValue_zero] + exact NatOrdinal.wpow_pos _ + rw [ZeroMemClass.coe_zero, derivAt_eq alpha 0 gamma hzero] + exact (principalComponentMk_eq_zero_iff _ _ hzero).mpr (by + rw [translatedTruncation_zero_input, ordinalValue_zero] + exact NatOrdinal.wpow_pos _) + map_add' := by + intro b c + change (derivAt (K := K) alpha (b + c) : + FunAtZeroMinus (PrincipalComponent K (alpha.removeNat 1))) = + (derivAt (K := K) alpha b : + FunAtZeroMinus (PrincipalComponent K (alpha.removeNat 1))) + + (derivAt (K := K) alpha c : + FunAtZeroMinus (PrincipalComponent K (alpha.removeNat 1))) + rw [← Filter.Germ.coe_add, Filter.Germ.coe_eq] + exact eventually_derivAt_add alpha halpha (b : Series K) (c : Series K) + ((mem_ordinalValueDegreeValuation_filtrationLE_iff (b : Series K) alpha).mp b.2) + ((mem_ordinalValueDegreeValuation_filtrationLE_iff (c : Series K) alpha).mp c.2) + +variable (K) in +/-- A series `u ∈ J_{ω^α}` has `∂(u) = 0` (truncation drop with `β = α⁻`). -/ +private theorem lowerFiltration_le_filtrationDerivAt_ker + (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) : + (ordinalValueDegreeValuation K).lowerFiltration alpha ≤ + (filtrationDerivAt K alpha halpha).ker := by + let w := ordinalValueDegreeValuation K + intro b hb + refine (FunAtZeroMinus.coe_eq_zero_iff (derivAt (K := K) alpha b)).mpr ?_ + have hbValue : ordinalValue (b : Series K) < ω^ (alpha.removeNat 1 + 1) := by + rw [removeOne_add_one alpha halpha] + have hvalue := (w.mem_lowerFiltration_iff alpha b).mp hb + rw [ordinalValueDegreeValuation_apply] at hvalue + exact (ordinalValueDegree_lt_coe_iff _ alpha).mp hvalue + have hdrop := eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one + (alpha.removeNat 1) (b : Series K) hbValue + filter_upwards [hdrop] with gamma hgamma + have hupper : ordinalValue (translatedTruncation ((b : Series K) : K⟦ℝ⟧) gamma) < + ω^ (alpha.removeNat 1 + 1) := + hgamma.trans (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one _)) + rw [derivAt_eq alpha (b : Series K) gamma hupper] + exact (principalComponentMk_eq_zero_iff _ _ hupper).mpr hgamma + +variable (K) in +private def principalComponentDerivAtAdd + (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) : + PrincipalComponent K alpha →+ FunAtZeroMinus (PrincipalComponent K (alpha.removeNat 1)) := + QuotientAddGroup.lift + ((ordinalValueDegreeValuation K).lowerFiltration alpha) + (filtrationDerivAt K alpha halpha) + (lowerFiltration_le_filtrationDerivAt_ker K alpha halpha) + +private theorem principalComponentDerivAtAdd_principalComponentMk + (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) + (b : Series K) (hb : ordinalValue b < ω^ (alpha + 1)) : + principalComponentDerivAtAdd K alpha halpha (principalComponentMk alpha b hb) = + (derivAt (K := K) alpha b : + FunAtZeroMinus (PrincipalComponent K (alpha.removeNat 1))) := by + let w := ordinalValueDegreeValuation K + rw [principalComponentMk_eq_componentMk, ← w.coe_component_eq_componentMk] + rfl + +private theorem eventually_derivAt_smul + (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) + (k : K) (b : Series K) (hb : ordinalValue b < ω^ (alpha + 1)) : + ∀ᶠ gamma in 𝓝[<] (0 : ℝ), + derivAt alpha + ((HahnSeries.Nonpositive.C : K →+* Series K) k * b) gamma = + k • derivAt alpha b gamma := by + let kb := (HahnSeries.Nonpositive.C : K →+* Series K) k * b + have hkb : ordinalValue kb < ω^ (alpha + 1) := by + rcases eq_or_ne k 0 with rfl | hk + · simp [kb] + · calc + ordinalValue kb ≤ ordinalValue ((HahnSeries.Nonpositive.C : K →+* Series K) k) * + ordinalValue b := ordinalValue_mul_le_naturalMul _ _ + _ = ordinalValue b := by rw [ordinalValue_C_of_ne hk, one_mul] + _ < ω^ (alpha + 1) := hb + filter_upwards [eventually_derivAt_bound alpha halpha b hb, + eventually_derivAt_bound alpha halpha kb hkb] with gamma hbg hkbg + rw [derivAt_eq alpha b gamma hbg, + derivAt_eq alpha kb gamma hkbg] + have hseries : translatedTruncation (kb : K⟦ℝ⟧) gamma = + (HahnSeries.Nonpositive.C : K →+* Series K) k * translatedTruncation (b : K⟦ℝ⟧) gamma := by + rw [show (kb : K⟦ℝ⟧) = HahnSeries.C k * (b : K⟦ℝ⟧) by + change ((((HahnSeries.Nonpositive.C : K →+* Series K) k) * b : Series K) : K⟦ℝ⟧) = _ + rw [Subring.coe_mul, HahnSeries.Nonpositive.coe_C]] + exact translatedTruncation_C_mul k (b : K⟦ℝ⟧) gamma + have hproduct : ordinalValue + ((HahnSeries.Nonpositive.C : K →+* Series K) k * translatedTruncation (b : K⟦ℝ⟧) gamma) < + ω^ (alpha.removeNat 1 + 1) := by + rwa [← hseries] + convert (smul_principalComponentMk (alpha.removeNat 1) k + (translatedTruncation (b : K⟦ℝ⟧) gamma) hbg).symm using 1 + simp only [hseries] + +private theorem principalComponentDerivAtAdd_map_smul + (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) + (k : K) (x : PrincipalComponent K alpha) : + principalComponentDerivAtAdd K alpha halpha (k • x) = + k • principalComponentDerivAtAdd K alpha halpha x := by + obtain ⟨b, hb, rfl⟩ := exists_principalComponentMk alpha x + rw [smul_principalComponentMk alpha k b hb, + principalComponentDerivAtAdd_principalComponentMk, + principalComponentDerivAtAdd_principalComponentMk] + change (derivAt alpha + ((HahnSeries.Nonpositive.C : K →+* Series K) k * b) : + FunAtZeroMinus (PrincipalComponent K (alpha.removeNat 1))) = + k • (derivAt (K := K) alpha b : + FunAtZeroMinus (PrincipalComponent K (alpha.removeNat 1))) + rw [← Filter.Germ.coe_smul, Filter.Germ.coe_eq] + exact eventually_derivAt_smul alpha halpha k b hb + +variable (K) in +/-- `∂` on `P_{α+1}` (paper eq:derivation): in Lean's indexing, the `K`-linear map +`P_α → Fun_{0⁻}(P_{α⁻})` for a successor `α`, where `α⁻ = α.removeNat 1` is the ordinal one below +`α`. -/ +def principalComponentDerivAt (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) : + PrincipalComponent K alpha →ₗ[K] FunAtZeroMinus (PrincipalComponent K (alpha.removeNat 1)) := + { principalComponentDerivAtAdd K alpha halpha with + map_smul' := principalComponentDerivAtAdd_map_smul alpha halpha } + +/-- On any representative `u ∈ J_{ω^(α+1)}`, `∂(u + J_{ω^α})` is the function at `0⁻` +`γ ↦ ∂(u)(γ)`, the class of the translated truncation `u^{|γ}` in `P_{α⁻}`. -/ +theorem principalComponentDerivAt_principalComponentMk + (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) + (b : Series K) (hb : ordinalValue b < ω^ (alpha + 1)) : + principalComponentDerivAt K alpha halpha (principalComponentMk alpha b hb) = + (derivAt (K := K) alpha b : + FunAtZeroMinus (PrincipalComponent K (alpha.removeNat 1))) := + principalComponentDerivAtAdd_principalComponentMk alpha halpha b hb + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivAtInjective.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivAtInjective.lean new file mode 100644 index 0000000000..1308dc9abc --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivAtInjective.lean @@ -0,0 +1,317 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAt + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal +import Mathlib.Topology.Instances.Real.Lemmas + +/-! +# Injectivity of translated truncation on `P_α` for successor `α` + +For every `α`, `∂` is injective on `P_{α+1}` (Berarducci's Lem. 6.8 in the present language). +Let `α = β + 1` be a successor ordinal and `u` a series with `v_J(u) = ω^α = ω^β · ω`. A +sufficiently short support tail `B` of `u` is order isomorphic to `ω` copies of `ω^β`. Let `S` +be its first block, the set of points of `B` of index below `ω^β`, and let `γ = sup S`. Then +`v_J(u^{|γ}) = ω^β`: + +* if `β = 0`, then `S` is a single support point `γ`, so `u^{|γ}` has nonzero constant term and + support otherwise bounded away from zero; +* if `β ≥ 1`, then `ω^β` is a limit, `S` has no largest element, the exponents of `u^{|γ}` + immediately below zero are the translates of final segments of `S`, and every nonempty final + segment of `S` has order type `ω^β` because `ω^β` is additively indecomposable. + +Applying this to the tail above any `θ < 0` produces cutoffs `γ ∈ (θ, 0)` at which +`∂(u)(γ) = u^{|γ} + J_{ω^β}` is nonzero, so `∂(B) ≠ 0` for every nonzero `B ∈ P_α`. +-/ + +open Filter Topology Ordinal +open scoped HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace Berarducci + +open Berarducci HahnSeries + +variable {K : Type v} [Field K] + +/-- A translated truncation at a support point is not in `J`. -/ +private theorem translatedTruncation_not_mem_negativeMonomialIdeal_of_mem_support + (u : Series K) {γ : ℝ} (hγ : γ ∈ (u : K⟦ℝ⟧).support) : + translatedTruncation (u : K⟦ℝ⟧) γ ∉ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + intro hJ + rw [HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero] at hJ + have hzero : (0 : ℝ) ∈ ((translatedTruncation (u : K⟦ℝ⟧) γ : Series K) : K⟦ℝ⟧).support := by + rw [HahnSeries.mem_support, coeff_translatedTruncation] + simpa using hγ + have hne : translatedTruncation (u : K⟦ℝ⟧) γ ≠ 0 := by + intro h + rw [h] at hzero + simp at hzero + rw [HahnSeries.Nonpositive.supportSup_of_ne hne] at hJ + exact absurd (le_csSup (HahnSeries.Nonpositive.bddAbove_support _) hzero) + (not_le.mpr (WithBot.coe_lt_coe.mp hJ)) + +/-- If `v_J(u) = ω^(β+1)` and `θ < 0`, there is a cutoff `θ < γ < 0` with +`v_J(u^{|γ}) = ω^β`. -/ +@[blueprint "lem:successor-truncation-value" + (phase := "Translated truncations") + (title := "Translated truncations of successor ordinal value") + (statement := /-- + Let $\beta<\omega_1$ and $b\in K((\mathbb R^{\le0}))$. If + $v_J(b)=\omega^{\beta+1}$, then for every $\theta<0$ there is + $\gamma\in(\theta,0)$ such that $v_J(b^{|\gamma})=\omega^\beta$. + -/) + (proof := /-- + By \ref{fact:ordinal-value-support-tail}, choose above $\theta$ a support + tail $B$ of order type + $\omega^{\beta+1}=\omega^\beta\cdot\omega$. Let $S$ be its initial block + of order type $\omega^\beta$, and put $\gamma=\sup S$. + + If $\beta=0$, then $S=\{\gamma\}$. The translated truncation has a non-zero + constant coefficient and a gap immediately below zero, so its ordinal value + is $1$. + + If $\beta>0$, then $\omega^\beta$ is an additively principal limit ordinal. + The set $S$ is a final segment of the support below $\gamma$, giving + $v_J(b^{|\gamma})\le\omega^\beta$. Every interval immediately below + $\gamma$ contains a final segment of $S$, still of order type + $\omega^\beta$, giving the reverse inequality. Thus + $v_J(b^{|\gamma})=\omega^\beta$, and the choice of $B$ gives + $\theta<\gamma<0$. + -/)] +theorem exists_ordinalValue_translatedTruncation_eq_wpow_of_ordinalValue_eq_wpow_add_one + (beta : NatOrdinal) (u : Series K) (hu : ordinalValue u = ω^ (beta + 1)) + {θ : ℝ} (hθ : θ < 0) : + ∃ γ : ℝ, θ < γ ∧ γ < 0 ∧ ordinalValue (translatedTruncation (u : K⟦ℝ⟧) γ) = ω^ beta := by + have hone : 1 < ordinalValue u := by + rw [hu, ← NatOrdinal.wpow_zero] + exact NatOrdinal.wpow_lt_wpow.mpr (by simp) + -- A tail `B = supp(u) ∩ (η, 0)` that computes the ordinal value, above `θ`. + obtain ⟨η₀, hη₀, htailType⟩ := + exists_forall_later_negativeSupportTail_orderType_eq_ordinalValue u hone + set η : ℝ := max (η₀ / 2) (θ / 2) with hηdef + have hη₀η : η₀ < η := lt_max_of_lt_left (by linarith) + have hθη : θ < η := lt_max_of_lt_right (by linarith) + have hη : η < 0 := max_lt (by linarith) (by linarith) + set B : Set ℝ := negativeSupportTail u η with hBdef + have hBsupp : B ⊆ (u : K⟦ℝ⟧).support := negativeSupportTail_subset_support u η + have hBpwo : B.IsPWO := (u : K⟦ℝ⟧).isPWO_support.mono hBsupp + set ρ : Ordinal := omega0 ^ beta.val with hρdef + have hρpos : 0 < ρ := opow_pos _ omega0_pos + have hBtype : hBpwo.orderType = ρ * omega0 := by + rw [Set.IsPWO.orderType_proof_irrel hBpwo + ((u : K⟦ℝ⟧).isPWO_support.mono (negativeSupportTail_subset_support u η)), + htailType η hη₀η hη, hu, NatOrdinal.val_wpow, NatOrdinal.val_add_one, hρdef, + ← Order.succ_eq_add_one, opow_succ] + -- The point `y` of index `ρ`; the first block is `S = B ∩ (-∞, y)`. + have hρlt : ρ < hBpwo.orderType := by + rw [hBtype] + calc ρ = ρ * 1 := (mul_one ρ).symm + _ < ρ * omega0 := mul_lt_mul_of_pos_left one_lt_omega0 hρpos + obtain ⟨y, hyB, hyIdx⟩ := hBpwo.exists_orderType_inter_Iio_eq hρlt + set S : Set ℝ := B ∩ Set.Iio y with hSdef + have hSpwo : S.IsPWO := hBpwo.mono Set.inter_subset_left + have hStype : hSpwo.orderType = ρ := hyIdx + have hSne : S.Nonempty := by + rw [Set.nonempty_iff_ne_empty] + intro hempty + have := (hSpwo.orderType_eq_zero).mpr hempty + rw [hStype] at this + exact hρpos.ne' this + have hSbdd : BddAbove S := ⟨y, fun x hx ↦ hx.2.le⟩ + set γ : ℝ := sSup S with hγdef + have hSγ : ∀ x ∈ S, x ≤ γ := fun x hx ↦ le_csSup hSbdd hx + have hγy : γ ≤ y := csSup_le hSne fun x hx ↦ hx.2.le + have hy0 : y < 0 := (mem_negativeSupportTail_iff.mp hyB).2.2 + have hγ0 : γ < 0 := hγy.trans_lt hy0 + have hθγ : θ < γ := by + obtain ⟨s, hs⟩ := hSne + exact (hθη.trans (mem_negativeSupportTail_iff.mp hs.1).2.1).trans_le (hSγ s hs) + -- Every point of `B` below `γ` lies in the first block. + have hbelow : ∀ x ∈ B, x < γ → x ∈ S := by + intro x hxB hxγ + obtain ⟨s, hs, hxs⟩ := exists_lt_of_lt_csSup hSne hxγ + exact ⟨hxB, hxs.trans hs.2⟩ + have hsuppBelow : ∀ x ∈ (u : K⟦ℝ⟧).support, η < x → x < γ → x ∈ S := fun x hx hηx hxγ ↦ + hbelow x (mem_negativeSupportTail_iff.mpr ⟨hx, hηx, hxγ.trans hγ0⟩) hxγ + refine ⟨γ, hθγ, hγ0, ?_⟩ + rcases eq_or_ne beta 0 with rfl | hbeta + · -- `β = 0`: the first block is a single support point `γ`. + have hρone : ρ = 1 := by simp [hρdef] + have hSmin : ∀ x ∈ S, ∀ x' ∈ S, x' ≤ x → x' = x := by + intro x hx x' hx' hle + by_contra hne + have hlt : x' < x := lt_of_le_of_ne hle hne + have hbelow := hSpwo.orderType_inter_Iio_lt hx + rw [hStype, hρone, Order.lt_one_iff, Set.IsPWO.orderType_eq_zero] at hbelow + have : x' ∈ S ∩ Set.Iio x := ⟨hx', hlt⟩ + rw [hbelow] at this + exact this + obtain ⟨m, hm⟩ := hSne + have hSeq : S = {m} := by + ext x + constructor + · intro hx + rcases le_total x m with hxm | hmx + · exact hSmin m hm x hx hxm + · exact (hSmin x hx m hm hmx).symm + · rintro rfl + exact hm + have hγm : γ = m := by rw [hγdef, hSeq, csSup_singleton] + have hγS : γ ∈ S := hγm ▸ hm + have hγsupp : γ ∈ (u : K⟦ℝ⟧).support := hBsupp hγS.1 + have hgap : (u : K⟦ℝ⟧).support ∩ Set.Ioo η γ = ∅ := by + rw [Set.eq_empty_iff_forall_notMem] + rintro x ⟨hx, hηx, hxγ⟩ + have hxS := hsuppBelow x hx hηx hxγ + rw [hSeq] at hxS + exact hxγ.ne (hxS.trans hγm.symm) + have hηγ : η < γ := (mem_negativeSupportTail_iff.mp hγS.1).2.1 + have hle := ordinalValue_translatedTruncation_le_one_of_eq_empty u hηγ hgap + have hne : ordinalValue (translatedTruncation (u : K⟦ℝ⟧) γ) ≠ 0 := by + rw [Ne, ordinalValue_eq_zero_iff] + exact translatedTruncation_not_mem_negativeMonomialIdeal_of_mem_support u hγsupp + rw [NatOrdinal.wpow_zero] + rcases Order.le_one_iff.mp hle with hzero | hone' + · exact absurd hzero hne + · exact hone' + · -- `β ≥ 1`: `ω^β` is an additively indecomposable limit. + have hρprin : IsAdditivelyPrincipal ρ := isAdditivelyPrincipal_omega0_opow _ + have hρone : 1 < ρ := by + have : ω^ (0 : NatOrdinal) < ω^ beta := + NatOrdinal.wpow_lt_wpow.mpr (pos_iff_ne_zero.mpr hbeta) + rw [NatOrdinal.wpow_zero] at this + have hval : (1 : NatOrdinal).val < (ω^ beta).val := this + simpa [hρdef] using hval + have hlimit : Order.IsSuccLimit hSpwo.orderType := by + rw [hStype] + exact hρprin.isSuccLimit_of_one_lt hρone + have hprincipal : IsPrincipal (fun a b : Ordinal ↦ a + b) hSpwo.orderType := by + rw [hStype] + exact (isAdditivelyPrincipal_iff_ne_zero_and_isPrincipal_add.mp hρprin).2 + -- `S` has no largest element, so every point of `S` lies strictly below `γ`. + have hSlt : ∀ x ∈ S, x < γ := by + intro x hx + obtain ⟨x', hx', hxx'⟩ := hSpwo.exists_gt_of_isSuccLimit_orderType hlimit hx + exact hxx'.trans_le (hSγ x' hx') + -- Upper bound: `S` is a nonempty final segment of the support strictly below `γ`. + have hSupper : IsRelUpperSet S (· ∈ (u : K⟦ℝ⟧).support ∩ Set.Iio γ) := by + intro x hx + refine ⟨⟨hBsupp hx.1, hSlt x hx⟩, fun y' hxy' hy' ↦ ?_⟩ + exact hsuppBelow y' hy'.1 ((mem_negativeSupportTail_iff.mp hx.1).2.1.trans_le hxy') hy'.2 + have hupper := ordinalValue_translatedTruncation_le_orderType_of_isRelUpperSet_supportBelow + (u : K⟦ℝ⟧) γ hSupper hSne + rw [Set.IsPWO.orderType_proof_irrel _ hSpwo, hStype] at hupper + -- Lower bound: every window `(θ', γ)` contains a nonempty final segment of `S`. + have hlower : NatOrdinal.of ρ ≤ ordinalValue (translatedTruncation (u : K⟦ℝ⟧) γ) := by + apply le_ordinalValue_translatedTruncation_of_forall_le_orderType + intro θ' hθ'γ + obtain ⟨s, hs, hθ's⟩ := exists_lt_of_lt_csSup hSne hθ'γ + have hfinal := hSpwo.orderType_inter_Ioi_eq_of_isPrincipal hprincipal ⟨s, hs, hθ's⟩ + rw [hStype] at hfinal + rw [← hfinal] + apply Set.IsPWO.orderType_mono + intro x hx + exact ⟨hBsupp hx.1.1, hx.2, hSlt x hx.1⟩ + rw [NatOrdinal.val_eq_iff.mp (le_antisymm hupper (NatOrdinal.of_le_iff.mp hlower)), hρdef, + ← NatOrdinal.val_wpow, NatOrdinal.of_val] + +/-- A nonzero class in `P_α`, for successor `α`, has a representative of ordinal value exactly +`ω^α`. -/ +theorem ordinalValue_eq_wpow_of_principalComponentMk_ne_zero (alpha : NatOrdinal) + (u : Series K) (hu : ordinalValue u < ω^ (alpha + 1)) + (hne : principalComponentMk alpha u hu ≠ 0) : + ordinalValue u = ω^ alpha := by + have hnot : ¬ ordinalValue u < ω^ alpha := fun h ↦ + hne ((principalComponentMk_eq_zero_iff alpha u hu).mpr h) + rcases ordinalValue_eq_zero_or_isAdditivelyPrincipal u with hzero | hprincipal + · exact absurd (hzero ▸ NatOrdinal.wpow_pos alpha) hnot + · have hxi := Ordinal.natOrdinal_of_eq_wpow_log hprincipal + rw [NatOrdinal.of_val] at hxi + rw [hxi] at hu hnot ⊢ + rw [NatOrdinal.wpow_inj] + exact le_antisymm (Order.lt_add_one_iff.mp (NatOrdinal.wpow_lt_wpow.mp hu)) + (not_lt.mp fun h ↦ hnot (NatOrdinal.wpow_lt_wpow.mpr h)) + +/-- If `α` is a successor, translated truncation sends every nonzero class in `P_α` to a nonzero +function at `0⁻`. -/ +theorem principalComponentDerivAt_ne_zero + (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) + {x : PrincipalComponent K alpha} (hx : x ≠ 0) : + principalComponentDerivAt K alpha halpha x ≠ 0 := by + obtain ⟨u, hu, rfl⟩ := exists_principalComponentMk alpha x + have hvalue := ordinalValue_eq_wpow_of_principalComponentMk_ne_zero alpha u hu hx + have halpha' : alpha.removeNat 1 + 1 = alpha := by + simpa using NatOrdinal.removeNat_add_natCast halpha + rw [principalComponentDerivAt_principalComponentMk] + intro hzero + obtain ⟨θ, hθ, hθzero⟩ := (FunAtZeroMinus.coe_eq_zero_iff_exists _).mp hzero + obtain ⟨γ, hθγ, hγ0, hγvalue⟩ := + exists_ordinalValue_translatedTruncation_eq_wpow_of_ordinalValue_eq_wpow_add_one + (alpha.removeNat 1) u + (by rw [hvalue, halpha']) hθ + have hbound : ordinalValue (translatedTruncation (u : K⟦ℝ⟧) γ) < ω^ (alpha.removeNat 1 + 1) := by + rw [hγvalue] + exact NatOrdinal.wpow_lt_wpow.mpr (lt_add_one _) + have hcut := hθzero γ hθγ hγ0 + rw [derivAt_eq alpha u γ hbound, principalComponentMk_eq_zero_iff, hγvalue] at hcut + exact lt_irrefl _ hcut + +variable (K) in +/-- Translated truncation is injective on `P_α` for every successor ordinal `α`. -/ +@[blueprint "prop:successor-principal-rv-injective" + (phase := "Translated truncations") + (title := "Injectivity of the translated-truncation map on $\\mathrm P_\\alpha$") + (statement := /-- + Let $K$ be a field, let $\alpha<\omega_1$ be a successor ordinal, and write + $\alpha=\beta+1$. Put + \[ + \mathrm P_\delta:=J_{\omega^{\delta+1}}/J_{\omega^\delta}. + \] + Let $\operatorname{Fun}_{0^-}(V)$ be the space of $V$-valued functions on + intervals $(\eta,0)$, identified when they agree sufficiently close to $0$. + Then the $K$-linear map + \[ + \partial_\alpha:\mathrm P_\alpha\longrightarrow + \operatorname{Fun}_{0^-}(\mathrm P_\beta),\qquad + \partial_\alpha([b])=[\gamma\mapsto[b^{|\gamma}]], + \] + is injective. The inner class is taken modulo $J_{\omega^\beta}$. + -/) + (proof := /-- + By \ref{lem:truncation-drop}, every series of ordinal value below + $\omega^\alpha$ has translated truncations of ordinal value below $\omega^\beta$ + sufficiently close to $0$. Thus translated truncation induces the displayed map on the + quotient. + + A nonzero class $[b]\in\mathrm P_\alpha$ has a representative with + $v_J(b)=\omega^\alpha$. By + \ref{lem:successor-truncation-value}, every interval $(\theta,0)$ contains + a cutoff $\gamma$ with $v_J(b^{|\gamma})=\omega^\beta$. Hence + $[b^{|\gamma}]\ne0$ in $\mathrm P_\beta$, so + $\partial_\alpha([b])\ne0$. The kernel of the linear map + $\partial_\alpha$ is therefore zero, and the map is injective. + -/)] +theorem principalComponentDerivAt_injective + (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) : + Function.Injective (principalComponentDerivAt K alpha halpha) := by + rw [← LinearMap.ker_eq_bot, LinearMap.ker_eq_bot'] + intro x hx + by_contra hne + exact principalComponentDerivAt_ne_zero alpha halpha hne hx + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivationIdeal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivationIdeal.lean new file mode 100644 index 0000000000..6ba1b57496 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivationIdeal.lean @@ -0,0 +1,256 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LoweringDerivation +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SumAlongCutoffs +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OmegaSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAtInjective + +/-! +# Ideal membership of a class from ideal membership of its derivative + +Let `α` be a successor ordinal and `(q_1, …, q_m) ⊆ P̂` the ideal generated by finitely many +homogeneous elements `q j` of degrees `c j` that are zero or limits (so `∂ q_j = 0`). For +`x ∈ P_α`, if `∂(x)` is the class of a function at `0⁻` with values in `(q_1, …, q_m)`, then +`x ∈ (q_1, …, q_m)`; indeed `x = ∑_j q_j w_j` with `w_j ∈ P_{μ_j + 1}` and `μ_j + c_j = α ⊖ 1`. + +The proof uses that every function at `0⁻` vanishing outside a sequence `γ_k ↑ 0` is a derivative, +and that `∂` is injective on `P_α`. Take a principal representative `p` of `x`; its derivative +`γ ↦ ∂(p)(γ)` vanishes outside a strictly increasing sequence of cutoffs `γ_k` with supremum `0` +(`exists_principal_representative_derivAt`). Decompose the value at `γ_k`, an element of +`(q_1, …, q_m) ∩ P_{α ⊖ 1}`, as `∑_j q_j a_{jk}` with `a_{jk} ∈ P_{μ_j}`, without any coherence in +`k` (`exists_decompose_eq_sum_mul_of_mem_span`). Each `k ↦ a_{jk}` is the derivative of the class +`w_j ∈ P_{μ_j + 1}` of a sum along the cutoffs `γ_k` (`exists_sumAlongCutoffs`). +Since `∂` is a derivation and `∂ q_j = 0`, `∂(∑_j q_j w_j) = ∑_j q_j ∂(w_j) = ∂(x)`, and `∂` is +injective on `P_α`. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries LoweringDerivation DirectSum + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- The class of a series in `P̂`, through an equality of indices. -/ +theorem of_principalComponentMk_congr {β β' : NatOrdinal} (h : β = β') (t : Series K) + (hβ : ordinalValue t < ω^ (β + 1)) (hβ' : ordinalValue t < ω^ (β' + 1)) : + DirectSum.of (PrincipalComponent K) β (principalComponentMk β t hβ) = + DirectSum.of (PrincipalComponent K) β' (principalComponentMk β' t hβ') := by + subst h + rfl + +/-- The class of a function at `0⁻` of a finite sum is the sum of the classes. -/ +theorem funAtZeroMinus_coe_sum {ι : Type w} (s : Finset ι) (g : ι → ℝ → PrincipalSubring K) : + ((fun ξ ↦ ∑ j ∈ s, g j ξ : ℝ → PrincipalSubring K) : FunAtZeroMinus (PrincipalSubring K)) = + ∑ j ∈ s, ((g j : ℝ → PrincipalSubring K) : FunAtZeroMinus (PrincipalSubring K)) := by + have : (fun ξ ↦ ∑ j ∈ s, g j ξ : ℝ → PrincipalSubring K) = ∑ j ∈ s, g j := by + ext ξ + simp [Finset.sum_apply] + rw [this] + exact map_sum (Filter.Germ.coeRingHom _) g s + +/-- `∂` vanishes on homogeneous elements of degree zero or a limit. -/ +theorem principalSubringDerivation_eq_zero_of_constantCoeff_eq_zero {c : NatOrdinal} + (hc : c.constantCoeff = 0) {q : PrincipalSubring K} (hq : q ∈ principalGrading K c) : + principalSubringDerivation K q = 0 := by + obtain ⟨b, rfl⟩ := (DirectSum.mem_rangeLof_iff K _ c q).mp hq + rw [DirectSum.lof_eq_of, principalSubringDerivation_of, + principalComponentDerivation_of_eq_zero hc] + +/-- **A sequence of values at the cutoffs `γ_k` is the derivative of a class.** Given cutoffs +`γ_k ↑ 0` and, for each `k`, an element `u k ∈ P_β` (`β + c = δ`), there is `w ∈ P̂` with +`q * w ∈ P_{δ+1}` for `q ∈ P_c`, whose derivative is the class of a function equal to `u k` at +`γ_k` and to `0` at every other cutoff in `(γ_0, 0)`. When no `β` with `β + c = δ` exists (and +then every `u k = 0`), `w = 0`. -/ +theorem exists_principalSubringDerivation_eq_of_forall {δ c : NatOrdinal} {q : PrincipalSubring K} + (hq : q ∈ principalGrading K c) (γ : ℕ → ℝ) (hγ : StrictMono γ) (hneg : ∀ k, γ k < 0) + (hcof : ∀ η < (0 : ℝ), ∃ k, η < γ k) (u : ℕ → PrincipalSubring K) + (hu : ∀ k, ∀ β, β + c = δ → u k ∈ principalGrading K β) + (hu0 : ∀ k, (¬ ∃ β, β + c = δ) → u k = 0) : + ∃ w : PrincipalSubring K, q * w ∈ principalGrading K (δ + 1) ∧ + ∃ g : ℝ → PrincipalSubring K, principalSubringDerivation K w = (g : FunAtZeroMinus _) ∧ + (∀ k, g (γ k) = u k) ∧ ∀ ξ, γ 0 < ξ → ξ < 0 → (∀ k, ξ ≠ γ k) → g ξ = 0 := by + classical + by_cases h : ∃ β, β + c = δ + · obtain ⟨μ, hμ⟩ := h + -- the values, as elements of the homogeneous component `P_μ` + have ha : ∀ k, ∃ a : PrincipalComponent K μ, + DirectSum.of (PrincipalComponent K) μ a = u k := fun k ↦ by + obtain ⟨a, ha⟩ := (DirectSum.mem_rangeLof_iff K _ μ (u k)).mp (hu k μ hμ) + exact ⟨a, by rw [← DirectSum.lof_eq_of K]; exact ha⟩ + choose a ha using ha + -- the sum (m) along the cutoffs `γ_k` whose derivative takes these values + obtain ⟨s, hs, hsk, hsoff⟩ := exists_sumAlongCutoffs μ γ hγ hneg hcof a + have hidx : (μ + 1).removeNat 1 = μ := by + have h1 : 1 ≤ (μ + 1).constantCoeff := by + have := NatOrdinal.constantCoeff_add_natCast μ 1 + rw [Nat.cast_one] at this + omega + have := NatOrdinal.removeNat_add_natCast (a := μ + 1) (n := 1) h1 + rw [Nat.cast_one] at this + exact add_right_cancel this + have hpos : 0 < (μ + 1).constantCoeff := by + have := NatOrdinal.constantCoeff_add_natCast μ 1 + rw [Nat.cast_one] at this + omega + refine ⟨DirectSum.of (PrincipalComponent K) (μ + 1) (principalComponentMk (μ + 1) s hs), ?_, + fun ξ ↦ DirectSum.of (PrincipalComponent K) ((μ + 1).removeNat 1) (derivAt (μ + 1) s ξ), ?_, + fun k ↦ ?_, fun ξ hξ0 hξ hξk ↦ ?_⟩ + · -- the degree of `q * w` + have hmem := SetLike.mul_mem_graded hq (of_mem_principalGrading (μ + 1) + (principalComponentMk (μ + 1) s hs)) + have heq : c + (μ + 1) = δ + 1 := by rw [← add_assoc, add_comm c μ, hμ] + rwa [heq] at hmem + · rw [principalSubringDerivation_of, principalComponentDerivation_principalComponentMk hpos] + · -- the value at `γ k` + obtain ⟨hk, hak⟩ := hsk k + have hk' : ordinalValue (translatedTruncation (s : K⟦ℝ⟧) (γ k)) < + ω^ ((μ + 1).removeNat 1 + 1) := by rwa [hidx] + beta_reduce + rw [derivAt_eq (μ + 1) s (γ k) hk', of_principalComponentMk_congr hidx _ hk' hk, hak, ha] + · -- the value at a cutoff that is not a `γ k` + have hlt := hsoff ξ hξ0 hξ hξk + have hk' : ordinalValue (translatedTruncation (s : K⟦ℝ⟧) ξ) < + ω^ ((μ + 1).removeNat 1 + 1) := by + rw [hidx] + exact hlt.trans (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one μ)) + beta_reduce + rw [derivAt_eq (μ + 1) s ξ hk', of_principalComponentMk_congr hidx _ hk' (by + exact hlt.trans (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one μ))), + (principalComponentMk_eq_zero_iff μ _ _).mpr hlt, map_zero] + · refine ⟨0, by rw [mul_zero]; exact zero_mem _, fun _ ↦ 0, by rw [map_zero]; rfl, + fun k ↦ (hu0 k h).symm, fun _ _ _ _ ↦ rfl⟩ + +/-- **Ideal membership of a class from ideal membership of its derivative.** Let `α` be a +successor ordinal, let `q j ∈ P_{c j}` be finitely many homogeneous elements of degrees `c j` that +are zero or limits, and let `x ∈ P_α`. If `∂(x)` is the class of a function at `0⁻` with values in +the ideal `(q_1, …, q_m)`, then `x` lies in that ideal. -/ +@[blueprint "prop:ideal-from-derivative" + (phase := "Translated truncations") + (title := "Derivative criterion for homogeneous ideal membership") + (statement := /-- + Let $K$ be a field and let $(q_j)_{j\in I}$ be a finite family in + $\widehat{\mathrm P}$. Suppose that $q_j$ is homogeneous of degree $c_j$ + and that the coefficient of $\omega^0$ in the Cantor normal form of $c_j$ + is zero for every $j$. Let $\alpha$ be an ordinal whose coefficient of + $\omega^0$ is positive, and let $x\in\mathrm P_\alpha$. If + $f\colon\mathbb R\to\widehat{\mathrm P}$ satisfies + \[ + f(\xi)\in(q_j:j\in I)\quad\text{for every }\xi\in\mathbb R + \] + and the lowering derivative $\partial x$ is the class of $f$ at $0^-$, + then + \[ + x\in(q_j:j\in I)\subseteq\widehat{\mathrm P}. + \] + -/) + (proof := /-- + By \ref{lem:successor-principal-rv-countable-support}, choose a principal series + representing $x$ whose derivative is supported on a strictly increasing + sequence of cutoffs cofinal below $0$. At each cutoff, decompose the value of + $f$ separately as a homogeneous linear combination of the $q_j$. For each + $j$, apply \ref{prop:realise-derivative} to the resulting sequence of + coefficients, obtaining a homogeneous element $w_j$ whose derivative has + exactly those values at the chosen cutoffs and vanishes between them. + + The coefficient condition on $c_j$ gives $\partial q_j=0$. Hence + \ref{thm:leibniz-rule-lowering-derivation} shows that + \[ + \partial\!\left(x-\sum_j q_jw_j\right)=0: + \] + at a chosen cutoff this is the selected homogeneous decomposition of + $f(\xi)$, and between the cutoffs both representative functions vanish near + $0$. The expression in parentheses is homogeneous of degree $\alpha$. + The same injectivity of the lowering derivative used in the representative + theorem applies because the coefficient of $\omega^0$ in $\alpha$ is + positive. Therefore $x=\sum_jq_jw_j$ and $x\in(q_j:j\in I)$. + -/)] +theorem mem_span_of_principalSubringDerivation_eq_coe {ι : Type w} [Finite ι] + {q : ι → PrincipalSubring K} {c : ι → NatOrdinal} (hq : ∀ j, q j ∈ principalGrading K (c j)) + (hc : ∀ j, (c j).constantCoeff = 0) {α : NatOrdinal} (hα : 0 < α.constantCoeff) + {x : PrincipalSubring K} (hx : x ∈ principalGrading K α) {f : ℝ → PrincipalSubring K} + (hf : ∀ ξ, f ξ ∈ Ideal.span (Set.range q)) + (hΔ : principalSubringDerivation K x = (f : FunAtZeroMinus (PrincipalSubring K))) : + x ∈ Ideal.span (Set.range q) := by + classical + cases nonempty_fintype ι + set δ := α.removeNat 1 with hδdef + have hδ : δ + 1 = α := by + have := NatOrdinal.removeNat_add_natCast (a := α) (n := 1) hα + rwa [Nat.cast_one] at this + have hinj := (principalSubringDerivation_isLoweringDerivation K).injective hα hx + -- `x` is the class of a principal series `p` + obtain ⟨a, hax⟩ := (DirectSum.mem_rangeLof_iff K _ α x).mp hx + rw [DirectSum.lof_eq_of] at hax + by_cases ha : a = 0 + · rw [← hax, ha, map_zero] + exact Ideal.zero_mem _ + obtain ⟨p, hp, -, -, hpa, γ, hγ, hneg, hcof, hsupp⟩ := + exists_principal_representative_derivAt α hα ha + have hΔx : principalSubringDerivation K x = + ((fun ξ ↦ DirectSum.of (PrincipalComponent K) δ (derivAt α p ξ) : ℝ → PrincipalSubring K) : + FunAtZeroMinus (PrincipalSubring K)) := by + rw [← hax, ← hpa, principalSubringDerivation_of, + principalComponentDerivation_principalComponentMk hα] + -- `f` agrees with `ξ ↦ ∂(p)(ξ)` on `(-ε, 0)` + rw [hΔx] at hΔ + obtain ⟨ε, hε, hfε⟩ := (funAtZeroMinus_coe_eq_iff_exists _ _).mp hΔ + -- decompose the values at the cutoffs along the generators + have hdec := fun k ↦ OrdinalGraded.exists_decompose_eq_sum_mul_of_mem_span + (𝒜 := principalGrading K) hq + (hf (γ k)) δ + choose u hu hu0 hsum using hdec + -- each sequence of coefficients `k ↦ u k j` is the derivative of a class `w j` + have hreal := fun j ↦ exists_principalSubringDerivation_eq_of_forall (hq j) γ hγ hneg hcof + (fun k ↦ u k j) (fun k β hβ ↦ hu k j β hβ) (fun k h ↦ hu0 k j h) + choose w hw g hg hgk hgoff using hreal + -- the difference `x - ∑ q_j w_j` has zero derivative + have hy : x - ∑ j, q j * w j ∈ principalGrading K α := + sub_mem hx (hδ ▸ sum_mem fun j _ ↦ hw j) + have hΔy : principalSubringDerivation K (x - ∑ j, q j * w j) = 0 := by + have hΔw : principalSubringDerivation K (∑ j, q j * w j) = + ((fun ξ ↦ ∑ j, q j * g j ξ : ℝ → PrincipalSubring K) : + FunAtZeroMinus (PrincipalSubring K)) := by + rw [map_sum, funAtZeroMinus_coe_sum] + refine Finset.sum_congr rfl fun j _ ↦ ?_ + rw [principalSubringDerivation_mul, + principalSubringDerivation_eq_zero_of_constantCoeff_eq_zero + (hc j) (hq j), zero_mul, zero_add, hg j, FunAtZeroMinus.const_mul_coe] + rw [map_sub, hΔx, hΔw, ← Filter.Germ.coe_sub, FunAtZeroMinus.coe_eq_zero_iff_exists] + refine ⟨max (-ε) (γ 0), max_lt (by linarith) (hneg 0), fun ξ hξ1 hξ2 ↦ ?_⟩ + rw [max_lt_iff] at hξ1 + simp only [Pi.sub_apply] + by_cases hξk : ∃ k, γ k = ξ + · obtain ⟨k, rfl⟩ := hξk + -- at a cutoff: `f (γ k) ∈ P_δ` equals its decomposition + have hfk : f (γ k) = DirectSum.of (PrincipalComponent K) δ (derivAt α p (γ k)) := + (hfε (γ k) hξ1.1 hξ2).symm + have hfδ : f (γ k) ∈ principalGrading K δ := hfk ▸ of_mem_principalGrading δ _ + rw [← hfk, sub_eq_zero, ← decompose_of_mem_same (principalGrading K) hfδ, hsum k] + exact Finset.sum_congr rfl fun j _ ↦ by rw [hgk j k] + · -- off the cutoffs both sides vanish + push Not at hξk + have h0 : derivAt α p ξ = 0 := by + by_contra hne + obtain ⟨k, hk⟩ := hsupp ξ hξ2 hne + exact hξk k hk + rw [h0, map_zero, Finset.sum_eq_zero fun j _ ↦ by + rw [hgoff j ξ hξ1.2 hξ2 fun k ↦ (hξk k).symm, mul_zero], sub_zero] + have hx' := (principalSubringDerivation_isLoweringDerivation K).injective hα hy hΔy + rw [sub_eq_zero] at hx' + rw [hx'] + exact Ideal.sum_mem _ fun j _ ↦ Ideal.mul_mem_right _ _ (Ideal.subset_span ⟨j, rfl⟩) + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/IdealFromTruncations.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/IdealFromTruncations.lean new file mode 100644 index 0000000000..9459ab19e2 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/IdealFromTruncations.lean @@ -0,0 +1,280 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.InductionOverDegrees +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval + +/-! +# Ideal membership of a class from the condition (p) on its translated truncations + +Let the polynomials `q j ∈ K[X]` be finitely many homogeneous polynomials of non-zero limit +degrees `c j` (the degrees `σ_j` of the generators), let `h = b j ⊕ c j < α` (`h` the degree `μ` +of the series being reduced, `b j` the cofactor degrees `ρ_j`) and assume evaluation injective +below `α`; let the degree `τ` satisfy `τ + 1 < h` and the separation condition (n) for every +`(b j, c j, τ)`: `b j ⊕ θ < τ` for every `θ < c j`. Let `u` be a series with `v_J(u) = ω^h` whose +translated truncations `u^{|γ}` at the cutoffs `γ` of some interval `(η, 0)` satisfy (p) for +`(q_1, …, q_m; τ)`: above the degree `τ`, the polynomial of every such translated truncation lies +in the ideal `(q_1, …, q_m) ⊆ K[X]`. Then the class of `u` in `P_h` lies in the ideal +`(q_1(𝓑), …, q_m(𝓑)) ⊆ P̂`. + +*Proof.* On an interval `(η, 0)` on which `ot(supp u ∩ (γ, 0)) = v_J(u)` for all `γ ∈ [η, 0)` +(Berarducci's remark after [Ber00, Def. 5.2]; +`exists_forall_later_negativeSupportTail_orderType_eq_ordinalValue`), every piece of `u` on +`(γ_k, γ_{k+1}]`, translated to `0`, with `γ_k ↑ 0`, has support of order type below `ω^h` and +translated truncations satisfying (p); the induction over degrees (`InductionOverDegrees.lean`) +yields for each piece cofactors such that every translated truncation of the difference has +ordinal value below `ω^(τ+1)`; the combined cofactors (`CombinedCofactors.lean`) are series `C_j` +of ordinal value below `ω^(b j + 1)` with `u - ∑_j C_j · q_j(b_𝓑)` of translated truncations of +ordinal value below `ω^(τ+1)` at every cutoff in `(η, 0)`, whence +`v_J(u - ∑_j C_j · q_j(b_𝓑)) < ω^(τ+2) ≤ ω^h` +(`ordinalValue_lt_wpow_add_one_of_forall_translatedTruncation_lt`): in `P_h`, the class of `u` is +the sum over `j` of the class of `C_j` in `P_{b j}` times `q_j(𝓑)`. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial DirectSum OrdinalGraded + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +namespace Lifts + +variable (σ : Lifts wt x) (hx : IsMinimalSystem (principalGrading K) wt x) {α : NatOrdinal} + (hinj : ∀ β < α, InjectiveAt K wt x β) (hσ : σ.IsPrincipal) +include hinj hσ + +/-- **Ideal membership from translated truncations.** If the high-degree components of the +polynomial representatives of the translated truncations of `u` lie in the indicated polynomial +ideal sufficiently close to zero, then the degree-`h` class of `u` lies in the evaluated ideal. -/ +@[blueprint "prop:ideal-from-truncations" + (phase := "Limit ordinals in the degree induction") + (title := "Ideal membership from translated truncations") + (statement := /-- + Let $K$ be a field and let $\mathcal B$ be a minimal homogeneous generating + system of $\widehat{\mathrm P}$ with principal representatives $b_B$. + Assume evaluation is injective below $\alpha$. Let $I$ be a finite index + set, and let $Q_j\in K[X_B:B\in\mathcal B]$ be weighted homogeneous of + nonzero degree $\sigma_j$ that is a limit ordinal. Suppose + \[ + \rho_j\oplus\sigma_j=\mu<\alpha,\qquad + \tau+1<\mu,\qquad + \rho_j\oplus\theta<\tau\quad(\theta<\sigma_j) + \] + for every $j$. + + Let $u\in K((\mathbb R^{\le0}))$ have ordinal value + $v_J(u)=\omega^\mu$. Suppose there is $\eta<0$ such that + \[ + \operatorname{pol}_{<\alpha}(u^{|\gamma})_{\ge\tau} + \in (Q_j:j\in I) + \] + for every $\eta<\gamma<0$. Then the degree-$\mu$ class + $u+J_{\omega^\mu}\in\mathrm P_\mu$, embedded in + $\widehat{\mathrm P}$, lies in + \[ + (Q_j(\mathcal B):j\in I)\subseteq\widehat{\mathrm P}. + \] + -/) + (proof := /-- + Choose a negative interval on which every support tail of $u$ has order type + $v_J(u)=\omega^\mu$, and cut that tail along a sequence $\gamma_k\uparrow0$. + Each interval piece has support order strictly below $\omega^\mu$ and + inherits the high-degree ideal condition. For a piece whose support degree is + at most $\tau$, take zero cofactors; otherwise apply + \ref{lem:induction-over-degrees} at that degree. + + Combine the piecewise cofactors into series $C_j$. Their support bounds give + $v_J(C_j)<\omega^{\rho_j+1}$, while every translated truncation sufficiently + close to zero of $u-\sum_jC_jQ_j(b_B)$ has ordinal value below + $\omega^{\tau+1}$. Consequently the residual series has ordinal value below + $\omega^{\tau+2}$. Since $\tau+1<\mu$, one has $\tau+2\le\mu$, and hence + this value is at most $\omega^\mu$. Thus $u$ and + $\sum_jC_jQ_j(b_B)$ define the same degree-$\mu$ class. Multiplicativity of + representatives then places this class in $(Q_j(\mathcal B):j\in I)$. + -/)] +theorem IsPrincipal.of_principalComponentMk_mem_span_of_forall_componentsGE_mem + {ι' : Type*} [Finite ι'] {q : ι' → MvPolynomial ι K} {c : ι' → NatOrdinal} + (hq : ∀ j, IsWeightedHomogeneous wt (q j) (c j)) (hc : ∀ j, (c j).constantCoeff = 0) + (hc0 : ∀ j, c j ≠ 0) {τ h : NatOrdinal} {b : ι' → NatOrdinal} (hb : ∀ j, b j + c j = h) + (hsep : ∀ j, ∀ θ, θ < c j → b j + θ < τ) (hτh : τ + 1 < h) (hhα : h < α) {u : Series K} + (hu : ordinalValue u = ω^ h) (hu' : ordinalValue u < ω^ (h + 1)) {η : ℝ} (hη : η < 0) + (htrunc : ∀ γ : ℝ, η < γ → γ < 0 → + componentsGE wt τ (σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) γ)) ∈ + Ideal.span (Set.range q)) : + DirectSum.of (PrincipalComponent K) h (principalComponentMk h u hu') ∈ + Ideal.span (Set.range fun j ↦ aeval x (q j)) := by + classical + cases nonempty_fintype ι' + have hwt : ∀ i, wt i ≠ 0 := hx.ne_zero + have h0 : 0 < h := lt_of_le_of_lt zero_le hτh + have hτ2 : τ + 1 + 1 ≤ h := Order.add_one_le_of_lt hτh + have hhα' : h ≤ α := hhα.le + have hqcut : ∀ j, ∀ β : ℝ, β < 0 → + ordinalValue (translatedTruncation (aeval σ.lift (q j) : K⟦ℝ⟧) β) < ω^ (c j) := fun j β hβ ↦ + hσ.ordinalValue_translatedTruncation_aeval_lt hwt (hq j) hβ + -- an interval `(η₀, 0)` on which `ot(supp u ∩ (ξ, 0)) = v_J(u) = ω^h` for all `ξ ∈ (η₀, 0)` + have hone : 1 < ordinalValue u := by + rw [hu, ← NatOrdinal.wpow_zero] + exact NatOrdinal.wpow_lt_wpow.mpr h0 + obtain ⟨η₀, hη₀, hstable⟩ := + exists_forall_later_negativeSupportTail_orderType_eq_ordinalValue u hone + set η₁ : ℝ := max η η₀ with hη₁def + have hη₁ : η₁ < 0 := max_lt hη hη₀ + set ε : ℝ := -η₁ / 2 with hεdef + have hε : 0 < ε := by rw [hεdef]; linarith + -- the pieces on `(γ k, γ (k+1)]` + set γ : ℕ → ℝ := fun k ↦ -ε / ((k : ℝ) + 1) with hγdef + have hγ : StrictMono γ := strictMono_neg_div_succ hε + have hneg : ∀ k, γ k < 0 := neg_div_succ_neg hε + have hcof : ∀ η' < (0 : ℝ), ∃ k, η' < γ k := fun η' hη' ↦ exists_lt_neg_div_succ ε hη' + have hγ0 : γ 0 = -ε := by simp [hγdef] + have hγ0gt : η₁ < γ 0 := by rw [hγ0, hεdef]; linarith + have hγle : ∀ k, γ 0 ≤ γ k := fun k ↦ hγ.monotone (Nat.zero_le k) + have hηγ : ∀ k, η < γ k := fun k ↦ (le_max_left η η₀).trans_lt (hγ0gt.trans_le (hγle k)) + have hη₀γ : ∀ k, η₀ < γ k := fun k ↦ (le_max_right η η₀).trans_lt (hγ0gt.trans_le (hγle k)) + -- every piece has support of order type below `ω^h` + have hwinot : ∀ k, ((piece (γ k) (γ (k + 1)) (u : K⟦ℝ⟧) : Series K) : K⟦ℝ⟧).supportOrderType < + (ω^ h).val := by + intro k + -- `T`, the part of `u` on `(γ k, 0)`, has support of order type `ω^h` + set T : K⟦ℝ⟧ := truncGT (γ k) (truncLT 0 (u : K⟦ℝ⟧)) with hTdef + have hTsupp : T.support = negativeSupportTail u (γ k) := by + ext y + rw [hTdef, support_truncGT, support_truncLT, mem_negativeSupportTail_iff] + simp only [Set.mem_setOf_eq] + tauto + have hTot : T.supportOrderType = (ω^ h).val := by + rw [supportOrderType_eq_setOrderType, ← hu] + rw [← hstable (γ k) (hη₀γ k) (hneg k)] + exact Set.IsPWO.orderType_congr _ _ hTsupp + -- split `T` at `γ (k+1)`; the part above is nonempty + have hsplit := supportOrderType_eq_truncLE_add_truncGT (γ (k + 1)) T + have hhigh : (truncGT (γ (k + 1)) T).supportOrderType ≠ 0 := by + rw [supportOrderType_eq_setOrderType, Ne, Set.IsPWO.orderType_eq_zero] + have hne : (negativeSupportTail u (γ (k + 1))).Nonempty := by + rw [Set.nonempty_iff_ne_empty] + intro hemp + have := hstable (γ (k + 1)) (hη₀γ (k + 1)) (hneg (k + 1)) + rw [Set.IsPWO.orderType_congr _ Set.isPWO_empty hemp, + (Set.isPWO_empty (α := ℝ)).orderType_eq_zero.mpr rfl, hu] at this + exact absurd this.symm (ne_of_gt (Ordinal.opow_pos _ Ordinal.omega0_pos)) + obtain ⟨y, hy⟩ := hne + rw [mem_negativeSupportTail_iff] at hy + refine Set.nonempty_iff_ne_empty.mp ⟨y, ?_⟩ + rw [support_truncGT, hTdef, support_truncGT, support_truncLT] + exact ⟨⟨⟨hy.1, hy.2.2⟩, by linarith [hγ (Nat.lt_succ_self k), hy.2.1]⟩, hy.2.1⟩ + have hlow : (truncLE (γ (k + 1)) T).supportOrderType < (ω^ h).val := by + by_contra hge + rw [not_lt] at hge + have : (ω^ h).val < (truncLE (γ (k + 1)) T).supportOrderType + + (truncGT (γ (k + 1)) T).supportOrderType := + lt_of_lt_of_le (lt_add_of_pos_right _ (pos_iff_ne_zero.mpr hhigh)) (add_le_add hge le_rfl) + rw [← hsplit, hTot] at this + exact lt_irrefl _ this + -- the piece is the part of `T` below `γ (k+1)`, translated + have hset : (truncGT (γ k) (truncLE (γ (k + 1)) (u : K⟦ℝ⟧))).support = + (truncLE (γ (k + 1)) T).support := by + ext y + rw [support_truncGT, support_truncLE, support_truncLE, hTdef, support_truncGT, + support_truncLT] + simp only [Set.mem_setOf_eq] + constructor + · rintro ⟨⟨h1, h2⟩, h3⟩ + exact ⟨⟨⟨h1, by linarith [hneg (k + 1)]⟩, h3⟩, h2⟩ + · rintro ⟨⟨⟨h1, -⟩, h3⟩, h2⟩ + exact ⟨⟨h1, h2⟩, h3⟩ + rw [coe_piece, supportOrderType_translate, supportOrderType_eq_setOrderType, + Set.IsPWO.orderType_congr _ (truncLE (γ (k + 1)) T).isPWO_support hset, + ← supportOrderType_eq_setOrderType] + exact hlow + -- the translated truncations of every piece satisfy (p) + have hwinctrl : ∀ k, ∀ θ : ℝ, θ ≤ 0 → + componentsGE wt τ (σ.pol hx α (translatedTruncation + ((piece (γ k) (γ (k + 1)) (u : K⟦ℝ⟧) : Series K) : K⟦ℝ⟧) θ)) ∈ + Ideal.span (Set.range q) := by + intro k θ hθ + rcases le_or_gt θ (γ k - γ (k + 1)) with h | h + · rw [translatedTruncation_eq_zero_of_forall_lt fun y hy ↦ + lt_of_le_of_lt h (lt_of_mem_support_piece hy), σ.pol_zero hx hinj, componentsGE_zero] + exact Ideal.zero_mem _ + · have hmem := translatedTruncation_window_sub_mem (γ k) (γ (k + 1)) (u : K⟦ℝ⟧) h hθ + have hval : ordinalValue (translatedTruncation + ((piece (γ k) (γ (k + 1)) (u : K⟦ℝ⟧) : Series K) : K⟦ℝ⟧) θ) < ω^ α := + (ordinalValue_translatedTruncation_lt_of_supportOrderType_lt (hwinot k) θ).trans_le + (NatOrdinal.wpow_le_wpow.mpr hhα') + rw [σ.pol_congr hx hinj hval (toGerm_eq_toGerm_iff.mpr hmem)] + exact htrunc _ (by linarith [hηγ k]) (by linarith [hneg (k + 1)]) + -- the induction over degrees in every piece + have hwin : ∀ k, ∃ w : ι' → Series K, + (∀ j, ((w j : Series K) : K⟦ℝ⟧).supportOrderType < (ω^ (b j)).val) ∧ + ∀ θ : ℝ, θ ≤ 0 → ordinalValue (translatedTruncation + ((piece (γ k) (γ (k + 1)) (u : K⟦ℝ⟧) - ∑ j, w j * aeval σ.lift (q j) : Series K) : K⟦ℝ⟧) + θ) < ω^ (τ + 1) := by + intro k + obtain ⟨hk, hhk1, hDk⟩ := exists_supportOrderType_lt_wpow_add_one h0.ne' (hwinot k) + have hhkh : hk < h := Order.add_one_le_iff.mp hhk1 + rcases le_or_gt hk τ with hτk | hτk + · refine ⟨fun _ ↦ 0, fun j ↦ ?_, fun θ _ ↦ ?_⟩ + · rw [Subring.coe_zero, supportOrderType_eq_setOrderType] + simp only [HahnSeries.support_zero] + rw [(Set.isPWO_empty.orderType_eq_zero).mpr rfl] + exact Ordinal.opow_pos _ Ordinal.omega0_pos + · simp only [zero_mul, Finset.sum_const_zero, sub_zero] + exact (ordinalValue_translatedTruncation_lt_of_supportOrderType_lt hDk θ).trans_le + (NatOrdinal.wpow_le_wpow.mpr (add_le_add_left hτk 1)) + · have he : ∀ j, ∃ e, e + c j = hk := fun j ↦ by + obtain ⟨b', -, hb'⟩ := NatOrdinal.exists_le_add_eq_of_forall_add_lt (hc0 j) (hsep j) hτk + (hhkh.le.trans_eq (hb j).symm) + exact ⟨b', hb'⟩ + choose e he using he + obtain ⟨w, hw1, hw2⟩ := + IsPrincipal.exists_forall_ordinalValue_translatedTruncation_sub_sum_mul_aeval_lt + σ hx hinj hσ hq hc hc0 hb hsep hhα hk hτk hhkh.le e he _ hDk (hwinctrl k) + refine ⟨w, fun j ↦ (hw1 j).trans_le (NatOrdinal.val.le_iff_le.mpr + (NatOrdinal.wpow_le_wpow.mpr ?_)), hw2⟩ + have : e j < b j := lt_of_add_lt_add_right ((he j).trans_lt (hhkh.trans_eq (hb j).symm)) + exact Order.add_one_le_of_lt this + choose w hw1 hw2 using hwin + -- the combined cofactors + set C : ι' → Series K := fun j ↦ combinedCofactor γ hγ hneg w j with hCdef + have hCot : ∀ j, ((C j : Series K) : K⟦ℝ⟧).supportOrderType ≤ (ω^ (b j)).val := + fun j ↦ supportOrderType_combinedCofactor_le γ hγ hneg w hw1 j + have hCv : ∀ j, ordinalValue (C j) < ω^ (b j + 1) := fun j ↦ + (ordinalValue_le_supportOrderType _).trans_lt (by + rw [← NatOrdinal.of_val (ω^ (b j + 1)), NatOrdinal.of.lt_iff_lt] + exact (hCot j).trans_lt (NatOrdinal.val.lt_iff_lt.mpr + (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one _)))) + have hres : ∀ ζ, γ 0 < ζ → ζ < 0 → ordinalValue (translatedTruncation + ((u - ∑ j, C j * aeval σ.lift (q j) : Series K) : K⟦ℝ⟧) ζ) < ω^ (τ + 1) := + fun ζ h1 h2 ↦ + ordinalValue_translatedTruncation_sub_sum_combinedCofactor_mul_lt u γ hγ hneg hcof w + hw1 hqcut hsep (fun k θ _ h2 ↦ hw2 k θ h2) h1 h2 + have hsmall : ordinalValue (u - ∑ j, C j * aeval σ.lift (q j)) < ω^ h := + (ordinalValue_lt_wpow_add_one_of_forall_translatedTruncation_lt (hneg 0) hres).trans_le + (NatOrdinal.wpow_le_wpow.mpr hτ2) + -- the classes + have hrepS : Represents (∑ j, C j * aeval σ.lift (q j)) h + (∑ j, DirectSum.of (PrincipalComponent K) (b j) (principalComponentMk (b j) (C j) (hCv j)) * + aeval x (q j)) := + represents_sum _ _ _ _ fun j _ ↦ + ((represents_iff.mpr ⟨hCv j, rfl⟩).mul (σ.aeval_represents (hq j))).of_eq (hb j) + have hmk : principalComponentMk h u hu' = + principalComponentMk h (∑ j, C j * aeval σ.lift (q j)) hrepS.ordinalValue_lt := + (principalComponentMk_eq_iff h _ _ hu' hrepS.ordinalValue_lt).mpr hsmall + rw [hmk, hrepS.of_principalComponentMk] + exact Ideal.sum_mem _ fun j _ ↦ Ideal.mul_mem_left _ _ (Ideal.subset_span ⟨j, rfl⟩) + +end Lifts + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/InductionOverDegrees.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/InductionOverDegrees.lean new file mode 100644 index 0000000000..fd55c987d0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/InductionOverDegrees.lean @@ -0,0 +1,228 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SupportLoweringPieces +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Separation + +/-! +# The induction over degrees + +Let the polynomials `q j ∈ K[X]` be homogeneous of nonzero degrees `c j` that are limit ordinals +(the degrees +`σ_j` of the generators), let `h = b j ⊕ c j` (`h` the degree `μ` of the series being reduced, +`b j` the cofactor degrees `ρ_j`), and let the degree `τ` satisfy the separation condition (n) for +every `(b j, c j, τ)`: `b j ⊕ θ < τ` for every `θ < c j`. Let `h < α` and assume evaluation +injective below `α`. For every degree `h'` with `τ < h' ≤ h` — then `h' = e j ⊕ c j` with +`e j ≤ b j` (`Separation.lean`) — and every series `D` whose support has order type below +`ω^(h'+1)` and whose translated truncations satisfy (p) for `(q_1, …, q_m; τ)`, there are +cofactors `u j` with supports of order type below `ω^(e j + 1)` such that every translated +truncation of `D - ∑_j u_j · q_j(b_𝓑)` has ordinal value below `ω^(τ+1)`. + +The proof is a well-founded induction on `h'`: the order type of the support of `D` is lowered +below `ω^{h'}` in one step when `h' = τ + 1` (the successor-degree bound) and by cutting into +pieces when `h' ≥ τ + 2` (`SupportLoweringPieces`, with the induction hypothesis at the degrees +of the pieces); the result has support of order type below `ω^{h'}`, hence below `ω^(h''+1)` for +some `h'' < h'`, and the induction hypothesis at `h''` finishes (or the bound is already below +`ω^(τ+1)`). +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial OrdinalGraded + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- The order type of the support of a nonpositive series, as a natural ordinal below `ω^g`, lies +below `ω^(h''+1)` for some `h''` with `h'' + 1 ≤ g`. -/ +theorem exists_supportOrderType_lt_wpow_add_one {D : Series K} {g : NatOrdinal} (hg : g ≠ 0) + (hD : (D : K⟦ℝ⟧).supportOrderType < (ω^ g).val) : + ∃ h'', h'' + 1 ≤ g ∧ (D : K⟦ℝ⟧).supportOrderType < (ω^ (h'' + 1)).val := by + have h : NatOrdinal.of (D : K⟦ℝ⟧).supportOrderType < ω^ g := by + rw [← NatOrdinal.of_val (ω^ g)] + exact NatOrdinal.of.lt_iff_lt.mpr hD + obtain ⟨h'', h1, h2⟩ := exists_lt_wpow_add_one_of_lt_wpow hg h + refine ⟨h'', h1, ?_⟩ + rw [← NatOrdinal.of_val (ω^ (h'' + 1)), NatOrdinal.of.lt_iff_lt] at h2 + exact h2 + +/-- A series whose support has order type below `ω^(τ+1)` has all translated truncations of value +below `ω^(τ+1)`. -/ +theorem ordinalValue_translatedTruncation_lt_of_supportOrderType_lt' {D : Series K} + {τ : NatOrdinal} (hD : (D : K⟦ℝ⟧).supportOrderType < (ω^ (τ + 1)).val) (ξ : ℝ) : + ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ξ) < ω^ (τ + 1) := + ordinalValue_translatedTruncation_lt_of_supportOrderType_lt hD ξ + +variable {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +namespace Lifts + +variable (σ : Lifts wt x) (hx : IsMinimalSystem (principalGrading K) wt x) {α : NatOrdinal} + (hinj : ∀ β < α, InjectiveAt K wt x β) (hσ : σ.IsPrincipal) +include hinj hσ + +/-- **Cofactor reduction at intermediate degrees.** For every intermediate degree and compatible +cofactor degrees, the stated translated-truncation ideal condition yields cofactors whose +remainder has translated truncations of ordinal value below `ω^(τ+1)`. -/ +@[blueprint "lem:induction-over-degrees" + (phase := "Limit ordinals in the degree induction") + (title := "Translated-truncation approximation at intermediate degrees") + (statement := /-- + Let $K$ be a field and let $\mathcal B$ be a minimal homogeneous generating + system of $\widehat{\mathrm P}$ with principal representatives $b_B$. + Assume evaluation is injective below $\alpha$. Let $I$ be a finite index + set, and let $Q_j\in K[X_B:B\in\mathcal B]$ be weighted homogeneous of + nonzero degree $\sigma_j$ that is a limit ordinal. Let $\mu<\alpha$, and suppose + \[ + \rho_j\oplus\sigma_j=\mu,\qquad + \rho_j\oplus\theta<\tau\quad(\theta<\sigma_j) + \] + for every $j$. + + For every $\mu'$ with $\tau<\mu'\le\mu$, every family $(\rho'_j)_{j\in I}$ + satisfying $\rho'_j\oplus\sigma_j=\mu'$, and every series + $u\in K((\mathbb R^{\le0}))$ such that + \[ + \operatorname{ot}(\operatorname{supp}(u))<\omega^{\mu'+1} + \] + and + \[ + \operatorname{pol}_{<\alpha}(u^{|\xi})_{\ge\tau} + \in (Q_j:j\in I)\quad(\xi\le0), + \] + there are series $u_j$ with + \[ + \operatorname{ot}(\operatorname{supp}(u_j))<\omega^{\rho'_j+1} + \] + and + \[ + v_J\!\left((u-\sum_ju_jQ_j(b_B))^{|\xi}\right) + <\omega^{\tau+1}\quad(\xi\le0). + \] + -/) + (proof := /-- + Use well-founded induction on $\mu'$. By + \ref{lem:intermediate-ordinal-hessenberg-decomposition}, each + $\rho'_j\le\rho_j$, so the separation inequalities remain valid; the same + result supplies cofactor degrees at every smaller degree used below. + + For a series with support order below $\omega^{\mu'}$, choose $\mu''<\mu'$ + such that its support order is below $\omega^{\mu''+1}$. If + $\mu''\le\tau$, zero cofactors suffice. Otherwise apply the induction + hypothesis at $\mu''$. + + If $\mu'=\tau+1$, apply \ref{lem:successor-support-lowering}, then convert + its support bound into the required translated-truncation bound. If + $\tau+1<\mu'$, apply \ref{lem:lower-by-pieces} to obtain first cofactors + whose remainder has support order below $\omega^{\mu'}$ and retains the + high-degree ideal condition. Apply the auxiliary induction hypothesis to + this remainder and add the two cofactor families. The natural-sum support + estimate gives the required bounds. + -/)] +theorem IsPrincipal.exists_forall_ordinalValue_translatedTruncation_sub_sum_mul_aeval_lt + {ι' : Type*} [Fintype ι'] {q : ι' → MvPolynomial ι K} {c : ι' → NatOrdinal} + (hq : ∀ j, IsWeightedHomogeneous wt (q j) (c j)) (hc : ∀ j, (c j).constantCoeff = 0) + (hc0 : ∀ j, c j ≠ 0) {τ h : NatOrdinal} {b : ι' → NatOrdinal} (hb : ∀ j, b j + c j = h) + (hsep : ∀ j, ∀ θ, θ < c j → b j + θ < τ) (hhα : h < α) : + ∀ h' : NatOrdinal, τ < h' → h' ≤ h → ∀ e : ι' → NatOrdinal, (∀ j, e j + c j = h') → + ∀ D : Series K, (D : K⟦ℝ⟧).supportOrderType < (ω^ (h' + 1)).val → + (∀ ξ : ℝ, ξ ≤ 0 → + componentsGE wt τ (σ.pol hx α (translatedTruncation (D : K⟦ℝ⟧) ξ)) ∈ + Ideal.span (Set.range q)) → + ∃ u : ι' → Series K, (∀ j, ((u j : Series K) : K⟦ℝ⟧).supportOrderType < (ω^ (e j + 1)).val) ∧ + ∀ ξ : ℝ, ξ ≤ 0 → ordinalValue (translatedTruncation + ((D - ∑ j, u j * aeval σ.lift (q j) : Series K) : K⟦ℝ⟧) ξ) < ω^ (τ + 1) := by + classical + intro h' + induction h' using WellFoundedLT.induction with + | _ h' ih => + intro hτh' hh'h e he D hD htrunc + have hh'α : h' < α := hh'h.trans_lt hhα + -- the cofactor degrees at `h'` are at most those at `h` + have heb : ∀ j, e j ≤ b j := fun j ↦ by + obtain ⟨b', hb'b, hb'⟩ := NatOrdinal.exists_le_add_eq_of_forall_add_lt (hc0 j) (hsep j) hτh' + (hh'h.trans_eq (hb j).symm) + have : e j = b' := add_right_cancel ((he j).trans hb'.symm) + rw [this] + exact hb'b + have hsep' : ∀ j, ∀ θ, θ < c j → e j + θ < τ := fun j θ hθ ↦ + (add_le_add_left (heb j) θ).trans_lt (hsep j θ hθ) + -- the induction hypothesis, in the form used when cutting into pieces + have hIH : ∀ E : Series K, (E : K⟦ℝ⟧).supportOrderType < (ω^ h').val → + (∀ ξ : ℝ, ξ ≤ 0 → + componentsGE wt τ (σ.pol hx α (translatedTruncation (E : K⟦ℝ⟧) ξ)) ∈ + Ideal.span (Set.range q)) → + ∃ w : ι' → Series K, (∀ j, ((w j : Series K) : K⟦ℝ⟧).supportOrderType < (ω^ (e j)).val) ∧ + ∀ ξ : ℝ, ξ ≤ 0 → ordinalValue (translatedTruncation + ((E - ∑ j, w j * aeval σ.lift (q j) : Series K) : K⟦ℝ⟧) ξ) < ω^ (τ + 1) := by + intro E hE hEctrl + obtain ⟨h'', hh''1, hE''⟩ := exists_supportOrderType_lt_wpow_add_one + (lt_of_le_of_lt zero_le hτh').ne' hE + have hh''h' : h'' < h' := Order.add_one_le_iff.mp hh''1 + rcases le_or_gt h'' τ with hτ'' | hτ'' + · -- the support of `E` is already small + refine ⟨fun _ ↦ 0, fun j ↦ ?_, fun ξ _ ↦ ?_⟩ + · rw [Subring.coe_zero, supportOrderType_eq_setOrderType] + simp only [HahnSeries.support_zero] + rw [(Set.isPWO_empty.orderType_eq_zero).mpr rfl] + exact Ordinal.opow_pos _ Ordinal.omega0_pos + · simp only [zero_mul, Finset.sum_const_zero, sub_zero] + exact (ordinalValue_translatedTruncation_lt_of_supportOrderType_lt hE'' ξ).trans_le + (NatOrdinal.wpow_le_wpow.mpr (add_le_add_left hτ'' 1)) + · -- the induction hypothesis at `h''` + have he'' : ∀ j, ∃ e'', e'' + c j = h'' := fun j ↦ by + obtain ⟨b', -, hb'⟩ := NatOrdinal.exists_le_add_eq_of_forall_add_lt (hc0 j) (hsep j) hτ'' + ((hh''h'.le.trans hh'h).trans_eq (hb j).symm) + exact ⟨b', hb'⟩ + choose e'' he'' using he'' + obtain ⟨w, hw1, hw2⟩ := ih h'' hh''h' hτ'' (hh''h'.le.trans hh'h) e'' he'' E hE'' hEctrl + refine ⟨w, fun j ↦ (hw1 j).trans_le (NatOrdinal.val.le_iff_le.mpr + (NatOrdinal.wpow_le_wpow.mpr ?_)), hw2⟩ + -- `e'' j < e j` since `e'' j ⊕ c j = h'' < h' = e j ⊕ c j` + have : e'' j < e j := by + have := (he'' j).trans_lt (hh''h'.trans_eq (he j).symm) + exact lt_of_add_lt_add_right this + exact Order.add_one_le_of_lt this + -- lower the order type of the support below `ω^{h'}` + rcases eq_or_lt_of_le (Order.add_one_le_of_lt hτh') with hsucc | hlt + · -- `h' = τ + 1`: one step; the result has support of order type below `ω^(τ+1)` + subst hsucc + obtain ⟨u₀, hu₀, hD'⟩ := IsPrincipal.exists_supportOrderType_sub_sum_mul_aeval_lt σ hx hinj + hσ hq hc hh'α he hsep' hD htrunc + exact ⟨u₀, hu₀, fun ξ _ ↦ ordinalValue_translatedTruncation_lt_of_supportOrderType_lt hD' ξ⟩ + · -- `h' ≥ τ + 2`: cutting into pieces, then the induction hypothesis on the result + obtain ⟨u₀, hu₀, hD', hD'ctrl⟩ := + IsPrincipal.exists_supportOrderType_sub_sum_mul_aeval_lt_of_pieces σ hx hinj hσ hq hlt + hh'α he hsep' hD htrunc hIH + obtain ⟨w, hw1, hw2⟩ := hIH _ hD' hD'ctrl + refine ⟨fun j ↦ u₀ j + w j, fun j ↦ ?_, fun ξ hξ ↦ ?_⟩ + · rw [Subring.coe_add] + refine (supportOrderType_add_le_naturalAdd _ _).trans_lt ?_ + have h1 : NatOrdinal.of ((u₀ j : Series K) : K⟦ℝ⟧).supportOrderType < ω^ (e j + 1) := by + rw [← NatOrdinal.of_val (ω^ (e j + 1))] + exact NatOrdinal.of.lt_iff_lt.mpr (hu₀ j) + have h2 : NatOrdinal.of ((w j : Series K) : K⟦ℝ⟧).supportOrderType < ω^ (e j + 1) := by + rw [← NatOrdinal.of_val (ω^ (e j + 1))] + exact NatOrdinal.of.lt_iff_lt.mpr ((hw1 j).trans (NatOrdinal.val.lt_iff_lt.mpr + (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one _)))) + exact NatOrdinal.val.lt_iff_lt.mpr (NatOrdinal.add_lt_wpow h1 h2) + · have heq : (D - ∑ j, (u₀ j + w j) * aeval σ.lift (q j) : Series K) = + (D - ∑ j, u₀ j * aeval σ.lift (q j)) - ∑ j, w j * aeval σ.lift (q j) := by + simp only [add_mul, Finset.sum_add_distrib] + ring + rw [heq] + exact hw2 ξ hξ + +end Lifts + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LeadingCoefficient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LeadingCoefficient.lean new file mode 100644 index 0000000000..1668bb4554 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LeadingCoefficient.lean @@ -0,0 +1,645 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationPolynomial + +/-! +# The coefficient of `X_{B₀}^e` in the polynomial of a translated truncation + +Fix a variable `B₀` of degree `deg B₀ < α` and assume evaluation injective below `α`. A series `u` +with `v_J(u) < ω^{β+1}`, `β < α`, is *free of `X_{B₀}`* (`FreeOfVariable`) if neither `pol(u)` nor +`pol(u^{|γ})`, for all `γ < 0` sufficiently close to `0`, involves `X_{B₀}`. Constants are free of +`X_{B₀}`; so are the lifts `b_B` of the variables `B ≠ B₀` of degree at most `deg B₀`, since a +polynomial of degree below `deg B₀` cannot involve `X_{B₀}`; and sums, scalar multiples, products +and powers of series free of `X_{B₀}` are free of `X_{B₀}` (degrees permitting), by the +convolution formula read in polynomials [Ber00, Lem. 7.5], because in every term each factor is +either free of `X_{B₀}` or untruncated. + +For `u` free of `X_{B₀}` and the lift `b_{B₀}`, the polynomial of `(b_{B₀}^e u)^{|γ}`, expanded in +powers of `X_{B₀}`, has no coefficient above `e`, and its coefficient of `X_{B₀}^e` is +`pol(u^{|γ})`: by induction on `e` through the convolution formula with the factors `b_{B₀}` and +`b_{B₀}^{e-1} u`, the only term reaching `X_{B₀}^e` is the boundary term +`X_{B₀} · pol((b_{B₀}^{e-1} u)^{|γ})`, every translated truncation of `b_{B₀}` at a cutoff `ζ < 0` +being free of `X_{B₀}`. For `u = 1` the coefficient of `X_{B₀}^{e-1}` is `e · pol(b_{B₀}^{|γ})`, by +the same induction. These are the two leading-coefficient identities used in the limit step. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci MvPolynomial OrdinalGraded + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] {ι : Type w} [DecidableEq ι] {wt : ι → NatOrdinal} + {x : ι → PrincipalSubring K} + +namespace Lifts + +variable (σ : Lifts wt x) (hx : IsMinimalSystem (Berarducci.principalGrading K) wt x) + {α : NatOrdinal} (hinj : ∀ β < α, InjectiveAt K wt x β) (B₀ : ι) + +/-! ### Series free of `X_{B₀}` -/ + +variable (α) in +/-- A series `u` with `v_J(u) < ω^{β+1}`, `β < α`, is free of `X_{B₀}` if `pol u` and the +polynomials `pol(u^{|γ})` of its translated truncations, for all `γ < 0` sufficiently close to `0`, +do not involve `X_{B₀}`. -/ +structure FreeOfVariable (u : Series K) (β : NatOrdinal) : Prop where + /-- `u ∈ J_{ω^(β+1)}`. -/ + lt : ordinalValue u < ω^ (β + 1) + /-- `β < α`. -/ + beta_lt : β < α + /-- `pol u` does not involve `X_{B₀}`. -/ + pol_mem : σ.pol hx α u ∈ supported K {B₀}ᶜ + /-- The polynomials of the translated truncations, for all `γ < 0` sufficiently close to `0`, do + not involve `X_{B₀}`. -/ + exists_forall : ∃ ε > 0, ∀ γ : ℝ, -ε < γ → γ < 0 → + σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) γ) ∈ supported K {B₀}ᶜ + +include hinj + +omit [DecidableEq ι] in +/-- Constants are free of `X_{B₀}` (in degree `0`, when `0 < α`). -/ +theorem freeOfVariable_C (hα : 0 < α) (k : K) : + σ.FreeOfVariable hx α B₀ ((HahnSeries.Nonpositive.C : K →+* Series K) k) 0 where + lt := ordinalValue_C_lt_wpow_one k + beta_lt := hα + pol_mem := by + have h1 : (HahnSeries.Nonpositive.C : K →+* Series K) k = + aeval σ.lift (C k : MvPolynomial ι K) := by + rw [aeval_C, HahnSeries.Nonpositive.algebraMap_apply] + have hC : DegreeLT wt (C k : MvPolynomial ι K) α := degreeLT_iff.mpr fun d hd ↦ by + classical + rw [support_C] at hd + split_ifs at hd with hk + · exact absurd hd (Finset.notMem_empty d) + · rw [Finset.mem_singleton] at hd + rw [hd, map_zero] + exact hα + rw [h1, σ.pol_aeval hx hinj hC] + exact Subalgebra.algebraMap_mem _ k + exists_forall := ⟨1, one_pos, fun γ _ hγ ↦ by + rw [σ.pol_translatedTruncation_C hx hinj k hγ] + exact Subalgebra.zero_mem _⟩ + +omit [DecidableEq ι] in +/-- `1` is free of `X_{B₀}`. -/ +theorem freeOfVariable_one (hα : 0 < α) : σ.FreeOfVariable hx α B₀ 1 0 := by + have := σ.freeOfVariable_C hx hinj B₀ hα 1 + rwa [map_one] at this + +omit [DecidableEq ι] in +/-- The lift of a variable `i ≠ B₀` of degree at most `wt B₀ < α` is free of `X_{B₀}`. -/ +theorem freeOfVariable_lift (hg : wt B₀ < α) {i : ι} (hi : i ≠ B₀) (hwt : wt i ≤ wt B₀) : + σ.FreeOfVariable hx α B₀ (σ.lift i) (wt i) where + lt := Berarducci.Represents.ordinalValue_lt (σ.represents i) + beta_lt := hwt.trans_lt hg + pol_mem := by + have h1 : σ.lift i = aeval σ.lift (X i : MvPolynomial ι K) := (aeval_X _ i).symm + have hX : DegreeLT wt (X i : MvPolynomial ι K) α := degreeLT_iff.mpr fun d hd ↦ by + rw [support_X, Finset.mem_singleton] at hd + rw [hd, Finsupp.weight_single, one_smul] + exact hwt.trans_lt hg + rw [h1, σ.pol_aeval hx hinj hX, X_mem_supported] + exact hi + exists_forall := by + obtain ⟨ε, hε, h⟩ := + exists_forall_ordinalValue_translatedTruncation_lt + (Berarducci.Represents.ordinalValue_lt (σ.represents i)) + refine ⟨ε, hε, fun γ hγε hγ0 ↦ ?_⟩ + have hlt := σ.pol_degreeLT_of_lt hx hinj (hwt.trans_lt hg).le (h γ hγε hγ0) + exact mem_supported_of_forall_weight_lt B₀ wt fun d hd ↦ + (degreeLT_iff.mp hlt d hd).trans_le hwt + +omit [DecidableEq ι] in +variable {σ hx B₀} in +/-- The product of two series free of `X_{B₀}` is free of `X_{B₀}`, when the sum of their degrees +stays below `α`. -/ +theorem FreeOfVariable.mul {u u' : Series K} {β β' : NatOrdinal} (hu : σ.FreeOfVariable hx α B₀ u β) + (hu' : σ.FreeOfVariable hx α B₀ u' β') (h : β + β' < α) : + σ.FreeOfVariable hx α B₀ (u * u') (β + β') where + lt := ordinalValue_mul_lt_wpow_add_one hu.lt hu'.lt + beta_lt := h + pol_mem := by + have hβα : β + 1 ≤ α := Order.add_one_le_of_lt hu.beta_lt + have hβ'α : β' + 1 ≤ α := Order.add_one_le_of_lt hu'.beta_lt + have hmul := σ.pol_mul hx hinj (hu.lt.trans_le (NatOrdinal.wpow_le_wpow.mpr hβα)) + (hu'.lt.trans_le (NatOrdinal.wpow_le_wpow.mpr hβ'α)) + (((σ.pol_degreeLE hx hinj hu.beta_lt hu.lt).mul + (σ.pol_degreeLE hx hinj hu'.beta_lt hu'.lt)).degreeLT h) + rw [hmul.2] + exact Subalgebra.mul_mem _ hu.pol_mem hu'.pol_mem + exists_forall := by + obtain ⟨ε₁, hε₁, h₁⟩ := hu.exists_forall + obtain ⟨ε₂, hε₂, h₂⟩ := hu'.exists_forall + obtain ⟨ε₃, hε₃, h₃⟩ := σ.exists_forall_pol_translatedTruncation_mul hx hinj hu.lt hu'.lt + hu.beta_lt hu'.beta_lt h.le + refine ⟨min ε₁ (min ε₂ ε₃), lt_min hε₁ (lt_min hε₂ hε₃), fun γ hγε hγ0 ↦ ?_⟩ + have hγ₁ : -ε₁ < γ := by have := min_le_left ε₁ (min ε₂ ε₃); linarith + have hγ₂ : -ε₂ < γ := by + have := (min_le_right ε₁ (min ε₂ ε₃)).trans (min_le_left ε₂ ε₃); linarith + have hγ₃ : -ε₃ < γ := by + have := (min_le_right ε₁ (min ε₂ ε₃)).trans (min_le_right ε₂ ε₃); linarith + rw [h₃ γ hγ₃ hγ0 _ subset_rfl fun β hβ ↦ mem_Icc_of_mem_convolutionIndex hβ] + refine Subalgebra.sum_mem _ fun β hβ ↦ Subalgebra.mul_mem _ ?_ ?_ + · obtain ⟨hγβ, hβ0⟩ := mem_Icc_of_mem_convolutionIndex hβ + rcases eq_or_lt_of_le hβ0 with rfl | hβneg + · rw [translatedTruncation_zero]; exact hu.pol_mem + · exact h₁ β (by linarith) hβneg + · obtain ⟨hγβ, hβ0⟩ := mem_Icc_of_mem_convolutionIndex hβ + rcases eq_or_lt_of_le (sub_nonpos.mpr hγβ) with h0 | hneg + · rw [h0, translatedTruncation_zero]; exact hu'.pol_mem + · exact h₂ (γ - β) (by linarith) hneg + +omit [DecidableEq ι] in +variable {σ hx B₀} in +/-- Powers of a series free of `X_{B₀}` are free of `X_{B₀}`, degrees permitting. -/ +theorem FreeOfVariable.pow {u : Series K} {β : NatOrdinal} (hu : σ.FreeOfVariable hx α B₀ u β) + (n : ℕ) + (h : n • β < α) : σ.FreeOfVariable hx α B₀ (u ^ n) (n • β) := by + induction n with + | zero => + rw [pow_zero, zero_smul] + exact σ.freeOfVariable_one hx hinj B₀ (zero_smul ℕ β ▸ h) + | succ n ih => + rw [pow_succ, succ_nsmul] + have hn : n • β < α := NatOrdinal.le_add_right.trans_lt (succ_nsmul β n ▸ h) + exact (ih hn).mul hinj hu (succ_nsmul β n ▸ h) + +omit [DecidableEq ι] in +/-- Finite products of series free of `X_{B₀}` are free of `X_{B₀}`, degrees permitting. -/ +theorem freeOfVariable_prod {ι' : Type*} (hα : 0 < α) (s : Finset ι') (f : ι' → Series K) + (g : ι' → NatOrdinal) (h : ∀ i ∈ s, σ.FreeOfVariable hx α B₀ (f i) (g i)) + (hsum : ∑ i ∈ s, g i < α) : + σ.FreeOfVariable hx α B₀ (∏ i ∈ s, f i) (∑ i ∈ s, g i) := by + classical + induction s using Finset.induction_on with + | empty => simpa using σ.freeOfVariable_one hx hinj B₀ hα + | insert a s ha ih => + rw [Finset.sum_insert ha] at hsum + rw [Finset.prod_insert ha, Finset.sum_insert ha] + have hs : ∑ i ∈ s, g i < α := NatOrdinal.le_add_left.trans_lt hsum + exact (h a (Finset.mem_insert_self a s)).mul hinj + (ih (fun i hi ↦ h i (Finset.mem_insert_of_mem hi)) hs) hsum + +omit [DecidableEq ι] in +/-- The evaluation at the lifts of a monomial not involving `X_{B₀}`, in variables of degree at +most `wt B₀`, of degree below `α`, is free of `X_{B₀}`. -/ +theorem freeOfVariable_aeval_monomial (hg : wt B₀ < α) (d : ι →₀ ℕ) (hd : d B₀ = 0) + (hwt : ∀ i ∈ d.support, wt i ≤ wt B₀) (hdegree : Finsupp.weight wt d < α) : + σ.FreeOfVariable hx α B₀ (∏ i ∈ d.support, σ.lift i ^ d i) (Finsupp.weight wt d) := by + have hα : 0 < α := (bot_le : (0 : NatOrdinal) ≤ wt B₀).trans_lt hg + rw [Finsupp.weight_apply, Finsupp.sum] + rw [Finsupp.weight_apply, Finsupp.sum] at hdegree + refine σ.freeOfVariable_prod hx hinj B₀ hα d.support (fun i ↦ σ.lift i ^ d i) + (fun i ↦ d i • wt i) ?_ hdegree + intro i hi + have hi0 : i ≠ B₀ := fun h ↦ (Finsupp.mem_support_iff.mp hi) (h ▸ hd) + have hlt : d i • wt i < α := (Finset.single_le_sum (f := fun i ↦ d i • wt i) + (fun _ _ ↦ bot_le) hi).trans_lt hdegree + exact (σ.freeOfVariable_lift hx hinj B₀ hg hi0 (hwt i hi)).pow hinj (d i) hlt + +omit [DecidableEq ι] in +/-- `0` is free of `X_{B₀}` in every degree below `α`. -/ +theorem freeOfVariable_zero {β : NatOrdinal} (hβ : β < α) : σ.FreeOfVariable hx α B₀ 0 β where + lt := by rw [ordinalValue_zero]; exact NatOrdinal.wpow_pos _ + beta_lt := hβ + pol_mem := by rw [σ.pol_zero hx hinj]; exact Subalgebra.zero_mem _ + exists_forall := ⟨1, one_pos, fun γ _ _ ↦ by + rw [Subring.coe_zero, translatedTruncation_zero_input, σ.pol_zero hx hinj] + exact Subalgebra.zero_mem _⟩ + +omit [DecidableEq ι] in +variable {σ hx B₀} in +/-- The sum of two series free of `X_{B₀}` of the same degree is free of `X_{B₀}`. -/ +theorem FreeOfVariable.add {u u' : Series K} {β : NatOrdinal} (hu : σ.FreeOfVariable hx α B₀ u β) + (hu' : σ.FreeOfVariable hx α B₀ u' β) : σ.FreeOfVariable hx α B₀ (u + u') β where + lt := (ordinalValue_add_le_max u u').trans_lt (max_lt hu.lt hu'.lt) + beta_lt := hu.beta_lt + pol_mem := by + have hβα : β + 1 ≤ α := Order.add_one_le_of_lt hu.beta_lt + rw [σ.pol_add hx hinj (hu.lt.trans_le (NatOrdinal.wpow_le_wpow.mpr hβα)) + (hu'.lt.trans_le (NatOrdinal.wpow_le_wpow.mpr hβα))] + exact Subalgebra.add_mem _ hu.pol_mem hu'.pol_mem + exists_forall := by + obtain ⟨ε₁, hε₁, h₁⟩ := hu.exists_forall + obtain ⟨ε₂, hε₂, h₂⟩ := hu'.exists_forall + obtain ⟨ε₃, hε₃, h₃⟩ := exists_forall_ordinalValue_translatedTruncation_lt hu.lt + obtain ⟨ε₄, hε₄, h₄⟩ := exists_forall_ordinalValue_translatedTruncation_lt hu'.lt + refine ⟨min (min ε₁ ε₂) (min ε₃ ε₄), lt_min (lt_min hε₁ hε₂) (lt_min hε₃ hε₄), + fun γ hγε hγ0 ↦ ?_⟩ + have hγ₁ : -ε₁ < γ := by + have := (min_le_left (min ε₁ ε₂) (min ε₃ ε₄)).trans (min_le_left ε₁ ε₂); linarith + have hγ₂ : -ε₂ < γ := by + have := (min_le_left (min ε₁ ε₂) (min ε₃ ε₄)).trans (min_le_right ε₁ ε₂); linarith + have hγ₃ : -ε₃ < γ := by + have := (min_le_right (min ε₁ ε₂) (min ε₃ ε₄)).trans (min_le_left ε₃ ε₄); linarith + have hγ₄ : -ε₄ < γ := by + have := (min_le_right (min ε₁ ε₂) (min ε₃ ε₄)).trans (min_le_right ε₃ ε₄); linarith + rw [Subring.coe_add, translatedTruncation_add, + σ.pol_add hx hinj ((h₃ γ hγ₃ hγ0).trans_le (NatOrdinal.wpow_le_wpow.mpr hu.beta_lt.le)) + ((h₄ γ hγ₄ hγ0).trans_le (NatOrdinal.wpow_le_wpow.mpr hu.beta_lt.le))] + exact Subalgebra.add_mem _ (h₁ γ hγ₁ hγ0) (h₂ γ hγ₂ hγ0) + +omit [DecidableEq ι] in +variable {σ hx B₀} in +/-- Scalar multiples of a series free of `X_{B₀}` are free of `X_{B₀}`. -/ +theorem FreeOfVariable.C_mul (k : K) {u : Series K} {β : NatOrdinal} + (hu : σ.FreeOfVariable hx α B₀ u β) : + σ.FreeOfVariable hx α B₀ ((HahnSeries.Nonpositive.C : K →+* Series K) k * u) β := by + rcases eq_or_ne k 0 with rfl | hk + · rw [map_zero, zero_mul]; exact σ.freeOfVariable_zero hx hinj B₀ hu.beta_lt + have hβα : β + 1 ≤ α := Order.add_one_le_of_lt hu.beta_lt + refine ⟨by rw [ordinalValue_C_mul hk]; exact hu.lt, hu.beta_lt, ?_, ?_⟩ + · rw [σ.pol_C_mul hx hinj k (hu.lt.trans_le (NatOrdinal.wpow_le_wpow.mpr hβα))] + exact Subalgebra.mul_mem _ (Subalgebra.algebraMap_mem _ k) hu.pol_mem + · obtain ⟨ε₁, hε₁, h₁⟩ := hu.exists_forall + obtain ⟨ε₂, hε₂, h₂⟩ := exists_forall_ordinalValue_translatedTruncation_lt hu.lt + refine ⟨min ε₁ ε₂, lt_min hε₁ hε₂, fun γ hγε hγ0 ↦ ?_⟩ + have hγ₁ : -ε₁ < γ := by have := min_le_left ε₁ ε₂; linarith + have hγ₂ : -ε₂ < γ := by have := min_le_right ε₁ ε₂; linarith + rw [Subring.coe_mul, HahnSeries.Nonpositive.coe_C, translatedTruncation_C_mul, + σ.pol_C_mul hx hinj k ((h₂ γ hγ₂ hγ0).trans_le + (NatOrdinal.wpow_le_wpow.mpr hu.beta_lt.le))] + exact Subalgebra.mul_mem _ (Subalgebra.algebraMap_mem _ k) (h₁ γ hγ₁ hγ0) + +omit [DecidableEq ι] in +/-- Finite sums of series free of `X_{B₀}`, all of one degree, are free of `X_{B₀}`. -/ +theorem freeOfVariable_sum {ι' : Type*} {β : NatOrdinal} (hβ : β < α) (s : Finset ι') + (f : ι' → Series K) (h : ∀ i ∈ s, σ.FreeOfVariable hx α B₀ (f i) β) : + σ.FreeOfVariable hx α B₀ (∑ i ∈ s, f i) β := by + classical + induction s using Finset.induction_on with + | empty => rw [Finset.sum_empty]; exact σ.freeOfVariable_zero hx hinj B₀ hβ + | insert a s ha ih => + rw [Finset.sum_insert ha] + exact (h a (Finset.mem_insert_self a s)).add hinj + (ih fun i hi ↦ h i (Finset.mem_insert_of_mem hi)) + +omit [DecidableEq ι] in +/-- The evaluation at the lifts of a polynomial not involving `X_{B₀}`, homogeneous of degree +`β < α`, in variables of degree at most `wt B₀`, is free of `X_{B₀}`. -/ +theorem freeOfVariable_aeval (hg : wt B₀ < α) {F : MvPolynomial ι K} {β : NatOrdinal} + (hF : IsWeightedHomogeneous wt F β) (hβ : β < α) (hmem : F ∈ supported K {B₀}ᶜ) + (hvars : ∀ i ∈ F.vars, wt i ≤ wt B₀) : σ.FreeOfVariable hx α B₀ (aeval σ.lift F) β := by + classical + conv => rw [F.as_sum] + rw [map_sum] + refine σ.freeOfVariable_sum hx hinj B₀ hβ _ _ fun d hd ↦ ?_ + have hdw : Finsupp.weight wt d = β := hF (mem_support_iff.mp hd) + have hmono : (monomial d (coeff d F) : MvPolynomial ι K) = C (coeff d F) * monomial d 1 := by + rw [C_mul_monomial, mul_one] + rw [hmono, map_mul, aeval_C, HahnSeries.Nonpositive.algebraMap_apply, aeval_monomial, map_one, + one_mul, Finsupp.prod] + refine FreeOfVariable.C_mul hinj _ ?_ + have hd0 : d B₀ = 0 := by + by_contra h0 + have hv : B₀ ∈ F.vars := + (mem_vars_iff_mem_support B₀).mpr ⟨d, hd, Finsupp.mem_support_iff.mpr h0⟩ + exact (mem_supported.mp hmem) hv rfl + have hwt' : ∀ i ∈ d.support, wt i ≤ wt B₀ := fun i hi ↦ + hvars i ((mem_vars_iff_mem_support i).mpr ⟨d, hd, hi⟩) + rw [← hdw] + exact σ.freeOfVariable_aeval_monomial hx hinj B₀ hg d hd0 hwt' (hdw ▸ hβ) + +/-! ### The coefficient of `X_{B₀}^e` -/ + +omit [DecidableEq ι] in +/-- The polynomial of `b_{B₀}^e` is `X_{B₀}^e` when `e • wt B₀ < α`. -/ +theorem pol_lift_pow (e : ℕ) (he : e • wt B₀ < α) : + σ.pol hx α (σ.lift B₀ ^ e) = X B₀ ^ e := by + have h1 : σ.lift B₀ ^ e = aeval σ.lift (X B₀ ^ e : MvPolynomial ι K) := by + rw [map_pow, aeval_X] + have hX : DegreeLT wt (X B₀ ^ e : MvPolynomial ι K) α := degreeLT_iff.mpr fun d hd ↦ by + classical + rw [X_pow_eq_monomial, support_monomial, if_neg one_ne_zero, Finset.mem_singleton] at hd + rw [hd, Finsupp.weight_single] + exact he + rw [h1, σ.pol_aeval hx hinj hX] + +omit [DecidableEq ι] in +/-- The polynomials of the translated truncations `b_{B₀}^{|γ}`, for all `γ < 0` sufficiently close +to `0`, do not involve `X_{B₀}`. -/ +@[blueprint "lem:proper-truncation-omits-variable" + (phase := "Translated truncations") + (title := "Omission of a maximal-weight variable from proper truncation representatives") + (statement := /-- + Let $K$ be a field, let $(x_i)_{i\in I}$ be a minimal homogeneous + generating system of $\widehat{\mathrm P}$ with + $x_i\in\mathrm P_{w_i}$, and choose representatives + $b_i\in K((\mathbb R^{\le0}))$. Fix $\alpha<\omega_1$, and suppose that + evaluation at $(x_i)$ is injective on weighted-homogeneous polynomials of + every degree below $\alpha$. For $v_J(u)<\omega^\alpha$, denote by $P_u$ + the unique polynomial whose monomials have weight below $\alpha$ and for + which $P_u(b_i)\equiv u\pmod J$. + + If $B_0\in I$ and $w_{B_0}<\alpha$, then there is $\varepsilon>0$ such + that + \[ + X_{B_0}\notin\operatorname{vars}(P_{b_{B_0}^{|\gamma}}) + \qquad(-\varepsilon<\gamma<0). + \] + -/) + (proof := /-- + Since $b_{B_0}$ represents $x_{B_0}\in\mathrm P_{w_{B_0}}$, its ordinal + value is below $\omega^{w_{B_0}+1}$. By + \ref{lem:truncation-drop}, for every $\gamma<0$ sufficiently close to $0$, + \[ + v_J(b_{B_0}^{|\gamma})<\omega^{w_{B_0}}. + \] + Apply \ref{prop:polynomial-representative-exists} at $w_{B_0}$. Its + polynomial has every monomial of weight below $w_{B_0}$, and uniqueness from + \ref{prop:polynomial-evaluation-ordinal-value} identifies it with the + representative $P_{b_{B_0}^{|\gamma}}$ chosen below $\alpha$. A monomial + involving $X_{B_0}$ has weight at least $w_{B_0}$, so no such monomial can + occur. + -/)] +theorem exists_forall_pol_translatedTruncation_lift_mem (hg : wt B₀ < α) : + ∃ ε > 0, ∀ γ : ℝ, -ε < γ → γ < 0 → + σ.pol hx α (translatedTruncation (σ.lift B₀ : K⟦ℝ⟧) γ) ∈ supported K {B₀}ᶜ := by + obtain ⟨ε, hε, h⟩ := + exists_forall_ordinalValue_translatedTruncation_lt + (Berarducci.Represents.ordinalValue_lt (σ.represents B₀)) + refine ⟨ε, hε, fun γ hγε hγ0 ↦ ?_⟩ + exact mem_supported_of_forall_weight_lt B₀ wt + (degreeLT_iff.mp (σ.pol_degreeLT_of_lt hx hinj hg.le (h γ hγε hγ0))) + +omit [DecidableEq ι] hinj in +/-- The sum over a finite set containing `0` and `γ ≠ 0`, split at these two points. -/ +theorem sum_eq_add_add_sum_erase {S : Finset ℝ} {γ : ℝ} (h0 : (0 : ℝ) ∈ S) (hγ : γ ∈ S) + (hne : γ ≠ 0) (f : ℝ → MvPolynomial ι K) : + ∑ β ∈ S, f β = f 0 + f γ + ∑ β ∈ (S.erase 0).erase γ, f β := by + rw [add_assoc, Finset.add_sum_erase _ _ (Finset.mem_erase.mpr ⟨hne, hγ⟩), + Finset.add_sum_erase _ _ h0] + +/-- **The coefficient of `X_{B₀}^e`.** For `u` free of `X_{B₀}`, of degree `β` with +`e • wt B₀ ⊕ β ≤ α`, and all `γ < 0` sufficiently close to `0`: the polynomial of +`(b_{B₀}^e · u)^{|γ}` has no coefficient of `X_{B₀}^k` for `k > e`, and its coefficient of +`X_{B₀}^e` is `pol(u^{|γ})`. -/ +@[blueprint "lem:leading-coefficient-of-truncated-product" + (phase := "Translated truncations") + (title := "Leading coefficient after translated truncation") + (statement := /-- + Let $(x_i)_{i\in I}$ be a minimal homogeneous generating system of + $\widehat{\mathrm P}$, with $x_i\in\mathrm P_{w_i}$, and choose series + $b_i$ representing the $x_i$. Assume that evaluation at $(x_i)$ is + injective in every weighted degree below $\alpha<\omega_1$, and write + $P_a$ for the resulting polynomial representative of a series $a$ of + ordinal value below $\omega^\alpha$. + + Fix $B_0\in I$ with $w_{B_0}<\alpha$. Let $\beta<\alpha$ and let + $u\in K((\mathbb R^{\le0}))$ satisfy $v_J(u)<\omega^{\beta+1}$. Suppose + that $P_u$ does not involve $X_{B_0}$ and that the same holds for + $P_{u^{|\gamma}}$ for every $\gamma<0$ sufficiently close to $0$. + + If $(e\odot w_{B_0})\oplus\beta\le\alpha$, then, for every + $\gamma<0$ sufficiently close to $0$, the polynomial + $P_{(b_{B_0}^eu)^{|\gamma}}$ has degree at most $e$ in $X_{B_0}$ and + \[ + [X_{B_0}^e]\,P_{(b_{B_0}^eu)^{|\gamma}}=P_{u^{|\gamma}}. + \] + -/) + (proof := /-- + Induct on $e$. The case $e=0$ is the hypothesis on $u$. For the successor + step, apply \ref{lem:polynomial-convolution-formula} to + $b_{B_0}(b_{B_0}^eu)$. The summand at cutoff $0$ is + $X_{B_0}P_{(b_{B_0}^eu)^{|\gamma}}$, whose coefficients are controlled by + the induction hypothesis. + + In every other summand the first factor is a proper translated truncation + of $b_{B_0}$, so its polynomial omits $X_{B_0}$ by + \ref{lem:proper-truncation-omits-variable}. At cutoff $\gamma$, the second + translated truncation is $b_{B_0}^eu$, whose unique polynomial + representative with monomial weights below $\alpha$ is $P_uX_{B_0}^e$; + at the interior cutoffs the induction hypothesis bounds its + $X_{B_0}$-degree by $e$. Thus only the cutoff-$0$ summand can contribute in + degree $e+1$, and its coefficient there is $P_{u^{|\gamma}}$. + -/)] +theorem exists_forall_xCoeff_pol_translatedTruncation_pow_mul (hg : wt B₀ < α) {u : Series K} + {β : NatOrdinal} (hu : σ.FreeOfVariable hx α B₀ u β) (e : ℕ) (he : e • wt B₀ + β ≤ α) : + ∃ ε > 0, ∀ γ : ℝ, -ε < γ → γ < 0 → + (∀ k, e < k → + xCoeff B₀ k (σ.pol hx α (translatedTruncation ((σ.lift B₀ ^ e * u : Series K) : K⟦ℝ⟧) γ)) + = 0) ∧ + xCoeff B₀ e (σ.pol hx α (translatedTruncation ((σ.lift B₀ ^ e * u : Series K) : K⟦ℝ⟧) γ)) = + σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) γ) := by + have hg0 : wt B₀ ≠ 0 := hx.ne_zero B₀ + induction e with + | zero => + obtain ⟨ε, hε, h⟩ := hu.exists_forall + refine ⟨ε, hε, fun γ hγε hγ0 ↦ ?_⟩ + rw [pow_zero, one_mul] + refine ⟨fun k hk ↦ ?_, ?_⟩ + · rw [xCoeff_of_mem_supported B₀ (h γ hγε hγ0), if_neg (Nat.pos_iff_ne_zero.mp hk)] + · rw [xCoeff_of_mem_supported B₀ (h γ hγε hγ0), if_pos rfl] + | succ e ih => + -- degrees + have hstep : e • wt B₀ + β < (e + 1) • wt B₀ + β := by + rw [succ_nsmul, add_right_comm] + exact lt_add_of_pos_right _ (pos_iff_ne_zero.mpr hg0) + have he' : e • wt B₀ + β < α := hstep.trans_le he + obtain ⟨ε₁, hε₁, h₁⟩ := ih he'.le + -- the factor `b_{B₀}^e · u` + have hw : ordinalValue (σ.lift B₀ ^ e * u) < ω^ (e • wt B₀ + β + 1) := + ordinalValue_mul_lt_wpow_add_one + (Berarducci.Represents.ordinalValue_lt ((σ.represents B₀).pow e)) hu.lt + have hsum : wt B₀ + (e • wt B₀ + β) ≤ α := by + rw [← add_assoc, add_comm (wt B₀), ← succ_nsmul] + exact he + obtain ⟨ε₂, hε₂, h₂⟩ := σ.exists_forall_pol_translatedTruncation_mul hx hinj + (Berarducci.Represents.ordinalValue_lt (σ.represents B₀)) hw hg he' hsum + obtain ⟨ε₃, hε₃, h₃⟩ := σ.exists_forall_pol_translatedTruncation_lift_mem hx hinj B₀ hg + refine ⟨min ε₁ (min ε₂ ε₃), lt_min hε₁ (lt_min hε₂ hε₃), fun γ hγε hγ0 ↦ ?_⟩ + have hγ₁ : -ε₁ < γ := by have := min_le_left ε₁ (min ε₂ ε₃); linarith + have hγ₂ : -ε₂ < γ := by + have := (min_le_right ε₁ (min ε₂ ε₃)).trans (min_le_left ε₂ ε₃); linarith + have hγ₃ : -ε₃ < γ := by + have := (min_le_right ε₁ (min ε₂ ε₃)).trans (min_le_right ε₂ ε₃); linarith + -- the convolution sum over `S = {0, γ} ∪ index` + set S : Finset ℝ := insert 0 (insert γ + (convolutionIndex (σ.lift B₀ : K⟦ℝ⟧) ((σ.lift B₀ ^ e * u : Series K) : K⟦ℝ⟧) γ)) with hS + have hSsub : convolutionIndex (σ.lift B₀ : K⟦ℝ⟧) ((σ.lift B₀ ^ e * u : Series K) : K⟦ℝ⟧) γ ⊆ + S := (Finset.subset_insert _ _).trans (Finset.subset_insert _ _) + have hSIcc : (S : Set ℝ) ⊆ Set.Icc γ 0 := by + intro β hβ + rw [hS, Finset.coe_insert, Finset.coe_insert] at hβ + rcases hβ with rfl | rfl | hβ + · exact ⟨hγ0.le, le_rfl⟩ + · exact ⟨le_rfl, hγ0.le⟩ + · exact mem_Icc_of_mem_convolutionIndex hβ + have h0S : (0 : ℝ) ∈ S := Finset.mem_insert_self _ _ + have hγS : γ ∈ S := Finset.mem_insert_of_mem (Finset.mem_insert_self _ _) + have hexp : σ.lift B₀ ^ (e + 1) * u = σ.lift B₀ * (σ.lift B₀ ^ e * u) := by ring + set f : ℝ → MvPolynomial ι K := fun β ↦ + σ.pol hx α (translatedTruncation (σ.lift B₀ : K⟦ℝ⟧) β) * + σ.pol hx α (translatedTruncation ((σ.lift B₀ ^ e * u : Series K) : K⟦ℝ⟧) (γ - β)) + with hf + have hconv : σ.pol hx α (translatedTruncation ((σ.lift B₀ ^ (e + 1) * u : Series K) : K⟦ℝ⟧) γ) + = f 0 + f γ + ∑ β ∈ (S.erase 0).erase γ, f β := by + rw [hexp, h₂ γ hγ₂ hγ0 S hSsub hSIcc, ← sum_eq_add_add_sum_erase h0S hγS hγ0.ne] + -- the three kinds of terms + have hf0 : f 0 = X B₀ * σ.pol hx α + (translatedTruncation ((σ.lift B₀ ^ e * u : Series K) : K⟦ℝ⟧) γ) := by + rw [hf] + simp only + rw [translatedTruncation_zero, sub_zero] + congr 1 + have := σ.pol_lift_pow hx hinj B₀ 1 (by rw [one_smul]; exact hg) + rwa [pow_one, pow_one] at this + have hfγ : f γ = σ.pol hx α (translatedTruncation (σ.lift B₀ : K⟦ℝ⟧) γ) * + (σ.pol hx α u * X B₀ ^ e) := by + rw [hf] + simp only + rw [sub_self, translatedTruncation_zero] + congr 1 + have hβα : β + 1 ≤ α := Order.add_one_le_of_lt hu.beta_lt + have hmul := σ.pol_mul hx hinj + ((Berarducci.Represents.ordinalValue_lt ((σ.represents B₀).pow e)).trans_le + (NatOrdinal.wpow_le_wpow.mpr + (Order.add_one_le_of_lt (NatOrdinal.le_add_right.trans_lt he')))) + (hu.lt.trans_le (NatOrdinal.wpow_le_wpow.mpr hβα)) + (by + rw [σ.pol_lift_pow hx hinj B₀ e (NatOrdinal.le_add_right.trans_lt he')] + exact (((isWeightedHomogeneous_X K wt B₀).pow e).degreeLE.mul + (σ.pol_degreeLE hx hinj hu.beta_lt hu.lt)).degreeLT he') + rw [hmul.2, σ.pol_lift_pow hx hinj B₀ e (NatOrdinal.le_add_right.trans_lt he'), mul_comm] + have hfβ : ∀ β ∈ (S.erase 0).erase γ, ∀ k, e < k → xCoeff B₀ k (f β) = 0 := by + intro β hβ k hk + have hβne : β ≠ γ := (Finset.mem_erase.mp hβ).1 + have hβ0 : β ≠ 0 := (Finset.mem_erase.mp (Finset.mem_erase.mp hβ).2).1 + obtain ⟨hγβ, hβle⟩ := hSIcc (Finset.mem_erase.mp (Finset.mem_erase.mp hβ).2).2 + have hβneg : β < 0 := lt_of_le_of_ne hβle hβ0 + have hγβneg : γ - β < 0 := by + rcases lt_or_eq_of_le hγβ with h | h + · linarith + · exact absurd h.symm hβne + rw [hf] + simp only + rw [xCoeff_mul_of_mem_supported B₀ (h₃ β (by linarith) hβneg), + (h₁ (γ - β) (by linarith) hγβneg).1 k hk, mul_zero] + refine ⟨fun k hk ↦ ?_, ?_⟩ + · -- no coefficient above `e + 1` + rw [hconv, map_add, map_add, hf0, hfγ, map_sum, + Finset.sum_eq_zero fun β hβ ↦ hfβ β hβ k (by omega)] + obtain ⟨k', rfl⟩ : ∃ k', k = k' + 1 := ⟨k - 1, by omega⟩ + rw [xCoeff_succ_X_mul, (h₁ γ hγ₁ hγ0).1 k' (by omega), ← mul_assoc, + xCoeff_mul_X_pow B₀ (Subalgebra.mul_mem _ (h₃ γ hγ₃ hγ0) hu.pol_mem), if_neg (by omega), + add_zero, add_zero] + · -- the coefficient of `X_{B₀}^(e+1)` + rw [hconv, map_add, map_add, hf0, hfγ, map_sum, + Finset.sum_eq_zero fun β hβ ↦ hfβ β hβ (e + 1) (Nat.lt_succ_self e), + xCoeff_succ_X_mul, (h₁ γ hγ₁ hγ0).2, ← mul_assoc, + xCoeff_mul_X_pow B₀ (Subalgebra.mul_mem _ (h₃ γ hγ₃ hγ0) hu.pol_mem), + if_neg (Nat.succ_ne_self e), add_zero, add_zero] + +/-- **The coefficient of `X_{B₀}^e` for the pure power `b_{B₀}^{e+1}`.** For `(e + 1) • wt B₀ ≤ α` +and all `γ < 0` sufficiently close to `0`, the coefficient of `X_{B₀}^e` in the polynomial of +`(b_{B₀}^{e+1})^{|γ}` is `(e + 1) · pol(b_{B₀}^{|γ})`. -/ +theorem exists_forall_xCoeff_pol_translatedTruncation_pow (hg : wt B₀ < α) (e : ℕ) + (he : (e + 1) • wt B₀ ≤ α) : + ∃ ε > 0, ∀ γ : ℝ, -ε < γ → γ < 0 → + xCoeff B₀ e (σ.pol hx α (translatedTruncation ((σ.lift B₀ ^ (e + 1) : Series K) : K⟦ℝ⟧) γ)) + = (e + 1 : ℕ) • σ.pol hx α (translatedTruncation (σ.lift B₀ : K⟦ℝ⟧) γ) := by + have hg0 : wt B₀ ≠ 0 := hx.ne_zero B₀ + have hα : 0 < α := (bot_le : (0 : NatOrdinal) ≤ wt B₀).trans_lt hg + induction e with + | zero => + obtain ⟨ε, hε, h⟩ := σ.exists_forall_pol_translatedTruncation_lift_mem hx hinj B₀ hg + refine ⟨ε, hε, fun γ hγε hγ0 ↦ ?_⟩ + rw [zero_add, pow_one, xCoeff_of_mem_supported B₀ (h γ hγε hγ0), if_pos rfl, one_smul] + | succ e ih => + have hstep : (e + 1) • wt B₀ < (e + 1 + 1) • wt B₀ := by + rw [succ_nsmul (wt B₀) (e + 1)] + exact lt_add_of_pos_right _ (pos_iff_ne_zero.mpr hg0) + have he' : (e + 1) • wt B₀ < α := hstep.trans_le he + obtain ⟨ε₁, hε₁, h₁⟩ := ih he'.le + -- the coefficient of `X_{B₀}^{e+1}` for `b_{B₀}^{e+1} · 1` + obtain ⟨ε₀, hε₀, h₀⟩ := σ.exists_forall_xCoeff_pol_translatedTruncation_pow_mul hx hinj B₀ hg + (σ.freeOfVariable_one hx hinj B₀ hα) (e + 1) (by rw [add_zero]; exact he'.le) + have hw : ordinalValue (σ.lift B₀ ^ (e + 1)) < ω^ ((e + 1) • wt B₀ + 1) := + (Berarducci.Represents.ordinalValue_lt ((σ.represents B₀).pow (e + 1))) + have hsum : wt B₀ + (e + 1) • wt B₀ ≤ α := by + rw [add_comm, ← succ_nsmul] + exact he + obtain ⟨ε₂, hε₂, h₂⟩ := σ.exists_forall_pol_translatedTruncation_mul hx hinj + (Berarducci.Represents.ordinalValue_lt (σ.represents B₀)) hw hg he' hsum + obtain ⟨ε₃, hε₃, h₃⟩ := σ.exists_forall_pol_translatedTruncation_lift_mem hx hinj B₀ hg + refine ⟨min (min ε₀ ε₁) (min ε₂ ε₃), lt_min (lt_min hε₀ hε₁) (lt_min hε₂ hε₃), + fun γ hγε hγ0 ↦ ?_⟩ + have hγ₀ : -ε₀ < γ := by + have := (min_le_left (min ε₀ ε₁) (min ε₂ ε₃)).trans (min_le_left ε₀ ε₁); linarith + have hγ₁ : -ε₁ < γ := by + have := (min_le_left (min ε₀ ε₁) (min ε₂ ε₃)).trans (min_le_right ε₀ ε₁); linarith + have hγ₂ : -ε₂ < γ := by + have := (min_le_right (min ε₀ ε₁) (min ε₂ ε₃)).trans (min_le_left ε₂ ε₃); linarith + have hγ₃ : -ε₃ < γ := by + have := (min_le_right (min ε₀ ε₁) (min ε₂ ε₃)).trans (min_le_right ε₂ ε₃); linarith + set S : Finset ℝ := insert 0 (insert γ + (convolutionIndex (σ.lift B₀ : K⟦ℝ⟧) ((σ.lift B₀ ^ (e + 1) : Series K) : K⟦ℝ⟧) γ)) with hS + have hSsub : convolutionIndex (σ.lift B₀ : K⟦ℝ⟧) ((σ.lift B₀ ^ (e + 1) : Series K) : K⟦ℝ⟧) γ ⊆ + S := (Finset.subset_insert _ _).trans (Finset.subset_insert _ _) + have hSIcc : (S : Set ℝ) ⊆ Set.Icc γ 0 := by + intro β hβ + rw [hS, Finset.coe_insert, Finset.coe_insert] at hβ + rcases hβ with rfl | rfl | hβ + · exact ⟨hγ0.le, le_rfl⟩ + · exact ⟨le_rfl, hγ0.le⟩ + · exact mem_Icc_of_mem_convolutionIndex hβ + have h0S : (0 : ℝ) ∈ S := Finset.mem_insert_self _ _ + have hγS : γ ∈ S := Finset.mem_insert_of_mem (Finset.mem_insert_self _ _) + have hexp : σ.lift B₀ ^ (e + 1 + 1) = σ.lift B₀ * σ.lift B₀ ^ (e + 1) := by ring + set f : ℝ → MvPolynomial ι K := fun β ↦ + σ.pol hx α (translatedTruncation (σ.lift B₀ : K⟦ℝ⟧) β) * + σ.pol hx α (translatedTruncation ((σ.lift B₀ ^ (e + 1) : Series K) : K⟦ℝ⟧) (γ - β)) + with hf + have hconv : σ.pol hx α (translatedTruncation ((σ.lift B₀ ^ (e + 1 + 1) : Series K) : K⟦ℝ⟧) γ) + = f 0 + f γ + ∑ β ∈ (S.erase 0).erase γ, f β := by + rw [hexp, h₂ γ hγ₂ hγ0 S hSsub hSIcc, ← sum_eq_add_add_sum_erase h0S hγS hγ0.ne] + have hf0 : f 0 = X B₀ * σ.pol hx α + (translatedTruncation ((σ.lift B₀ ^ (e + 1) : Series K) : K⟦ℝ⟧) γ) := by + rw [hf] + simp only + rw [translatedTruncation_zero, sub_zero] + congr 1 + have := σ.pol_lift_pow hx hinj B₀ 1 (by rw [one_smul]; exact hg) + rwa [pow_one, pow_one] at this + have hfγ : f γ = σ.pol hx α (translatedTruncation (σ.lift B₀ : K⟦ℝ⟧) γ) * X B₀ ^ (e + 1) := by + rw [hf] + simp only + rw [sub_self, translatedTruncation_zero, σ.pol_lift_pow hx hinj B₀ (e + 1) he'] + -- the interior terms have no coefficient of `X_{B₀}^(e+1)`: the coefficient of `X_{B₀}^{e+1}` + -- in the polynomial of a translated truncation of the pure power is the polynomial of a + -- translated truncation of `1`, which is `0` + have hfβ : ∀ β ∈ (S.erase 0).erase γ, xCoeff B₀ (e + 1) (f β) = 0 := by + intro β hβ + have hβne : β ≠ γ := (Finset.mem_erase.mp hβ).1 + have hβ0 : β ≠ 0 := (Finset.mem_erase.mp (Finset.mem_erase.mp hβ).2).1 + obtain ⟨hγβ, hβle⟩ := hSIcc (Finset.mem_erase.mp (Finset.mem_erase.mp hβ).2).2 + have hβneg : β < 0 := lt_of_le_of_ne hβle hβ0 + have hγβneg : γ - β < 0 := by + rcases lt_or_eq_of_le hγβ with h | h + · linarith + · exact absurd h.symm hβne + have h0' := (h₀ (γ - β) (by linarith) hγβneg).2 + rw [mul_one] at h0' + have hC := σ.pol_translatedTruncation_C hx hinj (1 : K) hγβneg + rw [map_one] at hC + rw [hf] + simp only + rw [xCoeff_mul_of_mem_supported B₀ (h₃ β (by linarith) hβneg), h0', hC, mul_zero] + rw [hconv, map_add, map_add, hf0, hfγ, map_sum, Finset.sum_eq_zero hfβ, add_zero, + xCoeff_succ_X_mul, h₁ γ hγ₁ hγ0, xCoeff_mul_X_pow B₀ (h₃ γ hγ₃ hγ0), if_pos rfl] + exact (succ_nsmul _ (e + 1)).symm + +end Lifts + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Lifts.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Lifts.lean new file mode 100644 index 0000000000..78d92f5172 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Lifts.lean @@ -0,0 +1,615 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.OrdinalGenerators +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeRepresentatives +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorLeibniz +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAt +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.TruncationIntegerPartPrimal +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal +public import Mathlib.Algebra.MvPolynomial.CommRing + +/-! +# Lifts of a minimal system of homogeneous generators of `P̂` and the polynomial of a series +modulo `J` + +Fix a minimal system of homogeneous generators `𝓑` of `P̂` (Lean `x : ι → P̂`, the generator `x i` +of degree `wt i`; `OrdinalGraded.IsMinimalSystem`) and lifts: series `lift i ∈ J_{ω^(wt i + 1)}` +representing `x i`, i.e. with class `x i` in `P_{wt i}`. Evaluation at the lifts is graded modulo +`J_{ω^β}`: a polynomial `F` homogeneous of degree `β` evaluates to a series `F(b_𝓑) ∈ J_{ω^(β+1)}` +representing `F(𝓑)`. + +Read modulo Berarducci's ideal `J` [Ber00, Def. 5.1], this gives the *polynomial of a series +modulo `J`*. Without any hypothesis, every series of ordinal value below `ω^α` is congruent +modulo `J` to a value `F(b_𝓑)` with every monomial of `F` of degree below `α`, by well-founded +induction on the ordinal value. If moreover evaluation `K[X] → P̂` is injective in every degree +below `α`, the polynomial is unique, and `v_J(F(b_𝓑)) = ω^(deg F)` for `F ≠ 0`. The function +`pol` records the polynomial of a series modulo `J`. +-/ + +universe v w + +open scoped NatOrdinal DirectSum +open Berarducci MvPolynomial OrdinalGraded + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +local notation "ν" => (ordinalValueDegreeValuation K) + +/-! ### Series representing homogeneous elements of `P̂` -/ + +/-- A series representing a homogeneous element of `P̂` in a specified degree. -/ +abbrev Represents (u : Series K) (β : NatOrdinal) (e : PrincipalSubring K) : Prop := + (ν).Represents u β e + +theorem represents_iff {u : Series K} {β : NatOrdinal} {e : PrincipalSubring K} : + Represents u β e ↔ ∃ h : ordinalValue u < ω^ (β + 1), + DirectSum.of (PrincipalComponent K) β (principalComponentMk β u h) = e := by + change (ν).Represents u β e ↔ _ + rw [MaxAddDegree.represents_iff] + constructor + · rintro ⟨hdegree, hclass⟩ + have hvalue : ordinalValue u < ω^ (β + 1) := + (mem_ordinalValueDegreeValuation_filtrationLE_iff u β).mp + ((ν).mem_filtrationLE_iff β u |>.mpr hdegree) + refine ⟨hvalue, ?_⟩ + simpa only [MaxAddDegree.homogeneousMk_apply, principalComponentMk_eq_componentMk] using hclass + · rintro ⟨hvalue, hclass⟩ + have hdegree : ν u ≤ β := + ((ν).mem_filtrationLE_iff β u).mp + ((mem_ordinalValueDegreeValuation_filtrationLE_iff u β).mpr hvalue) + refine ⟨hdegree, ?_⟩ + simpa only [MaxAddDegree.homogeneousMk_apply, principalComponentMk_eq_componentMk] using hclass + +theorem Represents.ordinalValue_lt {u : Series K} {β : NatOrdinal} {e : PrincipalSubring K} + (h : Represents u β e) : ordinalValue u < ω^ (β + 1) := + (ordinalValueDegree_le_coe_iff u β).mp (by + simpa only [ordinalValueDegreeValuation_apply] using h.degree_le) + +theorem Represents.of_principalComponentMk {u : Series K} {β : NatOrdinal} {e : PrincipalSubring K} + (h : Represents u β e) : + DirectSum.of (PrincipalComponent K) β (principalComponentMk β u h.ordinalValue_lt) = e := + (represents_iff.mp h).2 + +theorem represents_zero (β : NatOrdinal) : Represents (0 : Series K) β 0 := + (ν).represents_zero β + +theorem represents_C (k : K) : + Represents ((HahnSeries.Nonpositive.C : K →+* Series K) k) 0 + (algebraMap K (PrincipalSubring K) k) := + represents_iff.mpr ⟨ordinalValue_C_lt_wpow_one k, by + rw [principalSubring_algebraMap_apply, principalComponentScalarHom_apply]⟩ + +theorem represents_one : Represents (1 : Series K) 0 1 := by + have := represents_C (K := K) 1 + rwa [map_one, map_one] at this + +theorem Represents.add {u u' : Series K} {β : NatOrdinal} {e e' : PrincipalSubring K} + (h : Represents u β e) (h' : Represents u' β e') : Represents (u + u') β (e + e') := + MaxAddDegree.Represents.add h h' + +theorem Represents.mul {u u' : Series K} {β β' : NatOrdinal} {e e' : PrincipalSubring K} + (h : Represents u β e) (h' : Represents u' β' e') : + Represents (u * u') (β + β') (e * e') := + MaxAddDegree.Represents.mul rfl h h' + +theorem Represents.pow {u : Series K} {β : NatOrdinal} {e : PrincipalSubring K} + (h : Represents u β e) (n : ℕ) : Represents (u ^ n) (n • β) (e ^ n) := + MaxAddDegree.Represents.pow h n + +theorem represents_prod {ι : Type w} (s : Finset ι) (f : ι → Series K) (g : ι → NatOrdinal) + (e : ι → PrincipalSubring K) (h : ∀ i ∈ s, Represents (f i) (g i) (e i)) : + Represents (∏ i ∈ s, f i) (∑ i ∈ s, g i) (∏ i ∈ s, e i) := + (ν).represents_prod h + +/-- The ordinal value of a series representing a nonzero element of `P̂` in degree `β` is +exactly `ω^β`. -/ +theorem Represents.ordinalValue_eq {u : Series K} {β : NatOrdinal} {e : PrincipalSubring K} + (h : Represents u β e) (he : e ≠ 0) : ordinalValue u = ω^ β := by + apply (ordinalValueDegree_eq_coe_iff u β).mp + simpa only [ordinalValueDegreeValuation_apply] using + MaxAddDegree.Represents.degree_eq h he + +/-- A series representing `0` in degree `β` has ordinal value below `ω^β`. -/ +theorem Represents.ordinalValue_lt_of_eq_zero {u : Series K} {β : NatOrdinal} + (h : Represents u β 0) : ordinalValue u < ω^ β := by + apply (ordinalValueDegree_lt_coe_iff u β).mp + simpa only [ordinalValueDegreeValuation_apply] using + MaxAddDegree.Represents.degree_lt_of_eq_zero h + +/-! ### Lifts of a minimal system of homogeneous generators -/ + +variable {ι : Type w} (wt : ι → NatOrdinal) (x : ι → PrincipalSubring K) + +/-- Representatives of a family of homogeneous elements of `P̂`, in their specified degrees. -/ +abbrev Lifts := MaxAddDegree.LiftFamily (ordinalValueDegreeValuation K) wt x + +variable {wt x} + +/-- Lifts exist for every family of homogeneous elements. -/ +theorem exists_lifts (hmem : ∀ i, x i ∈ Berarducci.principalGrading K (wt i)) : + Nonempty (Lifts wt x) := by + have h : ∀ i, ∃ u : Series K, Represents u (wt i) (x i) := fun i ↦ by + obtain ⟨a, ha⟩ := (DirectSum.mem_rangeLof_iff K _ _ _).mp (hmem i) + obtain ⟨u, hu, rfl⟩ := exists_principalComponentMk (wt i) a + exact ⟨u, represents_iff.mpr ⟨hu, by rw [← ha, DirectSum.lof_eq_of]⟩⟩ + choose u hu using h + exact ⟨⟨u, hu⟩⟩ + +namespace Lifts + +variable (σ : Lifts wt x) + +/-- Evaluation at the lifts is graded: `F(b_𝓑) ∈ J_{ω^(β+1)}` represents `F(𝓑)` in degree `β` for +`F` homogeneous of degree `β`. -/ +@[blueprint "lem:homogeneous-evaluation-represents" + (phase := "Translated truncations") + (title := "Initial form of a weighted-homogeneous evaluation") + (statement := /-- + Let $K$ be a field. For each $i\in I$, let + $x_i\in\mathrm P_{\alpha_i}\subseteq\widehat{\mathrm P}$ and choose + $b_i\in K((\mathbb R^{\le0}))$ representing $x_i$, so that + \[ + v_J(b_i)<\omega^{\alpha_i+1},\qquad + b_i+J_{\omega^{\alpha_i}}=x_i. + \] + If $F\in K[X_i:i\in I]$ is weighted-homogeneous of degree $\beta$ for the + weights $\alpha_i$, then + \[ + v_J(F(b_i))<\omega^{\beta+1},\qquad + F(b_i)+J_{\omega^\beta}=F(x_i)\in\mathrm P_\beta. + \] + -/) + (proof := /-- + Constants represent their images in degree $0$, and representatives are + preserved by addition, multiplication, and powers. Hence every monomial in + $F(b_i)$ represents the corresponding monomial in $F(x_i)$ in its weighted + degree. Since every monomial of $F$ has weighted degree $\beta$, summing gives + the two asserted properties in degree $\beta$. + -/)] +theorem aeval_represents {F : MvPolynomial ι K} {β : NatOrdinal} + (hF : IsWeightedHomogeneous wt F β) : Represents (aeval σ.lift F) β (aeval x F) := + (ν).represents_aeval represents_C σ.represents hF + +/-- `v_J(F(b_𝓑)) < ω^(β+1)` for `F` homogeneous of degree `β`. -/ +theorem ordinalValue_aeval_lt_of_isWeightedHomogeneous {F : MvPolynomial ι K} {β : NatOrdinal} + (hF : IsWeightedHomogeneous wt F β) : ordinalValue (aeval σ.lift F) < ω^ (β + 1) := + (σ.aeval_represents hF).ordinalValue_lt + +/-- `v_J(F(b_𝓑)) = ω^β` for `F` homogeneous of degree `β` with `F(𝓑) ≠ 0`. -/ +theorem ordinalValue_aeval_eq_of_aeval_ne_zero {F : MvPolynomial ι K} {β : NatOrdinal} + (hF : IsWeightedHomogeneous wt F β) (h : aeval x F ≠ 0) : + ordinalValue (aeval σ.lift F) = ω^ β := + (σ.aeval_represents hF).ordinalValue_eq h + +/-- `v_J(F(b_𝓑)) < ω^β` for `F` homogeneous of degree `β` with `F(𝓑) = 0`. -/ +theorem ordinalValue_aeval_lt_of_aeval_eq_zero {F : MvPolynomial ι K} {β : NatOrdinal} + (hF : IsWeightedHomogeneous wt F β) (h : aeval x F = 0) : + ordinalValue (aeval σ.lift F) < ω^ β := + (h ▸ σ.aeval_represents hF).ordinalValue_lt_of_eq_zero + +end Lifts + +/-! ### Polynomials of degree below `α` -/ + +variable (wt) in +/-- Every monomial of `F` has degree below `α`. -/ +def DegreeLT (F : MvPolynomial ι K) (α : NatOrdinal) : Prop := + ∀ d ∈ F.support, Finsupp.weight wt d < α + +theorem degreeLT_iff {F : MvPolynomial ι K} {α : NatOrdinal} : + DegreeLT wt F α ↔ ∀ d ∈ F.support, Finsupp.weight wt d < α := + Iff.rfl + +theorem degreeLT_zero (α : NatOrdinal) : DegreeLT wt (0 : MvPolynomial ι K) α := fun d hd ↦ by + simp at hd + +theorem DegreeLT.add {F G : MvPolynomial ι K} {α : NatOrdinal} (hF : DegreeLT wt F α) + (hG : DegreeLT wt G α) : DegreeLT wt (F + G) α := fun d hd ↦ by + classical + rcases Finset.mem_union.mp (MvPolynomial.support_add hd) with h | h + · exact hF d h + · exact hG d h + +theorem DegreeLT.neg {F : MvPolynomial ι K} {α : NatOrdinal} (hF : DegreeLT wt F α) : + DegreeLT wt (-F) α := fun d hd ↦ hF d (by rwa [MvPolynomial.support_neg] at hd) + +theorem DegreeLT.sub {F G : MvPolynomial ι K} {α : NatOrdinal} (hF : DegreeLT wt F α) + (hG : DegreeLT wt G α) : DegreeLT wt (F - G) α := by + rw [sub_eq_add_neg]; exact hF.add hG.neg + +theorem DegreeLT.mono {F : MvPolynomial ι K} {α α' : NatOrdinal} (hF : DegreeLT wt F α) + (h : α ≤ α') : DegreeLT wt F α' := fun d hd ↦ (hF d hd).trans_le h + +theorem _root_.MvPolynomial.IsWeightedHomogeneous.degreeLT {F : MvPolynomial ι K} + {β α : NatOrdinal} (hF : IsWeightedHomogeneous wt F β) (h : β < α) : DegreeLT wt F α := + fun _ hd ↦ (hF (mem_support_iff.mp hd)).symm ▸ h + +/-- The homogeneous components of `F` of degree at least `α` vanish when `F` has degree below `α`. +-/ +theorem DegreeLT.weightedHomogeneousComponent_eq_zero {F : MvPolynomial ι K} {α β : NatOrdinal} + (hF : DegreeLT wt F α) (h : α ≤ β) : weightedHomogeneousComponent wt β F = 0 := + weightedHomogeneousComponent_eq_zero' β F fun d hd (hw : Finsupp.weight wt d = β) ↦ + (hF d hd).not_ge (hw.symm ▸ h) + +/-- The component of `F` in degree `β` has degree below `α` whenever `F` does. -/ +theorem DegreeLT.weightedHomogeneousComponent {F : MvPolynomial ι K} {α : NatOrdinal} + (hF : DegreeLT wt F α) (β : NatOrdinal) : + DegreeLT wt (weightedHomogeneousComponent wt β F) α := by + classical + intro d hd + rw [mem_support_iff, coeff_weightedHomogeneousComponent] at hd + split_ifs at hd with hw + · exact hF d (mem_support_iff.mpr hd) + · exact absurd rfl hd + +/-- A nonzero polynomial of degree below `α` has total degree below `α`. -/ +theorem DegreeLT.weightedTotalDegree_lt {F : MvPolynomial ι K} {α : NatOrdinal} + (hF : DegreeLT wt F α) (hF0 : F ≠ 0) : weightedTotalDegree wt F < α := by + obtain ⟨d, hd, hsup⟩ := Finset.exists_mem_eq_sup _ (support_nonempty.mpr hF0) + (Finsupp.weight wt) + rw [weightedTotalDegree, hsup] + exact hF d hd + +/-- The top homogeneous component of a nonzero polynomial is nonzero. -/ +theorem weightedHomogeneousComponent_weightedTotalDegree_ne_zero {F : MvPolynomial ι K} + (hF0 : F ≠ 0) : weightedHomogeneousComponent wt (weightedTotalDegree wt F) F ≠ 0 := by + classical + obtain ⟨d, hd, hsup⟩ := Finset.exists_mem_eq_sup _ (support_nonempty.mpr hF0) + (Finsupp.weight wt) + intro h + have := congrArg (coeff d) h + rw [coeff_weightedHomogeneousComponent, if_pos (by rw [weightedTotalDegree, hsup]), + coeff_zero] at this + exact mem_support_iff.mp hd this + +/-- Removing the top homogeneous component leaves a polynomial of degree below the top degree. -/ +theorem degreeLT_sub_weightedHomogeneousComponent_weightedTotalDegree (F : MvPolynomial ι K) : + DegreeLT wt (F - weightedHomogeneousComponent wt (weightedTotalDegree wt F) F) + (weightedTotalDegree wt F) := by + classical + intro d hd + rw [mem_support_iff, coeff_sub, coeff_weightedHomogeneousComponent] at hd + split_ifs at hd with hw + · exact absurd (sub_self _) hd + · exact lt_of_le_of_ne (le_weightedTotalDegree wt (mem_support_iff.mpr fun h ↦ hd + (by rw [h, sub_zero]))) hw + +/-- A polynomial of degree below `α` is the sum of its homogeneous components of degree below `α`, +over the finite set of degrees occurring. -/ +theorem sum_weightedHomogeneousComponent_eq (F : MvPolynomial ι K) : + ∑ β ∈ (weightedHomogeneousComponent_finsupp (w := wt) F).toFinset, + weightedHomogeneousComponent wt β F = F := by + rw [← finsum_eq_sum _ (weightedHomogeneousComponent_finsupp F), sum_weightedHomogeneousComponent] + +/-! ### Ordinal value of a finite sum -/ + +/-- The ordinal value of a finite sum of series of ordinal value below `c > 0` is below `c`. -/ +theorem ordinalValue_sum_lt {ι' : Type*} (s : Finset ι') (f : ι' → Series K) {c : NatOrdinal} + (hc : 0 < c) (h : ∀ i ∈ s, ordinalValue (f i) < c) : ordinalValue (∑ i ∈ s, f i) < c := by + classical + induction s using Finset.induction_on with + | empty => rw [Finset.sum_empty, ordinalValue_zero]; exact hc + | insert a s ha ih => + rw [Finset.sum_insert ha] + exact (ordinalValue_add_le_max _ _).trans_lt (max_lt (h a (Finset.mem_insert_self a s)) + (ih fun i hi ↦ h i (Finset.mem_insert_of_mem hi))) + +/-- The ordinal value of `a + b` is that of `a` when `v_J(b) < v_J(a)`. -/ +theorem ordinalValue_add_eq_of_lt {a b : Series K} (h : ordinalValue b < ordinalValue a) : + ordinalValue (a + b) = ordinalValue a := by + refine le_antisymm ((ordinalValue_add_le_max a b).trans (max_le le_rfl h.le)) ?_ + have h1 : a = a + b + -b := by abel + calc ordinalValue a = ordinalValue (a + b + -b) := by rw [← h1] + _ ≤ max (ordinalValue (a + b)) (ordinalValue (-b)) := ordinalValue_add_le_max _ _ + _ ≤ ordinalValue (a + b) := by + rw [ordinalValue_neg] + refine max_le le_rfl ?_ + by_contra hlt + rw [not_le] at hlt + have h2 : ordinalValue (a + b) ≤ max (ordinalValue a) (ordinalValue b) := + ordinalValue_add_le_max a b + rw [max_eq_left h.le] at h2 + have h3 : ordinalValue a ≤ max (ordinalValue (a + b)) (ordinalValue b) := by + calc ordinalValue a = ordinalValue (a + b + -b) := by rw [← h1] + _ ≤ max (ordinalValue (a + b)) (ordinalValue (-b)) := ordinalValue_add_le_max _ _ + _ = _ := by rw [ordinalValue_neg] + rw [max_eq_right hlt.le] at h3 + exact h.not_ge h3 + +namespace Lifts + +variable (σ : Lifts wt x) + +/-- `v_J(F(b_𝓑)) < ω^α` when every monomial of `F` has degree below `α`. -/ +theorem ordinalValue_aeval_lt_of_degreeLT {F : MvPolynomial ι K} {α : NatOrdinal} + (hF : DegreeLT wt F α) : ordinalValue (aeval σ.lift F) < ω^ α := + (ordinalValueDegree_lt_coe_iff _ _).mp (by + simpa only [ordinalValueDegreeValuation_apply] using + (ν).degree_aeval_lt_of_forall_weight_lt represents_C σ.represents hF) + +/-! ### Every series of ordinal value below `ω^α` is congruent modulo `J` to a value `F(b_𝓑)` -/ + +variable (hx : IsMinimalSystem (Berarducci.principalGrading K) wt x) +include hx + +/-- Every series of ordinal value below `ω^α` is congruent modulo `J` to a value `F(b_𝓑)` with +every monomial of `F` of degree below `α`. -/ +@[blueprint "prop:polynomial-representative-exists" + (phase := "Translated truncations") + (title := "Existence of polynomial representatives modulo $J$") + (statement := /-- + Let $K$ be a field, let $(x_i)_{i\in I}$ be a minimal homogeneous + generating system of + $\widehat{\mathrm P}=\bigoplus_{\beta<\omega_1}\mathrm P_\beta$, with + $x_i\in\mathrm P_{w_i}$, and choose representatives $b_i$ satisfying + \[ + v_J(b_i)<\omega^{w_i+1},\qquad + b_i+J_{\omega^{w_i}}=x_i. + \] + If $\alpha<\omega_1$ and + $u\in K((\mathbb R^{\le0}))$ satisfies $v_J(u)<\omega^\alpha$, then there + is a polynomial $F\in K[X_i:i\in I]$ such that every monomial of $F$ has + weighted degree less than $\alpha$ and + \[ + u\equiv F(b_i)\pmod J. + \] + -/) + (proof := /-- + Use well-founded induction on $v_J(u)$. The case $u\in J$ is represented by + $0$. Otherwise $v_J(u)=\omega^\beta$ for some $\beta<\alpha$. Since the + chosen $b_i$ are available by + \ref{fact:principal-series-representatives}, and since the $x_i$ generate + $\widehat{\mathrm P}$, \ref{lem:generate} gives a weighted-homogeneous polynomial $F_0$ of + degree $\beta$ whose value $F_0(x_i)$ is the class of $u$ in $\mathrm P_\beta$. + By \ref{lem:homogeneous-evaluation-represents}, $F_0(b_i)$ represents the + same class, so + \[ + v_J\bigl(u-F_0(b_i)\bigr) + intro u huo hu + rcases ordinalValue_eq_zero_or_isAdditivelyPrincipal u with h0 | hprin + · -- `u ∈ J` + refine ⟨0, degreeLT_zero α, ?_⟩ + rw [map_zero, map_zero, eq_comm, toGerm_apply, Ideal.Quotient.eq_zero_iff_mem] + exact ordinalValue_eq_zero_iff.mp h0 + · obtain ⟨γ, hγ⟩ := Ordinal.isAdditivelyPrincipal_iff.mp hprin + set β : NatOrdinal := NatOrdinal.of γ with hβdef + have hval : ordinalValue u = ω^ β := by + rw [hβdef, NatOrdinal.wpow_def, NatOrdinal.val_of, ← hγ, NatOrdinal.of_val] + have hβα : β < α := by rwa [hval, NatOrdinal.wpow_lt_wpow] at hu + have hu1 : ordinalValue u < ω^ (β + 1) := by + rw [hval, NatOrdinal.wpow_lt_wpow]; exact Order.lt_add_one_iff.mpr le_rfl + -- the class of `u` in `P_β` is the evaluation of a homogeneous polynomial + obtain ⟨G, hG, hGu⟩ := hx.exists_aeval_eq + (Berarducci.principalGrading_gradeZeroScalars K) β + (DirectSum.of (PrincipalComponent K) β (principalComponentMk β u hu1)) + (Berarducci.of_mem_principalGrading β _) + have hrep := σ.aeval_represents hG + rw [hGu] at hrep + obtain ⟨hGlt, hGmk⟩ := represents_iff.mp hrep + have hmk : principalComponentMk β (aeval σ.lift G) hGlt = principalComponentMk β u hu1 := + DirectSum.of_injective β hGmk + rw [principalComponentMk_eq_iff] at hmk + -- the difference `u - G(b_𝓑)` has smaller ordinal value + have hrem : ordinalValue (u - aeval σ.lift G) < o := by + rw [← huo, hval] + have := hmk + rwa [← ordinalValue_neg, neg_sub] at this + obtain ⟨F', hF', hF'u⟩ := ih _ hrem (u - aeval σ.lift G) rfl + (hrem.trans (huo ▸ hu)) + refine ⟨G + F', (hG.degreeLT hβα).add hF', ?_⟩ + rw [map_add, map_add, hF'u, map_sub, add_sub_cancel] + +end Lifts + +/-! ### Uniqueness of the polynomial when evaluation is injective below `α` -/ + +namespace Lifts + +variable (σ : Lifts wt x) + +/-- When evaluation is injective in degree `β`, `v_J(F(b_𝓑)) = ω^β` for every nonzero `F` +homogeneous of degree `β`. -/ +theorem ordinalValue_aeval_eq_of_injectiveAt {β : NatOrdinal} (hβ : InjectiveAt K wt x β) + {F : MvPolynomial ι K} (hF : IsWeightedHomogeneous wt F β) (hF0 : F ≠ 0) : + ordinalValue (aeval σ.lift F) = ω^ β := + σ.ordinalValue_aeval_eq_of_aeval_ne_zero hF fun h ↦ hF0 ((injectiveAt_iff β).mp hβ F hF h) + +/-- When evaluation is injective in the top degree of `F ≠ 0`, `v_J(F(b_𝓑)) = ω^(deg F)`. -/ +@[blueprint "prop:polynomial-evaluation-ordinal-value" + (phase := "Translated truncations") + (title := "Ordinal value of a polynomial evaluation") + (statement := /-- + Let $K$ be a field. For each $i\in I$, let + $x_i\in\mathrm P_{w_i}\subseteq\widehat{\mathrm P}$ and choose a + representative $b_i\in K((\mathbb R^{\le0}))$. Let + $F\in K[X_i:i\in I]$ be nonzero, and let $\deg_w(F)$ be the largest weighted + degree of a monomial of $F$. If evaluation at $(x_i)$ is injective on the + weighted-homogeneous polynomials of degree $\deg_w(F)$, then + \[ + v_J(F(b_i))=\omega^{\deg_w(F)}. + \] + -/) + (proof := /-- + Let $F_d$ be the weighted-homogeneous component of $F$ of top degree + $d=\deg_w(F)$. It is nonzero, and injectivity in degree $d$ gives + $F_d(x_i)\ne0$. By \ref{lem:homogeneous-evaluation-represents}, + $F_d(b_i)$ represents this nonzero class in $\mathrm P_d$, so + $v_J(F_d(b_i))=\omega^d$. Every monomial of $F-F_d$ has weighted degree less + than $d$, whence $v_J((F-F_d)(b_i))<\omega^d$. Since + $F(b_i)=F_d(b_i)+(F-F_d)(b_i)$, the strict inequality and the ultrametric + property give $v_J(F(b_i))=\omega^d$. + -/)] +theorem ordinalValue_aeval_eq_wpow_weightedTotalDegree {F : MvPolynomial ι K} + (hβ : InjectiveAt K wt x (weightedTotalDegree wt F)) (hF0 : F ≠ 0) : + ordinalValue (aeval σ.lift F) = ω^ (weightedTotalDegree wt F) := by + set β := weightedTotalDegree wt F + set T := weightedHomogeneousComponent wt β F + have hT : ordinalValue (aeval σ.lift T) = ω^ β := + σ.ordinalValue_aeval_eq_of_injectiveAt hβ + (weightedHomogeneousComponent_isWeightedHomogeneous (w := wt) (n := β) (φ := F)) + (weightedHomogeneousComponent_weightedTotalDegree_ne_zero hF0) + have hR : ordinalValue (aeval σ.lift (F - T)) < ω^ β := + σ.ordinalValue_aeval_lt_of_degreeLT + (degreeLT_sub_weightedHomogeneousComponent_weightedTotalDegree F) + have hsplit : aeval σ.lift F = aeval σ.lift T + aeval σ.lift (F - T) := by + rw [← map_add, add_sub_cancel] + rw [hsplit, ordinalValue_add_eq_of_lt (hT ▸ hR), hT] + +/-- When evaluation is injective in every degree below `α`, a polynomial of degree below `α` +whose value at the lifts lies in `J` is zero. -/ +theorem eq_zero_of_degreeLT_of_toGerm_aeval_eq_zero {α : NatOrdinal} + (hinj : ∀ β < α, InjectiveAt K wt x β) {F : MvPolynomial ι K} (hF : DegreeLT wt F α) + (h : toGerm (aeval σ.lift F) = 0) : F = 0 := by + by_contra hF0 + have hval := σ.ordinalValue_aeval_eq_wpow_weightedTotalDegree + (hinj _ (hF.weightedTotalDegree_lt hF0)) hF0 + rw [toGerm_apply, Ideal.Quotient.eq_zero_iff_mem, ← ordinalValue_eq_zero_iff, hval] at h + exact NatOrdinal.wpow_ne_zero _ h + +/-- Uniqueness of the polynomial: two polynomials of degree below `α` whose values at the lifts +are congruent modulo `J` agree, when evaluation is injective in every degree below `α`. -/ +theorem eq_of_degreeLT_of_toGerm_aeval_eq {α : NatOrdinal} (hinj : ∀ β < α, InjectiveAt K wt x β) + {F G : MvPolynomial ι K} (hF : DegreeLT wt F α) (hG : DegreeLT wt G α) + (h : toGerm (aeval σ.lift F) = toGerm (aeval σ.lift G)) : F = G := by + rw [← sub_eq_zero] + exact σ.eq_zero_of_degreeLT_of_toGerm_aeval_eq_zero hinj (hF.sub hG) + (by rw [map_sub, map_sub, h, sub_self]) + +end Lifts + +/-! ### The polynomial of a series modulo `J` -/ + +namespace Lifts + +variable (σ : Lifts wt x) (hx : IsMinimalSystem (Berarducci.principalGrading K) wt x) + +/-- The polynomial `pol(u)` of a series `u` of ordinal value below `ω^α` modulo `J`: a polynomial +`F` with every monomial of degree below `α` and `F(b_𝓑) ≡ u (mod J)`, chosen by +`exists_degreeLT_toGerm_aeval_eq`; `0` when `v_J(u) ≥ ω^α`. -/ +def pol (α : NatOrdinal) (u : Series K) : MvPolynomial ι K := by + classical + exact if hu : ordinalValue u < ω^ α then + Classical.choose (σ.exists_degreeLT_toGerm_aeval_eq hx α u hu) else 0 + +theorem pol_degreeLT (α : NatOrdinal) (u : Series K) : DegreeLT wt (σ.pol hx α u) α := by + classical + unfold pol + split_ifs with hu + · exact (Classical.choose_spec (σ.exists_degreeLT_toGerm_aeval_eq hx α u hu)).1 + · exact degreeLT_zero α + +theorem toGerm_aeval_pol {α : NatOrdinal} {u : Series K} (hu : ordinalValue u < ω^ α) : + toGerm (aeval σ.lift (σ.pol hx α u)) = toGerm u := by + classical + unfold pol + rw [dif_pos hu] + exact (Classical.choose_spec (σ.exists_degreeLT_toGerm_aeval_eq hx α u hu)).2 + +/-- When evaluation is injective below `α`, the polynomial of `u` modulo `J` is the unique +polynomial of degree below `α` whose value at the lifts is congruent to `u` modulo `J`. -/ +theorem pol_eq_of_toGerm_aeval_eq {α : NatOrdinal} (hinj : ∀ β < α, InjectiveAt K wt x β) + {u : Series K} (hu : ordinalValue u < ω^ α) {F : MvPolynomial ι K} (hF : DegreeLT wt F α) + (h : toGerm (aeval σ.lift F) = toGerm u) : σ.pol hx α u = F := + σ.eq_of_degreeLT_of_toGerm_aeval_eq hinj (σ.pol_degreeLT hx α u) hF + (by rw [σ.toGerm_aeval_pol hx hu, h]) + +/-- The polynomial of a value `F(b_𝓑)`, `F` of degree below `α`, is `F`. -/ +theorem pol_aeval {α : NatOrdinal} (hinj : ∀ β < α, InjectiveAt K wt x β) + {F : MvPolynomial ι K} (hF : DegreeLT wt F α) : + σ.pol hx α (aeval σ.lift F) = F := + σ.pol_eq_of_toGerm_aeval_eq hx hinj (σ.ordinalValue_aeval_lt_of_degreeLT hF) hF rfl + +/-- `pol` is additive. -/ +theorem pol_add {α : NatOrdinal} (hinj : ∀ β < α, InjectiveAt K wt x β) {u u' : Series K} + (hu : ordinalValue u < ω^ α) (hu' : ordinalValue u' < ω^ α) : + σ.pol hx α (u + u') = σ.pol hx α u + σ.pol hx α u' := + σ.pol_eq_of_toGerm_aeval_eq hx hinj + ((ordinalValue_add_le_max u u').trans_lt (max_lt hu hu')) + ((σ.pol_degreeLT hx α u).add (σ.pol_degreeLT hx α u')) + (by rw [map_add, map_add, σ.toGerm_aeval_pol hx hu, σ.toGerm_aeval_pol hx hu', map_add]) + +/-- The polynomial of a series in `J` is zero. -/ +theorem pol_eq_zero_of_mem {α : NatOrdinal} (hinj : ∀ β < α, InjectiveAt K wt x β) + {u : Series K} (hu : u ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K) : + σ.pol hx α u = 0 := + σ.pol_eq_of_toGerm_aeval_eq hx hinj + (by rw [ordinalValue_eq_zero_iff.mpr hu]; exact NatOrdinal.wpow_pos α) (degreeLT_zero α) + (by rw [map_zero, map_zero, toGerm_apply, eq_comm, Ideal.Quotient.eq_zero_iff_mem]; exact hu) + +/-- `v_J(u) = ω^(deg pol(u))` for `u ∉ J` of ordinal value below `ω^α`, when evaluation is +injective below `α`. -/ +@[blueprint "prop:ordinal-value-of-polynomial-representative" + (phase := "Translated truncations") + (title := "Ordinal value of a polynomial representative") + (statement := /-- + Let $K$ be a field, let $(x_i)_{i\in I}$ be a minimal homogeneous + generating system of $\widehat{\mathrm P}$ with + $x_i\in\mathrm P_{w_i}$, and choose representatives $b_i$. Fix + $\alpha<\omega_1$ and assume that evaluation at $(x_i)$ is injective on + weighted-homogeneous polynomials of every degree less than $\alpha$. + + For $u\in K((\mathbb R^{\le0}))$ with $v_J(u)<\omega^\alpha$, let $P_u$ be + the unique polynomial whose monomials have weight less than $\alpha$ and + which satisfies $P_u(b_i)\equiv u\pmod J$. If $u\notin J$, then + \[ + v_J(u)=\omega^{\deg_w(P_u)}, + \] + where $\deg_w(P_u)$ is the largest weighted degree of a monomial of $P_u$. + -/) + (proof := /-- + Existence and congruence of $P_u$ come from + \ref{prop:polynomial-representative-exists}. The polynomial is nonzero, + since otherwise its congruence would put $u$ in $J$. Its largest weighted + degree is less than $\alpha$, so the injectivity hypothesis applies there. + By \ref{prop:polynomial-evaluation-ordinal-value}, + \[ + v_J(P_u(b_i))=\omega^{\deg_w(P_u)}. + \] + Congruence modulo $J$ preserves every nonzero ordinal value, giving the + asserted equality for $u$. + -/)] +theorem ordinalValue_eq_wpow_weightedTotalDegree_pol {α : NatOrdinal} + (hinj : ∀ β < α, InjectiveAt K wt x β) {u : Series K} (hu : ordinalValue u < ω^ α) + (hu0 : u ∉ HahnSeries.Nonpositive.negativeMonomialIdeal K) : + ordinalValue u = ω^ (weightedTotalDegree wt (σ.pol hx α u)) := by + have hp0 : σ.pol hx α u ≠ 0 := by + intro h + have := σ.toGerm_aeval_pol hx hu + rw [h, map_zero, map_zero, toGerm_apply, eq_comm, Ideal.Quotient.eq_zero_iff_mem] at this + exact hu0 this + rw [← ordinalValue_eq_of_sub_mem_negativeMonomialIdeal + (toGerm_eq_toGerm_iff.mp (σ.toGerm_aeval_pol hx hu))] + exact σ.ordinalValue_aeval_eq_wpow_weightedTotalDegree + (hinj _ ((σ.pol_degreeLT hx α u).weightedTotalDegree_lt hp0)) hp0 + +end Lifts + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean new file mode 100644 index 0000000000..ad825d2a46 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean @@ -0,0 +1,386 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LinearMaximal +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.LimitOrdinalContradiction +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AlgebraicOrder + +/-! +# Relations of limit-ordinal degree split at a Cantor cutoff + +Let `α` be a limit ordinal, assume evaluation is injective below `α`, and let `F ≠ 0` be +homogeneous of degree `α` with `F(𝓑) = 0`. Let `B₀` be a variable of `F` of maximal degree +`δ := deg B₀`, +`D` the degree of `F` in `X_{B₀}`, `H_D` the coefficient of `X_{B₀}^D` in `F`, homogeneous of +degree `α ⊖ (δ ⊙ D)`, and `ω^β` the last term of the Cantor normal form of `deg H_D`. +The leading-coefficient argument excludes a constant `H_D` and excludes the situation in which +every term of `δ` is at least `ω^β`. Thus `δ` has a term below `ω^β`. Write every degree as +`λ = λ_{≥β} ⊕ λ_{<β}`, its parts at or above and below `β`; for a variable `B` of `F` the +part `(deg B)_{<β}` is `S.degLT B`; `α_{≥β}`, `α_{<β}` are `S.αGE`, `S.αLT`. The bound on +remainder of the Leibniz rule (`RemainderBound`) and the ordinal values of the translated +truncations of `F(b_𝓑)` provide `λ₀ < α_{<β}` such that every term of the expansion of a +monomial of `F` by the convolution formula with at least two truncated factors has degree below +`α' := α_{≥β} ⊕ λ₀`, together with `α₁ ≤ α'` and `ε₁ > 0` such that +`v_J(F(b_𝓑)^{|γ}) < ω^{α₁}` for all `γ ∈ (-ε₁, 0)`. + +`LimitOrdinalRelationAtCutoff` bundles this relation, cutoff, and the required bounds. +`LimitOrdinalRelationAtCutoff.HasCanonicalBounds` records the canonical choice obtained from the +last term of `deg H_D`. The first consequences are: `β ≠ 0`; every `(deg B)_{<β}` is a limit +ordinal or `0`; +`D = 1`; `(deg B₀)_{<β} = α_{<β}`; `H := ∂F/∂X_{B₀}` is nonzero and homogeneous of degree +`α ⊖ δ`; every variable of `H` has zero part below `β`; in every monomial of `F` the parts +below `β` add up to `α_{<β}`; and two factors with nonzero parts below `β` obey `pair_bound`. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial OrdinalGraded + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] {ι : Type w} {wt : ι → NatOrdinal} +variable {x : ι → PrincipalSubring K} + +namespace Lifts + +variable (σ : Lifts wt x) {α : NatOrdinal} + +/-- A homogeneous relation whose degree is a limit ordinal, a maximal variable, a Cantor cutoff, +and uniform bounds for translated truncations and the Leibniz remainder. -/ +structure LimitOrdinalRelationAtCutoff (α : NatOrdinal) where + /-- The relation. -/ + F : MvPolynomial ι K + hom : IsWeightedHomogeneous wt F α + eval_zero : aeval x F = 0 + ne_zero : F ≠ 0 + vars_lt : ∀ i ∈ F.vars, wt i < α + vars_limit : ∀ i ∈ F.vars, (wt i).constantCoeff = 0 + /-- A variable of maximal degree. -/ + B₀ : ι + mem : B₀ ∈ F.vars + max : ∀ i ∈ F.vars, wt i ≤ wt B₀ + /-- A cutoff exponent `β` such that every term of `deg H_D` is at least `ω^β`. -/ + β : NatOrdinal + /-- The degree `α ⊖ (δ ⊙ D)` of `H_D`, the coefficient of `X_{B₀}^D` in `F`. -/ + degHD : NatOrdinal + hdegHD : degHD + degreeOf B₀ F • wt B₀ = α + degHD_terms : ∀ t ∈ degHD.val.additivePrincipalTerms, (ω^ β).val ≤ t + degHD_ne_zero : degHD ≠ 0 + /-- The degree `δ = deg B₀` has a term below `ω^β`. -/ + term_lt : NatOrdinal.leastTerm (wt B₀) < ω^ β + /-- The bound `λ₀`: the terms of the remainder of the Leibniz rule have degree below + `α_{≥β} ⊕ λ₀`, and the translated truncations of `F(b_𝓑)` have ordinal value below + `ω^{α₁}` with `α₁ ≤ α_{≥β} ⊕ λ₀`. -/ + lam₀ : NatOrdinal + lam₀_lt : lam₀ < NatOrdinal.partLT β α + α₁ : NatOrdinal + α₁_le : α₁ ≤ NatOrdinal.partGE β α + lam₀ + α₁_le_α : α₁ ≤ α + ε₁ : ℝ + ε₁_pos : 0 < ε₁ + truncation_lt : ∀ γ : ℝ, -ε₁ < γ → γ < 0 → + ordinalValue (translatedTruncation ((aeval σ.lift F : Series K) : K⟦ℝ⟧) γ) < ω^ α₁ + remainder_lt : ∀ d ∈ F.support, ∀ (k : ℕ) (ρ : NatOrdinal), 2 ≤ k → + TermDegree wt d k ρ → ρ < NatOrdinal.partGE β α + lam₀ + +namespace LimitOrdinalRelationAtCutoff + +variable {σ} (S : σ.LimitOrdinalRelationAtCutoff α) + +/-- The part `α_{≥β}` of `α` at or above `β`. -/ +def αGE : NatOrdinal := NatOrdinal.partGE S.β α + +/-- The part `α_{<β}` of `α` below `β`. -/ +def αLT : NatOrdinal := NatOrdinal.partLT S.β α + +/-- The part `(deg B)_{<β}` of the degree of a variable `B` below `β`. -/ +def degLT (i : ι) : NatOrdinal := NatOrdinal.partLT S.β (wt i) + +/-- `H := ∂F/∂X_{B₀}`, the partial derivative of `F` at its variable of maximal degree. -/ +def H : MvPolynomial ι K := pderiv S.B₀ S.F + +/-- The part of `deg B` below `β` is zero. -/ +def LowDegreePartEqZero (i : ι) : Prop := S.degLT i = 0 + +/-- The part of `deg B` below `β` equals the part of `α` below `β`. -/ +def LowDegreePartEq (i : ι) : Prop := S.degLT i = S.αLT + +/-- The part of `deg B` below `β` precedes `λ₀` in the algebraic order. -/ +def LowDegreePartAlgebraicLE (i : ι) : Prop := NatOrdinal.AlgebraicLE (S.degLT i) S.lam₀ + +theorem αGE_def : S.αGE = NatOrdinal.partGE S.β α := (rfl) +theorem αLT_def : S.αLT = NatOrdinal.partLT S.β α := (rfl) +theorem degLT_def (i : ι) : S.degLT i = NatOrdinal.partLT S.β (wt i) := (rfl) +theorem H_def : S.H = pderiv S.B₀ S.F := (rfl) +theorem lowDegreePartEqZero_iff (i : ι) : S.LowDegreePartEqZero i ↔ S.degLT i = 0 := (Iff.rfl) +theorem lowDegreePartEq_iff (i : ι) : S.LowDegreePartEq i ↔ S.degLT i = S.αLT := (Iff.rfl) +theorem lowDegreePartAlgebraicLE_iff (i : ι) : + S.LowDegreePartAlgebraicLE i ↔ NatOrdinal.AlgebraicLE (S.degLT i) S.lam₀ := (Iff.rfl) + +/-- The canonical cutoff and bounds obtained from the last term of `deg H_D` and the truncation +and remainder estimates. -/ +structure HasCanonicalBounds : Prop where + /-- The degree `α` is nonzero. -/ + α_ne_zero : α ≠ 0 + /-- The degree `α` is a limit ordinal. -/ + α_constantCoeff : α.constantCoeff = 0 + /-- The last-term exponent `β` is nonzero. -/ + β_ne_zero : S.β ≠ 0 + /-- `ω^β` is the last term of the Cantor normal form of `deg H_D`. -/ + leastTerm_degHD : NatOrdinal.leastTerm S.degHD = ω^ S.β + /-- The translated-truncation exponent satisfies `α₁ < α`. -/ + α₁_lt : S.α₁ < α + /-- A remainder bound `λ` and the resulting definition of `λ₀`. -/ + lambda_choice : ∃ lam : NatOrdinal, + lam < S.αLT ∧ + (∀ d ∈ S.F.support, ∀ (k : ℕ) (ρ : NatOrdinal), 2 ≤ k → TermDegree wt d k ρ → + NatOrdinal.partGE S.β ρ = S.αGE → NatOrdinal.partLT S.β ρ ≤ lam) ∧ + S.lam₀ = Max.max (lam + 1) + (if NatOrdinal.partGE S.β S.α₁ = S.αGE then NatOrdinal.partLT S.β S.α₁ else 0) + +theorem αGE_add_αLT : S.αGE + S.αLT = α := NatOrdinal.partGE_add_partLT _ _ + +theorem partGE_add_degLT (i : ι) : NatOrdinal.partGE S.β (wt i) + S.degLT i = wt i := + NatOrdinal.partGE_add_partLT _ _ + +theorem degLT_lt_wpow (i : ι) : S.degLT i < ω^ S.β := NatOrdinal.partLT_lt _ _ + +theorem αLT_lt_wpow : S.αLT < ω^ S.β := NatOrdinal.partLT_lt _ _ + +theorem lam₀_lt_wpow : S.lam₀ < ω^ S.β := S.lam₀_lt.trans S.αLT_lt_wpow + +theorem partGE_αGE_add_lam₀ : + NatOrdinal.partGE S.β (NatOrdinal.partGE S.β α + S.lam₀) = + NatOrdinal.partGE S.β α := by + rw [NatOrdinal.partGE_add, NatOrdinal.partGE_partGE, + NatOrdinal.partGE_eq_zero_of_lt S.lam₀_lt_wpow, add_zero] + +theorem partLT_αGE_add_lam₀ : + NatOrdinal.partLT S.β (NatOrdinal.partGE S.β α + S.lam₀) = S.lam₀ := by + have := NatOrdinal.partGE_add_partLT S.β (NatOrdinal.partGE S.β α + S.lam₀) + rw [S.partGE_αGE_add_lam₀] at this + exact add_left_cancel this + +theorem partLT_degHD : NatOrdinal.partLT S.β S.degHD = 0 := + NatOrdinal.partLT_eq_zero_of_forall_le S.degHD_terms + +theorem αLT_eq_nsmul_degLT : S.αLT = degreeOf S.B₀ S.F • S.degLT S.B₀ := by + have h : NatOrdinal.partLT S.β α = + NatOrdinal.partLT S.β (S.degHD + degreeOf S.B₀ S.F • wt S.B₀) := + congrArg _ S.hdegHD.symm + rw [αLT, h, NatOrdinal.partLT_add, S.partLT_degHD, zero_add, NatOrdinal.partLT_nsmul] + rfl + +/-- In every monomial of `F` the parts below `β` add up to `α_{<β}`. -/ +theorem sum_degLT_eq_αLT {d : ι →₀ ℕ} (hd : d ∈ S.F.support) : + ∑ i ∈ d.support, d i • S.degLT i = S.αLT := by + simpa [degLT, αLT, Finsupp.weight_apply, Finsupp.sum] using + (S.hom.map_weight (NatOrdinal.partLTAddMonoidHom S.β) (mem_support_iff.mp hd)) + +/-- In every monomial of `F` the parts at or above `β` add up to `α_{≥β}`. -/ +theorem sum_partGE_eq_αGE {d : ι →₀ ℕ} (hd : d ∈ S.F.support) : + ∑ i ∈ d.support, d i • NatOrdinal.partGE S.β (wt i) = S.αGE := by + simpa [αGE, Finsupp.weight_apply, Finsupp.sum] using + (S.hom.map_weight (NatOrdinal.partGEAddMonoidHom S.β) (mem_support_iff.mp hd)) + +variable (hx : IsMinimalSystem (Berarducci.principalGrading K) wt x) +include hx + +theorem β_ne_zero : S.β ≠ 0 := by + intro h + have hbad := S.term_lt + rw [h, NatOrdinal.wpow_zero] at hbad + exact absurd (NatOrdinal.one_le_leastTerm (hx.ne_zero S.B₀)) (not_le.mpr hbad) + +/-- For every variable `B` of `F`, `(deg B)_{<β}` has finite part `0`. -/ +theorem degLT_constantCoeff {i : ι} (hi : i ∈ S.F.vars) : (S.degLT i).constantCoeff = 0 := by + rw [degLT, NatOrdinal.constantCoeff_partLT (S.β_ne_zero hx)] + exact S.vars_limit i hi + +/-- If `(deg B)_{<β} ≠ 0`, the last term of its Cantor normal form is `ω^e` with `e ≠ 0`. -/ +theorem exists_leastTerm_degLT {i : ι} (hi : i ∈ S.F.vars) (h : S.degLT i ≠ 0) : + ∃ e, e ≠ 0 ∧ NatOrdinal.leastTerm (S.degLT i) = ω^ e := by + obtain ⟨e, he⟩ := NatOrdinal.exists_leastTerm_eq_wpow h + refine ⟨e, fun he0 ↦ ?_, he⟩ + rw [he0, NatOrdinal.wpow_zero, ← NatOrdinal.removeLeastTerm_add_one_eq_self_iff] at he + have := S.degLT_constantCoeff hx hi + rw [← he, show (1 : NatOrdinal) = ((1 : ℕ) : NatOrdinal) by rw [Nat.cast_one], + NatOrdinal.constantCoeff_add_natCast] at this + omega + +/-- `(deg B₀)_{<β} ≠ 0`: the variable of maximal degree has a term below `ω^β`. -/ +theorem degLT_B₀_ne_zero : S.degLT S.B₀ ≠ 0 := by + obtain ⟨e, he⟩ := NatOrdinal.exists_leastTerm_eq_wpow (hx.ne_zero S.B₀) + have hlt : e < S.β := by + have := S.term_lt + rwa [he, NatOrdinal.wpow_lt_wpow] at this + exact NatOrdinal.partLT_ne_zero_of_leastTerm_lt (hx.ne_zero S.B₀) he hlt + +theorem αLT_ne_zero : S.αLT ≠ 0 := by + rw [S.αLT_eq_nsmul_degLT] + exact NatOrdinal.nsmul_ne_zero_of_ne_zero (S.degLT_B₀_ne_zero hx) + (Nat.one_le_iff_ne_zero.mpr (mem_vars_iff_degreeOf_ne_zero.mp S.mem)) + +theorem αLT_constantCoeff : S.αLT.constantCoeff = 0 := by + rw [S.αLT_eq_nsmul_degLT, NatOrdinal.constantCoeff_nsmul, S.degLT_constantCoeff hx S.mem, + mul_zero] + +/-! ### `X_{B₀}` occurs linearly in `F` -/ + +variable (hinj : ∀ β < α, InjectiveAt K wt x β) (hσ : σ.IsPrincipal) +include hinj hσ + +/-- **`D = 1`: `X_{B₀}` occurs linearly in `F`.** -/ +@[blueprint "lem:relation-at-limit-ordinal-maximal-variable-linear" + (phase := "Limit ordinals in the degree induction") + (title := "Maximal-variable linearity for the ordinal-value degree") + (statement := /-- + Let $K$ be a field of characteristic zero. Let $(x_i)_{i\in I}$ be a + minimal homogeneous generating system of $\widehat{\mathrm P}$, with + $x_i\in\mathrm P_{w_i}$, and choose principal series $b_i$ of degree + $w_i$ representing $x_i$. Assume evaluation at $(x_i)$ is injective on + every homogeneous degree below $\alpha$. + + Let $0\ne F\in K[X_i:i\in I]$ be weighted homogeneous of degree $\alpha$ + with $F(x)=0$. Suppose every variable of $F$ has weight below $\alpha$ + and zero constant Cantor coefficient. Choose $X_{B_0}$ of maximal weight + among the variables of $F$, and put $D=\deg_{X_{B_0}}F$. Suppose there are + ordinals $\beta,\Delta,\lambda_0,\alpha_1$ such that + \[ + \Delta\ne0,\qquad + \Delta\oplus D w_{B_0}=\alpha,\qquad + \lambda_0<\alpha_{<\beta}, + \] + every Cantor term of $\Delta$ is at least $\omega^\beta$, and the last + Cantor term of $w_{B_0}$ is below $\omega^\beta$. Assume also + \[ + \alpha_1\le\alpha_{\ge\beta}\oplus\lambda_0, + \qquad \alpha_1\le\alpha, + \] + that for some $\varepsilon_1>0$ every $\gamma\in(-\varepsilon_1,0)$ + satisfies + \[ + v_J\bigl(F(b)^{\vert\gamma}\bigr)<\omega^{\alpha_1}, + \] + and that in the convolution expansion of any monomial of $F$, every term + $\rho$ using at least two translated truncations satisfies + $\rho<\alpha_{\ge\beta}\oplus\lambda_0$. + + Then $D=1$. + -/) + (proof := /-- + Suppose $D\ge2$, put $t=(w_{B_0})_{<\beta}$, and set + $\Theta=\partial_{B_0}F$. The hypotheses give + $\alpha_{<\beta}=Dt$, while $t$ is a nonzero limit ordinal. The polynomial + $\Theta$ is nonzero and homogeneous of degree + \[ + h=\Delta\oplus(D-1)w_{B_0}<\alpha. + \] + Since evaluation is injective in degree $h$, the homogeneous evaluation + $\Theta(b)$ has ordinal value $\omega^h$. + + Since $\lambda_0\oplus1<(D-1)t\oplus t$, + \ref{lem:natural-sum-approach} gives $s<(D-1)t$ with + $\lambda_0\oplus1\le s\oplus t$. Put + $\tau=h_{\ge\beta}\oplus s$. Then $\tauw_{B_0}$. Maximality of $B_0$ makes + this ideal zero. On the other hand, \ref{lem:truncation-values} supplies + such a translated truncation with ordinal value exactly $\omega^\tau$. + This ordinal value is nonzero, and $\tau δ` (`exists_forall_componentsGE_pol_translatedTruncation_aeval_pderiv_mem`); there +are no such variables, so these components vanish, for any degree `τ` with `α′ ≤ τ ⊕ δ`. Here +`∂F/∂X_{B₀} ≠ 0` (characteristic `0`) is homogeneous of degree `h := deg H_D ⊕ (δ ⊙ (D−1))`, so +`v_J((∂F/∂X_{B₀})(b_𝓑)) = ω^h` by injectivity below `α`, and the cofinality clause of +[Ber00, Lem. 6.8] gives translated truncations of ordinal value `ω^τ` for every `τ < h` — whose +polynomials have a nonzero component of degree `τ`. It remains to find `τ < h` with `α′ ≤ τ ⊕ δ`: +the part of `h` below `β` is `(D−1) ⊙ δ_{<β}`, and some `σ < (D−1) ⊙ δ_{<β}` has +`σ ⊕ δ_{<β} > λ₀`; take `τ := h_{≥β} ⊕ σ`. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial OrdinalGraded + +public noncomputable section + +namespace NatOrdinal + +/-- A natural ordinal whose Cantor normal form has last term `ω^e` with `e ≠ 0` is a limit. -/ +theorem constantCoeff_eq_zero_of_leastTerm_eq_wpow {a e : NatOrdinal} (he : e ≠ 0) + (ha : leastTerm a = ω^ e) : a.constantCoeff = 0 := by + by_contra h + have := leastTerm_eq_one_of_constantCoeff_pos (pos_iff_ne_zero.mpr h) + rw [ha, ← wpow_zero, wpow_inj] at this + exact he this + +theorem ne_zero_of_leastTerm_eq_wpow {a e : NatOrdinal} (ha : leastTerm a = ω^ e) : a ≠ 0 := by + rintro rfl + rw [leastTerm_zero] at ha + exact (wpow_pos e).ne ha + +end NatOrdinal + +namespace Berarducci + +variable {K : Type v} [Field K] {ι : Type w} {wt : ι → NatOrdinal} + +variable {x : ι → PrincipalSubring K} + +namespace Lifts + +variable (σ : Lifts wt x) (hx : IsMinimalSystem (Berarducci.principalGrading K) wt x) + {α : NatOrdinal} (hinj : ∀ β < α, InjectiveAt K wt x β) (hσ : σ.IsPrincipal) +include hx hinj hσ + +/-- **A maximal variable occurs linearly.** Let `F` be a relation of degree `α` in +variables of degree `< α`, `B₀` a variable of `F` of maximal degree, `degHD ⊕ (D • wt B₀) = α` with +`D` the degree of `F` in `X_{B₀}`, every term of `degHD` at least `ω^β`, the part of `wt B₀` below +`β` with last term `ω^e`, `e ≠ 0`, and `lam₀ < α_{<β}`. If the translated truncations of `F(b_𝓑)` +have ordinal value below `ω^{α₁}` for all `γ < 0` sufficiently close to `0`, with +`α₁ ≤ α_{≥β} ⊕ lam₀` and `α₁ ≤ α`, and every term of the expansion of a monomial of `F` with at +least two translated truncations has degree below `α_{≥β} ⊕ lam₀`, then `D = 1` (characteristic +`0`). -/ +theorem degreeOf_eq_one_of_forall_termDegree_lt [CharZero K] {F : MvPolynomial ι K} + (hF : IsWeightedHomogeneous wt F α) (hvars : ∀ i ∈ F.vars, wt i < α) + {B₀ : ι} (hB₀ : B₀ ∈ F.vars) (hmax : ∀ i ∈ F.vars, wt i ≤ wt B₀) + {degHD : NatOrdinal} (hdegHD : degHD + degreeOf B₀ F • wt B₀ = α) + {β : NatOrdinal} (hdegHDβ : ∀ t ∈ degHD.val.additivePrincipalTerms, (ω^ β).val ≤ t) + {e : NatOrdinal} (he : e ≠ 0) + (ht : NatOrdinal.leastTerm (NatOrdinal.partLT β (wt B₀)) = ω^ e) + {lam₀ : NatOrdinal} (hlam₀ : lam₀ < NatOrdinal.partLT β α) + {α₁ : NatOrdinal} (hα₁ : α₁ ≤ NatOrdinal.partGE β α + lam₀) (hα₁α : α₁ ≤ α) + {ε₁ : ℝ} (hε₁ : 0 < ε₁) + (hG : ∀ γ : ℝ, -ε₁ < γ → γ < 0 → + ordinalValue (translatedTruncation ((aeval σ.lift F : Series K) : K⟦ℝ⟧) γ) < ω^ α₁) + (hwin : ∀ d ∈ F.support, ∀ (k : ℕ) (ρ : NatOrdinal), 2 ≤ k → TermDegree wt d k ρ → + ρ < NatOrdinal.partGE β α + lam₀) : + degreeOf B₀ F = 1 := by + classical + set D := degreeOf B₀ F with hDdef + have hD1 : 1 ≤ D := Nat.one_le_iff_ne_zero.mpr (mem_vars_iff_degreeOf_ne_zero.mp hB₀) + by_contra hne + have hD2 : 2 ≤ D := by omega + set g := wt B₀ with hgdef + set t := NatOrdinal.partLT β g with htdef + have ht0 : t ≠ 0 := NatOrdinal.ne_zero_of_leastTerm_eq_wpow ht + have hg0 : g ≠ 0 := hx.ne_zero B₀ + -- the part of `α` below `β` is `D • t`, a limit + have hμ : NatOrdinal.partLT β α = D • t := by + rw [← hdegHD, NatOrdinal.partLT_add, NatOrdinal.partLT_eq_zero_of_forall_le hdegHDβ, + zero_add, NatOrdinal.partLT_nsmul] + have hμcc : (NatOrdinal.partLT β α).constantCoeff = 0 := by + rw [hμ, NatOrdinal.constantCoeff_nsmul, + NatOrdinal.constantCoeff_eq_zero_of_leastTerm_eq_wpow he ht, mul_zero] + -- the degree `h = degHD ⊕ (D-1) • g` of `∂F/∂X_{B₀}` + set h : NatOrdinal := degHD + (D - 1) • g with hhdef + have hhg : h + g = α := by + rw [hhdef, add_assoc, ← succ_nsmul, Nat.sub_add_cancel hD1, hdegHD] + have hhα : h < α := by + rw [← hhg]; exact lt_add_of_pos_right _ (pos_iff_ne_zero.mpr hg0) + have hhLT : NatOrdinal.partLT β h = (D - 1) • t := by + rw [hhdef, NatOrdinal.partLT_add, NatOrdinal.partLT_eq_zero_of_forall_le hdegHDβ, + zero_add, NatOrdinal.partLT_nsmul] + set Θ := pderiv B₀ F with hΘdef + have hΘ : IsWeightedHomogeneous wt Θ h := isWeightedHomogeneous_pderiv wt hF B₀ hhg + have hΘ0 : Θ ≠ 0 := pderiv_ne_zero_of_mem_vars hB₀ + have hvΘ : ordinalValue (aeval σ.lift Θ) = ω^ h := + σ.ordinalValue_aeval_eq_of_injectiveAt (hinj h hhα) hΘ hΘ0 + -- the degree `τ = h_{≥β} ⊕ σ'` with `σ' < (D-1) • t` and `λ₀ + 1 ≤ σ' ⊕ t` + have hlam : (D - 1) • t ≠ 0 := NatOrdinal.nsmul_ne_zero_of_ne_zero ht0 (by omega) + have hsig : t = 0 ∨ NatOrdinal.leastTerm ((D - 1) • t) ≤ NatOrdinal.leastTerm t := + Or.inr (le_of_eq (NatOrdinal.leastTerm_nsmul ht0 (by omega))) + have htau : lam₀ + 1 < (D - 1) • t + t := by + rw [← succ_nsmul, Nat.sub_add_cancel hD1, ← hμ] + refine lt_of_le_of_ne (Order.add_one_le_of_lt hlam₀) fun heq ↦ ?_ + have := congrArg NatOrdinal.constantCoeff heq + rw [hμcc, show lam₀ + 1 = lam₀ + ((1 : ℕ) : NatOrdinal) by rw [Nat.cast_one], + NatOrdinal.constantCoeff_add_natCast] at this + omega + obtain ⟨σ', hσ'lt, hσ'⟩ := NatOrdinal.exists_lt_le_add_of_lastCantorTerm_le hlam hsig htau + set τ : NatOrdinal := NatOrdinal.partGE β h + σ' with hτdef + have hτh : τ < h := by + conv_rhs => rw [← NatOrdinal.partGE_add_partLT β h] + rw [hhLT] + exact add_lt_add_right hσ'lt _ + have hτα'' : NatOrdinal.partGE β α + lam₀ ≤ τ + g := by + have h1 : τ + g = NatOrdinal.partGE β α + (σ' + t) := by + rw [← hhg, NatOrdinal.partGE_add, hτdef, htdef] + conv_lhs => rw [show g = NatOrdinal.partGE β g + NatOrdinal.partLT β g from + (NatOrdinal.partGE_add_partLT β g).symm] + abel + rw [h1] + exact add_le_add_right ((lt_add_one lam₀).le.trans hσ') _ + -- no variable of `F` has degree above `wt B₀`: the components of degree at least `τ` vanish + obtain ⟨ε, hε, h2⟩ := σ.exists_forall_componentsGE_pol_translatedTruncation_aeval_pderiv_mem hx + hinj hσ hF hvars hα₁ hα₁α hε₁ hG hwin B₀ hτα'' + have hempty : IsEmpty {j : ι // j ∈ F.vars ∧ wt B₀ < wt j} := + ⟨fun j ↦ absurd j.2.2 (not_lt.mpr (hmax j.1 j.2.1))⟩ + have hzero : ∀ γ : ℝ, -ε < γ → γ < 0 → componentsGE wt τ (σ.pol hx α + (translatedTruncation ((aeval σ.lift Θ : Series K) : K⟦ℝ⟧) γ)) = 0 := by + intro γ hγε hγ0 + have := h2 γ hγε hγ0 + rwa [Set.range_eq_empty, Ideal.span_empty, Ideal.mem_bot] at this + -- a translated truncation of ordinal value exactly `ω^τ` (cofinality clause of [Ber00, Lem. 6.8]) + obtain ⟨γ, hγε, hγ0, hγ⟩ := exists_ordinalValue_translatedTruncation_eq_wpow_of_lt hτh + (aeval σ.lift Θ) hvΘ (neg_neg_of_pos hε) + have hlt : ordinalValue (translatedTruncation ((aeval σ.lift Θ : Series K) : K⟦ℝ⟧) γ) < ω^ α := by + rw [hγ]; exact NatOrdinal.wpow_lt_wpow.mpr (hτh.trans hhα) + have hnotJ : translatedTruncation ((aeval σ.lift Θ : Series K) : K⟦ℝ⟧) γ ∉ + HahnSeries.Nonpositive.negativeMonomialIdeal K := + fun h ↦ NatOrdinal.wpow_ne_zero τ (hγ ▸ ordinalValue_eq_zero_iff.mpr h) + have hdeg := σ.ordinalValue_eq_wpow_weightedTotalDegree_pol hx hinj hlt hnotJ + rw [hγ, NatOrdinal.wpow_inj] at hdeg + have hp0 : σ.pol hx α (translatedTruncation ((aeval σ.lift Θ : Series K) : K⟦ℝ⟧) γ) ≠ 0 := by + intro h + have := σ.toGerm_aeval_pol hx hlt + rw [h, map_zero, map_zero, toGerm_apply, eq_comm, Ideal.Quotient.eq_zero_iff_mem] at this + exact hnotJ this + have hcomp := weightedHomogeneousComponent_weightedTotalDegree_ne_zero (wt := wt) hp0 + rw [← hdeg, ← weightedHomogeneousComponent_componentsGE_of_le wt le_rfl, hzero γ hγε hγ0, + map_zero] at hcomp + exact hcomp rfl + +end Lifts + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LowDegreeParts.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LowDegreeParts.lean new file mode 100644 index 0000000000..4bc0f00638 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LowDegreeParts.lean @@ -0,0 +1,409 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.LimitOrdinalContradiction +public import + LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LimitOrdinalRelationAtCutoff + +/-! +# Low-degree parts and algebraic order + +For a relation of limit-ordinal degree `α` and a cutoff `β`, distinguish variables whose part of +the degree below `β` is zero, equals `α_{<β}`, precedes `λ₀` in the algebraic order, or is nonzero +and does not precede `λ₀` in that order. The bound `pair_bound` on a remainder term with two +truncated factors, through `PairBounds`, describes the last class: such a variable `B` occurs with +exponent `1` in every monomial of `F`; +every other variable `B'` with `(deg B')_{<β} ≠ 0` in such a monomial has the exponent `e_{B'}` +of the last term of `(deg B')_{<β}` above the exponent `e_B` of the last term of `(deg B)_{<β}`, +and `(λ₀)_{≥e_{B'}} = (α_{<β})_{≥e_{B'}}`; and with `ω^ε` the last term of the Cantor normal form +of `α_{<β} ⊖ (deg B)_{<β}`, `(λ₀)_{≥ε} = (α_{<β})_{≥ε}`. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial OrdinalGraded + +public noncomputable section + +namespace NatOrdinal + +/-- The last term of the Cantor normal form of a sum of nonzero natural ordinals is the last term +of one of them. -/ +theorem exists_leastTerm_sum_eq {ι' : Type*} {s : Finset ι'} (hs : s.Nonempty) + (f : ι' → NatOrdinal) (hf : ∀ i ∈ s, f i ≠ 0) : + ∃ i ∈ s, leastTerm (∑ j ∈ s, f j) = leastTerm (f i) := by + classical + induction hs using Finset.Nonempty.cons_induction with + | singleton a => exact ⟨a, Finset.mem_singleton_self a, by rw [Finset.sum_singleton]⟩ + | cons a s ha hs ih => + obtain ⟨i, hi, hi'⟩ := ih fun j hj ↦ hf j (Finset.mem_cons_of_mem hj) + have hsum : ∑ j ∈ s, f j ≠ 0 := by + have : f i ≤ ∑ j ∈ s, f j := Finset.single_le_sum (fun j _ ↦ zero_le) hi + exact (lt_of_lt_of_le (pos_iff_ne_zero.mpr (hf i (Finset.mem_cons_of_mem hi))) this).ne' + rw [Finset.sum_cons, leastTerm_add (hf a (Finset.mem_cons_self a s)) hsum] + rcases min_choice (leastTerm (f a)) (leastTerm (∑ j ∈ s, f j)) with h | h + · exact ⟨a, Finset.mem_cons_self a s, h⟩ + · exact ⟨i, Finset.mem_cons_of_mem hi, h.trans hi'⟩ + +end NatOrdinal + +namespace Berarducci + +/-! ### Splitting off factors of a monomial -/ + +variable {ι : Type w} + +/-- A monomial containing `X_i` twice is `d' · X_i · X_i`. -/ +theorem exists_eq_add_single_add_single_self {d : ι →₀ ℕ} {i : ι} (h : 2 ≤ d i) : + ∃ d' : ι →₀ ℕ, d = d' + Finsupp.single i 1 + Finsupp.single i 1 := by + classical + refine ⟨d - Finsupp.single i 1 - Finsupp.single i 1, ?_⟩ + have h1 : Finsupp.single i 1 ≤ d - Finsupp.single i 1 := by + rw [Finsupp.single_le_iff, Finsupp.tsub_apply, Finsupp.single_eq_same] + omega + have h2 : Finsupp.single i 1 ≤ d := Finsupp.single_le_iff.mpr (by omega) + rw [tsub_add_cancel_of_le h1, tsub_add_cancel_of_le h2] + +/-- A monomial containing `X_i` and `X_u`, `u ≠ i`, is `d' · X_i · X_u`. -/ +theorem exists_eq_add_single_add_single {d : ι →₀ ℕ} {i u : ι} (hi : i ∈ d.support) + (hu : u ∈ d.support) (hui : u ≠ i) : + ∃ d' : ι →₀ ℕ, d = d' + Finsupp.single i 1 + Finsupp.single u 1 := by + classical + refine ⟨d - Finsupp.single i 1 - Finsupp.single u 1, ?_⟩ + have hdi : 1 ≤ d i := Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hi) + have hdu : 1 ≤ d u := Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hu) + have h1 : Finsupp.single u 1 ≤ d - Finsupp.single i 1 := by + rw [Finsupp.single_le_iff, Finsupp.tsub_apply, Finsupp.single_apply, if_neg (Ne.symm hui)] + omega + have h2 : Finsupp.single i 1 ≤ d := Finsupp.single_le_iff.mpr hdi + rw [add_right_comm, tsub_add_cancel_of_le h1, tsub_add_cancel_of_le h2] + +variable {K : Type v} [Field K] {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +namespace Lifts.LimitOrdinalRelationAtCutoff + +variable {σ : Lifts wt x} {α : NatOrdinal} (S : σ.LimitOrdinalRelationAtCutoff α) + +/-- A variable of `F` has a proper low-degree part outside the algebraic bound when its part below +`β` is nonzero, is not all of `α_{<β}`, and does not precede `λ₀` in the algebraic order. -/ +def HasProperLowDegreePartNotAlgebraicLE (i : ι) : Prop := + i ∈ S.F.vars ∧ S.degLT i ≠ 0 ∧ ¬ S.LowDegreePartEq i ∧ ¬ S.LowDegreePartAlgebraicLE i + +theorem hasProperLowDegreePartNotAlgebraicLE_iff (i : ι) : + S.HasProperLowDegreePartNotAlgebraicLE i ↔ + i ∈ S.F.vars ∧ S.degLT i ≠ 0 ∧ ¬ S.LowDegreePartEq i ∧ + ¬ S.LowDegreePartAlgebraicLE i := (Iff.rfl) + +/-- For every variable `B` of `F`, `(deg B)_{<β} ≼ α_{<β}` in the algebraic order. -/ +theorem degLT_algebraicLE_αLT {i : ι} (hi : i ∈ S.F.vars) : + NatOrdinal.AlgebraicLE (S.degLT i) S.αLT := by + classical + obtain ⟨d, hd, hid⟩ := (mem_vars_iff_mem_support i).mp hi + have hsum := S.sum_degLT_eq_αLT hd + rw [← Finset.add_sum_erase _ _ hid] at hsum + have h1 : d i • S.degLT i = S.degLT i + (d i - 1) • S.degLT i := by + conv_lhs => rw [show d i = d i - 1 + 1 from + (Nat.sub_add_cancel (Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hid))).symm] + rw [succ_nsmul'] + rw [h1, add_assoc] at hsum + rw [← hsum] + exact NatOrdinal.algebraicLE_add_right _ _ + +/-- For a monomial `d' · X_i · X_u` of `F`: `(deg d')_{<β} ⊕ S.degLT i ⊕ S.degLT u = α_{<β}`. -/ +theorem partLT_weight_add_degLT_add_degLT {d' : ι →₀ ℕ} {i u : ι} + (hd : d' + Finsupp.single i 1 + Finsupp.single u 1 ∈ S.F.support) : + NatOrdinal.partLT S.β (Finsupp.weight wt d') + S.degLT i + S.degLT u = S.αLT := by + rw [S.αLT_def, S.degLT_def, S.degLT_def] + exact MvPolynomial.partLT_weight_add_partLT_add_partLT S.hom hd + +variable (hx : IsMinimalSystem (Berarducci.principalGrading K) wt x) +include hx + +/-- **A variable whose proper low-degree part does not precede `λ₀` occurs once in each monomial +that contains it.** -/ +@[blueprint "lem:low-degree-part-outside-algebraic-bound-occurs-linearly" + (phase := "Limit ordinals in the degree induction") + (title := "Linearity when $(w_B)_{<\\beta}\\oplus\\nu\\ne\\lambda_0$ for every $\\nu$") + (statement := /-- + Let $K$ be a field. Let $(x_i)_{i\in I}$ be a minimal homogeneous + generating system of $\widehat{\mathrm P}$, with + $x_i\in\mathrm P_{w_i}$, and choose series $b_i$ representing $x_i$. + + Let $0\ne F\in K[X_i:i\in I]$ be weighted homogeneous of degree $\alpha$ + with $F(x)=0$. Suppose every variable of $F$ has weight below $\alpha$ + and zero constant Cantor coefficient. Choose $X_{B_0}$ of maximal weight + among the variables of $F$, and put $D=\deg_{X_{B_0}}F$. Suppose there are + ordinals $\beta,\Delta,\lambda_0,\alpha_1$ such that + \[ + \Delta\ne0,\qquad + \Delta\oplus D w_{B_0}=\alpha,\qquad + \lambda_0<\alpha_{<\beta}, + \] + every Cantor term of $\Delta$ is at least $\omega^\beta$, and the last + Cantor term of $w_{B_0}$ is below $\omega^\beta$. Assume also + \[ + \alpha_1\le\alpha_{\ge\beta}\oplus\lambda_0, + \qquad \alpha_1\le\alpha, + \] + that for some $\varepsilon_1>0$ every $\gamma\in(-\varepsilon_1,0)$ + satisfies + \[ + v_J\bigl(F(b)^{\vert\gamma}\bigr)<\omega^{\alpha_1}, + \] + and that in the convolution expansion of any monomial of $F$, every term + $\rho$ using at least two translated truncations satisfies + $\rho<\alpha_{\ge\beta}\oplus\lambda_0$. + + Let $X_B$ occur in $F$, and suppose + \[ + 0<(w_B)_{<\beta}\ne\alpha_{<\beta}, + \qquad + (w_B)_{<\beta}\not\preccurlyeq\lambda_0. + \] + Then $X_B$ has exponent $1$ in every monomial of $F$ in which it occurs. + -/) + (proof := /-- + Put $t=(w_B)_{<\beta}$. If some monomial contains $X_B$ at least twice, + write it as $M'X_B^2$. The finite part of $t$ is zero, so its last Cantor + term is $\omega^e$ for some $e\ne0$. Weighted homogeneity gives + \[ + (\deg M')_{<\beta}\oplus t\oplus t=\alpha_{<\beta}. + \] + The two-truncation bound says that for all $\rho_1,\rho_20$ every $\gamma\in(-\varepsilon_1,0)$ + satisfies + \[ + v_J\bigl(F(b)^{\vert\gamma}\bigr)<\omega^{\alpha_1}, + \] + and that in the convolution expansion of any monomial of $F$, every term + $\rho$ using at least two translated truncations satisfies + $\rho<\alpha_{\ge\beta}\oplus\lambda_0$. + + Let distinct variables $X_B,X_C$ occur in the same monomial of $F$. + Suppose + \[ + 0<(w_B)_{<\beta}\ne\alpha_{<\beta},\qquad + (w_B)_{<\beta}\oplus\nu\ne\lambda_0 + \quad\text{for every ordinal }\nu, + \] + and $(w_C)_{<\beta}\ne0$. If the last Cantor terms of + $(w_B)_{<\beta}$ and $(w_C)_{<\beta}$ are respectively + $\omega^{e_B}$ and $\omega^{e_C}$, then + \[ + e_B0$ every $\gamma\in(-\varepsilon_1,0)$ + satisfies + \[ + v_J\bigl(F(b)^{\vert\gamma}\bigr)<\omega^{\alpha_1}, + \] + and that in the convolution expansion of any monomial of $F$, every term + $\rho$ using at least two translated truncations satisfies + $\rho<\alpha_{\ge\beta}\oplus\lambda_0$. + + Let $X_B$ occur in $F$, and suppose + \[ + 0<(w_B)_{<\beta}\ne\alpha_{<\beta},\qquad + (w_B)_{<\beta}\oplus\nu\ne\lambda_0 + \quad\text{for every ordinal }\nu. + \] + If + \[ + c\oplus(w_B)_{<\beta}=\alpha_{<\beta} + \] + and the last Cantor term of $c$ is $\omega^e$, then + \[ + (\lambda_0)_{\ge e}=(\alpha_{<\beta})_{\ge e}. + \] + -/) + (proof := /-- + Choose a monomial containing $X_B$. By + \ref{lem:low-degree-part-outside-algebraic-bound-occurs-linearly}, $X_B$ has exponent one in this + monomial. After deleting it, the natural sum of the remaining nonzero parts + below $\beta$ is $c$. This family is nonempty because otherwise + $(w_B)_{<\beta}=\alpha_{<\beta}$. + + The last Cantor term of a finite natural sum of nonzero ordinals is the last + Cantor term of one of its summands. Choose a remaining variable $X_C$ that + supplies $\omega^e$. Then + \ref{lem:later-cantor-terms-outside-algebraic-bound} applied to $X_B$ and + $X_C$ gives + $(\lambda_0)_{\ge e}=(\alpha_{<\beta})_{\ge e}$. + -/)] +theorem partGE_lam₀_eq_of_hasProperLowDegreePartNotAlgebraicLE {i : ι} + (hi : S.HasProperLowDegreePartNotAlgebraicLE i) {c ε : NatOrdinal} + (hc : c + S.degLT i = S.αLT) (hε : NatOrdinal.leastTerm c = ω^ ε) : + NatOrdinal.partGE ε S.lam₀ = NatOrdinal.partGE ε S.αLT := by + classical + obtain ⟨hiv, hti, htop, -⟩ := id hi + obtain ⟨d, hd, hid⟩ := (mem_vars_iff_mem_support i).mp hiv + have hd1 := S.apply_eq_one_of_hasProperLowDegreePartNotAlgebraicLE hx hi hd hid + -- the parts below `β` of the other factors add up to `c` + have hsum := S.sum_degLT_eq_αLT hd + rw [← Finset.add_sum_erase _ _ hid, hd1, one_smul, add_comm] at hsum + have hc' : ∑ j ∈ d.support.erase i, d j • S.degLT j = c := + add_right_cancel (hsum.trans hc.symm) + -- restrict to the factors with nonzero part below `β` + set s := (d.support.erase i).filter fun j ↦ S.degLT j ≠ 0 with hsdef + have hcs : ∑ j ∈ s, d j • S.degLT j = c := by + rw [← hc', hsdef, Finset.sum_filter] + refine Finset.sum_congr rfl fun j _ ↦ ?_ + split_ifs with h + · rfl + · rw [not_not.mp h, smul_zero] + have hc0 : c ≠ 0 := by + rintro rfl + rw [zero_add] at hc + exact htop ((S.lowDegreePartEq_iff i).mpr hc) + have hs : s.Nonempty := by + rw [Finset.nonempty_iff_ne_empty] + intro h + rw [h, Finset.sum_empty] at hcs + exact hc0 hcs.symm + have hsne : ∀ j ∈ s, d j • S.degLT j ≠ 0 := fun j hj ↦ by + obtain ⟨hj, htj⟩ := Finset.mem_filter.mp hj + exact NatOrdinal.nsmul_ne_zero_of_ne_zero htj + (Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp (Finset.mem_erase.mp hj).2)) + obtain ⟨u, hus, hu⟩ := NatOrdinal.exists_leastTerm_sum_eq hs _ hsne + obtain ⟨hu', htu⟩ := Finset.mem_filter.mp hus + obtain ⟨hui, hud⟩ := Finset.mem_erase.mp hu' + rw [hcs, hε, NatOrdinal.leastTerm_nsmul htu + (Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hud))] at hu + obtain ⟨eᵢ, -, heᵢ⟩ := S.exists_leastTerm_degLT hx hiv hti + exact + (S.lt_and_partGE_eq_of_hasProperLowDegreePartNotAlgebraicLE + hx hi hd hid hud hui htu heᵢ hu.symm).2 + +end Lifts.LimitOrdinalRelationAtCutoff + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LoweringDerivation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LoweringDerivation.lean new file mode 100644 index 0000000000..98140ed79a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LoweringDerivation.lean @@ -0,0 +1,306 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.BaseChange +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.InternalGrading +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GeometricIntegrality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorLeibniz +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus.Pointwise +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalIdealGE +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.BaseChange + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAtInjective +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFraction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue + +/-! +# `(P̂, ∂)` is a graded domain over `K` with a lowering derivation + +The ring `P̂ = ⨁ P_α` is internally graded by its components `P_α`, with `P_0 = K`, and the +maps `∂ : P_{α+1} → Fun_{0⁻}(P_α)` assemble into a single `K`-linear derivation +`∂ : P̂ → Fun_{0⁻}(P̂)`: the Leibniz identity on components of successor degree is the Leibniz +rule (D1) for `∂`, `∂` lowers the degree by one by construction (D2), and `∂` is injective on every +component of successor degree (D3). Hence `(P̂, ∂)` is a graded domain over `K` with a lowering +derivation (prop:P-lowering); the ideals `I_{≥j}` and the quotient `P̂/I` of the abstract theory are +those of `P̂`. + +The grading and `∂` exist over every coefficient field. In characteristic zero the abstract +structure theorem gives that `P̂/I` is a domain, and, applied to the base change `E ⊗[K] P̂` (a +domain, being a subring of the domain `P̂_E`), that `E ⊗[K] P̂/I` is a domain for every field +extension `E / K`: `P̂/I` is geometrically integral over `K`. +-/ + +universe v + +open Filter Topology +open scoped DirectSum HahnSeries NatOrdinal TensorProduct + +public noncomputable section + +namespace Berarducci + +open Berarducci LoweringDerivation + +variable {K : Type v} [Field K] + +/-! ### The derivation `∂` of `P̂` -/ + +variable (K) in +/-- `∂` on a single homogeneous component `P_α`, valued in `Fun_{0⁻}(P̂)`: for `α` a successor, +`∂` on `P_α` followed by the inclusion of the component `P_{α⁻}` indexed by its predecessor +into `P̂`; zero for `α` zero or a +limit (D2). -/ +def principalComponentDerivation (α : NatOrdinal) : + PrincipalComponent K α →ₗ[K] FunAtZeroMinus (PrincipalSubring K) := + if hα : 0 < α.constantCoeff then + (Filter.Germ.mapLinear (DirectSum.lof K NatOrdinal (PrincipalComponent K) (α.removeNat 1))).comp + (principalComponentDerivAt K α hα) + else 0 + +theorem principalComponentDerivation_of_pos {α : NatOrdinal} (hα : 0 < α.constantCoeff) + (a : PrincipalComponent K α) : + principalComponentDerivation K α a = + Filter.Germ.mapLinear (DirectSum.lof K NatOrdinal (PrincipalComponent K) (α.removeNat 1)) + (principalComponentDerivAt K α hα a) := by + rw [principalComponentDerivation, dif_pos hα, LinearMap.comp_apply] + +theorem principalComponentDerivation_of_eq_zero {α : NatOrdinal} (hα : α.constantCoeff = 0) + (a : PrincipalComponent K α) : principalComponentDerivation K α a = 0 := by + rw [principalComponentDerivation, dif_neg (by omega), LinearMap.zero_apply] + +/-- For `α` a successor, `∂` of the class of `u` is the function at `0⁻` `γ ↦ ∂(u)(γ)`, the class +of the translated truncation `u^{|γ}` in `P_{α⁻}` included into `P̂`. -/ +theorem principalComponentDerivation_principalComponentMk + {α : NatOrdinal} (hα : 0 < α.constantCoeff) + (u : Series K) (hu : ordinalValue u < ω^ (α + 1)) : + principalComponentDerivation K α (principalComponentMk α u hu) = + ((fun γ ↦ DirectSum.of (PrincipalComponent K) (α.removeNat 1) (derivAt α u γ) : + ℝ → PrincipalSubring K) : FunAtZeroMinus (PrincipalSubring K)) := by + rw [principalComponentDerivation_of_pos hα, principalComponentDerivAt_principalComponentMk, + Filter.Germ.mapLinear_coe] + rfl + +variable (K) in +/-- The derivation `∂ : P̂ → Fun_{0⁻}(P̂)`: `∂ : P_{α+1} → Fun_{0⁻}(P_α) ⊆ Fun_{0⁻}(P̂)` on each +component of successor degree, extended `K`-linearly, vanishing on components indexed by limit +ordinals +and of degree `0`. -/ +def principalSubringDerivation : PrincipalSubring K →ₗ[K] FunAtZeroMinus (PrincipalSubring K) := + DirectSum.toModule K NatOrdinal _ (principalComponentDerivation K) + +theorem principalSubringDerivation_of (α : NatOrdinal) (a : PrincipalComponent K α) : + principalSubringDerivation K (DirectSum.of (PrincipalComponent K) α a) = + principalComponentDerivation K α a := by + rw [principalSubringDerivation, ← DirectSum.lof_eq_of K, DirectSum.toModule_lof] + +/-- `∂` vanishes on scalars. -/ +theorem principalSubringDerivation_algebraMap (k : K) : + principalSubringDerivation K (algebraMap K (PrincipalSubring K) k) = 0 := by + rw [principalSubring_algebraMap_apply, principalSubringDerivation_of, + principalComponentDerivation_of_eq_zero NatOrdinal.constantCoeff_zero] + +/-- The Leibniz rule for `∂` on homogeneous elements, in the main case: `α` a successor and +`β > 0`. The translated-truncation identity in `P_{(α+β)⁻}` is pushed into `Fun_{0⁻}(P̂)`. -/ +private theorem principalSubringDerivation_of_mul_of_of_pos {α β : NatOrdinal} + (hα : 0 < α.constantCoeff) + (a : PrincipalComponent K α) (b : PrincipalComponent K β) : + principalSubringDerivation K + (DirectSum.of (PrincipalComponent K) α a * DirectSum.of (PrincipalComponent K) β b) = + principalSubringDerivation K (DirectSum.of (PrincipalComponent K) α a) * + ((DirectSum.of (PrincipalComponent K) β b : PrincipalSubring K) : FunAtZeroMinus _) + + ((DirectSum.of (PrincipalComponent K) α a : PrincipalSubring K) : FunAtZeroMinus _) * + principalSubringDerivation K (DirectSum.of (PrincipalComponent K) β b) := by + obtain ⟨u, hu, rfl⟩ := exists_principalComponentMk α a + obtain ⟨v, hv, rfl⟩ := exists_principalComponentMk β b + have hsum : 0 < (α + β).constantCoeff := by + rw [NatOrdinal.constantCoeff_add]; omega + rw [← of_principalComponentMul, principalComponentMul_mk, principalSubringDerivation_of, + principalSubringDerivation_of, principalSubringDerivation_of, + principalComponentDerivation_principalComponentMk hsum, + principalComponentDerivation_principalComponentMk hα] + by_cases hβc : 0 < β.constantCoeff + · rw [principalComponentDerivation_principalComponentMk hβc] + change _ = ((fun γ ↦ _ : ℝ → PrincipalSubring K) : FunAtZeroMinus (PrincipalSubring K)) + rw [Filter.Germ.coe_eq] + exact eventually_of_derivAt_mul_of_pos hα hβc u v hu hv + · rw [principalComponentDerivation_of_eq_zero (by omega), mul_zero, add_zero] + change _ = ((fun γ ↦ _ : ℝ → PrincipalSubring K) : FunAtZeroMinus (PrincipalSubring K)) + rw [Filter.Germ.coe_eq] + exact eventually_of_derivAt_mul_of_eq_zero hα (by omega) u v hu hv + +/-- The Leibniz rule for `∂` on homogeneous elements. -/ +theorem principalSubringDerivation_of_mul_of (α β : NatOrdinal) (a : PrincipalComponent K α) + (b : PrincipalComponent K β) : + principalSubringDerivation K + (DirectSum.of (PrincipalComponent K) α a * DirectSum.of (PrincipalComponent K) β b) = + principalSubringDerivation K (DirectSum.of (PrincipalComponent K) α a) * + ((DirectSum.of (PrincipalComponent K) β b : PrincipalSubring K) : FunAtZeroMinus _) + + ((DirectSum.of (PrincipalComponent K) α a : PrincipalSubring K) : FunAtZeroMinus _) * + principalSubringDerivation K (DirectSum.of (PrincipalComponent K) β b) := by + -- Scalars: a degree-zero factor is a constant `k`, and `k v` represents `k • B`. + rcases eq_or_ne α 0 with rfl | hα0 + · obtain ⟨k, rfl⟩ := principalComponentScalarHom_surjective K a + rw [← principalSubring_algebraMap_apply, ← Algebra.smul_def, map_smul, + principalSubringDerivation_algebraMap, zero_mul, zero_add, + FunAtZeroMinus.const_algebraMap_mul] + rcases eq_or_ne β 0 with rfl | hβ0 + · obtain ⟨k, rfl⟩ := principalComponentScalarHom_surjective K b + rw [← principalSubring_algebraMap_apply, ← Algebra.commutes, ← Algebra.smul_def, map_smul, + principalSubringDerivation_algebraMap, mul_zero, add_zero, + FunAtZeroMinus.mul_const_algebraMap] + by_cases hαc : 0 < α.constantCoeff + · exact principalSubringDerivation_of_mul_of_of_pos hαc a b + by_cases hβc : 0 < β.constantCoeff + · -- Symmetric case: apply the main case to `b * a`. + have h := principalSubringDerivation_of_mul_of_of_pos hβc b a + rw [mul_comm] at h + rw [h, add_comm] + simp only [mul_comm] + · -- Neither grade is a successor: both sides vanish. + have hsum : (α + β).constantCoeff = 0 := by + rw [NatOrdinal.constantCoeff_add]; omega + rw [← of_principalComponentMul, principalSubringDerivation_of, principalSubringDerivation_of, + principalSubringDerivation_of, principalComponentDerivation_of_eq_zero hsum, + principalComponentDerivation_of_eq_zero (by omega), + principalComponentDerivation_of_eq_zero (by omega), zero_mul, mul_zero, add_zero] + +/-- The Leibniz rule (D1) for `∂`. -/ +@[blueprint "thm:leibniz-rule-lowering-derivation" + (phase := "Translated truncations") + (title := "Leibniz rule for the lowering derivation") + (statement := /-- + Let $K$ be a field. On each successor component + $\mathrm P_{\alpha+1}\subseteq\widehat{\mathrm P}$, let $\partial$ send a + class represented by $b$ to the germ at $0^-$ of + \[ + \gamma\longmapsto + b^{\vert\gamma}+J_{\omega^\alpha}\in\mathrm P_\alpha, + \] + and let $\partial$ vanish on $\mathrm P_0$ and on components of limit + degree. Extend this map $K$-linearly to + \[ + \partial:\widehat{\mathrm P}\longrightarrow + \operatorname{Fun}_{0^-}(\widehat{\mathrm P}). + \] + Then, for all $B,C\in\widehat{\mathrm P}$, + \[ + \partial(BC)=\partial(B)C+B\partial(C) + \] + in $\operatorname{Fun}_{0^-}(\widehat{\mathrm P})$. + -/) + (proof := /-- + First suppose $B$ and $C$ are homogeneous. Degree-zero components are + scalars, so the identity follows from $K$-linearity. For positive degrees, + use \ref{fact:principal-series-representatives} to choose representatives. + If the degree of $B$ is a + successor, apply \ref{lem:convolution-formula} to $(BC)^{\vert\gamma}$. The two + boundary terms give $\partial(B)C+B\partial(C)$; by + \ref{lem:truncation-drop}, every interior term has smaller ordinal value and + vanishes in the target component. The case where only the degree of $C$ is a + successor follows by commutativity. If both positive degrees are limits, + their natural sum is a limit and all three derivatives vanish. + + Finally decompose arbitrary $B$ and $C$ into their finite sums of homogeneous + components. $K$-linearity of $\partial$ and distributivity extend the + homogeneous identity to all of $\widehat{\mathrm P}$. + -/)] +theorem principalSubringDerivation_mul (x y : PrincipalSubring K) : + principalSubringDerivation K (x * y) = + principalSubringDerivation K x * (y : FunAtZeroMinus _) + + (x : FunAtZeroMinus _) * principalSubringDerivation K y := by + induction x using DirectSum.induction_on with + | zero => rw [zero_mul, map_zero, zero_mul, FunAtZeroMinus.const_zero, zero_mul, add_zero] + | of α a => + induction y using DirectSum.induction_on with + | zero => rw [mul_zero, map_zero, mul_zero, FunAtZeroMinus.const_zero, mul_zero, add_zero] + | of β b => exact principalSubringDerivation_of_mul_of α β a b + | add y z hy hz => + rw [mul_add, map_add, hy, hz, map_add, FunAtZeroMinus.const_add, mul_add, mul_add] + abel + | add x z hx hz => + rw [add_mul, map_add, hx, hz, map_add, FunAtZeroMinus.const_add, add_mul, add_mul] + abel + +variable (K) in +/-- `∂` is a lowering derivation of `P̂` for its grading by the homogeneous components `P_α`: (D1) +the Leibniz +rule, (D2) `∂(P_{α+1}) ⊆ Fun_{0⁻}(P_α)` and `∂(P_α) = 0` for `α` zero or a limit, (D3) injectivity +on every `P_{α+1}`. With `P̂` a domain and `P_0 = K` this is prop:P-lowering: `(P̂, ∂)` is a +graded domain over `K` with a lowering derivation. -/ +theorem principalSubringDerivation_isLoweringDerivation : + IsLoweringDerivation (principalGrading K) (principalSubringDerivation K) where + map_mul := principalSubringDerivation_mul + mem_lower := by + intro α hα x hx + obtain ⟨a, rfl⟩ := (DirectSum.mem_rangeLof_iff K _ _ x).mp hx + rw [DirectSum.lof_eq_of, principalSubringDerivation_of, + principalComponentDerivation_of_pos hα, principalGrading, + DirectSum.rangeLof_eq_range] + exact mapLinear_mem_funAtZeroMinusSubmodule_range + (DirectSum.lof K NatOrdinal (PrincipalComponent K) (α.removeNat 1)) _ + eq_zero := by + intro α hα x hx + obtain ⟨a, rfl⟩ := (DirectSum.mem_rangeLof_iff K _ _ x).mp hx + rw [DirectSum.lof_eq_of, principalSubringDerivation_of, + principalComponentDerivation_of_eq_zero hα] + injective := by + intro α hα x hx h + obtain ⟨a, rfl⟩ := (DirectSum.mem_rangeLof_iff K _ _ x).mp hx + rw [DirectSum.lof_eq_of, principalSubringDerivation_of, + principalComponentDerivation_of_pos hα] at h + have h1 := Filter.Germ.mapLinear_injective _ (DirectSum.of_injective _) (by rw [h, map_zero] : + Filter.Germ.mapLinear (DirectSum.lof K NatOrdinal (PrincipalComponent K) (α.removeNat 1)) + (principalComponentDerivAt K α hα a) = Filter.Germ.mapLinear _ 0) + have h2 := principalComponentDerivAt_injective K α hα (by rw [h1, map_zero] : + principalComponentDerivAt K α hα a = principalComponentDerivAt _ α hα 0) + rw [h2, map_zero] + +/-! ### The quotient `P̂/I` is a domain -/ + +variable [CharZero K] + +variable (K) in +/-- The quotient `P̂/I` (Lean `PrincipalFibre K`) is an integral domain. -/ +theorem principalFibre_isDomain : + IsDomain (PrincipalFibre K) := + haveI : IsDomain (PrincipalSubring K) := principalSubringIsDomain + (principalSubringDerivation_isLoweringDerivation K).fibre_isDomain + (principalGrading_gradeZeroScalars K) + +variable (K) in +/-- `E ⊗[K] P̂/I` is a domain for every field extension `E / K`, in every universe: the base +change `E ⊗[K] P̂` is a graded domain over `E` with a lowering derivation, its quotient is +`E ⊗[K] P̂/I`, and the quotient `A/I` of every such ring is a domain. -/ +theorem isDomain_tensor_principalFibre (E : Type*) [Field E] [Algebra K E] : + IsDomain (E ⊗[K] PrincipalFibre K) := by + haveI := charZero_of_algebra K E + haveI : IsDomain (E ⊗[K] PrincipalSubring K) := isDomain_tensor_principalSubring K E + exact isDomain_tensor_fibre E (principalGrading K) (principalGrading_gradeZeroScalars K) + (principalSubringDerivation_isLoweringDerivation K) + +variable (K) in +/-- The quotient `P̂/I` is geometrically integral over `K`. -/ +theorem principalFibre_isGeometricallyIntegral : + Algebra.IsGeometricallyIntegral K (PrincipalFibre K) := by + rw [Algebra.isGeometricallyIntegral_iff] + intro E _ _ + haveI := isDomain_tensor_principalFibre K E + exact (Algebra.TensorProduct.comm K _ _).toMulEquiv.isDomain _ + +variable (K) in +/-- `P̂/I ⊗[K] D` is a domain for every domain `D` over `K`, in every universe. -/ +theorem isDomain_principalFibre_tensor (D : Type*) [CommRing D] [IsDomain D] [Algebra K D] : + IsDomain (PrincipalFibre K ⊗[K] D) := + Algebra.isDomain_tensor_of_isDomain_of_forall_field + (fun L _ _ ↦ + haveI := isDomain_tensor_principalFibre K L + (Algebra.TensorProduct.comm K (PrincipalFibre K) L).toMulEquiv.isDomain _) D + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/OmegaSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/OmegaSupport.lean new file mode 100644 index 0000000000..3ecf647ac3 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/OmegaSupport.lean @@ -0,0 +1,424 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAt +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAtInjective + +/-! +# The support of a derivative has order type at most `ω` + +Let `α` be a successor ordinal, `δ := α ⊖ 1`, and `p` a principal series of degree `α`: +`v_J(p) = ω^α` and the support of `p` has order type `ω^α`. The set of cutoffs `ξ < 0` at which +the ordinal value of `p` is at least `ω^δ`, that is `ω^δ ≤ v_J(p^{|ξ})` (`cutoffsGE δ p`), is well +ordered with finite initial segments, hence of order type at most `ω`. Indeed, for a cutoff `ξ` of +this set, every interval `(θ, ξ]` with `θ < ξ` carries support of order type at least `ω^δ`; a +strictly increasing sequence of such cutoffs bounded by `ξ₀ < 0` would therefore force support of +order type at least `ω^δ · ω = ω^α` below `ξ₀`, while `v_J(p) = ω^α` already needs support of +order type `ω^α` above `ξ₀`, more than the order type `ω^α` of the whole support. + +Consequently the derivative `∂(x)` of a nonzero `x ∈ P_α` is the class of a function at `0⁻` +vanishing outside a strictly increasing sequence of cutoffs with supremum `0`: `∂(x)` vanishes +outside the cutoffs at which the ordinal value of a principal representative is at least `ω^δ`. +This is the form used by `mem_span_of_principalSubringDerivation_eq_coe`. +-/ + +universe v + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-! ### Support between two cutoffs -/ + +/-- If `p^{|γ}` has ordinal value at least `ω^δ`, the support of `p` in any interval `(θ, γ]` +has order type at least `ω^δ`. -/ +theorem wpow_le_supportOrderType_truncGT_truncLE {δ : NatOrdinal} (p : Series K) {γ θ : ℝ} + (hθγ : θ < γ) (hγ : ω^ δ ≤ ordinalValue (translatedTruncation (p : K⟦ℝ⟧) γ)) : + ω^ δ ≤ NatOrdinal.of (truncGT θ (truncLE γ (p : K⟦ℝ⟧))).supportOrderType := by + -- the part of `p^{|γ}` beyond `θ - γ`, as a nonpositive series + let r : Series K := ⟨translate (-γ) (truncGT θ (truncLE γ (p : K⟦ℝ⟧))), by + rw [mem_nonpositiveSubring] + intro x hx + rw [support_translate] at hx + obtain ⟨y, hy, rfl⟩ := hx + have hy' : y ≤ γ := by + have := support_truncGT_subset θ _ hy + rw [support_truncLE] at this + exact this.2 + change -γ + y ≤ 0 + linarith⟩ + have hgerm : toGerm (translatedTruncation (p : K⟦ℝ⟧) γ) = toGerm r := by + rw [toGerm_eq_toGerm_iff_exists_coeff_eq] + refine ⟨θ - γ, by linarith, fun η hη1 hη2 ↦ ?_⟩ + rw [coeff_translatedTruncation, if_pos hη2] + change _ = (translate (-γ) (truncGT θ (truncLE γ (p : K⟦ℝ⟧)))).coeff η + rw [coeff_translate, sub_neg_eq_add, coeff_truncGT_of_lt (by linarith), + HahnSeries.coeff_truncLE, if_pos (by linarith), add_comm] + calc ω^ δ ≤ ordinalValue (translatedTruncation (p : K⟦ℝ⟧) γ) := hγ + _ = ordinalValue r := + ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (toGerm_eq_toGerm_iff.mp hgerm) + _ ≤ NatOrdinal.of (r : K⟦ℝ⟧).supportOrderType := ordinalValue_le_supportOrderType r + _ = NatOrdinal.of (truncGT θ (truncLE γ (p : K⟦ℝ⟧))).supportOrderType := by + change NatOrdinal.of + (translate (-γ) (truncGT θ (truncLE γ (p : K⟦ℝ⟧)))).supportOrderType = _ + rw [supportOrderType_translate] + +/-- The support of `p` in `(θ, γ]` is nonempty when `p^{|γ}` has ordinal value at least `ω^δ`. -/ +theorem exists_mem_support_Ioc_of_wpow_le {δ : NatOrdinal} (p : Series K) {γ θ : ℝ} + (hθγ : θ < γ) (hγ : ω^ δ ≤ ordinalValue (translatedTruncation (p : K⟦ℝ⟧) γ)) : + ∃ x ∈ (p : K⟦ℝ⟧).support, θ < x ∧ x ≤ γ := by + have h := wpow_le_supportOrderType_truncGT_truncLE p hθγ hγ + have hne : (truncGT θ (truncLE γ (p : K⟦ℝ⟧))).support.Nonempty := by + rw [Set.nonempty_iff_ne_empty] + intro hempty + have h0 : (truncGT θ (truncLE γ (p : K⟦ℝ⟧))).supportOrderType = 0 := by + rw [supportOrderType_eq_setOrderType] + exact (Set.IsPWO.orderType_eq_zero _).mpr hempty + rw [h0] at h + exact absurd h (not_le.mpr (NatOrdinal.wpow_pos δ)) + obtain ⟨x, hx⟩ := hne + rw [support_truncGT, support_truncLE] at hx + exact ⟨x, hx.1.1, hx.2, hx.1.2⟩ + +/-! ### The cutoffs at which the ordinal value is at least `ω^δ` -/ + +/-- The set of cutoffs `ξ < 0` at which the ordinal value of `p` is at least `ω^δ`: +`ω^δ ≤ v_J(p^{|ξ})`. For `p` principal of degree `δ + 1` this is the set of cutoffs at which +`∂(p + J_{ω^{δ+1}})` does not vanish and, `v_J^r(p)` being `ω^δ`, it is the set `Res(p) = X(p)` of +residual points of [FLLM, Def. 2.7], [Ber00, Def. 6.6]; for arbitrary `p` and `δ` it is the set +`Big^δ(p)` of [FLLM, Def. 2.7] *without* FLLM's clause `ξ > crit_J(p)`, which is not imposed +here. -/ +def cutoffsGE (δ : NatOrdinal) (p : Series K) : Set ℝ := + {ξ | ξ < 0 ∧ ω^ δ ≤ ordinalValue (translatedTruncation (p : K⟦ℝ⟧) ξ)} + +theorem mem_cutoffsGE_iff {δ : NatOrdinal} {p : Series K} {ξ : ℝ} : + ξ ∈ cutoffsGE δ p ↔ ξ < 0 ∧ ω^ δ ≤ ordinalValue (translatedTruncation (p : K⟦ℝ⟧) ξ) := + (Iff.rfl) + +/-- The cutoffs at which the ordinal value of `p` is at least `ω^δ` form a well-ordered set. -/ +theorem cutoffsGE_isPWO (δ : NatOrdinal) (p : Series K) : (cutoffsGE δ p).IsPWO := by + rw [Set.isPWO_iff_isWF, Set.isWF_iff_no_descending_seq] + intro f hf hmem + have hpick : ∀ k, ∃ x ∈ (p : K⟦ℝ⟧).support, f (k + 1) < x ∧ x ≤ f k := fun k ↦ + exists_mem_support_Ioc_of_wpow_le p (hf (Nat.lt_succ_self k)) (hmem k).2 + choose x hx hx1 hx2 using hpick + refine (Set.isWF_iff_no_descending_seq.mp (p : K⟦ℝ⟧).isPWO_support.isWF) x ?_ hx + exact strictAnti_nat_of_succ_lt fun k ↦ (hx2 (k + 1)).trans_lt (hx1 k) + +/-- Truncating below `c` and then below `c'` with `c ≤ c'` truncates below `c`. -/ +theorem truncLE_truncLE_of_le {c c' : ℝ} (h : c ≤ c') (x : K⟦ℝ⟧) : + truncLE c (truncLE c' x) = truncLE c x := by + ext g + simp only [HahnSeries.coeff_truncLE] + split_ifs with h1 h2 <;> first | rfl | exact absurd (h1.trans h) h2 + +/-- A strictly increasing sequence of cutoffs at which the ordinal value of `p` is at least `ω^δ` +forces support of order type at least `ω^δ · n` below its `n`-th member. -/ +theorem wpow_mul_le_supportOrderType_truncLE {δ : NatOrdinal} (p : Series K) (γ : ℕ → ℝ) + (hγ : StrictMono γ) (hmem : ∀ k, γ k ∈ cutoffsGE δ p) (n : ℕ) : + Ordinal.omega0 ^ δ.val * n ≤ (truncLE (γ n) (p : K⟦ℝ⟧)).supportOrderType := by + induction n with + | zero => simp + | succ n ih => + have hsplit := supportOrderType_eq_truncLE_add_truncGT (γ n) (truncLE (γ (n + 1)) (p : K⟦ℝ⟧)) + rw [truncLE_truncLE_of_le (hγ.monotone (Nat.le_succ n))] at hsplit + have hblock : Ordinal.omega0 ^ δ.val ≤ + (truncGT (γ n) (truncLE (γ (n + 1)) (p : K⟦ℝ⟧))).supportOrderType := by + have := wpow_le_supportOrderType_truncGT_truncLE (δ := δ) p (hγ (Nat.lt_succ_self n)) + (hmem (n + 1)).2 + rw [← NatOrdinal.val_wpow] + exact NatOrdinal.val.monotone this + rw [hsplit, Nat.cast_add_one, ← Order.succ_eq_add_one, Ordinal.mul_succ] + exact add_le_add ih hblock + +/-- A strictly increasing sequence of cutoffs at which the ordinal value of `p` is at least `ω^δ`, +bounded by `ξ₀`, forces support of order type at least `ω^(δ+1)` below `ξ₀`. -/ +theorem wpow_add_one_le_supportOrderType_truncLE {δ : NatOrdinal} (p : Series K) (γ : ℕ → ℝ) + (hγ : StrictMono γ) (hmem : ∀ k, γ k ∈ cutoffsGE δ p) {ξ₀ : ℝ} (hξ₀ : ∀ k, γ k ≤ ξ₀) : + ω^ (δ + 1) ≤ NatOrdinal.of (truncLE ξ₀ (p : K⟦ℝ⟧)).supportOrderType := by + rw [NatOrdinal.wpow_add_one_le_iff] + intro n + rw [NatOrdinal.wpow_mul_natCast] + refine NatOrdinal.of.monotone ?_ + refine (wpow_mul_le_supportOrderType_truncLE p γ hγ hmem n).trans ?_ + rw [supportOrderType_eq_setOrderType, supportOrderType_eq_setOrderType] + refine Set.IsPWO.orderType_mono _ _ ?_ + rw [support_truncLE, support_truncLE] + exact Set.inter_subset_inter_right _ (Set.Iic_subset_Iic.mpr (hξ₀ n)) + +/-- For `p` with ordinal value and support order type `ω^(δ+1)`, only finitely many translated +truncations at or below a fixed negative exponent have ordinal value at least `ω^δ`. -/ +@[blueprint "lem:finite-successor-value-cutoffs" + (phase := "Translated truncations") + (title := "Local finiteness of translated truncations at successor ordinal value") + (statement := /-- + Let $K$ be a field, let $\delta<\omega_1$, and let + $p\in K((\mathbb R^{\le0}))$ satisfy + \[ + v_J(p)=\operatorname{ot}(p)=\omega^{\delta+1}. + \] + For every $\xi_0<0$, the set + \[ + \{\xi\le\xi_0:v_J(p^{|\xi})\ge\omega^\delta\} + \] + is finite. + -/) + (proof := /-- + Otherwise choose a strictly increasing sequence $(\gamma_n)$ in this set. + The support between consecutive $\gamma_n$ has order type at least + $\omega^\delta$, so the support at or below $\xi_0$ has order type at least + $\omega^\delta\cdot\omega=\omega^{\delta+1}$. Removing that part does not + change the series modulo $J$, hence the remaining support above $\xi_0$ also + has order type at least $\omega^{\delta+1}$. Splitting the support at + $\xi_0$ would therefore give + \[ + \operatorname{ot}(p)\ge + \omega^{\delta+1}+\omega^{\delta+1}>\omega^{\delta+1}, + \] + a contradiction. + -/)] +theorem cutoffsGE_inter_Iic_finite_of_neg {δ : NatOrdinal} (p : Series K) + (hv : ordinalValue p = ω^ (δ + 1)) (hot : (p : K⟦ℝ⟧).supportOrderType = (ω^ (δ + 1)).val) + {ξ₀ : ℝ} (hξ₀ : ξ₀ < 0) : (cutoffsGE δ p ∩ Set.Iic ξ₀).Finite := by + by_contra hinf + rw [Set.not_finite] at hinf + -- a strictly increasing sequence in `cutoffsGE δ p` bounded by `ξ₀` + let f := hinf.natEmbedding + obtain ⟨g, hg⟩ := (cutoffsGE_isPWO δ p).exists_monotone_subseq + (f := fun n ↦ ((f n : ↥(cutoffsGE δ p ∩ Set.Iic ξ₀)) : ℝ)) fun n ↦ (f n).2.1 + set γ : ℕ → ℝ := fun k ↦ ((f (g k) : ↥(cutoffsGE δ p ∩ Set.Iic ξ₀)) : ℝ) with hγdef + have hmono : StrictMono γ := by + refine Monotone.strictMono_of_injective (fun ⦃_ _⦄ hmn ↦ hg hmn) ?_ + intro m n hmn + exact g.injective (f.injective (Subtype.val_injective hmn)) + have hmem : ∀ k, γ k ∈ cutoffsGE δ p := fun k ↦ (f (g k)).2.1 + have hle : ∀ k, γ k ≤ ξ₀ := fun k ↦ (f (g k)).2.2 + -- support of order type `ω^(δ+1)` below `ξ₀` … + have hbelow : (ω^ (δ + 1)).val ≤ (truncLE ξ₀ (p : K⟦ℝ⟧)).supportOrderType := + NatOrdinal.val.monotone (wpow_add_one_le_supportOrderType_truncLE p γ hmono hmem hle) + -- … and above `ξ₀` + have habove : (ω^ (δ + 1)).val ≤ (truncGT ξ₀ (p : K⟦ℝ⟧)).supportOrderType := by + let r : Series K := ⟨truncGT ξ₀ (p : K⟦ℝ⟧), by + rw [mem_nonpositiveSubring] + exact (support_truncGT_subset ξ₀ _).trans (HahnSeries.Nonpositive.support_subset p)⟩ + have hgerm : toGerm p = toGerm r := by + rw [toGerm_eq_toGerm_iff_exists_coeff_eq] + refine ⟨ξ₀, hξ₀, fun η hη1 _ ↦ ?_⟩ + change _ = (truncGT ξ₀ (p : K⟦ℝ⟧)).coeff η + rw [coeff_truncGT_of_lt hη1] + have := ordinalValue_le_supportOrderType r + rw [← ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (toGerm_eq_toGerm_iff.mp hgerm), + hv] at this + exact NatOrdinal.val.monotone this + have hsplit := supportOrderType_eq_truncLE_add_truncGT ξ₀ (p : K⟦ℝ⟧) + rw [hot] at hsplit + have hpos : 0 < (ω^ (δ + 1)).val := Ordinal.opow_pos _ Ordinal.omega0_pos + exact absurd hsplit (ne_of_lt ((lt_add_of_pos_right _ hpos).trans_le (add_le_add hbelow habove))) + +/-- **Finite initial segments.** For `p` with `v_J(p) = ω^(δ+1)` and support of order type +`ω^(δ+1)` (a principal series of degree `δ + 1`), the cutoffs of `cutoffsGE δ p` below any +`ξ₀ ∈ cutoffsGE δ p` are finitely many. -/ +theorem cutoffsGE_inter_Iic_finite {δ : NatOrdinal} (p : Series K) + (hv : ordinalValue p = ω^ (δ + 1)) (hot : (p : K⟦ℝ⟧).supportOrderType = (ω^ (δ + 1)).val) + {ξ₀ : ℝ} (hξ₀ : ξ₀ ∈ cutoffsGE δ p) : (cutoffsGE δ p ∩ Set.Iic ξ₀).Finite := + cutoffsGE_inter_Iic_finite_of_neg p hv hot hξ₀.1 + +/-- **Finitely many cutoffs of ordinal value at least `ω^δ`.** A series `p` whose support has +order type below `ω^(δ+1)` has only finitely many cutoffs `ξ < 0` with `ω^δ ≤ v_J(p^{|ξ})`. -/ +theorem cutoffsGE_finite_of_supportOrderType_lt {δ : NatOrdinal} (p : Series K) + (hot : (p : K⟦ℝ⟧).supportOrderType < (ω^ (δ + 1)).val) : (cutoffsGE δ p).Finite := by + by_contra hinf + rw [Set.not_finite] at hinf + let f := hinf.natEmbedding + obtain ⟨g, hg⟩ := (cutoffsGE_isPWO δ p).exists_monotone_subseq + (f := fun n ↦ ((f n : ↥(cutoffsGE δ p)) : ℝ)) fun n ↦ (f n).2 + set γ : ℕ → ℝ := fun k ↦ ((f (g k) : ↥(cutoffsGE δ p)) : ℝ) with hγdef + have hmono : StrictMono γ := by + refine Monotone.strictMono_of_injective (fun ⦃_ _⦄ hmn ↦ hg hmn) ?_ + intro m n hmn + exact g.injective (f.injective (Subtype.val_injective hmn)) + have hmem : ∀ k, γ k ∈ cutoffsGE δ p := fun k ↦ (f (g k)).2 + have hle : ∀ k, γ k ≤ 0 := fun k ↦ (mem_cutoffsGE_iff.mp (hmem k)).1.le + have h := wpow_add_one_le_supportOrderType_truncLE p γ hmono hmem hle + have htrunc : truncLE (0 : ℝ) (p : K⟦ℝ⟧) = p := by + ext i + rw [HahnSeries.coeff_truncLE] + split_ifs with hi + · rfl + · by_contra h + exact hi (HahnSeries.Nonpositive.support_subset p + ((HahnSeries.mem_support _ _).mpr fun h0 ↦ h h0.symm)) + rw [htrunc] at h + exact absurd (NatOrdinal.val.monotone h) (not_le.mpr hot) + +/-! ### Enumerating a well-ordered set with finite initial segments -/ + +/-- An infinite well-ordered set of reals with finite initial segments is the range of a strictly +increasing sequence. -/ +theorem exists_strictMono_range_eq {Z : Set ℝ} (hZ : Z.IsPWO) + (hfin : ∀ z ∈ Z, (Z ∩ Set.Iic z).Finite) (hinf : Z.Infinite) : + ∃ γ : ℕ → ℝ, StrictMono γ ∧ Set.range γ = Z := by + classical + have hne : Z.Nonempty := hinf.nonempty + -- the least element of `Z` above a point + let next : ℝ → ℝ := fun x ↦ + if h : (Z ∩ Set.Ioi x).Nonempty then (hZ.isWF.mono Set.inter_subset_left).min h else x + have hnext_mem : ∀ x, (Z ∩ Set.Ioi x).Nonempty → next x ∈ Z ∧ x < next x := fun x h ↦ by + simp only [next, dif_pos h] + exact Set.IsWF.min_mem _ h + have hnext_le : ∀ x, ∀ z ∈ Z, x < z → next x ≤ z := fun x z hz hxz ↦ by + have h : (Z ∩ Set.Ioi x).Nonempty := ⟨z, hz, hxz⟩ + simp only [next, dif_pos h] + exact Set.IsWF.min_le _ h ⟨hz, hxz⟩ + -- every point of `Z` has a point of `Z` above it + have hZne : ∀ x ∈ Z, (Z ∩ Set.Ioi x).Nonempty := fun x hx ↦ by + by_contra hcon + rw [Set.not_nonempty_iff_eq_empty] at hcon + refine hinf ((hfin x hx).subset fun z hz ↦ ⟨hz, ?_⟩) + by_contra hlt + rw [Set.mem_Iic, not_le] at hlt + exact Set.eq_empty_iff_forall_notMem.mp hcon z ⟨hz, hlt⟩ + let γ : ℕ → ℝ := fun k ↦ next^[k] (hZ.isWF.min hne) + have hγsucc : ∀ k, γ (k + 1) = next (γ k) := fun k ↦ Function.iterate_succ_apply' next k _ + have hγmem : ∀ k, γ k ∈ Z := by + intro k + induction k with + | zero => exact Set.IsWF.min_mem _ _ + | succ k ih => + rw [hγsucc] + exact (hnext_mem _ (hZne _ ih)).1 + have hmono : StrictMono γ := strictMono_nat_of_lt_succ fun k ↦ by + rw [hγsucc] + exact (hnext_mem _ (hZne _ (hγmem k))).2 + refine ⟨γ, hmono, Set.Subset.antisymm ?_ fun z hz ↦ ?_⟩ + · rintro _ ⟨k, rfl⟩ + exact hγmem k + · by_contra hz' + -- a point of `Z` missed by the enumeration lies above every term + have hlt : ∀ k, γ k < z := by + intro k + induction k with + | zero => exact lt_of_le_of_ne (Set.IsWF.min_le _ _ hz) fun h ↦ hz' ⟨0, h⟩ + | succ k ih => + rw [hγsucc] + exact lt_of_le_of_ne (hnext_le _ z hz ih) fun h ↦ hz' ⟨k + 1, by rw [hγsucc]; exact h⟩ + exact (hfin z hz).not_infinite ((Set.infinite_range_of_injective hmono.injective).mono + (Set.range_subset_iff.mpr fun k ↦ ⟨hγmem k, (hlt k).le⟩)) + +/-! ### The derivative of a nonzero class vanishes outside a sequence `γ_k ↑ 0` -/ + +/-- A nonzero class in `P_α`, for successor `α`, has a principal representative whose +translated-truncation function is supported on a sequence increasing to zero. -/ +@[blueprint "lem:successor-principal-rv-countable-support" + (phase := "Translated truncations") + (title := "Countable-support representatives of $\\mathrm P_\\alpha$") + (statement := /-- + Let $K$ be a field, let $\alpha=\beta+1<\omega_1$, and let + $0\ne x\in\mathrm P_\alpha$. Then $x$ has a principal representative $p$ + of degree $\alpha$. Let $D_p:\mathbb R\to\mathrm P_\beta$ be the function + used to represent $\partial_\alpha(x)$: whenever + $v_J(p^{|\xi})<\omega^{\beta+1}$, put $D_p(\xi)=[p^{|\xi}]$, and put + $D_p(\xi)=0$ otherwise. There is a strictly increasing sequence of negative + reals $(\gamma_k)_{k\in\mathbb N}$, cofinal in $0$, such that + \[ + \{\xi<0:D_p(\xi)\ne0\}\subseteq + \{\gamma_k:k\in\mathbb N\}. + \] + -/) + (proof := /-- + By \ref{fact:principal-series-representatives}, choose a principal + representative $p$ of $x$ of degree $\alpha$. The set + \[ + Z:=\{\xi<0:D_p(\xi)\ne0\} + \] + is well ordered because a decreasing sequence in $Z$ would induce a + decreasing sequence in $\operatorname{supp}(p)$. By + \ref{lem:finite-successor-value-cutoffs}, each initial segment of $Z$ is + finite. By + \ref{prop:successor-principal-rv-injective}, $D_p$ cannot vanish throughout + any interval $(\eta,0)$, since that would give + $\partial_\alpha(x)=0$ and hence $x=0$. Thus $Z$ is infinite and cofinal in + $0$. Enumerating $Z$ in increasing order gives the required sequence. + -/)] +theorem exists_principal_representative_derivAt (α : NatOrdinal) (hα : 0 < α.constantCoeff) + {x : PrincipalComponent K α} (hx : x ≠ 0) : + ∃ (p : Series K) (hp : ordinalValue p < ω^ (α + 1)), + HahnSeries.Nonpositive.IsPrincipal p ∧ + (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal) ∧ + principalComponentMk α p hp = x ∧ + ∃ γ : ℕ → ℝ, StrictMono γ ∧ (∀ k, γ k < 0) ∧ + (∀ η < (0 : ℝ), ∃ k, η < γ k) ∧ + ∀ ξ, ξ < 0 → derivAt α p ξ ≠ 0 → ∃ k, γ k = ξ := by + classical + obtain ⟨p, hp, hprin, hdeg, hpx⟩ := exists_principal_representative_of_ne_zero α x hx + refine ⟨p, hp, hprin, hdeg, hpx, ?_⟩ + set δ := α.removeNat 1 with hδdef + have hδ : δ + 1 = α := by + have := NatOrdinal.removeNat_add_natCast (a := α) (n := 1) hα + rwa [Nat.cast_one] at this + have hv : ordinalValue p = ω^ (δ + 1) := by + rw [hδ] + exact ordinalValue_eq_wpow_of_principalComponentMk_ne_zero α p hp (hpx ▸ hx) + have hot : (p : K⟦ℝ⟧).supportOrderType = (ω^ (δ + 1)).val := by + rw [hδ] + exact hprin.supportOrderType_eq_wpow_of_degree_eq hdeg + -- the cutoffs where the derivative is nonzero + set Z : Set ℝ := {ξ | ξ < 0 ∧ derivAt α p ξ ≠ 0} with hZdef + have hZsub : Z ⊆ cutoffsGE δ p := by + rintro ξ ⟨hξ0, hξ⟩ + refine ⟨hξ0, ?_⟩ + by_cases h : ordinalValue (translatedTruncation (p : K⟦ℝ⟧) ξ) < ω^ (δ + 1) + · rw [derivAt_eq α p ξ h] at hξ + exact (ordinalValue_eq_wpow_of_principalComponentMk_ne_zero δ _ h hξ).ge + · exact (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one δ)).le.trans (not_lt.mp h) + have hZpwo : Z.IsPWO := (cutoffsGE_isPWO δ p).mono hZsub + have hZfin : ∀ z ∈ Z, (Z ∩ Set.Iic z).Finite := fun z hz ↦ + (cutoffsGE_inter_Iic_finite p hv hot (hZsub hz)).subset + (Set.inter_subset_inter_left _ hZsub) + have hcof : ∀ η < (0 : ℝ), ∃ ξ, η < ξ ∧ ξ < 0 ∧ derivAt α p ξ ≠ 0 := by + intro η hη + by_contra h + push Not at h + have hzero : principalComponentDerivAt K α hα x = 0 := by + rw [← hpx, principalComponentDerivAt_principalComponentMk, + FunAtZeroMinus.coe_eq_zero_iff_exists] + exact ⟨η, hη, h⟩ + apply hx + apply principalComponentDerivAt_injective K α hα + simpa using hzero + have hinf : Z.Infinite := by + intro hfin + rcases Z.eq_empty_or_nonempty with hempty | hne + · obtain ⟨ξ, -, hξ2, hξ3⟩ := hcof (-1) (by norm_num) + exact Set.eq_empty_iff_forall_notMem.mp hempty ξ ⟨hξ2, hξ3⟩ + · obtain ⟨m, hm, hmax⟩ := Set.exists_max_image Z id hfin hne + obtain ⟨ξ, hξ1, hξ2, hξ3⟩ := hcof m hm.1 + exact absurd (hmax ξ ⟨hξ2, hξ3⟩) (not_le.mpr hξ1) + obtain ⟨γ, hmono, hrange⟩ := exists_strictMono_range_eq hZpwo hZfin hinf + have hγZ : ∀ k, γ k ∈ Z := fun k ↦ hrange ▸ Set.mem_range_self k + refine ⟨γ, hmono, fun k ↦ (hγZ k).1, fun η hη ↦ ?_, fun ξ hξ0 hξ ↦ ?_⟩ + · obtain ⟨ξ, hξ1, hξ2, hξ3⟩ := hcof η hη + have hξZ : ξ ∈ Z := ⟨hξ2, hξ3⟩ + rw [← hrange] at hξZ + obtain ⟨k, hk⟩ := hξZ + exact ⟨k, hk ▸ hξ1⟩ + · have hξZ : ξ ∈ Z := ⟨hξ0, hξ⟩ + rwa [← hrange] at hξZ + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/OrdinalValueCutoffs.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/OrdinalValueCutoffs.lean new file mode 100644 index 0000000000..9d9268e263 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/OrdinalValueCutoffs.lean @@ -0,0 +1,379 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OmegaSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationPolynomial +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Components +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportSupremum +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ + +/-! +# Ordinal-value bounds at translated-truncation cutoffs + +For a series `D` and an ordinal `ρ`, consider the cutoffs `ξ < 0` at which the translated +truncation `D^{|ξ}` has ordinal value at least `ω^ρ`. Two +facts drive the induction over degrees by cutting into pieces: a series whose support has order +type below `ω^(ρ+1)` has finitely many cutoffs with `ω^ρ ≤ v_J(D^{|ξ})` +(`cutoffsGE_finite_of_supportOrderType_lt`), and, conversely, a series supported in `(c, 0]` whose +support has order type at least `ω^ρ` has a cutoff `ξ ∈ (c, 0]` with `ω^ρ ≤ v_J(D^{|ξ})`: the +supremum of an initial segment of the support of order type `ω^ρ`. + +We also record how the class of a series `u ∈ J_{ω^(β+1)}` in `P_β` is read off its polynomial +when evaluation is injective below `α`: it is `pol(u)_β(𝓑)`, the evaluation of the degree-`β` +component of `pol(u)`. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial OrdinalGraded + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- If the support of `D` has order type at least `ω^ρ` with `ρ ≠ 0`, then at some cutoff `ξ ≤ 0`, +at or above some support point, the ordinal value of `D` is at least `ω^ρ`: +`ω^ρ ≤ v_J(D^{|ξ})`. -/ +@[blueprint "lem:cutoff-detects-support-order" + (phase := "Translated truncations") + (title := "Detection of support order type by a translated truncation") + (statement := /-- + Let $K$ be a field, let $b\in K((\mathbb R^{\le0}))$, and let + $\rho<\omega_1$ be nonzero. If + \[ + \operatorname{ot}(\operatorname{supp}(b))\ge\omega^\rho, + \] + then there are $\xi\le0$ and $y\in\operatorname{supp}(b)$ such that + $y\le\xi$ and + \[ + v_J(b^{|\xi})\ge\omega^\rho. + \] + -/) + (proof := /-- + Choose an initial segment $B$ of $\operatorname{supp}(b)$ of order type + $\omega^\rho$, and let $\xi=\sup B$. Then $\xi\le0$ and lies above every point of the + nonempty set $B$. + + Since $\rho\ne0$, the ordinal $\omega^\rho$ is additively principal and at least $\omega$. + For every $\theta<\xi$, the part of $B$ above $\theta$ still has order type + $\omega^\rho$. At most one of its points is at or above $\xi$, so its part in + $(\theta,\xi)$ also has order type at least $\omega^\rho$. Thus every support interval + immediately below $\xi$ has order type at least $\omega^\rho$, which gives + $v_J(b^{|\xi})\ge\omega^\rho$. + -/)] +theorem exists_le_wpow_le_ordinalValue_translatedTruncation_of_le_supportOrderType (D : Series K) + {ρ : NatOrdinal} (hρ : ρ ≠ 0) (hot : (ω^ ρ).val ≤ (D : K⟦ℝ⟧).supportOrderType) : + ∃ ξ, ξ ≤ 0 ∧ (∃ y ∈ (D : K⟦ℝ⟧).support, y ≤ ξ) ∧ + ω^ ρ ≤ ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ξ) := by + classical + -- an initial segment `S₀` of the support of order type exactly `ω^ρ` + obtain ⟨D₀, hD₀sub, hD₀ot⟩ : ∃ D₀ : K⟦ℝ⟧, D₀.support ⊆ (D : K⟦ℝ⟧).support ∧ + D₀.supportOrderType = (ω^ ρ).val := by + rcases hot.lt_or_eq with hlt | heq + · rw [supportOrderType_eq_setOrderType] at hlt + obtain ⟨x, _, hx⟩ := Set.IsPWO.exists_orderType_inter_Iio_eq _ hlt + refine ⟨truncLT x (D : K⟦ℝ⟧), support_truncLT_subset x _, ?_⟩ + rw [supportOrderType_eq_setOrderType] + rw [← hx] + apply Set.IsPWO.orderType_congr + rw [support_truncLT] + ext y + simp [and_comm] + · exact ⟨D, le_rfl, heq.symm⟩ + have hne : D₀.support.Nonempty := by + rw [Set.nonempty_iff_ne_empty] + intro h + have h0 : D₀.supportOrderType = 0 := by + rw [supportOrderType_eq_setOrderType] + exact (Set.IsPWO.orderType_eq_zero _).mpr h + rw [h0] at hD₀ot + exact absurd hD₀ot.symm (ne_of_gt (Ordinal.opow_pos _ Ordinal.omega0_pos)) + have hbdd : BddAbove D₀.support := + ⟨0, fun y hy ↦ HahnSeries.Nonpositive.support_subset D (hD₀sub hy)⟩ + -- `ξ`, the supremum of `S₀` + set ξ := sSup D₀.support with hξdef + have hξle : ξ ≤ 0 := csSup_le hne fun y hy ↦ HahnSeries.Nonpositive.support_subset D (hD₀sub hy) + have hyξ : ∃ y ∈ (D : K⟦ℝ⟧).support, y ≤ ξ := by + obtain ⟨y, hy⟩ := hne + exact ⟨y, hD₀sub hy, le_csSup hbdd hy⟩ + refine ⟨ξ, hξle, hyξ, ?_⟩ + have hprin : Ordinal.IsPrincipal (· + ·) (ω^ ρ).val := by + rw [NatOrdinal.val_wpow] + exact Ordinal.isPrincipal_add_omega0_opow _ + have hω : Ordinal.omega0 ≤ (ω^ ρ).val := by + rw [NatOrdinal.val_wpow] + exact Ordinal.left_le_opow _ (pos_iff_ne_zero.mpr (by simpa using hρ)) + -- the support on every interval `(θ, ξ)` has order type at least `ω^ρ` + have htail : ∀ θ, θ < ξ → (ω^ ρ).val ≤ ((D : K⟦ℝ⟧).isPWO_support.mono + (s := (D : K⟦ℝ⟧).support ∩ Set.Ioo θ ξ) Set.inter_subset_left).orderType := by + intro θ hθ + -- the part of `S₀` above `θ` has order type `ω^ρ` + have hsplit := supportOrderType_eq_truncLE_add_truncGT θ D₀ + rw [hD₀ot] at hsplit + obtain ⟨y, hy, hθy⟩ := exists_lt_of_lt_csSup hne hθ + have hpos : (truncGT θ D₀).supportOrderType ≠ 0 := by + rw [supportOrderType_eq_setOrderType, Ne, Set.IsPWO.orderType_eq_zero, support_truncGT] + exact Set.nonempty_iff_ne_empty.mp ⟨y, hy, hθy⟩ + have hlow : (truncLE θ D₀).supportOrderType < (ω^ ρ).val := by + by_contra hge + rw [not_lt] at hge + have : (ω^ ρ).val < (truncLE θ D₀).supportOrderType + (truncGT θ D₀).supportOrderType := + lt_of_lt_of_le (lt_add_of_pos_right _ (pos_iff_ne_zero.mpr hpos)) + (add_le_add hge le_rfl) + rw [← hsplit] at this + exact lt_irrefl _ this + have hhigh : (truncGT θ D₀).supportOrderType = (ω^ ρ).val := by + refine le_antisymm (by rw [hsplit]; exact le_add_self) (le_of_not_gt fun hlt ↦ ?_) + have := hprin hlow hlt + beta_reduce at this + rw [← hsplit] at this + exact lt_irrefl _ this + -- split the part above `θ` at `ξ`: at most one point is at or above `ξ` + set E := truncGT θ D₀ with hEdef + have hsplitE := supportOrderType_eq_truncLT_add_truncGE ξ E + rw [hhigh] at hsplitE + have hfin : (truncGE ξ E).supportOrderType < Ordinal.omega0 := by + rw [supportOrderType_eq_setOrderType, ← Set.IsPWO.finite_iff_orderType_lt_omega] + refine (Set.finite_singleton ξ).subset fun z hz ↦ ?_ + rw [support_truncGE] at hz + have hzξ : z ≤ ξ := le_csSup hbdd (support_truncGT_subset θ _ hz.1) + exact le_antisymm hzξ hz.2 + have hA : (ω^ ρ).val ≤ (truncLT ξ E).supportOrderType := by + by_contra hlt + rw [not_le] at hlt + have := hprin hlt (hfin.trans_le hω) + beta_reduce at this + rw [← hsplitE] at this + exact lt_irrefl _ this + refine hA.trans ?_ + rw [supportOrderType_eq_setOrderType] + refine Set.IsPWO.orderType_mono _ _ fun z hz ↦ ?_ + rw [support_truncLT, hEdef, support_truncGT] at hz + exact ⟨hD₀sub hz.1.1, hz.1.2, hz.2⟩ + have := le_ordinalValue_translatedTruncation_of_forall_le_orderType (D : K⟦ℝ⟧) ξ htail + rwa [NatOrdinal.of_val] at this + +/-- For a series supported in `(c, 0]` whose support has order type at least `ω^ρ`, `ρ ≠ 0`, there +is a cutoff `ξ ∈ (c, 0]` with `ω^ρ ≤ v_J(D^{|ξ})`. -/ +@[blueprint "lem:cutoff-detects-support-order-in-interval" + (phase := "Translated truncations") + (title := "Detection of interval support order type by a translated truncation") + (statement := /-- + Let $K$ be a field, let $b\in K((\mathbb R^{\le0}))$, let $c\in\mathbb R$, + and let $\rho<\omega_1$ be nonzero. If + \[ + \operatorname{supp}(b)\subseteq(c,0],\qquad + \operatorname{ot}(\operatorname{supp}(b))\ge\omega^\rho, + \] + then there is $\xi\in(c,0]$ such that + $v_J(b^{|\xi})\ge\omega^\rho$. + -/) + (proof := /-- + Apply \ref{lem:cutoff-detects-support-order}. Its cutoff $\xi$ lies above a point + $y\in\operatorname{supp}(b)$. Since $c deg B'`. Each `∂F/∂X_B` is +homogeneous of degree `σ_B := α ⊖ deg B`. + +* Every `σ_B` is a nonzero limit ordinal; `λ' < ω^β`, `τ + 1 < α ⊖ deg B'`, and + `α' = τ ⊕ deg B'`. +* If `σ_B ≼ α ⊖ deg B'`—equivalently, `deg B' ≼ deg B`—then the separation condition holds for + `((α ⊖ deg B') ⊖ σ_B, σ_B, τ)`. When the low-degree part equals `α_{<β}`, + `(σ_B)_{<β} = 0` and the last term of `σ_B` has exponent `ε ≥ β`; otherwise, + `(λ₀)_{≥ε} = (α_{<β})_{≥ε}` at the exponent `ε` of the last term of `(σ_B)_{<β}`; in both + cases `(α ⊖ deg B')_{≥ε} ≤ τ`. +* If `σ_B \not\preccurlyeq α ⊖ deg B'`, it precedes no degree + `e ∈ [τ, α ⊖ deg B')`, so `∂F/∂X_B` contributes nothing to the components of those degrees of an + element of the ideal (`componentsGE_mem_span_subtype`). +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial OrdinalGraded DirectSum + +public noncomputable section + +namespace Berarducci + +section Dropping + +variable {σ : Type*} {K : Type v} [Field K] (wt : σ → NatOrdinal) + +/-- **Generators contributing nothing in `[τ, h)`.** If the components of degree at least `τ` of +`P` lie in the ideal of the homogeneous generators `q j`, of degrees `c j`, `P` has degree below +`h`, and for every generator outside `A` the degree `c j` precedes no degree +`e ∈ [τ, h)`, then those components lie in the ideal of the generators in `A`. -/ +theorem componentsGE_mem_span_subtype {ι : Type w} [Finite ι] {q : ι → MvPolynomial σ K} + {c : ι → NatOrdinal} (hq : ∀ j, IsWeightedHomogeneous wt (q j) (c j)) {P : MvPolynomial σ K} + {τ h : NatOrdinal} (hP : componentsGE wt τ P ∈ Ideal.span (Set.range q)) + (hdeg : DegreeLT wt P h) (A : ι → Prop) + (hdrop : ∀ j, ¬ A j → ∀ e, τ ≤ e → e < h → ¬ ∃ β, β + c j = e) : + componentsGE wt τ P ∈ Ideal.span (Set.range fun j : {j // A j} ↦ q j.1) := by + classical + cases nonempty_fintype ι + letI := weightedGradedAlgebra K wt + have hdec : ∀ (R : MvPolynomial σ K) (e : NatOrdinal), + (DirectSum.decompose (weightedHomogeneousSubmodule K wt) R e : MvPolynomial σ K) = + weightedHomogeneousComponent wt e R := fun R e ↦ by + rw [← decompose'_apply] + rfl + rw [componentsGE_eq_sum_weightedHomogeneousComponent] + refine Ideal.sum_mem _ fun e he ↦ ?_ + obtain ⟨he', hτe⟩ := Finset.mem_filter.mp he + obtain ⟨d, hd, rfl⟩ := Finset.mem_image.mp he' + have heh : Finsupp.weight wt d < h := degreeLT_iff.mp hdeg d hd + have hmem : weightedHomogeneousComponent wt (Finsupp.weight wt d) P ∈ Ideal.span (Set.range q) := + weightedHomogeneousComponent_mem_span_of_componentsGE_mem wt hq hP hτe + obtain ⟨u, -, hu0, hsum⟩ := exists_decompose_eq_sum_mul_of_mem_span + (𝒜 := weightedHomogeneousSubmodule K wt) + (fun j ↦ (mem_weightedHomogeneousSubmodule _ _ _ _).mpr (hq j)) hmem (Finsupp.weight wt d) + rw [hdec] at hsum + have hcomp : weightedHomogeneousComponent wt (Finsupp.weight wt d) + (weightedHomogeneousComponent wt (Finsupp.weight wt d) P) = + weightedHomogeneousComponent wt (Finsupp.weight wt d) P := by + rw [weightedHomogeneousComponent_of_mem (weightedHomogeneousComponent_mem wt P _), if_pos rfl] + rw [← hcomp, hsum] + rw [← Finset.sum_filter_add_sum_filter_not Finset.univ A] + have hzero : ∑ j ∈ Finset.univ.filter (fun j ↦ ¬ A j), q j * u j = 0 := + Finset.sum_eq_zero fun j hj ↦ by + rw [hu0 j (hdrop j (Finset.mem_filter.mp hj).2 _ hτe heh), mul_zero] + rw [hzero, add_zero] + exact Ideal.sum_mem _ fun j hj ↦ Ideal.mul_mem_right _ _ + (Ideal.subset_span ⟨⟨j, (Finset.mem_filter.mp hj).2⟩, rfl⟩) + +end Dropping + +variable {K : Type v} [Field K] {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +namespace Lifts.LimitOrdinalRelationAtCutoff + +variable {σ : Lifts wt x} {α : NatOrdinal} (S : σ.LimitOrdinalRelationAtCutoff α) + (hx : IsMinimalSystem (Berarducci.principalGrading K) wt x) +include S hx + +/-! ### The degree `σ_B = α ⊖ deg B` of `∂F/∂X_B` -/ + +theorem α_constantCoeff : α.constantCoeff = 0 := by + have h := congrArg NatOrdinal.constantCoeff S.hdegHD + rw [NatOrdinal.constantCoeff_add, NatOrdinal.constantCoeff_nsmul, S.vars_limit _ S.mem, + mul_zero, add_zero] at h + rw [← h, ← NatOrdinal.partGE_eq_self_of_forall_le S.degHD_terms, + NatOrdinal.constantCoeff_partGE (S.β_ne_zero hx)] + +section Cofactor + +variable {v : ι} (hv : v ∈ S.F.vars) {c : NatOrdinal} (hc : c + wt v = α) +include hv hc + +omit hx in +/-- The degree `σ_B := α ⊖ deg B` of `∂F/∂X_B` (the binder `c`, with `c ⊕ wt v = α`) is +nonzero. -/ +theorem cdeg_ne_zero : c ≠ 0 := by + rintro rfl + rw [zero_add] at hc + exact (S.vars_lt v hv).ne hc + +omit hv in +/-- The degree `σ_B` is a limit. -/ +theorem cdeg_constantCoeff : c.constantCoeff = 0 := by + have h := congrArg NatOrdinal.constantCoeff hc + rw [NatOrdinal.constantCoeff_add, S.α_constantCoeff hx] at h + omega + +omit hx hv in +/-- `∂F/∂X_B` is homogeneous of degree `σ_B`. -/ +theorem pderiv_hom : IsWeightedHomogeneous wt (pderiv v S.F) c := + isWeightedHomogeneous_pderiv wt S.hom v hc + +omit hx hv in +/-- `(σ_B)_{<β} ⊕ (deg B)_{<β} = α_{<β}`. -/ +theorem partLT_cdeg_add_degLT : NatOrdinal.partLT S.β c + S.degLT v = S.αLT := by + have e : NatOrdinal.partLT S.β α = NatOrdinal.partLT S.β (c + wt v) := congrArg _ hc.symm + rw [S.αLT_def, e, NatOrdinal.partLT_add, S.degLT_def] + +omit hx hv in +theorem partGE_cdeg_add : + NatOrdinal.partGE S.β c + NatOrdinal.partGE S.β (wt v) = S.αGE := by + have e : NatOrdinal.partGE S.β α = NatOrdinal.partGE S.β (c + wt v) := congrArg _ hc.symm + rw [S.αGE_def, e, NatOrdinal.partGE_add] + +omit hx hv in +/-- If the low-degree part of `B` equals `α_{<β}`, then `(σ_B)_{<β} = 0`. -/ +theorem partLT_cdeg_eq_zero_of_lowDegreePartEq (htop : S.LowDegreePartEq v) : + NatOrdinal.partLT S.β c = 0 := by + have h := S.partLT_cdeg_add_degLT hc + rw [(S.lowDegreePartEq_iff v).mp htop] at h + exact add_eq_right.mp h + +omit hx hv in +theorem partGE_cdeg_eq_self_of_lowDegreePartEq (htop : S.LowDegreePartEq v) : + NatOrdinal.partGE S.β c = c := by + have := NatOrdinal.partGE_add_partLT S.β c + rwa [S.partLT_cdeg_eq_zero_of_lowDegreePartEq hc htop, add_zero] at this + +omit hx hv in +/-- If the low-degree part of `B` is not `α_{<β}`, then `(σ_B)_{<β} ≠ 0`. -/ +theorem partLT_cdeg_ne_zero (htop : ¬ S.LowDegreePartEq v) : NatOrdinal.partLT S.β c ≠ 0 := by + intro h + have h' := S.partLT_cdeg_add_degLT hc + rw [h, zero_add] at h' + exact htop ((S.lowDegreePartEq_iff v).mpr h') + +end Cofactor + +/-! ### The degree `τ` when the low-degree part precedes `λ₀` -/ + +section Tau + +variable {v' : ι} {h : NatOrdinal} (hh : h + wt v' = α) {lam' : NatOrdinal} + (hlam' : S.degLT v' + lam' = S.lam₀) +include hlam' + +omit hx in +theorem lam'_lt_wpow : lam' < ω^ S.β := + (le_add_of_nonneg_left zero_le).trans_lt (hlam' ▸ S.lam₀_lt_wpow) + +omit hx in +theorem partGE_τ (h : NatOrdinal) : + NatOrdinal.partGE S.β (NatOrdinal.partGE S.β h + lam') = + NatOrdinal.partGE S.β h := by + rw [NatOrdinal.partGE_add, NatOrdinal.partGE_partGE, + NatOrdinal.partGE_eq_zero_of_lt (S.lam'_lt_wpow hlam'), add_zero] + +omit hx in +theorem partLT_τ (h : NatOrdinal) : + NatOrdinal.partLT S.β (NatOrdinal.partGE S.β h + lam') = lam' := by + have := NatOrdinal.partGE_add_partLT S.β (NatOrdinal.partGE S.β h + lam') + rw [S.partGE_τ hlam' h] at this + exact add_left_cancel this + +include hh + +omit hx hlam' in +/-- `(α ⊖ deg B')_{<β} ⊕ (deg B')_{<β} = α_{<β}` (the binder `h` is `α ⊖ deg B'`). -/ +theorem partLT_h_add_degLT : NatOrdinal.partLT S.β h + S.degLT v' = S.αLT := + S.partLT_cdeg_add_degLT hh + +omit hx in +/-- `λ' < (α ⊖ deg B')_{<β}`. -/ +theorem lam'_lt_partLT_h : lam' < NatOrdinal.partLT S.β h := by + have h1 := S.partLT_h_add_degLT hh + have h2 : S.degLT v' + lam' < S.degLT v' + NatOrdinal.partLT S.β h := by + rw [hlam', add_comm _ (NatOrdinal.partLT S.β h), h1] + rw [S.αLT_def]; exact S.lam₀_lt + exact lt_of_add_lt_add_left h2 + +/-- `τ + 1 < α ⊖ deg B'`. -/ +theorem τ_add_one_lt : NatOrdinal.partGE S.β h + lam' + 1 < h := by + have hlt := S.lam'_lt_partLT_h hh hlam' + have hcc : (NatOrdinal.partLT S.β h).constantCoeff = 0 := by + rw [NatOrdinal.constantCoeff_partLT (S.β_ne_zero hx)] + have := congrArg NatOrdinal.constantCoeff hh + rw [NatOrdinal.constantCoeff_add, S.α_constantCoeff hx] at this + omega + have h1 : lam' + 1 < NatOrdinal.partLT S.β h := by + refine lt_of_le_of_ne (Order.add_one_le_of_lt hlt) fun heq ↦ ?_ + have := congrArg NatOrdinal.constantCoeff heq + rw [hcc, show lam' + 1 = lam' + ((1 : ℕ) : NatOrdinal) by rw [Nat.cast_one], + NatOrdinal.constantCoeff_add_natCast] at this + omega + conv_rhs => rw [← NatOrdinal.partGE_add_partLT S.β h] + rw [add_assoc] + exact add_lt_add_right h1 _ + +omit hx in +/-- `α' = α_{≥β} ⊕ λ₀ = τ ⊕ deg B'`. -/ +theorem αGE_add_lam₀_eq : S.αGE + S.lam₀ = NatOrdinal.partGE S.β h + lam' + wt v' := by + have e : NatOrdinal.partGE S.β α = NatOrdinal.partGE S.β (h + wt v') := + congrArg _ hh.symm + rw [← hlam', S.αGE_def, e, NatOrdinal.partGE_add] + conv_rhs => rw [← S.partGE_add_degLT v'] + abel + +omit hx hh in +/-- Every degree `e ∈ [τ, α ⊖ deg B')` has the same part at or above `β` as `α ⊖ deg B'`. -/ +theorem partGE_eq_of_τ_le {e : NatOrdinal} + (hτe : NatOrdinal.partGE S.β h + lam' ≤ e) (heh : e < h) : + NatOrdinal.partGE S.β e = NatOrdinal.partGE S.β h := + le_antisymm (NatOrdinal.partGE_mono heh.le) (by + have := NatOrdinal.partGE_mono (β := S.β) hτe + rwa [S.partGE_τ hlam' h] at this) + +end Tau + +/-! ### The separation condition (n) at the generators considered at `B'` -/ + +section PartialDerivativeIndices + +variable {v : ι} (hv : v ∈ S.F.vars) {c : NatOrdinal} (hc : c + wt v = α) + {v' : ι} {h : NatOrdinal} (hh : h + wt v' = α) {lam' : NatOrdinal} + (hlam' : S.degLT v' + lam' = S.lam₀) +include hv hc hh hlam' + +omit hx hh hlam' in +/-- If the low-degree part of `B` equals `α_{<β}` and `ω^ε` is the last term of `σ_B`, then +`ε ≥ β`, so `h_{≥ε} ≤ h_{≥β} ⊕ λ'` for every ordinal `h`. -/ +theorem partGE_le_τ_of_lowDegreePartEq (htop : S.LowDegreePartEq v) {ε : NatOrdinal} + (hε : NatOrdinal.leastTerm c = ω^ ε) (h : NatOrdinal) : + NatOrdinal.partGE ε h ≤ NatOrdinal.partGE S.β h + lam' := by + have hβε : S.β ≤ ε := by + have h1 := NatOrdinal.wpow_le_leastTerm_partGE (β := S.β) (a := c) + (by rw [S.partGE_cdeg_eq_self_of_lowDegreePartEq hc htop]; exact S.cdeg_ne_zero hv hc) + rw [S.partGE_cdeg_eq_self_of_lowDegreePartEq hc htop, hε, NatOrdinal.wpow_le_wpow] at h1 + exact h1 + exact (NatOrdinal.partGE_le_partGE_of_le hβε h).trans (le_add_of_nonneg_right zero_le) + +omit hv in +/-- If the proper low-degree part of `B` does not precede `λ₀` and `ω^ε` is the last term of +`(σ_B)_{<β}`, then `(α ⊖ deg B')_{≥ε} ≤ τ`. -/ +theorem partGE_le_τ_of_hasProperLowDegreePartNotAlgebraicLE + (hL : S.HasProperLowDegreePartNotAlgebraicLE v) {ε : NatOrdinal} + (hε : NatOrdinal.leastTerm (NatOrdinal.partLT S.β c) = ω^ ε) : + NatOrdinal.partGE ε h ≤ NatOrdinal.partGE S.β h + lam' := by + have hεβ : ε ≤ S.β := by + have h1 := NatOrdinal.leastTerm_le + (S.partLT_cdeg_ne_zero hc + ((S.hasProperLowDegreePartNotAlgebraicLE_iff v).mp hL).2.2.1) + rw [hε] at h1 + exact (NatOrdinal.wpow_lt_wpow.mp (h1.trans_lt (NatOrdinal.partLT_lt _ _))).le + -- `(λ₀)_{≥ε} = (α_{<β})_{≥ε}` + have h5 := S.partGE_lam₀_eq_of_hasProperLowDegreePartNotAlgebraicLE + hx hL (S.partLT_cdeg_add_degLT hc) hε + -- `λ'_{≥ε} = ((α ⊖ deg B')_{<β})_{≥ε}` + have hlamε : NatOrdinal.partGE ε lam' = + NatOrdinal.partGE ε (NatOrdinal.partLT S.β h) := by + have e1 := congrArg (NatOrdinal.partGE ε) hlam' + have e2 := congrArg (NatOrdinal.partGE ε) (S.partLT_h_add_degLT hh) + rw [NatOrdinal.partGE_add] at e1 e2 + rw [h5, ← e2, add_comm (NatOrdinal.partGE ε (NatOrdinal.partLT S.β h))] at e1 + exact add_left_cancel e1 + calc NatOrdinal.partGE ε h + = NatOrdinal.partGE ε (NatOrdinal.partGE S.β h) + + NatOrdinal.partGE ε (NatOrdinal.partLT S.β h) := by + conv_lhs => rw [← NatOrdinal.partGE_add_partLT S.β h] + rw [NatOrdinal.partGE_add] + _ = NatOrdinal.partGE S.β h + NatOrdinal.partGE ε lam' := by + rw [NatOrdinal.partGE_partGE_of_ge hεβ, hlamε] + _ ≤ NatOrdinal.partGE S.β h + lam' := add_le_add_right (NatOrdinal.partGE_le _ _) _ + +omit hx hv hh in +/-- If the low-degree part of `B` equals `α_{<β}` and +`σ_B \not\preccurlyeq α ⊖ deg B'`, then `σ_B` precedes no degree in +`[τ, α ⊖ deg B')` in the algebraic order. -/ +theorem not_algebraicLE_of_lowDegreePartEq_of_not (htop : S.LowDegreePartEq v) + (hdrop : ¬ NatOrdinal.AlgebraicLE c h) + {e : NatOrdinal} (hτe : NatOrdinal.partGE S.β h + lam' ≤ e) (heh : e < h) : + ¬ NatOrdinal.AlgebraicLE c e := by + intro hce + apply hdrop + have h1 := hce.partGE S.β + rw [S.partGE_eq_of_τ_le hlam' hτe heh, + S.partGE_cdeg_eq_self_of_lowDegreePartEq hc htop] at h1 + exact h1.trans (NatOrdinal.algebraicLE_partGE _ _) + +omit hv in +/-- If the proper low-degree part of `B` does not precede `λ₀` and +`σ_B \not\preccurlyeq α ⊖ deg B'`, then `σ_B` precedes no degree in +`[τ, α ⊖ deg B')` in the algebraic order. -/ +theorem not_algebraicLE_of_hasProperLowDegreePartNotAlgebraicLE_of_not + (hL : S.HasProperLowDegreePartNotAlgebraicLE v) + (hdrop : ¬ NatOrdinal.AlgebraicLE c h) + {e : NatOrdinal} (hτe : NatOrdinal.partGE S.β h + lam' ≤ e) (heh : e < h) : + ¬ NatOrdinal.AlgebraicLE c e := by + intro hce + apply hdrop + have hGE := S.partGE_eq_of_τ_le hlam' hτe heh + -- the parts at or above `β` + have h1 : NatOrdinal.AlgebraicLE (NatOrdinal.partGE S.β c) (NatOrdinal.partGE S.β h) := by + have := hce.partGE S.β + rwa [hGE] at this + -- the parts below `β`: `s := e_{<β} ∈ [λ', (α ⊖ deg B')_{<β})` + set s := NatOrdinal.partLT S.β e with hsdef + have hlamεs : lam' ≤ s := by + have h2 : NatOrdinal.partGE S.β h + lam' ≤ NatOrdinal.partGE S.β h + s := by + calc NatOrdinal.partGE S.β h + lam' ≤ e := hτe + _ = NatOrdinal.partGE S.β e + NatOrdinal.partLT S.β e := + (NatOrdinal.partGE_add_partLT S.β e).symm + _ = NatOrdinal.partGE S.β h + s := by rw [hGE] + exact le_of_add_le_add_left h2 + have hsh : s < NatOrdinal.partLT S.β h := + NatOrdinal.partLT_lt_of_lt_of_partGE_eq heh hGE + -- the exponent `ε` of the last term of `(σ_B)_{<β}` + obtain ⟨ε, hε⟩ := + NatOrdinal.exists_leastTerm_eq_wpow + (S.partLT_cdeg_ne_zero hc + ((S.hasProperLowDegreePartNotAlgebraicLE_iff v).mp hL).2.2.1) + have h5 := S.partGE_lam₀_eq_of_hasProperLowDegreePartNotAlgebraicLE + hx hL (S.partLT_cdeg_add_degLT hc) hε + have hlamε : NatOrdinal.partGE ε lam' = + NatOrdinal.partGE ε (NatOrdinal.partLT S.β h) := by + have e1 := congrArg (NatOrdinal.partGE ε) hlam' + have e2 := congrArg (NatOrdinal.partGE ε) (S.partLT_h_add_degLT hh) + rw [NatOrdinal.partGE_add] at e1 e2 + rw [h5, ← e2, add_comm (NatOrdinal.partGE ε (NatOrdinal.partLT S.β h))] at e1 + exact add_left_cancel e1 + have hs : NatOrdinal.partGE ε s = NatOrdinal.partGE ε (NatOrdinal.partLT S.β h) := + le_antisymm (NatOrdinal.partGE_mono hsh.le) + (hlamε ▸ NatOrdinal.partGE_mono hlamεs) + -- `(σ_B)_{<β}`, all of whose terms are at least `ω^ε`, precedes `s`, hence precedes + -- `(α ⊖ deg B')_{<β}` + have h2 : NatOrdinal.AlgebraicLE (NatOrdinal.partLT S.β c) (NatOrdinal.partLT S.β h) := by + have h3 := (hce.partLT S.β).partGE ε + rw [NatOrdinal.partGE_eq_self_of_leastTerm_eq + (S.partLT_cdeg_ne_zero hc + ((S.hasProperLowDegreePartNotAlgebraicLE_iff v).mp hL).2.2.1) hε, + ← hsdef, hs] at h3 + exact h3.trans (NatOrdinal.algebraicLE_partGE _ _) + exact NatOrdinal.algebraicLE_of_partGE_of_partLT h1 h2 + +end PartialDerivativeIndices + +end Lifts.LimitOrdinalRelationAtCutoff + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Partials.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Partials.lean new file mode 100644 index 0000000000..229e821adf --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Partials.lean @@ -0,0 +1,415 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartVars + +public import + LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PartialDerivativeIndices +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.IdealFromTruncations + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Partial derivatives and algebraic order of low-degree parts + +When `(deg B')_{<β} ≼ λ₀` in the algebraic order, + +`∂F/∂X_{B'} = ∑_B (∂F/∂X_B) U_B` + +over finitely many variables `B`: those whose low-degree part is all of `α_{<β}`, or larger +variables whose proper low-degree part does not precede `λ₀`. Moreover `∂U_B/∂X_{B₀} = 0`. + +*Proof*, by induction on the number of variables of `F` of degree above `deg B'`. Put +`λ' := λ₀ ⊖ (deg B')_{<β}` and `τ := (α ⊖ deg B')_{≥β} ⊕ λ'`. For all `γ < 0` +sufficiently close to `0`, the part at or above `τ` of +`pol((∂F/∂X_{B'})(b_𝓑)^{|γ})` lies in the ideal of the +`∂F/∂X_B` over the variables `B` of `F` with `deg B > deg B'` +(`exists_forall_componentsGE_pol_translatedTruncation_aeval_pderiv_mem`). A variable above `B'` +has a low-degree part equal to `α_{<β}`, outside the algebraic bound `λ₀`, or preceding `λ₀`; in +the last case `∂F/∂X_B` already lies in the ideal by induction. Among the retained derivatives, +those whose degree `σ_B ≼ α ⊖ deg B'` satisfy (n) against `τ`, and the others contribute nothing +in `[τ, α ⊖ deg B')`; so the translated truncations of +`(∂F/∂X_{B'})(b_𝓑)` satisfy (p) for the retained generators and `τ`, and ideal membership +of a +class from the condition (p) on its translated truncations +(`IsPrincipal.of_principalComponentMk_mem_span_of_forall_componentsGE_mem`) gives the class of +`(∂F/∂X_{B'})(b_𝓑)` in `P_{α ⊖ deg B'}` as a combination of the generators with +homogeneous +cofactors. Polynomial preimages of the cofactors and injectivity below `α` turn this into the +polynomial identity; the cofactors have degree below `δ = deg B₀`, so `∂U_B/∂X_{B₀} = 0`. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial OrdinalGraded + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +namespace Lifts.LimitOrdinalRelationAtCutoff + +variable {σ : Lifts wt x} {α : NatOrdinal} (S : σ.LimitOrdinalRelationAtCutoff α) + (hx : IsMinimalSystem (principalGrading K) wt x) (hinj : ∀ β < α, InjectiveAt K wt x β) + (hσ : σ.IsPrincipal) +include S hx hinj hσ + +/-- A variable contributes to the derivative at `v'` when its low-degree part is all of +`α_{<β}`, or when it is larger than `v'` and its proper low-degree part does not precede `λ₀`. -/ +def ContributesToPartialDerivativeAt (v' v : ι) : Prop := + v ∈ S.F.vars ∧ + (S.LowDegreePartEq v ∨ (S.HasProperLowDegreePartNotAlgebraicLE v ∧ wt v' < wt v)) + +omit hx hinj hσ in +theorem contributesToPartialDerivativeAt_iff (v' v : ι) : + S.ContributesToPartialDerivativeAt v' v ↔ + v ∈ S.F.vars ∧ + (S.LowDegreePartEq v ∨ (S.HasProperLowDegreePartNotAlgebraicLE v ∧ wt v' < wt v)) := + (Iff.rfl) + +omit hx hinj hσ in +theorem finite_setOf_contributesToPartialDerivativeAt (v' : ι) : + Finite {v // S.ContributesToPartialDerivativeAt v' v} := + (S.F.vars.finite_toSet.subset fun v + (hv : S.ContributesToPartialDerivativeAt v' v) ↦ hv.1).to_subtype + +/-- **The partial derivative when the low-degree part precedes `λ₀`.** If +`S.LowDegreePartAlgebraicLE v'`, then +`∂F/∂X_{v'} = ∑_v (∂F/∂X_v) U_v` over finitely many contributing variables, with +`∂U_v/∂X_{B₀} = 0`. -/ +@[blueprint "prop:partials-when-low-degree-part-is-algebraically-bounded" + (phase := "Limit ordinals in the degree induction") + (title := "Partial-derivative syzygy when $(w_{B'})_{<\\beta}\\oplus\\eta=\\lambda_0$ \ + for some $\\eta$") + (statement := /-- + Let $K$ be a field. Let $(x_i)_{i\in I}$ be a minimal homogeneous + generating system of $\widehat{\mathrm P}$, with + $x_i\in\mathrm P_{w_i}$, and choose principal series $b_i$ of degree + $w_i$ representing $x_i$. Assume evaluation at $(x_i)$ is injective on + every homogeneous degree below $\alpha$. + + Let $0\ne F\in K[X_i:i\in I]$ be weighted homogeneous of degree $\alpha$ + with $F(x)=0$. Suppose every variable of $F$ has weight below $\alpha$ + and zero constant Cantor coefficient. Choose $X_{B_0}$ of maximal weight + among the variables of $F$, and put $D=\deg_{X_{B_0}}F$. Suppose there are + ordinals $\beta,\Delta,\lambda_0,\alpha_1$ such that + \[ + \Delta\ne0,\qquad + \Delta\oplus D w_{B_0}=\alpha,\qquad + \lambda_0<\alpha_{<\beta}, + \] + every Cantor term of $\Delta$ is at least $\omega^\beta$, and the last + Cantor term of $w_{B_0}$ is below $\omega^\beta$. Assume also + \[ + \alpha_1\le\alpha_{\ge\beta}\oplus\lambda_0, + \qquad \alpha_1\le\alpha, + \] + that for some $\varepsilon_1>0$ every $\gamma\in(-\varepsilon_1,0)$ + satisfies + \[ + v_J\bigl(F(b)^{\vert\gamma}\bigr)<\omega^{\alpha_1}, + \] + and that in the convolution expansion of any monomial of $F$, every term + $\rho$ using at least two translated truncations satisfies + $\rho<\alpha_{\ge\beta}\oplus\lambda_0$. + + Let $X_{B'}$ occur in $F$, and suppose + $(w_{B'})_{<\beta}\preccurlyeq\lambda_0$ in the algebraic order. Then + there are a finite set $E$ of variables and + polynomials $(U_B)_{B\in E}$ such that every $B\in E$ occurs in $F$ and + either + \[ + (w_B)_{<\beta}=\alpha_{<\beta}, + \] + or + \[ + 0<(w_B)_{<\beta}\ne\alpha_{<\beta},\qquad + (w_B)_{<\beta}\not\preccurlyeq\lambda_0, + \qquad w_{B'} + intro v' hv' hn hdiff + obtain ⟨Θ, hΘdef⟩ : ∃ Θ, Θ = pderiv v' S.F := ⟨_, rfl⟩ + rw [← hΘdef] + rcases eq_or_ne Θ 0 with hΘ0 | hΘ0 + · exact ⟨∅, fun _ ↦ 0, fun v hv ↦ absurd hv (Finset.notMem_empty v), + fun v hv ↦ absurd hv (Finset.notMem_empty v), by rw [hΘ0, Finset.sum_empty]⟩ + -- the degree `h = α ⊖ deg v'` and `τ = h_{≥β} ⊕ λ'` + obtain ⟨h, hh⟩ := exists_add_wt_eq_of_mem_vars S.hom hv' + have hhα : h < α := by + rw [← hh]; exact lt_add_of_pos_right _ (pos_iff_ne_zero.mpr (hx.ne_zero v')) + have hΘhom : IsWeightedHomogeneous wt Θ h := by rw [hΘdef]; exact S.pderiv_hom hh + obtain ⟨lam', hlam'⟩ := NatOrdinal.algebraicLE_iff.mp + ((S.lowDegreePartAlgebraicLE_iff v').mp hdiff) + obtain ⟨τ, hτdef⟩ : ∃ τ : NatOrdinal, + τ = NatOrdinal.partGE S.β h + lam' := ⟨_, rfl⟩ + -- the variables above `v'` + have hτ : NatOrdinal.partGE S.β α + S.lam₀ ≤ τ + wt v' := by + have := S.αGE_add_lam₀_eq hh hlam' + rw [S.αGE_def, ← hτdef] at this + exact this.le + obtain ⟨ε₂, hε₂, h2⟩ := + σ.exists_forall_componentsGE_pol_translatedTruncation_aeval_pderiv_mem hx hinj hσ + S.hom S.vars_lt S.α₁_le S.α₁_le_α S.ε₁_pos S.truncation_lt S.remainder_lt v' hτ + rw [← hΘdef] at h2 + -- the partials of the variables above `v'` lie in the ideal of the generators + have habove : ∀ j ∈ S.F.vars, wt v' < wt j → + pderiv j S.F ∈ + Ideal.span (Set.range fun v : {v // S.ContributesToPartialDerivativeAt v' v} ↦ + pderiv v.1 S.F) := by + intro j hj hlt + by_cases htop : S.LowDegreePartEq j + · exact Ideal.subset_span ⟨⟨j, hj, Or.inl htop⟩, rfl⟩ + by_cases hL : S.HasProperLowDegreePartNotAlgebraicLE j + · exact Ideal.subset_span ⟨⟨j, hj, Or.inr ⟨hL, hlt⟩⟩, rfl⟩ + -- The low-degree part of `j` precedes `λ₀`: use the induction hypothesis. + have hdj : S.LowDegreePartAlgebraicLE j := by + by_contra hnd + rcases eq_or_ne (S.degLT j) 0 with ht | ht + · exact hnd ((S.lowDegreePartAlgebraicLE_iff j).mpr (by + rw [ht] + exact NatOrdinal.algebraicLE_zero _)) + · exact hL ((S.hasProperLowDegreePartNotAlgebraicLE_iff j).mpr ⟨hj, ht, htop, hnd⟩) + have hcard : (S.F.vars.filter fun v ↦ wt j < wt v).card < n := by + rw [← hn] + refine Finset.card_lt_card + (Finset.ssubset_iff_subset_ne.mpr ⟨fun v hv ↦ ?_, fun heq ↦ ?_⟩) + · obtain ⟨hv1, hv2⟩ := Finset.mem_filter.mp hv + exact Finset.mem_filter.mpr ⟨hv1, hlt.trans hv2⟩ + · have : j ∈ S.F.vars.filter fun v ↦ wt v' < wt v := Finset.mem_filter.mpr ⟨hj, hlt⟩ + rw [← heq, Finset.mem_filter] at this + exact lt_irrefl _ this.2 + obtain ⟨s, U, hs, -, heq⟩ := ih _ hcard j hj rfl hdj + rw [heq] + refine Ideal.sum_mem _ fun v hv ↦ + Ideal.mul_mem_right _ _ (Ideal.subset_span ⟨⟨v, ?_⟩, rfl⟩) + exact ⟨(hs v hv).1, (hs v hv).2.elim Or.inl fun h' ↦ Or.inr ⟨h'.1, hlt.trans h'.2⟩⟩ + have h2' : ∀ γ : ℝ, -ε₂ < γ → γ < 0 → + componentsGE wt τ (σ.pol hx α + (translatedTruncation ((aeval σ.lift Θ : Series K) : K⟦ℝ⟧) γ)) ∈ + Ideal.span (Set.range fun v : {v // S.ContributesToPartialDerivativeAt v' v} ↦ + pderiv v.1 S.F) := by + intro γ hγε hγ0 + refine Ideal.span_le.mpr ?_ (h2 γ hγε hγ0) + rintro _ ⟨j, rfl⟩ + exact habove j.1 j.2.1 j.2.2 + -- the generator degrees `σ_v = α ⊖ deg v` and cofactor degrees `b_v = deg v ⊖ deg v'` + haveI : Finite {v // S.ContributesToPartialDerivativeAt v' v} := + S.finite_setOf_contributesToPartialDerivativeAt v' + have hcd : ∀ v : {v // S.ContributesToPartialDerivativeAt v' v}, ∃ c, c + wt v.1 = α := + fun v ↦ exists_add_wt_eq_of_mem_vars S.hom v.2.1 + choose cd hcd using hcd + have hqG : ∀ v : {v // S.ContributesToPartialDerivativeAt v' v}, + IsWeightedHomogeneous wt (pderiv v.1 S.F) (cd v) := + fun v ↦ S.pderiv_hom (hcd v) + -- generators with `σ_v ≼ h`, equivalently `deg v' ≼ deg v` + obtain ⟨A, hAdef⟩ : ∃ A : {v // S.ContributesToPartialDerivativeAt v' v} → Prop, + A = fun v ↦ NatOrdinal.AlgebraicLE (wt v') (wt v.1) := ⟨_, rfl⟩ + have hAiff : ∀ v, A v ↔ NatOrdinal.AlgebraicLE (wt v') (wt v.1) := fun v ↦ by rw [hAdef] + haveI : Finite {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} := + Finite.of_injective (fun v ↦ v.1) Subtype.val_injective + have hbA : ∀ v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, + ∃ b, b + wt v' = wt v.1.1 := fun v ↦ by + obtain ⟨c, hc⟩ := NatOrdinal.algebraicLE_iff.mp ((hAiff v.1).mp v.2) + exact ⟨c, by rw [add_comm]; exact hc⟩ + choose b hb using hbA + have hbc : ∀ v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, + b v + cd v.1 = h := by + intro v + have h1 : b v + cd v.1 + wt v' = h + wt v' := by + rw [add_right_comm, hb v, add_comm, hcd v.1, hh] + exact add_right_cancel h1 + -- for the other generators, `σ_v \not\preccurlyeq h` + have hnotA : ∀ v : {v // S.ContributesToPartialDerivativeAt v' v}, ¬ A v → + ¬ NatOrdinal.AlgebraicLE (cd v) h := by + intro v hA hce + obtain ⟨b', hb'⟩ := NatOrdinal.algebraicLE_iff.mp hce + refine hA ((hAiff v).mpr (NatOrdinal.algebraicLE_iff.mpr ⟨b', ?_⟩)) + have h1 : cd v + (b' + wt v') = cd v + wt v.1 := by + rw [← add_assoc, hb', hh, hcd v] + rw [add_comm] + exact add_left_cancel h1 + -- the ordinal value of `(∂F/∂X_{v'})(b_𝓑)` and of its translated truncations + have hu : ordinalValue (aeval σ.lift Θ) = ω^ h := + σ.ordinalValue_aeval_eq_of_injectiveAt (hinj h hhα) hΘhom hΘ0 + have hu' : ordinalValue (aeval σ.lift Θ) < ω^ (h + 1) := by + rw [hu]; exact NatOrdinal.wpow_lt_wpow.mpr (lt_add_one h) + obtain ⟨ε₃, hε₃, h3⟩ := exists_forall_ordinalValue_translatedTruncation_lt hu' + -- ideal membership of the class from the condition (p) on the translated truncations + have hτh : τ + 1 < h := hτdef ▸ S.τ_add_one_lt hx hh hlam' + have hsep : ∀ v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, + ∀ θ, θ < cd v.1 → b v + θ < τ := by + intro v θ hθ + have hc0 := S.cdeg_ne_zero v.1.2.1 (hcd v.1) + obtain ⟨ε, hε⟩ := NatOrdinal.exists_leastTerm_eq_wpow hc0 + refine NatOrdinal.add_lt_of_lt_of_partGE_le hc0 hε (hbc v) ?_ hθ + rw [hτdef] + rcases v.1.2.2 with htop | ⟨hL, -⟩ + · exact S.partGE_le_τ_of_lowDegreePartEq v.1.2.1 (hcd v.1) htop hε h + · have hne := S.partLT_cdeg_ne_zero (hcd v.1) + ((S.hasProperLowDegreePartNotAlgebraicLE_iff _).mp hL).2.2.1 + rw [NatOrdinal.leastTerm_eq_leastTerm_partLT hne] at hε + exact S.partGE_le_τ_of_hasProperLowDegreePartNotAlgebraicLE hx (hcd v.1) hh hlam' hL hε + have htrunc : ∀ γ : ℝ, -(min ε₂ ε₃) < γ → γ < 0 → + componentsGE wt τ (σ.pol hx α + (translatedTruncation ((aeval σ.lift Θ : Series K) : K⟦ℝ⟧) γ)) ∈ + Ideal.span (Set.range fun v : + {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} ↦ pderiv v.1.1 S.F) := by + intro γ hγε hγ0 + have hγ₂ : -ε₂ < γ := by linarith [min_le_left ε₂ ε₃] + have hγ₃ : -ε₃ < γ := by linarith [min_le_right ε₂ ε₃] + refine componentsGE_mem_span_subtype wt hqG (h2' γ hγ₂ hγ0) + (σ.pol_degreeLT_of_lt hx hinj hhα.le (h3 γ hγ₃ hγ0)) A + fun v hA e hτe heh ⟨β', hβ'⟩ ↦ ?_ + have hce : NatOrdinal.AlgebraicLE (cd v) e := + NatOrdinal.algebraicLE_iff.mpr ⟨β', by rw [add_comm]; exact hβ'⟩ + rw [hτdef] at hτe + rcases v.2.2 with htop | ⟨hL, -⟩ + · exact S.not_algebraicLE_of_lowDegreePartEq_of_not + (hcd v) hlam' htop (hnotA v hA) hτe heh hce + · exact S.not_algebraicLE_of_hasProperLowDegreePartNotAlgebraicLE_of_not + hx (hcd v) hh hlam' hL (hnotA v hA) hτe heh hce + have hmem := IsPrincipal.of_principalComponentMk_mem_span_of_forall_componentsGE_mem σ hx hinj + hσ (ι' := {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}) + (q := fun v ↦ pderiv v.1.1 S.F) + (c := fun v ↦ cd v.1) (τ := τ) (h := h) (b := b) + (u := aeval σ.lift Θ) (η := -(min ε₂ ε₃)) + (fun v ↦ hqG v.1) (fun v ↦ S.cdeg_constantCoeff hx (hcd v.1)) + (fun v ↦ S.cdeg_ne_zero v.1.2.1 (hcd v.1)) hbc hsep hτh hhα hu hu' + (neg_neg_of_pos (lt_min hε₂ hε₃)) htrunc + -- back to polynomials + cases nonempty_fintype {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} + have hq' : ∀ v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, + aeval x (pderiv v.1.1 S.F) ∈ principalGrading K (cd v.1) := + fun v ↦ aeval_mem_of_forall_mem hx.mem (hqG v.1) + obtain ⟨u, hu_mem, -, hsum⟩ := exists_eq_sum_mul_of_mem_span (𝒜 := principalGrading K) hq' + (of_mem_principalGrading _ _) hmem + have hU : ∀ v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, + ∃ U : MvPolynomial ι K, + IsWeightedHomogeneous wt U (b v) ∧ aeval x U = u v := + fun v ↦ hx.exists_aeval_eq (principalGrading_gradeZeroScalars K) (b v) (u v) + (hu_mem v (b v) (hbc v)) + choose U hUhom hUu using hU + obtain ⟨Θ', hΘ'def⟩ : ∃ Θ', Θ' = Θ - ∑ v, pderiv v.1.1 S.F * U v := ⟨_, rfl⟩ + have hS : IsWeightedHomogeneous wt (∑ v, pderiv v.1.1 S.F * U v) h := + IsWeightedHomogeneous.sum _ _ _ fun v _ ↦ by + have := IsWeightedHomogeneous.mul (hqG v.1) (hUhom v) + rwa [add_comm, hbc v] at this + have hΘ'hom : IsWeightedHomogeneous wt Θ' h := by + rw [hΘ'def, sub_eq_add_neg] + refine IsWeightedHomogeneous.add hΘhom ?_ + intro d hd + rw [coeff_neg, neg_ne_zero] at hd + exact hS hd + have hΘ'0 : aeval x Θ' = 0 := by + rw [hΘ'def, map_sub, map_sum, ← (σ.aeval_represents hΘhom).of_principalComponentMk, hsum] + simp only [map_mul, hUu] + exact sub_self _ + have hΘ' : Θ' = 0 := (injectiveAt_iff h).mp (hinj h hhα) Θ' hΘ'hom hΘ'0 + have hΘeq : Θ = ∑ v, pderiv v.1.1 S.F * U v := by + rw [← sub_eq_zero, ← hΘ'def]; exact hΘ' + -- the cofactors have degree below `δ = deg B₀`, so `∂/∂X_{B₀}` annihilates them + have hUB₀ : ∀ v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, + pderiv S.B₀ (U v) = 0 := by + intro v + have hbg : b v < wt S.B₀ := by + have h1 : b v < wt v.1.1 := by + rw [← hb v]; exact lt_add_of_pos_right _ (pos_iff_ne_zero.mpr (hx.ne_zero v')) + exact h1.trans_le (S.max _ v.1.2.1) + exact pderiv_eq_zero_of_degreeLT_le ((hUhom v).degreeLT hbg) le_rfl + -- re-index the sum by the variables themselves + have hinjv : Function.Injective + (fun v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} ↦ v.1.1) := + fun v w hvw ↦ Subtype.ext (Subtype.ext hvw) + refine ⟨Finset.univ.image + (fun v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} ↦ v.1.1), + fun i ↦ if hi : ∃ v : + {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, v.1.1 = i then + U (Classical.choose hi) + else 0, ?_, ?_, ?_⟩ + · intro i hi + obtain ⟨v, -, rfl⟩ := Finset.mem_image.mp hi + exact v.1.2 + · intro i hi + obtain ⟨v, -, rfl⟩ := Finset.mem_image.mp hi + beta_reduce + rw [dif_pos (⟨v, rfl⟩ : + ∃ w : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, w.1.1 = v.1.1)] + exact hUB₀ _ + · rw [hΘeq, Finset.sum_image fun v _ w _ h ↦ hinjv h] + refine Finset.sum_congr rfl fun v _ ↦ ?_ + beta_reduce + rw [dif_pos (⟨v, rfl⟩ : + ∃ w : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, w.1.1 = v.1.1)] + congr 2 + exact (hinjv (Classical.choose_spec + (⟨v, rfl⟩ : ∃ w : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, + w.1.1 = v.1.1))).symm + +end Lifts.LimitOrdinalRelationAtCutoff + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Pieces.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Pieces.lean new file mode 100644 index 0000000000..67a793f234 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Pieces.lean @@ -0,0 +1,245 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SumAlongCutoffs +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SeriesTruncations +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.IncreasingSequenceUnion + +/-! +# Pieces of a series and sums along a sequence of cutoffs: their translated truncations + +For reals `a < b ≤ 0` the *piece* of a series `u` on `(a, b]`, translated to `0`, is +`(u_{>a})^{|b}` — the upper truncation [LM24, Def. 3.2.2] followed by the translated truncation at +`b` [Ber00, Def. 6.1] (`piece a b u`). In the induction over degrees a series is cut into the +pieces on `(γ_k, γ_{k+1}]` along a sequence `γ_k ↑ 0`, and the cofactors found for the pieces are +combined into a sum along the cutoffs, `s = ∑_k (w_k)_{>c_k} t^{γ_k}` (the sum (m) of +`SumAlongCutoffs.lean`, here as a nonpositive series, `sumAlongCutoffsSeries`). This file records +how translated truncations pass through the two operations, modulo `J`: + +* `(piece a b u)^{|ξ} ≡ u^{|b + ξ}` for `a - b < ξ ≤ 0`; +* `s^{|γ_k + ξ} ≡ w_k^{|ξ}` for `c_k < ξ ≤ 0`, and the translated truncations of `s` at cutoffs + `ζ ≤ γ_0 + c_0` vanish; +* the support of `s` has order type at most `ω^e` when every `w_k` has support of order type + below `ω^e`. +-/ + +universe v + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- A translated truncation at a cutoff below the whole support vanishes. -/ +theorem translatedTruncation_eq_zero_of_forall_lt {b : K⟦ℝ⟧} {ζ : ℝ} + (h : ∀ y ∈ b.support, ζ < y) : translatedTruncation b ζ = 0 := by + apply Subtype.ext + ext δ + rw [coeff_translatedTruncation, ZeroMemClass.coe_zero, HahnSeries.coeff_zero] + split_ifs with hδ + · by_contra hne + exact absurd (h (ζ + δ) ((HahnSeries.mem_support _ _).mpr hne)) (by linarith) + · rfl + +/-! ### Pieces -/ + +/-- The piece of the series `E` on `(a, b]`, translated so that `b` sits at `0`: `(E_{>a})^{|b}`, +the upper truncation `E_{>a}` followed by the translated truncation at `b`. -/ +def piece (a b : ℝ) (E : K⟦ℝ⟧) : Series K := + ⟨translate (-b) (truncGT a (truncLE b E)), by + rw [HahnSeries.mem_nonpositiveSubring, support_translate] + rintro δ ⟨y, hy, rfl⟩ + rw [support_truncGT] at hy + obtain ⟨hy1, -⟩ := hy + rw [support_truncLE] at hy1 + change -b + y ≤ 0 + linarith [hy1.2]⟩ + +theorem coe_piece (a b : ℝ) (E : K⟦ℝ⟧) : + ((piece a b E : Series K) : K⟦ℝ⟧) = translate (-b) (truncGT a (truncLE b E)) := + (rfl) + +theorem coeff_piece (a b : ℝ) (E : K⟦ℝ⟧) (δ : ℝ) : + ((piece a b E : Series K) : K⟦ℝ⟧).coeff δ = + if a < δ + b ∧ δ + b ≤ b then E.coeff (δ + b) else 0 := by + change (translate (-b) (truncGT a (truncLE b E))).coeff δ = _ + rw [coeff_translate, sub_neg_eq_add, HahnSeries.coeff_truncGT, HahnSeries.coeff_truncLE] + by_cases h1 : a < δ + b <;> by_cases h2 : δ + b ≤ b <;> simp [h1, h2] + +/-- **Translated truncations of interval pieces.** If `a - b < ξ ≤ 0`, then the translated +truncation at `ξ` of the restriction to `(a, b]`, translated so that `b` becomes `0`, is +congruent modulo `J` to the original series translated-truncated at `b + ξ`. -/ +@[blueprint "lem:window-truncation" + (phase := "Limit ordinals in the degree induction") + (title := "Translated truncations of interval pieces") + (statement := /-- + Let $K$ be a field, let $u\in K((\mathbb R))$, and let + $a,b,\xi\in\mathbb R$ satisfy $a-b<\xi\le0$. Put + \[ + p=t^{-b}\sum_{aa-b-\xi$, compare coefficients. If $\delta\le0$, then + $a0$, both coefficients are zero. The support + of the difference is therefore bounded above by $a-b-\xi<0$, so the + difference lies in $J$. + -/)] +theorem translatedTruncation_window_sub_mem (a b : ℝ) (E : K⟦ℝ⟧) {ξ : ℝ} (hξ : a - b < ξ) + (hξ0 : ξ ≤ 0) : + translatedTruncation ((piece a b E : Series K) : K⟦ℝ⟧) ξ - translatedTruncation E (b + ξ) ∈ + Nonpositive.negativeMonomialIdeal K := by + refine mem_negativeMonomialIdeal_of_forall_support_le (s := a - b - ξ) (by linarith) fun δ hδ ↦ ?_ + rw [HahnSeries.mem_support, AddSubgroupClass.coe_sub, HahnSeries.coeff_sub, + coeff_translatedTruncation, coeff_translatedTruncation, coeff_piece] at hδ + by_contra hlt + rw [not_le] at hlt + apply hδ + by_cases h0 : δ ≤ 0 + · rw [if_pos h0, if_pos h0, if_pos ⟨by linarith, by linarith⟩, show ξ + δ + b = b + ξ + δ by ring, + sub_self] + · rw [if_neg h0, if_neg h0, sub_zero] + +/-! ### Sums along a sequence of cutoffs -/ + +section SumAlongCutoffsSeries + +variable (w : ℕ → Series K) (c γ : ℕ → ℝ) (hγ : StrictMono γ) + (hdisj : ∀ k, γ k ≤ γ (k + 1) + c (k + 1)) (hneg : ∀ k, γ k < 0) +include hγ hdisj hneg + +/-- The sum (m), `∑_k (w_k)_{>c_k} t^{γ_k}`, as a nonpositive series. -/ +def sumAlongCutoffsSeries : Series K := + ⟨sumAlongCutoffs w c γ hγ hdisj, sumAlongCutoffs_mem w c γ hγ hdisj hneg⟩ + +theorem coe_sumAlongCutoffsSeries : + ((sumAlongCutoffsSeries w c γ hγ hdisj hneg : Series K) : K⟦ℝ⟧) = + sumAlongCutoffs w c γ hγ hdisj := + (rfl) + +/-- **Translated truncations of shifted truncation sums.** On the `k`-th support interval, the +translated truncation of the sum along cutoffs agrees modulo `J` with that of `w k`. -/ +@[blueprint "lem:cutoff-sum-truncation" + (phase := "Limit ordinals in the degree induction") + (title := "Translated truncations of shifted truncation sums") + (statement := /-- + Let $K$ be a field, let $w_k\in\Kser$, and let + $c_k,\gamma_k\in\mathbb R$. Suppose that $(\gamma_k)$ is strictly + increasing, $\gamma_k<0$, and + $\gamma_k\le\gamma_{k+1}+c_{k+1}$ for every $k$. Put + \[ + s=\sum_k\utrunc{w_k}{c_k}t^{\gamma_k}. + \] + For every $k$ and every $c_k<\xi\le0$, + \[ + \trunc s{\gamma_k+\xi}\equiv\trunc{w_k}\xi\pmod J. + \] + -/) + (proof := /-- + The shifted support intervals are strictly ordered, so + \ref{lem:increasing-union} ensures that their union is well ordered and the + series $s$ is defined. Fix $k$ and $c_k<\xi\le0$. Since $c_k-\xi<0$, it + suffices to compare coefficients at exponents $\delta>c_k-\xi$. If + $\delta\le0$, then $\gamma_k+\xi+\delta$ lies in the $k$-th interval, so + the coefficient of $s$ comes from its $k$-th summand and equals the + coefficient of $w_k$ at $\xi+\delta$. If $\delta>0$, both translated + truncations have zero coefficient. Their difference is supported at or + below $c_k-\xi<0$, and therefore lies in $J$. + -/)] +theorem translatedTruncation_sumAlongCutoffsSeries_sub_mem (k : ℕ) {ξ : ℝ} (hξ : c k < ξ) + (hξ0 : ξ ≤ 0) : + translatedTruncation ((sumAlongCutoffsSeries w c γ hγ hdisj hneg : Series K) : K⟦ℝ⟧) (γ k + ξ) - + translatedTruncation (w k : K⟦ℝ⟧) ξ ∈ Nonpositive.negativeMonomialIdeal K := by + refine mem_negativeMonomialIdeal_of_forall_support_le (s := c k - ξ) (by linarith) fun δ hδ ↦ ?_ + rw [HahnSeries.mem_support, AddSubgroupClass.coe_sub, HahnSeries.coeff_sub, + coeff_translatedTruncation, coeff_translatedTruncation, coe_sumAlongCutoffsSeries] at hδ + by_contra hlt + rw [not_le] at hlt + apply hδ + by_cases h0 : δ ≤ 0 + · rw [if_pos h0, if_pos h0, + coeff_sumAlongCutoffs_of_mem w c γ hγ hdisj (k := k) ⟨by linarith, by linarith⟩, + coeff_placedTerm, + if_pos (by linarith), show γ k + ξ + δ - γ k = ξ + δ by ring, sub_self] + · rw [if_neg h0, if_neg h0, sub_zero] + +/-- At cutoffs `ζ ≤ γ_0 + c_0`, below the first interval, the translated truncations of the sum +(m) vanish. -/ +theorem translatedTruncation_sumAlongCutoffsSeries_eq_zero (hc0 : c 0 ≤ 0) {ζ : ℝ} + (hζ : ζ ≤ γ 0 + c 0) : + translatedTruncation ((sumAlongCutoffsSeries w c γ hγ hdisj hneg : Series K) : K⟦ℝ⟧) ζ = 0 := by + refine translatedTruncation_eq_zero_of_forall_lt fun y hy ↦ ?_ + rw [coe_sumAlongCutoffsSeries] at hy + obtain ⟨k, hk⟩ := Set.mem_iUnion.mp (support_sumAlongCutoffs_subset w c γ hγ hdisj hy) + have : γ 0 + c 0 ≤ γ k + c k := by + rcases k with _ | k + · exact le_rfl + · have h1 : γ 0 ≤ γ k := hγ.monotone (Nat.zero_le k) + have h2 := hdisj k + linarith + linarith [hk.1] + +/-- **Order type of a sum along cutoffs.** If every `w k` has support order type below `ω^e`, +then the sum along cutoffs has support order type at most `ω^e`. -/ +@[blueprint "lem:cutoff-sum-support" + (phase := "Limit ordinals in the degree induction") + (title := "Order type of a sum along cutoffs") + (statement := /-- + Let $K$ be a field, let $w_k\in K((\mathbb R^{\le0}))$, let + $(\gamma_k)$ be a strictly increasing sequence of negative real numbers, + and let $c_k\in\mathbb R$ satisfy + $\gamma_k\le\gamma_{k+1}+c_{k+1}$ for every $k$. Put + \[ + s=\sum_k (w_k)_{>c_k}t^{\gamma_k}. + \] + If $\operatorname{ot}(\operatorname{supp}(w_k))<\omega^\rho$ for every + $k$, then $\operatorname{ot}(\operatorname{supp}(s))\le\omega^\rho$. + -/) + (proof := /-- + The $k$-th summand is supported in $(\gamma_k+c_k,\gamma_k]$, and its + support order type is at most $\operatorname{ot}(\operatorname{supp}(w_k))$. + The cutoff inequality strictly orders these supports by $k$. By + \ref{lem:increasing-union-below-principal-ordinal}, their union has order + type at most $\omega^\rho$. The support of $s$ is contained in this union. + -/)] +theorem supportOrderType_sumAlongCutoffsSeries_le {e : NatOrdinal} + (hw : ∀ k, ((w k : Series K) : K⟦ℝ⟧).supportOrderType < (ω^ e).val) : + ((sumAlongCutoffsSeries w c γ hγ hdisj hneg : Series K) : K⟦ℝ⟧).supportOrderType ≤ + (ω^ e).val := by + rw [coe_sumAlongCutoffsSeries] + have hB : ∀ k, (placedTerm w c γ k).support.IsPWO := fun k ↦ support_placedTerm_isPWO w c γ k + have hord : ∀ j k, j < k → ∀ x ∈ (placedTerm w c γ j).support, + ∀ y ∈ (placedTerm w c γ k).support, x < y := + fun j k hjk x hx y hy ↦ placedTerm_support_lt w c γ hγ hdisj hjk hx hy + have hU : (⋃ k, (placedTerm w c γ k).support).IsPWO := Set.IsPWO.iUnion_of_ordered hB hord + have hsub : (sumAlongCutoffs w c γ hγ hdisj).support ⊆ ⋃ k, (placedTerm w c γ k).support := + fun y hy ↦ by + obtain ⟨k, hk⟩ := Set.mem_iUnion.mp (support_sumAlongCutoffs_subset w c γ hγ hdisj hy) + refine Set.mem_iUnion.mpr ⟨k, ?_⟩ + rw [HahnSeries.mem_support] at hy ⊢ + rwa [coeff_sumAlongCutoffs_of_mem w c γ hγ hdisj hk] at hy + rw [supportOrderType_eq_setOrderType] + refine (Set.IsPWO.orderType_mono _ hU hsub).trans ?_ + refine Set.IsPWO.orderType_iUnion_le_wpow_of_ordered hB hord (fun k ↦ ?_) + rw [← supportOrderType_eq_setOrderType] + exact (supportOrderType_placedTerm_le w c γ k).trans_lt (hw k) + +end SumAlongCutoffsSeries + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Polynomiality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Polynomiality.lean new file mode 100644 index 0000000000..de49b347b1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Polynomiality.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +import Mathlib.RingTheory.AlgebraicIndependent.Basic + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.RealPartials + +/-! +# The polynomiality of `P̂` + +Let `K` be a field of characteristic `0` and `𝓑` a minimal system of homogeneous generators of +`P̂ = ⨁_α P_α`; in Lean the generators are `x i`, of degrees `wt i`. Evaluation +`K[X_B : B ∈ 𝓑] → P̂`, `X_B ↦ B`, is injective. + +For real Hahn series, Berarducci's ordinal value is `omega` raised to the Cantor–Bendixson rank of +zero in the closed support. Thus LM24's Cantor degree is that rank, and `P̂` is +canonically the associated graded algebra of the Cantor–Bendixson degree. Its polynomiality is the +generic degree-induction theorem. The interval-based partial-derivative argument is the remaining +step specific to the real exponent group. +-/ + +universe v w + +open scoped NatOrdinal +open MvPolynomial OrdinalGraded Berarducci + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] [CharZero K] {ι : Type w} {wt : ι → NatOrdinal} + {x : ι → PrincipalSubring K} + +private theorem algebraicIndependent_cantorBendixson + (hx : IsMinimalSystem (principalGrading K) wt x) : + AlgebraicIndependent K x := by + let e := principalSubringCantorBendixsonAlgEquiv (K := K) + let xg := fun i ↦ e (x i) + have hxg : IsMinimalSystem + (DirectSum.rangeLof K (HahnSeries.Nonpositive.cantorBendixsonDegreeValuation + (G := ℝ) (R := K)).Component) wt xg := + minimalSystem_cantorBendixson hx + obtain ⟨σ, hσ⟩ := Lifts.exists_isPrincipal hx + let σg := σ.cantorBendixson + have hσg : HahnSeries.Nonpositive.LiftFamily.HasLowerTruncationDegrees σg := + hσ.cantorBendixson + have haixg : AlgebraicIndependent K xg := + HahnSeries.Germ.algebraicIndependent_of_isMinimalSystem_of_limitOrdinalCases σg hxg hσg + (fun _ hinj S ↦ S.degreeOf_eq_one hxg hσg hinj) + (fun α hinj S v' hv' hlowDegree ↦ by + change HahnSeries.Germ.LimitOrdinalRelationAtCutoff σ.cantorBendixson α at S + change ∀ β < α, InjectiveAt K wt + (fun i ↦ principalSubringCantorBendixsonAlgEquiv (x i)) β at hinj + exact Lifts.RealPartialDecomposition.lowDegreePartAlgebraicLE_partials S hx hinj hσ hv' + hlowDegree) + have hxg_eq : e.toAlgHom ∘ x = xg := by rfl + rw [← hxg_eq] at haixg + exact (e.toAlgHom.algebraicIndependent_iff e.injective).mp haixg + +/-- **The polynomiality of `P̂`, degree by degree.** For a minimal system of homogeneous +generators `x` of degrees `wt`, evaluation is injective in every degree `α`: a polynomial +homogeneous of degree `α` that evaluates to `0` in `P̂` is `0`. -/ +theorem injectiveAt_of_isMinimalSystem (hx : IsMinimalSystem (principalGrading K) wt x) + (α : NatOrdinal) : InjectiveAt K wt x α := by + rw [OrdinalGraded.injectiveAt_iff] + intro F _ hF + apply algebraicIndependent_iff_injective_aeval.mp (algebraicIndependent_cantorBendixson hx) + rw [hF, map_zero] + +/-- **The algebraic independence of minimal systems in `P̂`.** Every minimal system of +homogeneous generators is algebraically independent. -/ +@[blueprint "thm:polynomial" + (phase := "Principal RV-elements") + (title := "Minimal homogeneous generators of $\\widehat{\\mathrm P}$ are algebraically \ + independent") + (statement := /-- + Let $K$ be a field of characteristic zero. If $(x_i)_{i\in I}$ is a + minimal homogeneous generating system of $\widehat{\mathrm P}$, with + $x_i\in\mathrm P_{w_i}$, then $(x_i)_{i\in I}$ is algebraically + independent over $K$. + -/) + (proof := /-- + Choose principal series representatives $b_i$ of the $x_i$. + By \ref{lem:principal-representatives-cantor-bendixson}, $(x_i)$ is a minimal + homogeneous generating system of + $\operatorname{gr}_{\delta_{\mathrm{CB}}}K((\mathbb R^{\le0}))$, and the + same $b_i$ have the required degree and translated-truncation + properties for the Cantor--Bendixson grading. + + Apply \ref{thm:cantor-bendixson-polynomiality}. Its two nontrivial relation + hypotheses follow from \ref{lem:linear-occurrence} and + \ref{lem:real-translated-truncation-partials}. Thus the + transported family is algebraically independent. Injectivity of the graded + isomorphism transports algebraic independence back to $(x_i)$ in + $\widehat{\mathrm P}$. + -/) + (highlight)] +theorem algebraicIndependent_of_isMinimalSystem + (hx : IsMinimalSystem (principalGrading K) wt x) : AlgebraicIndependent K x := + algebraicIndependent_cantorBendixson hx + +/-- **The polynomiality of `P̂`.** Evaluation `K[X_B : B ∈ 𝓑] → P̂` at a minimal system of +homogeneous generators is injective. -/ +theorem aeval_injective_of_isMinimalSystem (hx : IsMinimalSystem (principalGrading K) wt x) : + Function.Injective (aeval x : MvPolynomial ι K →ₐ[K] PrincipalSubring K) := + algebraicIndependent_iff_injective_aeval.mp (algebraicIndependent_of_isMinimalSystem hx) + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalGraded.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalGraded.lean new file mode 100644 index 0000000000..182fd8aef0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalGraded.lean @@ -0,0 +1,831 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubring +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.InternalGrading +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.FilteredModule +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Polynomial +public import Mathlib.Algebra.MvPolynomial.Eval +public import Mathlib.LinearAlgebra.Basis.VectorSpace +public import Mathlib.RingTheory.Ideal.Quotient.Operations + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedValuation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.OrdinalValueDegree +import Mathlib.LinearAlgebra.Projection + +/-! +# The internal grading of `P̂`, its finite-degree part `P̂_{<ω}` and the quotient `P̂/I` + +The ring `P̂ = ⨁_{α<ω₁} P_α` is internally graded by its components `P_α` +(`principalGrading`), with `P_0 = K`. The objects of the theory of graded algebras over countable +ordinals, specialised to this grading, are the paper's: + +`P̂_{<ω} = ⨁_{n<ω} P_n` is the subalgebra of finite degree, `I = I_{≥1} = (P̂_{<ω})₊ P̂` is the +ideal generated by the elements of positive finite degree, `P̂/I` is the quotient by `I`, and +`(P̂_{<ω})₊² ∩ P_n = ∑_{i,j ≥ 1, i+j=n} P_i P_j` is the subspace of decomposables of `P_n`, with +quotient `P_n / ((P̂_{<ω})₊² ∩ P_n)`. The names below are abbreviations, or definitional aliases, +of the generic objects at `principalGrading K`, the decomposables being read inside the component +`P_n` through its homogeneous inclusion. +The ideal `(P̂_{<ω})₊ ⊆ P̂_{<ω}` of elements of positive degree, the elements of `P̂_{<ω}` with +vanishing degree-zero component, is specific to `P̂`; `I` is the least ideal of `P̂` containing it. + +A choice of complements `P_n = ((P̂_{<ω})₊² ∩ P_n) ⊕ E_n` and of bases of the `E_n` supplies a +minimal system `𝓑` of homogeneous generators of `P̂_{<ω}`. The system and the evaluation +`K[X_B : B ∈ 𝓑] → P̂_{<ω}` are noncanonical, but evaluation is surjective for every such choice. + +Everything here holds over every coefficient field, except that nonzero vectors of finite degree +have nonzero product: that is the multiplicativity of the ordinal value, Berarducci, Theorem 9.7, +and needs characteristic zero. +-/ + +universe v + +public noncomputable section + +open Berarducci LoweringDerivation + +namespace Berarducci + +open scoped DirectSum NatOrdinal + +variable {K : Type v} [Field K] + +/-! ### The internal grading of `P̂` -/ + +variable (K) in +/-- The internal grading of `P̂` by the spaces `P_α`. -/ +abbrev principalGrading : NatOrdinal → Submodule K (PrincipalSubring K) := + DirectSum.rangeLof K (PrincipalComponent K) + +theorem of_mem_principalGrading (α : NatOrdinal) (a : PrincipalComponent K α) : + DirectSum.of (PrincipalComponent K) α a ∈ principalGrading K α := + DirectSum.of_mem_rangeLof K _ α a + +variable (K) in +/-- Degree zero of the internal grading is the coefficient field: `P_0 = K`. -/ +theorem principalGrading_gradeZeroScalars : GradeZeroScalars (principalGrading K) := by + rw [gradeZeroScalars_iff] + intro x hx + obtain ⟨a, rfl⟩ := (DirectSum.mem_rangeLof_iff K _ _ x).mp hx + obtain ⟨k, rfl⟩ := principalComponentScalarHom_surjective K a + exact ⟨k, rfl⟩ + +/-! ### The finite-degree part `P̂_{<ω}` and its ideal `(P̂_{<ω})₊` -/ + +variable (K) in +/-- The subalgebra of finite degree `P̂_{<ω} = ⨁_{n<ω} P_n` of `P̂`. -/ +abbrev principalFiniteDegreePart : Subalgebra K (PrincipalSubring K) := + finiteDegreePart (principalGrading K) + +/-- Membership in `P̂_{<ω}` means that every nonzero homogeneous component has finite degree. -/ +@[simp] +theorem mem_principalFiniteDegreePart_iff (x : PrincipalSubring K) : + x ∈ principalFiniteDegreePart K ↔ + ∀ α, x α ≠ 0 → α < NatOrdinal.of Ordinal.omega0 := by + rw [mem_finiteDegreePart_iff, mem_finiteDegreeSubmodule_iff] + refine forall_congr' fun α ↦ ?_ + rw [DirectSum.coe_decompose_rangeLof, NatOrdinal.lt_omega0, DirectSum.lof_eq_of] + exact imp_congr_left (not_congr ⟨fun h0 ↦ DirectSum.of_injective α (h0.trans (map_zero _).symm), + fun h0 ↦ by rw [h0, map_zero]⟩) + +/-- A homogeneous vector of finite degree belongs to `P̂_{<ω}`. -/ +theorem principalSubring_of_nat_mem (n : ℕ) + (x : PrincipalComponent K (n : NatOrdinal)) : + DirectSum.of (PrincipalComponent K) (n : NatOrdinal) x ∈ + principalFiniteDegreePart K := + mem_finiteDegreePart_of_mem _ (of_mem_principalGrading _ x) + +variable (K) in +/-- The homogeneous inclusion `P_n → P̂_{<ω}` for a finite degree `n`. -/ +def finiteDegreeOf (n : ℕ) : + PrincipalComponent K (n : NatOrdinal) →ₗ[K] + principalFiniteDegreePart K where + toFun x := ⟨DirectSum.of (PrincipalComponent K) (n : NatOrdinal) x, + principalSubring_of_nat_mem n x⟩ + map_add' x y := by + apply Subtype.ext + exact map_add (DirectSum.of (PrincipalComponent K) (n : NatOrdinal)) x y + map_smul' k x := by + apply Subtype.ext + exact DirectSum.of_smul K (M := PrincipalComponent K) (n : NatOrdinal) k x + +/-- Coercing the inclusion `P_n → P̂_{<ω}` to `P̂` gives `DirectSum.of`. -/ +@[simp] +theorem coe_finiteDegreeOf (n : ℕ) + (x : PrincipalComponent K (n : NatOrdinal)) : + (finiteDegreeOf K n x : PrincipalSubring K) = + DirectSum.of (PrincipalComponent K) (n : NatOrdinal) x := by + rw [finiteDegreeOf] + rfl + +variable (K) in +/-- The inclusion `P_n → P̂_{<ω}` is injective. -/ +theorem finiteDegreeOf_injective (n : ℕ) : + Function.Injective (finiteDegreeOf K n) := by + intro x y hxy + apply DirectSum.of_injective (n : NatOrdinal) + exact congrArg Subtype.val hxy + +/-- In degree zero, the homogeneous inclusion agrees with the algebra map from `K`. -/ +theorem finiteDegreeOf_zero_scalar (k : K) : + finiteDegreeOf K 0 (principalComponentScalarHom K k) = + algebraMap K (principalFiniteDegreePart K) k := by + apply Subtype.ext + rw [coe_finiteDegreeOf] + exact principalSubring_algebraMap_apply k + +variable (K) in +/-- The ideal `(P̂_{<ω})₊ = ⨁_{1≤n<ω} P_n` of elements of positive degree of `P̂_{<ω}`. -/ +def positiveFinitePrincipalIdeal : + Ideal (principalFiniteDegreePart K) where + carrier := {x | (x : PrincipalSubring K) 0 = 0} + zero_mem' := by simp + add_mem' := by + intro x y hx hy + change (x : PrincipalSubring K) 0 = 0 at hx + change (y : PrincipalSubring K) 0 = 0 at hy + change ((x : PrincipalSubring K) + y) 0 = 0 + simp [hx, hy] + smul_mem' := by + classical + intro x y hy + change (y : PrincipalSubring K) 0 = 0 at hy + change ((x : PrincipalSubring K) * y) 0 = 0 + calc + ((x : PrincipalSubring K) * y) 0 = + (∑ ij ∈ DFinsupp.support (x : PrincipalSubring K) ×ˢ + DFinsupp.support (y : PrincipalSubring K), + DirectSum.of (PrincipalComponent K) (ij.1 + ij.2) + (GradedMonoid.GMul.mul + ((x : PrincipalSubring K) ij.1) + ((y : PrincipalSubring K) ij.2))) 0 := + congrArg (fun z : PrincipalSubring K ↦ z 0) + (DirectSum.mul_eq_sum_support_ghas_mul + (A := PrincipalComponent K) x y) + _ = ∑ ij ∈ DFinsupp.support (x : PrincipalSubring K) ×ˢ + DFinsupp.support (y : PrincipalSubring K), + (DirectSum.of (PrincipalComponent K) (ij.1 + ij.2) + (GradedMonoid.GMul.mul + ((x : PrincipalSubring K) ij.1) + ((y : PrincipalSubring K) ij.2))) 0 := by + exact DFinsupp.finsetSum_apply _ _ _ + _ = 0 := by + apply Finset.sum_eq_zero + rintro ⟨i, j⟩ hij + by_cases hgrade : i + j = 0 + · have hj : j = 0 := (NatOrdinal.add_eq_zero_iff.mp hgrade).2 + have hyj : (y : PrincipalSubring K) j = 0 := hj ▸ hy + have hmulzero : GradedMonoid.GMul.mul + ((x : PrincipalSubring K) i) + ((y : PrincipalSubring K) j) = 0 := by + rw [hyj] + exact DirectSum.GNonUnitalNonAssocSemiring.mul_zero _ + rw [hmulzero, map_zero] + rfl + · rw [DirectSum.of_apply] + simp [hgrade] + +/-- Membership in `(P̂_{<ω})₊` is vanishing of the degree-zero component. -/ +@[simp] +theorem mem_positiveFinitePrincipalIdeal_iff_component_zero (x : principalFiniteDegreePart K) : + x ∈ positiveFinitePrincipalIdeal K ↔ + (x : PrincipalSubring K) 0 = 0 := + Iff.rfl + +/-- Equivalently, every nonzero component of an element of `(P̂_{<ω})₊` has positive degree. -/ +theorem mem_positiveFinitePrincipalIdeal_iff (x : principalFiniteDegreePart K) : + x ∈ positiveFinitePrincipalIdeal K ↔ + ∀ α, (x : PrincipalSubring K) α ≠ 0 → 0 < α := by + constructor + · intro hx α hα + change (x : PrincipalSubring K) 0 = 0 at hx + exact bot_lt_iff_ne_bot.mpr fun hzero ↦ hα (hzero ▸ hx) + · intro hx + change (x : PrincipalSubring K) 0 = 0 + by_contra hzero + exact (lt_irrefl 0) (hx 0 hzero) + +/-! ### The ideal `I = I_{≥1}` and the quotient `P̂/I` -/ + +variable (K) in +/-- The ideal `I = I_{≥1} = (P̂_{<ω})₊ P̂` of `P̂` generated by the elements of positive finite +degree. -/ +abbrev principalFibreIdeal : Ideal (PrincipalSubring K) := + fibreIdeal (principalGrading K) + +/-- The ideal `I` is the least ideal of `P̂` containing `(P̂_{<ω})₊`. -/ +theorem principalFibreIdeal_le_iff (I : Ideal (PrincipalSubring K)) : + principalFibreIdeal K ≤ I ↔ + ∀ x : principalFiniteDegreePart K, + x ∈ positiveFinitePrincipalIdeal K → + (x : PrincipalSubring K) ∈ I := by + classical + constructor + · intro h x hx + refine h ?_ + have hx0 : (x : PrincipalSubring K) 0 = 0 := + (mem_positiveFinitePrincipalIdeal_iff_component_zero x).mp hx + have hfin := (mem_principalFiniteDegreePart_iff _).mp x.2 + rw [← DirectSum.sum_support_of (β := PrincipalComponent K) (x : PrincipalSubring K)] + refine Submodule.sum_mem _ fun α hα ↦ ?_ + have hne : (x : PrincipalSubring K) α ≠ 0 := DFinsupp.mem_support_iff.mp hα + obtain ⟨n, hn⟩ := NatOrdinal.lt_omega0.mp (hfin α hne) + have hn0 : 1 ≤ n := Nat.one_le_iff_ne_zero.mpr fun h0 ↦ + hne (by rw [hn, h0, Nat.cast_zero]; exact hx0) + subst hn + exact mem_idealGE_of_mem _ hn0 (of_mem_principalGrading _ _) + · intro h + change idealGE (principalGrading K) 1 ≤ I + rw [idealGE_eq_span, Ideal.span_le] + intro y hy + obtain ⟨e, he, hye⟩ := (mem_idealGEGenerators_iff _ 1 y).mp hy + obtain ⟨F, rfl⟩ := (DirectSum.mem_rangeLof_iff K _ _ y).mp hye + have hmem : finiteDegreeOf K e F ∈ positiveFinitePrincipalIdeal K := by + rw [mem_positiveFinitePrincipalIdeal_iff_component_zero, coe_finiteDegreeOf] + exact DirectSum.of_eq_of_ne (e : NatOrdinal) 0 F + (Ne.symm (Nat.cast_ne_zero.mpr (Nat.one_le_iff_ne_zero.mp he))) + have hI := h _ hmem + rwa [coe_finiteDegreeOf, ← DirectSum.lof_eq_of K] at hI + +/-- Every element of `(P̂_{<ω})₊` belongs to the ideal `I` of `P̂` it generates. -/ +theorem coe_mem_principalFibreIdeal {x : principalFiniteDegreePart K} + (hx : x ∈ positiveFinitePrincipalIdeal K) : + (x : PrincipalSubring K) ∈ principalFibreIdeal K := + (principalFibreIdeal_le_iff _).mp le_rfl x hx + +variable (K) in +/-- The quotient `P̂/I` by the ideal `I = I_{≥1}` (the Lean noun is +"fibre": `P̂/I ≅ P̂ ⊗_{P̂_{<ω}} K` is the fibre of `P̂` over `P̂_{<ω} → K`). It is a definitional +alias rather than a reducible abbreviation, so that instance search on `P̂/I` stops here instead +of unfolding the quotient of the direct sum of components at every use. -/ +@[expose] def PrincipalFibre : Type (max 1 v) := + Fibre (principalGrading K) + +instance principalFibreCommRing : CommRing (PrincipalFibre K) := + inferInstanceAs (CommRing (Fibre (principalGrading K))) + +instance principalFibreAlgebra : Algebra K (PrincipalFibre K) := + inferInstanceAs (Algebra K (Fibre (principalGrading K))) + +variable (K) in +/-- The quotient map `π : P̂ → P̂/I`. -/ +abbrev principalFibreMap : + PrincipalSubring K →ₐ[K] PrincipalFibre K := + fibreMap (principalGrading K) + +/-- The quotient map `π : P̂ → P̂/I` is the usual ideal-quotient constructor on elements. -/ +theorem principalFibreMap_apply (x : PrincipalSubring K) : + principalFibreMap K x = + Ideal.Quotient.mk (principalFibreIdeal K) x := + (rfl) + +variable (K) in +/-- The kernel of `π : P̂ → P̂/I` is exactly `I`. -/ +@[simp] +theorem principalFibreMap_ker : + RingHom.ker (principalFibreMap K : + PrincipalSubring K →+* PrincipalFibre K) = + principalFibreIdeal K := + Ideal.Quotient.mkₐ_ker K (principalFibreIdeal K) + +/-- A class in `P̂/I` vanishes exactly when its representative lies in `I`. -/ +@[simp] +theorem principalFibreMap_eq_zero_iff (x : PrincipalSubring K) : + principalFibreMap K x = 0 ↔ x ∈ principalFibreIdeal K := + Ideal.Quotient.eq_zero_iff_mem + +variable (K) in +/-- The quotient map `π : P̂ → P̂/I` is surjective. -/ +theorem principalFibreMap_surjective : + Function.Surjective (principalFibreMap K) := + Ideal.Quotient.mkₐ_surjective K (principalFibreIdeal K) + +/-! ### Multiplication of components of finite degree and the decomposables -/ + +variable (K) in +/-- Multiplication `P_m × P_n → P_{m+n}` of two components of finite degree, with output degree the +natural number `m + n`. -/ +def principalComponentMulNat (m n : ℕ) : + PrincipalComponent K (m : NatOrdinal) → PrincipalComponent K (n : NatOrdinal) → + PrincipalComponent K ((m + n : ℕ) : NatOrdinal) := + fun x y ↦ + LinearEquiv.cast (R := K) (Nat.cast_add m n).symm (principalComponentMul x y) + +/-- Multiplication `P_m × P_n → P_{m+n}` is fixed-component multiplication transported across the +equality between the cast of `m + n` and the sum of the casts of `m` and `n`. -/ +theorem principalComponentMulNat_apply (m n : ℕ) + (x : PrincipalComponent K (m : NatOrdinal)) + (y : PrincipalComponent K (n : NatOrdinal)) : + principalComponentMulNat K m n x y = + LinearEquiv.cast (R := K) (Nat.cast_add m n).symm + (principalComponentMul x y) := + (rfl) + +/-- Multiplication in `P̂_{<ω}` agrees with multiplication +`P_m × P_n → P_{m+n}` of components. -/ +theorem finiteDegreeOf_mul (m n : ℕ) + (x : PrincipalComponent K (m : NatOrdinal)) + (y : PrincipalComponent K (n : NatOrdinal)) : + finiteDegreeOf K m x * finiteDegreeOf K n y = + finiteDegreeOf K (m + n) + (principalComponentMulNat K m n x y) := by + apply Subtype.ext + change ((finiteDegreeOf K m x : + principalFiniteDegreePart K) : PrincipalSubring K) * + ((finiteDegreeOf K n y : + principalFiniteDegreePart K) : PrincipalSubring K) = + ((finiteDegreeOf K (m + n) + (principalComponentMulNat K m n x y) : + principalFiniteDegreePart K) : PrincipalSubring K) + rw [coe_finiteDegreeOf, coe_finiteDegreeOf, + coe_finiteDegreeOf, DirectSum.of_mul_of] + apply DirectSum.of_eq_of_gradedMonoid_eq + have hmulEq : GradedMonoid.GMul.mul x y = principalComponentMul x y := + (principalComponentMul_eq_componentMul x y).symm + rw [hmulEq] + change (⟨(m : NatOrdinal) + (n : NatOrdinal), principalComponentMul x y⟩ : + GradedMonoid (PrincipalComponent K)) = + ⟨((m + n : ℕ) : NatOrdinal), principalComponentMulNat K m n x y⟩ + exact Sigma.ext (Nat.cast_add m n).symm (heq_of_cast_eq _ rfl) + +variable [CharZero K] in +/-- Multiplication of nonzero vectors of finite degree is nonzero: the ordinal value is +multiplicative (Berarducci, Theorem 9.7). -/ +theorem principalComponentMulNat_ne_zero {m n : ℕ} {x : PrincipalComponent K (m : NatOrdinal)} + {y : PrincipalComponent K (n : NatOrdinal)} + (hx : x ≠ 0) (hy : y ≠ 0) : + principalComponentMulNat K m n x y ≠ 0 := by + rw [principalComponentMulNat] + rw [← map_zero (LinearEquiv.cast (R := K) (M := PrincipalComponent K) + (Nat.cast_add m n).symm)] + apply (LinearEquiv.cast (R := K) (M := PrincipalComponent K) + (Nat.cast_add m n).symm).injective.ne + rw [principalComponentMul_eq_componentMul] + exact MaxAddDegree.componentMul_ne_zero + (ordinalValueDegreeValuation K) x y hx hy + +variable (K) in +/-- The subspace `(P̂_{<ω})₊² ∩ P_n = ∑_{i,j ≥ 1, i+j=n} P_i P_j` of decomposables of `P_n`: the +decomposable part of the internal grading in degree `n`, read inside the component through the +homogeneous inclusion. -/ +abbrev decomposablePrincipalComponent (n : ℕ) : + Submodule K (PrincipalComponent K (n : NatOrdinal)) := + (decomposable (principalGrading K) n).comap + (DirectSum.lof K NatOrdinal (PrincipalComponent K) (n : NatOrdinal)) + +/-- A homogeneous vector is decomposable exactly when its inclusion is a decomposable +element of `P̂`. -/ +theorem mem_decomposablePrincipalComponent_iff + (n : ℕ) (x : PrincipalComponent K (n : NatOrdinal)) : + x ∈ decomposablePrincipalComponent K n ↔ + DirectSum.of (PrincipalComponent K) (n : NatOrdinal) x ∈ + decomposable (principalGrading K) n := by + rw [Submodule.mem_comap, DirectSum.lof_eq_of] + +/-- A product of two homogeneous components of positive finite degree belongs to the decomposables +`(P̂_{<ω})₊² ∩ P_{i+j}`. -/ +theorem principalComponentMulNat_mem_decomposable {i j : ℕ} (hi : 0 < i) (hj : 0 < j) + (x : PrincipalComponent K (i : NatOrdinal)) + (y : PrincipalComponent K (j : NatOrdinal)) : + principalComponentMulNat K i j x y ∈ + decomposablePrincipalComponent K (i + j) := by + rw [mem_decomposablePrincipalComponent_iff] + have h := congrArg Subtype.val (finiteDegreeOf_mul i j x y) + rw [Subalgebra.coe_mul, coe_finiteDegreeOf, coe_finiteDegreeOf, coe_finiteDegreeOf] at h + rw [← h] + exact mul_mem_decomposable _ hi hj (of_mem_principalGrading _ _) (of_mem_principalGrading _ _) + +variable (K) in +/-- There are no decomposables in degrees zero and one. -/ +theorem decomposablePrincipalComponent_eq_bot_of_le_one {n : ℕ} (hn : n ≤ 1) : + decomposablePrincipalComponent K n = ⊥ := by + rw [eq_bot_iff] + intro z hz + rw [mem_decomposablePrincipalComponent_iff] at hz + have hle : decomposable (principalGrading K) n ≤ ⊥ := + decomposable_le _ fun i j hi hj hij ↦ (by omega : False).elim + rw [Submodule.mem_bot] + exact DirectSum.of_injective (n : NatOrdinal) + (((Submodule.mem_bot K).mp (hle hz)).trans (map_zero _).symm) + +variable (K) in +/-- There are no decomposables in degree zero. -/ +@[simp] +theorem decomposablePrincipalComponent_zero : + decomposablePrincipalComponent K 0 = ⊥ := + decomposablePrincipalComponent_eq_bot_of_le_one K (Nat.zero_le 1) + +variable (K) in +/-- There are no decomposables in degree one: `(P̂_{<ω})₊² ∩ P_1 = 0`. -/ +@[simp] +theorem decomposablePrincipalComponent_one : + decomposablePrincipalComponent K 1 = ⊥ := + decomposablePrincipalComponent_eq_bot_of_le_one K le_rfl + +variable (K) in +/-- The quotient `P_n / ((P̂_{<ω})₊² ∩ P_n)` of a finite-degree component by its +decomposables. -/ +abbrev PrincipalIndecomposableQuotient (n : ℕ) := + PrincipalComponent K (n : NatOrdinal) ⧸ decomposablePrincipalComponent K n + +variable (K) in +/-- The quotient map `P_n → P_n / ((P̂_{<ω})₊² ∩ P_n)`. -/ +def principalIndecomposableMk (n : ℕ) : + PrincipalComponent K (n : NatOrdinal) →ₗ[K] + PrincipalIndecomposableQuotient K n := + (decomposablePrincipalComponent K n).mkQ + +variable (K) in +/-- The kernel of `P_n → P_n / ((P̂_{<ω})₊² ∩ P_n)` is exactly the decomposables. -/ +@[simp] +theorem principalIndecomposableMk_ker (n : ℕ) : + LinearMap.ker (principalIndecomposableMk K n) = + decomposablePrincipalComponent K n := + by + rw [principalIndecomposableMk, Submodule.ker_mkQ] + +variable (K) in +/-- The quotient map `P_n → P_n / ((P̂_{<ω})₊² ∩ P_n)` is surjective. -/ +theorem principalIndecomposableMk_surjective (n : ℕ) : + Function.Surjective (principalIndecomposableMk K n) := + by + rw [principalIndecomposableMk] + exact Submodule.mkQ_surjective _ + +/-- A class in `P_n / ((P̂_{<ω})₊² ∩ P_n)` vanishes exactly when its representative is +decomposable. -/ +@[simp] +theorem principalIndecomposableMk_eq_zero_iff (n : ℕ) + (x : PrincipalComponent K (n : NatOrdinal)) : + principalIndecomposableMk K n x = 0 ↔ + x ∈ decomposablePrincipalComponent K n := by + rw [← LinearMap.mem_ker, principalIndecomposableMk_ker] + +variable (K) in +/-- A chosen complement `E_n` of the decomposables `(P̂_{<ω})₊² ∩ P_n` in `P_n`. -/ +noncomputable def principalIndecomposableComplement (n : ℕ) : + Submodule K (PrincipalComponent K (n : NatOrdinal)) := + Classical.choose (decomposablePrincipalComponent K n).exists_isCompl + +variable (K) in +/-- The chosen subspace `E_n` is complementary to the decomposables `(P̂_{<ω})₊² ∩ P_n`. -/ +theorem decomposablePrincipalComponent_isCompl_complement (n : ℕ) : + IsCompl (decomposablePrincipalComponent K n) + (principalIndecomposableComplement K n) := + Classical.choose_spec (decomposablePrincipalComponent K n).exists_isCompl + +variable (K) in +/-- The chosen index type for a basis of `E_n`: it indexes `𝓑_n = 𝓑 ∩ P_n`, the elements of degree +`n` of the minimal system. -/ +abbrev PrincipalCoordinateIndex (n : ℕ) := + Module.Free.ChooseBasisIndex K (principalIndecomposableComplement K n) + +variable (K) in +/-- A chosen basis `𝓑_n` of the complement `E_n`. -/ +noncomputable def principalCoordinateBasis (n : ℕ) : + Module.Basis (PrincipalCoordinateIndex K n) K + (principalIndecomposableComplement K n) := + Module.Free.chooseBasis K (principalIndecomposableComplement K n) + +variable (K) in +/-- The chosen complement `E_n` identified with the quotient `P_n / ((P̂_{<ω})₊² ∩ P_n)`. -/ +noncomputable def principalIndecomposableComplementEquiv (n : ℕ) : + principalIndecomposableComplement K n ≃ₗ[K] + PrincipalIndecomposableQuotient K n := + ((decomposablePrincipalComponent K n).quotientEquivOfIsCompl + (principalIndecomposableComplement K n) + (decomposablePrincipalComponent_isCompl_complement K n)).symm + +/-- The complement equivalence sends a vector to its class modulo the decomposables. -/ +@[simp] +theorem principalIndecomposableComplementEquiv_apply (n : ℕ) + (x : principalIndecomposableComplement K n) : + principalIndecomposableComplementEquiv K n x = + (decomposablePrincipalComponent K n).mkQ x := by + rw [principalIndecomposableComplementEquiv] + exact DFunLike.congr_fun + (Submodule.toLinearMap_symm_quotientEquivOfIsCompl + (decomposablePrincipalComponent_isCompl_complement K n)) x + +variable (K) in +/-- The basis of `P_n / ((P̂_{<ω})₊² ∩ P_n)` induced from the chosen basis `𝓑_n` of `E_n`. -/ +noncomputable def principalIndecomposableBasis (n : ℕ) : + Module.Basis (PrincipalCoordinateIndex K n) K + (PrincipalIndecomposableQuotient K n) := + (principalCoordinateBasis K n).map + (principalIndecomposableComplementEquiv K n) + +/-- The functional on `P_n / ((P̂_{<ω})₊² ∩ P_n)` dual to one basis vector `B ∈ 𝓑_n`. -/ +noncomputable def principalCoordinateFunctional (n : ℕ) + (i : PrincipalCoordinateIndex K n) : + Module.Dual K (PrincipalIndecomposableQuotient K n) := + (principalIndecomposableBasis K n).coord i + +/-- The dual functionals form the Kronecker dual family of the basis `𝓑_n`. -/ +@[simp] +theorem principalCoordinateFunctional_basis (n : ℕ) + (i j : PrincipalCoordinateIndex K n) : + principalCoordinateFunctional n i + (principalIndecomposableBasis K n j) = if i = j then 1 else 0 := by + classical + rw [principalCoordinateFunctional, Module.Basis.coord_apply] + simp [Finsupp.single_apply, eq_comm] + +variable (K) in +/-- The minimal system `𝓑` of homogeneous generators of `P̂_{<ω}`, as an index type: an element +`B ∈ 𝓑` is a positive finite degree `n` together with an index into the chosen basis `𝓑_n` of +`E_n`. -/ +abbrev MinimalSystem := + Σ n : {n : ℕ // 0 < n}, PrincipalCoordinateIndex K n + +/-- The degree `deg B` of an element `B ∈ 𝓑`, a positive natural number. -/ +abbrev minimalSystemDegree (x : MinimalSystem K) : ℕ := + x.1 + +/-- Every `B ∈ 𝓑` has positive degree. -/ +theorem minimalSystemDegree_pos (x : MinimalSystem K) : + 0 < minimalSystemDegree x := + x.1.property + +/-- An element `B ∈ 𝓑` as a vector of its component `P_{deg B}`. -/ +noncomputable def minimalSystemComponent (x : MinimalSystem K) : + PrincipalComponent K (minimalSystemDegree x : NatOrdinal) := + (principalCoordinateBasis K x.1 x.2).1 + +theorem minimalSystemComponent_eq (x : MinimalSystem K) : + minimalSystemComponent x = (principalCoordinateBasis K x.1 x.2).1 := + (rfl) + +/-- The class of `B ∈ 𝓑` modulo the decomposables is the corresponding basis vector of +`P_n / ((P̂_{<ω})₊² ∩ P_n)`. -/ +@[simp] +theorem minimalSystemComponent_mkQ (x : MinimalSystem K) : + Submodule.Quotient.mk (minimalSystemComponent x) = + principalIndecomposableBasis K x.1 x.2 := by + rw [minimalSystemComponent, + principalIndecomposableBasis, Module.Basis.map_apply, + principalIndecomposableComplementEquiv_apply] + rfl + +/-- The named quotient map sends `B ∈ 𝓑` to the corresponding basis vector of the quotient of +its component by the decomposables. -/ +@[simp] +theorem principalIndecomposableMk_minimalSystemComponent + (x : MinimalSystem K) : + principalIndecomposableMk K + (minimalSystemDegree x) + (minimalSystemComponent x) = + principalIndecomposableBasis K x.1 x.2 := by + rw [principalIndecomposableMk] + exact minimalSystemComponent_mkQ x + +/-- The functional on `P_{deg B} / ((P̂_{<ω})₊² ∩ P_{deg B})` dual to `B ∈ 𝓑`. -/ +noncomputable def minimalSystemFunctional (x : MinimalSystem K) : + Module.Dual K (PrincipalIndecomposableQuotient K x.1) := + principalCoordinateFunctional x.1 x.2 + +/-- `B ∈ 𝓑` evaluates to one under its dual functional. -/ +@[simp] +theorem minimalSystemFunctional_self (x : MinimalSystem K) : + minimalSystemFunctional x + (principalIndecomposableBasis K x.1 x.2) = 1 := by + rw [minimalSystemFunctional, + principalCoordinateFunctional_basis] + simp + +/-- The dual functional of `B ∈ 𝓑_n` evaluates the basis `𝓑_n` by the Kronecker formula. -/ +@[simp] +theorem minimalSystemFunctional_basis + (n : {n : ℕ // 0 < n}) (i j : PrincipalCoordinateIndex K n) : + minimalSystemFunctional ⟨n, i⟩ + (principalIndecomposableBasis K n j) = + if i = j then 1 else 0 := by + rw [minimalSystemFunctional, + principalCoordinateFunctional_basis] + +variable (K) in +/-- In degree one the chosen complement is the whole component `P_1`: `(P̂_{<ω})₊² ∩ P_1 = 0`, there +being no two positive degrees with sum one. -/ +theorem principalIndecomposableComplement_one_eq_top : + principalIndecomposableComplement K 1 = ⊤ := by + have h := decomposablePrincipalComponent_isCompl_complement K 1 + rw [decomposablePrincipalComponent_one] at h + have hsup := h.sup_eq_top + rwa [bot_sup_eq] at hsup + +variable (K) in +/-- `𝓑_1 = 𝓑 ∩ P_1` is a `K`-basis of the whole component `P_1`. Its coordinate representation +expands every element of `P_1` in the elements of `𝓑` of degree one. -/ +noncomputable def principalCoordinateBasisOne : + Module.Basis (PrincipalCoordinateIndex K 1) K + (PrincipalComponent K ((1 : ℕ) : NatOrdinal)) := + (principalCoordinateBasis K 1).map + ((LinearEquiv.ofEq _ _ (principalIndecomposableComplement_one_eq_top K)).trans + (Submodule.topEquiv)) + +/-- The basis vectors of `P_1` are the elements of `𝓑` of degree one. -/ +@[simp] +theorem principalCoordinateBasisOne_apply (i : PrincipalCoordinateIndex K 1) : + principalCoordinateBasisOne K i = + minimalSystemComponent ⟨⟨1, Nat.one_pos⟩, i⟩ := by + rw [principalCoordinateBasisOne, Module.Basis.map_apply, LinearEquiv.trans_apply] + rfl + +/-- Every `B ∈ 𝓑` is a nonzero vector of its component. -/ +theorem minimalSystemComponent_ne_zero (x : MinimalSystem K) : + minimalSystemComponent x ≠ 0 := by + rw [minimalSystemComponent] + intro hzero + apply (principalCoordinateBasis K x.1).ne_zero x.2 + exact Subtype.ext hzero + +/-- An element `B ∈ 𝓑` regarded as an element of `P̂_{<ω}`. -/ +noncomputable def minimalSystemElement (x : MinimalSystem K) : + principalFiniteDegreePart K := + finiteDegreeOf K + (minimalSystemDegree x) + (minimalSystemComponent x) + +/-- `B ∈ 𝓑` is homogeneous of degree `deg B`. -/ +theorem minimalSystemElement_eq (x : MinimalSystem K) : + minimalSystemElement x = + finiteDegreeOf K (minimalSystemDegree x) (minimalSystemComponent x) := + (rfl) + +/-- The element of `P̂` underlying `B ∈ 𝓑` is its homogeneous inclusion. -/ +@[simp] +theorem coe_minimalSystemElement (x : MinimalSystem K) : + ((minimalSystemElement x : + principalFiniteDegreePart K) : PrincipalSubring K) = + DirectSum.of (PrincipalComponent K) + (minimalSystemDegree x : NatOrdinal) + (minimalSystemComponent x) := by + rw [minimalSystemElement, coe_finiteDegreeOf] + +/-- Every `B ∈ 𝓑` belongs to `(P̂_{<ω})₊`. -/ +theorem minimalSystemElement_mem_positive (x : MinimalSystem K) : + minimalSystemElement x ∈ + positiveFinitePrincipalIdeal K := by + change (DirectSum.of (PrincipalComponent K) + (minimalSystemDegree x : NatOrdinal) + (minimalSystemComponent x)) 0 = 0 + rw [DirectSum.of_apply] + split_ifs with hzero + · exact ((Nat.cast_ne_zero.mpr + (Nat.ne_of_gt (minimalSystemDegree_pos x))) hzero).elim + · rfl + +/-- Every `B ∈ 𝓑` is nonzero in `P̂_{<ω}`. -/ +theorem minimalSystemElement_ne_zero (x : MinimalSystem K) : + minimalSystemElement x ≠ 0 := by + intro hzero + apply minimalSystemComponent_ne_zero x + apply finiteDegreeOf_injective K + (minimalSystemDegree x) + rw [map_zero] + exact hzero + +variable (K) in +/-- The evaluation `K[X_B : B ∈ 𝓑] → P̂_{<ω}`, `X_B ↦ B`. -/ +noncomputable def finiteDegreePolynomialEval : + MvPolynomial (MinimalSystem K) K →ₐ[K] + principalFiniteDegreePart K := + MvPolynomial.aeval minimalSystemElement + +/-- The evaluation `K[X_B : B ∈ 𝓑] → P̂_{<ω}` sends each indeterminate `X_B` to `B`. -/ +@[simp] +theorem finiteDegreePolynomialEval_X (x : MinimalSystem K) : + finiteDegreePolynomialEval K (MvPolynomial.X x) = + minimalSystemElement x := by + rw [finiteDegreePolynomialEval, MvPolynomial.aeval_X] + +private theorem finiteDegreeOf_mem_polynomialRange + (n : ℕ) (x : PrincipalComponent K (n : NatOrdinal)) : + finiteDegreeOf K n x ∈ + (finiteDegreePolynomialEval K).range := by + induction n using Nat.strong_induction_on with + | h n ih => + let A := (finiteDegreePolynomialEval K).range + rcases n.eq_zero_or_pos with rfl | hn + · obtain ⟨k, hk⟩ := principalComponentScalarHom_surjective K x + have hk' : principalComponentScalarHom K k = x := by + simpa only [Nat.cast_zero] using hk + refine ⟨MvPolynomial.C k, ?_⟩ + change finiteDegreePolynomialEval K (MvPolynomial.C k) = _ + rw [finiteDegreePolynomialEval, MvPolynomial.aeval_C, + ← hk', finiteDegreeOf_zero_scalar] + · let D := decomposablePrincipalComponent K n + let E := principalIndecomposableComplement K n + have hCompl : IsCompl D E := + decomposablePrincipalComponent_isCompl_complement K n + obtain ⟨d, e, hde, _⟩ := + Submodule.existsUnique_add_of_isCompl hCompl x + rw [← hde, map_add] + apply A.add_mem + · change finiteDegreeOf K n (d : + PrincipalComponent K (n : NatOrdinal)) ∈ A + -- the image of `A` in `P̂` contains every product `P_i P_j` with `i + j = n` + let N : Submodule K (PrincipalSubring K) := + (Subalgebra.toSubmodule A).map (principalFiniteDegreePart K).val.toLinearMap + have hN : decomposable (principalGrading K) n ≤ N := by + refine decomposable_le _ fun i j hi hj hij ↦ Submodule.mul_le.mpr fun a ha b hb ↦ ?_ + obtain ⟨a', rfl⟩ := (DirectSum.mem_rangeLof_iff K _ _ a).mp ha + obtain ⟨b', rfl⟩ := (DirectSum.mem_rangeLof_iff K _ _ b).mp hb + subst hij + refine ⟨finiteDegreeOf K i a' * finiteDegreeOf K j b', + A.mul_mem (ih i (by omega) a') (ih j (by omega) b'), ?_⟩ + rw [AlgHom.toLinearMap_apply, Subalgebra.coe_val, Subalgebra.coe_mul, + coe_finiteDegreeOf, coe_finiteDegreeOf, DirectSum.lof_eq_of, DirectSum.lof_eq_of] + obtain ⟨s, hs, hsd⟩ := hN (Submodule.mem_comap.mp d.2) + rw [AlgHom.toLinearMap_apply, Subalgebra.coe_val] at hsd + have hds : finiteDegreeOf K n (d : PrincipalComponent K (n : NatOrdinal)) = s := by + apply Subtype.ext + rw [coe_finiteDegreeOf, ← DirectSum.lof_eq_of K, ← hsd] + rw [hds] + exact hs + · change finiteDegreeOf K n (e : + PrincipalComponent K (n : NatOrdinal)) ∈ A + let B := principalCoordinateBasis K n + have he : e ∈ Submodule.span K (Set.range B) := by + rw [B.span_eq] + exact Submodule.mem_top + refine Submodule.span_induction (R := K) (M := E) + (s := Set.range B) (p := fun y _ ↦ + finiteDegreeOf K n (y : + PrincipalComponent K (n : NatOrdinal)) ∈ A) ?_ ?_ ?_ ?_ he + · intro z hz + obtain ⟨i, rfl⟩ := hz + let q : MinimalSystem K := ⟨⟨n, hn⟩, i⟩ + refine ⟨MvPolynomial.X q, ?_⟩ + change finiteDegreePolynomialEval K (MvPolynomial.X q) = _ + rw [finiteDegreePolynomialEval_X] + rfl + · change finiteDegreeOf K n (0 : + PrincipalComponent K (n : NatOrdinal)) ∈ A + rw [map_zero] + exact A.zero_mem + · intro y z _ _ hy hz + simpa using A.add_mem hy hz + · intro k y _ hy + simpa using A.smul_mem hy k + +variable (K) in +/-- The minimal system `𝓑` generates `P̂_{<ω}`: the evaluation `K[X_B : B ∈ 𝓑] → P̂_{<ω}` is +surjective. -/ +theorem finiteDegreePolynomialEval_surjective : + Function.Surjective (finiteDegreePolynomialEval K) := by + intro x + let A := (finiteDegreePolynomialEval K).range + let p : PrincipalSubring K → Prop := fun y ↦ + ∀ hy : ∀ α, y α ≠ 0 → α < NatOrdinal.of Ordinal.omega0, + (⟨y, (mem_principalFiniteDegreePart_iff y).mpr hy⟩ : principalFiniteDegreePart K) ∈ A + have hx : ∀ α, (x : PrincipalSubring K) α ≠ 0 → α < NatOrdinal.of Ordinal.omega0 := + (mem_principalFiniteDegreePart_iff _).mp x.2 + change (⟨(x : PrincipalSubring K), (mem_principalFiniteDegreePart_iff _).mpr hx⟩ : + principalFiniteDegreePart K) ∈ A + refine DFinsupp.induction (p := p) (x : PrincipalSubring K) ?_ ?_ hx + · intro hy + change (0 : principalFiniteDegreePart K) ∈ A + exact A.zero_mem + · intro α b y hyα hb hy hfinite + have hαFinite : α < NatOrdinal.of Ordinal.omega0 := by + apply hfinite α + change (DFinsupp.single α b + y) α ≠ 0 + simp [hyα, hb] + obtain ⟨n, hn⟩ := NatOrdinal.lt_omega0.mp hαFinite + subst α + have hyFinite : ∀ β, y β ≠ 0 → + β < NatOrdinal.of Ordinal.omega0 := by + intro β hyβ + apply hfinite β + by_cases hβ : (n : NatOrdinal) = β + · subst β + simpa [hyα] using hb + · change (DFinsupp.single (n : NatOrdinal) b + y) β ≠ 0 + simpa [DFinsupp.single_apply, hβ] using hyβ + have hsingle := finiteDegreeOf_mem_polynomialRange n b + have hyRange := hy hyFinite + have hsum : + (⟨DFinsupp.single (n : NatOrdinal) b + y, + (mem_principalFiniteDegreePart_iff _).mpr hfinite⟩ : principalFiniteDegreePart K) = + finiteDegreeOf K n b + + (⟨y, (mem_principalFiniteDegreePart_iff y).mpr hyFinite⟩ : + principalFiniteDegreePart K) := by + apply Subtype.ext + change DFinsupp.single (n : NatOrdinal) b + y = + ((finiteDegreeOf K n b : + principalFiniteDegreePart K) : PrincipalSubring K) + + (show PrincipalSubring K from y) + rw [coe_finiteDegreeOf] + ext β + simp only [DFinsupp.add_apply, DirectSum.add_apply] + rw [DirectSum.of_apply, DFinsupp.single_apply] + rw [hsum] + exact A.add_mem hsingle hyRange + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalIdealGE.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalIdealGE.lean new file mode 100644 index 0000000000..2bee51f153 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalIdealGE.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalGraded + +/-! +# The ideals `I_{≥j}` + +For `j : ℕ`, the ideal `I_{≥j}` of `P̂` is generated by the homogeneous elements of +finite degree at least `j`, that is, by the components `P_e` with `j ≤ e < ω`: + +`I_{≥j} = ∑_{j ≤ e < ω} P_e P̂`. + +These are the ideals `I_{≥j}` of the internal grading of `P̂`. They form a decreasing +multiplicative filtration `I_{≥•}` with `I_{≥0} = P̂` and `I_{≥1} = I`, and a homogeneous element +of `I_{≥j}` vanishes as soon as `j` exceeds the finite part of its degree (the constant term of +its Cantor normal form). +-/ + +open scoped DirectSum NatOrdinal + +universe v + +public noncomputable section + +namespace Berarducci + +open Berarducci LoweringDerivation + +variable {K : Type v} [Field K] + +variable (K) in +/-- The ideal `I_{≥j} = ∑_{j ≤ e < ω} P_e P̂` generated by the homogeneous elements of finite degree +at least `j`. -/ +abbrev principalIdealGE (j : ℕ) : Ideal (PrincipalSubring K) := + idealGE (principalGrading K) j + +/-- A homogeneous element of finite degree at least `j` belongs to `I_{≥j}`. -/ +theorem principalIdealGEGenerator_mem {j e : ℕ} (hje : j ≤ e) + (F : PrincipalComponent K (e : NatOrdinal)) : + DirectSum.of (PrincipalComponent K) (e : NatOrdinal) F ∈ principalIdealGE K j := + mem_idealGE_of_mem _ hje (of_mem_principalGrading _ F) + +variable (K) in +/-- `I_{≥1} = I = (P̂_{<ω})₊ P̂`. -/ +theorem principalIdealGE_one : principalIdealGE K 1 = principalFibreIdeal K := + (rfl) + +/-- A homogeneous element of `I_{≥j}` whose degree has finite part below `j` is zero. -/ +theorem eq_zero_of_homogeneous_mem_principalIdealGE {j : ℕ} {δ : NatOrdinal} + (hδ : δ.constantCoeff < j) (x : PrincipalComponent K δ) + (hx : DirectSum.of (PrincipalComponent K) δ x ∈ principalIdealGE K j) : x = 0 := + DirectSum.of_injective δ ((eq_zero_of_mem_idealGE_of_constantCoeff_lt _ + (of_mem_principalGrading δ x) hx hδ).trans (map_zero _).symm) + +/-- Every component of an element of `I_{≥j}` in a degree whose finite part is below `j` is +zero. -/ +theorem principalIdealGE_component_eq_zero {j : ℕ} (x : PrincipalSubring K) + (hx : x ∈ principalIdealGE K j) {δ : NatOrdinal} (hδ : δ.constantCoeff < j) : + x δ = 0 := by + refine eq_zero_of_homogeneous_mem_principalIdealGE hδ (x δ) ?_ + have := idealGE_isHomogeneous (principalGrading K) j δ hx + rwa [DirectSum.coe_decompose_rangeLof, DirectSum.lof_eq_of] at this + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalRepresentatives.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalRepresentatives.lean new file mode 100644 index 0000000000..21f731bb23 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalRepresentatives.lean @@ -0,0 +1,260 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OrdinalValueCutoffs +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationExpansion + +/-! +# Translated truncations of polynomials in principal representatives + +Let the lifts `b_B` of the generators be principal series of degree `deg B` (Lean: `σ.lift i` +principal of degree `wt i`, `Lifts.IsPrincipal`). Every translated truncation of a monomial +`X^d(b_𝓑)` at a cutoff `ζ < 0` has ordinal value below `ω^(deg d)`: by the convolution formula +[Ber00, Lem. 7.5], `(X^{d'}(b_𝓑) b_B)^{|ζ}` is congruent modulo `J` to a finite sum of products of +translated truncations, and in every product at least one factor is a translated truncation at a +cutoff `< 0`, whose ordinal value is below `ω^(degree of the factor)` — for `b_B` because it is +principal, for `X^{d'}(b_𝓑)` by induction. Hence, with principal-series representatives, +`v_J(Q(b_𝓑)^{|ζ}) < ω^(deg Q)` for every `ζ < 0` and `Q` homogeneous. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial OrdinalGraded + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +/-- Below `ω^g` one is below some `ω^(b+1)` with `b + 1 ≤ g`. -/ +theorem exists_lt_wpow_add_one_of_lt_wpow {y g : NatOrdinal} (hg : g ≠ 0) (h : y < ω^ g) : + ∃ b, b + 1 ≤ g ∧ y < ω^ (b + 1) := by + obtain ⟨z, hz, n, hn⟩ := (NatOrdinal.lt_wpow_iff hg).mp h + exact ⟨z, Order.add_one_le_of_lt hz, hn.trans (NatOrdinal.wpow_mul_natCast_lt (lt_add_one z) n)⟩ + +namespace Lifts + +/-- The lifts are principal series of the degrees of the generators. -/ +def IsPrincipal (σ : Lifts wt x) : Prop := + ∀ i, HahnSeries.Nonpositive.IsPrincipal (σ.lift i) ∧ + (σ.lift i : K⟦ℝ⟧).degree = (wt i : WithBot NatOrdinal) + +/-- A lift family is principal exactly when each lift is principal of its assigned degree. -/ +theorem isPrincipal_iff (σ : Lifts wt x) : + IsPrincipal σ ↔ ∀ i, HahnSeries.Nonpositive.IsPrincipal (σ.lift i) ∧ + (σ.lift i : K⟦ℝ⟧).degree = (wt i : WithBot NatOrdinal) := + Iff.rfl + +/-- Principal-series representatives exist for a minimal system of homogeneous generators. -/ +theorem exists_isPrincipal + (hx : IsMinimalSystem (Berarducci.principalGrading K) wt x) : + ∃ σ : Lifts wt x, σ.IsPrincipal := by + classical + have hne : ∀ i, x i ≠ 0 := fun i h0 ↦ by + have := hx.independent (wt i) (Finsupp.single i 1) (fun j hj ↦ by + rw [Finsupp.mem_support_single] at hj + rw [hj.1]) (by rw [Finsupp.linearCombination_single, h0, smul_zero]; exact zero_mem _) + exact one_ne_zero (Finsupp.single_eq_zero.mp this) + have h : ∀ i, ∃ p : Series K, Represents p (wt i) (x i) ∧ + HahnSeries.Nonpositive.IsPrincipal p ∧ (p : K⟦ℝ⟧).degree = (wt i : WithBot NatOrdinal) := by + intro i + obtain ⟨a, ha⟩ := (DirectSum.mem_rangeLof_iff K _ _ _).mp (hx.mem i) + rw [DirectSum.lof_eq_of] at ha + have ha0 : a ≠ 0 := fun h ↦ hne i (by rw [← ha, h, map_zero]) + obtain ⟨p, hp, hprin, hdeg, hpa⟩ := exists_principal_representative_of_ne_zero (wt i) a ha0 + exact ⟨p, represents_iff.mpr ⟨hp, by rw [hpa, ha]⟩, hprin, hdeg⟩ + choose p hp hprin hdeg using h + exact ⟨⟨p, hp⟩, fun i ↦ ⟨hprin i, hdeg i⟩⟩ + +variable {σ : Lifts wt x} (hσ : σ.IsPrincipal) +include hσ + +/-- A translated truncation of a principal-series representative at a cutoff `ζ < 0` has ordinal +value below `ω^(wt i)`. -/ +theorem IsPrincipal.ordinalValue_translatedTruncation_lift_lt (i : ι) {ζ : ℝ} (hζ : ζ < 0) : + ordinalValue (translatedTruncation (σ.lift i : K⟦ℝ⟧) ζ) < ω^ (wt i) := + ordinalValue_translatedTruncation_lt_of_isPrincipal (hσ i).1 (hσ i).2 hζ + +omit hσ in +/-- The product of a series of ordinal value below `ω^(a+1)` and one of ordinal value below `ω^g`, +`g ≠ 0`, has ordinal value below `ω^(a ⊕ g)`. -/ +theorem ordinalValue_mul_lt_wpow_add {u v : Series K} {a g : NatOrdinal} (hg : g ≠ 0) + (hu : ordinalValue u < ω^ (a + 1)) (hv : ordinalValue v < ω^ g) : + ordinalValue (u * v) < ω^ (a + g) := by + obtain ⟨b, hb, hvb⟩ := exists_lt_wpow_add_one_of_lt_wpow hg hv + refine (ordinalValue_mul_lt_wpow_add_one hu hvb).trans_le (NatOrdinal.wpow_le_wpow.mpr ?_) + rw [add_assoc] + exact add_le_add_right hb a + +/-- With principal-series representatives, `v_J((X^d(b_𝓑))^{|ζ}) < ω^(deg d)` for every +cutoff `ζ < 0`. -/ +@[blueprint "lem:principal-representatives-truncation" + (phase := "Translated truncations") + (title := "Translated truncations of monomials in principal series") + (statement := /-- + Let $K$ be a field. For each $i\in I$, let + $x_i\in\mathrm P_{w_i}\subseteq\widehat{\mathrm P}$ and choose a principal + series $b_i$ of degree $w_i$ representing $x_i$, where $w_i\ne0$. Then, + for every monomial $X^d$ and every $\zeta<0$, + \[ + v_J((X^d(b_i))^{|\zeta})<\omega^{\operatorname{wt}(d)}. + \] + -/) + (proof := /-- + Argue by strong induction on the number of factors of $X^d$. The constant + monomial has zero translated truncation. Otherwise write + $X^d=X^{d'}X_i$. By \ref{lem:homogeneous-evaluation-represents}, + $X^{d'}(b_i)$ and $b_i$ satisfy the ordinary ordinal-value bounds, and + \ref{lem:convolution-formula} expresses the translated truncation of their + product as a finite sum modulo $J$. + + Since $\zeta<0$, each convolution summand contains a proper translated + truncation. If its first cutoff is negative, the induction hypothesis lowers + the first factor. At cutoff $0$, the second factor is lowered by + \ref{lem:principal-truncations-lower-value}. Multiplicativity and strict + monotonicity of Hessenberg's natural sum put every product below + $\omega^{\operatorname{wt}(d)}$; the ultrametric inequality gives the same + bound for the finite sum. + -/)] +theorem IsPrincipal.ordinalValue_translatedTruncation_aeval_monomial_lt + (hwt : ∀ i, wt i ≠ 0) (d : ι →₀ ℕ) {ζ : ℝ} (hζ : ζ < 0) : + ordinalValue (translatedTruncation ((aeval σ.lift (monomial d (1 : K)) : Series K) : K⟦ℝ⟧) ζ) < + ω^ (Finsupp.weight wt d) := by + classical + suffices h : ∀ n : ℕ, ∀ d : ι →₀ ℕ, Finsupp.degree d = n → ∀ ζ : ℝ, ζ < 0 → + ordinalValue (translatedTruncation ((aeval σ.lift (monomial d (1 : K)) : Series K) : K⟦ℝ⟧) ζ) + < ω^ (Finsupp.weight wt d) from h _ d rfl ζ hζ + clear hζ ζ + intro n + induction n using Nat.strong_induction_on with + | _ n ih => + intro d hdn ζ hζ + rcases eq_or_ne d 0 with rfl | hd0 + · rw [monomial_zero', C_1, map_one] + have htr : translatedTruncation ((1 : Series K) : K⟦ℝ⟧) ζ = 0 := by + rw [Subring.coe_one, ← HahnSeries.C_one] + exact translatedTruncation_C_of_neg 1 hζ + rw [htr, ordinalValue_zero] + exact NatOrdinal.wpow_pos _ + · -- peel one occurrence `X_i` + obtain ⟨i, hi⟩ := Finsupp.support_nonempty_iff.mpr hd0 + set d' := d - Finsupp.single i 1 with hd'def + have hdd' : d' + Finsupp.single i 1 = d := + Finsupp.sub_add_single_one_cancel (Finsupp.mem_support_iff.mp hi) + have hwd : Finsupp.weight wt d' + wt i = Finsupp.weight wt d := by + rw [← hdd', map_add, Finsupp.weight_single, one_smul] + have hdeg : Finsupp.degree d' < n := by + rw [← hdn, ← hdd', map_add, Finsupp.degree_single] + omega + set M' : Series K := aeval σ.lift (monomial d' (1 : K)) with hM'def + have hprod : aeval σ.lift (monomial d (1 : K)) = M' * σ.lift i := by + rw [← hdd', monomial_add_single_one, map_mul, aeval_X] + -- the a priori bounds on the factors and their translated truncations + have hM' : ordinalValue M' < ω^ (Finsupp.weight wt d' + 1) := + Berarducci.Represents.ordinalValue_lt + (σ.aeval_represents (isWeightedHomogeneous_monomial wt d' (1 : K) rfl)) + have hli : ordinalValue (σ.lift i) < ω^ (wt i + 1) := + Berarducci.Represents.ordinalValue_lt (σ.represents i) + have hterm : ∀ β ∈ convolutionIndex (M' : K⟦ℝ⟧) (σ.lift i : K⟦ℝ⟧) ζ, + ordinalValue (translatedTruncation (M' : K⟦ℝ⟧) β * + translatedTruncation (σ.lift i : K⟦ℝ⟧) (ζ - β)) < ω^ (Finsupp.weight wt d) := by + intro β hβ + obtain ⟨hζβ, hβ0⟩ := mem_Icc_of_mem_convolutionIndex hβ + rcases lt_or_eq_of_le hβ0 with hβneg | rfl + · -- the first factor is a translated truncation at the cutoff `β < 0` + have h1 := ih _ hdeg d' rfl β hβneg + have h2 : ordinalValue (translatedTruncation (σ.lift i : K⟦ℝ⟧) (ζ - β)) < + ω^ (wt i + 1) := by + rcases lt_or_eq_of_le (sub_nonpos.mpr hζβ) with hneg | h0 + · exact (hσ.ordinalValue_translatedTruncation_lift_lt i hneg).trans + (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one _)) + · rw [h0, translatedTruncation_zero] + exact hli + rcases eq_or_ne d' 0 with hd'0 | hd'0 + · -- `X^{d'} = 1`: its translated truncation at `β < 0` vanishes + have h0 : translatedTruncation (M' : K⟦ℝ⟧) β = 0 := by + rw [hM'def, hd'0, monomial_zero', C_1, map_one, Subring.coe_one, ← HahnSeries.C_one] + exact translatedTruncation_C_of_neg 1 hβneg + rw [h0, zero_mul, ordinalValue_zero] + exact NatOrdinal.wpow_pos _ + · have hw0 : Finsupp.weight wt d' ≠ 0 := by + obtain ⟨j, hj⟩ := Finsupp.support_nonempty_iff.mpr hd'0 + intro h0 + have := Finsupp.le_weight_of_mem_support wt d' hj + rw [h0] at this + exact hwt j (le_antisymm this zero_le) + have := ordinalValue_mul_lt_wpow_add (u := translatedTruncation (σ.lift i : K⟦ℝ⟧) (ζ - β)) + (v := translatedTruncation ((aeval σ.lift (monomial d' (1 : K)) : Series K) : K⟦ℝ⟧) β) + (a := wt i) (g := Finsupp.weight wt d') hw0 h2 h1 + rw [mul_comm, add_comm, hwd] at this + exact this + · -- `β = 0`: the second factor is a translated truncation at the cutoff `ζ < 0` + rw [translatedTruncation_zero, sub_zero] + have := ordinalValue_mul_lt_wpow_add (hwt i) hM' + (hσ.ordinalValue_translatedTruncation_lift_lt i hζ) + rwa [hwd] at this + -- the translated truncation of the product is congruent modulo `J` to the convolution sum + have hgerm : toGerm (translatedTruncation ((M' * σ.lift i : Series K) : K⟦ℝ⟧) ζ) = + toGerm (∑ β ∈ convolutionIndex (M' : K⟦ℝ⟧) (σ.lift i : K⟦ℝ⟧) ζ, + translatedTruncation (M' : K⟦ℝ⟧) β * translatedTruncation (σ.lift i : K⟦ℝ⟧) (ζ - β)) := by + rw [← germAt_apply, Subring.coe_mul, germAt_mul_of_subset M' (σ.lift i) ζ subset_rfl, map_sum] + simp only [germAt_apply, map_mul] + rw [hprod, ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (toGerm_eq_toGerm_iff.mp hgerm)] + exact ordinalValue_sum_lt _ _ (NatOrdinal.wpow_pos _) hterm + +/-- With principal-series representatives, `v_J(q(b_𝓑)^{|ζ}) < ω^c` for `q ∈ K[X]` +homogeneous of degree `c` and every cutoff `ζ < 0`. -/ +@[blueprint "lem:principal-representatives-homogeneous-polynomial-truncation" + (phase := "Translated truncations") + (title := "Translated truncations of weighted-homogeneous polynomials") + (statement := /-- + Let $K$ be a field. For each $i\in I$, let + $x_i\in\mathrm P_{w_i}\subseteq\widehat{\mathrm P}$ and choose a principal + series $b_i$ of degree $w_i$ representing $x_i$, where $w_i\ne0$. If + $Q\in K[X_i:i\in I]$ is weighted homogeneous of degree $\sigma$, then, for + every $\zeta<0$, + \[ + v_J((Q(b_i))^{|\zeta})<\omega^\sigma. + \] + -/) + (proof := /-- + Expand $Q$ over its finite monomial support. Every occurring monomial has + weight $\sigma$, so + \ref{lem:principal-representatives-truncation} bounds the ordinal value of its + translated truncation by $\omega^\sigma$. Multiplication by its scalar + coefficient preserves this bound, and the ultrametric inequality gives it + for the finite sum. + -/)] +theorem IsPrincipal.ordinalValue_translatedTruncation_aeval_lt (hwt : ∀ i, wt i ≠ 0) + {q : MvPolynomial ι K} {c : NatOrdinal} (hq : IsWeightedHomogeneous wt q c) {ζ : ℝ} + (hζ : ζ < 0) : + ordinalValue (translatedTruncation ((aeval σ.lift q : Series K) : K⟦ℝ⟧) ζ) < ω^ c := by + classical + have hsplit : translatedTruncation ((aeval σ.lift q : Series K) : K⟦ℝ⟧) ζ = + ∑ d ∈ q.support, (HahnSeries.Nonpositive.C : K →+* Series K) (coeff d q) * + translatedTruncation ((aeval σ.lift (monomial d (1 : K)) : Series K) : K⟦ℝ⟧) ζ := by + conv_lhs => rw [q.as_sum, map_sum] + rw [AddSubmonoidClass.coe_finsetSum, ← translatedTruncationAddMonoidHom_apply, map_sum] + refine Finset.sum_congr rfl fun d _ ↦ ?_ + have hmon : monomial d (coeff d q) = C (coeff d q) * monomial d (1 : K) := by + rw [C_mul_monomial, mul_one] + rw [translatedTruncationAddMonoidHom_apply, hmon, map_mul, aeval_C, + HahnSeries.Nonpositive.algebraMap_apply, Subring.coe_mul, HahnSeries.Nonpositive.coe_C, + translatedTruncation_C_mul] + rw [hsplit] + refine ordinalValue_sum_lt _ _ (NatOrdinal.wpow_pos _) fun d hd ↦ ?_ + have := hσ.ordinalValue_translatedTruncation_aeval_monomial_lt hwt d hζ + rw [hq (mem_support_iff.mp hd)] at this + exact ordinalValue_C_mul_lt _ this + +end Lifts + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductCondition.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductCondition.lean new file mode 100644 index 0000000000..6e115f4bf5 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductCondition.lean @@ -0,0 +1,181 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import + LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan + +/-! +# The translated truncations of a term `u · q(b_𝓑)` satisfy (p) + +Let `q ∈ K[X]` be homogeneous of degree `c`, evaluated at principal-series representatives, and let +`u` be a series +of ordinal value below `ω^(b+1)` whose translated truncations at cutoffs `ζ < 0` have ordinal +value below `ω^b` (for instance a principal series of degree `b`), with `b ⊕ c < α`. The +separation condition (n) for `(b, c, τ)` — `b ⊕ θ < τ` for every `θ < c` — gives, for every +cutoff `ζ ≤ 0`, that `pol((u q(b_𝓑))^{|ζ})_{≥τ}` lies in the ideal `(q)`: the translated +truncations of `u · q(b_𝓑)` satisfy the condition (p) for `(q; τ)`. By the convolution formula, +read in polynomials [Ber00, Lem. 7.5], +`pol((u q(b_𝓑))^{|ζ}) = pol(u^{|ζ}) · q + ∑ pol(u^{|β}) pol(q(b_𝓑)^{|ζ - β})`, the first term lies +in `(q)` and every other term has as a factor the polynomial of a translated truncation of +`q(b_𝓑)` at a cutoff `< 0`, hence has degree below `τ`. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial OrdinalGraded + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +namespace Lifts + +variable (σ : Lifts wt x) (hx : IsMinimalSystem (Berarducci.principalGrading K) wt x) + {α : NatOrdinal} (hinj : ∀ β < α, InjectiveAt K wt x β) (hσ : σ.IsPrincipal) +include hinj hσ + +/-- **High-degree components of translated truncations of a polynomial multiple.** Under the +displayed ordinal-value and Hessenberg-sum bounds, the components of degree at least `τ` of +`pol((u * q(b_𝓑))^{|ζ})` lie in the principal ideal generated by `q`. -/ +@[blueprint "lem:term-truncation-condition" + (phase := "Translated truncations") + (title := "High-degree components of translated truncations of a polynomial multiple") + (statement := /-- + Let $K$ be a field and let $\mathcal B$ be a minimal homogeneous generating + system of $\widehat{\mathrm P}$, with principal representatives $b_B$. + Assume evaluation is injective in every degree below $\alpha$. Let + $Q\in K[X_B:B\in\mathcal B]$ be weighted homogeneous of degree $\sigma$. + Suppose + \[ + v_J(u)<\omega^{\rho+1},\qquad + v_J(u^{|\zeta})<\omega^\rho\quad(\zeta<0), + \] + \[ + \rho\oplus\sigma<\alpha,\qquad + \rho\oplus\theta<\tau\quad(\theta<\sigma). + \] + Then, for every $\xi\le0$, + \[ + \operatorname{pol}_{<\alpha} + \!\left((uQ(b_B))^{|\xi}\right)_{\ge\tau} + \in (Q)\subseteq K[X_B:B\in\mathcal B]. + \] + -/) + (proof := /-- + By \ref{prop:polynomial-representative-exists}, translated truncations of + ordinal value below $\omega^\alpha$ have polynomial representatives of + degree below $\alpha$; \ref{prop:polynomial-evaluation-ordinal-value} gives + the needed uniqueness. + Expand the translated truncation of $uQ(b_B)$ by convolution. The endpoint + term is $\operatorname{pol}_{<\alpha}(u^{|\xi})Q$, so its components of + degree at least $\tau$ lie in $(Q)$. In every other term the $Q(b_B)$ factor + is translated-truncated at a negative cutoff. By + \ref{lem:principal-representatives-homogeneous-polynomial-truncation}, its polynomial + representative has degree below $\sigma$, while the representative of the + $u$ factor has degree at most $\rho$. Thus $\rho\oplus\theta<\tau$ makes the + component of degree at least $\tau$ vanish. Summing proves the claim. + -/)] +theorem componentsGE_pol_translatedTruncation_mul_aeval_mem {q : MvPolynomial ι K} + {c : NatOrdinal} (hq : IsWeightedHomogeneous wt q c) {u : Series K} {b : NatOrdinal} + (hu : ordinalValue u < ω^ (b + 1)) + (hucut : ∀ ζ : ℝ, ζ < 0 → ordinalValue (translatedTruncation (u : K⟦ℝ⟧) ζ) < ω^ b) + (hbc : b + c < α) {τ : NatOrdinal} (hsep : ∀ θ, θ < c → b + θ < τ) {ζ : ℝ} (hζ : ζ ≤ 0) : + componentsGE wt τ + (σ.pol hx α (translatedTruncation ((u * aeval σ.lift q : Series K) : K⟦ℝ⟧) ζ)) ∈ + Ideal.span (Set.range fun _ : Unit ↦ q) := by + classical + have hwt : ∀ i, wt i ≠ 0 := hx.ne_zero + have hbα : b < α := (NatOrdinal.le_add_right).trans_lt hbc + have hcα : c < α := (NatOrdinal.le_add_left).trans_lt hbc + set v : Series K := aeval σ.lift q with hvdef + have hv : ordinalValue v < ω^ (c + 1) := (σ.aeval_represents hq).ordinalValue_lt + have hvcut : ∀ ξ : ℝ, ξ < 0 → ordinalValue (translatedTruncation (v : K⟦ℝ⟧) ξ) < ω^ c := + fun ξ hξ ↦ hσ.ordinalValue_translatedTruncation_aeval_lt hwt hq hξ + -- the convolution index set, with the endpoints added + set S : Finset ℝ := insert 0 (insert ζ (convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) ζ)) with hSdef + have hS1 : convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) ζ ⊆ S := + (Finset.subset_insert _ _).trans (Finset.subset_insert _ _) + have hS2 : ∀ β ∈ S, ζ ≤ β ∧ β ≤ 0 := by + intro β hβ + rw [hSdef, Finset.mem_insert, Finset.mem_insert] at hβ + rcases hβ with rfl | rfl | hβ + · exact ⟨hζ, le_rfl⟩ + · exact ⟨le_rfl, hζ⟩ + · exact mem_Icc_of_mem_convolutionIndex hβ + -- ordinal value bounds on the translated truncations of the factors + have hucut' : ∀ β, β ≤ 0 → ordinalValue (translatedTruncation (u : K⟦ℝ⟧) β) < ω^ (b + 1) := by + intro β hβ + rcases lt_or_eq_of_le hβ with h | rfl + · exact (hucut β h).trans (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one b)) + · rw [translatedTruncation_zero]; exact hu + have hvcut' : ∀ β, β ≤ 0 → ordinalValue (translatedTruncation (v : K⟦ℝ⟧) β) < ω^ (c + 1) := by + intro β hβ + rcases lt_or_eq_of_le hβ with h | rfl + · exact (hvcut β h).trans (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one c)) + · rw [translatedTruncation_zero]; exact hv + have hb1 : b + 1 ≤ α := Order.add_one_le_of_lt hbα + have hc1 : c + 1 ≤ α := Order.add_one_le_of_lt hcα + -- the a priori ordinal value bound on the translated truncation of the product + have hprod : ordinalValue (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) ζ) < ω^ α := by + have hgerm : toGerm (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) ζ) = + toGerm (∑ β ∈ S, translatedTruncation (u : K⟦ℝ⟧) β * + translatedTruncation (v : K⟦ℝ⟧) (ζ - β)) := by + rw [← germAt_apply, Subring.coe_mul, germAt_mul_of_subset u v ζ hS1, map_sum] + simp only [germAt_apply, map_mul] + rw [ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (toGerm_eq_toGerm_iff.mp hgerm)] + refine ordinalValue_sum_lt _ _ (NatOrdinal.wpow_pos α) fun β hβ ↦ ?_ + obtain ⟨hζβ, hβ0⟩ := hS2 β hβ + refine (ordinalValue_mul_lt_wpow_add_one (hucut' β hβ0) + (hvcut' (ζ - β) (by linarith))).trans_le (NatOrdinal.wpow_le_wpow.mpr ?_) + exact Order.add_one_le_of_lt hbc + -- the term bounds for the convolution formula + have hterm : ∀ β ∈ S, + ordinalValue (translatedTruncation (u : K⟦ℝ⟧) β) < ω^ α ∧ + ordinalValue (translatedTruncation (v : K⟦ℝ⟧) (ζ - β)) < ω^ α ∧ + DegreeLT wt (σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) β) * + σ.pol hx α (translatedTruncation (v : K⟦ℝ⟧) (ζ - β))) α := by + intro β hβ + obtain ⟨hζβ, hβ0⟩ := hS2 β hβ + have h1 := hucut' β hβ0 + have h2 := hvcut' (ζ - β) (by linarith) + refine ⟨h1.trans_le (NatOrdinal.wpow_le_wpow.mpr hb1), + h2.trans_le (NatOrdinal.wpow_le_wpow.mpr hc1), ?_⟩ + have hdu : DegreeLE wt (σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) β)) b := + degreeLT_add_one_iff_degreeLE.mp (σ.pol_degreeLT_of_lt hx hinj hb1 h1) + have hdv : DegreeLE wt (σ.pol hx α (translatedTruncation (v : K⟦ℝ⟧) (ζ - β))) c := + degreeLT_add_one_iff_degreeLE.mp (σ.pol_degreeLT_of_lt hx hinj hc1 h2) + exact (hdu.mul hdv).degreeLT hbc + rw [σ.pol_translatedTruncation_mul_eq_sum hx hinj hS1 hprod hterm, componentsGE_sum] + refine Ideal.sum_mem _ fun β hβ ↦ ?_ + obtain ⟨hζβ, hβ0⟩ := hS2 β hβ + rcases eq_or_lt_of_le hζβ with rfl | hlt + · -- the term `pol(u^{|ζ}) · q` + rw [sub_self, translatedTruncation_zero, hvdef, σ.pol_aeval hx hinj (hq.degreeLT hcα)] + exact componentsGE_mem_span wt (fun _ : Unit ↦ hq) + (Ideal.mul_mem_left _ _ (Ideal.subset_span ⟨(), rfl⟩)) τ + · -- a translated truncation of `q(b_𝓑)` at a cutoff `< 0`: degree below `τ` + have hdu : DegreeLE wt (σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) β)) b := + degreeLT_add_one_iff_degreeLE.mp (σ.pol_degreeLT_of_lt hx hinj hb1 (hucut' β hβ0)) + have hdv : DegreeLT wt (σ.pol hx α (translatedTruncation (v : K⟦ℝ⟧) (ζ - β))) c := + σ.pol_degreeLT_of_lt hx hinj hcα.le (hvcut (ζ - β) (by linarith)) + rw [componentsGE_eq_zero_of_forall_lt wt fun d hd ↦ ?_] + · exact zero_mem _ + obtain ⟨d₁, hd₁, d₂, hd₂, hw⟩ := exists_add_eq_weight_of_mem_support_mul (wt := wt) hd + rw [← hw] + calc Finsupp.weight wt d₁ + Finsupp.weight wt d₂ + ≤ b + Finsupp.weight wt d₂ := add_le_add_left ((degreeLE_iff).mp hdu d₁ hd₁) _ + _ < τ := hsep _ ((degreeLT_iff).mp hdv d₂ hd₂) + +end Lifts + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductTruncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductTruncation.lean new file mode 100644 index 0000000000..e5ec77901d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductTruncation.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductValues + +/-! +# The translated truncation of a product against that of its first factor + +For nonpositive series `u`, `v` and a cutoff `ζ < 0`, the convolution formula [Ber00, Lem. 7.5] +reads `(u v)^{|ζ} ≡ u^{|ζ} v + ∑_{ζ < β ≤ 0} u^{|β} v^{|ζ - β} (mod J)`. When every translated +truncation of `u` has ordinal value below `ω^(a+1)`, every translated truncation of `v` at a cutoff +`< 0` has ordinal value below `ω^g`, and the separation condition (n) holds for `(a, g, τ)` — +`a ⊕ θ < τ` for every `θ < g` — the sum has ordinal value below `ω^τ`: +`v_J((u v)^{|ζ} - u^{|ζ} v) < ω^τ`. This is the computation behind the terms `u′·Q(b_𝓑)` of a +sum along a sequence of cutoffs and behind the combined cofactors alike. +-/ + +universe v + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- **The convolution formula modulo `J`** (cf. [Ber00, Lem. 7.5]). For `S` containing the +convolution index set, `(u v)^{|ζ} - ∑_{β ∈ S} u^{|β} v^{|ζ - β} ∈ J`. -/ +theorem translatedTruncation_mul_sub_sum_mem_negativeMonomialIdeal (u v : Series K) (ζ : ℝ) + {S : Finset ℝ} (hS : convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) ζ ⊆ S) : + translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) ζ - + ∑ β ∈ S, translatedTruncation (u : K⟦ℝ⟧) β * translatedTruncation (v : K⟦ℝ⟧) (ζ - β) ∈ + Nonpositive.negativeMonomialIdeal K := by + rw [← toGerm_eq_toGerm_iff, ← germAt_apply, Subring.coe_mul, germAt_mul_of_subset u v ζ hS, + map_sum] + simp only [germAt_apply, map_mul] + +/-- **The translated truncation of a product against that of its first factor.** If every +translated truncation of `u` has ordinal value below `ω^(a+1)`, every translated truncation of `v` +at a cutoff `< 0` has ordinal value below `ω^g`, and (n) holds for `(a, g, τ)` (`a ⊕ θ < τ` for +every `θ < g`), then for every cutoff `ζ < 0` the difference `(u v)^{|ζ} - u^{|ζ} v` has ordinal +value below `ω^τ`. -/ +theorem ordinalValue_translatedTruncation_mul_sub_mul_lt {u v : Series K} {a g τ : NatOrdinal} + (hu : ∀ β : ℝ, β ≤ 0 → ordinalValue (translatedTruncation (u : K⟦ℝ⟧) β) < ω^ (a + 1)) + (hv : ∀ β : ℝ, β < 0 → ordinalValue (translatedTruncation (v : K⟦ℝ⟧) β) < ω^ g) + (hsep : ∀ θ, θ < g → a + θ < τ) {ζ : ℝ} (hζ : ζ < 0) : + ordinalValue (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) ζ - + translatedTruncation (u : K⟦ℝ⟧) ζ * v) < ω^ τ := by + classical + set S : Finset ℝ := insert 0 (insert ζ (convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) ζ)) with hSdef + have hS1 : convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) ζ ⊆ S := + (Finset.subset_insert _ _).trans (Finset.subset_insert _ _) + have hζS : ζ ∈ S := Finset.mem_insert_of_mem (Finset.mem_insert_self _ _) + have hS2 : ∀ β ∈ S, ζ ≤ β ∧ β ≤ 0 := by + intro β hβ + rw [hSdef, Finset.mem_insert, Finset.mem_insert] at hβ + rcases hβ with rfl | rfl | hβ + · exact ⟨hζ.le, le_rfl⟩ + · exact ⟨le_rfl, hζ.le⟩ + · exact mem_Icc_of_mem_convolutionIndex hβ + have hmem := translatedTruncation_mul_sub_sum_mem_negativeMonomialIdeal u v ζ hS1 + -- split off the term `β = ζ` + rw [← Finset.add_sum_erase _ _ hζS, sub_self, translatedTruncation_zero] at hmem + have heq : translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) ζ - + translatedTruncation (u : K⟦ℝ⟧) ζ * v = + (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) ζ - + (translatedTruncation (u : K⟦ℝ⟧) ζ * v + ∑ β ∈ S.erase ζ, + translatedTruncation (u : K⟦ℝ⟧) β * translatedTruncation (v : K⟦ℝ⟧) (ζ - β))) + + ∑ β ∈ S.erase ζ, + translatedTruncation (u : K⟦ℝ⟧) β * translatedTruncation (v : K⟦ℝ⟧) (ζ - β) := by + ring + rw [heq] + refine (ordinalValue_add_le_max _ _).trans_lt (max_lt ?_ ?_) + · rw [ordinalValue_of_mem_negativeMonomialIdeal hmem] + exact NatOrdinal.wpow_pos τ + · refine ordinalValue_sum_lt _ _ (NatOrdinal.wpow_pos τ) fun β hβ ↦ ?_ + obtain ⟨hne, hβS⟩ := Finset.mem_erase.mp hβ + obtain ⟨hζβ, hβ0⟩ := hS2 β hβS + have hlt : ζ < β := lt_of_le_of_ne hζβ fun h ↦ hne h.symm + exact ordinalValue_mul_lt_wpow_of_forall_add_lt (hu β hβ0) (hv (ζ - β) (by linarith)) hsep + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductValues.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductValues.lean new file mode 100644 index 0000000000..b9af0eb55d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductValues.lean @@ -0,0 +1,128 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import + LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives + +/-! +# Ordinal values of the translated truncations of a term `u · q(b_𝓑)` + +Let `q ∈ K[X]` be homogeneous of degree `c`, evaluated at principal-series representatives, and let +`u` be a series +of ordinal value below `ω^(b+1)` whose translated truncations at cutoffs `ζ < 0` have ordinal +value below `ω^b`. Under the separation condition (n) for `(b, c, τ)` — `b ⊕ θ < τ` for every +`θ < c` — and `τ ≤ ρ := b ⊕ c`, every translated truncation of the term `u · q(b_𝓑)` at a cutoff +`ζ < 0` has ordinal value below `ω^ρ`: in the convolution formula [Ber00, Lem. 7.5] +`(u q(b_𝓑))^{|ζ} ≡ u^{|ζ} q(b_𝓑) + ∑ u^{|β} q(b_𝓑)^{|ζ - β}` the first term has ordinal value +below `ω^ρ` since `v_J(u^{|ζ}) < ω^b`, and the others have ordinal value below `ω^τ ≤ ω^ρ`. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- A product with a factor of ordinal value below `1` (a factor in `J`) has ordinal value `0`. -/ +theorem ordinalValue_mul_eq_zero_of_lt_one {u v : Series K} (hv : ordinalValue v < 1) : + ordinalValue (u * v) = 0 := by + have hv0 : ordinalValue v = 0 := by + by_contra h + exact absurd (Order.one_le_iff_pos.mpr (pos_iff_ne_zero.mpr h)) (not_le.mpr hv) + rw [ordinalValue_eq_zero_iff] at hv0 ⊢ + exact Ideal.mul_mem_left _ _ hv0 + +/-- The product of a series of ordinal value below `ω^(a+1)` and one of ordinal value below `ω^g` +has ordinal value below `ω^(a ⊕ g)`; for `g = 0` the second factor lies in `J`, and so does the +product. -/ +theorem ordinalValue_mul_lt_wpow_add' {u v : Series K} {a g : NatOrdinal} + (hu : ordinalValue u < ω^ (a + 1)) (hv : ordinalValue v < ω^ g) : + ordinalValue (u * v) < ω^ (a + g) := by + rcases eq_or_ne g 0 with rfl | hg + · rw [NatOrdinal.wpow_zero] at hv + rw [ordinalValue_mul_eq_zero_of_lt_one hv] + exact NatOrdinal.wpow_pos _ + · exact Lifts.ordinalValue_mul_lt_wpow_add hg hu hv + +/-- **The separation condition (n) bounds a product.** If `v_J(u) < ω^(a+1)`, `v_J(v) < ω^g`, and +(n) holds for `(a, g, τ)` (`a ⊕ θ < τ` for every `θ < g`), the product has ordinal value below +`ω^τ`. -/ +theorem ordinalValue_mul_lt_wpow_of_forall_add_lt {u v : Series K} {a g τ : NatOrdinal} + (hu : ordinalValue u < ω^ (a + 1)) (hv : ordinalValue v < ω^ g) + (hsep : ∀ θ, θ < g → a + θ < τ) : ordinalValue (u * v) < ω^ τ := by + rcases eq_or_ne g 0 with rfl | hg + · rw [NatOrdinal.wpow_zero] at hv + rw [ordinalValue_mul_eq_zero_of_lt_one hv] + exact NatOrdinal.wpow_pos _ + · obtain ⟨θ, hθ, hvθ⟩ := exists_lt_wpow_add_one_of_lt_wpow hg hv + exact (ordinalValue_mul_lt_wpow_add_one hu hvθ).trans_le + (NatOrdinal.wpow_le_wpow.mpr (Order.add_one_le_of_lt (hsep θ (Order.add_one_le_iff.mp hθ)))) + +variable {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +namespace Lifts + +variable {σ : Lifts wt x} (hσ : σ.IsPrincipal) +include hσ + +/-- **Translated truncations of a term `u · q(b_𝓑)`.** With principal-series representatives, for +`q` homogeneous of +degree `c`, `u` with `v_J(u) < ω^(b+1)` whose translated truncations at cutoffs `< 0` have ordinal +value below `ω^b`, `ρ = b ⊕ c`, `τ ≤ ρ` and (n) for `(b, c, τ)` (`b ⊕ θ < τ` for every `θ < c`): +every translated truncation of `u · q(b_𝓑)` at a cutoff `ζ < 0` has ordinal value below `ω^ρ`. -/ +theorem IsPrincipal.ordinalValue_translatedTruncation_mul_aeval_lt (hwt : ∀ i, wt i ≠ 0) + {q : MvPolynomial ι K} {c : NatOrdinal} (hq : IsWeightedHomogeneous wt q c) {u : Series K} + {b : NatOrdinal} (hu : ordinalValue u < ω^ (b + 1)) + (hucut : ∀ ζ : ℝ, ζ < 0 → ordinalValue (translatedTruncation (u : K⟦ℝ⟧) ζ) < ω^ b) + {τ ρ : NatOrdinal} (hbc : b + c = ρ) (hτρ : τ ≤ ρ) (hsep : ∀ θ, θ < c → b + θ < τ) {ζ : ℝ} + (hζ : ζ < 0) : + ordinalValue (translatedTruncation ((u * aeval σ.lift q : Series K) : K⟦ℝ⟧) ζ) < ω^ ρ := by + classical + set v : Series K := aeval σ.lift q with hvdef + have hv : ordinalValue v < ω^ (c + 1) := (σ.aeval_represents hq).ordinalValue_lt + have hvcut : ∀ ξ : ℝ, ξ < 0 → ordinalValue (translatedTruncation (v : K⟦ℝ⟧) ξ) < ω^ c := + fun ξ hξ ↦ hσ.ordinalValue_translatedTruncation_aeval_lt hwt hq hξ + set S : Finset ℝ := insert 0 (insert ζ (convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) ζ)) with hSdef + have hS1 : convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) ζ ⊆ S := + (Finset.subset_insert _ _).trans (Finset.subset_insert _ _) + have hS2 : ∀ β ∈ S, ζ ≤ β ∧ β ≤ 0 := by + intro β hβ + rw [hSdef, Finset.mem_insert, Finset.mem_insert] at hβ + rcases hβ with rfl | rfl | hβ + · exact ⟨hζ.le, le_rfl⟩ + · exact ⟨le_rfl, hζ.le⟩ + · exact mem_Icc_of_mem_convolutionIndex hβ + have hucut' : ∀ β, β ≤ 0 → ordinalValue (translatedTruncation (u : K⟦ℝ⟧) β) < ω^ (b + 1) := by + intro β hβ + rcases lt_or_eq_of_le hβ with h | rfl + · exact (hucut β h).trans (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one b)) + · rw [translatedTruncation_zero]; exact hu + have hgerm : toGerm (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) ζ) = + toGerm (∑ β ∈ S, translatedTruncation (u : K⟦ℝ⟧) β * + translatedTruncation (v : K⟦ℝ⟧) (ζ - β)) := by + rw [← germAt_apply, Subring.coe_mul, germAt_mul_of_subset u v ζ hS1, map_sum] + simp only [germAt_apply, map_mul] + rw [ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (toGerm_eq_toGerm_iff.mp hgerm)] + refine ordinalValue_sum_lt _ _ (NatOrdinal.wpow_pos ρ) fun β hβ ↦ ?_ + obtain ⟨hζβ, hβ0⟩ := hS2 β hβ + rcases eq_or_lt_of_le hζβ with rfl | hlt + · -- the term `u^{|ζ} · q(b_𝓑)`: the translated truncation of `u` at `ζ < 0` against the whole + -- of `q(b_𝓑)` + rw [sub_self, translatedTruncation_zero, mul_comm, ← hbc, add_comm] + exact ordinalValue_mul_lt_wpow_add' hv (hucut _ hζ) + · -- a translated truncation of `q(b_𝓑)` at a cutoff `< 0`: ordinal value below `ω^τ ≤ ω^ρ` + exact (ordinalValue_mul_lt_wpow_of_forall_add_lt (hucut' β hβ0) (hvcut (ζ - β) (by linarith)) + hsep).trans_le (NatOrdinal.wpow_le_wpow.mpr hτρ) + +end Lifts + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/RealPartials.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/RealPartials.lean new file mode 100644 index 0000000000..7338baf274 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/RealPartials.lean @@ -0,0 +1,227 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.AlgebraicIndependence +public import + LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRepresentatives +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Partials + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# The real partial-derivative argument + +The polynomiality induction for the Cantor–Bendixson degree is generic. For real exponents, a +relation whose degree is a limit ordinal in the generic Hahn ring gives the corresponding relation +in `P̂` after replacing an eventual left-neighborhood statement by an interval `(-ε, 0)`. The +required partial-derivative decomposition then follows from real translated truncations. +-/ + +universe v w + +open scoped HahnSeries NatOrdinal Topology + +open Filter Berarducci HahnSeries MvPolynomial + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] [CharZero K] +variable {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} +variable {σ : Lifts wt x} {α : NatOrdinal} + +namespace Lifts + +namespace RealPartialDecomposition + +variable (S : HahnSeries.Germ.LimitOrdinalRelationAtCutoff σ.cantorBendixson α) + +/-- A generic relation of limit-ordinal degree reinterpreted in the real principal subring. -/ +@[expose] def principal : σ.LimitOrdinalRelationAtCutoff α := by + let hex := eventually_nhdsLT_iff_exists.mp S.truncation_lt + let l := Classical.choose hex + have hl := (Classical.choose_spec hex).1 + have htrunc := (Classical.choose_spec hex).2 + refine + { F := S.F + hom := S.hom + eval_zero := ?_ + ne_zero := S.ne_zero + vars_lt := S.vars_lt + vars_limit := S.vars_limit + B₀ := S.B₀ + mem := S.mem + max := S.max + β := S.β + degHD := S.degHD + hdegHD := S.hdegHD + degHD_terms := S.degHD_terms + degHD_ne_zero := S.degHD_ne_zero + term_lt := S.term_lt + lam₀ := S.lam₀ + lam₀_lt := S.lam₀_lt + α₁ := S.α₁ + α₁_le := S.α₁_le + α₁_le_α := S.α₁_le_α + ε₁ := -l + ε₁_pos := neg_pos.mpr hl + truncation_lt := ?_ + remainder_lt := S.remainder_lt } + · apply principalSubringCantorBendixsonAlgEquiv.injective + rw [map_zero, principalSubringCantorBendixsonAlgEquiv_aeval, S.eval_zero] + · intro γ hγl hγ0 + apply (ordinalValueDegree_lt_coe_iff _ _).mp + rw [show -l = -l by rfl] at hγl + have hcb := htrunc γ (by linarith) hγ0 + rw [show σ.cantorBendixson.lift = σ.lift by + funext i + exact cantorBendixson_lift σ i] at hcb + rw [ordinalValueDegree_eq_cantorBendixsonDegree] + simpa only [translatedTruncLE_eq_translatedTruncation] using hcb + +@[simp] +theorem principal_F : (principal S).F = S.F := rfl + +@[simp] +theorem principal_B₀ : (principal S).B₀ = S.B₀ := rfl + +@[simp] +theorem principal_lowDegreePartEq (i : ι) : + (principal S).LowDegreePartEq i ↔ S.LowDegreePartEq i := by + rw [Berarducci.Lifts.LimitOrdinalRelationAtCutoff.lowDegreePartEq_iff, + HahnSeries.Germ.LimitOrdinalRelationAtCutoff.lowDegreePartEq_iff, + Berarducci.Lifts.LimitOrdinalRelationAtCutoff.degLT_def, + Berarducci.Lifts.LimitOrdinalRelationAtCutoff.αLT_def, + HahnSeries.Germ.LimitOrdinalRelationAtCutoff.degLT_def, + HahnSeries.Germ.LimitOrdinalRelationAtCutoff.αLT_def] + rfl + +@[simp] +theorem principal_lowDegreePartAlgebraicLE (i : ι) : + (principal S).LowDegreePartAlgebraicLE i ↔ S.LowDegreePartAlgebraicLE i := by + rw [Berarducci.Lifts.LimitOrdinalRelationAtCutoff.lowDegreePartAlgebraicLE_iff, + HahnSeries.Germ.LimitOrdinalRelationAtCutoff.lowDegreePartAlgebraicLE_iff, + Berarducci.Lifts.LimitOrdinalRelationAtCutoff.degLT_def, + HahnSeries.Germ.LimitOrdinalRelationAtCutoff.degLT_def] + rfl + +@[simp] +theorem principal_hasProperLowDegreePartNotAlgebraicLE (i : ι) : + (principal S).HasProperLowDegreePartNotAlgebraicLE i ↔ + S.HasProperLowDegreePartNotAlgebraicLE i := by + rw [Berarducci.Lifts.LimitOrdinalRelationAtCutoff.hasProperLowDegreePartNotAlgebraicLE_iff, + HahnSeries.Germ.LimitOrdinalRelationAtCutoff.hasProperLowDegreePartNotAlgebraicLE_iff] + simp only [principal_F, principal_lowDegreePartEq, principal_lowDegreePartAlgebraicLE, + Berarducci.Lifts.LimitOrdinalRelationAtCutoff.degLT_def, + HahnSeries.Germ.LimitOrdinalRelationAtCutoff.degLT_def] + rfl + +@[simp] +theorem principal_contributesToPartialDerivativeAt (v' v : ι) : + (principal S).ContributesToPartialDerivativeAt v' v ↔ + S.ContributesToPartialDerivativeAt v' v := by + rw [Berarducci.Lifts.LimitOrdinalRelationAtCutoff.contributesToPartialDerivativeAt_iff, + HahnSeries.Germ.LimitOrdinalRelationAtCutoff.contributesToPartialDerivativeAt_iff] + simp only [principal_F, principal_lowDegreePartEq, principal_hasProperLowDegreePartNotAlgebraicLE] + +/-- The partial-derivative decomposition at a variable whose part of the degree below `β` +precedes `λ₀` in the algebraic order. -/ +@[blueprint "lem:real-translated-truncation-partials" + (phase := "Principal RV-elements") + (title := "Transport of the Jacobian syzygy to the Cantor--Bendixson grading") + (statement := /-- + Let $K$ be a field of characteristic zero. Let $(x_i)_{i\in I}$ be a + minimal homogeneous generating system of $\widehat{\mathrm P}$, with + $x_i\in\mathrm P_{w_i}$, and choose principal series $b_i$ of degree + $w_i$ representing $x_i$. Under the canonical isomorphism + \[ + \widehat{\mathrm P}\simeq_K + \operatorname{gr}_{\delta_{\mathrm{CB}}}K((\mathbb R^{\le0})), + \] + write $\bar x_i$ for the image of $x_i$, and assume evaluation at + $(\bar x_i)$ is injective on every homogeneous degree below $\alpha$. + + Let $0\ne F\in K[X_i:i\in I]$ be weighted homogeneous of degree $\alpha$ + with $F(\bar x)=0$. Suppose every variable of $F$ has weight below + $\alpha$ and zero constant Cantor coefficient. Choose $X_{B_0}$ of + maximal weight among the variables of $F$, and put + $D=\deg_{X_{B_0}}F$. Suppose there are ordinals + $\beta,\Delta,\lambda_0,\alpha_1$ such that + \[ + \Delta\ne0,\qquad + \Delta\oplus D w_{B_0}=\alpha,\qquad + \lambda_0<\alpha_{<\beta}, + \] + every Cantor term of $\Delta$ is at least $\omega^\beta$, and the last + Cantor term of $w_{B_0}$ is below $\omega^\beta$. Assume also + \[ + \alpha_1\le\alpha_{\ge\beta}\oplus\lambda_0, + \qquad \alpha_1\le\alpha, + \] + that for all $\gamma<0$ sufficiently close to $0$, + \[ + \delta_{\mathrm{CB}}\bigl(F(b)^{\vert\gamma}\bigr)<\alpha_1, + \] + and that in the convolution expansion of any monomial of $F$, every term + $\rho$ using at least two translated truncations satisfies + $\rho<\alpha_{\ge\beta}\oplus\lambda_0$. + + Let $X_{B'}$ occur in $F$, and suppose + $(w_{B'})_{<\beta}\preccurlyeq\lambda_0$ in the algebraic order. Then + there are a finite set $E$ of variables and + polynomials $(U_B)_{B\in E}$ such that every $B\in E$ occurs in $F$ and + either + \[ + (w_B)_{<\beta}=\alpha_{<\beta}, + \] + or + \[ + 0<(w_B)_{<\beta}\ne\alpha_{<\beta},\qquad + (w_B)_{<\beta}\not\preccurlyeq\lambda_0, + \qquad w_{B'} 0`). -/ +def shift (ξ : ℝ) (u : Series K) : Series K := + if h : ξ ≤ 0 then Nonpositive.single ξ (1 : K) h * u else 0 + +theorem coe_shift_of_le {ξ : ℝ} (hξ : ξ ≤ 0) (u : Series K) : + ((shift ξ u : Series K) : K⟦ℝ⟧) = translate ξ (u : K⟦ℝ⟧) := by + rw [shift, dif_pos hξ, Subring.coe_mul, Nonpositive.coe_single, single_one_mul_eq_translate] + +theorem shift_mul {ξ : ℝ} (hξ : ξ ≤ 0) (u v : Series K) : + shift ξ u * v = shift ξ (u * v) := by + rw [shift, shift, dif_pos hξ, dif_pos hξ, mul_assoc] + +/-- The translated truncation of a shift: `(t^ξ u)^{|ζ} = u^{|ζ - ξ}`. -/ +theorem translatedTruncation_shift {ξ : ℝ} (hξ : ξ ≤ 0) (u : Series K) (ζ : ℝ) : + translatedTruncation ((shift ξ u : Series K) : K⟦ℝ⟧) ζ = + translatedTruncation (u : K⟦ℝ⟧) (ζ - ξ) := by + rw [coe_shift_of_le hξ, translatedTruncation_translate] + +theorem supportOrderType_shift {ξ : ℝ} (hξ : ξ ≤ 0) (u : Series K) : + ((shift ξ u : Series K) : K⟦ℝ⟧).supportOrderType = (u : K⟦ℝ⟧).supportOrderType := by + rw [coe_shift_of_le hξ, supportOrderType_translate] + +/-! ### Sums -/ + +/-- A finite sum of series whose supports have order type below `ω^e` has support of order type +below `ω^e`. -/ +theorem supportOrderType_sum_lt_wpow {ι' : Type*} (s : Finset ι') (f : ι' → Series K) + {e : NatOrdinal} (h : ∀ i ∈ s, ((f i : Series K) : K⟦ℝ⟧).supportOrderType < (ω^ e).val) : + ((∑ i ∈ s, f i : Series K) : K⟦ℝ⟧).supportOrderType < (ω^ e).val := by + classical + induction s using Finset.induction_on with + | empty => + rw [Finset.sum_empty, Subring.coe_zero, supportOrderType_eq_setOrderType] + simp only [HahnSeries.support_zero] + rw [(Set.isPWO_empty.orderType_eq_zero).mpr rfl] + exact Ordinal.opow_pos _ Ordinal.omega0_pos + | insert a s ha ih => + rw [Finset.sum_insert ha, Subring.coe_add] + refine (supportOrderType_add_le_naturalAdd _ _).trans_lt ?_ + have h1 : NatOrdinal.of ((f a : Series K) : K⟦ℝ⟧).supportOrderType < ω^ e := by + rw [← NatOrdinal.of_val (ω^ e)] + exact NatOrdinal.of.lt_iff_lt.mpr (h a (Finset.mem_insert_self a s)) + have h2 : NatOrdinal.of ((∑ i ∈ s, f i : Series K) : K⟦ℝ⟧).supportOrderType < ω^ e := by + rw [← NatOrdinal.of_val (ω^ e)] + exact NatOrdinal.of.lt_iff_lt.mpr (ih fun i hi ↦ h i (Finset.mem_insert_of_mem hi)) + exact NatOrdinal.val.lt_iff_lt.mpr (NatOrdinal.add_lt_wpow h1 h2) + +/-! ### Representatives -/ + +theorem Represents.of_eq {u : Series K} {β β' : NatOrdinal} {e : PrincipalSubring K} (h : β = β') + (hu : Represents u β e) : Represents u β' e := by + subst h; exact hu + +/-- A finite sum of representatives represents the sum. -/ +theorem represents_sum {ι' : Type*} (s : Finset ι') (f : ι' → Series K) (β : NatOrdinal) + (e : ι' → PrincipalSubring K) (h : ∀ i ∈ s, Represents (f i) β (e i)) : + Represents (∑ i ∈ s, f i) β (∑ i ∈ s, e i) := by + classical + induction s using Finset.induction_on with + | empty => rw [Finset.sum_empty, Finset.sum_empty]; exact represents_zero β + | insert a s ha ih => + rw [Finset.sum_insert ha, Finset.sum_insert ha] + exact (h a (Finset.mem_insert_self a s)).add (ih fun i hi ↦ h i (Finset.mem_insert_of_mem hi)) + +/-- **Principal representatives.** Every element of `P_β ⊆ P̂` is represented by a series of +support order type at most `ω^β` whose translated truncations at cutoffs `ζ < 0` have ordinal +value below `ω^β`: a principal series of degree `β`, or `0`. -/ +theorem exists_represents_of_mem_principalGrading {β : NatOrdinal} {e : PrincipalSubring K} + (he : e ∈ principalGrading K β) : + ∃ p : Series K, Represents p β e ∧ (p : K⟦ℝ⟧).supportOrderType ≤ (ω^ β).val ∧ + ∀ ζ : ℝ, ζ < 0 → ordinalValue (translatedTruncation (p : K⟦ℝ⟧) ζ) < ω^ β := by + obtain ⟨a, rfl⟩ := (DirectSum.mem_rangeLof_iff K _ β e).mp he + rw [DirectSum.lof_eq_of] + rcases eq_or_ne a 0 with rfl | ha + · refine ⟨0, by rw [map_zero]; exact represents_zero β, ?_, fun ζ _ ↦ ?_⟩ + · rw [Subring.coe_zero, supportOrderType_eq_setOrderType] + simp only [HahnSeries.support_zero] + rw [(Set.isPWO_empty.orderType_eq_zero).mpr rfl] + exact bot_le + · rw [Subring.coe_zero, translatedTruncation_zero_input, ordinalValue_zero] + exact NatOrdinal.wpow_pos β + · obtain ⟨p, hp, hprin, hdeg, hpa⟩ := exists_principal_representative_of_ne_zero β a ha + exact ⟨p, represents_iff.mpr ⟨hp, by rw [hpa]⟩, + (hprin.supportOrderType_eq_wpow_of_degree_eq hdeg).le, + fun ζ hζ ↦ ordinalValue_translatedTruncation_lt_of_isPrincipal hprin hdeg hζ⟩ + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SuccessorLeibniz.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SuccessorLeibniz.lean new file mode 100644 index 0000000000..d7d6719ae5 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SuccessorLeibniz.lean @@ -0,0 +1,205 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAt +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubring +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.LeibnizRemainder + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSubmultiplicative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +import Mathlib.Topology.Instances.Real.Lemmas + +/-! +# The Leibniz rule on the spaces `P_α` + +Let `u ∈ J_{ω^(α+1)}` and `v ∈ J_{ω^(β+1)}` with `α` a successor, and put `δ = α + β`, so that +`δ⁻ = α⁻ + β`. Berarducci's convolution formula writes `(uv)^{|γ}` modulo `J` as the finite sum +of the products `u^{|ξ} v^{|ζ}` over `ξ + ζ = γ`. The pairs `(γ, 0)` and `(0, γ)` contribute +`u^{|γ} v` and `u v^{|γ}`; every other pair has `ξ, ζ ∈ (γ, 0)`, and for `γ` close to zero the +truncation drop gives `v_J(u^{|ξ}) ≤ ω^{α⁻}` and `v_J(v^{|ζ}) < ω^β`, so by submultiplicativity +the product has ordinal value below `ω^{α⁻ + β} = ω^{δ⁻}`. Hence + +`(uv)^{|γ} ≡ u^{|γ} v + u v^{|γ} (mod J_{ω^{δ⁻}})` + +for all `γ < 0` close to zero, and in the component `P_{δ⁻}` indexed by the predecessor of `δ` +this reads +`π_{δ⁻}((uv)^{|γ}) = π_{α⁻}(u^{|γ}) π_β(v) + π_α(u) π_{β⁻}(v^{|γ})`, the last term being zero +when `β` is not a successor because its ordinal value then already lies below `ω^{δ⁻}`. +-/ + +open Filter Topology +open scoped HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace Berarducci + +open Berarducci HahnSeries + +variable {K : Type v} [Field K] + +/-! ### The identity in the homogeneous component `P_{δ⁻}` -/ + +/-- If `v_J(a - b - c) < ω^δ`, then `π_δ(a) = π_δ(b) + π_δ(c)`. -/ +theorem principalComponentMk_eq_add_of_sub_sub_lt (delta : NatOrdinal) {a b c : Series K} + (ha : ordinalValue a < ω^ (delta + 1)) (hb : ordinalValue b < ω^ (delta + 1)) + (hc : ordinalValue c < ω^ (delta + 1)) (h : ordinalValue (a - b - c) < ω^ delta) : + principalComponentMk delta a ha = + principalComponentMk delta b hb + principalComponentMk delta c hc := by + have hbc : ordinalValue (b + c) < ω^ (delta + 1) := + (ordinalValue_add_le_max b c).trans_lt (max_lt hb hc) + rw [← principalComponentMk_add delta b c hb hc hbc, principalComponentMk_eq_iff] + rwa [sub_add_eq_sub_sub] + +/-- Homogeneous inclusions of the same representative in equal grades agree. -/ +theorem of_principalComponentMk_congr_of_eq + {alpha beta : NatOrdinal} (h : alpha = beta) (b : Series K) + (hb : ordinalValue b < ω^ (beta + 1)) : + DirectSum.of (PrincipalComponent K) beta (principalComponentMk beta b hb) = + DirectSum.of (PrincipalComponent K) alpha + (principalComponentMk alpha b (by rw [h]; exact hb)) := by + subst h + rfl + +/-- Multiplication of homogeneous inclusions is homogeneous multiplication. -/ +theorem of_principalComponentMul {alpha beta : NatOrdinal} + (x : PrincipalComponent K alpha) (y : PrincipalComponent K beta) : + DirectSum.of (PrincipalComponent K) (alpha + beta) (principalComponentMul x y) = + DirectSum.of (PrincipalComponent K) alpha x * DirectSum.of (PrincipalComponent K) beta y := by + rw [principalComponentMul_eq_componentMul, DirectSum.of_mul_of] + rfl + +/-- If `β` is not a successor and `β' < β`, then `α + β' < (α + β)⁻`. -/ +private theorem add_lt_removeOne_add_of_constantCoeff_eq_zero + {alpha beta beta' : NatOrdinal} (halpha : 0 < alpha.constantCoeff) + (hbeta : beta.constantCoeff = 0) (hlt : beta' < beta) : + alpha + beta' < (alpha + beta).removeNat 1 := by + have hpos : 0 < (alpha + beta).constantCoeff := by + rw [NatOrdinal.constantCoeff_add]; omega + have hsucc : (alpha + beta).removeNat 1 + 1 = alpha + beta := by + simpa using NatOrdinal.removeNat_add_natCast hpos + have hle : alpha + beta' ≤ (alpha + beta).removeNat 1 := by + rw [← Order.lt_add_one_iff, hsucc] + exact add_lt_add_right hlt alpha + refine lt_of_le_of_ne hle fun heq ↦ ?_ + have hc := congrArg NatOrdinal.constantCoeff heq + rw [NatOrdinal.constantCoeff_add, NatOrdinal.constantCoeff_removeNat, + NatOrdinal.constantCoeff_add, hbeta] at hc + omega + +/-- For `β` not a successor, the term `u v^{|γ}` vanishes in `P_{(α+β)⁻}` near zero. -/ +theorem eventually_ordinalValue_mul_translatedTruncation_lt_of_constantCoeff_eq_zero + {alpha beta : NatOrdinal} (halpha : 0 < alpha.constantCoeff) + (hbeta : beta.constantCoeff = 0) (u v : Series K) + (hu : ordinalValue u < ω^ (alpha + 1)) (hv : ordinalValue v < ω^ (beta + 1)) : + ∀ᶠ γ in 𝓝[<] (0 : ℝ), + ordinalValue (u * translatedTruncation (v : K⟦ℝ⟧) γ) < ω^ ((alpha + beta).removeNat 1) := by + filter_upwards + [eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one + beta v hv] with γ hγ + have hu' : ordinalValue u ≤ ω^ alpha := by + rcases ordinalValue_eq_zero_or_isAdditivelyPrincipal u with hzero | hprin + · rw [hzero]; exact bot_le + · have hxi := Ordinal.natOrdinal_of_eq_wpow_log hprin + rw [NatOrdinal.of_val] at hxi + rw [hxi] at hu ⊢ + exact NatOrdinal.wpow_le_wpow.mpr (Order.lt_add_one_iff.mp (NatOrdinal.wpow_lt_wpow.mp hu)) + rcases ordinalValue_eq_zero_or_isAdditivelyPrincipal (translatedTruncation (v : K⟦ℝ⟧) γ) with + hzero | hprin + · calc ordinalValue (u * translatedTruncation (v : K⟦ℝ⟧) γ) ≤ + ordinalValue u * ordinalValue (translatedTruncation (v : K⟦ℝ⟧) γ) := + ordinalValue_mul_le_naturalMul _ _ + _ = 0 := by rw [hzero, mul_zero] + _ < _ := NatOrdinal.wpow_pos _ + · have hxi := Ordinal.natOrdinal_of_eq_wpow_log hprin + rw [NatOrdinal.of_val] at hxi + set beta' := + NatOrdinal.of (Ordinal.log Ordinal.omega0 (ordinalValue (translatedTruncation (v : K⟦ℝ⟧) + γ)).val) + rw [hxi] at hγ + have hlt : beta' < beta := NatOrdinal.wpow_lt_wpow.mp hγ + calc ordinalValue (u * translatedTruncation (v : K⟦ℝ⟧) γ) ≤ + ordinalValue u * ordinalValue (translatedTruncation (v : K⟦ℝ⟧) γ) := + ordinalValue_mul_le_naturalMul _ _ + _ ≤ ω^ alpha * ω^ beta' := by rw [hxi]; exact mul_le_mul_left hu' _ + _ = ω^ (alpha + beta') := (NatOrdinal.wpow_add alpha beta').symm + _ < ω^ ((alpha + beta).removeNat 1) := + NatOrdinal.wpow_lt_wpow.mpr + (add_lt_removeOne_add_of_constantCoeff_eq_zero halpha hbeta hlt) + +/-- **Leibniz identity on representatives, both grades successors.** In `P̂`, near zero, +`π_{δ⁻}((uv)^{|γ}) = π_{α⁻}(u^{|γ}) π_β(v) + π_α(u) π_{β⁻}(v^{|γ})` with `δ = α + β`. -/ +theorem eventually_of_derivAt_mul_of_pos {alpha beta : NatOrdinal} + (halpha : 0 < alpha.constantCoeff) (hbeta : 0 < beta.constantCoeff) + (u v : Series K) (hu : ordinalValue u < ω^ (alpha + 1)) (hv : ordinalValue v < ω^ (beta + 1)) : + ∀ᶠ γ in 𝓝[<] (0 : ℝ), + DirectSum.of (PrincipalComponent K) ((alpha + beta).removeNat 1) + (derivAt (alpha + beta) (u * v) γ) = + DirectSum.of (PrincipalComponent K) (alpha.removeNat 1) (derivAt alpha u γ) * + DirectSum.of (PrincipalComponent K) beta (principalComponentMk beta v hv) + + DirectSum.of (PrincipalComponent K) alpha (principalComponentMk alpha u hu) * + DirectSum.of (PrincipalComponent K) (beta.removeNat 1) + (derivAt beta v γ) := by + have hsum : 0 < (alpha + beta).constantCoeff := by + rw [NatOrdinal.constantCoeff_add]; omega + have huv : ordinalValue (u * v) < ω^ (alpha + beta + 1) := ordinalValue_mul_lt_wpow_add_one hu hv + filter_upwards [eventually_derivAt_eq_principalComponentMk alpha halpha u hu, + eventually_derivAt_eq_principalComponentMk beta hbeta v hv, + eventually_derivAt_eq_principalComponentMk (alpha + beta) hsum (u * v) huv, + eventually_ordinalValue_leibnizRemainder_lt halpha u v hu hv] with γ ⟨hγu, hcu⟩ ⟨hγv, hcv⟩ + ⟨hγuv, hcuv⟩ hrem + have h1 : (alpha + beta).removeNat 1 = alpha.removeNat 1 + beta := + NatOrdinal.removeOne_add_right alpha beta halpha + have h2 : (alpha + beta).removeNat 1 = alpha + beta.removeNat 1 := by + rw [add_comm, NatOrdinal.removeOne_add_right beta alpha hbeta, add_comm] + rw [hcu, hcv, hcuv, ← of_principalComponentMul, ← of_principalComponentMul, + principalComponentMul_mk, principalComponentMul_mk, of_principalComponentMk_congr_of_eq h1, + of_principalComponentMk_congr_of_eq h2, ← map_add] + congr 1 + apply principalComponentMk_eq_add_of_sub_sub_lt + rw [h1] + exact hrem + +/-- **Leibniz identity on representatives, `β` not a successor.** In `P̂`, near zero, +`π_{δ⁻}((uv)^{|γ}) = π_{α⁻}(u^{|γ}) π_β(v)` with `δ = α + β`; the term `u v^{|γ}` vanishes in +`P_{δ⁻}`. -/ +theorem eventually_of_derivAt_mul_of_eq_zero {alpha beta : NatOrdinal} + (halpha : 0 < alpha.constantCoeff) (hbeta : beta.constantCoeff = 0) + (u v : Series K) (hu : ordinalValue u < ω^ (alpha + 1)) (hv : ordinalValue v < ω^ (beta + 1)) : + ∀ᶠ γ in 𝓝[<] (0 : ℝ), + DirectSum.of (PrincipalComponent K) ((alpha + beta).removeNat 1) + (derivAt (alpha + beta) (u * v) γ) = + DirectSum.of (PrincipalComponent K) (alpha.removeNat 1) (derivAt alpha u γ) * + DirectSum.of (PrincipalComponent K) beta (principalComponentMk beta v hv) := by + have hsum : 0 < (alpha + beta).constantCoeff := by + rw [NatOrdinal.constantCoeff_add]; omega + have huv : ordinalValue (u * v) < ω^ (alpha + beta + 1) := ordinalValue_mul_lt_wpow_add_one hu hv + filter_upwards [eventually_derivAt_eq_principalComponentMk alpha halpha u hu, + eventually_derivAt_eq_principalComponentMk (alpha + beta) hsum (u * v) huv, + eventually_ordinalValue_leibnizRemainder_lt halpha u v hu hv, + eventually_ordinalValue_mul_translatedTruncation_lt_of_constantCoeff_eq_zero halpha hbeta u v + hu hv] + with γ ⟨hγu, hcu⟩ ⟨hγuv, hcuv⟩ hrem hlimit + have h1 : (alpha + beta).removeNat 1 = alpha.removeNat 1 + beta := + NatOrdinal.removeOne_add_right alpha beta halpha + rw [hcu, hcuv, ← of_principalComponentMul, principalComponentMul_mk, + of_principalComponentMk_congr_of_eq h1] + congr 1 + rw [principalComponentMk_eq_iff] + have hsplit : translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ - translatedTruncation (u : + K⟦ℝ⟧) γ * v = + (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ - translatedTruncation (u : K⟦ℝ⟧) γ * v - + u * translatedTruncation (v : K⟦ℝ⟧) γ) + u * translatedTruncation (v : K⟦ℝ⟧) γ := by + abel + rw [hsplit] + exact (ordinalValue_add_le_max _ _).trans_lt (max_lt (h1 ▸ hrem) hlimit) + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SuccessorSupportBound.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SuccessorSupportBound.lean new file mode 100644 index 0000000000..160789af33 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SuccessorSupportBound.lean @@ -0,0 +1,338 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationsIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Shift +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan + +/-! +# Lowering the order type of the support below `ω^(τ+1)` + +Let the polynomials `q j ∈ K[X]` be homogeneous of degrees `c j` (the degrees `σ_j` of the +generators) that are zero or limits, with `b j ⊕ c j = τ + 1` (`b j` the cofactor degrees `ρ_j`), +and let the separation condition (n) hold for every `(b j, c j, τ)`: `b j ⊕ θ < τ` for every +`θ < c j`. Let `τ + 1 < α` and assume evaluation injective below `α`. Let `D` be a series whose +support has order type below `ω^(τ+2)` and whose translated truncations `D^{|ξ}`, `ξ ≤ 0`, +satisfy (p) for `(q_1, …, q_m; τ)`: above the degree `τ`, the polynomial of every translated +truncation of `D` lies in the ideal `(q_1, …, q_m)`. + +The cutoffs `ξ` at which the ordinal value of `D` is at least `ω^(τ+1)` are finitely many. At +each of them the class of `D^{|ξ}` in `P_{τ+1}` lies in the ideal `(q_1(𝓑), …, q_m(𝓑))` — ideal +membership of a class from the condition (p) on its translated truncations, in degree `τ + 1` +(`of_principalComponentMk_mem_span_of_forall_componentsGE_mem`) — so +`D^{|ξ} ≡ ∑_j u_{ξj} · q_j(b_𝓑)` +modulo `J_{ω^(τ+1)}` with `u_{ξj}` principal representatives of classes in `P_{b j}`; subtract the +terms `t^ξ u_{ξj} · q_j(b_𝓑)`. Every translated truncation of the result has ordinal value below +`ω^(τ+1)`: at `ξ` the class vanishes, and the other terms contribute translated truncations of +`u_{ξj} · q_j(b_𝓑)` at cutoffs `ζ < 0` (of ordinal value below `ω^(τ+1)`) or elements of `J`; at +every other cutoff `D^{|ζ}` itself has ordinal value below `ω^(τ+1)`. Hence the support of the +result has order type below `ω^(τ+1)`, and the cofactors `∑_ξ t^ξ u_{ξj}` have support of order +type below `ω^(b j + 1)`. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial DirectSum OrdinalGraded + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- **Finiteness of translated truncations above an ordinal-value bound.** The cutoffs `ξ ≤ 0` +at which the ordinal value of `d^{|ξ}` is at least `ω^ρ` are finite when the support of `d` has +order type below `ω^(ρ+1)`. -/ +@[blueprint "lem:successor-large-truncations-finite" + (phase := "Limit ordinals in the degree induction") + (title := "Finiteness of translated truncations above an ordinal-value bound") + (statement := /-- + Let $K$ be a field, let $d\in\Kser$, and let $\rho<\omega_1$. If + \[ + \ot(\supp d)<\omega^{\rho+1}, + \] + then the set + \[ + \{\xi\le0:\vJ(\trunc d\xi)\ge\omega^\rho\} + \] + is finite. + -/) + (proof := /-- + Among negative cutoffs, infinitely many such points would contain a strictly + increasing sequence. The support in every interval between consecutive + points would have order type at least $\omega^\rho$, so these disjoint + successive blocks would force the support at or below $0$ to have order type + at least $\omega^\rho\cdot\omega=\omega^{\rho+1}$, a contradiction. Adding + the possible cutoff $0$ preserves finiteness. + -/)] +theorem finite_setOf_wpow_le_ordinalValue_translatedTruncation {ρ : NatOrdinal} (D : Series K) + (hD : (D : K⟦ℝ⟧).supportOrderType < (ω^ (ρ + 1)).val) : + {ξ : ℝ | ξ ≤ 0 ∧ ω^ ρ ≤ ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ξ)}.Finite := by + refine ((cutoffsGE_finite_of_supportOrderType_lt D hD).union (Set.finite_singleton 0)).subset + fun ξ ⟨hξ, h⟩ ↦ ?_ + rcases hξ.lt_or_eq with hlt | rfl + · exact Or.inl (mem_cutoffsGE_iff.mpr ⟨hlt, h⟩) + · exact Or.inr rfl + +/-- Below a point, a finite set of reals leaves a gap. -/ +theorem exists_pos_forall_le_sub_of_finite {S : Set ℝ} (hS : S.Finite) (ξ : ℝ) : + ∃ ε > 0, ∀ ξ' ∈ S, ξ' < ξ → ξ' ≤ ξ - ε := by + classical + set T := hS.toFinset.filter (· < ξ) with hTdef + by_cases hT : T.Nonempty + · refine ⟨ξ - T.max' hT, ?_, fun ξ' hξ' hlt ↦ ?_⟩ + · have := (Finset.mem_filter.mp (T.max'_mem hT)).2 + linarith + · have : ξ' ≤ T.max' hT := + T.le_max' ξ' (Finset.mem_filter.mpr ⟨hS.mem_toFinset.mpr hξ', hlt⟩) + linarith + · refine ⟨1, one_pos, fun ξ' hξ' hlt ↦ ?_⟩ + exact absurd ⟨ξ', Finset.mem_filter.mpr ⟨hS.mem_toFinset.mpr hξ', hlt⟩⟩ hT + +variable {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +namespace Lifts + +variable (σ : Lifts wt x) (hx : IsMinimalSystem (principalGrading K) wt x) {α : NatOrdinal} + (hinj : ∀ β < α, InjectiveAt K wt x β) +include hinj + +/-- **The class of `D^{|ξ}` modulo `J_{ω^(τ+1)}`.** If the translated truncations of `D` satisfy +(p) for `(q_1, …, q_m; τ)` and those at the cutoffs of some interval `(ξ - ε, ξ)`, `ξ ≤ 0`, have +ordinal value below `ω^(τ+1)`, then `D^{|ξ}` is, modulo `J_{ω^(τ+1)}`, a combination +`∑_j w_j · q_j(b_𝓑)` in which each `w j` has ordinal value below `ω^(b j + 1)`, support of order +type at most `ω^(b j)` and translated truncations at cutoffs `ζ < 0` of ordinal value below +`ω^(b j)` (a principal representative of a class in `P_{b j}`, or zero). -/ +theorem exists_forall_ordinalValue_translatedTruncation_sub_sum_mul_aeval_lt {ι' : Type*} + [Fintype ι'] {q : ι' → MvPolynomial ι K} {c : ι' → NatOrdinal} + (hq : ∀ j, IsWeightedHomogeneous wt (q j) (c j)) (hc : ∀ j, (c j).constantCoeff = 0) + {τ : NatOrdinal} (hτ : τ + 1 < α) {b : ι' → NatOrdinal} (hb : ∀ j, b j + c j = τ + 1) + {D : Series K} (hD : (D : K⟦ℝ⟧).supportOrderType < (ω^ (τ + 1 + 1)).val) + (htrunc : ∀ ξ : ℝ, ξ ≤ 0 → + componentsGE wt τ (σ.pol hx α (translatedTruncation (D : K⟦ℝ⟧) ξ)) ∈ + Ideal.span (Set.range q)) + {ξ : ℝ} (hξ : ξ ≤ 0) {ε : ℝ} (hε : 0 < ε) (hgap : ∀ δ : ℝ, -ε < δ → δ < 0 → + ordinalValue (translatedTruncation (D : K⟦ℝ⟧) (ξ + δ)) < ω^ (τ + 1)) : + ∃ w : ι' → Series K, (∀ j, ((w j : Series K) : K⟦ℝ⟧).supportOrderType ≤ (ω^ (b j)).val) ∧ + (∀ j, ∀ ζ : ℝ, ζ < 0 → ordinalValue (translatedTruncation (w j : K⟦ℝ⟧) ζ) < ω^ (b j)) ∧ + (∀ j, ordinalValue (w j) < ω^ (b j + 1)) ∧ + ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ξ - ∑ j, w j * aeval σ.lift (q j)) < + ω^ (τ + 1) := by + classical + have hu : ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ξ) < ω^ (τ + 1 + 1) := + ordinalValue_translatedTruncation_lt_of_supportOrderType_lt hD ξ + -- the class of `D^{|ξ}` lies in the ideal + have hmem := σ.of_principalComponentMk_mem_span_of_forall_componentsGE_mem hx hinj hq hc hτ hu hε + (fun δ h1 h2 ↦ by + rw [translatedTruncation_translatedTruncation _ _ h2.le] + exact hgap δ h1 h2) + (fun δ h1 h2 ↦ by + rw [translatedTruncation_translatedTruncation _ _ h2.le] + exact htrunc (ξ + δ) (by linarith)) + have hq' : ∀ j, aeval x (q j) ∈ principalGrading K (c j) := + fun j ↦ aeval_mem_of_forall_mem hx.mem (hq j) + obtain ⟨w', hw', -, hsum⟩ := OrdinalGraded.exists_eq_sum_mul_of_mem_span + (𝒜 := principalGrading K) hq' (of_mem_principalGrading _ _) hmem + -- principal representatives of the cofactors + have hrep : ∀ j, ∃ p : Series K, Represents p (b j) (w' j) ∧ + (p : K⟦ℝ⟧).supportOrderType ≤ (ω^ (b j)).val ∧ + ∀ ζ : ℝ, ζ < 0 → ordinalValue (translatedTruncation (p : K⟦ℝ⟧) ζ) < ω^ (b j) := + fun j ↦ exists_represents_of_mem_principalGrading (hw' j (b j) (hb j)) + choose w hwrep hwot hwcut using hrep + refine ⟨w, hwot, hwcut, fun j ↦ (hwrep j).ordinalValue_lt, ?_⟩ + -- both `D^{|ξ}` and `∑_j w_j · q_j(b_𝓑)` represent the same class + have hrepS : Represents (∑ j, w j * aeval σ.lift (q j)) (τ + 1) + (∑ j, w' j * aeval x (q j)) := + represents_sum _ _ _ _ fun j _ ↦ ((hwrep j).mul (σ.aeval_represents (hq j))).of_eq (hb j) + have hX : DirectSum.of (PrincipalComponent K) (τ + 1) + (principalComponentMk (τ + 1) (translatedTruncation (D : K⟦ℝ⟧) ξ) hu) = + ∑ j, w' j * aeval x (q j) := by + rw [hsum] + exact Finset.sum_congr rfl fun j _ ↦ mul_comm _ _ + have hmk := DirectSum.of_injective (τ + 1) (hX.trans hrepS.of_principalComponentMk.symm) + exact (principalComponentMk_eq_iff _ _ _ hu hrepS.ordinalValue_lt).mp hmk + +variable (hσ : σ.IsPrincipal) +include hσ + +/-- **Support-order reduction at a successor degree.** For weighted homogeneous `q j` of degrees +`c j` that are zero or limits, suppose `b j ⊕ c j = τ + 1` and +`b j ⊕ θ < τ` whenever `θ < c j`. If `τ + 1 < α`, the chosen representatives are principal, +the support of `D` has order type below `ω^(τ+2)`, and every translated truncation has its +degree-at-least-`τ` polynomial part in `(q_1, …, q_m)`, then suitable cofactors lower the support +order type of the remainder below `ω^(τ+1)`. -/ +@[blueprint "lem:successor-support-lowering" + (phase := "Limit ordinals in the degree induction") + (title := "Support-order reduction at a successor degree") + (statement := /-- + Let $K$ be a field, let $(x_i)_{i\in I}$ be a minimal homogeneous + generating system of $\Ph$, with $x_i\in\Prin_{w_i}$, and choose principal + series $b_i$ representing the $x_i$. Fix $\alpha<\omega_1$, and assume + that evaluation at $(x_i)$ is injective in every weighted degree below + $\alpha$. + + Let $Q_1,\ldots,Q_m\in K[X_i:i\in I]$ be weighted homogeneous of degrees + $\sigma_1,\ldots,\sigma_m$, each a limit ordinal or $0$. Let + $\rho_1,\ldots,\rho_m$ and $\tau$ satisfy + \[ + \rho_j\nsum\sigma_j=\tau+1,\qquad + \rho_j\nsum\theta<\tau\quad(\theta<\sigma_j),\qquad + \tau+1<\alpha. + \] + Let $d\in\Kser$ satisfy + $\ot(\supp d)<\omega^{\tau+2}$, and suppose that, for every $\xi\le0$, + \[ + \partGE{\pol(\trunc d\xi)}{\tau}\in(Q_1,\ldots,Q_m). + \] + Then there are $u_1,\ldots,u_m\in\Kser$ such that + $\ot(\supp u_j)<\omega^{\rho_j+1}$ for every $j$ and + \[ + \ot\!\left(\supp\left(d-\sum_j u_jQ_j(b_i)\right)\right) + <\omega^{\tau+1}. + \] + -/) + (proof := /-- + By \ref{lem:successor-large-truncations-finite}, the set $L$ of cutoffs + $\xi\le0$ for which $\vJ(\trunc d\xi)\ge\omega^{\tau+1}$ is finite. For + each $\xi\in L$, choose an interval immediately below $\xi$ containing no + other point of $L$. Applying \ref{lem:lower-below-successor} to + $\trunc d\xi$ places its class in $\Prin_{\tau+1}$ in the ideal generated + by the $Q_j(x_i)$. By + \ref{lem:homogeneous-element-of-generated-ideal}, there are cofactor classes + of degrees $\rho_j$; choose principal representatives $w_{\xi j}$, shift them + to $\xi$, and sum over the finite set $L$. + + At a cutoff in $L$, the term placed there cancels its class. At every other + placement, the translated truncation either lies in $J$, because its cutoff + is positive, or is a proper translated truncation bounded by + \ref{lem:principal-representatives-homogeneous-polynomial-truncation} and the + separation hypothesis. Thus every translated truncation of the remainder + has ordinal value below $\omega^{\tau+1}$. + By \ref{cor:small-truncations-small-support}, its support has order type + below $\omega^{\tau+1}$. Each $u_j$ is a finite sum of shifts of series with + support order type at most $\omega^{\rho_j}$, so its support has order type + below $\omega^{\rho_j+1}$. + -/)] +theorem IsPrincipal.exists_supportOrderType_sub_sum_mul_aeval_lt {ι' : Type*} [Fintype ι'] + {q : ι' → MvPolynomial ι K} {c : ι' → NatOrdinal} + (hq : ∀ j, IsWeightedHomogeneous wt (q j) (c j)) (hc : ∀ j, (c j).constantCoeff = 0) + {τ : NatOrdinal} (hτ : τ + 1 < α) {b : ι' → NatOrdinal} (hb : ∀ j, b j + c j = τ + 1) + (hsep : ∀ j, ∀ θ, θ < c j → b j + θ < τ) + {D : Series K} (hD : (D : K⟦ℝ⟧).supportOrderType < (ω^ (τ + 1 + 1)).val) + (htrunc : ∀ ξ : ℝ, ξ ≤ 0 → + componentsGE wt τ (σ.pol hx α (translatedTruncation (D : K⟦ℝ⟧) ξ)) ∈ + Ideal.span (Set.range q)) : + ∃ u : ι' → Series K, (∀ j, ((u j : Series K) : K⟦ℝ⟧).supportOrderType < (ω^ (b j + 1)).val) ∧ + ((D - ∑ j, u j * aeval σ.lift (q j) : Series K) : K⟦ℝ⟧).supportOrderType < + (ω^ (τ + 1)).val := by + classical + have hwt : ∀ i, wt i ≠ 0 := hx.ne_zero + -- the cutoffs at which the ordinal value of `D` is at least `ω^(τ+1)` + set L : Set ℝ := {ξ | ξ ≤ 0 ∧ ω^ (τ + 1) ≤ ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ξ)} + with hLdef + have hL : L.Finite := finite_setOf_wpow_le_ordinalValue_translatedTruncation D hD + have hmemL : ∀ ξ, ξ ∈ hL.toFinset ↔ + ξ ≤ 0 ∧ ω^ (τ + 1) ≤ ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ξ) := + fun ξ ↦ hL.mem_toFinset + -- at each of them, representatives of the cofactors of its class + have hpt : ∀ ξ ∈ hL.toFinset, ∃ w : ι' → Series K, + (∀ j, ((w j : Series K) : K⟦ℝ⟧).supportOrderType ≤ (ω^ (b j)).val) ∧ + (∀ j, ∀ ζ : ℝ, ζ < 0 → ordinalValue (translatedTruncation (w j : K⟦ℝ⟧) ζ) < ω^ (b j)) ∧ + (∀ j, ordinalValue (w j) < ω^ (b j + 1)) ∧ + ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ξ - ∑ j, w j * aeval σ.lift (q j)) < + ω^ (τ + 1) := by + intro ξ hξ + obtain ⟨hξ0, -⟩ := (hmemL ξ).mp hξ + obtain ⟨ε, hε, hgap⟩ := exists_pos_forall_le_sub_of_finite hL ξ + refine σ.exists_forall_ordinalValue_translatedTruncation_sub_sum_mul_aeval_lt hx hinj hq hc hτ + hb hD htrunc hξ0 hε fun δ h1 h2 ↦ ?_ + by_contra hge + rw [not_lt] at hge + have : ξ + δ ∈ L := ⟨by linarith, hge⟩ + have := hgap _ this (by linarith) + linarith + choose! w hw using hpt + -- the cofactors + refine ⟨fun j ↦ ∑ ξ ∈ hL.toFinset, shift ξ (w ξ j), fun j ↦ ?_, ?_⟩ + · refine supportOrderType_sum_lt_wpow _ _ fun ξ hξ ↦ ?_ + rw [supportOrderType_shift ((hmemL ξ).mp hξ).1] + exact ((hw ξ hξ).1 j).trans_lt (NatOrdinal.val.lt_iff_lt.mpr + (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one _))) + -- the corrected series and its translated truncations + have heq : (D - ∑ j, (∑ ξ ∈ hL.toFinset, shift ξ (w ξ j)) * aeval σ.lift (q j) : Series K) = + D - ∑ ξ ∈ hL.toFinset, ∑ j, shift ξ (w ξ j * aeval σ.lift (q j)) := by + congr 1 + rw [Finset.sum_comm] + refine Finset.sum_congr rfl fun j _ ↦ ?_ + rw [Finset.sum_mul] + exact Finset.sum_congr rfl fun ξ hξ ↦ shift_mul ((hmemL ξ).mp hξ).1 _ _ + beta_reduce + rw [heq] + have hcut : ∀ ζ : ℝ, + translatedTruncation ((D - ∑ ξ ∈ hL.toFinset, ∑ j, shift ξ (w ξ j * aeval σ.lift (q j)) : + Series K) : K⟦ℝ⟧) ζ = + translatedTruncation (D : K⟦ℝ⟧) ζ - ∑ ξ ∈ hL.toFinset, ∑ j, + translatedTruncation ((w ξ j * aeval σ.lift (q j) : Series K) : K⟦ℝ⟧) (ζ - ξ) := by + intro ζ + rw [← translatedTruncationAddMonoidHom_apply, AddSubgroupClass.coe_sub, map_sub, + AddSubmonoidClass.coe_finsetSum, map_sum, translatedTruncationAddMonoidHom_apply ζ (D : K⟦ℝ⟧), + sub_right_inj] + refine Finset.sum_congr rfl fun ξ hξ ↦ ?_ + rw [AddSubmonoidClass.coe_finsetSum, map_sum] + refine Finset.sum_congr rfl fun j _ ↦ ?_ + rw [translatedTruncationAddMonoidHom_apply, translatedTruncation_shift ((hmemL ξ).mp hξ).1] + -- every translated truncation of the corrected series has value below `ω^(τ+1)` + refine supportOrderType_lt_of_forall_ordinalValue_translatedTruncation_lt _ + (lt_of_le_of_lt zero_le (lt_add_one τ)).ne' fun ζ hζ ↦ ?_ + rw [hcut ζ] + -- the terms placed at cutoffs other than `ζ` have small translated truncations at `ζ` + have hblock : ∀ ξ ∈ hL.toFinset, ξ ≠ ζ → ∀ j, + ordinalValue (translatedTruncation ((w ξ j * aeval σ.lift (q j) : Series K) : K⟦ℝ⟧) (ζ - ξ)) + < ω^ (τ + 1) := by + intro ξ hξ hne j + rcases lt_or_gt_of_ne hne with hlt | hgt + · -- `ζ - ξ > 0`: the translated truncation lies in `J` + rw [ordinalValue_translatedTruncation_eq_zero_of_forall_support_le (s := 0) + (fun y hy ↦ Nonpositive.support_subset _ hy) (by linarith)] + exact NatOrdinal.wpow_pos _ + · -- `ζ - ξ < 0`: a translated truncation of `w_{ξj} · q_j(b_𝓑)` at a cutoff below `0` + exact hσ.ordinalValue_translatedTruncation_mul_aeval_lt hwt (hq j) ((hw ξ hξ).2.2.1 j) + ((hw ξ hξ).2.1 j) (hb j) (lt_add_one τ).le (hsep j) (by linarith) + have hsmall : ∀ (s : Finset ℝ), (∀ ξ ∈ s, ξ ≠ ζ) → s ⊆ hL.toFinset → + ordinalValue (∑ ξ ∈ s, ∑ j, + translatedTruncation ((w ξ j * aeval σ.lift (q j) : Series K) : K⟦ℝ⟧) (ζ - ξ)) < + ω^ (τ + 1) := fun s hs hsub ↦ + ordinalValue_sum_lt _ _ (NatOrdinal.wpow_pos _) fun ξ hξ ↦ + ordinalValue_sum_lt _ _ (NatOrdinal.wpow_pos _) fun j _ ↦ hblock ξ (hsub hξ) (hs ξ hξ) j + by_cases hζL : ζ ∈ hL.toFinset + · -- at a cutoff where the ordinal value of `D` reaches `ω^(τ+1)`: the class vanishes + rw [← Finset.add_sum_erase _ _ hζL, ← sub_sub] + have h1 := (hw ζ hζL).2.2.2 + have h2 := hsmall (hL.toFinset.erase ζ) (fun ξ hξ ↦ (Finset.mem_erase.mp hξ).1) + (Finset.erase_subset _ _) + have h3 : ∑ j, translatedTruncation ((w ζ j * aeval σ.lift (q j) : Series K) : K⟦ℝ⟧) (ζ - ζ) = + ∑ j, w ζ j * aeval σ.lift (q j) := by + refine Finset.sum_congr rfl fun j _ ↦ ?_ + rw [sub_self, translatedTruncation_zero] + rw [h3, sub_eq_add_neg _ (∑ ξ ∈ _, _)] + refine (ordinalValue_add_le_max _ _).trans_lt (max_lt h1 ?_) + rwa [ordinalValue_neg] + · -- elsewhere `D^{|ζ}` is small + have h1 : ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ζ) < ω^ (τ + 1) := by + by_contra hge + rw [not_lt] at hge + exact hζL ((hmemL ζ).mpr ⟨hζ, hge⟩) + have h2 := hsmall hL.toFinset (fun ξ hξ hne ↦ hζL (hne ▸ hξ)) subset_rfl + rw [sub_eq_add_neg] + refine (ordinalValue_add_le_max _ _).trans_lt (max_lt h1 ?_) + rwa [ordinalValue_neg] + +end Lifts + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SumAlongCutoffs.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SumAlongCutoffs.lean new file mode 100644 index 0000000000..c9e2300579 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SumAlongCutoffs.lean @@ -0,0 +1,377 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponent +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.TruncationDrop +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.IncreasingSequenceUnion +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Translation +public import Mathlib.RingTheory.HahnSeries.Summable +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationPolynomial + +/-! +# Sums along a sequence of cutoffs: prescribed classes at prescribed cutoffs + +Given series `w_k`, negative reals `c_k` and cutoffs `γ_k`, their *sum along the sequence of +cutoffs* `γ_k` is + + `s = ∑_k (w_k)_{>c_k} t^{γ_k}`, `γ_0 < γ_1 < ⋯ < 0`, `sup_k γ_k = 0`, `c_k < 0`, + `γ_k ≤ γ_{k+1} + c_{k+1}`, + +whose `k`-th term `(w_k)_{>c_k} t^{γ_k}` (`placedTerm w c γ k`) places the upper truncation +`(w_k)_{>c_k}` [LM24, Def. 3.2.2] at `γ_k`. The intervals `(γ_k + c_k, γ_k]` are pairwise disjoint +and increasing, so the supports of the terms form an increasing sequence of well-ordered sets and +their union is well ordered ([Ber00, Lem. 4.1] is the two-set case); on `(γ_k + c_k, γ_k]` the +coefficients of `s` are those of the `k`-th term, and off these intervals they vanish +(`sumAlongCutoffs`). This is the construction behind Berarducci's "hyper-series" [Ber00, §6]. + +Let `δ` be an ordinal, `γ_0 < γ_1 < ⋯ < 0` cutoffs with supremum `0`, and `a_k ∈ P_δ` classes. +There is a series `s ∈ J_{ω^(δ+2)}` whose translated truncation at `γ_k` represents `a_k` in `P_δ` +for every `k`, and whose translated truncation at every other cutoff `ξ ∈ (γ_0, 0)` has ordinal +value below `ω^δ` (`exists_sumAlongCutoffs`): choose principal representatives `w_k` of the `a_k`, +choose `c_k < 0` so close to `0` that the translated truncations of `w_k` at the cutoffs in +`(c_k, 0)` have ordinal value below `ω^δ` and that `γ_k ≤ γ_{k+1} + c_{k+1}`, and take this sum. +Its support is the union of an increasing sequence of sets of order type at most `ω^δ`, hence has +order type at most `ω^δ · ω = ω^(δ+1)`. + +Read through the derivation `∂` on `P_{δ+1}`, this says that every function at `0⁻` with values in +`P_δ` vanishing outside a sequence `γ_k ↑ 0` is a derivative. +-/ + +universe v + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-! ### The terms of a sum along cutoffs -/ + +/-- The `k`-th term `(w_k)_{>c_k} t^{γ_k}` of the sum along cutoffs: the part of +`w k` with exponents in `(c k, 0]`, placed at `γ k`. -/ +def placedTerm (w : ℕ → Series K) (c γ : ℕ → ℝ) (k : ℕ) : K⟦ℝ⟧ := + HahnSeries.translate (γ k) (truncGT (c k) (w k : K⟦ℝ⟧)) + +theorem coeff_placedTerm (w : ℕ → Series K) (c γ : ℕ → ℝ) (k : ℕ) (x : ℝ) : + (placedTerm w c γ k).coeff x = if c k < x - γ k then (w k : K⟦ℝ⟧).coeff (x - γ k) else 0 := by + rw [placedTerm, coeff_translate] + split_ifs with h + · exact coeff_truncGT_of_lt h _ + · exact coeff_truncGT_of_le (not_lt.mp h) _ + +/-- The support of the `k`-th term lies in `(γ k + c k, γ k]`. -/ +theorem support_placedTerm_subset (w : ℕ → Series K) (c γ : ℕ → ℝ) (k : ℕ) : + (placedTerm w c γ k).support ⊆ Set.Ioc (γ k + c k) (γ k) := by + intro x hx + rw [HahnSeries.mem_support, coeff_placedTerm] at hx + split_ifs at hx with h + · have hle : x - γ k ≤ 0 := + HahnSeries.Nonpositive.support_subset (w k) ((HahnSeries.mem_support _ _).mpr hx) + exact ⟨by linarith, by linarith⟩ + · exact absurd rfl hx + +/-- The support of a term in the sum along cutoffs is partially well ordered. -/ +theorem support_placedTerm_isPWO (w : ℕ → Series K) (c γ : ℕ → ℝ) (k : ℕ) : + (placedTerm w c γ k).support.IsPWO := + (placedTerm w c γ k).isPWO_support + +/-- The order type of the support of the `k`-th term is at most that of `w k`. -/ +theorem supportOrderType_placedTerm_le (w : ℕ → Series K) (c γ : ℕ → ℝ) (k : ℕ) : + (placedTerm w c γ k).supportOrderType ≤ (w k : K⟦ℝ⟧).supportOrderType := by + rw [placedTerm, supportOrderType_translate, supportOrderType_eq_setOrderType, + supportOrderType_eq_setOrderType] + exact Set.IsPWO.orderType_mono _ _ (support_truncGT_subset (c k) (w k : K⟦ℝ⟧)) + +section Family + +variable (w : ℕ → Series K) (c γ : ℕ → ℝ) (hγ : StrictMono γ) + (hdisj : ∀ k, γ k ≤ γ (k + 1) + c (k + 1)) +include hγ hdisj + +/-- The intervals `(γ k + c k, γ k]` are pairwise disjoint and increasing. -/ +theorem placedTerm_interval_lt {j k : ℕ} (hjk : j < k) {x y : ℝ} + (hx : x ∈ Set.Ioc (γ j + c j) (γ j)) + (hy : y ∈ Set.Ioc (γ k + c k) (γ k)) : x < y := by + have h1 : γ j ≤ γ (k - 1) := hγ.monotone (by omega) + have h2 : γ (k - 1) ≤ γ k + c k := by + have := hdisj (k - 1) + rwa [Nat.sub_add_cancel (by omega : 1 ≤ k)] at this + linarith [hx.2, hy.1] + +/-- The supports of the terms form an increasing sequence of sets: for `j < k`, every point of +the support of the `j`-th term lies below every point of the support of the `k`-th. -/ +theorem placedTerm_support_lt {j k : ℕ} (hjk : j < k) {x y : ℝ} + (hx : x ∈ (placedTerm w c γ j).support) + (hy : y ∈ (placedTerm w c γ k).support) : x < y := + placedTerm_interval_lt c γ hγ hdisj hjk (support_placedTerm_subset w c γ j hx) + (support_placedTerm_subset w c γ k hy) + +/-- The terms in the sum along cutoffs form a summable family. -/ +def placedTerms : SummableFamily ℝ K ℕ where + toFun := placedTerm w c γ + isPWO_iUnion_support' := + Set.IsPWO.iUnion_of_ordered (fun k ↦ support_placedTerm_isPWO w c γ k) + fun j k hjk x hx y hy ↦ placedTerm_support_lt w c γ hγ hdisj hjk hx hy + finite_co_support' x := by + refine Set.Subsingleton.finite fun j hj k hk ↦ ?_ + by_contra hne + rcases Ne.lt_or_gt hne with h | h + · exact (placedTerm_support_lt w c γ hγ hdisj h hj hk).false + · exact (placedTerm_support_lt w c γ hγ hdisj h hk hj).false + +theorem placedTerms_apply (k : ℕ) : placedTerms w c γ hγ hdisj k = placedTerm w c γ k := (rfl) + +/-- The sum along the sequence of cutoffs `γ_k`, `s = ∑_k (w_k)_{>c_k} t^{γ_k}`. -/ +def sumAlongCutoffs : K⟦ℝ⟧ := (placedTerms w c γ hγ hdisj).hsum + +/-- The support of the sum along cutoffs lies in the union of the intervals +`(γ k + c k, γ k]`. -/ +theorem support_sumAlongCutoffs_subset : + (sumAlongCutoffs w c γ hγ hdisj).support ⊆ ⋃ k, Set.Ioc (γ k + c k) (γ k) := + SummableFamily.support_hsum_subset.trans + (Set.iUnion_mono fun k ↦ support_placedTerm_subset w c γ k) + +/-- On the `k`-th interval, the coefficient of the sum is that of its `k`-th term. -/ +theorem coeff_sumAlongCutoffs_of_mem {k : ℕ} {x : ℝ} (hx : x ∈ Set.Ioc (γ k + c k) (γ k)) : + (sumAlongCutoffs w c γ hγ hdisj).coeff x = (placedTerm w c γ k).coeff x := by + rw [sumAlongCutoffs, SummableFamily.coeff_hsum] + rw [finsum_eq_single _ k] + · rfl + · intro j hjk + by_contra hne + have hmem : x ∈ (placedTerm w c γ j).support := (HahnSeries.mem_support _ _).mpr hne + have hj := support_placedTerm_subset w c γ j hmem + rcases Ne.lt_or_gt hjk with h | h + · exact (placedTerm_interval_lt c γ hγ hdisj h hj hx).false + · exact (placedTerm_interval_lt c γ hγ hdisj h hx hj).false + +/-- Off every interval `(γ k + c k, γ k]` the coefficient of the sum along cutoffs vanishes. -/ +theorem coeff_sumAlongCutoffs_eq_zero {x : ℝ} (hx : ∀ k, x ∉ Set.Ioc (γ k + c k) (γ k)) : + (sumAlongCutoffs w c γ hγ hdisj).coeff x = 0 := by + by_contra h + have := support_sumAlongCutoffs_subset w c γ hγ hdisj ((HahnSeries.mem_support _ _).mpr h) + obtain ⟨k, hk⟩ := Set.mem_iUnion.mp this + exact hx k hk + +/-- The sum along cutoffs is a nonpositive series. -/ +theorem sumAlongCutoffs_mem (hneg : ∀ k, γ k < 0) : + sumAlongCutoffs w c γ hγ hdisj ∈ HahnSeries.nonpositiveSubring ℝ K := by + rw [HahnSeries.mem_nonpositiveSubring] + intro x hx + obtain ⟨k, hk⟩ := Set.mem_iUnion.mp (support_sumAlongCutoffs_subset w c γ hγ hdisj hx) + exact hk.2.trans (hneg k).le + +end Family + +/-! ### Representatives -/ + +/-- Every class in `P_δ` has a representative `w ∈ J_{ω^(δ+1)}` of support order type at most +`ω^δ`: a principal series of degree `δ`, or `0`. -/ +theorem exists_representative_supportOrderType_le (δ : NatOrdinal) (a : PrincipalComponent K δ) : + ∃ w : Series K, ∃ hw : ordinalValue w < ω^ (δ + 1), + principalComponentMk δ w hw = a ∧ (w : K⟦ℝ⟧).supportOrderType ≤ (ω^ δ).val := by + rcases eq_or_ne a 0 with rfl | ha + · have h0 : ordinalValue (0 : Series K) < ω^ (δ + 1) := by + rw [ordinalValue_zero]; exact NatOrdinal.wpow_pos _ + refine ⟨0, h0, (principalComponentMk_eq_zero_iff δ 0 h0).mpr (by + rw [ordinalValue_zero]; exact NatOrdinal.wpow_pos _), ?_⟩ + rw [Subring.coe_zero, supportOrderType_eq_setOrderType] + have : ((0 : K⟦ℝ⟧).isPWO_support).orderType = 0 := + (Set.IsPWO.orderType_eq_zero _).mpr HahnSeries.support_zero + rw [this] + exact bot_le + · obtain ⟨p, hp, hprin, hdeg, hpa⟩ := exists_principal_representative_of_ne_zero δ a ha + exact ⟨p, hp, hpa, (hprin.supportOrderType_eq_wpow_of_degree_eq hdeg).le⟩ + +/-! ### Prescribed classes at prescribed cutoffs -/ + +/-- **A sum along a sequence of cutoffs with prescribed classes at the cutoffs.** Let +`γ_0 < γ_1 < ⋯ < 0` have supremum `0` and let `a_k ∈ P_δ`. There is `s ∈ J_{ω^(δ+2)}` whose +translated truncation at `γ_k` represents `a_k` in `P_δ` for every `k`, and whose translated +truncation at every `ξ ∈ (γ_0, 0)` other than the `γ_k` has ordinal value below `ω^δ`. -/ +@[blueprint "prop:realise-derivative" + (phase := "Translated truncations") + (title := "Prescribed $\\mathrm P_\\delta$ classes at translated truncations") + (statement := /-- + Let $K$ be a field and let $\delta$ be a countable ordinal. Let + $(\gamma_k)_{k\in\mathbb N}$ be a strictly increasing sequence of negative + reals cofinal below $0$, and let $a_k\in\mathrm P_\delta$ for every $k$. + Then there is a series $s\in K((\mathbb R^{\le0}))$ such that + \[ + v_J(s)<\omega^{\delta\oplus1\oplus1}. + \] + For every $k$, + \[ + v_J(s^{\vert\gamma_k})<\omega^{\delta\oplus1},\qquad + s^{\vert\gamma_k}+J_{\omega^\delta}=a_k + \quad\text{in }\mathrm P_\delta. + \] + Moreover, if $\gamma_0<\xi<0$ and $\xi\ne\gamma_k$ for every $k$, then + \[ + v_J(s^{\vert\xi})<\omega^\delta. + \] + -/) + (proof := /-- + By \ref{fact:principal-series-representatives}, choose a principal series + $w_k$ representing each nonzero $a_k$, and choose $w_k=0$ when $a_k=0$. + Each support has order type at most $\omega^\delta$. By + \ref{lem:truncation-drop}, choose $c_k<0$ such that every proper translated + truncation of $w_k$ at a point of $(c_k,0)$ has ordinal value below + $\omega^\delta$; enlarge $c_k$ if necessary so that + $\gamma_{k-1}\le\gamma_k+c_k$ for $k\ge1$. + + Place $(w_k)_{>c_k}$ in the interval + $(\gamma_k+c_k,\gamma_k]$. These intervals are disjoint and strictly + increasing. By \ref{lem:increasing-union-order-type}, their union is well + ordered and has order type at most $\omega^{\delta\oplus1}$. Hence the Hahn + sum $s$ exists and + $v_J(s)<\omega^{\delta\oplus1\oplus1}$. + + At $\gamma_k$, every earlier interval contributes only an element of $J$, + the $k$-th interval has the same germ as $w_k$, and every later interval is + excluded. Thus $s^{\vert\gamma_k}$ represents $a_k$. Between two prescribed + cutoffs, its germ is either zero or the germ of a proper translated + truncation of one $w_k$, whose ordinal value is below $\omega^\delta$ by the + choice of $c_k$. + -/)] +theorem exists_sumAlongCutoffs (δ : NatOrdinal) (γ : ℕ → ℝ) (hγ : StrictMono γ) + (hneg : ∀ k, γ k < 0) + (hcof : ∀ η < (0 : ℝ), ∃ k, η < γ k) (a : ℕ → PrincipalComponent K δ) : + ∃ s : Series K, ordinalValue s < ω^ (δ + 1 + 1) ∧ + (∀ k, ∃ hk : ordinalValue (translatedTruncation (s : K⟦ℝ⟧) (γ k)) < ω^ (δ + 1), + principalComponentMk δ (translatedTruncation (s : K⟦ℝ⟧) (γ k)) hk = a k) ∧ + (∀ ξ : ℝ, γ 0 < ξ → ξ < 0 → (∀ k, ξ ≠ γ k) → + ordinalValue (translatedTruncation (s : K⟦ℝ⟧) ξ) < ω^ δ) := by + classical + -- representatives `w_k`, and an `ε_k` such that their translated truncations at the cutoffs in + -- `(-ε_k, 0)` have ordinal value below `ω^δ` + choose w hw hwa hwot using fun k ↦ exists_representative_supportOrderType_le δ (a k) + have hwin : ∀ k, ∃ ε > 0, ∀ ξ : ℝ, -ε < ξ → ξ < 0 → + ordinalValue (translatedTruncation ((w k : Series K) : K⟦ℝ⟧) ξ) < ω^ δ := fun k ↦ + exists_forall_ordinalValue_translatedTruncation_lt (hw k) + choose ε hε hwin using hwin + -- the reals `c_k` + set c : ℕ → ℝ := fun k ↦ if k = 0 then -ε 0 else max (γ (k - 1) - γ k) (-ε k) with hcdef + have hc : ∀ k, c k < 0 := by + intro k + simp only [hcdef] + split_ifs with hk + · subst hk; linarith [hε 0] + · exact max_lt (sub_neg.mpr (hγ (by omega))) (by linarith [hε k]) + have hcε : ∀ k, -ε k ≤ c k := by + intro k + simp only [hcdef] + split_ifs with hk + · subst hk; exact le_rfl + · exact le_max_right _ _ + have hdisj : ∀ k, γ k ≤ γ (k + 1) + c (k + 1) := by + intro k + simp only [hcdef, if_neg (Nat.succ_ne_zero k), Nat.add_sub_cancel] + linarith [le_max_left (γ k - γ (k + 1)) (-ε (k + 1))] + -- the sum along cutoffs + set s' := sumAlongCutoffs w c γ hγ hdisj with hs'def + set s : Series K := ⟨s', sumAlongCutoffs_mem w c γ hγ hdisj hneg⟩ with hsdef + have hscoe : (s : K⟦ℝ⟧) = s' := rfl + refine ⟨s, ?_, ?_, ?_⟩ + · -- the ordinal value of `s` + have hU : (⋃ k, (placedTerm w c γ k).support).IsPWO := + (placedTerms w c γ hγ hdisj).isPWO_iUnion_support + have hUle : hU.orderType ≤ (ω^ (δ + 1)).val := by + refine Set.IsPWO.orderType_iUnion_le_of_ordered (fun k ↦ support_placedTerm_isPWO w c γ k) + (fun j k hjk x hx y hy ↦ placedTerm_support_lt w c γ hγ hdisj hjk hx hy) (ρ := (ω^ δ).val) + (fun k ↦ ?_) fun n ↦ ?_ + · rw [← supportOrderType_eq_setOrderType] + exact (supportOrderType_placedTerm_le w c γ k).trans (hwot k) + · rw [NatOrdinal.of_val] + refine NatOrdinal.val.lt_iff_lt.mpr ?_ + rw [nsmul_eq_mul, mul_comm] + exact NatOrdinal.wpow_mul_natCast_lt (lt_add_one δ) n + have hsupp : (s : K⟦ℝ⟧).support ⊆ ⋃ k, (placedTerm w c γ k).support := + SummableFamily.support_hsum_subset + calc ordinalValue s ≤ NatOrdinal.of (s : K⟦ℝ⟧).supportOrderType := + ordinalValue_le_supportOrderType s + _ ≤ NatOrdinal.of (ω^ (δ + 1)).val := by + rw [supportOrderType_eq_setOrderType] + exact NatOrdinal.of.le_iff_le.mpr + ((Set.IsPWO.orderType_mono _ hU hsupp).trans hUle) + _ = ω^ (δ + 1) := NatOrdinal.of_val _ + _ < ω^ (δ + 1 + 1) := NatOrdinal.wpow_lt_wpow.mpr (lt_add_one _) + · -- the classes at the cutoffs + intro k + have hgerm : toGerm (translatedTruncation (s : K⟦ℝ⟧) (γ k)) = toGerm (w k) := by + rw [toGerm_eq_toGerm_iff_exists_coeff_eq] + refine ⟨c k, hc k, fun η hη1 hη2 ↦ ?_⟩ + rw [coeff_translatedTruncation, if_pos hη2, hscoe, + coeff_sumAlongCutoffs_of_mem w c γ hγ hdisj (k := k) ⟨by linarith, by linarith⟩, + coeff_placedTerm, + add_sub_cancel_left, if_pos hη1] + have hval : ordinalValue (translatedTruncation (s : K⟦ℝ⟧) (γ k)) = ordinalValue (w k) := + ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (toGerm_eq_toGerm_iff.mp hgerm) + refine ⟨hval ▸ hw k, ?_⟩ + rw [← hwa k, principalComponentMk_eq_iff, + ordinalValue_eq_zero_iff.mpr (toGerm_eq_toGerm_iff.mp hgerm)] + exact NatOrdinal.wpow_pos _ + · -- the translated truncations between the cutoffs + intro ξ hξ0 hξneg hξne + -- the first cutoff above `ξ` + have hex : ∃ k, ξ < γ k := hcof ξ hξneg + set k := Nat.find hex with hkdef + have hk : ξ < γ k := Nat.find_spec hex + have hk0 : k ≠ 0 := by + intro h + rw [h] at hk + exact hξ0.not_gt hk + have hkpred : γ (k - 1) < ξ := by + have hnot : ¬ ξ < γ (k - 1) := Nat.find_min hex (by omega) + exact lt_of_le_of_ne (not_lt.mp hnot) (fun h ↦ hξne (k - 1) h.symm) + rcases le_or_gt ξ (γ k + c k) with hle | hgt + · -- `ξ ≤ γ k + c k`: the translated truncation lies in `J` + have hgerm : toGerm (translatedTruncation (s : K⟦ℝ⟧) ξ) = toGerm 0 := by + rw [toGerm_eq_toGerm_iff_exists_coeff_eq] + refine ⟨γ (k - 1) - ξ, by linarith, fun η hη1 hη2 ↦ ?_⟩ + rw [coeff_translatedTruncation, if_pos hη2, hscoe, Subring.coe_zero, + HahnSeries.coeff_zero] + refine coeff_sumAlongCutoffs_eq_zero w c γ hγ hdisj fun j hj ↦ ?_ + rcases lt_trichotomy j k with hjk | rfl | hjk + · -- `j < k`: the interval lies below `γ (k - 1) < ξ + η` + have : γ j ≤ γ (k - 1) := hγ.monotone (by omega) + linarith [hj.2] + · -- `j = k`: `ξ + η ≤ γ k + c k` + linarith [hj.1] + · -- `j > k`: the interval lies above `γ k > ξ + η` + have h1 : γ k ≤ γ (j - 1) := hγ.monotone (by omega) + have h2 : γ (j - 1) ≤ γ j + c j := by + have := hdisj (j - 1) + rwa [Nat.sub_add_cancel (by omega : 1 ≤ j)] at this + linarith [hj.1] + rw [ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (toGerm_eq_toGerm_iff.mp hgerm), + ordinalValue_zero] + exact NatOrdinal.wpow_pos _ + · -- `γ k + c k < ξ < γ k`: the translated truncation is, modulo `J`, one of `w k` + have hgerm : toGerm (translatedTruncation (s : K⟦ℝ⟧) ξ) = + toGerm (translatedTruncation ((w k : Series K) : K⟦ℝ⟧) (ξ - γ k)) := by + rw [toGerm_eq_toGerm_iff_exists_coeff_eq] + refine ⟨γ k + c k - ξ, by linarith, fun η hη1 hη2 ↦ ?_⟩ + rw [coeff_translatedTruncation, coeff_translatedTruncation, if_pos hη2, if_pos hη2, hscoe, + coeff_sumAlongCutoffs_of_mem w c γ hγ hdisj (k := k) ⟨by linarith, by linarith⟩, + coeff_placedTerm, + if_pos (by linarith)] + congr 1 + ring + rw [ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (toGerm_eq_toGerm_iff.mp hgerm)] + exact hwin k (ξ - γ k) (by linarith [hcε k]) (by linarith) + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SupportLoweringPieces.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SupportLoweringPieces.lean new file mode 100644 index 0000000000..6217a40a0a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SupportLoweringPieces.lean @@ -0,0 +1,437 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorSupportBound +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CombinedCofactors +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductCondition + +/-! +# Lowering the order type of the support below `ω^ρ`, `ρ ≥ τ + 2`, by cutting into pieces + +Let the polynomials `q j ∈ K[X]` be homogeneous of degrees `c j` (the degrees `σ_j` of the +generators) with `e j ⊕ c j = ρ` (`e j` the cofactor degrees), `τ + 1 < ρ < α`, and let the +separation condition (n) hold for every `(e j, c j, τ)`: `e j ⊕ θ < τ` for every `θ < c j`. +Assume evaluation injective below `α`. Let `D` be a series whose support has order type below +`ω^(ρ+1)` and whose translated truncations satisfy (p) for `(q_1, …, q_m; τ)`. Suppose +(induction hypothesis) that every series `E` with support of order type below `ω^ρ` whose +translated truncations satisfy (p) admits cofactors `w j`, with supports of order type below +`ω^(e j)`, such that all translated truncations of `E - ∑_j w_j · q_j(b_𝓑)` have ordinal value +below `ω^(τ+1)`. + +At each of the finitely many cutoffs `ξ` at which the ordinal value of `D` is at least `ω^ρ`, +take an interval `(ξ - ε, ξ)` containing no such cutoff and the piece `E_ξ` of `D` on +`(ξ - ε, ξ]`, translated to `0`, and cut it into the pieces on `(γ_k, γ_{k+1}]`, +`γ_k := -ε/(k+1)`; each piece has support of order type below `ω^ρ` and translated truncations +satisfying (p), so the induction hypothesis applies; combine the cofactors of the pieces into the +combined cofactors `C^ξ_j` (`CombinedCofactors`). The difference `E_ξ - ∑_j C^ξ_j · q_j(b_𝓑)` +has translated truncations of ordinal value below `ω^(τ+1)` at every cutoff in `(-ε, 0)`, hence +ordinal value below `ω^(τ+2) ≤ ω^ρ` +(`ordinalValue_lt_wpow_add_one_of_forall_translatedTruncation_lt`). Subtracting the terms +`t^ξ C^ξ_j · q_j(b_𝓑)` leaves a series all of whose translated truncations have ordinal value +below `ω^ρ` — so its support has order type below `ω^ρ` — and whose translated truncations still +satisfy (p) (`ProductCondition`). +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial DirectSum OrdinalGraded + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- A point of the support of the piece of `E` on `(a, b]`, translated to `0`, lies above +`a - b`. -/ +theorem lt_of_mem_support_piece {a b : ℝ} {E : K⟦ℝ⟧} {y : ℝ} + (hy : y ∈ ((piece a b E : Series K) : K⟦ℝ⟧).support) : a - b < y := by + rw [HahnSeries.mem_support, coeff_piece] at hy + by_contra h + rw [not_lt] at h + exact hy (if_neg fun h' ↦ absurd h'.1 (not_lt.mpr (by linarith))) + +/-- The sequence `γ_k := -ε/(k+1)`: strictly increasing, negative, with supremum `0`. -/ +theorem strictMono_neg_div_succ {ε : ℝ} (hε : 0 < ε) : + StrictMono fun k : ℕ ↦ -ε / ((k : ℝ) + 1) := fun k l hkl ↦ by + simp only + rw [neg_div, neg_div, neg_lt_neg_iff] + exact div_lt_div_of_pos_left hε (by positivity) (by exact_mod_cast Nat.succ_lt_succ hkl) + +theorem neg_div_succ_neg {ε : ℝ} (hε : 0 < ε) (k : ℕ) : -ε / ((k : ℝ) + 1) < 0 := by + rw [neg_div, neg_lt_zero] + exact div_pos hε (by positivity) + +theorem exists_lt_neg_div_succ (ε : ℝ) {η : ℝ} (hη : η < 0) : + ∃ k : ℕ, η < -ε / ((k : ℝ) + 1) := by + obtain ⟨k, hk⟩ := exists_nat_gt (ε / -η) + refine ⟨k, ?_⟩ + have hk1 : (0 : ℝ) < (k : ℝ) + 1 := by positivity + have hη' : 0 < -η := neg_pos.mpr hη + rw [div_lt_iff₀ hη'] at hk + rw [neg_div, lt_neg, div_lt_iff₀ hk1] + nlinarith + +variable {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +namespace Lifts + +variable (σ : Lifts wt x) (hx : IsMinimalSystem (principalGrading K) wt x) {α : NatOrdinal} + (hinj : ∀ β < α, InjectiveAt K wt x β) (hσ : σ.IsPrincipal) +include hinj + +/-- The polynomial of a difference. -/ +theorem pol_sub {u u' : Series K} (hu : ordinalValue u < ω^ α) (hu' : ordinalValue u' < ω^ α) : + σ.pol hx α (u - u') = σ.pol hx α u - σ.pol hx α u' := by + have hneg : ordinalValue (-u') < ω^ α := by rwa [ordinalValue_neg] + rw [sub_eq_add_neg, σ.pol_add hx hinj hu hneg, sub_eq_add_neg] + congr 1 + have : (-u' : Series K) = (HahnSeries.Nonpositive.C : K →+* Series K) (-1) * u' := by + rw [map_neg, map_one, neg_one_mul] + rw [this, σ.pol_C_mul hx hinj (-1) hu', map_neg, map_one, neg_one_mul] + +include hσ + +/-- **Support-order reduction by interval decomposition.** Under the stated homogeneous-degree, +separation, and translated-truncation ideal hypotheses, cofactors reduce the support order type +below `ω^ρ` while preserving the translated-truncation ideal condition. -/ +@[blueprint "lem:lower-by-pieces" + (phase := "Limit ordinals in the degree induction") + (title := "Support-order reduction by interval decomposition") + (statement := /-- + Let $K$ be a field and let $\mathcal B$ be a minimal homogeneous generating + system of $\widehat{\mathrm P}$ with principal representatives $b_B$. + Assume evaluation is injective below $\alpha$. Let $I$ be a finite index + set, and let $Q_j\in K[X_B:B\in\mathcal B]$ be weighted homogeneous of + degree $\sigma_j$, for $j\in I$. Let + $\tau+1<\mu<\alpha$, and suppose + \[ + \rho_j\oplus\sigma_j=\mu,\qquad + \rho_j\oplus\theta<\tau\quad(\theta<\sigma_j) + \] + for every $j$. + + Let $u\in K((\mathbb R^{\le0}))$ satisfy + \[ + \operatorname{ot}(\operatorname{supp}(u))<\omega^{\mu+1} + \] + and, for every $\xi\le0$, + \[ + \operatorname{pol}_{<\alpha}(u^{|\xi})_{\ge\tau} + \in (Q_j:j\in I). + \] + Suppose every series $c$ with + $\operatorname{ot}(\operatorname{supp}(c))<\omega^\mu$ and the same + high-degree ideal condition admits series $w_j$ such that + \[ + \operatorname{ot}(\operatorname{supp}(w_j))<\omega^{\rho_j} + \] + and + \[ + v_J\!\left((c-\sum_jw_jQ_j(b_B))^{|\xi}\right) + <\omega^{\tau+1}\quad(\xi\le0). + \] + Then there are series $u_j$ such that + \[ + \operatorname{ot}(\operatorname{supp}(u_j))<\omega^{\rho_j+1}, + \] + \[ + \operatorname{ot}\!\left( + \operatorname{supp}(u-\sum_ju_jQ_j(b_B))\right)<\omega^\mu, + \] + and every translated truncation of the remainder satisfies the same + high-degree ideal condition. + -/) + (proof := /-- + By \ref{lem:successor-large-truncations-finite}, only finitely many cutoffs + $\xi\le0$ have $v_J(u^{|\xi})\ge\omega^\mu$. Around each such cutoff choose + an interval containing no other large cutoff. + \ref{lem:window-truncation} transfers the high-degree ideal condition to the + corresponding interval piece, and + \ref{cor:small-truncations-small-support} gives support order below + $\omega^\mu$ for its successive subpieces. Apply the assumed induction + hypothesis to those subpieces. + + Assemble their cofactors as sums along cutoffs. + \ref{lem:cutoff-sum-truncation} identifies their translated truncations, + while \ref{lem:cutoff-sum-support} bounds each local combined cofactor by + $\omega^{\rho_j}$. This non-strict bound is sufficient: there are only + finitely many exceptional cutoffs, so the finite sum of their shifted local + corrections has support order strictly below $\omega^{\rho_j+1}$. The + contrapositive consequence of + \ref{lem:truncation-values} bounds the local residual value by + $\omega^{\tau+2}\le\omega^\mu$, since $\tau+1<\mu$. + + Shift the local corrections back to their exceptional cutoffs and add + them. The corrections preserve the high-degree ideal + condition by \ref{lem:term-truncation-condition}. They cancel all large + cutoffs, so \ref{cor:small-truncations-small-support} gives support order + below $\omega^\mu$ for the final remainder. + -/)] +theorem IsPrincipal.exists_supportOrderType_sub_sum_mul_aeval_lt_of_pieces {ι' : Type*} + [Fintype ι'] {q : ι' → MvPolynomial ι K} {c : ι' → NatOrdinal} + (hq : ∀ j, IsWeightedHomogeneous wt (q j) (c j)) {τ ρ : NatOrdinal} (hτρ : τ + 1 < ρ) + (hρα : ρ < α) {e : ι' → NatOrdinal} (he : ∀ j, e j + c j = ρ) + (hsep : ∀ j, ∀ θ, θ < c j → e j + θ < τ) + {D : Series K} (hD : (D : K⟦ℝ⟧).supportOrderType < (ω^ (ρ + 1)).val) + (htrunc : ∀ ξ : ℝ, ξ ≤ 0 → + componentsGE wt τ (σ.pol hx α (translatedTruncation (D : K⟦ℝ⟧) ξ)) ∈ + Ideal.span (Set.range q)) + (hIH : ∀ E : Series K, (E : K⟦ℝ⟧).supportOrderType < (ω^ ρ).val → + (∀ ξ : ℝ, ξ ≤ 0 → + componentsGE wt τ (σ.pol hx α (translatedTruncation (E : K⟦ℝ⟧) ξ)) ∈ + Ideal.span (Set.range q)) → + ∃ w : ι' → Series K, (∀ j, ((w j : Series K) : K⟦ℝ⟧).supportOrderType < (ω^ (e j)).val) ∧ + ∀ ξ : ℝ, ξ ≤ 0 → ordinalValue (translatedTruncation + ((E - ∑ j, w j * aeval σ.lift (q j) : Series K) : K⟦ℝ⟧) ξ) < ω^ (τ + 1)) : + ∃ u : ι' → Series K, (∀ j, ((u j : Series K) : K⟦ℝ⟧).supportOrderType < (ω^ (e j + 1)).val) ∧ + ((D - ∑ j, u j * aeval σ.lift (q j) : Series K) : K⟦ℝ⟧).supportOrderType < (ω^ ρ).val ∧ + ∀ ζ : ℝ, ζ ≤ 0 → componentsGE wt τ (σ.pol hx α (translatedTruncation + ((D - ∑ j, u j * aeval σ.lift (q j) : Series K) : K⟦ℝ⟧) ζ)) ∈ Ideal.span (Set.range q) := by + classical + have hwt : ∀ i, wt i ≠ 0 := hx.ne_zero + have hρ0 : ρ ≠ 0 := (lt_of_le_of_lt zero_le hτρ).ne' + have hτ2ρ : τ + 1 + 1 ≤ ρ := Order.add_one_le_of_lt hτρ + have hρα' : ρ + 1 ≤ α := Order.add_one_le_of_lt hρα + have hDα : ∀ ζ, ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ζ) < ω^ α := fun ζ ↦ + (ordinalValue_translatedTruncation_lt_of_supportOrderType_lt hD ζ).trans_le + (NatOrdinal.wpow_le_wpow.mpr hρα') + -- the generators evaluated at the lifts, `q_j(b_𝓑)` + set qt : ι' → Series K := fun j ↦ aeval σ.lift (q j) with hqtdef + have hqv : ∀ j, ordinalValue (qt j) < ω^ (c j + 1) := fun j ↦ + (σ.aeval_represents (hq j)).ordinalValue_lt + have hqcut : ∀ j, ∀ β : ℝ, β < 0 → + ordinalValue (translatedTruncation (qt j : K⟦ℝ⟧) β) < ω^ (c j) := fun j β hβ ↦ + hσ.ordinalValue_translatedTruncation_aeval_lt hwt (hq j) hβ + -- the cutoffs at which the ordinal value of `D` is at least `ω^ρ` + set L : Set ℝ := {ξ | ξ ≤ 0 ∧ ω^ ρ ≤ ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ξ)} with hLdef + have hL : L.Finite := finite_setOf_wpow_le_ordinalValue_translatedTruncation D hD + have hmemL : ∀ ξ, ξ ∈ hL.toFinset ↔ + ξ ≤ 0 ∧ ω^ ρ ≤ ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ξ) := fun ξ ↦ hL.mem_toFinset + -- at each of them, combined cofactors lowering the ordinal value of `D^{|ξ}` below `ω^ρ` + have hpt : ∀ ξ ∈ hL.toFinset, ∃ C : ι' → Series K, + (∀ j, ((C j : Series K) : K⟦ℝ⟧).supportOrderType ≤ (ω^ (e j)).val) ∧ + (∀ j, ∀ ζ : ℝ, ζ < 0 → ordinalValue (translatedTruncation (C j : K⟦ℝ⟧) ζ) < ω^ (e j)) ∧ + ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ξ - ∑ j, C j * qt j) < ω^ ρ := by + intro ξ hξ + obtain ⟨hξ0, -⟩ := (hmemL ξ).mp hξ + obtain ⟨ε, hε, hgap⟩ := exists_pos_forall_le_sub_of_finite hL ξ + have hnolevel : ∀ θ, ξ - ε < θ → θ < ξ → + ordinalValue (translatedTruncation (D : K⟦ℝ⟧) θ) < ω^ ρ := by + intro θ h1 h2 + by_contra hge + rw [not_lt] at hge + have := hgap θ ⟨by linarith, hge⟩ h2 + linarith + -- the piece `E` of `D` on `(ξ - ε, ξ]`, translated to `0` + set E : Series K := piece (ξ - ε) ξ (D : K⟦ℝ⟧) with hEdef + have hEcut : ∀ θ : ℝ, -ε < θ → θ ≤ 0 → + translatedTruncation (E : K⟦ℝ⟧) θ - translatedTruncation (D : K⟦ℝ⟧) (ξ + θ) ∈ + Nonpositive.negativeMonomialIdeal K := fun θ h1 h2 ↦ + translatedTruncation_window_sub_mem (ξ - ε) ξ (D : K⟦ℝ⟧) (by linarith) h2 + -- the pieces on `(γ k, γ (k+1)]` + set γ : ℕ → ℝ := fun k ↦ -ε / ((k : ℝ) + 1) with hγdef + have hγ : StrictMono γ := strictMono_neg_div_succ hε + have hneg : ∀ k, γ k < 0 := neg_div_succ_neg hε + have hcof : ∀ η < (0 : ℝ), ∃ k, η < γ k := fun η hη ↦ exists_lt_neg_div_succ ε hη + have hγ0 : γ 0 = -ε := by simp [hγdef] + have hγ0le : ∀ k, -ε ≤ γ k := fun k ↦ hγ0 ▸ hγ.monotone (Nat.zero_le k) + -- each piece has support of order type below `ω^ρ` and translated truncations satisfying (p) + have hwin : ∀ k, ∃ w : ι' → Series K, + (∀ j, ((w j : Series K) : K⟦ℝ⟧).supportOrderType < (ω^ (e j)).val) ∧ + ∀ θ : ℝ, θ ≤ 0 → ordinalValue (translatedTruncation + ((piece (γ k) (γ (k + 1)) (E : K⟦ℝ⟧) - ∑ j, w j * qt j : Series K) : K⟦ℝ⟧) θ) < + ω^ (τ + 1) := by + intro k + set Dk : Series K := piece (γ k) (γ (k + 1)) (E : K⟦ℝ⟧) with hDkdef + have hDkzero : ∀ θ, θ ≤ γ k - γ (k + 1) → translatedTruncation (Dk : K⟦ℝ⟧) θ = 0 := + fun θ hθ ↦ translatedTruncation_eq_zero_of_forall_lt fun y hy ↦ + lt_of_le_of_lt hθ (lt_of_mem_support_piece hy) + have hDkcut : ∀ θ, γ k - γ (k + 1) < θ → θ ≤ 0 → + translatedTruncation (Dk : K⟦ℝ⟧) θ - + translatedTruncation (D : K⟦ℝ⟧) (ξ + (γ (k + 1) + θ)) ∈ + Nonpositive.negativeMonomialIdeal K := by + intro θ h1 h2 + have h3 := translatedTruncation_window_sub_mem (γ k) (γ (k + 1)) (E : K⟦ℝ⟧) h1 h2 + have h4 := hEcut (γ (k + 1) + θ) (by linarith [hγ0le k]) (by linarith [hneg (k + 1)]) + have := add_mem h3 h4 + rwa [sub_add_sub_cancel] at this + have hin : ∀ θ, γ k - γ (k + 1) < θ → θ ≤ 0 → + ξ - ε < ξ + (γ (k + 1) + θ) ∧ ξ + (γ (k + 1) + θ) < ξ := fun θ h1 h2 ↦ + ⟨by linarith [hγ0le k], by linarith [hneg (k + 1)]⟩ + have hDkot : (Dk : K⟦ℝ⟧).supportOrderType < (ω^ ρ).val := by + refine supportOrderType_lt_of_forall_ordinalValue_translatedTruncation_lt Dk hρ0 + fun θ hθ ↦ ?_ + rcases le_or_gt θ (γ k - γ (k + 1)) with h | h + · rw [hDkzero θ h, ordinalValue_zero] + exact NatOrdinal.wpow_pos _ + · rw [ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (hDkcut θ h hθ)] + exact hnolevel _ (hin θ h hθ).1 (hin θ h hθ).2 + have hDkctrl : ∀ θ : ℝ, θ ≤ 0 → + componentsGE wt τ (σ.pol hx α (translatedTruncation (Dk : K⟦ℝ⟧) θ)) ∈ + Ideal.span (Set.range q) := by + intro θ hθ + rcases le_or_gt θ (γ k - γ (k + 1)) with h | h + · rw [hDkzero θ h, σ.pol_zero hx hinj, componentsGE_zero] + exact Ideal.zero_mem _ + · have hval : ordinalValue (translatedTruncation (Dk : K⟦ℝ⟧) θ) < ω^ α := by + rw [ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (hDkcut θ h hθ)] + exact hDα _ + rw [σ.pol_congr hx hinj hval (toGerm_eq_toGerm_iff.mpr (hDkcut θ h hθ))] + exact htrunc _ (by linarith [hneg (k + 1)]) + exact hIH Dk hDkot hDkctrl + choose w hw1 hw2 using hwin + -- combine the cofactors of the pieces + refine ⟨fun j ↦ combinedCofactor γ hγ hneg w j, + fun j ↦ supportOrderType_combinedCofactor_le γ hγ hneg w hw1 j, + fun j ζ hζ ↦ + ordinalValue_translatedTruncation_combinedCofactor_lt γ hγ hneg hcof w hw1 j hζ, ?_⟩ + have hres : ∀ ζ, -ε < ζ → ζ < 0 → ordinalValue (translatedTruncation + ((E - ∑ j, combinedCofactor γ hγ hneg w j * qt j : Series K) : K⟦ℝ⟧) ζ) < ω^ (τ + 1) := + fun ζ h1 h2 ↦ + ordinalValue_translatedTruncation_sub_sum_combinedCofactor_mul_lt E γ hγ hneg hcof w + hw1 hqcut hsep (fun k θ _ h2 ↦ hw2 k θ h2) (by rw [hγ0]; exact h1) h2 + have hwhole : ordinalValue (E - ∑ j, combinedCofactor γ hγ hneg w j * qt j) < ω^ (τ + 1 + 1) := + ordinalValue_lt_wpow_add_one_of_forall_translatedTruncation_lt (neg_neg_of_pos hε) hres + have hE0 : translatedTruncation (D : K⟦ℝ⟧) ξ - E ∈ Nonpositive.negativeMonomialIdeal K := by + have := hEcut 0 (by linarith) le_rfl + rw [translatedTruncation_zero, add_zero] at this + rw [← neg_sub] + exact neg_mem this + have hsame : ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ξ - + ∑ j, combinedCofactor γ hγ hneg w j * qt j) = + ordinalValue (E - ∑ j, combinedCofactor γ hγ hneg w j * qt j) := by + apply ordinalValue_eq_of_sub_mem_negativeMonomialIdeal + rw [sub_sub_sub_cancel_right] + exact hE0 + rw [hsame] + exact hwhole.trans_le (NatOrdinal.wpow_le_wpow.mpr hτ2ρ) + choose! C hC using hpt + -- the terms `C^ξ_j · q_j(b_𝓑)`: translated truncations of small ordinal value, satisfying (p) + have hCv : ∀ ξ ∈ hL.toFinset, ∀ j, ordinalValue (C ξ j) < ω^ (e j + 1) := fun ξ hξ j ↦ + (ordinalValue_le_supportOrderType _).trans_lt (by + rw [← NatOrdinal.of_val (ω^ (e j + 1)), NatOrdinal.of.lt_iff_lt] + exact ((hC ξ hξ).1 j).trans_lt + (NatOrdinal.val.lt_iff_lt.mpr (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one _)))) + have hblock : ∀ ξ ∈ hL.toFinset, ∀ j, ∀ θ : ℝ, + ordinalValue (translatedTruncation ((C ξ j * qt j : Series K) : K⟦ℝ⟧) θ) < ω^ (ρ + 1) := by + intro ξ hξ j θ + rcases lt_trichotomy θ 0 with h | rfl | h + · exact (hσ.ordinalValue_translatedTruncation_mul_aeval_lt hwt (hq j) (hCv ξ hξ j) + ((hC ξ hξ).2.1 j) (he j) ((lt_add_one τ).le.trans hτρ.le) (hsep j) h).trans + (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one ρ)) + · rw [translatedTruncation_zero, ← he j] + exact ordinalValue_mul_lt_wpow_add_one (hCv ξ hξ j) (hqv j) + · rw [ordinalValue_translatedTruncation_eq_zero_of_forall_support_le (s := 0) + (fun y hy ↦ Nonpositive.support_subset _ hy) h] + exact NatOrdinal.wpow_pos _ + have hblockρ : ∀ ξ ∈ hL.toFinset, ξ ≠ 0 → ∀ j, ∀ θ : ℝ, θ ≠ 0 → + ordinalValue (translatedTruncation ((C ξ j * qt j : Series K) : K⟦ℝ⟧) θ) < ω^ ρ := by + intro ξ hξ _ j θ hθ + rcases lt_or_gt_of_ne hθ with h | h + · exact hσ.ordinalValue_translatedTruncation_mul_aeval_lt hwt (hq j) (hCv ξ hξ j) + ((hC ξ hξ).2.1 j) (he j) ((lt_add_one τ).le.trans hτρ.le) (hsep j) h + · rw [ordinalValue_translatedTruncation_eq_zero_of_forall_support_le (s := 0) + (fun y hy ↦ Nonpositive.support_subset _ hy) h] + exact NatOrdinal.wpow_pos _ + have hblockctrl : ∀ ξ ∈ hL.toFinset, ∀ j, ∀ θ : ℝ, + componentsGE wt τ (σ.pol hx α (translatedTruncation ((C ξ j * qt j : Series K) : K⟦ℝ⟧) θ)) + ∈ Ideal.span (Set.range q) := by + intro ξ hξ j θ + rcases le_or_gt θ 0 with h | h + · have := σ.componentsGE_pol_translatedTruncation_mul_aeval_mem hx hinj hσ (hq j) (hCv ξ hξ j) + ((hC ξ hξ).2.1 j) (he j ▸ hρα) (hsep j) h + exact Ideal.span_mono (by rintro _ ⟨_, rfl⟩; exact ⟨j, rfl⟩) this + · rw [σ.pol_eq_zero_of_mem hx hinj + (translatedTruncation_mem_negativeMonomialIdeal_of_forall_support_le (s := 0) + (fun y hy ↦ Nonpositive.support_subset _ hy) h), componentsGE_zero] + exact Ideal.zero_mem _ + -- the cofactors and the corrected series + refine ⟨fun j ↦ ∑ ξ ∈ hL.toFinset, shift ξ (C ξ j), fun j ↦ ?_, ?_⟩ + · refine supportOrderType_sum_lt_wpow _ _ fun ξ hξ ↦ ?_ + rw [supportOrderType_shift ((hmemL ξ).mp hξ).1] + exact ((hC ξ hξ).1 j).trans_lt (NatOrdinal.val.lt_iff_lt.mpr + (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one _))) + have heq : (D - ∑ j, (∑ ξ ∈ hL.toFinset, shift ξ (C ξ j)) * qt j : Series K) = + D - ∑ ξ ∈ hL.toFinset, ∑ j, shift ξ (C ξ j * qt j) := by + congr 1 + rw [Finset.sum_comm] + refine Finset.sum_congr rfl fun j _ ↦ ?_ + rw [Finset.sum_mul] + exact Finset.sum_congr rfl fun ξ hξ ↦ shift_mul ((hmemL ξ).mp hξ).1 _ _ + beta_reduce + rw [heq] + have hcut : ∀ ζ : ℝ, + translatedTruncation + ((D - ∑ ξ ∈ hL.toFinset, ∑ j, shift ξ (C ξ j * qt j) : Series K) : K⟦ℝ⟧) ζ = + translatedTruncation (D : K⟦ℝ⟧) ζ - ∑ ξ ∈ hL.toFinset, ∑ j, + translatedTruncation ((C ξ j * qt j : Series K) : K⟦ℝ⟧) (ζ - ξ) := by + intro ζ + rw [← translatedTruncationAddMonoidHom_apply, AddSubgroupClass.coe_sub, map_sub, + AddSubmonoidClass.coe_finsetSum, map_sum, translatedTruncationAddMonoidHom_apply ζ (D : K⟦ℝ⟧), + sub_right_inj] + refine Finset.sum_congr rfl fun ξ hξ ↦ ?_ + rw [AddSubmonoidClass.coe_finsetSum, map_sum] + refine Finset.sum_congr rfl fun j _ ↦ ?_ + rw [translatedTruncationAddMonoidHom_apply, translatedTruncation_shift ((hmemL ξ).mp hξ).1] + refine ⟨?_, ?_⟩ + · -- every translated truncation of the corrected series has value below `ω^ρ` + refine supportOrderType_lt_of_forall_ordinalValue_translatedTruncation_lt _ hρ0 fun ζ hζ ↦ ?_ + rw [hcut ζ] + have hsmall : ∀ (s : Finset ℝ), (∀ ξ ∈ s, ξ ≠ ζ) → s ⊆ hL.toFinset → + ordinalValue (∑ ξ ∈ s, ∑ j, + translatedTruncation ((C ξ j * qt j : Series K) : K⟦ℝ⟧) (ζ - ξ)) < ω^ ρ := fun s hs hsub ↦ + ordinalValue_sum_lt _ _ (NatOrdinal.wpow_pos _) fun ξ hξ ↦ + ordinalValue_sum_lt _ _ (NatOrdinal.wpow_pos _) fun j _ ↦ by + rcases lt_or_gt_of_ne (hs ξ hξ) with h | h + · rw [ordinalValue_translatedTruncation_eq_zero_of_forall_support_le (s := 0) + (fun y hy ↦ Nonpositive.support_subset _ hy) (by linarith)] + exact NatOrdinal.wpow_pos _ + · exact hσ.ordinalValue_translatedTruncation_mul_aeval_lt hwt (hq j) (hCv ξ (hsub hξ) j) + ((hC ξ (hsub hξ)).2.1 j) (he j) ((lt_add_one τ).le.trans hτρ.le) (hsep j) + (by linarith) + by_cases hζL : ζ ∈ hL.toFinset + · rw [← Finset.add_sum_erase _ _ hζL, ← sub_sub] + have h1 := (hC ζ hζL).2.2 + have h2 := hsmall (hL.toFinset.erase ζ) (fun ξ hξ ↦ (Finset.mem_erase.mp hξ).1) + (Finset.erase_subset _ _) + have h3 : ∑ j, translatedTruncation ((C ζ j * qt j : Series K) : K⟦ℝ⟧) (ζ - ζ) = + ∑ j, C ζ j * qt j := by + refine Finset.sum_congr rfl fun j _ ↦ ?_ + rw [sub_self, translatedTruncation_zero] + rw [h3, sub_eq_add_neg _ (∑ ξ ∈ _, _)] + refine (ordinalValue_add_le_max _ _).trans_lt (max_lt h1 ?_) + rwa [ordinalValue_neg] + · have h1 : ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ζ) < ω^ ρ := by + by_contra hge + rw [not_lt] at hge + exact hζL ((hmemL ζ).mpr ⟨hζ, hge⟩) + have h2 := hsmall hL.toFinset (fun ξ hξ hne ↦ hζL (hne ▸ hξ)) subset_rfl + rw [sub_eq_add_neg] + refine (ordinalValue_add_le_max _ _).trans_lt (max_lt h1 ?_) + rwa [ordinalValue_neg] + · -- the translated truncations of the corrected series still satisfy (p) + intro ζ hζ + rw [hcut ζ] + have hbα : ∀ ξ ∈ hL.toFinset, ∀ j, ordinalValue + (translatedTruncation ((C ξ j * qt j : Series K) : K⟦ℝ⟧) (ζ - ξ)) < ω^ α := + fun ξ hξ j ↦ (hblock ξ hξ j _).trans_le (NatOrdinal.wpow_le_wpow.mpr hρα') + rw [σ.pol_sub hx hinj (hDα ζ) (ordinalValue_sum_lt _ _ (NatOrdinal.wpow_pos _) fun ξ hξ ↦ + ordinalValue_sum_lt _ _ (NatOrdinal.wpow_pos _) fun j _ ↦ hbα ξ hξ j), + σ.pol_sum hx hinj _ _ fun ξ hξ ↦ ordinalValue_sum_lt _ _ (NatOrdinal.wpow_pos _) + fun j _ ↦ hbα ξ hξ j, + componentsGE_sub, componentsGE_sum] + refine Ideal.sub_mem _ (htrunc ζ hζ) (Ideal.sum_mem _ fun ξ hξ ↦ ?_) + rw [σ.pol_sum hx hinj _ _ fun j _ ↦ hbα ξ hξ j, componentsGE_sum] + exact Ideal.sum_mem _ fun j _ ↦ hblockctrl ξ hξ j _ + +end Lifts + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Syzygy.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Syzygy.lean new file mode 100644 index 0000000000..c38e1f8934 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Syzygy.lean @@ -0,0 +1,251 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.RemainderBound +public import + LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan + +/-! +# High-degree components of truncated partial derivatives + +Let `F ∈ K[X]` be homogeneous of degree `α` in variables of degree below `α`. Suppose that the +translated truncations of `F(b_𝓑)` have ordinal value below `ω^{α₁}` for all `γ < 0` sufficiently +close to `0`. Let `α''` be at least `α₁` and exceed the degree of every term of the expansion of a +monomial of `F` by the convolution formula in which at least two factors are translated truncations +at cutoffs `ζ < 0` (`TermDegree wt d k ρ` with `2 ≤ k`). For an index `B′` and a degree `τ` with +`α'' ≤ τ ⊕ deg B′`, the differentiated form of the Leibniz rule with remainder +(`exists_forall_pol_translatedTruncation_aeval_pderiv`) gives, for all `γ < 0` sufficiently close +to `0`, + +`pol((∂F/∂X_{B′})(b_𝓑)^{|γ}) = ∂/∂X_{B′}[pol(G^{|γ})] − ∑_B (∂ pol(b_B^{|γ})/∂X_{B′}) ∂F/∂X_B + − ∂R_γ/∂X_{B′} + R′_γ`, + +with `R_γ`, `R′_γ` the remainders for `F` and for `∂F/∂X_{B′}`. The components of degree at least +`τ` of the first term and of the two remainder terms vanish: a monomial `m′` of any of them has +`X_{B′} m′` of degree below `α''`, hence `m′` of degree below `τ`. In the sum only the `B` with +`deg B > deg B′` contribute, `pol(b_B^{|γ})` having degree below `deg B`. Hence the components of +degree at least `τ` of `pol((∂F/∂X_{B′})(b_𝓑)^{|γ})` lie in the ideal `(∂F/∂X_B : deg B > deg B′)`. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial OrdinalGraded + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] {ι : Type w} {wt : ι → NatOrdinal} + +/-! ### Partial derivatives -/ + +/-- A monomial `d'` of `∂_i p` has `d' · X_i` a monomial of `p`. -/ +theorem add_single_mem_support_of_mem_support_pderiv {i : ι} {p : MvPolynomial ι K} {d' : ι →₀ ℕ} + (hd' : d' ∈ (pderiv i p).support) : d' + Finsupp.single i 1 ∈ p.support := by + obtain ⟨d, hd, hdi, rfl⟩ := exists_mem_support_of_mem_support_pderiv hd' + rwa [tsub_add_cancel_of_le (Finsupp.single_le_iff.mpr (Nat.one_le_iff_ne_zero.mpr hdi))] + +/-- A polynomial all of whose monomials have degree below `g ≤ wt v` has no monomial containing +`X_v`: its partial derivative with respect to `X_v` vanishes. -/ +theorem pderiv_eq_zero_of_degreeLT_le {P : MvPolynomial ι K} {g : NatOrdinal} + (hP : DegreeLT wt P g) {v : ι} (hg : g ≤ wt v) : pderiv v P = 0 := by + by_contra h + obtain ⟨d', hd'⟩ := support_nonempty.mpr h + obtain ⟨d, hd, hw⟩ := exists_add_eq_weight_of_mem_support_pderiv wt hd' + have h1 := degreeLT_iff.mp hP d hd + rw [← hw] at h1 + exact absurd (hg.trans (le_add_of_nonneg_left zero_le)) (not_le.mpr h1) + +/-! ### Components of a product with a homogeneous factor -/ + +open scoped Classical in +/-- The component of degree `γ` of `P · Q`, `Q` homogeneous of degree `c`, is the component of +degree `γ ⊖ c` of `P` times `Q`, and `0` if `c \not\preccurlyeq γ` in the algebraic order. -/ +theorem weightedHomogeneousComponent_mul_of_isWeightedHomogeneous {P Q : MvPolynomial ι K} + {c : NatOrdinal} (hQ : IsWeightedHomogeneous wt Q c) (γ : NatOrdinal) : + weightedHomogeneousComponent wt γ (P * Q) = + if h : ∃ β, β + c = γ then weightedHomogeneousComponent wt (Classical.choose h) P * Q + else 0 := by + classical + letI := weightedGradedAlgebra K wt + have hdec : ∀ (R : MvPolynomial ι K) (e : NatOrdinal), + (DirectSum.decompose (weightedHomogeneousSubmodule K wt) R e : MvPolynomial ι K) = + weightedHomogeneousComponent wt e R := fun R e ↦ by + rw [← decompose'_apply] + rfl + have := coe_decompose_mul_of_left_mem (𝒜 := weightedHomogeneousSubmodule K wt) + ((mem_weightedHomogeneousSubmodule _ _ _ _).mpr hQ) P γ + rw [mul_comm, ← hdec, this] + split_ifs with h + · rw [hdec, mul_comm] + · rfl + +variable {x : ι → PrincipalSubring K} + +namespace Lifts + +variable (σ : Lifts wt x) (hx : IsMinimalSystem (Berarducci.principalGrading K) wt x) + {α : NatOrdinal} (hinj : ∀ β < α, InjectiveAt K wt x β) (hσ : σ.IsPrincipal) +include hinj hσ + +/-- **The polynomial of a truncated partial derivative, above a degree `τ`.** Let `F` be homogeneous +of degree `α` in variables of degree `< α`, whose evaluation `F(b_𝓑)` has translated truncations of +ordinal value below `ω^{α₁}` for all `γ < 0` sufficiently close to `0`, with `α₁ ≤ α''` and +`α₁ ≤ α`; let every term of the expansion of a monomial of `F` with at least two translated +truncations have degree below `α''`. For an index `v'` and a degree `τ` with +`α'' ≤ τ ⊕ wt v'`: for all `γ < 0` sufficiently close to `0`, the components of degree at least `τ` +of `pol((∂F/∂X_{v'})(b_𝓑)^{|γ})` lie in the ideal of the `∂F/∂X_j` over the variables `j` of `F` +with `wt v' < wt j`. The index `v'` need not occur in `F`. -/ +@[blueprint "lem:differentiated-relation" + (phase := "Translated truncations") + (title := "High-degree Jacobian ideal membership") + (statement := /-- + Let $K$ be a field, let $(x_i)_{i\in I}$ be a minimal homogeneous + generating system of $\widehat{\mathrm P}$ with + $x_i\in\mathrm P_{w_i}$, and choose principal series $b_i$ of degree + $w_i$ representing the $x_i$. Assume that evaluation at $(x_i)$ is + injective in every weighted degree below $\alpha<\omega_1$. For a series + $a$ of ordinal value below $\omega^\alpha$, write $P_a$ for its resulting + polynomial representative. + + Let $F\in K[X_i:i\in I]$ be weighted-homogeneous of degree $\alpha$, and + suppose $w_i<\alpha$ for every variable $X_i$ occurring in $F$. Choose + ordinals $\alpha_1,\alpha''$ such that + $\alpha_1\le\alpha''$ and $\alpha_1\le\alpha$. Suppose that, for some + $\varepsilon_1>0$, + \[ + v_J((F(b_i))^{|\gamma})<\omega^{\alpha_1} + \qquad(-\varepsilon_1<\gamma<0). + \] + Assume also that every term obtained from a monomial of $F$ by replacing + the weights of at least two variable factors, counted with multiplicity, + by strictly smaller ordinals has weight below $\alpha''$. + + Fix $i'\in I$ and an ordinal $\tau$ with + $\alpha''\le\tau\oplus w_{i'}$. Then, for every $\gamma<0$ sufficiently + close to $0$, + \[ + \bigl(P_{((\partial_{i'}F)(b_i))^{|\gamma}}\bigr)_{\ge\tau} + \in + \bigl(\partial_jF: + j\in\operatorname{vars}(F),\ w_{i'} 0, ∀ γ : ℝ, -ε < γ → γ < 0 → + componentsGE wt τ (σ.pol hx α + (translatedTruncation ((aeval σ.lift (pderiv v' F) : Series K) : K⟦ℝ⟧) γ)) ∈ + Ideal.span (Set.range fun j : {j : ι // j ∈ F.vars ∧ wt v' < wt j} ↦ pderiv j.1 F) := by + classical + have hFdeg : ∀ d ∈ F.support, Finsupp.weight wt d ≤ α := + fun d hd ↦ (hF (mem_support_iff.mp hd)).le + obtain ⟨ε₂, hε₂, hD⟩ := σ.exists_forall_pol_translatedTruncation_aeval_pderiv hx hinj F hFdeg + hvars v' + refine ⟨min ε₁ ε₂, lt_min hε₁ hε₂, fun γ hγε hγ0 ↦ ?_⟩ + have hγ₁ : -ε₁ < γ := by linarith [min_le_left ε₁ ε₂] + have hγ₂ : -ε₂ < γ := by linarith [min_le_right ε₁ ε₂] + obtain ⟨E, E', hE, hE', heq⟩ := hD γ hγ₂ hγ0 + rw [heq, componentsGE_add, componentsGE_sub, componentsGE_sub] + -- a monomial `m'` with `v' m'` of degree below `α''` has degree below `τ` + have hlow : ∀ d' : ι →₀ ℕ, Finsupp.weight wt d' + wt v' < α'' → Finsupp.weight wt d' < τ := + fun d' h ↦ lt_of_add_lt_add_right (h.trans_le hτ) + -- `∂/∂X_{v'} pol(G^{|γ})` + have h1 : componentsGE wt τ (pderiv v' (σ.pol hx α + (translatedTruncation ((aeval σ.lift F : Series K) : K⟦ℝ⟧) γ))) = 0 := by + refine componentsGE_eq_zero_of_forall_lt wt fun d' hd' ↦ ?_ + obtain ⟨d, hd, hw⟩ := exists_add_eq_weight_of_mem_support_pderiv wt hd' + refine hlow d' ?_ + rw [hw] + exact (degreeLT_iff.mp (σ.pol_degreeLT_of_lt hx hinj hα₁α (hG γ hγ₁ hγ0)) d hd).trans_le hα₁ + -- the remainder for `F`, differentiated + have h2 : componentsGE wt τ (pderiv v' E) = 0 := by + refine componentsGE_eq_zero_of_forall_lt wt fun d' hd' ↦ ?_ + obtain ⟨d, hd, hw⟩ := exists_add_eq_weight_of_mem_support_pderiv wt hd' + obtain ⟨d₀, hd₀, k, hk, hρ⟩ := hE d hd + refine hlow d' ?_ + rw [hw] + exact hwin d₀ hd₀ k _ hk hρ + -- the remainder for `∂F/∂X_{v'}` + have h3 : componentsGE wt τ E' = 0 := by + refine componentsGE_eq_zero_of_forall_lt wt fun d' hd' ↦ ?_ + obtain ⟨d, hd, k, hk, hρ⟩ := hE' d' hd' + refine hlow d' ?_ + exact hwin _ (add_single_mem_support_of_mem_support_pderiv hd) k _ hk (hρ.untrunc v') + rw [h1, h2, h3, zero_sub, sub_zero, add_zero] + refine neg_mem ?_ + -- the sum: only the variables of degree above `wt v'` contribute + rw [← Finset.sum_filter_add_sum_filter_not F.vars fun j ↦ wt v' < wt j, componentsGE_add] + have hzero : ∑ j ∈ F.vars.filter (fun j ↦ ¬ wt v' < wt j), + pderiv v' (σ.pol hx α (translatedTruncation (σ.lift j : K⟦ℝ⟧) γ)) * pderiv j F = 0 := by + refine Finset.sum_eq_zero fun j hj ↦ ?_ + have hj' := (Finset.mem_filter.mp hj).2 + rw [not_lt] at hj' + have hdeg : DegreeLT wt (σ.pol hx α (translatedTruncation (σ.lift j : K⟦ℝ⟧) γ)) (wt j) := + σ.pol_degreeLT_of_lt hx hinj (hvars j (Finset.mem_filter.mp hj).1).le + (hσ.ordinalValue_translatedTruncation_lift_lt j hγ0) + rw [pderiv_eq_zero_of_degreeLT_le hdeg hj', zero_mul] + rw [hzero, componentsGE_zero, add_zero] + -- the generators are homogeneous + have hgen : ∀ j : {j : ι // j ∈ F.vars ∧ wt v' < wt j}, + ∃ c, IsWeightedHomogeneous wt (pderiv j.1 F) c := by + intro j + by_cases h : ∃ β, β + wt j.1 = α + · obtain ⟨β, hβ⟩ := h + exact ⟨β, isWeightedHomogeneous_pderiv wt hF j.1 hβ⟩ + · exact ⟨0, by + rw [pderiv_eq_zero_of_isWeightedHomogeneous wt hF j.1 h] + exact isWeightedHomogeneous_zero _ _ _⟩ + choose c hc using hgen + haveI : Finite {j : ι // j ∈ F.vars ∧ wt v' < wt j} := + (F.vars.finite_toSet.subset fun j (hj : j ∈ F.vars ∧ wt v' < wt j) ↦ hj.1).to_subtype + refine componentsGE_mem_span wt hc ?_ τ + refine Ideal.sum_mem _ fun j hj ↦ ?_ + have hj' := Finset.mem_filter.mp hj + exact Ideal.mul_mem_left _ _ (Ideal.subset_span ⟨⟨j, hj'.1, hj'.2⟩, rfl⟩) + +end Lifts + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationExpansion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationExpansion.lean new file mode 100644 index 0000000000..ce4fa26441 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationExpansion.lean @@ -0,0 +1,589 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.TermDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LeadingCoefficient +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationPolynomial + +/-! +# The Leibniz rule with remainder, read in polynomials + +Let `𝓑` be a minimal system of homogeneous generators with lifts `b_B`, and assume evaluation +injective below `α`. For a monomial `X^d = X_{B_1} ⋯ X_{B_n}` (factors listed with multiplicity) +the convolution formula [Ber00, Lem. 7.5], iterated over the factors, expresses the polynomial of +the translated truncation `(X^d(b_𝓑))^{|γ}` as a sum over the nonempty sets `S` of truncated +factors of products `∏_{s ∈ S} pol(b_s^{|ζ_s}) ∏_{s ∉ S} X_s` with `∑_{s ∈ S} ζ_s = γ`. The terms +with exactly one truncated factor sum to `∑_B pol(b_B^{|γ}) ∂X^d/∂X_B`; the remaining terms — +at least two truncated factors — have degrees of the form `⨁_{s ∉ S} deg s ⊕ ⨁_{s ∈ S} ρ_s` with +`ρ_s < deg s`. The Leibniz rule with remainder [Ber00, Lem. 7.7] +(`exists_forall_pol_translatedTruncation_aeval`): for all `γ < 0` sufficiently close to `0`, +`pol(G(b_𝓑)^{|γ}) = ∑_B pol(b_B^{|γ}) ∂G/∂X_B + R_γ`, where every monomial of the remainder `R_γ` +has such a degree, for some monomial of `G` and some set of at least two truncated factors. + +The degrees are recorded by the inductive predicate `TermDegree wt d k ρ`: `ρ` is the degree of a +term of the expansion of the monomial `d` with `k` truncated factors. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci MvPolynomial OrdinalGraded + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] {ι : Type w} [DecidableEq ι] {wt : ι → NatOrdinal} + {x : ι → PrincipalSubring K} + +/-- A common punctured neighborhood works for finitely many eventual properties. -/ +theorem exists_forall_of_forall_exists_forall {ι' : Type*} (s : Finset ι') (p : ι' → ℝ → Prop) + (h : ∀ i ∈ s, ∃ ε > 0, ∀ γ : ℝ, -ε < γ → γ < 0 → p i γ) : + ∃ ε > 0, ∀ γ : ℝ, -ε < γ → γ < 0 → ∀ i ∈ s, p i γ := by + classical + induction s using Finset.induction_on with + | empty => exact ⟨1, one_pos, fun _ _ _ i hi ↦ absurd hi (Finset.notMem_empty i)⟩ + | insert a s ha ih => + obtain ⟨ε₁, hε₁, h₁⟩ := h a (Finset.mem_insert_self a s) + obtain ⟨ε₂, hε₂, h₂⟩ := ih fun i hi ↦ h i (Finset.mem_insert_of_mem hi) + refine ⟨min ε₁ ε₂, lt_min hε₁ hε₂, fun γ hγε hγ0 i hi ↦ ?_⟩ + have hγ₁ : -ε₁ < γ := by have := min_le_left ε₁ ε₂; linarith + have hγ₂ : -ε₂ < γ := by have := min_le_right ε₁ ε₂; linarith + rcases Finset.mem_insert.mp hi with rfl | hi + · exact h₁ γ hγ₁ hγ0 + · exact h₂ γ hγ₂ hγ0 i hi + +/-! ### Degrees of the terms of the expansion -/ + +/-! ### The remainder -/ + +variable (wt) in +/-- `E` is a *remainder* for the monomial `d`: every monomial of `E` has the degree of a term of +the expansion of `d` with at least two truncated factors. -/ +def IsRemainder (d : ι →₀ ℕ) (E : MvPolynomial ι K) : Prop := + ∀ d' ∈ E.support, ∃ k, 2 ≤ k ∧ TermDegree wt d k (Finsupp.weight wt d') + +omit [DecidableEq ι] in +theorem isRemainder_zero (d : ι →₀ ℕ) : IsRemainder wt d (0 : MvPolynomial ι K) := fun d' hd' ↦ by + rw [support_zero] at hd' + exact absurd hd' (Finset.notMem_empty d') + +omit [DecidableEq ι] in +theorem IsRemainder.add {d : ι →₀ ℕ} {E E' : MvPolynomial ι K} (hE : IsRemainder wt d E) + (hE' : IsRemainder wt d E') : IsRemainder wt d (E + E') := by + classical + intro d' hd' + rcases Finset.mem_union.mp (support_add hd') with h | h + · exact hE d' h + · exact hE' d' h + +omit [DecidableEq ι] in +theorem IsRemainder.sum {ι' : Type*} {d : ι →₀ ℕ} (s : Finset ι') (E : ι' → MvPolynomial ι K) + (hE : ∀ j ∈ s, IsRemainder wt d (E j)) : IsRemainder wt d (∑ j ∈ s, E j) := by + classical + induction s using Finset.induction_on with + | empty => rw [Finset.sum_empty]; exact isRemainder_zero d + | insert a s ha ih => + rw [Finset.sum_insert ha] + exact (hE a (Finset.mem_insert_self a s)).add (ih fun j hj ↦ hE j (Finset.mem_insert_of_mem hj)) + +omit [DecidableEq ι] in +/-- Multiplying a remainder for `d` by `X_i` gives a remainder for `d + single i 1`. -/ +theorem IsRemainder.mul_X {d : ι →₀ ℕ} {E : MvPolynomial ι K} (hE : IsRemainder wt d E) (i : ι) : + IsRemainder wt (d + Finsupp.single i 1) (E * X i) := fun d' hd' ↦ by + classical + obtain ⟨d₁, hd₁, d₂, hd₂, hw⟩ := exists_add_eq_weight_of_mem_support_mul (wt := wt) hd' + obtain ⟨k, hk, hT⟩ := hE d₁ hd₁ + rw [X, support_monomial, if_neg one_ne_zero, Finset.mem_singleton] at hd₂ + subst hd₂ + rw [Finsupp.weight_single, one_smul] at hw + exact ⟨k, hk, hw ▸ TermDegree.untrunc i hT⟩ + +omit [DecidableEq ι] in +/-- Multiplying a polynomial whose monomials have degrees of terms of `d` with at least one +truncated factor by a polynomial of degree `< wt i` gives a remainder for `d + single i 1`. -/ +theorem isRemainder_mul_of_degreeLT {d : ι →₀ ℕ} {P Q : MvPolynomial ι K} + (hP : ∀ d' ∈ P.support, ∃ k, 1 ≤ k ∧ TermDegree wt d k (Finsupp.weight wt d')) {i : ι} + (hQ : DegreeLT wt Q (wt i)) : IsRemainder wt (d + Finsupp.single i 1) (P * Q) := fun d' hd' ↦ by + classical + obtain ⟨d₁, hd₁, d₂, hd₂, hw⟩ := exists_add_eq_weight_of_mem_support_mul (wt := wt) hd' + obtain ⟨k, hk, hT⟩ := hP d₁ hd₁ + refine ⟨k + 1, by omega, hw ▸ TermDegree.trunc i ((degreeLT_iff).mp hQ d₂ hd₂) hT⟩ + +/-! ### The Leibniz rule for monomials -/ + +namespace Lifts + +variable (σ : Lifts wt x) (hx : IsMinimalSystem (Berarducci.principalGrading K) wt x) + {α : NatOrdinal} (hinj : ∀ β < α, InjectiveAt K wt x β) +include hinj + +omit [DecidableEq ι] in +/-- The polynomial of a lift is its variable. -/ +theorem pol_lift {i : ι} (hi : wt i < α) : σ.pol hx α (σ.lift i) = X i := by + have h : σ.lift i = aeval σ.lift (X i : MvPolynomial ι K) := (aeval_X _ _).symm + rw [h] + exact σ.pol_aeval hx hinj ((isWeightedHomogeneous_X K wt i).degreeLT hi) + +omit [DecidableEq ι] in +/-- The polynomial of a monomial in the lifts is the monomial. -/ +theorem pol_aeval_monomial {d : ι →₀ ℕ} (hd : Finsupp.weight wt d < α) : + σ.pol hx α (aeval σ.lift (monomial d (1 : K))) = monomial d 1 := + σ.pol_aeval hx hinj ((isWeightedHomogeneous_monomial wt d (1 : K) rfl).degreeLT hd) + +omit [DecidableEq ι] hinj in +/-- The first-order terms of the expansion of a monomial: every monomial of +`∑_j Tj j * ∂X^d/∂X_j` has the degree of a term of `d` with one truncated factor, provided each +`Tj j` (in the application, `pol(b_j^{|γ})`) has degree `< wt j`. -/ +theorem forall_termDegree_sum_mul_pderiv_monomial (d : ι →₀ ℕ) (Tj : ι → MvPolynomial ι K) + (hTj : ∀ j ∈ d.support, DegreeLT wt (Tj j) (wt j)) : + ∀ d' ∈ (∑ j ∈ d.support, Tj j * pderiv j (monomial d (1 : K))).support, + ∃ k, 1 ≤ k ∧ TermDegree wt d k (Finsupp.weight wt d') := by + classical + intro d' hd' + obtain ⟨j, hj, hd'j⟩ := Finset.mem_biUnion.mp (support_sum hd') + obtain ⟨d₁, hd₁, d₂, hd₂, hw⟩ := exists_add_eq_weight_of_mem_support_mul (wt := wt) hd'j + rw [pderiv_monomial, support_monomial] at hd₂ + split_ifs at hd₂ with h0 + · exact absurd hd₂ (Finset.notMem_empty d₂) + · rw [Finset.mem_singleton] at hd₂ + subst hd₂ + have hdj : d - Finsupp.single j 1 + Finsupp.single j 1 = d := + Finsupp.sub_add_single_one_cancel (Finsupp.mem_support_iff.mp hj) + refine ⟨1, le_rfl, ?_⟩ + have := TermDegree.trunc_left j ((degreeLT_iff).mp (hTj j hj) d₁ hd₁) + (termDegree_weight wt (d - Finsupp.single j 1)) + rw [add_comm (Finsupp.single j 1), hdj] at this + rwa [← hw] + +omit [DecidableEq ι] hinj in +/-- Splitting off one factor: `X^{d + e_i} = X^d · X_i`. -/ +theorem monomial_add_single_one (d : ι →₀ ℕ) (i : ι) : + monomial (d + Finsupp.single i 1) (1 : K) = monomial d 1 * X i := by + rw [X, monomial_mul, mul_one] + +omit [DecidableEq ι] hinj in +/-- The first-order terms after splitting off one factor: +`∑_j T_j ∂(X^d X_i)/∂X_j = (∑_j T_j ∂X^d/∂X_j) X_i + T_i X^d`. -/ +theorem sum_mul_pderiv_monomial_add_single (d : ι →₀ ℕ) (i : ι) (T : ι → MvPolynomial ι K) : + ∑ j ∈ (d + Finsupp.single i 1).support, T j * pderiv j (monomial (d + Finsupp.single i 1) 1) = + (∑ j ∈ d.support, T j * pderiv j (monomial d (1 : K))) * X i + T i * monomial d 1 := by + classical + have hmem : i ∈ (d + Finsupp.single i 1).support := by + rw [Finsupp.mem_support_iff, Finsupp.add_apply, Finsupp.single_eq_same] + omega + have hsub : d.support ⊆ (d + Finsupp.single i 1).support := fun j hj ↦ by + rw [Finsupp.mem_support_iff] at hj ⊢ + rw [Finsupp.add_apply] + omega + simp only [monomial_add_single_one, pderiv_mul, mul_add, Finset.sum_add_distrib] + congr 1 + · rw [Finset.sum_mul, ← Finset.sum_subset hsub] + · exact Finset.sum_congr rfl fun j _ ↦ by ring + · intro j _ hj + rw [pderiv_monomial, Finsupp.notMem_support_iff.mp hj, Nat.cast_zero, mul_zero, monomial_zero, + zero_mul, mul_zero] + · rw [Finset.sum_eq_single i] + · rw [pderiv_X_self, mul_one] + · intro j _ hji + rw [pderiv_X_of_ne (Ne.symm hji), mul_zero, mul_zero] + · intro h + exact absurd hmem h + +omit [DecidableEq ι] in +/-- **The Leibniz rule with remainder for a monomial.** For `X^d` of degree `≤ α` in variables of +degree `< α`, and all `γ < 0` sufficiently close to `0`, `v_J((X^d(b_𝓑))^{|γ}) < ω^α` and the +polynomial of `(X^d(b_𝓑))^{|γ}` is `∑_j pol(b_j^{|γ}) ∂X^d/∂X_j + R_γ` with `R_γ` a remainder +for `d`. -/ +theorem exists_forall_pol_translatedTruncation_aeval_monomial (d : ι →₀ ℕ) + (hd : Finsupp.weight wt d ≤ α) (hvars : ∀ i ∈ d.support, wt i < α) : + ∃ ε > 0, ∀ γ : ℝ, -ε < γ → γ < 0 → + ordinalValue (translatedTruncation ((aeval σ.lift (monomial d (1 : K)) : Series K) : K⟦ℝ⟧) γ) + < ω^ α ∧ + ∃ E : MvPolynomial ι K, IsRemainder wt d E ∧ + σ.pol hx α (translatedTruncation ((aeval σ.lift (monomial d (1 : K)) : Series K) : K⟦ℝ⟧) γ) + = ∑ j ∈ d.support, σ.pol hx α (translatedTruncation (σ.lift j : K⟦ℝ⟧) γ) * + pderiv j (monomial d 1) + E := by + classical + -- strong induction on the number of factors + suffices h : ∀ n : ℕ, ∀ d : ι →₀ ℕ, Finsupp.degree d = n → Finsupp.weight wt d ≤ α → + (∀ i ∈ d.support, wt i < α) → ∃ ε > 0, ∀ γ : ℝ, -ε < γ → γ < 0 → + ordinalValue (translatedTruncation ((aeval σ.lift (monomial d (1 : K)) : Series K) : K⟦ℝ⟧) γ) + < ω^ α ∧ + ∃ E : MvPolynomial ι K, IsRemainder wt d E ∧ + σ.pol hx α (translatedTruncation ((aeval σ.lift (monomial d (1 : K)) : Series K) : K⟦ℝ⟧) γ) + = ∑ j ∈ d.support, σ.pol hx α (translatedTruncation (σ.lift j : K⟦ℝ⟧) γ) * + pderiv j (monomial d 1) + E from h _ d rfl hd hvars + intro n + induction n using Nat.strong_induction_on with + | _ n ih => + intro d hdn hd hvars + rcases eq_or_ne d 0 with rfl | hd0 + · -- the constant monomial + refine ⟨1, one_pos, fun γ _ hγ0 ↦ ?_⟩ + have h1 : aeval σ.lift (monomial (0 : ι →₀ ℕ) (1 : K)) = (1 : Series K) := by + rw [monomial_zero', C_1, map_one] + have htr : translatedTruncation ((1 : Series K) : K⟦ℝ⟧) γ = 0 := by + rw [Subring.coe_one, ← HahnSeries.C_one] + exact translatedTruncation_C_of_neg 1 hγ0 + rw [h1, htr, ordinalValue_zero] + refine ⟨NatOrdinal.wpow_pos α, 0, isRemainder_zero 0, ?_⟩ + simp only [σ.pol_zero hx hinj, Finsupp.support_zero, Finset.sum_empty, add_zero] + · -- split off one factor `X_i` + obtain ⟨i, hi⟩ := Finsupp.support_nonempty_iff.mpr hd0 + set d' := d - Finsupp.single i 1 with hd'def + have hdd' : d' + Finsupp.single i 1 = d := + Finsupp.sub_add_single_one_cancel (Finsupp.mem_support_iff.mp hi) + have hwd : Finsupp.weight wt d' + wt i = Finsupp.weight wt d := by + rw [← hdd', map_add, Finsupp.weight_single, one_smul] + have hdeg : Finsupp.degree d' < n := by + rw [← hdn, ← hdd', map_add, Finsupp.degree_single] + omega + have hwi : wt i < α := hvars i hi + have hwd'α : Finsupp.weight wt d' < α := by + have : Finsupp.weight wt d' < Finsupp.weight wt d' + wt i := + lt_add_of_pos_right _ (pos_iff_ne_zero.mpr (hx.ne_zero i)) + exact this.trans_le (hwd ▸ hd) + have hsub : d'.support ⊆ d.support := by + rw [hd'def] + exact Finsupp.support_tsub + obtain ⟨ε', hε', ih'⟩ := ih _ hdeg d' rfl hwd'α.le fun j hj ↦ hvars j (hsub hj) + -- the translated truncations of the lifts of the variables of `d` have value below `ω^{wt j}` + obtain ⟨εd, hεd, hdrop⟩ := exists_forall_of_forall_exists_forall d.support + (fun j β ↦ ordinalValue (translatedTruncation (σ.lift j : K⟦ℝ⟧) β) < ω^ (wt j)) + fun j _ ↦ exists_forall_ordinalValue_translatedTruncation_lt + (Berarducci.Represents.ordinalValue_lt (σ.represents j)) + -- the convolution formula for `X^{d'}(b_𝓑) · b_i` + set M' : Series K := aeval σ.lift (monomial d' (1 : K)) with hM'def + have hM' : ordinalValue M' < ω^ (Finsupp.weight wt d' + 1) := + Berarducci.Represents.ordinalValue_lt + (σ.aeval_represents (isWeightedHomogeneous_monomial wt d' (1 : K) rfl)) + have hli : ordinalValue (σ.lift i) < ω^ (wt i + 1) := + Berarducci.Represents.ordinalValue_lt (σ.represents i) + obtain ⟨εL, hεL, hL2⟩ := σ.exists_forall_pol_translatedTruncation_mul hx hinj hM' hli hwd'α hwi + (hwd ▸ hd) + -- the translated truncations of the product have value below `ω^{deg d}` + have hprod : aeval σ.lift (monomial d (1 : K)) = M' * σ.lift i := by + rw [← hdd', monomial_add_single_one, map_mul, aeval_X] + have hMprod : ordinalValue (M' * σ.lift i) < ω^ (Finsupp.weight wt d + 1) := by + rw [← hprod] + exact Berarducci.Represents.ordinalValue_lt + (σ.aeval_represents (isWeightedHomogeneous_monomial wt d (1 : K) rfl)) + obtain ⟨εP, hεP, hdropP⟩ := exists_forall_ordinalValue_translatedTruncation_lt hMprod + refine ⟨min (min ε' εd) (min εL εP), lt_min (lt_min hε' hεd) (lt_min hεL hεP), + fun γ hγε hγ0 ↦ ?_⟩ + have hm1 := min_le_left (min ε' εd) (min εL εP) + have hm2 := min_le_right (min ε' εd) (min εL εP) + have hγ' : -ε' < γ := by have := min_le_left ε' εd; linarith + have hγd : -εd < γ := by have := min_le_right ε' εd; linarith + have hγL : -εL < γ := by have := min_le_left εL εP; linarith + have hγP : -εP < γ := by have := min_le_right εL εP; linarith + refine ⟨?_, ?_⟩ + · rw [hprod] + exact (hdropP γ hγP hγ0).trans_le (NatOrdinal.wpow_le_wpow.mpr hd) + -- the index set of the convolution formula, with `0` and `γ` added + set S : Finset ℝ := insert 0 (insert γ (convolutionIndex (M' : K⟦ℝ⟧) (σ.lift i : K⟦ℝ⟧) γ)) + with hSdef + have hS1 : convolutionIndex (M' : K⟦ℝ⟧) (σ.lift i : K⟦ℝ⟧) γ ⊆ S := + (Finset.subset_insert _ _).trans (Finset.subset_insert _ _) + have hS2 : (S : Set ℝ) ⊆ Set.Icc γ 0 := by + intro β hβ + rw [hSdef, Finset.coe_insert, Finset.coe_insert] at hβ + rcases hβ with rfl | rfl | hβ + · exact ⟨hγ0.le, le_rfl⟩ + · exact ⟨le_rfl, hγ0.le⟩ + · exact mem_Icc_of_mem_convolutionIndex hβ + have h0S : (0 : ℝ) ∈ S := Finset.mem_insert_self _ _ + have hγS : γ ∈ S := Finset.mem_insert_of_mem (Finset.mem_insert_self _ _) + have hconv := hL2 γ hγL hγ0 S hS1 hS2 + rw [sum_eq_add_add_sum_erase h0S hγS hγ0.ne] at hconv + -- the two first-order terms of the convolution formula + rw [translatedTruncation_zero, sub_zero, σ.pol_aeval_monomial hx hinj hwd'α, sub_self, + translatedTruncation_zero, σ.pol_lift hx hinj hwi] at hconv + -- the induction hypothesis at `γ` + obtain ⟨-, E', hE', hexp'⟩ := ih' γ hγ' hγ0 + -- the remaining terms form a remainder + set R : MvPolynomial ι K := ∑ β ∈ (S.erase 0).erase γ, + σ.pol hx α (translatedTruncation (M' : K⟦ℝ⟧) β) * + σ.pol hx α (translatedTruncation (σ.lift i : K⟦ℝ⟧) (γ - β)) with hRdef + have hR : IsRemainder wt d R := by + rw [← hdd'] + refine IsRemainder.sum _ _ fun β hβ ↦ ?_ + have hβγ : β ≠ γ := (Finset.mem_erase.mp hβ).1 + have hβ0 : β ≠ 0 := (Finset.mem_erase.mp (Finset.mem_erase.mp hβ).2).1 + have hβS : β ∈ S := (Finset.mem_erase.mp (Finset.mem_erase.mp hβ).2).2 + obtain ⟨hβ1, hβ2⟩ := hS2 hβS + have hβlt : β < 0 := lt_of_le_of_ne hβ2 hβ0 + have hβgt : γ < β := lt_of_le_of_ne hβ1 (Ne.symm hβγ) + -- the degree of the truncated lift + have hQ : DegreeLT wt (σ.pol hx α (translatedTruncation (σ.lift i : K⟦ℝ⟧) (γ - β))) + (wt i) := + σ.pol_degreeLT_of_lt hx hinj hwi.le (hdrop (γ - β) (by linarith) (by linarith) i hi) + -- the expansion of `(X^{d'}(b_𝓑))^{|β}` + obtain ⟨-, E'', hE'', hexp''⟩ := ih' β (by linarith) hβlt + refine isRemainder_mul_of_degreeLT (fun d₁ hd₁ ↦ ?_) hQ + rw [hexp''] at hd₁ + rcases Finset.mem_union.mp (support_add hd₁) with h | h + · exact forall_termDegree_sum_mul_pderiv_monomial d' _ + (fun j hj ↦ σ.pol_degreeLT_of_lt hx hinj (hvars j (hsub hj)).le + (hdrop β (by linarith) hβlt j (hsub hj))) d₁ h + · obtain ⟨k, hk, hT⟩ := hE'' d₁ h + exact ⟨k, by omega, hT⟩ + refine ⟨E' * X i + R, (hdd' ▸ hE'.mul_X i).add hR, ?_⟩ + -- combine + rw [hprod, hconv, hexp', ← hdd', sum_mul_pderiv_monomial_add_single] + ring + +omit [DecidableEq ι] hinj in +/-- The ordinal value of a scalar multiple. -/ +theorem ordinalValue_C_mul_lt (k : K) {u : Series K} {β : NatOrdinal} (hu : ordinalValue u < ω^ β) : + ordinalValue ((HahnSeries.Nonpositive.C : K →+* Series K) k * u) < ω^ β := by + rcases eq_or_ne k 0 with rfl | hk + · rw [map_zero, zero_mul, ordinalValue_zero] + exact NatOrdinal.wpow_pos β + · rwa [ordinalValue_C_mul hk] + +omit [DecidableEq ι] in +/-- **The Leibniz rule with remainder [Ber00, Lem. 7.7], read in polynomials.** For `H ∈ K[X]` +with monomials of degree `≤ α` in variables of degree `< α`, and all `γ < 0` sufficiently close to +`0`, `v_J(H(b_𝓑)^{|γ}) < ω^α` and `pol(H(b_𝓑)^{|γ}) = ∑_j pol(b_j^{|γ}) ∂H/∂X_j + R_γ`, where +every monomial of the remainder `R_γ` has the degree of a term of the expansion of some monomial +of `H` with at least two truncated factors. -/ +@[blueprint "lem:leibniz-remainder" + (phase := "Translated truncations") + (title := "Polynomial Leibniz rule for translated truncations") + (statement := /-- + Let $K$ be a field, let $(x_i)_{i\in I}$ be a minimal homogeneous + generating system of $\widehat{\mathrm P}$ with + $x_i\in\mathrm P_{w_i}$, and choose series $b_i$ representing the $x_i$. + Assume that evaluation at $(x_i)$ is injective in every weighted degree + below $\alpha<\omega_1$. For a series $a$ of ordinal value below + $\omega^\alpha$, write $P_a$ for its resulting polynomial representative. + + Let $G\in K[X_i:i\in I]$. Suppose every monomial $X^d$ of $G$ has weight + at most $\alpha$, and $w_i<\alpha$ for every variable $X_i$ occurring in + $G$. Then, for every $\gamma<0$ sufficiently close to $0$, + \[ + v_J((G(b_i))^{|\gamma})<\omega^\alpha + \] + and there is a polynomial $R_\gamma$ such that + \[ + P_{(G(b_i))^{|\gamma}} + =\sum_{i\in\operatorname{vars}(G)} + P_{b_i^{|\gamma}}\frac{\partial G}{\partial X_i}+R_\gamma. + \] + More precisely, for every monomial $X^{d'}$ of $R_\gamma$, there are a + monomial $X^d$ of $G$, an integer $k\ge2$, a factorisation + \[ + X^d=X^{d_0}X_{i_1}\cdots X_{i_k}, + \] + with factors listed with multiplicity, and ordinals $\rho_r 0, ∀ γ : ℝ, -ε < γ → γ < 0 → + ordinalValue (translatedTruncation ((aeval σ.lift H : Series K) : K⟦ℝ⟧) γ) < ω^ α ∧ + ∃ E : MvPolynomial ι K, + (∀ d' ∈ E.support, ∃ d ∈ H.support, ∃ k, 2 ≤ k ∧ + TermDegree wt d k (Finsupp.weight wt d')) ∧ + σ.pol hx α (translatedTruncation ((aeval σ.lift H : Series K) : K⟦ℝ⟧) γ) = + ∑ j ∈ H.vars, σ.pol hx α (translatedTruncation (σ.lift j : K⟦ℝ⟧) γ) * pderiv j H + + E := by + classical + -- the expansions of the monomials, on a common interval `(-ε, 0)` + obtain ⟨ε, hε, hmono⟩ := exists_forall_of_forall_exists_forall H.support + (fun d γ ↦ ordinalValue (translatedTruncation + ((aeval σ.lift (monomial d (1 : K)) : Series K) : K⟦ℝ⟧) γ) < ω^ α ∧ + ∃ E : MvPolynomial ι K, IsRemainder wt d E ∧ + σ.pol hx α (translatedTruncation ((aeval σ.lift (monomial d (1 : K)) : Series K) : K⟦ℝ⟧) γ) + = ∑ j ∈ d.support, σ.pol hx α (translatedTruncation (σ.lift j : K⟦ℝ⟧) γ) * + pderiv j (monomial d 1) + E) + fun d hd ↦ σ.exists_forall_pol_translatedTruncation_aeval_monomial hx hinj d (hH d hd) + fun i hi ↦ hvars i ((mem_vars_iff_mem_support i).mpr ⟨d, hd, hi⟩) + refine ⟨ε, hε, fun γ hγε hγ0 ↦ ?_⟩ + -- the translated truncation of `H(b_𝓑)` as a sum over the monomials of `H` + have hmon : ∀ d, monomial d (coeff d H) = C (coeff d H) * monomial d (1 : K) := fun d ↦ by + rw [C_mul_monomial, mul_one] + have hcoe : ∀ d, aeval σ.lift (monomial d (coeff d H)) = + (HahnSeries.Nonpositive.C : K →+* Series K) (coeff d H) * + aeval σ.lift (monomial d (1 : K)) := fun d ↦ by + rw [hmon, map_mul, aeval_C, HahnSeries.Nonpositive.algebraMap_apply] + have hsplit : translatedTruncation ((aeval σ.lift H : Series K) : K⟦ℝ⟧) γ = + ∑ d ∈ H.support, (HahnSeries.Nonpositive.C : K →+* Series K) (coeff d H) * + translatedTruncation ((aeval σ.lift (monomial d (1 : K)) : Series K) : K⟦ℝ⟧) γ := by + conv_lhs => rw [H.as_sum, map_sum] + rw [AddSubmonoidClass.coe_finsetSum, ← translatedTruncationAddMonoidHom_apply, map_sum] + refine Finset.sum_congr rfl fun d _ ↦ ?_ + rw [translatedTruncationAddMonoidHom_apply, hcoe, Subring.coe_mul, + HahnSeries.Nonpositive.coe_C, translatedTruncation_C_mul] + have hval : ∀ d ∈ H.support, + ordinalValue ((HahnSeries.Nonpositive.C : K →+* Series K) (coeff d H) * + translatedTruncation ((aeval σ.lift (monomial d (1 : K)) : Series K) : K⟦ℝ⟧) γ) < ω^ α := + fun d hd ↦ ordinalValue_C_mul_lt _ (hmono γ hγε hγ0 d hd).1 + refine ⟨?_, ?_⟩ + · rw [hsplit] + exact ordinalValue_sum_lt _ _ (NatOrdinal.wpow_pos α) hval + -- the expansions of the monomials + choose E hE hexp using fun d (hd : d ∈ H.support) ↦ (hmono γ hγε hγ0 d hd).2 + refine ⟨∑ d ∈ H.support.attach, C (coeff d.1 H) * E d.1 d.2, fun d' hd' ↦ ?_, ?_⟩ + · obtain ⟨d, _, hd'd⟩ := Finset.mem_biUnion.mp (support_sum hd') + have hd'E : d' ∈ (E d.1 d.2).support := by + rw [C_mul'] at hd'd + exact support_smul hd'd + obtain ⟨k, hk, hT⟩ := hE d.1 d.2 d' hd'E + exact ⟨d.1, d.2, k, hk, hT⟩ + -- abbreviations + set T : ι → MvPolynomial ι K := fun j ↦ σ.pol hx α (translatedTruncation (σ.lift j : K⟦ℝ⟧) γ) + with hTdef + have hsupp : ∀ d : ι →₀ ℕ, ∀ j, j ∉ d.support → pderiv j (monomial d (1 : K)) = 0 := + fun d j hj ↦ by + rw [pderiv_monomial, Finsupp.notMem_support_iff.mp hj, Nat.cast_zero, mul_zero, monomial_zero] + have hsub : ∀ d ∈ H.support, d.support ⊆ H.vars := fun d hd j hj ↦ + (mem_vars_iff_mem_support j).mpr ⟨d, hd, hj⟩ + -- the left-hand side + have hlhs : σ.pol hx α (translatedTruncation ((aeval σ.lift H : Series K) : K⟦ℝ⟧) γ) = + ∑ d ∈ H.support.attach, (C (coeff d.1 H) * ∑ j ∈ H.vars, T j * pderiv j (monomial d.1 1) + + C (coeff d.1 H) * E d.1 d.2) := by + rw [hsplit, σ.pol_sum hx hinj _ _ hval, ← Finset.sum_attach H.support] + refine Finset.sum_congr rfl fun d _ ↦ ?_ + rw [σ.pol_C_mul hx hinj _ (hmono γ hγε hγ0 _ d.2).1, hexp d.1 d.2, mul_add] + congr 2 + exact Finset.sum_subset (hsub d.1 d.2) fun j _ hj ↦ by rw [hsupp d.1 j hj, mul_zero] + -- the right-hand side + have hpd : ∀ j, pderiv j H = + ∑ d ∈ H.support.attach, C (coeff d.1 H) * pderiv j (monomial d.1 1) := fun j ↦ by + conv_lhs => rw [H.as_sum, map_sum, ← Finset.sum_attach H.support] + exact Finset.sum_congr rfl fun d _ ↦ by rw [hmon, pderiv_C_mul] + rw [hlhs, Finset.sum_add_distrib] + congr 1 + simp only [hpd, Finset.mul_sum] + rw [Finset.sum_comm] + refine Finset.sum_congr rfl fun d _ ↦ Finset.sum_congr rfl fun j _ ↦ by ring + +omit [DecidableEq ι] in +/-- **The Leibniz rule with remainder, differentiated.** Differentiating the Leibniz rule for `F` +with respect to `X_v` and comparing with the rule for `∂F/∂X_v`: for all `γ < 0` sufficiently +close to `0`, +`pol((∂F/∂X_v)(b_𝓑)^{|γ}) = ∂/∂X_v [pol(F(b_𝓑)^{|γ})] - ∑_j (∂/∂X_v pol(b_j^{|γ})) ∂F/∂X_j +- ∂R_γ/∂X_v + R'_γ`, where every monomial of `R_γ`, resp. `R'_γ`, has the degree of a term of the +expansion of a monomial of `F`, resp. of `∂F/∂X_v`, with at least two truncated factors. -/ +@[blueprint "lem:differentiated-leibniz-remainder" + (phase := "Translated truncations") + (title := "Differentiated polynomial Leibniz rule") + (statement := /-- + Let $K$ be a field, let $(x_i)_{i\in I}$ be a minimal homogeneous + generating system of $\widehat{\mathrm P}$ with + $x_i\in\mathrm P_{w_i}$, and choose series $b_i$ representing the $x_i$. + Assume that evaluation at $(x_i)$ is injective in every weighted degree + below $\alpha<\omega_1$, and write $P_a$ for the polynomial representative + of a series $a$ of ordinal value below $\omega^\alpha$. + + Let $F\in K[X_i:i\in I]$. Suppose every monomial of $F$ has weight at most + $\alpha$, and $w_i<\alpha$ for every variable $X_i$ occurring in $F$. For + every $v\in I$ and every $\gamma<0$ sufficiently close to $0$, there are + polynomials $R_\gamma,R'_\gamma$ such that + \[ + P_{((\partial_vF)(b_i))^{|\gamma}} + =\partial_vP_{(F(b_i))^{|\gamma}} + -\sum_{j\in\operatorname{vars}(F)} + (\partial_vP_{b_j^{|\gamma}})\,\partial_jF + -\partial_vR_\gamma+R'_\gamma, + \] + where every monomial of $R_\gamma$, respectively $R'_\gamma$, is obtained + from a monomial of $F$, respectively $\partial_vF$, by replacing the + weights of at least two variable factors, counted with multiplicity, by + strictly smaller ordinals. + -/) + (proof := /-- + Partial differentiation weakly decreases every monomial weight and + introduces no new variables. Hence \ref{lem:leibniz-remainder} applies to + both $F$ and $\partial_vF$ on one + common punctured interval. Differentiate the expansion for $F$, use the + polynomial product rule and commutativity of partial derivatives, and + subtract the expansion for $\partial_vF$. Variables of $F$ absent from + $\partial_vF$ contribute zero, so both sums may be indexed by + $\operatorname{vars}(F)$. Rearrangement gives the displayed identity while + preserving the two remainder conditions. + -/)] +theorem exists_forall_pol_translatedTruncation_aeval_pderiv (F : MvPolynomial ι K) + (hF : ∀ d ∈ F.support, Finsupp.weight wt d ≤ α) (hvars : ∀ i ∈ F.vars, wt i < α) (v : ι) : + ∃ ε > 0, ∀ γ : ℝ, -ε < γ → γ < 0 → + ∃ E E' : MvPolynomial ι K, + (∀ d' ∈ E.support, ∃ d ∈ F.support, ∃ k, 2 ≤ k ∧ + TermDegree wt d k (Finsupp.weight wt d')) ∧ + (∀ d' ∈ E'.support, ∃ d ∈ (pderiv v F).support, ∃ k, 2 ≤ k ∧ + TermDegree wt d k (Finsupp.weight wt d')) ∧ + σ.pol hx α (translatedTruncation ((aeval σ.lift (pderiv v F) : Series K) : K⟦ℝ⟧) γ) = + pderiv v (σ.pol hx α (translatedTruncation ((aeval σ.lift F : Series K) : K⟦ℝ⟧) γ)) - + ∑ j ∈ F.vars, pderiv v (σ.pol hx α (translatedTruncation (σ.lift j : K⟦ℝ⟧) γ)) * + pderiv j F - pderiv v E + E' := by + classical + have hΘ : ∀ d ∈ (pderiv v F).support, Finsupp.weight wt d ≤ α := fun d' hd' ↦ by + obtain ⟨d, hd, hw⟩ := exists_add_eq_weight_of_mem_support_pderiv wt hd' + exact (NatOrdinal.le_add_right.trans hw.le).trans (hF d hd) + have hvarsΘ : ∀ i ∈ (pderiv v F).vars, wt i < α := fun i hi ↦ hvars i (vars_pderiv_subset v F hi) + obtain ⟨ε₁, hε₁, h₁⟩ := σ.exists_forall_pol_translatedTruncation_aeval hx hinj F hF hvars + obtain ⟨ε₂, hε₂, h₂⟩ := σ.exists_forall_pol_translatedTruncation_aeval hx hinj (pderiv v F) hΘ + hvarsΘ + refine ⟨min ε₁ ε₂, lt_min hε₁ hε₂, fun γ hγε hγ0 ↦ ?_⟩ + have hγ₁ : -ε₁ < γ := by have := min_le_left ε₁ ε₂; linarith + have hγ₂ : -ε₂ < γ := by have := min_le_right ε₁ ε₂; linarith + obtain ⟨-, E, hE, hexpF⟩ := h₁ γ hγ₁ hγ0 + obtain ⟨-, E', hE', hexpΘ⟩ := h₂ γ hγ₂ hγ0 + refine ⟨E, E', hE, hE', ?_⟩ + set T : ι → MvPolynomial ι K := fun j ↦ σ.pol hx α (translatedTruncation (σ.lift j : K⟦ℝ⟧) γ) + with hTdef + -- differentiate the expansion of `F` + have hdF : pderiv v (σ.pol hx α (translatedTruncation ((aeval σ.lift F : Series K) : K⟦ℝ⟧) γ)) = + ∑ j ∈ F.vars, pderiv v (T j) * pderiv j F + ∑ j ∈ F.vars, T j * pderiv j (pderiv v F) + + pderiv v E := by + rw [hexpF, map_add, map_sum, ← Finset.sum_add_distrib] + congr 1 + exact Finset.sum_congr rfl fun j _ ↦ by rw [pderiv_mul, pderiv_pderiv_comm] + -- the expansion of `∂F/∂X_v`, summed over the variables of `F` + have hexpΘ' : σ.pol hx α (translatedTruncation ((aeval σ.lift (pderiv v F) : Series K) : K⟦ℝ⟧) γ) + = ∑ j ∈ F.vars, T j * pderiv j (pderiv v F) + E' := by + rw [hexpΘ] + congr 1 + exact Finset.sum_subset (vars_pderiv_subset v F) fun j _ hj ↦ by + rw [pderiv_eq_zero_of_notMem_vars hj, mul_zero] + rw [hexpΘ', hdF] + ring + +end Lifts + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationPolynomial.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationPolynomial.lean new file mode 100644 index 0000000000..3370a360d1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationPolynomial.lean @@ -0,0 +1,463 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Lifts +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.TruncationDrop +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalExpansion +import Mathlib.Topology.Order.LeftRightNhds + +/-! +# The polynomial of a translated truncation, and the convolution formula read in polynomials + +Fix a minimal system of homogeneous generators `𝓑` of `P̂` with lifts `b_B`, a degree `α`, and +assume evaluation `K[X] → P̂` injective in every degree below `α`; `pol` then identifies the +classes modulo `J` of ordinal value below `ω^α` with the polynomials of degree below `α` +(`Lifts.pol_eq_of_toGerm_aeval_eq`). This file records the calculus of `pol`: it respects +congruence modulo `J`, sums, scalars, and products whose polynomial has degree below `α`; a series +of ordinal value below `ω^(β+1)` has polynomial of degree at most `β`. + +Berarducci's convolution formula `(uv)^{|γ} ≡ ∑_ξ u^{|ξ} v^{|γ-ξ} (mod J)` [Ber00, Lem. 7.5] then +reads, for `u, v` of ordinal value below `ω^(β_u+1)`, `ω^(β_v+1)` with `β_u, β_v < α` and +`β_u ⊕ β_v ≤ α`, and all `γ < 0` sufficiently close to `0`, as the polynomial identity +`pol((uv)^{|γ}) = ∑_ξ pol(u^{|ξ}) · pol(v^{|γ-ξ})` +(`Lifts.exists_forall_pol_translatedTruncation_mul`). The sum may be taken over any finite set of +cutoffs containing Berarducci's index set and contained in `[γ, 0]`; the terms at `ξ = 0` and +`ξ = γ` are the boundary terms `pol(u) · pol(v^{|γ})` and `pol(u^{|γ}) · pol(v)`. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci MvPolynomial OrdinalGraded Filter Topology + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-! ### The quantifier "for all `γ < 0` sufficiently close to `0`" with an explicit `ε` -/ + +/-- A property holds for all `γ < 0` sufficiently close to `0` exactly when there is `ε > 0` such +that it holds for all `γ ∈ (-ε, 0)`. -/ +theorem eventually_nhdsLT_zero_iff {p : ℝ → Prop} : + (∀ᶠ γ in 𝓝[<] (0 : ℝ), p γ) ↔ ∃ ε > 0, ∀ γ : ℝ, -ε < γ → γ < 0 → p γ := by + rw [Filter.eventually_iff, mem_nhdsLT_iff_exists_Ioo_subset] + constructor + · rintro ⟨l, hl, hsub⟩ + exact ⟨-l, by simpa using hl, fun γ h1 h2 ↦ hsub ⟨by linarith, h2⟩⟩ + · rintro ⟨ε, hε, h⟩ + exact ⟨-ε, by simpa using hε, fun γ hγ ↦ h γ hγ.1 hγ.2⟩ + +/-- If `v_J(u) < ω^(β+1)`, there is `ε > 0` such that `v_J(u^{|γ}) < ω^β` for all `γ ∈ (-ε, 0)`. -/ +theorem exists_forall_ordinalValue_translatedTruncation_lt {β : NatOrdinal} {u : Series K} + (hu : ordinalValue u < ω^ (β + 1)) : + ∃ ε > 0, ∀ γ : ℝ, -ε < γ → γ < 0 → + ordinalValue (translatedTruncation (u : K⟦ℝ⟧) γ) < ω^ β := + eventually_nhdsLT_zero_iff.mp + (eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one β u hu) + +/-- The translated truncation of a constant at a negative cutoff is zero. -/ +theorem translatedTruncation_C_of_neg (k : K) {γ : ℝ} (hγ : γ < 0) : + translatedTruncation (HahnSeries.C k : K⟦ℝ⟧) γ = 0 := by + apply Subtype.ext + ext δ + rw [coeff_translatedTruncation, Subring.coe_zero, HahnSeries.coeff_zero] + split_ifs with hδ + · rw [HahnSeries.C_apply, HahnSeries.coeff_single, if_neg (by linarith)] + · rfl + +/-! ### Degree at most `β` -/ + +variable {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +variable (wt) in +/-- Every monomial of `F` has degree at most `β`. -/ +def DegreeLE (F : MvPolynomial ι K) (β : NatOrdinal) : Prop := + ∀ d ∈ F.support, Finsupp.weight wt d ≤ β + +theorem degreeLE_iff {F : MvPolynomial ι K} {β : NatOrdinal} : + DegreeLE wt F β ↔ ∀ d ∈ F.support, Finsupp.weight wt d ≤ β := + Iff.rfl + +theorem degreeLT_add_one_iff_degreeLE {F : MvPolynomial ι K} {β : NatOrdinal} : + DegreeLT wt F (β + 1) ↔ DegreeLE wt F β := by + rw [degreeLT_iff, degreeLE_iff] + exact forall₂_congr fun _ _ ↦ Order.lt_add_one_iff + +theorem DegreeLE.degreeLT {F : MvPolynomial ι K} {β α : NatOrdinal} (hF : DegreeLE wt F β) + (h : β < α) : DegreeLT wt F α := + degreeLT_iff.mpr fun d hd ↦ (hF d hd).trans_lt h + +theorem DegreeLT.degreeLE {F : MvPolynomial ι K} {β : NatOrdinal} (hF : DegreeLT wt F β) : + DegreeLE wt F β := fun d hd ↦ (degreeLT_iff.mp hF d hd).le + +theorem _root_.MvPolynomial.IsWeightedHomogeneous.degreeLE {F : MvPolynomial ι K} + {β : NatOrdinal} (hF : IsWeightedHomogeneous wt F β) : DegreeLE wt F β := + fun _ hd ↦ (hF (mem_support_iff.mp hd)).le + +theorem DegreeLE.mul {F G : MvPolynomial ι K} {β β' : NatOrdinal} (hF : DegreeLE wt F β) + (hG : DegreeLE wt G β') : DegreeLE wt (F * G) (β + β') := by + classical + intro d hd + obtain ⟨d1, hd1, d2, hd2, rfl⟩ := Finset.mem_add.mp (support_mul F G hd) + rw [map_add] + exact add_le_add (hF d1 hd1) (hG d2 hd2) + +theorem DegreeLE.mul_degreeLT {F G : MvPolynomial ι K} {β β' : NatOrdinal} (hF : DegreeLE wt F β) + (hG : DegreeLT wt G β') : DegreeLT wt (F * G) (β + β') := by + classical + rw [degreeLT_iff] at hG ⊢ + intro d hd + obtain ⟨d1, hd1, d2, hd2, rfl⟩ := Finset.mem_add.mp (support_mul F G hd) + rw [map_add] + exact add_lt_add_of_le_of_lt (hF d1 hd1) (hG d2 hd2) + +theorem DegreeLT.mul_degreeLE {F G : MvPolynomial ι K} {β β' : NatOrdinal} (hF : DegreeLT wt F β) + (hG : DegreeLE wt G β') : DegreeLT wt (F * G) (β + β') := by + classical + rw [degreeLT_iff] at hF ⊢ + intro d hd + obtain ⟨d1, hd1, d2, hd2, rfl⟩ := Finset.mem_add.mp (support_mul F G hd) + rw [map_add] + exact add_lt_add_of_lt_of_le (hF d1 hd1) (hG d2 hd2) + +theorem DegreeLT.mul {F G : MvPolynomial ι K} {β β' : NatOrdinal} (hF : DegreeLT wt F β) + (hG : DegreeLT wt G β') : DegreeLT wt (F * G) (β + β') := + hF.mul_degreeLE hG.degreeLE + +/-! ### The calculus of `pol` -/ + +namespace Lifts + +variable (σ : Lifts wt x) (hx : IsMinimalSystem (Berarducci.principalGrading K) wt x) + {α : NatOrdinal} (hinj : ∀ β < α, InjectiveAt K wt x β) +include hinj + +theorem pol_zero : σ.pol hx α (0 : Series K) = 0 := + σ.pol_eq_zero_of_mem hx hinj (Ideal.zero_mem _) + +/-- `pol` depends only on the class modulo `J`. -/ +theorem pol_congr {u u' : Series K} (hu : ordinalValue u < ω^ α) (h : toGerm u = toGerm u') : + σ.pol hx α u = σ.pol hx α u' := by + have hu' : ordinalValue u' < ω^ α := by + rwa [← ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (toGerm_eq_toGerm_iff.mp h)] + exact (σ.pol_eq_of_toGerm_aeval_eq hx hinj hu' (σ.pol_degreeLT hx α u) + (by rw [σ.toGerm_aeval_pol hx hu, h])).symm + +theorem pol_sum {ι' : Type*} (s : Finset ι') (f : ι' → Series K) + (h : ∀ i ∈ s, ordinalValue (f i) < ω^ α) : + σ.pol hx α (∑ i ∈ s, f i) = ∑ i ∈ s, σ.pol hx α (f i) := by + classical + induction s using Finset.induction_on with + | empty => rw [Finset.sum_empty, Finset.sum_empty]; exact σ.pol_zero hx hinj + | insert a s ha ih => + rw [Finset.sum_insert ha, Finset.sum_insert ha, + σ.pol_add hx hinj (h a (Finset.mem_insert_self a s)) + (ordinalValue_sum_lt s f (NatOrdinal.wpow_pos α) fun i hi ↦ + h i (Finset.mem_insert_of_mem hi)), + ih fun i hi ↦ h i (Finset.mem_insert_of_mem hi)] + +/-- `pol` of a scalar multiple. -/ +theorem pol_C_mul (k : K) {u : Series K} (hu : ordinalValue u < ω^ α) : + σ.pol hx α ((HahnSeries.Nonpositive.C : K →+* Series K) k * u) = + C k * σ.pol hx α u := by + rcases eq_or_ne k 0 with rfl | hk + · rw [map_zero, zero_mul, map_zero, zero_mul]; exact σ.pol_zero hx hinj + refine σ.pol_eq_of_toGerm_aeval_eq hx hinj (by rwa [ordinalValue_C_mul hk]) ?_ ?_ + · rw [C_mul', degreeLT_iff] + exact fun d hd ↦ degreeLT_iff.mp (σ.pol_degreeLT hx α u) d (support_smul hd) + · rw [map_mul, aeval_C, HahnSeries.Nonpositive.algebraMap_apply, map_mul, map_mul, + σ.toGerm_aeval_pol hx hu] + +/-- `pol` of a product whose polynomial has degree below `α`, together with the ordinal value +bound on the product. -/ +theorem pol_mul {u u' : Series K} (hu : ordinalValue u < ω^ α) (hu' : ordinalValue u' < ω^ α) + (hFG : DegreeLT wt (σ.pol hx α u * σ.pol hx α u') α) : + ordinalValue (u * u') < ω^ α ∧ σ.pol hx α (u * u') = σ.pol hx α u * σ.pol hx α u' := by + have hgerm : toGerm (aeval σ.lift (σ.pol hx α u * σ.pol hx α u')) = toGerm (u * u') := by + rw [map_mul, map_mul, σ.toGerm_aeval_pol hx hu, σ.toGerm_aeval_pol hx hu', map_mul] + have hval : ordinalValue (u * u') < ω^ α := by + rw [← ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (toGerm_eq_toGerm_iff.mp hgerm)] + exact σ.ordinalValue_aeval_lt_of_degreeLT hFG + exact ⟨hval, σ.pol_eq_of_toGerm_aeval_eq hx hinj hval hFG hgerm⟩ + +/-- A series of ordinal value below `ω^α'`, `α' ≤ α`, has polynomial of degree below `α'`. -/ +theorem pol_degreeLT_of_lt {α' : NatOrdinal} (hα' : α' ≤ α) {u : Series K} + (hu : ordinalValue u < ω^ α') : DegreeLT wt (σ.pol hx α u) α' := by + obtain ⟨F, hF, hFu⟩ := σ.exists_degreeLT_toGerm_aeval_eq hx α' u hu + rw [σ.pol_eq_of_toGerm_aeval_eq hx hinj (hu.trans_le (NatOrdinal.wpow_le_wpow.mpr hα')) + (hF.mono hα') hFu] + exact hF + +/-- A series of ordinal value below `ω^(β+1)`, `β < α`, has polynomial of degree at most `β`. -/ +theorem pol_degreeLE {β : NatOrdinal} (hβ : β < α) {u : Series K} + (hu : ordinalValue u < ω^ (β + 1)) : DegreeLE wt (σ.pol hx α u) β := + degreeLT_add_one_iff_degreeLE.mp (σ.pol_degreeLT_of_lt hx hinj (Order.add_one_le_of_lt hβ) hu) + +/-- The polynomial of the translated truncation of a constant at a cutoff `γ < 0` is zero. -/ +theorem pol_translatedTruncation_C (k : K) {γ : ℝ} (hγ : γ < 0) : + σ.pol hx α (translatedTruncation + (((HahnSeries.Nonpositive.C : K →+* Series K) k : Series K) : K⟦ℝ⟧) γ) = 0 := by + rw [HahnSeries.Nonpositive.coe_C, translatedTruncation_C_of_neg k hγ] + exact σ.pol_zero hx hinj + +end Lifts + +/-! ### The convolution formula over an enlarged index set -/ + +/-- The cutoffs of Berarducci's index set lie in `[γ, 0]` for nonpositive series. -/ +theorem mem_Icc_of_mem_convolutionIndex {u v : Series K} {γ β : ℝ} + (h : β ∈ convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) γ) : β ∈ Set.Icc γ 0 := by + rw [mem_convolutionIndex] at h + have h1 : β ≤ 0 := closure_minimal (HahnSeries.Nonpositive.support_subset u) isClosed_Iic h.1 + have h2 : γ - β ≤ 0 := + closure_minimal (HahnSeries.Nonpositive.support_subset v) isClosed_Iic h.2 + exact ⟨by linarith, h1⟩ + +/-- The germ convolution formula over a finite set containing every cutoff whose germ product +is nonzero; omitted zero terms do not need to be listed. -/ +theorem germAt_mul_of_support_subset (u v : Series K) (γ : ℝ) {S : Finset ℝ} + (hS : ∀ ξ : ℝ, + germAt (u : K⟦ℝ⟧) ξ * germAt (v : K⟦ℝ⟧) (γ - ξ) ≠ 0 → ξ ∈ S) : + germAt ((u : K⟦ℝ⟧) * (v : K⟦ℝ⟧)) γ = + ∑ ξ ∈ S, germAt (u : K⟦ℝ⟧) ξ * germAt (v : K⟦ℝ⟧) (γ - ξ) := by + classical + rw [germAt_mul] + calc + ∑ ξ ∈ convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) γ, + germAt (u : K⟦ℝ⟧) ξ * germAt (v : K⟦ℝ⟧) (γ - ξ) = + ∑ ξ ∈ convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) γ ∩ S, + germAt (u : K⟦ℝ⟧) ξ * germAt (v : K⟦ℝ⟧) (γ - ξ) := by + symm + refine Finset.sum_subset Finset.inter_subset_left fun ξ hξ hnot ↦ ?_ + by_contra hne + exact hnot (Finset.mem_inter.mpr ⟨hξ, hS ξ hne⟩) + _ = ∑ ξ ∈ S, germAt (u : K⟦ℝ⟧) ξ * germAt (v : K⟦ℝ⟧) (γ - ξ) := by + refine Finset.sum_subset Finset.inter_subset_right fun ξ hξ hnot ↦ ?_ + have hI : ξ ∉ convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) γ := + fun hi ↦ hnot (Finset.mem_inter.mpr ⟨hi, hξ⟩) + rw [mem_convolutionIndex, not_and_or] at hI + rcases hI with h | h + · rw [germAt_eq_zero_of_not_mem_closure_support h, zero_mul] + · rw [germAt_eq_zero_of_not_mem_closure_support h, mul_zero] + +/-- Berarducci's convolution formula [Ber00, Lem. 7.5] summed over any finite set of cutoffs +containing his index set: the extra terms vanish. -/ +theorem germAt_mul_of_subset (u v : Series K) (γ : ℝ) {S : Finset ℝ} + (hS : convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) γ ⊆ S) : + germAt ((u : K⟦ℝ⟧) * (v : K⟦ℝ⟧)) γ = + ∑ β ∈ S, germAt (u : K⟦ℝ⟧) β * germAt (v : K⟦ℝ⟧) (γ - β) := by + apply germAt_mul_of_support_subset u v γ + intro ξ hξ + by_contra hξS + have hξI : ξ ∉ convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) γ := + fun hi ↦ hξS (hS hi) + rw [mem_convolutionIndex, not_and_or] at hξI + rcases hξI with h | h + · exact hξ (by rw [germAt_eq_zero_of_not_mem_closure_support h, zero_mul]) + · exact hξ (by rw [germAt_eq_zero_of_not_mem_closure_support h, mul_zero]) + +/-! ### The convolution formula, read in polynomials -/ + +namespace Lifts + +variable (σ : Lifts wt x) (hx : IsMinimalSystem (Berarducci.principalGrading K) wt x) + {α : NatOrdinal} (hinj : ∀ β < α, InjectiveAt K wt x β) +include hinj + +/-- **The convolution formula, read in polynomials** (cf. [Ber00, Lem. 7.5]). For `u, v` of ordinal +value below `ω^(β_u+1)`, `ω^(β_v+1)` with `β_u, β_v < α` and `β_u ⊕ β_v ≤ α`, there is `ε > 0` such +that for all `γ ∈ (-ε, 0)`: `pol((uv)^{|γ}) = ∑_ξ pol(u^{|ξ}) · pol(v^{|γ-ξ})`, the sum over any +finite set of cutoffs `ξ` (the Lean binder `β`) containing Berarducci's index set and contained in +`[γ, 0]`. -/ +@[blueprint "lem:polynomial-convolution-formula" + (phase := "Translated truncations") + (title := "Convolution formula for polynomial representatives") + (statement := /-- + Let $K$ be a field. Let $(x_i)_{i\in I}$ be a minimal homogeneous generating system of + $\widehat{\mathrm P}$, with $x_i\in\mathrm P_{w_i}$, and choose series + $b_i$ representing the $x_i$. Assume that evaluation at $(x_i)$ is + injective in every weighted degree below $\alpha<\omega_1$. For every + series $a$ with $v_J(a)<\omega^\alpha$, write + $\operatorname{pol}_{<\alpha}(a)$ for the unique polynomial whose + monomials have weight below $\alpha$ and such that + \[ + a\equiv \operatorname{pol}_{<\alpha}(a)(b_i)\pmod J. + \] + + Let $u,v\in K((\mathbb R^{\le0}))$ satisfy + \[ + v_J(u)<\omega^{\beta+1},\qquad + v_J(v)<\omega^{\beta'+1},\qquad + \beta,\beta'<\alpha,\qquad \beta\oplus\beta'\le\alpha. + \] + For $\gamma\in\mathbb R$, put + \[ + C_\gamma(u,v)=\{\xi\in\mathrm{cl}(\operatorname{supp}(u)): + \gamma-\xi\in\mathrm{cl}(\operatorname{supp}(v))\}. + \] + Then there is $\varepsilon>0$ such that, for every + $\gamma\in(-\varepsilon,0)$ and every finite + $S$ with $C_\gamma(u,v)\subseteq S\subseteq[\gamma,0]$, + \[ + \operatorname{pol}_{<\alpha}((uv)^{|\gamma}) + =\sum_{\xi\in S} + \operatorname{pol}_{<\alpha}(u^{|\xi}) + \operatorname{pol}_{<\alpha}(v^{|\gamma-\xi}). + \] + -/) + (proof := /-- + By \ref{lem:truncation-drop}, choose one interval on which the translated truncations of + $u$, $v$, and $uv$ have the required lower ordinal values. By + \ref{prop:polynomial-representative-exists} and + \ref{prop:polynomial-evaluation-ordinal-value}, their degree-$<\alpha$ + polynomial representatives exist and are unique. + + Fix $\gamma$ in this interval and $\xi\in S$. Since $\gamma<0$ and + $\gamma\le\xi\le0$, at least one of $\xi$ and $\gamma-\xi$ is negative. Its translated + truncation has polynomial weight strictly below $\beta$ or $\beta'$, while the other has + weight at most the corresponding ordinal. Hence the product has weight strictly below + $\beta\oplus\beta'\le\alpha$. + + \ref{lem:convolution-formula} gives the displayed identity modulo $J$ over + $C_\gamma(u,v)$. Every additional term indexed by $S$ vanishes modulo $J$. Uniqueness of the + polynomial representatives turns this congruence into the asserted polynomial identity. + -/)] +theorem exists_forall_pol_translatedTruncation_mul {u v : Series K} {βu βv : NatOrdinal} + (hu : ordinalValue u < ω^ (βu + 1)) (hv : ordinalValue v < ω^ (βv + 1)) + (hβu : βu < α) (hβv : βv < α) (hsum : βu + βv ≤ α) : + ∃ ε > 0, ∀ γ : ℝ, -ε < γ → γ < 0 → ∀ S : Finset ℝ, + convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) γ ⊆ S → (S : Set ℝ) ⊆ Set.Icc γ 0 → + σ.pol hx α (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ) = + ∑ β ∈ S, σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) β) * + σ.pol hx α (translatedTruncation (v : K⟦ℝ⟧) (γ - β)) := by + obtain ⟨εu, hεu, hdropu⟩ := exists_forall_ordinalValue_translatedTruncation_lt hu + obtain ⟨εv, hεv, hdropv⟩ := exists_forall_ordinalValue_translatedTruncation_lt hv + have huv : ordinalValue (u * v) < ω^ (βu + βv + 1) := ordinalValue_mul_lt_wpow_add_one hu hv + obtain ⟨εuv, hεuv, hdropuv⟩ := exists_forall_ordinalValue_translatedTruncation_lt huv + have hβuα : βu + 1 ≤ α := Order.add_one_le_of_lt hβu + have hβvα : βv + 1 ≤ α := Order.add_one_le_of_lt hβv + refine ⟨min εu (min εv εuv), lt_min hεu (lt_min hεv hεuv), fun γ hγε hγ0 S hS hSIcc ↦ ?_⟩ + have hγu : -εu < γ := by + have := min_le_left εu (min εv εuv); linarith + have hγv : -εv < γ := by + have := (min_le_right εu (min εv εuv)).trans (min_le_left εv εuv); linarith + have hγuv : -εuv < γ := by + have := (min_le_right εu (min εv εuv)).trans (min_le_right εv εuv); linarith + -- the ordinal value of the translated truncation of the product + have hprod : ordinalValue (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ) < ω^ α := + (hdropuv γ hγuv hγ0).trans_le (NatOrdinal.wpow_le_wpow.mpr hsum) + -- each term of the convolution sum + have hterm : ∀ β ∈ S, + ordinalValue (translatedTruncation (u : K⟦ℝ⟧) β) < ω^ α ∧ + ordinalValue (translatedTruncation (v : K⟦ℝ⟧) (γ - β)) < ω^ α ∧ + DegreeLT wt (σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) β) * + σ.pol hx α (translatedTruncation (v : K⟦ℝ⟧) (γ - β))) α := by + intro β hβ + obtain ⟨hγβ, hβ0⟩ := hSIcc hβ + -- the first factor + have hfirst : (ordinalValue (translatedTruncation (u : K⟦ℝ⟧) β) < ω^ α ∧ + DegreeLE wt (σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) β)) βu) ∧ + (β < 0 → ordinalValue (translatedTruncation (u : K⟦ℝ⟧) β) < ω^ βu ∧ + DegreeLT wt (σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) β)) βu) := by + rcases eq_or_lt_of_le hβ0 with rfl | hβneg + · rw [translatedTruncation_zero] + exact ⟨⟨hu.trans_le (NatOrdinal.wpow_le_wpow.mpr hβuα), σ.pol_degreeLE hx hinj hβu hu⟩, + fun h ↦ absurd h (lt_irrefl 0)⟩ + · have hlt := hdropu β (by linarith) hβneg + exact ⟨⟨hlt.trans_le (NatOrdinal.wpow_le_wpow.mpr hβu.le), + (σ.pol_degreeLT_of_lt hx hinj hβu.le hlt).degreeLE⟩, + fun _ ↦ ⟨hlt, σ.pol_degreeLT_of_lt hx hinj hβu.le hlt⟩⟩ + -- the second factor + have hsecond : (ordinalValue (translatedTruncation (v : K⟦ℝ⟧) (γ - β)) < ω^ α ∧ + DegreeLE wt (σ.pol hx α (translatedTruncation (v : K⟦ℝ⟧) (γ - β))) βv) ∧ + (γ - β < 0 → ordinalValue (translatedTruncation (v : K⟦ℝ⟧) (γ - β)) < ω^ βv ∧ + DegreeLT wt (σ.pol hx α (translatedTruncation (v : K⟦ℝ⟧) (γ - β))) βv) := by + rcases eq_or_lt_of_le (sub_nonpos.mpr hγβ) with h0 | hneg + · rw [h0, translatedTruncation_zero] + exact ⟨⟨hv.trans_le (NatOrdinal.wpow_le_wpow.mpr hβvα), σ.pol_degreeLE hx hinj hβv hv⟩, + fun h ↦ absurd h (lt_irrefl 0)⟩ + · have hlt := hdropv (γ - β) (by linarith) hneg + exact ⟨⟨hlt.trans_le (NatOrdinal.wpow_le_wpow.mpr hβv.le), + (σ.pol_degreeLT_of_lt hx hinj hβv.le hlt).degreeLE⟩, + fun _ ↦ ⟨hlt, σ.pol_degreeLT_of_lt hx hinj hβv.le hlt⟩⟩ + refine ⟨hfirst.1.1, hsecond.1.1, ?_⟩ + -- at least one cutoff is negative, as `γ < 0` + rcases lt_or_eq_of_le hβ0 with hβneg | hβzero + · exact ((hfirst.2 hβneg).2.mul_degreeLE hsecond.1.2).mono hsum + · have hneg : γ - β < 0 := by rw [hβzero, sub_zero]; exact hγ0 + exact (hfirst.1.2.mul_degreeLT (hsecond.2 hneg).2).mono hsum + -- the translated truncation of the product is congruent modulo `J` to the convolution sum + have hgerm : toGerm (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ) = + toGerm (∑ β ∈ S, translatedTruncation (u : K⟦ℝ⟧) β * + translatedTruncation (v : K⟦ℝ⟧) (γ - β)) := by + rw [← germAt_apply, Subring.coe_mul, germAt_mul_of_subset u v γ hS, map_sum] + simp only [germAt_apply, map_mul] + rw [σ.pol_congr hx hinj hprod hgerm, + σ.pol_sum hx hinj S _ fun β hβ ↦ (σ.pol_mul hx hinj (hterm β hβ).1 (hterm β hβ).2.1 + (hterm β hβ).2.2).1] + exact Finset.sum_congr rfl fun β hβ ↦ + (σ.pol_mul hx hinj (hterm β hβ).1 (hterm β hβ).2.1 (hterm β hβ).2.2).2 + + +/-- At a fixed cutoff, the polynomial convolution formula may be summed over any finite set +containing all nonzero germ products, provided the product truncation and all listed factors have +ordinal value below `ω^α` and each listed polynomial product has degree below `α`. -/ +theorem pol_translatedTruncation_mul_eq_sum_of_nonzero_terms {u v : Series K} {γ : ℝ} {S : Finset ℝ} + (hS : ∀ ξ : ℝ, + germAt (u : K⟦ℝ⟧) ξ * germAt (v : K⟦ℝ⟧) (γ - ξ) ≠ 0 → ξ ∈ S) + (hprod : ordinalValue (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ) < ω^ α) + (hterm : ∀ β ∈ S, + ordinalValue (translatedTruncation (u : K⟦ℝ⟧) β) < ω^ α ∧ + ordinalValue (translatedTruncation (v : K⟦ℝ⟧) (γ - β)) < ω^ α ∧ + DegreeLT wt (σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) β) * + σ.pol hx α (translatedTruncation (v : K⟦ℝ⟧) (γ - β))) α) : + σ.pol hx α (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ) = + ∑ β ∈ S, σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) β) * + σ.pol hx α (translatedTruncation (v : K⟦ℝ⟧) (γ - β)) := by + have hgerm : toGerm (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ) = + toGerm (∑ β ∈ S, translatedTruncation (u : K⟦ℝ⟧) β * + translatedTruncation (v : K⟦ℝ⟧) (γ - β)) := by + rw [← germAt_apply, Subring.coe_mul, germAt_mul_of_support_subset u v γ hS, map_sum] + simp only [germAt_apply, map_mul] + rw [σ.pol_congr hx hinj hprod hgerm, + σ.pol_sum hx hinj S _ fun β hβ ↦ (σ.pol_mul hx hinj (hterm β hβ).1 (hterm β hβ).2.1 + (hterm β hβ).2.2).1] + exact Finset.sum_congr rfl fun β hβ ↦ + (σ.pol_mul hx hinj (hterm β hβ).1 (hterm β hβ).2.1 (hterm β hβ).2.2).2 + +/-- **The convolution formula at a fixed cutoff.** If the translated truncation of the product and +every term of the convolution sum at `γ` have ordinal value below `ω^α`, and each term's polynomial +has degree below `α`, then the polynomial of `(uv)^{|γ}` is the convolution sum of polynomials. -/ +theorem pol_translatedTruncation_mul_eq_sum {u v : Series K} {γ : ℝ} {S : Finset ℝ} + (hS : convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) γ ⊆ S) + (hprod : ordinalValue (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ) < ω^ α) + (hterm : ∀ β ∈ S, + ordinalValue (translatedTruncation (u : K⟦ℝ⟧) β) < ω^ α ∧ + ordinalValue (translatedTruncation (v : K⟦ℝ⟧) (γ - β)) < ω^ α ∧ + DegreeLT wt (σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) β) * + σ.pol hx α (translatedTruncation (v : K⟦ℝ⟧) (γ - β))) α) : + σ.pol hx α (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ) = + ∑ β ∈ S, σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) β) * + σ.pol hx α (translatedTruncation (v : K⟦ℝ⟧) (γ - β)) := by + refine σ.pol_translatedTruncation_mul_eq_sum_of_nonzero_terms hx hinj ?_ hprod hterm + intro ξ hξ + by_contra hξS + have hξI : ξ ∉ convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) γ := + fun hi ↦ hξS (hS hi) + rw [mem_convolutionIndex, not_and_or] at hξI + rcases hξI with h | h + · exact hξ (by rw [germAt_eq_zero_of_not_mem_closure_support h, zero_mul]) + · exact hξ (by rw [germAt_eq_zero_of_not_mem_closure_support h, mul_zero]) + +end Lifts + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationsIdeal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationsIdeal.lean new file mode 100644 index 0000000000..dc4b714319 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationsIdeal.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivationIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OrdinalValueCutoffs +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart + +/-! +# Ideal membership of a class from the condition (p) on its translated truncations + +Let `q j ∈ K[X]` be finitely many homogeneous polynomials `Q_1, …, Q_m` of degrees `c j` that are +zero or limits, and let `τ + 1 < α`, evaluation being injective below `α`. If `u ∈ J_{ω^(τ+2)}` +and, for all real cutoffs `δ < 0` sufficiently close to `0`, the translated truncation `u^{|δ}` +lies in `J_{ω^(τ+1)}` and the translated truncations satisfy (p) for `(Q_1, …, Q_m; τ)` — the part +`pol(u^{|δ})_{≥τ}` of degree at least `τ` of the polynomial of `u^{|δ}` modulo `J` lies in the +ideal `(Q_1, …, Q_m) ⊆ K[X]` — then the class of `u` in `P_{τ+1}` lies in the ideal +`(Q_1(𝓑), …, Q_m(𝓑)) ⊆ P̂`. + +This is ideal membership of a class from ideal membership of its derivative +(`mem_span_of_principalSubringDerivation_eq_coe`) applied to the class of `u`: its derivative is the +class in `Fun_{0⁻}(P̂)` of `δ ↦ u^{|δ} + J_{ω^τ}`, and `u^{|δ} + J_{ω^τ} ∈ P_τ` is the evaluation +`pol(u^{|δ})_τ(𝓑)` of the degree-`τ` component of the polynomial of `u^{|δ}`, an element of the +ideal. +-/ + +universe v w + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial DirectSum OrdinalGraded + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +/-- Evaluation carries the ideal of `K[X]` generated by the `q j` into the ideal of `P̂` generated +by the evaluations `(q j)(𝓑)`. -/ +theorem aeval_mem_span_range_of_mem_span {ι' : Type*} {q : ι' → MvPolynomial ι K} + {P : MvPolynomial ι K} (hP : P ∈ Ideal.span (Set.range q)) : + aeval x P ∈ Ideal.span (Set.range fun j ↦ aeval x (q j)) := by + have := Ideal.mem_map_of_mem (aeval x : MvPolynomial ι K →ₐ[K] PrincipalSubring K).toRingHom hP + rw [Ideal.map_span, ← Set.range_comp] at this + exact this + +/-- `τ + 1` has positive finite part. -/ +theorem constantCoeff_add_one_pos (τ : NatOrdinal) : 0 < (τ + 1).constantCoeff := by + have := NatOrdinal.constantCoeff_add_natCast τ 1 + rw [Nat.cast_one] at this + rw [this] + exact Nat.succ_pos _ + +/-- `(τ + 1) ⊖ 1 = τ`: removing `1` from the finite part of `τ + 1` gives back `τ`. -/ +theorem removeNat_one_add_one (τ : NatOrdinal) : (τ + 1).removeNat 1 = τ := by + have h := NatOrdinal.removeNat_add_natCast (a := τ + 1) (n := 1) (by + have := constantCoeff_add_one_pos τ + omega) + rw [Nat.cast_one] at h + exact add_right_cancel h + +namespace Lifts + +variable (σ : Lifts wt x) (hx : IsMinimalSystem (principalGrading K) wt x) {α : NatOrdinal} + (hinj : ∀ β < α, InjectiveAt K wt x β) +include hinj + +/-- **Ideal membership in `P_(τ+1)` from translated truncations.** For `τ + 1 < α` and +`u ∈ J_{ω^(τ+2)}`, suppose that the translated truncations `u^{|δ}` for `-ε < δ < 0` +lie in `J_{ω^(τ+1)}` and that `pol(u^{|δ})_{≥τ}` lies in the ideal `(q_1, …, q_m)`. +Then the class of `u` in `P_{τ+1}` lies in the ideal of `P̂` generated by the evaluations +`(q j)(𝓑)`. -/ +@[blueprint "lem:lower-below-successor" + (phase := "Translated truncations") + (title := "Ideal membership in $\\mathrm P_{\\tau+1}$ from translated truncations") + (statement := /-- + Let $K$ be a field, let $(x_i)_{i\in I}$ be a minimal homogeneous + generating system of $\Ph$, with $x_i\in\Prin_{w_i}$, and choose series + $b_i$ representing $x_i$. Fix + $\alpha<\omega_1$, and assume that evaluation at $(x_i)$ is injective in + every weighted degree below $\alpha$. + + Let $Q_1,\ldots,Q_m\in K[X_i:i\in I]$ be weighted homogeneous of degrees + $\sigma_1,\ldots,\sigma_m$, each a limit ordinal or $0$. Let + $\tau+1<\alpha$, and let $u\in\Kser$ satisfy + $\vJ(u)<\omega^{\tau+2}$. Suppose there is $\varepsilon>0$ such that, for + every $-\varepsilon<\gamma<0$, + \[ + \vJ(\trunc u\gamma)<\omega^{\tau+1},\qquad + \partGE{\pol(\trunc u\gamma)}{\tau}\in(Q_1,\ldots,Q_m). + \] + Then the class $u+J_{\omega^{\tau+1}}\in\Prin_{\tau+1}$ belongs, inside + $\Ph$, to the ideal generated by + $Q_1(x_i),\ldots,Q_m(x_i)$. + -/) + (proof := /-- + For every $\gamma\in(-\varepsilon,0)$, + \ref{lem:polynomial-homogeneous-component-represents-class} identifies the + class of $\trunc u\gamma$ in $\Prin_\tau$ with the evaluation of the + degree-$\tau$ component of $\pol(\trunc u\gamma)$. Since the part of degree + at least $\tau$ lies in the homogeneous ideal $(Q_1,\ldots,Q_m)$, its + degree-$\tau$ component does too. Hence every value of the derivative of + $u+J_{\omega^{\tau+1}}$, sufficiently close to $0$, lies in the ideal + generated by the $Q_j(x_i)$. Applying \ref{prop:ideal-from-derivative} gives + the asserted ideal membership in $\Ph$. + -/)] +theorem of_principalComponentMk_mem_span_of_forall_componentsGE_mem {ι' : Type*} [Finite ι'] + {q : ι' → MvPolynomial ι K} {c : ι' → NatOrdinal} + (hq : ∀ j, IsWeightedHomogeneous wt (q j) (c j)) (hc : ∀ j, (c j).constantCoeff = 0) + {τ : NatOrdinal} (hτ : τ + 1 < α) {u : Series K} (hu : ordinalValue u < ω^ (τ + 1 + 1)) + {ε : ℝ} (hε : 0 < ε) + (hdrop : ∀ δ : ℝ, -ε < δ → δ < 0 → + ordinalValue (translatedTruncation (u : K⟦ℝ⟧) δ) < ω^ (τ + 1)) + (htrunc : ∀ δ : ℝ, -ε < δ → δ < 0 → + componentsGE wt τ (σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) δ)) ∈ + Ideal.span (Set.range q)) : + DirectSum.of (PrincipalComponent K) (τ + 1) (principalComponentMk (τ + 1) u hu) ∈ + Ideal.span (Set.range fun j ↦ aeval x (q j)) := by + classical + have hα1 : 0 < (τ + 1).constantCoeff := constantCoeff_add_one_pos τ + have hrem : (τ + 1).removeNat 1 = τ := removeNat_one_add_one τ + have hτα : τ < α := (lt_add_one τ).trans hτ + have hq' : ∀ j, aeval x (q j) ∈ principalGrading K (c j) := + fun j ↦ aeval_mem_of_forall_mem hx.mem (hq j) + -- the derivative of the class of `u`, as a function at `0⁻` + let f : ℝ → PrincipalSubring K := fun δ ↦ + if -ε < δ ∧ δ < 0 then + DirectSum.of (PrincipalComponent K) ((τ + 1).removeNat 1) (derivAt (τ + 1) u δ) + else 0 + have hΔ : principalSubringDerivation K + (DirectSum.of (PrincipalComponent K) (τ + 1) (principalComponentMk (τ + 1) u hu)) = + (f : FunAtZeroMinus (PrincipalSubring K)) := by + rw [principalSubringDerivation_of, principalComponentDerivation_principalComponentMk hα1] + exact (funAtZeroMinus_coe_eq_iff_exists _ _).mpr ⟨ε, hε, fun δ h1 h2 ↦ by + simp only [f, if_pos (And.intro h1 h2)]⟩ + have hf : ∀ δ, f δ ∈ Ideal.span (Set.range fun j ↦ aeval x (q j)) := by + intro δ + by_cases h : -ε < δ ∧ δ < 0 + · simp only [f, if_pos h] + have hδ : ordinalValue (translatedTruncation (u : K⟦ℝ⟧) δ) < + ω^ ((τ + 1).removeNat 1 + 1) := by + rw [hrem]; exact hdrop δ h.1 h.2 + rw [derivAt_eq (τ + 1) u δ hδ, of_principalComponentMk_congr hrem _ hδ (by + rw [← hrem]; exact hδ)] + have hrep := σ.represents_aeval_weightedHomogeneousComponent_pol hx hinj hτα + (hdrop δ h.1 h.2) + rw [hrep.of_principalComponentMk] + exact aeval_mem_span_range_of_mem_span + (weightedHomogeneousComponent_mem_span_of_componentsGE_mem wt hq (htrunc δ h.1 h.2) le_rfl) + · simp only [f, if_neg h] + exact Ideal.zero_mem _ + exact mem_span_of_principalSubringDerivation_eq_coe hq' hc hα1 (of_mem_principalGrading _ _) hf hΔ + +end Lifts + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/UnboundedTruncations.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/UnboundedTruncations.lean new file mode 100644 index 0000000000..a8fb04b4b5 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/UnboundedTruncations.lean @@ -0,0 +1,260 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.TruncationDrop +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal +import Mathlib.Topology.Instances.Real.Lemmas + +/-! +# Translated truncations of a series of ordinal value `ω^β` reach every `ω^ρ`, `ρ < β` + +If `v_J(u) = ω^β` and `ρ < β`, then for every real `θ < 0` there is a cutoff `θ < γ < 0` with +`v_J(u^{|γ}) = ω^ρ` exactly: take an interval `(η, 0)` with `η > θ` on which +`ot(supp u ∩ (γ', 0)) = v_J(u)` for all `γ' ∈ [η, 0)`, the initial segment `S` of +`supp u ∩ (η, 0)` of order type `ω^ρ`, and `γ := sup S`. Every point of `supp u ∩ (η, 0)` below +`γ` lies in `S`, so the support of `u^{|γ}` on some interval `(η', 0]` is a translate of a final +segment of `S`, of order type `ω^ρ` by additive indecomposability (for `ρ = 0`, `S` is a single +support point and `u^{|γ}` has a nonzero constant term and a gap below `0`). This is the +same support-tail phenomenon as Berarducci [Ber00, Lem. 6.8], at every degree below the ordinal +value. The case `β = α + 1`, `ρ = α` gives the injectivity of the lowering derivation on +`P_{α+1}`. +-/ + +universe v + +open Ordinal Set +open scoped NatOrdinal + +public noncomputable section + +namespace Berarducci + +open Berarducci HahnSeries + +variable {K : Type v} [Field K] + +/-- A translated truncation at a support point is not in `J`. -/ +private theorem translatedTruncation_not_mem_negativeMonomialIdeal_of_mem_support + (u : Series K) {γ : ℝ} (hγ : γ ∈ (u : K⟦ℝ⟧).support) : + translatedTruncation (u : K⟦ℝ⟧) γ ∉ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + intro hJ + rw [HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero] at hJ + have hzero : (0 : ℝ) ∈ ((translatedTruncation (u : K⟦ℝ⟧) γ : Series K) : K⟦ℝ⟧).support := by + rw [HahnSeries.mem_support, coeff_translatedTruncation] + simpa using hγ + have hne : translatedTruncation (u : K⟦ℝ⟧) γ ≠ 0 := by + intro h + rw [h] at hzero + simp at hzero + rw [HahnSeries.Nonpositive.supportSup_of_ne hne] at hJ + exact absurd (le_csSup (HahnSeries.Nonpositive.bddAbove_support _) hzero) + (not_le.mpr (WithBot.coe_lt_coe.mp hJ)) + +/-- If `v_J(u) = ω^β`, `ρ < β` and `θ < 0`, there is a cutoff `θ < γ < 0` with `v_J(u^{|γ}) = ω^ρ` +(cf. [Ber00, Lem. 6.8]). -/ +@[blueprint "lem:truncation-values" + (phase := "Limit ordinals in the degree induction") + (title := "Realisation of lower ordinal values by translated truncations") + (statement := /-- + Let $K$ be a field and let + $u\in K((\mathbb R^{\le0}))$. If + \[ + v_J(u)=\omega^\beta + \qquad\text{and}\qquad + \rho<\beta, + \] + then, for every $\theta<0$, there is a $\gamma$ such that + \[ + \theta<\gamma<0 + \qquad\text{and}\qquad + v_J(u^{|\gamma})=\omega^\rho. + \] + -/) + (proof := /-- + Since $\rho<\beta$, the ordinal value of $u$ is greater than $1$. By + \ref{fact:ordinal-value-support-tail}, choose $\eta>\theta$ such that the + negative support tail + \[ + B=\operatorname{supp}(u)\cap(\eta,0) + \] + has order type $\omega^\beta$. Let $S$ be the initial segment of $B$ of + order type $\omega^\rho$, and put $\gamma=\sup S$. Then + $\theta<\gamma<0$. + + If $\rho=0$, the set $S$ is a singleton. Thus $\gamma$ is a support point + with a gap immediately below it. The translated truncation $u^{|\gamma}$ + has a nonzero constant term and ordinal value at most $1$, hence ordinal + value exactly $1=\omega^0$. + + Suppose $\rho>0$. Then $\omega^\rho$ is an additively principal limit + ordinal, so $S$ has no largest element. The set $S$ is a final segment of + the support strictly below $\gamma$, which gives + $v_J(u^{|\gamma})\le\omega^\rho$. Conversely, every interval immediately + below $\gamma$ contains a nonempty final segment of $S$, and every such + final segment still has order type $\omega^\rho$. The support-tail + characterisation of $v_J$ therefore gives the reverse inequality. + -/)] +theorem exists_ordinalValue_translatedTruncation_eq_wpow_of_lt + {beta rho : NatOrdinal} (hrho : rho < beta) (u : Series K) (hu : ordinalValue u = ω^ beta) + {θ : ℝ} (hθ : θ < 0) : + ∃ γ : ℝ, θ < γ ∧ γ < 0 ∧ ordinalValue (translatedTruncation (u : K⟦ℝ⟧) γ) = ω^ rho := by + have hbeta0 : beta ≠ 0 := (pos_of_gt hrho).ne' + have hone : 1 < ordinalValue u := by + rw [hu, ← NatOrdinal.wpow_zero] + exact NatOrdinal.wpow_lt_wpow.mpr (pos_iff_ne_zero.mpr hbeta0) + -- `B = supp(u) ∩ (η, 0)` with `η > θ`, on which the order type of the support is `v_J(u)`. + obtain ⟨η₀, hη₀, hstable⟩ := + exists_forall_later_negativeSupportTail_orderType_eq_ordinalValue u hone + set η : ℝ := max (η₀ / 2) (θ / 2) with hηdef + have hη₀η : η₀ < η := lt_max_of_lt_left (by linarith) + have hθη : θ < η := lt_max_of_lt_right (by linarith) + have hη : η < 0 := max_lt (by linarith) (by linarith) + set B : Set ℝ := negativeSupportTail u η with hBdef + have hBsupp : B ⊆ (u : K⟦ℝ⟧).support := negativeSupportTail_subset_support u η + have hBpwo : B.IsPWO := (u : K⟦ℝ⟧).isPWO_support.mono hBsupp + set ρ : Ordinal := omega0 ^ rho.val with hρdef + have hρpos : 0 < ρ := opow_pos _ omega0_pos + have hBtype : hBpwo.orderType = omega0 ^ beta.val := by + rw [Set.IsPWO.orderType_proof_irrel hBpwo + ((u : K⟦ℝ⟧).isPWO_support.mono (negativeSupportTail_subset_support u η)), + hstable η hη₀η hη, hu, NatOrdinal.val_wpow] + -- The point `y` of index `ρ`; the initial segment `S = B ∩ (-∞, y)`. + have hρlt : ρ < hBpwo.orderType := by + rw [hBtype, hρdef] + exact (opow_lt_opow_iff_right one_lt_omega0).mpr hrho + obtain ⟨y, hyB, hyIdx⟩ := hBpwo.exists_orderType_inter_Iio_eq hρlt + set S : Set ℝ := B ∩ Set.Iio y with hSdef + have hSpwo : S.IsPWO := hBpwo.mono Set.inter_subset_left + have hStype : hSpwo.orderType = ρ := hyIdx + have hSne : S.Nonempty := by + rw [Set.nonempty_iff_ne_empty] + intro hempty + have := (hSpwo.orderType_eq_zero).mpr hempty + rw [hStype] at this + exact hρpos.ne' this + have hSbdd : BddAbove S := ⟨y, fun x hx ↦ hx.2.le⟩ + set γ : ℝ := sSup S with hγdef + have hSγ : ∀ x ∈ S, x ≤ γ := fun x hx ↦ le_csSup hSbdd hx + have hγy : γ ≤ y := csSup_le hSne fun x hx ↦ hx.2.le + have hy0 : y < 0 := (mem_negativeSupportTail_iff.mp hyB).2.2 + have hγ0 : γ < 0 := hγy.trans_lt hy0 + have hθγ : θ < γ := by + obtain ⟨s, hs⟩ := hSne + exact (hθη.trans (mem_negativeSupportTail_iff.mp hs.1).2.1).trans_le (hSγ s hs) + -- Every point of `B` below `γ` lies in `S`. + have hbelow : ∀ x ∈ B, x < γ → x ∈ S := by + intro x hxB hxγ + obtain ⟨s, hs, hxs⟩ := exists_lt_of_lt_csSup hSne hxγ + exact ⟨hxB, hxs.trans hs.2⟩ + have hsuppBelow : ∀ x ∈ (u : K⟦ℝ⟧).support, η < x → x < γ → x ∈ S := fun x hx hηx hxγ ↦ + hbelow x (mem_negativeSupportTail_iff.mpr ⟨hx, hηx, hxγ.trans hγ0⟩) hxγ + refine ⟨γ, hθγ, hγ0, ?_⟩ + rcases eq_or_ne rho 0 with rfl | hrho0 + · -- `ρ = 0`: `S` is a single support point `γ`. + have hρone : ρ = 1 := by simp [hρdef] + have hSmin : ∀ x ∈ S, ∀ x' ∈ S, x' ≤ x → x' = x := by + intro x hx x' hx' hle + by_contra hne + have hlt : x' < x := lt_of_le_of_ne hle hne + have hbelow := hSpwo.orderType_inter_Iio_lt hx + rw [hStype, hρone, Order.lt_one_iff, Set.IsPWO.orderType_eq_zero] at hbelow + have : x' ∈ S ∩ Set.Iio x := ⟨hx', hlt⟩ + rw [hbelow] at this + exact this + obtain ⟨m, hm⟩ := hSne + have hSeq : S = {m} := by + ext x + constructor + · intro hx + rcases le_total x m with hxm | hmx + · exact hSmin m hm x hx hxm + · exact (hSmin x hx m hm hmx).symm + · rintro rfl + exact hm + have hγm : γ = m := by rw [hγdef, hSeq, csSup_singleton] + have hγS : γ ∈ S := hγm ▸ hm + have hγsupp : γ ∈ (u : K⟦ℝ⟧).support := hBsupp hγS.1 + have hgap : (u : K⟦ℝ⟧).support ∩ Set.Ioo η γ = ∅ := by + rw [Set.eq_empty_iff_forall_notMem] + rintro x ⟨hx, hηx, hxγ⟩ + have hxS := hsuppBelow x hx hηx hxγ + rw [hSeq] at hxS + exact hxγ.ne (hxS.trans hγm.symm) + have hηγ : η < γ := (mem_negativeSupportTail_iff.mp hγS.1).2.1 + have hle := ordinalValue_translatedTruncation_le_one_of_eq_empty u hηγ hgap + have hne : ordinalValue (translatedTruncation (u : K⟦ℝ⟧) γ) ≠ 0 := by + rw [Ne, ordinalValue_eq_zero_iff] + exact translatedTruncation_not_mem_negativeMonomialIdeal_of_mem_support u hγsupp + rw [NatOrdinal.wpow_zero] + rcases Order.le_one_iff.mp hle with hzero | hone' + · exact absurd hzero hne + · exact hone' + · -- `ρ ≥ 1`: `ω^ρ` is an additively indecomposable limit. + have hρprin : IsAdditivelyPrincipal ρ := isAdditivelyPrincipal_omega0_opow _ + have hρone : 1 < ρ := by + have : ω^ (0 : NatOrdinal) < ω^ rho := + NatOrdinal.wpow_lt_wpow.mpr (pos_iff_ne_zero.mpr hrho0) + rw [NatOrdinal.wpow_zero] at this + have hval : (1 : NatOrdinal).val < (ω^ rho).val := this + simpa [hρdef] using hval + have hlimit : Order.IsSuccLimit hSpwo.orderType := by + rw [hStype] + exact hρprin.isSuccLimit_of_one_lt hρone + have hprincipal : IsPrincipal (fun a b : Ordinal ↦ a + b) hSpwo.orderType := by + rw [hStype] + exact (isAdditivelyPrincipal_iff_ne_zero_and_isPrincipal_add.mp hρprin).2 + -- `S` has no largest element, so every point of `S` lies strictly below `γ`. + have hSlt : ∀ x ∈ S, x < γ := by + intro x hx + obtain ⟨x', hx', hxx'⟩ := hSpwo.exists_gt_of_isSuccLimit_orderType hlimit hx + exact hxx'.trans_le (hSγ x' hx') + -- Upper bound: `S` is a nonempty final segment of the support strictly below `γ`. + have hSupper : IsRelUpperSet S (· ∈ (u : K⟦ℝ⟧).support ∩ Set.Iio γ) := by + intro x hx + refine ⟨⟨hBsupp hx.1, hSlt x hx⟩, fun y' hxy' hy' ↦ ?_⟩ + exact hsuppBelow y' hy'.1 ((mem_negativeSupportTail_iff.mp hx.1).2.1.trans_le hxy') hy'.2 + have hupper := ordinalValue_translatedTruncation_le_orderType_of_isRelUpperSet_supportBelow + (u : K⟦ℝ⟧) γ hSupper hSne + rw [Set.IsPWO.orderType_proof_irrel _ hSpwo, hStype] at hupper + -- Lower bound: every interval `(θ', γ)` contains a nonempty final segment of `S`. + have hlower : NatOrdinal.of ρ ≤ ordinalValue (translatedTruncation (u : K⟦ℝ⟧) γ) := by + apply le_ordinalValue_translatedTruncation_of_forall_le_orderType + intro θ' hθ'γ + obtain ⟨s, hs, hθ's⟩ := exists_lt_of_lt_csSup hSne hθ'γ + have hfinal := hSpwo.orderType_inter_Ioi_eq_of_isPrincipal hprincipal ⟨s, hs, hθ's⟩ + rw [hStype] at hfinal + rw [← hfinal] + apply Set.IsPWO.orderType_mono + intro x hx + exact ⟨hBsupp hx.1.1, hx.2, hSlt x hx.1⟩ + rw [NatOrdinal.val_eq_iff.mp (le_antisymm hupper (NatOrdinal.of_le_iff.mp hlower)), hρdef, + ← NatOrdinal.val_wpow, NatOrdinal.of_val] + +/-- If `v_J(u) = ω^β` and `ρ < β`, then `v_J(u^{|γ}) = ω^ρ` for cutoffs `γ < 0` arbitrarily close +to `0`. -/ +theorem frequently_ordinalValue_translatedTruncation_eq_wpow_of_lt + {beta rho : NatOrdinal} (hrho : rho < beta) (u : Series K) (hu : ordinalValue u = ω^ beta) : + ∃ᶠ γ in nhdsWithin (0 : ℝ) (Set.Iio 0), + ordinalValue (translatedTruncation (u : K⟦ℝ⟧) γ) = ω^ rho := by + rw [Filter.frequently_iff] + intro U hU + obtain ⟨ε, hε, hεU⟩ := Metric.mem_nhdsWithin_iff.mp hU + obtain ⟨γ, hθγ, hγ0, hγ⟩ := exists_ordinalValue_translatedTruncation_eq_wpow_of_lt hrho u hu + (neg_neg_of_pos hε : -ε < 0) + refine ⟨γ, hεU ⟨?_, hγ0⟩, hγ⟩ + rw [Metric.mem_ball, Real.dist_eq, abs_lt] + constructor <;> linarith + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CoefficientMap.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CoefficientMap.lean new file mode 100644 index 0000000000..e6de795a10 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CoefficientMap.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveCoefficientMap + +/-! +# Ordinal value under coefficient extension + +An embedding of coefficient fields preserves the support and hence the ordinal value of a +nonpositive Hahn series. +-/ + +universe v w + +open scoped HahnSeries + +namespace Berarducci + +open HahnSeries.Nonpositive + +public section + +/-- Coefficient extension along a field embedding preserves the ordinal value. -/ +theorem ordinalValue_nonpositiveCoefficientMap {K : Type v} {E : Type w} + [Field K] [Field E] (f : K →+* E) (u : HahnSeries.Nonpositive ℝ K) : + ordinalValue (nonpositiveCoefficientMap f u) = ordinalValue u := + le_antisymm + (ordinalValue_le_of_support_subset _ _ (support_nonpositiveCoefficientMap f u).subset) + (ordinalValue_le_of_support_subset _ _ (support_nonpositiveCoefficientMap f u).superset) + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ComplexityDecrease.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ComplexityDecrease.lean new file mode 100644 index 0000000000..f209340a76 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ComplexityDecrease.lean @@ -0,0 +1,248 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.FormalExpression +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPoint + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointValue + +/-! +# The complexity drop of Berarducci's reduction step + +Berarducci, Lemma 9.5: replacing the selected factor of a formal expression by one truncation +`b₀^{|γ}` and one fewer copy of `b₀`, while doubling every other exponent, strictly decreases +the complexity, provided `γ` is a residual point of `b₀` close enough to zero. + +Only two properties of the truncation are used, both supplied by the residual-point remarks of +Section 6 and Section 9: its ordinal value is strictly below `v_J(b₀)`, and its principal value is +at least `v_J^p(b₀)`. The combinatorial step is therefore stated for an arbitrary multiset of +factors having those two properties, which also accommodates the source's convention of omitting +the truncation when its value is one. +-/ + +universe v + +public noncomputable section + +open HahnSeries Ordinal + +namespace Berarducci + +variable {K : Type v} [Field K] + +namespace FormalExpression + +open Classical in +/-- The factors of `w` other than the selected one. -/ +noncomputable def unselected (w : FormalExpression K) (hw : w ≠ 0) : FormalExpression K := + w.filter (· ≠ selected w hw) + +open Classical in +theorem unselected_eq (w : FormalExpression K) (hw : w ≠ 0) : + unselected w hw = w.filter (· ≠ selected w hw) := (rfl) + +open Classical in +theorem mem_unselected {w : FormalExpression K} {hw : w ≠ 0} + {y : SeriesWithOrdinalValueAboveOne K} : + y ∈ unselected w hw ↔ y ∈ w ∧ y ≠ selected w hw := by + rw [unselected] + exact Multiset.mem_filter + +open Classical in +/-- Berarducci, Lemma 9.5: the expression +`b₀^{|γ} b₀^{k - 1} b₁^{2 k₁} ⋯ bₙ^{2 kₙ}` obtained from `w` by reducing the selected +exponent, doubling the others, and adjoining the truncation factors `t`. -/ +noncomputable def reduced (w : FormalExpression K) (hw : w ≠ 0) (t : FormalExpression K) : + FormalExpression K := + t + Multiset.replicate (selectedExponent w hw - 1) (selected w hw) + + (unselected w hw + unselected w hw) + +theorem reduced_eq (w : FormalExpression K) (hw : w ≠ 0) (t : FormalExpression K) : + reduced w hw t = t + Multiset.replicate (selectedExponent w hw - 1) (selected w hw) + + (unselected w hw + unselected w hw) := (rfl) + +theorem mem_reduced {w : FormalExpression K} {hw : w ≠ 0} {t : FormalExpression K} + {y : SeriesWithOrdinalValueAboveOne K} : + y ∈ reduced w hw t ↔ y ∈ t ∨ (selectedExponent w hw - 1 ≠ 0 ∧ y = selected w hw) ∨ + (y ∈ w ∧ y ≠ selected w hw) := by + rw [reduced] + simp only [Multiset.mem_add, Multiset.mem_replicate, mem_unselected, or_self, or_assoc] + +theorem one_le_selectedExponent (w : FormalExpression K) (hw : w ≠ 0) : + 1 ≤ selectedExponent w hw := by + classical + rw [selectedExponent_eq_count] + exact Multiset.count_pos.mpr (isSelected_selected w hw).mem + +open Classical in +/-- The reduction removes one copy of the selected factor. -/ +theorem count_selected_reduced {w : FormalExpression K} {hw : w ≠ 0} {t : FormalExpression K} + (ht : selected w hw ∉ t) : + Multiset.count (selected w hw) (reduced w hw t) = selectedExponent w hw - 1 := by + rw [reduced] + simp only [Multiset.count_add, Multiset.count_replicate_self] + rw [Multiset.count_eq_zero.mpr ht, + Multiset.count_eq_zero.mpr fun h ↦ (mem_unselected.mp h).2 rfl] + omega + +open Classical in +/-- The reduction doubles the exponent of every other factor. -/ +theorem count_reduced_of_ne {w : FormalExpression K} {hw : w ≠ 0} {t : FormalExpression K} + {y : SeriesWithOrdinalValueAboveOne K} (hy : y ≠ selected w hw) (hyt : y ∉ t) : + Multiset.count y (reduced w hw t) = 2 * Multiset.count y w := by + rw [reduced, unselected] + simp only [Multiset.count_add, Multiset.count_replicate, Multiset.count_filter, + if_neg (Ne.symm hy), if_pos hy, Multiset.count_eq_zero.mpr hyt] + omega + +/-- The selected factor survives the reduction exactly when its exponent exceeds one. -/ +theorem selected_mem_reduced {w : FormalExpression K} {hw : w ≠ 0} {t : FormalExpression K} + (hk : 1 < selectedExponent w hw) : selected w hw ∈ reduced w hw t := + mem_reduced.mpr (Or.inr (Or.inl ⟨by omega, rfl⟩)) + +theorem selectedExponent_lt_of_isSelected {w : FormalExpression K} {hw : w ≠ 0} + {t : FormalExpression K} (hw₂ : reduced w hw t ≠ 0) + (ht : selected w hw ∉ t) (hsel : selected (reduced w hw t) hw₂ = selected w hw) : + selectedExponent (reduced w hw t) hw₂ < selectedExponent w hw := by + rw [selectedExponent_eq_count, hsel, count_selected_reduced ht] + have := one_le_selectedExponent w hw + omega + +/-- Case 1 of Berarducci, Lemma 9.5: when the selected exponent exceeds one, the selected factor +of the reduced expression is unchanged. -/ +theorem isSelected_reduced (w : FormalExpression K) (hw : w ≠ 0) (t : FormalExpression K) + (ht : ∀ u ∈ t, ordinalValue u.1 < ordinalValue (selected w hw).1) + (htp : ∀ u ∈ t, (selected w hw).principalValue ≤ u.principalValue) + (hk : 1 < selectedExponent w hw) : + IsSelected (reduced w hw t) (selected w hw) := by + have hsel := isSelected_selected w hw + refine ⟨mem_reduced.mpr (Or.inr (Or.inl ⟨by omega, rfl⟩)), ?_, ?_, ?_⟩ + · intro y hy + rcases mem_reduced.mp hy with h | ⟨-, rfl⟩ | ⟨hyw, -⟩ + · exact htp y h + · exact le_rfl + · exact hsel.min_principalValue y hyw + · intro y hy hyp + rcases mem_reduced.mp hy with h | ⟨-, rfl⟩ | ⟨hyw, -⟩ + · exact (ht y h).le + · exact le_rfl + · exact hsel.max_ordinalValue y hyw hyp + · intro y hy hyp hyo + rcases mem_reduced.mp hy with h | ⟨-, rfl⟩ | ⟨hyw, -⟩ + · exact absurd hyo (ht y h).ne + · exact irrefl_of (WellOrderingRel : SeriesWithOrdinalValueAboveOne K → _ → Prop) _ + · exact hsel.least y hyw hyp hyo + +/-- The Dershowitz-Manna step behind the second case of Berarducci, Lemma 9.5: an expression each +of whose factors is either of strictly smaller ordinal value than the selected factor of `w`, or a +factor of `w` other than that one, has strictly smaller complexity. The selected factor of the +smaller expression never has to be identified. -/ +theorem complexityLT_of_forall_lt_or_mem {w w' : FormalExpression K} (hw : w ≠ 0) (hw' : w' ≠ 0) + (h : ∀ u ∈ w', ordinalValue u.1 < ordinalValue (selected w hw).1 ∨ + (u ∈ w ∧ u ≠ selected w hw)) : + ComplexityLT (complexity w' hw') (complexity w hw) := by + classical + set f : SeriesWithOrdinalValueAboveOne K → Ordinal := fun y ↦ (ordinalValue y.1).val with hf + set S : Finset (SeriesWithOrdinalValueAboveOne K) := w'.toFinset.filter + (fun y ↦ ordinalValue (selected w' hw').1 ≤ ordinalValue y.1) with hS + set T : Finset (SeriesWithOrdinalValueAboveOne K) := + w.toFinset.filter (fun y ↦ ordinalValue (selected w hw).1 ≤ ordinalValue y.1) with hT + have hxT : selected w hw ∈ T := + Finset.mem_filter.mpr ⟨Multiset.mem_toFinset.mpr (isSelected_selected w hw).mem, le_rfl⟩ + set R : Finset (SeriesWithOrdinalValueAboveOne K) := T.erase (selected w hw) with hR + have hkey : ∀ u ∈ S, u ∉ R → ordinalValue u.1 < ordinalValue (selected w hw).1 := by + intro u hu huR + have humem : u ∈ w' := Multiset.mem_toFinset.mp (Finset.mem_filter.mp hu).1 + rcases h u humem with hlt | ⟨huw, hux⟩ + · exact hlt + · rw [hR, Finset.mem_erase] at huR + have hTu : u ∉ T := fun hmem ↦ huR ⟨hux, hmem⟩ + refine lt_of_not_ge fun hle ↦ hTu ?_ + rw [hT] + exact Finset.mem_filter.mpr ⟨Multiset.mem_toFinset.mpr huw, hle⟩ + have hsplit : ∀ A B : Finset (SeriesWithOrdinalValueAboveOne K), + A.val = (A ∩ B).val + (A \ B).val := by + intro A B + rw [← Finset.filter_mem_eq_inter, Finset.sdiff_eq_filter, Finset.filter_val, + Finset.filter_val] + exact (Multiset.filter_add_not _ _).symm + refine complexityLT_of_relevantValues (X := (S ∩ R).val.map f) (Y := (S \ R).val.map f) + (Z := f (selected w hw) ::ₘ (R \ S).val.map f) (by simp) ?_ ?_ ?_ + · rw [relevantValues_eq_map, ← hS, hsplit S R, Multiset.map_add] + · rw [relevantValues_eq_map, ← hT, ← Multiset.cons_erase (s := T.val) hxT, + ← Finset.erase_val, ← hR, Multiset.map_cons, hsplit R S, Multiset.map_add, + Finset.inter_comm, Multiset.add_cons] + · intro y hy + obtain ⟨u, hu, rfl⟩ := Multiset.mem_map.mp hy + rw [Finset.mem_val, Finset.mem_sdiff] at hu + exact ⟨f (selected w hw), Multiset.mem_cons_self _ _, + NatOrdinal.val.lt_iff_lt.mpr (hkey u hu.1 hu.2)⟩ + +/-- The factors other than the selected one form an expression of strictly smaller complexity. -/ +theorem complexityLT_unselected {w : FormalExpression K} (hw : w ≠ 0) + (hr : unselected w hw ≠ 0) : + ComplexityLT (complexity (unselected w hw) hr) (complexity w hw) := + complexityLT_of_forall_lt_or_mem hw hr fun _ hu ↦ Or.inr (mem_unselected.mp hu) + +/-- Berarducci, Lemma 9.5: the reduction step strictly decreases the complexity. The adjoined +factors are only required to have strictly smaller ordinal value and no smaller principal value +than the selected factor. -/ +theorem complexityLT_reduced (w : FormalExpression K) (hw : w ≠ 0) (t : FormalExpression K) + (ht : ∀ u ∈ t, ordinalValue u.1 < ordinalValue (selected w hw).1) + (htp : ∀ u ∈ t, (selected w hw).principalValue ≤ u.principalValue) + (hw₂ : reduced w hw t ≠ 0) : + ComplexityLT (complexity (reduced w hw t) hw₂) (complexity w hw) := by + classical + have htmem : selected w hw ∉ t := fun h ↦ absurd (ht _ h) (lt_irrefl _) + rcases lt_or_ge 1 (selectedExponent w hw) with hk | hk + · -- Case 1: the selected factor survives, so only its exponent moves. + have hsel : selected (reduced w hw t) hw₂ = selected w hw := + (eq_selected_of_isSelected hw₂ (isSelected_reduced w hw t ht htp hk)).symm + refine complexityLT_of_selectedExponent ?_ (selectedExponent_lt_of_isSelected hw₂ htmem hsel) + refine relevantValues_congr hw₂ hw hsel fun y hy ↦ ?_ + rw [hsel] at hy + constructor + · intro hmem + rcases mem_reduced.mp hmem with hmem | ⟨-, rfl⟩ | ⟨hmem, -⟩ + · exact absurd hy (not_le.mpr (ht y hmem)) + · exact (isSelected_selected w hw).mem + · exact hmem + · intro hmem + by_cases hyx : y = selected w hw + · exact mem_reduced.mpr (Or.inr (Or.inl ⟨by omega, hyx⟩)) + · exact mem_reduced.mpr (Or.inr (Or.inr ⟨hmem, hyx⟩)) + · -- Case 2: the selected factor disappears, and its value is replaced by smaller ones. + have hk1 : selectedExponent w hw - 1 = 0 := by + have := one_le_selectedExponent w hw + omega + refine complexityLT_of_forall_lt_or_mem hw hw₂ fun u hu ↦ ?_ + rcases mem_reduced.mp hu with hmem | ⟨hne, -⟩ | hmem + · exact Or.inl (ht u hmem) + · exact absurd hk1 hne + · exact Or.inr hmem + +end FormalExpression + +/-- Berarducci, Lemma 9.5: for residual points of the selected factor close enough to zero, the +reduction step strictly decreases the complexity. -/ +theorem exists_complexityLT_reduced (w : FormalExpression K) (hw : w ≠ 0) : + ∃ η < (0 : ℝ), ∀ γ : ℝ, η < γ → γ < 0 → + γ ∈ residualPointSet (FormalExpression.selected w hw) → + ∀ t : FormalExpression K, + (∀ u ∈ t, u.1 = translatedTruncation ((FormalExpression.selected w hw).1 : K⟦ℝ⟧) γ) → + ∀ hw₂ : FormalExpression.reduced w hw t ≠ 0, + FormalExpression.ComplexityLT (FormalExpression.complexity _ hw₂) + (FormalExpression.complexity w hw) := by + obtain ⟨η, hη, hcut⟩ := exists_ordinalValue_translatedTruncation_lt (FormalExpression.selected w + hw) + refine ⟨η, hη, fun γ hlow hhigh hγ t htu hw₂ ↦ ?_⟩ + refine FormalExpression.complexityLT_reduced w hw t (fun u hu ↦ ?_) (fun u hu ↦ ?_) hw₂ + · rw [htu u hu] + exact hcut γ hlow hhigh + · exact principalValue_le_of_mem_residualPointSet _ u hγ (htu u hu) + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Convolution.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Convolution.lean new file mode 100644 index 0000000000..37c79a2f0e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Convolution.lean @@ -0,0 +1,179 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation +public import Mathlib.Topology.MetricSpace.Pseudo.Defs + +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOSumset +import Mathlib.Topology.Instances.Real.Lemmas + +/-! +# Berarducci's convolution formula for germs + +Berarducci, Lemma 7.5(2): the germ of a product at `γ` is the finite sum of the products of the +germs of the factors over all pairs of exponents summing to `γ`. The index set +`Berarducci.convolutionIndex` is the finite set of first coordinates of points of the two closed +supports on the line of sum `γ`; it is finite by the well-ordering estimate proved with the +sumset lemmas. + +The proof has two halves. `coeff_translatedTruncation_mul` reindexes the coefficient of a product + of two +germ truncations as a sum over the pairs of the original supports on the line of sum `β + ξ + δ` +that lie weakly below `(β, ξ)`; this is a translation bijection and needs no hypotheses. The +remaining half is Berarducci, Lemma 7.4: for `γ + δ` below and sufficiently close to `γ`, each +such pair is dominated by exactly one index, so summing the reindexed coefficients over the index +set recovers the full antidiagonal sum, which is the coefficient of the product. + +Equality of germs is equality on some interval `(η, γ]`; `η` is exactly the cutoff supplied by +Lemma 7.4. +-/ + +universe v + +public noncomputable section + +open HahnSeries Filter Topology + +namespace Berarducci + +variable {K : Type v} [Field K] + +private theorem mem_support_translatedTruncation {b : K⟦ℝ⟧} {β u : ℝ} : + u ∈ ((translatedTruncation b β : Series K) : K⟦ℝ⟧).support ↔ + u ≤ 0 ∧ β + u ∈ b.support := by + rw [HahnSeries.mem_support, coeff_translatedTruncation] + by_cases hu : u ≤ 0 + · simp [hu, HahnSeries.mem_support] + · simp [hu] + +theorem coeff_translatedTruncation_mul (b c : K⟦ℝ⟧) (β ξ δ : ℝ) : + ((translatedTruncation b β * translatedTruncation c ξ : Series K) : K⟦ℝ⟧).coeff δ = + ∑ pq ∈ (Finset.addAntidiagonal b.isPWO_support c.isPWO_support (β + ξ + δ)).filter + (fun pq ↦ pq.1 ≤ β ∧ pq.2 ≤ ξ), b.coeff pq.1 * c.coeff pq.2 := by + rw [Subring.coe_mul, HahnSeries.coeff_mul] + refine Finset.sum_nbij' (i := fun uv ↦ (β + uv.1, ξ + uv.2)) + (j := fun pq ↦ (pq.1 - β, pq.2 - ξ)) ?_ ?_ ?_ ?_ ?_ + · rintro ⟨u, v⟩ huv + rw [Finset.mem_addAntidiagonal] at huv + obtain ⟨hu, hv, huv⟩ := huv + rw [mem_support_translatedTruncation] at hu + rw [mem_support_translatedTruncation] at hv + simp only [Finset.mem_filter, Finset.mem_addAntidiagonal] + refine ⟨⟨hu.2, hv.2, by linarith⟩, by linarith [hu.1], by linarith [hv.1]⟩ + · rintro ⟨p, q⟩ hpq + simp only [Finset.mem_filter, Finset.mem_addAntidiagonal] at hpq + obtain ⟨⟨hp, hq, hsum⟩, hpβ, hqξ⟩ := hpq + rw [Finset.mem_addAntidiagonal] + refine ⟨?_, ?_, by linarith⟩ + · rw [mem_support_translatedTruncation] + exact ⟨by linarith, by simpa using hp⟩ + · rw [mem_support_translatedTruncation] + exact ⟨by linarith, by simpa using hq⟩ + · rintro ⟨u, v⟩ _ + simp + · rintro ⟨p, q⟩ _ + simp + · rintro ⟨u, v⟩ huv + rw [Finset.mem_addAntidiagonal] at huv + obtain ⟨hu, hv, -⟩ := huv + rw [mem_support_translatedTruncation] at hu + rw [mem_support_translatedTruncation] at hv + rw [coeff_translatedTruncation, coeff_translatedTruncation, if_pos hu.1, if_pos hv.1] + +/-- The finite index set of Berarducci's convolution formula: the first coordinates of the points +of the closed supports lying on the line of sum `γ`. -/ +def convolutionIndex (b c : K⟦ℝ⟧) (γ : ℝ) : Finset ℝ := + (Set.IsPWO.finite_sub_mem (Set.isPWO_closure b.isPWO_support) + (Set.isPWO_closure c.isPWO_support) γ).toFinset + +@[simp] +theorem mem_convolutionIndex {b c : K⟦ℝ⟧} {γ β : ℝ} : + β ∈ convolutionIndex b c γ ↔ + β ∈ closure b.support ∧ γ - β ∈ closure c.support := by + simp [convolutionIndex] + +/-- The convolution formula for germs of a product, valid at every real cutoff. -/ +@[blueprint "lem:convolution-formula" + (phase := "Ordinal value and degree") + (title := "Convolution formula for translated truncations") + (statement := /-- + Let $K$ be a field. For $b,c\in K((\mathbb R))$ and $\gamma\in\mathbb R$, + \[ + \trunc{(bc)}\gamma\equiv\sum_{\xi+\zeta=\gamma}\trunc b\xi\trunc c\zeta + \bmod J . + \] + -/) + (proof := /-- + For a cutoff $\gamma$, only finitely many pairs of points in the two closed + supports can sum to $\gamma$. Below a sufficiently small neighbourhood of + zero, every support pair contributing to the coefficient of $bc$ is dominated + by a unique such boundary pair. Regrouping the convolution product by that pair + identifies the coefficients of $(bc)^{|\gamma}$ with the finite sum of + $b^{|\xi}c^{|\zeta}$; equality near zero is precisely congruence modulo $J$. + This is the proof of \cite[Lemma~7.5(2)]{Ber00}; its argument does not use + $\gamma\le 0$, so it gives the displayed formula at every real cutoff. + -/)] +theorem germAt_mul (b c : K⟦ℝ⟧) (γ : ℝ) : + germAt (b * c) γ = ∑ β ∈ convolutionIndex b c γ, germAt b β * germAt c (γ - β) := by + classical + have hB := Set.isPWO_closure b.isPWO_support + have hC := Set.isPWO_closure c.isPWO_support + have hev := Set.IsPWO.eventually_existsUnique_dominating hB hC + isClosed_closure isClosed_closure γ + obtain ⟨η₀, hη₀, hsub⟩ := mem_nhdsLE_iff_exists_Ioc_subset.mp hev + rw [Set.mem_Iio] at hη₀ + have hRHS : ∑ β ∈ convolutionIndex b c γ, germAt b β * germAt c (γ - β) = + toGerm (∑ β ∈ convolutionIndex b c γ, + translatedTruncation b β * translatedTruncation c (γ - β)) := by + rw [map_sum] + simp only [germAt_apply, map_mul] + rw [germAt_apply, hRHS, toGerm_eq_toGerm_iff_exists_coeff_eq] + refine ⟨η₀ - γ, by linarith, fun δ hδlow hδ0 ↦ ?_⟩ + have hγδ : γ + δ ∈ Set.Ioc η₀ γ := ⟨by linarith, by linarith⟩ + have hunique := hsub hγδ + rw [coeff_translatedTruncation, if_pos hδ0] + set A := Finset.addAntidiagonal b.isPWO_support c.isPWO_support (γ + δ) with hA + rw [HahnSeries.coeff_mul] + have hcoeSum : ((∑ β ∈ convolutionIndex b c γ, + translatedTruncation b β * translatedTruncation c (γ - β) : Series K) : K⟦ℝ⟧).coeff δ = + ∑ β ∈ convolutionIndex b c γ, + ((translatedTruncation b β * translatedTruncation c (γ - β) : Series K) : K⟦ℝ⟧).coeff δ := + by + rw [AddSubmonoidClass.coe_finsetSum, HahnSeries.coeff_sum] + rw [hcoeSum] + have hterm : ∀ β ∈ convolutionIndex b c γ, + ((translatedTruncation b β * translatedTruncation c (γ - β) : Series K) : K⟦ℝ⟧).coeff δ = + ∑ pq ∈ A.filter (fun pq ↦ pq.1 ≤ β ∧ pq.2 ≤ γ - β), + b.coeff pq.1 * c.coeff pq.2 := by + intro β _ + have hidx : β + (γ - β) + δ = γ + δ := by ring + rw [coeff_translatedTruncation_mul b c β (γ - β) δ, hidx, ← hA] + rw [Finset.sum_congr rfl hterm] + simp only [Finset.sum_filter] + rw [Finset.sum_comm] + refine (Finset.sum_congr rfl fun pq hpq ↦ ?_).symm + rw [Finset.mem_addAntidiagonal] at hpq + obtain ⟨hp, hq, hsum⟩ := hpq + obtain ⟨β₀, hβ₀, hβ₀uniq⟩ := + hunique pq.1 (subset_closure hp) pq.2 (subset_closure hq) hsum + refine (Finset.sum_eq_single β₀ ?_ ?_).trans ?_ + · intro β hβ hne + refine if_neg fun hdom ↦ hne ?_ + exact hβ₀uniq β ⟨(mem_convolutionIndex.mp hβ).1, (mem_convolutionIndex.mp hβ).2, + hdom.1, hdom.2⟩ + · intro hnot + exact absurd (mem_convolutionIndex.mpr ⟨hβ₀.1, hβ₀.2.1⟩) hnot + · exact if_pos ⟨hβ₀.2.2.1, hβ₀.2.2.2⟩ + +/-- Berarducci, Lemma 7.5(2), the convolution formula at a nonpositive cutoff. -/ +theorem germAt_mul_of_nonpos (b c : K⟦ℝ⟧) (γ : ℝ) (_hγ : γ ≤ 0) : + germAt (b * c) γ = ∑ β ∈ convolutionIndex b c γ, germAt b β * germAt c (γ - β) := + germAt_mul b c γ + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ConvolutionList.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ConvolutionList.lean new file mode 100644 index 0000000000..614e2bdb95 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ConvolutionList.lean @@ -0,0 +1,146 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointWellOrdered +import Mathlib.Topology.Instances.Real.Lemmas + +/-! +# The multi-factor convolution formula + +Berarducci, Remark 7.6: the two-factor convolution formula extends by induction to a product of +finitely many series. The germ of the product of a list of series at a cutoff is the finite sum, +over the exponent lists summing to that cutoff, of the products of the germs of the factors at +those exponents. + +The index set is built by the same recursion as the formula. At a cons the two-factor index set +selects the exponent of the head, and the exponent lists of the tail are taken at the shifted +cutoff; the resulting families are pairwise disjoint because they have distinct heads, and the +cons map is injective, so the double sum collapses to a single sum. The empty list contributes the +unit exactly at cutoff zero, since the support of one is the single exponent zero and its germ +vanishes elsewhere. +-/ + +universe v + +public noncomputable section + +open HahnSeries + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- The product of the germs of a list of series at a list of exponents. -/ +def germListProd : List K⟦ℝ⟧ → List ℝ → Germ K + | [], [] => 1 + | b :: l, β :: f => germAt b β * germListProd l f + | _, _ => 0 + +@[simp] +theorem germListProd_nil : germListProd ([] : List K⟦ℝ⟧) [] = 1 := + (rfl) + +@[simp] +theorem germListProd_cons (b : K⟦ℝ⟧) (l : List K⟦ℝ⟧) (β : ℝ) (f : List ℝ) : + germListProd (b :: l) (β :: f) = germAt b β * germListProd l f := + (rfl) + +/-- The finite index set of the multi-factor convolution formula. -/ +def convolutionIndexList : List K⟦ℝ⟧ → ℝ → Finset (List ℝ) + | [], γ => if γ = 0 then {[]} else ∅ + | b :: l, γ => + (convolutionIndex b l.prod γ).biUnion + fun β ↦ (convolutionIndexList l (γ - β)).image (β :: ·) + +@[simp] +theorem convolutionIndexList_nil (γ : ℝ) : + convolutionIndexList ([] : List K⟦ℝ⟧) γ = if γ = 0 then {[]} else ∅ := + (rfl) + +@[simp] +theorem convolutionIndexList_cons (b : K⟦ℝ⟧) (l : List K⟦ℝ⟧) (γ : ℝ) : + convolutionIndexList (b :: l) γ = + (convolutionIndex b l.prod γ).biUnion + fun β ↦ (convolutionIndexList l (γ - β)).image (β :: ·) := + (rfl) + +theorem length_of_mem_convolutionIndexList : + ∀ (l : List K⟦ℝ⟧) (γ : ℝ) {f : List ℝ}, f ∈ convolutionIndexList l γ → + f.length = l.length + | [], γ, f, hf => by + rw [convolutionIndexList_nil] at hf + by_cases hγ : γ = 0 + · rw [if_pos hγ, Finset.mem_singleton] at hf + rw [hf] + rfl + · rw [if_neg hγ] at hf + exact absurd hf (Finset.notMem_empty f) + | b :: t, γ, f, hf => by + rw [convolutionIndexList_cons, Finset.mem_biUnion] at hf + obtain ⟨β, _, hβ⟩ := hf + obtain ⟨g, hg, rfl⟩ := Finset.mem_image.mp hβ + rw [List.length_cons, List.length_cons, + length_of_mem_convolutionIndexList t (γ - β) hg] + +theorem sum_of_mem_convolutionIndexList : + ∀ (l : List K⟦ℝ⟧) (γ : ℝ) {f : List ℝ}, + f ∈ convolutionIndexList l γ → f.sum = γ + | [], γ, f, hf => by + rw [convolutionIndexList_nil] at hf + by_cases hγ : γ = 0 + · rw [if_pos hγ, Finset.mem_singleton] at hf + rw [hf, List.sum_nil, hγ] + · rw [if_neg hγ] at hf + exact absurd hf (Finset.notMem_empty f) + | b :: t, γ, f, hf => by + rw [convolutionIndexList_cons, Finset.mem_biUnion] at hf + obtain ⟨β, _, hβ⟩ := hf + obtain ⟨g, hg, rfl⟩ := Finset.mem_image.mp hβ + rw [List.sum_cons, sum_of_mem_convolutionIndexList t (γ - β) hg] + ring + +private theorem germAt_one_of_ne_zero {γ : ℝ} (hγ : γ ≠ 0) : + germAt (1 : K⟦ℝ⟧) γ = 0 := by + refine germAt_eq_zero_of_not_mem_closure_support ?_ + have hsupp : (1 : K⟦ℝ⟧).support = {(0 : ℝ)} := by + change (HahnSeries.single (0 : ℝ) (1 : K)).support = _ + exact HahnSeries.support_single_of_ne one_ne_zero + rw [hsupp, closure_singleton] + simpa using hγ + +/-- Berarducci, Remark 7.6: the germ of a product of a list of series at a cutoff is the finite +sum, over the exponent lists summing to that cutoff, of the products of the germs of the factors +at those exponents. -/ +theorem germAt_listProd (l : List K⟦ℝ⟧) (γ : ℝ) : + germAt l.prod γ = ∑ f ∈ convolutionIndexList l γ, germListProd l f := by + induction l generalizing γ with + | nil => + rw [List.prod_nil, convolutionIndexList_nil] + by_cases hγ : γ = 0 + · subst hγ + rw [if_pos rfl, Finset.sum_singleton, germListProd_nil] + change germAt ((1 : Series K) : K⟦ℝ⟧) 0 = 1 + rw [germAt_apply, translatedTruncation_zero] + exact map_one toGerm + · rw [if_neg hγ, Finset.sum_empty] + exact germAt_one_of_ne_zero hγ + | cons b t ih => + rw [List.prod_cons, germAt_mul, convolutionIndexList_cons] + rw [Finset.sum_biUnion] + · refine Finset.sum_congr rfl fun β _ ↦ ?_ + rw [Finset.sum_image (fun _ _ _ _ h ↦ (List.cons_inj_right β).mp h), ih (γ - β), + Finset.mul_sum] + exact Finset.sum_congr rfl fun f _ ↦ rfl + · intro x _ y _ hxy + refine Finset.disjoint_left.mpr fun g hg hg' ↦ hxy ?_ + obtain ⟨f, _, rfl⟩ := Finset.mem_image.mp hg + obtain ⟨f', _, hf'⟩ := Finset.mem_image.mp hg' + exact (List.cons.injEq _ _ _ _ ▸ hf').1.symm + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ConvolutionRemainder.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ConvolutionRemainder.lean new file mode 100644 index 0000000000..54a19aec98 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ConvolutionRemainder.lean @@ -0,0 +1,202 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermValueCut +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointWellOrdered +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +import Mathlib.Topology.Instances.Real.Lemmas +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSubmultiplicative +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPrincipal + +/-! +# The convolution remainder estimate + +Berarducci, Lemma 7.7: when `v_J^p(b) ≤ v_J^p(c)`, the germ of `b * c` at a sufficiently high +negative cutoff differs from `b^{|γ} c + b c^{|γ}` by a germ of ordinal value strictly below +`v_J^r(b) ⊙ v_J(c)`. + +The convolution formula expands the germ of the product as a finite sum over the index set. Two +of its terms are the displayed ones: the index `γ` contributes `b^{|γ} c` and the index `0` +contributes `b c^{|γ}`, and when either index is absent from the set the corresponding term is +already zero because a germ at a point outside the closed support vanishes. Every remaining index +`β` satisfies `γ < β < 0` and `γ < γ - β < 0`, so the eventual value cut bounds both factor +values by proper multiples of the two residual values, submultiplicativity bounds the product, and +Berarducci, Fact 3.7 for the natural product collapses the two multipliers strictly below +`v_J^p(c)`. + +The bound uses Hessenberg multiplication throughout; the multipliers supplied by the value cut are +ordinary ordinal products, and the comparison between the two is where `NatOrdinal.omul_le_mul'` +enters. +-/ + +universe u v + +public noncomputable section + +open HahnSeries Filter Topology + +namespace Berarducci + +variable {K : Type v} [Field K] + +@[simp] +theorem germOrdinalValue_zero : germOrdinalValue (0 : Germ K) = 0 := + germOrdinalValue_eq_zero_iff.mpr rfl + +theorem germOrdinalValue_add_le_max (q p : Germ K) : + germOrdinalValue (q + p) ≤ max (germOrdinalValue q) (germOrdinalValue p) := by + obtain ⟨b, rfl⟩ := Ideal.Quotient.mk_surjective q + obtain ⟨c, rfl⟩ := Ideal.Quotient.mk_surjective p + rw [← map_add, germOrdinalValue_mk, germOrdinalValue_mk, germOrdinalValue_mk] + exact ordinalValue_add_le_max b c + +theorem germOrdinalValue_sum_lt {ι : Type u} {s : Finset ι} {f : ι → Germ K} + {X : NatOrdinal} (hX : 0 < X) (h : ∀ i ∈ s, germOrdinalValue (f i) < X) : + germOrdinalValue (∑ i ∈ s, f i) < X := by + classical + induction s using Finset.induction_on with + | empty => simpa using hX + | insert a s ha ih => + rw [Finset.sum_insert ha] + refine (germOrdinalValue_add_le_max _ _).trans_lt (max_lt ?_ ?_) + · exact h a (Finset.mem_insert_self a s) + · exact ih fun i hi ↦ h i (Finset.mem_insert_of_mem hi) + + +theorem exists_germOrdinalValue_convolution_remainder_lt + (b c : SeriesWithOrdinalValueAboveOne K) + (hp : b.principalValue ≤ c.principalValue) : + ∃ η < (0 : ℝ), ∀ γ : ℝ, η < γ → γ < 0 → + germOrdinalValue (germAt ((b.1 * c.1 : Series K) : K⟦ℝ⟧) γ + - germAt (b.1 : K⟦ℝ⟧) γ * toGerm c.1 + - toGerm b.1 * germAt (c.1 : K⟦ℝ⟧) γ) + < b.residualValue * ordinalValue c.1 := by + classical + obtain ⟨ηb, hηb, hcutb⟩ := exists_ordinalValue_translatedTruncation_le b + obtain ⟨ηc, hηc, hcutc⟩ := exists_ordinalValue_translatedTruncation_le c + refine ⟨max ηb ηc, max_lt hηb hηc, fun γ hγlow hγ ↦ ?_⟩ + have hηbγ : ηb < γ := (le_max_left ηb ηc).trans_lt hγlow + have hηcγ : ηc < γ := (le_max_right ηb ηc).trans_lt hγlow + have hclosb : closure (b.1 : K⟦ℝ⟧).support ⊆ Set.Iic 0 := + closure_minimal (HahnSeries.Nonpositive.support_subset b.1) isClosed_Iic + have hclosc : closure (c.1 : K⟦ℝ⟧).support ⊆ Set.Iic 0 := + closure_minimal (HahnSeries.Nonpositive.support_subset c.1) isClosed_Iic + set X : NatOrdinal := b.residualValue * ordinalValue c.1 with hXdef + have hρb : (0 : NatOrdinal) < b.residualValue := + pos_iff_ne_zero.mpr b.residualValue_ne_zero + have hρc : (0 : NatOrdinal) < c.residualValue := + pos_iff_ne_zero.mpr c.residualValue_ne_zero + have hvc : (0 : NatOrdinal) < ordinalValue c.1 := lt_trans zero_lt_one c.2 + have hXpos : 0 < X := mul_pos hρb hvc + set f : ℝ → Germ K := + fun β ↦ germAt (b.1 : K⟦ℝ⟧) β * germAt (c.1 : K⟦ℝ⟧) (γ - β) with hfdef + set T := convolutionIndex (b.1 : K⟦ℝ⟧) (c.1 : K⟦ℝ⟧) γ with hTdef + have hfγ : f γ = germAt (b.1 : K⟦ℝ⟧) γ * toGerm c.1 := by + simp only [hfdef, sub_self, germAt_apply, translatedTruncation_zero] + have hf0 : f 0 = toGerm b.1 * germAt (c.1 : K⟦ℝ⟧) γ := by + simp only [hfdef, sub_zero, germAt_apply, translatedTruncation_zero] + have hfγzero : γ ∉ T → f γ = 0 := by + intro hmem + rw [hTdef, mem_convolutionIndex] at hmem + push Not at hmem + simp only [sub_self] at hmem + simp only [hfdef, sub_self] + by_cases hb : γ ∈ closure (b.1 : K⟦ℝ⟧).support + · rw [germAt_eq_zero_of_not_mem_closure_support (hmem hb), mul_zero] + · rw [germAt_eq_zero_of_not_mem_closure_support hb, zero_mul] + have hf0zero : (0 : ℝ) ∉ T → f 0 = 0 := by + intro hmem + rw [hTdef, mem_convolutionIndex] at hmem + push Not at hmem + simp only [sub_zero] at hmem + simp only [hfdef, sub_zero] + by_cases hb : (0 : ℝ) ∈ closure (b.1 : K⟦ℝ⟧).support + · rw [germAt_eq_zero_of_not_mem_closure_support (hmem hb), mul_zero] + · rw [germAt_eq_zero_of_not_mem_closure_support hb, zero_mul] + have hstep1 : ∑ β ∈ T, f β = f γ + ∑ β ∈ T.erase γ, f β := by + by_cases hmem : γ ∈ T + · exact (Finset.add_sum_erase T f hmem).symm + · rw [Finset.erase_eq_of_notMem hmem, hfγzero hmem, zero_add] + have hmem0 : (0 : ℝ) ∈ T.erase γ ↔ (0 : ℝ) ∈ T := by + rw [Finset.mem_erase] + exact ⟨fun h ↦ h.2, fun h ↦ ⟨(ne_of_lt hγ).symm, h⟩⟩ + have hstep2 : ∑ β ∈ T.erase γ, f β = f 0 + ∑ β ∈ (T.erase γ).erase 0, f β := by + by_cases hmem : (0 : ℝ) ∈ T.erase γ + · exact (Finset.add_sum_erase _ f hmem).symm + · rw [Finset.erase_eq_of_notMem hmem, hf0zero (fun h ↦ hmem (hmem0.mpr h)), zero_add] + have hcoe : ((b.1 * c.1 : Series K) : K⟦ℝ⟧) = (b.1 : K⟦ℝ⟧) * (c.1 : K⟦ℝ⟧) := rfl + have hrewrite : germAt ((b.1 * c.1 : Series K) : K⟦ℝ⟧) γ + - germAt (b.1 : K⟦ℝ⟧) γ * toGerm c.1 + - toGerm b.1 * germAt (c.1 : K⟦ℝ⟧) γ + = ∑ β ∈ (T.erase γ).erase 0, f β := by + rw [hcoe, germAt_mul, ← hTdef, ← hfdef, hstep1, hstep2, ← hfγ, ← hf0] + abel + rw [hrewrite] + refine germOrdinalValue_sum_lt hXpos fun β hβ ↦ ?_ + obtain ⟨hβ0, hβrest⟩ := Finset.mem_erase.mp hβ + obtain ⟨hβγ, hβT⟩ := Finset.mem_erase.mp hβrest + rw [hTdef, mem_convolutionIndex] at hβT + have hβle : β ≤ 0 := hclosb hβT.1 + have hβneg : β < 0 := lt_of_le_of_ne hβle hβ0 + have hγβle : γ - β ≤ 0 := hclosc hβT.2 + have hγβ : γ < β := by + rcases lt_or_eq_of_le (by linarith : γ ≤ β) with h | h + · exact h + · exact absurd h.symm hβγ + obtain ⟨α₁, hα₁, hα₁le⟩ := hcutb β (hηbγ.trans hγβ) hβneg + obtain ⟨α₂, hα₂, hα₂le⟩ := + hcutc (γ - β) (by linarith) (by linarith) + have hgerm : germOrdinalValue (f β) ≤ + ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) β) * + ordinalValue (translatedTruncation (c.1 : K⟦ℝ⟧) (γ - β)) := by + simpa only [hfdef, germAt_apply, toGerm_apply, germOrdinalValue_mk] using + germOrdinalValue_mul_le_naturalMul (germAt (b.1 : K⟦ℝ⟧) β) + (germAt (c.1 : K⟦ℝ⟧) (γ - β)) + have hb₁ : ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) β) ≤ + NatOrdinal.of (b.residualValue.val * α₁) := by + simpa using NatOrdinal.of.le_iff_le.mpr hα₁le + have hc₁ : ordinalValue (translatedTruncation (c.1 : K⟦ℝ⟧) (γ - β)) ≤ + NatOrdinal.of (c.residualValue.val * α₂) := by + simpa using NatOrdinal.of.le_iff_le.mpr hα₂le + have hfinal : NatOrdinal.of (b.residualValue.val * α₁) * + NatOrdinal.of (c.residualValue.val * α₂) < X := by + have hlt := NatOrdinal.naturalMul_mul_lt_of_lt + (ρ₁ := b.residualValue) (ρ₂ := c.residualValue) + (π₁ := b.principalValue) (π₂ := c.principalValue) + (α₁ := NatOrdinal.of α₁) (α₂ := NatOrdinal.of α₂) + c.principalValue_isMultiplicativelyPrincipal hp + (by simpa using NatOrdinal.of.lt_iff_lt.mpr hα₁) + (by simpa using NatOrdinal.of.lt_iff_lt.mpr hα₂) + (mul_pos hρb hρc) + simpa only [NatOrdinal.val_of, hXdef, mul_assoc, + c.residualValue_mul_principalValue] using hlt + exact ((hgerm.trans (mul_le_mul' hb₁ hc₁)).trans_lt hfinal) + +/-- The convolution-remainder estimate for the actual translated truncation series, with one +left neighbourhood working uniformly for every cutoff in it. -/ +theorem exists_ordinalValue_convolution_remainder_lt + (b c : SeriesWithOrdinalValueAboveOne K) + (hp : b.principalValue ≤ c.principalValue) : + ∃ η < (0 : ℝ), ∀ γ : ℝ, η < γ → γ < 0 → + ordinalValue + (translatedTruncation (((b.1 * c.1 : Series K) : K⟦ℝ⟧)) γ + - translatedTruncation (b.1 : K⟦ℝ⟧) γ * c.1 + - b.1 * translatedTruncation (c.1 : K⟦ℝ⟧) γ) < + b.residualValue * ordinalValue c.1 := by + obtain ⟨η, hη, hrem⟩ := exists_germOrdinalValue_convolution_remainder_lt b c hp + refine ⟨η, hη, fun γ hηγ hγ ↦ ?_⟩ + have hrem' := hrem γ hηγ hγ + simp only [germAt_apply, toGerm_apply] at hrem' + rw [← map_mul, ← map_mul, ← map_sub, ← map_sub, germOrdinalValue_mk] at hrem' + exact hrem' + + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPoint.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPoint.lean new file mode 100644 index 0000000000..01f68c0d59 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPoint.lean @@ -0,0 +1,234 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.MainLemma +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointWellOrdered +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +import Mathlib.Topology.Instances.Real.Lemmas + +/-! +# Critical points of nonpositive real Hahn series + +For a nonzero series `b`, Berarducci defines its critical point as the least nonpositive exponent +where the ordinal value of a translated truncation is maximal. `IsCriticalPoint b x` states this +characterization directly; existence is the separate content of Berarducci, Lemma 10.1. + +The main result here is Berarducci, Lemma 10.4: at critical points `x` and `y`, the translated +truncation of `b * c` at `x + y` has value equal to the Hessenberg product of the two critical +values. The proof isolates the `(x, y)` term in the finite germ-convolution formula. Minimality +makes every other term strictly smaller, so it cannot cancel the distinguished term. + +## References + +* A. Berarducci, *Factorization in generalized power series*, Trans. Amer. Math. Soc. 352 + (2000), 553–577, cited as [Ber00]. +-/ + +universe v + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace Berarducci + +open HahnSeries + +variable {K : Type v} [Field K] + +/-- `x` is the critical point of `b` when `b` is nonzero, `x ≤ 0`, the value of the translated +truncation at `x` is maximal, and `x` is the least point attaining that value. -/ +def IsCriticalPoint (b : Series K) (x : ℝ) : Prop := + b ≠ 0 ∧ x ≤ 0 ∧ + (∀ y : ℝ, y ≤ 0 → + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) y) ≤ + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x)) ∧ + ∀ y : ℝ, y ≤ 0 → + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) y) = + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) → x ≤ y + +/-- Characterization of the critical-point predicate. -/ +theorem isCriticalPoint_iff {b : Series K} {x : ℝ} : + IsCriticalPoint b x ↔ + b ≠ 0 ∧ x ≤ 0 ∧ + (∀ y : ℝ, y ≤ 0 → + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) y) ≤ + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x)) ∧ + ∀ y : ℝ, y ≤ 0 → + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) y) = + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) → x ≤ y := + (Iff.rfl) + +/-- Eliminate the critical-point predicate through the module boundary. -/ +theorem IsCriticalPoint.elim {b : Series K} {x : ℝ} (hx : IsCriticalPoint b x) : + b ≠ 0 ∧ x ≤ 0 ∧ + (∀ y : ℝ, y ≤ 0 → + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) y) ≤ + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x)) ∧ + ∀ y : ℝ, y ≤ 0 → + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) y) = + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) → x ≤ y := + hx + +/-- A series with a critical point is nonzero. -/ +theorem IsCriticalPoint.ne_zero {b : Series K} {x : ℝ} + (hx : IsCriticalPoint b x) : b ≠ 0 := + hx.elim.1 + +/-- A critical point is nonpositive. -/ +theorem IsCriticalPoint.nonpositive {b : Series K} {x : ℝ} + (hx : IsCriticalPoint b x) : x ≤ 0 := + hx.elim.2.1 + +/-- The translated-truncation value at a critical point is maximal. -/ +theorem IsCriticalPoint.value_le {b : Series K} {x : ℝ} + (hx : IsCriticalPoint b x) (y : ℝ) (hy : y ≤ 0) : + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) y) ≤ + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) := + hx.elim.2.2.1 y hy + +/-- A critical point is the least nonpositive point attaining the maximal value. -/ +theorem IsCriticalPoint.le_of_value_eq {b : Series K} {x : ℝ} + (hx : IsCriticalPoint b x) (y : ℝ) (hy : y ≤ 0) + (hvalue : ordinalValue (translatedTruncation (b : K⟦ℝ⟧) y) = + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x)) : x ≤ y := + hx.elim.2.2.2 y hy hvalue + +/-- Berarducci's ordinal value is multiplicative on the germ quotient once its multiplicativity +on series is known. -/ +theorem germOrdinalValue_mul [CharZero K] (q p : Germ K) : + germOrdinalValue (q * p) = germOrdinalValue q * germOrdinalValue p := by + obtain ⟨b, hb⟩ := Ideal.Quotient.mk_surjective q + obtain ⟨c, hc⟩ := Ideal.Quotient.mk_surjective p + have hb' : toGerm b = q := (toGerm_apply b).trans hb + have hc' : toGerm c = p := (toGerm_apply c).trans hc + rw [← hb', ← hc', ← map_mul] + simp only [toGerm_apply, germOrdinalValue_mk, ordinalValue_mul] + +/-- Adding a germ of strictly smaller value does not change the larger value. -/ +theorem germOrdinalValue_add_eq_left_of_lt {q p : Germ K} + (h : germOrdinalValue p < germOrdinalValue q) : + germOrdinalValue (q + p) = germOrdinalValue q := by + apply le_antisymm + · simpa [max_eq_left h.le] using germOrdinalValue_add_le_max q p + · have hle := germOrdinalValue_add_le_max (q + p) (-p) + rw [add_neg_cancel_right, germOrdinalValue_neg] at hle + by_contra hnot + exact (not_lt_of_ge hle) (max_lt (lt_of_not_ge hnot) h) + +/-- At an exponent in the support, the translated truncation has positive ordinal value. -/ +theorem ordinalValue_translatedTruncation_pos_of_mem_support + {b : K⟦ℝ⟧} {x : ℝ} (hx : x ∈ b.support) : + 0 < ordinalValue (translatedTruncation b x) := by + rw [pos_iff_ne_zero] + intro hzero + have hmem := ordinalValue_eq_zero_iff.mp hzero + have hcoeff := constantCoeff_eq_zero_of_mem_negativeMonomialIdeal hmem + rw [HahnSeries.Nonpositive.constantCoeff_apply, coeff_translatedTruncation] at hcoeff + simp only [le_refl, if_true, add_zero] at hcoeff + exact (HahnSeries.mem_support _ _).mp hx hcoeff + +/-- The maximal translated-truncation value at a critical point is positive. -/ +theorem IsCriticalPoint.value_pos {b : Series K} {x : ℝ} + (hx : IsCriticalPoint b x) : + 0 < ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) := by + have hsupport : (b : K⟦ℝ⟧).support.Nonempty := + HahnSeries.support_nonempty_iff.mpr (by simpa using hx.ne_zero) + obtain ⟨y, hy⟩ := hsupport + have hy0 := HahnSeries.Nonpositive.support_subset b hy + exact (ordinalValue_translatedTruncation_pos_of_mem_support hy).trans_le + (hx.value_le y hy0) + +/-- A critical point lies in the closure of the series support. -/ +theorem IsCriticalPoint.mem_closure_support {b : Series K} {x : ℝ} + (hx : IsCriticalPoint b x) : x ∈ closure (b : K⟦ℝ⟧).support := by + by_contra hmem + have hJ := translatedTruncation_mem_negativeMonomialIdeal_of_not_mem_closure_support hmem + rw [← ordinalValue_eq_zero_iff] at hJ + exact hx.value_pos.ne' hJ + +/-- Berarducci, Lemma 10.4: the value of a product truncated at the sum of the factors' critical +points is the Hessenberg product of their critical values. -/ +theorem criticalPoint_product_value [CharZero K] + {b c : Series K} {x y : ℝ} + (hx : IsCriticalPoint b x) (hy : IsCriticalPoint c y) : + ordinalValue (translatedTruncation (((b * c : Series K) : K⟦ℝ⟧)) (x + y)) = + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) * + ordinalValue (translatedTruncation (c : K⟦ℝ⟧) y) := by + classical + let gamma := x + y + let s := convolutionIndex (b : K⟦ℝ⟧) (c : K⟦ℝ⟧) gamma + let f : ℝ → Germ K := fun beta ↦ + germAt (b : K⟦ℝ⟧) beta * germAt (c : K⟦ℝ⟧) (gamma - beta) + let X := ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) * + ordinalValue (translatedTruncation (c : K⟦ℝ⟧) y) + have hxs : x ∈ s := by + rw [mem_convolutionIndex] + refine ⟨hx.mem_closure_support, ?_⟩ + simpa [gamma] using hy.mem_closure_support + have hXpos : 0 < X := mul_pos hx.value_pos hy.value_pos + have hfx : germOrdinalValue (f x) = X := by + dsimp only [f] + rw [germOrdinalValue_mul] + simp only [germAt_apply, toGerm_apply, germOrdinalValue_mk] + congr 1 + simp [gamma] + have hterm : ∀ beta ∈ s.erase x, germOrdinalValue (f beta) < X := by + intro beta hbeta + have hbetaS := (Finset.mem_erase.mp hbeta).2 + have hbetaNe := (Finset.mem_erase.mp hbeta).1 + obtain ⟨hbetaClosure, hdeltaClosure⟩ := mem_convolutionIndex.mp hbetaS + have hclosureB : closure (b : K⟦ℝ⟧).support ⊆ Set.Iic 0 := + closure_minimal (HahnSeries.Nonpositive.support_subset b) isClosed_Iic + have hclosureC : closure (c : K⟦ℝ⟧).support ⊆ Set.Iic 0 := + closure_minimal (HahnSeries.Nonpositive.support_subset c) isClosed_Iic + have hbeta0 : beta ≤ 0 := hclosureB hbetaClosure + have hdelta0 : gamma - beta ≤ 0 := hclosureC hdeltaClosure + have hbLe := hx.value_le beta hbeta0 + have hcLe := hy.value_le (gamma - beta) hdelta0 + dsimp only [f] + rw [germOrdinalValue_mul] + simp only [germAt_apply, toGerm_apply, germOrdinalValue_mk] + change ordinalValue (translatedTruncation (b : K⟦ℝ⟧) beta) * + ordinalValue (translatedTruncation (c : K⟦ℝ⟧) (gamma - beta)) < X + dsimp only [X] + rcases hbLe.eq_or_lt with hbEq | hbLt + · have hxbeta : x ≤ beta := hx.le_of_value_eq beta hbeta0 hbEq + have hdeltaLt : gamma - beta < y := by + dsimp [gamma] + rcases hxbeta.eq_or_lt with h | h + · exact (hbetaNe h.symm).elim + · linarith + have hcLt : ordinalValue (translatedTruncation (c : K⟦ℝ⟧) (gamma - beta)) < + ordinalValue (translatedTruncation (c : K⟦ℝ⟧) y) := by + exact lt_of_le_of_ne hcLe fun heq ↦ + (not_le_of_gt hdeltaLt) (hy.le_of_value_eq (gamma - beta) hdelta0 heq) + rw [hbEq] + exact mul_lt_mul_of_pos_left hcLt hx.value_pos + · exact (mul_le_mul_right hcLe _).trans_lt + (mul_lt_mul_of_pos_right hbLt hy.value_pos) + have hrest : germOrdinalValue (∑ beta ∈ s.erase x, f beta) < X := + germOrdinalValue_sum_lt hXpos hterm + have hsum : germOrdinalValue (∑ beta ∈ s, f beta) = X := by + rw [← s.add_sum_erase f hxs] + rw [germOrdinalValue_add_eq_left_of_lt] + · exact hfx + · rwa [hfx] + have hconv := germAt_mul (b : K⟦ℝ⟧) (c : K⟦ℝ⟧) gamma + change ordinalValue (translatedTruncation (((b * c : Series K) : K⟦ℝ⟧)) gamma) = X + calc + _ = germOrdinalValue (germAt (((b * c : Series K) : K⟦ℝ⟧)) gamma) := by + rw [germAt_apply, toGerm_apply, germOrdinalValue_mk] + _ = germOrdinalValue + (germAt ((b : K⟦ℝ⟧) * (c : K⟦ℝ⟧)) gamma) := by rfl + _ = X := by rw [hconv]; exact hsum + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPointExistence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPointExistence.lean new file mode 100644 index 0000000000..c62ca5b286 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPointExistence.lean @@ -0,0 +1,250 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPoint + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOSumset +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.MainLemma +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointWellOrdered +import Mathlib.Tactic.Linarith + +/-! +# Existence of Berarducci critical points + +Berarducci, Lemma 10.1 proves that the ordinal values of all translated truncations of a nonzero +nonpositive real Hahn series have a maximum. Definition 10.2 chooses the least nonpositive cutoff +where that maximum occurs. + +The proof realizes the maximum through the LM24 normal form. Its principal head has the same +degree as the full series. Truncating at the head exponent recovers that principal coefficient up +to a constant, so its ordinal-value degree reaches the upper bound for every translated truncation. +The maximizers lie in the closed support, which is partially well ordered, and therefore have a +least element. + +## References + +* A. Berarducci, *Factorization in generalized power series*, Trans. Amer. Math. Soc. 352 + (2000), 553–577, cited as [Ber00]. +-/ + +universe v + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace Berarducci + +open HahnSeries + +variable {K : Type v} [Field K] + +private theorem translatedTruncation_translate_self + (p : Series K) (x : ℝ) : + translatedTruncation (HahnSeries.translate x (p : K⟦ℝ⟧)) x = p := by + apply Subtype.ext + rw [coe_translatedTruncation, HahnSeries.truncLE_translate] + simp only [sub_self] + rw [HahnSeries.truncLE_eq_self_of_support_subset_Iic + (HahnSeries.Nonpositive.support_subset p), HahnSeries.translate_add_apply] + simp + +private theorem translatedTruncation_eq_C_of_support_subset_Ici + (b : Series K) (x : ℝ) + (hb : (b : K⟦ℝ⟧).support ⊆ Set.Ici x) : + translatedTruncation (b : K⟦ℝ⟧) x = + HahnSeries.Nonpositive.C ((b : K⟦ℝ⟧).coeff x) := by + apply Subtype.ext + ext δ + rw [coeff_translatedTruncation, HahnSeries.Nonpositive.coe_C] + rcases lt_trichotomy δ 0 with hδ | rfl | hδ + · rw [if_pos hδ.le, HahnSeries.C_apply, + HahnSeries.coeff_single_of_ne hδ.ne] + apply not_ne_iff.mp + rw [← HahnSeries.mem_support] + intro hmem + exact (not_le_of_gt (by linarith : x + δ < x)) (hb hmem) + · simp + · rw [if_neg (not_le_of_gt hδ), HahnSeries.C_apply, + HahnSeries.coeff_single_of_ne hδ.ne'] + +private theorem principalHeadExponent_nonpositive + {b p r : Series K} {x : ℝ} + (hb : (b : K⟦ℝ⟧) = + HahnSeries.translate x (p : K⟦ℝ⟧) + (r : K⟦ℝ⟧)) + (hp : HahnSeries.Nonpositive.IsPrincipal p) : x ≤ 0 := by + by_contra hx + have hxpos : 0 < x := lt_of_not_ge hx + have hheadNe : HahnSeries.translate x (p : K⟦ℝ⟧) ≠ 0 := + fun hzero ↦ hp.ne_zero (Subtype.ext + ((HahnSeries.translate x).injective (by simpa using hzero))) + have hpSup : sSup (p : K⟦ℝ⟧).support = 0 := by + have hsup := hp.supportSup_eq_zero + rw [HahnSeries.Nonpositive.supportSup_of_ne hp.ne_zero] at hsup + exact WithBot.coe_eq_coe.mp hsup + have hheadBdd : BddAbove + (HahnSeries.translate x (p : K⟦ℝ⟧)).support := by + refine ⟨x, ?_⟩ + rw [HahnSeries.support_translate] + rintro _ ⟨y, hy, rfl⟩ + have hy0 := HahnSeries.Nonpositive.support_subset p hy + change y ≤ 0 at hy0 + change x + y ≤ x + linarith + have hheadSup : sSup + (HahnSeries.translate x (p : K⟦ℝ⟧)).support = x := by + rw [HahnSeries.csSup_support_translate (by simpa using hp.ne_zero) + (HahnSeries.Nonpositive.bddAbove_support p), hpSup] + simp + have hheadLUB : IsLUB + (HahnSeries.translate x (p : K⟦ℝ⟧)).support x := by + simpa only [hheadSup] using + (isLUB_csSup (HahnSeries.support_nonempty_iff.mpr hheadNe) hheadBdd) + obtain ⟨y, hy, hypos, -⟩ := hheadLUB.exists_between hxpos + have hrCoeff : (r : K⟦ℝ⟧).coeff y = 0 := by + apply not_ne_iff.mp + rw [← HahnSeries.mem_support] + exact fun hmem ↦ (not_le_of_gt hypos) + (HahnSeries.Nonpositive.support_subset r hmem) + have hbCoeff := congrArg (fun q : K⟦ℝ⟧ ↦ q.coeff y) hb + simp only [HahnSeries.coeff_add, hrCoeff, add_zero] at hbCoeff + have hyb : y ∈ (b : K⟦ℝ⟧).support := by + rw [HahnSeries.mem_support, hbCoeff] + exact (HahnSeries.mem_support _ _).mp hy + exact (not_le_of_gt hypos) (HahnSeries.Nonpositive.support_subset b hyb) + +private theorem ordinalValue_add_eq_left_of_lt [CharZero K] + {b c : Series K} (h : ordinalValue c < ordinalValue b) : + ordinalValue (b + c) = ordinalValue b := by + apply le_antisymm + · simpa [max_eq_left h.le] using ordinalValue_add_le_max b c + · have hle := ordinalValue_add_le_max (b + c) (-c) + rw [add_neg_cancel_right, ordinalValue_neg] at hle + by_contra hnot + exact (not_lt_of_ge hle) (max_lt (lt_of_not_ge hnot) h) + +private theorem ordinalValue_le_of_ordinalValueDegree_le + {b c : Series K} (h : ordinalValueDegree b ≤ ordinalValueDegree c) : + ordinalValue b ≤ ordinalValue c := by + by_cases hb : ordinalValue b = 0 + · simp [hb] + have hc : ordinalValue c ≠ 0 := by + intro hc + have hcDegree : ordinalValueDegree c = ⊥ := + ordinalValueDegree_eq_bot_iff.mpr (ordinalValue_eq_zero_iff.mp hc) + have hbDegree : ordinalValueDegree b ≠ ⊥ := fun hbot ↦ + hb (ordinalValue_eq_zero_iff.mpr (ordinalValueDegree_eq_bot_iff.mp hbot)) + exact hbDegree (bot_unique (h.trans_eq hcDegree)) + have hbDegreeNe : ordinalValueDegree b ≠ ⊥ := fun hbot ↦ + hb (ordinalValue_eq_zero_iff.mpr (ordinalValueDegree_eq_bot_iff.mp hbot)) + have hcDegreeNe : ordinalValueDegree c ≠ ⊥ := fun hbot ↦ + hc (ordinalValue_eq_zero_iff.mpr (ordinalValueDegree_eq_bot_iff.mp hbot)) + let a := (ordinalValueDegree b).unbot hbDegreeNe + let d := (ordinalValueDegree c).unbot hcDegreeNe + have haDegree : ordinalValueDegree b = (a : WithBot NatOrdinal) := + (WithBot.coe_unbot _ hbDegreeNe).symm + have hdDegree : ordinalValueDegree c = (d : WithBot NatOrdinal) := + (WithBot.coe_unbot _ hcDegreeNe).symm + have haValue : ordinalValue b = ω^ a := + (ordinalValueDegree_eq_coe_iff b a).mp haDegree + have hdValue : ordinalValue c = ω^ d := + (ordinalValueDegree_eq_coe_iff c d).mp hdDegree + rw [haValue, hdValue] + apply NatOrdinal.wpow_le_wpow.mpr + rw [← WithBot.coe_le_coe] + exact haDegree.symm.trans_le (h.trans_eq hdDegree) + +private theorem exists_maximal_translatedTruncation [CharZero K] + {b : Series K} (hb : b ≠ 0) : + ∃ x : ℝ, x ≤ 0 ∧ + ∀ y : ℝ, y ≤ 0 → + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) y) ≤ + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) := by + obtain ⟨p, x, r, hp, hbpr, hrSupport, hpDegree, -, hrStrict⟩ := + HahnSeries.exists_principal_head_decomposition hb + have hx : x ≤ 0 := principalHeadExponent_nonpositive hbpr hp + let k := (r : K⟦ℝ⟧).coeff x + have hgerm : translatedTruncation (b : K⟦ℝ⟧) x = + p + HahnSeries.Nonpositive.C k := by + rw [← translatedTruncation_translate_self p x, + ← translatedTruncation_eq_C_of_support_subset_Ici r x hrSupport, + ← translatedTruncation_add, hbpr] + have hpDegreeNe : (p : K⟦ℝ⟧).degree ≠ ⊥ := by + intro hbot + exact hp.ne_zero (Subtype.ext (HahnSeries.degree_eq_bot.mp hbot)) + let a := (p : K⟦ℝ⟧).degree.unbot hpDegreeNe + have hpDegree' : (p : K⟦ℝ⟧).degree = + (a : WithBot NatOrdinal) := (WithBot.coe_unbot _ hpDegreeNe).symm + have hpValue : ordinalValue p = ω^ a := + ordinalValue_eq_wpow_of_isPrincipal hp hpDegree' + have hgermValue : ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) = ω^ a := by + rcases eq_or_ne a 0 with ha | ha + · have hpDegreeZero : (p : K⟦ℝ⟧).degree = 0 := by simpa [ha] using hpDegree' + have hrStrict' := hrStrict (hpDegree.symm.trans hpDegreeZero) + have hk : k = 0 := by + apply not_ne_iff.mp + rw [← HahnSeries.mem_support] + exact fun hmem ↦ (lt_irrefl x) (hrStrict' hmem) + simpa [ha, hgerm, hk] using hpValue + · have haPos : 0 < a := bot_lt_iff_ne_bot.mpr ha + have hconstant : ordinalValue (HahnSeries.Nonpositive.C k : Series K) ≤ 1 := by + by_cases hk : k = 0 + · simp [hk] + · rw [ordinalValue_C_of_ne hk] + rw [hgerm, ordinalValue_add_eq_left_of_lt] + · exact hpValue + · rw [hpValue] + exact hconstant.trans_lt (by + simpa using NatOrdinal.wpow_lt_wpow.mpr haPos) + refine ⟨x, hx, fun y _ ↦ ordinalValue_le_of_ordinalValueDegree_le ?_⟩ + calc + ordinalValueDegree (translatedTruncation (b : K⟦ℝ⟧) y) ≤ + (b : K⟦ℝ⟧).degree := + ordinalValueDegree_translatedTruncation_le_degree (b : K⟦ℝ⟧) y + _ = (p : K⟦ℝ⟧).degree := hpDegree.symm + _ = ordinalValueDegree (translatedTruncation (b : K⟦ℝ⟧) x) := + hpDegree'.trans + ((ordinalValueDegree_eq_coe_iff _ a).mpr hgermValue).symm + +/-- Berarducci, Lemma 10.1 and Definition 10.2: every nonzero nonpositive real Hahn series has +a critical point. -/ +theorem exists_isCriticalPoint [CharZero K] {b : Series K} (hb : b ≠ 0) : + ∃ x : ℝ, IsCriticalPoint b x := by + obtain ⟨x, hx0, hxMax⟩ := exists_maximal_translatedTruncation hb + let M : Set ℝ := {y | y ≤ 0 ∧ + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) y) = + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x)} + have hxM : x ∈ M := ⟨hx0, rfl⟩ + have hxValue : ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) ≠ 0 := by + have hsupport : (b : K⟦ℝ⟧).support.Nonempty := + HahnSeries.support_nonempty_iff.mpr (by simpa using hb) + obtain ⟨y, hy⟩ := hsupport + exact ne_of_gt ((ordinalValue_translatedTruncation_pos_of_mem_support hy).trans_le + (hxMax y (HahnSeries.Nonpositive.support_subset b hy))) + have hMsub : M ⊆ closure (b : K⟦ℝ⟧).support := by + intro y hy + by_contra hclosure + have hyJ := translatedTruncation_mem_negativeMonomialIdeal_of_not_mem_closure_support hclosure + have hyZero := ordinalValue_of_mem_negativeMonomialIdeal hyJ + exact hxValue (hy.2.symm.trans hyZero) + let hMPWO : M.IsPWO := + (Set.isPWO_closure (b : K⟦ℝ⟧).isPWO_support).mono hMsub + obtain ⟨z, hzMinimal⟩ := hMPWO.exists_minimal ⟨x, hxM⟩ + have hzM : z ∈ M := hzMinimal.1 + refine ⟨z, isCriticalPoint_iff.mpr ⟨hb, hzM.1, ?_, ?_⟩⟩ + · intro y hy + exact (hxMax y hy).trans_eq hzM.2.symm + · intro y hy hvalue + have hyM : y ∈ M := ⟨hy, hvalue.trans hzM.2⟩ + exact le_of_not_gt fun hyz ↦ + (minimal_iff_forall_lt.mp hzMinimal).2 hyz hyM + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/FormalExpression.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/FormalExpression.lean new file mode 100644 index 0000000000..b7df093b33 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/FormalExpression.lean @@ -0,0 +1,237 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalValue +public import Mathlib.SetTheory.Cardinal.Order + +import Mathlib.Data.Multiset.DershowitzManna + +/-! +# Formal expressions and their complexity + +Berarducci, Definitions 9.1 and 9.3. A formal expression is a finite multiset of series of ordinal +value above one; its evaluation is the product of its factors. The selected factor has minimal +principal value, maximal ordinal value among those, and is least for a fixed well order; that rule +determines it uniquely. The relevant factors are those whose ordinal value is at least the selected +factor's, and the complexity records their values together with the multiplicity of the selected +factor. + +The source writes the complexity as the ordinal `ω * [α₀, …, α_m] + k`, where +`[α₀, …, α_m] = ω ^ α₀ ⊕ ⋯ ⊕ ω ^ α_m` is chosen so that it decreases when any +`αᵢ` is replaced by finitely many strictly smaller ordinals. That last property is exactly +Mathlib's Dershowitz–Manna relation on multisets, so the complexity is kept as a pair consisting +of a multiset and a natural number, ordered lexicographically. It carries the same information +and inherits well-foundedness from Mathlib, with no ordinal to construct. +-/ + +universe v + +public noncomputable section + +open HahnSeries Ordinal + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- Berarducci, Definition 9.1: a formal expression is a finite multiset of series of ordinal +value above one. -/ +abbrev FormalExpression (K : Type v) [Field K] := Multiset (SeriesWithOrdinalValueAboveOne K) + +namespace FormalExpression + +/-- The product of the factors of a formal expression. -/ +def eval (w : FormalExpression K) : Series K := (w.map (·.1)).prod + +theorem eval_eq (w : FormalExpression K) : eval w = (w.map (·.1)).prod := (rfl) + +theorem eval_zero : (0 : FormalExpression K).eval = 1 := (rfl) + +theorem eval_cons (x : SeriesWithOrdinalValueAboveOne K) (w : FormalExpression K) : + eval (x ::ₘ w) = x.1 * eval w := by + rw [eval, eval, Multiset.map_cons, Multiset.prod_cons] + +/-- Berarducci, Definition 9.3: `x` is the selected factor of `w`. Among the factors of minimal +principal value it has maximal ordinal value, and ties are broken by a fixed well order. -/ +structure IsSelected (w : FormalExpression K) (x : SeriesWithOrdinalValueAboveOne K) : Prop where + mem : x ∈ w + min_principalValue : ∀ y ∈ w, x.principalValue ≤ y.principalValue + max_ordinalValue : ∀ y ∈ w, y.principalValue = x.principalValue → + ordinalValue y.1 ≤ ordinalValue x.1 + least : ∀ y ∈ w, y.principalValue = x.principalValue → ordinalValue y.1 = ordinalValue x.1 → + ¬ WellOrderingRel y x + +theorem existsUnique_isSelected {w : FormalExpression K} (hw : w ≠ 0) : + ∃! x, IsSelected w x := by + classical + have hne : w.toFinset.Nonempty := by + rw [Finset.nonempty_iff_ne_empty] + intro h + exact hw (Multiset.toFinset_eq_empty.mp h) + obtain ⟨x₀, hx₀, hx₀min⟩ := + w.toFinset.exists_min_image (fun y ↦ y.principalValue) hne + set A := w.toFinset.filter fun y ↦ y.principalValue = x₀.principalValue with hAdef + have hAne : A.Nonempty := ⟨x₀, by simp [hAdef, hx₀]⟩ + obtain ⟨x₁, hx₁, hx₁max⟩ := A.exists_max_image (fun y ↦ ordinalValue y.1) hAne + set B := A.filter fun y ↦ ordinalValue y.1 = ordinalValue x₁.1 with hBdef + have hBne : (↑B : Set (SeriesWithOrdinalValueAboveOne K)).Nonempty := + ⟨x₁, by simp [hBdef, hx₁]⟩ + have hwf : WellFounded (WellOrderingRel (α := SeriesWithOrdinalValueAboveOne K)) := + (WellOrderingRel.isWellOrder (α := SeriesWithOrdinalValueAboveOne K)).wf + set x := hwf.min _ hBne with hxdef + have hxB : x ∈ B := hwf.min_mem _ hBne + have hxA : x ∈ A := (Finset.mem_filter.mp hxB).1 + have hxw : x ∈ w := Multiset.mem_toFinset.mp (Finset.mem_filter.mp hxA).1 + have hxprin : x.principalValue = x₀.principalValue := (Finset.mem_filter.mp hxA).2 + have hxord : ordinalValue x.1 = ordinalValue x₁.1 := (Finset.mem_filter.mp hxB).2 + refine ⟨x, ⟨hxw, ?_, ?_, ?_⟩, ?_⟩ + · intro y hy + rw [hxprin] + exact hx₀min y (Multiset.mem_toFinset.mpr hy) + · intro y hy hyprin + rw [hxord] + refine hx₁max y ?_ + simp only [hAdef, Finset.mem_filter, Multiset.mem_toFinset] + exact ⟨hy, hyprin.trans hxprin⟩ + · intro y hy hyprin hyord + have hyB : y ∈ (↑B : Set (SeriesWithOrdinalValueAboveOne K)) := by + simp only [hBdef, hAdef, Finset.mem_coe, Finset.mem_filter, Multiset.mem_toFinset] + exact ⟨⟨hy, hyprin.trans hxprin⟩, hyord.trans hxord⟩ + exact hwf.not_lt_min _ hyB + · rintro y hy + have hsel : IsSelected w x := by + refine ⟨hxw, ?_, ?_, ?_⟩ + · intro z hz + rw [hxprin] + exact hx₀min z (Multiset.mem_toFinset.mpr hz) + · intro z hz hzprin + rw [hxord] + refine hx₁max z ?_ + simp only [hAdef, Finset.mem_filter, Multiset.mem_toFinset] + exact ⟨hz, hzprin.trans hxprin⟩ + · intro z hz hzprin hzord + have hzB : z ∈ (↑B : Set (SeriesWithOrdinalValueAboveOne K)) := by + simp only [hBdef, hAdef, Finset.mem_coe, Finset.mem_filter, Multiset.mem_toFinset] + exact ⟨⟨hz, hzprin.trans hxprin⟩, hzord.trans hxord⟩ + exact hwf.not_lt_min _ hzB + have hprin : y.principalValue = x.principalValue := + le_antisymm (hy.min_principalValue x hxw) (hsel.min_principalValue y hy.mem) + have hord : ordinalValue y.1 = ordinalValue x.1 := + le_antisymm (hsel.max_ordinalValue y hy.mem hprin) (hy.max_ordinalValue x hxw hprin.symm) + rcases trichotomous_of + (WellOrderingRel : SeriesWithOrdinalValueAboveOne K → _ → Prop) y x with h | h | h + · exact absurd h (hsel.least y hy.mem hprin hord) + · exact h + · exact absurd h (hy.least x hxw hprin.symm hord.symm) + +/-- The selected factor of a nonempty formal expression. -/ +noncomputable def selected (w : FormalExpression K) (hw : w ≠ 0) : + SeriesWithOrdinalValueAboveOne K := + (existsUnique_isSelected hw).choose + +theorem isSelected_selected (w : FormalExpression K) (hw : w ≠ 0) : + IsSelected w (selected w hw) := + (existsUnique_isSelected hw).choose_spec.1 + +theorem eq_selected_of_isSelected {w : FormalExpression K} (hw : w ≠ 0) + {x : SeriesWithOrdinalValueAboveOne K} (hx : IsSelected w x) : x = selected w hw := + (existsUnique_isSelected hw).choose_spec.2 x hx + +/-- A one-factor expression selects that factor. -/ +theorem selected_singleton (x : SeriesWithOrdinalValueAboveOne K) : + selected {x} (by simp) = x := by + refine (eq_selected_of_isSelected (by simp) ⟨by simp, ?_, ?_, ?_⟩).symm + · intro y hy + rw [Multiset.mem_singleton.mp hy] + · intro y hy _ + rw [Multiset.mem_singleton.mp hy] + · intro y hy _ _ + rw [Multiset.mem_singleton.mp hy] + exact irrefl_of (WellOrderingRel : SeriesWithOrdinalValueAboveOne K → _ → Prop) x + +open Classical in +/-- Berarducci, Definition 9.3: the selected exponent is the multiplicity of the selected +factor. -/ +noncomputable def selectedExponent (w : FormalExpression K) (hw : w ≠ 0) : ℕ := + w.count (selected w hw) + +/-- Adjoining another copy of a factor already present does not change the selected factor. -/ +theorem selected_cons_of_mem {w : FormalExpression K} (hw : w ≠ 0) + {y : SeriesWithOrdinalValueAboveOne K} (hy : y ∈ w) : + selected (y ::ₘ w) Multiset.cons_ne_zero = selected w hw := by + have hmem : ∀ z ∈ y ::ₘ w, z ∈ w := + fun z hz ↦ (Multiset.mem_cons.mp hz).elim (fun h ↦ h ▸ hy) id + have hsel := isSelected_selected w hw + refine (eq_selected_of_isSelected Multiset.cons_ne_zero ⟨Multiset.mem_cons_of_mem hsel.mem, + fun z hz ↦ hsel.min_principalValue z (hmem z hz), + fun z hz ↦ hsel.max_ordinalValue z (hmem z hz), + fun z hz ↦ hsel.least z (hmem z hz)⟩).symm + +open Classical in +theorem selectedExponent_eq_count (w : FormalExpression K) (hw : w ≠ 0) : + selectedExponent w hw = w.count (selected w hw) := (rfl) + +open Classical in +/-- Berarducci, Definition 9.3: the ordinal values of the relevant factors, namely those whose +ordinal value is at least that of the selected factor. The source indexes these by the distinct +factors, so multiplicities are discarded. -/ +noncomputable def relevantValues (w : FormalExpression K) (hw : w ≠ 0) : Multiset Ordinal := + (w.toFinset.filter fun y ↦ ordinalValue (selected w hw).1 ≤ ordinalValue y.1).val.map + fun y ↦ (ordinalValue y.1).val + +open Classical in +theorem relevantValues_eq_map (w : FormalExpression K) (hw : w ≠ 0) : + relevantValues w hw = (w.toFinset.filter fun y ↦ + ordinalValue (selected w hw).1 ≤ ordinalValue y.1).val.map fun y ↦ (ordinalValue y.1).val := + (rfl) + +open Classical in +/-- The relevant values see only the selected factor and which factors of value at least its own +are present, so duplicating or deleting other factors does not change them. -/ +theorem relevantValues_congr {w w' : FormalExpression K} (hw : w ≠ 0) (hw' : w' ≠ 0) + (hsel : selected w hw = selected w' hw') + (hmem : ∀ y, ordinalValue (selected w hw).1 ≤ ordinalValue y.1 → (y ∈ w ↔ y ∈ w')) : + relevantValues w hw = relevantValues w' hw' := by + have hfilter : (w.toFinset.filter fun y ↦ ordinalValue (selected w hw).1 ≤ ordinalValue y.1) + = w'.toFinset.filter fun y ↦ ordinalValue (selected w hw).1 ≤ ordinalValue y.1 := by + ext y + simp only [Finset.mem_filter, Multiset.mem_toFinset] + exact and_congr_left fun h ↦ hmem y h + rw [relevantValues, relevantValues, ← hsel, hfilter] + +/-- Berarducci, Definition 9.3: the complexity of a formal expression, as the pair of the multiset +of relevant-factor values and the selected exponent. -/ +noncomputable def complexity (w : FormalExpression K) (hw : w ≠ 0) : Multiset Ordinal × ℕ := + (relevantValues w hw, selectedExponent w hw) + +/-- The complexity order: the Dershowitz–Manna order on the relevant values, refined by the +selected exponent. This is the order of Berarducci, Definition 9.2. -/ +def ComplexityLT : (Multiset Ordinal × ℕ) → (Multiset Ordinal × ℕ) → Prop := + Prod.Lex Multiset.IsDershowitzMannaLT (· < ·) + +theorem wellFounded_complexityLT : WellFounded (ComplexityLT) := + WellFounded.prod_lex Multiset.wellFounded_isDershowitzMannaLT wellFounded_lt + +/-- A Dershowitz–Manna step on the relevant values, presented by its witnesses: the values of `w'` +are those of `w` with the nonempty part `Z` replaced by members of `Y`, each below some member of +`Z`. -/ +theorem complexityLT_of_relevantValues {w w' : FormalExpression K} {hw : w ≠ 0} {hw' : w' ≠ 0} + {X Y Z : Multiset Ordinal} (hZ : Z ≠ 0) (hw'X : relevantValues w' hw' = X + Y) + (hwX : relevantValues w hw = X + Z) (hYZ : ∀ y ∈ Y, ∃ z ∈ Z, y < z) : + ComplexityLT (complexity w' hw') (complexity w hw) := + Prod.Lex.left _ _ ⟨X, Y, Z, hZ, hw'X, hwX, hYZ⟩ + +theorem complexityLT_of_selectedExponent {w w' : FormalExpression K} {hw : w ≠ 0} {hw' : w' ≠ 0} + (h₁ : relevantValues w' hw' = relevantValues w hw) + (h₂ : selectedExponent w' hw' < selectedExponent w hw) : + ComplexityLT (complexity w' hw') (complexity w hw) := by + rw [complexity, complexity, h₁] + exact Prod.Lex.right _ h₂ + +end FormalExpression + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Germ.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Germ.lean new file mode 100644 index 0000000000..79d71f7d2d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Germ.lean @@ -0,0 +1,226 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NegativeMonomialIdeal +public import Mathlib.RingTheory.Ideal.Quotient.Defs + +import Mathlib.Algebra.Group.Subgroup.Lattice + +/-! +# Berarducci germs of nonpositive real Hahn series + +For a field `K`, `Berarducci.Series K` is the ring `K((ℝ⁽≤0⁾))`, and +`Berarducci.Germ K` is its quotient by the ideal `J` generated by the monomials `t^x` for +`x < 0`. This is Berarducci, Definition 5.1. The additive subgroup +`Berarducci.nearConstantSubgroup K` is the subgroup denoted by `J + K` in Berarducci, +Definition 5.2 and LM24, Section 2.7. It is deliberately an `AddSubgroup`, not an ideal. + +The quotient equality certificate proves that two series determine the same germ exactly when +their coefficients agree on an interval `(η, 0]`. The endpoint zero is included: a discrepancy at +zero is a nonzero constant and therefore does not belong to `J`. + +These quotient and subgroup definitions make sense over any field. Results imported from +Berarducci that use characteristic zero will retain that hypothesis in their theorem signatures. +-/ + +universe v + +public noncomputable section + +namespace Berarducci + +open HahnSeries + +variable {K : Type v} [Field K] + +/-- Every element of the negative-monomial ideal has zero constant coefficient. -/ +theorem constantCoeff_eq_zero_of_mem_negativeMonomialIdeal + {b : HahnSeries.Nonpositive ℝ K} + (hb : b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K) : + HahnSeries.Nonpositive.constantCoeff b = 0 := by + have hsup := + HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero.mp hb + by_contra hcoeff + have hbZero : b ≠ 0 := by + intro hb + subst b + simp at hcoeff + have hzeroSupport : 0 ∈ (b : K⟦ℝ⟧).support := by + rw [HahnSeries.mem_support] + simpa [HahnSeries.Nonpositive.constantCoeff_apply] using hcoeff + rw [HahnSeries.Nonpositive.supportSup_of_ne hbZero] at hsup + apply (not_lt_of_ge _ hsup) + exact WithBot.coe_le_coe.mpr + (le_csSup (HahnSeries.Nonpositive.bddAbove_support b) hzeroSupport) + +/-- Berarducci's ring `K((ℝ⁽≤0⁾))` of nonpositive real Hahn series. -/ +abbrev Series (K : Type v) [Field K] := HahnSeries.Nonpositive ℝ K + +/-- Berarducci's ring of germs `K((ℝ⁽≤0⁾)) / J`. -/ +abbrev Germ (K : Type v) [Field K] := + Series K ⧸ HahnSeries.Nonpositive.negativeMonomialIdeal K + +/-- The quotient map from nonpositive series to Berarducci germs. -/ +def toGerm : Series K →+* Germ K := + Ideal.Quotient.mk (HahnSeries.Nonpositive.negativeMonomialIdeal K) + +/-- Evaluating the germ quotient map is Mathlib's ideal-quotient constructor. -/ +@[simp] +theorem toGerm_apply (b : Series K) : + toGerm b = Ideal.Quotient.mk + (HahnSeries.Nonpositive.negativeMonomialIdeal K) b := + (rfl) + +/-- The additive subgroup of constant series in `Berarducci.Series K`. -/ +def constantSubgroup (K : Type v) [Field K] : AddSubgroup (Series K) := + HahnSeries.Nonpositive.C.toAddMonoidHom.range + +/-- Berarducci's additive subgroup `J + K` of series equal to a constant modulo `J`. -/ +def nearConstantSubgroup (K : Type v) [Field K] : AddSubgroup (Series K) := + (HahnSeries.Nonpositive.negativeMonomialIdeal K).toAddSubgroup ⊔ constantSubgroup K + +/-- Membership in the constant subgroup means equality to a constant Hahn series. -/ +theorem mem_constantSubgroup_iff {b : Series K} : + b ∈ constantSubgroup K ↔ ∃ k : K, HahnSeries.Nonpositive.C k = b := + AddMonoidHom.mem_range + +/-- Membership in `J + K` means being a sum of an element of `J` and a constant series. -/ +theorem mem_nearConstantSubgroup_iff {b : Series K} : + b ∈ nearConstantSubgroup K ↔ + ∃ j ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K, + ∃ k : K, j + HahnSeries.Nonpositive.C k = b := by + rw [nearConstantSubgroup, AddSubgroup.mem_sup] + constructor + · rintro ⟨j, hj, c, hc, rfl⟩ + rw [mem_constantSubgroup_iff] at hc + obtain ⟨k, rfl⟩ := hc + exact ⟨j, hj, k, rfl⟩ + · rintro ⟨j, hj, k, rfl⟩ + exact ⟨j, hj, HahnSeries.Nonpositive.C k, + mem_constantSubgroup_iff.mpr ⟨k, rfl⟩, rfl⟩ + +/-- Two series have the same germ exactly when their difference belongs to `J`. -/ +theorem toGerm_eq_toGerm_iff {b c : Series K} : + toGerm b = toGerm c ↔ + b - c ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K := + Ideal.Quotient.eq + +/-- Two nonpositive series define the same germ exactly when their coefficients agree on some +interval immediately below zero, including the right endpoint. -/ +theorem toGerm_eq_toGerm_iff_exists_coeff_eq {b c : Series K} : + toGerm b = toGerm c ↔ + ∃ η < (0 : ℝ), ∀ δ : ℝ, η < δ → δ ≤ 0 → + (b : K⟦ℝ⟧).coeff δ = (c : K⟦ℝ⟧).coeff δ := by + rw [toGerm_eq_toGerm_iff] + constructor + · intro hbc + have hsup := + HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero.mp hbc + by_cases hd : b - c = 0 + · have hbcEq : b = c := sub_eq_zero.mp hd + exact ⟨-1, by norm_num, fun _ _ _ ↦ by rw [hbcEq]⟩ + · have hsupReal : sSup ((b - c : Series K) : K⟦ℝ⟧).support < 0 := by + rw [HahnSeries.Nonpositive.supportSup_of_ne hd] at hsup + exact WithBot.coe_lt_coe.mp hsup + refine ⟨sSup ((b - c : Series K) : K⟦ℝ⟧).support, hsupReal, + fun δ hδ _ ↦ ?_⟩ + have hnotSupport : δ ∉ ((b - c : Series K) : K⟦ℝ⟧).support := by + intro hδSupport + have hle := le_csSup + (HahnSeries.Nonpositive.bddAbove_support (b - c)) hδSupport + exact (not_lt_of_ge hle) hδ + have hcoeff : (((b - c : Series K) : K⟦ℝ⟧).coeff δ) = 0 := by + rw [← not_ne_iff, ← HahnSeries.mem_support] + exact hnotSupport + simpa using sub_eq_zero.mp hcoeff + · rintro ⟨η, hη, hcoeff⟩ + rw [HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero] + by_cases hd : b - c = 0 + · simp [hd] + · rw [HahnSeries.Nonpositive.supportSup_of_ne hd] + apply WithBot.coe_lt_coe.mpr + refine (csSup_le ?_ ?_).trans_lt hη + · have hd' : (((b - c : Series K) : K⟦ℝ⟧)) ≠ 0 := by + intro h + exact hd (Subtype.ext h) + exact HahnSeries.support_nonempty_iff.mpr hd' + · intro δ hδSupport + apply le_of_not_gt + intro hηδ + have hδ0 := HahnSeries.Nonpositive.support_subset (b - c) hδSupport + have heq := hcoeff δ hηδ hδ0 + have hzero : (((b - c : Series K) : K⟦ℝ⟧).coeff δ) = 0 := by + simpa using sub_eq_zero.mpr heq + exact (HahnSeries.mem_support _ _).mp hδSupport hzero + +/-- A series belongs to `J + K` exactly when subtracting its own constant coefficient leaves an +element of `J`. -/ +theorem mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem {b : Series K} : + b ∈ nearConstantSubgroup K ↔ + b - HahnSeries.Nonpositive.C (HahnSeries.Nonpositive.constantCoeff b) ∈ + HahnSeries.Nonpositive.negativeMonomialIdeal K := by + constructor + · intro hb + obtain ⟨j, hj, k, hsum⟩ := mem_nearConstantSubgroup_iff.mp hb + have hcoeff : HahnSeries.Nonpositive.constantCoeff b = k := by + rw [← hsum, map_add, + constantCoeff_eq_zero_of_mem_negativeMonomialIdeal hj] + simp + rw [hcoeff, ← hsum, add_sub_cancel_right] + exact hj + · intro hb + apply mem_nearConstantSubgroup_iff.mpr + refine ⟨b - HahnSeries.Nonpositive.C + (HahnSeries.Nonpositive.constantCoeff b), hb, + HahnSeries.Nonpositive.constantCoeff b, ?_⟩ + exact sub_add_cancel _ _ + +/-- A series belongs to `J + K` exactly when its germ is represented by a constant series. -/ +theorem mem_nearConstantSubgroup_iff_exists_germ_eq_constant {b : Series K} : + b ∈ nearConstantSubgroup K ↔ + ∃ k : K, toGerm b = toGerm (HahnSeries.Nonpositive.C k) := by + rw [mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem, ← toGerm_eq_toGerm_iff] + constructor + · exact fun h ↦ ⟨HahnSeries.Nonpositive.constantCoeff b, h⟩ + · rintro ⟨k, hk⟩ + rw [toGerm_eq_toGerm_iff] at hk ⊢ + have hcoeff : HahnSeries.Nonpositive.constantCoeff b = k := by + have hzero := constantCoeff_eq_zero_of_mem_negativeMonomialIdeal hk + have hzero' : HahnSeries.Nonpositive.constantCoeff b - k = 0 := by + simpa using hzero + exact sub_eq_zero.mp hzero' + simpa [hcoeff] using hk + +/-- The negative-monomial ideal, regarded as an additive subgroup, is contained in `J + K`. -/ +theorem negativeMonomialIdeal_le_nearConstantSubgroup : + (HahnSeries.Nonpositive.negativeMonomialIdeal K).toAddSubgroup ≤ + nearConstantSubgroup K := by + intro b hb + apply AddSubgroup.mem_sup.mpr + exact ⟨b, hb, 0, (constantSubgroup K).zero_mem, add_zero b⟩ + +/-- Series congruent modulo `J + K` have equal coefficients on some interval `(η, 0)`. The right +endpoint is excluded: a constant summand changes exactly the coefficient at zero. -/ +theorem exists_coeff_eq_of_sub_mem_nearConstantSubgroup + {b c : Series K} (hbc : b - c ∈ nearConstantSubgroup K) : + ∃ η < (0 : ℝ), ∀ δ : ℝ, η < δ → δ < 0 → + (b : K⟦ℝ⟧).coeff δ = (c : K⟦ℝ⟧).coeff δ := by + have hq := mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem.mp hbc + have hgerm : toGerm + (b - c - HahnSeries.Nonpositive.C + (HahnSeries.Nonpositive.constantCoeff (b - c))) = toGerm 0 := by + rw [toGerm_eq_toGerm_iff] + simpa using hq + obtain ⟨η, hη, hcoeff⟩ := + toGerm_eq_toGerm_iff_exists_coeff_eq.mp hgerm + refine ⟨η, hη, fun δ hηδ hδ ↦ ?_⟩ + have heq := hcoeff δ hηδ hδ.le + have hzero : (b : K⟦ℝ⟧).coeff δ - (c : K⟦ℝ⟧).coeff δ = 0 := by + simpa [hδ.ne] using heq + exact sub_eq_zero.mp hzero + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/GermDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/GermDegree.lean new file mode 100644 index 0000000000..f46909572d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/GermDegree.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation + +/-! +# Degree bounds for translated truncations + +Translated closed truncation at a real exponent does not increase Hahn-series degree. Since +Berarducci's ordinal-value degree is bounded by Hahn-series degree, the same bound holds for the +ordinal-value degree of every translated truncation. +-/ + +open scoped HahnSeries + +universe v + +public noncomputable section + +namespace Berarducci + +open HahnSeries + +variable {K : Type v} [Field K] + +/-- Translated closed truncation does not increase Hahn-series degree. -/ +theorem degree_translatedTruncation_le (b : K⟦ℝ⟧) (γ : ℝ) : + ((translatedTruncation b γ : Series K) : K⟦ℝ⟧).degree ≤ b.degree := by + rw [coe_translatedTruncation, HahnSeries.degree_translate] + exact HahnSeries.degree_truncLE_le γ b + +/-- The ordinal-value degree of a translated closed truncation is bounded by the degree of the +original Hahn series. -/ +theorem ordinalValueDegree_translatedTruncation_le_degree (b : K⟦ℝ⟧) (γ : ℝ) : + ordinalValueDegree (translatedTruncation b γ) ≤ b.degree := + (ordinalValueDegree_le_degree (translatedTruncation b γ)).trans + (degree_translatedTruncation_le b γ) + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/GermValueCut.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/GermValueCut.lean new file mode 100644 index 0000000000..7687cf2260 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/GermValueCut.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval + +/-! +# The eventual value cut for translated truncations + +For a series of ordinal value above one, every sufficiently high translated truncation has +ordinal value at most `v_J^r(b) * α` for some `α < v_J^p(b)`, with ordinary ordinal +multiplication. This is the upper half of Berarducci, Lemma 6.8, in the quantitative form used by +the value estimates of Berarducci, Lemma 7.7 and Lemma 8.2, and it is the statement that lets a +truncation value be absorbed strictly below `v_J(b)`. + +On a stable tail the ordinary order type is exactly `v_J(b) = v_J^r(b) * v_J^p(b)`. Cutting at `γ` +leaves a relative upper set of the support below `γ` whose order type is bounded by that of a +proper initial segment of the tail, hence strictly below `v_J(b)`; continuity of ordinary ordinal +multiplication in its second argument at the successor-limit `v_J^p(b)` then supplies `α`. + +When the support has no point in `(η, γ)` the truncation is a constant modulo `J`, its value is at +most one, and `α = 1` works because the residual value is at least one and the principal value is +above one. +-/ + +universe v + +public noncomputable section + +open HahnSeries + +namespace Berarducci + +variable {K : Type v} [Field K] + +theorem exists_ordinalValue_translatedTruncation_le (b : SeriesWithOrdinalValueAboveOne K) : + ∃ η < (0 : ℝ), ∀ γ : ℝ, η < γ → γ < 0 → + ∃ α < b.principalValue.val, + (ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) γ)).val ≤ b.residualValue.val * α := by + obtain ⟨η, hη, hstable⟩ := + exists_forall_later_negativeSupportTail_orderType_eq_ordinalValue b.1 b.2 + obtain ⟨η', hηη', hη'0⟩ := exists_between hη + have hone : (1 : Ordinal) < b.principalValue.val := by + simpa using NatOrdinal.val.lt_iff_lt.mpr b.one_lt_principalValue + have hρ : (1 : Ordinal) ≤ b.residualValue.val := by + rw [Order.one_le_iff_ne_zero] + intro h + exact b.residualValue_ne_zero (NatOrdinal.val.injective (by simpa using h)) + refine ⟨η', hη'0, fun γ hη'γ hγ ↦ ?_⟩ + by_cases hne : ((b.1 : K⟦ℝ⟧).support ∩ Set.Ioo η' γ).Nonempty + · set C := (b.1 : K⟦ℝ⟧).support ∩ Set.Ioo η' γ with hCdef + have hC : IsRelUpperSet C (· ∈ (b.1 : K⟦ℝ⟧).support ∩ Set.Iio γ) := by + rintro a ⟨haSupport, haLow, haHigh⟩ + refine ⟨⟨haSupport, haHigh⟩, ?_⟩ + rintro d had ⟨hdSupport, hdHigh⟩ + exact ⟨hdSupport, lt_of_lt_of_le haLow had, hdHigh⟩ + have hbound := + ordinalValue_translatedTruncation_le_orderType_of_isRelUpperSet_supportBelow + (b.1 : K⟦ℝ⟧) γ hC hne + have htailLUB := + isLUB_negativeSupportTail_zero_of_one_lt_ordinalValue b.1 b.2 hη'0 + obtain ⟨x, hxTail, hγx, _⟩ := htailLUB.exists_between hγ + have htailPWO : (negativeSupportTail b.1 η').IsPWO := + (b.1 : K⟦ℝ⟧).isPWO_support.mono (negativeSupportTail_subset_support b.1 η') + have hsub : C ⊆ negativeSupportTail b.1 η' ∩ Set.Iio x := by + rintro y ⟨hySupport, hyLow, hyHigh⟩ + exact ⟨mem_negativeSupportTail_iff.mpr ⟨hySupport, hyLow, hyHigh.trans hγ⟩, + hyHigh.trans hγx⟩ + have hlt : ((b.1 : K⟦ℝ⟧).isPWO_support.mono fun _ hx ↦ (hC hx).1.1).orderType < + (ordinalValue b.1).val := by + calc + ((b.1 : K⟦ℝ⟧).isPWO_support.mono fun _ hx ↦ (hC hx).1.1).orderType + ≤ (htailPWO.mono (s := negativeSupportTail b.1 η' ∩ Set.Iio x) + Set.inter_subset_left).orderType := + Set.IsPWO.orderType_mono _ _ hsub + _ < htailPWO.orderType := htailPWO.orderType_inter_Iio_lt hxTail + _ = (ordinalValue b.1).val := hstable η' hηη' hη'0 + rw [← b.residualValue_val_mul_principalValue_val] at hlt + obtain ⟨α, hα, hαlt⟩ := + (Ordinal.lt_mul_iff_of_isSuccLimit + b.principalValue_isInfiniteMultiplicativelyPrincipal.isSuccLimit).mp hlt + exact ⟨α, hα, hbound.trans hαlt.le⟩ + · refine ⟨1, hone, ?_⟩ + rw [mul_one] + rw [Set.not_nonempty_iff_eq_empty] at hne + have hmem : translatedTruncation (b.1 : K⟦ℝ⟧) γ ∈ nearConstantSubgroup K := by + refine mem_nearConstantSubgroup_iff_exists_germ_eq_constant.mpr + ⟨(b.1 : K⟦ℝ⟧).coeff γ, ?_⟩ + refine toGerm_eq_toGerm_iff_exists_coeff_eq.mpr + ⟨η' - γ, by linarith, fun δ hδlow hδ0 ↦ ?_⟩ + rw [coeff_translatedTruncation, if_pos hδ0, HahnSeries.Nonpositive.coe_C] + rcases hδ0.eq_or_lt with rfl | hδneg + · simp + · rw [HahnSeries.C_apply, HahnSeries.coeff_single_of_ne (by linarith : δ ≠ (0 : ℝ))] + by_contra hcoeff + have hmemSupport : γ + δ ∈ (b.1 : K⟦ℝ⟧).support ∩ Set.Ioo η' γ := + ⟨(HahnSeries.mem_support _ _).mpr hcoeff, by linarith, by linarith⟩ + rw [hne] at hmemSupport + exact hmemSupport + have hle : ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) γ) ≤ 1 := + le_of_not_gt fun h ↦ (one_lt_ordinalValue_iff.mp h) hmem + exact (NatOrdinal.val.monotone hle).trans hρ + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Irreducibility.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Irreducibility.lean new file mode 100644 index 0000000000..4d4f5bc0c0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Irreducibility.lean @@ -0,0 +1,336 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrderTypeMultiplicativity + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Monomial +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPrincipal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPointExistence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.MainLemma +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +import Mathlib.Tactic.Linarith +import Mathlib.Tactic.Ring + +/-! +# Irreducibility at multiplicatively principal support order types + +Berarducci, Theorem 10.5 proves that a nonpositive real Hahn series with support order type `ω` +or `ω ^ (ω ^ β)` is irreducible, as is its sum with one, provided no strictly negative monomial +divides it. + +The proof combines multiplicativity of the ordinal value with critical points. In a nontrivial +factorisation, multiplicative principality forces one factor to have ordinal value one. The two +critical points must sum to zero because every strictly negative translated truncation has smaller +ordinal value. But a nonunit of ordinal value one has a strictly negative critical point, giving a +contradiction. + +## References + +* A. Berarducci, *Factorization in generalized power series*, Trans. Amer. Math. Soc. 352 + (2000), 553–577, cited as [Ber00]. +-/ + +universe v + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace Berarducci + +open HahnSeries Ordinal + +variable {K : Type v} [Field K] + +private theorem not_mem_negativeMonomialIdeal_of_no_negativeMonomial_dvd + {a : Series K} + (ha : ∀ (gamma : ℝ) (hgamma : gamma < 0), + ¬HahnSeries.Nonpositive.single gamma (1 : K) hgamma.le ∣ a) : + a ∉ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + intro haJ + have hsup := + HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero.mp haJ + by_cases haZero : a = 0 + · have hneg : (-1 : ℝ) < 0 := by norm_num + apply ha (-1) hneg + refine ⟨0, ?_⟩ + simp [haZero] + · rw [HahnSeries.Nonpositive.supportSup_of_ne haZero] at hsup + have hsupReal : sSup (a : K⟦ℝ⟧).support < 0 := WithBot.coe_lt_coe.mp hsup + apply ha (sSup (a : K⟦ℝ⟧).support) hsupReal + refine ⟨HahnSeries.Nonpositive.normalize a, ?_⟩ + apply Subtype.ext + simpa only [Subring.coe_mul, HahnSeries.Nonpositive.coe_single, + HahnSeries.single_one_mul_eq_translate] using + (HahnSeries.Nonpositive.translate_csSup_normalize a).symm + +private theorem ordinalValue_eq_one_of_isUnit {b : Series K} (hb : IsUnit b) : + ordinalValue b = 1 := by + have hbConstant := HahnSeries.Nonpositive.eq_C_constantCoeff_of_isUnit hb + have hcoeff : HahnSeries.Nonpositive.constantCoeff b ≠ 0 := by + intro hzero + have hbZero : b = 0 := by simpa [hzero] using hbConstant + exact hb.ne_zero hbZero + rw [hbConstant, ordinalValue_C_of_ne hcoeff] + +private theorem exists_negative_support_of_ordinalValue_eq_one_of_not_isUnit + {b : Series K} (hbValue : ordinalValue b = 1) (hbUnit : ¬IsUnit b) : + ∃ gamma ∈ (b : K⟦ℝ⟧).support, gamma < 0 := by + have hbNear := (ordinalValue_eq_one_iff.mp hbValue).1 + have hbJ := (ordinalValue_eq_one_iff.mp hbValue).2 + have hbCoeff : HahnSeries.Nonpositive.constantCoeff b ≠ 0 := by + intro hzero + apply hbJ + have hsub := mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem.mp hbNear + simpa [hzero] using hsub + have hzeroSupport : (0 : ℝ) ∈ (b : K⟦ℝ⟧).support := by + rw [HahnSeries.mem_support, ← HahnSeries.Nonpositive.constantCoeff_apply] + exact hbCoeff + by_contra hnegative + have hsupport : (b : K⟦ℝ⟧).support = {0} := by + apply Set.Subset.antisymm + · intro gamma hgamma + rw [Set.mem_singleton_iff] + have hnonpositive := HahnSeries.Nonpositive.support_subset b hgamma + exact le_antisymm hnonpositive (le_of_not_gt fun hgammaNeg ↦ + hnegative ⟨gamma, hgamma, hgammaNeg⟩) + · exact Set.singleton_subset_iff.mpr hzeroSupport + apply hbUnit + have hbConstant : b = HahnSeries.Nonpositive.C + (HahnSeries.Nonpositive.constantCoeff b) := by + apply Subtype.ext + apply HahnSeries.coeff_injective + funext gamma + by_cases hgamma : gamma = 0 + · subst gamma + simp [HahnSeries.Nonpositive.constantCoeff_apply] + · have hgammaSupport : gamma ∉ (b : K⟦ℝ⟧).support := by + rw [hsupport] + simpa using hgamma + rw [HahnSeries.mem_support, not_ne_iff] at hgammaSupport + simp [hgamma, hgammaSupport] + rw [hbConstant] + exact (isUnit_iff_ne_zero.mpr hbCoeff).map HahnSeries.Nonpositive.C + +private theorem criticalPoint_lt_zero_of_ordinalValue_eq_one_of_not_isUnit + {b : Series K} {x : ℝ} (hbValue : ordinalValue b = 1) + (hbUnit : ¬IsUnit b) (hx : IsCriticalPoint b x) : x < 0 := by + obtain ⟨gamma, hgammaSupport, hgamma⟩ := + exists_negative_support_of_ordinalValue_eq_one_of_not_isUnit hbValue hbUnit + apply lt_of_le_of_ne hx.nonpositive + intro hxZero + have hxValue : ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) = 1 := by + rw [hxZero, translatedTruncation_zero, hbValue] + have hgammaPos : 0 < ordinalValue (translatedTruncation (b : K⟦ℝ⟧) gamma) := + ordinalValue_translatedTruncation_pos_of_mem_support hgammaSupport + have hgammaValue : ordinalValue (translatedTruncation (b : K⟦ℝ⟧) gamma) = 1 := by + apply le_antisymm + · exact (hx.value_le gamma hgamma.le).trans_eq hxValue + · exact Order.one_le_iff_pos.mpr hgammaPos + have hxLeGamma := hx.le_of_value_eq gamma hgamma.le (hgammaValue.trans hxValue.symm) + exact (not_le_of_gt hgamma) (hxZero ▸ hxLeGamma) + +private theorem factor_ordinalValue_eq_one_of_mul_eq_infiniteMultiplicativelyPrincipal + {b c rho : NatOrdinal} + (hrho : Ordinal.IsInfiniteMultiplicativelyPrincipal rho.val) + (hmul : b * c = rho) : b = 1 ∨ c = 1 := by + have hrhoPos : 0 < rho := by + rw [← NatOrdinal.val.lt_iff_lt] + exact hrho.isSuccLimit.bot_lt + have hbNe : b ≠ 0 := by + intro hb + rw [hb, zero_mul] at hmul + exact hrhoPos.ne' hmul.symm + have hcNe : c ≠ 0 := by + intro hc + rw [hc, mul_zero] at hmul + exact hrhoPos.ne' hmul.symm + by_cases hb : b = 1 + · exact Or.inl hb + by_cases hc : c = 1 + · exact Or.inr hc + exfalso + have hbOne : 1 < b := lt_of_le_of_ne (Order.one_le_iff_pos.mpr (pos_iff_ne_zero.mpr hbNe)) + (Ne.symm hb) + have hcOne : 1 < c := lt_of_le_of_ne (Order.one_le_iff_pos.mpr (pos_iff_ne_zero.mpr hcNe)) + (Ne.symm hc) + have hbLt : b < rho := by + rw [← hmul] + simpa only [mul_one] using mul_lt_mul_of_pos_left hcOne (pos_iff_ne_zero.mpr hbNe) + have hcLt : c < rho := by + rw [← hmul] + simpa only [one_mul] using mul_lt_mul_of_pos_right hbOne (pos_iff_ne_zero.mpr hcNe) + have hlt := NatOrdinal.mul_lt_of_isMultiplicativelyPrincipal + (Ordinal.isInfiniteMultiplicativelyPrincipal_iff_two_lt_and_isMultiplicativelyPrincipal.mp + hrho).2 hbLt hcLt + rw [hmul] at hlt + exact (lt_irrefl _) hlt + +private theorem irreducible_of_infiniteMultiplicativelyPrincipal_ordinalValue + [CharZero K] {a : Series K} + (haPrincipal : Ordinal.IsInfiniteMultiplicativelyPrincipal (ordinalValue a).val) + (haNegative : ∀ u : ℝ, u < 0 → + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) u) < ordinalValue a) : + Irreducible a := by + have haOne : 1 < ordinalValue a := by + rw [← NatOrdinal.val.lt_iff_lt] + exact (show (1 : Ordinal) < 2 by norm_num).trans + (Ordinal.isInfiniteMultiplicativelyPrincipal_iff_two_lt_and_isMultiplicativelyPrincipal.mp + haPrincipal).1 + rw [irreducible_iff] + refine ⟨fun haUnit ↦ haOne.ne' (ordinalValue_eq_one_of_isUnit haUnit), ?_⟩ + intro b c habc + by_cases hbUnit : IsUnit b + · exact Or.inl hbUnit + by_cases hcUnit : IsUnit c + · exact Or.inr hcUnit + exfalso + have hmul : ordinalValue b * ordinalValue c = ordinalValue a := by + rw [← ordinalValue_mul, ← habc] + have hfactor := + factor_ordinalValue_eq_one_of_mul_eq_infiniteMultiplicativelyPrincipal haPrincipal hmul + have haNe : a ≠ 0 := by + intro haZero + rw [haZero, ordinalValue_zero] at haOne + exact (not_lt_of_ge zero_le_one) haOne + have hbNe : b ≠ 0 := by + intro hbZero + apply haNe + rw [habc, hbZero, zero_mul] + have hcNe : c ≠ 0 := by + intro hcZero + apply haNe + rw [habc, hcZero, mul_zero] + obtain ⟨x, hx⟩ := exists_isCriticalPoint hbNe + obtain ⟨y, hy⟩ := exists_isCriticalPoint hcNe + have hbLe : ordinalValue b ≤ ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) := by + simpa using hx.value_le 0 le_rfl + have hcLe : ordinalValue c ≤ ordinalValue (translatedTruncation (c : K⟦ℝ⟧) y) := by + simpa using hy.value_le 0 le_rfl + have hcriticalLower : ordinalValue a ≤ + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) (x + y)) := by + calc + ordinalValue a = ordinalValue b * ordinalValue c := hmul.symm + _ ≤ ordinalValue (translatedTruncation (b : K⟦ℝ⟧) x) * + ordinalValue (translatedTruncation (c : K⟦ℝ⟧) y) := + mul_le_mul hbLe hcLe bot_le bot_le + _ = ordinalValue (translatedTruncation (((b * c : Series K) : K⟦ℝ⟧)) (x + y)) := + (criticalPoint_product_value hx hy).symm + _ = ordinalValue (translatedTruncation (a : K⟦ℝ⟧) (x + y)) := by rw [habc] + have hsum : x + y = 0 := by + apply le_antisymm (add_nonpos hx.nonpositive hy.nonpositive) + apply le_of_not_gt + intro hnegative + exact (not_lt_of_ge hcriticalLower) (haNegative (x + y) hnegative) + rcases hfactor with hbValue | hcValue + · have hxNegative := + criticalPoint_lt_zero_of_ordinalValue_eq_one_of_not_isUnit hbValue hbUnit hx + linarith [hy.nonpositive] + · have hyNegative := + criticalPoint_lt_zero_of_ordinalValue_eq_one_of_not_isUnit hcValue hcUnit hy + linarith [hx.nonpositive] + +private theorem translatedTruncation_one_eq_zero_of_neg {u : ℝ} (hu : u < 0) : + translatedTruncation (1 : K⟦ℝ⟧) u = 0 := by + apply Subtype.ext + apply HahnSeries.coeff_injective + funext delta + rw [coeff_translatedTruncation] + by_cases hdelta : delta ≤ 0 + · rw [if_pos hdelta] + have hsum : u + delta ≠ 0 := ne_of_lt (add_neg_of_neg_of_nonpos hu hdelta) + simp [hsum] + · rw [if_neg hdelta] + rfl + +private theorem ordinalValue_add_one_eq_of_one_lt [CharZero K] + {a : Series K} (ha : 1 < ordinalValue a) : ordinalValue (a + 1) = ordinalValue a := by + apply le_antisymm + · simpa [ordinalValue_one, max_eq_left ha.le] using ordinalValue_add_le_max a 1 + · have h := ordinalValue_add_le_max (a + 1) (-1) + have hsum : (a + 1) + (-1) = a := by ring + rw [hsum, ordinalValue_neg, ordinalValue_one] at h + exact (le_max_iff.mp h).resolve_right (not_le_of_gt ha) + +private theorem ordinalValue_translatedTruncation_lt_of_supportOrderType_eq_ordinalValue + {a : Series K} + (haValue : (a : K⟦ℝ⟧).supportOrderType = (ordinalValue a).val) + (haZero : ordinalValue a ≠ 0) {u : ℝ} (hu : u < 0) : + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) u) < ordinalValue a := by + have hLUB := isLUB_support_zero_of_ordinalValue_ne_zero haZero + obtain ⟨gamma, hgammaSupport, hugamma, -⟩ := hLUB.exists_between hu + have htruncNe : HahnSeries.truncLE u (a : K⟦ℝ⟧) ≠ (a : K⟦ℝ⟧) := by + intro htrunc + have hgammaTrunc : gamma ∈ (HahnSeries.truncLE u (a : K⟦ℝ⟧)).support := by + rw [htrunc] + exact hgammaSupport + rw [HahnSeries.support_truncLE] at hgammaTrunc + exact (not_le_of_gt hugamma) hgammaTrunc.2 + calc + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) u) ≤ + NatOrdinal.of + ((translatedTruncation (a : K⟦ℝ⟧) u : Series K) : K⟦ℝ⟧).supportOrderType := + ordinalValue_le_supportOrderType _ + _ = NatOrdinal.of (HahnSeries.truncLE u (a : K⟦ℝ⟧)).supportOrderType := by + rw [coe_translatedTruncation, HahnSeries.supportOrderType_translate] + _ < NatOrdinal.of (a : K⟦ℝ⟧).supportOrderType := + NatOrdinal.of.lt_iff_lt.mpr (HahnSeries.supportOrderType_truncLE_lt u htruncNe) + _ = ordinalValue a := by rw [haValue, NatOrdinal.of_val] + +/-- Berarducci, Theorem 10.5: a nonpositive real Hahn series not divisible by a strictly +negative monomial is irreducible, as is its sum with one, when its support has order type `ω` or +`ω ^ (ω ^ beta)`. -/ +theorem irreducible_and_add_one_of_supportOrderType + [CharZero K] {a : Series K} + (haMonomial : ∀ (gamma : ℝ) (hgamma : gamma < 0), + ¬HahnSeries.Nonpositive.single gamma (1 : K) hgamma.le ∣ a) + (haType : (a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ∨ + ∃ beta : Ordinal, (a : K⟦ℝ⟧).supportOrderType = + Ordinal.omega0 ^ Ordinal.omega0 ^ beta) : + Irreducible a ∧ Irreducible (a + 1) := by + have haJ := not_mem_negativeMonomialIdeal_of_no_negativeMonomial_dvd haMonomial + have haPrincipal : Ordinal.IsInfiniteMultiplicativelyPrincipal + (a : K⟦ℝ⟧).supportOrderType := by + rcases haType with haOmega | ⟨beta, haBeta⟩ + · rw [haOmega] + simpa using Ordinal.isInfiniteMultiplicativelyPrincipal_omega0_opow_opow 0 + · rw [haBeta] + exact Ordinal.isInfiniteMultiplicativelyPrincipal_omega0_opow_opow beta + have haWeak : HahnSeries.IsWeaklyPrincipal (a : K⟦ℝ⟧) := by + rw [HahnSeries.isWeaklyPrincipal_iff] + exact haPrincipal.isAdditivelyPrincipal + have haValue := supportOrderType_eq_ordinalValue_of_isWeaklyPrincipal haWeak haJ + have haOrderPrincipal : Ordinal.IsInfiniteMultiplicativelyPrincipal (ordinalValue a).val := by + rw [← haValue] + exact haPrincipal + have haOne : 1 < ordinalValue a := by + rw [← NatOrdinal.val.lt_iff_lt] + exact (show (1 : Ordinal) < 2 by norm_num).trans + (Ordinal.isInfiniteMultiplicativelyPrincipal_iff_two_lt_and_isMultiplicativelyPrincipal.mp + haOrderPrincipal).1 + have haNegative : ∀ u : ℝ, u < 0 → + ordinalValue (translatedTruncation (a : K⟦ℝ⟧) u) < ordinalValue a := + fun _ hu ↦ ordinalValue_translatedTruncation_lt_of_supportOrderType_eq_ordinalValue + haValue (zero_lt_one.trans haOne).ne' hu + refine ⟨irreducible_of_infiniteMultiplicativelyPrincipal_ordinalValue + haOrderPrincipal haNegative, ?_⟩ + have haAddValue := ordinalValue_add_one_eq_of_one_lt haOne + have haAddPrincipal : + Ordinal.IsInfiniteMultiplicativelyPrincipal (ordinalValue (a + 1)).val := by + rw [haAddValue] + exact haOrderPrincipal + apply irreducible_of_infiniteMultiplicativelyPrincipal_ordinalValue haAddPrincipal + intro u hu + have hgerm : translatedTruncation (((a + 1 : Series K) : K⟦ℝ⟧)) u = + translatedTruncation (a : K⟦ℝ⟧) u := by + rw [show (((a + 1 : Series K) : K⟦ℝ⟧)) = (a : K⟦ℝ⟧) + 1 from rfl, + translatedTruncation_add, translatedTruncation_one_eq_zero_of_neg hu, add_zero] + rw [hgerm, haAddValue] + exact haNegative u hu + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/LeibnizRemainder.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/LeibnizRemainder.lean new file mode 100644 index 0000000000..b6060535a3 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/LeibnizRemainder.lean @@ -0,0 +1,192 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.TruncationDrop +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSubmultiplicative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +import Mathlib.Topology.Instances.Real.Lemmas + +/-! +# The Leibniz remainder of a product near zero + +Berarducci, Lemma 7.7 (Fornasiero, Lavi, L'Innocente and Mantova, Proposition 2.10): for +`u ∈ J_{ω^(α+1)}` and `v ∈ J_{ω^(β+1)}` with `α` a successor, Berarducci's convolution formula +writes `(uv)^{|γ}` modulo `J` as the finite sum of the products `u^{|ξ} v^{|ζ}` over `ξ + ζ = γ`. +The pairs `(γ, 0)` and `(0, γ)` contribute `u^{|γ} v` and `u v^{|γ}`; every other pair has +`ξ, ζ ∈ (γ, 0)`, and for `γ` close to zero the truncation drop gives `v_J(u^{|ξ}) ≤ ω^{α⁻}` and +`v_J(v^{|ζ}) < ω^β`, so by submultiplicativity the product has ordinal value below +`ω^{α⁻ + β}`. Hence + +`(uv)^{|γ} ≡ u^{|γ} v + u v^{|γ} (mod J_{ω^{α⁻ + β}})` + +for all `γ < 0` close to zero. Here `α⁻ + β` is `deg_J^r(u) ⊕ deg_J(v)` when `u` and `v` have +ordinal values `ω^α` and `ω^β`, which is the bound printed in the source. +-/ + +open Filter Topology +open scoped HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace Berarducci + +open HahnSeries + +variable {K : Type v} [Field K] + +/-- A finite sum of series of ordinal value below `ρ > 0` has ordinal value below `ρ`. -/ +private theorem ordinalValue_finset_sum_lt {ι : Type*} (s : Finset ι) (f : ι → Series K) + {ρ : NatOrdinal} (hρ : 0 < ρ) (h : ∀ i ∈ s, ordinalValue (f i) < ρ) : + ordinalValue (∑ i ∈ s, f i) < ρ := by + classical + induction s using Finset.induction_on with + | empty => simpa using hρ + | insert a s ha ih => + rw [Finset.sum_insert ha] + exact (ordinalValue_add_le_max _ _).trans_lt + (max_lt (h a (Finset.mem_insert_self a s)) + (ih fun i hi ↦ h i (Finset.mem_insert_of_mem hi))) + +/-- `ω^a ⊙ y < ω^(a + b)` whenever `y < ω^b`. -/ +private theorem wpow_mul_lt_wpow_add_of_lt {a b y : NatOrdinal} (hy : y < ω^ b) : + ω^ a * y < ω^ (a + b) := by + rcases eq_or_ne y 0 with rfl | hy0 + · simp + have hb : b ≠ 0 := by + rintro rfl + rw [NatOrdinal.wpow_zero] at hy + exact hy0 (le_antisymm (Order.lt_one_iff.mp hy).le bot_le) + obtain ⟨z, hz, n, hn⟩ := (NatOrdinal.lt_wpow_iff hb).mp hy + calc ω^ a * y ≤ ω^ a * (ω^ z * n) := mul_le_mul_right hn.le _ + _ = ω^ (a + z) * n := by rw [← mul_assoc, ← NatOrdinal.wpow_add] + _ < ω^ (a + b) := NatOrdinal.wpow_mul_natCast_lt (add_lt_add_right hz a) n + +/-- **Convolution remainder.** For `u ∈ J_{ω^(α+1)}`, `v ∈ J_{ω^(β+1)}` and `α` a successor, +`(uv)^{|γ} - u^{|γ} v - u v^{|γ}` has ordinal value below `ω^{α⁻ + β}` for all `γ < 0` close to +zero. -/ +theorem eventually_ordinalValue_leibnizRemainder_lt + {alpha beta : NatOrdinal} (halpha : 0 < alpha.constantCoeff) + (u v : Series K) (hu : ordinalValue u < ω^ (alpha + 1)) (hv : ordinalValue v < ω^ (beta + 1)) : + ∀ᶠ γ in 𝓝[<] (0 : ℝ), + ordinalValue (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ - + translatedTruncation (u : K⟦ℝ⟧) γ * v - u * translatedTruncation (v : K⟦ℝ⟧) γ) < + ω^ (alpha.removeNat 1 + beta) := by + classical + obtain ⟨ηu, hηu, hu'⟩ := eventually_nhdsLT_iff_exists.mp + (eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one alpha u + hu) + obtain ⟨ηv, hηv, hv'⟩ := eventually_nhdsLT_iff_exists.mp + (eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one beta v hv) + rw [eventually_nhdsLT_iff_exists] + refine ⟨max ηu ηv, max_lt hηu hηv, fun γ hηγ hγ ↦ ?_⟩ + have hαpred : alpha.removeNat 1 + 1 = alpha := by + simpa using NatOrdinal.removeNat_add_natCast halpha + -- The terms of the convolution sum with `ξ ∈ (γ, 0)` have small ordinal value. + have hterm : ∀ ξ : ℝ, γ < ξ → ξ < 0 → + ordinalValue (translatedTruncation (u : K⟦ℝ⟧) ξ * translatedTruncation (v : K⟦ℝ⟧) (γ - ξ)) < + ω^ (alpha.removeNat 1 + beta) := by + intro ξ hγξ hξ + have hξu : ordinalValue (translatedTruncation (u : K⟦ℝ⟧) ξ) < ω^ alpha := + hu' ξ ((le_max_left _ _).trans_lt (hηγ.trans hγξ)) hξ + have hξv : ordinalValue (translatedTruncation (v : K⟦ℝ⟧) (γ - ξ)) < ω^ beta := + hv' (γ - ξ) (by linarith [le_max_right ηu ηv]) (by linarith) + have hξu' : ordinalValue (translatedTruncation (u : K⟦ℝ⟧) ξ) ≤ ω^ (alpha.removeNat 1) := by + rcases ordinalValue_eq_zero_or_isAdditivelyPrincipal (translatedTruncation (u : K⟦ℝ⟧) ξ) with + hzero | hprin + · rw [hzero]; exact bot_le + · have hxi := Ordinal.natOrdinal_of_eq_wpow_log hprin + rw [NatOrdinal.of_val] at hxi + rw [hxi] at hξu ⊢ + rw [← hαpred] at hξu + exact NatOrdinal.wpow_le_wpow.mpr (Order.lt_add_one_iff.mp (NatOrdinal.wpow_lt_wpow.mp hξu)) + calc ordinalValue (translatedTruncation (u : K⟦ℝ⟧) ξ * translatedTruncation (v : K⟦ℝ⟧) (γ - ξ)) + ≤ + ordinalValue (translatedTruncation (u : K⟦ℝ⟧) ξ) * ordinalValue (translatedTruncation (v + : K⟦ℝ⟧) (γ - ξ)) := + ordinalValue_mul_le_naturalMul _ _ + _ ≤ ω^ (alpha.removeNat 1) * ordinalValue (translatedTruncation (v : K⟦ℝ⟧) (γ - ξ)) := + mul_le_mul_left hξu' _ + _ < ω^ (alpha.removeNat 1 + beta) := wpow_mul_lt_wpow_add_of_lt hξv + -- Berarducci's convolution formula, with the endpoint pairs added to the index set. + set I : Finset ℝ := convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) γ with hIdef + set I' : Finset ℝ := insert γ (insert 0 I) with hI'def + set F : ℝ → Series K := fun ξ ↦ translatedTruncation (u : K⟦ℝ⟧) ξ * translatedTruncation (v : + K⟦ℝ⟧) (γ - ξ) + with hFdef + have hJ : ∀ ξ, ξ ∉ I → F ξ ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + intro ξ hξ + rw [hIdef, mem_convolutionIndex, not_and_or] at hξ + rcases hξ with hξ | hξ + · exact Ideal.mul_mem_right _ _ + (translatedTruncation_mem_negativeMonomialIdeal_of_not_mem_closure_support hξ) + · exact Ideal.mul_mem_left _ _ + (translatedTruncation_mem_negativeMonomialIdeal_of_not_mem_closure_support hξ) + have hsumI : ∑ ξ ∈ I', F ξ - ∑ ξ ∈ I, F ξ ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + have hsub : I ⊆ I' := fun ξ hξ ↦ Finset.mem_insert_of_mem (Finset.mem_insert_of_mem hξ) + rw [← Finset.sum_sdiff hsub, add_sub_cancel_right] + exact Submodule.sum_mem _ fun ξ hξ ↦ hJ ξ (Finset.mem_sdiff.mp hξ).2 + have hconv : translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ - ∑ ξ ∈ I', F ξ ∈ + HahnSeries.Nonpositive.negativeMonomialIdeal K := by + have hformula := germAt_mul (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) γ + simp only [germAt_apply, ← map_mul, ← map_sum] at hformula + have hI : translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ - ∑ ξ ∈ I, F ξ ∈ + HahnSeries.Nonpositive.negativeMonomialIdeal K := by + rw [← toGerm_eq_toGerm_iff, Subring.coe_mul] + exact hformula + have := Ideal.sub_mem _ hI hsumI + rwa [sub_sub_sub_cancel_right] at this + -- Split off the endpoint pairs `ξ = γ` and `ξ = 0`. + set R : Finset ℝ := (I'.erase γ).erase 0 with hRdef + have hγI' : γ ∈ I' := Finset.mem_insert_self γ _ + have h0I' : (0 : ℝ) ∈ I'.erase γ := + Finset.mem_erase.mpr ⟨hγ.ne', Finset.mem_insert_of_mem (Finset.mem_insert_self 0 I)⟩ + have hsplit : ∑ ξ ∈ I', F ξ = F γ + (F 0 + ∑ ξ ∈ R, F ξ) := by + rw [Finset.add_sum_erase _ _ h0I', Finset.add_sum_erase _ _ hγI'] + have hFγ : F γ = translatedTruncation (u : K⟦ℝ⟧) γ * v := by + simp only [hFdef, sub_self, translatedTruncation_zero] + have hF0 : F 0 = u * translatedTruncation (v : K⟦ℝ⟧) γ := by + simp only [hFdef, sub_zero, translatedTruncation_zero] + -- The remainder is congruent modulo `J` to the sum over `R`. + have hrem : translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ - translatedTruncation (u : K⟦ℝ⟧) + γ * v - + u * translatedTruncation (v : K⟦ℝ⟧) γ - ∑ ξ ∈ R, F ξ ∈ + HahnSeries.Nonpositive.negativeMonomialIdeal K := by + have : translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ - translatedTruncation (u : K⟦ℝ⟧) γ * + v - + u * translatedTruncation (v : K⟦ℝ⟧) γ - ∑ ξ ∈ R, F ξ = + translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ - ∑ ξ ∈ I', F ξ := by + rw [hsplit, hFγ, hF0] + abel + rw [this] + exact hconv + rw [ordinalValue_eq_of_sub_mem_negativeMonomialIdeal hrem] + apply ordinalValue_finset_sum_lt _ _ (NatOrdinal.wpow_pos _) + intro ξ hξ + have hξ0 : ξ ≠ 0 := (Finset.mem_erase.mp hξ).1 + have hξγ : ξ ≠ γ := (Finset.mem_erase.mp (Finset.mem_erase.mp hξ).2).1 + have hξI : ξ ∈ I := by + have hmem := (Finset.mem_erase.mp (Finset.mem_erase.mp hξ).2).2 + rw [hI'def, Finset.mem_insert, Finset.mem_insert] at hmem + rcases hmem with h | h | h + · exact absurd h hξγ + · exact absurd h hξ0 + · exact h + rw [hIdef, mem_convolutionIndex] at hξI + have hclosure : ∀ b : Series K, closure (b : K⟦ℝ⟧).support ⊆ Set.Iic 0 := fun b ↦ + closure_minimal (HahnSeries.Nonpositive.support_subset b) isClosed_Iic + have hξle : ξ ≤ 0 := hclosure u hξI.1 + have hγξle : γ - ξ ≤ 0 := hclosure v hξI.2 + exact hterm ξ (lt_of_le_of_ne (by linarith) (Ne.symm hξγ)) (lt_of_le_of_ne hξle hξ0) + +end Berarducci + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/MainLemma.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/MainLemma.lean new file mode 100644 index 0000000000..a41647e275 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/MainLemma.lean @@ -0,0 +1,209 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PurePowerRemainder + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueConstantMul +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage + +/-! +# Ingredients of Berarducci's main lemma + +The proof of Berarducci, Lemma 8.2 rewrites the expected value `⊙^k v_J(b) ⊙ v_J(c)` as the +ordinary product `[⊙^{k-1} v_J(b) ⊙ v_J^r(b) ⊙ v_J(c)] * v_J^p(b)`, so that ordinal +multiplication is continuous in its second argument there; the Hessenberg product is not. The +conversion is justified by the criterion on Cantor terms, and the hypothesis +`v_J^p(b) ≤ v_J^p(c)` is exactly what supplies it: every canonical multiplicative factor of an +ordinal value or of a residual value is at least the corresponding principal value. + +The remaining ingredients are the invariance of the ordinal value under negation and under a +nonzero natural-number scalar. The second is the only place where the characteristic-zero +hypothesis of the source is used: in characteristic `p` the coefficient `k` of the surviving term +could annihilate it. +-/ + +universe v + +public noncomputable section + +open HahnSeries Ordinal + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- `Y` is additive principal and each of its canonical multiplicative factors is at least +`ω ^ w`. -/ +private def GoodAt (w : Ordinal) (Y : NatOrdinal) : Prop := + IsAdditivelyPrincipal Y.val ∧ + ∀ t ∈ (log omega0 Y.val).additivePrincipalTerms, w ≤ t + +private theorem GoodAt.one (w : Ordinal) : GoodAt w 1 := by + refine ⟨isAdditivelyPrincipal_iff.mpr ⟨0, by simp⟩, fun t ht ↦ ?_⟩ + rw [show ((1 : NatOrdinal).val) = 1 from rfl, log_one_right, + additivePrincipalTerms_zero] at ht + exact absurd ht (List.not_mem_nil) + +private theorem GoodAt.mul {w : Ordinal} {Y Z : NatOrdinal} + (hY : GoodAt w Y) (hZ : GoodAt w Z) : GoodAt w (Y * Z) := by + have hYval : NatOrdinal.of Y.val = Y := NatOrdinal.of_val Y + have hZval : NatOrdinal.of Z.val = Z := NatOrdinal.of_val Z + have hprod : (NatOrdinal.of Y.val * NatOrdinal.of Z.val).val = (Y * Z).val := by + rw [hYval, hZval] + constructor + · obtain ⟨e, he⟩ := isAdditivelyPrincipal_iff.mp hY.1 + obtain ⟨f, hf⟩ := isAdditivelyPrincipal_iff.mp hZ.1 + refine isAdditivelyPrincipal_iff.mpr + ⟨(NatOrdinal.of e + NatOrdinal.of f).val, ?_⟩ + rw [← hprod, he, hf, NatOrdinal.of_omega0_opow, NatOrdinal.of_omega0_opow, + ← NatOrdinal.wpow_add, NatOrdinal.val_wpow] + · intro t ht + rw [← hprod] at ht + rcases mem_additivePrincipalTerms_log_natMul hY.1 hZ.1 ht with h | h + · exact hY.2 t h + · exact hZ.2 t h + +private theorem GoodAt.pow {w : Ordinal} {Y : NatOrdinal} (hY : GoodAt w Y) (n : ℕ) : + GoodAt w (Y ^ n) := by + induction n with + | zero => simpa using GoodAt.one w + | succ n ih => rw [pow_succ]; exact ih.mul hY + +private theorem goodAt_principalValue (b : SeriesWithOrdinalValueAboveOne K) : + GoodAt (log omega0 b.principalValue.val) b.principalValue := by + refine ⟨b.principalValue_isInfiniteMultiplicativelyPrincipal.isAdditivelyPrincipal, + fun t ht ↦ ?_⟩ + rw [additivePrincipalTerms_of_isAdditivelyPrincipal + b.isAdditivelyPrincipal_log_principalValue, List.mem_singleton] at ht + exact ht.ge + +private theorem goodAt_residualValue (b : SeriesWithOrdinalValueAboveOne K) : + GoodAt (log omega0 b.principalValue.val) b.residualValue := + ⟨b.residualValue_isAdditivelyPrincipal, + fun _ ht ↦ b.log_principalValue_le_of_mem_terms_residualValue ht⟩ + +private theorem goodAt_ordinalValue (b : SeriesWithOrdinalValueAboveOne K) : + GoodAt (log omega0 b.principalValue.val) (ordinalValue b.1) := + ⟨ordinalValue_isAdditivelyPrincipal_of_one_lt b.2, + fun _ ht ↦ b.log_principalValue_le_of_mem_terms_ordinalValue ht⟩ + +private theorem GoodAt.mono {w w' : Ordinal} {Y : NatOrdinal} (hY : GoodAt w Y) + (hw : w' ≤ w) : GoodAt w' Y := + ⟨hY.1, fun t ht ↦ hw.trans (hY.2 t ht)⟩ + +private theorem log_principalValue_mono {b c : SeriesWithOrdinalValueAboveOne K} + (hp : b.principalValue ≤ c.principalValue) : + log omega0 b.principalValue.val ≤ log omega0 c.principalValue.val := by + have hle : b.principalValue.val ≤ c.principalValue.val := NatOrdinal.val.monotone hp + rw [← b.principalValue_val_eq_opow_log, ← c.principalValue_val_eq_opow_log] at hle + exact (opow_le_opow_iff_right one_lt_omega0).mp hle + +private theorem goodAt_powerRemainderBound (b c : SeriesWithOrdinalValueAboveOne K) + (hp : b.principalValue ≤ c.principalValue) (m : ℕ) : + GoodAt (log omega0 b.principalValue.val) (powerRemainderBound b c m) := by + rw [powerRemainderBound_eq] + exact (((goodAt_ordinalValue b).pow m).mul (goodAt_residualValue b)).mul + ((goodAt_ordinalValue c).mono (log_principalValue_mono hp)) + +/-- The remainder bound is additive principal. -/ +theorem isAdditivelyPrincipal_powerRemainderBound (b c : SeriesWithOrdinalValueAboveOne K) + (hp : b.principalValue ≤ c.principalValue) (m : ℕ) : + IsAdditivelyPrincipal (powerRemainderBound b c m).val := + (goodAt_powerRemainderBound b c hp m).1 + +/-- The Hessenberg-to-ordinary conversion described above, at the expected value. -/ +theorem powerRemainderBound_mul_principalValue_val + (b c : SeriesWithOrdinalValueAboveOne K) (hp : b.principalValue ≤ c.principalValue) (m : ℕ) : + (powerRemainderBound b c m * b.principalValue).val + = (powerRemainderBound b c m).val * b.principalValue.val := by + have hX := goodAt_powerRemainderBound b c hp m + have h := natOrdinal_of_mul_wpow_eq_mul_of_log_terms + b.isAdditivelyPrincipal_log_principalValue hX.1 hX.2 + rw [b.principalValue_val_eq_opow_log, NatOrdinal.of_val, NatOrdinal.of_val] at h + exact (congrArg NatOrdinal.val h).symm + +private theorem goodAt_powerRemainderBoundOne (b : SeriesWithOrdinalValueAboveOne K) (m : ℕ) : + GoodAt (log omega0 b.principalValue.val) (powerRemainderBoundOne b m) := by + rw [powerRemainderBoundOne_eq] + exact ((goodAt_ordinalValue b).pow m).mul (goodAt_residualValue b) + +/-- The pure-power remainder bound is additive principal. -/ +theorem isAdditivelyPrincipal_powerRemainderBoundOne (b : SeriesWithOrdinalValueAboveOne K) + (m : ℕ) : IsAdditivelyPrincipal (powerRemainderBoundOne b m).val := + (goodAt_powerRemainderBoundOne b m).1 + +/-- The Hessenberg-to-ordinary conversion for a pure power. No comparison of principal values is +needed: both factors of the bound come from `b` itself. -/ +theorem powerRemainderBoundOne_mul_principalValue_val (b : SeriesWithOrdinalValueAboveOne K) + (m : ℕ) : (powerRemainderBoundOne b m * b.principalValue).val + = (powerRemainderBoundOne b m).val * b.principalValue.val := by + have hX := goodAt_powerRemainderBoundOne b m + have h := natOrdinal_of_mul_wpow_eq_mul_of_log_terms + b.isAdditivelyPrincipal_log_principalValue hX.1 hX.2 + rw [b.principalValue_val_eq_opow_log, NatOrdinal.of_val, NatOrdinal.of_val] at h + exact (congrArg NatOrdinal.val h).symm + +/-- Berarducci, Lemma 8.2: a value strictly below the expected one is bounded by a proper +ordinary multiple of the remainder bound. -/ +theorem exists_le_mul_of_lt_powerRemainderBound_mul + (b c : SeriesWithOrdinalValueAboveOne K) (hp : b.principalValue ≤ c.principalValue) (m : ℕ) + {u : NatOrdinal} (hu : u < powerRemainderBound b c m * b.principalValue) : + ∃ α < b.principalValue.val, u.val ≤ (powerRemainderBound b c m).val * α := by + have hlt : u.val < (powerRemainderBound b c m).val * b.principalValue.val := by + rw [← powerRemainderBound_mul_principalValue_val b c hp m] + exact NatOrdinal.val.lt_iff_lt.mpr hu + obtain ⟨α, hα, hlt'⟩ := + (Ordinal.lt_mul_iff_of_isSuccLimit + b.principalValue_isInfiniteMultiplicativelyPrincipal.isSuccLimit).mp hlt + exact ⟨α, hα, hlt'.le⟩ + +private theorem goodAt_prod {w : Ordinal} (l : Multiset (SeriesWithOrdinalValueAboveOne K)) + (hl : ∀ y ∈ l, GoodAt w (ordinalValue y.1)) : + GoodAt w (l.map fun y ↦ ordinalValue y.1).prod := by + induction l using Multiset.induction with + | empty => simpa using GoodAt.one w + | cons a s ih => + rw [Multiset.map_cons, Multiset.prod_cons] + exact (hl a (Multiset.mem_cons_self a s)).mul + (ih fun y hy ↦ hl y (Multiset.mem_cons_of_mem hy)) + +/-- If every factor of a product has principal value at least that of `b`, then so does the +product. This supplies the hypothesis of Lemma 8.2 when the second factor is itself a product. -/ +theorem principalValue_le_of_forall_mem (b c : SeriesWithOrdinalValueAboveOne K) + (l : Multiset (SeriesWithOrdinalValueAboveOne K)) + (hl : ∀ y ∈ l, b.principalValue ≤ y.principalValue) + (hc : ordinalValue c.1 = (l.map fun y ↦ ordinalValue y.1).prod) : + b.principalValue ≤ c.principalValue := by + have hgood := goodAt_prod (w := log omega0 b.principalValue.val) l + fun y hy ↦ (goodAt_ordinalValue y).mono (log_principalValue_mono (hl y hy)) + rw [← hc] at hgood + exact b.le_principalValue_of_forall_mem_terms c fun t ht ↦ hgood.2 t ht + +theorem ordinalValue_neg (x : Series K) : ordinalValue (-x) = ordinalValue x := by + have hx : -x = HahnSeries.Nonpositive.C (-1 : K) * x := by + rw [map_neg, map_one, neg_one_mul] + rw [hx, ordinalValue_C_mul (neg_ne_zero.mpr one_ne_zero)] + +theorem germOrdinalValue_neg (q : Germ K) : germOrdinalValue (-q) = germOrdinalValue q := by + obtain ⟨x, rfl⟩ := Ideal.Quotient.mk_surjective q + rw [← map_neg, germOrdinalValue_mk, germOrdinalValue_mk, ordinalValue_neg] + +/-- A nonzero natural-number scalar does not change the ordinal value. This is the only place +where the characteristic-zero hypothesis is used. -/ +theorem ordinalValue_nsmul {n : ℕ} (hn : (n : K) ≠ 0) (x : Series K) : + ordinalValue (n • x) = ordinalValue x := by + have hns : (n • x : Series K) = HahnSeries.Nonpositive.C ((n : K)) * x := by + rw [map_natCast HahnSeries.Nonpositive.C n] + exact nsmul_eq_mul _ _ + rw [hns, ordinalValue_C_mul hn] + +theorem germOrdinalValue_nsmul {n : ℕ} (hn : (n : K) ≠ 0) (q : Germ K) : + germOrdinalValue (n • q) = germOrdinalValue q := by + obtain ⟨x, rfl⟩ := Ideal.Quotient.mk_surjective q + rw [← map_nsmul, germOrdinalValue_mk, germOrdinalValue_mk, ordinalValue_nsmul hn] + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OneRow.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OneRow.lean new file mode 100644 index 0000000000..5df67406f1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OneRow.lean @@ -0,0 +1,262 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Irreducibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveCoefficientMap + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Domain + +/-! +# The one-row irreducibles + +The series + +`a = Σ n : ℕ, t ^ (-1 / (n + 1))` + +has support order type `ω`, with supremum zero approached from below. Berarducci, Theorem 10.5 +therefore proves that both `a` and `a + 1` are irreducible over every characteristic-zero +coefficient field. The second series is the signed Hahn-series form of Conway's one-row omnific +integer `1 + Σ n, ω ^ (1 / (n + 1))`, discussed in LM24, Example 9.2.8. + +## References + +* A. Berarducci, *Factorization in generalized power series*, Trans. Amer. Math. Soc. 352 + (2000), 553–577, cited as [Ber00]. +* S. L'Innocente, V. Mantova, *A factorisation theory for generalised power series and omnific + integers*, Adv. Math. 442 (2024) 109513, cited as [LM24]. +-/ + +universe v w + +open scoped HahnSeries + +public noncomputable section + +namespace Berarducci.OneRow + +variable {K : Type v} [Field K] + +/-- The `n`-th exponent in the one-row series approaching zero from below. -/ +def exponent (n : ℕ) : ℝ := + -(1 / (n + 1 : ℝ)) + +@[simp] +theorem exponent_apply (n : ℕ) : exponent n = -(1 / (n + 1 : ℝ)) := + (rfl) + +private theorem exponent_strictMono : StrictMono exponent := + strictMono_nat_of_lt_succ fun n ↦ by + rw [exponent_apply, exponent_apply] + apply neg_lt_neg + apply one_div_lt_one_div_of_lt + · positivity + · norm_num + +/-- The order embedding enumerating the support of the one-row series. -/ +def exponentEmbedding : ℕ ↪o ℝ := + OrderEmbedding.ofStrictMono exponent exponent_strictMono + +@[simp] +theorem exponentEmbedding_apply (n : ℕ) : exponentEmbedding n = exponent n := + (rfl) + +private def coefficientOne : K⟦ℕ⟧ where + coeff _ := 1 + isPWO_support' := by + simpa [Function.support] using Set.IsPWO.of_linearOrder (Set.univ : Set ℕ) + +private theorem coefficientOne_support : (coefficientOne (K := K)).support = Set.univ := by + ext n + simp [coefficientOne] + +/-- The coefficient-one nonpositive Hahn series `Σ n, t ^ (-1 / (n + 1))`. -/ +def withoutConstant : Series K := + ⟨HahnSeries.embDomain exponentEmbedding (coefficientOne (K := K)), by + rw [HahnSeries.mem_nonpositiveSubring, + HahnSeries.support_embDomain, coefficientOne_support, Set.image_univ] + rintro _ ⟨n, rfl⟩ + rw [exponentEmbedding_apply, exponent_apply] + exact neg_nonpos.mpr (show 0 ≤ 1 / (n + 1 : ℝ) by positivity)⟩ + +/-- Every exponent displayed in the one-row series has coefficient one. -/ +theorem withoutConstant_coeff_exponent (n : ℕ) : + (withoutConstant (K := K) : K⟦ℝ⟧).coeff (exponent n) = 1 := by + rw [withoutConstant, ← exponentEmbedding_apply, HahnSeries.embDomain_coeff] + rfl + +/-- The support of the one-row series is exactly its displayed exponent sequence. -/ +theorem withoutConstant_support : + (withoutConstant (K := K) : K⟦ℝ⟧).support = Set.range exponentEmbedding := by + rw [withoutConstant, HahnSeries.support_embDomain, + coefficientOne_support, Set.image_univ] + +/-- Coefficient extension preserves the coefficient-one row. -/ +theorem nonpositiveCoefficientMap_withoutConstant + {E : Type w} [Field E] (f : K →+* E) : + HahnSeries.Nonpositive.nonpositiveCoefficientMap f + (withoutConstant (K := K)) = + withoutConstant (K := E) := by + apply Subtype.ext + apply HahnSeries.coeff_injective + funext x + by_cases hx : x ∈ Set.range exponentEmbedding + · obtain ⟨n, rfl⟩ := hx + rw [HahnSeries.Nonpositive.coe_nonpositiveCoefficientMap] + simp only [exponentEmbedding_apply, withoutConstant_coeff_exponent, map_one] + · have hK : (withoutConstant (K := K) : K⟦ℝ⟧).coeff x = 0 := by + rw [← not_ne_iff, ← HahnSeries.mem_support, withoutConstant_support] + exact hx + have hE : (withoutConstant (K := E) : E⟦ℝ⟧).coeff x = 0 := by + rw [← not_ne_iff, ← HahnSeries.mem_support, withoutConstant_support] + exact hx + rw [HahnSeries.Nonpositive.coe_nonpositiveCoefficientMap, hK, map_zero, hE] + +@[simp] +theorem withoutConstant_coeff_zero : + (withoutConstant (K := K) : K⟦ℝ⟧).coeff 0 = 0 := by + rw [← not_ne_iff, ← HahnSeries.mem_support, withoutConstant_support] + rintro ⟨n, hn⟩ + have hneg : exponentEmbedding n < 0 := by + rw [exponentEmbedding_apply, exponent_apply] + exact neg_lt_zero.mpr (by positivity) + exact hneg.ne hn + +/-- The support of the one-row series has order type `ω`. -/ +theorem withoutConstant_supportOrderType : + (withoutConstant (K := K) : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 := by + rw [HahnSeries.supportOrderType_eq_setOrderType] + have e : (withoutConstant (K := K) : K⟦ℝ⟧).support ≃o ℕ := + (OrderIso.setCongr _ (Set.range exponentEmbedding) + (withoutConstant_support (K := K))).trans exponentEmbedding.orderIso.symm + exact (withoutConstant (K := K) : K⟦ℝ⟧).isPWO_support + |>.orderType_eq_typeLT_of_orderIso e |>.trans Ordinal.type_nat_lt + +private theorem withoutConstant_isLUB : + IsLUB (withoutConstant (K := K) : K⟦ℝ⟧).support 0 := by + rw [withoutConstant_support] + constructor + · rintro _ ⟨n, rfl⟩ + rw [exponentEmbedding_apply, exponent_apply] + exact neg_nonpos.mpr (by positivity) + · intro a ha + by_contra hnot + have haNeg : a < 0 := lt_of_not_ge hnot + obtain ⟨n, hn⟩ := exists_nat_one_div_lt (neg_pos.mpr haNeg) + have hle := ha (Set.mem_range_self n) + rw [exponentEmbedding_apply, exponent_apply] at hle + linarith + +/-- The support supremum is zero and is not attained. -/ +theorem withoutConstant_supportSup : + HahnSeries.Nonpositive.supportSup (withoutConstant (K := K)) = 0 := by + apply HahnSeries.Nonpositive.supportSup_eq_coe_iff.mpr + refine ⟨?_, withoutConstant_isLUB (K := K)⟩ + intro hzero + have hcoeff := withoutConstant_coeff_exponent (K := K) 0 + rw [hzero] at hcoeff + change (0 : K) = 1 at hcoeff + exact zero_ne_one hcoeff + +/-- No strictly negative monomial divides the one-row series. -/ +theorem negative_single_not_dvd_withoutConstant + (gamma : ℝ) (hgamma : gamma < 0) : + ¬ HahnSeries.Nonpositive.single gamma (1 : K) hgamma.le ∣ + withoutConstant (K := K) := by + have hnotJ : withoutConstant (K := K) ∉ + HahnSeries.Nonpositive.negativeMonomialIdeal K := by + rw [HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero, + withoutConstant_supportSup] + exact lt_irrefl 0 + intro hdvd + obtain ⟨c, hc⟩ := hdvd + apply hnotJ + rw [hc] + apply Ideal.mul_mem_right c + rw [HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero, + HahnSeries.Nonpositive.supportSup_single one_ne_zero] + exact_mod_cast hgamma + +/-- The one-row series with its final constant coefficient one. -/ +def withConstant : Series K := + withoutConstant (K := K) + 1 + +/-- Coefficient extension preserves the constant-capped coefficient-one row. -/ +theorem nonpositiveCoefficientMap_withConstant + {E : Type w} [Field E] (f : K →+* E) : + HahnSeries.Nonpositive.nonpositiveCoefficientMap f + (withConstant (K := K)) = + withConstant (K := E) := by + rw [withConstant, withConstant, map_add, map_one, + nonpositiveCoefficientMap_withoutConstant] + +theorem withConstant_coeff_exponent (n : ℕ) : + (withConstant (K := K) : K⟦ℝ⟧).coeff (exponent n) = 1 := by + rw [withConstant, Subring.coe_add, HahnSeries.coeff_add, + withoutConstant_coeff_exponent, show ((1 : Series K) : K⟦ℝ⟧) = 1 from rfl] + have hne : exponent n ≠ 0 := by + rw [exponent_apply] + exact (neg_lt_zero.mpr (by positivity)).ne + rw [HahnSeries.coeff_one, if_neg hne, add_zero] + +@[simp] +theorem withConstant_coeff_zero : + (withConstant (K := K) : K⟦ℝ⟧).coeff 0 = 1 := by + rw [withConstant, Subring.coe_add, HahnSeries.coeff_add, + withoutConstant_coeff_zero] + simp + +/-- The constant coefficient of the capped row is one. -/ +theorem withConstant_constantCoeff : + HahnSeries.Nonpositive.constantCoeff (withConstant (K := K)) = 1 := by + rw [HahnSeries.Nonpositive.constantCoeff_apply, withConstant_coeff_zero] + +/-- The support of the constant-capped series is the one-row sequence followed by zero. -/ +theorem withConstant_support : + (withConstant (K := K) : K⟦ℝ⟧).support = Set.range exponentEmbedding ∪ {0} := by + ext x + by_cases hx : x = 0 + · subst x + simp [withConstant_coeff_zero] + · have hone : (1 : K⟦ℝ⟧).coeff x = 0 := by + rw [HahnSeries.coeff_one, if_neg hx] + rw [HahnSeries.mem_support, withConstant, Subring.coe_add, + HahnSeries.coeff_add, show ((1 : Series K) : K⟦ℝ⟧) = 1 from rfl, + hone, add_zero, ← HahnSeries.mem_support, withoutConstant_support] + simp [hx] + +private theorem withoutConstant_supportBelow_one : + HahnSeries.SupportBelow (withoutConstant (K := K) : K⟦ℝ⟧) 1 := by + rw [HahnSeries.supportBelow_iff] + intro i hi j hj + rw [withoutConstant_support] at hi + obtain ⟨n, rfl⟩ := hi + have hj0 : j = 0 := by + simpa [HahnSeries.support_one] using hj + subst j + rw [exponentEmbedding_apply, exponent_apply] + exact neg_lt_zero.mpr (by positivity) + +/-- The support of the constant-capped one-row series has order type `ω + 1`. -/ +theorem withConstant_supportOrderType : + (withConstant (K := K) : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 + 1 := by + apply (HahnSeries.supportOrderType_eq_add_iff _ _ _).mpr + refine ⟨(withoutConstant (K := K) : K⟦ℝ⟧), 1, + withoutConstant_supportBelow_one (K := K), + withoutConstant_supportOrderType (K := K), ?_, ?_⟩ + · change (HahnSeries.C (1 : K)).supportOrderType = 1 + rw [HahnSeries.C_apply, HahnSeries.supportOrderType_single one_ne_zero] + · rfl + +/-- Berarducci's theorem makes both the one-row series and its constant-capped form irreducible. -/ +theorem irreducible_withoutConstant_and_withConstant [CharZero K] : + Irreducible (withoutConstant (K := K)) ∧ + Irreducible (withConstant (K := K)) := by + apply Berarducci.irreducible_and_add_one_of_supportOrderType + · exact negative_single_not_dvd_withoutConstant + · exact Or.inl withoutConstant_supportOrderType + +end Berarducci.OneRow diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrderTypeMultiplicativity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrderTypeMultiplicativity.lean new file mode 100644 index 0000000000..b39ae46582 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrderTypeMultiplicativity.lean @@ -0,0 +1,214 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Multiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Sumset +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue + +/-! +# Multiplicativity of the support order type + +Berarducci, Corollary 9.9, imported by LM24 as Fact 3.4.1: the support order type is +multiplicative for the Hessenberg product on series whose order types are additively principal. + +The ordinal value is bounded above by the support order type, and on a series outside `J` whose +order type is additively principal the two agree: a representative modulo `J + K` shares a final +segment of the support, and a nonempty final segment of an additively principal order type has +the full order type. The order type of a product is bounded above by the Hessenberg product of +the order types, because the support of a product lies in the sumset of the supports. Theorem 9.7 +supplies the matching lower bound, and the two squeeze. +-/ + +universe v + +public noncomputable section + +open HahnSeries Ordinal + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- Berarducci, Remark 5.4: the support order type of a product is at most the Hessenberg product +of the support order types. -/ +theorem supportOrderType_mul_le_naturalMul (b c : K⟦ℝ⟧) : + (b * c).supportOrderType + ≤ (NatOrdinal.of b.supportOrderType * NatOrdinal.of c.supportOrderType).val := by + rw [supportOrderType_eq_setOrderType, supportOrderType_eq_setOrderType, + supportOrderType_eq_setOrderType] + exact ((b * c).isPWO_support.orderType_mono (b.isPWO_support.add c.isPWO_support) + HahnSeries.support_mul_subset).trans + (Set.IsPWO.orderType_add_le_naturalMul b.isPWO_support c.isPWO_support) + +/-- A series outside `J` has support points arbitrarily close to zero. -/ +private theorem exists_mem_support_gt {b : Series K} + (hbJ : b ∉ HahnSeries.Nonpositive.negativeMonomialIdeal K) {η : ℝ} (hη : η < 0) : + ∃ y ∈ (b : K⟦ℝ⟧).support, η < y := by + have hlub := isLUB_support_zero_of_ordinalValue_ne_zero + (b := b) (fun h ↦ hbJ (ordinalValue_eq_zero_iff.mp h)) + by_contra hcon + exact absurd (hlub.2 fun y hy ↦ le_of_not_gt fun hgt ↦ hcon ⟨y, hy, hgt⟩) (not_le.mpr hη) + +/-- Above order type one an additively principal order type is a limit, so the support has no +maximum and in particular misses the origin. -/ +private theorem notMem_support_zero_of_ne_one {b : Series K} + (hb : IsWeaklyPrincipal (b : K⟦ℝ⟧)) (h1 : (b : K⟦ℝ⟧).supportOrderType ≠ 1) : + (0 : ℝ) ∉ (b : K⟦ℝ⟧).support := by + obtain ⟨e, he⟩ := isAdditivelyPrincipal_iff.mp (isWeaklyPrincipal_iff.mp hb) + have hene : e ≠ 0 := by + rintro rfl + exact h1 (by simpa using he) + have hlim : Order.IsSuccLimit (b : K⟦ℝ⟧).supportOrderType := by + rw [he] + exact Ordinal.isSuccLimit_opow_left Ordinal.isSuccLimit_omega0 hene + intro h0 + obtain ⟨y, hy, hy0⟩ := (b : K⟦ℝ⟧).isPWO_support.exists_gt_of_isSuccLimit_orderType + (by rwa [← supportOrderType_eq_setOrderType]) h0 + exact absurd ((HahnSeries.mem_nonpositiveSubring (Γ := ℝ) (R := K)).mp b.2 hy) (not_le.mpr hy0) + +/-- A representative modulo `J + K` of a series outside `J` whose order type is additively +principal has at least that order type. Above one the order type is a limit, so the support has no +maximum and in particular misses the origin, where a constant summand could have changed it; the +two supports then share a final segment, which carries the whole order type. -/ +private theorem supportOrderType_le_of_sub_mem_nearConstantSubgroup {b c : Series K} + (hb : IsWeaklyPrincipal (b : K⟦ℝ⟧)) + (hbJ : b ∉ HahnSeries.Nonpositive.negativeMonomialIdeal K) + (hbc : b - c ∈ nearConstantSubgroup K) (hc : c ≠ 0) : + (b : K⟦ℝ⟧).supportOrderType ≤ (c : K⟦ℝ⟧).supportOrderType := by + have hbsupp : (b : K⟦ℝ⟧).support ⊆ Set.Iic (0 : ℝ) := + (HahnSeries.mem_nonpositiveSubring (Γ := ℝ) (R := K)).mp b.2 + rcases eq_or_ne (b : K⟦ℝ⟧).supportOrderType 1 with h1 | h1 + · rw [h1] + refine Order.one_le_iff_ne_zero.mpr fun h0 ↦ hc ?_ + rw [supportOrderType_eq_setOrderType, Set.IsPWO.orderType_eq_zero] at h0 + exact Subtype.ext (HahnSeries.support_eq_empty_iff.mp h0) + · have hzero := notMem_support_zero_of_ne_one hb h1 + obtain ⟨η, hη, hcoeff⟩ := exists_coeff_eq_of_sub_mem_nearConstantSubgroup hbc + have hprin : + Ordinal.IsPrincipal (fun a b ↦ a + b) (b : K⟦ℝ⟧).isPWO_support.orderType := by + rw [← supportOrderType_eq_setOrderType] + exact (isAdditivelyPrincipal_iff_ne_zero_and_isPrincipal_add.mp + (isWeaklyPrincipal_iff.mp hb)).2 + have hseg := (b : K⟦ℝ⟧).isPWO_support.orderType_inter_Ioi_eq_of_isPrincipal hprin + (exists_mem_support_gt hbJ hη) + have hsub : (b : K⟦ℝ⟧).support ∩ Set.Ioi η ⊆ (c : K⟦ℝ⟧).support := by + intro y hy + have hy0 : y < 0 := lt_of_le_of_ne (hbsupp hy.1) fun h ↦ hzero (h ▸ hy.1) + rw [HahnSeries.mem_support, ← hcoeff y hy.2 hy0] + exact (HahnSeries.mem_support _ _).mp hy.1 + rw [supportOrderType_eq_setOrderType, ← hseg, supportOrderType_eq_setOrderType] + exact Set.IsPWO.orderType_mono _ _ hsub + +/-- On a series outside `J` whose order type is additively principal, the support order type and +the ordinal value agree. -/ +theorem supportOrderType_eq_ordinalValue_of_isWeaklyPrincipal {b : Series K} + (hb : IsWeaklyPrincipal (b : K⟦ℝ⟧)) + (hbJ : b ∉ HahnSeries.Nonpositive.negativeMonomialIdeal K) : + (b : K⟦ℝ⟧).supportOrderType = (ordinalValue b).val := by + refine le_antisymm ?_ (NatOrdinal.val.monotone (ordinalValue_le_supportOrderType b)) + by_cases hbNear : b ∈ nearConstantSubgroup K + · rw [ordinalValue_of_mem_nearConstantSubgroup_of_not_mem_negativeMonomialIdeal hbNear hbJ] + rcases eq_or_ne (b : K⟦ℝ⟧).supportOrderType 1 with h1 | h1 + · rw [h1] + simp + · refine absurd ?_ hbJ + have hcc : HahnSeries.Nonpositive.constantCoeff b = 0 := by + by_contra hne + exact notMem_support_zero_of_ne_one hb h1 ((HahnSeries.mem_support _ _).mpr + (by rwa [HahnSeries.Nonpositive.constantCoeff_apply] at hne)) + have hsub := mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem.mp hbNear + rwa [hcc, map_zero, _root_.sub_zero] at hsub + · obtain ⟨hmem, -⟩ := ordinalValue_isLeast_representativeOrderTypes hbNear + obtain ⟨d, hd, hdeq⟩ := mem_representativeOrderTypes_iff.mp hmem + have hdne : d ≠ 0 := by + rintro rfl + rw [_root_.sub_zero] at hd + exact hbNear hd + rw [← hdeq, NatOrdinal.val_of] + exact supportOrderType_le_of_sub_mem_nearConstantSubgroup hb hbJ hd hdne + +/-- Berarducci, Corollary 9.9 for series outside `J`: the ordinal value and the support order +type coincide there, and Theorem 9.7 supplies the lower bound that meets Remark 5.4. -/ +private theorem supportOrderType_mul_of_notMem_negativeMonomialIdeal [CharZero K] {b c : Series K} + (hb : IsWeaklyPrincipal (b : K⟦ℝ⟧)) (hc : IsWeaklyPrincipal (c : K⟦ℝ⟧)) + (hbJ : b ∉ HahnSeries.Nonpositive.negativeMonomialIdeal K) + (hcJ : c ∉ HahnSeries.Nonpositive.negativeMonomialIdeal K) : + ((b * c : Series K) : K⟦ℝ⟧).supportOrderType + = (NatOrdinal.of (b : K⟦ℝ⟧).supportOrderType * + NatOrdinal.of (c : K⟦ℝ⟧).supportOrderType).val := by + refine le_antisymm ?_ ?_ + · rw [show ((b * c : Series K) : K⟦ℝ⟧) = (b : K⟦ℝ⟧) * (c : K⟦ℝ⟧) from rfl] + exact supportOrderType_mul_le_naturalMul _ _ + · rw [supportOrderType_eq_ordinalValue_of_isWeaklyPrincipal hb hbJ, + supportOrderType_eq_ordinalValue_of_isWeaklyPrincipal hc hcJ, NatOrdinal.of_val, + NatOrdinal.of_val, ← ordinalValue_mul b c] + exact NatOrdinal.val.monotone (ordinalValue_le_supportOrderType (b * c)) + +end Berarducci + +namespace HahnSeries.Nonpositive + +variable {K : Type v} [Field K] + +/-- Berarducci, Corollary 9.9, imported by LM24 as Fact 3.4.1. Normalizing each factor moves it +out of `J` without changing any order type, since translation is an order isomorphism of the +exponents and the product of two translates is a translate of the product. -/ +@[blueprint "fact:weakly-principal-order-type-multiplicativity" + (phase := "Ordinal value and degree") + (title := "Multiplicativity of order type for weakly principal series \ + (Ber00, Corollary 9.9; LM24, Fact 3.4.1)") + (statement := /-- + Let $K$ be a field of characteristic zero. If + $b,c\in K((\mathbb R^{\le 0}))$ are weakly principal, then + \[ + \operatorname{ot}(bc)= + \operatorname{ot}(b)\odot\operatorname{ot}(c). + \] + -/) + (proof := /-- + Translate each factor so that the supremum of its support is zero. Translation + preserves the three support order types and places both factors outside $J$. + For a weakly principal series outside $J$, its support order type equals its + ordinal value. \ref{fact:ordinal-value-multiplicativity} gives the lower bound for + the product, while containment of its support in the sum of the two supports + gives the reverse bound. + -/)] +theorem orderTypeMultiplicativeOnWeaklyPrincipal [CharZero K] : + OrderTypeMultiplicativeOnWeaklyPrincipal K := by + refine orderTypeMultiplicativeOnWeaklyPrincipal_iff.mpr fun b c hb hc ↦ ?_ + have hne : ∀ x : Berarducci.Series K, IsWeaklyPrincipal (x : K⟦ℝ⟧) → x ≠ 0 := by + rintro x hx rfl + exact (isAdditivelyPrincipal_iff_ne_zero_and_isPrincipal_add.mp + (isWeaklyPrincipal_iff.mp hx)).1 (by + rw [HahnSeries.supportOrderType_eq_setOrderType, Set.IsPWO.orderType_eq_zero] + simp) + set sb := sSup (b : K⟦ℝ⟧).support with hsb + set sc := sSup (c : K⟦ℝ⟧).support with hsc + have hbot : (normalize b : K⟦ℝ⟧).supportOrderType = (b : K⟦ℝ⟧).supportOrderType := + supportOrderType_normalize b + have hcot : (normalize c : K⟦ℝ⟧).supportOrderType = (c : K⟦ℝ⟧).supportOrderType := + supportOrderType_normalize c + have hmul : (b : K⟦ℝ⟧) * (c : K⟦ℝ⟧) + = HahnSeries.translate (sb + sc) + ((normalize b : K⟦ℝ⟧) * (normalize c : K⟦ℝ⟧)) := by + have h := HahnSeries.translate_mul_translate sb sc + (normalize b : K⟦ℝ⟧) (normalize c : K⟦ℝ⟧) + rwa [translate_csSup_normalize b, translate_csSup_normalize c] at h + rw [show ((b * c : Berarducci.Series K) : K⟦ℝ⟧) = + (b : K⟦ℝ⟧) * (c : K⟦ℝ⟧) from rfl, + hmul, HahnSeries.supportOrderType_translate, ← hbot, ← hcot] + exact Berarducci.supportOrderType_mul_of_notMem_negativeMonomialIdeal + (by rwa [isWeaklyPrincipal_iff, hbot, ← isWeaklyPrincipal_iff]) + (by rwa [isWeaklyPrincipal_iff, hcot, ← isWeaklyPrincipal_iff]) + (not_mem_negativeMonomialIdeal_of_supportSup_eq_zero (supportSup_normalize (hne b hb))) + (not_mem_negativeMonomialIdeal_of_supportSup_eq_zero (supportSup_normalize (hne c hc))) + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValue.lean new file mode 100644 index 0000000000..63b75d3bd7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValue.lean @@ -0,0 +1,422 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Basic + +import Mathlib.Tactic.Abel + +/-! +# Berarducci's ordinal value + +This module defines the ordinal value `Berarducci.ordinalValue` by the three disjoint clauses in +Berarducci, Definition 5.2 and LM24, Section 2.7: + +* it is zero on the negative-monomial ideal `J`; +* it is one on `(J + K) \ J`; +* otherwise it is the least support order type among representatives congruent modulo `J + K`. + +`NatOrdinal` is a type synonym for ordinals equipped with Hessenberg addition and multiplication; +its underlying order is the ordinary ordinal order. Using it here preserves the source value while +making the later multiplicative statement type-correct without introducing parallel operations. + +The third branch is not postulated to have a minimum. Its candidate set contains the original +series, and the well-order of `NatOrdinal` proves that its infimum is a member and is least. The +characteristic theorems prove the exact zero and one fibers, invariance modulo `J`, and the induced +separated value on the germ quotient. No additive or multiplicative law is asserted in this file. + +The definition and these order-theoretic properties make sense over any field. Berarducci's +additive and multiplicative theorems retain the source's characteristic-zero hypothesis. +-/ + +universe v + +public noncomputable section + +namespace Berarducci + +open HahnSeries + +variable {K : Type v} [Field K] + +/-- The support order types of series congruent to `b` modulo Berarducci's subgroup `J + K`. -/ +def representativeOrderTypes (b : Series K) : Set NatOrdinal := + {o | ∃ c : Series K, + b - c ∈ nearConstantSubgroup K ∧ + NatOrdinal.of (c : K⟦ℝ⟧).supportOrderType = o} + +/-- Membership in the set of support order types of representatives congruent to `b`. -/ +theorem mem_representativeOrderTypes_iff {b : Series K} {o : NatOrdinal} : + o ∈ representativeOrderTypes b ↔ + ∃ c : Series K, + b - c ∈ nearConstantSubgroup K ∧ + NatOrdinal.of (c : K⟦ℝ⟧).supportOrderType = o := by + rfl + +/-- The candidate set for the third branch of the ordinal value is nonempty. -/ +theorem representativeOrderTypes_nonempty (b : Series K) : + (representativeOrderTypes b).Nonempty := by + refine ⟨NatOrdinal.of (b : K⟦ℝ⟧).supportOrderType, b, ?_, rfl⟩ + simp + +/-- Berarducci's ordinal value on nonpositive real Hahn series. -/ +noncomputable def ordinalValue (b : Series K) : NatOrdinal := by + classical + exact if b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K then 0 + else if b ∈ nearConstantSubgroup K then 1 + else sInf (representativeOrderTypes b) + +/-- The first defining clause of the ordinal value. -/ +theorem ordinalValue_of_mem_negativeMonomialIdeal {b : Series K} + (hb : b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K) : + ordinalValue b = 0 := by + simp [ordinalValue, hb] + +/-- The second defining clause of the ordinal value. -/ +theorem ordinalValue_of_mem_nearConstantSubgroup_of_not_mem_negativeMonomialIdeal + {b : Series K} (hbNear : b ∈ nearConstantSubgroup K) + (hbJ : b ∉ HahnSeries.Nonpositive.negativeMonomialIdeal K) : + ordinalValue b = 1 := by + simp [ordinalValue, hbJ, hbNear] + +/-- The third defining clause of the ordinal value. -/ +theorem ordinalValue_of_not_mem_nearConstantSubgroup {b : Series K} + (hb : b ∉ nearConstantSubgroup K) : + ordinalValue b = sInf (representativeOrderTypes b) := by + have hbJ : b ∉ HahnSeries.Nonpositive.negativeMonomialIdeal K := + fun hbJ ↦ hb (negativeMonomialIdeal_le_nearConstantSubgroup hbJ) + simp [ordinalValue, hbJ, hb] + +/-- Outside `J + K`, the ordinal value is attained by a congruent representative. -/ +theorem ordinalValue_mem_representativeOrderTypes_of_not_mem_nearConstantSubgroup + {b : Series K} + (hb : b ∉ nearConstantSubgroup K) : + ordinalValue b ∈ representativeOrderTypes b := by + rw [ordinalValue_of_not_mem_nearConstantSubgroup hb] + exact csInf_mem (representativeOrderTypes_nonempty b) + +/-- The support order type of a nonzero constant series is one. -/ +private theorem supportOrderType_C_eq_one {k : K} (hk : k ≠ 0) : + ((HahnSeries.Nonpositive.C k : Series K) : K⟦ℝ⟧).supportOrderType = 1 := by + rw [HahnSeries.Nonpositive.coe_C, HahnSeries.C_apply] + exact HahnSeries.supportOrderType_single hk + +/-- In every branch of its definition, the ordinal value is attained by a representative +congruent modulo `J + K`. -/ +theorem ordinalValue_mem_representativeOrderTypes (b : Series K) : + ordinalValue b ∈ representativeOrderTypes b := by + by_cases hbJ : b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K + · rw [ordinalValue_of_mem_negativeMonomialIdeal hbJ] + apply mem_representativeOrderTypes_iff.mpr + refine ⟨0, ?_, by simp⟩ + exact negativeMonomialIdeal_le_nearConstantSubgroup (by simpa using hbJ) + by_cases hbNear : b ∈ nearConstantSubgroup K + · rw [ordinalValue_of_mem_nearConstantSubgroup_of_not_mem_negativeMonomialIdeal + hbNear hbJ] + let k := HahnSeries.Nonpositive.constantCoeff b + have hk : k ≠ 0 := by + intro hk + apply hbJ + have hsub := mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem.mp hbNear + simpa [k, hk] using hsub + apply mem_representativeOrderTypes_iff.mpr + refine ⟨HahnSeries.Nonpositive.C k, ?_, ?_⟩ + · exact negativeMonomialIdeal_le_nearConstantSubgroup + (mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem.mp hbNear) + · rw [supportOrderType_C_eq_one hk] + simp + · exact ordinalValue_mem_representativeOrderTypes_of_not_mem_nearConstantSubgroup hbNear + +/-- A common lower bound for all representative support order types is a lower bound for the +ordinal value. -/ +theorem le_ordinalValue_of_forall_mem_representativeOrderTypes + {b : Series K} {o : NatOrdinal} + (h : ∀ p ∈ representativeOrderTypes b, o ≤ p) : + o ≤ ordinalValue b := + h _ (ordinalValue_mem_representativeOrderTypes b) + +/-- Outside `J + K`, the ordinal value is the least candidate support order type. -/ +theorem ordinalValue_isLeast_representativeOrderTypes {b : Series K} + (hb : b ∉ nearConstantSubgroup K) : + IsLeast (representativeOrderTypes b) (ordinalValue b) := by + refine ⟨ordinalValue_mem_representativeOrderTypes b, ?_⟩ + intro o ho + rw [ordinalValue_of_not_mem_nearConstantSubgroup hb] + exact csInf_le' ho + +private theorem mem_nearConstantSubgroup_of_supportOrderType_le_one + {b : Series K} + (hbType : NatOrdinal.of (b : K⟦ℝ⟧).supportOrderType ≤ 1) : + b ∈ nearConstantSubgroup K := by + rcases Order.le_one_iff.mp hbType with hbZero | hbOne + · have hbTypeZero : (b : K⟦ℝ⟧).supportOrderType = 0 := by + simpa using hbZero + have hb : b = 0 := by + apply Subtype.ext + exact HahnSeries.supportOrderType_eq_zero.mp hbTypeZero + subst b + exact (nearConstantSubgroup K).zero_mem + · have hbTypeOne : (b : K⟦ℝ⟧).supportOrderType = 1 := by + simpa using hbOne + letI : WellFoundedLT (b : K⟦ℝ⟧).support := + ⟨(b : K⟦ℝ⟧).isWF_support⟩ + have htype : Ordinal.type + (fun x y : (b : K⟦ℝ⟧).support ↦ x < y) = 1 := by + rw [← HahnSeries.supportOrderType_eq_typeLT (x := (b : K⟦ℝ⟧)) + (OrderIso.refl (b : K⟦ℝ⟧).support)] + exact hbTypeOne + obtain ⟨hUnique⟩ := Ordinal.type_eq_one_iff_unique.mp htype + letI : Unique (b : K⟦ℝ⟧).support := hUnique + let g : (b : K⟦ℝ⟧).support := default + have hsupport : (b : K⟦ℝ⟧).support = {(g : ℝ)} := by + ext x + constructor + · intro hx + have heq : (⟨x, hx⟩ : (b : K⟦ℝ⟧).support) = g := + Subsingleton.elim _ _ + exact Set.mem_singleton_iff.mpr (congrArg Subtype.val heq) + · intro hx + rw [Set.mem_singleton_iff] at hx + subst x + exact g.2 + have hbSingle : (b : K⟦ℝ⟧) = + HahnSeries.single (g : ℝ) ((b : K⟦ℝ⟧).coeff g) := by + ext x + by_cases hx : x = (g : ℝ) + · subst x + simp + · have hxSupport : x ∉ (b : K⟦ℝ⟧).support := by + rw [hsupport] + simpa using hx + have hxCoeff : (b : K⟦ℝ⟧).coeff x = 0 := by + rw [HahnSeries.mem_support] at hxSupport + exact not_ne_iff.mp hxSupport + simp [hx, hxCoeff] + have hgNonpositive : (g : ℝ) ≤ 0 := + HahnSeries.Nonpositive.support_subset b g.2 + rcases hgNonpositive.eq_or_lt with hgZero | hgNegative + · apply mem_nearConstantSubgroup_iff.mpr + refine ⟨0, (HahnSeries.Nonpositive.negativeMonomialIdeal K).zero_mem, + (b : K⟦ℝ⟧).coeff g, ?_⟩ + apply Subtype.ext + simp only [zero_add, HahnSeries.Nonpositive.coe_C] + calc + HahnSeries.C ((b : K⟦ℝ⟧).coeff g) = + HahnSeries.single 0 ((b : K⟦ℝ⟧).coeff g) := rfl + _ = HahnSeries.single (g : ℝ) ((b : K⟦ℝ⟧).coeff g) := by + rw [hgZero] + _ = (b : K⟦ℝ⟧) := hbSingle.symm + · apply negativeMonomialIdeal_le_nearConstantSubgroup + have hgen := HahnSeries.Nonpositive.single_one_mem_negativeMonomialIdeal + (K := K) hgNegative + have hmul := Ideal.mul_mem_left + (HahnSeries.Nonpositive.negativeMonomialIdeal K) + (HahnSeries.Nonpositive.C ((b : K⟦ℝ⟧).coeff g)) hgen + have hproduct : HahnSeries.Nonpositive.C ((b : K⟦ℝ⟧).coeff g) * + HahnSeries.Nonpositive.single (g : ℝ) 1 hgNegative.le = b := by + apply Subtype.ext + simp only [Subring.coe_mul, HahnSeries.Nonpositive.coe_C, + HahnSeries.Nonpositive.coe_single] + change HahnSeries.single 0 ((b : K⟦ℝ⟧).coeff g) * + HahnSeries.single (g : ℝ) 1 = (b : K⟦ℝ⟧) + rw [HahnSeries.single_mul_single, zero_add, mul_one] + exact hbSingle.symm + rwa [hproduct] at hmul + +/-- The zero fiber of the ordinal value is exactly the negative-monomial ideal. -/ +theorem ordinalValue_eq_zero_iff {b : Series K} : + ordinalValue b = 0 ↔ + b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + constructor + · intro hvalue + by_contra hbJ + by_cases hbNear : b ∈ nearConstantSubgroup K + · rw [ordinalValue_of_mem_nearConstantSubgroup_of_not_mem_negativeMonomialIdeal + hbNear hbJ] at hvalue + exact one_ne_zero hvalue + · obtain ⟨c, hcb, hcType⟩ := + ordinalValue_mem_representativeOrderTypes_of_not_mem_nearConstantSubgroup hbNear + rw [hvalue] at hcType + have hcTypeZero : (c : K⟦ℝ⟧).supportOrderType = 0 := by + simpa using hcType + have hc : c = 0 := by + apply Subtype.ext + exact HahnSeries.supportOrderType_eq_zero.mp hcTypeZero + subst c + exact hbNear (by simpa using hcb) + · exact ordinalValue_of_mem_negativeMonomialIdeal + +/-- The one fiber of the ordinal value is exactly `(J + K) \ J`. -/ +theorem ordinalValue_eq_one_iff {b : Series K} : + ordinalValue b = 1 ↔ + b ∈ nearConstantSubgroup K ∧ + b ∉ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + constructor + · intro hvalue + have hbJ : b ∉ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + intro hbJ + rw [ordinalValue_of_mem_negativeMonomialIdeal hbJ] at hvalue + exact zero_ne_one hvalue + refine ⟨?_, hbJ⟩ + by_contra hbNear + obtain ⟨c, hcb, hcType⟩ := + ordinalValue_mem_representativeOrderTypes_of_not_mem_nearConstantSubgroup hbNear + rw [hvalue] at hcType + have hcNear : c ∈ nearConstantSubgroup K := + mem_nearConstantSubgroup_of_supportOrderType_le_one hcType.le + have hbNear' := (nearConstantSubgroup K).add_mem hcb hcNear + apply hbNear + have heq : (b - c) + c = b := by abel + rwa [heq] at hbNear' + · rintro ⟨hbNear, hbJ⟩ + exact ordinalValue_of_mem_nearConstantSubgroup_of_not_mem_negativeMonomialIdeal + hbNear hbJ + +/-- The third branch consists exactly of the series outside `J + K`. -/ +theorem one_lt_ordinalValue_iff {b : Series K} : + 1 < ordinalValue b ↔ b ∉ nearConstantSubgroup K := by + constructor + · intro hvalue hbNear + by_cases hbJ : b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K + · rw [ordinalValue_of_mem_negativeMonomialIdeal hbJ] at hvalue + exact (not_lt_of_ge zero_le_one) hvalue + · rw [ordinalValue_of_mem_nearConstantSubgroup_of_not_mem_negativeMonomialIdeal + hbNear hbJ] at hvalue + exact (lt_irrefl 1) hvalue + · intro hbNear + apply lt_of_not_ge + intro hle + rcases Order.le_one_iff.mp hle with hzero | hone + · apply hbNear + exact negativeMonomialIdeal_le_nearConstantSubgroup + (ordinalValue_eq_zero_iff.mp hzero) + · exact hbNear (ordinalValue_eq_one_iff.mp hone).1 + +/-- A series with zero constant coefficient and support supremum zero lies in the third branch of +the ordinal value. -/ +theorem one_lt_ordinalValue_of_constantCoeff_eq_zero_of_supportSup_eq_zero + {b : Series K} (hcoeff : HahnSeries.Nonpositive.constantCoeff b = 0) + (hsup : HahnSeries.Nonpositive.supportSup b = 0) : + 1 < ordinalValue b := by + apply one_lt_ordinalValue_iff.mpr + intro hnear + have hmem := mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem.mp hnear + have hbJ : b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + simpa [hcoeff] using hmem + exact + (HahnSeries.Nonpositive.not_mem_negativeMonomialIdeal_of_supportSup_eq_zero hsup) hbJ + +/-- The ordinal value is at most the ordinary order type of the support. -/ +theorem ordinalValue_le_supportOrderType (b : Series K) : + ordinalValue b ≤ NatOrdinal.of (b : K⟦ℝ⟧).supportOrderType := by + by_cases hbJ : b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K + · rw [ordinalValue_of_mem_negativeMonomialIdeal hbJ] + exact bot_le + by_cases hbNear : b ∈ nearConstantSubgroup K + · rw [ordinalValue_of_mem_nearConstantSubgroup_of_not_mem_negativeMonomialIdeal + hbNear hbJ, Order.one_le_iff_pos] + apply bot_lt_iff_ne_bot.mpr + intro htype + have htypeZero : (b : K⟦ℝ⟧).supportOrderType = 0 := by + simpa using htype + have hbZero : b = 0 := by + apply Subtype.ext + exact HahnSeries.supportOrderType_eq_zero.mp htypeZero + subst b + exact hbJ (HahnSeries.Nonpositive.negativeMonomialIdeal K).zero_mem + · rw [ordinalValue_of_not_mem_nearConstantSubgroup hbNear] + apply csInf_le' + exact ⟨b, by simp, rfl⟩ + +private theorem mem_negativeMonomialIdeal_iff_of_sub_mem + {b c : Series K} + (hbc : b - c ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K) : + b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K ↔ + c ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + let J := HahnSeries.Nonpositive.negativeMonomialIdeal K + constructor + · intro hb + have hc : b - (b - c) ∈ J := J.sub_mem hb hbc + have heq : b - (b - c) = c := by abel + rwa [heq] at hc + · intro hc + have hb : (b - c) + c ∈ J := J.add_mem hbc hc + have heq : (b - c) + c = b := by abel + rwa [heq] at hb + +private theorem mem_nearConstantSubgroup_iff_of_sub_mem_negativeMonomialIdeal + {b c : Series K} + (hbc : b - c ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K) : + b ∈ nearConstantSubgroup K ↔ c ∈ nearConstantSubgroup K := by + have hbcNear : b - c ∈ nearConstantSubgroup K := + negativeMonomialIdeal_le_nearConstantSubgroup hbc + constructor + · intro hb + have hc := (nearConstantSubgroup K).sub_mem hb hbcNear + have heq : b - (b - c) = c := by abel + rwa [heq] at hc + · intro hc + have hb := (nearConstantSubgroup K).add_mem hbcNear hc + have heq : (b - c) + c = b := by abel + rwa [heq] at hb + +private theorem representativeOrderTypes_eq_of_sub_mem_negativeMonomialIdeal + {b c : Series K} + (hbc : b - c ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K) : + representativeOrderTypes b = representativeOrderTypes c := by + have hbcNear : b - c ∈ nearConstantSubgroup K := + negativeMonomialIdeal_le_nearConstantSubgroup hbc + have hcbNear : c - b ∈ nearConstantSubgroup K := by + have hneg := (nearConstantSubgroup K).neg_mem hbcNear + have heq : -(b - c) = c - b := by abel + rwa [heq] at hneg + ext o + constructor + · rintro ⟨d, hbd, hdType⟩ + refine ⟨d, ?_, hdType⟩ + have hsum := (nearConstantSubgroup K).add_mem hcbNear hbd + have heq : (c - b) + (b - d) = c - d := by abel + rwa [heq] at hsum + · rintro ⟨d, hcd, hdType⟩ + refine ⟨d, ?_, hdType⟩ + have hsum := (nearConstantSubgroup K).add_mem hbcNear hcd + have heq : (b - c) + (c - d) = b - d := by abel + rwa [heq] at hsum + +/-- The ordinal value depends only on the germ modulo the negative-monomial ideal. -/ +theorem ordinalValue_eq_of_sub_mem_negativeMonomialIdeal {b c : Series K} + (hbc : b - c ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K) : + ordinalValue b = ordinalValue c := by + have hbJ := mem_negativeMonomialIdeal_iff_of_sub_mem hbc + have hbNear := mem_nearConstantSubgroup_iff_of_sub_mem_negativeMonomialIdeal hbc + have htypes := representativeOrderTypes_eq_of_sub_mem_negativeMonomialIdeal hbc + classical + unfold ordinalValue + rw [hbJ, hbNear, htypes] + +/-- The ordinal value induced on Berarducci germs. -/ +noncomputable def germOrdinalValue (q : Germ K) : NatOrdinal := + Quotient.liftOn' q ordinalValue fun _ _ h ↦ + ordinalValue_eq_of_sub_mem_negativeMonomialIdeal + (Ideal.Quotient.eq.mp (Quot.sound h)) + +@[simp] +theorem germOrdinalValue_mk (b : Series K) : + germOrdinalValue + (Ideal.Quotient.mk (HahnSeries.Nonpositive.negativeMonomialIdeal K) b) = + ordinalValue b := + (rfl) + +/-- The induced ordinal value is zero exactly at the zero germ. -/ +theorem germOrdinalValue_eq_zero_iff {q : Germ K} : + germOrdinalValue q = 0 ↔ q = 0 := by + obtain ⟨b, rfl⟩ := Ideal.Quotient.mk_surjective q + rw [germOrdinalValue_mk, ordinalValue_eq_zero_iff] + exact (Ideal.Quotient.eq_zero_iff_mem + (I := HahnSeries.Nonpositive.negativeMonomialIdeal K) (a := b)).symm + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueConstantMul.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueConstantMul.lean new file mode 100644 index 0000000000..1167d4ff0c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueConstantMul.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue + +/-! +# Invariance of Berarducci's ordinal value under nonzero constant factors + +Multiplication by a nonzero constant series is an automorphism of `Berarducci.Series K` fixing +`J` and `J + K` setwise and preserving supports exactly, so it leaves Berarducci's ordinal value +unchanged. Each defining branch is transported separately, the third by showing that the +candidate set `Berarducci.representativeOrderTypes` is literally the same set. + +The proof of the submultiplicative property in Berarducci, Lemma 5.5(2) uses this invariance for +the cross terms produced by representatives modulo `J + K`. +-/ + +universe v + +public noncomputable section + +namespace Berarducci + +open HahnSeries + +variable {K : Type v} [Field K] + +private theorem coe_C_mul (k : K) (b : Series K) : + ((HahnSeries.Nonpositive.C k * b : Series K) : K⟦ℝ⟧) = k • (b : K⟦ℝ⟧) := by + rw [Subring.coe_mul, HahnSeries.Nonpositive.coe_C, HahnSeries.C_mul_eq_smul] + +/-- A nonzero constant factor leaves the support of a nonpositive series unchanged. -/ +theorem support_C_mul_of_ne_zero {k : K} (hk : k ≠ 0) (b : Series K) : + ((HahnSeries.Nonpositive.C k * b : Series K) : K⟦ℝ⟧).support = + (b : K⟦ℝ⟧).support := by + rw [coe_C_mul] + ext x + simp [HahnSeries.mem_support, hk] + +/-- A nonzero constant factor leaves the ordinary support order type unchanged. -/ +theorem supportOrderType_C_mul_of_ne_zero {k : K} (hk : k ≠ 0) (b : Series K) : + ((HahnSeries.Nonpositive.C k * b : Series K) : K⟦ℝ⟧).supportOrderType = + (b : K⟦ℝ⟧).supportOrderType := + le_antisymm + (HahnSeries.supportOrderType_mono (by rw [support_C_mul_of_ne_zero hk])) + (HahnSeries.supportOrderType_mono (by rw [support_C_mul_of_ne_zero hk])) + +/-- A nonzero constant factor does not change membership in the negative-monomial ideal. -/ +theorem mem_negativeMonomialIdeal_C_mul_iff {k : K} (hk : k ≠ 0) (b : Series K) : + HahnSeries.Nonpositive.C k * b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K ↔ + b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + refine ⟨fun h ↦ ?_, fun h ↦ Ideal.mul_mem_left _ _ h⟩ + have hmem := Ideal.mul_mem_left + (HahnSeries.Nonpositive.negativeMonomialIdeal K) (HahnSeries.Nonpositive.C k⁻¹) h + rwa [← mul_assoc, ← map_mul, inv_mul_cancel₀ hk, map_one, one_mul] at hmem + +private theorem C_mul_mem_nearConstantSubgroup (k : K) {b : Series K} + (hb : b ∈ nearConstantSubgroup K) : + HahnSeries.Nonpositive.C k * b ∈ nearConstantSubgroup K := by + obtain ⟨j, hj, c, rfl⟩ := mem_nearConstantSubgroup_iff.mp hb + refine mem_nearConstantSubgroup_iff.mpr + ⟨HahnSeries.Nonpositive.C k * j, Ideal.mul_mem_left _ _ hj, k * c, ?_⟩ + rw [map_mul, mul_add] + +/-- A nonzero constant factor does not change membership in `J + K`. -/ +theorem mem_nearConstantSubgroup_C_mul_iff {k : K} (hk : k ≠ 0) (b : Series K) : + HahnSeries.Nonpositive.C k * b ∈ nearConstantSubgroup K ↔ b ∈ nearConstantSubgroup K := by + refine ⟨fun h ↦ ?_, C_mul_mem_nearConstantSubgroup k⟩ + have hmem := C_mul_mem_nearConstantSubgroup k⁻¹ h + rwa [← mul_assoc, ← map_mul, inv_mul_cancel₀ hk, map_one, one_mul] at hmem + +/-- A nonzero constant factor permutes the representatives modulo `J + K`, so the candidate set of +support order types is unchanged. -/ +theorem representativeOrderTypes_C_mul {k : K} (hk : k ≠ 0) (b : Series K) : + representativeOrderTypes (HahnSeries.Nonpositive.C k * b) = representativeOrderTypes b := by + ext o + rw [mem_representativeOrderTypes_iff, mem_representativeOrderTypes_iff] + constructor + · rintro ⟨d, hd, rfl⟩ + refine ⟨HahnSeries.Nonpositive.C k⁻¹ * d, ?_, ?_⟩ + · have hmem := C_mul_mem_nearConstantSubgroup k⁻¹ hd + rwa [mul_sub, ← mul_assoc, ← map_mul, inv_mul_cancel₀ hk, map_one, one_mul] at hmem + · rw [supportOrderType_C_mul_of_ne_zero (inv_ne_zero hk)] + · rintro ⟨d, hd, rfl⟩ + refine ⟨HahnSeries.Nonpositive.C k * d, ?_, ?_⟩ + · have hmem := C_mul_mem_nearConstantSubgroup k hd + rwa [mul_sub] at hmem + · rw [supportOrderType_C_mul_of_ne_zero hk] + +/-- Berarducci's ordinal value is invariant under multiplication by a nonzero constant series. -/ +theorem ordinalValue_C_mul {k : K} (hk : k ≠ 0) (b : Series K) : + ordinalValue (HahnSeries.Nonpositive.C k * b) = ordinalValue b := by + by_cases hbJ : b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K + · rw [ordinalValue_of_mem_negativeMonomialIdeal + ((mem_negativeMonomialIdeal_C_mul_iff hk b).mpr hbJ), + ordinalValue_of_mem_negativeMonomialIdeal hbJ] + by_cases hbNear : b ∈ nearConstantSubgroup K + · rw [ordinalValue_of_mem_nearConstantSubgroup_of_not_mem_negativeMonomialIdeal + ((mem_nearConstantSubgroup_C_mul_iff hk b).mpr hbNear) + (fun h ↦ hbJ ((mem_negativeMonomialIdeal_C_mul_iff hk b).mp h)), + ordinalValue_of_mem_nearConstantSubgroup_of_not_mem_negativeMonomialIdeal hbNear hbJ] + · rw [ordinalValue_of_not_mem_nearConstantSubgroup + (fun h ↦ hbNear ((mem_nearConstantSubgroup_C_mul_iff hk b).mp h)), + ordinalValue_of_not_mem_nearConstantSubgroup hbNear, + representativeOrderTypes_C_mul hk] + +@[simp] +theorem ordinalValue_one : ordinalValue (1 : Series K) = 1 := by + rw [ordinalValue_eq_one_iff] + refine ⟨mem_nearConstantSubgroup_iff.mpr ⟨0, Submodule.zero_mem _, 1, by simp⟩, + fun h ↦ ?_⟩ + have hc := constantCoeff_eq_zero_of_mem_negativeMonomialIdeal h + simp at hc + +/-- A factor of ordinal value one does not change the value of a product: it is a nonzero +constant modulo `J`, and `J` is an ideal. -/ +theorem ordinalValue_mul_of_ordinalValue_eq_one {g : Series K} (hg : ordinalValue g = 1) (y : + Series K) : + ordinalValue (g * y) = ordinalValue y := by + obtain ⟨hnear, hnotJ⟩ := ordinalValue_eq_one_iff.mp hg + set k := HahnSeries.Nonpositive.constantCoeff g with hk + have hsub : g - HahnSeries.Nonpositive.C k ∈ + HahnSeries.Nonpositive.negativeMonomialIdeal K := + mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem.mp hnear + have hkne : k ≠ 0 := by + intro h + rw [h, map_zero, sub_zero] at hsub + exact hnotJ hsub + have hmul : g * y - HahnSeries.Nonpositive.C k * y ∈ + HahnSeries.Nonpositive.negativeMonomialIdeal K := by + rw [← sub_mul] + exact Ideal.mul_mem_right _ _ hsub + rw [ordinalValue_eq_of_sub_mem_negativeMonomialIdeal hmul, ordinalValue_C_mul hkne] + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueDegree.lean new file mode 100644 index 0000000000..91e47a7886 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueDegree.lean @@ -0,0 +1,329 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueConstantMul + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +import Mathlib.Tactic.Abel + +/-! +# The exponent of Berarducci's ordinal value + +The value `Berarducci.ordinalValueDegree b` is the leading Cantor exponent of Berarducci's order +value `v_J(b)`, with bottom value on the ideal `J`. LM24 does not introduce separate notation for +this exponent-valued transform; it supplies the ordinal-value properties from which the +construction is derived. + +The additive part is proved from the intrinsic minimum defining `ordinalValue`. First, minimal +representatives give a Hessenberg-sum bound. The fact that every nonzero ordinal value is a power +of `ω` sharpens this to the max-form inequality in LM24, Fact 2.7.1(1), and gives the max-form +inequality for `ordinalValueDegree`. + +The ordinal value is invariant under multiplication by a nonzero constant, hence under negation, +and its kernel is exactly `J`. The weak and strict cuts `ordinalValueDegree b ≤ α` and +`ordinalValueDegree b < α` are identified with the intrinsic cuts `v_J(b) < ω^(α+1)` and +`v_J(b) < ω^α`. + +Everything here is valid over any field. Multiplicativity of the ordinal value is kept as the +explicit proposition `OrdinalValueMultiplicative K`, with its consequence for the exponent; it is +Berarducci, Theorem 9.7, proved with its characteristic-zero hypothesis in +`ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue`. The exponent is +bundled as the max-additive degree `ordinalValueDegreeValuation` in +`ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueValuation`, from the +submultiplicative bound of Berarducci, Lemma 5.5 alone. +-/ + +universe v + +public noncomputable section + +namespace Berarducci + +open HahnSeries + +variable {K : Type v} [Field K] + +@[simp] +theorem ordinalValue_zero : ordinalValue (0 : Series K) = 0 := + ordinalValue_of_mem_negativeMonomialIdeal + (HahnSeries.Nonpositive.negativeMonomialIdeal K).zero_mem + +/-- A nonzero constant series has ordinal value one. -/ +theorem ordinalValue_C_of_ne {k : K} (hk : k ≠ 0) : + ordinalValue (HahnSeries.Nonpositive.C k : Series K) = 1 := by + apply ordinalValue_of_mem_nearConstantSubgroup_of_not_mem_negativeMonomialIdeal + · apply mem_nearConstantSubgroup_iff.mpr + exact ⟨0, (HahnSeries.Nonpositive.negativeMonomialIdeal K).zero_mem, k, by simp⟩ + · intro hmem + have hcoeff := constantCoeff_eq_zero_of_mem_negativeMonomialIdeal hmem + exact hk (by simpa using hcoeff) + +/-- The ordinal value is invariant under negation: `-b = C (-1) * b`, and a nonzero constant +factor does not change the ordinal value. -/ +@[simp] +theorem ordinalValue_neg (b : Series K) : ordinalValue (-b) = ordinalValue b := by + have hnegOne : (-1 : Series K) = HahnSeries.Nonpositive.C (-1 : K) := by simp + rw [← neg_one_mul b, hnegOne, ordinalValue_C_mul (neg_ne_zero.mpr one_ne_zero)] + +private theorem representativeOrderTypes_eq_of_sub_mem_nearConstantSubgroup + {b c : Series K} (hbc : b - c ∈ nearConstantSubgroup K) : + representativeOrderTypes b = representativeOrderTypes c := by + have hcb : c - b ∈ nearConstantSubgroup K := by + have hneg := (nearConstantSubgroup K).neg_mem hbc + have heq : -(b - c) = c - b := by abel + rwa [heq] at hneg + ext o + constructor + · intro ho + obtain ⟨d, hbd, hd⟩ := mem_representativeOrderTypes_iff.mp ho + apply mem_representativeOrderTypes_iff.mpr + refine ⟨d, ?_, hd⟩ + have hsum := (nearConstantSubgroup K).add_mem hcb hbd + have heq : (c - b) + (b - d) = c - d := by abel + rwa [heq] at hsum + · intro ho + obtain ⟨d, hcd, hd⟩ := mem_representativeOrderTypes_iff.mp ho + apply mem_representativeOrderTypes_iff.mpr + refine ⟨d, ?_, hd⟩ + have hsum := (nearConstantSubgroup K).add_mem hbc hcd + have heq : (b - c) + (c - d) = b - d := by abel + rwa [heq] at hsum + +private theorem ordinalValue_eq_of_sub_mem_nearConstantSubgroup + {b c : Series K} (hb : b ∉ nearConstantSubgroup K) + (hc : c ∉ nearConstantSubgroup K) + (hbc : b - c ∈ nearConstantSubgroup K) : + ordinalValue b = ordinalValue c := by + rw [ordinalValue_of_not_mem_nearConstantSubgroup hb, + ordinalValue_of_not_mem_nearConstantSubgroup hc, + representativeOrderTypes_eq_of_sub_mem_nearConstantSubgroup hbc] + +/-- The ordinal value of a sum is bounded by the Hessenberg sum of the two ordinal values. -/ +theorem ordinalValue_add_le_naturalAdd (b c : Series K) : + ordinalValue (b + c) ≤ ordinalValue b + ordinalValue c := by + by_cases hsumNear : b + c ∈ nearConstantSubgroup K + · by_cases hsumJ : b + c ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K + · rw [ordinalValue_of_mem_negativeMonomialIdeal hsumJ] + exact bot_le + · rw [ordinalValue_of_mem_nearConstantSubgroup_of_not_mem_negativeMonomialIdeal + hsumNear hsumJ] + rw [Order.one_le_iff_pos, pos_iff_ne_zero] + intro hzero + have hbZero : ordinalValue b = 0 := + (NatOrdinal.add_eq_zero_iff.mp hzero).1 + have hcZero : ordinalValue c = 0 := + (NatOrdinal.add_eq_zero_iff.mp hzero).2 + have hbJ := ordinalValue_eq_zero_iff.mp hbZero + have hcJ := ordinalValue_eq_zero_iff.mp hcZero + exact hsumJ ((HahnSeries.Nonpositive.negativeMonomialIdeal K).add_mem hbJ hcJ) + · by_cases hbNear : b ∈ nearConstantSubgroup K + · have hcNear : c ∉ nearConstantSubgroup K := by + intro hcNear + exact hsumNear ((nearConstantSubgroup K).add_mem hbNear hcNear) + have hdiff : (b + c) - c ∈ nearConstantSubgroup K := by + simpa only [add_sub_cancel_right] using hbNear + rw [ordinalValue_eq_of_sub_mem_nearConstantSubgroup hsumNear hcNear hdiff] + exact NatOrdinal.le_add_left + · by_cases hcNear : c ∈ nearConstantSubgroup K + · have hdiff : (b + c) - b ∈ nearConstantSubgroup K := by + have heq : (b + c) - b = c := by abel + rwa [heq] + rw [ordinalValue_eq_of_sub_mem_nearConstantSubgroup hsumNear hbNear hdiff] + exact NatOrdinal.le_add_right + · obtain ⟨b', hbb', hb'Type⟩ := + mem_representativeOrderTypes_iff.mp + (ordinalValue_mem_representativeOrderTypes b) + obtain ⟨c', hcc', hc'Type⟩ := + mem_representativeOrderTypes_iff.mp + (ordinalValue_mem_representativeOrderTypes c) + have hcandidate : + NatOrdinal.of (((b' + c' : Series K) : K⟦ℝ⟧).supportOrderType) ∈ + representativeOrderTypes (b + c) := by + apply mem_representativeOrderTypes_iff.mpr + refine ⟨b' + c', ?_, rfl⟩ + have hsum := (nearConstantSubgroup K).add_mem hbb' hcc' + have heq : (b + c) - (b' + c') = (b - b') + (c - c') := by abel + rwa [heq] + calc + ordinalValue (b + c) ≤ + NatOrdinal.of (((b' + c' : Series K) : K⟦ℝ⟧).supportOrderType) := + (ordinalValue_isLeast_representativeOrderTypes hsumNear).2 hcandidate + _ ≤ NatOrdinal.of ((NatOrdinal.of (b' : K⟦ℝ⟧).supportOrderType + + NatOrdinal.of (c' : K⟦ℝ⟧).supportOrderType).val) := + NatOrdinal.of.monotone + (HahnSeries.supportOrderType_add_le_naturalAdd + (b' : K⟦ℝ⟧) (c' : K⟦ℝ⟧)) + _ = ordinalValue b + ordinalValue c := by + rw [NatOrdinal.of_val, hb'Type, hc'Type] + +/-- The leading Cantor exponent of Berarducci's ordinal value, with bottom on `J`. -/ +def ordinalValueDegree (b : Series K) : WithBot NatOrdinal := + NatOrdinal.cantorDegree (ordinalValue b) + +@[simp] +theorem ordinalValueDegree_eq_bot_iff {b : Series K} : + ordinalValueDegree b = ⊥ ↔ + b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + rw [ordinalValueDegree, NatOrdinal.cantorDegree_eq_bot, ordinalValue_eq_zero_iff] + +@[simp] +theorem ordinalValueDegree_zero : ordinalValueDegree (0 : Series K) = ⊥ := by + rw [ordinalValueDegree_eq_bot_iff] + exact (HahnSeries.Nonpositive.negativeMonomialIdeal K).zero_mem + +@[simp] +theorem ordinalValueDegree_one : ordinalValueDegree (1 : Series K) = 0 := by + rw [ordinalValueDegree, ordinalValue_one] + simpa using NatOrdinal.cantorDegree_wpow (0 : NatOrdinal) + +/-- A nonzero constant series has ordinal-value degree zero. -/ +theorem ordinalValueDegree_C_of_ne {k : K} (hk : k ≠ 0) : + ordinalValueDegree (HahnSeries.Nonpositive.C k : Series K) = 0 := by + rw [ordinalValueDegree, ordinalValue_C_of_ne hk] + simpa using NatOrdinal.cantorDegree_wpow (0 : NatOrdinal) + +/-- The exponent-valued ordinal value is the leading Cantor exponent of the ordinal value. -/ +theorem ordinalValueDegree_eq_cantorDegree (b : Series K) : + ordinalValueDegree b = NatOrdinal.cantorDegree (ordinalValue b) := + (rfl) + +/-- A nonzero constant factor does not change the exponent-valued ordinal value. -/ +theorem ordinalValueDegree_C_mul {k : K} (hk : k ≠ 0) (b : Series K) : + ordinalValueDegree (HahnSeries.Nonpositive.C k * b) = ordinalValueDegree b := by + rw [ordinalValueDegree, ordinalValueDegree, ordinalValue_C_mul hk] + +/-- The exponent-valued ordinal value is invariant under negation. -/ +@[simp] +theorem ordinalValueDegree_neg (b : Series K) : ordinalValueDegree (-b) = ordinalValueDegree b := by + rw [ordinalValueDegree, ordinalValueDegree, ordinalValue_neg] + +/-- Weak degree filtration in terms of the corresponding ordinal-value cut. -/ +theorem ordinalValueDegree_le_coe_iff (b : Series K) (α : NatOrdinal) : + ordinalValueDegree b ≤ (α : WithBot NatOrdinal) ↔ ordinalValue b < ω^ (α + 1) := + NatOrdinal.cantorDegree_le_coe_iff _ _ + +/-- Strict degree filtration in terms of the corresponding ordinal-value cut. -/ +theorem ordinalValueDegree_lt_coe_iff (b : Series K) (α : NatOrdinal) : + ordinalValueDegree b < (α : WithBot NatOrdinal) ↔ ordinalValue b < ω^ α := + NatOrdinal.cantorDegree_lt_coe_iff _ _ + +/-- The exponent-valued ordinal value satisfies the max-form additive inequality. -/ +theorem ordinalValueDegree_add_le_max (b c : Series K) : + ordinalValueDegree (b + c) ≤ max (ordinalValueDegree b) (ordinalValueDegree c) := by + change NatOrdinal.cantorDegree (ordinalValue (b + c)) ≤ + max (NatOrdinal.cantorDegree (ordinalValue b)) + (NatOrdinal.cantorDegree (ordinalValue c)) + calc + NatOrdinal.cantorDegree (ordinalValue (b + c)) ≤ + NatOrdinal.cantorDegree (ordinalValue b + ordinalValue c) := + by + rw [NatOrdinal.cantorDegree_eq_ordinalCantorDegree, + NatOrdinal.cantorDegree_eq_ordinalCantorDegree] + exact Ordinal.cantorDegree_mono + (NatOrdinal.val.monotone (ordinalValue_add_le_naturalAdd b c)) + _ = max (ordinalValueDegree b) (ordinalValueDegree c) := + NatOrdinal.cantorDegree_add _ _ + +private theorem exists_ordinalValueDegree_eq_and_ordinalValue_eq_wpow + {b : Series K} (hb : ordinalValue b ≠ 0) : + ∃ α : NatOrdinal, + ordinalValueDegree b = (α : WithBot NatOrdinal) ∧ ordinalValue b = ω^ α := by + rcases ordinalValue_eq_zero_or_isAdditivelyPrincipal b with hzero | hprincipal + · exact (hb hzero).elim + obtain ⟨α, hα⟩ := Ordinal.isAdditivelyPrincipal_iff.mp hprincipal + let a : NatOrdinal := NatOrdinal.of α + have hvalue : ordinalValue b = ω^ a := by + apply NatOrdinal.val.injective + simpa only [a, NatOrdinal.val_wpow, NatOrdinal.val_of] using hα + refine ⟨a, ?_, hvalue⟩ + rw [ordinalValueDegree, hvalue, NatOrdinal.cantorDegree_wpow] + +/-- An ordinal value has degree `α` exactly when it is the pure power `ω^α`. -/ +theorem ordinalValueDegree_eq_coe_iff (b : Series K) (α : NatOrdinal) : + ordinalValueDegree b = (α : WithBot NatOrdinal) ↔ ordinalValue b = ω^ α := by + constructor + · intro hdegree + have hvalueNe : ordinalValue b ≠ 0 := by + intro hzero + have hbot : ordinalValueDegree b = ⊥ := by + rw [ordinalValueDegree, hzero, NatOrdinal.cantorDegree_zero] + exact WithBot.bot_ne_coe (hbot.symm.trans hdegree) + obtain ⟨d, hdDegree, hdValue⟩ := + exists_ordinalValueDegree_eq_and_ordinalValue_eq_wpow hvalueNe + have hdα : d = α := WithBot.coe_eq_coe.mp (hdDegree.symm.trans hdegree) + rwa [hdα] at hdValue + · intro hvalue + rw [ordinalValueDegree, hvalue, NatOrdinal.cantorDegree_wpow] + +/-- Berarducci's ordinal-value degree never exceeds the Hahn-series degree. -/ +theorem ordinalValueDegree_le_degree (b : Series K) : + ordinalValueDegree b ≤ (b : K⟦ℝ⟧).degree := by + rw [ordinalValueDegree, NatOrdinal.cantorDegree_eq_ordinalCantorDegree, + HahnSeries.degree_eq_cantorDegree] + apply Ordinal.cantorDegree_mono + simpa using NatOrdinal.val.monotone (ordinalValue_le_supportOrderType b) + +/-- Berarducci's ordinal value satisfies the max-form inequality in LM24, Fact 2.7.1(1). -/ +theorem ordinalValue_add_le_max (b c : Series K) : + ordinalValue (b + c) ≤ max (ordinalValue b) (ordinalValue c) := by + by_cases hsumZero : ordinalValue (b + c) = 0 + · rw [hsumZero] + exact bot_le + by_cases hbZero : ordinalValue b = 0 + · calc + ordinalValue (b + c) ≤ ordinalValue b + ordinalValue c := + ordinalValue_add_le_naturalAdd b c + _ = ordinalValue c := by rw [hbZero, zero_add] + _ ≤ max (ordinalValue b) (ordinalValue c) := le_max_right _ _ + by_cases hcZero : ordinalValue c = 0 + · calc + ordinalValue (b + c) ≤ ordinalValue b + ordinalValue c := + ordinalValue_add_le_naturalAdd b c + _ = ordinalValue b := by rw [hcZero, add_zero] + _ ≤ max (ordinalValue b) (ordinalValue c) := le_max_left _ _ + obtain ⟨s, hsDegree, hsValue⟩ := + exists_ordinalValueDegree_eq_and_ordinalValue_eq_wpow hsumZero + obtain ⟨a, haDegree, haValue⟩ := + exists_ordinalValueDegree_eq_and_ordinalValue_eq_wpow hbZero + obtain ⟨d, hdDegree, hdValue⟩ := + exists_ordinalValueDegree_eq_and_ordinalValue_eq_wpow hcZero + have hdegree := ordinalValueDegree_add_le_max b c + rw [hsDegree, haDegree, hdDegree, ← WithBot.coe_max, WithBot.coe_le_coe] at hdegree + rw [hsValue, haValue, hdValue] + rcases le_total a d with had | hda + · rw [max_eq_right (NatOrdinal.wpow_le_wpow.mpr had)] + exact NatOrdinal.wpow_le_wpow.mpr (hdegree.trans_eq (max_eq_right had)) + · rw [max_eq_left (NatOrdinal.wpow_le_wpow.mpr hda)] + exact NatOrdinal.wpow_le_wpow.mpr (hdegree.trans_eq (max_eq_left hda)) + +/-- Multiplicativity of Berarducci's ordinal value, isolated from its definitions. -/ +def OrdinalValueMultiplicative (K : Type v) [Field K] : Prop := + ∀ b c : Series K, ordinalValue (b * c) = ordinalValue b * ordinalValue c + +/-- Establish Berarducci ordinal-value multiplicativity from the two-series identity. -/ +theorem OrdinalValueMultiplicative.of_forall + (h : ∀ b c : Series K, ordinalValue (b * c) = ordinalValue b * ordinalValue c) : + OrdinalValueMultiplicative K := h + +/-- Apply Berarducci ordinal-value multiplicativity to two series. -/ +theorem OrdinalValueMultiplicative.ordinalValue_mul + (hmul : OrdinalValueMultiplicative K) (b c : Series K) : + ordinalValue (b * c) = ordinalValue b * ordinalValue c := + hmul b c + +/-- Multiplicativity of the exponent-valued ordinal value, assuming the single Berarducci product +theorem. -/ +theorem OrdinalValueMultiplicative.ordinalValueDegree_mul + (hmul : OrdinalValueMultiplicative K) (b c : Series K) : + ordinalValueDegree (b * c) = ordinalValueDegree b + ordinalValueDegree c := by + simpa only [ordinalValueDegree, hmul b c] using + NatOrdinal.cantorDegree_mul (ordinalValue b) (ordinalValue c) + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueFinalSegment.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueFinalSegment.lean new file mode 100644 index 0000000000..02915d4faf --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueFinalSegment.lean @@ -0,0 +1,305 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Negative +import Mathlib.Tactic.Linarith + +/-! +# Final support segments and Berarducci's ordinal value + +This module proves the support consequence of Berarducci's three-clause ordinal value used in the +proof of Lemma 6.9. Every nonempty final segment of the strictly negative support of a +nonpositive series has ordinary order type at least the series' ordinal value. The exponent zero +must be excluded: a nonzero constant coefficient would otherwise give the singleton final segment +`{0}`, independently of the third-branch value. + +Translation gives the corresponding theorem for a final segment of a Hahn-series support strictly +below an arbitrary cutoff `γ`. A separate theorem proves that representatives congruent modulo +`J + K` have equal values after truncation and translation at every sufficiently large negative +cutoff. Together these results isolate the value-theoretic part of Berarducci, Lemma 6.9 from its +remaining cofinal reindexing argument. + +-/ + +universe v + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace Berarducci + +open HahnSeries Ordinal + +variable {K : Type v} [Field K] + +/-- The ordinal value is bounded above by the ordinary order type of every nonempty final segment +of the strictly negative support. -/ +theorem ordinalValue_le_orderType_of_isRelUpperSet_negativeSupport + {b : Series K} {C : Set ℝ} + (hC : IsRelUpperSet C (· ∈ (b : K⟦ℝ⟧).support ∩ Set.Iio 0)) + (hCne : C.Nonempty) : + (ordinalValue b).val ≤ + ((b : K⟦ℝ⟧).isPWO_support.mono fun _ hx ↦ (hC hx).1.1).orderType := by + classical + let c : Series K := + ⟨HahnSeries.filter (· ∈ C) (b : K⟦ℝ⟧), by + rw [HahnSeries.mem_nonpositiveSubring] + exact (HahnSeries.support_filter_subset (· ∈ C) (b : K⟦ℝ⟧)).trans + (HahnSeries.Nonpositive.support_subset b)⟩ + have hcSupport : (c : K⟦ℝ⟧).support = C := by + change (HahnSeries.filter (· ∈ C) (b : K⟦ℝ⟧)).support = C + rw [HahnSeries.support_filter] + ext x + constructor + · exact fun hx ↦ hx.2 + · intro hx + exact ⟨(hC hx).1.1, hx⟩ + obtain ⟨a, haC⟩ := hCne + have ha := (hC haC).1 + have hbc : b - c ∈ nearConstantSubgroup K := by + rw [mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem] + rw [HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero] + let q := b - c - HahnSeries.Nonpositive.C + (HahnSeries.Nonpositive.constantCoeff (b - c)) + change HahnSeries.Nonpositive.supportSup q < 0 + by_cases hq : q = 0 + · simp [hq] + · rw [HahnSeries.Nonpositive.supportSup_of_ne hq] + apply WithBot.coe_lt_coe.mpr + refine (csSup_le (HahnSeries.support_nonempty_iff.mpr ?_) ?_).trans_lt ha.2 + · simpa using hq + · intro x hx + apply le_of_not_gt + intro hax + have hx0 : x ≤ 0 := HahnSeries.Nonpositive.support_subset q hx + rcases hx0.eq_or_lt with rfl | hx0 + · have hcoeff : (q : K⟦ℝ⟧).coeff 0 = 0 := by + simp [q] + exact (HahnSeries.mem_support _ _).mp hx hcoeff + · by_cases hxb : x ∈ (b : K⟦ℝ⟧).support + · have hxC : x ∈ C := (hC haC).2 hax.le ⟨hxb, hx0⟩ + have hcCoeff : (c : K⟦ℝ⟧).coeff x = (b : K⟦ℝ⟧).coeff x := by + simp [c, hxC] + have hcoeff : (q : K⟦ℝ⟧).coeff x = 0 := by + simp [q, hcCoeff, hx0.ne] + exact (HahnSeries.mem_support _ _).mp hx hcoeff + · have hbCoeff : (b : K⟦ℝ⟧).coeff x = 0 := by + rwa [← not_ne_iff, ← HahnSeries.mem_support] + have hcoeff : (q : K⟦ℝ⟧).coeff x = 0 := by + simp [q, c, hbCoeff, hx0.ne] + exact (HahnSeries.mem_support _ _).mp hx hcoeff + rw [NatOrdinal.val_le_iff] + by_cases hb : 1 < ordinalValue b + · have hcCandidate : + NatOrdinal.of (c : K⟦ℝ⟧).supportOrderType ∈ representativeOrderTypes b := + mem_representativeOrderTypes_iff.mpr ⟨c, hbc, rfl⟩ + have hvalue := (ordinalValue_isLeast_representativeOrderTypes + (one_lt_ordinalValue_iff.mp hb)).2 hcCandidate + calc + ordinalValue b ≤ NatOrdinal.of (c : K⟦ℝ⟧).supportOrderType := hvalue + _ = NatOrdinal.of + (((b : K⟦ℝ⟧).isPWO_support.mono fun _ hx ↦ (hC hx).1.1).orderType) := by + apply congrArg NatOrdinal.of + rw [HahnSeries.supportOrderType_eq_setOrderType] + exact (c : K⟦ℝ⟧).isPWO_support.orderType_congr + ((b : K⟦ℝ⟧).isPWO_support.mono fun _ hx ↦ (hC hx).1.1) hcSupport + · apply (le_of_not_gt hb).trans + rw [Order.one_le_iff_pos] + apply NatOrdinal.of.lt_iff_lt.mpr + apply bot_lt_iff_ne_bot.mpr + intro htypeZero + have hCempty := + (((b : K⟦ℝ⟧).isPWO_support.mono fun _ hx ↦ (hC hx).1.1).orderType_eq_zero).mp + htypeZero + simp [hCempty] at haC + +/-- A series with nonzero ordinal value has support with least upper bound zero. -/ +theorem isLUB_support_zero_of_ordinalValue_ne_zero + {b : Series K} (hb : ordinalValue b ≠ 0) : + IsLUB (b : K⟦ℝ⟧).support 0 := by + have hbJ : b ∉ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + rwa [← ordinalValue_eq_zero_iff] + have hbne : b ≠ 0 := by + intro hbzero + apply hbJ + rw [hbzero] + exact (HahnSeries.Nonpositive.negativeMonomialIdeal K).zero_mem + have hsup : HahnSeries.Nonpositive.supportSup b = 0 := by + apply le_antisymm (HahnSeries.Nonpositive.supportSup_le_zero b) + apply le_of_not_gt + intro hlt + exact hbJ + (HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero.mpr hlt) + exact (HahnSeries.Nonpositive.supportSup_eq_coe_iff.mp hsup).2 + +/-- A series of ordinal value greater than one has strictly negative support with least upper +bound zero. -/ +theorem isLUB_negativeSupport_zero_of_one_lt_ordinalValue + {b : Series K} (hb : 1 < ordinalValue b) : + IsLUB ((b : K⟦ℝ⟧).support ∩ Set.Iio 0) 0 := by + let n : HahnSeries.Negative ℝ K := HahnSeries.Nonpositive.negativePart ℝ K b + have hnJ : (n : Series K) ∉ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + intro hnJ + apply (one_lt_ordinalValue_iff.mp hb) + apply mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem.mpr + simpa only [n, HahnSeries.Nonpositive.coe_negativePart] using hnJ + have hn : (n : Series K) ≠ 0 := by + intro hn + apply hnJ + rw [hn] + exact (HahnSeries.Nonpositive.negativeMonomialIdeal K).zero_mem + have hsup : HahnSeries.Nonpositive.supportSup (n : Series K) = 0 := by + apply le_antisymm (HahnSeries.Nonpositive.supportSup_le_zero (n : Series K)) + apply le_of_not_gt + intro hlt + exact hnJ + (HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero.mpr hlt) + have hLUB := + (HahnSeries.Nonpositive.supportSup_eq_coe_iff.mp hsup).2 + simpa only [n, HahnSeries.Nonpositive.support_negativePart] using hLUB + +/-- After translating a cutoff to zero, the ordinal value is bounded above by the ordinary order +type of every nonempty final segment of the support strictly below that cutoff. -/ +theorem ordinalValue_translatedTruncation_le_orderType_of_isRelUpperSet_supportBelow + (b : K⟦ℝ⟧) (γ : ℝ) {C : Set ℝ} + (hC : IsRelUpperSet C (· ∈ b.support ∩ Set.Iio γ)) + (hCne : C.Nonempty) : + (ordinalValue (translatedTruncation b γ)).val ≤ + (b.isPWO_support.mono fun _ hx ↦ (hC hx).1.1).orderType := by + let shifted : Set ℝ := (-γ + ·) '' C + have hshifted : IsRelUpperSet shifted + (· ∈ ((translatedTruncation b γ : Series K) : K⟦ℝ⟧).support ∩ Set.Iio 0) := by + rintro _ ⟨x, hxC, rfl⟩ + refine ⟨⟨?_, ?_⟩, ?_⟩ + · rw [support_translatedTruncation] + exact ⟨x, ⟨(hC hxC).1.1, (hC hxC).1.2.le⟩, rfl⟩ + · have hxγ := (hC hxC).1.2 + change x < γ at hxγ + change -γ + x < 0 + linarith + · intro y hxy hy + rw [support_translatedTruncation] at hy + obtain ⟨⟨z, hz, hzEq⟩, hy0⟩ := hy + subst y + refine ⟨z, ?_, rfl⟩ + apply (hC hxC).2 + · linarith + · refine ⟨hz.1, ?_⟩ + change -γ + z < 0 at hy0 + change z < γ + linarith + have hshiftedNonempty : shifted.Nonempty := hCne.image _ + have hbound := ordinalValue_le_orderType_of_isRelUpperSet_negativeSupport + hshifted hshiftedNonempty + let hCPWO : C.IsPWO := b.isPWO_support.mono fun _ hx ↦ (hC hx).1.1 + let hshiftedPWO : shifted.IsPWO := + ((translatedTruncation b γ : Series K) : K⟦ℝ⟧).isPWO_support.mono + fun _ hx ↦ (hshifted hx).1.1 + letI : WellFoundedLT C := ⟨hCPWO.isWF⟩ + letI : WellFoundedLT shifted := ⟨hshiftedPWO.isWF⟩ + let f : C → shifted := fun x ↦ ⟨-γ + x.1, x.1, x.2, rfl⟩ + have hf : StrictMono f := by + intro x y hxy + change x.1 < y.1 at hxy + change -γ + x.1 < -γ + y.1 + linarith + have hsurjective : Function.Surjective f := by + rintro ⟨_, x, hxC, rfl⟩ + exact ⟨⟨x, hxC⟩, rfl⟩ + let e : C ≃o shifted := hf.orderIsoOfSurjective f hsurjective + have htype : hshiftedPWO.orderType = hCPWO.orderType := by + calc + hshiftedPWO.orderType = typeLT C := + hshiftedPWO.orderType_eq_typeLT_of_orderIso e.symm + _ = hCPWO.orderType := + (hCPWO.orderType_eq_typeLT_of_orderIso (OrderIso.refl C)).symm + exact hbound.trans_eq htype + +/-- A lower bound on a translated-truncation value is a lower bound on every nonempty final +segment of the support strictly below the cutoff. -/ +theorem le_orderType_of_le_ordinalValue_translatedTruncation_of_isRelUpperSet_supportBelow + (b : K⟦ℝ⟧) (γ : ℝ) {C : Set ℝ} {ρ : Ordinal} + (hρ : NatOrdinal.of ρ ≤ ordinalValue (translatedTruncation b γ)) + (hC : IsRelUpperSet C (· ∈ b.support ∩ Set.Iio γ)) + (hCne : C.Nonempty) : + ρ ≤ (b.isPWO_support.mono fun _ hx ↦ (hC hx).1.1).orderType := by + apply (NatOrdinal.of.le_iff_le.mp ?_).trans + (ordinalValue_translatedTruncation_le_orderType_of_isRelUpperSet_supportBelow b γ hC hCne) + simpa only [NatOrdinal.of_val] using hρ + +/-- A uniform lower bound on the ordinary order types of the support windows immediately below +`γ` is a lower bound on the value of the translated truncation at `γ`. This is the converse of +`Berarducci.ordinalValue_translatedTruncation_le_orderType_of_isRelUpperSet_supportBelow`. -/ +theorem le_ordinalValue_translatedTruncation_of_forall_le_orderType + (b : K⟦ℝ⟧) (γ : ℝ) {ρ : Ordinal} + (h : ∀ θ, θ < γ → ρ ≤ (b.isPWO_support.mono + (s := b.support ∩ Set.Ioo θ γ) Set.inter_subset_left).orderType) : + NatOrdinal.of ρ ≤ ordinalValue (translatedTruncation b γ) := by + apply le_ordinalValue_of_forall_mem_representativeOrderTypes + intro p hp + obtain ⟨d, hd, rfl⟩ := mem_representativeOrderTypes_iff.mp hp + rw [NatOrdinal.of.le_iff_le] + obtain ⟨θ, hθ, hcoeff⟩ := exists_coeff_eq_of_sub_mem_nearConstantSubgroup hd + set A : Set ℝ := b.support ∩ Set.Ioo (γ + θ) γ with hA + have hAPWO : A.IsPWO := b.isPWO_support.mono Set.inter_subset_left + have hmono : StrictMonoOn (fun x ↦ -γ + x) A := fun _ _ _ _ hxy ↦ by simpa using hxy + have himage : (fun x ↦ -γ + x) '' A ⊆ (d : K⟦ℝ⟧).support := by + rintro _ ⟨x, hx, rfl⟩ + obtain ⟨hxsupp, hxlow, hxhigh⟩ := hx + have hδ0 : -γ + x ≤ 0 := by linarith + have hδθ : θ < -γ + x := by linarith + have hδneg : -γ + x < 0 := by linarith + have hgerm : ((translatedTruncation b γ : Series K) : K⟦ℝ⟧).coeff (-γ + x) = b.coeff x := by + rw [coeff_translatedTruncation, if_pos hδ0] + congr 1 + ring + rw [HahnSeries.mem_support, ← hcoeff (-γ + x) hδθ hδneg, hgerm] + exact (HahnSeries.mem_support _ _).mp hxsupp + calc ρ ≤ hAPWO.orderType := h (γ + θ) (by linarith) + _ = (hAPWO.image_of_monotoneOn hmono.monotoneOn).orderType := + (hAPWO.orderType_image_of_strictMonoOn hmono).symm + _ ≤ (d : K⟦ℝ⟧).isPWO_support.orderType := + (hAPWO.image_of_monotoneOn hmono.monotoneOn).orderType_mono _ himage + _ = (d : K⟦ℝ⟧).supportOrderType := + (HahnSeries.supportOrderType_eq_setOrderType _).symm + +/-- Series congruent modulo `J + K` have equal translated-truncation values at every sufficiently +large negative cutoff. -/ +theorem exists_ordinalValue_translatedTruncation_eq_of_sub_mem_nearConstantSubgroup + {b c : Series K} (hbc : b - c ∈ nearConstantSubgroup K) : + ∃ η < (0 : ℝ), ∀ γ : ℝ, η < γ → γ < 0 → + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) γ) = + ordinalValue (translatedTruncation (c : K⟦ℝ⟧) γ) := by + obtain ⟨j, hj, k, hjk⟩ := mem_nearConstantSubgroup_iff.mp hbc + have hjGerm : toGerm j = toGerm 0 := by + rw [toGerm_eq_toGerm_iff] + simpa using hj + obtain ⟨η, hη, hjCoeff⟩ := + toGerm_eq_toGerm_iff_exists_coeff_eq.mp hjGerm + refine ⟨η, hη, fun γ hηγ hγ ↦ ?_⟩ + apply ordinalValue_eq_of_sub_mem_negativeMonomialIdeal + rw [← toGerm_eq_toGerm_iff] + apply toGerm_eq_toGerm_iff_exists_coeff_eq.mpr + refine ⟨η - γ, sub_neg.mpr hηγ, fun δ hδ hδ0 ↦ ?_⟩ + rw [coeff_translatedTruncation, coeff_translatedTruncation, if_pos hδ0, if_pos hδ0] + have hnear : η < γ + δ := by linarith + have hnegative : γ + δ < 0 := by linarith + have hjZero : (j : K⟦ℝ⟧).coeff (γ + δ) = 0 := by + simpa using hjCoeff (γ + δ) hnear hnegative.le + have hjkCoeff := congrArg + (fun q : Series K ↦ (q : K⟦ℝ⟧).coeff (γ + δ)) hjk + simp only [Subring.coe_add, HahnSeries.coeff_add, HahnSeries.Nonpositive.coe_C, + HahnSeries.C_apply] at hjkCoeff + rw [HahnSeries.coeff_single_of_ne hnegative.ne] at hjkCoeff + simp only [add_zero] at hjkCoeff + exact sub_eq_zero.mp (hjkCoeff.symm.trans hjZero) + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueImage.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueImage.lean new file mode 100644 index 0000000000..a83ff30d3f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueImage.lean @@ -0,0 +1,215 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +import Mathlib.Tactic.Abel + +/-! +# Image of Berarducci's ordinal value + +Berarducci, Remark 5.3 states that the ordinal value has image in the class of additive-principal +ordinals, where that class includes zero. Thus the value is either zero or +`Ordinal.IsAdditivelyPrincipal`; equivalently, its underlying ordinary ordinal satisfies +Mathlib's `Ordinal.IsPrincipal (\x y => x + y)`. + +The proof here derives the assertion directly from the three-branch minimum in Definition 5.2. If +a minimal representative had support order type `a + d` with both summands strictly smaller, the +support-splitting theorem would write it as a lower series plus an upper series. When the upper +series lies in `J + K`, it can be removed. Otherwise it has a negative support exponent, so the +strictly lower series is bounded away from zero and lies in `J`; that lower series can instead be +removed. Either case gives a congruent representative with strictly smaller support order type, +contradicting minimality. + +The argument requires no characteristic-zero hypothesis and is therefore proved over an arbitrary +field. It supplies the additive-principality input for Berarducci's principal and residual value +definition. +-/ + +universe v + +public noncomputable section + +namespace Berarducci + +open HahnSeries + +variable {K : Type v} [Field K] + +private theorem exists_negative_support_of_not_mem_nearConstantSubgroup + {b : Series K} (hb : b ∉ nearConstantSubgroup K) : + ∃ x ∈ (b : K⟦ℝ⟧).support, x < 0 := by + by_contra hnegative + apply hb + rw [mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem] + have heq : b - HahnSeries.Nonpositive.C + (HahnSeries.Nonpositive.constantCoeff b) = 0 := by + apply Subtype.ext + ext x + by_cases hx : x = 0 + · subst x + simp + · have hxSupport : x ∉ (b : K⟦ℝ⟧).support := by + intro hxb + have hxle := HahnSeries.Nonpositive.support_subset b hxb + have hxge : 0 ≤ x := le_of_not_gt fun hxlt ↦ + hnegative ⟨x, hxb, hxlt⟩ + exact hx (le_antisymm hxle hxge) + have hxCoeff : (b : K⟦ℝ⟧).coeff x = 0 := by + rwa [← not_ne_iff, ← HahnSeries.mem_support] + simp [hx, hxCoeff] + rw [heq] + exact (HahnSeries.Nonpositive.negativeMonomialIdeal K).zero_mem + +private theorem mem_negativeMonomialIdeal_of_supportBelow_of_negative_support + {b c : Series K} + (hbc : HahnSeries.SupportBelow (b : K⟦ℝ⟧) (c : K⟦ℝ⟧)) + {x : ℝ} (hxc : x ∈ (c : K⟦ℝ⟧).support) (hx : x < 0) : + b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + rw [HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero] + by_cases hb : b = 0 + · subst b + simp + · rw [HahnSeries.Nonpositive.supportSup_of_ne hb] + apply WithBot.coe_lt_coe.mpr + have hb' : (b : K⟦ℝ⟧) ≠ 0 := by simpa using hb + apply (csSup_le (HahnSeries.support_nonempty_iff.mpr hb') ?_).trans_lt hx + intro y hy + exact (hbc.lt hy hxc).le + +private theorem sub_mem_nearConstantSubgroup_left_of_add_eq + {b c y z : Series K} + (hbc : b - c ∈ nearConstantSubgroup K) + (hc : c = y + z) + (hz : z ∈ nearConstantSubgroup K) : + b - y ∈ nearConstantSubgroup K := by + have hsum := (nearConstantSubgroup K).add_mem hbc hz + have heq : (b - c) + z = b - y := by + rw [hc] + abel + rwa [heq] at hsum + +private theorem sub_mem_nearConstantSubgroup_right_of_add_eq + {b c y z : Series K} + (hbc : b - c ∈ nearConstantSubgroup K) + (hc : c = y + z) + (hy : y ∈ nearConstantSubgroup K) : + b - z ∈ nearConstantSubgroup K := by + have hsum := (nearConstantSubgroup K).add_mem hbc hy + have heq : (b - c) + y = b - z := by + rw [hc] + abel + rwa [heq] at hsum + +/-- Every Berarducci ordinal value strictly above one is positive additive principal. This is the +nontrivial branch of Berarducci, Remark 5.3. -/ +theorem ordinalValue_isAdditivelyPrincipal_of_one_lt {b : Series K} + (hb : 1 < ordinalValue b) : + Ordinal.IsAdditivelyPrincipal (ordinalValue b).val := by + have hbNear : b ∉ nearConstantSubgroup K := one_lt_ordinalValue_iff.mp hb + have hleast := ordinalValue_isLeast_representativeOrderTypes hbNear + obtain ⟨c, hbc, hcType⟩ := mem_representativeOrderTypes_iff.mp hleast.1 + have hcTypeVal : (c : K⟦ℝ⟧).supportOrderType = (ordinalValue b).val := by + have h := congrArg NatOrdinal.val hcType + simpa using h + have hvalueNe : (ordinalValue b).val ≠ 0 := by + intro hzero + have : ordinalValue b = 0 := by + apply NatOrdinal.val.injective + simpa using hzero + rw [this] at hb + exact not_lt_of_ge zero_le_one hb + rw [Ordinal.isAdditivelyPrincipal_iff_ne_zero_and_isPrincipal_add] + refine ⟨hvalueNe, ?_⟩ + by_contra hprincipal + obtain ⟨a, ha, d, hd, hadd⟩ := + Ordinal.exists_lt_add_of_not_isPrincipal_add hprincipal + have hcSplit : (c : K⟦ℝ⟧).supportOrderType = a + d := by + rw [hcTypeVal, hadd] + obtain ⟨y, z, hyz, hya, hzd, hcyz⟩ := + (HahnSeries.supportOrderType_eq_add_iff (c : K⟦ℝ⟧) a d).mp hcSplit + have hySupport : y.support ⊆ (c : K⟦ℝ⟧).support := by + rw [hcyz, HahnSeries.support_add_eq_union_of_supportBelow y z hyz] + exact Set.subset_union_left + have hzSupport : z.support ⊆ (c : K⟦ℝ⟧).support := by + rw [hcyz, HahnSeries.support_add_eq_union_of_supportBelow y z hyz] + exact Set.subset_union_right + let y' : Series K := ⟨y, + (HahnSeries.mem_nonpositiveSubring (x := y)).mpr fun _ hx ↦ + HahnSeries.Nonpositive.support_subset c (hySupport hx)⟩ + let z' : Series K := ⟨z, + (HahnSeries.mem_nonpositiveSubring (x := z)).mpr fun _ hx ↦ + HahnSeries.Nonpositive.support_subset c (hzSupport hx)⟩ + have hyz' : HahnSeries.SupportBelow (y' : K⟦ℝ⟧) (z' : K⟦ℝ⟧) := hyz + have hcyz' : c = y' + z' := by + apply Subtype.ext + exact hcyz + by_cases hzNear : z' ∈ nearConstantSubgroup K + · have hby := sub_mem_nearConstantSubgroup_left_of_add_eq hbc hcyz' hzNear + have hyCandidate : NatOrdinal.of y.supportOrderType ∈ + representativeOrderTypes b := + mem_representativeOrderTypes_iff.mpr ⟨y', hby, rfl⟩ + have hle := hleast.2 hyCandidate + have hlt : NatOrdinal.of y.supportOrderType < ordinalValue b := by + rw [hya, ← hcType] + exact NatOrdinal.of.lt_iff_lt.mpr (ha.trans_eq hcTypeVal.symm) + exact not_lt_of_ge hle hlt + · obtain ⟨x, hxz, hx⟩ := + exists_negative_support_of_not_mem_nearConstantSubgroup hzNear + have hyJ := + mem_negativeMonomialIdeal_of_supportBelow_of_negative_support hyz' hxz hx + have hyNear : y' ∈ nearConstantSubgroup K := + negativeMonomialIdeal_le_nearConstantSubgroup hyJ + have hbz := sub_mem_nearConstantSubgroup_right_of_add_eq hbc hcyz' hyNear + have hzCandidate : NatOrdinal.of z.supportOrderType ∈ + representativeOrderTypes b := + mem_representativeOrderTypes_iff.mpr ⟨z', hbz, rfl⟩ + have hle := hleast.2 hzCandidate + have hlt : NatOrdinal.of z.supportOrderType < ordinalValue b := by + rw [hzd, ← hcType] + exact NatOrdinal.of.lt_iff_lt.mpr (hd.trans_eq hcTypeVal.symm) + exact not_lt_of_ge hle hlt + +/-- A Berarducci ordinal value is either zero or positive additive principal. This is the +positive formulation of Berarducci, Remark 5.3. -/ +theorem ordinalValue_eq_zero_or_isAdditivelyPrincipal (b : Series K) : + ordinalValue b = 0 ∨ + Ordinal.IsAdditivelyPrincipal (ordinalValue b).val := by + by_cases hzero : ordinalValue b = 0 + · exact Or.inl hzero + · right + have hpos : 0 < ordinalValue b := bot_lt_iff_ne_bot.mpr hzero + have hone : 1 ≤ ordinalValue b := Order.one_le_iff_pos.mpr hpos + rcases hone.eq_or_lt with hone | hone + · have hval : (ordinalValue b).val = 1 := by + rw [← hone] + simp + rw [hval] + simpa using Ordinal.isAdditivelyPrincipal_omega0_opow 0 + · exact ordinalValue_isAdditivelyPrincipal_of_one_lt hone + +/-- The underlying ordinary ordinal of every Berarducci value belongs to Berarducci's class +`H`, represented exactly by Mathlib's additive-principal predicate that includes zero. -/ +theorem ordinalValue_isPrincipal_add (b : Series K) : + Ordinal.IsPrincipal (· + ·) (ordinalValue b).val := by + rcases ordinalValue_eq_zero_or_isAdditivelyPrincipal b with hzero | hprincipal + · have hval : (ordinalValue b).val = 0 := by rw [hzero]; simp + rw [hval] + exact Ordinal.isPrincipal_zero + · exact + (Ordinal.isAdditivelyPrincipal_iff_ne_zero_and_isPrincipal_add.mp hprincipal).2 + +/-- The ordinal value induced on the germ quotient also has image in Berarducci's class `H`. -/ +theorem germOrdinalValue_isPrincipal_add (q : Germ K) : + Ordinal.IsPrincipal (· + ·) (germOrdinalValue q).val := by + obtain ⟨b, rfl⟩ := Ideal.Quotient.mk_surjective q + rw [germOrdinalValue_mk] + exact ordinalValue_isPrincipal_add b + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueSubmultiplicative.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueSubmultiplicative.lean new file mode 100644 index 0000000000..fd1b0f90c3 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueSubmultiplicative.lean @@ -0,0 +1,142 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueConstantMul + +/-! +# Submultiplicativity of Berarducci's ordinal value + +Berarducci, Lemma 5.5(2): the ordinal value of a product is at most the Hessenberg product of the +two ordinal values. The product on the right is Hessenberg multiplication, carried by +`NatOrdinal`; it dominates ordinary ordinal multiplication and the two must not be interchanged. +This is the inequality half of Berarducci, Theorem 9.7; the opposite inequality is the deep part +of the paper and is not proved here. + +The proof follows the source. Choosing representatives `b'`, `c'` modulo `J + K` whose support +order types realize `v_J(b)` and `v_J(c)`, and writing `b - b' = j + r`, `c - c' = i + s` with +`j, i ∈ J` and `r, s` constant, expansion gives + +`b c ≡ b' c' + s b' + r c' (mod J + K)`. + +The max-form additive inequality of Berarducci, Lemma 5.5(1) then reduces the claim to the +order-type bound for `b' c'` together with constant-factor invariance for the two cross terms. + +The ideal cases `b ∈ J` and `c ∈ J` come first: the right-hand side is then zero, and the bounds +`v_J(b) ≤ v_J(b) ⊙ v_J(c)` and `v_J(c) ≤ v_J(b) ⊙ v_J(c)` used afterwards are unavailable. + +For the leading Cantor exponent, the bound reads `ordinalValueDegree (b c) ≤ ordinalValueDegree b ++ ordinalValueDegree c`, since the Cantor degree of a Hessenberg product is the Hessenberg sum of +the Cantor degrees. This is the product inequality of the max-additive degree +`ordinalValueDegreeValuation`. +-/ + +universe v + +public noncomputable section + +namespace Berarducci + +open HahnSeries + +variable {K : Type v} [Field K] + +private theorem ordinalValue_C_mul_le (k : K) (b : Series K) : + ordinalValue (HahnSeries.Nonpositive.C k * b) ≤ ordinalValue b := by + rcases eq_or_ne k 0 with rfl | hk + · rw [map_zero, zero_mul, ordinalValue_zero] + exact bot_le + · exact (ordinalValue_C_mul hk b).le + +private theorem ordinalValue_le_one_of_mem_nearConstantSubgroup {b : Series K} + (hb : b ∈ nearConstantSubgroup K) : ordinalValue b ≤ 1 := + le_of_not_gt fun h ↦ (one_lt_ordinalValue_iff.mp h) hb + +/-- Berarducci, Lemma 5.5(2): the ordinal value of a product is at most the Hessenberg product of +the ordinal values of the factors. -/ +theorem ordinalValue_mul_le_naturalMul (b c : Series K) : + ordinalValue (b * c) ≤ ordinalValue b * ordinalValue c := by + by_cases hbJ : b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K + · rw [ordinalValue_of_mem_negativeMonomialIdeal + ((HahnSeries.Nonpositive.negativeMonomialIdeal K).mul_mem_right c hbJ)] + exact bot_le + by_cases hcJ : c ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K + · rw [ordinalValue_of_mem_negativeMonomialIdeal + ((HahnSeries.Nonpositive.negativeMonomialIdeal K).mul_mem_left b hcJ)] + exact bot_le + have hb1 : 1 ≤ ordinalValue b := + Order.one_le_iff_pos.mpr (pos_iff_ne_zero.mpr fun h ↦ hbJ (ordinalValue_eq_zero_iff.mp h)) + have hc1 : 1 ≤ ordinalValue c := + Order.one_le_iff_pos.mpr (pos_iff_ne_zero.mpr fun h ↦ hcJ (ordinalValue_eq_zero_iff.mp h)) + have hbmul : ordinalValue b ≤ ordinalValue b * ordinalValue c := + le_mul_of_one_le_right zero_le hc1 + have hcmul : ordinalValue c ≤ ordinalValue b * ordinalValue c := + le_mul_of_one_le_left zero_le hb1 + obtain ⟨b', hbb', hb'⟩ := + mem_representativeOrderTypes_iff.mp (ordinalValue_mem_representativeOrderTypes b) + obtain ⟨c', hcc', hc'⟩ := + mem_representativeOrderTypes_iff.mp (ordinalValue_mem_representativeOrderTypes c) + obtain ⟨j, hj, r, hjr⟩ := mem_nearConstantSubgroup_iff.mp hbb' + obtain ⟨i, hi, s, his⟩ := mem_nearConstantSubgroup_iff.mp hcc' + have hb : b = b' + (j + HahnSeries.Nonpositive.C r) := by rw [hjr]; ring + have hc : c = c' + (i + HahnSeries.Nonpositive.C s) := by rw [his]; ring + set d : Series K := + b' * c' + (HahnSeries.Nonpositive.C s * b' + HahnSeries.Nonpositive.C r * c') with hdDef + have hkey : b * c - d = + (b' * i + j * c' + j * i + j * HahnSeries.Nonpositive.C s + + HahnSeries.Nonpositive.C r * i) + HahnSeries.Nonpositive.C (r * s) := by + rw [hdDef, map_mul, hb, hc]; ring + have hrest : b * c - d ∈ nearConstantSubgroup K := by + rw [hkey] + refine mem_nearConstantSubgroup_iff.mpr ⟨_, ?_, r * s, rfl⟩ + exact Ideal.add_mem _ (Ideal.add_mem _ (Ideal.add_mem _ (Ideal.add_mem _ + (Ideal.mul_mem_left _ b' hi) (Ideal.mul_mem_right c' _ hj)) + (Ideal.mul_mem_right i _ hj)) (Ideal.mul_mem_right _ _ hj)) + (Ideal.mul_mem_left _ _ hi) + have hdle : ordinalValue d ≤ ordinalValue b * ordinalValue c := by + refine (ordinalValue_add_le_max _ _).trans (max_le ?_ ((ordinalValue_add_le_max _ _).trans + (max_le ?_ ?_))) + · calc ordinalValue (b' * c') + ≤ NatOrdinal.of ((b' * c' : Series K) : K⟦ℝ⟧).supportOrderType := + ordinalValue_le_supportOrderType _ + _ ≤ NatOrdinal.of ((NatOrdinal.of (b' : K⟦ℝ⟧).supportOrderType * + NatOrdinal.of (c' : K⟦ℝ⟧).supportOrderType).val) := by + apply NatOrdinal.of.monotone + rw [Subring.coe_mul] + exact HahnSeries.supportOrderType_mul_le_naturalMul _ _ + _ = ordinalValue b * ordinalValue c := by rw [NatOrdinal.of_val, hb', hc'] + · exact ((ordinalValue_C_mul_le s b').trans + ((ordinalValue_le_supportOrderType b').trans_eq hb')).trans hbmul + · exact ((ordinalValue_C_mul_le r c').trans + ((ordinalValue_le_supportOrderType c').trans_eq hc')).trans hcmul + have hsplit : b * c = d + (b * c - d) := by ring + calc ordinalValue (b * c) = ordinalValue (d + (b * c - d)) := by rw [← hsplit] + _ ≤ max (ordinalValue d) (ordinalValue (b * c - d)) := ordinalValue_add_le_max _ _ + _ ≤ ordinalValue b * ordinalValue c := + max_le hdle ((ordinalValue_le_one_of_mem_nearConstantSubgroup hrest).trans + (hb1.trans hbmul)) + +/-- Berarducci, Lemma 5.5(2) for the leading Cantor exponent: the exponent of a product is at +most the Hessenberg sum of the exponents. -/ +theorem ordinalValueDegree_mul_le_add (b c : Series K) : + ordinalValueDegree (b * c) ≤ ordinalValueDegree b + ordinalValueDegree c := by + rw [ordinalValueDegree_eq_cantorDegree, ordinalValueDegree_eq_cantorDegree, + ordinalValueDegree_eq_cantorDegree, ← NatOrdinal.cantorDegree_mul, + NatOrdinal.cantorDegree_eq_ordinalCantorDegree, NatOrdinal.cantorDegree_eq_ordinalCantorDegree] + exact Ordinal.cantorDegree_mono (NatOrdinal.val.monotone (ordinalValue_mul_le_naturalMul b c)) + +/-- Berarducci's germ ordinal value is submultiplicative under Hessenberg multiplication. -/ +theorem germOrdinalValue_mul_le_naturalMul (q p : Germ K) : + germOrdinalValue (q * p) ≤ germOrdinalValue q * germOrdinalValue p := by + obtain ⟨b, rfl⟩ := Ideal.Quotient.mk_surjective q + obtain ⟨c, rfl⟩ := Ideal.Quotient.mk_surjective p + rw [← map_mul, germOrdinalValue_mk, germOrdinalValue_mk, germOrdinalValue_mk] + exact ordinalValue_mul_le_naturalMul b c + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueSupport.lean new file mode 100644 index 0000000000..360b743dc1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueSupport.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveCoefficientMap + +/-! +# Support-determined monotonicity of the ordinal value + +The ordinal value of a nonpositive series depends only on its support, so it is monotone under +inclusion of supports. The two series need not have the same coefficient field: the three regimes +that define the ordinal value — a support bounded strictly below zero, a support meeting zero only +in the constant term, and the general case measured by the order types of the negative support +tails — are each phrased in terms of the support alone. +-/ + +universe v w + +open scoped HahnSeries NatOrdinal + +namespace Berarducci + +open HahnSeries.Nonpositive + +public noncomputable section + +/-- Order-value monotonicity under support deletion, across coefficient fields. -/ +theorem ordinalValue_le_of_support_subset + {K₁ : Type v} {K₂ : Type w} [Field K₁] [Field K₂] + (u : HahnSeries.Nonpositive ℝ K₁) (v : HahnSeries.Nonpositive ℝ K₂) + (h : (u : K₁⟦ℝ⟧).support ⊆ (v : K₂⟦ℝ⟧).support) : + ordinalValue u ≤ ordinalValue v := by + by_cases hvJ : v ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K₂ + · have huJ : u ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K₁ := by + rw [HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero] at hvJ ⊢ + exact lt_of_le_of_lt (supportSup_mono h) hvJ + rw [ordinalValue_of_mem_negativeMonomialIdeal huJ, + ordinalValue_of_mem_negativeMonomialIdeal hvJ] + · by_cases hvN : v ∈ nearConstantSubgroup K₂ + · have huN : u ∈ nearConstantSubgroup K₁ := by + rw [mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem, + HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero] at hvN ⊢ + refine lt_of_le_of_lt (supportSup_mono ?_) hvN + rw [support_sub_C_constantCoeff, support_sub_C_constantCoeff] + exact Set.sdiff_subset_sdiff_left h + have h1 : ordinalValue u ≤ 1 := + not_lt.mp fun hc ↦ (one_lt_ordinalValue_iff.mp hc) huN + have h2 : (1 : NatOrdinal) ≤ ordinalValue v := + (ordinalValue_of_mem_nearConstantSubgroup_of_not_mem_negativeMonomialIdeal + hvN hvJ).ge + exact h1.trans h2 + · have hv1 : 1 < ordinalValue v := one_lt_ordinalValue_iff.mpr hvN + by_cases hu1 : ordinalValue u ≤ 1 + · exact hu1.trans hv1.le + · replace hu1 : 1 < ordinalValue u := not_le.mp hu1 + obtain ⟨ηu, hηu, hstu⟩ := + exists_forall_later_negativeSupportTail_orderType_eq_ordinalValue u hu1 + obtain ⟨ηv, hηv, hstv⟩ := + exists_forall_later_negativeSupportTail_orderType_eq_ordinalValue v hv1 + set ξ : ℝ := max ηu ηv / 2 with hξdef + have hmaxneg : max ηu ηv < 0 := max_lt hηu hηv + have hξ0 : ξ < 0 := by rw [hξdef]; linarith + have hξu : ηu < ξ := by + rw [hξdef]; have := le_max_left ηu ηv; linarith + have hξv : ηv < ξ := by + rw [hξdef]; have := le_max_right ηu ηv; linarith + have hsub : negativeSupportTail u ξ ⊆ negativeSupportTail v ξ := by + intro x hx + obtain ⟨hxs, hη, h0⟩ := mem_negativeSupportTail_iff.mp hx + exact mem_negativeSupportTail_iff.mpr ⟨h hxs, hη, h0⟩ + have hmono := Set.IsPWO.orderType_mono + ((u : K₁⟦ℝ⟧).isPWO_support.mono (negativeSupportTail_subset_support u ξ)) + ((v : K₂⟦ℝ⟧).isPWO_support.mono (negativeSupportTail_subset_support v ξ)) hsub + rw [hstu ξ hξu hξ0, hstv ξ hξv hξ0] at hmono + exact hmono + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueValuation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueValuation.lean new file mode 100644 index 0000000000..6f5ac68b37 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueValuation.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSubmultiplicative + +/-! +# The exponent-valued order valuation + +The leading Cantor exponent of Berarducci's ordinal value `v_J` is a max-additive degree on +`K((ℝ^{≤0}))` over every coefficient field, with kernel `J`: the max-form inequality for sums is +Berarducci, Lemma 5.5(1), and the bound `v_J(bc) ≤ v_J(b) ⊙ v_J(c)` of Berarducci, Lemma 5.5(2) +gives the product inequality for the exponent. This module fixes that degree once, as +`ordinalValueDegreeValuation K`. The spaces +`P_α = J_{ω^(α+1)} / J_{ω^α}` are its homogeneous components and `P̂` is its +associated graded ring, so both exist, with their graded multiplication, over every field. + +Exact multiplicativity `v_J(bc) = v_J(b) ⊙ v_J(c)` is Berarducci, Theorem 9.7, proved for a field +of characteristic zero; it is recorded separately as the instance +`(ordinalValueDegreeValuation K).IsMultiplicative` in +`ConwayRefinement.HahnSeries.OrdinalValue.Statements.OrdinalValueDegree`, and it is what makes +the ring `P̂` a domain. +-/ + +universe v + +public noncomputable section + +namespace Berarducci + +variable (K : Type v) [Field K] + +/-- The exponent-valued order valuation of `K((ℝ^{≤0}))`, as a degree function: its value on `b` +is the leading Cantor exponent of Berarducci's ordinal value `v_J(b)`, with bottom value on `J`. +It is a max-additive degree by Berarducci, Lemma 5.5. -/ +def ordinalValueDegreeValuation : MaxAddDegree (Series K) NatOrdinal where + toFun := ordinalValueDegree + map_zero' := ordinalValueDegree_zero + map_one_le_zero' := ordinalValueDegree_one.le + map_neg' := ordinalValueDegree_neg + map_add_le_max' := ordinalValueDegree_add_le_max + map_mul_le_add' := ordinalValueDegree_mul_le_add + +variable {K} + +@[simp] +theorem ordinalValueDegreeValuation_apply (b : Series K) : + ordinalValueDegreeValuation K b = ordinalValueDegree b := + (rfl) + +/-- The kernel of the exponent-valued order valuation is exactly Berarducci's `J`. -/ +theorem ordinalValueDegreeValuation_eq_bot_iff (b : Series K) : + ordinalValueDegreeValuation K b = ⊥ ↔ b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + rw [ordinalValueDegreeValuation_apply, ordinalValueDegree_eq_bot_iff] + +theorem mem_ordinalValueDegreeValuation_filtrationLE_iff (b : Series K) (α : NatOrdinal) : + b ∈ (ordinalValueDegreeValuation K).filtrationLE α ↔ ordinalValue b < ω^ (α + 1) := by + rw [MaxAddDegree.mem_filtrationLE_iff, ordinalValueDegreeValuation_apply, + ordinalValueDegree_le_coe_iff] + +theorem mem_ordinalValueDegreeValuation_filtrationLT_iff (b : Series K) (α : NatOrdinal) : + b ∈ (ordinalValueDegreeValuation K).filtrationLT α ↔ ordinalValue b < ω^ α := by + rw [MaxAddDegree.mem_filtrationLT_iff, ordinalValueDegreeValuation_apply, + ordinalValueDegree_lt_coe_iff] + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PowerRemainder.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PowerRemainder.lean new file mode 100644 index 0000000000..632878c11d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PowerRemainder.lean @@ -0,0 +1,376 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermValueCut +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointWellOrdered +import Mathlib.Topology.Instances.Real.Lemmas +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPrincipal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSubmultiplicative + +/-! +# The product-rule form of the convolution remainder estimate + +The form of Berarducci, Lemma 7.7 used in the proof of Lemma 8.2: when `v_J^p(b) ≤ v_J^p(c)`, the +germ of `b ^ (m + 1) * c` at a sufficiently high negative cutoff differs from + +`(m + 1) * b^{|γ} b^m c + b^{m+1} c^{|γ}` + +by a germ of ordinal value strictly below `v_J(b) ^ m ⊙ v_J^r(b) ⊙ v_J(c)`. + +The source proves this by "reasoning as in Lemma 7.7". Applying Lemma 7.7 to the pair +`(b, b^m c)` is not available, because its hypothesis compares principal values and the principal +value of a product is exactly what multiplicativity has yet to supply. The induction here avoids +that by carrying a value cut for the partial products alongside the formula: from the formula at +stage `m`, submultiplicativity bounds `v_J((b^{m+1} c)^{|ξ})` by a maximum of three terms, each of +which is small enough after multiplication by a truncation value of `b`. The three resulting +estimates are two instances of `NatOrdinal.naturalMul_mul_lt_of_lt` and the comparison +`v_J^r(b) * α < v_J(b)` for `α < v_J^p(b)`. + +The integer coefficient is a natural-number scalar on germs, so the identity holds in every +characteristic. Berarducci's characteristic-zero hypothesis is needed only where that coefficient +must be shown not to annihilate its term, which happens in Lemma 8.2. +-/ + +universe v + +public noncomputable section + +open HahnSeries + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- The remainder in the product-rule form of Berarducci, Lemma 7.7, for `b ^ (m + 1) * c`. -/ +def powerRemainder (b c : SeriesWithOrdinalValueAboveOne K) (m : ℕ) (γ : ℝ) : Germ K := + germAt ((b.1 ^ (m + 1) * c.1 : Series K) : K⟦ℝ⟧) γ + - (m + 1) • (germAt (b.1 : K⟦ℝ⟧) γ * toGerm (b.1 ^ m * c.1)) + - toGerm (b.1 ^ (m + 1)) * germAt (c.1 : K⟦ℝ⟧) γ + +/-- The remainder, unfolded. -/ +theorem powerRemainder_eq (b c : SeriesWithOrdinalValueAboveOne K) (m : ℕ) (γ : ℝ) : + powerRemainder b c m γ = germAt ((b.1 ^ (m + 1) * c.1 : Series K) : K⟦ℝ⟧) γ + - (m + 1) • (germAt (b.1 : K⟦ℝ⟧) γ * toGerm (b.1 ^ m * c.1)) + - toGerm (b.1 ^ (m + 1)) * germAt (c.1 : K⟦ℝ⟧) γ := (rfl) + +/-- The bound on that remainder. -/ +def powerRemainderBound (b c : SeriesWithOrdinalValueAboveOne K) (m : ℕ) : NatOrdinal := + ordinalValue b.1 ^ m * b.residualValue * ordinalValue c.1 + +/-- The remainder bound, unfolded. -/ +theorem powerRemainderBound_eq (b c : SeriesWithOrdinalValueAboveOne K) (m : ℕ) : + powerRemainderBound b c m = ordinalValue b.1 ^ m * b.residualValue * ordinalValue c.1 := + (rfl) + +private theorem powerRemainder_zero (b c : SeriesWithOrdinalValueAboveOne K) (γ : ℝ) : + powerRemainder b c 0 γ = + germAt ((b.1 * c.1 : Series K) : K⟦ℝ⟧) γ + - germAt (b.1 : K⟦ℝ⟧) γ * toGerm c.1 + - toGerm b.1 * germAt (c.1 : K⟦ℝ⟧) γ := by + simp only [powerRemainder, pow_one, pow_zero, one_mul, zero_add, one_smul] + +private theorem powerRemainderBound_zero (b c : SeriesWithOrdinalValueAboveOne K) : + powerRemainderBound b c 0 = b.residualValue * ordinalValue c.1 := by + simp [powerRemainderBound] + +theorem exists_powerRemainder_lt_zero + (b c : SeriesWithOrdinalValueAboveOne K) (hp : b.principalValue ≤ c.principalValue) : + ∃ η < (0 : ℝ), ∀ γ : ℝ, η < γ → γ < 0 → + germOrdinalValue (powerRemainder b c 0 γ) < powerRemainderBound b c 0 := by + obtain ⟨η, hη, h⟩ := exists_germOrdinalValue_convolution_remainder_lt b c hp + refine ⟨η, hη, fun γ hlow hhigh ↦ ?_⟩ + rw [powerRemainder_zero, powerRemainderBound_zero] + exact h γ hlow hhigh + +theorem germOrdinalValue_nsmul_le (n : ℕ) (q : Germ K) : + germOrdinalValue (n • q) ≤ germOrdinalValue q := by + induction n with + | zero => simp + | succ n ih => + rw [succ_nsmul] + exact (germOrdinalValue_add_le_max _ _).trans (max_le ih le_rfl) + +theorem ordinalValue_pow_le (b : Series K) (m : ℕ) : + ordinalValue (b ^ m) ≤ ordinalValue b ^ m := by + induction m with + | zero => simp + | succ m ih => + rw [pow_succ, pow_succ] + exact (ordinalValue_mul_le_naturalMul _ _).trans (mul_le_mul_left ih _) + +theorem ordinalValue_pow_mul_le (b c : Series K) (m : ℕ) : + ordinalValue (b ^ m * c) ≤ ordinalValue b ^ m * ordinalValue c := + (ordinalValue_mul_le_naturalMul _ _).trans (mul_le_mul_left (ordinalValue_pow_le b m) _) + +/-- The defining decomposition of the remainder, read as an expansion of the germ. -/ +theorem germAt_powerProduct_decomp + (b c : SeriesWithOrdinalValueAboveOne K) (m : ℕ) (ξ : ℝ) : + germAt ((b.1 ^ (m + 1) * c.1 : Series K) : K⟦ℝ⟧) ξ = + (m + 1) • (germAt (b.1 : K⟦ℝ⟧) ξ * toGerm (b.1 ^ m * c.1)) + + toGerm (b.1 ^ (m + 1)) * germAt (c.1 : K⟦ℝ⟧) ξ + + powerRemainder b c m ξ := by + rw [powerRemainder] + abel + +/-- The germ ordinal value of a class is the ordinal value of any representative. -/ +theorem germOrdinalValue_toGerm (x : Series K) : + germOrdinalValue (toGerm x) = ordinalValue x := by + rw [toGerm_apply, germOrdinalValue_mk] + +private theorem exists_mul_germOrdinalValue_powerProduct_lt + (b c : SeriesWithOrdinalValueAboveOne K) (hp : b.principalValue ≤ c.principalValue) (m : ℕ) + (hP : ∃ η < (0 : ℝ), ∀ γ : ℝ, η < γ → γ < 0 → + germOrdinalValue (powerRemainder b c m γ) < powerRemainderBound b c m) : + ∃ η < (0 : ℝ), ∀ ξ : ℝ, η < ξ → ξ < 0 → + ∀ α : Ordinal, α < b.principalValue.val → NatOrdinal.of (b.residualValue.val * α) * + germOrdinalValue (germAt ((b.1 ^ (m + 1) * c.1 : Series K) : K⟦ℝ⟧) ξ) + < powerRemainderBound b c (m + 1) := by + obtain ⟨ηP, hηP, hP'⟩ := hP + obtain ⟨ηb, hηb, hcutb⟩ := exists_ordinalValue_translatedTruncation_le b + obtain ⟨ηc, hηc, hcutc⟩ := exists_ordinalValue_translatedTruncation_le c + refine ⟨max ηP (max ηb ηc), max_lt hηP (max_lt hηb hηc), + fun ξ hlow hhigh α hα ↦ ?_⟩ + have hξP : ηP < ξ := (le_max_left _ _).trans_lt hlow + have hξb : ηb < ξ := ((le_max_left ηb ηc).trans (le_max_right ηP _)).trans_lt hlow + have hξc : ηc < ξ := ((le_max_right ηb ηc).trans (le_max_right ηP _)).trans_lt hlow + obtain ⟨α₁, hα₁, hα₁le⟩ := hcutb ξ hξb hhigh + obtain ⟨α₂, hα₂, hα₂le⟩ := hcutc ξ hξc hhigh + set t : NatOrdinal := NatOrdinal.of (b.residualValue.val * α) with htdef + set V := ordinalValue b.1 with hV + set W := ordinalValue c.1 with hW + have hmono : Monotone fun x : NatOrdinal ↦ t * x := fun _ _ h ↦ mul_le_mul_right h t + have hgermb : germOrdinalValue (germAt (b.1 : K⟦ℝ⟧) ξ) ≤ + NatOrdinal.of (b.residualValue.val * α₁) := by + rw [germAt_apply, toGerm_apply, germOrdinalValue_mk] + simpa using NatOrdinal.of.le_iff_le.mpr hα₁le + have hgermc : germOrdinalValue (germAt (c.1 : K⟦ℝ⟧) ξ) ≤ + NatOrdinal.of (c.residualValue.val * α₂) := by + rw [germAt_apply, toGerm_apply, germOrdinalValue_mk] + simpa using NatOrdinal.of.le_iff_le.mpr hα₂le + have hA : germOrdinalValue ((m + 1) • (germAt (b.1 : K⟦ℝ⟧) ξ * toGerm (b.1 ^ m * c.1))) ≤ + NatOrdinal.of (b.residualValue.val * α₁) * (V ^ m * W) := by + refine (germOrdinalValue_nsmul_le _ _).trans ?_ + refine (germOrdinalValue_mul_le_naturalMul _ _).trans (mul_le_mul' hgermb ?_) + rw [germOrdinalValue_toGerm] + exact ordinalValue_pow_mul_le b.1 c.1 m + have hB : germOrdinalValue (toGerm (b.1 ^ (m + 1)) * germAt (c.1 : K⟦ℝ⟧) ξ) ≤ + V ^ (m + 1) * NatOrdinal.of (c.residualValue.val * α₂) := by + refine (germOrdinalValue_mul_le_naturalMul _ _).trans (mul_le_mul' ?_ hgermc) + rw [germOrdinalValue_toGerm] + exact ordinalValue_pow_le b.1 (m + 1) + have hC : germOrdinalValue (powerRemainder b c m ξ) < V ^ m * b.residualValue * W := + hP' ξ hξP hhigh + have hval : germOrdinalValue (germAt ((b.1 ^ (m + 1) * c.1 : Series K) : K⟦ℝ⟧) ξ) ≤ + max (max (NatOrdinal.of (b.residualValue.val * α₁) * (V ^ m * W)) + (V ^ (m + 1) * NatOrdinal.of (c.residualValue.val * α₂))) + (V ^ m * b.residualValue * W) := by + rw [germAt_powerProduct_decomp b c m ξ] + refine (germOrdinalValue_add_le_max _ _).trans (max_le ?_ ?_) + · exact ((germOrdinalValue_add_le_max _ _).trans (max_le (hA.trans (le_max_left _ _)) + (hB.trans (le_max_right _ _)))).trans (le_max_left _ _) + · exact hC.le.trans (le_max_right _ _) + have hVpos : (0 : NatOrdinal) < V := lt_trans zero_lt_one b.2 + have hWpos : (0 : NatOrdinal) < W := lt_trans zero_lt_one c.2 + have hρpos : (0 : NatOrdinal) < b.residualValue := + pos_iff_ne_zero.mpr b.residualValue_ne_zero + have hσpos : (0 : NatOrdinal) < c.residualValue := + pos_iff_ne_zero.mpr c.residualValue_ne_zero + have hVmW : (0 : NatOrdinal) < V ^ m * W := mul_pos (pow_pos hVpos m) hWpos + have hVm1 : (0 : NatOrdinal) < V ^ (m + 1) := pow_pos hVpos (m + 1) + have hXpos : (0 : NatOrdinal) < V ^ m * b.residualValue * W := + mul_pos (mul_pos (pow_pos hVpos m) hρpos) hWpos + have h1 : t * (NatOrdinal.of (b.residualValue.val * α₁) * (V ^ m * W)) < + powerRemainderBound b c (m + 1) := by + have key : t * NatOrdinal.of (b.residualValue.val * α₁) < + b.residualValue * b.residualValue * b.principalValue := + NatOrdinal.naturalMul_mul_lt_of_lt + b.principalValue_isMultiplicativelyPrincipal le_rfl + (by rw [← NatOrdinal.of_val b.principalValue]; exact NatOrdinal.of.lt_iff_lt.mpr hα) + (by rw [← NatOrdinal.of_val b.principalValue]; exact NatOrdinal.of.lt_iff_lt.mpr hα₁) + (mul_pos hρpos hρpos) + calc t * (NatOrdinal.of (b.residualValue.val * α₁) * (V ^ m * W)) + = t * NatOrdinal.of (b.residualValue.val * α₁) * (V ^ m * W) := by ring + _ < b.residualValue * b.residualValue * b.principalValue * (V ^ m * W) := + mul_lt_mul_of_pos_right key hVmW + _ = powerRemainderBound b c (m + 1) := by + rw [powerRemainderBound, mul_assoc b.residualValue b.residualValue, + b.residualValue_mul_principalValue] + ring + have h2 : t * (V ^ (m + 1) * NatOrdinal.of (c.residualValue.val * α₂)) < + powerRemainderBound b c (m + 1) := by + have key : t * NatOrdinal.of (c.residualValue.val * α₂) < + b.residualValue * c.residualValue * c.principalValue := + NatOrdinal.naturalMul_mul_lt_of_lt + c.principalValue_isMultiplicativelyPrincipal hp + (by rw [← NatOrdinal.of_val b.principalValue]; exact NatOrdinal.of.lt_iff_lt.mpr hα) + (by rw [← NatOrdinal.of_val c.principalValue]; exact NatOrdinal.of.lt_iff_lt.mpr hα₂) + (mul_pos hρpos hσpos) + calc t * (V ^ (m + 1) * NatOrdinal.of (c.residualValue.val * α₂)) + = V ^ (m + 1) * (t * NatOrdinal.of (c.residualValue.val * α₂)) := by ring + _ < V ^ (m + 1) * (b.residualValue * c.residualValue * c.principalValue) := + mul_lt_mul_of_pos_left key hVm1 + _ = powerRemainderBound b c (m + 1) := by + rw [powerRemainderBound, mul_assoc b.residualValue c.residualValue, + c.residualValue_mul_principalValue] + ring + have h3 : t * (V ^ m * b.residualValue * W) < powerRemainderBound b c (m + 1) := by + have htV : t < V := by + have hle : t ≤ b.residualValue * NatOrdinal.of α := by + simpa [htdef] using NatOrdinal.of.le_iff_le.mpr + (NatOrdinal.omul_le_mul' b.residualValue.val α) + refine hle.trans_lt ?_ + have hVeq : b.residualValue * b.principalValue = V := + b.residualValue_mul_principalValue + rw [← hVeq] + refine mul_lt_mul_of_pos_left ?_ hρpos + rw [← NatOrdinal.of_val b.principalValue] + exact NatOrdinal.of.lt_iff_lt.mpr hα + calc t * (V ^ m * b.residualValue * W) < V * (V ^ m * b.residualValue * W) := + mul_lt_mul_of_pos_right htV hXpos + _ = powerRemainderBound b c (m + 1) := by + rw [powerRemainderBound] + ring + calc t * germOrdinalValue (germAt ((b.1 ^ (m + 1) * c.1 : Series K) : K⟦ℝ⟧) ξ) + ≤ t * (max (max (NatOrdinal.of (b.residualValue.val * α₁) * (V ^ m * W)) + (V ^ (m + 1) * NatOrdinal.of (c.residualValue.val * α₂))) + (V ^ m * b.residualValue * W)) := mul_le_mul_right hval t + _ = max (max (t * (NatOrdinal.of (b.residualValue.val * α₁) * (V ^ m * W))) + (t * (V ^ (m + 1) * NatOrdinal.of (c.residualValue.val * α₂)))) + (t * (V ^ m * b.residualValue * W)) := by + rw [hmono.map_max, hmono.map_max] + _ < powerRemainderBound b c (m + 1) := max_lt (max_lt h1 h2) h3 + +private theorem powerRemainder_step + (b c : SeriesWithOrdinalValueAboveOne K) (hp : b.principalValue ≤ c.principalValue) (m : ℕ) + (hP : ∃ η < (0 : ℝ), ∀ γ : ℝ, η < γ → γ < 0 → + germOrdinalValue (powerRemainder b c m γ) < powerRemainderBound b c m) : + ∃ η < (0 : ℝ), ∀ γ : ℝ, η < γ → γ < 0 → + germOrdinalValue (powerRemainder b c (m + 1) γ) < powerRemainderBound b c (m + 1) := by + classical + obtain ⟨ηQ, hηQ, hQ⟩ := exists_mul_germOrdinalValue_powerProduct_lt b c hp m hP + obtain ⟨ηP, hηP, hP'⟩ := hP + obtain ⟨ηb, hηb, hcutb⟩ := exists_ordinalValue_translatedTruncation_le b + refine ⟨max ηQ (max ηP ηb), max_lt hηQ (max_lt hηP hηb), fun γ hlow hhigh ↦ ?_⟩ + have hγQ : ηQ < γ := (le_max_left _ _).trans_lt hlow + have hγP : ηP < γ := ((le_max_left ηP ηb).trans (le_max_right ηQ _)).trans_lt hlow + have hγb : ηb < γ := ((le_max_right ηP ηb).trans (le_max_right ηQ _)).trans_lt hlow + set d : Series K := b.1 ^ (m + 1) * c.1 with hddef + set T := convolutionIndex (b.1 : K⟦ℝ⟧) ((d : Series K) : K⟦ℝ⟧) γ with hTdef + set f : ℝ → Germ K := + fun β ↦ + germAt (b.1 : K⟦ℝ⟧) β * germAt ((d : Series K) : K⟦ℝ⟧) (γ - β) with hfdef + have hclosb : closure (b.1 : K⟦ℝ⟧).support ⊆ Set.Iic 0 := + closure_minimal (HahnSeries.Nonpositive.support_subset b.1) isClosed_Iic + have hclosd : closure ((d : Series K) : K⟦ℝ⟧).support ⊆ Set.Iic 0 := + closure_minimal (HahnSeries.Nonpositive.support_subset d) isClosed_Iic + have hfγ : f γ = germAt (b.1 : K⟦ℝ⟧) γ * toGerm d := by + simp only [hfdef, sub_self, germAt_apply, translatedTruncation_zero] + have hf0 : f 0 = toGerm b.1 * germAt ((d : Series K) : K⟦ℝ⟧) γ := by + simp only [hfdef, sub_zero, germAt_apply, translatedTruncation_zero] + have hfγzero : γ ∉ T → f γ = 0 := by + intro hmem + rw [hTdef, mem_convolutionIndex] at hmem + push Not at hmem + simp only [sub_self] at hmem + simp only [hfdef, sub_self] + by_cases hb : γ ∈ closure (b.1 : K⟦ℝ⟧).support + · rw [germAt_eq_zero_of_not_mem_closure_support (hmem hb), mul_zero] + · rw [germAt_eq_zero_of_not_mem_closure_support hb, zero_mul] + have hf0zero : (0 : ℝ) ∉ T → f 0 = 0 := by + intro hmem + rw [hTdef, mem_convolutionIndex] at hmem + push Not at hmem + simp only [sub_zero] at hmem + simp only [hfdef, sub_zero] + by_cases hb : (0 : ℝ) ∈ closure (b.1 : K⟦ℝ⟧).support + · rw [germAt_eq_zero_of_not_mem_closure_support (hmem hb), mul_zero] + · rw [germAt_eq_zero_of_not_mem_closure_support hb, zero_mul] + have hstep1 : ∑ β ∈ T, f β = f γ + ∑ β ∈ T.erase γ, f β := by + by_cases hmem : γ ∈ T + · exact (Finset.add_sum_erase T f hmem).symm + · rw [Finset.erase_eq_of_notMem hmem, hfγzero hmem, zero_add] + have hmem0 : (0 : ℝ) ∈ T.erase γ ↔ (0 : ℝ) ∈ T := by + rw [Finset.mem_erase] + exact ⟨fun h ↦ h.2, fun h ↦ ⟨(ne_of_lt hhigh).symm, h⟩⟩ + have hstep2 : ∑ β ∈ T.erase γ, f β = f 0 + ∑ β ∈ (T.erase γ).erase 0, f β := by + by_cases hmem : (0 : ℝ) ∈ T.erase γ + · exact (Finset.add_sum_erase _ f hmem).symm + · rw [Finset.erase_eq_of_notMem hmem, hf0zero (fun h ↦ hmem (hmem0.mpr h)), zero_add] + have hSeries : (b.1 ^ (m + 1 + 1) * c.1 : Series K) = b.1 * d := by + rw [hddef]; ring + have hcoe : ((b.1 ^ (m + 1 + 1) * c.1 : Series K) : K⟦ℝ⟧) + = (b.1 : K⟦ℝ⟧) * ((d : Series K) : K⟦ℝ⟧) := by rw [hSeries]; rfl + have hsum : germAt ((b.1 ^ (m + 1 + 1) * c.1 : Series K) : K⟦ℝ⟧) γ + = f γ + f 0 + ∑ β ∈ (T.erase γ).erase 0, f β := by + rw [hcoe, germAt_mul, ← hTdef, ← hfdef, hstep1, hstep2] + abel + have hg1 : toGerm (b.1 ^ m * c.1) = toGerm b.1 ^ m * toGerm c.1 := by + rw [map_mul, map_pow] + have hg2 : toGerm d = toGerm b.1 ^ (m + 1) * toGerm c.1 := by + rw [hddef, map_mul, map_pow] + have hg3 : toGerm (b.1 ^ (m + 1)) = toGerm b.1 ^ (m + 1) := map_pow _ _ _ + have hg4 : toGerm (b.1 ^ (m + 1 + 1)) = toGerm b.1 ^ (m + 1 + 1) := map_pow _ _ _ + have hrewrite : powerRemainder b c (m + 1) γ + = toGerm b.1 * powerRemainder b c m γ + ∑ β ∈ (T.erase γ).erase 0, f β := by + rw [powerRemainder, hsum, hfγ, hf0, germAt_powerProduct_decomp b c m γ, + powerRemainder, hg1, hg2, hg3, hg4] + ring + have hVpos : (0 : NatOrdinal) < ordinalValue b.1 := lt_trans zero_lt_one b.2 + have hWpos : (0 : NatOrdinal) < ordinalValue c.1 := lt_trans zero_lt_one c.2 + have hρpos : (0 : NatOrdinal) < b.residualValue := + pos_iff_ne_zero.mpr b.residualValue_ne_zero + have hboundpos : (0 : NatOrdinal) < powerRemainderBound b c (m + 1) := by + rw [powerRemainderBound] + exact mul_pos (mul_pos (pow_pos hVpos (m + 1)) hρpos) hWpos + rw [hrewrite] + refine (germOrdinalValue_add_le_max _ _).trans_lt (max_lt ?_ ?_) + · calc germOrdinalValue (toGerm b.1 * powerRemainder b c m γ) + ≤ ordinalValue b.1 * germOrdinalValue (powerRemainder b c m γ) := by + refine (germOrdinalValue_mul_le_naturalMul _ _).trans ?_ + rw [germOrdinalValue_toGerm] + _ < ordinalValue b.1 * powerRemainderBound b c m := + mul_lt_mul_of_pos_left (hP' γ hγP hhigh) hVpos + _ = powerRemainderBound b c (m + 1) := by + rw [powerRemainderBound, powerRemainderBound]; ring + · refine germOrdinalValue_sum_lt hboundpos fun β hβ ↦ ?_ + obtain ⟨hβ0, hβrest⟩ := Finset.mem_erase.mp hβ + obtain ⟨hβγ, hβT⟩ := Finset.mem_erase.mp hβrest + rw [hTdef, mem_convolutionIndex] at hβT + have hβle : β ≤ 0 := hclosb hβT.1 + have hβneg : β < 0 := lt_of_le_of_ne hβle hβ0 + have hγβle : γ - β ≤ 0 := hclosd hβT.2 + have hγβ : γ < β := by + rcases lt_or_eq_of_le (by linarith : γ ≤ β) with h | h + · exact h + · exact absurd h.symm hβγ + obtain ⟨α, hα, hαle⟩ := hcutb β (hγb.trans hγβ) hβneg + have hb₁ : germOrdinalValue (germAt (b.1 : K⟦ℝ⟧) β) ≤ + NatOrdinal.of (b.residualValue.val * α) := by + rw [germAt_apply, toGerm_apply, germOrdinalValue_mk] + simpa using NatOrdinal.of.le_iff_le.mpr hαle + refine lt_of_le_of_lt ((germOrdinalValue_mul_le_naturalMul _ _).trans + (mul_le_mul_left hb₁ _)) ?_ + exact hQ (γ - β) (by linarith) (by linarith) α hα + +/-- Berarducci, Lemma 7.7 in the product-rule form used by Lemma 8.2: the germ of `b ^ (m + 1) * c` +at a sufficiently high negative cutoff differs from `(m + 1) * b^{|γ} b^m c + b^{m+1} c^{|γ}` by a +germ of ordinal value strictly below `v_J(b) ^ m ⊙ v_J^r(b) ⊙ v_J(c)`. -/ +theorem exists_powerRemainder_lt + (b c : SeriesWithOrdinalValueAboveOne K) (hp : b.principalValue ≤ c.principalValue) (m : ℕ) : + ∃ η < (0 : ℝ), ∀ γ : ℝ, η < γ → γ < 0 → + germOrdinalValue (powerRemainder b c m γ) < powerRemainderBound b c m := by + induction m with + | zero => exact exists_powerRemainder_lt_zero b c hp + | succ m ih => exact powerRemainder_step b c hp m ih + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponent.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponent.lean new file mode 100644 index 0000000000..8b5a50cedc --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponent.lean @@ -0,0 +1,461 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.RV +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Residue +import Mathlib.Tactic.Abel + +/-! +# The spaces `P_α` + +For an exponent `α`, this module defines the space `P_α` intrinsically as + +`J_{ω^(α+1)} / J_{ω^α}`. + +Here `J_{ω^α}` is the additive subgroup of series whose ordinal value is strictly below `ω^α`. +In Lean, the quotient is the grade-`α` component of the multiplicative degree +`ordinalValueDegreeValuation K`, the leading Cantor exponent of `v_J`. Thus the quotient structure +and representative independence are inherited from the generic associated-graded construction; +no basis, complement, or chosen family of representatives occurs in the definition. + +The representative API proves that equality is congruence modulo `J_{ω^α}`. It also proves the +characterization from LM24, Remark 7.2.4: every nonzero class has a principal Hahn series +representative of exact degree `α`. This characterization is a theorem about the intrinsic +quotient, not its primitive definition. + +Constants act through the degree-zero residue ring, giving every homogeneous component its canonical +`K`-module structure. Everything here holds over an arbitrary coefficient field: the components and +their multiplication use only the max-additive degree structure of `ordinalValueDegreeValuation`, +that is, Berarducci, Lemma 5.5, and never the multiplicativity of the ordinal value. +-/ + +universe v + +public noncomputable section + +namespace Berarducci + +open HahnSeries +open scoped DirectSum + +variable {K : Type v} [Field K] + +variable (K) in +/-- The source space `J_{ω^α}` of series whose ordinal value is below `ω^α`. -/ +abbrev ordinalValueCut (α : NatOrdinal) := + (ordinalValueDegreeValuation K).filtrationLT α + +theorem mem_ordinalValueCut_iff (α : NatOrdinal) (b : Series K) : + b ∈ ordinalValueCut K α ↔ ordinalValue b < ω^ α := + mem_ordinalValueDegreeValuation_filtrationLT_iff b α + +variable (K) in +/-- The source space `J_{ω^(α+1)}` is the weak degree filtration at `α`. -/ +theorem ordinalValueCut_add_one_eq_filtrationLE (α : NatOrdinal) : + ordinalValueCut K (α + 1) = + (ordinalValueDegreeValuation K).filtrationLE α := by + ext b + rw [mem_ordinalValueCut_iff, + mem_ordinalValueDegreeValuation_filtrationLE_iff] + +variable (K) in +/-- The space `P_α = J_{ω^(α+1)} / J_{ω^α}`. -/ +abbrev PrincipalComponent (α : NatOrdinal) := + (ordinalValueDegreeValuation K).Component α + +/-- The class in `P_α` of a series in `J_{ω^(α+1)}`. -/ +def principalComponentMk (α : NatOrdinal) + (b : Series K) (hb : ordinalValue b < ω^ (α + 1)) : PrincipalComponent K α := + let w := ordinalValueDegreeValuation K + w.componentMk α ⟨b, (mem_ordinalValueDegreeValuation_filtrationLE_iff b α).mpr hb⟩ + +/-- `principalComponentMk` is the associated-graded quotient map on the ordinal-value filtration. -/ +theorem principalComponentMk_eq_componentMk (α : NatOrdinal) + (b : Series K) (hb : ordinalValue b < ω^ (α + 1)) : + principalComponentMk α b hb = + (ordinalValueDegreeValuation K).componentMk α + ⟨b, (mem_ordinalValueDegreeValuation_filtrationLE_iff b α).mpr hb⟩ := + (rfl) + +@[simp] +theorem principalComponentMk_eq_zero_iff + (α : NatOrdinal) (b : Series K) (hb : ordinalValue b < ω^ (α + 1)) : + principalComponentMk α b hb = 0 ↔ ordinalValue b < ω^ α := by + let w := ordinalValueDegreeValuation K + change w.componentMk α ⟨b, _⟩ = 0 ↔ _ + rw [w.componentMk_eq_zero_iff] + rw [show w b = ordinalValueDegree b from + ordinalValueDegreeValuation_apply b] + exact ordinalValueDegree_lt_coe_iff b α + +/-- Equality in `P_α` is congruence modulo the strict cut `J_{ω^α}`. -/ +theorem principalComponentMk_eq_iff (α : NatOrdinal) (b c : Series K) + (hb : ordinalValue b < ω^ (α + 1)) + (hc : ordinalValue c < ω^ (α + 1)) : + principalComponentMk α b hb = principalComponentMk α c hc ↔ + ordinalValue (b - c) < ω^ α := by + let w := ordinalValueDegreeValuation K + change w.componentMk α ⟨b, _⟩ = w.componentMk α ⟨c, _⟩ ↔ _ + rw [← sub_eq_zero, ← map_sub, w.componentMk_eq_zero_iff] + change w (b - c) < (α : WithBot NatOrdinal) ↔ _ + rw [ordinalValueDegreeValuation_apply] + exact ordinalValueDegree_lt_coe_iff (b - c) α + +/-- Every class in `P_α` has a representative in its weak ordinal-value cut. -/ +theorem exists_principalComponentMk (α : NatOrdinal) (x : PrincipalComponent K α) : + ∃ (b : Series K) (hb : ordinalValue b < ω^ (α + 1)), + principalComponentMk α b hb = x := by + let w := ordinalValueDegreeValuation K + induction x using QuotientAddGroup.induction_on with + | H b => + have hb : ordinalValue (b : Series K) < ω^ (α + 1) := + (mem_ordinalValueDegreeValuation_filtrationLE_iff (b : Series K) α).mp b.2 + refine ⟨b, hb, ?_⟩ + rw [show principalComponentMk α b hb = + w.componentMk α ⟨(b : Series K), _⟩ from rfl, + w.coe_component_eq_componentMk] + +private theorem supportSup_eq_zero_of_not_mem_nearConstantSubgroup + {b : Series K} (hb : b ∉ nearConstantSubgroup K) : + HahnSeries.Nonpositive.supportSup b = 0 := by + apply le_antisymm (HahnSeries.Nonpositive.supportSup_le_zero b) + apply le_of_not_gt + intro hlt + apply hb + apply negativeMonomialIdeal_le_nearConstantSubgroup + exact HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero.mpr hlt + +private theorem principal_representative_of_ordinalValue_eq_wpow + (α : NatOrdinal) (hα : 0 < α) (b : Series K) + (hbValue : ordinalValue b = ω^ α) : + ∃ (p : Series K), + HahnSeries.Nonpositive.IsPrincipal p ∧ + (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal) ∧ + ordinalValue p < ω^ (α + 1) ∧ + ordinalValue (b - p) < ω^ α := by + have hbOne : 1 < ordinalValue b := by + rw [hbValue] + simpa using NatOrdinal.wpow_lt_wpow.mpr hα + have hbNear : b ∉ nearConstantSubgroup K := one_lt_ordinalValue_iff.mp hbOne + obtain ⟨p, hbp, hpTypeNat⟩ := + mem_representativeOrderTypes_iff.mp + (ordinalValue_mem_representativeOrderTypes b) + have hpNear : p ∉ nearConstantSubgroup K := by + intro hpNear + apply hbNear + have hsum := (nearConstantSubgroup K).add_mem hbp hpNear + simpa only [sub_add_cancel] using hsum + have hpType : (p : K⟦ℝ⟧).supportOrderType = (ω^ α).val := by + have h := congrArg NatOrdinal.val hpTypeNat + rw [hbValue] at h + simpa using h + have hpPrincipal : HahnSeries.Nonpositive.IsPrincipal p := by + rw [HahnSeries.Nonpositive.isPrincipal_iff] + constructor + · rw [HahnSeries.isWeaklyPrincipal_iff, hpType, NatOrdinal.val_wpow] + exact Ordinal.isAdditivelyPrincipal_omega0_opow α.val + · exact supportSup_eq_zero_of_not_mem_nearConstantSubgroup hpNear + have hpDegree : (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal) := by + rw [HahnSeries.degree_eq_cantorDegree, hpType, + ← NatOrdinal.cantorDegree_eq_ordinalCantorDegree, + NatOrdinal.cantorDegree_wpow] + have hpBound : ordinalValue p < ω^ (α + 1) := by + apply (ordinalValue_le_supportOrderType p).trans_lt + rw [hpType] + exact NatOrdinal.val.strictMono (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one α)) + have hdiffBound : ordinalValue (b - p) < ω^ α := by + by_cases hdiffJ : b - p ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K + · rw [ordinalValue_of_mem_negativeMonomialIdeal hdiffJ] + exact NatOrdinal.wpow_pos α + · rw [ordinalValue_of_mem_nearConstantSubgroup_of_not_mem_negativeMonomialIdeal + hbp hdiffJ] + simpa using NatOrdinal.wpow_lt_wpow.mpr hα + exact ⟨p, hpPrincipal, hpDegree, hpBound, hdiffBound⟩ + +private theorem principal_representative_of_ordinalValue_eq_one (b : Series K) + (hbValue : ordinalValue b = 1) : + ∃ (p : Series K), + HahnSeries.Nonpositive.IsPrincipal p ∧ + (p : K⟦ℝ⟧).degree = (0 : WithBot NatOrdinal) ∧ + ordinalValue p < ω^ (0 + 1 : NatOrdinal) ∧ + ordinalValue (b - p) < ω^ (0 : NatOrdinal) := by + have hb := ordinalValue_eq_one_iff.mp hbValue + let k := HahnSeries.Nonpositive.constantCoeff b + have hk : k ≠ 0 := by + intro hk + apply hb.2 + have hmem := mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem.mp hb.1 + simpa [k, hk] using hmem + let p : Series K := HahnSeries.Nonpositive.C k + have hpPrincipal : HahnSeries.Nonpositive.IsPrincipal p := + HahnSeries.Nonpositive.isPrincipal_C hk + have hpDegree : (p : K⟦ℝ⟧).degree = (0 : WithBot NatOrdinal) := by + change ((HahnSeries.Nonpositive.C k : Series K) : K⟦ℝ⟧).degree = + (0 : WithBot NatOrdinal) + rw [HahnSeries.Nonpositive.coe_C] + change (HahnSeries.C (Γ := ℝ) k).degree = (0 : WithBot NatOrdinal) + rw [HahnSeries.C_apply, HahnSeries.degree_eq_cantorDegree, + HahnSeries.supportOrderType_single hk, Ordinal.cantorDegree_one] + have hpBound : ordinalValue p < ω^ (0 + 1 : NatOrdinal) := by + rw [show p = HahnSeries.Nonpositive.C k from rfl, ordinalValue_C_of_ne hk] + simpa using NatOrdinal.wpow_lt_wpow.mpr (zero_lt_one : (0 : NatOrdinal) < 1) + have hdiffJ : b - p ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K := + mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem.mp hb.1 + have hdiffBound : ordinalValue (b - p) < ω^ (0 : NatOrdinal) := by + rw [ordinalValue_of_mem_negativeMonomialIdeal hdiffJ] + exact NatOrdinal.wpow_pos 0 + exact ⟨p, hpPrincipal, hpDegree, hpBound, hdiffBound⟩ + +/-- Every nonzero class in `P_α` has a principal representative of exact series degree +`α`. This is the representative characterization in LM24, Remark 7.2.4. -/ +@[blueprint "fact:principal-series-representatives" + (phase := "Ordinal value and degree") + (title := "Principal representatives of $\\mathrm P_\\alpha$ (LM24, Remark 7.2.4)") + (statement := /-- + Every nonzero element of $\Prin_\alpha$ is represented by a principal + series $p$ of exact degree $\alpha$. + -/) + (proof := /-- + A nonzero class in $P_\alpha$ has a representative $b$ with + $v_J(b)=\omega^\alpha$. The principal-part theorem replaces $b$ by a + principal series $p$ of degree $\alpha$ with $v_J(b-p)<\omega^\alpha$; + this is exactly equality in the quotient. + -/)] +theorem exists_principal_representative_of_ne_zero (α : NatOrdinal) + (x : PrincipalComponent K α) (hx : x ≠ 0) : + ∃ (p : Series K) (hpBound : ordinalValue p < ω^ (α + 1)), + HahnSeries.Nonpositive.IsPrincipal p ∧ + (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal) ∧ + principalComponentMk α p hpBound = x := by + obtain ⟨b, hbBound, hbx⟩ := exists_principalComponentMk α x + have hbNotLower : ¬ordinalValue b < ω^ α := by + intro hbLower + apply hx + rw [← hbx] + exact (principalComponentMk_eq_zero_iff α b hbBound).mpr hbLower + have hbDegreeLE : ordinalValueDegree b ≤ (α : WithBot NatOrdinal) := + (ordinalValueDegree_le_coe_iff b α).mpr hbBound + have hbDegreeGE : (α : WithBot NatOrdinal) ≤ ordinalValueDegree b := by + apply le_of_not_gt + intro hbDegreeLT + exact hbNotLower ((ordinalValueDegree_lt_coe_iff b α).mp hbDegreeLT) + have hbDegree : ordinalValueDegree b = (α : WithBot NatOrdinal) := + le_antisymm hbDegreeLE hbDegreeGE + have hbValue : ordinalValue b = ω^ α := + (ordinalValueDegree_eq_coe_iff b α).mp hbDegree + rcases eq_or_ne α 0 with rfl | hα + · obtain ⟨p, hp, hpDegree, hpBound, hdiff⟩ := + principal_representative_of_ordinalValue_eq_one b (by simpa using hbValue) + refine ⟨p, hpBound, hp, hpDegree, ?_⟩ + calc + principalComponentMk 0 p hpBound = + principalComponentMk 0 b hbBound := + (principalComponentMk_eq_iff 0 p b hpBound hbBound).mpr (by + have hdiffEq : p - b = -(b - p) := by abel + rw [hdiffEq, ordinalValue_neg] + exact hdiff) + _ = x := hbx + · obtain ⟨p, hp, hpDegree, hpBound, hdiff⟩ := + principal_representative_of_ordinalValue_eq_wpow α + (bot_lt_iff_ne_bot.mpr hα) b hbValue + refine ⟨p, hpBound, hp, hpDegree, ?_⟩ + calc + principalComponentMk α p hpBound = + principalComponentMk α b hbBound := + (principalComponentMk_eq_iff α p b hpBound hbBound).mpr (by + have hdiffEq : p - b = -(b - p) := by abel + rw [hdiffEq, ordinalValue_neg] + exact hdiff) + _ = x := hbx + +/-- Multiplication `P_α × P_β → P_{α + β}`, where addition is the Hessenberg sum. -/ +def principalComponentMul {α β : NatOrdinal} : + PrincipalComponent K α → PrincipalComponent K β → PrincipalComponent K (α + β) := + (ordinalValueDegreeValuation K).componentMul + +/-- Intrinsic homogeneous multiplication is the associated-graded component multiplication. -/ +theorem principalComponentMul_eq_componentMul {α β : NatOrdinal} + (x : PrincipalComponent K α) (y : PrincipalComponent K β) : + principalComponentMul x y = + (ordinalValueDegreeValuation K).componentMul x y := + (rfl) + +/-- Products of representatives from the weak cuts at `α` and `β` lie in the weak cut at +`α + β`. -/ +theorem ordinalValue_mul_lt_wpow_add_one {α β : NatOrdinal} + {b c : Series K} (hb : ordinalValue b < ω^ (α + 1)) + (hc : ordinalValue c < ω^ (β + 1)) : + ordinalValue (b * c) < ω^ (α + β + 1) := by + apply (ordinalValueDegree_le_coe_iff (b * c) (α + β)).mp + exact (ordinalValueDegree_mul_le_add b c).trans (add_le_add + ((ordinalValueDegree_le_coe_iff b α).mpr hb) + ((ordinalValueDegree_le_coe_iff c β).mpr hc)) + +/-- Homogeneous multiplication is induced by multiplication of representatives. -/ +@[simp] +theorem principalComponentMul_mk {α β : NatOrdinal} (b c : Series K) + (hb : ordinalValue b < ω^ (α + 1)) + (hc : ordinalValue c < ω^ (β + 1)) : + principalComponentMul + (principalComponentMk α b hb) + (principalComponentMk β c hc) = + principalComponentMk (α + β) (b * c) + (ordinalValue_mul_lt_wpow_add_one hb hc) := by + let w := ordinalValueDegreeValuation K + change w.componentMul + (w.componentMk α ⟨b, _⟩) + (w.componentMk β ⟨c, _⟩) = + w.componentMk (α + β) ⟨b * c, _⟩ + rw [w.componentMul_componentMk] + apply congrArg (w.componentMk (α + β)) + apply Subtype.ext + exact w.coe_mulFiltrationLE _ _ + +/-- A constant has ordinal value below the first positive principal cut. -/ +theorem ordinalValue_C_lt_wpow_one (k : K) : + ordinalValue ((HahnSeries.Nonpositive.C : K →+* Series K) k) < + ω^ (0 + 1 : NatOrdinal) := by + by_cases hk : k = 0 + · subst k + simp + · rw [ordinalValue_C_of_ne hk] + simpa only [zero_add, NatOrdinal.wpow_zero] using + NatOrdinal.wpow_lt_wpow.mpr (zero_lt_one : (0 : NatOrdinal) < 1) + +variable (K) in +private def constantToOrdinalValueNonpositiveSubring : + K →+* (ordinalValueDegreeValuation K).nonpositiveSubring := + let w := ordinalValueDegreeValuation K + (HahnSeries.Nonpositive.C : K →+* Series K).codRestrict w.nonpositiveSubring fun k ↦ by + rw [w.mem_nonpositiveSubring_iff, + ordinalValueDegreeValuation_apply] + by_cases hk : k = 0 + · subst k + simp + · rw [ordinalValueDegree_C_of_ne hk] + +variable (K) in +/-- The scalar map from constants to the grade-zero residue ring of the exponent-valued order +value. -/ +def principalComponentScalarHom : + K →+* (ordinalValueDegreeValuation K).ResidueRing := + let w := ordinalValueDegreeValuation K + w.residueMap.comp (constantToOrdinalValueNonpositiveSubring K) + +/-- The scalar map `K → P_0` sends a coefficient to the class of the corresponding constant +series. -/ +theorem principalComponentScalarHom_apply (k : K) : + principalComponentScalarHom K k = + principalComponentMk 0 + ((HahnSeries.Nonpositive.C : K →+* Series K) k) + (ordinalValue_C_lt_wpow_one k) := by + let w := ordinalValueDegreeValuation K + change w.residueMap _ = w.componentMk 0 _ + rw [w.residueMap_apply] + apply congrArg (w.componentMk 0) + apply Subtype.ext + rw [w.coe_nonpositiveEquivFiltrationLEZero] + rfl + +variable (K) in +/-- Distinct coefficients determine distinct classes in `P_0`. -/ +theorem principalComponentScalarHom_injective : + Function.Injective (principalComponentScalarHom K) := by + intro k l hkl + have hsub : principalComponentScalarHom K (k - l) = 0 := by + rw [map_sub, hkl, sub_self] + rw [principalComponentScalarHom_apply, + principalComponentMk_eq_zero_iff] at hsub + by_contra hne + rw [ordinalValue_C_of_ne (sub_ne_zero.mpr hne)] at hsub + exact (lt_irrefl (1 : NatOrdinal)) (by + simpa only [NatOrdinal.wpow_zero] using hsub) + +variable (K) in +/-- Every grade-zero principal class is represented by a unique coefficient. -/ +theorem principalComponentScalarHom_surjective : + Function.Surjective (principalComponentScalarHom K) := by + intro x + by_cases hx : x = 0 + · exact ⟨0, by simp [hx]⟩ + obtain ⟨p, hpBound, _, _, hpx⟩ := + exists_principal_representative_of_ne_zero 0 x hx + let k := HahnSeries.Nonpositive.constantCoeff p + refine ⟨k, ?_⟩ + rw [principalComponentScalarHom_apply, ← hpx] + apply (principalComponentMk_eq_iff 0 + (HahnSeries.Nonpositive.C k) p + (ordinalValue_C_lt_wpow_one k) hpBound).mpr + have hpNotLower : ¬ordinalValue p < ω^ (0 : NatOrdinal) := by + intro hpLower + apply hx + rw [← hpx] + exact (principalComponentMk_eq_zero_iff 0 p hpBound).mpr hpLower + have hpDegreeLE : ordinalValueDegree p ≤ (0 : WithBot NatOrdinal) := + (ordinalValueDegree_le_coe_iff p 0).mpr hpBound + have hpDegreeGE : (0 : WithBot NatOrdinal) ≤ ordinalValueDegree p := by + apply le_of_not_gt + intro hpDegreeLT + exact hpNotLower ((ordinalValueDegree_lt_coe_iff p 0).mp hpDegreeLT) + have hpValue : ordinalValue p = 1 := by + simpa only [NatOrdinal.wpow_zero] using + (ordinalValueDegree_eq_coe_iff p 0).mp + (le_antisymm hpDegreeLE hpDegreeGE) + have hpJ : + p - HahnSeries.Nonpositive.C k ∈ + HahnSeries.Nonpositive.negativeMonomialIdeal K := + mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem.mp + (ordinalValue_eq_one_iff.mp hpValue).1 + rw [show HahnSeries.Nonpositive.C k - p = + -(p - HahnSeries.Nonpositive.C k) by abel] + rw [ordinalValue_neg, ordinalValue_of_mem_negativeMonomialIdeal hpJ] + exact NatOrdinal.wpow_pos 0 + +/-- The space `P_0` is nontrivial because it contains the coefficient field. -/ +instance principalComponentZeroNontrivial : + Nontrivial (PrincipalComponent K 0) := + (principalComponentScalarHom_injective K).nontrivial + +/-- Every `P_α` is canonically a vector space over `K`. -/ +noncomputable instance principalComponentModule (α : NatOrdinal) : + Module K (PrincipalComponent K α) := + Module.compHom (PrincipalComponent K α) (principalComponentScalarHom K) + +/-- Scalar multiplication on `P_α` is multiplication of a representative by the corresponding +constant series. -/ +theorem smul_principalComponentMk (α : NatOrdinal) + (k : K) (b : Series K) (hb : ordinalValue b < ω^ (α + 1)) : + k • principalComponentMk α b hb = + principalComponentMk α + ((HahnSeries.Nonpositive.C : K →+* Series K) k * b) + (by + simpa only [zero_add] using + ordinalValue_mul_lt_wpow_add_one + (ordinalValue_C_lt_wpow_one k) hb) := by + let w := ordinalValueDegreeValuation K + rw [show k • principalComponentMk α b hb = + (principalComponentScalarHom K k) • principalComponentMk α b hb from rfl] + rw [principalComponentScalarHom_apply] + apply DirectSum.of_injective (β := w.Component) α + rw [DirectSum.of_zero_smul, DirectSum.of_mul_of] + change DirectSum.of w.Component (0 + α) + (principalComponentMul + (principalComponentMk 0 + ((HahnSeries.Nonpositive.C : K →+* Series K) k) + (ordinalValue_C_lt_wpow_one k)) + (principalComponentMk α b hb)) = _ + rw [principalComponentMul_mk] + apply DirectSum.of_eq_of_gradedMonoid_eq + apply Sigma.ext (zero_add α) + exact w.componentMk_heq_of_grade_eq_of_coe_eq (zero_add α) _ _ rfl + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentDegree.lean new file mode 100644 index 0000000000..d625b13781 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentDegree.lean @@ -0,0 +1,784 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponent +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.OrdinalValueDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedMap + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Residue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition + +/-! +# Principal series in the two degree filtrations + +This module relates a principal Hahn series to Berarducci's ordinal value and then compares the +fixed homogeneous components for Hahn-series degree and ordinal-value degree. Both are components +of associated graded rings of `K((ℝ^{≤0}))`, and since `ordinalValueDegree b ≤ degree b`, the +identity of the ring induces the canonical component map `degreeLayerToPrincipalComponent` from the +degree-`α` component of `RV̂` to `P_α`: the generic map induced by a coarsening of filtrations. + +For a principal series of Hahn-series degree `α`, its ordinal value is exactly `ω^α`. The proof +uses the stable negative support interval for positive degree and treats degree zero separately. +Consequently, two principal representatives of exact degree `α` determine the same class in the +degree-`α` component of `RV̂` precisely when their difference lies in `J_{ω^α}`. This is +the equal-degree case of LM24, Lemma 7.2.3, and is the case used to identify the source component +with +the intrinsic quotient `J_{ω^(α+1)} / J_{ω^α}`. + +The proof uses the repaired equal-degree form of LM24, Proposition 3.6.2. The weaker printed +formulation is not assumed. + +The comparison of the two filtrations, the principal classes of a fixed degree, and their +identification with `P_α` hold over every coefficient field. Characteristic zero +enters only for the multiplication of principal classes: the product of two principal series is +principal by LM24, Proposition 3.6.1, which rests on Berarducci, Theorem 9.7, and its degree is +the Hessenberg sum of the degrees by LM24, Theorem D. +-/ + +universe v + +open scoped DirectSum HahnSeries NatOrdinal + +public noncomputable section + +namespace Berarducci + +open HahnSeries + +variable {K : Type v} [Field K] + +/-- A principal series of Hahn-series degree `α` has ordinal value `ω^α`. -/ +theorem ordinalValue_eq_wpow_of_isPrincipal {p : Series K} (hp : HahnSeries.Nonpositive.IsPrincipal + p) + {α : NatOrdinal} + (hpDegree : (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) : + ordinalValue p = ω^ α := by + have hpType := hp.supportOrderType_eq_wpow_of_degree_eq hpDegree + rcases eq_or_ne α 0 with rfl | hα + · apply le_antisymm + · simpa [hpType] using ordinalValue_le_supportOrderType p + · rw [show (ω^ (0 : NatOrdinal)) = 1 by simp] + rw [Order.one_le_iff_pos, pos_iff_ne_zero] + intro hzero + have hpJ := ordinalValue_eq_zero_iff.mp hzero + have hpSupLt := + HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero.mp hpJ + rw [hp.supportSup_eq_zero] at hpSupLt + exact lt_irrefl 0 hpSupLt + · have hαpos : 0 < α := bot_lt_iff_ne_bot.mpr hα + have hpZeroCoeff := hp.constantCoeff_eq_zero_of_degree_pos hpDegree hαpos + have hpOne : 1 < ordinalValue p := + one_lt_ordinalValue_of_constantCoeff_eq_zero_of_supportSup_eq_zero + hpZeroCoeff hp.supportSup_eq_zero + obtain ⟨η, hη, htail⟩ := + exists_negativeSupportTail_orderType_eq_ordinalValue p hpOne + let hpSupport : (p : K⟦ℝ⟧).support.IsPWO := (p : K⟦ℝ⟧).isPWO_support + let hpUpper : ((p : K⟦ℝ⟧).support ∩ Set.Ioi η).IsPWO := + hpSupport.mono Set.inter_subset_left + let hpTail : (negativeSupportTail p η).IsPWO := + hpSupport.mono (negativeSupportTail_subset_support p η) + have htailSet : negativeSupportTail p η = + (p : K⟦ℝ⟧).support ∩ Set.Ioi η := by + ext x + simp only [mem_negativeSupportTail_iff, Set.mem_inter_iff, Set.mem_Ioi] + constructor + · rintro ⟨hxp, hηx, -⟩ + exact ⟨hxp, hηx⟩ + · rintro ⟨hxp, hηx⟩ + refine ⟨hxp, hηx, lt_of_le_of_ne + (HahnSeries.Nonpositive.support_subset p hxp) ?_⟩ + intro hx + subst x + apply (HahnSeries.mem_support _ _).mp hxp + simpa [HahnSeries.Nonpositive.constantCoeff_apply] using hpZeroCoeff + have hpLUB : IsLUB (p : K⟦ℝ⟧).support 0 := + (HahnSeries.Nonpositive.supportSup_eq_coe_iff.mp hp.supportSup_eq_zero).2 + obtain ⟨y, hy, hηy, -⟩ := hpLUB.exists_between hη + have hpPrincipal : Ordinal.IsPrincipal (fun a b ↦ a + b) hpSupport.orderType := + by + simpa only [hpSupport, ← HahnSeries.supportOrderType_eq_setOrderType] using + (Ordinal.isAdditivelyPrincipal_iff_ne_zero_and_isPrincipal_add.mp + (HahnSeries.isWeaklyPrincipal_iff.mp hp.isWeaklyPrincipal)).2 + have hupperType : hpUpper.orderType = hpSupport.orderType := + hpSupport.orderType_inter_Ioi_eq_of_isPrincipal hpPrincipal ⟨y, hy, hηy⟩ + apply NatOrdinal.val.injective + calc + (ordinalValue p).val = hpTail.orderType := htail.symm + _ = hpUpper.orderType := hpTail.orderType_congr hpUpper htailSet + _ = hpSupport.orderType := hupperType + _ = (p : K⟦ℝ⟧).supportOrderType := + (HahnSeries.supportOrderType_eq_setOrderType _).symm + _ = (ω^ α).val := hpType + +/-- On a principal series, Berarducci's exponent-valued ordinal value equals Hahn-series degree. -/ +theorem ordinalValueDegree_eq_degree_of_isPrincipal + {p : Series K} (hp : HahnSeries.Nonpositive.IsPrincipal p) : + ordinalValueDegree p = (p : K⟦ℝ⟧).degree := by + have hpDegreeNe : (p : K⟦ℝ⟧).degree ≠ ⊥ := by + intro hbot + exact hp.ne_zero (Subtype.ext (HahnSeries.degree_eq_bot.mp hbot)) + let α := (p : K⟦ℝ⟧).degree.unbot hpDegreeNe + have hpDegree : (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal) := + (WithBot.coe_unbot _ hpDegreeNe).symm + rw [hpDegree] + exact (ordinalValueDegree_eq_coe_iff p α).mpr + (ordinalValue_eq_wpow_of_isPrincipal hp hpDegree) + +/-- Berarducci multiplicativity implies that the product of two principal series is principal. +This recovers LM24, Proposition 3.6.1 directly from the single ordinal-value prerequisite. -/ +theorem OrdinalValueMultiplicative.isPrincipal_mul + (hmul : OrdinalValueMultiplicative K) {b c : Series K} + (hb : HahnSeries.Nonpositive.IsPrincipal b) + (hc : HahnSeries.Nonpositive.IsPrincipal c) : + HahnSeries.Nonpositive.IsPrincipal (b * c) := by + have hbDegreeNe : (b : K⟦ℝ⟧).degree ≠ ⊥ := by + intro hbot + exact hb.ne_zero (Subtype.ext (HahnSeries.degree_eq_bot.mp hbot)) + have hcDegreeNe : (c : K⟦ℝ⟧).degree ≠ ⊥ := by + intro hbot + exact hc.ne_zero (Subtype.ext (HahnSeries.degree_eq_bot.mp hbot)) + let α := (b : K⟦ℝ⟧).degree.unbot hbDegreeNe + let β := (c : K⟦ℝ⟧).degree.unbot hcDegreeNe + have hbDegree : (b : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal) := + (WithBot.coe_unbot _ hbDegreeNe).symm + have hcDegree : (c : K⟦ℝ⟧).degree = (β : WithBot NatOrdinal) := + (WithBot.coe_unbot _ hcDegreeNe).symm + have hbValue := ordinalValue_eq_wpow_of_isPrincipal hb hbDegree + have hcValue := ordinalValue_eq_wpow_of_isPrincipal hc hcDegree + have hproductValue : ordinalValue (b * c) = ω^ (α + β) := by + rw [hmul.ordinalValue_mul, hbValue, hcValue, ← NatOrdinal.wpow_add] + have htypeLE : ((b * c : Series K) : K⟦ℝ⟧).supportOrderType ≤ + (ω^ (α + β)).val := by + calc + ((b * c : Series K) : K⟦ℝ⟧).supportOrderType ≤ + (NatOrdinal.of (b : K⟦ℝ⟧).supportOrderType * + NatOrdinal.of (c : K⟦ℝ⟧).supportOrderType).val := + HahnSeries.supportOrderType_mul_le_naturalMul _ _ + _ = (ω^ (α + β)).val := by + rw [hb.supportOrderType_eq_wpow_of_degree_eq hbDegree, + hc.supportOrderType_eq_wpow_of_degree_eq hcDegree, + NatOrdinal.of_val, NatOrdinal.of_val, NatOrdinal.wpow_add] + have htypeGE : (ω^ (α + β)).val ≤ + ((b * c : Series K) : K⟦ℝ⟧).supportOrderType := by + have h := NatOrdinal.val.monotone (ordinalValue_le_supportOrderType (b * c)) + rw [hproductValue, NatOrdinal.val_wpow, NatOrdinal.val_of] at h + simpa only [NatOrdinal.val_wpow] using h + have htype : ((b * c : Series K) : K⟦ℝ⟧).supportOrderType = + (ω^ (α + β)).val := le_antisymm htypeLE htypeGE + have hnotJ : b * c ∉ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + rw [← ordinalValue_eq_zero_iff, hproductValue] + exact NatOrdinal.wpow_ne_zero (α + β) + rw [HahnSeries.Nonpositive.isPrincipal_iff] + constructor + · rw [HahnSeries.isWeaklyPrincipal_iff, htype, NatOrdinal.val_wpow] + exact Ordinal.isAdditivelyPrincipal_omega0_opow (α + β).val + · apply le_antisymm (HahnSeries.Nonpositive.supportSup_le_zero (b * c)) + apply le_of_not_gt + intro hlt + exact hnotJ + (HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero.mpr hlt) + +/-- Projection of a Hahn series in the weak degree cut to the degree-`α` component. -/ +def degreeLayerMk (α : NatOrdinal) (b : Series K) + (hb : (b : K⟦ℝ⟧).degree ≤ (α : WithBot NatOrdinal)) : + (HahnSeries.Nonpositive.degreeValuation K).Component α := by + let w := HahnSeries.Nonpositive.degreeValuation K + have hbValue : w b ≤ (α : WithBot NatOrdinal) := by + change (HahnSeries.Nonpositive.degreeValuation K) b ≤ + (α : WithBot NatOrdinal) + rw [HahnSeries.Nonpositive.degreeValuation_apply] + exact hb + exact w.componentMk α ⟨b, (w.mem_filtrationLE_iff α b).mpr hbValue⟩ + +/-- `degreeLayerMk` is the quotient map to a component of the degree-graded ring. -/ +theorem degreeLayerMk_eq_componentMk (α : NatOrdinal) (b : Series K) + (hb : (b : K⟦ℝ⟧).degree ≤ (α : WithBot NatOrdinal)) : + degreeLayerMk α b hb = + (HahnSeries.Nonpositive.degreeValuation K).componentMk α + ⟨b, by + rw [MaxAddDegree.mem_filtrationLE_iff, + HahnSeries.Nonpositive.degreeValuation_apply] + exact hb⟩ := + (rfl) + +/-- A representative vanishes in the fixed component of `RV̂` exactly when its degree is +strictly below the component grade. -/ +@[simp] +theorem degreeLayerMk_eq_zero_iff (α : NatOrdinal) (b : Series K) + (hb : (b : K⟦ℝ⟧).degree ≤ (α : WithBot NatOrdinal)) : + degreeLayerMk α b hb = 0 ↔ + (b : K⟦ℝ⟧).degree < (α : WithBot NatOrdinal) := by + let w := HahnSeries.Nonpositive.degreeValuation K + change w.componentMk α ⟨b, _⟩ = 0 ↔ _ + rw [w.componentMk_eq_zero_iff, + HahnSeries.Nonpositive.degreeValuation_apply] + +variable (K) in +/-- The ordinal-value degree is bounded by Hahn-series degree: the degree filtration refines the +ordinal-value filtration. -/ +theorem ordinalValueDegreeValuation_le_degreeValuation (b : Series K) : + ordinalValueDegreeValuation K b ≤ HahnSeries.Nonpositive.degreeValuation K b := by + rw [ordinalValueDegreeValuation_apply, HahnSeries.Nonpositive.degreeValuation_apply] + exact ordinalValueDegree_le_degree b + +variable (K) in +/-- The canonical additive map from the degree-`α` component of `RV̂` to `P_α`: +the component map of the associated graded rings induced by the identity of `K((ℝ^{≤0}))`, which +does not increase the degree because `ordinalValueDegree b ≤ degree b`. -/ +def degreeLayerToPrincipalComponent (α : NatOrdinal) : + (HahnSeries.Nonpositive.degreeValuation K).Component α →+ + PrincipalComponent K α := + (HahnSeries.Nonpositive.degreeValuation K).componentMap (ordinalValueDegreeValuation K) + (RingHom.id (Series K)) (ordinalValueDegreeValuation_le_degreeValuation K) α + +/-- The canonical component map is the generic component map of the two filtrations. -/ +theorem degreeLayerToPrincipalComponent_eq_componentMap (α : NatOrdinal) : + degreeLayerToPrincipalComponent K α = + (HahnSeries.Nonpositive.degreeValuation K).componentMap (ordinalValueDegreeValuation K) + (RingHom.id (Series K)) (ordinalValueDegreeValuation_le_degreeValuation K) α := + (rfl) + +/-- On an arbitrary weak-filtration representative, the canonical component map keeps the +underlying Hahn series and changes only the quotient filtration. -/ +theorem degreeLayerToPrincipalComponent_componentMk (α : NatOrdinal) + (b : MaxAddDegree.filtrationLE + (HahnSeries.Nonpositive.degreeValuation K) α) : + degreeLayerToPrincipalComponent K α + (MaxAddDegree.componentMk + (HahnSeries.Nonpositive.degreeValuation K) α b) = + (ordinalValueDegreeValuation K).componentMk α + ⟨b, by + rw [MaxAddDegree.mem_filtrationLE_iff, + ordinalValueDegreeValuation_apply] + have hbDegree := + (MaxAddDegree.mem_filtrationLE_iff + (HahnSeries.Nonpositive.degreeValuation K) α b).mp b.2 + rw [HahnSeries.Nonpositive.degreeValuation_apply] at hbDegree + exact (ordinalValueDegree_le_degree (b : Series K)).trans hbDegree⟩ := by + rw [degreeLayerToPrincipalComponent, MaxAddDegree.componentMap_componentMk] + apply congrArg ((ordinalValueDegreeValuation K).componentMk α) + apply Subtype.ext + rw [MaxAddDegree.coe_mapFiltrationLE, RingHom.id_apply] + +/-- The canonical component map sends a degree-`α` representative to the same series modulo +the ordinal-value cut. -/ +@[simp] +theorem degreeLayerToPrincipalComponent_mk (α : NatOrdinal) (b : Series K) + (hbDegree : (b : K⟦ℝ⟧).degree ≤ (α : WithBot NatOrdinal)) : + degreeLayerToPrincipalComponent K α + (degreeLayerMk α b hbDegree) = + principalComponentMk α b + ((ordinalValueDegree_le_coe_iff b α).mp + ((ordinalValueDegree_le_degree b).trans hbDegree)) := by + let wDegree := HahnSeries.Nonpositive.degreeValuation K + change degreeLayerToPrincipalComponent K α + (wDegree.componentMk α ⟨b, _⟩) = _ + rw [degreeLayerToPrincipalComponent_componentMk, principalComponentMk_eq_componentMk] + +/-- Projection to a fixed component of `RV̂` preserves addition of representatives. -/ +theorem degreeLayerMk_add (α : NatOrdinal) (b c : Series K) + (hb : (b : K⟦ℝ⟧).degree ≤ (α : WithBot NatOrdinal)) + (hc : (c : K⟦ℝ⟧).degree ≤ (α : WithBot NatOrdinal)) : + degreeLayerMk α (b + c) + ((HahnSeries.degree_add_le (b : K⟦ℝ⟧) (c : K⟦ℝ⟧)).trans + (max_le hb hc)) = + degreeLayerMk α b hb + degreeLayerMk α c hc := by + let w := HahnSeries.Nonpositive.degreeValuation K + change w.componentMk α ⟨b + c, _⟩ = + w.componentMk α ⟨b, _⟩ + w.componentMk α ⟨c, _⟩ + rw [← map_add] + apply congrArg (w.componentMk α) + rfl + +/-- Projection to a fixed component of `RV̂` preserves negation of representatives. -/ +theorem degreeLayerMk_neg (α : NatOrdinal) (b : Series K) + (hb : (b : K⟦ℝ⟧).degree ≤ (α : WithBot NatOrdinal)) : + degreeLayerMk α (-b) (by simpa using hb) = + -degreeLayerMk α b hb := by + let w := HahnSeries.Nonpositive.degreeValuation K + change w.componentMk α ⟨-b, _⟩ = -w.componentMk α ⟨b, _⟩ + rw [← map_neg] + apply congrArg (w.componentMk α) + rfl + +/-- Multiplication in the degree-graded ring `RV̂` is induced by multiplication of +representatives. -/ +theorem degreeLayerMk_mul {α β : NatOrdinal} (b c : Series K) + (hb : (b : K⟦ℝ⟧).degree ≤ (α : WithBot NatOrdinal)) + (hc : (c : K⟦ℝ⟧).degree ≤ (β : WithBot NatOrdinal)) : + (HahnSeries.Nonpositive.degreeValuation K).componentMul + (degreeLayerMk α b hb) + (degreeLayerMk β c hc) = + degreeLayerMk (α + β) (b * c) (by + rw [Subring.coe_mul] + exact (HahnSeries.degree_mul_le _ _).trans (add_le_add hb hc)) := by + let w := HahnSeries.Nonpositive.degreeValuation K + change w.componentMul (w.componentMk α ⟨b, _⟩) (w.componentMk β ⟨c, _⟩) = + w.componentMk (α + β) ⟨b * c, _⟩ + rw [w.componentMul_componentMk] + apply congrArg (w.componentMk (α + β)) + apply Subtype.ext + exact w.coe_mulFiltrationLE _ _ + +/-- A constant Hahn series lies in the degree-zero weak filtration. -/ +theorem degree_C_le_zero (k : K) : + (((HahnSeries.Nonpositive.C : K →+* Series K) k : Series K) : + K⟦ℝ⟧).degree ≤ (0 : WithBot NatOrdinal) := by + rw [HahnSeries.degree_le_zero_iff] + rw [HahnSeries.Nonpositive.coe_C, HahnSeries.C_apply] + exact Set.Finite.subset (Set.finite_singleton 0) + (HahnSeries.support_single_subset (a := 0) (r := k)) + +/-- A nonzero constant Hahn series has degree zero. -/ +theorem degree_C_eq_zero_of_ne {k : K} (hk : k ≠ 0) : + (((HahnSeries.Nonpositive.C : K →+* Series K) k : Series K) : + K⟦ℝ⟧).degree = (0 : WithBot NatOrdinal) := by + apply HahnSeries.degree_eq_zero.mpr + constructor + · simpa only [HahnSeries.Nonpositive.coe_C] using HahnSeries.C_ne_zero hk + · rw [HahnSeries.Nonpositive.coe_C, HahnSeries.C_apply] + exact Set.Finite.subset (Set.finite_singleton 0) + (HahnSeries.support_single_subset (a := 0) (r := k)) + +variable (K) in +private def constantToDegreeNonpositiveSubring : + K →+* (HahnSeries.Nonpositive.degreeValuation K).nonpositiveSubring := + let w := HahnSeries.Nonpositive.degreeValuation K + (HahnSeries.Nonpositive.C : K →+* Series K).codRestrict w.nonpositiveSubring fun k ↦ by + rw [w.mem_nonpositiveSubring_iff, + HahnSeries.Nonpositive.degreeValuation_apply] + exact degree_C_le_zero k + +variable (K) in +/-- The scalar map from coefficients to the grade-zero residue ring of Hahn-series degree. -/ +def degreeLayerScalarHom : + K →+* (HahnSeries.Nonpositive.degreeValuation K).ResidueRing := + let w := HahnSeries.Nonpositive.degreeValuation K + w.residueMap.comp (constantToDegreeNonpositiveSubring K) + +/-- The scalar map into the degree-zero component sends a coefficient to the class of the +corresponding +constant Hahn series. -/ +theorem degreeLayerScalarHom_apply (k : K) : + degreeLayerScalarHom K k = + degreeLayerMk 0 + ((HahnSeries.Nonpositive.C : K →+* Series K) k) + (degree_C_le_zero k) := by + let w := HahnSeries.Nonpositive.degreeValuation K + change w.residueMap _ = w.componentMk 0 _ + rw [w.residueMap_apply] + apply congrArg (w.componentMk 0) + apply Subtype.ext + rw [w.coe_nonpositiveEquivFiltrationLEZero] + rfl + +/-- Each component of `RV̂` is canonically a vector space over the coefficient field. -/ +noncomputable instance degreeLayerModule (α : NatOrdinal) : + Module K + ((HahnSeries.Nonpositive.degreeValuation K).Component α) := + Module.compHom _ (degreeLayerScalarHom K) + +/-- Coefficient scalar multiplication on a component of `RV̂` is the action of the +corresponding grade-zero residue class. -/ +theorem degreeLayer_smul_eq_residue_smul (alpha : NatOrdinal) (k : K) + (x : (HahnSeries.Nonpositive.degreeValuation K).Component alpha) : + k • x = degreeLayerScalarHom K k • x := + (rfl) + +/-- Scalar multiplication in a component of `RV̂` is multiplication of a representative by +the corresponding constant Hahn series. -/ +theorem smul_degreeLayerMk (α : NatOrdinal) (k : K) (b : Series K) + (hb : (b : K⟦ℝ⟧).degree ≤ (α : WithBot NatOrdinal)) : + k • degreeLayerMk α b hb = + degreeLayerMk α + ((HahnSeries.Nonpositive.C : K →+* Series K) k * b) + (by + rw [Subring.coe_mul] + exact (HahnSeries.degree_mul_le _ _).trans + ((add_le_add (degree_C_le_zero k) hb).trans_eq (zero_add _))) := by + let w := HahnSeries.Nonpositive.degreeValuation K + rw [show k • degreeLayerMk α b hb = + (degreeLayerScalarHom K k) • degreeLayerMk α b hb from rfl] + rw [degreeLayerScalarHom_apply] + apply DirectSum.of_injective (β := w.Component) α + rw [DirectSum.of_zero_smul, DirectSum.of_mul_of] + change DirectSum.of w.Component (0 + α) + (w.componentMul + (degreeLayerMk 0 + ((HahnSeries.Nonpositive.C : K →+* Series K) k) + (degree_C_le_zero k)) + (degreeLayerMk α b hb)) = _ + rw [degreeLayerMk_mul] + apply DirectSum.of_eq_of_gradedMonoid_eq + apply Sigma.ext (zero_add α) + exact w.componentMk_heq_of_grade_eq_of_coe_eq (zero_add α) _ _ rfl + +/-- The canonical map from the components of `RV̂` to the spaces `P_α` commutes with +homogeneous multiplication. -/ +theorem degreeLayerToPrincipalComponent_componentMul {α β : NatOrdinal} + (x : (HahnSeries.Nonpositive.degreeValuation K).Component α) + (y : (HahnSeries.Nonpositive.degreeValuation K).Component β) : + degreeLayerToPrincipalComponent K (α + β) + (MaxAddDegree.componentMul + (HahnSeries.Nonpositive.degreeValuation K) x y) = + principalComponentMul + (degreeLayerToPrincipalComponent K α x) + (degreeLayerToPrincipalComponent K β y) := by + rw [principalComponentMul_eq_componentMul] + exact MaxAddDegree.componentMap_componentMul _ _ _ _ x y + +/-- The canonical component map is compatible with the coefficient-field actions on the two +degree filtrations. -/ +theorem degreeLayerToPrincipalComponent_map_smul (α : NatOrdinal) (k : K) + (x : (HahnSeries.Nonpositive.degreeValuation K).Component α) : + degreeLayerToPrincipalComponent K α (k • x) = + k • degreeLayerToPrincipalComponent K α x := by + let w := HahnSeries.Nonpositive.degreeValuation K + induction x using QuotientAddGroup.induction_on with + | H x => + rw [w.coe_component_eq_componentMk] + let b : Series K := x + have hb : (b : K⟦ℝ⟧).degree ≤ (α : WithBot NatOrdinal) := by + have hbValue := (w.mem_filtrationLE_iff α b).mp x.2 + rw [HahnSeries.Nonpositive.degreeValuation_apply] at hbValue + exact hbValue + change degreeLayerToPrincipalComponent K α + (k • degreeLayerMk α b hb) = + k • degreeLayerToPrincipalComponent K α + (degreeLayerMk α b hb) + rw [smul_degreeLayerMk, degreeLayerToPrincipalComponent_mk, + degreeLayerToPrincipalComponent_mk, smul_principalComponentMk] + +variable (K) in +/-- The canonical component map, bundled as a `K`-linear map. -/ +def degreeLayerToPrincipalComponentLinear (α : NatOrdinal) : + (HahnSeries.Nonpositive.degreeValuation K).Component α →ₗ[K] + PrincipalComponent K α := + { degreeLayerToPrincipalComponent K α with + map_smul' := degreeLayerToPrincipalComponent_map_smul α } + +@[simp] +theorem degreeLayerToPrincipalComponentLinear_apply (α : NatOrdinal) + (x : (HahnSeries.Nonpositive.degreeValuation K).Component α) : + degreeLayerToPrincipalComponentLinear K α x = + degreeLayerToPrincipalComponent K α x := + (rfl) + +/-- For exact-degree principal representatives, equality in the degree component is exactly +congruence modulo `J_{ω^α}`. This is the equal-degree case of LM24, Lemma 7.2.3. -/ +theorem degreeLayerMk_eq_iff_ordinalValue_sub_lt (α : NatOrdinal) {b c : Series K} + (hb : HahnSeries.Nonpositive.IsPrincipal b) + (hc : HahnSeries.Nonpositive.IsPrincipal c) + (hbDegree : (b : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) + (hcDegree : (c : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) : + degreeLayerMk α b hbDegree.le = + degreeLayerMk α c hcDegree.le ↔ + ordinalValue (b - c) < ω^ α := by + let w := HahnSeries.Nonpositive.degreeValuation K + change w.componentMk α ⟨b, _⟩ = w.componentMk α ⟨c, _⟩ ↔ _ + rw [w.componentMk_eq_componentMk_iff, + HahnSeries.Nonpositive.degreeValuation_apply] + constructor + · intro hdegree + apply (ordinalValueDegree_lt_coe_iff (b - c) α).mp + exact (ordinalValueDegree_le_degree (b - c)).trans_lt hdegree + · intro hvalue + have hdegreeLE : ((b - c : Series K) : K⟦ℝ⟧).degree ≤ + (α : WithBot NatOrdinal) := by + change ((b : K⟦ℝ⟧) - (c : K⟦ℝ⟧)).degree ≤ + (α : WithBot NatOrdinal) + calc + ((b : K⟦ℝ⟧) - (c : K⟦ℝ⟧)).degree = + ((b : K⟦ℝ⟧) + -(c : K⟦ℝ⟧)).degree := by + rw [sub_eq_add_neg] + _ ≤ max (b : K⟦ℝ⟧).degree (-(c : K⟦ℝ⟧)).degree := + HahnSeries.degree_add_le _ _ + _ = (α : WithBot NatOrdinal) := by + rw [HahnSeries.degree_neg, hbDegree, hcDegree, max_self] + apply lt_of_le_of_ne hdegreeLE + intro hdegreeEq + have hdiffDegree : ((b - c : Series K) : K⟦ℝ⟧).degree = + (α : WithBot NatOrdinal) := hdegreeEq + have hnegDegree : ((-c : Series K) : K⟦ℝ⟧).degree = + (b : K⟦ℝ⟧).degree := by + simp only [Subring.coe_neg, HahnSeries.degree_neg, hbDegree, hcDegree] + have hsumDegree : + (((b + (-c) : Series K) : K⟦ℝ⟧)).degree = + (b : K⟦ℝ⟧).degree := by + simpa only [sub_eq_add_neg, hbDegree] using hdiffDegree + have hdiffPrincipal : HahnSeries.Nonpositive.IsPrincipal (b - c) := by + have hprincipal := hb.add_of_degree_eq hc.neg hnegDegree hsumDegree + simpa only [sub_eq_add_neg] using hprincipal + have hordinalValue := ordinalValue_eq_wpow_of_isPrincipal hdiffPrincipal hdiffDegree + rw [hordinalValue] at hvalue + exact lt_irrefl _ hvalue + +/-- A homogeneous class of `RV̂` is principal when it is zero or has a principal +representative of exactly that degree. This is the source predicate from LM24, Definition 5.2.1. -/ +def IsPrincipalDegreeClass (α : NatOrdinal) + (x : (HahnSeries.Nonpositive.degreeValuation K).Component α) : + Prop := + x = 0 ∨ + ∃ (p : Series K) (_hp : HahnSeries.Nonpositive.IsPrincipal p) + (hpDegree : (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)), + x = degreeLayerMk α p hpDegree.le + +/-- Characterization of a principal homogeneous class of `RV̂` by a representative. -/ +theorem isPrincipalDegreeClass_iff (α : NatOrdinal) + (x : (HahnSeries.Nonpositive.degreeValuation K).Component α) : + IsPrincipalDegreeClass α x ↔ + x = 0 ∨ + ∃ (p : Series K) (_hp : HahnSeries.Nonpositive.IsPrincipal p) + (hpDegree : (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)), + x = degreeLayerMk α p hpDegree.le := + (Iff.rfl) + +variable (K) in +/-- The principal classes of a fixed Hahn degree form the `K`-subspace `P_α` from LM24, +Proposition 5.2.4 and Corollary 5.2.5. -/ +def principalDegreeClasses (α : NatOrdinal) : + Submodule K + ((HahnSeries.Nonpositive.degreeValuation K).Component α) where + carrier := {x | IsPrincipalDegreeClass α x} + zero_mem' := Or.inl rfl + add_mem' := by + intro x y hx hy + change IsPrincipalDegreeClass α x at hx + change IsPrincipalDegreeClass α y at hy + change IsPrincipalDegreeClass α (x + y) + rw [isPrincipalDegreeClass_iff] at hx hy ⊢ + rcases hx with rfl | ⟨p, hp, hpDegree, rfl⟩ + · simpa using hy + rcases hy with rfl | ⟨q, hq, hqDegree, rfl⟩ + · exact Or.inr ⟨p, hp, hpDegree, by simp⟩ + have hsumLE : (((p + q : Series K) : K⟦ℝ⟧)).degree ≤ + (α : WithBot NatOrdinal) := + (HahnSeries.degree_add_le (p : K⟦ℝ⟧) (q : K⟦ℝ⟧)).trans + (max_le hpDegree.le hqDegree.le) + have hprojection : + degreeLayerMk α p hpDegree.le + + degreeLayerMk α q hqDegree.le = + degreeLayerMk α (p + q) hsumLE := + (degreeLayerMk_add α p q hpDegree.le hqDegree.le).symm + by_cases hzero : degreeLayerMk α (p + q) hsumLE = 0 + · exact Or.inl (hprojection.trans hzero) + · have hsumNotLt : ¬(((p + q : Series K) : K⟦ℝ⟧).degree < + (α : WithBot NatOrdinal)) := by + intro hlt + apply hzero + let w := HahnSeries.Nonpositive.degreeValuation K + change w.componentMk α ⟨p + q, _⟩ = 0 + rw [w.componentMk_eq_zero_iff, + HahnSeries.Nonpositive.degreeValuation_apply] + exact hlt + have hsumDegree : (((p + q : Series K) : K⟦ℝ⟧)).degree = + (α : WithBot NatOrdinal) := + le_antisymm hsumLE (le_of_not_gt hsumNotLt) + have hsumPrincipal : HahnSeries.Nonpositive.IsPrincipal (p + q) := + hp.add_of_degree_eq hq + (hqDegree.trans hpDegree.symm) + (hsumDegree.trans hpDegree.symm) + exact Or.inr ⟨p + q, hsumPrincipal, hsumDegree, hprojection⟩ + smul_mem' := by + intro k x hx + change IsPrincipalDegreeClass α x at hx + change IsPrincipalDegreeClass α (k • x) + rw [isPrincipalDegreeClass_iff] at hx ⊢ + rcases hx with rfl | ⟨p, hp, hpDegree, rfl⟩ + · exact Or.inl (smul_zero k) + · by_cases hk : k = 0 + · subst k + exact Or.inl + (zero_smul K (degreeLayerMk α p hpDegree.le)) + · have hkpDegree : + ((((HahnSeries.Nonpositive.C : K →+* Series K) k) * p : Series K) : + K⟦ℝ⟧).degree = (α : WithBot NatOrdinal) := by + rw [← ordinalValueDegree_eq_degree_of_isPrincipal (hp.const_mul hk), + ordinalValueDegree_C_mul hk, ordinalValueDegree_eq_degree_of_isPrincipal hp, hpDegree] + exact Or.inr + ⟨(HahnSeries.Nonpositive.C : K →+* Series K) k * p, + hp.const_mul hk, hkpDegree, + smul_degreeLayerMk α k p hpDegree.le⟩ + +/-- Membership in the source presentation `P_α` is exactly the principal-class predicate. -/ +theorem mem_principalDegreeClasses_iff (α : NatOrdinal) + (x : (HahnSeries.Nonpositive.degreeValuation K).Component α) : + x ∈ principalDegreeClasses K α ↔ + IsPrincipalDegreeClass α x := + (Iff.rfl) + +variable (K) in +/-- Restriction of the canonical component map to the source principal subspace. -/ +def principalDegreeClassesToPrincipalComponent (α : NatOrdinal) : + principalDegreeClasses K α →ₗ[K] PrincipalComponent K α := + (degreeLayerToPrincipalComponentLinear K α).comp + (principalDegreeClasses K α).subtype + +/-- The restricted map is the canonical map on the underlying homogeneous class. -/ +@[simp] +theorem principalDegreeClassesToPrincipalComponent_apply + (α : NatOrdinal) (x : principalDegreeClasses K α) : + principalDegreeClassesToPrincipalComponent K α x = + degreeLayerToPrincipalComponent K α x := + (rfl) + +/-- The restricted canonical map commutes with coefficient scalar multiplication. -/ +theorem principalDegreeClassesToPrincipalComponent_smul + (α : NatOrdinal) (k : K) (x : principalDegreeClasses K α) : + principalDegreeClassesToPrincipalComponent K α (k • x) = + k • principalDegreeClassesToPrincipalComponent K α x := + map_smul (principalDegreeClassesToPrincipalComponent K α) k x + +private theorem principalComponentMk_ne_zero_of_isPrincipal (α : NatOrdinal) + {p : Series K} (hp : HahnSeries.Nonpositive.IsPrincipal p) + (hpDegree : (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) + (hpBound : ordinalValue p < ω^ (α + 1)) : + principalComponentMk α p hpBound ≠ 0 := by + intro hzero + have hlt := (principalComponentMk_eq_zero_iff α p hpBound).mp hzero + rw [ordinalValue_eq_wpow_of_isPrincipal hp hpDegree] at hlt + exact lt_irrefl (ω^ α) hlt + +variable (K) in +private theorem principalDegreeClassesToPrincipalComponent_injective (α : NatOrdinal) : + Function.Injective (principalDegreeClassesToPrincipalComponent K α) := by + intro x y hxy + apply Subtype.ext + change degreeLayerToPrincipalComponent K α x = + degreeLayerToPrincipalComponent K α y at hxy + have hx := (mem_principalDegreeClasses_iff α _).mp x.2 + have hy := (mem_principalDegreeClasses_iff α _).mp y.2 + rw [isPrincipalDegreeClass_iff] at hx hy + rcases hx with hx0 | ⟨p, hp, hpDegree, hxp⟩ + · rcases hy with hy0 | ⟨q, hq, hqDegree, hyq⟩ + · exact hx0.trans hy0.symm + · rw [hx0, hyq, map_zero, degreeLayerToPrincipalComponent_mk] at hxy + exact (principalComponentMk_ne_zero_of_isPrincipal α hq hqDegree _ + hxy.symm).elim + · rcases hy with hy0 | ⟨q, hq, hqDegree, hyq⟩ + · rw [hxp, hy0, degreeLayerToPrincipalComponent_mk, map_zero] at hxy + exact (principalComponentMk_ne_zero_of_isPrincipal α hp hpDegree _ hxy).elim + · rw [hxp, hyq, degreeLayerToPrincipalComponent_mk, + degreeLayerToPrincipalComponent_mk] at hxy + have hpBound : ordinalValue p < ω^ (α + 1) := + (ordinalValueDegree_le_coe_iff p α).mp + ((ordinalValueDegree_le_degree p).trans hpDegree.le) + have hqBound : ordinalValue q < ω^ (α + 1) := + (ordinalValueDegree_le_coe_iff q α).mp + ((ordinalValueDegree_le_degree q).trans hqDegree.le) + have hcongr : ordinalValue (p - q) < ω^ α := + (principalComponentMk_eq_iff α p q hpBound hqBound).mp hxy + exact hxp.trans + (((degreeLayerMk_eq_iff_ordinalValue_sub_lt α hp hq + hpDegree hqDegree).mpr hcongr).trans hyq.symm) + +variable (K) in +private theorem principalDegreeClassesToPrincipalComponent_surjective (α : NatOrdinal) : + Function.Surjective (principalDegreeClassesToPrincipalComponent K α) := by + intro x + by_cases hx : x = 0 + · refine ⟨0, ?_⟩ + subst x + exact map_zero _ + · obtain ⟨p, hpBound, hp, hpDegree, hpx⟩ := + exists_principal_representative_of_ne_zero α x hx + let pClass := degreeLayerMk α p hpDegree.le + have hpClass : pClass ∈ principalDegreeClasses K α := by + rw [mem_principalDegreeClasses_iff, isPrincipalDegreeClass_iff] + exact Or.inr ⟨p, hp, hpDegree, rfl⟩ + refine ⟨⟨pClass, hpClass⟩, ?_⟩ + change degreeLayerToPrincipalComponent K α pClass = x + rw [show pClass = degreeLayerMk α p hpDegree.le from rfl, + degreeLayerToPrincipalComponent_mk] + exact hpx + +variable (K) in +/-- The source homogeneous principal classes are canonically linearly equivalent to the intrinsic +quotient `J_{ω^(α+1)} / J_{ω^α}`. This formalizes LM24, Remark 7.2.4. -/ +def principalDegreeClassesEquivPrincipalComponent (α : NatOrdinal) : + principalDegreeClasses K α ≃ₗ[K] PrincipalComponent K α := + LinearEquiv.ofBijective + (principalDegreeClassesToPrincipalComponent K α) + ⟨principalDegreeClassesToPrincipalComponent_injective K α, + principalDegreeClassesToPrincipalComponent_surjective K α⟩ + +/-- The canonical equivalence is the canonical component map on underlying classes. -/ +@[simp] +theorem principalDegreeClassesEquivPrincipalComponent_apply + (α : NatOrdinal) (x : principalDegreeClasses K α) : + principalDegreeClassesEquivPrincipalComponent K α x = + degreeLayerToPrincipalComponent K α x := + (rfl) + +section Multiplication + +variable [CharZero K] + +/-- Multiplication of principal classes, inherited from the degree-graded ring +ring: the product of two principal series of degrees `α` and `β` is principal of degree `α + β` +(LM24, Proposition 3.6.1 and Theorem D). -/ +def principalDegreeClassesMul {α β : NatOrdinal} + (x : principalDegreeClasses K α) + (y : principalDegreeClasses K β) : + principalDegreeClasses K (α + β) := by + let w := HahnSeries.Nonpositive.degreeValuation K + refine ⟨w.componentMul x y, ?_⟩ + rw [mem_principalDegreeClasses_iff, isPrincipalDegreeClass_iff] + have hx := (mem_principalDegreeClasses_iff α _).mp x.2 + have hy := (mem_principalDegreeClasses_iff β _).mp y.2 + rw [isPrincipalDegreeClass_iff] at hx hy + rcases hx with hx0 | ⟨p, hp, hpDegree, hxp⟩ + · exact Or.inl (by rw [hx0]; simp) + rcases hy with hy0 | ⟨q, hq, hqDegree, hyq⟩ + · exact Or.inl (by rw [hy0]; simp) + have hpqDegree : ((p * q : Series K) : K⟦ℝ⟧).degree = + ((α + β : NatOrdinal) : WithBot NatOrdinal) := by + rw [HahnSeries.Nonpositive.degree_mul, hpDegree, hqDegree, WithBot.coe_add] + apply Or.inr + refine ⟨p * q, OrdinalValueMultiplicative.isPrincipal_mul ordinalValueMultiplicative hp hq, + hpqDegree, ?_⟩ + calc + w.componentMul x y = w.componentMul + (degreeLayerMk α p hpDegree.le) + (degreeLayerMk β q hqDegree.le) := by rw [hxp, hyq] + _ = degreeLayerMk (α + β) (p * q) hpqDegree.le := + degreeLayerMk_mul p q hpDegree.le hqDegree.le + +/-- Multiplication of the source classes is multiplication in the degree-graded ring +ring on underlying classes. -/ +theorem coe_principalDegreeClassesMul {α β : NatOrdinal} + (x : principalDegreeClasses K α) + (y : principalDegreeClasses K β) : + (principalDegreeClassesMul x y : + (HahnSeries.Nonpositive.degreeValuation K).Component + (α + β)) = + (HahnSeries.Nonpositive.degreeValuation K).componentMul x y := + (rfl) + +/-- The canonical equivalence from source principal classes to the spaces `P_α` commutes with +homogeneous multiplication. -/ +theorem principalDegreeClassesEquivPrincipalComponent_mul {α β : NatOrdinal} + (x : principalDegreeClasses K α) + (y : principalDegreeClasses K β) : + principalDegreeClassesEquivPrincipalComponent K (α + β) + (principalDegreeClassesMul x y) = + principalComponentMul + (principalDegreeClassesEquivPrincipalComponent K α x) + (principalDegreeClassesEquivPrincipalComponent K β y) := by + rw [principalDegreeClassesEquivPrincipalComponent_apply, + principalDegreeClassesEquivPrincipalComponent_apply, + principalDegreeClassesEquivPrincipalComponent_apply, + coe_principalDegreeClassesMul] + exact degreeLayerToPrincipalComponent_componentMul + (x : (HahnSeries.Nonpositive.degreeValuation K).Component α) + (y : (HahnSeries.Nonpositive.degreeValuation K).Component β) + +end Multiplication + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentTensor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentTensor.lean new file mode 100644 index 0000000000..2102bdca2a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentTensor.lean @@ -0,0 +1,779 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubring +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportResidue +public import Mathlib.LinearAlgebra.TensorProduct.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition +import Mathlib.LinearAlgebra.TensorProduct.Basis + +/-! +# Extension of scalars for `P_α` + +This module proves LM24, Proposition 5.3.1. For each Hahn-series degree `α`, multiplication +induces the canonical linear equivalence + +`P_α ⊗[K] K(ℝ^{≤ 0}) ≃ RV_α`. + +Here `P_α` is the intrinsic quotient `J_(ω^(α+1)) / J_(ω^α)`, the finite-support +factor has its canonical monomial basis, and `RV_α` is the degree-`α` component of `RV̂`. +No basis or complement is chosen in `P_α`. + +Surjectivity follows by sending each term of the unique LM24 normal form to its principal +coefficient tensored with the corresponding monomial; lower-degree terms vanish in `RV_α`. +For injectivity, translated closed truncation at an exponent extracts the coefficient at that +monomial in `P_α`. This proves linear independence without choosing representatives coherently. +-/ + +open scoped DirectSum HahnSeries NatOrdinal TensorProduct + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [CharZero K] + +abbrev FiniteSupportRing := + HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K) + +omit [CharZero K] in +private theorem coe_translatedTruncation_translate (p : Series K) (h g : ℝ) : + ((translatedTruncation (HahnSeries.translate h (p : K⟦ℝ⟧)) g : Series K) : + K⟦ℝ⟧) = + HahnSeries.translate (h - g) + (HahnSeries.truncLE (g - h) (p : K⟦ℝ⟧)) := by + rw [coe_translatedTruncation, HahnSeries.truncLE_translate, + HahnSeries.translate_add_apply] + congr 2 + · ring + +variable (K) in +/-- On a series `b` of degree `≤ α`, the class of the translated truncation `b^{|γ}` in `P_α`, +additive in `b`. -/ +private def degreeLayerTruncationAtRepresentative (alpha : NatOrdinal) (g : ℝ) : + (HahnSeries.Nonpositive.degreeValuation K).filtrationLE alpha →+ + PrincipalComponent K alpha := by + let wDegree := HahnSeries.Nonpositive.degreeValuation K + let wOrder := ordinalValueDegreeValuation K + refine + { toFun := fun b ↦ wOrder.componentMk alpha ⟨translatedTruncation (b : Series K) g, ?_⟩ + map_zero' := ?_ + map_add' := ?_ } + · rw [wOrder.mem_filtrationLE_iff, + ordinalValueDegreeValuation_apply] + have hbDegree := (wDegree.mem_filtrationLE_iff alpha (b : Series K)).mp b.2 + rw [HahnSeries.Nonpositive.degreeValuation_apply] at hbDegree + exact (ordinalValueDegree_translatedTruncation_le_degree + ((b : Series K) : K⟦ℝ⟧) g).trans hbDegree + · change wOrder.componentMk alpha ⟨translatedTruncation 0 g, _⟩ = 0 + rw [← map_zero (wOrder.componentMk alpha)] + apply congrArg (wOrder.componentMk alpha) + apply Subtype.ext + exact translatedTruncation_zero_input (K := K) g + · intro b c + change wOrder.componentMk alpha + ⟨translatedTruncation ((b : Series K) + (c : Series K)) g, _⟩ = + wOrder.componentMk alpha ⟨translatedTruncation (b : Series K) g, _⟩ + + wOrder.componentMk alpha ⟨translatedTruncation (c : Series K) g, _⟩ + rw [← map_add] + apply congrArg (wOrder.componentMk alpha) + apply Subtype.ext + exact translatedTruncation_add + ((b : Series K) : K⟦ℝ⟧) ((c : Series K) : K⟦ℝ⟧) g + +omit [CharZero K] in +variable (K) in +private theorem degreeLayerTruncationAt_lower_le_ker (alpha : NatOrdinal) (g : ℝ) : + (HahnSeries.Nonpositive.degreeValuation K).lowerFiltration alpha ≤ + (degreeLayerTruncationAtRepresentative K alpha g).ker := by + let wDegree := HahnSeries.Nonpositive.degreeValuation K + let wOrder := ordinalValueDegreeValuation K + intro b hb + rw [AddMonoidHom.mem_ker] + change wOrder.componentMk alpha ⟨translatedTruncation (b : Series K) g, _⟩ = 0 + rw [wOrder.componentMk_eq_zero_iff, + ordinalValueDegreeValuation_apply] + have hbDegree := (wDegree.mem_lowerFiltration_iff alpha b).mp hb + rw [HahnSeries.Nonpositive.degreeValuation_apply] at hbDegree + exact (ordinalValueDegree_translatedTruncation_le_degree + ((b : Series K) : K⟦ℝ⟧) g).trans_lt hbDegree + +variable (K) in +/-- The class of the translated truncation `b^{|γ}` in `P_α`, as an additive map on the degree +component `{deg ≤ α}/{deg < α}`: series of degree `< α` have `b^{|γ} ∈ J_{ω^α}`. -/ +private def degreeLayerTruncationAt (alpha : NatOrdinal) (g : ℝ) : + (HahnSeries.Nonpositive.degreeValuation K).Component alpha →+ + PrincipalComponent K alpha := + QuotientAddGroup.lift + ((HahnSeries.Nonpositive.degreeValuation K).lowerFiltration alpha) + (degreeLayerTruncationAtRepresentative K alpha g) + (degreeLayerTruncationAt_lower_le_ker K alpha g) + +omit [CharZero K] in +/-- On the degree-`α` homogeneous class of `b`, the map is the class of `b^{|γ}` in `P_α`. -/ +private theorem degreeLayerTruncationAt_mk (alpha : NatOrdinal) (g : ℝ) + (b : Series K) (hb : (b : K⟦ℝ⟧).degree ≤ + (alpha : WithBot NatOrdinal)) : + degreeLayerTruncationAt K alpha g (degreeLayerMk alpha b hb) = + principalComponentMk alpha (translatedTruncation (b : K⟦ℝ⟧) g) + ((ordinalValueDegree_le_coe_iff (translatedTruncation (b : K⟦ℝ⟧) g) alpha).mp + ((ordinalValueDegree_translatedTruncation_le_degree (b : K⟦ℝ⟧) g).trans hb)) := by + let wDegree := HahnSeries.Nonpositive.degreeValuation K + rw [degreeLayerMk_eq_componentMk] + change degreeLayerTruncationAt K alpha g + (wDegree.componentMk alpha ⟨b, _⟩) = _ + rw [← wDegree.coe_component_eq_componentMk] + rw [principalComponentMk_eq_componentMk] + rfl + +omit [CharZero K] in +/-- The finite-support residue equivalence sends a constant series to its canonical +degree-zero homogeneous class. -/ +theorem degreeFiniteSupportResidueEquiv_scalar (k : K) : + HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K + (HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k) = + degreeLayerScalarHom K k := by + let w := HahnSeries.Nonpositive.degreeValuation K + rw [HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv_apply, + degreeLayerScalarHom_apply] + rw [w.residueMap_apply, degreeLayerMk_eq_componentMk] + apply congrArg (w.componentMk 0) + apply Subtype.ext + rw [w.coe_nonpositiveEquivFiltrationLEZero] + rw [RingEquiv.coe_subringCongr_apply] + apply Subtype.ext + exact (HahnSeries.Nonpositive.coe_finiteSupportScalarHom + (G := ℝ) (K := K) k).trans (HahnSeries.Nonpositive.coe_C k).symm + +omit [CharZero K] in +/-- Successive scalar actions by degree-zero residue classes agree with multiplication in the +residue ring. -/ +theorem degreeResidue_smul_smul (alpha : NatOrdinal) + (a b : (HahnSeries.Nonpositive.degreeValuation K).ResidueRing) + (x : (HahnSeries.Nonpositive.degreeValuation K).Component alpha) : + (a * b) • x = a • (b • x) := by + let w := HahnSeries.Nonpositive.degreeValuation K + apply DirectSum.of_injective (β := w.Component) alpha + rw [DirectSum.of_zero_smul, DirectSum.of_zero_smul, + DirectSum.of_zero_smul, DirectSum.of_zero_mul] + rw [mul_assoc] + +omit [CharZero K] in +/-- The unit residue class acts identically on every degree component. -/ +theorem degreeResidue_one_smul (alpha : NatOrdinal) + (x : (HahnSeries.Nonpositive.degreeValuation K).Component alpha) : + (1 : (HahnSeries.Nonpositive.degreeValuation K).ResidueRing) • x = + x := by + let w := HahnSeries.Nonpositive.degreeValuation K + apply DirectSum.of_injective (β := w.Component) alpha + rw [DirectSum.of_zero_smul, DirectSum.of_zero_one, one_mul] + +omit [CharZero K] in +private theorem residue_smul_comm (alpha : NatOrdinal) + (a b : (HahnSeries.Nonpositive.degreeValuation K).ResidueRing) + (x : (HahnSeries.Nonpositive.degreeValuation K).Component alpha) : + a • (b • x) = b • (a • x) := by + rw [← degreeResidue_smul_smul alpha, + ← degreeResidue_smul_smul alpha, mul_comm] + +omit [CharZero K] in +private theorem residueEquiv_eq_degreeLayerMk (p : FiniteSupportRing (K := K)) : + HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K p = + degreeLayerMk 0 (p : Series K) (by + simpa using (HahnSeries.degree_le_zero_iff.mpr + ((HahnSeries.Nonpositive.mem_finiteSupportSubring_iff + (p : Series K)).mp p.2))) := by + let w := HahnSeries.Nonpositive.degreeValuation K + rw [HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv_apply, + w.residueMap_apply, degreeLayerMk_eq_componentMk] + apply congrArg (w.componentMk 0) + apply Subtype.ext + rw [w.coe_nonpositiveEquivFiltrationLEZero, + RingEquiv.coe_subringCongr_apply] + +/-- The degree-zero residue action of a finite-support series on a fixed component is +multiplication of representatives. -/ +theorem degreeFiniteSupportResidueEquiv_smul_degreeLayerMk (alpha : NatOrdinal) + (p : FiniteSupportRing (K := K)) (b : Series K) + (hb : (b : K⟦ℝ⟧).degree ≤ (alpha : WithBot NatOrdinal)) : + HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K p • + degreeLayerMk alpha b hb = + degreeLayerMk alpha ((p : Series K) * b) (by + rw [HahnSeries.Nonpositive.degree_mul] + exact (add_le_add (by + simpa using (HahnSeries.degree_le_zero_iff.mpr + ((HahnSeries.Nonpositive.mem_finiteSupportSubring_iff + (p : Series K)).mp p.2))) hb).trans_eq (zero_add _)) := by + let w := HahnSeries.Nonpositive.degreeValuation K + apply DirectSum.of_injective (β := w.Component) alpha + rw [DirectSum.of_zero_smul, DirectSum.of_mul_of] + change DirectSum.of w.Component (0 + alpha) + (w.componentMul + (HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K p) + (degreeLayerMk alpha b hb)) = _ + rw [residueEquiv_eq_degreeLayerMk, degreeLayerMk_mul] + apply DirectSum.of_eq_of_gradedMonoid_eq + apply Sigma.ext (zero_add alpha) + rw [degreeLayerMk_eq_componentMk, degreeLayerMk_eq_componentMk] + exact w.componentMk_heq_of_grade_eq_of_coe_eq (zero_add alpha) _ _ rfl + +omit [CharZero K] in +theorem principalComponentToHahnDegreeLayer_mk (alpha : NatOrdinal) + (p : Series K) (hp : HahnSeries.Nonpositive.IsPrincipal p) + (hpDegree : (p : K⟦ℝ⟧).degree = (alpha : WithBot NatOrdinal)) + (hpBound : ordinalValue p < ω^ (alpha + 1)) : + principalComponentToHahnDegreeLayer K alpha + (principalComponentMk alpha p hpBound) = + degreeLayerMk alpha p hpDegree.le := by + rw [← degreeLayerToPrincipalComponent_mk alpha p hpDegree.le] + apply principalComponentToHahnDegreeLayer_degreeLayerToPrincipalComponent_of_isPrincipal + rw [isPrincipalDegreeClass_iff] + exact Or.inr ⟨p, hp, hpDegree, rfl⟩ + +variable (K) in +def principalComponentFiniteSupportMul (alpha : NatOrdinal) : + PrincipalComponent K alpha →ₗ[K] + FiniteSupportRing (K := K) →ₗ[K] + (HahnSeries.Nonpositive.degreeValuation K).Component alpha := + LinearMap.mk₂ K + (fun x p ↦ + HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K p • + principalComponentToHahnDegreeLayer K alpha x) + (by + intro x y p + simpa only [map_add] using + (smul_add + (HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K p) + (principalComponentToHahnDegreeLayer K alpha x) + (principalComponentToHahnDegreeLayer K alpha y))) + (by + intro k x p + rw [map_smul] + rw [degreeLayer_smul_eq_residue_smul, + degreeLayer_smul_eq_residue_smul] + exact residue_smul_comm alpha _ _ _) + (by + intro x p q + simpa only [map_add] using + (add_smul + (HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K p) + (HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K q) + (principalComponentToHahnDegreeLayer K alpha x))) + (by + intro k x p + rw [HahnSeries.Nonpositive.smul_finiteSupport_eq_scalar_mul] + rw [map_mul, degreeFiniteSupportResidueEquiv_scalar] + rw [degreeLayer_smul_eq_residue_smul] + exact degreeResidue_smul_smul alpha _ _ _) + +omit [CharZero K] in +@[simp] +theorem principalComponentFiniteSupportMul_apply (alpha : NatOrdinal) + (x : PrincipalComponent K alpha) (p : FiniteSupportRing (K := K)) : + principalComponentFiniteSupportMul K alpha x p = + HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K p • + principalComponentToHahnDegreeLayer K alpha x := + (rfl) + +variable (K) in +def principalComponentTensorMap (alpha : NatOrdinal) : + PrincipalComponent K alpha ⊗[K] FiniteSupportRing (K := K) →ₗ[K] + (HahnSeries.Nonpositive.degreeValuation K).Component alpha := + TensorProduct.lift (principalComponentFiniteSupportMul K alpha) + +omit [CharZero K] in +@[simp] +theorem principalComponentTensorMap_tmul (alpha : NatOrdinal) + (x : PrincipalComponent K alpha) (p : FiniteSupportRing (K := K)) : + principalComponentTensorMap K alpha (x ⊗ₜ p) = + HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K p • + principalComponentToHahnDegreeLayer K alpha x := by + rw [principalComponentTensorMap, TensorProduct.lift.tmul] + rfl + +theorem principalComponentTensorMap_principal_monomial (alpha : NatOrdinal) + (p : Series K) (hp : HahnSeries.Nonpositive.IsPrincipal p) + (hpDegree : (p : K⟦ℝ⟧).degree = (alpha : WithBot NatOrdinal)) + (hpBound : ordinalValue p < ω^ (alpha + 1)) + (g : {g : ℝ // g ≤ 0}) : + principalComponentTensorMap K alpha + (principalComponentMk alpha p hpBound ⊗ₜ + HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g) = + degreeLayerMk alpha + (((HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g : + FiniteSupportRing (K := K)) : Series K) * p) (by + rw [HahnSeries.Nonpositive.degree_mul] + exact (add_le_add (by + exact HahnSeries.degree_le_zero_iff.mpr + ((HahnSeries.Nonpositive.mem_finiteSupportSubring_iff + ((HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g : + FiniteSupportRing (K := K)) : Series K)).mp + (HahnSeries.Nonpositive.finiteSupportMonomial + (K := K) g).2)) hpDegree.le).trans_eq (zero_add _)) := by + rw [principalComponentTensorMap_tmul, + principalComponentToHahnDegreeLayer_mk alpha p hp hpDegree hpBound] + rw [degreeFiniteSupportResidueEquiv_smul_degreeLayerMk] + +omit [CharZero K] in +private theorem finiteSupportMonomial_degree (g : {g : ℝ // g ≤ 0}) : + ((((HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g : + FiniteSupportRing (K := K)) : Series K) : K⟦ℝ⟧).degree) = 0 := by + apply HahnSeries.degree_eq_zero.mpr + constructor + · rw [HahnSeries.Nonpositive.coe_finiteSupportMonomial] + exact HahnSeries.single_ne_zero one_ne_zero + · exact (HahnSeries.Nonpositive.mem_finiteSupportSubring_iff + ((HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g : + FiniteSupportRing (K := K)) : Series K)).mp + (HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g).2 + +omit [CharZero K] in +private theorem coe_finiteSupportMonomial_mul (g : {g : ℝ // g ≤ 0}) (p : Series K) : + ((((HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g : + FiniteSupportRing (K := K)) : Series K) * p : Series K) : K⟦ℝ⟧) = + HahnSeries.translate (g : ℝ) (p : K⟦ℝ⟧) := by + change + (((HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g : + FiniteSupportRing (K := K)) : Series K) : K⟦ℝ⟧) * (p : K⟦ℝ⟧) = _ + rw [HahnSeries.Nonpositive.coe_finiteSupportMonomial, + HahnSeries.single_one_mul_eq_translate] + +private def shiftedSeries (g : {g : ℝ // g ≤ 0}) (p : Series K) : Series K := + ⟨HahnSeries.translate (g : ℝ) (p : K⟦ℝ⟧), by + rw [HahnSeries.mem_nonpositiveSubring, HahnSeries.support_translate] + rintro _ ⟨x, hx, rfl⟩ + exact add_nonpos g.2 (HahnSeries.Nonpositive.support_subset p hx)⟩ + +omit [CharZero K] in +@[simp] +private theorem coe_shiftedSeries (g : {g : ℝ // g ≤ 0}) (p : Series K) : + ((shiftedSeries g p : Series K) : K⟦ℝ⟧) = + HahnSeries.translate (g : ℝ) (p : K⟦ℝ⟧) := + (rfl) + +omit [CharZero K] in +private theorem finiteSupportMonomial_mul_eq_shiftedSeries (g : {g : ℝ // g ≤ 0}) (p : Series K) : + ((HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g : + FiniteSupportRing (K := K)) : Series K) * p = shiftedSeries g p := by + apply Subtype.ext + exact coe_finiteSupportMonomial_mul g p + +private abbrev PrincipalMonomialTerm (K : Type v) [Field K] := + Series K × {g : ℝ // g ≤ 0} + +private def principalMonomialTermSeries (t : PrincipalMonomialTerm K) : Series K := + (HahnSeries.Nonpositive.finiteSupportMonomial (K := K) t.2 : + FiniteSupportRing (K := K)) * t.1 + +private theorem principalMonomialTermSeries_degree (t : PrincipalMonomialTerm K) : + ((principalMonomialTermSeries t : Series K) : K⟦ℝ⟧).degree = + (t.1 : K⟦ℝ⟧).degree := by + rw [principalMonomialTermSeries, HahnSeries.Nonpositive.degree_mul, + finiteSupportMonomial_degree, zero_add] + +private def normalTermSeries (t : HahnSeries.NormalForm.Term K) + (ht : t.exponent ≤ 0) : Series K := + ⟨t.series, (HahnSeries.mem_nonpositiveSubring (x := t.series)).mpr (by + rw [HahnSeries.NormalForm.Term.series_eq_translate, + HahnSeries.support_translate] + rintro _ ⟨g, hg, rfl⟩ + exact add_nonpos ht (HahnSeries.Nonpositive.support_subset t.coefficient hg))⟩ + +omit [CharZero K] in +private theorem principalMonomialTerm_series_eq_normalTermSeries + (t : HahnSeries.NormalForm.Term K) (ht : t.exponent ≤ 0) : + principalMonomialTermSeries + (⟨t.coefficient, ⟨t.exponent, ht⟩⟩ : PrincipalMonomialTerm K) = + normalTermSeries t ht := by + apply Subtype.ext + change + (((HahnSeries.Nonpositive.finiteSupportMonomial (K := K) + ⟨t.exponent, ht⟩ : FiniteSupportRing (K := K)) : Series K) : K⟦ℝ⟧) * + (t.coefficient : K⟦ℝ⟧) = t.series + rw [HahnSeries.Nonpositive.coe_finiteSupportMonomial, + HahnSeries.single_one_mul_eq_translate, + HahnSeries.NormalForm.Term.series_eq_translate] + +private theorem principalMonomialTerms_sum_degree_le (alpha : NatOrdinal) + (terms : List (PrincipalMonomialTerm K)) + (hdegree : ∀ t ∈ terms, + (t.1 : K⟦ℝ⟧).degree ≤ (alpha : WithBot NatOrdinal)) : + (((terms.map principalMonomialTermSeries).sum : Series K) : K⟦ℝ⟧).degree ≤ + (alpha : WithBot NatOrdinal) := by + induction terms with + | nil => simp + | cons t terms ih => + rw [List.map_cons, List.sum_cons] + exact (HahnSeries.degree_add_le _ _).trans (max_le + (by rw [principalMonomialTermSeries_degree] + exact hdegree t (by simp)) + (ih fun s hs ↦ hdegree s (by simp [hs]))) + +private theorem exists_tensor_eq_degreeLayerMk_terms (alpha : NatOrdinal) + (terms : List (PrincipalMonomialTerm K)) + (hprincipal : ∀ t ∈ terms, + HahnSeries.Nonpositive.IsPrincipal t.1) + (hdegree : ∀ t ∈ terms, + (t.1 : K⟦ℝ⟧).degree ≤ (alpha : WithBot NatOrdinal)) : + ∃ z : PrincipalComponent K alpha ⊗[K] FiniteSupportRing (K := K), + principalComponentTensorMap K alpha z = + degreeLayerMk alpha + (terms.map principalMonomialTermSeries).sum + (principalMonomialTerms_sum_degree_le alpha terms hdegree) := by + induction terms with + | nil => + refine ⟨0, ?_⟩ + rw [map_zero] + symm + rw [degreeLayerMk_eq_zero_iff] + simp + | cons t terms ih => + have htPrincipal := hprincipal t (by simp) + have htDegreeLE := hdegree t (by simp) + have htSeriesLE : ((principalMonomialTermSeries t : Series K) : K⟦ℝ⟧).degree ≤ + (alpha : WithBot NatOrdinal) := by + rw [principalMonomialTermSeries_degree] + exact htDegreeLE + have htailPrincipal : ∀ s ∈ terms, + HahnSeries.Nonpositive.IsPrincipal s.1 := + fun s hs ↦ hprincipal s (by simp [hs]) + have htailDegree : ∀ s ∈ terms, + (s.1 : K⟦ℝ⟧).degree ≤ (alpha : WithBot NatOrdinal) := + fun s hs ↦ hdegree s (by simp [hs]) + obtain ⟨z, hz⟩ := ih htailPrincipal htailDegree + by_cases htDegree : (t.1 : K⟦ℝ⟧).degree = + (alpha : WithBot NatOrdinal) + · have htBound : ordinalValue t.1 < ω^ (alpha + 1) := + (ordinalValueDegree_le_coe_iff t.1 alpha).mp + ((ordinalValueDegree_le_degree t.1).trans htDegreeLE) + let zt : PrincipalComponent K alpha ⊗[K] FiniteSupportRing (K := K) := + principalComponentMk alpha t.1 htBound ⊗ₜ + HahnSeries.Nonpositive.finiteSupportMonomial (K := K) t.2 + refine ⟨zt + z, ?_⟩ + rw [map_add, hz] + rw [show principalComponentTensorMap K alpha zt = + degreeLayerMk alpha (principalMonomialTermSeries t) htSeriesLE by + exact principalComponentTensorMap_principal_monomial alpha + t.1 htPrincipal htDegree htBound t.2] + simpa only [List.map_cons, List.sum_cons] using + (degreeLayerMk_add alpha (principalMonomialTermSeries t) + (terms.map principalMonomialTermSeries).sum + htSeriesLE + (principalMonomialTerms_sum_degree_le alpha terms htailDegree)).symm + · have htDegreeLT : (t.1 : K⟦ℝ⟧).degree < + (alpha : WithBot NatOrdinal) := lt_of_le_of_ne htDegreeLE htDegree + refine ⟨z, ?_⟩ + rw [hz] + have htSeriesLT : ((principalMonomialTermSeries t : Series K) : K⟦ℝ⟧).degree < + (alpha : WithBot NatOrdinal) := by + rw [principalMonomialTermSeries_degree] + exact htDegreeLT + have htZero : degreeLayerMk alpha + (principalMonomialTermSeries t) htSeriesLE = 0 := + (degreeLayerMk_eq_zero_iff alpha + (principalMonomialTermSeries t) htSeriesLE).mpr + htSeriesLT + have hadd := degreeLayerMk_add alpha (principalMonomialTermSeries t) + (terms.map principalMonomialTermSeries).sum + htSeriesLE + (principalMonomialTerms_sum_degree_le alpha terms htailDegree) + rw [htZero, zero_add] at hadd + simpa only [List.map_cons, List.sum_cons] using hadd.symm + +variable (K) in +private theorem principalComponentTensorMap_surjective (alpha : NatOrdinal) : + Function.Surjective (principalComponentTensorMap K alpha) := by + let w := HahnSeries.Nonpositive.degreeValuation K + intro y + induction y using QuotientAddGroup.induction_on with + | H b => + have hbDegree : ((b : Series K) : K⟦ℝ⟧).degree ≤ + (alpha : WithBot NatOrdinal) := by + have hbValue := (w.mem_filtrationLE_iff alpha (b : Series K)).mp b.2 + rw [HahnSeries.Nonpositive.degreeValuation_apply] at hbValue + exact hbValue + obtain ⟨terms, hterms⟩ := HahnSeries.exists_isNormalForm (b : Series K) + obtain ⟨hsum, _, hprincipal, _, hpair⟩ := + HahnSeries.isNormalForm_iff.mp hterms + have htermSupport (t : HahnSeries.NormalForm.Term K) (ht : t ∈ terms) : + t.series.support ⊆ ((b : Series K) : K⟦ℝ⟧).support := by + have htMem : t.series ∈ terms.map HahnSeries.NormalForm.Term.series := + List.mem_map.mpr ⟨t, ht, rfl⟩ + have hsubset := HahnSeries.support_subset_list_sum_of_mem hpair htMem + rwa [hsum] at hsubset + have htermExponent (t : HahnSeries.NormalForm.Term K) (ht : t ∈ terms) : + t.exponent ≤ 0 := by + rw [← HahnSeries.NormalForm.Term.csSup_support_series t + (hprincipal t ht)] + apply csSup_le + (HahnSeries.support_nonempty_iff.mpr + (HahnSeries.NormalForm.Term.series_ne_zero (hprincipal t ht))) + intro g hg + exact HahnSeries.Nonpositive.support_subset (b : Series K) + (htermSupport t ht hg) + have htermDegree (t : HahnSeries.NormalForm.Term K) (ht : t ∈ terms) : + (t.coefficient : K⟦ℝ⟧).degree ≤ + (alpha : WithBot NatOrdinal) := by + calc + (t.coefficient : K⟦ℝ⟧).degree = t.series.degree := by + rw [HahnSeries.NormalForm.Term.series_eq_translate, + HahnSeries.degree_translate] + _ ≤ ((b : Series K) : K⟦ℝ⟧).degree := + HahnSeries.degree_mono_support (htermSupport t ht) + _ ≤ (alpha : WithBot NatOrdinal) := hbDegree + let principalTerms : List (PrincipalMonomialTerm K) := terms.pmap + (fun t ht ↦ ⟨t.coefficient, ⟨t.exponent, ht⟩⟩) htermExponent + have hprincipalTerms : ∀ t ∈ principalTerms, + HahnSeries.Nonpositive.IsPrincipal t.1 := by + intro t ht + simp only [principalTerms, List.mem_pmap] at ht + obtain ⟨s, hs, rfl⟩ := ht + exact hprincipal s hs + have hdegreeTerms : ∀ t ∈ principalTerms, + (t.1 : K⟦ℝ⟧).degree ≤ + (alpha : WithBot NatOrdinal) := by + intro t ht + simp only [principalTerms, List.mem_pmap] at ht + obtain ⟨s, hs, rfl⟩ := ht + exact htermDegree s hs + have hseriesList : + principalTerms.map + (fun t ↦ ((principalMonomialTermSeries t : Series K) : K⟦ℝ⟧)) = + terms.map HahnSeries.NormalForm.Term.series := by + simp only [principalTerms, List.map_pmap] + calc + List.pmap + (fun t ht ↦ + ((principalMonomialTermSeries + (⟨t.coefficient, ⟨t.exponent, ht⟩⟩ : PrincipalMonomialTerm K) : + Series K) : K⟦ℝ⟧)) + terms htermExponent = + List.pmap (fun t _ ↦ t.series) terms htermExponent := by + apply List.pmap_congr_left + intro t _ ht _ + exact congrArg (fun x : Series K ↦ (x : K⟦ℝ⟧)) + (principalMonomialTerm_series_eq_normalTermSeries t ht) + _ = terms.map HahnSeries.NormalForm.Term.series := + List.pmap_eq_map htermExponent + have hseriesSum : + (((principalTerms.map principalMonomialTermSeries).sum : Series K) : + K⟦ℝ⟧) = (b : Series K) := by + change (HahnSeries.nonpositiveSubring ℝ K).subtype + (principalTerms.map principalMonomialTermSeries).sum = + ((b : Series K) : K⟦ℝ⟧) + rw [map_list_sum] + have hcoeList : + (principalTerms.map principalMonomialTermSeries).map + (HahnSeries.nonpositiveSubring ℝ K).subtype = + principalTerms.map + (fun t ↦ ((principalMonomialTermSeries t : Series K) : K⟦ℝ⟧)) := by + rw [List.map_map] + apply List.map_congr_left + intro t _ + rfl + rw [hcoeList] + exact (congrArg List.sum hseriesList).trans hsum + obtain ⟨z, hz⟩ := exists_tensor_eq_degreeLayerMk_terms alpha principalTerms hprincipalTerms + hdegreeTerms + refine ⟨z, ?_⟩ + rw [hz, degreeLayerMk_eq_componentMk, w.coe_component_eq_componentMk] + apply congrArg (w.componentMk alpha) + apply Subtype.ext + exact Subtype.ext hseriesSum + +private theorem degreeLayerTruncationAt_principalComponentTensorMap_tmul_monomial + (alpha : NatOrdinal) (x : PrincipalComponent K alpha) + (h g : {x : ℝ // x ≤ 0}) : + degreeLayerTruncationAt K alpha g + (principalComponentTensorMap K alpha + (x ⊗ₜ HahnSeries.Nonpositive.finiteSupportMonomial (K := K) h)) = + if h = g then x else 0 := by + by_cases hx : x = 0 + · subst x + simp + obtain ⟨p, hpBound, hp, hpDegree, hpx⟩ := + exists_principal_representative_of_ne_zero alpha x hx + rw [← hpx] + have hshiftedDegree : ((shiftedSeries h p : Series K) : K⟦ℝ⟧).degree = + (alpha : WithBot NatOrdinal) := by + rw [coe_shiftedSeries, HahnSeries.degree_translate, hpDegree] + have himage : + principalComponentTensorMap K alpha + (principalComponentMk alpha p hpBound ⊗ₜ + HahnSeries.Nonpositive.finiteSupportMonomial (K := K) h) = + degreeLayerMk alpha (shiftedSeries h p) hshiftedDegree.le := by + rw [principalComponentTensorMap_principal_monomial alpha + p hp hpDegree hpBound h] + rw [degreeLayerMk_eq_componentMk, degreeLayerMk_eq_componentMk] + apply congrArg + ((HahnSeries.Nonpositive.degreeValuation K).componentMk alpha) + apply Subtype.ext + exact finiteSupportMonomial_mul_eq_shiftedSeries h p + rw [himage, degreeLayerTruncationAt_mk] + simp only [coe_shiftedSeries] + by_cases hhg : h = g + · subst g + rw [if_pos rfl] + have hgerm : translatedTruncation + (HahnSeries.translate (h : ℝ) (p : K⟦ℝ⟧)) h = p := by + apply Subtype.ext + rw [coe_translatedTruncation_translate] + rw [sub_self, HahnSeries.truncLE_eq_self_of_support_subset_Iic + (HahnSeries.Nonpositive.support_subset p)] + simp + apply (principalComponentMk_eq_iff alpha _ p _ hpBound).mpr + rw [hgerm, sub_self, ordinalValue_zero] + exact NatOrdinal.wpow_pos alpha + · rw [if_neg hhg] + rw [principalComponentMk_eq_zero_iff] + rcases lt_or_gt_of_ne (Subtype.coe_ne_coe.mpr hhg) with hhgLT | hghLT + · have htrunc : HahnSeries.truncLE ((g : ℝ) - (h : ℝ)) + (p : K⟦ℝ⟧) = p := by + apply HahnSeries.truncLE_eq_self_of_support_subset_Iic + exact (HahnSeries.Nonpositive.support_subset p).trans fun y hy ↦ + hy.trans (sub_nonneg.mpr hhgLT.le) + have hgermCoe : + ((translatedTruncation + (HahnSeries.translate (h : ℝ) (p : K⟦ℝ⟧)) g : Series K) : + K⟦ℝ⟧) = + HahnSeries.translate ((h : ℝ) - (g : ℝ)) (p : K⟦ℝ⟧) := by + rw [coe_translatedTruncation_translate, htrunc] + have hpCoeNe : (p : K⟦ℝ⟧) ≠ 0 := by simpa using hp.ne_zero + have htranslatedNe : + HahnSeries.translate ((h : ℝ) - (g : ℝ)) (p : K⟦ℝ⟧) ≠ 0 := + fun hzero ↦ hpCoeNe ((HahnSeries.translate + ((h : ℝ) - (g : ℝ))).injective (by simpa using hzero)) + have hgermNe : + translatedTruncation + (HahnSeries.translate (h : ℝ) (p : K⟦ℝ⟧)) g ≠ 0 := by + intro hzero + apply htranslatedNe + rw [← hgermCoe] + exact congrArg Subtype.val hzero + have hpSup : sSup (p : K⟦ℝ⟧).support = 0 := by + have hsup := hp.supportSup_eq_zero + rw [HahnSeries.Nonpositive.supportSup_of_ne hp.ne_zero] at hsup + change ((sSup (p : K⟦ℝ⟧).support : ℝ) : WithBot ℝ) = + ((0 : ℝ) : WithBot ℝ) at hsup + exact WithBot.coe_eq_coe.mp hsup + have hgermJ : translatedTruncation + (HahnSeries.translate (h : ℝ) (p : K⟦ℝ⟧)) g ∈ + HahnSeries.Nonpositive.negativeMonomialIdeal K := by + rw [HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero] + rw [HahnSeries.Nonpositive.supportSup_of_ne hgermNe] + change + ((sSup (((translatedTruncation + (HahnSeries.translate (h : ℝ) (p : K⟦ℝ⟧)) g : Series K) : + K⟦ℝ⟧).support) : ℝ) : WithBot ℝ) < ((0 : ℝ) : WithBot ℝ) + apply WithBot.coe_lt_coe.mpr + rw [hgermCoe] + rw [HahnSeries.csSup_support_translate hpCoeNe + (HahnSeries.Nonpositive.bddAbove_support p), hpSup, add_zero] + exact sub_neg.mpr hhgLT + rw [ordinalValue_of_mem_negativeMonomialIdeal hgermJ] + exact NatOrdinal.wpow_pos alpha + · apply (ordinalValueDegree_lt_coe_iff _ alpha).mp + calc + ordinalValueDegree + (translatedTruncation + (HahnSeries.translate (h : ℝ) (p : K⟦ℝ⟧)) g) ≤ + (((translatedTruncation + (HahnSeries.translate (h : ℝ) (p : K⟦ℝ⟧)) g : Series K) : + K⟦ℝ⟧).degree) := ordinalValueDegree_le_degree _ + _ = (HahnSeries.truncLE ((g : ℝ) - (h : ℝ)) + (p : K⟦ℝ⟧)).degree := by + rw [coe_translatedTruncation_translate, HahnSeries.degree_translate] + _ < (alpha : WithBot NatOrdinal) := + hp.degree_truncLE_lt_of_degree_eq hpDegree (sub_neg.mpr hghLT) + +private theorem degreeLayerTruncationAt_principalComponentTensorMap (alpha : NatOrdinal) + (z : PrincipalComponent K alpha ⊗[K] FiniteSupportRing (K := K)) + (g : {x : ℝ // x ≤ 0}) : + degreeLayerTruncationAt K alpha g + (principalComponentTensorMap K alpha z) = + TensorProduct.equivFinsuppOfBasisRight + (HahnSeries.Nonpositive.finiteSupportBasis (G := ℝ) (K := K)) z g := by + let basis := HahnSeries.Nonpositive.finiteSupportBasis (G := ℝ) (K := K) + let coordinates := TensorProduct.equivFinsuppOfBasisRight + (M := PrincipalComponent K alpha) basis + let f := coordinates z + change degreeLayerTruncationAt K alpha g + (principalComponentTensorMap K alpha z) = f g + have hz : z = f.sum fun i x ↦ x ⊗ₜ basis i := by + calc + z = coordinates.symm f := by simp [f] + _ = f.sum fun i x ↦ x ⊗ₜ basis i := + TensorProduct.equivFinsuppOfBasisRight_symm_apply basis f + rw [hz] + induction f using Finsupp.induction with + | zero => + simp + rfl + | single_add a b f ha hb ih => + have hzero : ∀ i, + (0 : PrincipalComponent K alpha) ⊗ₜ[K] basis i = 0 := + fun i ↦ TensorProduct.zero_tmul (PrincipalComponent K alpha) (basis i) + have hadd : ∀ i b₁ b₂, + (b₁ + b₂ : PrincipalComponent K alpha) ⊗ₜ[K] basis i = + b₁ ⊗ₜ[K] basis i + b₂ ⊗ₜ[K] basis i := + fun i b₁ b₂ ↦ TensorProduct.add_tmul b₁ b₂ (basis i) + rw [Finsupp.sum_add_index' hzero hadd] + rw [Finsupp.sum_single_index (hzero a)] + rw [map_add, map_add, ih] + rw [HahnSeries.Nonpositive.finiteSupportBasis_apply] + rw [degreeLayerTruncationAt_principalComponentTensorMap_tmul_monomial] + rw [Finsupp.add_apply, Finsupp.single_apply] + rfl + +variable (K) in +private theorem principalComponentTensorMap_injective (alpha : NatOrdinal) : + Function.Injective (principalComponentTensorMap K alpha) := by + intro x y hxy + let basis := HahnSeries.Nonpositive.finiteSupportBasis (G := ℝ) (K := K) + let coordinates := TensorProduct.equivFinsuppOfBasisRight + (M := PrincipalComponent K alpha) basis + apply coordinates.injective + ext g + rw [← degreeLayerTruncationAt_principalComponentTensorMap alpha, + ← degreeLayerTruncationAt_principalComponentTensorMap alpha, hxy] + +variable (K) in +/-- The canonical extension-of-scalars equivalence +`P_α ⊗[K] K(ℝ^{≤ 0}) ≃ RV_α` from LM24, Proposition 5.3.1. -/ +def principalComponentTensorEquiv (α : NatOrdinal) : + PrincipalComponent K α ⊗[K] FiniteSupportRing (K := K) ≃ₗ[K] + (HahnSeries.Nonpositive.degreeValuation K).Component α := + LinearEquiv.ofBijective (principalComponentTensorMap K α) + ⟨principalComponentTensorMap_injective K α, + principalComponentTensorMap_surjective K α⟩ + +/-- The extension-of-scalars equivalence has the canonical multiplication map as its forward +linear map. -/ +@[simp] +theorem principalComponentTensorEquiv_apply (α : NatOrdinal) + (z : PrincipalComponent K α ⊗[K] FiniteSupportRing (K := K)) : + principalComponentTensorEquiv K α z = + principalComponentTensorMap K α z := + (rfl) + +/-- On a pure tensor, the extension-of-scalars equivalence is multiplication by the image of +the finite-support factor in the degree-zero residue ring. -/ +theorem principalComponentTensorEquiv_tmul (α : NatOrdinal) + (x : PrincipalComponent K α) (p : FiniteSupportRing (K := K)) : + principalComponentTensorEquiv K α (x ⊗ₜ p) = + HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K p • + principalComponentToHahnDegreeLayer K α x := by + rw [principalComponentTensorEquiv_apply, principalComponentTensorMap_tmul] + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubring.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubring.lean new file mode 100644 index 0000000000..28d95b7839 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubring.lean @@ -0,0 +1,492 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentDegree +public import Mathlib.Algebra.DirectSum.Algebra + +/-! +# The subring $\widehat{\mathrm P}$ of principal elements + +This module defines $\widehat{\mathrm P}$ intrinsically as the external direct sum + +`P̂ = ⨁ α, P_α`, + +where `P_α = J_{ω^(α+1)} / J_{ω^α}`. Its multiplication is induced by the homogeneous maps +`P_α × P_β → P_(α + β)`, where addition of `NatOrdinal` is Hessenberg addition. No basis, +complement, or chosen representatives enter this definition, and `P̂` is a graded commutative +`K`-algebra over every coefficient field: it is the associated graded ring of the max-additive +degree `ordinalValueDegreeValuation`, which rests on Berarducci, Lemma 5.5 alone. + +LM24, Definition 6.1.1 instead presents `P̂` as the subring of the degree-graded ring `RV̂` +whose homogeneous components are zero or principal. Both rings are associated graded rings of +`K((ℝ^{≤0}))`, for the degree and ordinal-value filtrations; since +`ordinalValueDegree b ≤ degree b`, the identity of `K((ℝ^{≤0}))` induces the canonical graded +algebra map `rvProjection : RV̂ → P̂`, the generic map of associated graded rings of +a coarsening, again over every field. The map `principalSubringEmbedding` in the other direction +chooses principal representatives of exact degree; it is a section of the projection, and its +range is exactly the componentwise-principal subalgebra. This explicit round trip identifies the +intrinsic direct sum with the paper's subring, and the projection is the left inverse that makes +the embedding injective. + +The embedding is where characteristic zero enters: it is multiplicative because the product of +two principal series is principal (LM24, Proposition 3.6.1, from Berarducci, Theorem 9.7) and +because degree is multiplicative (LM24, Theorem D). Both graded rings carry their +coefficient-field algebra structures componentwise; the embedding is an algebra homomorphism and +commutes with every homogeneous projection. +-/ + +universe v + +public noncomputable section + +namespace Berarducci + +open scoped DirectSum HahnSeries NatOrdinal + +variable {K : Type v} [Field K] + +variable (K) in +/-- The intrinsic direct sum `P̂ = ⨁ α, P_α`. -/ +abbrev PrincipalSubring := + (ordinalValueDegreeValuation K).AssociatedGraded + +variable (K) in +/-- The associated graded ring of Hahn-series degree. This is the paper's `RV̂` in the +real-exponent setting. -/ +abbrev DegreeGraded := + (HahnSeries.Nonpositive.degreeValuation K).AssociatedGraded + +/-- The coefficient-field algebra structure on `P̂`. -/ +instance principalSubringGAlgebra : + DirectSum.GAlgebra K (PrincipalComponent K) where + toFun := (principalComponentScalarHom K).toAddMonoidHom + map_one := map_one (principalComponentScalarHom K) + map_mul r s := by + change GradedMonoid.mk 0 (principalComponentScalarHom K (r * s)) = _ + rw [(principalComponentScalarHom K).map_mul] + exact GradedMonoid.mk_zero_smul _ _ + commutes _ x := DirectSum.GCommSemiring.mul_comm _ x + smul_def r x := + GradedMonoid.mk_zero_smul (principalComponentScalarHom K r) x.2 + +/-- The coefficient-field algebra structure on the degree-graded ring `RV̂`. -/ +instance degreeGradedGAlgebra : + DirectSum.GAlgebra K + (HahnSeries.Nonpositive.degreeValuation K).Component where + toFun := (degreeLayerScalarHom K).toAddMonoidHom + map_one := map_one (degreeLayerScalarHom K) + map_mul r s := by + change GradedMonoid.mk 0 (degreeLayerScalarHom K (r * s)) = _ + rw [(degreeLayerScalarHom K).map_mul] + exact GradedMonoid.mk_zero_smul _ _ + commutes _ x := DirectSum.GCommSemiring.mul_comm _ x + smul_def r x := GradedMonoid.mk_zero_smul (degreeLayerScalarHom K r) x.2 + +/-- The coefficient-field algebra structure on `P̂`. Recovering it re-traverses +`DirectSum.GAlgebra` and the componentwise multiplication, and the `Module` and `SMul` structures +used throughout are projections of it. -/ +instance principalSubringAlgebra : + Algebra K (PrincipalSubring K) := + inferInstance + +/-- The commutative ring structure on `P̂`, named for the reason given at +`principalSubringAlgebra`. -/ +instance principalSubringCommRing : + CommRing (PrincipalSubring K) := + inferInstance + +/-- The semiring structure on `P̂`. `Algebra K P̂` takes a `Semiring P̂` argument, so every +occurrence of the algebra structure resolves this too. The levels below are named for the same +reason. -/ +instance principalSubringSemiring : + Semiring (PrincipalSubring K) := + inferInstance + +instance principalSubring : + Ring (PrincipalSubring K) := + inferInstance + +instance principalSubringCommSemiring : + CommSemiring (PrincipalSubring K) := + inferInstance + +instance principalSubringAddCommGroup : + AddCommGroup (PrincipalSubring K) := + inferInstance + +/-- The coefficient-field algebra structure on `RV̂`, named for the reason given at +`principalSubringAlgebra`. -/ +instance degreeGradedAlgebra : + Algebra K (DegreeGraded K) := + inferInstance + +/-- The commutative ring structure on `RV̂`, named for the reason given at +`principalSubringAlgebra`. -/ +instance degreeGradedCommRing : + CommRing (DegreeGraded K) := + inferInstance + +/-- The semiring structure on `RV̂`, named for the reason given at `principalSubringSemiring`. -/ +instance degreeGradedSemiring : + Semiring (DegreeGraded K) := + inferInstance + +instance degreeGradedRing : + Ring (DegreeGraded K) := + inferInstance + +instance degreeGradedAddCommGroup : + AddCommGroup (DegreeGraded K) := + inferInstance + +/-- The coefficient-field algebra map lands in the intrinsic degree-zero component. -/ +@[simp] +theorem principalSubring_algebraMap_apply (k : K) : + algebraMap K (PrincipalSubring K) k = + DirectSum.of (PrincipalComponent K) 0 (principalComponentScalarHom K k) := + DirectSum.algebraMap_apply K (PrincipalComponent K) k + +/-- The ring `P̂` is nontrivial because its degree-zero component contains the +coefficient field. -/ +instance principalSubringNontrivial : + Nontrivial (PrincipalSubring K) := + (DirectSum.of_injective (β := PrincipalComponent K) 0).nontrivial + +variable (K) in +/-- The coefficient-field embedding into `P̂` is injective. -/ +theorem principalSubring_algebraMap_injective : + Function.Injective (algebraMap K (PrincipalSubring K)) := by + intro k l hkl + apply principalComponentScalarHom_injective K + apply DirectSum.of_injective (β := PrincipalComponent K) 0 + simpa only [principalSubring_algebraMap_apply] using hkl + +/-- Scalar multiplication by the coefficient field on `P̂` is +faithful. -/ +instance principalSubringFaithfulSMul : + FaithfulSMul K (PrincipalSubring K) := + (faithfulSMul_iff_algebraMap_injective K _).mpr + (principalSubring_algebraMap_injective K) + +/-- The coefficient-field algebra map for `RV̂` lands in degree zero. -/ +@[simp] +theorem degreeGraded_algebraMap_apply (k : K) : + algebraMap K (DegreeGraded K) k = + DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component + 0 (degreeLayerScalarHom K k) := + DirectSum.algebraMap_apply K + (HahnSeries.Nonpositive.degreeValuation K).Component k + +variable (K) in +/-- The inclusion of `P_α` into the degree-`α` component of `RV̂`. -/ +def principalComponentToHahnDegreeLayer (α : NatOrdinal) : + PrincipalComponent K α →ₗ[K] + (HahnSeries.Nonpositive.degreeValuation K).Component α := + (principalDegreeClasses K α).subtype.comp + (principalDegreeClassesEquivPrincipalComponent K α).symm.toLinearMap + +@[simp] +theorem degreeLayerToPrincipalComponent_principalComponentToHahnDegreeLayer + (α : NatOrdinal) (x : PrincipalComponent K α) : + degreeLayerToPrincipalComponent K α + (principalComponentToHahnDegreeLayer K α x) = x := by + let e := principalDegreeClassesEquivPrincipalComponent K α + have hcoe : principalComponentToHahnDegreeLayer K α x = + ((e.symm x : principalDegreeClasses K α) : + (HahnSeries.Nonpositive.degreeValuation K).Component α) := + rfl + rw [hcoe, ← principalDegreeClassesEquivPrincipalComponent_apply] + exact e.apply_symm_apply x + +variable (K) in +/-- The inclusion of `P_α` into the degree-`α` component of `RV̂` is injective. -/ +theorem principalComponentToHahnDegreeLayer_injective (α : NatOrdinal) : + Function.Injective (principalComponentToHahnDegreeLayer K α) := by + intro x y hxy + apply (degreeLayerToPrincipalComponent_principalComponentToHahnDegreeLayer α x).symm.trans + rw [hxy] + exact degreeLayerToPrincipalComponent_principalComponentToHahnDegreeLayer α y + +variable (K) in +/-- The inclusion of `P_0` sends its identity to the identity of `RV̂`. -/ +theorem principalComponentToHahnDegreeLayer_componentOne : + principalComponentToHahnDegreeLayer K 0 + (ordinalValueDegreeValuation K).componentOne = + (HahnSeries.Nonpositive.degreeValuation K).componentOne := by + let wOrder := ordinalValueDegreeValuation K + let wDegree := HahnSeries.Nonpositive.degreeValuation K + let e := principalDegreeClassesEquivPrincipalComponent K 0 + have honeDegree : (((1 : Series K) : K⟦ℝ⟧)).degree = + (0 : WithBot NatOrdinal) := by + rw [← map_one (HahnSeries.Nonpositive.C : K →+* Series K)] + exact degree_C_eq_zero_of_ne one_ne_zero + have honeClass : wDegree.componentOne ∈ principalDegreeClasses K 0 := by + rw [mem_principalDegreeClasses_iff, isPrincipalDegreeClass_iff] + refine Or.inr ⟨1, HahnSeries.Nonpositive.isPrincipal_one, honeDegree, ?_⟩ + rw [wDegree.componentOne_eq_componentMk, degreeLayerMk_eq_componentMk] + change ((e.symm wOrder.componentOne : principalDegreeClasses K 0) : + wDegree.Component 0) = wDegree.componentOne + have heq : e.symm wOrder.componentOne = ⟨wDegree.componentOne, honeClass⟩ := by + apply e.injective + rw [e.apply_symm_apply, + principalDegreeClassesEquivPrincipalComponent_apply, + degreeLayerToPrincipalComponent_eq_componentMap] + exact (MaxAddDegree.componentMap_componentOne _ _ _ _).symm + exact congrArg Subtype.val heq + +variable (K) in +/-- The canonical component map sends the degree-zero scalar of `k` to its class in +`P_0`. -/ +theorem degreeLayerToPrincipalComponent_degreeLayerScalarHom (k : K) : + degreeLayerToPrincipalComponent K 0 (degreeLayerScalarHom K k) = + principalComponentScalarHom K k := by + rw [degreeLayerScalarHom_apply, degreeLayerToPrincipalComponent_mk, + principalComponentScalarHom_apply] + +variable (K) in +/-- The canonical graded algebra map from `RV̂` to `P̂`: the map of associated graded rings +induced by the identity of `K((ℝ^{≤0}))`, which carries the degree +filtration into the coarser ordinal-value filtration because `ordinalValueDegree b ≤ degree b`. -/ +def rvProjection : + DegreeGraded K →ₐ[K] PrincipalSubring K where + toRingHom := + (HahnSeries.Nonpositive.degreeValuation K).associatedGradedMap + (ordinalValueDegreeValuation K) (RingHom.id (Series K)) + (ordinalValueDegreeValuation_le_degreeValuation K) + commutes' k := by + change (HahnSeries.Nonpositive.degreeValuation K).associatedGradedMap + (ordinalValueDegreeValuation K) (RingHom.id (Series K)) + (ordinalValueDegreeValuation_le_degreeValuation K) + (algebraMap K (DegreeGraded K) k) = algebraMap K (PrincipalSubring K) k + rw [degreeGraded_algebraMap_apply, principalSubring_algebraMap_apply, + MaxAddDegree.associatedGradedMap_of, ← degreeLayerToPrincipalComponent_eq_componentMap, + degreeLayerToPrincipalComponent_degreeLayerScalarHom K k] + +/-- The graded projection sends a homogeneous vector to the same grade. -/ +@[simp] +theorem rvProjection_of (α : NatOrdinal) + (x : (HahnSeries.Nonpositive.degreeValuation K).Component α) : + rvProjection K (DirectSum.of _ α x) = + DirectSum.of _ α (degreeLayerToPrincipalComponent K α x) := by + rw [degreeLayerToPrincipalComponent_eq_componentMap] + exact MaxAddDegree.associatedGradedMap_of _ _ _ _ α x + +/-- The graded projection commutes with every homogeneous projection. -/ +@[simp] +theorem rvProjection_apply (x : DegreeGraded K) (α : NatOrdinal) : + rvProjection K x α = + degreeLayerToPrincipalComponent K α (x α) := by + rw [degreeLayerToPrincipalComponent_eq_componentMap] + exact MaxAddDegree.associatedGradedMap_apply _ _ _ _ x α + +/-- Every vector in the image of a fixed intrinsic component is a principal degree class. -/ +theorem principalComponentToHahnDegreeLayer_isPrincipal + (α : NatOrdinal) (x : PrincipalComponent K α) : + IsPrincipalDegreeClass α + (principalComponentToHahnDegreeLayer K α x) := by + apply (mem_principalDegreeClasses_iff α _).mp + exact (principalDegreeClassesEquivPrincipalComponent K α).symm x |>.2 + +/-- On a principal class of `RV̂`, projection followed by inclusion is the identity. -/ +theorem principalComponentToHahnDegreeLayer_degreeLayerToPrincipalComponent_of_isPrincipal + (α : NatOrdinal) + (x : (HahnSeries.Nonpositive.degreeValuation K).Component α) + (hx : IsPrincipalDegreeClass α x) : + principalComponentToHahnDegreeLayer K α + (degreeLayerToPrincipalComponent K α x) = x := by + let e := principalDegreeClassesEquivPrincipalComponent K α + let x' : principalDegreeClasses K α := + ⟨x, (mem_principalDegreeClasses_iff α x).mpr hx⟩ + change ((e.symm (degreeLayerToPrincipalComponent K α x) : + principalDegreeClasses K α) : + (HahnSeries.Nonpositive.degreeValuation K).Component α) = x + have hex : e x' = degreeLayerToPrincipalComponent K α x := + principalDegreeClassesEquivPrincipalComponent_apply α x' + rw [← hex, e.symm_apply_apply] + +/-- The componentwise predicate in LM24, Definition 6.1.1: every homogeneous component is zero +or principal. -/ +def IsPrincipalGraded (x : DegreeGraded K) : Prop := + ∀ α, IsPrincipalDegreeClass α (x α) + +/-- Characterization of the paper's componentwise principal predicate. -/ +theorem isPrincipalGraded_iff (x : DegreeGraded K) : + IsPrincipalGraded x ↔ + ∀ α, IsPrincipalDegreeClass α (x α) := + Iff.rfl + +section Embedding + +variable [CharZero K] + +/-- The inclusion of each homogeneous component commutes with homogeneous multiplication. -/ +theorem principalComponentToHahnDegreeLayer_mul + {α β : NatOrdinal} (x : PrincipalComponent K α) (y : PrincipalComponent K β) : + principalComponentToHahnDegreeLayer K (α + β) + (principalComponentMul x y) = + (HahnSeries.Nonpositive.degreeValuation K).componentMul + (principalComponentToHahnDegreeLayer K α x) + (principalComponentToHahnDegreeLayer K β y) := by + let eα := principalDegreeClassesEquivPrincipalComponent K α + let eβ := principalDegreeClassesEquivPrincipalComponent K β + let eαβ := principalDegreeClassesEquivPrincipalComponent K (α + β) + let x' := eα.symm x + let y' := eβ.symm y + have hmul' := principalDegreeClassesEquivPrincipalComponent_mul x' y' + have hsource : eαβ.symm (principalComponentMul x y) = + principalDegreeClassesMul x' y' := by + apply eαβ.injective + simpa [eα, eβ, eαβ, x', y'] using hmul'.symm + change ((eαβ.symm (principalComponentMul x y) : + principalDegreeClasses K (α + β)) : + (HahnSeries.Nonpositive.degreeValuation K).Component + (α + β)) = _ + rw [hsource] + exact coe_principalDegreeClassesMul x' y' + +variable (K) in +private def principalComponentToHahnDegreeGradedLinear (α : NatOrdinal) : + PrincipalComponent K α →ₗ[K] DegreeGraded K := + (DirectSum.lof K NatOrdinal + (HahnSeries.Nonpositive.degreeValuation K).Component α).comp + (principalComponentToHahnDegreeLayer K α) + +variable (K) in +/-- The component-compatible algebra embedding of `P̂` into `RV̂`. -/ +def principalSubringEmbedding : + PrincipalSubring K →ₐ[K] DegreeGraded K := + DirectSum.toAlgebra K _ + (principalComponentToHahnDegreeGradedLinear K) + (by + let wOrder := ordinalValueDegreeValuation K + let wDegree := HahnSeries.Nonpositive.degreeValuation K + change DirectSum.of wDegree.Component 0 + (principalComponentToHahnDegreeLayer K 0 wOrder.componentOne) = + DirectSum.of wDegree.Component 0 wDegree.componentOne + rw [principalComponentToHahnDegreeLayer_componentOne K]) + (by + intro α β x y + simp only [principalComponentToHahnDegreeGradedLinear, LinearMap.comp_apply, + DirectSum.lof_eq_of] + rw [DirectSum.of_mul_of] + have hmulCompat := + principalComponentToHahnDegreeLayer_mul x y + rw [principalComponentMul_eq_componentMul] at hmulCompat + exact congrArg + (DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component + (α + β)) + hmulCompat) + +/-- The graded embedding sends a homogeneous vector to the same grade. -/ +@[simp] +theorem principalSubringEmbedding_of (α : NatOrdinal) (x : PrincipalComponent K α) : + principalSubringEmbedding K + (DirectSum.of (PrincipalComponent K) α x) = + DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component + α (principalComponentToHahnDegreeLayer K α x) := by + simp [principalSubringEmbedding, principalComponentToHahnDegreeGradedLinear, + DirectSum.toAlgebra, DirectSum.lof_eq_of] + +/-- The graded projection is a left inverse of the principal graded embedding. -/ +theorem rvProjection_principalGradedEmbedding (x : PrincipalSubring K) : + rvProjection K + (principalSubringEmbedding K x) = x := by + induction x using DirectSum.induction_on with + | zero => rw [map_zero, map_zero] + | of α x => + rw [principalSubringEmbedding_of, rvProjection_of, + degreeLayerToPrincipalComponent_principalComponentToHahnDegreeLayer] + | add x y hx hy => rw [map_add, map_add, hx, hy] + +variable (K) in +/-- The principal graded embedding is injective. -/ +theorem principalSubringEmbedding_injective : + Function.Injective (principalSubringEmbedding K) := + Function.LeftInverse.injective + rvProjection_principalGradedEmbedding + +/-- The principal graded embedding commutes with every homogeneous projection. -/ +@[simp] +theorem principalSubringEmbedding_apply (x : PrincipalSubring K) (α : NatOrdinal) : + principalSubringEmbedding K x α = + principalComponentToHahnDegreeLayer K α (x α) := by + induction x using DirectSum.induction_on with + | zero => simp + | of β x => + rw [principalSubringEmbedding_of] + by_cases hβα : β = α + · subst β + simp + · simp [DirectSum.of_apply, hβα] + | add x y hx hy => simp [map_add, hx, hy] + +variable (K) in +/-- The paper's principal graded subalgebra inside `RV̂`. -/ +def principalSubringSubalgebra : + Subalgebra K (DegreeGraded K) := + (principalSubringEmbedding K).range + +/-- The intrinsic range is exactly the componentwise definition of `P̂` from LM24, +Definition 6.1.1. -/ +theorem mem_principalGradedSubalgebra_iff (x : DegreeGraded K) : + x ∈ principalSubringSubalgebra K ↔ + IsPrincipalGraded x := by + constructor + · rintro ⟨y, hy⟩ + change principalSubringEmbedding K y = x at hy + intro α + rw [← hy, principalSubringEmbedding_apply] + exact principalComponentToHahnDegreeLayer_isPrincipal α (y α) + · intro hx + refine ⟨rvProjection K x, ?_⟩ + change principalSubringEmbedding K + (rvProjection K x) = x + apply DirectSum.ext + intro α + rw [principalSubringEmbedding_apply, rvProjection_apply] + exact + principalComponentToHahnDegreeLayer_degreeLayerToPrincipalComponent_of_isPrincipal + α (x α) (hx α) + +/-- Every element in the range of the intrinsic principal graded embedding is +componentwise principal. -/ +theorem principalSubringEmbedding_isPrincipal (x : PrincipalSubring K) : + IsPrincipalGraded (principalSubringEmbedding K x) := + (mem_principalGradedSubalgebra_iff _).mp ⟨x, rfl⟩ + +variable (K) in +/-- The intrinsic direct sum `P̂` is canonically algebra-equivalent to the subalgebra of principal +elements of `RV̂`. -/ +def principalSubringEquivSubalgebra : + PrincipalSubring K ≃ₐ[K] principalSubringSubalgebra K := + AlgEquiv.ofLeftInverse + (f := principalSubringEmbedding K) + (g := rvProjection K) + rvProjection_principalGradedEmbedding + +/-- The forward map of the intrinsic-to-paper equivalence is the graded embedding. -/ +@[simp] +theorem principalSubringEquivSubalgebra_apply (x : PrincipalSubring K) : + ((principalSubringEquivSubalgebra K x : + principalSubringSubalgebra K) : + DegreeGraded K) = + principalSubringEmbedding K x := + (rfl) + +/-- The inverse map of the intrinsic-to-paper equivalence is the graded projection. -/ +@[simp] +theorem principalSubringEquivSubalgebra_symm_apply (x : principalSubringSubalgebra K) : + (principalSubringEquivSubalgebra K).symm x = + rvProjection K x := + (rfl) + +end Embedding + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFiniteSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFiniteSupport.lean new file mode 100644 index 0000000000..d00618a4bd --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFiniteSupport.lean @@ -0,0 +1,239 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFraction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarExtension + +/-! +# Finite-support series over the principal graded fraction field + +Let `L = Frac(P̂)`. This module defines the finite-support Hahn-series ring +`L(ℝ^{≤0})` used in LM24, Lemma 6.3.4, together with the coefficient extension +`K(ℝ^{≤0}) → L(ℝ^{≤0})`. Its range is bundled as the embedded coefficient-series subring. + +All maps are canonical. The coefficient-field embedding is the composite `K → P̂ → Frac(P̂)`, +and finite-support scalar extension preserves every exponent and applies this composite to every +coefficient. +-/ + +open scoped HahnSeries + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [CharZero K] + +variable (K) in +/-- The canonical coefficient-field embedding `K → P̂ → Frac(P̂)`. -/ +def principalSubringFractionCoefficientMap : + K →+* PrincipalSubringFractionField K := + (principalSubringToFraction K).comp + (algebraMap K (PrincipalSubring K)) + +/-- The coefficient-field embedding evaluates as the composite `K → P̂ → Frac(P̂)`. -/ +@[simp] +theorem principalSubringFractionCoefficientMap_apply (k : K) : + principalSubringFractionCoefficientMap K k = + principalSubringToFraction K + (algebraMap K (PrincipalSubring K) k) := + (rfl) + +variable (K) in +/-- The coefficient-field embedding into the principal graded fraction field is injective. -/ +theorem principalSubringFractionCoefficientMap_injective : + Function.Injective (principalSubringFractionCoefficientMap K) := + (principalSubringToFraction_injective K).comp + (principalSubring_algebraMap_injective K) + +variable (K) in +/-- The finite-support nonpositive real-exponent Hahn-series ring over `Frac(P̂)`. -/ +abbrev PrincipalSubringFractionFiniteSupportRing := + HahnSeries.Nonpositive.FiniteSupportRing + (G := ℝ) (K := PrincipalSubringFractionField K) + +variable (K) in +/-- Extend coefficients from `K` to `Frac(P̂)` in finite-support nonpositive real-exponent +series. -/ +def principalSubringFractionScalarExtension : + HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K) →+* + PrincipalSubringFractionFiniteSupportRing K := + HahnSeries.Nonpositive.finiteSupportMap + (G := ℝ) (principalSubringFractionCoefficientMap K) + +/-- Principal-graded fraction scalar extension applies the coefficient embedding at every +exponent. -/ +theorem principalSubringFractionScalarExtension_coeff + (b : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)) + (g : HahnSeries.Nonpositive.exponentMonoid ℝ) : + HahnSeries.Nonpositive.finiteSupportCoefficients + (principalSubringFractionScalarExtension K b) g = + principalSubringFractionCoefficientMap K + (HahnSeries.Nonpositive.finiteSupportCoefficients b g) := + HahnSeries.Nonpositive.finiteSupportMap_coeff + (principalSubringFractionCoefficientMap K) b g + +variable (K) in +/-- Principal-graded fraction scalar extension is injective. -/ +theorem principalSubringFractionScalarExtension_injective : + Function.Injective (principalSubringFractionScalarExtension K) := + HahnSeries.Nonpositive.finiteSupportMap_injective + (principalSubringFractionCoefficientMap K) + (principalSubringFractionCoefficientMap_injective K) + +/-- Principal-graded fraction scalar extension maps a constant series through the coefficient +embedding. -/ +@[simp] +theorem principalSubringFractionScalarExtension_scalar (k : K) : + principalSubringFractionScalarExtension K + (HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k) = + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) + (principalSubringFractionCoefficientMap K k) := + HahnSeries.Nonpositive.finiteSupportMap_scalar + (principalSubringFractionCoefficientMap K) k + +variable (K) in +/-- Principal-graded fraction scalar extension preserves every Hahn monomial. -/ +@[simp] +theorem principalSubringFractionScalarExtension_monomial + (g : HahnSeries.Nonpositive.exponentMonoid ℝ) : + principalSubringFractionScalarExtension K + (HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g) = + HahnSeries.Nonpositive.finiteSupportMonomial + (K := PrincipalSubringFractionField K) g := + HahnSeries.Nonpositive.finiteSupportMap_monomial + (principalSubringFractionCoefficientMap K) g + +variable (K) in +/-- The embedded copy of `K(ℝ^{≤0})` inside `Frac(P̂)(ℝ^{≤0})`. -/ +def principalSubringFractionCoefficientSubring : + Subring (PrincipalSubringFractionFiniteSupportRing K) := + (principalSubringFractionScalarExtension K).range + +/-- Membership in the embedded coefficient-series subring is existence of a preimage over `K`. -/ +theorem mem_principalGradedFractionCoefficientSubring_iff + (b : PrincipalSubringFractionFiniteSupportRing K) : + b ∈ principalSubringFractionCoefficientSubring K ↔ + ∃ a, principalSubringFractionScalarExtension K a = b := by + rw [principalSubringFractionCoefficientSubring, RingHom.mem_range] + +variable (K) in +/-- Scalar redistribution for finite-support series over `Frac(P̂)`: a nonzero scalar may be +moved between two nonzero factors whose product has coefficients in the original field so that +both adjusted factors again have coefficients in that field. -/ +structure PrincipalSubringFractionScalarRedistribution : Prop where + exists_scalar : + ∀ {p₁ p₂ : PrincipalSubringFractionFiniteSupportRing K}, + p₁ ≠ 0 → p₂ ≠ 0 → + p₁ * p₂ ∈ principalSubringFractionCoefficientSubring K → + ∃ B : PrincipalSubringFractionField K, + B ≠ 0 ∧ + p₁ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B ∈ + principalSubringFractionCoefficientSubring K ∧ + p₂ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B⁻¹ ∈ + principalSubringFractionCoefficientSubring K + +/-- A finite-support series over `Frac(P̂)` belongs to the embedded coefficient-series subring +exactly when every coefficient belongs to the image of `K`. -/ +theorem mem_principalGradedFractionCoefficientSubring_iff_coeff + (b : PrincipalSubringFractionFiniteSupportRing K) : + b ∈ principalSubringFractionCoefficientSubring K ↔ + ∀ g, HahnSeries.Nonpositive.finiteSupportCoefficients b g ∈ + Set.range (principalSubringFractionCoefficientMap K) := by + rw [principalSubringFractionCoefficientSubring, + principalSubringFractionScalarExtension] + exact HahnSeries.Nonpositive.mem_range_finiteSupportMap_iff + (principalSubringFractionCoefficientMap K) b + +/-- If an extended nonzero series becomes a coefficient-series after multiplication by a +constant fraction, then that fraction belongs to the image of the coefficient field. -/ +theorem principalSubringFractionCoefficientMap_mem_range_of_mul_scalar_mem + {p : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)} + (hp : p ≠ 0) {B : PrincipalSubringFractionField K} + (hmem : principalSubringFractionScalarExtension K p * + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B ∈ + principalSubringFractionCoefficientSubring K) : + B ∈ Set.range (principalSubringFractionCoefficientMap K) := by + apply HahnSeries.Nonpositive.coefficient_mem_range_of_map_mul_scalar_mem_range + (Field.toIsField K) (principalSubringFractionCoefficientMap K) hp + rw [principalSubringFractionCoefficientSubring, RingHom.mem_range] at hmem + change ∃ x, + HahnSeries.Nonpositive.finiteSupportMap + (principalSubringFractionCoefficientMap K) x = + HahnSeries.Nonpositive.finiteSupportMap + (principalSubringFractionCoefficientMap K) p * + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B + simpa only [principalSubringFractionScalarExtension] using hmem + +/-- Scalar redistribution implies that the coefficient extension from `K(ℝ^{≤0})` to +`Frac(P̂)(ℝ^{≤0})` reflects divisibility. -/ +theorem principalSubringFractionScalarExtension_dvd_iff_of_scalarRedistribution (hredistribute : + ∀ {p₁ p₂ : PrincipalSubringFractionFiniteSupportRing K}, + p₁ ≠ 0 → p₂ ≠ 0 → + p₁ * p₂ ∈ principalSubringFractionCoefficientSubring K → + ∃ B : PrincipalSubringFractionField K, + B ≠ 0 ∧ + p₁ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B ∈ + principalSubringFractionCoefficientSubring K ∧ + p₂ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B⁻¹ ∈ + principalSubringFractionCoefficientSubring K) + (p q : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)) : + principalSubringFractionScalarExtension K p ∣ + principalSubringFractionScalarExtension K q ↔ + p ∣ q := by + apply HahnSeries.Nonpositive.finiteSupportMap_dvd_iff_of_scalarRedistribution + (principalSubringFractionCoefficientMap K) + (principalSubringFractionCoefficientMap_injective K) ?_ p q + intro p₁ p₂ hp₁ hp₂ hprod + have hprod' : + p₁ * p₂ ∈ principalSubringFractionCoefficientSubring K := by + rw [principalSubringFractionCoefficientSubring, RingHom.mem_range] + exact hprod + obtain ⟨B, hB, hleft, hright⟩ := hredistribute hp₁ hp₂ hprod' + refine ⟨B, hB, ?_, ?_⟩ + · rw [principalSubringFractionCoefficientSubring, RingHom.mem_range] at hleft + exact hleft + · rw [principalSubringFractionCoefficientSubring, RingHom.mem_range] at hright + exact hright + +/-- Scalar redistribution and greatest-common-divisor existence over `Frac(P̂)` descend primal +factor witnesses through the coefficient extension. Both descended factors remain finite-support +series over the original coefficient field. -/ +theorem principalSubringFractionScalarExtension_exists_factor_dvd_of_scalarRedistribution + (hredistribute : PrincipalSubringFractionScalarRedistribution K) + (hgcd : ∀ p q : PrincipalSubringFractionFiniteSupportRing K, + ∃ d : PrincipalSubringFractionFiniteSupportRing K, + ∀ e : PrincipalSubringFractionFiniteSupportRing K, + e ∣ p ∧ e ∣ q ↔ e ∣ d) + (p : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)) + (b c : PrincipalSubringFractionFiniteSupportRing K) + (hp : principalSubringFractionScalarExtension K p ∣ b * c) : + ∃ p₁ p₂ : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K), + p = p₁ * p₂ ∧ + principalSubringFractionScalarExtension K p₁ ∣ b ∧ + principalSubringFractionScalarExtension K p₂ ∣ c := by + apply HahnSeries.Nonpositive.finiteSupportMap_exists_factor_dvd_of_scalarRedistribution + (principalSubringFractionCoefficientMap K) + (principalSubringFractionCoefficientMap_injective K) ?_ hgcd p b c hp + intro p₁ p₂ hp₁ hp₂ hprod + have hprod' : + p₁ * p₂ ∈ principalSubringFractionCoefficientSubring K := by + rw [principalSubringFractionCoefficientSubring, RingHom.mem_range] + exact hprod + obtain ⟨B, hB, hleft, hright⟩ := + hredistribute.exists_scalar hp₁ hp₂ hprod' + refine ⟨B, hB, ?_, ?_⟩ + · rw [principalSubringFractionCoefficientSubring, RingHom.mem_range] at hleft + exact hleft + · rw [principalSubringFractionCoefficientSubring, RingHom.mem_range] at hright + exact hright + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFraction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFraction.lean new file mode 100644 index 0000000000..5aabcb429b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFraction.lean @@ -0,0 +1,228 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubring +public import Mathlib.RingTheory.Localization.FractionRing + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.OrdinalValueDegree + +/-! +# The fraction field of $\widehat{\mathrm P}$ + +This module defines the fraction field `Frac(P̂)` occurring in LM24, Lemmas 6.3.3--6.3.4. The +ring `P̂` is the intrinsic direct sum of the spaces `P_α`, and its canonical map to the +fraction field is injective. + +The coefficient-field algebra structure is obtained by composing `K → P̂` with the canonical +localization map `P̂ → Frac(P̂)`. It is kept distinct from the localization algebra structure, +so the two scalar structures are not conflated. +-/ + +universe v + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] [CharZero K] + +/-- The intrinsic direct sum `P̂` is an integral domain: the exponent-valued order valuation is +multiplicative (Berarducci, Theorem 9.7), so its associated graded ring has no zero divisors. -/ +instance principalSubringIsDomain : + IsDomain (PrincipalSubring K) := + NoZeroDivisors.to_isDomain _ + +variable (K) in +/-- The canonical fraction field of `P̂`. -/ +def PrincipalSubringFractionField := + FractionRing (PrincipalSubring K) + +omit [CharZero K] in +variable (K) in +/-- The principal graded fraction field is the canonical fraction-ring construction. -/ +theorem principalSubringFractionField_eq_fractionRing : + PrincipalSubringFractionField K = + FractionRing (PrincipalSubring K) := + (rfl) + +/-- The canonical field structure on the fraction field of `P̂`. -/ +noncomputable instance principalSubringFractionFieldInstance : + Field (PrincipalSubringFractionField K) := + (principalSubringFractionField_eq_fractionRing K).symm ▸ + (inferInstance : Field (FractionRing (PrincipalSubring K))) + +variable (K) in +/-- The canonical ring equivalence from the defined fraction field to the fraction-ring +construction. -/ +def principalSubringFractionRingEquiv : + PrincipalSubringFractionField K ≃+* + FractionRing (PrincipalSubring K) := by + let h := principalSubringFractionField_eq_fractionRing K + exact + { toFun := fun x ↦ h.mp x + invFun := fun x ↦ h.mpr x + left_inv := fun x ↦ by cases h; rfl + right_inv := fun x ↦ by cases h; rfl + map_add' := by + intro x y + cases h + rfl + map_mul' := by + intro x y + cases h + rfl } + +variable (K) in +/-- The canonical localization algebra structure `P̂ → Frac(P̂)`. -/ +noncomputable abbrev principalSubringFractionSelfAlgebra : + Algebra (PrincipalSubring K) + (PrincipalSubringFractionField K) := + RingHom.toAlgebra + ((principalSubringFractionRingEquiv K).symm.toRingHom.comp + (algebraMap (PrincipalSubring K) + (FractionRing (PrincipalSubring K)))) + +local instance principalSubringFractionSelfAlgebraInstance : + Algebra (PrincipalSubring K) + (PrincipalSubringFractionField K) := + principalSubringFractionSelfAlgebra K + +variable (K) in +/-- The defined fraction field is canonically equivalent, as a `P̂`-algebra, to the fraction-ring +construction. -/ +def principalSubringFractionAlgEquiv : + FractionRing (PrincipalSubring K) ≃ₐ[PrincipalSubring K] + PrincipalSubringFractionField K where + toRingEquiv := (principalSubringFractionRingEquiv K).symm + commutes' _ := rfl + +local instance principalSubringFractionIsFractionRing : + IsFractionRing (PrincipalSubring K) + (PrincipalSubringFractionField K) := by + exact IsFractionRing.of_algEquiv (principalSubringFractionAlgEquiv K) + +variable (K) in +/-- The canonical inclusion `P̂ → Frac(P̂)`. -/ +def principalSubringToFraction : + PrincipalSubring K →+* PrincipalSubringFractionField K := + algebraMap _ _ + +/-- The canonical inclusion is the localization algebra map on each element of `P̂`. -/ +@[simp] +theorem principalSubringToFraction_apply (B : PrincipalSubring K) : + principalSubringToFraction K B = + @algebraMap (PrincipalSubring K) + (PrincipalSubringFractionField K) _ _ + (principalSubringFractionSelfAlgebra K) B := + (rfl) + +/-- Construct an element of `Frac(P̂)` from a numerator and a non-zero-divisor denominator. -/ +def principalSubringFractionMk (B : PrincipalSubring K) + (C : nonZeroDivisors (PrincipalSubring K)) : + PrincipalSubringFractionField K := + IsLocalization.mk' (PrincipalSubringFractionField K) B C + +/-- The canonical inclusion sends `B` to the localization fraction `B / 1`. -/ +theorem principalSubringToFraction_apply_eq_mk (B : PrincipalSubring K) : + principalSubringToFraction K B = + principalSubringFractionMk B + (1 : nonZeroDivisors (PrincipalSubring K)) := by + rw [principalSubringFractionMk, IsLocalization.mk'_one] + rfl + +variable (K) in +/-- A localization representative in `Frac(P̂)` is zero exactly when its numerator is zero. -/ +@[simp] +theorem principalSubringFractionMk_eq_zero_iff {B : PrincipalSubring K} + {C : nonZeroDivisors (PrincipalSubring K)} : + principalSubringFractionMk B C = 0 ↔ B = 0 := by + rw [principalSubringFractionMk] + exact IsFractionRing.mk'_eq_zero_iff_eq_zero + +variable (K) in +/-- The canonical inclusion of `P̂` in its fraction field is injective. -/ +theorem principalSubringToFraction_injective : + Function.Injective (principalSubringToFraction K) := + IsFractionRing.injective _ _ + +/-- Every element of `Frac(P̂)` has a localization representative with denominator in the +non-zero-divisor submonoid of `P̂`. -/ +theorem principalSubringFraction_exists_mk (x : PrincipalSubringFractionField K) : + ∃ (B : PrincipalSubring K) + (C : nonZeroDivisors (PrincipalSubring K)), + x = principalSubringFractionMk B C := by + obtain ⟨B, C, hBC⟩ := + IsLocalization.exists_mk'_eq + (nonZeroDivisors (PrincipalSubring K)) x + exact ⟨B, C, by simpa only [principalSubringFractionMk] using hBC.symm⟩ + +/-- Every nonzero element of `Frac(P̂)` has a localization representative with nonzero +numerator. -/ +theorem principalSubringFraction_exists_mk_of_ne_zero + {x : PrincipalSubringFractionField K} (hx : x ≠ 0) : + ∃ (B : PrincipalSubring K) + (C : nonZeroDivisors (PrincipalSubring K)), + B ≠ 0 ∧ x = principalSubringFractionMk B C := by + obtain ⟨B, C, hBC⟩ := principalSubringFraction_exists_mk x + refine ⟨B, C, ?_, hBC⟩ + intro hB + apply hx + rw [hBC, hB] + exact (principalSubringFractionMk_eq_zero_iff K).mpr rfl + +variable (K) in +/-- The coefficient-field algebra structure on `Frac(P̂)`, induced through `K → P̂`. -/ +noncomputable abbrev principalSubringFractionAlgebra : + Algebra K (PrincipalSubringFractionField K) := + RingHom.toAlgebra + ((principalSubringToFraction K).comp + (algebraMap K (PrincipalSubring K))) + +local instance principalSubringFractionAlgebraInstance : + Algebra K (PrincipalSubringFractionField K) := + principalSubringFractionAlgebra K + +/-- The coefficient-field embedding in `Frac(P̂)` is the composite `K → P̂ → Frac(P̂)`. -/ +@[simp] +theorem principalSubringFraction_algebraMap_apply (k : K) : + algebraMap K (PrincipalSubringFractionField K) k = + principalSubringToFraction K + (algebraMap K (PrincipalSubring K) k) := + (rfl) + +variable (K) in +/-- The coefficient, principal-graded, and fraction-field algebra structures form the canonical +scalar tower `K → P̂ → Frac(P̂)`. -/ +theorem principalSubringFraction_isScalarTower : + @IsScalarTower K (PrincipalSubring K) + (PrincipalSubringFractionField K) + inferInstance + (principalSubringFractionSelfAlgebra K).toSMul + (principalSubringFractionAlgebra K).toSMul := by + apply @IsScalarTower.of_algebraMap_eq K (PrincipalSubring K) + (PrincipalSubringFractionField K) _ _ _ _ + (principalSubringFractionSelfAlgebra K) + (principalSubringFractionAlgebra K) + intro k + rw [principalSubringFraction_algebraMap_apply, + principalSubringToFraction_apply] + +variable (K) in +/-- The coefficient-field embedding into `Frac(P̂)` is injective. -/ +theorem principalSubringFraction_algebraMap_injective : + Function.Injective + (algebraMap K (PrincipalSubringFractionField K)) := by + intro k l hkl + apply principalSubring_algebraMap_injective K + apply principalSubringToFraction_injective K + simpa only [principalSubringFraction_algebraMap_apply] using hkl + +attribute [irreducible] PrincipalSubringFractionField + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFractionAlgebraic.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFractionAlgebraic.lean new file mode 100644 index 0000000000..f88037430c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFractionAlgebraic.lean @@ -0,0 +1,850 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFraction +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.LeadingGrade +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CoefficientMap +public import Mathlib.RingTheory.Polynomial.ScaleRoots +public import Mathlib.RingTheory.Algebraic.Defs +public import Mathlib.FieldTheory.Minpoly.Basic + +import Mathlib.FieldTheory.IsAlgClosed.AlgebraicClosure +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue + +/-! +# Degrees in a homogenized algebraic relation + +An element of the fraction field of `P̂` that is algebraic over the +coefficient field satisfies a monic relation which, after clearing denominators, becomes a sum of +terms `B ^ e * C ^ f` with `e + f` constant. Because the degree is a multiplicative valuation, the +degree of such a term is `e` copies of `deg B` plus `f` copies of `deg C`, the sum taken in the +Hessenberg (natural) arithmetic of `NatOrdinal`. + +This file records the arithmetic that forces the two degrees to agree. Natural addition is +cancellative and strictly monotone and natural multiplication by a positive factor is strictly +monotone, so if the two degrees differed, the degrees of the individual terms would be pairwise +distinct and the term of largest degree could not be cancelled by the others. The consequence +recorded here is the contrapositive: distinct terms of equal degree force `deg B = deg C`. + +Where the source argument passes from a relation among leading homogeneous components back to a +degree bound on a combination of representatives, it cites LM24, Lemma 4.2.5. That appeal is +discharged here by the quotient presentation of `P_α` instead: `principalComponentMk_eq_zero_iff` +identifies the vanishing of a class with a degree drop of any representative, and additivity of +the class map turns the homogeneous relation into the required bound. No separate formalization of +the printed lemma is used. +-/ + +universe v + +open scoped HahnSeries NatOrdinal + +namespace Berarducci + +open HahnSeries.Nonpositive + +public noncomputable section + +/-- Along a homogenized relation the term degrees are strictly antitone in the exponent of the +smaller of the two degrees. -/ +theorem natOrdinal_termDegree_lt_of_lt {beta gamma : NatOrdinal} (h : beta < gamma) + {e f e' f' : ℕ} (hsum : e + f = e' + f') (hlt : e < e') : + (e' : NatOrdinal) * beta + (f' : NatOrdinal) * gamma < + (e : NatOrdinal) * beta + (f : NatOrdinal) * gamma := by + obtain ⟨m, hm⟩ := Nat.exists_eq_add_of_lt hlt + have hm0 : 0 < m + 1 := Nat.succ_pos m + have hf : f = f' + (m + 1) := by omega + have hmul : ((m + 1 : ℕ) : NatOrdinal) * beta < ((m + 1 : ℕ) : NatOrdinal) * gamma := by + refine mul_lt_mul_of_pos_left h ?_ + exact_mod_cast hm0 + have hleft : (e' : NatOrdinal) * beta + (f' : NatOrdinal) * gamma = + ((e : NatOrdinal) * beta + (f' : NatOrdinal) * gamma) + + ((m + 1 : ℕ) : NatOrdinal) * beta := by + rw [hm] + push_cast + ring + have hright : (e : NatOrdinal) * beta + (f : NatOrdinal) * gamma = + ((e : NatOrdinal) * beta + (f' : NatOrdinal) * gamma) + + ((m + 1 : ℕ) : NatOrdinal) * gamma := by + rw [hf] + push_cast + ring + rw [hleft, hright] + exact add_lt_add_of_le_of_lt le_rfl hmul + +/-- If `β ≠ γ`, two distinct exponent pairs with the same total exponent have distinct +`β, γ`-weighted degrees. -/ +theorem natOrdinal_termDegree_ne {beta gamma : NatOrdinal} (h : beta ≠ gamma) + {e f e' f' : ℕ} (hsum : e + f = e' + f') (hne : e ≠ e') : + (e : NatOrdinal) * beta + (f : NatOrdinal) * gamma ≠ + (e' : NatOrdinal) * beta + (f' : NatOrdinal) * gamma := by + have hswap : ∀ a b : ℕ, (a : NatOrdinal) * beta + (b : NatOrdinal) * gamma = + (b : NatOrdinal) * gamma + (a : NatOrdinal) * beta := fun a b ↦ add_comm _ _ + rcases lt_or_gt_of_ne h with hbg | hbg + · rcases lt_or_gt_of_ne hne with hee | hee + · exact (natOrdinal_termDegree_lt_of_lt hbg hsum hee).ne' + · exact (natOrdinal_termDegree_lt_of_lt hbg hsum.symm hee).ne + · have hfne : f ≠ f' := by omega + rw [hswap e f, hswap e' f'] + rcases lt_or_gt_of_ne hfne with hff | hff + · exact (natOrdinal_termDegree_lt_of_lt hbg (by omega : f + e = f' + e') hff).ne' + · exact (natOrdinal_termDegree_lt_of_lt hbg (by omega : f' + e' = f + e) hff).ne + +/-! ### Multiplicativity of the leading grade on `P̂` -/ + +variable {K : Type v} [Field K] [CharZero K] + +/-- Nonzero homogeneous classes have nonzero product: `P̂` is a domain, and +the product of the homogeneous inclusions is the inclusion of the graded product. -/ +theorem principalComponent_gMul_ne_zero {i j : NatOrdinal} + (a : PrincipalComponent K i) (b : PrincipalComponent K j) (ha : a ≠ 0) (hb : b ≠ 0) : + GradedMonoid.GMul.mul a b ≠ 0 := by + intro hzero + have hprod : + (DirectSum.of (PrincipalComponent K) i a) * + (DirectSum.of (PrincipalComponent K) j b) = 0 := by + rw [DirectSum.of_mul_of, hzero, map_zero] + rcases mul_eq_zero.mp hprod with h | h + · exact ha (DirectSum.of_injective i (by rw [h, map_zero])) + · exact hb (DirectSum.of_injective j (by rw [h, map_zero])) + +/-- On `P̂` the leading grade is additive on products. -/ +theorem leadingGrade_mul_principalGraded (x y : PrincipalSubring K) : + DirectSum.leadingGrade (PrincipalComponent K) (x * y) = + DirectSum.leadingGrade (PrincipalComponent K) x + + DirectSum.leadingGrade (PrincipalComponent K) y := + DirectSum.leadingGrade_mul (PrincipalComponent K) + (fun a b ha hb ↦ principalComponent_gMul_ne_zero a b ha hb) x y + +omit [CharZero K] in +variable (K) in +/-- The unit has leading grade zero. -/ +theorem leadingGrade_one_principalGraded : + DirectSum.leadingGrade (PrincipalComponent K) (1 : PrincipalSubring K) = + ((0 : NatOrdinal) : WithBot NatOrdinal) := by + have hone : (GradedMonoid.GOne.one : PrincipalComponent K 0) ≠ 0 := by + intro hzero + have : (1 : PrincipalSubring K) = 0 := by + rw [DirectSum.one_def, hzero, map_zero] + exact one_ne_zero this + rw [DirectSum.one_def] + exact DirectSum.leadingGrade_of (PrincipalComponent K) hone + +/-- The leading grade of a power multiplies the leading grade by the exponent. -/ +theorem leadingGrade_pow_principalGraded {x : PrincipalSubring K} {beta : NatOrdinal} + (hx : DirectSum.leadingGrade (PrincipalComponent K) x = (beta : WithBot NatOrdinal)) + (n : ℕ) : + DirectSum.leadingGrade (PrincipalComponent K) (x ^ n) = + (((n : NatOrdinal) * beta : NatOrdinal) : WithBot NatOrdinal) := by + induction n with + | zero => simpa using leadingGrade_one_principalGraded K + | succ n ih => + rw [pow_succ, leadingGrade_mul_principalGraded, ih, hx, ← WithBot.coe_add] + congr 1 + push_cast + ring + +omit [CharZero K] in +/-- Adding an element of strictly smaller leading grade leaves the leading grade unchanged. This +is the step that makes a uniquely maximal term impossible to cancel. -/ +theorem leadingGrade_add_eq_of_lt {x y : PrincipalSubring K} + (h : DirectSum.leadingGrade (PrincipalComponent K) y < + DirectSum.leadingGrade (PrincipalComponent K) x) : + DirectSum.leadingGrade (PrincipalComponent K) (x + y) = + DirectSum.leadingGrade (PrincipalComponent K) x := by + have hx : x ≠ 0 := by + intro hzero + rw [hzero, DirectSum.leadingGrade_zero] at h + exact (not_lt_bot h).elim + obtain ⟨m, hm, hxm⟩ := DirectSum.exists_grade_eq_leadingGrade (PrincipalComponent K) hx + have hym : y m = 0 := by + by_contra hne + exact absurd (DirectSum.grade_le_leadingGrade (PrincipalComponent K) hne) + (not_le.mpr (by rw [hm] at h; exact h)) + refine le_antisymm ?_ ?_ + · refine (DirectSum.leadingGrade_add_le_max (PrincipalComponent K) x y).trans ?_ + exact max_le le_rfl h.le + · rw [hm] + refine DirectSum.grade_le_leadingGrade (PrincipalComponent K) ?_ + rw [DirectSum.add_apply, hym, add_zero] + exact hxm + +/-! ### A uniquely maximal term cannot cancel -/ + +omit [CharZero K] in +/-- The leading grade of a finite sum is at most the supremum of the leading grades. -/ +theorem leadingGrade_finsetSum_le {iota : Type*} + (s : Finset iota) (g : iota → PrincipalSubring K) : + DirectSum.leadingGrade (PrincipalComponent K) (∑ i ∈ s, g i) ≤ + s.sup fun i ↦ DirectSum.leadingGrade (PrincipalComponent K) (g i) := by + classical + induction s using Finset.induction with + | empty => simp [DirectSum.leadingGrade_zero] + | insert a t ha ih => + rw [Finset.sum_insert ha, Finset.sup_insert] + exact (DirectSum.leadingGrade_add_le_max (PrincipalComponent K) _ _).trans + (max_le_max le_rfl ih) + +omit [CharZero K] in +/-- A finite sum in which one nonzero term has strictly largest leading grade has that leading +grade. In particular such a sum cannot vanish, which is what forbids the degrees of two distinct +terms of the homogenized relation from being separated. -/ +theorem leadingGrade_finsetSum_eq_of_unique_max + {iota : Type*} (s : Finset iota) (g : iota → PrincipalSubring K) + {i₀ : iota} (hi₀ : i₀ ∈ s) (hg₀ : g i₀ ≠ 0) + (hmax : ∀ i ∈ s, i ≠ i₀ → + DirectSum.leadingGrade (PrincipalComponent K) (g i) < + DirectSum.leadingGrade (PrincipalComponent K) (g i₀)) : + DirectSum.leadingGrade (PrincipalComponent K) (∑ i ∈ s, g i) = + DirectSum.leadingGrade (PrincipalComponent K) (g i₀) := by + classical + have hbot : (⊥ : WithBot NatOrdinal) < + DirectSum.leadingGrade (PrincipalComponent K) (g i₀) := + bot_lt_iff_ne_bot.mpr fun hb ↦ + hg₀ ((DirectSum.leadingGrade_eq_bot_iff (PrincipalComponent K) _).mp hb) + rw [← Finset.add_sum_erase s g hi₀] + refine leadingGrade_add_eq_of_lt ?_ + refine lt_of_le_of_lt (leadingGrade_finsetSum_le _ g) ?_ + exact (Finset.sup_lt_iff hbot).mpr fun i hi ↦ + hmax i (Finset.mem_of_mem_erase hi) (Finset.ne_of_mem_erase hi) + +/-! ### The two degrees of a homogenized relation agree -/ + +omit [CharZero K] in +/-- A nonzero scalar has leading grade zero. -/ +theorem leadingGrade_algebraMap_of_ne_zero {a : K} + (ha : a ≠ 0) : + DirectSum.leadingGrade (PrincipalComponent K) (algebraMap K (PrincipalSubring K) a) = + ((0 : NatOrdinal) : WithBot NatOrdinal) := by + rw [principalSubring_algebraMap_apply] + refine DirectSum.leadingGrade_of (PrincipalComponent K) ?_ + intro hzero + exact ha (principalComponentScalarHom_injective K (by rw [hzero, map_zero])) + +/-- The leading grade of a term of a homogenized relation. -/ +theorem leadingGrade_relationTerm {a : K} (ha : a ≠ 0) + {B C : PrincipalSubring K} {beta gamma : NatOrdinal} + (hB : DirectSum.leadingGrade (PrincipalComponent K) B = (beta : WithBot NatOrdinal)) + (hC : DirectSum.leadingGrade (PrincipalComponent K) C = (gamma : WithBot NatOrdinal)) + (i f : ℕ) : + DirectSum.leadingGrade (PrincipalComponent K) + (algebraMap K (PrincipalSubring K) a * B ^ i * C ^ f) = + (((i : NatOrdinal) * beta + (f : NatOrdinal) * gamma : NatOrdinal) : + WithBot NatOrdinal) := by + rw [leadingGrade_mul_principalGraded, leadingGrade_mul_principalGraded, + leadingGrade_algebraMap_of_ne_zero ha, + leadingGrade_pow_principalGraded hB, leadingGrade_pow_principalGraded hC, + ← WithBot.coe_add, ← WithBot.coe_add, zero_add] + +/-- The two degrees of a homogenized relation agree. If `∑ i, k i * B ^ i * C ^ (d - i) = 0` with +top coefficient nonzero and `B`, `C` nonzero, then `B` and `C` have the same leading grade: +otherwise the term degrees would be pairwise distinct, so the term of largest degree could not be +cancelled and the sum could not vanish. -/ +theorem leadingGrade_eq_of_relation {B C : PrincipalSubring K} (hB : B ≠ 0) (hC : C ≠ 0) + {d : ℕ} (k : ℕ → K) (hkd : k d ≠ 0) + (hrel : ∑ i ∈ Finset.range (d + 1), + algebraMap K (PrincipalSubring K) (k i) * B ^ i * C ^ (d - i) = 0) : + DirectSum.leadingGrade (PrincipalComponent K) B = + DirectSum.leadingGrade (PrincipalComponent K) C := by + classical + obtain ⟨beta, hbeta⟩ := WithBot.ne_bot_iff_exists.mp + (fun hb ↦ hB ((DirectSum.leadingGrade_eq_bot_iff (PrincipalComponent K) B).mp hb)) + obtain ⟨gamma, hgamma⟩ := WithBot.ne_bot_iff_exists.mp + (fun hb ↦ hC ((DirectSum.leadingGrade_eq_bot_iff (PrincipalComponent K) C).mp hb)) + rw [← hbeta, ← hgamma] + by_contra hne + have hbg : beta ≠ gamma := fun h ↦ hne (by rw [h]) + obtain ⟨i₀, hi₀S, hi₀max⟩ := + ((Finset.range (d + 1)).filter fun i ↦ k i ≠ 0).exists_max_image + (fun i ↦ (i : NatOrdinal) * beta + ((d - i : ℕ) : NatOrdinal) * gamma) + ⟨d, Finset.mem_filter.mpr ⟨Finset.self_mem_range_succ d, hkd⟩⟩ + have hi₀range : i₀ ∈ Finset.range (d + 1) := (Finset.mem_filter.mp hi₀S).1 + have hk₀ : k i₀ ≠ 0 := (Finset.mem_filter.mp hi₀S).2 + have hgrade₀ := leadingGrade_relationTerm hk₀ hbeta.symm hgamma.symm i₀ (d - i₀) + have hg₀ : algebraMap K (PrincipalSubring K) (k i₀) * B ^ i₀ * C ^ (d - i₀) ≠ 0 := by + intro hzero + rw [hzero, DirectSum.leadingGrade_zero] at hgrade₀ + exact WithBot.coe_ne_bot hgrade₀.symm + have hsum := leadingGrade_finsetSum_eq_of_unique_max (Finset.range (d + 1)) + (fun i ↦ algebraMap K (PrincipalSubring K) (k i) * B ^ i * C ^ (d - i)) + hi₀range hg₀ (fun i hi hine ↦ ?_) + · rw [hrel, DirectSum.leadingGrade_zero, hgrade₀] at hsum + exact WithBot.coe_ne_bot hsum.symm + · by_cases hki : k i = 0 + · have hzero : algebraMap K (PrincipalSubring K) (k i) * B ^ i * C ^ (d - i) = 0 := by + rw [hki, map_zero, zero_mul, zero_mul] + rw [hzero, DirectSum.leadingGrade_zero, hgrade₀] + exact bot_lt_iff_ne_bot.mpr WithBot.coe_ne_bot + · rw [leadingGrade_relationTerm hki hbeta.symm hgamma.symm i (d - i), hgrade₀, + WithBot.coe_lt_coe] + refine lt_of_le_of_ne (hi₀max i (Finset.mem_filter.mpr ⟨hi, hki⟩)) ?_ + have hile : i ≤ d := Nat.lt_succ_iff.mp (Finset.mem_range.mp hi) + have hi₀le : i₀ ≤ d := Nat.lt_succ_iff.mp (Finset.mem_range.mp hi₀range) + exact natOrdinal_termDegree_ne hbg (by omega) hine + +/-! ### Homogenizing a split polynomial -/ + +/-- Scaling the roots of a product of monic linear factors and evaluating produces the +homogenized linear factors. This is the identity that turns the cleared relation into a product +over the roots of the minimal polynomial. -/ +theorem eval_scaleRoots_prod_X_sub_C {R : Type*} [CommRing R] [Nontrivial R] (s : Multiset R) + (b c : R) : + Polynomial.eval b + ((s.map fun z ↦ Polynomial.X - Polynomial.C z).prod.scaleRoots c) = + (s.map fun z ↦ b - z * c).prod := by + induction s using Multiset.induction with + | empty => simp + | cons z t ih => + have hmonic : (t.map fun z ↦ Polynomial.X - Polynomial.C z).prod.Monic := + Polynomial.monic_multiset_prod_of_monic t _ fun w _ ↦ Polynomial.monic_X_sub_C w + have hlead : (Polynomial.X - Polynomial.C z).leadingCoeff * + (t.map fun z ↦ Polynomial.X - Polynomial.C z).prod.leadingCoeff ≠ 0 := by + rw [(Polynomial.monic_X_sub_C z).leadingCoeff, hmonic.leadingCoeff, one_mul] + exact one_ne_zero + have hlin : (Polynomial.X - Polynomial.C z).scaleRoots c = + Polynomial.X - Polynomial.C (z * c) := by + have := Polynomial.X_add_C_scaleRoots (-z) c + rwa [map_neg, ← sub_eq_add_neg, neg_mul, map_neg, ← sub_eq_add_neg] at this + rw [Multiset.map_cons, Multiset.prod_cons, Polynomial.mul_scaleRoots' _ _ _ hlead, hlin, + Polynomial.eval_mul, ih, Multiset.map_cons, Multiset.prod_cons] + simp + +/-! ### Passing to leading terms -/ + +omit [CharZero K] in +/-- The leading term of a product is the product of the leading terms. Stated in the graded ring +itself rather than in its homogeneous components, so no grade casts appear. -/ +theorem of_apply_add_mul {x y : PrincipalSubring K} + {m n : NatOrdinal} + (hx : DirectSum.leadingGrade (PrincipalComponent K) x = (m : WithBot NatOrdinal)) + (hy : DirectSum.leadingGrade (PrincipalComponent K) y = (n : WithBot NatOrdinal)) : + DirectSum.of (PrincipalComponent K) (m + n) ((x * y) (m + n)) = + DirectSum.of (PrincipalComponent K) m (x m) * + DirectSum.of (PrincipalComponent K) n (y n) := by + rw [DirectSum.of_mul_of, DirectSum.mul_apply_add_eq_of_leadingGrade_eq _ hx hy] + +/-- The leading term of a power is the power of the leading term. -/ +theorem of_apply_pow {x : PrincipalSubring K} + {m : NatOrdinal} + (hx : DirectSum.leadingGrade (PrincipalComponent K) x = (m : WithBot NatOrdinal)) (i : ℕ) : + DirectSum.of (PrincipalComponent K) ((i : NatOrdinal) * m) + ((x ^ i) ((i : NatOrdinal) * m)) = + (DirectSum.of (PrincipalComponent K) m (x m)) ^ i := by + induction i with + | zero => + have h1 : (1 : PrincipalSubring K) 0 = GradedMonoid.GOne.one := by + rw [DirectSum.one_def, DirectSum.of_eq_same] + rw [pow_zero, pow_zero, Nat.cast_zero, zero_mul, h1] + exact (DirectSum.one_def (PrincipalComponent K)).symm + | succ i ih => + have hgrade : ((i + 1 : ℕ) : NatOrdinal) * m = (i : NatOrdinal) * m + m := by + push_cast; ring + have hshift : DirectSum.of (PrincipalComponent K) (((i + 1 : ℕ) : NatOrdinal) * m) + ((x ^ (i + 1)) (((i + 1 : ℕ) : NatOrdinal) * m)) = + DirectSum.of (PrincipalComponent K) ((i : NatOrdinal) * m + m) + ((x ^ (i + 1)) ((i : NatOrdinal) * m + m)) := + DirectSum.of_eq_of_gradedMonoid_eq (by rw [hgrade]) + rw [hshift, pow_succ, pow_succ, ← ih, + of_apply_add_mul (leadingGrade_pow_principalGraded hx i) hx] + +/-- The homogenized relation passes to the leading terms. Every term of the relation has leading +grade `d * beta`, so taking that component turns the relation into the same relation among the +homogeneous leading terms of `B` and `C`. -/ +theorem sum_leadingTerm_eq_zero + {B C : PrincipalSubring K} {beta : NatOrdinal} {d : ℕ} (k : ℕ → K) + (hB : DirectSum.leadingGrade (PrincipalComponent K) B = (beta : WithBot NatOrdinal)) + (hC : DirectSum.leadingGrade (PrincipalComponent K) C = (beta : WithBot NatOrdinal)) + (hrel : ∑ i ∈ Finset.range (d + 1), + algebraMap K (PrincipalSubring K) (k i) * B ^ i * C ^ (d - i) = 0) : + ∑ i ∈ Finset.range (d + 1), algebraMap K (PrincipalSubring K) (k i) * + (DirectSum.of (PrincipalComponent K) beta (B beta)) ^ i * + (DirectSum.of (PrincipalComponent K) beta (C beta)) ^ (d - i) = 0 := by + classical + have hterm : ∀ i ∈ Finset.range (d + 1), + DirectSum.of (PrincipalComponent K) ((d : NatOrdinal) * beta) + ((algebraMap K (PrincipalSubring K) (k i) * B ^ i * C ^ (d - i)) + ((d : NatOrdinal) * beta)) = + algebraMap K (PrincipalSubring K) (k i) * + (DirectSum.of (PrincipalComponent K) beta (B beta)) ^ i * + (DirectSum.of (PrincipalComponent K) beta (C beta)) ^ (d - i) := by + intro i hi + have hile : i ≤ d := Nat.lt_succ_iff.mp (Finset.mem_range.mp hi) + have hgr : (d : NatOrdinal) * beta = + (i : NatOrdinal) * beta + ((d - i : ℕ) : NatOrdinal) * beta := by + have : ((d : ℕ) : NatOrdinal) = ((i : ℕ) : NatOrdinal) + ((d - i : ℕ) : NatOrdinal) := by + rw [← Nat.cast_add] + congr 1 + omega + rw [this, add_mul] + have hshift : DirectSum.of (PrincipalComponent K) ((d : NatOrdinal) * beta) + ((B ^ i * C ^ (d - i)) ((d : NatOrdinal) * beta)) = + DirectSum.of (PrincipalComponent K) + ((i : NatOrdinal) * beta + ((d - i : ℕ) : NatOrdinal) * beta) + ((B ^ i * C ^ (d - i)) + ((i : NatOrdinal) * beta + ((d - i : ℕ) : NatOrdinal) * beta)) := + DirectSum.of_eq_of_gradedMonoid_eq (by rw [hgr]) + have hsmul : (algebraMap K (PrincipalSubring K) (k i) * (B ^ i * C ^ (d - i))) + ((d : NatOrdinal) * beta) = k i • ((B ^ i * C ^ (d - i)) ((d : NatOrdinal) * beta)) := by + rw [← Algebra.smul_def] + rfl + rw [mul_assoc, hsmul, DirectSum.of_smul, Algebra.smul_def, hshift, + of_apply_add_mul (leadingGrade_pow_principalGraded hB i) + (leadingGrade_pow_principalGraded hC (d - i)), + of_apply_pow hB, of_apply_pow hC, mul_assoc] + have hfinal : DirectSum.of (PrincipalComponent K) ((d : NatOrdinal) * beta) + ((∑ i ∈ Finset.range (d + 1), + algebraMap K (PrincipalSubring K) (k i) * B ^ i * C ^ (d - i)) + ((d : NatOrdinal) * beta)) = 0 := by + rw [hrel] + simp + rw [← Finset.sum_congr rfl hterm, ← map_sum, ← DFinsupp.finsetSum_apply] + exact hfinal + +/-! ### Descending to representatives -/ + +omit [CharZero K] in +/-- A power of a homogeneous class is the class of the power of a representative. The grade is +written with `nsmul`, for which the successor identity is definitional, so no grade cast +intervenes. -/ +theorem of_principalComponentMk_pow {beta : NatOrdinal} + (b : Series K) (hb : ordinalValue b < ω^ (beta + 1)) (i : ℕ) : + ∃ h : ordinalValue (b ^ i) < ω^ (i • beta + 1), + (DirectSum.of (PrincipalComponent K) beta (principalComponentMk beta b hb)) ^ i = + DirectSum.of (PrincipalComponent K) (i • beta) + (principalComponentMk (i • beta) (b ^ i) h) := by + induction i with + | zero => + have h0 : ordinalValue ((b : Series K) ^ 0) < ω^ ((0 : ℕ) • beta + 1) := by + rw [pow_zero, ordinalValue_one, zero_nsmul, zero_add] + simpa using NatOrdinal.wpow_lt_wpow.mpr (zero_lt_one : (0 : NatOrdinal) < 1) + refine ⟨h0, ?_⟩ + rw [pow_zero, DirectSum.one_def] + congr 1 + have hone : (GradedMonoid.GOne.one : PrincipalComponent K 0) = + (ordinalValueDegreeValuation K).componentOne := rfl + rw [hone, MaxAddDegree.componentOne_eq_componentMk] + simp only [pow_zero] + rw [principalComponentMk_eq_componentMk] + rfl + | succ i ih => + obtain ⟨hi, hstep⟩ := ih + have hbound : ordinalValue (b ^ (i + 1)) < ω^ ((i + 1) • beta + 1) := by + have h := ordinalValue_mul_lt_wpow_add_one hi hb + rwa [← pow_succ] at h + refine ⟨hbound, ?_⟩ + rw [pow_succ, hstep, DirectSum.of_mul_of] + congr 1 + rw [show (GradedMonoid.GMul.mul + (principalComponentMk (i • beta) (b ^ i) hi) + (principalComponentMk beta b hb)) = + principalComponentMul _ _ from + (principalComponentMul_eq_componentMul _ _).symm, + principalComponentMul_mk] + congr 1 + +omit [CharZero K] in +/-- A product of powers of two homogeneous classes is the class of the corresponding product of +representatives. -/ +theorem of_principalComponentMk_pow_mul_pow {beta : NatOrdinal} + (b c : Series K) (hb : ordinalValue b < ω^ (beta + 1)) (hc : ordinalValue c < ω^ (beta + 1)) + (i j : ℕ) : + ∃ h : ordinalValue (b ^ i * c ^ j) < ω^ (i • beta + j • beta + 1), + (DirectSum.of (PrincipalComponent K) beta (principalComponentMk beta b hb)) ^ i * + (DirectSum.of (PrincipalComponent K) beta (principalComponentMk beta c hc)) ^ j = + DirectSum.of (PrincipalComponent K) (i • beta + j • beta) + (principalComponentMk (i • beta + j • beta) (b ^ i * c ^ j) h) := by + obtain ⟨hi, hpi⟩ := of_principalComponentMk_pow b hb i + obtain ⟨hj, hpj⟩ := of_principalComponentMk_pow c hc j + refine ⟨ordinalValue_mul_lt_wpow_add_one hi hj, ?_⟩ + rw [hpi, hpj, DirectSum.of_mul_of] + congr 1 + rw [show (GradedMonoid.GMul.mul + (principalComponentMk (i • beta) (b ^ i) hi) + (principalComponentMk (j • beta) (c ^ j) hj)) = + principalComponentMul _ _ from + (principalComponentMul_eq_componentMul _ _).symm, + principalComponentMul_mk] + +omit [CharZero K] in +/-- The same statement with the grade presented in normalized form. -/ +theorem of_principalComponentMk_pow_mul_pow' {beta : NatOrdinal} + (b c : Series K) (hb : ordinalValue b < ω^ (beta + 1)) (hc : ordinalValue c < ω^ (beta + 1)) + (i j : ℕ) {p : NatOrdinal} (hp : i • beta + j • beta = p) : + ∃ h : ordinalValue (b ^ i * c ^ j) < ω^ (p + 1), + (DirectSum.of (PrincipalComponent K) beta (principalComponentMk beta b hb)) ^ i * + (DirectSum.of (PrincipalComponent K) beta (principalComponentMk beta c hc)) ^ j = + DirectSum.of (PrincipalComponent K) p + (principalComponentMk p (b ^ i * c ^ j) h) := by + subst hp + exact of_principalComponentMk_pow_mul_pow b c hb hc i j + +omit [CharZero K] in +/-- The class of a finite sum of representatives is the sum of the classes. -/ +theorem principalComponentMk_finsetSum {iota : Type*} + (s : Finset iota) (alpha : NatOrdinal) (u : iota → Series K) + (hu : ∀ i, ordinalValue (u i) < ω^ (alpha + 1)) + (hsum : ordinalValue (∑ i ∈ s, u i) < ω^ (alpha + 1)) : + ∑ i ∈ s, principalComponentMk alpha (u i) (hu i) = + principalComponentMk alpha (∑ i ∈ s, u i) hsum := by + classical + simp only [principalComponentMk_eq_componentMk] + rw [← map_sum] + congr 1 + apply Subtype.ext + rw [AddSubmonoidClass.coe_finsetSum] + +omit [CharZero K] in +/-- A finite sum of series each of ordinal value below a positive bound stays below that bound. -/ +theorem ordinalValue_finsetSum_lt {iota : Type*} (s : Finset iota) (u : iota → Series K) + {X : NatOrdinal} (hX : 0 < X) (hu : ∀ i ∈ s, ordinalValue (u i) < X) : + ordinalValue (∑ i ∈ s, u i) < X := by + classical + induction s using Finset.induction with + | empty => simpa using hX + | insert a t ha ih => + rw [Finset.sum_insert ha] + refine lt_of_le_of_lt (ordinalValue_add_le_max _ _) ?_ + exact max_lt (hu a (Finset.mem_insert_self a t)) + (ih fun i hi ↦ hu i (Finset.mem_insert_of_mem hi)) + +omit [CharZero K] in +/-- The relation among leading terms descends to a degree bound on the corresponding combination +of representatives. This is where the source argument's appeal to LM24, Lemma 4.2.5 is replaced +by the intrinsic homogeneous-component interface. -/ +theorem ordinalValue_relationSum_lt {beta : NatOrdinal} + {d : ℕ} (k : ℕ → K) (b c : Series K) + (hb : ordinalValue b < ω^ (beta + 1)) (hc : ordinalValue c < ω^ (beta + 1)) + (hrel : ∑ i ∈ Finset.range (d + 1), + algebraMap K (PrincipalSubring K) (k i) * + (DirectSum.of (PrincipalComponent K) beta (principalComponentMk beta b hb)) ^ i * + (DirectSum.of (PrincipalComponent K) beta (principalComponentMk beta c hc)) ^ (d - i) + = 0) : + ordinalValue (∑ i ∈ Finset.range (d + 1), + (HahnSeries.Nonpositive.C : K →+* Series K) (k i) * (b ^ i * c ^ (d - i))) < + ω^ (d • beta) := by + classical + have hterm : ∀ i ∈ Finset.range (d + 1), + ∃ h : ordinalValue ((HahnSeries.Nonpositive.C : K →+* Series K) (k i) * + (b ^ i * c ^ (d - i))) < ω^ (d • beta + 1), + algebraMap K (PrincipalSubring K) (k i) * + (DirectSum.of (PrincipalComponent K) beta (principalComponentMk beta b hb)) ^ i * + (DirectSum.of (PrincipalComponent K) beta (principalComponentMk beta c hc)) ^ (d - i) = + DirectSum.of (PrincipalComponent K) (d • beta) + (principalComponentMk (d • beta) + ((HahnSeries.Nonpositive.C : K →+* Series K) (k i) * (b ^ i * c ^ (d - i))) h) := by + intro i hi + have hile : i ≤ d := Nat.lt_succ_iff.mp (Finset.mem_range.mp hi) + have hp : i • beta + (d - i) • beta = d • beta := by + rw [← add_nsmul] + congr 1 + omega + obtain ⟨h1, e1⟩ := of_principalComponentMk_pow_mul_pow' b c hb hc i (d - i) hp + refine ⟨?_, ?_⟩ + · simpa only [zero_add] using + ordinalValue_mul_lt_wpow_add_one (ordinalValue_C_lt_wpow_one (k i)) h1 + · rw [mul_assoc, ← Algebra.smul_def, e1, ← DirectSum.of_smul K, smul_principalComponentMk] + have hupos : (0 : NatOrdinal) < ω^ (d • beta + 1) := + lt_of_lt_of_le zero_lt_one + (by rw [← NatOrdinal.wpow_zero]; exact NatOrdinal.wpow_le_wpow.mpr zero_le) + classical + set u : ℕ → Series K := fun i ↦ + if i ∈ Finset.range (d + 1) then + (HahnSeries.Nonpositive.C : K →+* Series K) (k i) * (b ^ i * c ^ (d - i)) else 0 with hu_def + have hu : ∀ i : ℕ, ordinalValue (u i) < ω^ (d • beta + 1) := by + intro i + by_cases hi : i ∈ Finset.range (d + 1) + · rw [hu_def] + simp only [hi, if_true] + exact (hterm i hi).choose + · rw [hu_def] + simp only [hi, if_false] + simp + have hu_eq : ∀ j ∈ Finset.range (d + 1), u j = + (HahnSeries.Nonpositive.C : K →+* Series K) (k j) * (b ^ j * c ^ (d - j)) := by + intro j hj + rw [hu_def] + simp only [hj, if_true] + have hcongr : ∑ i ∈ Finset.range (d + 1), + (HahnSeries.Nonpositive.C : K →+* Series K) (k i) * (b ^ i * c ^ (d - i)) = + ∑ i ∈ Finset.range (d + 1), u i := + Finset.sum_congr rfl fun i hi ↦ (hu_eq i hi).symm + have hsum : ordinalValue (∑ i ∈ Finset.range (d + 1), u i) < ω^ (d • beta + 1) := + ordinalValue_finsetSum_lt _ _ hupos fun i _ ↦ hu i + rw [hcongr, ← principalComponentMk_eq_zero_iff (d • beta) _ hsum, + ← principalComponentMk_finsetSum (Finset.range (d + 1)) (d • beta) u hu hsum] + apply DirectSum.of_injective (d • beta) + rw [map_zero, map_sum, ← hrel] + refine Finset.sum_congr rfl fun i hi ↦ ?_ + obtain ⟨h, e⟩ := hterm i hi + rw [e] + congr 1 + rw [principalComponentMk_eq_iff, hu_eq i hi, sub_self] + simp + +omit [CharZero K] in +/-- The homogenized relation sum is the scaled-roots evaluation of the polynomial pushed along a +ring homomorphism out of the coefficient field. -/ +theorem eval_scaleRoots_map {R : Type*} [CommRing R] [Nontrivial R] (g : K →+* R) + (p : Polynomial K) (b c : R) : + Polynomial.eval b ((p.map g).scaleRoots c) = + ∑ i ∈ Finset.range (p.natDegree + 1), + g (p.coeff i) * (b ^ i * c ^ (p.natDegree - i)) := by + have hdeg : (p.map g).natDegree = p.natDegree := + Polynomial.natDegree_map_eq_of_injective g.injective p + rw [Polynomial.eval_eq_sum_range' (by + rw [Polynomial.natDegree_scaleRoots, hdeg] + exact Nat.lt_succ_self _)] + refine Finset.sum_congr rfl fun i _ ↦ ?_ + rw [Polynomial.coeff_scaleRoots, Polynomial.coeff_map, hdeg] + ring + +omit [CharZero K] in +/-- Coefficient extension carries the homogenized relation sum of a polynomial to that of the +extended polynomial. -/ +theorem map_relationSum {E : Type v} [Field E] (f : K →+* E) (p : Polynomial K) (b c : Series K) + (n : ℕ) : + nonpositiveCoefficientMap f + (∑ i ∈ Finset.range (n + 1), + (HahnSeries.Nonpositive.C : K →+* Series K) (p.coeff i) * (b ^ i * c ^ (n - i))) = + ∑ i ∈ Finset.range (n + 1), + (HahnSeries.Nonpositive.C : E →+* Series E) ((p.map f).coeff i) * + ((nonpositiveCoefficientMap f b) ^ i * (nonpositiveCoefficientMap f c) ^ (n - i)) := by + rw [map_sum] + refine Finset.sum_congr rfl fun i _ ↦ ?_ + rw [map_mul, map_mul, map_pow, map_pow, nonpositiveCoefficientMap_C, Polynomial.coeff_map] + +/-! ### Pigeonhole on the factor degrees -/ + +/-- If a product of ordinal-value-multiplicative factors has ordinal value below `ω ^ (n * beta)`, +where `n` is the number of factors, then some factor has ordinal value below `ω ^ beta`. -/ +theorem exists_ordinalValue_lt_of_prod_lt {E : Type v} [Field E] [CharZero E] + (s : Multiset (Series E)) (beta : NatOrdinal) + (h : ordinalValue s.prod < ω^ ((s.card : NatOrdinal) * beta)) : + ∃ u ∈ s, ordinalValue u < ω^ beta := by + by_contra hcon + simp only [not_exists, not_and, not_lt] at hcon + have key : ∀ t : Multiset (Series E), (∀ u ∈ t, ω^ beta ≤ ordinalValue u) → + ω^ ((t.card : NatOrdinal) * beta) ≤ ordinalValue t.prod := by + intro t + induction t using Multiset.induction with + | empty => intro _; simp [ordinalValue_one] + | cons a u ih => + intro hall + rw [Multiset.prod_cons, ordinalValueMultiplicative.ordinalValue_mul, Multiset.card_cons] + push_cast + rw [add_mul, one_mul, NatOrdinal.wpow_add, mul_comm] + exact mul_le_mul' (hall a (Multiset.mem_cons_self a u)) + (ih fun v hv ↦ hall v (Multiset.mem_cons_of_mem hv)) + exact absurd (key s hcon) (not_le.mpr h) + +/-! ### Rationality of a root read off a single exponent -/ + +/-- The single-exponent rationality step. If, after extending the coefficients along `f`, +subtracting `zeta` times `c` from `b` strictly lowers the ordinal value below that of `b`, then some +exponent must cancel, and at that exponent `zeta` is the ratio of a coefficient of `b` by a +coefficient of `c`. Hence `zeta` lies in the range of `f`. + +This is the step of the source argument that returns a root of the minimal polynomial from the +algebraic closure of the coefficient field to the coefficient field itself. -/ +theorem mem_range_of_ordinalValue_sub_C_mul_lt {K E : Type v} [Field K] [Field E] (f : K →+* E) + (b c : HahnSeries.Nonpositive ℝ K) (zeta : E) + (h : ordinalValue (nonpositiveCoefficientMap f b - + HahnSeries.Nonpositive.C zeta * nonpositiveCoefficientMap f c) < + ordinalValue (nonpositiveCoefficientMap f b)) : + zeta ∈ f.range := by + by_contra hzeta + refine absurd (ordinalValue_le_of_support_subset _ _ ?_) (not_le.mpr h) + intro x hx + rw [HahnSeries.mem_support] at hx ⊢ + rw [coe_nonpositiveCoefficientMap] at hx + intro hzero + apply hzeta + rw [AddSubgroupClass.coe_sub, HahnSeries.coeff_sub, Subring.coe_mul, + HahnSeries.Nonpositive.coe_C, HahnSeries.C_mul_eq_smul, HahnSeries.coeff_smul, + coe_nonpositiveCoefficientMap, coe_nonpositiveCoefficientMap, smul_eq_mul, + sub_eq_zero] at hzero + have hcx : f ((c : K⟦ℝ⟧).coeff x) ≠ 0 := by + intro hc0 + rw [hc0, mul_zero] at hzero + exact hx hzero + rw [RingHom.mem_range] + refine ⟨(b : K⟦ℝ⟧).coeff x / (c : K⟦ℝ⟧).coeff x, ?_⟩ + rw [map_div₀, hzero, mul_div_assoc, div_self hcx, mul_one] + +/-! ### A root in the coefficient field -/ + +/-- If the homogenized relation sum of a monic polynomial at two representatives has strictly +smaller degree than the product of the degrees, the polynomial already has a root in the +coefficient field. The source argument factors over the algebraic closure; the ordinal value is +multiplicative there because the multiplicativity theorem is field-polymorphic. -/ +theorem exists_isRoot_of_ordinalValue_relationSum_lt {beta : NatOrdinal} {d : ℕ} + (Q : Polynomial K) (hQ : Q.Monic) (hdeg : Q.natDegree = d) (b c : Series K) + (hbdeg : ω^ beta ≤ ordinalValue b) + (hlt : ordinalValue (∑ i ∈ Finset.range (d + 1), + (HahnSeries.Nonpositive.C : K →+* Series K) (Q.coeff i) * (b ^ i * c ^ (d - i))) < + ω^ (d • beta)) : + ∃ z : K, Q.IsRoot z := by + classical + set f : K →+* AlgebraicClosure K := algebraMap K (AlgebraicClosure K) with hf + have hQLmonic : (Q.map f).Monic := hQ.map f + have hQLdeg : (Q.map f).natDegree = d := by + rw [Polynomial.natDegree_map_eq_of_injective f.injective, hdeg] + have hsplits : Polynomial.Splits (Q.map f) := IsAlgClosed.splits _ + have hprod : Q.map f = ((Q.map f).roots.map fun z ↦ Polynomial.X - Polynomial.C z).prod := + hsplits.eq_prod_roots_of_monic hQLmonic + have hcard : (Q.map f).roots.card = d := by + rw [← hQLdeg] + exact Polynomial.splits_iff_card_roots.mp hsplits + have hsum_eq : nonpositiveCoefficientMap f + (∑ i ∈ Finset.range (d + 1), + (HahnSeries.Nonpositive.C : K →+* Series K) (Q.coeff i) * (b ^ i * c ^ (d - i))) = + ((Q.map f).roots.map fun z ↦ + nonpositiveCoefficientMap f b - + (HahnSeries.Nonpositive.C : AlgebraicClosure K →+* Series (AlgebraicClosure K)) z * + nonpositiveCoefficientMap f c).prod := by + rw [map_relationSum, ← hQLdeg, ← eval_scaleRoots_map] + conv_lhs => rw [hprod] + rw [Polynomial.map_multiset_prod, Multiset.map_map] + have hlin : ∀ z : AlgebraicClosure K, + ((fun q : Polynomial (AlgebraicClosure K) ↦ + q.map (HahnSeries.Nonpositive.C : AlgebraicClosure K →+* Series (AlgebraicClosure K))) + ∘ fun z ↦ Polynomial.X - Polynomial.C z) z = + Polynomial.X - Polynomial.C ((HahnSeries.Nonpositive.C : + AlgebraicClosure K →+* Series (AlgebraicClosure K)) z) := by + intro z + simp + rw [Multiset.map_congr rfl fun z _ ↦ hlin z] + rw [show (Multiset.map (fun z ↦ Polynomial.X - Polynomial.C + ((HahnSeries.Nonpositive.C : AlgebraicClosure K →+* Series (AlgebraicClosure K)) z)) + (Q.map f).roots) = + Multiset.map (fun w ↦ Polynomial.X - Polynomial.C w) + (Multiset.map (HahnSeries.Nonpositive.C : + AlgebraicClosure K →+* Series (AlgebraicClosure K)) (Q.map f).roots) from + by rw [Multiset.map_map]; rfl, + eval_scaleRoots_prod_X_sub_C, Multiset.map_map] + rfl + have hprodlt : ordinalValue (((Q.map f).roots.map fun z ↦ + nonpositiveCoefficientMap f b - + (HahnSeries.Nonpositive.C : AlgebraicClosure K →+* Series (AlgebraicClosure K)) z * + nonpositiveCoefficientMap f c).prod) < + ω^ ((((Q.map f).roots.map fun z ↦ + nonpositiveCoefficientMap f b - + (HahnSeries.Nonpositive.C : AlgebraicClosure K →+* Series (AlgebraicClosure K)) z * + nonpositiveCoefficientMap f c).card : NatOrdinal) * beta) := by + rw [← hsum_eq, ordinalValue_nonpositiveCoefficientMap, Multiset.card_map, hcard, + ← nsmul_eq_mul] + exact hlt + obtain ⟨w, hw_mem, hw_lt⟩ := exists_ordinalValue_lt_of_prod_lt _ beta hprodlt + obtain ⟨z, hz_mem, rfl⟩ := Multiset.mem_map.mp hw_mem + have hzrange : z ∈ f.range := by + refine mem_range_of_ordinalValue_sub_C_mul_lt f b c z (lt_of_lt_of_le hw_lt ?_) + rw [ordinalValue_nonpositiveCoefficientMap] + exact hbdeg + obtain ⟨z₀, hz₀⟩ := hzrange + refine ⟨z₀, ?_⟩ + have hroot : (Q.map f).IsRoot z := Polynomial.isRoot_of_mem_roots hz_mem + rw [Polynomial.IsRoot, Polynomial.eval_map, ← hz₀, Polynomial.eval₂_at_apply] at hroot + exact f.injective (by rw [hroot, map_zero]) + +/-! ### Clearing denominators -/ + +local instance principalSubringFractionSelfAlgebraLocal : + Algebra (PrincipalSubring K) (PrincipalSubringFractionField K) := + principalSubringFractionSelfAlgebra K + +local instance principalSubringFractionIsFractionRingLocal : + IsFractionRing (PrincipalSubring K) (PrincipalSubringFractionField K) := + IsFractionRing.of_algEquiv (principalSubringFractionAlgEquiv K) + +local instance principalSubringFractionAlgebraLocal : + Algebra K (PrincipalSubringFractionField K) := + principalSubringFractionAlgebra K + +/-- Clearing denominators in an algebraic relation satisfied by a nonzero fraction. -/ +theorem exists_relation_of_aeval_eq_zero (Q : Polynomial K) + {x : PrincipalSubringFractionField K} (hQ : Polynomial.aeval x Q = 0) (hx0 : x ≠ 0) : + ∃ B C : PrincipalSubring K, B ≠ 0 ∧ C ≠ 0 ∧ + ∑ i ∈ Finset.range (Q.natDegree + 1), + algebraMap K (PrincipalSubring K) (Q.coeff i) * B ^ i * + C ^ (Q.natDegree - i) = 0 := by + haveI : IsScalarTower K (PrincipalSubring K) (PrincipalSubringFractionField K) := + principalSubringFraction_isScalarTower K + have hinj : Function.Injective + (algebraMap (PrincipalSubring K) (PrincipalSubringFractionField K)) := + IsFractionRing.injective _ _ + obtain ⟨⟨B, C⟩, hBC⟩ := + IsLocalization.surj (nonZeroDivisors (PrincipalSubring K)) x + have hCne : (C : PrincipalSubring K) ≠ 0 := nonZeroDivisors.coe_ne_zero C + have hmapC : algebraMap (PrincipalSubring K) (PrincipalSubringFractionField K) + (C : PrincipalSubring K) ≠ 0 := fun h ↦ hCne (hinj (by rw [h, map_zero])) + have hdiv : x = + algebraMap (PrincipalSubring K) (PrincipalSubringFractionField K) B / + algebraMap (PrincipalSubring K) (PrincipalSubringFractionField K) + (C : PrincipalSubring K) := + eq_div_of_mul_eq hmapC hBC + have hBne : B ≠ 0 := by + intro hB + exact hx0 (by rw [hdiv, hB, map_zero, zero_div]) + refine ⟨B, (C : PrincipalSubring K), hBne, hCne, ?_⟩ + have haeval : Polynomial.aeval + (algebraMap (PrincipalSubring K) (PrincipalSubringFractionField K) B / + algebraMap (PrincipalSubring K) (PrincipalSubringFractionField K) + (C : PrincipalSubring K)) + (Q.map (algebraMap K (PrincipalSubring K))) = 0 := by + rw [Polynomial.aeval_map_algebraMap, ← hdiv] + exact hQ + have hsr := Polynomial.scaleRoots_aeval_eq_zero_of_aeval_div_eq_zero hinj haeval C.2 + have hmapped : algebraMap (PrincipalSubring K) (PrincipalSubringFractionField K) + (Polynomial.eval B ((Q.map (algebraMap K (PrincipalSubring K))).scaleRoots + (C : PrincipalSubring K))) = 0 := by + rw [← hsr, Polynomial.aeval_def, Polynomial.eval₂_at_apply] + have heval : Polynomial.eval B ((Q.map (algebraMap K (PrincipalSubring K))).scaleRoots + (C : PrincipalSubring K)) = 0 := hinj (by rw [hmapped, map_zero]) + rw [eval_scaleRoots_map] at heval + rw [← heval] + refine Finset.sum_congr rfl fun i _ ↦ ?_ + ring + +/-! ### The minimal-polynomial bound -/ + +/-- LM24, Lemma 6.3.3: a nonzero element of the fraction field of `P̂` that +is algebraic over the coefficient field has minimal polynomial of degree at most one. -/ +theorem principalSubringFraction_minpoly_natDegree_le_one_of_ne_zero (x : + PrincipalSubringFractionField K) + (hx : IsAlgebraic K x) (hx0 : x ≠ 0) : + (minpoly K x).natDegree ≤ 1 := by + classical + have hint : IsIntegral K x := hx.isIntegral + have hQmonic : (minpoly K x).Monic := minpoly.monic hint + have hcd : (minpoly K x).coeff (minpoly K x).natDegree ≠ 0 := by + rw [hQmonic.coeff_natDegree] + exact one_ne_zero + obtain ⟨B, C, hB, hC, hrel⟩ := + exists_relation_of_aeval_eq_zero (minpoly K x) (minpoly.aeval K x) hx0 + have hgr := leadingGrade_eq_of_relation hB hC (fun i ↦ (minpoly K x).coeff i) hcd hrel + obtain ⟨m, hm, hBm⟩ := DirectSum.exists_grade_eq_leadingGrade (PrincipalComponent K) hB + have hCm : DirectSum.leadingGrade (PrincipalComponent K) C = (m : WithBot NatOrdinal) := by + rw [← hgr, hm] + obtain ⟨b, hb, hbeq⟩ := exists_principalComponentMk m (B m) + obtain ⟨c, hc, hceq⟩ := exists_principalComponentMk m (C m) + have hlead := sum_leadingTerm_eq_zero (fun i ↦ (minpoly K x).coeff i) hm hCm hrel + rw [← hbeq, ← hceq] at hlead + have hlt := ordinalValue_relationSum_lt (fun i ↦ (minpoly K x).coeff i) b c hb hc hlead + have hbdeg : ω^ m ≤ ordinalValue b := by + by_contra hcon + exact hBm (by rw [← hbeq, principalComponentMk_eq_zero_iff]; exact not_le.mp hcon) + obtain ⟨z, hz⟩ := + exists_isRoot_of_ordinalValue_relationSum_lt (minpoly K x) hQmonic rfl b c hbdeg hlt + obtain ⟨u, hu⟩ := Polynomial.dvd_iff_isRoot.mpr hz + rcases (minpoly.irreducible hint).isUnit_or_isUnit hu with hunit | hunit + · exact absurd hunit (Polynomial.not_isUnit_X_sub_C z) + · have hune : u ≠ 0 := hunit.ne_zero + rw [hu, Polynomial.natDegree_mul (Polynomial.X_sub_C_ne_zero z) hune, + Polynomial.natDegree_X_sub_C, Polynomial.natDegree_eq_zero_of_isUnit hunit] + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringLocalization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringLocalization.lean new file mode 100644 index 0000000000..4d7072011f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringLocalization.lean @@ -0,0 +1,411 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarTensor + +import Mathlib.RingTheory.TensorProduct.Maps +import Mathlib.RingTheory.Flat.Domain + +/-! +# Localization of the degree-graded ring + +Let `P̂` be the subring of principal elements and let `RV̂` be the degree-graded ring. +Using the tensor decomposition `RV̂ ≃ P̂ ⊗[K] K(ℝ^{≤ 0})`, extension of the principal +factor to `Frac(P̂)` gives the canonical map + +`RV̂ → Frac(P̂)(ℝ^{≤ 0})`. + +The two evaluation theorems identify its restrictions to the finite-support and principal graded +factors. They are the concrete form of the localization identification used in LM24, Corollary +6.3.6. +-/ + +open scoped HahnSeries TensorProduct + +universe v + +namespace Berarducci + +public noncomputable section + +open HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +local instance principalSubringFractionAlgebraLocalization : + Algebra K (PrincipalSubringFractionField K) := + principalSubringFractionAlgebra K + +variable (K) in +/-- Extend the principal factor of `P̂ ⊗[K] K(ℝ^{≤ 0})` to `Frac(P̂)` while leaving the +finite-support factor unchanged. -/ +def principalSubringTensorToFractionTensor : + PrincipalSubring K ⊗[K] FiniteSupportRing (K := K) →ₐ[K] + PrincipalSubringFractionField K ⊗[K] FiniteSupportRing (K := K) := by + letI : Algebra (PrincipalSubring K) + (PrincipalSubringFractionField K) := + principalSubringFractionSelfAlgebra K + letI : IsScalarTower K (PrincipalSubring K) + (PrincipalSubringFractionField K) := + principalSubringFraction_isScalarTower K + exact Algebra.TensorProduct.map + (IsScalarTower.toAlgHom K (PrincipalSubring K) + (PrincipalSubringFractionField K)) + (AlgHom.id K (FiniteSupportRing (K := K))) + +/-- Extension of the principal tensor factor sends a pure tensor to the tensor of the canonical +fraction-field image and the unchanged finite-support factor. -/ +@[simp] +theorem principalSubringTensorToFractionTensor_tmul + (x : PrincipalSubring K) (p : FiniteSupportRing (K := K)) : + principalSubringTensorToFractionTensor K (x ⊗ₜ p) = + principalSubringToFraction K x ⊗ₜ p := by + rw [principalSubringTensorToFractionTensor, Algebra.TensorProduct.map_tmul] + congr 1 + exact (principalSubringToFraction_apply x).symm + +variable (K) in +/-- The canonical map from the degree-graded ring `RV̂` to finite-support series over +`Frac(P̂)`. -/ +def principalSubringLocalizationMap : + DegreeGraded K →+* + PrincipalSubringFractionFiniteSupportRing K := by + let e := HahnSeries.Nonpositive.finiteSupportScalarTensorEquiv + (G := ℝ) (K := K) (L := PrincipalSubringFractionField K) + let f := principalSubringTensorToFractionTensor K + let g := (principalSubringTensorEquiv K).symm + exact e.toRingEquiv.toRingHom.comp (f.toRingHom.comp g.toRingEquiv.toRingHom) + +/-- The graded localization map is the composite of the inverse tensor decomposition, extension +of the principal factor to its fraction field, and finite-support scalar base change. -/ +theorem principalSubringLocalizationMap_apply (x : DegreeGraded K) : + principalSubringLocalizationMap K x = + HahnSeries.Nonpositive.finiteSupportScalarTensorEquiv + (G := ℝ) (K := K) (L := PrincipalSubringFractionField K) + (principalSubringTensorToFractionTensor K + ((principalSubringTensorEquiv K).symm x)) := + (rfl) + +/-- The graded localization map restricts to coefficientwise scalar extension on the +finite-support factor. -/ +theorem principalSubringLocalizationMap_finiteSupport (p : FiniteSupportRing (K := K)) : + principalSubringLocalizationMap K + (finiteSupportGradedEmbedding K p) = + principalSubringFractionScalarExtension K p := by + rw [principalSubringLocalizationMap_apply, + principalSubringTensorEquiv_symm_finiteSupportGradedEmbedding, + principalSubringTensorToFractionTensor_tmul, + HahnSeries.Nonpositive.finiteSupportScalarTensorEquiv_tmul] + rw [(principalSubringToFraction K).map_one, + (HahnSeries.Nonpositive.finiteSupportScalarHom + (G := ℝ) (K := PrincipalSubringFractionField K)).map_one, + one_mul] + apply HahnSeries.Nonpositive.finiteSupportFinsuppEquiv.injective + ext g + rw [HahnSeries.Nonpositive.finiteSupportFinsuppEquiv_apply, + HahnSeries.Nonpositive.finiteSupportFinsuppEquiv_apply] + rw [HahnSeries.Nonpositive.finiteSupportScalarExtension_coeff, + principalSubringFractionScalarExtension_coeff] + rw [principalSubringFraction_algebraMap_apply, + principalSubringFractionCoefficientMap_apply] + +/-- The graded localization map sends the principal factor to the corresponding constant series +over `Frac(P̂)`. -/ +@[simp] +theorem principalSubringLocalizationMap_principal (x : PrincipalSubring K) : + principalSubringLocalizationMap K + (principalSubringEmbedding K x) = + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) + (principalSubringToFraction K x) := by + rw [principalSubringLocalizationMap_apply, + principalSubringTensorEquiv_symm_principalGradedEmbedding, + principalSubringTensorToFractionTensor_tmul, + HahnSeries.Nonpositive.finiteSupportScalarTensorEquiv_tmul] + change HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) + (principalSubringToFraction K x) * + HahnSeries.Nonpositive.finiteSupportScalarExtension 1 = _ + rw [map_one, mul_one] + +variable (K) in +/-- The submonoid of nonzero principal graded factors inverted by the graded localization map. -/ +def principalSubringDenominators : + Submonoid (DegreeGraded K) := + (nonZeroDivisors (PrincipalSubring K)).map + (principalSubringEmbedding K).toRingHom + +/-- A graded element is a localization denominator exactly when it is the image of a nonzero +principal graded element. -/ +theorem mem_principalGradedDenominators_iff (x : DegreeGraded K) : + x ∈ principalSubringDenominators K ↔ + ∃ y : PrincipalSubring K, + y ≠ 0 ∧ principalSubringEmbedding K y = x := by + rw [principalSubringDenominators] + constructor + · rintro ⟨y, hy, rfl⟩ + exact ⟨y, (mem_nonZeroDivisors_iff_ne_zero.mp hy), rfl⟩ + · rintro ⟨y, hy, rfl⟩ + exact ⟨y, mem_nonZeroDivisors_iff_ne_zero.mpr hy, rfl⟩ + +/-- The canonical algebra structure induced by the graded localization map. -/ +noncomputable instance principalSubringLocalizationAlgebra : + Algebra (DegreeGraded K) + (PrincipalSubringFractionFiniteSupportRing K) := + (principalSubringLocalizationMap K).toAlgebra + +/-- The algebra map of the graded localization is the explicitly constructed localization map. -/ +@[simp] +theorem principalSubringLocalization_algebraMap_apply (x : DegreeGraded K) : + algebraMap (DegreeGraded K) + (PrincipalSubringFractionFiniteSupportRing K) x = + principalSubringLocalizationMap K x := + (rfl) + +variable (K) in +private abbrev PrincipalTensor := + PrincipalSubring K ⊗[K] FiniteSupportRing (K := K) + +variable (K) in +private abbrev FractionTensor := + PrincipalSubringFractionField K ⊗[K] FiniteSupportRing (K := K) + +local instance principalSubringFractionSelfAlgebraLocalization : + Algebra (PrincipalSubring K) (PrincipalSubringFractionField K) := + principalSubringFractionSelfAlgebra K + +local instance principalSubringFractionScalarTowerLocalization : + IsScalarTower K (PrincipalSubring K) + (PrincipalSubringFractionField K) := + principalSubringFraction_isScalarTower K + +local instance principalSubringFractionIsLocalizationLocalization : + IsFractionRing (PrincipalSubring K) + (PrincipalSubringFractionField K) := + IsFractionRing.of_algEquiv (principalSubringFractionAlgEquiv K) + +attribute [local instance 1100] Module.Free.of_divisionRing Module.Flat.of_free in +variable (K) in +/-- Extending the principal tensor factor to `Frac(P̂)` is injective. -/ +theorem principalSubringTensorToFractionTensor_injective : + Function.Injective (principalSubringTensorToFractionTensor K) := by + change Function.Injective + (TensorProduct.map + (IsScalarTower.toAlgHom K (PrincipalSubring K) + (PrincipalSubringFractionField K)).toLinearMap + (AlgHom.id K (FiniteSupportRing (K := K))).toLinearMap) + apply TensorProduct.map_injective_of_flat_flat + · intro x y hxy + apply principalSubringToFraction_injective K + calc + principalSubringToFraction K x = + (IsScalarTower.toAlgHom K (PrincipalSubring K) + (PrincipalSubringFractionField K)) x := + principalSubringToFraction_apply x + _ = (IsScalarTower.toAlgHom K (PrincipalSubring K) + (PrincipalSubringFractionField K)) y := hxy + _ = principalSubringToFraction K y := + (principalSubringToFraction_apply y).symm + · exact Function.injective_id + +/-- The canonical map from the degree-graded ring `RV̂` to its principal localization is +injective. -/ +theorem principalSubringLocalizationMap_injective {x y : DegreeGraded K} + (hxy : principalSubringLocalizationMap K x = + principalSubringLocalizationMap K y) : + x = y := by + apply (principalSubringTensorEquiv K).symm.injective + apply principalSubringTensorToFractionTensor_injective K + apply (HahnSeries.Nonpositive.finiteSupportScalarTensorEquiv + (G := ℝ) (K := K) (L := PrincipalSubringFractionField K)).injective + calc + _ = principalSubringLocalizationMap K x := + (principalSubringLocalizationMap_apply x).symm + _ = principalSubringLocalizationMap K y := hxy + _ = _ := principalSubringLocalizationMap_apply y + +private instance principalTensorFractionTensorAlgebra : + Algebra (PrincipalTensor K) (FractionTensor K) := + (principalSubringTensorToFractionTensor K).toAlgebra + +private instance principalTensorPrincipalAlgebra : + Algebra (PrincipalSubring K) (PrincipalTensor K) := + inferInstance + +private instance fractionTensorPrincipalAlgebra : + Algebra (PrincipalSubring K) (FractionTensor K) := + inferInstance + +private instance principalTensorPrincipalSMul : + SMul (PrincipalSubring K) (PrincipalTensor K) := + principalTensorPrincipalAlgebra.toSMul + +private instance fractionTensorPrincipalSMul : + SMul (PrincipalSubring K) (FractionTensor K) := + fractionTensorPrincipalAlgebra.toSMul + +private instance principalTensorFractionTensorTower : + IsScalarTower (PrincipalSubring K) + (PrincipalTensor K) (FractionTensor K) := by + apply IsScalarTower.of_algebraMap_eq + intro x + change principalSubringTensorToFractionTensor K + (algebraMap (PrincipalSubring K) (PrincipalTensor K) x) = + algebraMap (PrincipalSubring K) (FractionTensor K) x + change principalSubringTensorToFractionTensor K (x ⊗ₜ 1) = _ + rw [principalSubringTensorToFractionTensor_tmul] + simp + +variable (K) in +private def principalTensorDenominators : Submonoid (PrincipalTensor K) := + Algebra.algebraMapSubmonoid (PrincipalTensor K) + (nonZeroDivisors (PrincipalSubring K)) + +private instance fractionTensorIsLocalization : + IsLocalization (principalTensorDenominators K) (FractionTensor K) := by + apply IsLocalization.tensorProduct_tensorProduct K + (FiniteSupportRing (K := K)) + (nonZeroDivisors (PrincipalSubring K)) + (PrincipalSubringFractionField K) + ext p + change principalSubringTensorToFractionTensor K (1 ⊗ₜ p) = 1 ⊗ₜ p + rw [principalSubringTensorToFractionTensor_tmul] + simp + +variable (K) in +private theorem principalSubringDenominators_eq_map : + principalSubringDenominators K = + (principalTensorDenominators K).map + (principalSubringTensorEquiv K).toRingEquiv.toMonoidHom := by + ext z + constructor + · rintro ⟨x, hx, rfl⟩ + refine ⟨algebraMap (PrincipalSubring K) (PrincipalTensor K) x, ?_, ?_⟩ + · exact ⟨x, hx, rfl⟩ + · change principalSubringTensorEquiv K (x ⊗ₜ 1) = + principalSubringEmbedding K x + exact principalSubringTensorEquiv_tmul_one x + · rintro ⟨_, ⟨x, hx, rfl⟩, rfl⟩ + refine ⟨x, hx, ?_⟩ + change principalSubringEmbedding K x = + principalSubringTensorEquiv K (x ⊗ₜ 1) + exact (principalSubringTensorEquiv_tmul_one x).symm + +private instance gradedFractionTensorAlgebra : + Algebra (DegreeGraded K) (FractionTensor K) := + ((algebraMap (PrincipalTensor K) (FractionTensor K)).comp + (principalSubringTensorEquiv K).symm.toRingEquiv.toRingHom).toAlgebra + +private instance gradedFractionTensorIsLocalization : + IsLocalization (principalSubringDenominators K) (FractionTensor K) := by + rw [principalSubringDenominators_eq_map] + exact IsLocalization.isLocalization_of_base_ringEquiv + (principalTensorDenominators K) (FractionTensor K) + (principalSubringTensorEquiv K).toRingEquiv + +variable (K) in +private def fractionTensorFiniteSupportAlgEquiv : + FractionTensor K ≃ₐ[DegreeGraded K] + PrincipalSubringFractionFiniteSupportRing K where + toRingEquiv := + (HahnSeries.Nonpositive.finiteSupportScalarTensorEquiv + (G := ℝ) (K := K) (L := PrincipalSubringFractionField K)).toRingEquiv + commutes' _ := rfl + +/-- Finite-support series over `Frac(P̂)` are the localization of the degree-graded ring `RV̂` at +the nonzero principal graded factors. -/ +noncomputable instance principalSubringLocalizationIsLocalization : + IsLocalization (principalSubringDenominators K) + (PrincipalSubringFractionFiniteSupportRing K) := + IsLocalization.isLocalization_of_algEquiv + (principalSubringDenominators K) + (fractionTensorFiniteSupportAlgEquiv K) + +/-- Every element of the graded localization has a numerator in `RV̂` and a nonzero principal +graded denominator. The equation is the denominator-cleared form of `z = x / d`. -/ +theorem principalSubringLocalization_exists_mul_principalDenominator + (z : PrincipalSubringFractionFiniteSupportRing K) : + ∃ x : DegreeGraded K, + ∃ d : PrincipalSubring K, + d ≠ 0 ∧ + z * principalSubringLocalizationMap K + (principalSubringEmbedding K d) = + principalSubringLocalizationMap K x := by + obtain ⟨⟨x, s⟩, hs⟩ := + IsLocalization.surj (principalSubringDenominators K) z + obtain ⟨d, hd, hds⟩ := + (mem_principalGradedDenominators_iff (s : DegreeGraded K)).mp s.2 + refine ⟨x, d, hd, ?_⟩ + rw [hds] + simpa only [principalSubringLocalization_algebraMap_apply] using hs + +/-- A localized divisibility relation by an embedded finite-support series can be cleared by a +nonzero principal graded denominator. -/ +theorem principalSubringLocalization_exists_finiteSupport_dvd_mul_principal + {p : FiniteSupportRing (K := K)} + {B : DegreeGraded K} + (hp : principalSubringFractionScalarExtension K p ∣ + principalSubringLocalizationMap K B) : + ∃ X : DegreeGraded K, + ∃ d : PrincipalSubring K, + d ≠ 0 ∧ + B * principalSubringEmbedding K d = + finiteSupportGradedEmbedding K p * X := by + obtain ⟨z, hz⟩ := hp + obtain ⟨X, d, hd, hclear⟩ := + principalSubringLocalization_exists_mul_principalDenominator z + refine ⟨X, d, hd, ?_⟩ + apply principalSubringLocalizationMap_injective + calc + principalSubringLocalizationMap K + (B * principalSubringEmbedding K d) = + principalSubringLocalizationMap K B * + principalSubringLocalizationMap K + (principalSubringEmbedding K d) := + (principalSubringLocalizationMap K).map_mul _ _ + _ = (principalSubringFractionScalarExtension K p * z) * + principalSubringLocalizationMap K + (principalSubringEmbedding K d) := by + rw [hz] + _ = principalSubringFractionScalarExtension K p * + (z * principalSubringLocalizationMap K + (principalSubringEmbedding K d)) := + mul_assoc _ _ _ + _ = principalSubringFractionScalarExtension K p * + principalSubringLocalizationMap K X := by + rw [hclear] + _ = principalSubringLocalizationMap K + (finiteSupportGradedEmbedding K p) * + principalSubringLocalizationMap K X := by + rw [principalSubringLocalizationMap_finiteSupport] + _ = principalSubringLocalizationMap K + (finiteSupportGradedEmbedding K p * X) := + ((principalSubringLocalizationMap K).map_mul _ _).symm + +/-- The graded localization map preserves divisibility by an embedded finite-support series. -/ +theorem principalSubringLocalizationMap_finiteSupport_dvd {p : FiniteSupportRing (K := K)} + {B : DegreeGraded K} + (hp : finiteSupportGradedEmbedding K p ∣ B) : + principalSubringFractionScalarExtension K p ∣ + principalSubringLocalizationMap K B := by + simpa only [principalSubringLocalizationMap_finiteSupport] using + map_dvd (principalSubringLocalizationMap K) hp + +/-- The localization image of an embedded finite-support divisor of a product divides the +product of the two localization images. -/ +theorem principalSubringLocalizationMap_finiteSupport_dvd_mul {p : FiniteSupportRing (K := K)} + {B C : DegreeGraded K} + (hp : finiteSupportGradedEmbedding K p ∣ B * C) : + principalSubringFractionScalarExtension K p ∣ + principalSubringLocalizationMap K B * + principalSubringLocalizationMap K C := by + simpa only [(principalSubringLocalizationMap K).map_mul] using + principalSubringLocalizationMap_finiteSupport_dvd hp + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringMonoidAlgebra.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringMonoidAlgebra.lean new file mode 100644 index 0000000000..12af0e5fe7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringMonoidAlgebra.lean @@ -0,0 +1,191 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportMonoidAlgebra + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.SingleZeroFactors +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility +import Mathlib.Algebra.Algebra.Tower +import Mathlib.RingTheory.TensorProduct.MonoidAlgebra + +/-! +# The degree-graded ring as a monoid algebra + +LM24, Proposition 6.1.2 identifies the degree-graded ring with the tensor product of +`P̂` and the finite-support Hahn-series ring. Combining that identification +with the canonical monoid-algebra presentation of finite-support Hahn series presents the full +graded ring as a finite-support monoid algebra over `P̂`. + +Under this presentation, the principal graded subring consists precisely of the terms supported +at exponent zero. Therefore, if a product of two nonzero graded elements lies in the principal +graded subring, then both factors lie there. This is the algebraic step used in LM24, +Corollary 6.2.2. +-/ + +open scoped DirectSum HahnSeries NatOrdinal TensorProduct + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [CharZero K] + +variable (K) in +/-- The canonical monoid-algebra presentation of the degree-graded ring. -/ +def degreeGradedEquivPrincipalMonoidAlgebra : + DegreeGraded K ≃ₐ[K] + AddMonoidAlgebra (PrincipalSubring K) + (HahnSeries.Nonpositive.exponentMonoid ℝ) := + (principalSubringTensorEquiv K).symm |>.trans + (Algebra.TensorProduct.congr AlgEquiv.refl + HahnSeries.Nonpositive.finiteSupportAddMonoidAlgebraEquiv) |>.trans + ((AddMonoidAlgebra.scalarTensorEquiv K (PrincipalSubring K) + (M := HahnSeries.Nonpositive.exponentMonoid ℝ)).restrictScalars K) + +/-- A principal graded element corresponds to a term supported at exponent zero. -/ +@[simp] +theorem degreeGradedEquivPrincipalMonoidAlgebra_principal + (x : PrincipalSubring K) : + degreeGradedEquivPrincipalMonoidAlgebra K + (principalSubringEmbedding K x) = + AddMonoidAlgebra.single 0 x := by + have htensor : + (principalSubringTensorEquiv K).symm + (principalSubringEmbedding K x) = + x ⊗ₜ (1 : FiniteSupportRing (K := K)) := by + apply (principalSubringTensorEquiv K).injective + rw [(principalSubringTensorEquiv K).apply_symm_apply] + rw [principalSubringTensorEquiv_tmul] + rw [map_one, mul_one] + rw [degreeGradedEquivPrincipalMonoidAlgebra, + AlgEquiv.trans_apply, AlgEquiv.trans_apply, htensor] + simp only [Algebra.TensorProduct.congr_apply, AlgEquiv.refl_toAlgHom, + Algebra.TensorProduct.map_tmul, AlgHom.coe_id, id_eq, map_one, + AlgEquiv.coe_restrictScalars', AddMonoidAlgebra.scalarTensorEquiv_tmul] + rw [AddMonoidAlgebra.one_def, AddMonoidAlgebra.smul_single', mul_one] + +variable (K) in +/-- A finite-support Hahn monomial corresponds to the same exponent with coefficient one. -/ +theorem degreeGradedEquivPrincipalMonoidAlgebra_finiteSupportMonomial + (g : HahnSeries.Nonpositive.exponentMonoid ℝ) : + degreeGradedEquivPrincipalMonoidAlgebra K + (finiteSupportGradedEmbedding K + (HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g)) = + AddMonoidAlgebra.single g 1 := by + have htensor : + (principalSubringTensorEquiv K).symm + (finiteSupportGradedEmbedding K + (HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g)) = + (1 : PrincipalSubring K) ⊗ₜ + HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g := by + apply (principalSubringTensorEquiv K).injective + rw [(principalSubringTensorEquiv K).apply_symm_apply] + rw [principalSubringTensorEquiv_tmul] + rw [map_one, one_mul] + rw [degreeGradedEquivPrincipalMonoidAlgebra, + AlgEquiv.trans_apply, AlgEquiv.trans_apply, htensor] + simp only [Algebra.TensorProduct.congr_apply, AlgEquiv.refl_toAlgHom, + Algebra.TensorProduct.map_tmul, AlgEquiv.coe_algHom, + HahnSeries.Nonpositive.finiteSupportAddMonoidAlgebraEquiv_monomial, + AlgEquiv.coe_restrictScalars', AddMonoidAlgebra.scalarTensorEquiv_tmul, + AddMonoidAlgebra.mapAlgHom_single, map_one, one_smul] + +/-- A principal coefficient multiplied by a finite-support Hahn monomial corresponds to a +single formal monomial. -/ +theorem degreeGradedEquivPrincipalMonoidAlgebra_principal_monomial + (x : PrincipalSubring K) + (g : HahnSeries.Nonpositive.exponentMonoid ℝ) : + degreeGradedEquivPrincipalMonoidAlgebra K + (principalSubringEmbedding K x * + finiteSupportGradedEmbedding K + (HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g)) = + AddMonoidAlgebra.single g x := by + rw [map_mul, + degreeGradedEquivPrincipalMonoidAlgebra_principal, + degreeGradedEquivPrincipalMonoidAlgebra_finiteSupportMonomial] + rw [AddMonoidAlgebra.single_mul_single, zero_add, mul_one] + +/-- The inverse presentation sends one formal monomial to the corresponding product of the +principal coefficient and finite-support Hahn monomial. -/ +@[simp] +theorem degreeGradedEquivPrincipalMonoidAlgebra_symm_single + (g : HahnSeries.Nonpositive.exponentMonoid ℝ) + (x : PrincipalSubring K) : + (degreeGradedEquivPrincipalMonoidAlgebra K).symm + (AddMonoidAlgebra.single g x) = + principalSubringEmbedding K x * + finiteSupportGradedEmbedding K + (HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g) := by + apply (degreeGradedEquivPrincipalMonoidAlgebra K).injective + rw [(degreeGradedEquivPrincipalMonoidAlgebra K).apply_symm_apply] + exact (degreeGradedEquivPrincipalMonoidAlgebra_principal_monomial x g).symm + +/-- Nonzero factors of an element of the principal graded subalgebra lie in that subalgebra. -/ +theorem factors_mem_principalGradedSubalgebra_of_mul_mem {B C : DegreeGraded K} + (hB : B ≠ 0) (hC : C ≠ 0) + (hBC : B * C ∈ principalSubringSubalgebra K) : + B ∈ principalSubringSubalgebra K ∧ + C ∈ principalSubringSubalgebra K := by + let eP := principalSubringEquivSubalgebra K + let BC : principalSubringSubalgebra K := ⟨B * C, hBC⟩ + let x := eP.symm BC + have hx : principalSubringEmbedding K x = B * C := by + calc + principalSubringEmbedding K x = (eP x : DegreeGraded K) := + (principalSubringEquivSubalgebra_apply x).symm + _ = B * C := congrArg Subtype.val (eP.apply_symm_apply BC) + let e := degreeGradedEquivPrincipalMonoidAlgebra K + have hProduct : e B * e C = AddMonoidAlgebra.single 0 x := by + calc + e B * e C = e (B * C) := (e.map_mul B C).symm + _ = e (principalSubringEmbedding K x) := congrArg e hx.symm + _ = AddMonoidAlgebra.single 0 x := by + change degreeGradedEquivPrincipalMonoidAlgebra K + (principalSubringEmbedding K x) = _ + exact degreeGradedEquivPrincipalMonoidAlgebra_principal x + have heB : e B ≠ 0 := fun h ↦ hB (e.injective (h.trans (map_zero e).symm)) + have heC : e C ≠ 0 := fun h ↦ hC (e.injective (h.trans (map_zero e).symm)) + obtain ⟨b, c, hb, hc⟩ := + AddMonoidAlgebra.exists_eq_single_zero_of_mul_eq_single_zero + (R := PrincipalSubring K) + (M := HahnSeries.Nonpositive.exponentMonoid ℝ) + (HahnSeries.Nonpositive.exponentMonoid_top_eq_zero ℝ) + heB heC hProduct + constructor + · have hB_eq : principalSubringEmbedding K b = B := by + apply e.injective + calc + e (principalSubringEmbedding K b) = + AddMonoidAlgebra.single 0 b := by + change degreeGradedEquivPrincipalMonoidAlgebra K + (principalSubringEmbedding K b) = _ + exact degreeGradedEquivPrincipalMonoidAlgebra_principal b + _ = e B := hb.symm + rw [← hB_eq, mem_principalGradedSubalgebra_iff, isPrincipalGraded_iff] + intro α + rw [principalSubringEmbedding_apply] + exact principalComponentToHahnDegreeLayer_isPrincipal α (b α) + · have hC_eq : principalSubringEmbedding K c = C := by + apply e.injective + calc + e (principalSubringEmbedding K c) = + AddMonoidAlgebra.single 0 c := by + change degreeGradedEquivPrincipalMonoidAlgebra K + (principalSubringEmbedding K c) = _ + exact degreeGradedEquivPrincipalMonoidAlgebra_principal c + _ = e C := hc.symm + rw [← hC_eq, mem_principalGradedSubalgebra_iff, isPrincipalGraded_iff] + intro α + rw [principalSubringEmbedding_apply] + exact principalComponentToHahnDegreeLayer_isPrincipal α (c α) + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringScalarRedistributionProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringScalarRedistributionProof.lean new file mode 100644 index 0000000000..5e66e9509f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringScalarRedistributionProof.lean @@ -0,0 +1,231 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FactorCoefficients +public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.RelativeAlgebraicClosure + +/-! +# Redistributing a coefficient between two finite-support factors + +Two series with finite support have finitely many exponents between them, so both are supported +in the subgroup those exponents generate. That subgroup is finitely generated and torsion-free, +hence free of finite rank, and its group ring over a field therefore has unique factorisation. + +This file records the passage from a pair of finite-support series to such a common subgroup, +which is the setting in which the redistribution argument factors a product. +-/ + +universe u v + +namespace Berarducci + +public noncomputable section + +/-- Two finite-support series lie in the group ring of a common finitely generated subgroup of +the exponent group, and that group ring has unique factorisation. -/ +theorem exists_common_subgroup_uniqueFactorization {G : Type u} {L : Type v} [LinearOrder G] + [AddCommGroup G] [IsOrderedAddMonoid G] [Field L] (p q : HahnSeries G L) + (hp : p.support.Finite) (hq : q.support.Finite) : + ∃ H : AddSubgroup G, UniqueFactorizationMonoid (AddMonoidAlgebra L H) ∧ + p.support ⊆ (H : Set G) ∧ q.support ⊆ (H : Set G) := by + classical + refine ⟨AddSubgroup.closure ((hp.toFinset ∪ hq.toFinset : Finset G) : Set G), + HahnSeries.uniqueFactorizationMonoid_subgroupAlgebra + (HahnSeries.exists_addEquiv_fin (hp.toFinset ∪ hq.toFinset)), ?_, ?_⟩ + · exact fun x hx ↦ AddSubgroup.subset_closure + (Finset.mem_coe.mpr (Finset.mem_union_left _ (hp.mem_toFinset.mpr hx))) + · exact fun x hx ↦ AddSubgroup.subset_closure + (Finset.mem_coe.mpr (Finset.mem_union_right _ (hq.mem_toFinset.mpr hx))) + +section Redistribution + +variable {K : Type v} [Field K] [CharZero K] + +local instance algLocal : + Algebra K (PrincipalSubringFractionField K) := principalSubringFractionAlgebra K + +/-- Multiplying a finite-support series by a constant scales every coefficient. -/ +theorem coeff_mul_finiteSupportScalarHom {L : Type*} [Field L] + (p : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := L)) (c : L) (x : ℝ) : + ((((p * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) c : + HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := L)) : + HahnSeries.Nonpositive ℝ L) : HahnSeries ℝ L)).coeff x = + ((((p : HahnSeries.Nonpositive ℝ L) : HahnSeries ℝ L)).coeff x) * c := by + have h1 : (((p * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) c : + HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := L)) : + HahnSeries.Nonpositive ℝ L) : HahnSeries ℝ L) = + (((p : HahnSeries.Nonpositive ℝ L) : HahnSeries ℝ L)) * HahnSeries.C c := by + rw [Subring.coe_mul, Subring.coe_mul, + HahnSeries.Nonpositive.coe_finiteSupportScalarHom (G := ℝ) (K := L) c] + rw [h1, mul_comm, HahnSeries.C_mul_eq_smul, HahnSeries.coeff_smul, smul_eq_mul, mul_comm] + +omit [CharZero K] in +/-- Coefficient extension of finite-support series is coefficientwise on Hahn series. -/ +theorem coe_finiteSupportMap {L : Type*} [Field L] (f : K →+* L) + (b : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)) : + (((HahnSeries.Nonpositive.finiteSupportMap (G := ℝ) f b : + HahnSeries.Nonpositive ℝ L) : HahnSeries ℝ L)) = + (((b : HahnSeries.Nonpositive ℝ K) : HahnSeries ℝ K)).map f := by + refine HahnSeries.coeff_injective (funext fun x ↦ ?_) + rw [HahnSeries.map_coeff] + rcases le_or_gt x 0 with hx | hx + · have h1 := HahnSeries.Nonpositive.finiteSupportMap_coeff (G := ℝ) f b ⟨x, hx⟩ + rw [HahnSeries.Nonpositive.finiteSupportCoefficients_apply, + HahnSeries.Nonpositive.finiteSupportCoefficients_apply] at h1 + exact h1 + · have hzK : (((b : HahnSeries.Nonpositive ℝ K) : HahnSeries ℝ K)).coeff x = 0 := by + by_contra hne + exact absurd (HahnSeries.Nonpositive.support_subset _ + ((HahnSeries.mem_support _ _).mpr hne)) (by simpa using hx) + have hzL : ((((HahnSeries.Nonpositive.finiteSupportMap (G := ℝ) f b : + HahnSeries.Nonpositive ℝ L)) : HahnSeries ℝ L)).coeff x = 0 := by + by_contra hne + exact absurd (HahnSeries.Nonpositive.support_subset _ + ((HahnSeries.mem_support _ _).mpr hne)) (by simpa using hx) + rw [hzK, hzL, map_zero] + +variable (K) in +/-- The algebra map of the fraction field is the coefficient embedding. -/ +theorem algebraMap_eq_coefficientMap : + algebraMap K (PrincipalSubringFractionField K) = + principalSubringFractionCoefficientMap K := by + refine RingHom.ext fun k ↦ ?_ + rw [principalSubringFraction_algebraMap_apply, principalSubringFractionCoefficientMap_apply] + +/-- The scalar extension acts coefficientwise on the underlying Hahn series. -/ +theorem coe_scalarExtension (b : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)) : + (((principalSubringFractionScalarExtension K b : + HahnSeries.Nonpositive ℝ (PrincipalSubringFractionField K)) : + HahnSeries ℝ (PrincipalSubringFractionField K))) = + (((b : HahnSeries.Nonpositive ℝ K) : HahnSeries ℝ K)).map + (algebraMap K (PrincipalSubringFractionField K)) := by + refine HahnSeries.coeff_injective (funext fun x ↦ ?_) + rw [HahnSeries.map_coeff, algebraMap_eq_coefficientMap] + rcases le_or_gt x 0 with hx | hx + · have h1 := principalSubringFractionScalarExtension_coeff b ⟨x, hx⟩ + rw [HahnSeries.Nonpositive.finiteSupportCoefficients_apply, + HahnSeries.Nonpositive.finiteSupportCoefficients_apply] at h1 + exact h1 + · have hzK : (((b : HahnSeries.Nonpositive ℝ K) : HahnSeries ℝ K)).coeff x = 0 := by + by_contra hne + exact absurd (HahnSeries.Nonpositive.support_subset _ + ((HahnSeries.mem_support _ _).mpr hne)) (by simpa using hx) + have hzL : (((principalSubringFractionScalarExtension K b : + HahnSeries.Nonpositive ℝ (PrincipalSubringFractionField K)) : + HahnSeries ℝ (PrincipalSubringFractionField K))).coeff x = 0 := by + by_contra hne + exact absurd (HahnSeries.Nonpositive.support_subset _ + ((HahnSeries.mem_support _ _).mpr hne)) (by simpa using hx) + rw [hzK, hzL, map_zero] + +/-- One factor is cleared into the coefficient field by a single nonzero scalar. -/ +theorem exists_clearing_scalar + (hclosed : Algebra.IsRelativelyAlgebraicallyClosed K (PrincipalSubringFractionField K)) + {p q : PrincipalSubringFractionFiniteSupportRing K} (hp : p ≠ 0) (hq : q ≠ 0) + (hpq : p * q ∈ principalSubringFractionCoefficientSubring K) : + ∃ c : PrincipalSubringFractionField K, c ≠ 0 ∧ + p * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) c ∈ + principalSubringFractionCoefficientSubring K := by + obtain ⟨a, ha⟩ := (mem_principalGradedFractionCoefficientSubring_iff _).mp hpq + have hPfin := (HahnSeries.Nonpositive.mem_finiteSupportSubring_iff _).mp p.2 + have hQfin := (HahnSeries.Nonpositive.mem_finiteSupportSubring_iff _).mp q.2 + have hP0 : (((p : HahnSeries.Nonpositive ℝ (PrincipalSubringFractionField K)) : + HahnSeries ℝ (PrincipalSubringFractionField K))) ≠ 0 := by + intro h0 + exact hp (Subtype.ext (Subtype.ext h0)) + have hQ0 : (((q : HahnSeries.Nonpositive ℝ (PrincipalSubringFractionField K)) : + HahnSeries ℝ (PrincipalSubringFractionField K))) ≠ 0 := by + intro h0 + exact hq (Subtype.ext (Subtype.ext h0)) + have hrel : (((p : HahnSeries.Nonpositive ℝ (PrincipalSubringFractionField K)) : + HahnSeries ℝ (PrincipalSubringFractionField K))) * + (((q : HahnSeries.Nonpositive ℝ (PrincipalSubringFractionField K)) : + HahnSeries ℝ (PrincipalSubringFractionField K))) = + (((a : HahnSeries.Nonpositive ℝ K) : HahnSeries ℝ K)).map + (algebraMap K (PrincipalSubringFractionField K)) := by + have h1 : (((p * q : PrincipalSubringFractionFiniteSupportRing K) : + HahnSeries.Nonpositive ℝ (PrincipalSubringFractionField K)) : + HahnSeries ℝ (PrincipalSubringFractionField K)) = + (((p : HahnSeries.Nonpositive ℝ (PrincipalSubringFractionField K)) : + HahnSeries ℝ (PrincipalSubringFractionField K))) * + (((q : HahnSeries.Nonpositive ℝ (PrincipalSubringFractionField K)) : + HahnSeries ℝ (PrincipalSubringFractionField K))) := by + rw [Subring.coe_mul, Subring.coe_mul] + rw [← h1, ← ha] + exact coe_scalarExtension a + obtain ⟨c, hc, hcoeff⟩ := + HahnSeries.exists_scalar_of_hahn_mul_eq_map hclosed hP0 hQ0 hPfin hQfin hrel + refine ⟨c, hc, ?_⟩ + rw [mem_principalGradedFractionCoefficientSubring_iff_coeff] + intro g + rw [HahnSeries.Nonpositive.finiteSupportCoefficients_apply, + coeff_mul_finiteSupportScalarHom, mul_comm] + have := hcoeff (g : ℝ) + rw [algebraMap_eq_coefficientMap] at this + exact this + +/-- A constant whose value lies in the coefficient field is a coefficient series. -/ +theorem finiteSupportScalarHom_mem_of_mem_range {B : PrincipalSubringFractionField K} + (hB : B ∈ Set.range (principalSubringFractionCoefficientMap K)) : + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B ∈ + principalSubringFractionCoefficientSubring K := by + obtain ⟨k, rfl⟩ := hB + rw [mem_principalGradedFractionCoefficientSubring_iff] + exact ⟨HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k, + principalSubringFractionScalarExtension_scalar k⟩ + +/-- The product of two clearing scalars lies in the coefficient field. -/ +theorem mul_clearing_scalars_mem_range + {p₁ p₂ : PrincipalSubringFractionFiniteSupportRing K} (hp₁ : p₁ ≠ 0) (hp₂ : p₂ ≠ 0) + (hprod : p₁ * p₂ ∈ principalSubringFractionCoefficientSubring K) + {c₁ c₂ : PrincipalSubringFractionField K} + (hm₁ : p₁ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) c₁ ∈ + principalSubringFractionCoefficientSubring K) + (hm₂ : p₂ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) c₂ ∈ + principalSubringFractionCoefficientSubring K) : + c₁ * c₂ ∈ Set.range (principalSubringFractionCoefficientMap K) := by + obtain ⟨a, ha⟩ := (mem_principalGradedFractionCoefficientSubring_iff _).mp hprod + have ha0 : a ≠ 0 := by + intro h0 + rw [h0, map_zero] at ha + exact (mul_ne_zero hp₁ hp₂) ha.symm + refine principalSubringFractionCoefficientMap_mem_range_of_mul_scalar_mem ha0 ?_ + rw [ha, map_mul, mul_mul_mul_comm] + exact Subring.mul_mem _ hm₁ hm₂ + +/-- LM24, Lemma 6.3.4: a nonzero scalar may be moved between two nonzero finite-support factors +whose product has coefficients in the coefficient field. -/ +theorem principalSubringFraction_exists_scalarRedistribution_of_isRelativelyAlgebraicallyClosed + (hclosed : Algebra.IsRelativelyAlgebraicallyClosed K (PrincipalSubringFractionField K)) + {p₁ p₂ : PrincipalSubringFractionFiniteSupportRing K} + (hp₁ : p₁ ≠ 0) (hp₂ : p₂ ≠ 0) + (hprod : p₁ * p₂ ∈ principalSubringFractionCoefficientSubring K) : + ∃ B : PrincipalSubringFractionField K, B ≠ 0 ∧ + p₁ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B ∈ + principalSubringFractionCoefficientSubring K ∧ + p₂ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B⁻¹ ∈ + principalSubringFractionCoefficientSubring K := by + obtain ⟨c₁, hc₁, hm₁⟩ := exists_clearing_scalar hclosed hp₁ hp₂ hprod + obtain ⟨c₂, hc₂, hm₂⟩ := exists_clearing_scalar hclosed hp₂ hp₁ + (by rw [mul_comm]; exact hprod) + have hrange := mul_clearing_scalars_mem_range hp₁ hp₂ hprod hm₁ hm₂ + refine ⟨c₁, hc₁, hm₁, ?_⟩ + have hinv : c₁⁻¹ = c₂ * (c₁ * c₂)⁻¹ := by + rw [mul_inv, ← mul_assoc, mul_comm c₂ c₁⁻¹, mul_assoc, mul_inv_cancel₀ hc₂, mul_one] + have hrangeinv : (c₁ * c₂)⁻¹ ∈ Set.range (principalSubringFractionCoefficientMap K) := by + obtain ⟨k, hk⟩ := hrange + exact ⟨k⁻¹, by rw [map_inv₀, hk]⟩ + rw [hinv, map_mul, ← mul_assoc] + exact Subring.mul_mem _ hm₂ (finiteSupportScalarHom_mem_of_mem_range hrangeinv) + +end Redistribution + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringTensor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringTensor.lean new file mode 100644 index 0000000000..13512f47a8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringTensor.lean @@ -0,0 +1,378 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentTensor +public import Mathlib.RingTheory.TensorProduct.Basic +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +import Mathlib.LinearAlgebra.DirectSum.TensorProduct +import Mathlib.RingTheory.TensorProduct.Maps + +/-! +# Extension of scalars from $\widehat{\mathrm P}$ + +This module proves LM24, Proposition 6.1.2. The homogeneous-component equivalences of Proposition +5.3.1 +assemble to the graded algebra equivalence + +`P̂ ⊗[K] K(ℝ^{≤ 0}) ≃ₐ[K] RV̂`. + +The map sends a pure tensor to the product of the principal graded embedding and the grade-zero +finite-support embedding. Its component at `α` is exactly the equivalence on the +`α`-component. Thus both scalar factors and all homogeneous projections remain visible in the +public API. The displayed orientation agrees with Proposition 5.3.1; one sentence in the printed +proof reverses the corresponding component arrow. + +The construction is stated over a coefficient field of characteristic zero, which supplies the +two multiplicativity theorems behind the principal and degree gradings. +-/ + +open scoped DirectSum HahnSeries NatOrdinal TensorProduct + +universe v + +namespace Berarducci + +public noncomputable section + +variable {K : Type v} [Field K] [CharZero K] + +variable (K) in +private def principalSubringTensorLinearEquiv : + PrincipalSubring K ⊗[K] FiniteSupportRing (K := K) ≃ₗ[K] + DegreeGraded K := + TensorProduct.directSumLeft K K (PrincipalComponent K) + (FiniteSupportRing (K := K)) ≪≫ₗ + DirectSum.congrLinearEquiv + (fun α ↦ principalComponentTensorEquiv K α) + +variable (K) in +/-- The canonical projection of the tensor product onto its tensor factor in principal grade +`α`. -/ +def principalSubringTensorComponent (α : NatOrdinal) : + PrincipalSubring K ⊗[K] FiniteSupportRing (K := K) →ₗ[K] + PrincipalComponent K α ⊗[K] FiniteSupportRing (K := K) := + (DirectSum.component K NatOrdinal + (fun β ↦ PrincipalComponent K β ⊗[K] FiniteSupportRing (K := K)) + α).comp + (TensorProduct.directSumLeft K K (PrincipalComponent K) + (FiniteSupportRing (K := K))).toLinearMap + +omit [CharZero K] in +/-- The tensor component of a pure tensor is the tensor of the corresponding principal +component. -/ +@[simp] +theorem principalSubringTensorComponent_tmul (α : NatOrdinal) (x : PrincipalSubring K) + (p : FiniteSupportRing (K := K)) : + principalSubringTensorComponent K α (x ⊗ₜ p) = x α ⊗ₜ p := by + exact TensorProduct.directSumLeft_tmul K K x p α + +private theorem principalSubringTensorLinearEquiv_tmul_apply + (x : PrincipalSubring K) (p : FiniteSupportRing (K := K)) + (α : NatOrdinal) : + principalSubringTensorLinearEquiv K (x ⊗ₜ p) α = + principalComponentTensorEquiv K α (x α ⊗ₜ p) := by + simp [principalSubringTensorLinearEquiv, DirectSum.coe_congrLinearEquiv] + +variable (K) in +/-- The finite-support ring embeds in the degree-graded ring through the +degree-zero residue equivalence. -/ +def finiteSupportGradedEmbedding : + FiniteSupportRing (K := K) →ₐ[K] DegreeGraded K where + toRingHom := (DirectSum.ofZeroRingHom + (HahnSeries.Nonpositive.degreeValuation K).Component).comp + (HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K).toRingHom + commutes' k := by + change DirectSum.of _ 0 + (HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K + (HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k)) = + algebraMap K (DegreeGraded K) k + rw [degreeFiniteSupportResidueEquiv_scalar, + degreeGraded_algebraMap_apply] + +omit [CharZero K] in +/-- The finite-support embedding places the degree residue class in grade zero. -/ +@[simp] +theorem finiteSupportGradedEmbedding_apply (p : FiniteSupportRing (K := K)) : + finiteSupportGradedEmbedding K p = + DirectSum.of _ 0 + (HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K p) := + (rfl) + +omit [CharZero K] in +/-- Multiplication by the grade-zero finite-support embedding is the residue-ring scalar action +on each homogeneous component. -/ +theorem finiteSupportGradedEmbedding_mul_of (p : FiniteSupportRing (K := K)) (α : NatOrdinal) + (x : (HahnSeries.Nonpositive.degreeValuation K).Component α) : + finiteSupportGradedEmbedding K p * + DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component α x = + DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component α + (HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K p • x) := by + rw [finiteSupportGradedEmbedding_apply, ← DirectSum.of_zero_smul] + +omit [CharZero K] in +variable (K) in +/-- The grade-zero finite-support embedding is injective. -/ +theorem finiteSupportGradedEmbedding_injective : + Function.Injective (finiteSupportGradedEmbedding K) := by + intro p q hpq + apply (HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K).injective + exact (DirectSum.of_injective 0) hpq + +variable (K) in +/-- Multiplication of the two canonical graded embeddings induces the global tensor map. -/ +def principalSubringTensorMap : + PrincipalSubring K ⊗[K] FiniteSupportRing (K := K) →ₐ[K] + DegreeGraded K := + Algebra.TensorProduct.productMap + (principalSubringEmbedding K) + (finiteSupportGradedEmbedding K) + +/-- On a pure tensor, the global tensor map is multiplication of the two embedded factors. -/ +theorem principalSubringTensorMap_tmul (x : PrincipalSubring K) (p : FiniteSupportRing (K := K)) : + principalSubringTensorMap K (x ⊗ₜ p) = + principalSubringEmbedding K x * + finiteSupportGradedEmbedding K p := + (rfl) + +omit [CharZero K] in +private theorem degreeGraded_of_zero_mul + (a : (HahnSeries.Nonpositive.degreeValuation K).Component 0) + (x : DegreeGraded K) : + DirectSum.of _ 0 a * x = a • x := by + induction x using DirectSum.induction_on with + | zero => rw [mul_zero, smul_zero] + | of α x => + rw [← DirectSum.of_zero_smul] + exact (DirectSum.lof + ((HahnSeries.Nonpositive.degreeValuation K).Component 0) + NatOrdinal + (HahnSeries.Nonpositive.degreeValuation K).Component + α).map_smul a x + | add x y hx hy => rw [mul_add, smul_add, hx, hy] + +private theorem principalSubringTensorMap_eq_linearEquiv + (z : PrincipalSubring K ⊗[K] FiniteSupportRing (K := K)) : + principalSubringTensorMap K z = + principalSubringTensorLinearEquiv K z := by + induction z using TensorProduct.induction_on with + | zero => rw [map_zero, LinearEquiv.map_zero] + | tmul x p => + rw [principalSubringTensorMap_tmul, + finiteSupportGradedEmbedding_apply, mul_comm, + degreeGraded_of_zero_mul] + ext α + rw [DirectSum.smul_apply, + principalSubringTensorLinearEquiv_tmul_apply, + principalSubringEmbedding_apply, + principalComponentTensorEquiv_tmul] + | add x y hx hy => + calc + principalSubringTensorMap K (x + y) = + principalSubringTensorMap K x + + principalSubringTensorMap K y := + (principalSubringTensorMap K).map_add x y + _ = principalSubringTensorLinearEquiv K x + + principalSubringTensorLinearEquiv K y := + congrArg₂ (· + ·) hx hy + _ = principalSubringTensorLinearEquiv K (x + y) := + ((principalSubringTensorLinearEquiv K).map_add x y).symm + +variable (K) in +/-- The multiplication-induced global tensor map is bijective. -/ +theorem principalSubringTensorMap_bijective : + Function.Bijective (principalSubringTensorMap K) := by + have hfunctions : + (principalSubringTensorMap K : + PrincipalSubring K ⊗[K] FiniteSupportRing (K := K) → + DegreeGraded K) = + principalSubringTensorLinearEquiv K := by + funext z + exact principalSubringTensorMap_eq_linearEquiv z + rw [hfunctions] + exact (principalSubringTensorLinearEquiv K).bijective + +variable (K) in +/-- LM24, Proposition 6.1.2: the algebra equivalence induced by multiplication. -/ +@[blueprint "fact:principal-subring-tensor-decomposition" + (phase := "Polynomial presentations") + (title := "Scalar extension from $\\widehat{\\mathrm P}$ to $\\widehat{\\mathrm{RV}}$ (LM24, \ + Proposition 6.1.2)") + (statement := /-- + Let $K$ be a field of characteristic zero. Multiplication of initial forms + induces an isomorphism of $K$-algebras + \[ + \widehat{\mathrm P}\otimes_K K(\mathbb R^{\le 0}) + \xrightarrow{\sim}\widehat{\mathrm{RV}}. + \] + -/) + (proof := /-- + \ref{fact:principal-series-representatives} gives in each degree the + component equivalence of LM24, Proposition 5.3.1. + \ref{fact:degree-multiplicativity} makes multiplication of initial forms respect those + components, so their direct sum is an algebra homomorphism. Every element has finite degree + support; applying the inverse component maps degree by degree proves bijectivity. + -/)] +def principalSubringTensorEquiv : + PrincipalSubring K ⊗[K] FiniteSupportRing (K := K) ≃ₐ[K] + DegreeGraded K := + AlgEquiv.ofBijective (principalSubringTensorMap K) + (principalSubringTensorMap_bijective K) + +/-- The graded tensor equivalence has the multiplication-induced tensor map as its forward map. -/ +@[simp] +theorem principalSubringTensorEquiv_apply + (z : PrincipalSubring K ⊗[K] FiniteSupportRing (K := K)) : + principalSubringTensorEquiv K z = + principalSubringTensorMap K z := + (rfl) + +/-- The graded tensor equivalence multiplies the images of a pure tensor's two factors. -/ +theorem principalSubringTensorEquiv_tmul + (x : PrincipalSubring K) (p : FiniteSupportRing (K := K)) : + principalSubringTensorEquiv K (x ⊗ₜ p) = + principalSubringEmbedding K x * + finiteSupportGradedEmbedding K p := by + rw [principalSubringTensorEquiv_apply, principalSubringTensorMap_tmul] + +/-- On a pure tensor, each homogeneous projection of the global equivalence is the corresponding +homogeneous-component equivalence. -/ +theorem principalSubringTensorEquiv_tmul_apply + (x : PrincipalSubring K) (p : FiniteSupportRing (K := K)) + (α : NatOrdinal) : + principalSubringTensorEquiv K (x ⊗ₜ p) α = + principalComponentTensorEquiv K α (x α ⊗ₜ p) := by + rw [principalSubringTensorEquiv_apply, + principalSubringTensorMap_eq_linearEquiv, + principalSubringTensorLinearEquiv_tmul_apply] + +/-- On an arbitrary tensor, every homogeneous projection of the global equivalence is the +corresponding homogeneous-component equivalence applied to the canonical tensor component. -/ +theorem principalSubringTensorEquiv_component + (z : PrincipalSubring K ⊗[K] FiniteSupportRing (K := K)) + (α : NatOrdinal) : + principalSubringTensorEquiv K z α = + principalComponentTensorEquiv K α + (principalSubringTensorComponent K α z) := by + rw [principalSubringTensorEquiv_apply, + principalSubringTensorMap_eq_linearEquiv] + rw [principalSubringTensorLinearEquiv, LinearEquiv.trans_apply, + principalSubringTensorComponent, LinearMap.comp_apply, + DirectSum.coe_congrLinearEquiv, DirectSum.lmap_apply, + ← DirectSum.apply_eq_component] + rfl + +/-- The canonical tensor component of the inverse global equivalence is the inverse +homogeneous-component +equivalence of that homogeneous component. -/ +@[simp] +theorem principalSubringTensorComponent_symm_apply + (y : DegreeGraded K) (α : NatOrdinal) : + principalSubringTensorComponent K α + ((principalSubringTensorEquiv K).symm y) = + (principalComponentTensorEquiv K α).symm (y α) := by + apply (principalComponentTensorEquiv K α).injective + rw [← principalSubringTensorEquiv_component] + simp + +/-- Restricting the global equivalence to the finite-support factor gives its grade-zero +embedding. -/ +theorem principalSubringTensorEquiv_one_tmul (p : FiniteSupportRing (K := K)) : + principalSubringTensorEquiv K (1 ⊗ₜ p) = + finiteSupportGradedEmbedding K p := by + rw [principalSubringTensorEquiv_tmul, map_one, one_mul] + +/-- Restricting the global equivalence to the principal graded factor gives its canonical +embedding. -/ +theorem principalSubringTensorEquiv_tmul_one (x : PrincipalSubring K) : + principalSubringTensorEquiv K (x ⊗ₜ 1) = + principalSubringEmbedding K x := by + rw [principalSubringTensorEquiv_tmul, map_one, mul_one] + +/-- The inverse global tensor equivalence sends the finite-support embedding to the corresponding +pure tensor. -/ +theorem principalSubringTensorEquiv_symm_finiteSupportGradedEmbedding + (p : FiniteSupportRing (K := K)) : + (principalSubringTensorEquiv K).symm + (finiteSupportGradedEmbedding K p) = 1 ⊗ₜ p := by + apply (principalSubringTensorEquiv K).injective + rw [AlgEquiv.apply_symm_apply, principalSubringTensorEquiv_one_tmul] + +/-- The inverse global tensor equivalence sends the principal graded embedding to the +corresponding pure tensor. -/ +@[simp] +theorem principalSubringTensorEquiv_symm_principalGradedEmbedding (x : PrincipalSubring K) : + (principalSubringTensorEquiv K).symm + (principalSubringEmbedding K x) = x ⊗ₜ 1 := by + apply (principalSubringTensorEquiv K).injective + rw [AlgEquiv.apply_symm_apply, principalSubringTensorEquiv_tmul_one] + +omit [CharZero K] in +/-- A nonzero finite-support series has degree zero. -/ +theorem degreeValuation_finiteSupport_eq_zero (p : FiniteSupportRing (K := K)) (hp : p ≠ 0) : + HahnSeries.Nonpositive.degreeValuation K (p : Series K) = 0 := by + rw [HahnSeries.Nonpositive.degreeValuation_apply, HahnSeries.degree_eq_zero] + refine ⟨fun h ↦ hp (Subtype.ext (Subtype.ext h)), ?_⟩ + exact (HahnSeries.Nonpositive.mem_finiteSupportSubring_iff (p : Series K)).mp p.property + +/-- A finite-support series as a representative in the weak degree filtration at zero. -/ +def finiteSupportFiltrationRepresentative (p : FiniteSupportRing (K := K)) : + (HahnSeries.Nonpositive.degreeValuation K).filtrationLE 0 := + ⟨(p : Series K), ((HahnSeries.Nonpositive.degreeValuation K).mem_filtrationLE_iff 0 _).mpr (by + by_cases hp : p = 0 + · subst hp + simp + · rw [degreeValuation_finiteSupport_eq_zero p hp, WithBot.coe_zero])⟩ + +omit [CharZero K] in +@[simp] +theorem coe_finiteSupportFiltrationRepresentative (p : FiniteSupportRing (K := K)) : + (finiteSupportFiltrationRepresentative p : Series K) = (p : Series K) := + (rfl) + +omit [CharZero K] in +/-- The finite-support embedding sends a series to its grade-zero homogeneous class. -/ +theorem finiteSupportGradedEmbedding_eq_homogeneousMk (p : FiniteSupportRing (K := K)) : + finiteSupportGradedEmbedding K p = + (HahnSeries.Nonpositive.degreeValuation K).homogeneousMk 0 + (finiteSupportFiltrationRepresentative p) := by + rw [finiteSupportGradedEmbedding_apply, + HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv_apply, + (HahnSeries.Nonpositive.degreeValuation K).residueMap_apply, + MaxAddDegree.homogeneousMk_apply] + apply congrArg (DirectSum.of (HahnSeries.Nonpositive.degreeValuation K).Component 0) + apply congrArg ((HahnSeries.Nonpositive.degreeValuation K).componentMk 0) + apply Subtype.ext + rw [(HahnSeries.Nonpositive.degreeValuation K).coe_nonpositiveEquivFiltrationLEZero, + RingEquiv.coe_subringCongr_apply, coe_finiteSupportFiltrationRepresentative] + +omit [CharZero K] in +/-- The finite-support embedding sends a series to its initial form. -/ +theorem finiteSupportGradedEmbedding_eq_initialForm (p : FiniteSupportRing (K := K)) : + finiteSupportGradedEmbedding K p = + (HahnSeries.Nonpositive.degreeValuation K).initialForm (p : Series K) := by + rw [finiteSupportGradedEmbedding_eq_homogeneousMk] + by_cases hp : p = 0 + · have hzero : (HahnSeries.Nonpositive.degreeValuation K).homogeneousMk 0 + (finiteSupportFiltrationRepresentative p) = 0 := by + rw [MaxAddDegree.homogeneousMk_eq_zero_iff, coe_finiteSupportFiltrationRepresentative, hp, + ZeroMemClass.coe_zero, MaxAddDegree.map_zero] + exact WithBot.bot_lt_coe 0 + rw [hzero, hp, ZeroMemClass.coe_zero, MaxAddDegree.initialForm_zero] + · have hne : (HahnSeries.Nonpositive.degreeValuation K).componentMk 0 + (finiteSupportFiltrationRepresentative p) ≠ 0 := by + rw [ne_eq, MaxAddDegree.componentMk_eq_zero_iff, coe_finiteSupportFiltrationRepresentative, + degreeValuation_finiteSupport_eq_zero p hp] + exact lt_irrefl _ + exact (MaxAddDegree.initialForm_eq_homogeneousMk_of_componentMk_ne_zero _ 0 _ hne).symm + +end + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalValue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalValue.lean new file mode 100644 index 0000000000..b53eb81cc7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalValue.lean @@ -0,0 +1,360 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.MultiplicativelyPrincipal +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTerm + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SuccessorFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.GeneralFactorization + +/-! +# Principal and residual ordinal values + +Berarducci, Definition 6.4 assigns principal and residual values to a nonpositive Hahn series +`b` whose ordinal value satisfies `1 < v_J(b)`. Its value is a positive additive-principal +ordinal, and therefore has a unique nonincreasing factorisation into infinite multiplicatively +principal ordinals greater than one. The principal value is the final factor. The residual value +is the product of all preceding factors, with value one when there is only one factor. + +`SeriesWithOrdinalValueAboveOne` is the exact domain of these operations. The definitions therefore +have no arbitrary branch at ordinal values zero and one. Both values are represented by +`NatOrdinal`: this makes Berarducci's Hessenberg-product reconstruction directly available while +the corresponding theorem on underlying ordinary ordinals records the product printed in the +source. + +The factor list and its ordinary-versus-Hessenberg product comparison are provided by the ordinal +factorisation module. The image theorem for `ordinalValue` supplies the additive-principality +hypothesis required to enter its exact domain. +-/ + +universe v + +open scoped NatOrdinal + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- Nonpositive Hahn series in the exact domain of Berarducci's principal and residual values. -/ +abbrev SeriesWithOrdinalValueAboveOne (K : Type v) [Field K] := + {b : Series K // 1 < ordinalValue b} + +namespace SeriesWithOrdinalValueAboveOne + +private def factorOrdinal (b : SeriesWithOrdinalValueAboveOne K) : + Ordinal.AdditivePrincipalAboveOne := + ⟨(ordinalValue b.1).val, ordinalValue_isAdditivelyPrincipal_of_one_lt b.2, b.2⟩ + +/-- The final factor in the canonical multiplicative factorisation of `v_J(b)`. -/ +noncomputable def principalValue (b : SeriesWithOrdinalValueAboveOne K) : NatOrdinal := + NatOrdinal.of b.factorOrdinal.principalFactor + +/-- The product of all but the final factor in the canonical factorisation of `v_J(b)`. -/ +noncomputable def residualValue (b : SeriesWithOrdinalValueAboveOne K) : NatOrdinal := + NatOrdinal.of b.factorOrdinal.residualFactor + +/-- The principal value is an infinite multiplicatively principal ordinal. -/ +theorem principalValue_isInfiniteMultiplicativelyPrincipal + (b : SeriesWithOrdinalValueAboveOne K) : + Ordinal.IsInfiniteMultiplicativelyPrincipal b.principalValue.val := by + simp only [principalValue, NatOrdinal.val_of] + exact b.factorOrdinal.principalFactor_isInfiniteMultiplicativelyPrincipal + +/-- The principal value satisfies Berarducci's printed multiplicative-principality predicate. -/ +theorem principalValue_isMultiplicativelyPrincipal + (b : SeriesWithOrdinalValueAboveOne K) : + Ordinal.IsMultiplicativelyPrincipal b.principalValue.val := + (Ordinal.isInfiniteMultiplicativelyPrincipal_iff_two_lt_and_isMultiplicativelyPrincipal.mp + b.principalValue_isInfiniteMultiplicativelyPrincipal).2 + +/-- The principal value is strictly greater than one. -/ +theorem one_lt_principalValue (b : SeriesWithOrdinalValueAboveOne K) : + 1 < b.principalValue := by + change NatOrdinal.of (1 : Ordinal) < + NatOrdinal.of b.factorOrdinal.principalFactor + exact NatOrdinal.of.lt_iff_lt.mpr b.factorOrdinal.one_lt_principalFactor + +/-- The residual value is a positive additive-principal ordinal. -/ +theorem residualValue_isAdditivelyPrincipal + (b : SeriesWithOrdinalValueAboveOne K) : + Ordinal.IsAdditivelyPrincipal b.residualValue.val := by + simp only [residualValue, NatOrdinal.val_of] + exact b.factorOrdinal.residualFactor_isAdditivelyPrincipal + +/-- The residual value is nonzero. -/ +theorem residualValue_ne_zero (b : SeriesWithOrdinalValueAboveOne K) : + b.residualValue ≠ 0 := by + intro hzero + apply b.residualValue_isAdditivelyPrincipal.ne_zero + have hval := congrArg NatOrdinal.val hzero + simpa using hval + +/-- Ordinary ordinal multiplication of the residual and principal values recovers `v_J(b)`. -/ +theorem residualValue_val_mul_principalValue_val + (b : SeriesWithOrdinalValueAboveOne K) : + b.residualValue.val * b.principalValue.val = (ordinalValue b.1).val := by + simpa only [residualValue, principalValue, NatOrdinal.val_of, factorOrdinal] using + b.factorOrdinal.residualFactor_mul_principalFactor + +/-- Hessenberg multiplication of the residual and principal values also recovers `v_J(b)`. -/ +theorem residualValue_mul_principalValue + (b : SeriesWithOrdinalValueAboveOne K) : + b.residualValue * b.principalValue = ordinalValue b.1 := by + change NatOrdinal.of b.factorOrdinal.residualFactor * + NatOrdinal.of b.factorOrdinal.principalFactor = ordinalValue b.1 + rw [b.factorOrdinal.naturalResidual_mul_naturalPrincipal] + simp [factorOrdinal] + +/-- Every canonical multiplicative factor of the ordinal value is at least the principal value, +read on Cantor terms of the logarithm. -/ +theorem log_principalValue_le_of_mem_terms_ordinalValue + (b : SeriesWithOrdinalValueAboveOne K) {t : Ordinal} + (ht : t ∈ (Ordinal.log Ordinal.omega0 (ordinalValue b.1).val).additivePrincipalTerms) : + Ordinal.log Ordinal.omega0 b.principalValue.val ≤ t := by + have h := b.factorOrdinal.log_principalFactor_le_of_mem_terms ht + simpa [principalValue] using h + +/-- The same bound for the canonical factors of the residual value. -/ +theorem log_principalValue_le_of_mem_terms_residualValue + (b : SeriesWithOrdinalValueAboveOne K) {t : Ordinal} + (ht : t ∈ (Ordinal.log Ordinal.omega0 b.residualValue.val).additivePrincipalTerms) : + Ordinal.log Ordinal.omega0 b.principalValue.val ≤ t := by + have hmem : t ∈ + (Ordinal.log Ordinal.omega0 b.factorOrdinal.1).additivePrincipalTerms := + b.factorOrdinal.mem_terms_of_mem_terms_log_residualFactor (by simpa [residualValue] using ht) + have h := b.factorOrdinal.log_principalFactor_le_of_mem_terms hmem + simpa [principalValue] using h + +/-- The logarithm of the principal value is additive principal. -/ +theorem isAdditivelyPrincipal_log_principalValue (b : SeriesWithOrdinalValueAboveOne K) : + Ordinal.IsAdditivelyPrincipal (Ordinal.log Ordinal.omega0 b.principalValue.val) := by + obtain ⟨e, he⟩ := Ordinal.isInfiniteMultiplicativelyPrincipal_iff.mp + b.principalValue_isInfiniteMultiplicativelyPrincipal + rw [he, Ordinal.log_opow Ordinal.one_lt_omega0] + exact Ordinal.isAdditivelyPrincipal_omega0_opow e + +/-- The principal value is the power of `ω` at that logarithm. -/ +theorem principalValue_val_eq_opow_log (b : SeriesWithOrdinalValueAboveOne K) : + Ordinal.omega0 ^ Ordinal.log Ordinal.omega0 b.principalValue.val = b.principalValue.val := + (b.principalValue_isInfiniteMultiplicativelyPrincipal.isAdditivelyPrincipal).opow_log_self + +/-- The residual value is strictly smaller than the ordinal value. -/ +theorem residualValue_lt_ordinalValue (b : SeriesWithOrdinalValueAboveOne K) : + b.residualValue < ordinalValue b.1 := by + rw [← b.residualValue_mul_principalValue] + simpa only [mul_one] using + mul_lt_mul_of_pos_left b.one_lt_principalValue + (pos_iff_ne_zero.mpr b.residualValue_ne_zero) + +/-- Berarducci, Remark 6.7: a series whose ordinal value is the residual value of `b` has +principal value at least that of `b`. -/ +theorem principalValue_le_of_ordinalValue_eq_residualValue + (b d : SeriesWithOrdinalValueAboveOne K) (hd : ordinalValue d.1 = b.residualValue) : + b.principalValue ≤ d.principalValue := by + have hval : d.factorOrdinal.1 = b.factorOrdinal.residualFactor := by + change (ordinalValue d.1).val = b.factorOrdinal.residualFactor + rw [hd] + rfl + exact NatOrdinal.of.le_iff_le.mpr + (Ordinal.AdditivePrincipalAboveOne.principalFactor_le_principalFactor_of_eq_residualFactor + b.factorOrdinal d.factorOrdinal hval) + +/-- When `v_J(b)` is already infinite multiplicatively principal, it is the principal value. -/ +theorem principalValue_eq_ordinalValue_of_isInfiniteMultiplicativelyPrincipal + (b : SeriesWithOrdinalValueAboveOne K) + (hb : Ordinal.IsInfiniteMultiplicativelyPrincipal (ordinalValue b.1).val) : + b.principalValue = ordinalValue b.1 := by + apply NatOrdinal.val.injective + simp only [principalValue, NatOrdinal.val_of] + exact + b.factorOrdinal.principalFactor_eq_self_of_isInfiniteMultiplicativelyPrincipal hb + +/-- When `v_J(b)` is already infinite multiplicatively principal, the residual value is one. -/ +theorem residualValue_eq_one_of_isInfiniteMultiplicativelyPrincipal + (b : SeriesWithOrdinalValueAboveOne K) + (hb : Ordinal.IsInfiniteMultiplicativelyPrincipal (ordinalValue b.1).val) : + b.residualValue = 1 := by + apply NatOrdinal.val.injective + simp only [residualValue, NatOrdinal.val_of, NatOrdinal.val_one] + exact + b.factorOrdinal.residualFactor_eq_one_of_isInfiniteMultiplicativelyPrincipal hb + +private theorem ordinalValue_isInfiniteMultiplicativelyPrincipal_of_isMultiplicativelyPrincipal + (b : SeriesWithOrdinalValueAboveOne K) + (hb : Ordinal.IsMultiplicativelyPrincipal (ordinalValue b.1).val) : + Ordinal.IsInfiniteMultiplicativelyPrincipal (ordinalValue b.1).val := by + rw [Ordinal.isInfiniteMultiplicativelyPrincipal_iff_two_lt_and_isMultiplicativelyPrincipal] + refine ⟨?_, hb⟩ + have hone : (1 : Ordinal) < (ordinalValue b.1).val := + NatOrdinal.of_lt_iff.mp b.2 + have homega : Ordinal.omega0 ≤ (ordinalValue b.1).val := + (ordinalValue_isAdditivelyPrincipal_of_one_lt b.2).omega0_le_of_one_lt hone + exact (Ordinal.natCast_lt_omega0 2).trans_le homega + +/-- Under Berarducci's exact multiplicative-principality hypothesis, the principal value is the +ordinal value itself. -/ +theorem principalValue_eq_ordinalValue_of_isMultiplicativelyPrincipal + (b : SeriesWithOrdinalValueAboveOne K) + (hb : Ordinal.IsMultiplicativelyPrincipal (ordinalValue b.1).val) : + b.principalValue = ordinalValue b.1 := + b.principalValue_eq_ordinalValue_of_isInfiniteMultiplicativelyPrincipal + (ordinalValue_isInfiniteMultiplicativelyPrincipal_of_isMultiplicativelyPrincipal b hb) + +/-- Under Berarducci's exact multiplicative-principality hypothesis, the residual value is one. -/ +theorem residualValue_eq_one_of_isMultiplicativelyPrincipal + (b : SeriesWithOrdinalValueAboveOne K) + (hb : Ordinal.IsMultiplicativelyPrincipal (ordinalValue b.1).val) : + b.residualValue = 1 := + b.residualValue_eq_one_of_isInfiniteMultiplicativelyPrincipal + (ordinalValue_isInfiniteMultiplicativelyPrincipal_of_isMultiplicativelyPrincipal b hb) + +/-- Conversely, a lower bound on every canonical multiplicative factor of `v_J(c)` is a lower +bound on `v_J^p(c)`. -/ +theorem le_principalValue_of_forall_mem_terms (b c : SeriesWithOrdinalValueAboveOne K) + (h : ∀ t ∈ (Ordinal.log Ordinal.omega0 (ordinalValue c.1).val).additivePrincipalTerms, + Ordinal.log Ordinal.omega0 b.principalValue.val ≤ t) : + b.principalValue ≤ c.principalValue := by + have hmem : Ordinal.log Ordinal.omega0 c.principalValue.val + ∈ (Ordinal.log Ordinal.omega0 (ordinalValue c.1).val).additivePrincipalTerms := by + simpa [principalValue, factorOrdinal] using c.factorOrdinal.log_principalFactor_mem_terms + refine NatOrdinal.val.le_iff_le.mp ?_ + rw [← b.principalValue_val_eq_opow_log, ← c.principalValue_val_eq_opow_log] + exact (Ordinal.opow_le_opow_iff_right Ordinal.one_lt_omega0).mpr (h _ hmem) + +/-- Principal and residual values depend only on the ordinal value of the series. -/ +theorem principalValue_eq_and_residualValue_eq_of_ordinalValue_eq + (b c : SeriesWithOrdinalValueAboveOne K) (hbc : ordinalValue b.1 = ordinalValue c.1) : + b.principalValue = c.principalValue ∧ b.residualValue = c.residualValue := by + have hfactor : b.factorOrdinal = c.factorOrdinal := by + apply Subtype.ext + exact congrArg NatOrdinal.val hbc + constructor + · simp [principalValue, hfactor] + · simp [residualValue, hfactor] + +/-- If `v_J(b) = ω^α` and `α` has positive constant Cantor coefficient, the final +multiplicative factor of `v_J(b)` is `ω`. -/ +theorem principalValue_eq_wpow_one_of_ordinalValue_eq_wpow + (b : SeriesWithOrdinalValueAboveOne K) (alpha : NatOrdinal) + (halpha : 0 < alpha.constantCoeff) (hb : ordinalValue b.1 = ω^ alpha) : + b.principalValue = ω^ (1 : NatOrdinal) := by + apply NatOrdinal.val.injective + simp only [principalValue, NatOrdinal.val_of, NatOrdinal.val_wpow, + NatOrdinal.val_one, Ordinal.opow_one] + change Ordinal.AdditivePrincipalAboveOne.principalFactor + (⟨(ordinalValue b.1).val, + ordinalValue_isAdditivelyPrincipal_of_one_lt b.2, b.2⟩ : + Ordinal.AdditivePrincipalAboveOne) = Ordinal.omega0 + have hbval : (ordinalValue b.1).val = Ordinal.omega0 ^ alpha.val := by + simpa only [NatOrdinal.val_wpow] using congrArg NatOrdinal.val hb + let q : Ordinal.AdditivePrincipalAboveOne := + ⟨Ordinal.omega0 ^ alpha.val, + Ordinal.isAdditivelyPrincipal_omega0_opow alpha.val, + hbval ▸ b.2⟩ + have hfactor : + (⟨(ordinalValue b.1).val, + ordinalValue_isAdditivelyPrincipal_of_one_lt b.2, b.2⟩ : + Ordinal.AdditivePrincipalAboveOne) = q := + Subtype.ext hbval + rw [hfactor] + dsimp only [q] + exact Ordinal.AdditivePrincipalAboveOne.principalFactor_wpow_of_constantCoeff_pos + alpha halpha (Ordinal.isAdditivelyPrincipal_omega0_opow alpha.val) + (hbval ▸ b.2) + +/-- If `v_J(b) = ω^α` and `α` has positive constant Cantor coefficient, deleting the +final multiplicative factor leaves `ω^(α.removeNat 1)`. -/ +theorem residualValue_eq_wpow_removeNat_of_ordinalValue_eq_wpow + (b : SeriesWithOrdinalValueAboveOne K) (alpha : NatOrdinal) + (halpha : 0 < alpha.constantCoeff) (hb : ordinalValue b.1 = ω^ alpha) : + b.residualValue = ω^ (alpha.removeNat 1) := by + apply NatOrdinal.val.injective + simp only [residualValue, NatOrdinal.val_of, NatOrdinal.val_wpow] + change Ordinal.AdditivePrincipalAboveOne.residualFactor + (⟨(ordinalValue b.1).val, + ordinalValue_isAdditivelyPrincipal_of_one_lt b.2, b.2⟩ : + Ordinal.AdditivePrincipalAboveOne) = + Ordinal.omega0 ^ (alpha.removeNat 1).val + have hbval : (ordinalValue b.1).val = Ordinal.omega0 ^ alpha.val := by + simpa only [NatOrdinal.val_wpow] using congrArg NatOrdinal.val hb + let q : Ordinal.AdditivePrincipalAboveOne := + ⟨Ordinal.omega0 ^ alpha.val, + Ordinal.isAdditivelyPrincipal_omega0_opow alpha.val, + hbval ▸ b.2⟩ + have hfactor : + (⟨(ordinalValue b.1).val, + ordinalValue_isAdditivelyPrincipal_of_one_lt b.2, b.2⟩ : + Ordinal.AdditivePrincipalAboveOne) = q := + Subtype.ext hbval + rw [hfactor] + dsimp only [q] + exact Ordinal.AdditivePrincipalAboveOne.residualFactor_wpow_of_constantCoeff_pos + alpha halpha (Ordinal.isAdditivelyPrincipal_omega0_opow alpha.val) + (hbval ▸ b.2) + +theorem residualValue_eq_wpow_removeLeastTerm + (b : SeriesWithOrdinalValueAboveOne K) (alpha : NatOrdinal) + (hb : ordinalValue b.1 = ω^ alpha) : + b.residualValue = ω^ (NatOrdinal.removeLeastTerm alpha) := by + apply NatOrdinal.val.injective + simp only [residualValue, NatOrdinal.val_of, NatOrdinal.val_wpow] + have hbval : (ordinalValue b.1).val = Ordinal.omega0 ^ alpha.val := by + simpa only [NatOrdinal.val_wpow] using congrArg NatOrdinal.val hb + change Ordinal.AdditivePrincipalAboveOne.residualFactor + (⟨(ordinalValue b.1).val, + ordinalValue_isAdditivelyPrincipal_of_one_lt b.2, b.2⟩ : + Ordinal.AdditivePrincipalAboveOne) = _ + have hfactor : + (⟨(ordinalValue b.1).val, + ordinalValue_isAdditivelyPrincipal_of_one_lt b.2, b.2⟩ : + Ordinal.AdditivePrincipalAboveOne) = + (⟨Ordinal.omega0 ^ alpha.val, + Ordinal.isAdditivelyPrincipal_omega0_opow alpha.val, hbval ▸ b.2⟩ : + Ordinal.AdditivePrincipalAboveOne) := + Subtype.ext hbval + rw [hfactor, Ordinal.residualFactor_omega0_opow alpha.val + (Ordinal.isAdditivelyPrincipal_omega0_opow alpha.val) (hbval ▸ b.2), + NatOrdinal.val_removeLeastTerm] + +theorem principalValue_eq_wpow_leastTerm + (b : SeriesWithOrdinalValueAboveOne K) (alpha : NatOrdinal) + (hb : ordinalValue b.1 = ω^ alpha) : + b.principalValue = ω^ (NatOrdinal.leastTerm alpha) := by + have halpha : alpha ≠ 0 := by + intro hzero + rw [hzero, NatOrdinal.wpow_zero] at hb + exact absurd hb b.2.ne' + have hne : alpha.val.additivePrincipalTerms ≠ [] := + NatOrdinal.additivePrincipalTerms_ne_nil halpha + apply NatOrdinal.val.injective + simp only [principalValue, NatOrdinal.val_of, NatOrdinal.val_wpow] + have hbval : (ordinalValue b.1).val = Ordinal.omega0 ^ alpha.val := by + simpa only [NatOrdinal.val_wpow] using congrArg NatOrdinal.val hb + change Ordinal.AdditivePrincipalAboveOne.principalFactor + (⟨(ordinalValue b.1).val, + ordinalValue_isAdditivelyPrincipal_of_one_lt b.2, b.2⟩ : + Ordinal.AdditivePrincipalAboveOne) = _ + have hfactor : + (⟨(ordinalValue b.1).val, + ordinalValue_isAdditivelyPrincipal_of_one_lt b.2, b.2⟩ : + Ordinal.AdditivePrincipalAboveOne) = + (⟨Ordinal.omega0 ^ alpha.val, + Ordinal.isAdditivelyPrincipal_omega0_opow alpha.val, hbval ▸ b.2⟩ : + Ordinal.AdditivePrincipalAboveOne) := + Subtype.ext hbval + rw [hfactor, Ordinal.principalFactor_omega0_opow alpha.val + (Ordinal.isAdditivelyPrincipal_omega0_opow alpha.val) (hbval ▸ b.2) hne, + NatOrdinal.val_leastTerm hne] + +end SeriesWithOrdinalValueAboveOne + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PurePowerRemainder.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PurePowerRemainder.lean new file mode 100644 index 0000000000..172835b6bd --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PurePowerRemainder.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PowerRemainder + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionRemainder + +/-! +# The remainder estimate for pure powers + +Berarducci's induction computes the value of a pure power `b ^ k` by applying Lemma 8.2 with +`c = 1`. That reading is not available: Definition 6.4 defines `v_J^p` only for value above one, +so the hypothesis `v_J^p(b) ≤ v_J^p(c)` of Lemma 8.2 is undefined at `c = 1`. Nor can the case be +absorbed by choosing some other factor for `c`, since the doubling in Lemma 9.5 then raises the +exponent of `b` instead of lowering it. The pure-power case is therefore developed on its own. + +It is strictly easier than the general one. The term carrying the truncation of `c` disappears, +and with it the only use of that hypothesis. At a positive exponent the remainder for `b ^ (m + 1)` +is literally the two-factor remainder for the pair `(b, b)` one step down, so Lemma 7.7 transfers +with no new analysis; at exponent zero the remainder vanishes. +-/ + +universe v + +public noncomputable section + +open HahnSeries Ordinal + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- The remainder in the product rule for `b ^ (m + 1)`. -/ +def powerRemainderOne (b : SeriesWithOrdinalValueAboveOne K) (m : ℕ) (γ : ℝ) : Germ K := + germAt ((b.1 ^ (m + 1) : Series K) : K⟦ℝ⟧) γ + - (m + 1) • (germAt (b.1 : K⟦ℝ⟧) γ * toGerm (b.1 ^ m)) + +/-- The bound on that remainder. -/ +def powerRemainderBoundOne (b : SeriesWithOrdinalValueAboveOne K) (m : ℕ) : NatOrdinal := + ordinalValue b.1 ^ m * b.residualValue + +theorem powerRemainderBoundOne_eq (b : SeriesWithOrdinalValueAboveOne K) (m : ℕ) : + powerRemainderBoundOne b m = ordinalValue b.1 ^ m * b.residualValue := (rfl) + +/-- The defining decomposition, read as an expansion of the germ. -/ +theorem germAt_purePower_decomp (b : SeriesWithOrdinalValueAboveOne K) (m : ℕ) (ξ : ℝ) : + germAt ((b.1 ^ (m + 1) : Series K) : K⟦ℝ⟧) ξ = + (m + 1) • (germAt (b.1 : K⟦ℝ⟧) ξ * toGerm (b.1 ^ m)) + powerRemainderOne b m ξ := by + rw [powerRemainderOne] + abel + +/-- Taking both factors equal shifts the two-factor bound by one exponent. -/ +theorem powerRemainderBound_self (b : SeriesWithOrdinalValueAboveOne K) (m : ℕ) : + powerRemainderBound b b m = powerRemainderBoundOne b (m + 1) := by + rw [powerRemainderBound_eq, powerRemainderBoundOne_eq, pow_succ] + ring + +/-- Taking both factors equal shifts the two-factor remainder by one exponent. -/ +theorem powerRemainderOne_succ (b : SeriesWithOrdinalValueAboveOne K) (m : ℕ) (γ : ℝ) : + powerRemainderOne b (m + 1) γ = powerRemainder b b m γ := by + rw [powerRemainderOne, powerRemainder_eq] + simp only [← pow_succ] + rw [mul_comm (toGerm (b.1 ^ (m + 1))) (germAt (b.1 : K⟦ℝ⟧) γ), succ_nsmul] + abel + +/-- Berarducci, Lemma 7.7 for a pure power. -/ +theorem exists_powerRemainderOne_lt (b : SeriesWithOrdinalValueAboveOne K) (m : ℕ) : + ∃ η < (0 : ℝ), ∀ γ : ℝ, η < γ → γ < 0 → + germOrdinalValue (powerRemainderOne b m γ) < powerRemainderBoundOne b m := by + cases m with + | zero => + refine ⟨-1, by norm_num, fun γ _ _ ↦ ?_⟩ + have hzero : powerRemainderOne b 0 γ = 0 := by + rw [powerRemainderOne] + simp + rw [hzero, germOrdinalValue_zero, powerRemainderBoundOne_eq, pow_zero, one_mul] + exact pos_iff_ne_zero.mpr b.residualValue_ne_zero + | succ n => + obtain ⟨η, hη, h⟩ := exists_powerRemainder_lt b b le_rfl n + refine ⟨η, hη, fun γ hlow hhigh ↦ ?_⟩ + rw [powerRemainderOne_succ, ← powerRemainderBound_self] + exact h γ hlow hhigh + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPoint.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPoint.lean new file mode 100644 index 0000000000..d92831bc1c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPoint.lean @@ -0,0 +1,125 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation + +/-! +# Berarducci residual points + +For a nonpositive real Hahn series `b` with `1 < v_J(b)`, Berarducci, Definition 6.6 defines +`X(b)` to consist of the strictly negative exponents `γ` for which the translated closed +truncation `b^{|γ}` has ordinal value equal to the residual value of `b`. + +The definition below uses the exact domain already imposed on principal and residual values. Its +strict inequality `γ < 0`, closed truncation at `γ`, and equality with the residual value are +all part of the carrier. In later statements, the source phrase "sufficiently close to zero" is +represented by `nhdsWithin 0 (Set.Iio 0)`, Mathlib's left-neighborhood filter; no separate +informal predicate is introduced. + +When `v_J(b)` satisfies Berarducci's exact multiplicative-principality predicate, its residual +value is one. The corresponding theorem recovers the description immediately following +Definition 6.6. + +-/ + +universe v + +open scoped HahnSeries + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- The set `X(b)` of residual points from Berarducci, Definition 6.6. -/ +def residualPointSet (b : SeriesWithOrdinalValueAboveOne K) : Set ℝ := + {γ | γ < 0 ∧ + ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) γ) = b.residualValue} + +/-- Membership in `X(b)` is the conjunction printed in Berarducci, Definition 6.6. -/ +theorem mem_residualPointSet_iff {b : SeriesWithOrdinalValueAboveOne K} {γ : ℝ} : + γ ∈ residualPointSet b ↔ + γ < 0 ∧ + ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) γ) = b.residualValue := + (Iff.rfl) + +/-- Every residual point is strictly negative. -/ +theorem residualPointSet_subset_Iio (b : SeriesWithOrdinalValueAboveOne K) : + residualPointSet b ⊆ Set.Iio 0 := + fun _ hγ ↦ hγ.1 + +/-- At zero, the translated truncation has the value of the original series, which is strictly +larger than its residual value. -/ +theorem ordinalValue_translatedTruncation_zero_ne_residualValue + (b : SeriesWithOrdinalValueAboveOne K) : + ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) 0) ≠ b.residualValue := by + rw [translatedTruncation_zero] + exact ne_of_gt b.residualValue_lt_ordinalValue + +/-- On the domain `1 < v_J(b)`, the value equality already excludes zero. Thus replacing the +printed condition `γ < 0` by `γ ≤ 0` gives an extensionally equal set, although the defining +characteristic theorem retains Berarducci's strict inequality. -/ +theorem mem_residualPointSet_iff_le_zero + {b : SeriesWithOrdinalValueAboveOne K} {γ : ℝ} : + γ ∈ residualPointSet b ↔ + γ ≤ 0 ∧ ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) γ) = b.residualValue := by + constructor + · rintro ⟨hγ, hvalue⟩ + exact ⟨hγ.le, hvalue⟩ + · rintro ⟨hγ, hvalue⟩ + apply mem_residualPointSet_iff.mpr + refine ⟨lt_of_le_of_ne hγ ?_, hvalue⟩ + intro hzero + subst γ + exact ordinalValue_translatedTruncation_zero_ne_residualValue b hvalue + +/-- Zero is not a residual point. -/ +@[simp] +theorem zero_not_mem_residualPointSet (b : SeriesWithOrdinalValueAboveOne K) : + (0 : ℝ) ∉ residualPointSet b := + fun hzero ↦ (mem_residualPointSet_iff.mp hzero).1.false + +/-- At a residual point, the translated truncation does not belong to the negative-monomial +ideal. -/ +theorem translatedTruncation_not_mem_negativeMonomialIdeal_of_mem_residualPointSet + {b : SeriesWithOrdinalValueAboveOne K} {γ : ℝ} + (hγ : γ ∈ residualPointSet b) : + translatedTruncation (b.1 : K⟦ℝ⟧) γ ∉ + HahnSeries.Nonpositive.negativeMonomialIdeal K := by + intro hmem + have hzero := ordinalValue_of_mem_negativeMonomialIdeal hmem + have hresidual := (mem_residualPointSet_iff.mp hγ).2 + exact b.residualValue_ne_zero (hresidual.symm.trans hzero) + +/-- At a residual point, the translated truncation has support supremum zero. -/ +theorem supportSup_translatedTruncation_eq_zero_of_mem_residualPointSet + {b : SeriesWithOrdinalValueAboveOne K} {γ : ℝ} + (hγ : γ ∈ residualPointSet b) : + HahnSeries.Nonpositive.supportSup (translatedTruncation (b.1 : K⟦ℝ⟧) γ) = 0 := by + apply le_antisymm + · exact HahnSeries.Nonpositive.supportSup_le_zero _ + · apply le_of_not_gt + intro hlt + have hmem : translatedTruncation (b.1 : K⟦ℝ⟧) γ ∈ + HahnSeries.Nonpositive.negativeMonomialIdeal K := + HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero.mpr hlt + exact translatedTruncation_not_mem_negativeMonomialIdeal_of_mem_residualPointSet hγ hmem + +/-- If `v_J(b)` is multiplicatively principal, `X(b)` consists exactly of the strictly negative +exponents whose translated truncations have value one. -/ +theorem residualPointSet_eq_setOf_ordinalValue_eq_one_of_isMultiplicativelyPrincipal + (b : SeriesWithOrdinalValueAboveOne K) + (hb : Ordinal.IsMultiplicativelyPrincipal (ordinalValue b.1).val) : + residualPointSet b = + {γ : ℝ | γ < 0 ∧ ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) γ) = 1} := by + ext γ + rw [mem_residualPointSet_iff, Set.mem_setOf_eq, + b.residualValue_eq_one_of_isMultiplicativelyPrincipal hb] + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointCofinality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointCofinality.lean new file mode 100644 index 0000000000..742735faac --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointCofinality.lean @@ -0,0 +1,421 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPoint + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval +import Mathlib.Order.Bounds.OrderIso +import Mathlib.SetTheory.Ordinal.Arithmetic +import Mathlib.Tactic.Linarith + +/-! +# Cofinality of Berarducci residual points + +This module proves the first conclusion of Berarducci, Lemma 6.8: for a nonpositive real Hahn +series `b` with `1 < v_J(b)`, the residual-point set `X(b)` has least upper bound zero. + +Write `v_J(b) = ρ l`, where `ρ` is the residual value and `l` is the principal value. When +`1 < ρ`, the proof extracts, above any prescribed negative cutoff, a final support block of +ordinary order type `ρ`. Its real supremum is a residual point because translation makes that +block a stable interval of the germ. + +The case `ρ = 1` requires a separate argument. Berarducci's proof takes the supremum of the +first `ρ(α + 1)` support elements and states that the resulting germ has value `ρ`. For +`ρ = 1` and limit `α`, that supremum can be an attained limit point, whose germ need not have +value one. The theorem is repaired without changing its statement: above any cutoff, take the +least later support exponent. It is isolated from below, so its germ lies in `(J + K) \ J` and +has value one. + +-/ + +universe v + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace Berarducci + +open HahnSeries + +variable {K : Type v} [Field K] + +private theorem ordinalValue_translatedTruncation_eq_one_of_isolatedBelow + (b : Series K) {z y : ℝ} + (hySupport : y ∈ (b : K⟦ℝ⟧).support) (hzy : z < y) + (hgap : (b : K⟦ℝ⟧).support ∩ Set.Ioo z y = ∅) : + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) y) = 1 := by + apply ordinalValue_eq_one_iff.mpr + constructor + · rw [mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem] + rw [HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero] + let q := translatedTruncation (b : K⟦ℝ⟧) y - + HahnSeries.Nonpositive.C + (HahnSeries.Nonpositive.constantCoeff (translatedTruncation (b : K⟦ℝ⟧) y)) + change HahnSeries.Nonpositive.supportSup q < 0 + by_cases hq : q = 0 + · simp [hq] + · rw [HahnSeries.Nonpositive.supportSup_of_ne hq] + apply WithBot.coe_lt_coe.mpr + refine (csSup_le (HahnSeries.support_nonempty_iff.mpr ?_) ?_).trans_lt + (sub_neg.mpr hzy) + · simpa using hq + · intro δ hδSupport + apply le_of_not_gt + intro hzyδ + have hδ0 : δ ≤ 0 := HahnSeries.Nonpositive.support_subset q hδSupport + rcases hδ0.eq_or_lt with rfl | hδ0 + · have hcoeff : (q : K⟦ℝ⟧).coeff 0 = 0 := by + simp [q] + exact (HahnSeries.mem_support _ _).mp hδSupport hcoeff + · have hbySupport : y + δ ∈ (b : K⟦ℝ⟧).support := by + rw [HahnSeries.mem_support] + have hcoeff : (q : K⟦ℝ⟧).coeff δ = + (b : K⟦ℝ⟧).coeff (y + δ) := by + simp [q, hδ0.le, hδ0.ne] + rw [← hcoeff] + exact (HahnSeries.mem_support _ _).mp hδSupport + have hby : y + δ < y := by linarith + have hzby : z < y + δ := by linarith + have : y + δ ∈ (b : K⟦ℝ⟧).support ∩ Set.Ioo z y := + ⟨hbySupport, hzby, hby⟩ + simp [hgap] at this + · intro hmem + have hconstant := constantCoeff_eq_zero_of_mem_negativeMonomialIdeal hmem + have hyCoeff : (b : K⟦ℝ⟧).coeff y ≠ 0 := + (HahnSeries.mem_support _ _).mp hySupport + apply hyCoeff + simpa [HahnSeries.Nonpositive.constantCoeff_apply] using hconstant + +private theorem isLUB_negativeSupport_translatedTruncation_of_cofinal_support + (b : Series K) {gamma : ℝ} {B : Set ℝ} + (hBSupport : B ⊆ (b : K⟦ℝ⟧).support) + (hBlt : ∀ x ∈ B, x < gamma) (hBLUB : IsLUB B gamma) : + IsLUB + (((translatedTruncation (b : K⟦ℝ⟧) gamma : Series K) : K⟦ℝ⟧).support ∩ + Set.Iio 0) 0 := by + have hshiftedLUB : IsLUB ((fun x ↦ -gamma + x) '' B) 0 := by + simpa using (OrderIso.addLeft (-gamma)).isLUB_image'.mpr hBLUB + have hshiftedSubset : (fun x ↦ -gamma + x) '' B ⊆ + ((translatedTruncation (b : K⟦ℝ⟧) gamma : Series K) : K⟦ℝ⟧).support ∩ + Set.Iio 0 := by + rintro delta ⟨x, hxB, rfl⟩ + have hxCoeff : (b : K⟦ℝ⟧).coeff x ≠ 0 := + (HahnSeries.mem_support _ _).mp (hBSupport hxB) + have hdelta0 : -gamma + x < 0 := by + linarith [hBlt x hxB] + constructor + · rw [HahnSeries.mem_support, coeff_translatedTruncation, if_pos hdelta0.le] + simpa using hxCoeff + · exact hdelta0 + constructor + · intro delta hdelta + exact hdelta.2.le + · intro x hxUpper + apply hshiftedLUB.2 + intro delta hdelta + exact hxUpper (hshiftedSubset hdelta) + +private theorem exists_cofinal_final_block_of_orderType_eq_mul + {T : Set ℝ} (hT : T.IsPWO) (hT0 : T ⊆ Set.Iio 0) + (hTLUB : IsLUB T 0) {rho l : Ordinal} + (hrho : 0 < rho) (hl : Order.IsSuccLimit l) + (hTType : hT.orderType = rho * l) {a : ℝ} (ha : a < 0) : + ∃ (gamma : ℝ) (B : Set ℝ) (hB : B.IsPWO), + a < gamma ∧ gamma < 0 ∧ B ⊆ T ∧ hB.orderType = rho ∧ + IsLUB B gamma ∧ + ∀ {x}, x ∈ B → ∀ {y}, y ∈ T → x < y → y < gamma → y ∈ B := by + obtain ⟨z, hzT, haz, _⟩ := hTLUB.exists_between ha + let hBelow : (T ∩ Set.Iio z).IsPWO := hT.mono Set.inter_subset_left + have hBelowLt : hBelow.orderType < rho * l := by + rw [← hTType] + exact hT.orderType_inter_Iio_lt hzT + obtain ⟨c, hc, hBelowMul⟩ := + (Ordinal.lt_mul_iff_of_isSuccLimit hl).mp hBelowLt + let k := rho * Order.succ c + have hck : rho * c ≤ k := + mul_le_mul_right (Order.le_succ c) rho + have hBelowK : hBelow.orderType < k := hBelowMul.trans_le hck + have hkType : k < hT.orderType := by + rw [hTType] + exact mul_lt_mul_of_pos_left (hl.succ_lt hc) hrho + let d := hT.orderType - k + have hkd : k + d = hT.orderType := + Ordinal.add_sub_cancel_of_le hkType.le + obtain ⟨S, U, hS, hU, hST, hUT, hSU, hSType, hUType, hTUnion⟩ := + (hT.orderType_eq_add_iff k d).mp hkd.symm + have hzS : z ∈ S := by + have hzUnion : z ∈ S ∪ U := by + rw [← hTUnion] + exact hzT + rcases hzUnion with hzS | hzU + · exact hzS + · exfalso + have hSBelow : S ⊆ T ∩ Set.Iio z := by + intro x hxS + exact ⟨hST hxS, hSU x hxS z hzU⟩ + have hle := hS.orderType_mono hBelow hSBelow + rw [hSType] at hle + exact (not_lt_of_ge hle) hBelowK + have hSne : S.Nonempty := ⟨z, hzS⟩ + have hdne : d ≠ 0 := Ordinal.sub_ne_zero_iff_lt.mpr hkType + have hUne : U.Nonempty := by + apply Set.nonempty_iff_ne_empty.mpr + intro hUempty + have hzero := hU.orderType_eq_zero.mpr hUempty + rw [hUType] at hzero + exact hdne hzero + obtain ⟨u, huU⟩ := hUne + have hSbdd : BddAbove S := + ⟨u, fun x hxS ↦ (hSU x hxS u huU).le⟩ + let gamma := sSup S + have hSLUB : IsLUB S gamma := isLUB_csSup hSne hSbdd + have hgamma0 : gamma < 0 := + (hSLUB.2 fun x hxS ↦ (hSU x hxS u huU).le).trans_lt (hT0 (hUT huU)) + have hagamma : a < gamma := haz.trans_le (hSLUB.1 hzS) + have hSTypeSplit : hS.orderType = rho * c + rho := by + rw [hSType] + simp only [k, Ordinal.mul_succ] + obtain ⟨A, B, hA, hB, hAS, hBS, hAB, hAType, hBType, hSUnion⟩ := + (hS.orderType_eq_add_iff (rho * c) rho).mp hSTypeSplit + have hBne : B.Nonempty := by + apply Set.nonempty_iff_ne_empty.mpr + intro hBempty + have hzero := hB.orderType_eq_zero.mpr hBempty + rw [hBType] at hzero + exact hrho.ne' hzero + obtain ⟨b0, hb0B⟩ := hBne + have hBLUB : IsLUB B gamma := by + constructor + · intro x hxB + exact hSLUB.1 (hBS hxB) + · intro x hxUpper + apply hSLUB.2 + intro y hyS + rw [hSUnion] at hyS + rcases hyS with hyA | hyB + · exact (hAB y hyA b0 hb0B).le.trans (hxUpper hb0B) + · exact hxUpper hyB + refine ⟨gamma, B, hB, hagamma, hgamma0, hBS.trans hST, hBType, hBLUB, ?_⟩ + intro x hxB y hyT hxy hygamma + have hyUnion : y ∈ S ∪ U := by + rw [← hTUnion] + exact hyT + rcases hyUnion with hyS | hyU + · rw [hSUnion] at hyS + rcases hyS with hyA | hyB + · exfalso + exact (not_lt_of_ge (hAB y hyA x hxB).le) hxy + · exact hyB + · exfalso + have hgammaY : gamma ≤ y := + hSLUB.2 fun s hsS ↦ (hSU s hsS y hyU).le + exact (not_lt_of_ge hgammaY) hygamma + +private theorem ordinalValue_translatedTruncation_eq_of_cofinal_final_block + (b : Series K) {eta gamma : ℝ} (rho : NatOrdinal) + (hrhoPrincipal : Ordinal.IsAdditivelyPrincipal rho.val) + (hrho : 1 < rho) {B : Set ℝ} (hB : B.IsPWO) + (hBSub : B ⊆ negativeSupportTail b eta) + (hBType : hB.orderType = rho.val) (hBLUB : IsLUB B gamma) + (hgamma0 : gamma < 0) + (hfinal : ∀ {x}, x ∈ B → ∀ {y}, y ∈ negativeSupportTail b eta → + x < y → y < gamma → y ∈ B) : + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) gamma) = rho := by + have hrhoVal : 1 < rho.val := NatOrdinal.one_lt_val.mpr hrho + have hrhoLimit : Order.IsSuccLimit rho.val := + hrhoPrincipal.isSuccLimit_of_one_lt hrhoVal + have hBOrderLimit : Order.IsSuccLimit hB.orderType := by + rw [hBType] + exact hrhoLimit + have hBne : B.Nonempty := by + apply Set.nonempty_iff_ne_empty.mpr + intro hBempty + have hzero := hB.orderType_eq_zero.mpr hBempty + rw [hBType] at hzero + exact (zero_lt_one.trans hrhoVal).ne' hzero + have hBlt : ∀ x ∈ B, x < gamma := by + intro x hxB + obtain ⟨y, hyB, hxy⟩ := + hB.exists_gt_of_isSuccLimit_orderType hBOrderLimit hxB + exact hxy.trans_le (hBLUB.1 hyB) + let q : Series K := translatedTruncation (b : K⟦ℝ⟧) gamma + have hqLUB : IsLUB ((q : K⟦ℝ⟧).support ∩ Set.Iio 0) 0 := by + apply isLUB_negativeSupport_translatedTruncation_of_cofinal_support b + (B := B) (gamma := gamma) + · exact fun _ hxB ↦ negativeSupportTail_subset_support b eta (hBSub hxB) + · exact hBlt + · exact hBLUB + have hqValue : 1 < ordinalValue q := + one_lt_ordinalValue_of_isLUB_negativeSupport hqLUB + obtain ⟨theta, htheta, hstable⟩ := + exists_forall_later_negativeSupportTail_orderType_eq_ordinalValue q hqValue + obtain ⟨b0, hb0B⟩ := hBne + have hb0gamma : b0 < gamma := hBlt b0 hb0B + have hthetaGamma : gamma + theta < gamma := by linarith + have hmaxGamma : max (gamma + theta) b0 < gamma := + max_lt hthetaGamma hb0gamma + obtain ⟨x, hxB, hmaxX, _⟩ := hBLUB.exists_between hmaxGamma + have hxgamma : x < gamma := hBlt x hxB + let xi := x - gamma + have hthetaXi : theta < xi := by + have hgammaThetaX : gamma + theta < x := + (le_max_left (gamma + theta) b0).trans_lt hmaxX + dsimp only [xi] + linarith + have hxi0 : xi < 0 := by + dsimp only [xi] + linarith + let BFinal := B ∩ Set.Ioi x + let hBFinal : BFinal.IsPWO := hB.mono Set.inter_subset_left + have hBUpper : ∃ y ∈ B, x < y := + hB.exists_gt_of_isSuccLimit_orderType hBOrderLimit hxB + have hBPrincipal : Ordinal.IsPrincipal (fun a b ↦ a + b) hB.orderType := by + rw [hBType] + exact + (Ordinal.isAdditivelyPrincipal_iff_ne_zero_and_isPrincipal_add.mp + hrhoPrincipal).2 + have hBFinalType : hBFinal.orderType = hB.orderType := + hB.orderType_inter_Ioi_eq_of_isPrincipal hBPrincipal hBUpper + have hsupport : negativeSupportTail q xi = + (fun y ↦ -gamma + y) '' BFinal := by + ext delta + constructor + · intro hdelta + obtain ⟨hdeltaSupport, hxiDelta, hdelta0⟩ := + mem_negativeSupportTail_iff.mp hdelta + rw [support_translatedTruncation] at hdeltaSupport + obtain ⟨y, hySupport, hdelta⟩ := hdeltaSupport + have hxy : x < y := by + dsimp only [xi] at hxiDelta + linarith + have hygamma : y < gamma := by linarith + have hyTail : y ∈ negativeSupportTail b eta := by + apply mem_negativeSupportTail_iff.mpr + exact ⟨hySupport.1, + (mem_negativeSupportTail_iff.mp (hBSub hxB)).2.1.trans hxy, + hygamma.trans hgamma0⟩ + have hyB : y ∈ B := hfinal hxB hyTail hxy hygamma + exact ⟨y, ⟨hyB, hxy⟩, hdelta⟩ + · rintro ⟨y, ⟨hyB, hxy⟩, rfl⟩ + change x < y at hxy + have hygamma : y < gamma := hBlt y hyB + apply mem_negativeSupportTail_iff.mpr + constructor + · rw [support_translatedTruncation] + exact ⟨y, + ⟨negativeSupportTail_subset_support b eta (hBSub hyB), hygamma.le⟩, rfl⟩ + · constructor + · dsimp only [xi] + linarith + · linarith + let hShifted : ((fun y ↦ -gamma + y) '' BFinal).IsPWO := + hBFinal.image_of_monotone (OrderIso.addLeft (-gamma)).monotone + let hQTail : (negativeSupportTail q xi).IsPWO := + (q : K⟦ℝ⟧).isPWO_support.mono (negativeSupportTail_subset_support q xi) + apply NatOrdinal.val.injective + calc + (ordinalValue (translatedTruncation (b : K⟦ℝ⟧) gamma)).val = + (ordinalValue q).val := rfl + _ = hQTail.orderType := (hstable xi hthetaXi hxi0).symm + _ = hShifted.orderType := hQTail.orderType_congr hShifted hsupport + _ = hBFinal.orderType := + hBFinal.orderType_image_of_strictMonoOn + ((OrderIso.addLeft (-gamma)).strictMono.strictMonoOn BFinal) + _ = hB.orderType := hBFinalType + _ = rho.val := hBType + +private theorem residualPointSet_isLUB_zero_of_residualValue_eq_one + (b : SeriesWithOrdinalValueAboveOne K) (hresidual : b.residualValue = 1) : + IsLUB (residualPointSet b) 0 := by + obtain ⟨eta, heta, _⟩ := + exists_negativeSupportTail_orderType_eq_ordinalValue b.1 b.2 + have htailLUB := + isLUB_negativeSupportTail_zero_of_one_lt_ordinalValue b.1 b.2 heta + refine ⟨fun _ hx ↦ (residualPointSet_subset_Iio b hx).le, ?_⟩ + intro a ha + apply le_of_not_gt + intro ha0 + obtain ⟨z, hzTail, haz, _⟩ := htailLUB.exists_between ha0 + have hzTail' := mem_negativeSupportTail_iff.mp hzTail + obtain ⟨w, hwTail, hzw, _⟩ := htailLUB.exists_between hzTail'.2.2 + let laterSupport := negativeSupportTail b.1 eta ∩ Set.Ioi z + have hlaterPWO : laterSupport.IsPWO := + (b.1 : K⟦ℝ⟧).isPWO_support.mono fun _ hx ↦ + negativeSupportTail_subset_support b.1 eta hx.1 + have hwLater : w ∈ laterSupport := ⟨hwTail, hzw⟩ + obtain ⟨y, hyMinimal⟩ := hlaterPWO.exists_minimal ⟨w, hwLater⟩ + have hyTail : y ∈ negativeSupportTail b.1 eta := hyMinimal.1.1 + have hyTail' := mem_negativeSupportTail_iff.mp hyTail + have hzy : z < y := hyMinimal.1.2 + have hgap : (b.1 : K⟦ℝ⟧).support ∩ Set.Ioo z y = ∅ := by + apply Set.eq_empty_iff_forall_notMem.mpr + intro x hx + have hxLater : x ∈ laterSupport := by + refine ⟨?_, hx.2.1⟩ + apply mem_negativeSupportTail_iff.mpr + exact ⟨hx.1, hzTail'.2.1.trans hx.2.1, hx.2.2.trans hyTail'.2.2⟩ + exact (not_lt_of_ge (hyMinimal.le hxLater)) hx.2.2 + have hyValue : ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) y) = 1 := + ordinalValue_translatedTruncation_eq_one_of_isolatedBelow b.1 hyTail'.1 hzy hgap + have hyResidual : y ∈ residualPointSet b := by + apply mem_residualPointSet_iff.mpr + exact ⟨hyTail'.2.2, hyValue.trans hresidual.symm⟩ + exact (not_lt_of_ge (ha hyResidual)) (haz.trans hzy) + +private theorem residualPointSet_isLUB_zero_of_one_lt_residualValue + (b : SeriesWithOrdinalValueAboveOne K) (hresidual : 1 < b.residualValue) : + IsLUB (residualPointSet b) 0 := by + obtain ⟨eta, heta, hstable⟩ := + exists_negativeSupportTail_orderType_eq_ordinalValue b.1 b.2 + let T := negativeSupportTail b.1 eta + let hT : T.IsPWO := + (b.1 : K⟦ℝ⟧).isPWO_support.mono (negativeSupportTail_subset_support b.1 eta) + have hT0 : T ⊆ Set.Iio 0 := fun _ hx ↦ + (mem_negativeSupportTail_iff.mp hx).2.2 + have hTLUB : IsLUB T 0 := + isLUB_negativeSupportTail_zero_of_one_lt_ordinalValue b.1 b.2 heta + have hTType : hT.orderType = + b.residualValue.val * b.principalValue.val := + hstable.trans b.residualValue_val_mul_principalValue_val.symm + have hresidualVal : 1 < b.residualValue.val := + NatOrdinal.one_lt_val.mpr hresidual + have hresidualPos : 0 < b.residualValue.val := + zero_lt_one.trans hresidualVal + have hprincipalLimit : Order.IsSuccLimit b.principalValue.val := + b.principalValue_isInfiniteMultiplicativelyPrincipal.isSuccLimit + refine ⟨fun _ hx ↦ (residualPointSet_subset_Iio b hx).le, ?_⟩ + intro a haUpper + apply le_of_not_gt + intro ha0 + have hmax0 : max a eta < 0 := max_lt ha0 heta + obtain ⟨gamma, B, hB, hmaxGamma, hgamma0, hBSub, hBType, hBLUB, hfinal⟩ := + exists_cofinal_final_block_of_orderType_eq_mul hT hT0 hTLUB + hresidualPos hprincipalLimit hTType hmax0 + have hgammaValue : + ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) gamma) = b.residualValue := + ordinalValue_translatedTruncation_eq_of_cofinal_final_block b.1 b.residualValue + b.residualValue_isAdditivelyPrincipal hresidual hB hBSub hBType hBLUB + hgamma0 hfinal + have hgammaResidual : gamma ∈ residualPointSet b := + mem_residualPointSet_iff.mpr ⟨hgamma0, hgammaValue⟩ + have hagamma : a < gamma := + (le_max_left a eta).trans_lt hmaxGamma + exact (not_lt_of_ge (haUpper hgammaResidual)) hagamma + +/-- The residual-point set has zero as its least upper bound. This is the cofinality conclusion in +the first part of Berarducci, Lemma 6.8. -/ +theorem residualPointSet_isLUB_zero (b : SeriesWithOrdinalValueAboveOne K) : + IsLUB (residualPointSet b) 0 := by + have honeLe : 1 ≤ b.residualValue := by + rw [Order.one_le_iff_pos] + exact pos_iff_ne_zero.mpr b.residualValue_ne_zero + rcases honeLe.eq_or_lt with hone | hone + · exact residualPointSet_isLUB_zero_of_residualValue_eq_one b hone.symm + · exact residualPointSet_isLUB_zero_of_one_lt_residualValue b hone + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointOrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointOrderType.lean new file mode 100644 index 0000000000..a52494a5b8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointOrderType.lean @@ -0,0 +1,650 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointTail +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval +public import Mathlib.Topology.MetricSpace.Pseudo.Defs + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointCofinality +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.OrderedUnion +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood +import Mathlib.Topology.Instances.Real.Lemmas + +/-! +# The residual-point tail order type + +The order-type computation in Berarducci, Lemma 6.8: on a stable interval, the ordinary order type +of a residual-point tail is exactly `v_J^p(b)`. + +The support of `b` restricted to the stable interval is covered by the truncations at the residual +points of the tail. Every residual point has translated-truncation value `v_J^r(b)`, so every +nonempty final segment of each piece has order type at least `v_J^r(b)`, and consecutive pieces +are strictly separated because the truncation at a residual point has support supremum zero. The +ordered-union estimate of Berarducci, Lemma 4.7 then bounds `v_J^r(b) * λ` by the order type of +the stable interval, which is `v_J^r(b) * v_J^p(b)`, and left cancellation gives `λ ≤ v_J^p(b)`. + +The residual value one is treated separately: the pieces are then closed at their right endpoint, +since a residual point of value one is an isolated support point and admits no support point +immediately below it, and the final-segment hypothesis is the trivial nonemptiness bound. + +For the reverse bound the source constructs, for each `α < v_J^p(b)`, the supremum of the first +`v_J^r(b) * (α + 1)` elements of the stable interval and asserts that it is a residual point. That +construction can fail when `v_J^r(b) = 1` and `α` is a limit: the supremum is then the `α`-th +support point, which need not be isolated from below. If it is a limit of earlier support points, +as at the final point of a support block of order type `ω + 1`, its translated truncation has +value above one. Thus the printed construction does not establish the asserted residuality in +general. The conclusion is unaffected, and this module proves it by splitting on the residual +value. For residual value above one the printed construction is used, and the first +`v_J^r(b) * (α + 1)` elements have limit order type, so their supremum is not attained and every +window below it is a nonempty final segment of order type at least `v_J^r(b)`. For residual value +one the residual points are exactly the isolated support points, and the successor-indexed support +points supply a strictly increasing family of the required order type, which is Berarducci, +Lemma 4.6. +-/ + +universe v + +public noncomputable section + +open Ordinal HahnSeries + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- The residual points of a tail accumulate at `0`, so every residual point of the tail has a +larger one, and the ordinary order type of the tail is a limit ordinal. -/ +private theorem residualPointTail_orderType_isSuccLimit + (b : SeriesWithOrdinalValueAboveOne K) (hX : (residualPointSet b).IsPWO) + {η : ℝ} (hη : η < 0) : + Order.IsSuccLimit (residualPointTail_isPWO b η hX).orderType := by + obtain ⟨htailNe, htailLUB⟩ := + residualPointTail_nonempty_and_isLUB b hη (residualPointSet_isLUB_zero b) + refine Set.IsPWO.isSuccLimit_orderType_of_forall_exists_gt _ htailNe fun x hx ↦ ?_ + have hx0 : x < 0 := + residualPointSet_subset_Iio b (residualPointTail_subset_residualPointSet b η hx) + obtain ⟨y, hy, hxy, _⟩ := htailLUB.exists_between hx0 + exact ⟨y, hy, hxy⟩ + +/-- Between a point `θ` and a residual point `γ' > θ` there is a support point of `b` in the +half-open interval `(θ, γ']`, because the translated truncation at a residual point has support +supremum `0`. -/ +private theorem exists_mem_support_Ioc_of_lt_of_mem_residualPointSet + (b : SeriesWithOrdinalValueAboveOne K) {θ γ' : ℝ} (hγ' : γ' ∈ residualPointSet b) + (hθ : θ < γ') : ∃ y ∈ (b.1 : K⟦ℝ⟧).support, θ < y ∧ y ≤ γ' := by + have hsup := supportSup_translatedTruncation_eq_zero_of_mem_residualPointSet hγ' + have hLUB := (HahnSeries.Nonpositive.supportSup_eq_coe_iff.mp hsup).2 + have hcut : θ - γ' < 0 := sub_neg.mpr hθ + obtain ⟨δ, hδ, hδabove, _⟩ := hLUB.exists_between hcut + rw [support_translatedTruncation] at hδ + obtain ⟨y, hy, hyeq⟩ := hδ + rw [← hyeq] at hδabove + refine ⟨y, hy.1, ?_, hy.2⟩ + change -γ' + y > θ - γ' at hδabove + linarith + +/-- If the translated truncation at `γ'` has ordinal value above one, then between a point +`θ < γ'` and `γ'` there is a support point of `b` in the open interval `(θ, γ')`, because the +negative support of that truncation has supremum `0`. -/ +private theorem exists_mem_support_Ioo_of_lt_of_one_lt_ordinalValue + (b : SeriesWithOrdinalValueAboveOne K) {θ γ' : ℝ} + (hγ' : 1 < ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) γ')) (hθ : θ < γ') : + ∃ y ∈ (b.1 : K⟦ℝ⟧).support, θ < y ∧ y < γ' := by + have hLUB := isLUB_negativeSupport_zero_of_one_lt_ordinalValue hγ' + have hcut : θ - γ' < 0 := sub_neg.mpr hθ + obtain ⟨δ, hδ, hδabove, _⟩ := hLUB.exists_between hcut + rw [support_translatedTruncation] at hδ + obtain ⟨⟨y, hy, hyeq⟩, hδneg⟩ := hδ + rw [← hyeq] at hδabove hδneg + refine ⟨y, hy.1, ?_, ?_⟩ + · change -γ' + y > θ - γ' at hδabove + linarith + · change -γ' + y < 0 at hδneg + linarith + +/-- A nonempty final segment of the support of `b` in `(η, γ')`, for a residual point `γ'`, has +order type at least the residual value: it is a final segment of the support below `γ'`, and +those have order type at least the value of the translated truncation at `γ'`. -/ +private theorem residualValue_le_orderType_of_isRelUpperSet_support_Ioo + (b : SeriesWithOrdinalValueAboveOne K) {η γ' : ℝ} (hγ' : γ' ∈ residualPointSet b) + {C : Set ℝ} (hC : IsRelUpperSet C (· ∈ (b.1 : K⟦ℝ⟧).support ∩ Set.Ioo η γ')) + (hCne : C.Nonempty) : + b.residualValue.val ≤ + ((b.1 : K⟦ℝ⟧).isPWO_support.mono fun _ hx ↦ (hC hx).1.1).orderType := by + have hC' : IsRelUpperSet C (· ∈ (b.1 : K⟦ℝ⟧).support ∩ Set.Iio γ') := by + intro a ha + obtain ⟨haB, hup⟩ := hC ha + refine ⟨⟨haB.1, haB.2.2⟩, ?_⟩ + intro d had hd + exact hup had ⟨hd.1, haB.2.1.trans_le had, hd.2⟩ + have hbound := + le_orderType_of_le_ordinalValue_translatedTruncation_of_isRelUpperSet_supportBelow + (b.1 : K⟦ℝ⟧) γ' (ρ := b.residualValue.val) + (by rw [(mem_residualPointSet_iff.mp hγ').2]; simp) hC' hCne + exact hbound.trans_eq (Set.IsPWO.orderType_proof_irrel _ _) + +/-- The ordered-union estimate of Berarducci, Lemma 4.7, for residual value one. Given a strictly +increasing family `γ : l.ToType → ℝ` of residual points of the tail above `η`, with `l` a limit, +the pieces `supp(b) ∩ (η, γ i]` are nonempty and strictly separated, since between two residual +points there is a support point; so `1 ⬝ l` is at most the order type of the support of `b` on +`(η, 0)`. -/ +private theorem residualValue_mul_le_orderType_negativeSupportTail_of_eq_one + (b : SeriesWithOrdinalValueAboveOne K) {η : ℝ} (hρ1 : b.residualValue = 1) + {l : Ordinal} (hl : Order.IsSuccLimit l) (γ : l.ToType → ℝ) (hγmono : StrictMono γ) + (hγtail : ∀ i, γ i ∈ residualPointTail b η) : + b.residualValue.val * l ≤ + ((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)).orderType := by + have hγX : ∀ i, γ i ∈ residualPointSet b := fun i ↦ + residualPointTail_subset_residualPointSet b η (hγtail i) + have hγneg : ∀ i, γ i < 0 := fun i ↦ residualPointSet_subset_Iio b (hγX i) + have hγη : ∀ i, η < γ i := fun i ↦ (mem_residualPointTail_iff.mp (hγtail i)).2 + set B : l.ToType → Set ℝ := + fun i ↦ (b.1 : K⟦ℝ⟧).support ∩ Set.Ioc η (γ i) with hBdef + have hB : ∀ i, (B i).IsPWO := fun _ ↦ + (b.1 : K⟦ℝ⟧).isPWO_support.mono Set.inter_subset_left + have hUnionSub : (⋃ i, B i) ⊆ negativeSupportTail b.1 η := by + intro x hx + obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hx + exact mem_negativeSupportTail_iff.mpr + ⟨hi.1, hi.2.1, hi.2.2.trans_lt (hγneg i)⟩ + have hUnion : (⋃ i, B i).IsPWO := + (b.1 : K⟦ℝ⟧).isPWO_support.mono + (hUnionSub.trans (negativeSupportTail_subset_support b.1 η)) + have hsep : ∀ {i j : l.ToType}, i < j → ∃ y ∈ B j, ∀ x ∈ B i, x < y := by + intro i j hij + obtain ⟨y, hy, hγiy, hyγj⟩ := + exists_mem_support_Ioc_of_lt_of_mem_residualPointSet b (hγX j) (hγmono hij) + exact ⟨y, ⟨hy, (hγη i).trans hγiy, hyγj⟩, fun x hx ↦ hx.2.2.trans_lt hγiy⟩ + have hfinal : ∀ (i : l.ToType) (C : Set ℝ) + (hC : IsRelUpperSet C (· ∈ B i)), C.Nonempty → + b.residualValue.val ≤ ((hB i).mono fun _ hx ↦ (hC hx).1).orderType := by + intro i C hC hCne + rw [hρ1] + change (1 : Ordinal) ≤ _ + rw [Order.one_le_iff_ne_zero] + intro hzero + obtain ⟨x, hx⟩ := hCne + have := ((hB i).mono fun _ hx ↦ (hC hx).1).orderType_eq_zero.mp hzero + rw [this] at hx + exact hx + calc b.residualValue.val * l + ≤ hUnion.orderType := + Set.IsPWO.mul_le_orderType_iUnion_of_isSuccLimit hl B hB hsep hfinal hUnion + _ ≤ ((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)).orderType := + hUnion.orderType_mono _ hUnionSub + +/-- The ordered-union estimate of Berarducci, Lemma 4.7, for residual value above one. Given a +strictly increasing family `γ : l.ToType → ℝ` of residual points of the tail above `η`, with `l` +a limit, the pieces `supp(b) ∩ (η, γ i)` are strictly separated, since the negative support of +the truncation at a residual point accumulates at `0`, and every nonempty final segment of a +piece has order type at least the residual value; so `v_J^r(b) ⬝ l` is at most the order type of +the support of `b` on `(η, 0)`. -/ +private theorem residualValue_mul_le_orderType_negativeSupportTail_of_one_lt + (b : SeriesWithOrdinalValueAboveOne K) {η : ℝ} (h1ρ : 1 < b.residualValue) + {l : Ordinal} (hl : Order.IsSuccLimit l) (γ : l.ToType → ℝ) (hγmono : StrictMono γ) + (hγtail : ∀ i, γ i ∈ residualPointTail b η) : + b.residualValue.val * l ≤ + ((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)).orderType := by + have hγX : ∀ i, γ i ∈ residualPointSet b := fun i ↦ + residualPointTail_subset_residualPointSet b η (hγtail i) + have hγneg : ∀ i, γ i < 0 := fun i ↦ residualPointSet_subset_Iio b (hγX i) + have hγη : ∀ i, η < γ i := fun i ↦ (mem_residualPointTail_iff.mp (hγtail i)).2 + have hvalueOne : ∀ i, 1 < ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) (γ i)) := by + intro i + rw [(mem_residualPointSet_iff.mp (hγX i)).2] + exact h1ρ + set B : l.ToType → Set ℝ := + fun i ↦ (b.1 : K⟦ℝ⟧).support ∩ Set.Ioo η (γ i) with hBdef + have hB : ∀ i, (B i).IsPWO := fun _ ↦ + (b.1 : K⟦ℝ⟧).isPWO_support.mono Set.inter_subset_left + have hUnionSub : (⋃ i, B i) ⊆ negativeSupportTail b.1 η := by + intro x hx + obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hx + exact mem_negativeSupportTail_iff.mpr + ⟨hi.1, hi.2.1, hi.2.2.trans (hγneg i)⟩ + have hUnion : (⋃ i, B i).IsPWO := + (b.1 : K⟦ℝ⟧).isPWO_support.mono + (hUnionSub.trans (negativeSupportTail_subset_support b.1 η)) + have hsep : ∀ {i j : l.ToType}, i < j → ∃ y ∈ B j, ∀ x ∈ B i, x < y := by + intro i j hij + obtain ⟨y, hy, hγiy, hyγj⟩ := + exists_mem_support_Ioo_of_lt_of_one_lt_ordinalValue b (hvalueOne j) (hγmono hij) + exact ⟨y, ⟨hy, (hγη i).trans hγiy, hyγj⟩, fun x hx ↦ hx.2.2.trans hγiy⟩ + have hfinal : ∀ (i : l.ToType) (C : Set ℝ) + (hC : IsRelUpperSet C (· ∈ B i)), C.Nonempty → + b.residualValue.val ≤ ((hB i).mono fun _ hx ↦ (hC hx).1).orderType := + fun i C hC hCne ↦ + (residualValue_le_orderType_of_isRelUpperSet_support_Ioo b (hγX i) hC hCne).trans_eq + (Set.IsPWO.orderType_proof_irrel _ _) + calc b.residualValue.val * l + ≤ hUnion.orderType := + Set.IsPWO.mul_le_orderType_iUnion_of_isSuccLimit hl B hB hsep hfinal hUnion + _ ≤ ((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)).orderType := + hUnion.orderType_mono _ hUnionSub + +/-- The ordered-union estimate for a residual-point tail: the residual value times the ordinary +order type of the tail is at most the order type of the support of `b` on `(η, 0)`. The tail is +enumerated by its order type, a limit, and the estimate splits on the residual value. -/ +private theorem residualValue_mul_residualPointTail_orderType_le + (b : SeriesWithOrdinalValueAboveOne K) (hX : (residualPointSet b).IsPWO) + {η : ℝ} (hη : η < 0) : + b.residualValue.val * (residualPointTail_isPWO b η hX).orderType ≤ + ((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)).orderType := by + classical + have hlimit := residualPointTail_orderType_isSuccLimit b hX hη + obtain ⟨e⟩ := (residualPointTail_isPWO b η hX).nonempty_orderIso_toType + have hγmono : StrictMono fun i ↦ (e i).1 := fun i j hij ↦ e.strictMono hij + have hγtail : ∀ i, (e i).1 ∈ residualPointTail b η := fun i ↦ (e i).2 + rcases (Order.one_le_iff_ne_zero.mpr b.residualValue_ne_zero).lt_or_eq with hρ | hρ + · exact residualValue_mul_le_orderType_negativeSupportTail_of_one_lt b hρ hlimit _ + hγmono hγtail + · exact residualValue_mul_le_orderType_negativeSupportTail_of_eq_one b hρ.symm hlimit _ + hγmono hγtail + +/-- The upper bound of Berarducci, Lemma 6.8: on a stable interval the residual-point tail has +ordinary order type at most the principal value. The ordered-union estimate bounds +`v_J^r(b) ⬝ λ` by the order type `v_J^r(b) ⬝ v_J^p(b)` of the stable interval, and left +multiplication by the nonzero residual value is strictly increasing. -/ +theorem residualPointTail_orderType_le + (b : SeriesWithOrdinalValueAboveOne K) (hX : (residualPointSet b).IsPWO) + {η : ℝ} (hη : η < 0) + (hstable : ((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)).orderType = (ordinalValue b.1).val) : + (residualPointTail_isPWO b η hX).orderType ≤ b.principalValue.val := by + have hρpos : 0 < b.residualValue.val := by + rw [pos_iff_ne_zero] + intro h + exact b.residualValue_ne_zero (NatOrdinal.val.injective (by simpa using h)) + have hkey := residualValue_mul_residualPointTail_orderType_le b hX hη + rw [hstable, ← b.residualValue_val_mul_principalValue_val] at hkey + exact (Ordinal.isNormal_mul_right hρpos).strictMono.le_iff_le.mp hkey + +/-- The supremum of a proper initial segment of limit order type. Let `S ⊆ ℝ` be partially +well-ordered and `κ < ot(S)` a limit ordinal. The initial segment of `S` of order type `κ` has +no greatest element, so its supremum `γ` is not attained: the segment is `S ∩ (-∞, γ)`, it is +nonempty, `γ` is its least upper bound, and some element of `S` lies weakly above `γ`. -/ +private theorem exists_isLUB_orderType_inter_Iio_eq_of_isSuccLimit + {S : Set ℝ} (hS : S.IsPWO) {κ : Ordinal} (hκ : Order.IsSuccLimit κ) + (hκlt : κ < hS.orderType) : + ∃ γ : ℝ, (S ∩ Set.Iio γ).Nonempty ∧ IsLUB (S ∩ Set.Iio γ) γ ∧ (∃ y ∈ S, γ ≤ y) ∧ + (hS.mono (s := S ∩ Set.Iio γ) Set.inter_subset_left).orderType = κ := by + obtain ⟨x, hxS, hxot⟩ := hS.exists_orderType_inter_Iio_eq hκlt + set I := S ∩ Set.Iio x with hIdef + set hI := hS.mono (s := I) Set.inter_subset_left with hIpwo + have hIot : hI.orderType = κ := hxot + have hIne : I.Nonempty := by + rw [Set.nonempty_iff_ne_empty] + intro hempty + have hzero : hI.orderType = 0 := hI.orderType_eq_zero.mpr hempty + rw [hIot] at hzero + exact hκ.ne_bot (by simpa using hzero) + have hInomax : ∀ y ∈ I, ∃ z ∈ I, y < z := fun y hy ↦ + hI.exists_gt_of_isSuccLimit_orderType (by rw [hIot]; exact hκ) hy + have hIbdd : BddAbove I := ⟨x, fun y hy ↦ le_of_lt hy.2⟩ + set γ := sSup I with hγdef + have hle : ∀ y ∈ I, y ≤ γ := fun y hy ↦ le_csSup hIbdd hy + have hlt : ∀ y ∈ I, y < γ := by + intro y hy + obtain ⟨z, hz, hyz⟩ := hInomax y hy + exact hyz.trans_le (hle z hz) + have hSIio : S ∩ Set.Iio γ = I := by + ext y + constructor + · rintro ⟨hyS, hyγ⟩ + by_contra hyI + have hub : ∀ z ∈ I, z ≤ y := by + intro z hz + by_contra hzy + exact hyI ⟨hyS, lt_trans (lt_of_not_ge hzy) hz.2⟩ + exact absurd (csSup_le hIne hub) (not_le.mpr hyγ) + · exact fun hy ↦ ⟨hy.1, hlt y hy⟩ + refine ⟨γ, ?_, ?_, ⟨x, hxS, csSup_le hIne fun y hy ↦ le_of_lt hy.2⟩, ?_⟩ + · rw [hSIio] + exact hIne + · rw [hSIio] + exact isLUB_csSup hIne hIbdd + · rw [Set.IsPWO.orderType_congr _ hI hSIio, hIot] + +/-- The upper bound on the value at the supremum. Let `I = S ∩ (-∞, γ)` be an initial segment +of the stable interval `S` of order type `ρ ⬝ (α + 1)`, with `ρ` a limit and `γ ≤ 0`. Then `I` +splits at the point `w` with `ot(S ∩ (-∞, w)) = ρ ⬝ α` into its first `ρ ⬝ α` elements and a +final segment of order type `ρ`; the window `S ∩ (w, γ)` is therefore a nonempty final segment of +the support below `γ` of order type at most `ρ`, which bounds the value of the translated +truncation at `γ`. -/ +private theorem ordinalValue_translatedTruncation_val_le_of_orderType_inter_Iio_eq + (b : SeriesWithOrdinalValueAboveOne K) {η γ : ℝ} {ρ α : Ordinal} + (hρ0 : 0 < ρ) (hρlimit : Order.IsSuccLimit ρ) (hγ0 : γ ≤ 0) + (hIot : (((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)).mono + (s := negativeSupportTail b.1 η ∩ Set.Iio γ) Set.inter_subset_left).orderType = + ρ * (α + 1)) : + (ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) γ)).val ≤ ρ := by + classical + set S := negativeSupportTail b.1 η with hSdef + set hS := ((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)) with hSpwo + set I := S ∩ Set.Iio γ with hIdef + set hI := hS.mono (s := I) Set.inter_subset_left with hIpwo + have hsucc : ρ * α < ρ * (α + 1) := + (Ordinal.isNormal_mul_right hρ0).strictMono (lt_add_one α) + have hραlt : ρ * α < hS.orderType := + hsucc.trans_le (hIot.symm.le.trans (hI.orderType_mono hS Set.inter_subset_left)) + obtain ⟨w, hwS, hwot⟩ := hS.exists_orderType_inter_Iio_eq hραlt + have hwγ : w < γ := by + by_contra hγw + have hsub : I ⊆ S ∩ Set.Iio w := + fun y hy ↦ ⟨hy.1, lt_of_lt_of_le hy.2 (not_lt.mp hγw)⟩ + have := hI.orderType_mono (hS.mono (s := S ∩ Set.Iio w) Set.inter_subset_left) hsub + rw [hIot, hwot] at this + exact absurd this (not_le.mpr hsucc) + have hwI : w ∈ I := ⟨hwS, hwγ⟩ + have hIiow : I ∩ Set.Iio w = S ∩ Set.Iio w := by + ext y + exact ⟨fun hy ↦ ⟨hy.1.1, hy.2⟩, fun hy ↦ ⟨⟨hy.1, lt_trans hy.2 hwγ⟩, hy.2⟩⟩ + letI : WellFoundedLT I := ⟨hI.isWF⟩ + have hsplit := hI.orderType_inter_Iio_add_inter_Ici hwI + have hIiowot : (hI.mono (s := I ∩ Set.Iio w) Set.inter_subset_left).orderType = ρ * α := by + rw [Set.IsPWO.orderType_congr _ (hS.mono (s := S ∩ Set.Iio w) Set.inter_subset_left) hIiow] + exact hwot + rw [hIiowot, hIot, mul_add_one] at hsplit + have hIciwot : (hI.mono (s := I ∩ Set.Ici w) Set.inter_subset_left).orderType = ρ := + (add_left_cancel hsplit) + have hCeq : S ∩ Set.Ioo w γ = I ∩ Set.Ioi w := by + ext y + exact ⟨fun ⟨hyS, hwy, hyγ⟩ ↦ ⟨⟨hyS, hyγ⟩, hwy⟩, fun ⟨hyI, hwy⟩ ↦ ⟨hyI.1, hwy, hyI.2⟩⟩ + have hCne : (S ∩ Set.Ioo w γ).Nonempty := by + have hwT : w ∈ I ∩ Set.Ici w := ⟨hwI, le_refl w⟩ + obtain ⟨z, hz, hwz⟩ := Set.IsPWO.exists_gt_of_isSuccLimit_orderType + (hI.mono (s := I ∩ Set.Ici w) Set.inter_subset_left) + (by rw [hIciwot]; exact hρlimit) hwT + exact ⟨z, by rw [hCeq]; exact ⟨hz.1, hwz⟩⟩ + have hCupper : IsRelUpperSet (S ∩ Set.Ioo w γ) + (· ∈ (b.1 : K⟦ℝ⟧).support ∩ Set.Iio γ) := by + rintro a ⟨haS, hwa, haγ⟩ + refine ⟨⟨(mem_negativeSupportTail_iff.mp haS).1, haγ⟩, ?_⟩ + rintro d had ⟨hdsupp, hdγ⟩ + exact ⟨mem_negativeSupportTail_iff.mpr + ⟨hdsupp, lt_of_lt_of_le (mem_negativeSupportTail_iff.mp haS).2.1 had, + lt_of_lt_of_le hdγ hγ0⟩, lt_of_lt_of_le hwa had, hdγ⟩ + refine (ordinalValue_translatedTruncation_le_orderType_of_isRelUpperSet_supportBelow + (b.1 : K⟦ℝ⟧) γ hCupper hCne).trans ?_ + have hCsub : S ∩ Set.Ioo w γ ⊆ I ∩ Set.Ici w := by + rw [hCeq] + exact fun y hy ↦ ⟨hy.1, Set.mem_Ici.mpr (le_of_lt hy.2)⟩ + calc ((b.1 : K⟦ℝ⟧).isPWO_support.mono fun _ hx ↦ (hCupper hx).1.1).orderType + ≤ (hI.mono (s := I ∩ Set.Ici w) Set.inter_subset_left).orderType := + Set.IsPWO.orderType_mono _ _ hCsub + _ = ρ := hIciwot + +/-- The lower bound on the value at the supremum. Let `γ` be the least upper bound of the initial +segment `I = S ∩ (-∞, γ)` of the stable interval `S`, of order type `ρ ⬝ (α + 1)` with `ρ` +additive principal. Every window `(θ, γ)` contains a final segment `I ∩ [z, γ)` of `I`, whose +order type is at least `ρ`, because `ot(I ∩ (-∞, z)) + ot(I ∩ [z, γ)) = ρ ⬝ (α + 1)` with the +first summand strictly smaller; so the value of the translated truncation at `γ` is at least +`ρ`. -/ +private theorem le_ordinalValue_translatedTruncation_of_isLUB_of_orderType_inter_Iio_eq + (b : SeriesWithOrdinalValueAboveOne K) {η γ : ℝ} {ρ α : Ordinal} + (hρprin : Ordinal.IsAdditivelyPrincipal ρ) + (hLUB : IsLUB (negativeSupportTail b.1 η ∩ Set.Iio γ) γ) + (hIot : (((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)).mono + (s := negativeSupportTail b.1 η ∩ Set.Iio γ) Set.inter_subset_left).orderType = + ρ * (α + 1)) : + NatOrdinal.of ρ ≤ ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) γ) := by + classical + set S := negativeSupportTail b.1 η with hSdef + set hS := ((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)) with hSpwo + set I := S ∩ Set.Iio γ with hIdef + set hI := hS.mono (s := I) Set.inter_subset_left with hIpwo + letI : WellFoundedLT I := ⟨hI.isWF⟩ + apply le_ordinalValue_translatedTruncation_of_forall_le_orderType + intro θ hθ + obtain ⟨z, hzI, hθz, _⟩ := hLUB.exists_between hθ + have hsplit2 := hI.orderType_inter_Iio_add_inter_Ici hzI + have hlt2 : (hI.mono (s := I ∩ Set.Iio z) Set.inter_subset_left).orderType + < hI.orderType := hI.orderType_inter_Iio_lt hzI + rw [hIot] at hsplit2 hlt2 + refine (hρprin.le_of_add_eq_mul_succ hlt2 hsplit2).trans + (Set.IsPWO.orderType_mono _ _ ?_) + rintro y ⟨hyI, hzy⟩ + exact ⟨(mem_negativeSupportTail_iff.mp hyI.1).1, lt_of_lt_of_le hθz hzy, hyI.2⟩ + +/-- The printed construction of Berarducci, Lemma 6.8, for residual value above one. For each +`α` below the principal value, the supremum `γ` of the first `v_J^r(b) ⬝ (α + 1)` elements of the +stable interval is a residual point of the tail: that order type is a limit, so `γ` is not +attained, and the two value bounds at the supremum pin the translated truncation at `γ` to value +exactly `v_J^r(b)`. -/ +theorem exists_residualPoint_orderType_eq + (b : SeriesWithOrdinalValueAboveOne K) {η : ℝ} + (hstable : ((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)).orderType = (ordinalValue b.1).val) + (hρ : 1 < b.residualValue) (i : b.principalValue.val.ToType) : + ∃ γ : ℝ, γ ∈ residualPointTail b η ∧ + (((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)).mono + (s := negativeSupportTail b.1 η ∩ Set.Iio γ) Set.inter_subset_left).orderType + = b.residualValue.val * + (Ordinal.typein (α := b.principalValue.val.ToType) (· < ·) i + 1) := by + classical + set S := negativeSupportTail b.1 η with hSdef + set hS := ((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)) with hSpwo + set ρ := b.residualValue.val with hρdef + set α := Ordinal.typein (α := b.principalValue.val.ToType) (· < ·) i with hαdef + have hρprin : Ordinal.IsAdditivelyPrincipal ρ := b.residualValue_isAdditivelyPrincipal + have hρ0 : 0 < ρ := by + rw [pos_iff_ne_zero] + exact NatOrdinal.val_ne_zero.mpr b.residualValue_ne_zero + have hρlimit : Order.IsSuccLimit ρ := + hρprin.isSuccLimit_of_one_lt (NatOrdinal.val.lt_iff_lt.mpr hρ) + have hκlimit : Order.IsSuccLimit (ρ * (α + 1)) := by + rw [mul_add_one] + exact Ordinal.isSuccLimit_add _ hρlimit + have hκlt : ρ * (α + 1) < hS.orderType := by + rw [hstable, ← b.residualValue_val_mul_principalValue_val] + exact (Ordinal.isNormal_mul_right hρ0).strictMono + (b.principalValue_isInfiniteMultiplicativelyPrincipal.isSuccLimit.succ_lt + (Ordinal.typein_lt_self i)) + obtain ⟨γ, ⟨y, hy⟩, hLUB, ⟨x, hxS, hγx⟩, hIot⟩ := + exists_isLUB_orderType_inter_Iio_eq_of_isSuccLimit hS hκlimit hκlt + have hγneg : γ < 0 := hγx.trans_lt (mem_negativeSupportTail_iff.mp hxS).2.2 + have hγη : η < γ := lt_of_lt_of_le (mem_negativeSupportTail_iff.mp hy.1).2.1 (hLUB.1 hy) + have hveq : ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) γ) = b.residualValue := by + apply NatOrdinal.val.injective + refine le_antisymm + (ordinalValue_translatedTruncation_val_le_of_orderType_inter_Iio_eq b hρ0 hρlimit + hγneg.le hIot) ?_ + have hmono := NatOrdinal.val.monotone + (le_ordinalValue_translatedTruncation_of_isLUB_of_orderType_inter_Iio_eq b hρprin + hLUB hIot) + rwa [NatOrdinal.val_of] at hmono + exact ⟨γ, mem_residualPointTail_iff.mpr + ⟨mem_residualPointSet_iff.mpr ⟨hγneg, hveq⟩, hγη⟩, hIot⟩ + +private theorem principalValue_le_of_exists_residualPoint + (b : SeriesWithOrdinalValueAboveOne K) (hX : (residualPointSet b).IsPWO) {η : ℝ} + (g : b.principalValue.val.ToType → Ordinal) (hg : StrictMono g) + (h : ∀ i, ∃ γ : ℝ, γ ∈ residualPointTail b η ∧ + ((((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)).mono + (s := negativeSupportTail b.1 η ∩ Set.Iio γ) Set.inter_subset_left)).orderType = g i) : + b.principalValue.val ≤ (residualPointTail_isPWO b η hX).orderType := by + classical + choose f hf hfot using h + set hS := ((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)) with hSpwo + have hmono : StrictMono f := by + intro i j hij + by_contra hle + rw [not_lt] at hle + have hsub : negativeSupportTail b.1 η ∩ Set.Iio (f j) ⊆ + negativeSupportTail b.1 η ∩ Set.Iio (f i) := + fun y hy ↦ ⟨hy.1, lt_of_lt_of_le hy.2 hle⟩ + have hcmp := Set.IsPWO.orderType_mono + (hS.mono (s := negativeSupportTail b.1 η ∩ Set.Iio (f j)) Set.inter_subset_left) + (hS.mono (s := negativeSupportTail b.1 η ∩ Set.Iio (f i)) Set.inter_subset_left) hsub + rw [hfot i, hfot j] at hcmp + exact absurd hcmp (not_le.mpr (hg hij)) + have hrange : Set.range f ⊆ residualPointTail b η := by + rintro _ ⟨i, rfl⟩ + exact hf i + have hRPWO : (Set.range f).IsPWO := (residualPointTail_isPWO b η hX).mono hrange + have hRot : hRPWO.orderType = b.principalValue.val := by + rw [hRPWO.orderType_eq_typeLT_of_orderIso (hmono.orderIso f).symm] + exact Ordinal.type_toType _ + calc b.principalValue.val = hRPWO.orderType := hRot.symm + _ ≤ (residualPointTail_isPWO b η hX).orderType := + hRPWO.orderType_mono _ hrange + +theorem principalValue_le_residualPointTail_orderType_of_one_lt + (b : SeriesWithOrdinalValueAboveOne K) (hX : (residualPointSet b).IsPWO) {η : ℝ} + (hstable : ((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)).orderType = (ordinalValue b.1).val) + (hρ : 1 < b.residualValue) : + b.principalValue.val ≤ (residualPointTail_isPWO b η hX).orderType := by + have hρ0 : 0 < b.residualValue.val := by + rw [pos_iff_ne_zero] + exact NatOrdinal.val_ne_zero.mpr b.residualValue_ne_zero + refine principalValue_le_of_exists_residualPoint b hX + (fun i ↦ b.residualValue.val * + (Ordinal.typein (α := b.principalValue.val.ToType) (· < ·) i + 1)) ?_ + (exists_residualPoint_orderType_eq b hstable hρ) + intro i j hij + have hlt : Ordinal.typein (α := b.principalValue.val.ToType) (· < ·) i < + Ordinal.typein (α := b.principalValue.val.ToType) (· < ·) j := + (Ordinal.typein_lt_typein (· < ·)).mpr hij + exact (Ordinal.isNormal_mul_right hρ0).strictMono + ((Order.add_one_le_iff.mpr hlt).trans_lt (lt_add_one _)) + +theorem exists_residualPoint_orderType_eq_of_residualValue_eq_one + (b : SeriesWithOrdinalValueAboveOne K) {η : ℝ} + (hstable : ((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)).orderType = (ordinalValue b.1).val) + (hρ : b.residualValue = 1) (i : b.principalValue.val.ToType) : + ∃ γ : ℝ, γ ∈ residualPointTail b η ∧ + (((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)).mono + (s := negativeSupportTail b.1 η ∩ Set.Iio γ) Set.inter_subset_left).orderType + = Ordinal.typein (α := b.principalValue.val.ToType) (· < ·) i + 1 := by + classical + set S := negativeSupportTail b.1 η with hSdef + set hS := ((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)) with hSpwo + set α := Ordinal.typein (α := b.principalValue.val.ToType) (· < ·) i with hαdef + have hαπ : α < b.principalValue.val := Ordinal.typein_lt_self i + have hπlimit : Order.IsSuccLimit b.principalValue.val := + b.principalValue_isInfiniteMultiplicativelyPrincipal.isSuccLimit + have hSot : hS.orderType = b.principalValue.val := by + rw [hstable, ← b.residualValue_val_mul_principalValue_val, hρ] + simp + have hsucclt : α + 1 < b.principalValue.val := hπlimit.succ_lt hαπ + obtain ⟨y, hyS, hyot⟩ := hS.exists_orderType_inter_Iio_eq (by rw [hSot]; exact hsucclt) + set T := S ∩ Set.Iio y with hTdef + set hT := hS.mono (s := T) Set.inter_subset_left with hTpwo + have hTot : hT.orderType = α + 1 := hyot + have hTmax : ∃ z ∈ T, ∀ u ∈ T, u ≤ z := by + by_contra hcon + push Not at hcon + have hne : T.Nonempty := by + rw [Set.nonempty_iff_ne_empty] + intro hempty + have := hT.orderType_eq_zero.mpr hempty + rw [hTot] at this + rw [← Order.succ_eq_add_one] at this + exact Order.succ_ne_bot α this + have hgt : ∀ u ∈ T, ∃ v ∈ T, u < v := by + intro u hu + obtain ⟨v, hv, hvu⟩ := hcon u hu + exact ⟨v, hv, hvu⟩ + have := Set.IsPWO.isSuccLimit_orderType_of_forall_exists_gt hT hne hgt + rw [hTot, ← Order.succ_eq_add_one] at this + exact Order.not_isSuccLimit_succ α this + obtain ⟨z, hzT, hzmax⟩ := hTmax + have hzy : z < y := hzT.2 + have hgap : ∀ u : ℝ, z < u → u < y → u ∉ (b.1 : K⟦ℝ⟧).support := by + intro u hzu huy hu + have huS : u ∈ S := mem_negativeSupportTail_iff.mpr + ⟨hu, lt_trans (mem_negativeSupportTail_iff.mp hzT.1).2.1 hzu, + lt_trans huy (mem_negativeSupportTail_iff.mp hyS).2.2⟩ + exact absurd (hzmax u ⟨huS, huy⟩) (not_le.mpr hzu) + have hycoeff : (b.1 : K⟦ℝ⟧).coeff y ≠ 0 := + (HahnSeries.mem_support _ _).mp (mem_negativeSupportTail_iff.mp hyS).1 + have hyneg : y < 0 := (mem_negativeSupportTail_iff.mp hyS).2.2 + have hyη : η < y := (mem_negativeSupportTail_iff.mp hyS).2.1 + have hnear : translatedTruncation (b.1 : K⟦ℝ⟧) y ∈ nearConstantSubgroup K := by + refine mem_nearConstantSubgroup_iff_exists_germ_eq_constant.mpr + ⟨(b.1 : K⟦ℝ⟧).coeff y, ?_⟩ + refine toGerm_eq_toGerm_iff_exists_coeff_eq.mpr + ⟨z - y, by linarith, fun δ hδlow hδ0 ↦ ?_⟩ + rw [coeff_translatedTruncation, if_pos hδ0, HahnSeries.Nonpositive.coe_C] + rcases hδ0.eq_or_lt with rfl | hδneg + · simp + · rw [HahnSeries.C_apply, HahnSeries.coeff_single_of_ne (by linarith : δ ≠ (0 : ℝ))] + by_contra hne + exact hgap (y + δ) (by linarith) (by linarith) + ((HahnSeries.mem_support _ _).mpr hne) + have hnotJ : translatedTruncation (b.1 : K⟦ℝ⟧) y ∉ + HahnSeries.Nonpositive.negativeMonomialIdeal K := by + intro hmem + have hzero := constantCoeff_eq_zero_of_mem_negativeMonomialIdeal hmem + rw [HahnSeries.Nonpositive.constantCoeff_apply, coeff_translatedTruncation, + if_pos le_rfl] at hzero + exact hycoeff (by simpa using hzero) + have hveq : ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) y) = b.residualValue := by + rw [hρ] + exact ordinalValue_of_mem_nearConstantSubgroup_of_not_mem_negativeMonomialIdeal hnear hnotJ + exact ⟨y, mem_residualPointTail_iff.mpr + ⟨mem_residualPointSet_iff.mpr ⟨hyneg, hveq⟩, hyη⟩, hyot⟩ + +theorem principalValue_le_residualPointTail_orderType_of_eq_one + (b : SeriesWithOrdinalValueAboveOne K) (hX : (residualPointSet b).IsPWO) {η : ℝ} + (hstable : ((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)).orderType = (ordinalValue b.1).val) + (hρ : b.residualValue = 1) : + b.principalValue.val ≤ (residualPointTail_isPWO b η hX).orderType := by + refine principalValue_le_of_exists_residualPoint b hX + (fun i ↦ Ordinal.typein (α := b.principalValue.val.ToType) (· < ·) i + 1) ?_ + (exists_residualPoint_orderType_eq_of_residualValue_eq_one b hstable hρ) + intro i j hij + have hlt : Ordinal.typein (α := b.principalValue.val.ToType) (· < ·) i < + Ordinal.typein (α := b.principalValue.val.ToType) (· < ·) j := + (Ordinal.typein_lt_typein (· < ·)).mpr hij + exact (Order.add_one_le_iff.mpr hlt).trans_lt (lt_add_one _) + +/-- The order-type computation in Berarducci, Lemma 6.8: on a stable interval the residual-point +tail has ordinary order type exactly the principal value. -/ +theorem residualPointTail_orderType_eq + (b : SeriesWithOrdinalValueAboveOne K) (hX : (residualPointSet b).IsPWO) + {η : ℝ} (hη : η < 0) + (hstable : ((b.1 : K⟦ℝ⟧).isPWO_support.mono + (negativeSupportTail_subset_support b.1 η)).orderType = (ordinalValue b.1).val) : + (residualPointTail_isPWO b η hX).orderType = b.principalValue.val := by + refine le_antisymm (residualPointTail_orderType_le b hX hη hstable) ?_ + rcases (Order.one_le_iff_ne_zero.mpr b.residualValue_ne_zero).lt_or_eq with hρ | hρ + · exact principalValue_le_residualPointTail_orderType_of_one_lt b hX hstable hρ + · exact principalValue_le_residualPointTail_orderType_of_eq_one b hX hstable hρ.symm + +/-- Berarducci, Lemma 6.8, order-type half: sufficiently high residual-point tails have ordinary +order type equal to the principal value. -/ +theorem residualPointTail_orderType_eventually + (b : SeriesWithOrdinalValueAboveOne K) (hX : (residualPointSet b).IsPWO) : + ∀ᶠ η in nhdsWithin (0 : ℝ) (Set.Iio 0), + (residualPointTail_isPWO b η hX).orderType = b.principalValue.val := by + obtain ⟨η₀, hη₀, hstable⟩ := + exists_forall_later_negativeSupportTail_orderType_eq_ordinalValue b.1 b.2 + rw [eventually_nhdsLT_iff_exists] + exact ⟨η₀, hη₀, fun ξ hlow hhigh ↦ + residualPointTail_orderType_eq b hX hhigh (hstable ξ hlow hhigh)⟩ + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointSupport.lean new file mode 100644 index 0000000000..f52fa040f0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointSupport.lean @@ -0,0 +1,191 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointTail + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import Mathlib.Tactic.Linarith + +/-! +# Support families along Berarducci residual points + +This module proves the support-family construction in Berarducci, Lemma 6.9. A final segment of a +residual-point tail still has the full principal order type. This permits a strictly increasing +reindexing by `v_J^p(b)`. Congruence modulo `J + K` then transports the translated-truncation +value bound from the given series to every representative used in the definition of `v_J`. + +For the support blocks there is an essential boundary distinction. When `ρ = 1`, a block retains +the cutoff exponent and uses closed lower support. When `1 < ρ`, a block uses strict lower support; +excluding the cutoff prevents a constant endpoint from forming a final segment of order type one. +The final-segment estimate in +`ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment` supplies the required lower +bound in the latter case. + +This expands the source's terse application of Lemma 4.7 and makes the residual-value-one +endpoint case explicit. +-/ + +universe v + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace Berarducci + +open Ordinal + +variable {K : Type v} [Field K] + +/-- A residual-point tail contains a strictly increasing copy of its full principal order type on +which the translated-truncation lower bound holds for any fixed representative modulo `J + K`. -/ +theorem exists_strictMono_cutoff_of_residualPointTail + (b : SeriesWithOrdinalValueAboveOne K) (c : Series K) {ρ : Ordinal} {η : ℝ} + (htail : (residualPointTail b η).IsPWO) + (htailType : htail.orderType = b.principalValue.val) + (htailLUB : IsLUB (residualPointTail b η) 0) + (hc : ∀ γ ∈ residualPointTail b η, + NatOrdinal.of ρ ≤ ordinalValue (translatedTruncation (c : K⟦ℝ⟧) γ)) + (d : Series K) (hcd : c - d ∈ nearConstantSubgroup K) : + ∃ γ : b.principalValue.val.ToType → ℝ, + StrictMono γ ∧ + (∀ i, γ i ∈ residualPointTail b η) ∧ + ∀ i, NatOrdinal.of ρ ≤ + ordinalValue (translatedTruncation (d : K⟦ℝ⟧) (γ i)) := by + obtain ⟨θ, hθ, hvalueEq⟩ := + exists_ordinalValue_translatedTruncation_eq_of_sub_mem_nearConstantSubgroup hcd + let finalTail : Set ℝ := residualPointTail b η ∩ Set.Ioi θ + let hfinalTail : finalTail.IsPWO := htail.mono Set.inter_subset_left + obtain ⟨x, hxTail, hθx, _⟩ := htailLUB.exists_between hθ + have hfinalTailType : hfinalTail.orderType = b.principalValue.val := by + calc + hfinalTail.orderType = htail.orderType := by + apply htail.orderType_inter_Ioi_eq_of_isPrincipal + · rw [htailType] + exact + (isAdditivelyPrincipal_iff_ne_zero_and_isPrincipal_add.mp + b.principalValue_isInfiniteMultiplicativelyPrincipal.isAdditivelyPrincipal).2 + · exact ⟨x, hxTail, hθx⟩ + _ = b.principalValue.val := htailType + letI : WellFoundedLT finalTail := ⟨hfinalTail.isWF⟩ + have htypes : typeLT b.principalValue.val.ToType = typeLT finalTail := by + calc + typeLT b.principalValue.val.ToType = b.principalValue.val := + type_toType b.principalValue.val + _ = hfinalTail.orderType := hfinalTailType.symm + _ = typeLT finalTail := + hfinalTail.orderType_eq_typeLT_of_orderIso (OrderIso.refl finalTail) + let e : b.principalValue.val.ToType ≃o finalTail := + OrderIso.ofRelIsoLT (Classical.choice (Ordinal.type_eq.mp htypes)) + let γ : b.principalValue.val.ToType → ℝ := fun i ↦ (e i).1 + refine ⟨γ, ?_, ?_, ?_⟩ + · intro i j hij + exact e.strictMono hij + · intro i + exact (e i).2.1 + · intro i + have hθγ : θ < γ i := (e i).2.2 + have hγTail : γ i ∈ residualPointTail b η := (e i).2.1 + have hγ0 : γ i < 0 := + residualPointSet_subset_Iio b + (residualPointTail_subset_residualPointSet b η hγTail) + rw [← hvalueEq (γ i) hθγ hγ0] + exact hc (γ i) hγTail + +/-- A residual-point tail yields a well-ordered family of subsets of the support of `d`, strictly +separated between indices and with every nonempty upper subset of each member having order type +at least `ρ`. -/ +theorem exists_supportFamily_of_residualPointTail + (b : SeriesWithOrdinalValueAboveOne K) (c : Series K) {ρ : Ordinal} {η : ℝ} + (hρ0 : ρ ≠ 0) + (htail : (residualPointTail b η).IsPWO) + (htailType : htail.orderType = b.principalValue.val) + (htailLUB : IsLUB (residualPointTail b η) 0) + (hc : ∀ γ ∈ residualPointTail b η, + NatOrdinal.of ρ ≤ ordinalValue (translatedTruncation (c : K⟦ℝ⟧) γ)) + (d : Series K) (hcd : c - d ∈ nearConstantSubgroup K) : + ∃ B : b.principalValue.val.ToType → Set ℝ, + ∃ hB : ∀ i, (B i).IsPWO, + (∀ {i j}, i < j → ∃ y ∈ B j, ∀ x ∈ B i, x < y) ∧ + (∀ (i : b.principalValue.val.ToType) (C : Set ℝ) + (hC : IsRelUpperSet C (· ∈ B i)), C.Nonempty → + ρ ≤ ((hB i).mono fun _ hx ↦ (hC hx).1).orderType) ∧ + ∃ _ : (⋃ i, B i).IsPWO, + (⋃ i, B i) ⊆ (d : K⟦ℝ⟧).support := by + obtain ⟨γ, hγmono, _, hγvalue⟩ := + exists_strictMono_cutoff_of_residualPointTail b c htail htailType htailLUB hc d hcd + by_cases hρ1 : ρ = 1 + · subst ρ + let B : b.principalValue.val.ToType → Set ℝ := + fun i ↦ (d : K⟦ℝ⟧).support ∩ Set.Iic (γ i) + let hB : ∀ i, (B i).IsPWO := + fun _ ↦ (d : K⟦ℝ⟧).isPWO_support.mono Set.inter_subset_left + refine ⟨B, hB, ?_, ?_, ?_⟩ + · intro i j hij + have hvalueNe : ordinalValue (translatedTruncation (d : K⟦ℝ⟧) (γ j)) ≠ 0 := by + intro hzero + have hle := hγvalue j + rw [hzero] at hle + exact (not_le_of_gt zero_lt_one) hle + have hLUB := isLUB_support_zero_of_ordinalValue_ne_zero hvalueNe + have hcutoff : γ i - γ j < 0 := sub_neg.mpr (hγmono hij) + obtain ⟨δ, hδSupport, hδAbove, _⟩ := hLUB.exists_between hcutoff + rw [support_translatedTruncation] at hδSupport + obtain ⟨y, hy, hδ⟩ := hδSupport + refine ⟨y, ⟨hy.1, hy.2⟩, fun x hx ↦ ?_⟩ + rw [← hδ] at hδAbove + exact hx.2.trans_lt (by linarith) + · intro i C hC hCne + apply Order.one_le_iff_ne_zero.mpr + intro hzero + have hCempty := ((hB i).mono fun _ hx ↦ (hC hx).1).orderType_eq_zero.mp hzero + obtain ⟨x, hx⟩ := hCne + simp [hCempty] at hx + · let hUnion : (⋃ i, B i).IsPWO := + (d : K⟦ℝ⟧).isPWO_support.mono fun _ hx ↦ by + obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hx + exact hi.1 + exact ⟨hUnion, fun _ hx ↦ by + obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hx + exact hi.1⟩ + · have h1ρ : 1 < ρ := + lt_of_le_of_ne (Order.one_le_iff_ne_zero.mpr hρ0) (Ne.symm hρ1) + let B : b.principalValue.val.ToType → Set ℝ := + fun i ↦ (d : K⟦ℝ⟧).support ∩ Set.Iio (γ i) + let hB : ∀ i, (B i).IsPWO := + fun _ ↦ (d : K⟦ℝ⟧).isPWO_support.mono Set.inter_subset_left + have hvalueOneLt (i : b.principalValue.val.ToType) : + 1 < ordinalValue (translatedTruncation (d : K⟦ℝ⟧) (γ i)) := by + apply (show (1 : NatOrdinal) < NatOrdinal.of ρ by + exact NatOrdinal.of.lt_iff_lt.mpr h1ρ).trans_le + exact hγvalue i + refine ⟨B, hB, ?_, ?_, ?_⟩ + · intro i j hij + have hLUB := isLUB_negativeSupport_zero_of_one_lt_ordinalValue (hvalueOneLt j) + have hcutoff : γ i - γ j < 0 := sub_neg.mpr (hγmono hij) + obtain ⟨δ, hδSupport, hδAbove, _⟩ := hLUB.exists_between hcutoff + rw [support_translatedTruncation] at hδSupport + obtain ⟨⟨y, hy, hδ⟩, hδ0⟩ := hδSupport + refine ⟨y, ⟨hy.1, ?_⟩, fun x hx ↦ ?_⟩ + · rw [← hδ] at hδ0 + change -γ j + y < 0 at hδ0 + change y < γ j + linarith + · rw [← hδ] at hδAbove + exact hx.2.trans (by linarith) + · intro i C hC hCne + exact le_orderType_of_le_ordinalValue_translatedTruncation_of_isRelUpperSet_supportBelow + (d : K⟦ℝ⟧) (γ i) (hγvalue i) hC hCne + · let hUnion : (⋃ i, B i).IsPWO := + (d : K⟦ℝ⟧).isPWO_support.mono fun _ hx ↦ by + obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hx + exact hi.1 + exact ⟨hUnion, fun _ hx ↦ by + obtain ⟨i, hi⟩ := Set.mem_iUnion.mp hx + exact hi.1⟩ + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointTail.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointTail.lean new file mode 100644 index 0000000000..b2e9c94337 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointTail.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPoint + +/-! +# Final tails of Berarducci residual points + +For a cutoff `η`, `residualPointTail b η` is the final part of `X(b)` strictly above `η`. +Since every residual point is strictly negative, this is exactly `X(b) ∩ (η, 0)`. + +The source phrase "sufficiently close to zero" is represented later by +`nhdsWithin 0 (Set.Iio 0)`. Its generic cutoff interface prevents a silent change of side or +inclusion of zero. + +The remaining results isolate elementary consequences of well-ordering and least-upper-bound +hypotheses. They are the proved part of the interface needed to state and partially prove +Berarducci, Lemmas 6.8 and 6.9. +-/ + +universe v + +open scoped HahnSeries + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- The residual points strictly above the real cutoff `η`. -/ +def residualPointTail (b : SeriesWithOrdinalValueAboveOne K) (η : ℝ) : Set ℝ := + residualPointSet b ∩ Set.Ioi η + +/-- Membership in a residual-point tail records both residual-point membership and the strict +cutoff inequality. -/ +theorem mem_residualPointTail_iff + {b : SeriesWithOrdinalValueAboveOne K} {η γ : ℝ} : + γ ∈ residualPointTail b η ↔ γ ∈ residualPointSet b ∧ η < γ := + (Iff.rfl) + +/-- A residual-point tail is exactly the intersection of `X(b)` with `(η, 0)`. -/ +theorem residualPointTail_eq_inter_Ioo + (b : SeriesWithOrdinalValueAboveOne K) (η : ℝ) : + residualPointTail b η = residualPointSet b ∩ Set.Ioo η 0 := by + ext γ + rw [mem_residualPointTail_iff] + constructor + · rintro ⟨hγ, hηγ⟩ + exact ⟨hγ, hηγ, residualPointSet_subset_Iio b hγ⟩ + · rintro ⟨hγ, hηγ, _⟩ + exact ⟨hγ, hηγ⟩ + +/-- Every residual-point tail is contained in `X(b)`. -/ +theorem residualPointTail_subset_residualPointSet + (b : SeriesWithOrdinalValueAboveOne K) (η : ℝ) : + residualPointTail b η ⊆ residualPointSet b := + Set.inter_subset_left + +/-- Residual-point tails are antitone in their cutoff. -/ +theorem residualPointTail_antitone + (b : SeriesWithOrdinalValueAboveOne K) : Antitone (residualPointTail b) := by + intro η ξ hηξ γ hγ + exact ⟨hγ.1, hηξ.trans_lt hγ.2⟩ + +/-- A tail of a partially well-ordered residual-point set is partially well ordered. -/ +theorem residualPointTail_isPWO + (b : SeriesWithOrdinalValueAboveOne K) (η : ℝ) + (hX : (residualPointSet b).IsPWO) : + (residualPointTail b η).IsPWO := + hX.mono (residualPointTail_subset_residualPointSet b η) + +/-- If zero is the least upper bound of `X(b)`, every tail with negative cutoff is nonempty and +still has least upper bound zero. -/ +theorem residualPointTail_nonempty_and_isLUB + (b : SeriesWithOrdinalValueAboveOne K) {η : ℝ} (hη : η < 0) + (hX : IsLUB (residualPointSet b) 0) : + (residualPointTail b η).Nonempty ∧ IsLUB (residualPointTail b η) 0 := by + obtain ⟨x, hxX, hηx, _⟩ := hX.exists_between hη + have hxTail : x ∈ residualPointTail b η := ⟨hxX, hηx⟩ + refine ⟨⟨x, hxTail⟩, ⟨?_, ?_⟩⟩ + · intro y hy + exact hX.1 hy.1 + · intro a ha + apply hX.2 + intro y hy + by_cases hηy : η < y + · exact ha ⟨hy, hηy⟩ + · exact (le_of_not_gt hηy).trans (hηx.le.trans (ha hxTail)) + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointValue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointValue.lean new file mode 100644 index 0000000000..63acf9d6de --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointValue.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPoint + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermValueCut + +/-! +# Values of translated truncations at residual points + +Berarducci, Remark 9.4 and Remark 6.7, in the forms used by the complexity induction of Section 9. + +Every sufficiently high translated truncation has strictly smaller ordinal value, because the +value cut bounds it by a proper ordinary multiple of the residual value. At a residual point the +truncation value is the residual value itself, so its principal value is the principal factor of +the residual factor, which is at least the principal value of the series. +-/ + +universe v + +public noncomputable section + +open HahnSeries Ordinal + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- Berarducci, Remark 9.4: sufficiently high translated truncations have strictly smaller +ordinal value. -/ +theorem exists_ordinalValue_translatedTruncation_lt (b : SeriesWithOrdinalValueAboveOne K) : + ∃ η < (0 : ℝ), ∀ γ : ℝ, η < γ → γ < 0 → + ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) γ) < ordinalValue b.1 := by + obtain ⟨η, hη, hcut⟩ := exists_ordinalValue_translatedTruncation_le b + refine ⟨η, hη, fun γ hlow hhigh ↦ ?_⟩ + obtain ⟨α, hα, hle⟩ := hcut γ hlow hhigh + have hρpos : 0 < b.residualValue.val := by + rw [pos_iff_ne_zero] + exact NatOrdinal.val_ne_zero.mpr b.residualValue_ne_zero + have hlt : b.residualValue.val * α < (ordinalValue b.1).val := by + rw [← b.residualValue_val_mul_principalValue_val] + exact (Ordinal.isNormal_mul_right hρpos).strictMono hα + exact NatOrdinal.val.lt_iff_lt.mp (hle.trans_lt hlt) + +/-- Berarducci, Remark 6.7: at a residual point, the translated truncation has principal value at +least that of the series. -/ +theorem principalValue_le_of_mem_residualPointSet + (b d : SeriesWithOrdinalValueAboveOne K) {γ : ℝ} (hγ : γ ∈ residualPointSet b) + (hd : d.1 = translatedTruncation (b.1 : K⟦ℝ⟧) γ) : + b.principalValue ≤ d.principalValue := by + refine b.principalValue_le_of_ordinalValue_eq_residualValue d ?_ + rw [hd] + exact (mem_residualPointSet_iff.mp hγ).2 + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointWellOrdered.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointWellOrdered.lean new file mode 100644 index 0000000000..186fcc068d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointWellOrdered.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPoint +public import Mathlib.Topology.MetricSpace.Pseudo.Defs + +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOSumset + +/-! +# Residual points form a well-ordered set + +Berarducci, Remark 6.3: the translated truncation `b^{|γ}` lies in `J` unless `γ` belongs to the +order-topological closure of the support of `b`, so it is nonzero modulo `J` only for `γ` ranging +over a well-ordered set. Since a residual point has translated truncation of nonzero ordinal +value, the residual-point set is contained in that closure and is therefore partially well +ordered. + +The two inputs are the vanishing of a germ outside the closed support, which is an elementary +metric argument, and the fact that the closure of a partially well-ordered set of reals is again +partially well ordered. +-/ + +universe v + +public noncomputable section + +open HahnSeries + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- Residual points lie in the closure of the support. -/ +theorem residualPointSet_subset_closure_support (b : SeriesWithOrdinalValueAboveOne K) : + residualPointSet b ⊆ closure (b.1 : K⟦ℝ⟧).support := by + intro γ hγ + by_contra hmem + exact translatedTruncation_not_mem_negativeMonomialIdeal_of_mem_residualPointSet hγ + (translatedTruncation_mem_negativeMonomialIdeal_of_not_mem_closure_support hmem) + +/-- Berarducci, Remark 6.3: the residual-point set is partially well ordered. -/ +theorem residualPointSet_isPWO (b : SeriesWithOrdinalValueAboveOne K) : + (residualPointSet b).IsPWO := + (Set.isPWO_closure (b.1 : K⟦ℝ⟧).isPWO_support).mono + (residualPointSet_subset_closure_support b) + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/StableInterval.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/StableInterval.lean new file mode 100644 index 0000000000..526e044b85 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/StableInterval.lean @@ -0,0 +1,250 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Stable support intervals for Berarducci's ordinal value + +Berarducci's discussion after Definition 5.2 describes the ordinal value through sufficiently +short open intervals immediately below zero. For a nonpositive series `b`, the set +`negativeSupportTail b η` is its support in the open interval `(η, 0)`. If the ordinal value is +greater than one, some such tail has ordinary order type exactly `v_J(b)`, and every shorter +nonempty tail has the same order type. These are the stable intervals used in Lemma 6.8. + +The endpoint zero is excluded because the third clause of the ordinal value works modulo `J + K`, +not merely modulo `J`. The proofs first choose a representative of minimum support order type and +then use eventual equality of negative coefficients modulo `J + K`. + +-/ + +universe v + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace Berarducci + +open HahnSeries + +variable {K : Type v} [Field K] + +/-- The support of a nonpositive series in the open interval `(η, 0)`. -/ +def negativeSupportTail (b : Series K) (η : ℝ) : Set ℝ := + (b : K⟦ℝ⟧).support ∩ Set.Ioo η 0 + +/-- Membership in a negative support tail records both strict endpoints. -/ +theorem mem_negativeSupportTail_iff {b : Series K} {η x : ℝ} : + x ∈ negativeSupportTail b η ↔ + x ∈ (b : K⟦ℝ⟧).support ∧ η < x ∧ x < 0 := + (Iff.rfl) + +/-- A negative support tail is contained in the support of the original series. -/ +theorem negativeSupportTail_subset_support (b : Series K) (η : ℝ) : + negativeSupportTail b η ⊆ (b : K⟦ℝ⟧).support := + fun _ hx ↦ (mem_negativeSupportTail_iff.mp hx).1 + +private def negativeSupportTailSeries (b : Series K) (η : ℝ) : Series K := + ⟨HahnSeries.filter (fun x ↦ η < x ∧ x < 0) (b : K⟦ℝ⟧), by + rw [HahnSeries.mem_nonpositiveSubring] + intro x hx + rw [HahnSeries.support_filter] at hx + exact hx.2.2.le⟩ + +private theorem support_negativeSupportTailSeries (b : Series K) (η : ℝ) : + ((negativeSupportTailSeries b η : Series K) : K⟦ℝ⟧).support = + negativeSupportTail b η := by + change (HahnSeries.filter (fun x ↦ η < x ∧ x < 0) (b : K⟦ℝ⟧)).support = _ + rw [HahnSeries.support_filter] + rfl + +private theorem negativeSupportTailSeries_sub_mem_nearConstantSubgroup + (b : Series K) (η : ℝ) (hη : η < 0) : + b - negativeSupportTailSeries b η ∈ nearConstantSubgroup K := by + rw [mem_nearConstantSubgroup_iff_sub_C_constantCoeff_mem] + rw [HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero] + let q := b - negativeSupportTailSeries b η - + HahnSeries.Nonpositive.C + (HahnSeries.Nonpositive.constantCoeff (b - negativeSupportTailSeries b η)) + change HahnSeries.Nonpositive.supportSup q < 0 + by_cases hq : q = 0 + · simp [hq] + · rw [HahnSeries.Nonpositive.supportSup_of_ne hq] + apply WithBot.coe_lt_coe.mpr + refine (csSup_le (HahnSeries.support_nonempty_iff.mpr ?_) ?_).trans_lt hη + · simpa using hq + · intro x hx + apply le_of_not_gt + intro hηx + have hx0 : x ≤ 0 := HahnSeries.Nonpositive.support_subset q hx + rcases hx0.eq_or_lt with rfl | hx0 + · have hcoeff : (q : K⟦ℝ⟧).coeff 0 = 0 := by + simp [q] + exact (HahnSeries.mem_support _ _).mp hx hcoeff + · have htailCoeff : + ((negativeSupportTailSeries b η : Series K) : K⟦ℝ⟧).coeff x = + (b : K⟦ℝ⟧).coeff x := by + simp [negativeSupportTailSeries, hηx, hx0] + have hcoeff : (q : K⟦ℝ⟧).coeff x = 0 := by + simp [q, htailCoeff, hx0.ne] + exact (HahnSeries.mem_support _ _).mp hx hcoeff + +/-- A series of ordinal value greater than one has an open negative support tail whose ordinary +order type is exactly its ordinal value. -/ +@[blueprint "fact:ordinal-value-support-tail" + (phase := "Ordinal value and degree") + (title := "Support-tail characterization of the ordinal value \ + (Ber00, Definition 5.2)") + (statement := /-- + Let $K$ be a field and let $b\in K((\mathbb R^{\le0}))$. If + $1 rw [valueProd_zero] + | cons a s ih => + rw [valueProd, Multiset.map_cons, Multiset.prod_cons, ← valueProd] + calc (1 : NatOrdinal) = 1 * 1 := (one_mul 1).symm + _ ≤ ordinalValue a.1 * valueProd s := mul_le_mul' a.2.le ih + +theorem one_lt_valueProd {w : FormalExpression K} (hw : w ≠ 0) : 1 < valueProd w := by + obtain ⟨a, ha⟩ := Multiset.exists_mem_of_ne_zero hw + obtain ⟨s, rfl⟩ := Multiset.exists_cons_of_mem ha + rw [valueProd, Multiset.map_cons, Multiset.prod_cons, ← valueProd] + calc (1 : NatOrdinal) < ordinalValue a.1 := a.2 + _ = ordinalValue a.1 * 1 := (mul_one _).symm + _ ≤ ordinalValue a.1 * valueProd s := mul_le_mul' le_rfl (one_le_valueProd s) + +open Classical in +/-- Splitting an expression at its selected factor. -/ +theorem replicate_selectedExponent_add_unselected (w : FormalExpression K) (hw : w ≠ 0) : + Multiset.replicate (selectedExponent w hw) (selected w hw) + unselected w hw = w := by + refine Multiset.ext.mpr fun y ↦ ?_ + rw [Multiset.count_add, unselected_eq, Multiset.count_replicate, Multiset.count_filter] + by_cases hy : y = selected w hw + · subst hy + rw [if_pos rfl, if_neg (fun h ↦ h rfl), add_zero, selectedExponent_eq_count] + · rw [if_neg (Ne.symm hy), if_pos hy, zero_add] + +end FormalExpression + +open FormalExpression + +/-- Berarducci, Lemma 9.6: the value of a product is the Hessenberg product of the values. -/ +theorem ordinalValue_eval [CharZero K] (w : FormalExpression K) : + ordinalValue (eval w) = valueProd w := by + suffices h : ∀ p : Multiset Ordinal × ℕ, ∀ (w : FormalExpression K) (hw : w ≠ 0), + complexity w hw = p → ordinalValue (eval w) = valueProd w by + rcases eq_or_ne w 0 with rfl | hw + · rw [eval_zero, valueProd_zero, ordinalValue_one] + · exact h _ w hw rfl + refine fun p ↦ wellFounded_complexityLT.induction + (C := fun q ↦ ∀ (w : FormalExpression K) (hw : w ≠ 0), complexity w hw = q → + ordinalValue (eval w) = valueProd w) p ?_ + clear p + intro p ih w hw hp + classical + have IH : ∀ w' : FormalExpression K, + (∀ hw' : w' ≠ 0, ComplexityLT (complexity w' hw') (complexity w hw)) → + ordinalValue (eval w') = valueProd w' := by + intro w' hlt + rcases eq_or_ne w' 0 with rfl | hw' + · rw [eval_zero, valueProd_zero, ordinalValue_one] + · exact ih (complexity w' hw') (hp ▸ hlt hw') w' hw' rfl + set x := selected w hw with hx + set r := unselected w hw with hrdef + obtain ⟨m, hm⟩ : ∃ m, selectedExponent w hw = m + 1 := + ⟨selectedExponent w hw - 1, by have := one_le_selectedExponent w hw; omega⟩ + have hdecomp : w = Multiset.replicate (m + 1) x + r := by + rw [hrdef, hx, ← hm, replicate_selectedExponent_add_unselected] + have heval : eval w = x.1 ^ (m + 1) * eval r := by + conv_lhs => rw [hdecomp] + rw [eval_add, eval_replicate] + have hvp : valueProd w = ordinalValue x.1 ^ (m + 1) * valueProd r := by + conv_lhs => rw [hdecomp] + rw [valueProd_add, valueProd_replicate] + have hr : ordinalValue (eval r) = valueProd r := + IH r fun hr0 ↦ complexityLT_unselected hw hr0 + -- the induction hypothesis at the reduced expression, for any admissible truncation factors + have hIHred : ∀ t : FormalExpression K, (∀ u ∈ t, ordinalValue u.1 < ordinalValue x.1) → + (∀ u ∈ t, x.principalValue ≤ u.principalValue) → + ordinalValue (eval t * x.1 ^ m * (eval r * eval r)) + = valueProd t * ordinalValue x.1 ^ m * (valueProd r * valueProd r) := by + intro t ht htp + have hred := IH (reduced w hw t) fun hne ↦ complexityLT_reduced w hw t ht htp hne + rw [reduced_eq, hm, Nat.add_sub_cancel] at hred + simpa only [eval_add, eval_replicate, valueProd_add, valueProd_replicate] using hred + -- the eventual hypothesis of Lemma 8.2 + have hkey : ∀ᶠ γ in nhdsWithin (0 : ℝ) (Set.Iio 0), γ ∈ residualPointSet x → + ordinalValue (translatedTruncation (x.1 : K⟦ℝ⟧) γ * x.1 ^ m * (eval r * eval r)) + = ordinalValue x.1 ^ m * ordinalValue (translatedTruncation (x.1 : K⟦ℝ⟧) γ) + * valueProd r * valueProd r := by + obtain ⟨η, hη, hlt⟩ := exists_ordinalValue_translatedTruncation_lt x + rw [eventually_nhdsLT_iff_exists] + refine ⟨η, hη, fun γ hlow hhigh hγ ↦ ?_⟩ + have hgv : ordinalValue (translatedTruncation (x.1 : K⟦ℝ⟧) γ) < ordinalValue x.1 := hlt γ hlow + hhigh + by_cases hg1 : 1 < ordinalValue (translatedTruncation (x.1 : K⟦ℝ⟧) γ) + · have h := hIHred {⟨translatedTruncation (x.1 : K⟦ℝ⟧) γ, hg1⟩} + (fun u hu ↦ by rw [Multiset.mem_singleton.mp hu]; exact hgv) + (fun u hu ↦ by + rw [Multiset.mem_singleton.mp hu] + exact principalValue_le_of_mem_residualPointSet x _ hγ rfl) + rw [eval_eq, valueProd, Multiset.map_singleton, Multiset.map_singleton, + Multiset.prod_singleton, Multiset.prod_singleton] at h + rw [h] + ring + · have hone : ordinalValue (translatedTruncation (x.1 : K⟦ℝ⟧) γ) = 1 := by + have hne : ordinalValue (translatedTruncation (x.1 : K⟦ℝ⟧) γ) ≠ 0 := by + rw [(mem_residualPointSet_iff.mp hγ).2] + exact x.residualValue_ne_zero + rcases eq_or_lt_of_le (Order.one_le_iff_pos.mpr (pos_iff_ne_zero.mpr hne)) with h | h + · exact h.symm + · exact absurd h hg1 + have h := hIHred 0 (by simp) (by simp) + rw [eval_zero, valueProd_zero, one_mul, one_mul] at h + rw [mul_assoc, ordinalValue_mul_of_ordinalValue_eq_one hone, h, hone] + ring + rcases eq_or_ne r 0 with hr0 | hr0 + · -- no other factor: the pure-power form of Lemma 8.2 + rw [heval, hvp, hr0, eval_zero, valueProd_zero, mul_one, mul_one] + refine ordinalValue_pow_eq_of_eventually x m (hkey.mono fun γ hγ hmem ↦ ?_) + have h := hγ hmem + simp only [hr0, eval_zero, valueProd_zero, mul_one] at h + exact h + · -- at least one other factor: the general form + have hc1 : 1 < ordinalValue (eval r) := hr ▸ one_lt_valueProd hr0 + set c : SeriesWithOrdinalValueAboveOne K := ⟨eval r, hc1⟩ with hcdef + have hce : c.1 = eval r := rfl + have hp' : x.principalValue ≤ c.principalValue := + principalValue_le_of_forall_mem x c r + (fun y hy ↦ (isSelected_selected w hw).min_principalValue y (mem_unselected.mp hy).1) + (by rw [hce]; exact hr) + have hev : ∀ᶠ γ in nhdsWithin (0 : ℝ) (Set.Iio 0), γ ∈ residualPointSet x → + ordinalValue (translatedTruncation (x.1 : K⟦ℝ⟧) γ * x.1 ^ m * c.1 ^ 2) + = ordinalValue x.1 ^ m * ordinalValue (translatedTruncation (x.1 : K⟦ℝ⟧) γ) + * ordinalValue c.1 * ordinalValue c.1 := by + refine hkey.mono fun γ hγ hmem ↦ ?_ + rw [hce, sq, hr] + exact hγ hmem + have h82 := ordinalValue_pow_mul_eq_of_eventually x c hp' m hev + rw [hce] at h82 + rw [heval, hvp, h82, hr] + +/-- Berarducci, Theorem 9.7: the ordinal value is multiplicative for the Hessenberg product. +Factors in `J` make both sides zero and factors of value one are deleted from both sides, which +reduces the statement to Lemma 9.6 on a two-factor expression. -/ +@[blueprint "fact:ordinal-value-multiplicativity" + (phase := "Ordinal value and degree") + (title := "Multiplicative property of the ordinal value (Ber00, Theorem 9.7)") + (statement := /-- + Let $K$ be a field of characteristic zero. For all + $b,c\in K((\mathbb R^{\le 0}))$, + \[ + v_J(bc)=v_J(b)\odot v_J(c). + \] + -/) + (proof := /-- + The cases $v_J(b)=0$, $v_J(c)=0$, $v_J(b)=1$, and $v_J(c)=1$ follow from + the ideal $J$ and multiplication by a series of ordinal value one. In the + remaining case, \ref{fact:ordinal-value-support-tail} bounds every sufficiently high + proper translated truncation below the value of its factor. Together with + \ref{lem:convolution-formula}, this supplies + Berarducci's well-founded induction on finite products of factors of ordinal + value greater than one. Applying the resulting identity to $b,c$ gives the + formula. + -/)] +theorem ordinalValue_mul [CharZero K] (b c : Series K) : + ordinalValue (b * c) = ordinalValue b * ordinalValue c := by + rcases eq_or_ne (ordinalValue b) 0 with hb0 | hb0 + · rw [hb0, zero_mul, ordinalValue_eq_zero_iff] + exact Ideal.mul_mem_right _ _ (ordinalValue_eq_zero_iff.mp hb0) + rcases eq_or_ne (ordinalValue c) 0 with hc0 | hc0 + · rw [hc0, mul_zero, ordinalValue_eq_zero_iff] + exact Ideal.mul_mem_left _ _ (ordinalValue_eq_zero_iff.mp hc0) + rcases eq_or_lt_of_le (Order.one_le_iff_pos.mpr (pos_iff_ne_zero.mpr hb0)) with hb1 | hb1 + · rw [← hb1, one_mul, ordinalValue_mul_of_ordinalValue_eq_one hb1.symm] + rcases eq_or_lt_of_le (Order.one_le_iff_pos.mpr (pos_iff_ne_zero.mpr hc0)) with hc1 | hc1 + · rw [← hc1, mul_one, mul_comm b c, ordinalValue_mul_of_ordinalValue_eq_one hc1.symm] + have h := ordinalValue_eval ({⟨b, hb1⟩, ⟨c, hc1⟩} : FormalExpression K) + rw [eval_eq, valueProd] at h + simpa using h + +/-- Berarducci, Corollary 9.8: the ideal of infinitesimal series is prime. -/ +theorem negativeMonomialIdeal_isPrime [CharZero K] : + (HahnSeries.Nonpositive.negativeMonomialIdeal K).IsPrime := by + rw [Ideal.isPrime_iff] + refine ⟨HahnSeries.Nonpositive.negativeMonomialIdeal_ne_top, ?_⟩ + intro b c hbc + have hzero : ordinalValue b * ordinalValue c = 0 := by + rw [← ordinalValue_mul, ordinalValue_eq_zero_iff] + exact hbc + by_cases hb : ordinalValue b = 0 + · exact Or.inl (ordinalValue_eq_zero_iff.mp hb) + · right + apply ordinalValue_eq_zero_iff.mp + by_contra hc + have hpos : 0 < ordinalValue b * ordinalValue c := + mul_pos (pos_iff_ne_zero.mpr hb) (pos_iff_ne_zero.mpr hc) + rw [hzero] at hpos + exact (lt_irrefl 0) hpos + +/-- Berarducci ordinal-value multiplicativity, imported as LM24, Fact 2.7.1(2). -/ +theorem ordinalValueMultiplicative [CharZero K] : OrdinalValueMultiplicative K := + OrdinalValueMultiplicative.of_forall ordinalValue_mul + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ResidualPoint.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ResidualPoint.lean new file mode 100644 index 0000000000..2c527154b7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ResidualPoint.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointTail +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +public import Mathlib.Topology.MetricSpace.Pseudo.Defs + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointWellOrdered +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointCofinality +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.OrderedUnion +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood +import Mathlib.Topology.MetricSpace.Pseudo.Lemmas + +/-! +# Berarducci residual-point tail statements + +This module gives direct Lean statements of Berarducci, Lemmas 6.8 and 6.9. Lemma 6.8 combines +the proved cofinality, well-ordering, and order-type results. Lemma 6.9 invokes Lemma 6.8, applies +the proved support-family construction, and then applies the proved ordered-union estimate from +Berarducci, Lemma 4.7. + +The phrase "sufficiently close to zero" is the filter `nhdsWithin 0 (Set.Iio 0)`. The order type +in Lemma 6.8 is an `Ordinal`, hence the explicit `.val` on the `NatOrdinal` principal value. The +product in Lemma 6.9 is ordinary ordinal multiplication inside `NatOrdinal.of`, not Hessenberg +multiplication. + +Berarducci prints Lemma 6.9 for arbitrary `b`, although both `X(b)` and `v_J^p(b)` were +defined only when `1 < v_J(b)`. The Lean statement uses `SeriesWithOrdinalValueAboveOne K` for `b`, +making that necessary domain explicit without adding a mathematical hypothesis to a well-formed +source formula. + +The theorem statements agree with the printed Lemmas 6.8 and 6.9. For residual value one, the +proof of Lemma 6.8 uses isolated successor-indexed support points instead of the failing +limit-index construction in the printed proof; its conclusion is unchanged. + +Berarducci's ambient coefficient field has characteristic zero. The source statements retain +that hypothesis even though their proved definitions and cofinality prerequisite are available over +an arbitrary field. +-/ + +universe v + +open scoped HahnSeries NatOrdinal Topology + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] + +/-- Berarducci, Lemma 6.8: sufficiently high residual-point tails have principal order type and +least upper bound zero. -/ +theorem residualPointTail_eventually [CharZero K] + (b : SeriesWithOrdinalValueAboveOne K) : + ∀ᶠ η in nhdsWithin (0 : ℝ) (Set.Iio 0), + (residualPointTail b η).Nonempty ∧ + ∃ htail : (residualPointTail b η).IsPWO, + htail.orderType = b.principalValue.val ∧ + IsLUB (residualPointTail b η) 0 := by + have hX := residualPointSet_isPWO b + have hXLUB := residualPointSet_isLUB_zero b + filter_upwards [residualPointTail_orderType_eventually b hX, + self_mem_nhdsWithin] with η htailType hη + have htailStructure := residualPointTail_nonempty_and_isLUB b hη hXLUB + exact ⟨htailStructure.1, residualPointTail_isPWO b η hX, + htailType, htailStructure.2⟩ + +/-- Berarducci, Lemma 6.9: an eventual lower bound on values of translated truncations along +`X(b)` gives the corresponding ordinary-product lower bound on `v_J(c)`. -/ +theorem ordinalValue_ge_of_eventually_ordinalValue_translatedTruncation_ge [CharZero K] + (b : SeriesWithOrdinalValueAboveOne K) (c : Series K) {ρ : Ordinal} + (hρ : Ordinal.IsPrincipal (fun α β ↦ α + β) ρ) + (hc : ∀ᶠ γ in nhdsWithin (0 : ℝ) (Set.Iio 0), + γ ∈ residualPointSet b → + NatOrdinal.of ρ ≤ ordinalValue (translatedTruncation (c : K⟦ℝ⟧) γ)) : + NatOrdinal.of (ρ * b.principalValue.val) ≤ ordinalValue c := by + by_cases hρ0 : ρ = 0 + · subst ρ + simp + obtain ⟨ηc, hηc, hcAbove⟩ := + eventually_nhdsLT_iff_exists.mp hc + obtain ⟨ηt, hηt, htailAbove⟩ := + eventually_nhdsLT_iff_exists.mp (residualPointTail_eventually b) + obtain ⟨η, hηLower, hη⟩ := exists_between (max_lt hηc hηt) + have hηcη : ηc < η := (le_max_left ηc ηt).trans_lt hηLower + have hηtη : ηt < η := (le_max_right ηc ηt).trans_lt hηLower + obtain ⟨_, ⟨htail, htailType, htailLUB⟩⟩ := + htailAbove η hηtη hη + have hcTail : ∀ γ ∈ residualPointTail b η, + NatOrdinal.of ρ ≤ ordinalValue (translatedTruncation (c : K⟦ℝ⟧) γ) := by + intro γ hγ + obtain ⟨hγX, hηγ⟩ := mem_residualPointTail_iff.mp hγ + exact hcAbove γ (hηcη.trans hηγ) + (residualPointSet_subset_Iio b hγX) hγX + apply le_ordinalValue_of_forall_mem_representativeOrderTypes + intro o ho + obtain ⟨d, hcd, rfl⟩ := mem_representativeOrderTypes_iff.mp ho + rw [NatOrdinal.of.le_iff_le] + obtain ⟨B, hB, hseparated, hfinal, hUnion, hsubset⟩ := + exists_supportFamily_of_residualPointTail b c hρ0 htail htailType htailLUB hcTail d hcd + have hproduct := hUnion.mul_le_orderType_iUnion_of_isSuccLimit + b.principalValue_isInfiniteMultiplicativelyPrincipal.isSuccLimit B hB + hseparated hfinal + calc + ρ * b.principalValue.val ≤ hUnion.orderType := hproduct + _ ≤ (d : K⟦ℝ⟧).isPWO_support.orderType := + hUnion.orderType_mono (d : K⟦ℝ⟧).isPWO_support hsubset + _ = (d : K⟦ℝ⟧).supportOrderType := + (HahnSeries.supportOrderType_eq_setOrderType _).symm + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests.lean new file mode 100644 index 0000000000..d4a36b33c1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests.lean @@ -0,0 +1,27 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.BerarducciPrimitives +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ComplexityDecrease +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.Convolution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ConvolutionList +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ConvolutionRemainder +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.CriticalPoint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueSubmultiplicative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponent +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponentDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponentTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubring +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFiniteSupport +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFraction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ResidualPoint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.SectionSixThree + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence.lean new file mode 100644 index 0000000000..cfd467ac0d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence.lean @@ -0,0 +1,17 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.BaseChange +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.CutoffConvolution +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.DerivAt +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.FinitePowerFamily +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.LoweringDerivation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.OmegaOmegaBoundary +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.PrincipalGraded +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.PrincipalIdealGE +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.SuccessorLeibniz + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/BaseChange.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/BaseChange.lean new file mode 100644 index 0000000000..9e0d5af381 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/BaseChange.lean @@ -0,0 +1,193 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.BaseChange +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval + +/-! +# API checks for coefficient base change + +Coefficient extension is exercised where it is supposed to be rigid: it fixes the support, hence +the ordinal value, and it carries constants to constants, so a nonzero constant series keeps its +ordinal value along any extension of fields. The zero series is checked separately, since an empty +support is the boundary case of the support computations. + +On the homogeneous components, the checks run through the intrinsic classes rather than through +representatives: the class of an extended representative is the extension of the class, +componentwise +base change is +evaluated on a pure tensor, and its injectivity, valid for every field extension, shows that +distinct classes stay distinct. + +The graded checks evaluate the base-change map on a homogeneous pure tensor, record that it is an +injective algebra map, and draw the conclusion used by the structure theorem: `E ⊗[K] P̂` is a +domain. They also record the graded ring homomorphism `P̂ → P̂^(E)` of coefficient extension on a +homogeneous element and as the factor of the base change on an arbitrary pure tensor. The +remaining checks record the coefficientwise formulas for a `K`-linear map between extensions: a +functional into `K`, and the structure map `K → E`, along which the coefficientwise map is +coefficient extension and preserves the ordinal value. +-/ + +universe v w + +open scoped DirectSum HahnSeries NatOrdinal TensorProduct + +public noncomputable section + +namespace Tests + +open Berarducci + +open Berarducci + +open HahnSeries.Nonpositive + +variable {K : Type v} {E : Type w} [Field K] [Field E] + +/-! ### Coefficient extension of nonpositive series -/ + +/-- Coefficient extension fixes the ordinal value of a nonzero constant series, and computes it as +the constant series on the extended value. This runs the extension along the structure map of a +genuine field extension rather than along an endomorphism of the base. -/ +theorem baseChange_ordinalValue_coefficientMap_C [Algebra K E] (k : K) : + ordinalValue (nonpositiveCoefficientMap (algebraMap K E) + (HahnSeries.Nonpositive.C k)) = + ordinalValue (HahnSeries.Nonpositive.C k) ∧ + nonpositiveCoefficientMap (algebraMap K E) (HahnSeries.Nonpositive.C k) = + HahnSeries.Nonpositive.C (algebraMap K E k) := + ⟨ordinalValue_nonpositiveCoefficientMap _ _, nonpositiveCoefficientMap_C _ k⟩ + +/-- Boundary case: the zero series has empty support, and coefficient extension preserves both +the support and the individual coefficients there. -/ +theorem baseChange_coefficientMap_zero (f : K →+* E) (x : ℝ) : + ((nonpositiveCoefficientMap f (0 : HahnSeries.Nonpositive ℝ K) : + HahnSeries.Nonpositive ℝ E) : E⟦ℝ⟧).support = ∅ ∧ + ((nonpositiveCoefficientMap f (0 : HahnSeries.Nonpositive ℝ K) : + HahnSeries.Nonpositive ℝ E) : E⟦ℝ⟧).coeff x = 0 := by + refine ⟨?_, ?_⟩ + · rw [support_nonpositiveCoefficientMap] + simp + · rw [coe_nonpositiveCoefficientMap] + simp + +/-- Deleting the constant term cannot increase the ordinal value or the support supremum. -/ +theorem baseChange_ordinalValue_sub_C_constantCoeff_le (b : HahnSeries.Nonpositive ℝ K) : + ordinalValue (b - HahnSeries.Nonpositive.C (HahnSeries.Nonpositive.constantCoeff b)) ≤ + ordinalValue b ∧ + supportSup (b - HahnSeries.Nonpositive.C (HahnSeries.Nonpositive.constantCoeff b)) ≤ + supportSup b := by + have hsub : ((b - HahnSeries.Nonpositive.C (HahnSeries.Nonpositive.constantCoeff b) : + HahnSeries.Nonpositive ℝ K) : K⟦ℝ⟧).support ⊆ (b : K⟦ℝ⟧).support := by + rw [support_sub_C_constantCoeff] + exact Set.sdiff_subset + exact ⟨ordinalValue_le_of_support_subset _ _ hsub, supportSup_mono hsub⟩ + +/-- Interface check: along the structure map `K → E`, viewed as a `K`-linear map between the +extensions `K` and `E` of `K`, the coefficientwise linear map is coefficient extension, and it +preserves the ordinal value, as every injective `K`-linear map does. -/ +theorem baseChange_linearCoeffMap_algebraMap [Algebra K E] (u : HahnSeries.Nonpositive ℝ K) : + nonpositiveLinearCoeffMap (Algebra.linearMap K E) u = + nonpositiveCoefficientMap (algebraMap K E) u ∧ + ordinalValue (nonpositiveLinearCoeffMap (Algebra.linearMap K E) u) = ordinalValue u := + ⟨Subtype.ext (by + ext x + rw [coe_nonpositiveLinearCoeffMap, coe_nonpositiveCoefficientMap] + rfl), + ordinalValue_nonpositiveLinearCoeffMap_of_injective _ (algebraMap K E).injective u⟩ + +/-! ### Base change of `P_α` -/ + +section Layer + + +/-- The class of an extended representative is the extension of the class, both for the additive +component map and for its semilinear refinement. -/ +theorem baseChange_layer_mk [Algebra K E] (alpha : NatOrdinal) + (u : HahnSeries.Nonpositive ℝ K) (hu : ordinalValue u < ω^ (alpha + 1)) : + principalComponentCoefficientExtendAddHom (algebraMap K E) alpha + (principalComponentMk alpha u hu) = + principalComponentMk alpha (nonpositiveCoefficientMap (algebraMap K E) u) + (by rw [ordinalValue_nonpositiveCoefficientMap]; exact hu) ∧ + principalComponentCoefficientExtend K E alpha (principalComponentMk alpha u hu) = + principalComponentMk alpha (nonpositiveCoefficientMap (algebraMap K E) u) + (by rw [ordinalValue_nonpositiveCoefficientMap]; exact hu) := + ⟨principalComponentCoefficientExtendAddHom_principalComponentMk _ alpha u hu, + principalComponentCoefficientExtend_principalComponentMk E alpha u hu⟩ + +/-- Componentwise base change evaluates on a pure tensor as the scalar multiple of the extended +class. -/ +theorem baseChange_layer_tmul [Algebra K E] (alpha : NatOrdinal) (e : E) + (A : PrincipalComponent K alpha) : + principalComponentBaseChange K E alpha (e ⊗ₜ[K] A) = + e • principalComponentCoefficientExtend K E alpha A := + principalComponentBaseChange_tmul alpha e A + +/-- Tensors with equal images are equal: componentwise base change reflects equality, for every +field extension `E / K`. -/ +theorem baseChange_layer_eq_of_image_eq [Algebra K E] + (alpha : NatOrdinal) {t₁ t₂ : E ⊗[K] PrincipalComponent K alpha} + (h : principalComponentBaseChange K E alpha t₁ = + principalComponentBaseChange K E alpha t₂) : t₁ = t₂ := + principalComponentBaseChange_injective K E alpha h + +/-- Applying a `K`-linear functional coefficientwise acts coefficientwise, does not enlarge the +support, and does not increase the ordinal value. -/ +theorem baseChange_linearCoeffMap_properties [Algebra K E] (r : E →ₗ[K] K) + (u : HahnSeries.Nonpositive ℝ E) (x : ℝ) : + ((nonpositiveLinearCoeffMap r u : HahnSeries.Nonpositive ℝ K) : K⟦ℝ⟧).coeff x = + r ((u : E⟦ℝ⟧).coeff x) ∧ + ((nonpositiveLinearCoeffMap r u : HahnSeries.Nonpositive ℝ K) : K⟦ℝ⟧).support ⊆ + (u : E⟦ℝ⟧).support ∧ + ordinalValue (nonpositiveLinearCoeffMap r u) ≤ ordinalValue u := + ⟨coe_nonpositiveLinearCoeffMap r u x, support_nonpositiveLinearCoeffMap_subset r u, + ordinalValue_nonpositiveLinearCoeffMap_le r u⟩ + +end Layer + +/-! ### Base change of `P̂` and the quotient `P̂/I` -/ + +section Graded + +variable [Algebra K E] + +/-- The graded base change evaluates on a homogeneous pure tensor as the scalar multiple of the +extended homogeneous class. -/ +theorem baseChange_graded_tmul_of (e : E) (alpha : NatOrdinal) + (A : PrincipalComponent K alpha) : + principalSubringBaseChange K E + (e ⊗ₜ[K] DirectSum.of (PrincipalComponent K) alpha A) = + e • DirectSum.of (PrincipalComponent E) alpha + (principalComponentCoefficientExtend K E alpha A) := + principalSubringBaseChange_tmul_of e alpha A + +/-- Coefficient extension of `P̂` is a ring homomorphism acting on a homogeneous element through +the component map, and the graded base change on any pure tensor `e ⊗ B` is `e` times the +coefficient +extension of `B`, whether or not `B` is homogeneous. -/ +theorem baseChange_graded_coefficientExtend (e : E) (alpha : NatOrdinal) + (A : PrincipalComponent K alpha) (B : PrincipalSubring K) : + principalSubringCoefficientExtend K E (DirectSum.of (PrincipalComponent K) alpha A) = + DirectSum.of (PrincipalComponent E) alpha + (principalComponentCoefficientExtend K E alpha A) ∧ + principalSubringBaseChangeLinear K E (e ⊗ₜ[K] B) = + e • principalSubringCoefficientExtend K E B := + ⟨principalSubringCoefficientExtend_of alpha A, principalSubringBaseChangeLinear_tmul e B⟩ + +/-- The graded base change is an injective `E`-algebra map, for every field extension. -/ +theorem baseChange_graded_injective : + Function.Injective (principalSubringBaseChange K E) := + principalSubringBaseChange_injective K E + +/-- Consequently `E ⊗[K] P̂` is a domain. -/ +theorem baseChange_graded_isDomain [CharZero E] : + IsDomain (E ⊗[K] PrincipalSubring K) := + isDomain_tensor_principalSubring K E + +end Graded + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/CutoffConvolution.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/CutoffConvolution.lean new file mode 100644 index 0000000000..dfd1ea0dc5 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/CutoffConvolution.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OmegaSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationPolynomial +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero + +/-! +# Cutoff and convolution API checks + +These clients exercise finiteness below an arbitrary negative cutoff and polynomial convolution +under bounds imposed only on nonzero germ products. The cutoff client uses the nonconstant +approach-zero series, so its value and support order type are genuinely omega. The convolution +boundary checks include an empty sum for a zero factor and a nonzero term at the zero cutoff. +They check these strengthened interfaces, not new definitions of series or ordinal value. +-/ + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial OrdinalGraded + +public noncomputable section + +namespace Tests + +universe v w + +variable {K : Type v} [Field K] + +/-- The nonconstant approach-zero series has finitely many cutoffs of ordinal value at least one +below every negative real, without requiring that real to belong to the cutoff set. -/ +theorem approachZero_negative_cutoff_finite {ξ : ℝ} (hξ : ξ < 0) : + (cutoffsGE 0 approachZeroNonpositive ∩ Set.Iic ξ).Finite := by + have hv := ordinalValue_eq_wpow_of_isPrincipal + approachZero_isPrincipal approachZero_degree_eq_one + apply cutoffsGE_inter_Iic_finite_of_neg approachZeroNonpositive + (by simpa using hv) ?_ hξ + simp [coe_approachZeroNonpositive, approachZero_supportOrderType] + +/-- The original membership-based cutoff interface remains available. -/ +theorem cutoff_membership_interface {δ : NatOrdinal} (p : Series K) + (hv : ordinalValue p = ω^ (δ + 1)) + (hot : (p : K⟦ℝ⟧).supportOrderType = (ω^ (δ + 1)).val) + {ξ : ℝ} (hξ : ξ ∈ cutoffsGE δ p) : (cutoffsGE δ p ∩ Set.Iic ξ).Finite := + cutoffsGE_inter_Iic_finite p hv hot hξ + +/-- A zero factor needs no cutoff in the support-indexed germ convolution sum. -/ +theorem zero_germ_convolution_empty (γ : ℝ) : + germAt ((0 : K⟦ℝ⟧) * 1) γ = + ∑ ξ ∈ (∅ : Finset ℝ), germAt (0 : K⟦ℝ⟧) ξ * germAt (1 : K⟦ℝ⟧) (γ - ξ) := by + apply germAt_mul_of_support_subset (0 : Series K) 1 γ + intro ξ hξ + exact (hξ (by + rw [Subring.coe_zero, germAt_apply, translatedTruncation_zero_input, map_zero, zero_mul])).elim + +/-- At the zero cutoff the product of two units has the singleton convolution term. -/ +theorem one_germ_convolution_at_zero : + germAt ((1 : ℚ⟦ℝ⟧) * 1) 0 = + ∑ ξ ∈ ({0} : Finset ℝ), germAt (1 : ℚ⟦ℝ⟧) ξ * germAt (1 : ℚ⟦ℝ⟧) (0 - ξ) := by + apply germAt_mul_of_support_subset (1 : Series ℚ) 1 0 + intro ξ hξ + by_contra hnot + have hclosure : ξ ∉ closure (1 : ℚ⟦ℝ⟧).support := by + simpa [HahnSeries.support_one] using hnot + exact hξ (by rw [Subring.coe_one, germAt_eq_zero_of_not_mem_closure_support hclosure, zero_mul]) + +/-- The singleton boundary check is not a vacuous zero convolution. -/ +theorem one_germ_convolution_term_ne_zero : + (∑ ξ ∈ ({0} : Finset ℝ), + germAt (1 : ℚ⟦ℝ⟧) ξ * germAt (1 : ℚ⟦ℝ⟧) (0 - ξ)) ≠ 0 := by + have h : germAt (1 : ℚ⟦ℝ⟧) 0 = 1 := by + rw [germAt_apply] + change toGerm (translatedTruncation ((1 : Series ℚ) : ℚ⟦ℝ⟧) 0) = 1 + rw [translatedTruncation_zero, map_one] + have hg : (1 : Germ ℚ) ≠ 0 := by + intro hz + have heq : toGerm (1 : Series ℚ) = toGerm 0 := by simpa using hz + have hv := ordinalValue_eq_of_sub_mem_negativeMonomialIdeal + (toGerm_eq_toGerm_iff.mp heq) + simp [ordinalValue_one, ordinalValue_zero] at hv + simpa only [Finset.sum_singleton, sub_zero, h, one_mul] using hg + +variable {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +/-- Bounds only at nonzero germ products suffice: the finite sum uses exactly those cutoffs. -/ +theorem polynomial_convolution_from_nonzero_bounds (σ : Lifts wt x) + (hx : IsMinimalSystem (principalGrading K) wt x) {α : NatOrdinal} + (hinj : ∀ β < α, InjectiveAt K wt x β) {u v : Series K} {γ : ℝ} + (hprod : ordinalValue (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ) < ω^ α) + (hterm : ∀ ξ : ℝ, + germAt (u : K⟦ℝ⟧) ξ * germAt (v : K⟦ℝ⟧) (γ - ξ) ≠ 0 → + ordinalValue (translatedTruncation (u : K⟦ℝ⟧) ξ) < ω^ α ∧ + ordinalValue (translatedTruncation (v : K⟦ℝ⟧) (γ - ξ)) < ω^ α ∧ + DegreeLT wt (σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) ξ) * + σ.pol hx α (translatedTruncation (v : K⟦ℝ⟧) (γ - ξ))) α) : + ∃ S : Finset ℝ, + (∀ ξ : ℝ, ξ ∈ S ↔ + germAt (u : K⟦ℝ⟧) ξ * germAt (v : K⟦ℝ⟧) (γ - ξ) ≠ 0) ∧ + σ.pol hx α (translatedTruncation ((u * v : Series K) : K⟦ℝ⟧) γ) = + ∑ ξ ∈ S, σ.pol hx α (translatedTruncation (u : K⟦ℝ⟧) ξ) * + σ.pol hx α (translatedTruncation (v : K⟦ℝ⟧) (γ - ξ)) := by + classical + let S := (convolutionIndex (u : K⟦ℝ⟧) (v : K⟦ℝ⟧) γ).filter fun ξ ↦ + germAt (u : K⟦ℝ⟧) ξ * germAt (v : K⟦ℝ⟧) (γ - ξ) ≠ 0 + have hS : ∀ ξ : ℝ, germAt (u : K⟦ℝ⟧) ξ * germAt (v : K⟦ℝ⟧) (γ - ξ) ≠ 0 → ξ ∈ S := by + intro ξ hξ + refine Finset.mem_filter.mpr ⟨?_, hξ⟩ + by_contra hnot + rw [mem_convolutionIndex, not_and_or] at hnot + rcases hnot with h | h + · exact hξ (by rw [germAt_eq_zero_of_not_mem_closure_support h, zero_mul]) + · exact hξ (by rw [germAt_eq_zero_of_not_mem_closure_support h, mul_zero]) + refine ⟨S, fun ξ ↦ ⟨fun hξ ↦ (Finset.mem_filter.mp hξ).2, hS ξ⟩, ?_⟩ + exact σ.pol_translatedTruncation_mul_eq_sum_of_nonzero_terms hx hinj hS hprod + fun ξ hξ ↦ hterm ξ (Finset.mem_filter.mp hξ).2 + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/DerivAt.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/DerivAt.lean new file mode 100644 index 0000000000..5b16538302 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/DerivAt.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponent +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LoweringDerivation +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAtInjective + +/-! +# API checks for `∂` on `P_α` + +The degree-one approach-zero series gives a nonzero class in the homogeneous component `P_1`. +Injectivity of `∂` +on `P_1` (D3) sends it to a nonzero element of `Fun_{0⁻}(P_0)`, and the derivation +`∂ : P̂ → Fun_{0⁻}(P̂)` sends its homogeneous inclusion to a nonzero function at `0⁻`. These +checks distinguish both maps from zero on a class represented by a series with infinite support +cofinal below zero. +-/ + +open Filter Topology +open scoped HahnSeries NatOrdinal TensorProduct + +public noncomputable section + +namespace Tests + +open Berarducci + +private theorem approachZero_ordinalValue_bound_for_lowering : + Berarducci.ordinalValue approachZeroNonpositive < + ω^ ((1 : NatOrdinal) + 1) := by + rw [Berarducci.ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal + approachZero_degree_eq_one] + exact NatOrdinal.wpow_lt_wpow.mpr (lt_add_one (1 : NatOrdinal)) + +private theorem one_constantCoeff_pos : + 0 < (1 : NatOrdinal).constantCoeff := by + have hcoeff : (1 : NatOrdinal).constantCoeff = 1 := by + simpa only [Nat.cast_one] using NatOrdinal.constantCoeff_natCast (1 : ℕ) + rw [hcoeff] + decide + +/-- `∂(B)` for the class `B ∈ P_1` of the degree-one approach-zero series. -/ +def approachZeroDerivAt : + FunAtZeroMinus (Berarducci.PrincipalComponent ℚ + ((1 : NatOrdinal).removeNat 1)) := + principalComponentDerivAt ℚ 1 one_constantCoeff_pos + (Berarducci.principalComponentMk 1 approachZeroNonpositive + approachZero_ordinalValue_bound_for_lowering) + +private theorem approachZeroPrincipalClass_ne_zero : + Berarducci.principalComponentMk 1 approachZeroNonpositive + approachZero_ordinalValue_bound_for_lowering ≠ 0 := by + intro hzero + have hlower := (Berarducci.principalComponentMk_eq_zero_iff 1 + approachZeroNonpositive approachZero_ordinalValue_bound_for_lowering).mp hzero + rw [Berarducci.ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal + approachZero_degree_eq_one] at hlower + exact lt_irrefl _ hlower + +private theorem approachZero_ordinalValue_bound_for_natCast_one : + Berarducci.ordinalValue approachZeroNonpositive < + ω^ (((1 : ℕ) : NatOrdinal) + 1) := by + simpa only [Nat.cast_one] using approachZero_ordinalValue_bound_for_lowering + +private theorem approachZeroPrincipalClassNatCast_ne_zero : + Berarducci.principalComponentMk ((1 : ℕ) : NatOrdinal) + approachZeroNonpositive approachZero_ordinalValue_bound_for_natCast_one ≠ 0 := by + intro hzero + have hlower := (Berarducci.principalComponentMk_eq_zero_iff + ((1 : ℕ) : NatOrdinal) approachZeroNonpositive + approachZero_ordinalValue_bound_for_natCast_one).mp hzero + rw [Berarducci.ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal + approachZero_degree_eq_one] at hlower + have : ω^ (1 : NatOrdinal) < ω^ (1 : NatOrdinal) := by + simpa only [Nat.cast_one] using hlower + exact lt_irrefl _ this + +/-- `∂(B) ≠ 0` for the approach-zero class `B`, because support cutoffs remain cofinal at +zero. -/ +theorem approachZeroDerivAt_ne_zero : + approachZeroDerivAt ≠ 0 := by + rw [approachZeroDerivAt] + exact principalComponentDerivAt_ne_zero 1 + one_constantCoeff_pos approachZeroPrincipalClass_ne_zero + +/-- The homogeneous inclusion of the approach-zero class in `P̂`. -/ +def approachZeroPrincipalElement : Berarducci.PrincipalSubring ℚ := + DirectSum.of (Berarducci.PrincipalComponent ℚ) 1 + (Berarducci.principalComponentMk 1 approachZeroNonpositive + approachZero_ordinalValue_bound_for_lowering) + +/-- The derivation `∂` of `P̂` detects the approach-zero element: `∂` is injective on `P_1`. -/ +theorem principalSubringDerivation_approachZero_ne_zero : + principalSubringDerivation ℚ approachZeroPrincipalElement ≠ 0 := by + intro hzero + have h := (principalSubringDerivation_isLoweringDerivation ℚ).injective + one_constantCoeff_pos (of_mem_principalGrading 1 _) hzero + exact approachZeroPrincipalClass_ne_zero + (DirectSum.of_injective 1 (h.trans (map_zero _).symm)) + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/FinitePowerFamily.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/FinitePowerFamily.lean new file mode 100644 index 0000000000..dc1b9534d9 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/FinitePowerFamily.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamilyProof + +/-! +# Boundary examples for the finite-power family + +At `n = 0`, the positive support consists of one exponent, and adjoining the constant term gives +a support of order type two. At `n = 1`, the first two positive exponents are `4 / 3` and +`4 / 9`. At `n = 2`, the first exponent is `13 / 9` and the support has order type `ω ^ 2 + 1`. +These values distinguish +the recursive lexicographic construction from a constant sequence or a one-dimensional +flattening. + +The constant coefficient is one before subtracting one and zero afterwards. The doubled family +has the same exponent support, showing directly that the support is insensitive to this change of +coefficients. +-/ + +public noncomputable section + +namespace Tests.HahnSeries.OrdinalValue.AlgebraicIndependence.FinitePowerFamily + +open Ordinal +open ConwayRefinement.Standalone.Oz.FinitePowerFamily + +example : finitePowerConwayExponent 0 () = 1 := by + rw [finitePowerConwayExponent_apply, finitePowerExponent_zero] + norm_num + +example : finitePowerConwayExponent 1 (toLex (0, ())) = 4 / 3 := by + rw [finitePowerConwayExponent_apply, finitePowerExponent_succ, + finitePowerExponent_zero, scale_eq_one_div_three] + norm_num + +example : finitePowerConwayExponent 1 (toLex (1, ())) = 4 / 9 := by + rw [finitePowerConwayExponent_apply, finitePowerExponent_succ, + finitePowerExponent_zero, scale_eq_one_div_three] + norm_num + +example : + finitePowerConwayExponent 2 (toLex (0, toLex (0, ()))) = 13 / 9 := by + rw [finitePowerConwayExponent_apply, finitePowerExponent_succ, + finitePowerExponent_succ, finitePowerExponent_zero, + scale_eq_one_div_three] + norm_num + +example : (finitePowerOz 0).1.length = 2 := by + rw [finitePowerOz_length] + norm_num + +example : (finitePowerOz 1).1.length = ω + 1 := by + simpa using finitePowerOz_length 1 + +example : (finitePowerOz 2).1.length = ω ^ (2 : Ordinal) + 1 := + finitePowerOz_length 2 + +example : finitePowerOz 1 ≠ finitePowerOz 2 := by + intro h + have := finitePowerOz_injective h + omega + +example (n : ℕ) : 0 ∉ ((finitePowerOz n).1 - 1).support := + zero_not_mem_finitePowerOz_sub_one_support n + +example (n : ℕ) : + (finitePowerFoil n).1.support = (finitePowerOz n).1.support := + finitePowerFoil_support n + +example (n : ℕ) : ¬ ConwayRefinement.Standalone.Oz.IsReduced (finitePowerFoil n) := + finitePowerFoil_not_isReduced n + +example (n : ℕ) : IsPrimal (finitePowerOz n) := + PrimalFamily.proof n + +end Tests.HahnSeries.OrdinalValue.AlgebraicIndependence.FinitePowerFamily diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/LoweringDerivation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/LoweringDerivation.lean new file mode 100644 index 0000000000..86a0e1f50a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/LoweringDerivation.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LoweringDerivation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree + +/-! +# API checks for the quotient `P̂/I` + +The quotient `P̂/I` satisfies two conclusions of different strength: the ideal `I` is prime, +equivalently `P̂/I` is a domain, and `P̂/I` is geometrically integral over `K`. + +Geometric integrality is strictly stronger than integrality over `K`: tensoring with every field +extension must give a domain, with no finiteness or separability hypothesis. + +The separate nontriviality statement matters because a quotient by the whole ring would satisfy +the no-zero-divisors condition vacuously, while `IsDomain` also requires `0 ≠ 1`. +-/ + +open scoped TensorProduct + +public noncomputable section + +namespace Tests + +open Berarducci +open Berarducci + +universe v + +variable {K : Type v} [Field K] + +variable (K) in +/-- The ideal `I = I_{≥1}` is proper, so the quotient `P̂/I` is nontrivial, over every field. -/ +theorem coefficientIdeal_ne_top : + principalFibreIdeal K ≠ ⊤ := + fun h ↦ LoweringDerivation.one_notMem_fibreIdeal _ (h ▸ Submodule.mem_top) + +variable [CharZero K] + +variable (K) in +/-- The quotient `P̂/I` is a domain. -/ +theorem coefficientQuotient_isDomain : + IsDomain (PrincipalFibre K) := + principalFibre_isDomain K + +variable (K) in +/-- Tensoring `P̂/I` with an arbitrary field extension gives a domain. -/ +theorem coefficientQuotient_isDomain_tensor (L : Type (max 1 v)) [Field L] [Algebra K L] : + IsDomain (PrincipalFibre K ⊗[K] L) := + Algebra.isGeometricallyIntegral_iff.mp + (principalFibre_isGeometricallyIntegral K) L + +variable (K) in +/-- The quotient `P̂/I` is geometrically integral over `K`. -/ +theorem coefficientQuotient_isGeometricallyIntegral : + Algebra.IsGeometricallyIntegral K (PrincipalFibre K) := + principalFibre_isGeometricallyIntegral K + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/OmegaOmegaBoundary.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/OmegaOmegaBoundary.lean new file mode 100644 index 0000000000..a617bffc9b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/OmegaOmegaBoundary.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmegaOmegaBoundary + +/-! +# Concrete values at the `ω ^ ω` boundary + +The unique exponent in block zero is `7 / 9`, while the first exponent in block one is `25 / 81`. +Thus successive tuple blocks are genuinely rescaled and separated rather than superimposed. The +normal form has coefficient zero at exponent zero, distinguishing the purely infinite boundary +element from the finite-power family, whose normal forms include a constant term. +-/ + +public noncomputable section + +namespace Tests.HahnSeries.OrdinalValue.AlgebraicIndependence.OmegaOmegaBoundary + +open Ordinal +open ConwayRefinement.Standalone.Oz.FinitePowerFamily +open ConwayRefinement.Standalone.Oz.OmegaOmegaBoundary + +example : boundaryConwayExponent (toLex ⟨0, ()⟩) = 7 / 9 := by + rw [boundaryConwayExponent_apply, boundarySignedExponent_mk, + finitePowerExponent_zero, scale_eq_one_div_three] + norm_num + +example : boundaryConwayExponent (toLex ⟨1, toLex (0, ())⟩) = 25 / 81 := by + rw [boundaryConwayExponent_apply, boundarySignedExponent_mk, + finitePowerExponent_succ, finitePowerExponent_zero, scale_eq_one_div_three] + norm_num + +example : + boundaryConwayExponent (toLex ⟨1, toLex (0, ())⟩) < + boundaryConwayExponent (toLex ⟨0, ()⟩) := by + norm_num [boundaryConwayExponent_apply, boundarySignedExponent_mk, + finitePowerExponent_succ, finitePowerExponent_zero, scale_eq_one_div_three] + +example : + boundaryOz.1.coeff (boundaryExponentAtIndex (toLex ⟨0, ()⟩)) = 1 := + boundaryOz_coeff_exponent _ + +example : boundaryOz.1.coeff 0 = 0 := + boundaryOz_coeff_zero + +example : boundaryOz.1.length = ω ^ ω := + boundaryOz_length + +example : ¬ ConwayRefinement.Standalone.Oz.IsOrdinaryInteger boundaryOz := + boundaryOz_not_isOrdinaryInteger + +example : ConwayRefinement.Standalone.Oz.IsReduced boundaryOz := + boundaryOz_isReduced + +example : ¬ ConwayRefinement.Standalone.Oz.HasFiniteDegree boundaryOz := + boundaryOz_not_hasFiniteDegree + +end Tests.HahnSeries.OrdinalValue.AlgebraicIndependence.OmegaOmegaBoundary diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/PrincipalGraded.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/PrincipalGraded.lean new file mode 100644 index 0000000000..d6d0f91747 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/PrincipalGraded.lean @@ -0,0 +1,213 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalGraded + +/-! +# API checks for the finite-degree part `P̂_{<ω}` and the quotient `P̂/I` + +The approach-zero series supplies a nonzero class in `P_1`. Its homogeneous realization belongs +to `(P̂_{<ω})₊`, whereas a nonzero scalar in `P_0` belongs to `P̂_{<ω}` but not to `(P̂_{<ω})₊`. +These two examples separate the ideal of positive degree from both the zero ideal and all of +`P̂_{<ω}`. + +The same degree-one class remains nonzero modulo the decomposables because +`(P̂_{<ω})₊² ∩ P_1 = 0`. Its nonzero square belongs to `(P̂_{<ω})₊² ∩ P_2` and vanishes in +`P_2 / ((P̂_{<ω})₊² ∩ P_2)`. These examples distinguish the decomposables from both zero and the +whole component. They also show that the minimal system `𝓑` has a member of degree one, so the +polynomial evaluation statements are nonvacuous. Surjectivity is then exercised on an element +having both nonzero scalar and positive homogeneous parts. + +Finally, a nonzero homogeneous class in degree `ω` is excluded from `P̂_{<ω}`, distinguishing +`P̂_{<ω}` from `P̂`. +-/ + +public noncomputable section + +namespace Tests + +open scoped DirectSum HahnSeries NatOrdinal + +private theorem approachZero_ordinalValue_bound_for_finiteDegree : + Berarducci.ordinalValue approachZeroNonpositive < + ω^ (((1 : ℕ) : NatOrdinal) + 1) := by + rw [Berarducci.ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal + approachZero_degree_eq_one] + rw [Nat.cast_one] + exact NatOrdinal.wpow_lt_wpow.mpr (lt_add_one (1 : NatOrdinal)) + +/-- The nonzero degree-one principal class represented by the approach-zero series. -/ +def finiteDegreeApproachZeroComponent : + Berarducci.PrincipalComponent ℚ ((1 : ℕ) : NatOrdinal) := + Berarducci.principalComponentMk ((1 : ℕ) : NatOrdinal) approachZeroNonpositive + approachZero_ordinalValue_bound_for_finiteDegree + +theorem finiteDegreeApproachZeroComponent_ne_zero : + finiteDegreeApproachZeroComponent ≠ 0 := by + intro hzero + rw [finiteDegreeApproachZeroComponent] at hzero + have hlt := (Berarducci.principalComponentMk_eq_zero_iff + ((1 : ℕ) : NatOrdinal) approachZeroNonpositive + approachZero_ordinalValue_bound_for_finiteDegree).mp hzero + rw [Berarducci.ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal + approachZero_degree_eq_one] at hlt + rw [Nat.cast_one] at hlt + exact (lt_irrefl _) hlt + +/-- The approach-zero class regarded as a homogeneous element of `P̂_{<ω}`. -/ +def finiteDegreeApproachZeroElement : + Berarducci.principalFiniteDegreePart ℚ := + Berarducci.finiteDegreeOf ℚ 1 + finiteDegreeApproachZeroComponent + +/-- The degree-one fixture belongs to `(P̂_{<ω})₊` and remains nonzero in `P̂_{<ω}`. -/ +theorem finiteDegreeApproachZeroElement_positive_nonzero : + finiteDegreeApproachZeroElement ∈ + Berarducci.positiveFinitePrincipalIdeal ℚ ∧ + finiteDegreeApproachZeroElement ≠ 0 := by + constructor + · rw [Berarducci.mem_positiveFinitePrincipalIdeal_iff_component_zero, + finiteDegreeApproachZeroElement, + Berarducci.coe_finiteDegreeOf, + DirectSum.of_apply] + simp + · intro hzero + apply finiteDegreeApproachZeroComponent_ne_zero + apply Berarducci.finiteDegreeOf_injective ℚ 1 + rw [map_zero] + exact hzero + +private theorem principalComponentScalarOne_ne_zero : + Berarducci.principalComponentScalarHom ℚ (1 : ℚ) ≠ 0 := by + rw [Berarducci.principalComponentScalarHom_apply] + intro hzero + have hlt := (Berarducci.principalComponentMk_eq_zero_iff 0 + ((HahnSeries.Nonpositive.C : ℚ →+* Berarducci.Series ℚ) 1) + (Berarducci.ordinalValue_C_lt_wpow_one 1)).mp hzero + rw [Berarducci.ordinalValue_C_of_ne one_ne_zero, + NatOrdinal.wpow_zero] at hlt + exact (lt_irrefl _) hlt + +/-- The nonzero scalar one, represented homogeneously in degree zero of `P̂_{<ω}`. -/ +def finiteDegreeScalarOne : + Berarducci.principalFiniteDegreePart ℚ := + 1 + +/-- The scalar fixture belongs to `P̂_{<ω}` but not to its ideal `(P̂_{<ω})₊` of positive degree. -/ +theorem finiteDegreeScalarOne_not_mem_positive : + finiteDegreeScalarOne ∉ + Berarducci.positiveFinitePrincipalIdeal ℚ := by + rw [Berarducci.mem_positiveFinitePrincipalIdeal_iff_component_zero, + finiteDegreeScalarOne] + change (1 : Berarducci.PrincipalSubring ℚ) 0 ≠ 0 + rw [← map_one (algebraMap ℚ (Berarducci.PrincipalSubring ℚ)), + Berarducci.principalSubring_algebraMap_apply, DirectSum.of_apply] + simp + +/-- The nonzero degree-one class in the quotient `P_1 / ((P̂_{<ω})₊² ∩ P_1)`. -/ +def finiteDegreeApproachZeroIndecomposable : + Berarducci.PrincipalIndecomposableQuotient ℚ 1 := + Berarducci.principalIndecomposableMk ℚ 1 + finiteDegreeApproachZeroComponent + +/-- The approach-zero class survives modulo the decomposables, as `(P̂_{<ω})₊² ∩ P_1 = 0`. -/ +theorem finiteDegreeApproachZeroIndecomposable_ne_zero : + finiteDegreeApproachZeroIndecomposable ≠ 0 := by + rw [finiteDegreeApproachZeroIndecomposable, ne_eq, + Berarducci.principalIndecomposableMk_eq_zero_iff, + Berarducci.decomposablePrincipalComponent_one, Submodule.mem_bot] + exact finiteDegreeApproachZeroComponent_ne_zero + +/-- The square of the approach-zero principal class, in degree two. -/ +def finiteDegreeApproachZeroSquare : + Berarducci.PrincipalComponent ℚ ((2 : ℕ) : NatOrdinal) := + Berarducci.principalComponentMulNat ℚ 1 1 + finiteDegreeApproachZeroComponent + finiteDegreeApproachZeroComponent + +/-- The square is a nonzero decomposable vector: it lies in `(P̂_{<ω})₊² ∩ P_2`. -/ +theorem finiteDegreeApproachZeroSquare_mem_decomposable_ne_zero : + finiteDegreeApproachZeroSquare ∈ + Berarducci.decomposablePrincipalComponent ℚ 2 ∧ + finiteDegreeApproachZeroSquare ≠ 0 := by + constructor + · exact Berarducci.principalComponentMulNat_mem_decomposable + (i := 1) (j := 1) (Nat.zero_lt_succ 0) (Nat.zero_lt_succ 0) + finiteDegreeApproachZeroComponent + finiteDegreeApproachZeroComponent + · exact Berarducci.principalComponentMulNat_ne_zero + finiteDegreeApproachZeroComponent_ne_zero + finiteDegreeApproachZeroComponent_ne_zero + +/-- The same nonzero decomposable square vanishes in `P_2 / ((P̂_{<ω})₊² ∩ P_2)`. -/ +theorem finiteDegreeApproachZeroSquare_indecomposable_eq_zero : + Berarducci.principalIndecomposableMk ℚ 2 + finiteDegreeApproachZeroSquare = 0 := by + rw [Berarducci.principalIndecomposableMk_eq_zero_iff] + exact finiteDegreeApproachZeroSquare_mem_decomposable_ne_zero.1 + +/-- The quotient map `π : P̂ → P̂/I` kills the degree-one fixture. -/ +theorem finiteDegreeApproachZeroElement_quotient_eq_zero : + Berarducci.principalFibreMap ℚ + (finiteDegreeApproachZeroElement : + Berarducci.PrincipalSubring ℚ) = 0 := by + rw [Berarducci.principalFibreMap_eq_zero_iff] + exact Berarducci.coe_mem_principalFibreIdeal + finiteDegreeApproachZeroElement_positive_nonzero.1 + +/-- A nonzero homogeneous class in degree `ω` does not belong to `P̂_{<ω}`. -/ +theorem infiniteDegreeHomogeneous_not_mem_finite + (x : Berarducci.PrincipalComponent ℚ (NatOrdinal.of Ordinal.omega0)) + (hx : x ≠ 0) : + DirectSum.of (Berarducci.PrincipalComponent ℚ) + (NatOrdinal.of Ordinal.omega0) x ∉ + Berarducci.principalFiniteDegreePart ℚ := by + intro hmem + have hfinite := + (Berarducci.mem_principalFiniteDegreePart_iff _).mp hmem + have hcomponent : + (DirectSum.of (Berarducci.PrincipalComponent ℚ) + (NatOrdinal.of Ordinal.omega0) x) (NatOrdinal.of Ordinal.omega0) ≠ 0 := by + rw [DirectSum.of_apply] + simpa using hx + exact (lt_irrefl _) (hfinite (NatOrdinal.of Ordinal.omega0) hcomponent) + +/-- The minimal system `𝓑` has an element of degree one. -/ +theorem exists_minimalSystem_degree_one : + ∃ x : Berarducci.MinimalSystem ℚ, + Berarducci.minimalSystemDegree x = 1 := by + let q := finiteDegreeApproachZeroIndecomposable + have hq : q ≠ 0 := finiteDegreeApproachZeroIndecomposable_ne_zero + letI : Nontrivial (Berarducci.PrincipalIndecomposableQuotient ℚ 1) := + ⟨⟨q, 0, hq⟩⟩ + obtain ⟨i⟩ := (Berarducci.principalIndecomposableBasis ℚ 1).index_nonempty + exact ⟨⟨⟨1, by decide⟩, i⟩, rfl⟩ + +/-- The evaluation `K[X_B : B ∈ 𝓑] → P̂_{<ω}` has a variable `X_B` with `deg B = 1` whose value is +nonzero and of positive degree. -/ +theorem exists_finiteDegreePolynomialVariable_degree_one : + ∃ x : Berarducci.MinimalSystem ℚ, + Berarducci.minimalSystemDegree x = 1 ∧ + Berarducci.finiteDegreePolynomialEval ℚ (MvPolynomial.X x) ≠ 0 ∧ + Berarducci.finiteDegreePolynomialEval ℚ (MvPolynomial.X x) ∈ + Berarducci.positiveFinitePrincipalIdeal ℚ := by + obtain ⟨x, hx⟩ := exists_minimalSystem_degree_one + refine ⟨x, hx, ?_, ?_⟩ + · rw [Berarducci.finiteDegreePolynomialEval_X] + exact Berarducci.minimalSystemElement_ne_zero x + · rw [Berarducci.finiteDegreePolynomialEval_X] + exact Berarducci.minimalSystemElement_mem_positive x + +/-- Polynomial evaluation reaches a target with nonzero degree-zero and degree-one parts. -/ +theorem exists_finiteDegreePolynomial_scalar_add_approachZero : + ∃ p : MvPolynomial (Berarducci.MinimalSystem ℚ) ℚ, + Berarducci.finiteDegreePolynomialEval ℚ p = + finiteDegreeScalarOne + finiteDegreeApproachZeroElement := + Berarducci.finiteDegreePolynomialEval_surjective ℚ _ + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/PrincipalIdealGE.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/PrincipalIdealGE.lean new file mode 100644 index 0000000000..634841cdbb --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/PrincipalIdealGE.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalIdealGE + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LoweringDerivation + +/-! +# API checks for the filtration `I_{≥•}` + +The approach-zero class gives a nonzero homogeneous element of degree one in `I_{≥1} \ I_{≥2}`; +its square gives one in `I_{≥2} \ I_{≥3}`. Adding a nonzero scalar component to the degree-one +element produces an element outside `I_{≥1}`, which distinguishes the filtration from a cutoff +determined by the largest visible homogeneous degree. +-/ + +open scoped DirectSum HahnSeries NatOrdinal + +public noncomputable section + +namespace Tests + +open Berarducci + +private theorem approachZero_ordinalValue_bound_for_idealGE : + Berarducci.ordinalValue approachZeroNonpositive < + ω^ (((1 : ℕ) : NatOrdinal) + 1) := by + rw [Berarducci.ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal + approachZero_degree_eq_one] + simpa only [Nat.cast_one] using + NatOrdinal.wpow_lt_wpow.mpr (lt_add_one (1 : NatOrdinal)) + +/-- The approach-zero series represented in the homogeneous component `P_1`. -/ +def idealGEApproachZeroLayer : + Berarducci.PrincipalComponent ℚ ((1 : ℕ) : NatOrdinal) := + Berarducci.principalComponentMk ((1 : ℕ) : NatOrdinal) + approachZeroNonpositive approachZero_ordinalValue_bound_for_idealGE + +/-- The approach-zero class used by the filtration fixture is nonzero. -/ +theorem idealGEApproachZeroLayer_ne_zero : + idealGEApproachZeroLayer ≠ 0 := by + intro hzero + have hlower := (Berarducci.principalComponentMk_eq_zero_iff + ((1 : ℕ) : NatOrdinal) approachZeroNonpositive + approachZero_ordinalValue_bound_for_idealGE).mp hzero + rw [Berarducci.ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal + approachZero_degree_eq_one] at hlower + have : ω^ (1 : NatOrdinal) < ω^ (1 : NatOrdinal) := by + simpa only [Nat.cast_one] using hlower + exact (lt_irrefl _) this + +/-- The approach-zero class placed homogeneously in `P̂`. -/ +def idealGEApproachZeroElement : Berarducci.PrincipalSubring ℚ := + DirectSum.of (Berarducci.PrincipalComponent ℚ) ((1 : ℕ) : NatOrdinal) + idealGEApproachZeroLayer + +/-- The degree-one fixture lies in `I_{≥1}` but not in `I_{≥2}`. -/ +theorem idealGEApproachZeroElement_mem_one_not_mem_two : + idealGEApproachZeroElement ∈ principalIdealGE ℚ 1 ∧ + idealGEApproachZeroElement ∉ principalIdealGE ℚ 2 := by + constructor + · exact principalIdealGEGenerator_mem (le_refl 1) + idealGEApproachZeroLayer + · intro hmem + apply idealGEApproachZeroLayer_ne_zero + apply eq_zero_of_homogeneous_mem_principalIdealGE + (j := 2) (δ := ((1 : ℕ) : NatOrdinal)) (by + rw [NatOrdinal.constantCoeff_natCast] + decide) + exact hmem + +/-- The square of the approach-zero class in the homogeneous component `P_2`. -/ +def idealGEApproachZeroSquare : + Berarducci.PrincipalComponent ℚ ((2 : ℕ) : NatOrdinal) := + principalComponentMulNat ℚ 1 1 + idealGEApproachZeroLayer idealGEApproachZeroLayer + +/-- The square of the approach-zero class is nonzero. -/ +theorem idealGEApproachZeroSquare_ne_zero : + idealGEApproachZeroSquare ≠ 0 := + principalComponentMulNat_ne_zero + idealGEApproachZeroLayer_ne_zero + idealGEApproachZeroLayer_ne_zero + +/-- The approach-zero square placed homogeneously in `P̂`. -/ +def idealGEApproachZeroSquareElement : Berarducci.PrincipalSubring ℚ := + DirectSum.of (Berarducci.PrincipalComponent ℚ) ((2 : ℕ) : NatOrdinal) + idealGEApproachZeroSquare + +/-- The degree-two fixture lies in `I_{≥2}` but not in `I_{≥3}`. -/ +theorem idealGEApproachZeroSquareElement_mem_two_not_mem_three : + idealGEApproachZeroSquareElement ∈ principalIdealGE ℚ 2 ∧ + idealGEApproachZeroSquareElement ∉ principalIdealGE ℚ 3 := by + constructor + · exact principalIdealGEGenerator_mem (le_refl 2) + idealGEApproachZeroSquare + · intro hmem + apply idealGEApproachZeroSquare_ne_zero + apply eq_zero_of_homogeneous_mem_principalIdealGE + (j := 3) (δ := ((2 : ℕ) : NatOrdinal)) (by + rw [NatOrdinal.constantCoeff_natCast] + decide) + exact hmem + +/-- The sum of scalar one and the homogeneous degree-one fixture. -/ +def idealGEScalarPlusApproachZero : Berarducci.PrincipalSubring ℚ := + 1 + idealGEApproachZeroElement + +/-- A nonzero scalar component prevents the mixed fixture from belonging to `I_{≥1}`. -/ +theorem idealGEScalarPlusApproachZero_not_mem_one : + idealGEScalarPlusApproachZero ∉ principalIdealGE ℚ 1 := by + intro hmem + have hzero := principalIdealGE_component_eq_zero + idealGEScalarPlusApproachZero hmem (δ := 0) (by simp) + have hscalar : (1 : Berarducci.PrincipalSubring ℚ) 0 ≠ 0 := by + intro hone + have hone' : GradedMonoid.GOne.one = + (0 : Berarducci.PrincipalComponent ℚ 0) := by + simpa only [DirectSum.one_def, DirectSum.of_apply, dite_true] using hone + apply (one_ne_zero : (1 : Berarducci.PrincipalSubring ℚ) ≠ 0) + rw [DirectSum.one_def, hone', map_zero] + apply hscalar + simpa [idealGEScalarPlusApproachZero, idealGEApproachZeroElement, + DirectSum.add_apply, DirectSum.of_apply] using hzero + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/SuccessorLeibniz.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/SuccessorLeibniz.lean new file mode 100644 index 0000000000..97a1a63d3c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/SuccessorLeibniz.lean @@ -0,0 +1,169 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorLeibniz +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LoweringDerivation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAtInjective + +/-! +# API checks for the Leibniz identities on the spaces `P_α` + +The degree-one approach-zero series `a` has a nonzero class in `P_1`. Its +square exercises the two-term identity `eventually_of_derivAt_mul_of_pos`; the check +records that neither endpoint term is degenerate, because the class of `a` is nonzero and the +values `∂(a)(γ)` are not eventually zero. A nonzero constant `k`, of degree `0`, against +`a` exercises the one-term identity `eventually_of_derivAt_mul_of_eq_zero`, and the +Leibniz rule `principalSubringDerivation_mul` of `∂ : P̂ → Fun_{0⁻}(P̂)` then reads +`∂(a k) = k ∂(a)`, since `∂` vanishes on scalars. The zero series is the degenerate case. + +The nearest wrong statement is an unconditional two-term identity in which the factor of degree +`0` or a limit ordinal contributes `π_α(u) π_β(v^{|γ})` with `π_β(v^{|γ})` the class of the +translated truncation in `P_β` itself. At degree `β = 0` that class vanishes termwise, which the +last check records, so the present fixture certifies the branch where the degree is a limit ordinal +but does not separate it from the unconditional identity; the two differ only when `β ≥ ω` is a +limit ordinal, for which there +there is no fixture in the test suite. +-/ + +open Filter Topology +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace Tests + +open Berarducci + +private theorem one_constantCoeff_pos : 0 < (1 : NatOrdinal).constantCoeff := by + have hcoeff : (1 : NatOrdinal).constantCoeff = 1 := by + simpa only [Nat.cast_one] using NatOrdinal.constantCoeff_natCast (1 : ℕ) + rw [hcoeff] + decide + +private theorem approachZero_ordinalValue_bound : + ordinalValue approachZeroNonpositive < ω^ ((1 : NatOrdinal) + 1) := by + rw [ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal approachZero_degree_eq_one] + exact NatOrdinal.wpow_lt_wpow.mpr (lt_add_one (1 : NatOrdinal)) + +/-- The degree-one class of the approach-zero series. -/ +def approachZeroClass : PrincipalComponent ℚ 1 := + principalComponentMk 1 approachZeroNonpositive approachZero_ordinalValue_bound + +/-- The approach-zero class is nonzero in `P_1`. -/ +theorem approachZeroClass_ne_zero : approachZeroClass ≠ 0 := by + intro hzero + have hlower := (principalComponentMk_eq_zero_iff 1 approachZeroNonpositive + approachZero_ordinalValue_bound).mp hzero + rw [ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal approachZero_degree_eq_one] + at hlower + exact lt_irrefl _ hlower + +/-! ### Both grades successors: two endpoint terms -/ + +/-- The Leibniz identity for `a · a` in `P_{(1+1)⁻}`: near zero, the cutoff class of `(a a)^{|γ}` +is `π_{1⁻}(a^{|γ}) π_1(a) + π_1(a) π_{1⁻}(a^{|γ})`. -/ +theorem approachZero_sq_leibniz : + ∀ᶠ γ in 𝓝[<] (0 : ℝ), + DirectSum.of (PrincipalComponent ℚ) (((1 : NatOrdinal) + 1).removeNat 1) + (derivAt (1 + 1) (approachZeroNonpositive * approachZeroNonpositive) γ) = + DirectSum.of (PrincipalComponent ℚ) ((1 : NatOrdinal).removeNat 1) + (derivAt 1 approachZeroNonpositive γ) * + DirectSum.of (PrincipalComponent ℚ) 1 approachZeroClass + + DirectSum.of (PrincipalComponent ℚ) 1 approachZeroClass * + DirectSum.of (PrincipalComponent ℚ) ((1 : NatOrdinal).removeNat 1) + (derivAt 1 approachZeroNonpositive γ) := + eventually_of_derivAt_mul_of_pos one_constantCoeff_pos one_constantCoeff_pos + approachZeroNonpositive approachZeroNonpositive approachZero_ordinalValue_bound + approachZero_ordinalValue_bound + +/-- Neither endpoint term of `approachZero_sq_leibniz` is degenerate: the values `∂(a)(γ)` are +not eventually zero, because `∂` of the class of `a` is nonzero. -/ +theorem approachZero_derivAt_not_eventually_zero : + ¬ ∀ᶠ γ in 𝓝[<] (0 : ℝ), derivAt 1 approachZeroNonpositive γ = 0 := by + intro h + apply principalComponentDerivAt_ne_zero 1 one_constantCoeff_pos + approachZeroClass_ne_zero + rw [approachZeroClass, principalComponentDerivAt_principalComponentMk, ← Filter.Germ.coe_zero, + Filter.Germ.coe_eq] + exact h + +/-! ### A limit-grade factor: one endpoint term -/ + +/-- The Leibniz identity for `a · k` with `k` a constant of limit grade `0`: near zero, the +cutoff class of `(a k)^{|γ}` in `P_{(1+0)⁻}` is the single term `π_{1⁻}(a^{|γ}) π_0(k)`. -/ +theorem approachZero_mul_C_leibniz (k : ℚ) : + ∀ᶠ γ in 𝓝[<] (0 : ℝ), + DirectSum.of (PrincipalComponent ℚ) (((1 : NatOrdinal) + 0).removeNat 1) + (derivAt (1 + 0) + (approachZeroNonpositive * HahnSeries.Nonpositive.C k) γ) = + DirectSum.of (PrincipalComponent ℚ) ((1 : NatOrdinal).removeNat 1) + (derivAt 1 approachZeroNonpositive γ) * + DirectSum.of (PrincipalComponent ℚ) 0 + (principalComponentMk 0 (HahnSeries.Nonpositive.C k) (ordinalValue_C_lt_wpow_one k)) := + eventually_of_derivAt_mul_of_eq_zero one_constantCoeff_pos + NatOrdinal.constantCoeff_zero approachZeroNonpositive _ approachZero_ordinalValue_bound + (ordinalValue_C_lt_wpow_one k) + +/-- The homogeneous inclusion of the approach-zero class in `P̂`. -/ +def approachZeroElement : PrincipalSubring ℚ := + DirectSum.of (PrincipalComponent ℚ) 1 approachZeroClass + +/-- The Leibniz rule of `Δ` against a scalar: `Δ(a k) = k • Δ(a)`, the scalar term vanishing +because `Δ` is zero on the limit grade `0`. -/ +theorem principalSubringDerivation_approachZero_mul_algebraMap (k : ℚ) : + principalSubringDerivation ℚ + (approachZeroElement * algebraMap ℚ (PrincipalSubring ℚ) k) = + k • principalSubringDerivation ℚ approachZeroElement := by + rw [principalSubringDerivation_mul, principalSubringDerivation_algebraMap, mul_zero, add_zero, + FunAtZeroMinus.mul_const_algebraMap] + +/-- At grade `0` the would-be second endpoint term vanishes termwise: for `γ < 0` the cutoff +class of a constant is zero, since its translated truncation at `γ` is the zero series. -/ +theorem derivAt_C_eq_zero (k : ℚ) {γ : ℝ} (hγ : γ < 0) : + derivAt 0 (HahnSeries.Nonpositive.C k) γ = 0 := by + have hzero : translatedTruncation ((HahnSeries.Nonpositive.C k : Series ℚ) : ℚ⟦ℝ⟧) γ = 0 := by + apply Subtype.ext + ext δ + rw [coeff_translatedTruncation, HahnSeries.Nonpositive.coe_C, HahnSeries.C_apply, + HahnSeries.coeff_single, ZeroMemClass.coe_zero, HahnSeries.coeff_zero] + split_ifs with hδ hsum + · exact absurd hsum (by linarith) + · rfl + · rfl + have hbound : ordinalValue (translatedTruncation ((HahnSeries.Nonpositive.C k : Series ℚ) : ℚ⟦ℝ⟧) + γ) < + ω^ ((0 : NatOrdinal).removeNat 1 + 1) := by + rw [hzero, ordinalValue_zero] + exact NatOrdinal.wpow_pos _ + rw [derivAt_eq 0 _ γ hbound, principalComponentMk_eq_zero_iff, hzero, ordinalValue_zero] + exact NatOrdinal.wpow_pos _ + +/-! ### The degenerate case -/ + +/-- The values `∂(0)(γ)` of the zero series are zero. -/ +theorem derivAt_zero (γ : ℝ) : + derivAt 1 (0 : Series ℚ) γ = 0 := by + have hbound : ordinalValue (translatedTruncation ((0 : Series ℚ) : ℚ⟦ℝ⟧) γ) < + ω^ ((1 : NatOrdinal).removeNat 1 + 1) := by + rw [ZeroMemClass.coe_zero, translatedTruncation_zero_input, ordinalValue_zero] + exact NatOrdinal.wpow_pos _ + rw [derivAt_eq 1 0 γ hbound, principalComponentMk_eq_zero_iff, ZeroMemClass.coe_zero, + translatedTruncation_zero_input, ordinalValue_zero] + exact NatOrdinal.wpow_pos _ + +/-- The Leibniz rule at the zero element: both sides of `principalSubringDerivation_mul` vanish. -/ +theorem principalSubringDerivation_zero_mul (x : PrincipalSubring ℚ) : + principalSubringDerivation ℚ (0 * x) = 0 ∧ + principalSubringDerivation ℚ 0 * (x : FunAtZeroMinus (PrincipalSubring ℚ)) + + ((0 : PrincipalSubring ℚ) : FunAtZeroMinus (PrincipalSubring ℚ)) * + principalSubringDerivation ℚ x = 0 := by + refine ⟨by rw [zero_mul, map_zero], ?_⟩ + rw [map_zero, zero_mul, FunAtZeroMinus.const_zero, zero_mul, add_zero] + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/BerarducciPrimitives.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/BerarducciPrimitives.lean new file mode 100644 index 0000000000..24f4403d53 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/BerarducciPrimitives.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero + +/-! +# API checks for Berarducci's germs and ordinal value + +The first certificates exercise all three defining branches of `Berarducci.ordinalValue`: a +nonzero strictly negative monomial has value zero, a nonconstant series in `J + K` has value one, +and a series with support cofinal in zero has value strictly greater than one. These examples +distinguish the source definition from both a two-branch function and a function whose value-one +fiber contains only literal constants. + +The germ certificates distinguish the closed interval `(η, γ]` from the incorrect open interval +`(η, γ)`: zero and the constant-one series agree at every exponent strictly below zero but have +different germs at zero. A monomial supported exactly at the cutoff becomes a nonzero constant +germ, which also distinguishes weak lower truncation from strict lower truncation. +-/ + +public noncomputable section + +namespace Tests + +open scoped HahnSeries + +/-- A coefficient-one monomial at a strictly negative exponent has Berarducci ordinal value zero. -/ +theorem ordinalValue_negative_monomial : + Berarducci.ordinalValue + (HahnSeries.Nonpositive.single (-1) (1 : ℚ) (by norm_num)) = 0 := by + apply Berarducci.ordinalValue_eq_zero_iff.mpr + exact HahnSeries.Nonpositive.single_one_mem_negativeMonomialIdeal (by norm_num) + +/-- The nonzero constant-one series has Berarducci ordinal value one. -/ +theorem ordinalValue_nonzero_constant : + Berarducci.ordinalValue (HahnSeries.Nonpositive.C (1 : ℚ)) = 1 := by + apply Berarducci.ordinalValue_eq_one_iff.mpr + constructor + · apply Berarducci.mem_nearConstantSubgroup_iff.mpr + exact ⟨0, (HahnSeries.Nonpositive.negativeMonomialIdeal ℚ).zero_mem, 1, by simp⟩ + · intro hmem + have hcoeff := Berarducci.constantCoeff_eq_zero_of_mem_negativeMonomialIdeal hmem + norm_num at hcoeff + +private theorem one_lt_ordinalValue_approachZero : + 1 < Berarducci.ordinalValue approachZeroNonpositive := by + apply Berarducci.one_lt_ordinalValue_of_constantCoeff_eq_zero_of_supportSup_eq_zero + · rw [HahnSeries.Nonpositive.constantCoeff_apply, coe_approachZeroNonpositive] + exact not_ne_iff.mp (by + simpa [HahnSeries.mem_support] using zero_not_mem_approachZero_support) + · exact approachZero_supportSup + +private theorem ordinalValue_nonconstant_nearConstant : + ∃ b : Berarducci.Series ℚ, + b ∉ Berarducci.constantSubgroup ℚ ∧ + Berarducci.ordinalValue b = 1 := by + let j : Berarducci.Series ℚ := + HahnSeries.Nonpositive.single (-1) 1 (by norm_num) + let b : Berarducci.Series ℚ := j + HahnSeries.Nonpositive.C 1 + have hj : j ∈ HahnSeries.Nonpositive.negativeMonomialIdeal ℚ := by + exact HahnSeries.Nonpositive.single_one_mem_negativeMonomialIdeal (by norm_num) + refine ⟨b, ?_, ?_⟩ + · intro hbConstant + obtain ⟨k, hk⟩ := Berarducci.mem_constantSubgroup_iff.mp hbConstant + have hcoeff := congrArg + (fun x : Berarducci.Series ℚ ↦ ((x : ℚ⟦ℝ⟧).coeff (-1))) hk + norm_num [b, j, HahnSeries.Nonpositive.coe_C, + HahnSeries.Nonpositive.coe_single] at hcoeff + · apply Berarducci.ordinalValue_eq_one_iff.mpr + constructor + · exact Berarducci.mem_nearConstantSubgroup_iff.mpr ⟨j, hj, 1, rfl⟩ + · intro hbJ + have hcoeff := Berarducci.constantCoeff_eq_zero_of_mem_negativeMonomialIdeal hbJ + norm_num [b, j, HahnSeries.Nonpositive.constantCoeff_apply, + HahnSeries.Nonpositive.coe_C, HahnSeries.Nonpositive.coe_single] at hcoeff + +/-- The three disjoint branches of Berarducci's ordinal value are all nonempty. -/ +theorem ordinalValue_three_branch_separator : + ∃ b₀ b₁ b₂ : Berarducci.Series ℚ, + b₀ ≠ 0 ∧ + Berarducci.ordinalValue b₀ = 0 ∧ + b₁ ∉ Berarducci.constantSubgroup ℚ ∧ + Berarducci.ordinalValue b₁ = 1 ∧ + 1 < Berarducci.ordinalValue b₂ := by + obtain ⟨b₁, hb₁Constant, hb₁Value⟩ := ordinalValue_nonconstant_nearConstant + let b₀ : Berarducci.Series ℚ := + HahnSeries.Nonpositive.single (-1) 1 (by norm_num) + refine ⟨b₀, b₁, approachZeroNonpositive, ?_, ordinalValue_negative_monomial, + hb₁Constant, hb₁Value, one_lt_ordinalValue_approachZero⟩ + intro hb₀ + have hb₀' := congrArg Subtype.val hb₀ + exact HahnSeries.single_ne_zero one_ne_zero (by + simpa only [b₀, HahnSeries.Nonpositive.coe_single, Subring.coe_zero] using hb₀') + +/-- Agreement strictly below a cutoff does not determine the germ when the cutoff coefficient is +omitted. -/ +theorem germAt_closed_endpoint_separator : + ∃ b c : ℚ⟦ℝ⟧, + (∀ δ : ℝ, δ < 0 → b.coeff δ = c.coeff δ) ∧ + Berarducci.germAt b 0 ≠ Berarducci.germAt c 0 := by + refine ⟨0, HahnSeries.C 1, ?_, ?_⟩ + · intro δ hδ + simp [hδ.ne] + · intro heq + rw [Berarducci.germAt_eq_germAt_iff_exists_coeff_eq] at heq + obtain ⟨η, hη, hcoeff⟩ := heq + have h := hcoeff 0 hη le_rfl + norm_num at h + +/-- A monomial at the cutoff becomes its coefficient as a constant germ. -/ +theorem germAt_single_cut (k : ℚ) (γ : ℝ) : + Berarducci.germAt (HahnSeries.single γ k) γ = + Berarducci.toGerm (HahnSeries.Nonpositive.C k) := by + rw [Berarducci.germAt_apply, Berarducci.translatedTruncation_single_cut] + +/-- The germ at its support exponent of a coefficient-one monomial is nonzero. -/ +theorem germAt_single_cut_ne_zero (γ : ℝ) : + Berarducci.germAt (HahnSeries.single γ (1 : ℚ)) γ ≠ 0 := by + rw [germAt_single_cut] + intro hzero + have hvalue := Berarducci.germOrdinalValue_eq_zero_iff.mpr hzero + simp only [Berarducci.toGerm_apply, Berarducci.germOrdinalValue_mk, + ordinalValue_nonzero_constant] at hvalue + exact one_ne_zero hvalue + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ComplexityDecrease.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ComplexityDecrease.lean new file mode 100644 index 0000000000..e3fc7a778e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ComplexityDecrease.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ComplexityDecrease + +/-! +# API checks for the complexity of formal expressions + +These certificates separate the complexity and its reduction step from three nearby wrong +readings: relevant values indexed with multiplicity rather than by distinct factors, a reduction +that carries the unselected factors over unchanged rather than doubling them, and one that deletes +the selected factor outright rather than lowering its exponent by one. +-/ + +universe v + +public noncomputable section + +namespace Tests + +open Berarducci Berarducci.FormalExpression + +variable {K : Type v} [Field K] + +/-- The relevant values are indexed by the distinct factors: adjoining another copy of a factor +already present leaves them unchanged. -/ +theorem relevantValues_cons_of_mem {w : FormalExpression K} (hw : w ≠ 0) + {y : SeriesWithOrdinalValueAboveOne K} (hy : y ∈ w) : + relevantValues (y ::ₘ w) Multiset.cons_ne_zero = relevantValues w hw := by + refine relevantValues_congr Multiset.cons_ne_zero hw (selected_cons_of_mem hw hy) fun z _ ↦ ?_ + rw [Multiset.mem_cons] + exact ⟨fun h ↦ h.elim (fun hz ↦ hz ▸ hy) id, Or.inr⟩ + +open Classical in +/-- The reduction doubles the unselected exponents rather than carrying them over. -/ +theorem count_reduced_eq_two_mul {w : FormalExpression K} {hw : w ≠ 0} + {y : SeriesWithOrdinalValueAboveOne K} (hy : y ≠ selected w hw) : + Multiset.count y (reduced w hw 0) = 2 * Multiset.count y w := + count_reduced_of_ne hy (Multiset.notMem_zero y) + +open Classical in +/-- The reduction lowers the selected exponent by exactly one, so a selected factor of exponent +above one survives it. -/ +theorem count_selected_reduced_add_one {w : FormalExpression K} (hw : w ≠ 0) + (hk : 1 < selectedExponent w hw) : + Multiset.count (selected w hw) (reduced w hw 0) + 1 = selectedExponent w hw := by + rw [count_selected_reduced (Multiset.notMem_zero _)] + omega + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/Convolution.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/Convolution.lean new file mode 100644 index 0000000000..e4b8153f3f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/Convolution.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportSupremum +import Mathlib.Topology.Instances.Real.Lemmas +import Mathlib.Topology.Order.IsLUB + +/-! +# API checks for the convolution index + +The index set of Berarducci's convolution formula is built from the closed supports of the two +factors, not from the supports themselves. These certificates exhibit a series whose closed +support strictly contains its support, and an exponent that the index set therefore contains +although it lies in neither support. +-/ + +public noncomputable section + +namespace Tests + +open scoped HahnSeries + +private theorem isLUB_approachZero_support : IsLUB approachZero.support 0 := by + have h := (HahnSeries.Nonpositive.supportSup_eq_coe_iff.mp approachZero_supportSup).2 + rwa [coe_approachZeroNonpositive] at h + +private theorem zero_mem_closure_approachZero_support : + (0 : ℝ) ∈ closure approachZero.support := by + refine isLUB_approachZero_support.mem_closure (HahnSeries.support_nonempty_iff.mpr ?_) + intro hzero + exact approachZero_ne_zero (Subtype.ext (by rw [coe_approachZeroNonpositive, hzero]; rfl)) + +/-- The closed support of `approachZero` strictly contains its support. -/ +theorem closure_approachZero_support_ne : + closure approachZero.support ≠ approachZero.support := + fun h ↦ zero_not_mem_approachZero_support (h ▸ zero_mem_closure_approachZero_support) + +/-- The convolution index is computed from the closed supports: it contains an exponent lying in +the support of neither factor. -/ +theorem zero_mem_convolutionIndex_approachZero : + (0 : ℝ) ∈ Berarducci.convolutionIndex approachZero approachZero 0 ∧ + (0 : ℝ) ∉ approachZero.support := + ⟨Berarducci.mem_convolutionIndex.mpr + ⟨zero_mem_closure_approachZero_support, by + simpa using zero_mem_closure_approachZero_support⟩, + zero_not_mem_approachZero_support⟩ + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ConvolutionList.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ConvolutionList.lean new file mode 100644 index 0000000000..9546f06906 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ConvolutionList.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionList + +/-! +# API checks for the multi-factor convolution formula + +These certificates separate the formula from two nearby wrong readings: an empty product that +would contribute at every cutoff rather than only at zero, and an index set that would not +constrain its exponent lists. A third check records that the exponent lists are positional, so +their length is the number of factors. +-/ + +public noncomputable section + +namespace Tests + +open scoped HahnSeries + +/-- The empty product contributes only at cutoff zero. -/ +theorem convolutionIndexList_nil_one : + Berarducci.convolutionIndexList ([] : List ℚ⟦ℝ⟧) 1 = ∅ := by + rw [Berarducci.convolutionIndexList_nil, if_neg one_ne_zero] + +/-- Reading the formula at the empty list computes the germ of one away from zero. -/ +theorem germAt_one_at_one : Berarducci.germAt (1 : ℚ⟦ℝ⟧) 1 = 0 := by + have h := Berarducci.germAt_listProd ([] : List ℚ⟦ℝ⟧) 1 + rw [List.prod_nil, convolutionIndexList_nil_one, Finset.sum_empty] at h + exact h + +/-- Exponent lists in the index set are constrained: one that does not sum to the cutoff is +absent. -/ +theorem notMem_convolutionIndexList_of_sum_ne + (l : List ℚ⟦ℝ⟧) (γ : ℝ) (f : List ℝ) (h : f.sum ≠ γ) : + f ∉ Berarducci.convolutionIndexList l γ := + fun hf ↦ h (Berarducci.sum_of_mem_convolutionIndexList l γ hf) + +/-- Exponent lists are positional: their length is the number of factors. -/ +theorem length_eq_of_mem_convolutionIndexList + (l : List ℚ⟦ℝ⟧) (γ : ℝ) (f : List ℝ) + (hf : f ∈ Berarducci.convolutionIndexList l γ) : + f.length = l.length := + Berarducci.length_of_mem_convolutionIndexList l γ hf + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ConvolutionRemainder.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ConvolutionRemainder.lean new file mode 100644 index 0000000000..bb787c3337 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ConvolutionRemainder.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionRemainder + +/-! +# API check for the convolution remainder + +The paper uses the estimate for actual translated truncation series. The underlying proof first +establishes a germ-valued inequality, so it would be easy to expose only that nearby but weaker +interface. This check pins the public result to `ordinalValue` of the displayed series remainder and +to one left neighbourhood uniform in the cutoff. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries HahnSeries.Nonpositive Berarducci + +universe v + +variable {K : Type v} [Field K] + +/-- The remainder estimate holds for the translated truncation series, uniformly for every +cutoff in one left neighbourhood of zero. -/ +theorem convolutionRemainder_actualSeries + (b c : SeriesWithOrdinalValueAboveOne K) + (hp : b.principalValue ≤ c.principalValue) : + ∃ eta < (0 : ℝ), ∀ gamma : ℝ, eta < gamma → gamma < 0 → + ordinalValue + (translatedTruncation (((b.1 * c.1 : Series K) : K⟦ℝ⟧)) gamma + - translatedTruncation (b.1 : K⟦ℝ⟧) gamma * c.1 + - b.1 * translatedTruncation (c.1 : K⟦ℝ⟧) gamma) < + b.residualValue * ordinalValue c.1 := + exists_ordinalValue_convolution_remainder_lt b c hp + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/CriticalPoint.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/CriticalPoint.lean new file mode 100644 index 0000000000..da9e806390 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/CriticalPoint.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPointExistence + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +import Mathlib.Tactic.Linarith +import Mathlib.Tactic.NormNum + +/-! +# API checks for Berarducci critical points + +The monomial `t⁻¹` has critical point `-1`, not zero: truncating exactly at its support exponent +turns it into a nonzero constant germ, while truncating strictly earlier gives zero. Squaring it +then exercises Berarducci's critical-product formula at the genuinely negative point `-2`. +-/ + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace Tests + +/-- The coefficient-one monomial `t⁻¹` as a nonpositive real Hahn series. -/ +def criticalNegativeMonomial : Berarducci.Series ℚ := + HahnSeries.Nonpositive.single (-1) 1 (by norm_num) + +private theorem coe_criticalNegativeMonomial : + (criticalNegativeMonomial : ℚ⟦ℝ⟧) = HahnSeries.single (-1) 1 := by + rw [criticalNegativeMonomial, HahnSeries.Nonpositive.coe_single] + +private theorem criticalNegativeMonomial_ne_zero : criticalNegativeMonomial ≠ 0 := by + intro hzero + have hcoe := congrArg Subtype.val hzero + rw [coe_criticalNegativeMonomial] at hcoe + exact HahnSeries.single_ne_zero one_ne_zero hcoe + +private theorem criticalNegativeMonomial_value : + Berarducci.ordinalValue + (Berarducci.translatedTruncation (criticalNegativeMonomial : ℚ⟦ℝ⟧) (-1)) = 1 := by + rw [coe_criticalNegativeMonomial, Berarducci.translatedTruncation_single_cut, + Berarducci.ordinalValue_C_of_ne one_ne_zero] + +private theorem criticalNegativeMonomial_germ_zero_of_lt + {y : ℝ} (hy : y < -1) : + Berarducci.translatedTruncation (criticalNegativeMonomial : ℚ⟦ℝ⟧) y = 0 := by + apply Subtype.ext + ext d + rw [Berarducci.coeff_translatedTruncation] + by_cases hd : d ≤ 0 + · rw [if_pos hd, coe_criticalNegativeMonomial] + have hne : y + d ≠ -1 := by linarith + rw [HahnSeries.coeff_single_of_ne hne] + simp + · simp [hd] + +/-- The exponent `-1` is the critical point of `t⁻¹`; this excludes a definition that +automatically chooses zero for every nonzero series. -/ +theorem criticalNegativeMonomial_isCriticalPoint : + Berarducci.IsCriticalPoint criticalNegativeMonomial (-1) := by + rw [Berarducci.isCriticalPoint_iff] + refine ⟨criticalNegativeMonomial_ne_zero, by norm_num, ?_, ?_⟩ + · intro y _hy + rw [criticalNegativeMonomial_value] + calc + Berarducci.ordinalValue + (Berarducci.translatedTruncation (criticalNegativeMonomial : ℚ⟦ℝ⟧) y) ≤ + NatOrdinal.of + ((Berarducci.translatedTruncation + (criticalNegativeMonomial : ℚ⟦ℝ⟧) y : Berarducci.Series ℚ) : + ℚ⟦ℝ⟧).supportOrderType := + Berarducci.ordinalValue_le_supportOrderType _ + _ ≤ NatOrdinal.of (criticalNegativeMonomial : ℚ⟦ℝ⟧).supportOrderType := by + apply NatOrdinal.of.monotone + rw [Berarducci.coe_translatedTruncation, HahnSeries.supportOrderType_translate] + apply HahnSeries.supportOrderType_mono + rw [HahnSeries.support_truncLE] + exact Set.sep_subset _ _ + _ = 1 := by + rw [coe_criticalNegativeMonomial, + HahnSeries.supportOrderType_single one_ne_zero] + simp + · intro y _hy hvalue + apply le_of_not_gt + intro hylt + have hzero := criticalNegativeMonomial_germ_zero_of_lt hylt + rw [hzero, Berarducci.ordinalValue_zero, + criticalNegativeMonomial_value] at hvalue + exact zero_ne_one hvalue + +/-- The general existence theorem produces a critical point for the nondegenerate fixture. -/ +theorem criticalNegativeMonomial_exists_isCriticalPoint : + ∃ x : ℝ, Berarducci.IsCriticalPoint criticalNegativeMonomial x := + Berarducci.exists_isCriticalPoint criticalNegativeMonomial_ne_zero + +/-- The product formula computes the critical value of `t⁻¹ * t⁻¹` at `-2`. -/ +theorem criticalNegativeMonomial_square_value : + Berarducci.ordinalValue + (Berarducci.translatedTruncation + (((criticalNegativeMonomial * criticalNegativeMonomial : + Berarducci.Series ℚ) : ℚ⟦ℝ⟧)) (-2)) = 1 := by + rw [show (-2 : ℝ) = -1 + -1 by norm_num] + rw [Berarducci.criticalPoint_product_value + criticalNegativeMonomial_isCriticalPoint criticalNegativeMonomial_isCriticalPoint, + criticalNegativeMonomial_value, one_mul] + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/OrdinalValueFinalSegment.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/OrdinalValueFinalSegment.lean new file mode 100644 index 0000000000..fe129aaf73 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/OrdinalValueFinalSegment.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero +public import Mathlib.Order.UpperLower.Relative + +/-! +# API check for final support segments and Berarducci's ordinal value + +The approach-zero series with constant coefficient one has ordinal value greater than one and +support containing zero. Its strictly negative support is nonempty, so the final-segment theorem +gives the intended lower bound there. + +This fixture separates strict negative support from the nearby incorrect full-support statement. +The singleton containing zero is a nonempty final segment of the full support and has order type +one, strictly below the series' ordinal value. Thus including the exponent zero would make the +claimed lower bound false rather than merely change its presentation. +-/ + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace Tests + +open Ordinal + +/-- The approach-zero series with a nonzero constant coefficient. -/ +def approachZeroPlusOne : Berarducci.Series ℚ := + approachZeroNonpositive + HahnSeries.Nonpositive.C 1 + +private theorem approachZero_ordinalValue_one_lt : + 1 < Berarducci.ordinalValue approachZeroNonpositive := by + apply Berarducci.one_lt_ordinalValue_of_constantCoeff_eq_zero_of_supportSup_eq_zero + · rw [HahnSeries.Nonpositive.constantCoeff_apply, coe_approachZeroNonpositive] + exact not_ne_iff.mp (by + simpa [HahnSeries.mem_support] using zero_not_mem_approachZero_support) + · exact approachZero_supportSup + +/-- Adding a nonzero constant coefficient does not place the approach-zero series in `J + K`. -/ +theorem approachZeroPlusOne_ordinalValue_one_lt : + 1 < Berarducci.ordinalValue approachZeroPlusOne := by + apply Berarducci.one_lt_ordinalValue_iff.mpr + have happroach := + Berarducci.one_lt_ordinalValue_iff.mp approachZero_ordinalValue_one_lt + intro hsum + apply happroach + have hconstant : HahnSeries.Nonpositive.C (1 : ℚ) ∈ + Berarducci.nearConstantSubgroup ℚ := by + apply Berarducci.mem_nearConstantSubgroup_iff.mpr + exact ⟨0, (HahnSeries.Nonpositive.negativeMonomialIdeal ℚ).zero_mem, 1, by simp⟩ + have hdifference := + (Berarducci.nearConstantSubgroup ℚ).sub_mem hsum hconstant + simpa only [approachZeroPlusOne, add_sub_cancel_right] using hdifference + +private theorem approachZeroPlusOne_zero_mem_support : + (0 : ℝ) ∈ (approachZeroPlusOne : ℚ⟦ℝ⟧).support := by + rw [HahnSeries.mem_support] + have hzero : approachZero.coeff 0 = 0 := by + rw [← not_ne_iff, ← HahnSeries.mem_support] + exact zero_not_mem_approachZero_support + simp [approachZeroPlusOne, hzero] + +private theorem approachZeroPlusOne_neg_one_mem_support : + (-1 : ℝ) ∈ (approachZeroPlusOne : ℚ⟦ℝ⟧).support := by + rw [HahnSeries.mem_support] + have hcoeff : approachZero.coeff (-1) = 1 := by + rw [← show approachZeroEmbedding 0 = (-1 : ℝ) by norm_num] + exact approachZero_coeff_embedding 0 + simp [approachZeroPlusOne, hcoeff] + +/-- The public theorem bounds the ordinal value by the order type of the strictly negative +support in a concrete nonconstant example with nonzero constant coefficient. -/ +theorem approachZeroPlusOne_strictNegativeSupport_bound : + (Berarducci.ordinalValue approachZeroPlusOne).val ≤ + ((approachZeroPlusOne : ℚ⟦ℝ⟧).isPWO_support.mono + (s := (approachZeroPlusOne : ℚ⟦ℝ⟧).support ∩ Set.Iio 0) + Set.inter_subset_left).orderType := by + apply Berarducci.ordinalValue_le_orderType_of_isRelUpperSet_negativeSupport + (C := (approachZeroPlusOne : ℚ⟦ℝ⟧).support ∩ Set.Iio 0) + · exact isRelUpperSet_self + · exact ⟨-1, approachZeroPlusOne_neg_one_mem_support, by norm_num⟩ + +private theorem singletonZero_isRelUpperSet_approachZeroPlusOne_support : + IsRelUpperSet ({0} : Set ℝ) + (· ∈ (approachZeroPlusOne : ℚ⟦ℝ⟧).support) := by + intro x hx + rw [Set.mem_singleton_iff] at hx + subst x + refine ⟨approachZeroPlusOne_zero_mem_support, ?_⟩ + intro y h0y hy + rw [Set.mem_singleton_iff] + exact le_antisymm (HahnSeries.Nonpositive.support_subset approachZeroPlusOne hy) h0y + +/-- Including exponent zero would give a nonempty final segment of order type one, although the +series has ordinal value strictly greater than one. -/ +theorem approachZeroPlusOne_fullSupport_singleton_counterexample : + let hsingleton : ({0} : Set ℝ).IsPWO := Set.isPWO_singleton 0 + IsRelUpperSet ({0} : Set ℝ) + (· ∈ (approachZeroPlusOne : ℚ⟦ℝ⟧).support) ∧ + ({0} : Set ℝ).Nonempty ∧ + hsingleton.orderType = 1 ∧ + 1 < (Berarducci.ordinalValue approachZeroPlusOne).val := by + dsimp only + refine ⟨singletonZero_isRelUpperSet_approachZeroPlusOne_support, + Set.singleton_nonempty 0, ?_, ?_⟩ + · let hsingleton : ({0} : Set ℝ).IsPWO := Set.isPWO_singleton 0 + letI : WellFoundedLT ({0} : Set ℝ) := ⟨hsingleton.isWF⟩ + calc + hsingleton.orderType = typeLT ({0} : Set ℝ) := + hsingleton.orderType_eq_typeLT_of_orderIso (OrderIso.refl _) + _ = 1 := Ordinal.type_eq_one_of_unique _ + · exact NatOrdinal.of_lt_iff.mp approachZeroPlusOne_ordinalValue_one_lt + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/OrdinalValueSubmultiplicative.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/OrdinalValueSubmultiplicative.lean new file mode 100644 index 0000000000..524e77bc8e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/OrdinalValueSubmultiplicative.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueConstantMul +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSubmultiplicative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue + +/-! +# API checks for submultiplicativity of Berarducci's ordinal value + +These certificates separate the submultiplicative bound from three nearby wrong statements: the +same inequality read with ordinary ordinal multiplication instead of the Hessenberg product, +constant-factor invariance without the nonzero hypothesis, and a bound holding only on `J` and +`J + K` rather than in the third branch of the ordinal value. +-/ + +universe v + +public noncomputable section + +namespace Tests + +open scoped HahnSeries + +/-- The submultiplicative bound is stated with Hessenberg multiplication: on the very ordinals it +ranges over, ordinary ordinal multiplication gives a strictly smaller value. -/ +theorem naturalMul_ne_ordinalMul : + ∃ x y : NatOrdinal, NatOrdinal.of (x.val * y.val) ≠ x * y := by + refine ⟨2, NatOrdinal.of Ordinal.omega0, ?_⟩ + have hpos : (0 : NatOrdinal) < NatOrdinal.of Ordinal.omega0 := by + simpa using NatOrdinal.of.lt_iff_lt.mpr Ordinal.omega0_pos + have hval : NatOrdinal.of ((2 : NatOrdinal).val * (NatOrdinal.of Ordinal.omega0).val) = + NatOrdinal.of Ordinal.omega0 := by + rw [NatOrdinal.val_of] + congr 1 + have h2 : ((2 : NatOrdinal).val) = ((2 : ℕ) : Ordinal) := by + simpa using NatOrdinal.val_natCast 2 + rw [h2] + exact Ordinal.natCast_mul_omega0 (by norm_num) + rw [hval] + refine ne_of_lt ?_ + calc NatOrdinal.of Ordinal.omega0 + < NatOrdinal.of Ordinal.omega0 + NatOrdinal.of Ordinal.omega0 := lt_add_of_pos_left _ hpos + _ = 2 * NatOrdinal.of Ordinal.omega0 := (two_mul _).symm + +/-- Constant-factor invariance genuinely needs the constant to be nonzero. -/ +theorem ordinalValue_C_mul_needs_ne_zero : + ∃ b : Berarducci.Series ℚ, + Berarducci.ordinalValue (HahnSeries.Nonpositive.C (0 : ℚ) * b) ≠ + Berarducci.ordinalValue b := by + refine ⟨HahnSeries.Nonpositive.C (1 : ℚ), ?_⟩ + rw [map_zero, zero_mul, Berarducci.ordinalValue_zero, + Berarducci.ordinalValue_C_of_ne (one_ne_zero (α := ℚ))] + exact zero_ne_one + +/-- Multiplication by a nonzero constant preserves the ordinal value of a series whose value lies +in the third branch. -/ +theorem ordinalValue_C_mul_approachZero : + Berarducci.ordinalValue (HahnSeries.Nonpositive.C (2 : ℚ) * approachZeroNonpositive) = + Berarducci.ordinalValue approachZeroNonpositive := + Berarducci.ordinalValue_C_mul (by norm_num) _ + +private theorem one_lt_ordinalValue_approachZero : + 1 < Berarducci.ordinalValue approachZeroNonpositive := by + apply Berarducci.one_lt_ordinalValue_of_constantCoeff_eq_zero_of_supportSup_eq_zero + · rw [HahnSeries.Nonpositive.constantCoeff_apply, coe_approachZeroNonpositive] + exact not_ne_iff.mp (by + simpa [HahnSeries.mem_support] using zero_not_mem_approachZero_support) + · exact approachZero_supportSup + +/-- The submultiplicative bound applies in the third branch of the ordinal value, where both +factors lie outside `J + K`. -/ +theorem ordinalValue_mul_le_naturalMul_third_branch : + ∃ b : Berarducci.Series ℚ, + 1 < Berarducci.ordinalValue b ∧ + Berarducci.ordinalValue (b * b) ≤ Berarducci.ordinalValue b * Berarducci.ordinalValue b := + ⟨approachZeroNonpositive, one_lt_ordinalValue_approachZero, + Berarducci.ordinalValue_mul_le_naturalMul _ _⟩ + +/-- Berarducci, Theorem 9.7 applies to a nonconstant product in the third branch of the ordinal +value. -/ +theorem ordinalValue_mul_approachZero : + Berarducci.ordinalValue (approachZeroNonpositive * approachZeroNonpositive) = + Berarducci.ordinalValue approachZeroNonpositive * + Berarducci.ordinalValue approachZeroNonpositive := + Berarducci.ordinalValue_mul _ _ + +/-- In the ideal branch the submultiplicative bound is an equality with value zero. -/ +theorem ordinalValue_mul_negative_monomial : + Berarducci.ordinalValue + (HahnSeries.Nonpositive.single (-1) (1 : ℚ) (by norm_num) * approachZeroNonpositive) = + Berarducci.ordinalValue (HahnSeries.Nonpositive.single (-1) (1 : ℚ) (by norm_num)) * + Berarducci.ordinalValue approachZeroNonpositive := by + have hj : HahnSeries.Nonpositive.single (-1) (1 : ℚ) (by norm_num) ∈ + HahnSeries.Nonpositive.negativeMonomialIdeal ℚ := + HahnSeries.Nonpositive.single_one_mem_negativeMonomialIdeal (by norm_num) + rw [Berarducci.ordinalValue_of_mem_negativeMonomialIdeal + ((HahnSeries.Nonpositive.negativeMonomialIdeal ℚ).mul_mem_right _ hj), + Berarducci.ordinalValue_of_mem_negativeMonomialIdeal hj, zero_mul] + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponent.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponent.lean new file mode 100644 index 0000000000..f328290ce1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponent.lean @@ -0,0 +1,165 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponent +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage + +/-! +# API checks for the spaces `P_α` + +The degree-zero fixture proves that a nonzero constant represents a nonzero class in `P_0`, while +a strictly negative monomial represents zero. This distinguishes the intrinsic quotient by `J` +from literal equality of representatives. + +The approach-zero series has ordinal value `ω` and represents a nonzero class in `P_1`. Its class +has a principal representative of exact degree one by LM24, Remark 7.2.4. Multiplication by the +degree-zero class of one agrees with multiplication of representatives. +-/ + +universe v + +public noncomputable section + +namespace Tests + +open HahnSeries +open scoped NatOrdinal + +variable {K : Type v} [Field K] + +section Generic + +theorem one_ordinalValue_bound : + Berarducci.ordinalValue (1 : Berarducci.Series K) < ω^ (0 + 1 : NatOrdinal) := by + rw [Berarducci.ordinalValue_one] + simpa using NatOrdinal.wpow_lt_wpow.mpr (zero_lt_one : (0 : NatOrdinal) < 1) + +variable (K) in +/-- A nonzero constant gives a nonzero class in the intrinsic degree-zero component. -/ +theorem principalComponent_zero_constant_ne_zero : + Berarducci.principalComponentMk 0 (1 : Berarducci.Series K) + (one_ordinalValue_bound (K := K)) ≠ 0 := by + rw [ne_eq, Berarducci.principalComponentMk_eq_zero_iff] + rw [Berarducci.ordinalValue_one] + simp + +def principalComponentNegativeMonomial : Berarducci.Series K := + HahnSeries.Nonpositive.single (-1 : ℝ) 1 (by norm_num) + +theorem principalComponentNegativeMonomial_ordinalValue_eq_zero : + Berarducci.ordinalValue (principalComponentNegativeMonomial (K := K)) = 0 := by + apply Berarducci.ordinalValue_of_mem_negativeMonomialIdeal + exact HahnSeries.Nonpositive.single_one_mem_negativeMonomialIdeal (by norm_num) + +theorem principalComponentNegativeMonomial_ordinalValue_bound : + Berarducci.ordinalValue (principalComponentNegativeMonomial (K := K)) < + ω^ (0 + 1 : NatOrdinal) := by + rw [principalComponentNegativeMonomial_ordinalValue_eq_zero] + exact NatOrdinal.wpow_pos _ + +variable (K) in +/-- A nonzero series in `J` represents zero in `P_0`. -/ +theorem principalComponent_zero_negativeMonomial_eq_zero : + Berarducci.principalComponentMk 0 (principalComponentNegativeMonomial (K := K)) + (principalComponentNegativeMonomial_ordinalValue_bound (K := K)) = 0 := by + rw [Berarducci.principalComponentMk_eq_zero_iff, + principalComponentNegativeMonomial_ordinalValue_eq_zero] + exact NatOrdinal.wpow_pos _ + +end Generic + +section RationalFixture + +theorem approachZero_ordinalValue_eq_omega : + Berarducci.ordinalValue approachZeroNonpositive = NatOrdinal.of Ordinal.omega0 := by + apply le_antisymm + · simpa only [coe_approachZeroNonpositive, approachZero_supportOrderType] using + Berarducci.ordinalValue_le_supportOrderType approachZeroNonpositive + · have hone : 1 < Berarducci.ordinalValue approachZeroNonpositive := by + apply Berarducci.one_lt_ordinalValue_of_constantCoeff_eq_zero_of_supportSup_eq_zero + · rw [HahnSeries.Nonpositive.constantCoeff_apply, coe_approachZeroNonpositive] + exact not_ne_iff.mp (by + simpa [HahnSeries.mem_support] using zero_not_mem_approachZero_support) + · exact approachZero_supportSup + have hprincipal := + Berarducci.ordinalValue_isAdditivelyPrincipal_of_one_lt hone + have honeVal : (1 : Ordinal) < + (Berarducci.ordinalValue approachZeroNonpositive).val := + NatOrdinal.of_lt_iff.mp hone + apply NatOrdinal.of_le_iff.mpr + exact hprincipal.omega0_le_of_one_lt honeVal + +theorem approachZero_ordinalValue_bound : + Berarducci.ordinalValue approachZeroNonpositive < ω^ (1 + 1 : NatOrdinal) := by + rw [approachZero_ordinalValue_eq_omega] + have homega : NatOrdinal.of Ordinal.omega0 = ω^ (1 : NatOrdinal) := by + apply NatOrdinal.val.injective + simp only [NatOrdinal.val_of, NatOrdinal.val_wpow, NatOrdinal.val_one, + Ordinal.opow_one] + rw [homega] + exact NatOrdinal.wpow_lt_wpow.mpr (lt_add_one (1 : NatOrdinal)) + +/-- The genuine infinite-support fixture gives a nonzero class in `P_1`. -/ +theorem principalComponent_one_approachZero_ne_zero : + Berarducci.principalComponentMk 1 approachZeroNonpositive + approachZero_ordinalValue_bound ≠ 0 := by + rw [ne_eq, Berarducci.principalComponentMk_eq_zero_iff, + approachZero_ordinalValue_eq_omega] + have homega : NatOrdinal.of Ordinal.omega0 = ω^ (1 : NatOrdinal) := by + apply NatOrdinal.val.injective + simp only [NatOrdinal.val_of, NatOrdinal.val_wpow, NatOrdinal.val_one, + Ordinal.opow_one] + rw [homega] + exact lt_irrefl _ + +/-- The intrinsic class admits a principal representative of exact degree one. -/ +theorem principalComponent_one_has_exact_principal_representative : + ∃ (p : Berarducci.Series ℚ) + (hpBound : Berarducci.ordinalValue p < ω^ (1 + 1 : NatOrdinal)), + HahnSeries.Nonpositive.IsPrincipal p ∧ + (p : ℚ⟦ℝ⟧).degree = (1 : WithBot NatOrdinal) ∧ + Berarducci.principalComponentMk 1 p hpBound = + Berarducci.principalComponentMk 1 approachZeroNonpositive + approachZero_ordinalValue_bound := + Berarducci.exists_principal_representative_of_ne_zero 1 _ + principalComponent_one_approachZero_ne_zero + +/-- Scalar multiplication by two is represented by multiplication by the corresponding constant +Hahn series on the infinite-support class. -/ +theorem two_smul_principalComponent_one_approachZero : + (2 : ℚ) • Berarducci.principalComponentMk 1 approachZeroNonpositive + approachZero_ordinalValue_bound = + Berarducci.principalComponentMk 1 + ((HahnSeries.Nonpositive.C : ℚ →+* Berarducci.Series ℚ) 2 * + approachZeroNonpositive) + (by + simpa only [zero_add] using + Berarducci.ordinalValue_mul_lt_wpow_add_one + (Berarducci.ordinalValue_C_lt_wpow_one (2 : ℚ)) + approachZero_ordinalValue_bound) := + Berarducci.smul_principalComponentMk 1 2 approachZeroNonpositive + approachZero_ordinalValue_bound + +/-- Homogeneous multiplication sends the classes of `1` and the approach-zero series to the +class of their product in `P_1`. -/ +theorem principalComponent_zero_mul_one_representation : + Berarducci.principalComponentMul + (Berarducci.principalComponentMk 0 (1 : Berarducci.Series ℚ) + (one_ordinalValue_bound (K := ℚ))) + (Berarducci.principalComponentMk 1 approachZeroNonpositive + approachZero_ordinalValue_bound) = + Berarducci.principalComponentMk (0 + 1) approachZeroNonpositive + (by simpa using approachZero_ordinalValue_bound) := by + rw [Berarducci.principalComponentMul_mk] + rw [Berarducci.principalComponentMk_eq_iff] + simp + +end RationalFixture + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponentDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponentDegree.lean new file mode 100644 index 0000000000..d49f66c124 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponentDegree.lean @@ -0,0 +1,126 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponent +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentDegree + +/-! +# API checks for the two presentations of `P_α` + +The approach-zero series supplies a nonzero principal class of exact Hahn degree one. This module +places that class in the source subspace of the degree-graded component and checks that +the canonical linear equivalence sends it to the same representative in the intrinsic quotient +`J_{ω²} / J_ω`. + +Multiplying the class by itself exercises two genuinely infinite principal representatives. The +compiled checks identify the underlying product in the degree-graded component and +verify that the equivalence commutes with homogeneous multiplication into degree `1 + 1`. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries +open scoped NatOrdinal + +/-- The source homogeneous class of the approach-zero series in degree one. -/ +def approachZeroPrincipalDegreeClass : + Berarducci.principalDegreeClasses ℚ 1 := by + refine ⟨Berarducci.degreeLayerMk 1 approachZeroNonpositive + approachZero_degree_eq_one.le, ?_⟩ + rw [Berarducci.mem_principalDegreeClasses_iff, + Berarducci.isPrincipalDegreeClass_iff] + exact Or.inr ⟨approachZeroNonpositive, approachZero_isPrincipal, + approachZero_degree_eq_one, rfl⟩ + +/-- The underlying class in the degree-graded ring has the expected representative. -/ +@[simp] +theorem coe_approachZeroPrincipalDegreeClass : + (approachZeroPrincipalDegreeClass : + (HahnSeries.Nonpositive.degreeValuation ℚ).Component 1) = + Berarducci.degreeLayerMk 1 approachZeroNonpositive + approachZero_degree_eq_one.le := + (rfl) + +/-- The approach-zero class is nonzero in the source degree-one component. -/ +theorem approachZeroPrincipalDegreeClass_ne_zero : + approachZeroPrincipalDegreeClass ≠ 0 := by + intro hzero + have hzero' := congrArg Subtype.val hzero + rw [coe_approachZeroPrincipalDegreeClass] at hzero' + have hlt := (Berarducci.degreeLayerMk_eq_zero_iff 1 + approachZeroNonpositive approachZero_degree_eq_one.le).mp hzero' + rw [approachZero_degree_eq_one] at hlt + exact lt_irrefl (1 : WithBot NatOrdinal) hlt + +/-- The canonical equivalence sends the source class to the same intrinsic representative. -/ +theorem approachZeroPrincipalDegreeClass_equiv : + Berarducci.principalDegreeClassesEquivPrincipalComponent ℚ 1 + approachZeroPrincipalDegreeClass = + Berarducci.principalComponentMk 1 approachZeroNonpositive + approachZero_ordinalValue_bound := by + rw [Berarducci.principalDegreeClassesEquivPrincipalComponent_apply, + coe_approachZeroPrincipalDegreeClass, + Berarducci.degreeLayerToPrincipalComponent_mk] + +/-- The canonical equivalence commutes with a nontrivial coefficient scalar on the infinite +approach-zero class. -/ +theorem approachZeroPrincipalDegreeClass_equiv_smul : + Berarducci.principalDegreeClassesEquivPrincipalComponent ℚ 1 + ((2 : ℚ) • approachZeroPrincipalDegreeClass) = + (2 : ℚ) • Berarducci.principalDegreeClassesEquivPrincipalComponent ℚ 1 + approachZeroPrincipalDegreeClass := + map_smul (Berarducci.principalDegreeClassesEquivPrincipalComponent ℚ 1) + (2 : ℚ) approachZeroPrincipalDegreeClass + +/-- On underlying degree classes, scalar multiplication by two is multiplication of the +infinite-support representative by the constant Hahn series `2`. -/ +theorem coe_two_smul_approachZeroPrincipalDegreeClass : + ((2 : ℚ) • approachZeroPrincipalDegreeClass : + (HahnSeries.Nonpositive.degreeValuation ℚ).Component 1) = + Berarducci.degreeLayerMk 1 + ((HahnSeries.Nonpositive.C : ℚ →+* Berarducci.Series ℚ) 2 * + approachZeroNonpositive) + (by + rw [HahnSeries.Nonpositive.degree_mul, + Berarducci.degree_C_eq_zero_of_ne (by norm_num), + approachZero_degree_eq_one, zero_add] + exact le_rfl) := by + rw [coe_approachZeroPrincipalDegreeClass, Berarducci.smul_degreeLayerMk] + +/-- Multiplication in the source component is represented by the square of the approach-zero series. +-/ +theorem approachZeroPrincipalDegreeClass_mul_coe : + (Berarducci.principalDegreeClassesMul + approachZeroPrincipalDegreeClass + approachZeroPrincipalDegreeClass : + (HahnSeries.Nonpositive.degreeValuation ℚ).Component (1 + 1)) = + Berarducci.degreeLayerMk (1 + 1) + (approachZeroNonpositive * approachZeroNonpositive) (by + rw [HahnSeries.Nonpositive.degree_mul, approachZero_degree_eq_one, + WithBot.coe_add] + exact le_rfl) := by + rw [Berarducci.coe_principalDegreeClassesMul] + exact Berarducci.degreeLayerMk_mul approachZeroNonpositive + approachZeroNonpositive approachZero_degree_eq_one.le + approachZero_degree_eq_one.le + +/-- The source-to-intrinsic equivalence commutes with the nonconstant degree-one product. -/ +theorem approachZeroPrincipalDegreeClass_mul_equiv : + Berarducci.principalDegreeClassesEquivPrincipalComponent ℚ (1 + 1) + (Berarducci.principalDegreeClassesMul + approachZeroPrincipalDegreeClass + approachZeroPrincipalDegreeClass) = + Berarducci.principalComponentMul + (Berarducci.principalDegreeClassesEquivPrincipalComponent ℚ 1 + approachZeroPrincipalDegreeClass) + (Berarducci.principalDegreeClassesEquivPrincipalComponent ℚ 1 + approachZeroPrincipalDegreeClass) := + Berarducci.principalDegreeClassesEquivPrincipalComponent_mul _ _ + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponentTensor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponentTensor.lean new file mode 100644 index 0000000000..fbaaa1a5ec --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponentTensor.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentTensor +public import Mathlib.LinearAlgebra.TensorProduct.Basis + +import Mathlib.Tactic.NormNum + +/-! +# API checks for extension of scalars on a homogeneous component + +The fixture has two distinct finite-support exponents and a nonzero infinite-support coefficient +in `P_1`. Its two tensor coordinates are checked independently. The forward map agrees with +multiplication of representatives, and both inverse identities hold on the fixture. +-/ + +public noncomputable section + +namespace Tests + +open scoped HahnSeries NatOrdinal TensorProduct + +private theorem approachZero_ordinalValue_bound_for_tensor : + Berarducci.ordinalValue approachZeroNonpositive < ω^ (1 + 1 : NatOrdinal) := by + rw [Berarducci.ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal + approachZero_degree_eq_one] + exact NatOrdinal.wpow_lt_wpow.mpr (lt_add_one (1 : NatOrdinal)) + +/-- The intrinsic degree-one class of the approach-zero series. -/ +def approachZeroPrincipalComponent : Berarducci.PrincipalComponent ℚ 1 := + Berarducci.principalComponentMk 1 approachZeroNonpositive + approachZero_ordinalValue_bound_for_tensor + +private theorem approachZeroPrincipalComponent_ne_zero : + approachZeroPrincipalComponent ≠ 0 := by + rw [approachZeroPrincipalComponent, ne_eq, + Berarducci.principalComponentMk_eq_zero_iff, + Berarducci.ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal + approachZero_degree_eq_one] + exact lt_irrefl _ + +/-- The exponent zero in the nonpositive real cone. -/ +def tensorExponentZero : {g : ℝ // g ≤ 0} := ⟨0, le_rfl⟩ + +/-- The exponent negative one in the nonpositive real cone. -/ +def tensorExponentNegOne : {g : ℝ // g ≤ 0} := ⟨-1, by norm_num⟩ + +/-- A tensor with nonzero coordinates at the two distinct exponents `0` and `-1`. -/ +def approachZeroTwoExponentTensor : + Berarducci.PrincipalComponent ℚ 1 ⊗[ℚ] + Berarducci.FiniteSupportRing (K := ℚ) := + approachZeroPrincipalComponent ⊗ₜ + HahnSeries.Nonpositive.finiteSupportMonomial (K := ℚ) tensorExponentZero + + ((2 : ℚ) • approachZeroPrincipalComponent) ⊗ₜ + HahnSeries.Nonpositive.finiteSupportMonomial (K := ℚ) tensorExponentNegOne + +/-- Both coordinates of the two-exponent fixture are retained by the canonical tensor-basis +presentation. -/ +theorem approachZeroTwoExponentTensor_coordinates : + TensorProduct.equivFinsuppOfBasisRight + (HahnSeries.Nonpositive.finiteSupportBasis (G := ℝ) (K := ℚ)) + approachZeroTwoExponentTensor tensorExponentZero = + approachZeroPrincipalComponent ∧ + TensorProduct.equivFinsuppOfBasisRight + (HahnSeries.Nonpositive.finiteSupportBasis (G := ℝ) (K := ℚ)) + approachZeroTwoExponentTensor tensorExponentNegOne = + (2 : ℚ) • approachZeroPrincipalComponent := by + constructor <;> + simp [approachZeroTwoExponentTensor, + HahnSeries.Nonpositive.finiteSupportBasis_repr_apply, + HahnSeries.Nonpositive.coe_finiteSupportMonomial, + tensorExponentZero, tensorExponentNegOne] + +/-- The two-exponent tensor is nonzero; in particular, it is not a one-term presentation in +which one of the two monomials has silently been discarded. -/ +theorem approachZeroTwoExponentTensor_ne_zero : + approachZeroTwoExponentTensor ≠ 0 := by + intro hzero + have hcoordinates := approachZeroTwoExponentTensor_coordinates.1 + rw [hzero, map_zero, Finsupp.zero_apply] at hcoordinates + exact approachZeroPrincipalComponent_ne_zero hcoordinates.symm + +/-- The public extension-of-scalars equivalence sends the two-exponent fixture to the sum of +the two corresponding homogeneous products. -/ +theorem approachZeroTwoExponentTensor_forward : + Berarducci.principalComponentTensorEquiv ℚ 1 + approachZeroTwoExponentTensor = + HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv ℚ + (HahnSeries.Nonpositive.finiteSupportMonomial + (K := ℚ) tensorExponentZero) • + Berarducci.principalComponentToHahnDegreeLayer ℚ 1 + approachZeroPrincipalComponent + + HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv ℚ + (HahnSeries.Nonpositive.finiteSupportMonomial + (K := ℚ) tensorExponentNegOne) • + Berarducci.principalComponentToHahnDegreeLayer ℚ 1 + ((2 : ℚ) • approachZeroPrincipalComponent) := by + rw [approachZeroTwoExponentTensor, map_add, + Berarducci.principalComponentTensorEquiv_tmul, + Berarducci.principalComponentTensorEquiv_tmul] + +/-- The representative formula sends the negative-one pure tensor to the degree-one class of +the translated approach-zero series. -/ +theorem approachZeroTensorNegOne_representative : + Berarducci.principalComponentTensorMap ℚ 1 + (approachZeroPrincipalComponent ⊗ₜ + HahnSeries.Nonpositive.finiteSupportMonomial + (K := ℚ) tensorExponentNegOne) = + Berarducci.degreeLayerMk 1 + (((HahnSeries.Nonpositive.finiteSupportMonomial + (K := ℚ) tensorExponentNegOne : + Berarducci.FiniteSupportRing (K := ℚ)) : Berarducci.Series ℚ) * + approachZeroNonpositive) (by + rw [HahnSeries.Nonpositive.degree_mul, approachZero_degree_eq_one] + exact (add_le_add (by + exact (HahnSeries.degree_eq_zero.mpr ⟨by simp, + (HahnSeries.Nonpositive.mem_finiteSupportSubring_iff _).mp + (HahnSeries.Nonpositive.finiteSupportMonomial + (K := ℚ) tensorExponentNegOne).2⟩).le) le_rfl).trans_eq + (zero_add _)) := by + exact Berarducci.principalComponentTensorMap_principal_monomial 1 approachZeroNonpositive + approachZero_isPrincipal + approachZero_degree_eq_one approachZero_ordinalValue_bound_for_tensor tensorExponentNegOne + +/-- The public inverse is a genuine inverse on the nontrivial two-exponent fixture. -/ +theorem approachZeroTwoExponentTensor_roundtrip : + (Berarducci.principalComponentTensorEquiv ℚ 1).symm + (Berarducci.principalComponentTensorEquiv ℚ 1 + approachZeroTwoExponentTensor) = + approachZeroTwoExponentTensor := + (Berarducci.principalComponentTensorEquiv ℚ 1).symm_apply_apply _ + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubring.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubring.lean new file mode 100644 index 0000000000..d535e924de --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubring.lean @@ -0,0 +1,206 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubring + +import Mathlib.Tactic.NormNum + +/-! +# API checks for `P̂` + +The two-grade fixture verifies that intrinsic `P̂` is an external direct sum rather than a single +space `P_α`: independently nonzero vectors in grades zero and one remain visible in exactly those +two homogeneous components. The embedding preserves both components and their grades. + +A strictly negative monomial gives the decisive range separator. Its nonzero degree-zero +class lies in `RV̂`, but its image in the intrinsic ordinal-value component `P_0` is zero. Hence it +does +not belong to the principal graded subalgebra. This distinguishes LM24, Definition 6.1.1 from the +nearby wrong definition in which `P̂` is all of `RV̂`. +-/ + +universe v + +public noncomputable section + +namespace Tests + +open scoped DirectSum HahnSeries NatOrdinal + +variable {K : Type v} [Field K] + +section TwoGrades + +/-- A principal graded element with prescribed components in grades zero and one. -/ +def principalTwoGradeElement (x₀ : Berarducci.PrincipalComponent K 0) + (x₁ : Berarducci.PrincipalComponent K 1) : + Berarducci.PrincipalSubring K := + DirectSum.of (Berarducci.PrincipalComponent K) 0 x₀ + + DirectSum.of (Berarducci.PrincipalComponent K) 1 x₁ + +/-- The two-grade fixture has the prescribed components and vanishes in every other grade. -/ +theorem principalTwoGradeElement_components (x₀ : Berarducci.PrincipalComponent K 0) + (x₁ : Berarducci.PrincipalComponent K 1) : + principalTwoGradeElement x₀ x₁ 0 = x₀ ∧ + principalTwoGradeElement x₀ x₁ 1 = x₁ ∧ + ∀ α, α ≠ 0 → α ≠ 1 → principalTwoGradeElement x₀ x₁ α = 0 := by + constructor + · simp [principalTwoGradeElement, DirectSum.of_apply] + constructor + · simp [principalTwoGradeElement, DirectSum.of_apply] + · intro α hα0 hα1 + have h0α : (0 : NatOrdinal) ≠ α := Ne.symm hα0 + have h1α : (1 : NatOrdinal) ≠ α := Ne.symm hα1 + simp [principalTwoGradeElement, DirectSum.of_apply, h0α, h1α] + +/-- Nonzero inputs remain independently visible in grades zero and one. -/ +theorem principalTwoGradeElement_nonzero_components (x₀ : Berarducci.PrincipalComponent K 0) + (x₁ : Berarducci.PrincipalComponent K 1) + (hx₀ : x₀ ≠ 0) (hx₁ : x₁ ≠ 0) : + principalTwoGradeElement x₀ x₁ 0 ≠ 0 ∧ + principalTwoGradeElement x₀ x₁ 1 ≠ 0 := by + rw [(principalTwoGradeElement_components x₀ x₁).1, + (principalTwoGradeElement_components x₀ x₁).2.1] + exact ⟨hx₀, hx₁⟩ + +section Embedding + +variable [CharZero K] + +/-- The graded embedding preserves both prescribed components and their grades. -/ +theorem principalTwoGradeElement_embedding_components (x₀ : Berarducci.PrincipalComponent K 0) + (x₁ : Berarducci.PrincipalComponent K 1) : + Berarducci.principalSubringEmbedding K + (principalTwoGradeElement x₀ x₁) 0 = + Berarducci.principalComponentToHahnDegreeLayer K 0 x₀ ∧ + Berarducci.principalSubringEmbedding K + (principalTwoGradeElement x₀ x₁) 1 = + Berarducci.principalComponentToHahnDegreeLayer K 1 x₁ ∧ + ∀ α, α ≠ 0 → α ≠ 1 → + Berarducci.principalSubringEmbedding K + (principalTwoGradeElement x₀ x₁) α = 0 := by + simp only [Berarducci.principalSubringEmbedding_apply] + rw [(principalTwoGradeElement_components x₀ x₁).1, + (principalTwoGradeElement_components x₀ x₁).2.1] + refine ⟨rfl, rfl, ?_⟩ + intro α hα0 hα1 + rw [(principalTwoGradeElement_components x₀ x₁).2.2 α hα0 hα1, + map_zero] + +/-- The public algebra equivalence exposes the embedding and projection without unfolding. -/ +theorem principalSubringEquiv_evaluation (x : Berarducci.PrincipalSubring K) + (y : Berarducci.principalSubringSubalgebra K) : + ((Berarducci.principalSubringEquivSubalgebra K x : + Berarducci.principalSubringSubalgebra K) : + Berarducci.DegreeGraded K) = + Berarducci.principalSubringEmbedding K x ∧ + (Berarducci.principalSubringEquivSubalgebra K).symm y = + Berarducci.rvProjection K y := by + exact ⟨Berarducci.principalSubringEquivSubalgebra_apply x, + Berarducci.principalSubringEquivSubalgebra_symm_apply y⟩ + +end Embedding + +end TwoGrades + +section ProperRange + +def negativeMonomialForPrincipalGraded : Berarducci.Series K := + HahnSeries.Nonpositive.single (-1 : ℝ) 1 (by norm_num) + +theorem negativeMonomialForPrincipalGraded_degree : + ((negativeMonomialForPrincipalGraded (K := K) : Berarducci.Series K) : + K⟦ℝ⟧).degree = (0 : WithBot NatOrdinal) := by + apply HahnSeries.degree_eq_zero.mpr + constructor + · simp [negativeMonomialForPrincipalGraded] + · rw [negativeMonomialForPrincipalGraded, + HahnSeries.Nonpositive.coe_single] + exact (Set.finite_singleton (-1 : ℝ)).subset + HahnSeries.support_single_subset + +theorem negativeMonomialForPrincipalGraded_ordinalValue : + Berarducci.ordinalValue (negativeMonomialForPrincipalGraded (K := K)) = 0 := by + apply Berarducci.ordinalValue_of_mem_negativeMonomialIdeal + exact HahnSeries.Nonpositive.single_one_mem_negativeMonomialIdeal (by norm_num) + +variable (K) in +/-- The nonzero degree-zero class of the strictly negative monomial in `RV̂`. -/ +def negativeMonomialDegreeClass : + (HahnSeries.Nonpositive.degreeValuation K).Component 0 := + Berarducci.degreeLayerMk 0 + (negativeMonomialForPrincipalGraded (K := K)) + (negativeMonomialForPrincipalGraded_degree (K := K)).le + +variable (K) in +theorem negativeMonomialDegreeClass_ne_zero : + negativeMonomialDegreeClass K ≠ 0 := by + rw [negativeMonomialDegreeClass, ne_eq, + Berarducci.degreeLayerMk_eq_zero_iff, + negativeMonomialForPrincipalGraded_degree] + exact (lt_irrefl (0 : WithBot NatOrdinal)) + +variable (K) in +/-- The homogeneous realization of the strictly negative monomial class in `RV̂`. -/ +def negativeMonomialDegreeGraded : Berarducci.DegreeGraded K := + DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component 0 + (negativeMonomialDegreeClass K) + +variable (K) in +theorem negativeMonomialDegreeGraded_ne_zero : + negativeMonomialDegreeGraded K ≠ 0 := by + rw [negativeMonomialDegreeGraded, + ← map_zero (DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component 0)] + exact (DirectSum.of_injective 0).ne + (negativeMonomialDegreeClass_ne_zero K) + +variable (K) in +theorem negativeMonomialDegreeClass_projection_eq_zero : + Berarducci.degreeLayerToPrincipalComponent K 0 + (negativeMonomialDegreeClass K) = 0 := by + rw [negativeMonomialDegreeClass, + Berarducci.degreeLayerToPrincipalComponent_mk] + rw [Berarducci.principalComponentMk_eq_zero_iff, + negativeMonomialForPrincipalGraded_ordinalValue] + exact NatOrdinal.wpow_pos 0 + +variable (K) in +theorem negativeMonomialDegreeGraded_projection_eq_zero : + Berarducci.rvProjection K + (negativeMonomialDegreeGraded K) = 0 := by + rw [negativeMonomialDegreeGraded, + Berarducci.rvProjection_of, + negativeMonomialDegreeClass_projection_eq_zero] + exact map_zero _ + +variable (K) [CharZero K] in +/-- The principal graded subalgebra is strictly smaller than the full degree-graded +graded ring. -/ +theorem negativeMonomialDegreeGraded_not_mem_principalGradedSubalgebra : + negativeMonomialDegreeGraded K ∉ + Berarducci.principalSubringSubalgebra K := by + intro hmem + have hprincipal := + (Berarducci.mem_principalGradedSubalgebra_iff + (negativeMonomialDegreeGraded K)).mp hmem + rw [Berarducci.isPrincipalGraded_iff] at hprincipal + have hprincipalZero := hprincipal 0 + rw [negativeMonomialDegreeGraded, DirectSum.of_apply] at hprincipalZero + have hprincipalZero' : Berarducci.IsPrincipalDegreeClass 0 + (negativeMonomialDegreeClass K) := by + simpa using hprincipalZero + have hinverse := + Berarducci.principalComponentToHahnDegreeLayer_degreeLayerToPrincipalComponent_of_isPrincipal 0 + (negativeMonomialDegreeClass K) hprincipalZero' + rw [negativeMonomialDegreeClass_projection_eq_zero, map_zero] at hinverse + exact negativeMonomialDegreeClass_ne_zero K hinverse.symm + +end ProperRange + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFiniteSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFiniteSupport.lean new file mode 100644 index 0000000000..2f82d157d8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFiniteSupport.lean @@ -0,0 +1,238 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFraction + +/-! +# API checks for finite-support series over `Frac(P̂)` + +The first fixture verifies that coefficient extension preserves both the constant term and a term +at exponent `-1`. The second fixture uses the non-scalar positive-degree fraction from the +principal graded fraction-field client. A series having that fraction as its constant coefficient +does not belong to the embedded copy of `K(ℝ^{≤0})`. + +Finally, the non-scalar coefficient and its inverse are placed in opposite factors of a +nonconstant product. Multiplying the first factor by the inverse coefficient and the second by +its reciprocal puts both factors in `K(ℝ^{≤0})`. This checks the exact `B`/`B⁻¹` orientation +and the nonzero witness required in LM24, Lemma 6.3.4. +-/ + +open scoped HahnSeries + +namespace Tests.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport + +public noncomputable section + +/-- A nonzero element of `Frac(P̂)` outside the coefficient-field image. -/ +def outsideCoefficient : Berarducci.PrincipalSubringFractionField ℚ := + Tests.fractionPositiveDegreeImage + +/-- The chosen coefficient outside `ℚ` is nonzero. -/ +theorem outsideCoefficient_ne_zero : outsideCoefficient ≠ 0 := by + rw [outsideCoefficient] + exact Tests.fractionPositiveDegreeImage_ne_zero + +/-- The chosen coefficient does not belong to the image of the coefficient-field embedding. -/ +theorem outsideCoefficient_not_mem_coefficientMap_range : + outsideCoefficient ∉ + Set.range (Berarducci.principalSubringFractionCoefficientMap ℚ) := by + rintro ⟨k, hk⟩ + apply Tests.fractionPositiveDegreeImage_not_scalar + refine ⟨k, ?_⟩ + rw [Berarducci.principalSubringFraction_algebraMap_apply] + rw [Berarducci.principalSubringFractionCoefficientMap_apply, + outsideCoefficient] at hk + exact hk + +/-- The nonpositive real exponent `-1`. -/ +def negativeOne : HahnSeries.Nonpositive.exponentMonoid ℝ := + ⟨-1, by norm_num⟩ + +/-- A nonconstant finite-support series over `ℚ`, with coefficients one at `0` and `-1`. -/ +def sourceBinomial : + HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := ℚ) := + 1 + HahnSeries.Nonpositive.finiteSupportMonomial (K := ℚ) negativeOne + +/-- The coefficient extension of `sourceBinomial` to `Frac(P̂)`. -/ +def extendedBinomial : Berarducci.PrincipalSubringFractionFiniteSupportRing ℚ := + Berarducci.principalSubringFractionScalarExtension ℚ sourceBinomial + +/-- The term at exponent `-1` survives coefficient extension. -/ +theorem extendedBinomial_negativeOne_coeff : + HahnSeries.Nonpositive.finiteSupportCoefficients + extendedBinomial negativeOne = 1 := by + rw [extendedBinomial, + Berarducci.principalSubringFractionScalarExtension_coeff] + simp [sourceBinomial, negativeOne, + HahnSeries.Nonpositive.finiteSupportCoefficients_apply] + +/-- The constant term survives coefficient extension. -/ +theorem extendedBinomial_zero_coeff : + HahnSeries.Nonpositive.finiteSupportCoefficients + extendedBinomial 0 = 1 := by + rw [extendedBinomial, + Berarducci.principalSubringFractionScalarExtension_coeff] + simp [sourceBinomial, negativeOne, + HahnSeries.Nonpositive.finiteSupportCoefficients_apply] + +/-- The extended binomial lies in the embedded coefficient-series subring. -/ +theorem extendedBinomial_mem_coefficientSubring : + extendedBinomial ∈ + Berarducci.principalSubringFractionCoefficientSubring ℚ := + (Berarducci.mem_principalGradedFractionCoefficientSubring_iff _).mpr + ⟨sourceBinomial, rfl⟩ + +/-- The positive-degree fraction, regarded as a constant finite-support series. -/ +def outsideConstant : Berarducci.PrincipalSubringFractionFiniteSupportRing ℚ := + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) + outsideCoefficient + +/-- The constant coefficient of `outsideConstant` is the chosen non-scalar fraction. -/ +theorem outsideConstant_zero_coeff : + HahnSeries.Nonpositive.finiteSupportCoefficients outsideConstant 0 = + outsideCoefficient := by + rw [outsideConstant] + simp [HahnSeries.Nonpositive.finiteSupportCoefficients_apply] + +/-- The positive-degree constant series is not in the coefficient-series subring. -/ +theorem outsideConstant_not_mem_coefficientSubring : + outsideConstant ∉ + Berarducci.principalSubringFractionCoefficientSubring ℚ := by + rw [Berarducci.mem_principalGradedFractionCoefficientSubring_iff_coeff] + push Not + refine ⟨0, ?_⟩ + rw [outsideConstant_zero_coeff] + exact outsideCoefficient_not_mem_coefficientMap_range + +/-- The first redistribution factor has a non-scalar coefficient and nonconstant support. -/ +def redistributionLeft : Berarducci.PrincipalSubringFractionFiniteSupportRing ℚ := + outsideConstant * extendedBinomial + +/-- The second redistribution factor is the inverse non-scalar constant. -/ +def redistributionRight : Berarducci.PrincipalSubringFractionFiniteSupportRing ℚ := + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) + outsideCoefficient⁻¹ + +/-- The coefficient of the first redistribution factor at `-1` is the non-scalar coefficient. -/ +theorem redistributionLeft_negativeOne_coeff : + HahnSeries.Nonpositive.finiteSupportCoefficients + redistributionLeft negativeOne = outsideCoefficient := by + rw [redistributionLeft, outsideConstant, + ← HahnSeries.Nonpositive.smul_finiteSupport_eq_scalar_mul, + map_smul, Finsupp.smul_apply, extendedBinomial_negativeOne_coeff] + simp + +/-- The constant coefficient of the second redistribution factor is the inverse coefficient. -/ +theorem redistributionRight_zero_coeff : + HahnSeries.Nonpositive.finiteSupportCoefficients + redistributionRight 0 = outsideCoefficient⁻¹ := by + rw [redistributionRight] + simp [HahnSeries.Nonpositive.finiteSupportCoefficients_apply] + +private theorem finiteSupportCoefficients_zero (g : HahnSeries.Nonpositive.exponentMonoid ℝ) : + HahnSeries.Nonpositive.finiteSupportCoefficients + (0 : Berarducci.PrincipalSubringFractionFiniteSupportRing ℚ) g = 0 := by + have hmap := congrArg + (fun f : HahnSeries.Nonpositive.exponentMonoid ℝ →₀ + Berarducci.PrincipalSubringFractionField ℚ ↦ f g) + ((HahnSeries.Nonpositive.finiteSupportCoefficients + (G := ℝ) (K := Berarducci.PrincipalSubringFractionField ℚ)).map_zero) + simpa only [Finsupp.zero_apply] using hmap + +/-- The first redistribution factor is nonzero. -/ +theorem redistributionLeft_ne_zero : redistributionLeft ≠ 0 := by + intro hzero + have hcoeff := congrArg + (fun b : Berarducci.PrincipalSubringFractionFiniteSupportRing ℚ ↦ + HahnSeries.Nonpositive.finiteSupportCoefficients b negativeOne) hzero + rw [redistributionLeft_negativeOne_coeff] at hcoeff + rw [finiteSupportCoefficients_zero] at hcoeff + exact outsideCoefficient_ne_zero hcoeff + +/-- The second redistribution factor is nonzero. -/ +theorem redistributionRight_ne_zero : redistributionRight ≠ 0 := by + intro hzero + have hcoeff := congrArg + (fun b : Berarducci.PrincipalSubringFractionFiniteSupportRing ℚ ↦ + HahnSeries.Nonpositive.finiteSupportCoefficients b 0) hzero + rw [redistributionRight_zero_coeff] at hcoeff + rw [finiteSupportCoefficients_zero] at hcoeff + exact inv_ne_zero outsideCoefficient_ne_zero hcoeff + +/-- The two redistribution factors multiply to the extended nonconstant binomial. -/ +theorem redistributionLeft_mul_right : + redistributionLeft * redistributionRight = + extendedBinomial := by + rw [redistributionLeft, redistributionRight, outsideConstant] + calc + _ = + (HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) + outsideCoefficient * + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) + outsideCoefficient⁻¹) * + extendedBinomial := by ring + _ = extendedBinomial := by + rw [← (HahnSeries.Nonpositive.finiteSupportScalarHom + (G := ℝ) (K := Berarducci.PrincipalSubringFractionField ℚ)).map_mul] + simp [outsideCoefficient_ne_zero] + +/-- The product of the redistribution factors belongs to the coefficient-series subring. -/ +theorem redistributionLeft_mul_right_mem_coefficientSubring : + redistributionLeft * redistributionRight ∈ + Berarducci.principalSubringFractionCoefficientSubring ℚ := by + rw [redistributionLeft_mul_right] + exact extendedBinomial_mem_coefficientSubring + +/-- The non-scalar constant factor divides the first redistribution factor in the ordinary +finite-support ring sense, with the nonconstant extended binomial as quotient. -/ +theorem outsideConstant_dvd_redistributionLeft : + outsideConstant ∣ redistributionLeft := by + exact dvd_mul_right _ _ + +/-- The inverse positive-degree coefficient is an explicit valid redistribution witness. -/ +theorem inversePositiveDegree_is_redistributionWitness : + let B := outsideCoefficient⁻¹ + B ≠ 0 ∧ + redistributionLeft * + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B ∈ + Berarducci.principalSubringFractionCoefficientSubring ℚ ∧ + redistributionRight * + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B⁻¹ ∈ + Berarducci.principalSubringFractionCoefficientSubring ℚ := by + dsimp only + have hX := outsideCoefficient_ne_zero + refine ⟨inv_ne_zero hX, ?_, ?_⟩ + · rw [redistributionLeft, outsideConstant] + have hleft : + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) + outsideCoefficient * extendedBinomial * + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) + outsideCoefficient⁻¹ = + extendedBinomial := by + calc + _ = + (HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) + outsideCoefficient * + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) + outsideCoefficient⁻¹) * + extendedBinomial := by ring + _ = extendedBinomial := by + rw [← (HahnSeries.Nonpositive.finiteSupportScalarHom + (G := ℝ) (K := Berarducci.PrincipalSubringFractionField ℚ)).map_mul] + simp [hX] + rw [hleft] + exact extendedBinomial_mem_coefficientSubring + · rw [redistributionRight] + rw [inv_inv, ← (HahnSeries.Nonpositive.finiteSupportScalarHom + (G := ℝ) (K := Berarducci.PrincipalSubringFractionField ℚ)).map_mul] + simp [hX] + +end + +end Tests.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFraction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFraction.lean new file mode 100644 index 0000000000..c3eb072cba --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFraction.lean @@ -0,0 +1,166 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFraction + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero + +/-! +# API checks for the principal graded fraction field + +The positive-degree fixture is the grade-one class of the approach-zero series. Its image in +`Frac(P̂)` is nonzero and does not belong to the image of the coefficient field. This separates +relative algebraic closure from the incorrect assertion that `Frac(P̂) = K`. + +The inverse identity is also verified on a nonconstant fraction, rather than only on elements of +the underlying ring `P̂`. +-/ + +open scoped DirectSum HahnSeries NatOrdinal + +namespace Tests + +public noncomputable section + +local instance principalSubringFractionClientSelfSMul : + SMul (Berarducci.PrincipalSubring ℚ) + (Berarducci.PrincipalSubringFractionField ℚ) := + (Berarducci.principalSubringFractionSelfAlgebra ℚ).toSMul + +local instance principalSubringFractionClientSelfAlgebra : + Algebra (Berarducci.PrincipalSubring ℚ) + (Berarducci.PrincipalSubringFractionField ℚ) := + Berarducci.principalSubringFractionSelfAlgebra ℚ + +local instance principalSubringFractionClientSMul : + SMul ℚ (Berarducci.PrincipalSubringFractionField ℚ) := + (Berarducci.principalSubringFractionAlgebra ℚ).toSMul + +local instance principalSubringFractionClientAlgebra : + Algebra ℚ (Berarducci.PrincipalSubringFractionField ℚ) := + Berarducci.principalSubringFractionAlgebra ℚ + +local instance principalSubringFractionClientIsScalarTower : + IsScalarTower ℚ (Berarducci.PrincipalSubring ℚ) + (Berarducci.PrincipalSubringFractionField ℚ) := + Berarducci.principalSubringFraction_isScalarTower ℚ + +private theorem fractionApproachZero_ordinalValue_bound : + Berarducci.ordinalValue approachZeroNonpositive < ω^ (1 + 1 : NatOrdinal) := by + rw [Berarducci.ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal + approachZero_degree_eq_one] + exact NatOrdinal.wpow_lt_wpow.mpr (lt_add_one (1 : NatOrdinal)) + +/-- The intrinsic degree-one class represented by the approach-zero series. -/ +def fractionApproachZeroLayer : Berarducci.PrincipalComponent ℚ 1 := + Berarducci.principalComponentMk 1 approachZeroNonpositive + fractionApproachZero_ordinalValue_bound + +/-- The approach-zero degree-one class is nonzero. -/ +theorem fractionApproachZeroLayer_ne_zero : + fractionApproachZeroLayer ≠ 0 := by + rw [fractionApproachZeroLayer, ne_eq, + Berarducci.principalComponentMk_eq_zero_iff, + Berarducci.ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal + approachZero_degree_eq_one] + exact lt_irrefl _ + +/-- The homogeneous principal graded element represented by the approach-zero series. -/ +def fractionPositiveDegree : Berarducci.PrincipalSubring ℚ := + DirectSum.of _ 1 fractionApproachZeroLayer + +@[simp] +theorem fractionPositiveDegree_apply_one : + fractionPositiveDegree 1 = fractionApproachZeroLayer := by + simp [fractionPositiveDegree] + +/-- The positive-degree fixture is nonzero in `P̂`. -/ +theorem fractionPositiveDegree_ne_zero : + fractionPositiveDegree ≠ 0 := by + rw [fractionPositiveDegree, + ← map_zero (DirectSum.of (Berarducci.PrincipalComponent ℚ) 1)] + exact (DirectSum.of_injective 1).ne + fractionApproachZeroLayer_ne_zero + +/-- No coefficient scalar equals the positive-degree fixture. -/ +theorem fractionPositiveDegree_not_scalar (k : ℚ) : + fractionPositiveDegree ≠ + algebraMap ℚ (Berarducci.PrincipalSubring ℚ) k := by + intro hscalar + have hscalarZero : + (algebraMap ℚ (Berarducci.PrincipalSubring ℚ) k) 1 = 0 := by + rw [Berarducci.principalSubring_algebraMap_apply, + DirectSum.of_apply] + simp + have hcomponent := + congrArg (fun x : Berarducci.PrincipalSubring ℚ ↦ x 1) hscalar + rw [fractionPositiveDegree_apply_one, hscalarZero] at hcomponent + exact fractionApproachZeroLayer_ne_zero hcomponent + +/-- The image of the positive-degree fixture in the principal graded fraction field. -/ +def fractionPositiveDegreeImage : + Berarducci.PrincipalSubringFractionField ℚ := + Berarducci.principalSubringToFraction ℚ fractionPositiveDegree + +/-- The positive-degree fixture remains nonzero in the fraction field. -/ +theorem fractionPositiveDegreeImage_ne_zero : + fractionPositiveDegreeImage ≠ 0 := by + intro hzero + apply fractionPositiveDegree_ne_zero + apply Berarducci.principalSubringToFraction_injective ℚ + simpa only [fractionPositiveDegreeImage, map_zero] using hzero + +/-- The nonzero fixture admits the localization representation used at the start of LM24, +Lemma 6.3.3. -/ +theorem fractionPositiveDegreeImage_exists_mk : + ∃ (B : Berarducci.PrincipalSubring ℚ) + (C : nonZeroDivisors (Berarducci.PrincipalSubring ℚ)), + B ≠ 0 ∧ fractionPositiveDegreeImage = + Berarducci.principalSubringFractionMk B C := + Berarducci.principalSubringFraction_exists_mk_of_ne_zero + fractionPositiveDegreeImage_ne_zero + +/-- The public localization-map equation identifies the fixture with its fraction `B / 1`. -/ +theorem fractionPositiveDegree_toFraction_eq_mk : + Berarducci.principalSubringToFraction ℚ + fractionPositiveDegree = + Berarducci.principalSubringFractionMk + fractionPositiveDegree + (1 : nonZeroDivisors (Berarducci.PrincipalSubring ℚ)) := + Berarducci.principalSubringToFraction_apply_eq_mk _ + +/-- The exposed scalar tower makes the two scalar actions on the fraction field compatible. -/ +theorem fractionScalarTower_smul_assoc (k : ℚ) (B : Berarducci.PrincipalSubring ℚ) + (x : Berarducci.PrincipalSubringFractionField ℚ) : + (k • B) • x = k • (B • x) := + smul_assoc k B x + +/-- The principal graded fraction field strictly contains the image of the coefficient field. -/ +theorem fractionPositiveDegreeImage_not_scalar : + fractionPositiveDegreeImage ∉ + (algebraMap ℚ + (Berarducci.PrincipalSubringFractionField ℚ)).range := by + rintro ⟨k, hk⟩ + apply fractionPositiveDegree_not_scalar k + apply Berarducci.principalSubringToFraction_injective ℚ + calc + Berarducci.principalSubringToFraction ℚ fractionPositiveDegree = + fractionPositiveDegreeImage := rfl + _ = algebraMap ℚ (Berarducci.PrincipalSubringFractionField ℚ) k := hk.symm + _ = Berarducci.principalSubringToFraction ℚ + (algebraMap ℚ (Berarducci.PrincipalSubring ℚ) k) := + Berarducci.principalSubringFraction_algebraMap_apply k + +/-- The nonzero positive-degree element has a multiplicative inverse in `Frac(P̂)`. -/ +theorem fractionPositiveDegreeImage_mul_inv : + fractionPositiveDegreeImage * + fractionPositiveDegreeImage⁻¹ = 1 := + mul_inv_cancel₀ fractionPositiveDegreeImage_ne_zero + +end + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringTensor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringTensor.lean new file mode 100644 index 0000000000..4fe9f9bbb6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringTensor.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero +import Mathlib.Tactic.NormNum + +/-! +# API checks for the principal graded tensor decomposition + +The two-grade fixture has independently visible components in grades zero and one. Its image +therefore distinguishes the graded tensor equivalence from a construction that retains only the +degree-zero summand. The finite-support fixture is the monomial at exponent `-1`; proving that its +image is not a coefficient scalar distinguishes the factor `K(ℝ^{≤ 0})` from `K` itself. + +The final round trip verifies both inverse identities on this nondegenerate element. +-/ + +public noncomputable section + +namespace Tests + +open scoped DirectSum HahnSeries NatOrdinal TensorProduct + +private theorem gradedTensorApproachZero_ordinalValue_bound : + Berarducci.ordinalValue approachZeroNonpositive < ω^ (1 + 1 : NatOrdinal) := by + rw [Berarducci.ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal + approachZero_degree_eq_one] + exact NatOrdinal.wpow_lt_wpow.mpr (lt_add_one (1 : NatOrdinal)) + +/-- The intrinsic degree-one class represented by the approach-zero series. -/ +def gradedTensorApproachZeroLayer : Berarducci.PrincipalComponent ℚ 1 := + Berarducci.principalComponentMk 1 approachZeroNonpositive + gradedTensorApproachZero_ordinalValue_bound + +/-- The approach-zero degree-one class is nonzero. -/ +theorem gradedTensorApproachZeroLayer_ne_zero : + gradedTensorApproachZeroLayer ≠ 0 := by + rw [gradedTensorApproachZeroLayer, ne_eq, + Berarducci.principalComponentMk_eq_zero_iff, + Berarducci.ordinalValue_eq_wpow_of_isPrincipal approachZero_isPrincipal + approachZero_degree_eq_one] + exact lt_irrefl _ + +/-- The grade-zero class of the coefficient one. -/ +def gradedTensorScalarLayer : Berarducci.PrincipalComponent ℚ 0 := + Berarducci.principalComponentScalarHom ℚ 1 + +/-- A principal graded element with nontrivial data in grades zero and one. -/ +def gradedTensorTwoGradeElement : Berarducci.PrincipalSubring ℚ := + DirectSum.of _ 0 gradedTensorScalarLayer + + DirectSum.of _ 1 gradedTensorApproachZeroLayer + +/-- The two prescribed homogeneous components remain distinct in the direct sum. -/ +theorem gradedTensorTwoGradeElement_components : + gradedTensorTwoGradeElement 0 = gradedTensorScalarLayer ∧ + gradedTensorTwoGradeElement 1 = gradedTensorApproachZeroLayer := by + simp [gradedTensorTwoGradeElement, DirectSum.of_apply] + +/-- Tensoring the two-grade fixture with one preserves both homogeneous components through the +homogeneous-component equivalences. -/ +theorem gradedTensorTwoGrade_components : + Berarducci.principalSubringTensorEquiv ℚ + (gradedTensorTwoGradeElement ⊗ₜ (1 : Berarducci.FiniteSupportRing)) 0 = + Berarducci.principalComponentToHahnDegreeLayer ℚ 0 + gradedTensorScalarLayer ∧ + Berarducci.principalSubringTensorEquiv ℚ + (gradedTensorTwoGradeElement ⊗ₜ (1 : Berarducci.FiniteSupportRing)) 1 = + Berarducci.principalComponentToHahnDegreeLayer ℚ 1 + gradedTensorApproachZeroLayer := by + constructor + · rw [Berarducci.principalSubringTensorEquiv_tmul_apply, + gradedTensorTwoGradeElement_components.1, + Berarducci.principalComponentTensorEquiv_tmul, map_one, one_smul] + · rw [Berarducci.principalSubringTensorEquiv_tmul_apply, + gradedTensorTwoGradeElement_components.2, + Berarducci.principalComponentTensorEquiv_tmul, map_one, one_smul] + +/-- The positive-degree component survives; a degree-zero-only assembly fails this check. -/ +theorem gradedTensorTwoGrade_positive_component_ne_zero : + Berarducci.principalSubringTensorEquiv ℚ + (gradedTensorTwoGradeElement ⊗ₜ (1 : Berarducci.FiniteSupportRing)) 1 ≠ 0 := by + rw [gradedTensorTwoGrade_components.2] + intro hzero + apply gradedTensorApproachZeroLayer_ne_zero + apply Berarducci.principalComponentToHahnDegreeLayer_injective ℚ 1 + simpa only [map_zero] using hzero + +/-- The nonpositive exponent `-1` used by the finite-support factor fixture. -/ +def gradedTensorExponentNegOne : {g : ℝ // g ≤ 0} := ⟨-1, by norm_num⟩ + +/-- The finite-support monomial at exponent `-1`. -/ +def gradedTensorFiniteMonomial : Berarducci.FiniteSupportRing (K := ℚ) := + HahnSeries.Nonpositive.finiteSupportMonomial (K := ℚ) gradedTensorExponentNegOne + +/-- The negative-exponent monomial is not a constant finite-support series. -/ +theorem gradedTensorFiniteMonomial_not_scalar (k : ℚ) : + gradedTensorFiniteMonomial ≠ + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k := by + intro h + have hcoeff := congrArg + (fun p : Berarducci.FiniteSupportRing (K := ℚ) ↦ + (((p : Berarducci.Series ℚ) : ℚ⟦ℝ⟧).coeff (-1))) h + simp [gradedTensorFiniteMonomial, gradedTensorExponentNegOne, + HahnSeries.Nonpositive.coe_finiteSupportMonomial, + HahnSeries.Nonpositive.coe_finiteSupportScalarHom, + HahnSeries.C_apply] at hcoeff + +/-- The global equivalence retains the full finite-support factor rather than only coefficient +scalars. -/ +theorem gradedTensorFiniteSupportFactor_not_scalar (k : ℚ) : + Berarducci.principalSubringTensorEquiv ℚ + (1 ⊗ₜ gradedTensorFiniteMonomial) ≠ + algebraMap ℚ (Berarducci.DegreeGraded ℚ) k := by + rw [Berarducci.principalSubringTensorEquiv_one_tmul] + intro h + apply gradedTensorFiniteMonomial_not_scalar k + apply Berarducci.finiteSupportGradedEmbedding_injective ℚ + calc + Berarducci.finiteSupportGradedEmbedding ℚ gradedTensorFiniteMonomial = + algebraMap ℚ (Berarducci.DegreeGraded ℚ) k := h + _ = Berarducci.finiteSupportGradedEmbedding ℚ + (algebraMap ℚ (Berarducci.FiniteSupportRing (K := ℚ)) k) := + ((Berarducci.finiteSupportGradedEmbedding ℚ).commutes k).symm + _ = Berarducci.finiteSupportGradedEmbedding ℚ + (HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k) := rfl + +/-- The inverse equivalence recovers the positive-degree tensor component through the +homogeneous-component +inverse, without unfolding either equivalence. -/ +theorem gradedTensor_inverse_positive_component : + Berarducci.principalSubringTensorComponent ℚ 1 + ((Berarducci.principalSubringTensorEquiv ℚ).symm + (Berarducci.principalSubringTensorEquiv ℚ + (gradedTensorTwoGradeElement ⊗ₜ gradedTensorFiniteMonomial))) = + gradedTensorApproachZeroLayer ⊗ₜ gradedTensorFiniteMonomial := by + rw [Berarducci.principalSubringTensorComponent_symm_apply, + Berarducci.principalSubringTensorEquiv_component, + LinearEquiv.symm_apply_apply, + Berarducci.principalSubringTensorComponent_tmul, + gradedTensorTwoGradeElement_components.2] + +/-- The opaque global equivalence is invertible on the nondegenerate two-grade, +negative-exponent fixture. -/ +theorem gradedTensor_roundtrip : + (Berarducci.principalSubringTensorEquiv ℚ).symm + (Berarducci.principalSubringTensorEquiv ℚ + (gradedTensorTwoGradeElement ⊗ₜ gradedTensorFiniteMonomial)) = + gradedTensorTwoGradeElement ⊗ₜ gradedTensorFiniteMonomial := + (Berarducci.principalSubringTensorEquiv ℚ).symm_apply_apply _ + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalValue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalValue.lean new file mode 100644 index 0000000000..bdebe13fef --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalValue.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentDegree + +/-! +# API checks for principal and residual ordinal values + +The approach-zero Hahn series supplies a concrete nonzero input whose ordinal value is strictly +greater than one. The first certificate checks both ordinary and Hessenberg reconstruction on +that input, as well as the defining classes of the two factors. The constant-one certificate +checks that a nonzero series of ordinal value one is outside the exact domain. + +The companion ordinal-factor client distinguishes the final principal factor from the first +factor by an asymmetric computation and checks the singleton residual convention. Together these +clients test the factorisation primitives and their application to Berarducci's ordinal value. +-/ + +public noncomputable section + +namespace Tests + +open scoped HahnSeries NatOrdinal + +/-- The approach-zero series, packaged in the exact domain of principal and residual values. -/ +def approachZeroWithOrdinalValueAboveOne : + Berarducci.SeriesWithOrdinalValueAboveOne ℚ := + ⟨approachZeroNonpositive, by + apply Berarducci.one_lt_ordinalValue_of_constantCoeff_eq_zero_of_supportSup_eq_zero + · rw [HahnSeries.Nonpositive.constantCoeff_apply, coe_approachZeroNonpositive] + exact not_ne_iff.mp (by + simpa [HahnSeries.mem_support] using zero_not_mem_approachZero_support) + · exact approachZero_supportSup⟩ + +/-- Principal and residual values satisfy all source characteristics on a concrete nonzero input +whose support is cofinal in zero. -/ +theorem approachZero_principalResidualValue_certificate : + (approachZeroWithOrdinalValueAboveOne : Berarducci.Series ℚ) ≠ 0 ∧ + Ordinal.IsInfiniteMultiplicativelyPrincipal + approachZeroWithOrdinalValueAboveOne.principalValue.val ∧ + Ordinal.IsAdditivelyPrincipal + approachZeroWithOrdinalValueAboveOne.residualValue.val ∧ + approachZeroWithOrdinalValueAboveOne.residualValue.val * + approachZeroWithOrdinalValueAboveOne.principalValue.val = + (Berarducci.ordinalValue approachZeroNonpositive).val ∧ + approachZeroWithOrdinalValueAboveOne.residualValue * + approachZeroWithOrdinalValueAboveOne.principalValue = + Berarducci.ordinalValue approachZeroNonpositive := by + exact ⟨approachZero_ne_zero, + approachZeroWithOrdinalValueAboveOne.principalValue_isInfiniteMultiplicativelyPrincipal, + approachZeroWithOrdinalValueAboveOne.residualValue_isAdditivelyPrincipal, + approachZeroWithOrdinalValueAboveOne.residualValue_val_mul_principalValue_val, + approachZeroWithOrdinalValueAboveOne.residualValue_mul_principalValue⟩ + +private theorem approachZero_ordinalValue_eq_wpow_one : + Berarducci.ordinalValue approachZeroNonpositive = ω^ (1 : NatOrdinal) := + Berarducci.ordinalValue_eq_wpow_of_isPrincipal + approachZero_isPrincipal approachZero_degree_eq_one + +/-- The successor-exponent formulas identify the two factors of the concrete degree-one +principal series. -/ +theorem approachZero_successor_principalResidualValue : + approachZeroWithOrdinalValueAboveOne.principalValue = ω^ (1 : NatOrdinal) ∧ + approachZeroWithOrdinalValueAboveOne.residualValue = 1 := by + have hone : 0 < (1 : NatOrdinal).constantCoeff := by + have h : (1 : NatOrdinal) = ((1 : ℕ) : NatOrdinal) := by norm_num + rw [h, NatOrdinal.constantCoeff_natCast] + norm_num + constructor + · exact approachZeroWithOrdinalValueAboveOne.principalValue_eq_wpow_one_of_ordinalValue_eq_wpow + 1 hone approachZero_ordinalValue_eq_wpow_one + · have hremove : (1 : NatOrdinal).removeNat 1 = 0 := by + symm + apply (NatOrdinal.eq_removeNat_iff_add_natCast_eq + (a := (1 : NatOrdinal)) (eta := 0) (n := 1) + (Nat.succ_le_iff.mpr hone)).mpr + simp + simpa [hremove] using + approachZeroWithOrdinalValueAboveOne.residualValue_eq_wpow_removeNat_of_ordinalValue_eq_wpow + 1 hone approachZero_ordinalValue_eq_wpow_one + +/-- The nonzero constant-one series is excluded from the domain because its ordinal value is one. -/ +theorem not_one_lt_ordinalValue_constant_one : + ¬1 < Berarducci.ordinalValue (HahnSeries.Nonpositive.C (1 : ℚ)) := by + have hvalue : + Berarducci.ordinalValue (HahnSeries.Nonpositive.C (1 : ℚ)) = 1 := by + apply Berarducci.ordinalValue_eq_one_iff.mpr + constructor + · apply Berarducci.mem_nearConstantSubgroup_iff.mpr + exact ⟨0, (HahnSeries.Nonpositive.negativeMonomialIdeal ℚ).zero_mem, 1, by simp⟩ + · intro hmem + have hcoeff := Berarducci.constantCoeff_eq_zero_of_mem_negativeMonomialIdeal hmem + norm_num at hcoeff + intro hlt + rw [hvalue] at hlt + exact lt_irrefl 1 hlt + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ResidualPoint.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ResidualPoint.lean new file mode 100644 index 0000000000..0e9a4622ad --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ResidualPoint.lean @@ -0,0 +1,176 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointTail +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointCofinality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage + +/-! +# API checks for Berarducci residual points + +The approach-zero series has ordinal value `ω`, hence principal value `ω` and residual value one. +Its least support exponent is `-1`. Closed truncation at that exponent retains the coefficient-one +monomial, and translation turns it into the constant-one series, so `-1` belongs to `X(b)`. + +This example separates Definition 6.6 from two nearby errors. Replacing residual value by +principal value would reject `-1`, while using strict rather than closed truncation would give the +zero series at `-1`. The endpoint zero is also excluded, but this is not a semantic separator for +the printed strict inequality: on the domain `1 < v_J(b)`, the value equation itself already +excludes zero, as proved in the definition module. + +The final test uses the same residual point to distinguish the strict tail cutoff `(η, 0)` from +the nearby closed cutoff `[η, 0)`: the point `-1` lies above `-2`, but not strictly above itself. + +The cofinality certificate produces a residual point strictly between `-1/1000` and zero. It +therefore distinguishes the proved conclusion of Lemma 6.8 from the nearby false assertion that +the residual-point set of this series consists only of its least exponent `-1`. +-/ + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace Tests + +open Ordinal +open Berarducci.SeriesWithOrdinalValueAboveOne + +/-- The approach-zero series in the exact domain of principal, residual, and residual-point +operations. -/ +def approachZeroResidualInput : + Berarducci.SeriesWithOrdinalValueAboveOne ℚ := + ⟨approachZeroNonpositive, by + apply Berarducci.one_lt_ordinalValue_of_constantCoeff_eq_zero_of_supportSup_eq_zero + · rw [HahnSeries.Nonpositive.constantCoeff_apply, coe_approachZeroNonpositive] + exact not_ne_iff.mp (by + simpa [HahnSeries.mem_support] using zero_not_mem_approachZero_support) + · exact approachZero_supportSup⟩ + +/-- The packaged residual-point input has the intended underlying Hahn series. -/ +@[simp] +theorem coe_approachZeroResidualInput : + (approachZeroResidualInput : Berarducci.Series ℚ) = approachZeroNonpositive := + (rfl) + +/-- The Berarducci ordinal value of the approach-zero series is `ω`. -/ +theorem approachZero_ordinalValue_eq_omega : + Berarducci.ordinalValue approachZeroNonpositive = NatOrdinal.of omega0 := by + apply le_antisymm + · simpa only [coe_approachZeroNonpositive, approachZero_supportOrderType] using + Berarducci.ordinalValue_le_supportOrderType approachZeroNonpositive + · apply NatOrdinal.of_le_iff.mpr + rw [← coe_approachZeroResidualInput] + have hprincipal := + Berarducci.ordinalValue_isAdditivelyPrincipal_of_one_lt + approachZeroResidualInput.2 + have hone : (1 : Ordinal) < + (Berarducci.ordinalValue approachZeroResidualInput.1).val := + NatOrdinal.of_lt_iff.mp approachZeroResidualInput.2 + exact hprincipal.omega0_le_of_one_lt hone + +private theorem approachZero_ordinalValue_isMultiplicativelyPrincipal : + Ordinal.IsMultiplicativelyPrincipal + (Berarducci.ordinalValue approachZeroResidualInput.1).val := by + rw [coe_approachZeroResidualInput, approachZero_ordinalValue_eq_omega] + simp only [NatOrdinal.val_of] + simpa [opow_zero, opow_one] using + Ordinal.isMultiplicativelyPrincipal_omega0_opow_opow 0 + +/-- The approach-zero series has principal value `ω` and residual value one. -/ +theorem approachZero_principalValue_eq_omega_and_residualValue_eq_one : + approachZeroResidualInput.principalValue = NatOrdinal.of omega0 ∧ + approachZeroResidualInput.residualValue = 1 := by + constructor + · rw [principalValue_eq_ordinalValue_of_isMultiplicativelyPrincipal + approachZeroResidualInput approachZero_ordinalValue_isMultiplicativelyPrincipal, + coe_approachZeroResidualInput, approachZero_ordinalValue_eq_omega] + · exact residualValue_eq_one_of_isMultiplicativelyPrincipal + approachZeroResidualInput approachZero_ordinalValue_isMultiplicativelyPrincipal + +private theorem approachZeroEmbedding_zero : + approachZeroEmbedding 0 = -1 := by + norm_num + +private theorem approachZero_coeff_neg_one : + approachZero.coeff (-1) = 1 := by + rw [← approachZeroEmbedding_zero, approachZero_coeff_embedding] + +private theorem approachZero_coeff_eq_zero_of_lt_neg_one {x : ℝ} (hx : x < -1) : + approachZero.coeff x = 0 := by + apply not_ne_iff.mp + rw [← HahnSeries.mem_support, approachZero_support] + rintro ⟨n, hn⟩ + have hmin : (-1 : ℝ) ≤ approachZeroEmbedding n := by + rw [← approachZeroEmbedding_zero] + exact approachZeroEmbedding.monotone (Nat.zero_le n) + linarith + +/-- Closed truncation of the approach-zero series at its least exponent, translated to zero, is +the constant-one series. -/ +theorem translatedTruncation_approachZero_neg_one : + Berarducci.translatedTruncation approachZero (-1) = + HahnSeries.Nonpositive.C (1 : ℚ) := by + apply Subtype.ext + ext δ + rw [Berarducci.coeff_translatedTruncation] + by_cases hδ : δ = 0 + · subst δ + simp [approachZero_coeff_neg_one] + · by_cases hδNonpositive : δ ≤ 0 + · have hδNeg : δ < 0 := lt_of_le_of_ne hδNonpositive hδ + have hlt : -1 + δ < -1 := by linarith + rw [if_pos hδNonpositive, + approachZero_coeff_eq_zero_of_lt_neg_one hlt] + simp [hδ] + · rw [if_neg hδNonpositive] + simp [hδ] + +/-- The least exponent is a residual point, whereas zero fails the value equation and is +excluded. -/ +theorem approachZero_residualPointSet_boundary : + (-1 : ℝ) ∈ Berarducci.residualPointSet approachZeroResidualInput ∧ + (0 : ℝ) ∉ Berarducci.residualPointSet approachZeroResidualInput := by + constructor + · rw [Berarducci.mem_residualPointSet_iff, + approachZero_principalValue_eq_omega_and_residualValue_eq_one.2] + constructor + · norm_num + · rw [coe_approachZeroResidualInput, coe_approachZeroNonpositive, + translatedTruncation_approachZero_neg_one] + apply Berarducci.ordinalValue_eq_one_iff.mpr + constructor + · apply Berarducci.mem_nearConstantSubgroup_iff.mpr + exact ⟨0, (HahnSeries.Nonpositive.negativeMonomialIdeal ℚ).zero_mem, + 1, by simp⟩ + · intro hmem + have hcoeff := + Berarducci.constantCoeff_eq_zero_of_mem_negativeMonomialIdeal hmem + norm_num at hcoeff + · exact Berarducci.zero_not_mem_residualPointSet approachZeroResidualInput + +/-- The residual-point set contains a point strictly between `-1/1000` and zero. -/ +theorem approachZero_residualPointSet_cofinal_near_zero : + ∃ γ ∈ Berarducci.residualPointSet approachZeroResidualInput, + -(1 : ℝ) / 1000 < γ ∧ γ < 0 := by + have hLUB := Berarducci.residualPointSet_isLUB_zero approachZeroResidualInput + obtain ⟨γ, hγ, hcutoff, _⟩ := hLUB.exists_between (by norm_num : -(1 : ℝ) / 1000 < 0) + exact ⟨γ, hγ, hcutoff, Berarducci.residualPointSet_subset_Iio _ hγ⟩ + +/-- The least exponent belongs to the tail cut at `-2` but not to the tail cut at `-1`. This +separates the strict cutoff in `residualPointTail` from a closed cutoff. -/ +theorem approachZero_residualPointTail_strict_cutoff : + (-1 : ℝ) ∈ Berarducci.residualPointTail approachZeroResidualInput (-2) ∧ + (-1 : ℝ) ∉ Berarducci.residualPointTail approachZeroResidualInput (-1) := by + constructor + · rw [Berarducci.mem_residualPointTail_iff] + exact ⟨approachZero_residualPointSet_boundary.1, by norm_num⟩ + · rw [Berarducci.mem_residualPointTail_iff] + exact fun h ↦ (lt_irrefl (-1)) h.2 + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/SectionSixThree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/SectionSixThree.lean new file mode 100644 index 0000000000..d79d3991bc --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/SectionSixThree.lean @@ -0,0 +1,183 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFiniteMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesPrimality +import Mathlib.Tactic.NormNum + +/-! +# API checks for LM24, Corollaries 6.3.6--6.3.9 + +These checks compose the reductions underlying the final four results of LM24, +Section 6.3. The factor-witness checks retain both factors in the finite-support ring; they would +not follow from the weaker bare `IsPrimal` conclusions. The three-factor checks require literal +multiplicativity of the normalized maximal finite-support divisor, rather than the previously +proved one-sided divisibility. + +The zero test preserves the absence of a nonzero hypothesis in Corollary 6.3.9. The final fixture +uses two genuinely nonconstant finite-support series, each with a nonzero coefficient at exponent +`-1`, to exercise Proposition 6.3.8 away from the constant and zero cases. The unresolved +mathematical prerequisites (gcd existence, scalar redistribution, unit classification) are +explicit parameters; the coefficient field has characteristic zero. +-/ + +open scoped HahnSeries + +universe v + +namespace Tests + +public noncomputable section + +open HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] +variable (hgcdK : ∀ p q : Berarducci.FiniteSupportRing (K := K), + ∃ d : Berarducci.FiniteSupportRing (K := K), + ∀ e : Berarducci.FiniteSupportRing (K := K), e ∣ p ∧ e ∣ q ↔ e ∣ d) +variable (hgcdL : ∀ p q : Berarducci.PrincipalSubringFractionFiniteSupportRing K, + ∃ d : Berarducci.PrincipalSubringFractionFiniteSupportRing K, + ∀ e : Berarducci.PrincipalSubringFractionFiniteSupportRing K, + e ∣ p ∧ e ∣ q ↔ e ∣ d) +variable (hredistribute : Berarducci.PrincipalSubringFractionScalarRedistribution K) +variable (hunits : ∀ u : Berarducci.FiniteSupportRing (K := K), + IsUnit u ↔ ∃ k : K, k ≠ 0 ∧ + u = finiteSupportScalarHom (G := ℝ) k) + +include hgcdK hgcdL hredistribute in +/-- The generic reduction for Corollary 6.3.6 retains both factors in the finite-support +ring, rather than merely producing factors in the ambient associated graded ring. -/ +theorem sectionSixThree_gradedFactorWitness (p : Berarducci.FiniteSupportRing (K := K)) + (B C : Berarducci.DegreeGraded K) + (hp : Berarducci.finiteSupportGradedEmbedding K p ∣ B * C) : + ∃ p₁ p₂ : Berarducci.FiniteSupportRing (K := K), + p = p₁ * p₂ ∧ + Berarducci.finiteSupportGradedEmbedding K p₁ ∣ B ∧ + Berarducci.finiteSupportGradedEmbedding K p₂ ∣ C := + Berarducci.finiteSupportGradedEmbedding_exists_factor_dvd_of_scalarRedistribution hgcdK hgcdL + hredistribute p B C hp + +include hgcdK hgcdL hredistribute hunits in +/-- Iterated multiplication verifies that Corollary 6.3.7 supplies an equality, not merely +one-sided divisibility. -/ +theorem sectionSixThree_gradedMaximal_three_mul (B C D : Berarducci.DegreeGraded K) : + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor ((B * C) * D) = + (Berarducci.gradedNormalizedMaximalFiniteSupportDivisor B * + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor C) * + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor D := by + have hfactor := sectionSixThree_gradedFactorWitness hgcdK hgcdL hredistribute + have hmax := Berarducci.gradedNormalizedMaximalFiniteSupportDivisor_mul_of_factorization hgcdK + hunits hfactor + rw [hmax (B * C) D, hmax B C] + +include hgcdK hgcdL hredistribute hunits in +/-- Iterated multiplication verifies the exact equality in Proposition 6.3.8 at the series +level. -/ +theorem sectionSixThree_seriesMaximal_three_mul (b c d : Berarducci.Series K) : + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor ((b * c) * d) = + (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b * + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor c) * + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor d := by + have hfactor := sectionSixThree_gradedFactorWitness hgcdK hgcdL hredistribute + have hgraded := + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor_mul_of_factorization hgcdK hunits hfactor + have hseries := Berarducci.seriesNormalizedMaximalFiniteSupportDivisor_mul_of_graded hgcdK hunits + hgraded + rw [hseries (b * c) d, hseries b c] + +include hgcdK hgcdL hredistribute hunits in +/-- The stronger form of Corollary 6.3.9 retains finite-support factors and asserts their +product equality in the ambient Hahn-series ring. -/ +theorem sectionSixThree_seriesFactorWitness + (p : Berarducci.FiniteSupportRing (K := K)) (b c : Berarducci.Series K) + (hp : (p : Berarducci.Series K) ∣ b * c) : + ∃ p₁ p₂ : Berarducci.FiniteSupportRing (K := K), + (p : Berarducci.Series K) = + (p₁ : Berarducci.Series K) * (p₂ : Berarducci.Series K) ∧ + (p₁ : Berarducci.Series K) ∣ b ∧ + (p₂ : Berarducci.Series K) ∣ c := by + have hfactor := sectionSixThree_gradedFactorWitness hgcdK hgcdL hredistribute + have hgraded := + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor_mul_of_factorization hgcdK hunits hfactor + have hseries := Berarducci.seriesNormalizedMaximalFiniteSupportDivisor_mul_of_graded hgcdK hunits + hgraded + obtain ⟨p₁, p₂, hpFactor, hp₁, hp₂⟩ := + Berarducci.finiteSupportSeries_exists_factor_dvd_of_maximalMultiplicative hgcdK hseries p b c hp + refine ⟨p₁, p₂, ?_, hp₁, hp₂⟩ + exact congrArg + (finiteSupportSubring (G := ℝ) (K := K)).subtype hpFactor + +include hgcdK hgcdL hredistribute hunits in +/-- The zero finite-support element is included in the witness theorem, so no hidden +nonzeroness hypothesis has entered the reduction. -/ +theorem sectionSixThree_zeroSeriesFactorWitness (b c : Berarducci.Series K) (hbc : b * c = 0) : + ∃ p₁ p₂ : Berarducci.FiniteSupportRing (K := K), + (0 : Berarducci.Series K) = + (p₁ : Berarducci.Series K) * (p₂ : Berarducci.Series K) ∧ + (p₁ : Berarducci.Series K) ∣ b ∧ + (p₂ : Berarducci.Series K) ∣ c := by + apply sectionSixThree_seriesFactorWitness hgcdK hgcdL hredistribute hunits 0 b c + rw [hbc] + exact dvd_refl 0 + +/-- The finite-support monomial `t⁻¹` used in the nonconstant multiplicativity fixture. -/ +def sectionSixThreeNegativeMonomial : Berarducci.FiniteSupportRing (K := ℚ) := + finiteSupportMonomial (K := ℚ) ⟨-1, by norm_num⟩ + +/-- The first nonconstant factor `t⁻¹ + 1`. -/ +def sectionSixThreeLeftSeries : Berarducci.Series ℚ := + ((sectionSixThreeNegativeMonomial + 1 : Berarducci.FiniteSupportRing (K := ℚ)) : + Berarducci.Series ℚ) + +/-- The second nonconstant factor `t⁻¹ - 1`. -/ +def sectionSixThreeRightSeries : Berarducci.Series ℚ := + ((sectionSixThreeNegativeMonomial - 1 : Berarducci.FiniteSupportRing (K := ℚ)) : + Berarducci.Series ℚ) + +/-- Both concrete factors have coefficient one at exponent `-1`; their constant coefficients +are respectively one and negative one. In particular, neither factor is zero or constant. -/ +theorem sectionSixThree_nonconstantFactors_coefficients : + (sectionSixThreeLeftSeries : ℚ⟦ℝ⟧).coeff (-1) = 1 ∧ + (sectionSixThreeRightSeries : ℚ⟦ℝ⟧).coeff (-1) = 1 ∧ + (sectionSixThreeLeftSeries : ℚ⟦ℝ⟧).coeff 0 = 1 ∧ + (sectionSixThreeRightSeries : ℚ⟦ℝ⟧).coeff 0 = -1 := by + simp [sectionSixThreeLeftSeries, sectionSixThreeRightSeries, + sectionSixThreeNegativeMonomial] + +/-- Proposition 6.3.8 applies as a literal equality to two concrete nonzero, nonconstant +finite-support series. -/ +theorem sectionSixThree_nonconstantSeriesMaximal_mul + (hgcdK : ∀ p q : Berarducci.FiniteSupportRing (K := ℚ), + ∃ d : Berarducci.FiniteSupportRing (K := ℚ), + ∀ e : Berarducci.FiniteSupportRing (K := ℚ), e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hgcdL : ∀ p q : Berarducci.PrincipalSubringFractionFiniteSupportRing ℚ, + ∃ d : Berarducci.PrincipalSubringFractionFiniteSupportRing ℚ, + ∀ e : Berarducci.PrincipalSubringFractionFiniteSupportRing ℚ, + e ∣ p ∧ e ∣ q ↔ e ∣ d) + (hredistribute : Berarducci.PrincipalSubringFractionScalarRedistribution ℚ) + (hunits : ∀ u : Berarducci.FiniteSupportRing (K := ℚ), + IsUnit u ↔ ∃ k : ℚ, k ≠ 0 ∧ + u = finiteSupportScalarHom (G := ℝ) k) : + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor + (sectionSixThreeLeftSeries * sectionSixThreeRightSeries) = + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor sectionSixThreeLeftSeries * + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor + sectionSixThreeRightSeries := by + have hfactor := sectionSixThree_gradedFactorWitness hgcdK hgcdL hredistribute + have hgraded := + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor_mul_of_factorization hgcdK hunits hfactor + exact Berarducci.seriesNormalizedMaximalFiniteSupportDivisor_mul_of_graded hgcdK hunits hgraded _ + _ + +end + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Truncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Truncation.lean new file mode 100644 index 0000000000..8fffe264a6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Truncation.lean @@ -0,0 +1,228 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ +public import Mathlib.Topology.MetricSpace.Pseudo.Defs + +import Mathlib.Tactic.Linarith + +/-! +# Berarducci germs at a real exponent + +For a real Hahn series `b` and an exponent `γ`, `Berarducci.translatedTruncation b γ` restricts +`b` to exponents at most `γ` and translates `γ` to zero. Its image in +`Berarducci.Germ K` is `Berarducci.germAt b γ`. + +Two series have the same germ at `γ` exactly when their coefficients agree on an interval +`(η, γ]`. The right endpoint is essential: after translation, a discrepancy at `γ` is a +nonzero constant and therefore does not belong to Berarducci's ideal `J`. + +Berarducci, Remark 6.3: the translated truncation `b^{|γ}` lies in `J` unless `γ` belongs to the +closure of the support of `b`. + +-/ + +universe v + +public noncomputable section + +namespace Berarducci + +open HahnSeries + +variable {K : Type v} [Field K] + +/-- Restrict a real Hahn series at `γ` and translate `γ` to zero, obtaining a nonpositive +series. -/ +def translatedTruncation (b : K⟦ℝ⟧) (γ : ℝ) : Series K := + ⟨HahnSeries.translate (-γ) (HahnSeries.truncLE γ b), by + rw [HahnSeries.mem_nonpositiveSubring] + rw [HahnSeries.support_translate] + rintro δ ⟨x, hx, rfl⟩ + rw [HahnSeries.support_truncLE] at hx + change -γ + x ≤ 0 + linarith [hx.2]⟩ + +/-- The underlying Hahn series of the translated closed truncation. -/ +theorem coe_translatedTruncation (b : K⟦ℝ⟧) (γ : ℝ) : + ((translatedTruncation b γ : Series K) : K⟦ℝ⟧) = + HahnSeries.translate (-γ) (HahnSeries.truncLE γ b) := + (rfl) + +/-- The support of the translated truncation is the translated closed lower support. -/ +theorem support_translatedTruncation (b : K⟦ℝ⟧) (γ : ℝ) : + ((translatedTruncation b γ : Series K) : K⟦ℝ⟧).support = + (-γ + ·) '' {x ∈ b.support | x ≤ γ} := by + simp only [translatedTruncation, HahnSeries.support_translate, HahnSeries.support_truncLE] + +/-- The coefficient at `δ ≤ 0` is the original coefficient at `γ + δ`; all positive +coefficients vanish. -/ +@[simp] +theorem coeff_translatedTruncation (b : K⟦ℝ⟧) (γ δ : ℝ) : + ((translatedTruncation b γ : Series K) : K⟦ℝ⟧).coeff δ = + if δ ≤ 0 then b.coeff (γ + δ) else 0 := by + simp only [translatedTruncation, HahnSeries.coeff_translate, HahnSeries.coeff_truncLE] + have hindex : δ - -γ = γ + δ := by + simp [add_comm] + rw [hindex] + by_cases hδ : δ ≤ 0 + · have hle : γ + δ ≤ γ := by linarith + simp [hδ, hle] + · have hnot : ¬γ + δ ≤ γ := by linarith + simp [hδ, hnot] + +/-- Translated closed truncation preserves addition. -/ +theorem translatedTruncation_add (b c : K⟦ℝ⟧) (γ : ℝ) : + translatedTruncation (b + c) γ = translatedTruncation b γ + translatedTruncation c γ := by + apply Subtype.ext + ext δ + change + ((translatedTruncation (b + c) γ : Series K) : K⟦ℝ⟧).coeff δ = + ((translatedTruncation b γ : Series K) : K⟦ℝ⟧).coeff δ + + ((translatedTruncation c γ : Series K) : K⟦ℝ⟧).coeff δ + rw [coeff_translatedTruncation, coeff_translatedTruncation, coeff_translatedTruncation] + by_cases hδ : δ ≤ 0 <;> simp [hδ] + +/-- Translated closed truncation commutes with multiplication by a constant Hahn series. -/ +theorem translatedTruncation_C_mul (k : K) (b : K⟦ℝ⟧) (γ : ℝ) : + translatedTruncation (HahnSeries.C k * b) γ = + (HahnSeries.Nonpositive.C : K →+* Series K) k * translatedTruncation b γ := by + apply Subtype.ext + ext δ + rw [coeff_translatedTruncation, Subring.coe_mul, HahnSeries.Nonpositive.coe_C] + simp only [HahnSeries.C_mul_eq_smul, HahnSeries.coeff_smul, + coeff_translatedTruncation] + by_cases hδ : δ ≤ 0 <;> simp [hδ] + +/-- Translated closed truncation sends the zero series to zero. -/ +@[simp] +theorem translatedTruncation_zero_input (γ : ℝ) : + translatedTruncation (0 : K⟦ℝ⟧) γ = 0 := by + apply Subtype.ext + ext δ + rw [coeff_translatedTruncation] + simp + +/-- Translated closed truncation at a fixed exponent as an additive homomorphism. -/ +def translatedTruncationAddMonoidHom (γ : ℝ) : K⟦ℝ⟧ →+ Series K where + toFun b := translatedTruncation b γ + map_zero' := translatedTruncation_zero_input γ + map_add' b c := translatedTruncation_add b c γ + +/-- Evaluation of the additive translated-truncation map. -/ +@[simp] +theorem translatedTruncationAddMonoidHom_apply (γ : ℝ) (b : K⟦ℝ⟧) : + translatedTruncationAddMonoidHom γ b = translatedTruncation b γ := + by + rw [translatedTruncationAddMonoidHom] + rfl + +/-- Truncation and translation at zero leave a nonpositive series unchanged. -/ +@[simp] +theorem translatedTruncation_zero (b : Series K) : + translatedTruncation (b : K⟦ℝ⟧) 0 = b := by + apply Subtype.ext + ext δ + rw [coeff_translatedTruncation] + by_cases hδ : δ ≤ 0 + · simp [hδ] + · rw [if_neg hδ] + apply Eq.symm + apply not_ne_iff.mp + rw [← HahnSeries.mem_support] + exact fun hmem ↦ hδ (HahnSeries.Nonpositive.support_subset b hmem) + +/-- The germ at `γ` of the monomial supported at `γ` is represented by its coefficient as a +constant series. -/ +theorem translatedTruncation_single_cut (k : K) (γ : ℝ) : + translatedTruncation (HahnSeries.single γ k) γ = HahnSeries.Nonpositive.C k := by + apply Subtype.ext + ext δ + rw [coeff_translatedTruncation] + by_cases hδ : δ = 0 + · subst δ + simp + · by_cases hδ0 : δ ≤ 0 + · have hsum : γ + δ ≠ γ := by + intro h + apply hδ + exact add_left_cancel (a := γ) (by simpa using h) + simp [hδ0, hsum, hδ] + · simp [hδ0, hδ] + +/-- A translated truncation of a translated truncation is the translated truncation at the sum +of the exponents, when the second exponent is nonpositive: `(b^{|γ})^{|γ'} = b^{|γ + γ'}`. -/ +theorem translatedTruncation_translatedTruncation (b : K⟦ℝ⟧) (γ : ℝ) {γ' : ℝ} (hγ' : γ' ≤ 0) : + translatedTruncation ((translatedTruncation b γ : Series K) : K⟦ℝ⟧) γ' = + translatedTruncation b (γ + γ') := by + apply Subtype.ext + ext δ + simp only [coeff_translatedTruncation] + by_cases hδ : δ ≤ 0 + · simp [hδ, add_nonpos hγ' hδ, add_assoc] + · simp [hδ] + +/-- The Berarducci germ at the real exponent `γ`. -/ +def germAt (b : K⟦ℝ⟧) (γ : ℝ) : Germ K := + toGerm (translatedTruncation b γ) + +/-- Evaluation of the germ at `γ` through the quotient map. -/ +@[simp] +theorem germAt_apply (b : K⟦ℝ⟧) (γ : ℝ) : + germAt b γ = toGerm (translatedTruncation b γ) := + (rfl) + +/-- Two real Hahn series have the same germ at `γ` exactly when their coefficients agree on +some interval `(η, γ]`. -/ +theorem germAt_eq_germAt_iff_exists_coeff_eq {b c : K⟦ℝ⟧} {γ : ℝ} : + germAt b γ = germAt c γ ↔ + ∃ η < γ, ∀ δ : ℝ, η < δ → δ ≤ γ → b.coeff δ = c.coeff δ := by + rw [germAt_apply, germAt_apply, toGerm_eq_toGerm_iff_exists_coeff_eq] + constructor + · rintro ⟨ε, hε, heq⟩ + refine ⟨γ + ε, by linarith, fun δ hεδ hδγ ↦ ?_⟩ + have hshiftLower : ε < δ - γ := by linarith + have hshiftUpper : δ - γ ≤ 0 := by linarith + have h := heq (δ - γ) hshiftLower hshiftUpper + rw [coeff_translatedTruncation, coeff_translatedTruncation, if_pos hshiftUpper, + if_pos hshiftUpper] at h + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using h + · rintro ⟨η, hη, heq⟩ + refine ⟨η - γ, by linarith, fun δ hεδ hδ0 ↦ ?_⟩ + have hLower : η < γ + δ := by linarith + have hUpper : γ + δ ≤ γ := by linarith + rw [coeff_translatedTruncation, coeff_translatedTruncation, if_pos hδ0, if_pos hδ0] + exact heq (γ + δ) hLower hUpper + +/-- A germ taken at a point outside the closure of the support vanishes. -/ +theorem germAt_eq_zero_of_not_mem_closure_support {b : K⟦ℝ⟧} {γ : ℝ} + (h : γ ∉ closure b.support) : germAt b γ = 0 := by + rw [Metric.mem_closure_iff] at h + push Not at h + obtain ⟨ε, hε, hall⟩ := h + have hzero : (0 : Germ K) = toGerm 0 := by simp + rw [germAt_apply, hzero, toGerm_eq_toGerm_iff_exists_coeff_eq] + refine ⟨-ε, by linarith, fun δ hδlow hδ0 ↦ ?_⟩ + rw [coeff_translatedTruncation, if_pos hδ0] + simp only [Subring.coe_zero, HahnSeries.coeff_zero] + by_contra hcoeff + have hmem : γ + δ ∈ b.support := (HahnSeries.mem_support _ _).mpr hcoeff + have hdist := hall (γ + δ) hmem + rw [Real.dist_eq] at hdist + have habs : |γ - (γ + δ)| = -δ := by + rw [show γ - (γ + δ) = -δ by ring, abs_of_nonneg (by linarith)] + rw [habs] at hdist + linarith + +/-- A translated truncation taken at a point outside the closure of the support lies in `J`. -/ +theorem translatedTruncation_mem_negativeMonomialIdeal_of_not_mem_closure_support + {b : K⟦ℝ⟧} {γ : ℝ} (h : γ ∉ closure b.support) : + translatedTruncation b γ ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + have hzero := germAt_eq_zero_of_not_mem_closure_support h + rwa [germAt_apply, toGerm_apply, Ideal.Quotient.eq_zero_iff_mem] at hzero + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/TruncationDrop.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/TruncationDrop.lean new file mode 100644 index 0000000000..cb04802cb3 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/TruncationDrop.lean @@ -0,0 +1,169 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood +public import Mathlib.Topology.Instances.Real.Lemmas + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +public import Mathlib.Topology.MetricSpace.Pseudo.Lemmas + +/-! +# Truncation drop + +If `v_J(a) ≤ ω^β`, then the translated truncations `a^{|γ}` at all cutoffs `γ < 0` +sufficiently close to zero have ordinal value strictly below `ω^β`. + +The proof reads the ordinal value from a sufficiently short support tail. If `a ∈ J + K`, the +translated truncations near zero lie in `J`. Otherwise `1 < v_J(a)`, so `β ≥ 1`, and for a cutoff +`γ` in a tail `(η, 0)` that computes the ordinal value, the support of `a` strictly between `η` +and `γ` is a proper initial segment of the full tail, whose order type is therefore below `ω^β`; +it is also a final segment of the support below `γ`, and bounds the ordinal value of `a^{|γ}`. +-/ + +open Filter Topology +open scoped HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace Berarducci + +open HahnSeries + +variable {K : Type v} [Field K] + +/-- A translated truncation whose support has a gap immediately below the cutoff lies in +`J + K`, hence has ordinal value at most one. -/ +theorem ordinalValue_translatedTruncation_le_one_of_eq_empty + (b : Series K) {η γ : ℝ} (hηγ : η < γ) + (hempty : (b : K⟦ℝ⟧).support ∩ Set.Ioo η γ = ∅) : + ordinalValue (translatedTruncation (b : K⟦ℝ⟧) γ) ≤ 1 := by + by_contra hlt + have hLUB := isLUB_negativeSupport_zero_of_one_lt_ordinalValue (lt_of_not_ge hlt) + obtain ⟨x, ⟨hxSupport, hx0⟩, hηx, _⟩ := hLUB.exists_between (sub_neg.mpr hηγ) + rw [support_translatedTruncation] at hxSupport + obtain ⟨y, ⟨hySupport, hyγ⟩, rfl⟩ := hxSupport + have hy : y ∈ (b : K⟦ℝ⟧).support ∩ Set.Ioo η γ := + ⟨hySupport, by linarith, lt_of_le_of_ne hyγ (by intro h; subst h; simp at hx0)⟩ + rw [hempty] at hy + exact hy + +/-- **Truncation drop.** If `v_J(a) ≤ ω^β`, then `v_J(a^{|γ}) < ω^β` for every cutoff +`γ < 0` sufficiently close to zero. -/ +@[blueprint "lem:truncation-drop" + (phase := "Ordinal value and degree") + (title := "Decrease of the ordinal value under translated truncation") + (statement := /-- + Let $\beta<\omega_1$ and $b\in K((\mathbb R^{\le0}))$. If + $v_J(b)\le\omega^\beta$, then + \[ + v_J(b^{|\gamma})<\omega^\beta + \] + for all $\gamma<0$ sufficiently close to $0$. + -/) + (proof := /-- + If $b\in J+K$, all sufficiently late translated truncations lie in $J$. + Otherwise $1 (cantorBendixsonDegreeValuation (G := G) (R := K)) +local notation "J" => Valuation.supp (cantorBendixsonValuation (G := G) (R := K)) + +variable {ι : Type w} {wt : ι → NatOrdinal.{u}} + {xg : ι → (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded} +variable (σ : LiftFamily wt xg) + +/-- Evaluation at representatives, followed by passage to the quotient by bounded series. -/ +def germAlgHom : MvPolynomial ι K →ₐ[K] Nonpositive G K ⧸ J := + (Ideal.Quotient.mkₐ K J).comp (aeval σ.lift) + +theorem germAlgHom_apply (F : MvPolynomial ι K) : + germAlgHom σ F = Ideal.Quotient.mk J (aeval σ.lift F) := by + rfl + +/-- Generation of the associated graded ring makes evaluation at the lifts surjective on germs. -/ +theorem germAlgHom_surjective + (hgenerate : Function.Surjective + (aeval xg : MvPolynomial ι K →ₐ[K] (ν).AssociatedGraded)) : + Function.Surjective (germAlgHom σ) := by + intro g + obtain ⟨u, rfl⟩ := Ideal.Quotient.mk_surjective g + obtain ⟨α, huα⟩ : ∃ α : NatOrdinal.{u}, ν u < (α : WithBot NatOrdinal) := by + cases hν : ν u with + | bot => exact ⟨0, WithBot.bot_lt_coe 0⟩ + | coe β => exact ⟨β + 1, WithBot.coe_lt_coe.mpr (lt_add_one β)⟩ + obtain ⟨F, -, -, hF⟩ := exists_forall_weight_lt_and_degree_sub_aeval_eq_bot + xg σ.represents α (fun β _ y hy ↦ by + obtain ⟨P, hP⟩ := hgenerate y + exact ⟨weightedHomogeneousComponent wt β P, + weightedHomogeneousComponent_isWeightedHomogeneous (w := wt) (n := β) (φ := P), + (OrdinalGraded.decompose_aeval (𝒜 := DirectSum.rangeLof K (ν).Component) + (fun i ↦ HahnSeries.Nonpositive.Represents.mem_rangeLof (σ.represents i)) P β).symm.trans + (by + rw [hP] + exact DirectSum.decompose_of_mem_same _ hy)⟩) u huα + refine ⟨F, ?_⟩ + rw [germAlgHom_apply, Ideal.Quotient.eq] + rw [mem_cantorBendixsonValuation_supp, + ← cantorBendixsonDegreeValuation_eq_bot_iff] + rw [← neg_sub, MaxAddDegree.map_neg] + exact hF + +/-- Graded injectivity makes evaluation at the lifts injective after passage to germs. -/ +theorem germAlgHom_injective + (hinj : Function.Injective (aeval xg : MvPolynomial ι K →ₐ[K] (ν).AssociatedGraded)) : + Function.Injective (germAlgHom σ) := by + classical + rw [injective_iff_map_eq_zero] + intro F hF + by_contra hF0 + let β := F.support.sup (Finsupp.weight wt) + obtain ⟨d, hd, hβ⟩ := Finset.exists_mem_eq_sup F.support + (MvPolynomial.support_nonempty.mpr hF0) (Finsupp.weight wt) + have hcomponent : weightedHomogeneousComponent wt β F ≠ 0 := by + rw [MvPolynomial.ne_zero_iff] + refine ⟨d, ?_⟩ + rw [coeff_weightedHomogeneousComponent, if_pos hβ.symm] + exact MvPolynomial.mem_support_iff.mp hd + have hgraded : aeval xg (weightedHomogeneousComponent wt β F) ≠ 0 := by + intro h + apply hcomponent + apply hinj + simpa using h + have hdegree : ν (aeval σ.lift F) = (β : WithBot NatOrdinal) := + degree_aeval_eq_of_aeval_weightedHomogeneousComponent_ne_zero xg σ.represents + (fun _ hd' ↦ Finset.le_sup hd') hgraded + rw [germAlgHom_apply, Ideal.Quotient.eq_zero_iff_mem, + mem_cantorBendixsonValuation_supp, + ← cantorBendixsonDegreeValuation_eq_bot_iff] at hF + exact WithBot.coe_ne_bot (hdegree.symm.trans hF) + +/-- Under graded polynomiality and generation, the quotient by series bounded strictly below zero +is a polynomial algebra on the chosen representatives. -/ +def germAlgEquiv + (hindependent : AlgebraicIndependent K xg) + (hgenerate : Function.Surjective + (aeval xg : MvPolynomial ι K →ₐ[K] (ν).AssociatedGraded)) : + MvPolynomial ι K ≃ₐ[K] Nonpositive G K ⧸ J := + AlgEquiv.ofBijective (germAlgHom σ) + ⟨germAlgHom_injective σ (algebraicIndependent_iff_injective_aeval.mp hindependent), + germAlgHom_surjective σ hgenerate⟩ + +/-- The quotient by series bounded strictly below zero is a polynomial ring, hence refines +products, when homogeneous generators are algebraically independent and have representatives. -/ +theorem hasFourFactorRefinement_of_algebraicIndependent_generators + (σ : LiftFamily wt xg) + (hindependent : AlgebraicIndependent K xg) + (hgenerate : Function.Surjective + (aeval xg : MvPolynomial ι K →ₐ[K] (ν).AssociatedGraded)) : + HasFourFactorRefinement (Nonpositive G K ⧸ J) := by + letI : DecompositionMonoid (Nonpositive G K ⧸ J) := + MulEquiv.decompositionMonoid (germAlgEquiv σ hindependent hgenerate).symm.toMulEquiv + exact hasFourFactorRefinement_of_decompositionMonoid + +end HahnSeries.Germ + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/CompleteGermOfCauchyComplete.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/CompleteGermOfCauchyComplete.lean new file mode 100644 index 0000000000..98724e0124 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/CompleteGermOfCauchyComplete.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.CompleteGerm + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Polynomial presentation of a germ ring + +For a Cauchy-complete exponent group, a minimal homogeneous generating system for the +Cantor--Bendixson degree is algebraically independent. Representatives of the generators identify +the quotient by series bounded strictly below zero with a polynomial ring. +-/ + +open Set +open scoped HahnSeries + +universe u v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {K : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + [NoMaxOrder (FiniteArchimedeanClass G)] + [Field K] [CharZero K] + +/-- For an ordered exponent group that is Cauchy complete and has no smallest nonzero magnitude, +the quotient by series supported away from zero is a polynomial algebra. -/ +@[blueprint "thm:complete-hahn-germ-polynomial-algebra" + (phase := "Polynomial presentations") + (title := "Polynomial presentation of the germ ring over a Cauchy-complete exponent group") + (statement := /-- + Let $K$ be a field of characteristic zero and let $G$ be a nontrivial, + densely ordered abelian group with no least or greatest element and with + no least nonzero Archimedean class in the magnitude order. Assume that + $G$ is Cauchy complete for its additive uniformity. If $J$ is the ideal + of series in $K((G^{\le 0}))$ whose support is bounded strictly below zero, + then for some set $I$ there is a $K$-algebra isomorphism + \[ + K[X_i:i\in I]\simeq K((G^{\le 0}))/J. + \] + -/) + (proof := /-- + Applying \ref{lem:extend-to-minimal-system} to the empty family gives a + minimal homogeneous generating system of the associated graded ring of the + Cantor--Bendixson degree. Well-order the nonzero Archimedean classes and + retain each class that is smaller in magnitude than every earlier class. + The resulting family is coinitial in the magnitude order and well-founded + when ordered by reverse magnitude. Its groups $G_{\prec\sigma}$ therefore + form a decreasing neighbourhood basis at zero. Choose + series representing the generators. By + \ref{thm:cantor-bendixson-minimal-generators-independent}, these generators + are algebraically independent. Minimality makes homogeneous evaluation + surjective. Evaluation at the representatives is therefore surjective + modulo $J$, while its highest nonzero weighted-homogeneous component proves + injectivity modulo $J$. + -/)] +theorem exists_mvPolynomial_algEquiv_germ : + ∃ ι : Type (max (u + 1) v), Nonempty + (MvPolynomial ι K ≃ₐ[K] + Nonpositive G K ⧸ (cantorBendixsonValuation (G := G) (R := K)).supp) := by + let ν := cantorBendixsonDegreeValuation (G := G) (R := K) + obtain ⟨ι, weight, generators, hminimal⟩ := OrdinalGraded.exists_isMinimalSystem + (DirectSum.rangeLof K (ν).Component) + obtain ⟨lifts, hlower⟩ := exists_liftFamily_hasLowerTruncationDegrees hminimal.mem + have hindependent : AlgebraicIndependent K generators := + HahnSeries.Germ.algebraicIndependent_of_minimal_system + lifts hminimal hlower + have hgenerate : Function.Surjective (MvPolynomial.aeval generators : + MvPolynomial ι K →ₐ[K] (ν).AssociatedGraded) := + cantorBendixson_ordinalMinimalSystem_aeval_surjective weight generators hminimal + exact ⟨ι, ⟨HahnSeries.Germ.germAlgEquiv lifts hindependent hgenerate⟩⟩ + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/InitialForms.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/InitialForms.lean new file mode 100644 index 0000000000..e198e6e457 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/InitialForms.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.SubalgebraBasis +public import Mathlib.RingTheory.MvPolynomial.WeightedHomogeneous +public import Mathlib.Data.Finsupp.Weight +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeWeightedPolynomial +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.BaseChange + +import Mathlib.Algebra.MvPolynomial.Rename +import Mathlib.RingTheory.MvPolynomial.Tower +import Mathlib.Algebra.MvPolynomial.Basic + +/-! +# The series ring over the finite-support series and `RV̂ ≅ P̂ ⊗_K K_fin` + +Let `K((ℝ^{≤0}))` be the series ring, with the finite-support series `K_fin = K(ℝ^{≤0})`. The +degree is a separated multiplicative degree on `K((ℝ^{≤0}))`, and +`RV̂ = gr_deg K((ℝ^{≤0})) ≅ P̂ ⊗_K K_fin`. This file records the structure map +`K_fin → K((ℝ^{≤0}))`, its degree, and the compatibility of the identification +`RV̂ ≅ P̂ ⊗_K K_fin` with initial forms: `1 ⊗ c` is the initial form of the finite-support series +`c`, and `B ⊗ 1` is the initial form of any series of degree `α` whose class is `B ∈ P_α`. The +lifts of a minimal system of homogeneous generators and the degree formula for polynomials in them +are in `Berarducci.PolynomialRing`. +-/ + +open HahnSeries HahnSeries.Nonpositive Berarducci + +open scoped TensorProduct MaxAddDegree + +universe v + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] [CharZero K] + +omit [CharZero K] in +/-- The structure map `K_fin → K((ℝ^{≤0}))` is the subring inclusion. -/ +theorem algebraMap_finiteSupportRing_apply (c : Berarducci.FiniteSupportRing (K := K)) : + algebraMap (Berarducci.FiniteSupportRing (K := K)) (Nonpositive ℝ K) c = + (c : Nonpositive ℝ K) := (rfl) + +omit [CharZero K] in +/-- A nonzero finite-support series has degree zero, stated for the structure map +`K_fin → K((ℝ^{≤0}))`. -/ +theorem degreeValuation_algebraMap_eq_zero (c : Berarducci.FiniteSupportRing (K := K)) + (hc : c ≠ 0) : + degreeValuation K (algebraMap (Berarducci.FiniteSupportRing (K := K)) (Nonpositive ℝ K) c) = + 0 := + degreeValuation_finiteSupport_eq_zero c hc + +/-- The right tensor factor gives `P̂ ⊗_K K_fin` its canonical `K_fin`-algebra structure. -/ +instance principalSubringTensorFiniteSupportAlgebra : + Algebra (Berarducci.FiniteSupportRing (K := K)) + (PrincipalSubring K ⊗[K] Berarducci.FiniteSupportRing (K := K)) := + Algebra.TensorProduct.rightAlgebra + +/-- The identification `P̂ ⊗_K K_fin ≅ RV̂` sends a finite-support scalar to its initial form. -/ +theorem principalSubringTensorEquiv_one_tmul_eq_initialForm + (c : Berarducci.FiniteSupportRing (K := K)) : + principalSubringTensorEquiv K (1 ⊗ₜ[K] c) = + (degreeValuation K).initialForm + (algebraMap (Berarducci.FiniteSupportRing (K := K)) (Nonpositive ℝ K) c) := by + rw [principalSubringTensorEquiv_one_tmul, finiteSupportGradedEmbedding_eq_initialForm] + rfl + +/-- The identification `P̂ ⊗_K K_fin ≅ RV̂` on a homogeneous pure tensor: `rv(b) ⊗ 1`, for `b` a +principal series of exact degree `α`, maps to the initial form of `b`. -/ +theorem principalSubringTensorEquiv_of_tmul_one_eq_initialForm + {α : NatOrdinal} (b : Nonpositive ℝ K) + (hb : Berarducci.ordinalValue b < ω^ (α + 1)) + (hprin : IsPrincipal b) + (hdeg : ((b : Nonpositive ℝ K) : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) : + principalSubringTensorEquiv K + ((DirectSum.of (Berarducci.PrincipalComponent K) α + (Berarducci.principalComponentMk α b hb)) ⊗ₜ 1) = + (degreeValuation K).initialForm b := by + classical + have hbLe : ((b : Nonpositive ℝ K) : K⟦ℝ⟧).degree ≤ (α : WithBot NatOrdinal) := hdeg.le + -- The homogeneous class corresponds to the degree-graded class of the same representative. + have hclassPrin : Berarducci.IsPrincipalDegreeClass α + (Berarducci.degreeLayerMk α b hbLe) := by + rw [Berarducci.isPrincipalDegreeClass_iff] + exact Or.inr ⟨b, hprin, hdeg, rfl⟩ + have hA : Berarducci.principalComponentToHahnDegreeLayer K α + (Berarducci.principalComponentMk α b hb) = + Berarducci.degreeLayerMk α b hbLe := by + have hproj : Berarducci.degreeLayerToPrincipalComponent K α + (Berarducci.degreeLayerMk α b hbLe) = + Berarducci.principalComponentMk α b hb := + Berarducci.degreeLayerToPrincipalComponent_mk α b hbLe + rw [← hproj] + exact + Berarducci.principalComponentToHahnDegreeLayer_degreeLayerToPrincipalComponent_of_isPrincipal + α _ hclassPrin + change principalSubringTensorEquiv K (_ ⊗ₜ[K] 1) = _ + rw [principalSubringTensorEquiv_tmul_one, Berarducci.principalSubringEmbedding_of, hA] + -- The degree-graded class of the representative is its initial form. + rw [Berarducci.degreeLayerMk_eq_componentMk, ← MaxAddDegree.homogeneousMk_apply, + ← MaxAddDegree.initialForm_eq_homogeneousMk_of_componentMk_ne_zero] + intro h0 + rw [MaxAddDegree.componentMk_eq_zero_iff] at h0 + have hvalue : degreeValuation K b = ((b : Nonpositive ℝ K) : K⟦ℝ⟧).degree := + degreeValuation_apply b + rw [hvalue, hdeg] at h0 + exact lt_irrefl _ h0 + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialPresentation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialPresentation.lean new file mode 100644 index 0000000000..701065ca16 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialPresentation.lean @@ -0,0 +1,352 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.InitialForms +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesPrimality +public import Mathlib.RingTheory.Localization.FractionRing +public import Mathlib.Algebra.Prime.Defs + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeValuation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +import Mathlib.RingTheory.MvPolynomial.Localization +import Mathlib.RingTheory.Polynomial.UniqueFactorization +import Mathlib.RingTheory.Ideal.Quotient.Operations + +/-! +# Polynomial presentations of the series ring and primality + +Let `K((ℝ^{≤0}))` be the series ring, `K_fin = K(ℝ^{≤0})` its series with finite support, and +`L = Frac(K_fin)`. The argument of this file is stated for a *polynomial presentation* +(`IsPolynomialPresentation`) of a `K_fin`-subalgebra `K_fin[b_i : i ∈ ι]` of `K((ℝ^{≤0}))`: +evaluation `K_fin[X_i] → K((ℝ^{≤0})))`, `X_i ↦ b_i`, is injective, a polynomial whose value has +degree at most zero is a constant, and the subalgebra is saturated under the nonzero scalars of +`K_fin`. An irreducible `a = F(b) ∈ K((ℝ^{≤0}))` with `0 < deg a` then generates a prime ideal of +`K_fin[X_i]`: + +* a finite-support divisor of `a` is a unit, since its cofactor would otherwise be a unit and + force `deg a = 0`; +* `F` is irreducible in `L[X_i]`: a factorisation is cleared of denominators, the finite-support + denominator is primal in `K((ℝ^{≤0}))` with finite-support factors, and the degree formula + forces one factor to be a constant; +* `D = K_fin[X_i]/(F)` embeds in `L[X_i]/(F)`, by the same clearing of denominators together with + the saturation of the presented subalgebra; +* `L[X_i]` is a unique factorisation domain, so `L[X_i]/(F)` and hence `D` are domains. + +The presentation used is that of the whole series ring by the lifts of a minimal system of +homogeneous generators of `P̂` (`Berarducci.PolynomialRing`), which rests on the polynomiality +of `P̂`; the primality of every series follows (`Berarducci.Primality`). +-/ + +open HahnSeries HahnSeries.Nonpositive Berarducci +open scoped TensorProduct MaxAddDegree + +universe v w + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] [CharZero K] + +/-! ### Degrees of divisors and units -/ + +/-- The degree of a divisor of a nonzero series is at most the degree of the series. -/ +theorem seriesDegree_le_of_dvd {a c : Nonpositive ℝ K} (hdvd : c ∣ a) (ha : a ≠ 0) : + degreeValuation K c ≤ degreeValuation K a := by + obtain ⟨d, rfl⟩ := hdvd + have hd : d ≠ 0 := fun h ↦ ha (by rw [h, mul_zero]) + rw [(degreeValuation K).map_mul] + calc degreeValuation K c = degreeValuation K c + 0 := (add_zero _).symm + _ ≤ degreeValuation K c + degreeValuation K d := + add_le_add le_rfl ((degreeValuation K).zero_le_degree (degreeValuation_isSeparated K) + (fun _ ↦ bot_le) hd) + +/-- A unit of the series ring has degree zero. -/ +theorem seriesDegree_eq_zero_of_isUnit {b : Nonpositive ℝ K} (hb : IsUnit b) : + degreeValuation K b = 0 := by + rw [degreeValuation_apply, degree_eq_zero_of_isUnit degree_mul hb] + +/-- A divisor of degree at most zero of an irreducible series of positive degree is a unit. -/ +theorem isUnit_of_dvd_of_seriesDegree_le_zero {a u : Nonpositive ℝ K} (ha : Irreducible a) + (haDegree : 0 < degreeValuation K a) (hu : degreeValuation K u ≤ 0) (hdvd : u ∣ a) : + IsUnit u := by + obtain ⟨w, rfl⟩ := hdvd + rcases ha.isUnit_or_isUnit rfl with h | h + · exact h + · exfalso + rw [(degreeValuation K).map_mul, + seriesDegree_eq_zero_of_isUnit h, add_zero] at haDegree + exact absurd (lt_of_lt_of_le haDegree hu) (lt_irrefl _) + +/-! ### Clearing denominators -/ + +/-- The fraction field `L = Frac(K_fin)` of the finite-support series. -/ +abbrev FiniteSupportFractionField : Type v := + FractionRing (Berarducci.FiniteSupportRing (K := K)) + +variable {ι : Type w} + +variable (K ι) in +/-- Extension of coefficients `K_fin[X_i] → L[X_i]`. -/ +abbrev coordinatePolynomialMap : + MvPolynomial ι (Berarducci.FiniteSupportRing (K := K)) →+* + MvPolynomial ι (FiniteSupportFractionField (K := K)) := + MvPolynomial.map (algebraMap (Berarducci.FiniteSupportRing (K := K)) + (FiniteSupportFractionField (K := K))) + +omit [CharZero K] in +variable (K ι) in +/-- Extension of coefficients to the fraction field is injective. -/ +theorem coordinatePolynomialMap_injective : + Function.Injective (coordinatePolynomialMap K ι) := + MvPolynomial.map_injective _ (IsFractionRing.injective _ _) + +omit [CharZero K] in +/-- Every polynomial over `L` becomes a polynomial over `K_fin` after multiplication by a nonzero +finite-support denominator. -/ +theorem exists_C_mul_eq_coordinatePolynomialMap + (q : MvPolynomial ι (FiniteSupportFractionField (K := K))) : + ∃ (u : Berarducci.FiniteSupportRing (K := K)) + (h : MvPolynomial ι (Berarducci.FiniteSupportRing (K := K))), + u ≠ 0 ∧ MvPolynomial.C (algebraMap (Berarducci.FiniteSupportRing (K := K)) + (FiniteSupportFractionField (K := K)) u) * q = coordinatePolynomialMap K ι h := by + letI := MvPolynomial.algebraMvPolynomial (σ := ι) + (R := Berarducci.FiniteSupportRing (K := K)) (S := FiniteSupportFractionField (K := K)) + obtain ⟨⟨h, m⟩, hm⟩ := IsLocalization.surj + ((nonZeroDivisors (Berarducci.FiniteSupportRing (K := K))).map + (MvPolynomial.C (σ := ι))) q + obtain ⟨u, hu, hum⟩ := Submonoid.mem_map.mp m.2 + refine ⟨u, h, nonZeroDivisors.ne_zero hu, ?_⟩ + simp only at hm + rw [MvPolynomial.algebraMap_def, ← hum, MvPolynomial.map_C, mul_comm] at hm + exact hm + +/-! ### Polynomial presentations -/ + +omit [CharZero K] in +/-- A constant `c ∈ K_fin` evaluates to itself under `K_fin[X_i] → K((ℝ^{≤0}))`. -/ +theorem aeval_C_finiteSupport (b : ι → Nonpositive ℝ K) + (c : Berarducci.FiniteSupportRing (K := K)) : + MvPolynomial.aeval b (MvPolynomial.C c) = (c : Nonpositive ℝ K) := + MvPolynomial.aeval_C _ _ + +/-- A family `b : ι → K((ℝ^{≤0}))` is a *polynomial presentation* of the `K_fin`-subalgebra +`K_fin[b_i : i ∈ ι]` it generates: evaluation `K_fin[X_i] → K((ℝ^{≤0}))`, `X_i ↦ b_i`, is +injective, a polynomial whose value has degree at most zero is a constant, and the subalgebra is +saturated under the nonzero scalars of `K_fin`: if `u t ∈ K_fin[b_i]` with `0 ≠ u ∈ K_fin`, then +`t ∈ K_fin[b_i]`. The paper's presentation `S = K_fin[b_B : B ∈ 𝓑]` of the ring of series of +finite degree is one, and so is any presentation of the whole series ring. -/ +structure IsPolynomialPresentation (b : ι → Nonpositive ℝ K) : Prop where + /-- Evaluation `F ↦ F(b)` is injective. -/ + injective : Function.Injective (MvPolynomial.aeval b : MvPolynomial ι + (Berarducci.FiniteSupportRing (K := K)) →ₐ[Berarducci.FiniteSupportRing (K := K)] + Nonpositive ℝ K) + /-- A polynomial whose value has degree at most zero is a constant. -/ + eq_C_of_degree_le_zero : ∀ G : MvPolynomial ι (Berarducci.FiniteSupportRing (K := K)), + degreeValuation K (MvPolynomial.aeval b G) ≤ 0 → G = MvPolynomial.C (MvPolynomial.coeff 0 G) + /-- `K_fin[b_i]` is saturated under the nonzero scalars of `K_fin`. -/ + mem_range_of_mul_mem_range : ∀ (u : Berarducci.FiniteSupportRing (K := K)) (t : Nonpositive ℝ K), + u ≠ 0 → (u : Nonpositive ℝ K) * t ∈ (MvPolynomial.aeval b : MvPolynomial ι + (Berarducci.FiniteSupportRing (K := K)) →ₐ[Berarducci.FiniteSupportRing (K := K)] + Nonpositive ℝ K).range → + t ∈ (MvPolynomial.aeval b : MvPolynomial ι + (Berarducci.FiniteSupportRing (K := K)) →ₐ[Berarducci.FiniteSupportRing (K := K)] + Nonpositive ℝ K).range + +namespace IsPolynomialPresentation + +variable {b : ι → Nonpositive ℝ K} (hb : IsPolynomialPresentation b) +include hb + +/-! ### Constant polynomials -/ + +omit [CharZero K] in +/-- If a nonzero finite-support multiple of `G ∈ L[X_i]` comes from a polynomial over `K_fin` +whose value has degree at most zero, and `G ≠ 0`, then `G` is a unit of `L[X_i]`. -/ +theorem isUnit_of_C_mul_eq_coordinatePolynomialMap + {u : Berarducci.FiniteSupportRing (K := K)} (hu : u ≠ 0) + {G : MvPolynomial ι (FiniteSupportFractionField (K := K))} (hG : G ≠ 0) + {G' : MvPolynomial ι (Berarducci.FiniteSupportRing (K := K))} + (hGG' : MvPolynomial.C (algebraMap (Berarducci.FiniteSupportRing (K := K)) + (FiniteSupportFractionField (K := K)) u) * G = coordinatePolynomialMap K ι G') + (hdeg : degreeValuation K (MvPolynomial.aeval b G') ≤ 0) : IsUnit G := by + rw [hb.eq_C_of_degree_le_zero G' hdeg, coordinatePolynomialMap, MvPolynomial.map_C] at hGG' + have hc : MvPolynomial.coeff 0 G' ≠ 0 := by + intro hc + rw [hc, map_zero, MvPolynomial.C_0, mul_eq_zero, MvPolynomial.C_eq_zero, + map_eq_zero_iff _ (IsFractionRing.injective _ _)] at hGG' + exact hGG'.elim hu hG + have hunit : IsUnit (MvPolynomial.C (algebraMap (Berarducci.FiniteSupportRing (K := K)) + (FiniteSupportFractionField (K := K)) (MvPolynomial.coeff 0 G')) : + MvPolynomial ι (FiniteSupportFractionField (K := K))) := + (isUnit_iff_ne_zero.mpr ((map_ne_zero_iff _ (IsFractionRing.injective _ _)).mpr hc)).map + MvPolynomial.C + rw [← hGG'] at hunit + exact isUnit_of_mul_isUnit_right hunit + +omit hb in +/-- The image of a degree-zero finite-support factor times a unit has degree at most zero. -/ +private theorem seriesDegree_le_zero_of_eq_mul {w u₁ g₁ : Nonpositive ℝ K} + (hw : w = u₁ * g₁) {d : Nonpositive ℝ K} (hd : d ≠ 0) (hd0 : degreeValuation K d = 0) + (hu₁ : u₁ ∣ d) (hg₁ : IsUnit g₁) : degreeValuation K w ≤ 0 := by + rw [hw, (degreeValuation K).map_mul, + seriesDegree_eq_zero_of_isUnit hg₁, add_zero, ← hd0] + exact seriesDegree_le_of_dvd hu₁ hd + +/-! ### Irreducibility over the fraction field -/ + +/-- If `F(b)` is irreducible of positive degree, then `F` is irreducible in `L[X_i]`. -/ +theorem irreducible_coordinatePolynomialMap_of_irreducible_aeval + {F : MvPolynomial ι (Berarducci.FiniteSupportRing (K := K))} + (ha : Irreducible (MvPolynomial.aeval b F)) + (haDegree : 0 < degreeValuation K (MvPolynomial.aeval b F)) : + Irreducible (coordinatePolynomialMap K ι F) := by + have hinj := coordinatePolynomialMap_injective K ι + have hF0 : F ≠ 0 := fun h ↦ ha.ne_zero (by rw [h, map_zero]) + refine ⟨fun hunit ↦ ?_, fun G H hGH ↦ ?_⟩ + · -- a unit would make `a` divide a finite-support series + obtain ⟨G, hG⟩ := hunit.exists_right_inv + obtain ⟨v, h, hv, hvh⟩ := exists_C_mul_eq_coordinatePolynomialMap G + have hmap : coordinatePolynomialMap K ι (MvPolynomial.C v) = + coordinatePolynomialMap K ι (F * h) := by + rw [coordinatePolynomialMap, MvPolynomial.map_C, map_mul, ← hvh, ← mul_assoc, + mul_right_comm, hG, one_mul] + have heq := hinj hmap + have heval : (v : Nonpositive ℝ K) = + MvPolynomial.aeval b F * MvPolynomial.aeval b h := by + rw [← aeval_C_finiteSupport b v, heq, map_mul] + have hdvd : MvPolynomial.aeval b F ∣ (v : Nonpositive ℝ K) := ⟨MvPolynomial.aeval b h, heval⟩ + have hv' : (v : Nonpositive ℝ K) ≠ 0 := fun h0 ↦ hv (Subtype.ext h0) + have hle := seriesDegree_le_of_dvd hdvd hv' + rw [degreeValuation_finiteSupport_eq_zero v hv] at hle + exact absurd (lt_of_lt_of_le haDegree hle) (lt_irrefl _) + · -- clear denominators in a factorisation and use primality of the denominator + obtain ⟨u, G', hu, huG⟩ := exists_C_mul_eq_coordinatePolynomialMap G + obtain ⟨v, H', hv, hvH⟩ := exists_C_mul_eq_coordinatePolynomialMap H + have hmap : coordinatePolynomialMap K ι (MvPolynomial.C (u * v) * F) = + coordinatePolynomialMap K ι (G' * H') := by + rw [map_mul (coordinatePolynomialMap K ι), map_mul (coordinatePolynomialMap K ι), ← huG, + ← hvH, hGH, coordinatePolynomialMap, MvPolynomial.map_C, map_mul, MvPolynomial.C_mul] + ring + have heq := hinj hmap + have heval : ((u * v : Berarducci.FiniteSupportRing (K := K)) : Nonpositive ℝ K) * + MvPolynomial.aeval b F = MvPolynomial.aeval b G' * MvPolynomial.aeval b H' := by + rw [← aeval_C_finiteSupport b (u * v), ← map_mul, heq, map_mul] + have huv : u * v ≠ 0 := mul_ne_zero hu hv + have huv' : ((u * v : Berarducci.FiniteSupportRing (K := K)) : Nonpositive ℝ K) ≠ 0 := + fun h0 ↦ huv (Subtype.ext h0) + have huvdeg : degreeValuation K ((u * v : Berarducci.FiniteSupportRing (K := K)) : + Nonpositive ℝ K) = 0 := degreeValuation_finiteSupport_eq_zero _ huv + obtain ⟨u₁, u₂, hu₁, hu₂, huv₁₂⟩ := + isPrimal_of_mem_finiteSupportSubring (u * v).2 ⟨MvPolynomial.aeval b F, heval.symm⟩ + obtain ⟨g₁, hg₁⟩ := hu₁ + obtain ⟨h₁, hh₁⟩ := hu₂ + have hprod : MvPolynomial.aeval b F = g₁ * h₁ := by + refine mul_left_cancel₀ huv' ?_ + rw [heval, hg₁, hh₁, huv₁₂] + ring + have hu₁dvd : u₁ ∣ ((u * v : Berarducci.FiniteSupportRing (K := K)) : + Nonpositive ℝ K) := ⟨u₂, huv₁₂⟩ + have hu₂dvd : u₂ ∣ ((u * v : Berarducci.FiniteSupportRing (K := K)) : + Nonpositive ℝ K) := ⟨u₁, by rw [huv₁₂, mul_comm]⟩ + have hG0 : G ≠ 0 := fun h0 ↦ hF0 (hinj (by rw [hGH, h0, zero_mul, map_zero])) + have hH0 : H ≠ 0 := fun h0 ↦ hF0 (hinj (by rw [hGH, h0, mul_zero, map_zero])) + rcases ha.isUnit_or_isUnit hprod with h | h + · exact Or.inl (hb.isUnit_of_C_mul_eq_coordinatePolynomialMap hu hG0 huG + (seriesDegree_le_zero_of_eq_mul hg₁ huv' huvdeg hu₁dvd h)) + · exact Or.inr (hb.isUnit_of_C_mul_eq_coordinatePolynomialMap hv hH0 hvH + (seriesDegree_le_zero_of_eq_mul hh₁ huv' huvdeg hu₂dvd h)) + +/-! ### The embedding `K_fin[X_i]/(F) → L[X_i]/(F)` -/ + +/-- If `F(b)` is irreducible of positive degree and a polynomial over `K_fin` becomes a multiple +of `F` over `L`, then it is already a multiple of `F` over `K_fin`. -/ +theorem mem_span_of_coordinatePolynomialMap_mem_span + {F : MvPolynomial ι (Berarducci.FiniteSupportRing (K := K))} + (ha : Irreducible (MvPolynomial.aeval b F)) + (haDegree : 0 < degreeValuation K (MvPolynomial.aeval b F)) + {g : MvPolynomial ι (Berarducci.FiniteSupportRing (K := K))} + (hg : coordinatePolynomialMap K ι g ∈ Ideal.span {coordinatePolynomialMap K ι F}) : + g ∈ Ideal.span {F} := by + have hinj := coordinatePolynomialMap_injective K ι + rw [Ideal.mem_span_singleton] at hg ⊢ + obtain ⟨q, hq⟩ := hg + obtain ⟨u, h, hu, huh⟩ := exists_C_mul_eq_coordinatePolynomialMap q + have hmap : coordinatePolynomialMap K ι (MvPolynomial.C u * g) = + coordinatePolynomialMap K ι (F * h) := by + rw [map_mul, map_mul, coordinatePolynomialMap, MvPolynomial.map_C, ← huh, hq] + ring + have heq := hinj hmap + have heval : (u : Nonpositive ℝ K) * MvPolynomial.aeval b g = + MvPolynomial.aeval b F * MvPolynomial.aeval b h := by + rw [← aeval_C_finiteSupport b u, ← map_mul, heq, map_mul] + have hu' : (u : Nonpositive ℝ K) ≠ 0 := fun h0 ↦ hu (Subtype.ext h0) + -- primality of `u` and the unit property of finite-support divisors of `a` + obtain ⟨u₁, u₂, hu₁, hu₂, hu₁₂⟩ := + isPrimal_of_mem_finiteSupportSubring u.2 ⟨MvPolynomial.aeval b g, heval.symm⟩ + have hu₁unit : IsUnit u₁ := by + refine isUnit_of_dvd_of_seriesDegree_le_zero ha haDegree ?_ hu₁ + rw [← degreeValuation_finiteSupport_eq_zero u hu] + exact seriesDegree_le_of_dvd ⟨u₂, hu₁₂⟩ hu' + obtain ⟨t', ht'⟩ := hu₂ + -- `h(b) = u * t` with `t ∈ K_fin[b_i]`, by saturation + set t : Nonpositive ℝ K := (hu₁unit.unit⁻¹ : Units (Nonpositive ℝ K)) * t' with ht + have hht : MvPolynomial.aeval b h = (u : Nonpositive ℝ K) * t := by + have hinv : u₁ * (hu₁unit.unit⁻¹ : Units (Nonpositive ℝ K)) = 1 := + hu₁unit.mul_val_inv + rw [ht, ht', hu₁₂] + calc u₂ * t' = (u₁ * (hu₁unit.unit⁻¹ : Units (Nonpositive ℝ K))) * (u₂ * t') := by + rw [hinv, one_mul] + _ = u₁ * u₂ * ((hu₁unit.unit⁻¹ : Units (Nonpositive ℝ K)) * t') := by ring + obtain ⟨t'', ht''⟩ := (AlgHom.mem_range _).mp + (hb.mem_range_of_mul_mem_range u t hu (hht ▸ (MvPolynomial.aeval b).mem_range_self h)) + have hh' : h = MvPolynomial.C u * t'' := by + apply hb.injective + rw [map_mul, aeval_C_finiteSupport, ht'', hht] + refine ⟨t'', mul_left_cancel₀ (MvPolynomial.C_ne_zero.mpr hu) ?_⟩ + rw [heq, hh'] + ring + +/-- The ideal `(F) ⊆ K_fin[X_i]` is the contraction of the ideal `(F) ⊆ L[X_i]`. -/ +theorem span_singleton_eq_comap + {F : MvPolynomial ι (Berarducci.FiniteSupportRing (K := K))} + (ha : Irreducible (MvPolynomial.aeval b F)) + (haDegree : 0 < degreeValuation K (MvPolynomial.aeval b F)) : + Ideal.span {F} = + (Ideal.span {coordinatePolynomialMap K ι F}).comap (coordinatePolynomialMap K ι) := by + refine le_antisymm ?_ fun g hg ↦ ?_ + · rw [Ideal.span_le, Set.singleton_subset_iff, SetLike.mem_coe, Ideal.mem_comap] + exact Ideal.subset_span rfl + · exact hb.mem_span_of_coordinatePolynomialMap_mem_span ha haDegree (Ideal.mem_comap.mp hg) + +/-- `D = K_fin[X_i]/(F)` is a domain when `F(b)` is irreducible of positive degree: it embeds in +`L[X_i]/(F)`, and `L[X_i]` is a unique factorisation domain. -/ +theorem quotient_span_singleton_isDomain + {F : MvPolynomial ι (Berarducci.FiniteSupportRing (K := K))} + (ha : Irreducible (MvPolynomial.aeval b F)) + (haDegree : 0 < degreeValuation K (MvPolynomial.aeval b F)) : + IsDomain (MvPolynomial ι (Berarducci.FiniteSupportRing (K := K)) ⧸ Ideal.span {F}) := by + have hirr := hb.irreducible_coordinatePolynomialMap_of_irreducible_aeval ha haDegree + haveI : (Ideal.span {coordinatePolynomialMap K ι F}).IsPrime := + (Ideal.span_singleton_prime hirr.ne_zero).mpr hirr.prime + rw [hb.span_singleton_eq_comap ha haDegree] + exact Ideal.Quotient.isDomain _ + +/-- `F` is prime in `K_fin[X_i]` when `F(b)` is irreducible of positive degree. -/ +theorem prime_of_irreducible_aeval + {F : MvPolynomial ι (Berarducci.FiniteSupportRing (K := K))} + (ha : Irreducible (MvPolynomial.aeval b F)) + (haDegree : 0 < degreeValuation K (MvPolynomial.aeval b F)) : Prime F := by + have hF0 : F ≠ 0 := fun h ↦ ha.ne_zero (by rw [h, map_zero]) + haveI := hb.quotient_span_singleton_isDomain ha haDegree + exact (Ideal.span_singleton_prime hF0).mp + ((Ideal.Quotient.isDomain_iff_prime (Ideal.span {F})).mp inferInstance) + +end IsPolynomialPresentation + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialRing.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialRing.lean new file mode 100644 index 0000000000..d7b1adb032 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialRing.lean @@ -0,0 +1,427 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.InitialForms +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Polynomiality +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.Extension +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.BasisOver +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.BaseChange + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeValuation + +/-! +# The series ring is a polynomial ring over the series with finite support + +Let `K((ℝ^{≤0}))` be the series ring and `K(ℝ^{≤0})` its subring of series with finite support +[LM24, Not. 2.1.5], written `K_fin` below. Let `𝓑` be a minimal system of homogeneous generators +of `P̂` — in Lean the classes `x i`, of degrees `wt i` — and choose series `b_i` with +initial form `x i ⊗ 1` and `deg b_i = wt i` (`GeneratorLifts`): the lifts `b_B` of the minimal +system. +Then evaluation `K_fin[X_i] → K((ℝ^{≤0}))`, `X_i ↦ b_i`, is an isomorphism of `K_fin`-algebras +(`polynomialRingEquiv`), and for a non-zero polynomial `F`, `deg F(b) = deg F` for the grading +`deg X_i = wt i`, with initial form the evaluation in `RV̂` of the homogeneous component of `F` of +largest degree. + +This is the theorem `S = K_fin[b_B : B ∈ 𝓑]` of `FiniteDegreePolynomialRing`, with the ring `S` +of series of finite degree replaced by the whole series ring and the finite-degree part `P̂_{<ω}` +by `P̂`: injectivity is the degree formula, which rests on the polynomiality of `P̂` +(`Berarducci.aeval_injective_of_isMinimalSystem`) through the identification +`RV̂ ≅ P̂ ⊗_K K_fin`, and surjectivity is well-founded induction on the degree, the generators +spanning `P̂` (`OrdinalGraded.IsMinimalSystem.aeval_surjective`). +-/ + +open HahnSeries HahnSeries.Nonpositive Berarducci MvPolynomial OrdinalGraded + +open scoped TensorProduct MaxAddDegree NatOrdinal + +universe v w + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] [CharZero K] +variable {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +/-! ### The lifts `b_i` of the minimal system -/ + +variable (wt x) in +/-- The lifts `b_i` of a family `x i ∈ P_{wt i}` of homogeneous elements of `P̂`: series `b_i` +with `deg b_i = wt i` whose initial form is `x i ⊗ 1` under `P̂ ⊗_K K_fin ≅ RV̂`, that is, +`rv(b_i) = x i`. This is `Berarducci.GeneratorLifts` for an arbitrary family of +homogeneous elements of `P̂` in place of the minimal system `𝓑` of `P̂_{<ω}`. -/ +structure GeneratorLifts where + /-- The series `b_i` lifting `x i`. -/ + lift : ι → Series K + /-- `deg b_i = wt i`. -/ + degree_lift : ∀ i, ((lift i : Series K) : K⟦ℝ⟧).degree = (wt i : WithBot NatOrdinal) + /-- `rv(b_i) = x i`: the initial form of `b_i` is `x i ⊗ 1` under `P̂ ⊗_K K_fin ≅ RV̂`. -/ + initialForm_lift : ∀ i, + principalSubringTensorEquiv K (x i ⊗ₜ[K] 1) = (degreeValuation K).initialForm (lift i) + +/-- Every non-zero homogeneous element of `P_α` is `rv(b)` for a principal series `b` of degree +`α` (Berarducci's principal representatives), so lifts exist for every family of non-zero +homogeneous elements. -/ +theorem exists_generatorLifts (hmem : ∀ i, x i ∈ Berarducci.principalGrading K (wt i)) + (hne : ∀ i, x i ≠ 0) : Nonempty (GeneratorLifts wt x) := by + have h : ∀ i, ∃ b : Series K, ((b : Series K) : K⟦ℝ⟧).degree = (wt i : WithBot NatOrdinal) ∧ + principalSubringTensorEquiv K (x i ⊗ₜ[K] 1) = (degreeValuation K).initialForm b := fun i ↦ by + obtain ⟨a, ha⟩ := (DirectSum.mem_rangeLof_iff K _ _ _).mp (hmem i) + rw [DirectSum.lof_eq_of] at ha + have ha0 : a ≠ 0 := fun h0 ↦ hne i (by rw [← ha, h0, map_zero]) + obtain ⟨b, hb, hprin, hdeg, hmk⟩ := exists_principal_representative_of_ne_zero (wt i) a ha0 + refine ⟨b, hdeg, ?_⟩ + rw [← ha, ← hmk] + exact Berarducci.principalSubringTensorEquiv_of_tmul_one_eq_initialForm b hb hprin hdeg + choose b hdeg hin using h + exact ⟨⟨b, hdeg, hin⟩⟩ + +namespace GeneratorLifts + +variable (σ : GeneratorLifts wt x) + +/-- `deg b_i = wt i`, for the degree as a `MaxAddDegree`. -/ +theorem degreeValuation_lift (i : ι) : + degreeValuation K (σ.lift i) = (wt i : WithBot NatOrdinal) := by + rw [degreeValuation_apply] + exact σ.degree_lift i + +end GeneratorLifts + +/-! ### The evaluation `K_fin[X_i] → P̂ ⊗_K K_fin ≅ RV̂` -/ + +variable (x) in +/-- The evaluation `K_fin[X_i] → P̂ ⊗_K K_fin`, `X_i ↦ x i ⊗ 1`. -/ +def coordinateTensorEval : + MvPolynomial ι (FiniteSupportRing (K := K)) →ₐ[FiniteSupportRing (K := K)] + (PrincipalSubring K ⊗[K] FiniteSupportRing (K := K)) := + aeval fun i ↦ x i ⊗ₜ[K] 1 + +omit [CharZero K] in +/-- The evaluation into `P̂ ⊗_K K_fin` on a variable: `X_i ↦ x i ⊗ 1`. -/ +theorem coordinateTensorEval_X (i : ι) : coordinateTensorEval x (X i) = x i ⊗ₜ[K] 1 := + aeval_X _ _ + +omit [CharZero K] in +/-- The evaluation into `P̂ ⊗_K K_fin` of a constant `c ∈ K_fin` is `1 ⊗ c`. -/ +theorem coordinateTensorEval_C (c : FiniteSupportRing (K := K)) : + coordinateTensorEval x (C c) = (1 : PrincipalSubring K) ⊗ₜ[K] c := by + rw [coordinateTensorEval, aeval_C, Algebra.TensorProduct.right_algebraMap_apply] + +omit [CharZero K] in +/-- The evaluation `K_fin[X_i] → P̂ ⊗_K K_fin` is, as a function, the evaluation at the `x i ⊗ 1` +of `K[X_i] → P̂` after extending scalars to `K_fin`. -/ +theorem coe_coordinateTensorEval : + ⇑(coordinateTensorEval x) = ⇑(aevalTmulOne K (FiniteSupportRing (K := K)) x) := by + funext F + induction F using MvPolynomial.induction_on with + | C c => rw [coordinateTensorEval_C, aevalTmulOne_C] + | add p q hp hq => rw [map_add, map_add, hp, hq] + | mul_X p i hp => rw [map_mul, map_mul, hp, coordinateTensorEval_X, aevalTmulOne_X] + +variable (hx : IsMinimalSystem (Berarducci.principalGrading K) wt x) +include hx + +/-- **The polynomiality of `P̂` over `K_fin`.** The evaluation `K_fin[X_i] → P̂ ⊗_K K_fin` at a +minimal system of homogeneous generators is injective: the generators `x i` remain algebraically +independent after extending scalars to `K_fin`. -/ +theorem coordinateTensorEval_injective : Function.Injective (coordinateTensorEval x) := by + rw [coe_coordinateTensorEval] + exact aevalTmulOne_injective (aeval_injective_of_isMinimalSystem hx) + +omit [CharZero K] in +/-- The evaluation `K_fin[X_i] → P̂ ⊗_K K_fin` at a minimal system of homogeneous generators is +surjective: the generators `x i` generate `P̂` over `K`. -/ +theorem coordinateTensorEval_surjective : Function.Surjective (coordinateTensorEval x) := by + rw [coe_coordinateTensorEval] + exact aevalTmulOne_surjective + (hx.aeval_surjective (Berarducci.principalGrading_gradeZeroScalars K)) + +omit hx + +variable (x) in +/-- The evaluation `K_fin[X_i] → RV̂`, `X_i ↦ rv(b_i) = x i`: the evaluation into `P̂ ⊗_K K_fin` +followed by the identification `P̂ ⊗_K K_fin ≅ RV̂`, as a ring homomorphism. -/ +def gradedCoordinateEval : + MvPolynomial ι (FiniteSupportRing (K := K)) →+* (degreeValuation K).AssociatedGraded := + (principalSubringTensorEquiv K).toRingEquiv.toRingHom.comp (coordinateTensorEval x).toRingHom + +theorem gradedCoordinateEval_apply (F : MvPolynomial ι (FiniteSupportRing (K := K))) : + gradedCoordinateEval x F = principalSubringTensorEquiv K (coordinateTensorEval x F) := + (rfl) + +/-! ### Evaluation at the lifts `b_i` and the degree formula -/ + +variable (σ : GeneratorLifts wt x) + +/-- Evaluation `K_fin[X_i] → K((ℝ^{≤0}))`, `F ↦ F(b)`, at the lifts `b_i`. -/ +def evalAtLifts : + MvPolynomial ι (FiniteSupportRing (K := K)) →ₐ[FiniteSupportRing (K := K)] Series K := + aeval σ.lift + +/-- The evaluation `F ↦ F(b)` unfolded. -/ +theorem evalAtLifts_eq : evalAtLifts σ = aeval σ.lift := (rfl) + +/-- `X_i(b) = b_i`. -/ +theorem evalAtLifts_X (i : ι) : evalAtLifts σ (X i) = σ.lift i := + aeval_X _ _ + +/-- A constant `c ∈ K_fin` evaluates to itself: `c(b) = c`. -/ +theorem evalAtLifts_C (c : FiniteSupportRing (K := K)) : evalAtLifts σ (C c) = (c : Series K) := + aeval_C _ _ + +include hx + +/-- The lifts `b_i` are initial-form coordinates of `K((ℝ^{≤0}))` over `K_fin`: `deg b_i = wt i`, +the non-zero scalars of `K_fin` have degree zero, and the evaluation into `RV̂` is an injective ring +homomorphism sending a constant `c` to `in(c)` and `X_i` to `in(b_i) = rv(b_i)`. -/ +theorem isInitialFormCoordinates : + MaxAddDegree.IsInitialFormCoordinates (degreeValuation K) wt σ.lift + (gradedCoordinateEval x) where + degree_algebraMap := Berarducci.degreeValuation_algebraMap_eq_zero + degree_x := σ.degreeValuation_lift + injective := (principalSubringTensorEquiv K).injective.comp (coordinateTensorEval_injective hx) + map_C c := by + rw [gradedCoordinateEval_apply, coordinateTensorEval_C, + Berarducci.principalSubringTensorEquiv_one_tmul_eq_initialForm] + map_X i := by + rw [gradedCoordinateEval_apply, coordinateTensorEval_X] + exact σ.initialForm_lift i + +/-- `deg F(b) ≤ deg F`, the degree of `F` taken for the grading `deg X_i = wt i` (Mathlib's +`weightedTotalDegree`). -/ +theorem degree_evalAtLifts_le (F : MvPolynomial ι (FiniteSupportRing (K := K))) : + degreeValuation K (evalAtLifts σ F) ≤ + ((weightedTotalDegree wt F : NatOrdinal) : WithBot NatOrdinal) := + (isInitialFormCoordinates hx σ).degree_aeval_le F + +/-- For non-zero `F`, `deg F(b) = deg F` for the grading `deg X_i = wt i`, and the initial form +of `F(b)` is the evaluation in `RV̂` of the homogeneous component of `F` of largest degree. -/ +theorem degree_evalAtLifts_eq_and_initialForm {F : MvPolynomial ι (FiniteSupportRing (K := K))} + (hF : F ≠ 0) : + degreeValuation K (evalAtLifts σ F) = + ((weightedTotalDegree wt F : NatOrdinal) : WithBot NatOrdinal) ∧ + (degreeValuation K).initialForm (evalAtLifts σ F) = + principalSubringTensorEquiv K + (coordinateTensorEval x (weightedHomogeneousComponent wt (weightedTotalDegree wt F) F)) := + (isInitialFormCoordinates hx σ).degree_aeval_eq_and_initialForm hF + +/-- For `G` homogeneous for the grading `deg X_i = wt i`, the initial form of `G(b)` is the +evaluation of `G` in `RV̂`; both sides vanish for `G = 0`. -/ +theorem initialForm_evalAtLifts_of_isWeightedHomogeneous + {G : MvPolynomial ι (FiniteSupportRing (K := K))} {d : NatOrdinal} + (hG : G.IsWeightedHomogeneous wt d) : + (degreeValuation K).initialForm (evalAtLifts σ G) = + principalSubringTensorEquiv K (coordinateTensorEval x G) := + (isInitialFormCoordinates hx σ).initialForm_aeval_of_isWeightedHomogeneous hG + +/-- For non-zero `F`, `deg F(b) = deg F` for the grading `deg X_i = wt i`. -/ +@[blueprint "thm:series-polynomial-degree" + (phase := "Polynomial presentations") + (title := "Weighted degree under evaluation at series lifts") + (statement := /-- + Let $K$ be a field of characteristic zero, and let $(x_i)_{i\in I}$ be a + minimal homogeneous generating system of $\widehat{\mathrm P}$, with + $x_i\in\mathrm P_{w_i}$. For each $i$, choose a series + $b_i\in K((\mathbb R^{\le0}))$ of degree $w_i$ whose initial form is the + image of $x_i\otimes1$ under + $\widehat{\mathrm P}\otimes_KK(\mathbb R^{\le0}) + \simeq\widehat{\mathrm{RV}}$. + + If $0\ne F\in K(\mathbb R^{\le0})[X_i:i\in I]$, then the degree of + $F(b_i)$ equals the weighted total degree of $F$ for + $\deg(X_i)=w_i$. + -/) + (proof := /-- + By \ref{fact:principal-subring-tensor-decomposition}, the associated graded + ring is + $\widehat{\mathrm P}\otimes_KK(\mathbb R^{\le0})$. + \ref{thm:polynomial} makes evaluation at + $(x_i\otimes1)$ injective after scalar extension. The hypotheses on $b_i$ + therefore make their initial forms an initial-form coordinate system. The + top weighted homogeneous component of a non-zero $F$ has non-zero initial + form after evaluation, so the degree of $F(b_i)$ is its weighted degree. + -/)] +theorem degree_evalAtLifts_eq {F : MvPolynomial ι (FiniteSupportRing (K := K))} (hF : F ≠ 0) : + degreeValuation K (evalAtLifts σ F) = + ((weightedTotalDegree wt F : NatOrdinal) : WithBot NatOrdinal) := + (degree_evalAtLifts_eq_and_initialForm hx σ hF).1 + +/-- Evaluation `F ↦ F(b)` is injective: the lifts `b_i` are algebraically independent over +`K_fin`. -/ +@[blueprint "thm:series-lifts-algebraically-independent" + (phase := "Polynomial presentations") + (title := "Algebraic independence of series lifts") + (statement := /-- + Let $K$ be a field of characteristic zero, and let $(x_i)_{i\in I}$ be a + minimal homogeneous generating system of $\widehat{\mathrm P}$, with + $x_i\in\mathrm P_{w_i}$. For each $i$, choose a series + $b_i\in K((\mathbb R^{\le0}))$ of degree $w_i$ whose initial form is the + image of $x_i\otimes1$ under + $\widehat{\mathrm P}\otimes_KK(\mathbb R^{\le0}) + \simeq\widehat{\mathrm{RV}}$. Then evaluation + \[ + K(\mathbb R^{\le0})[X_i:i\in I]\longrightarrow + K((\mathbb R^{\le0})),\qquad X_i\longmapsto b_i, + \] + is injective. + -/) + (proof := /-- + \ref{fact:principal-subring-tensor-decomposition} identifies the associated + graded ring with + $\widehat{\mathrm P}\otimes_KK(\mathbb R^{\le0})$. + By \ref{thm:polynomial}, evaluation at the minimal homogeneous generating + system is injective, and it remains injective after scalar extension. Hence + a non-zero polynomial in the $b_i$ has a non-zero initial form and cannot + evaluate to zero. + -/)] +theorem evalAtLifts_injective : Function.Injective (evalAtLifts σ) := + (isInitialFormCoordinates hx σ).aeval_injective + +/-- A polynomial `G` whose value `G(b)` has degree at most zero is constant: its weighted total +degree is zero, and every generator has positive degree. -/ +theorem eq_C_of_degree_evalAtLifts_le_zero {G : MvPolynomial ι (FiniteSupportRing (K := K))} + (hG : degreeValuation K (evalAtLifts σ G) ≤ 0) : G = C (coeff 0 G) := by + classical + by_cases hzero : G = 0 + · rw [hzero, MvPolynomial.coeff_zero, C_0] + rw [degree_evalAtLifts_eq hx σ hzero, ← WithBot.coe_zero, WithBot.coe_le_coe] at hG + refine MvPolynomial.ext _ _ fun d ↦ ?_ + rw [coeff_C] + split_ifs with hd + · rw [hd] + · by_contra h + have hw : Finsupp.weight wt d = 0 := + le_antisymm ((le_weightedTotalDegree wt (mem_support_iff.mpr h)).trans hG) bot_le + exact hd (eq_zero_of_weight_eq_zero hx.ne_zero hw).symm + +/-! ### Surjectivity: `K((ℝ^{≤0})) = K_fin[b_i]` -/ + +/-- Every element of `RV̂` is a finite sum of initial forms of values `F(b)`: it is the image of a +polynomial under `K_fin[X_i] → P̂ ⊗_K K_fin ≅ RV̂`, and the homogeneous components of that +polynomial evaluate to series whose initial forms are their images. -/ +theorem exists_eq_sum_initialForm_evalAtLifts (g : (degreeValuation K).AssociatedGraded) : + ∃ (κ : Type 1) (_ : Fintype κ) (p : κ → (evalAtLifts σ).range), + g = ∑ k, (degreeValuation K).initialForm (p k : Series K) := by + classical + obtain ⟨F, hF⟩ := coordinateTensorEval_surjective hx ((principalSubringTensorEquiv K).symm g) + set W : Finset NatOrdinal := F.support.image fun s ↦ Finsupp.weight wt s with hW + refine ⟨{m // m ∈ W}, inferInstance, + fun k ↦ ⟨evalAtLifts σ (weightedHomogeneousComponent wt k.1 F), + (evalAtLifts σ).mem_range_self _⟩, ?_⟩ + have hg : g = principalSubringTensorEquiv K (coordinateTensorEval x F) := by + rw [hF, AlgEquiv.apply_symm_apply] + rw [hg] + conv_lhs => rw [eq_sum_weightedHomogeneousComponent wt F] + rw [map_sum, map_sum, ← Finset.sum_coe_sort W] + exact Finset.sum_congr rfl fun (k : {m // m ∈ W}) _ ↦ + (initialForm_evalAtLifts_of_isWeightedHomogeneous hx σ + (weightedHomogeneousComponent_isWeightedHomogeneous k.1 F)).symm + +/-- Evaluation `F ↦ F(b)` is surjective: every series is a polynomial in the lifts `b_i` with +coefficients in `K_fin`, by well-founded induction on the degree. -/ +@[blueprint "thm:series-lifts-generate-series-ring" + (phase := "Polynomial presentations") + (title := "Generation of the series ring by series lifts") + (statement := /-- + Let $K$ be a field of characteristic zero, and let $(x_i)_{i\in I}$ be a + minimal homogeneous generating system of $\widehat{\mathrm P}$, with + $x_i\in\mathrm P_{w_i}$. For each $i$, choose a series + $b_i\in K((\mathbb R^{\le0}))$ of degree $w_i$ whose initial form is the + image of $x_i\otimes1$ under + $\widehat{\mathrm P}\otimes_KK(\mathbb R^{\le0}) + \simeq\widehat{\mathrm{RV}}$. Then every element of + $K((\mathbb R^{\le0}))$ is the value at $(b_i)$ of a polynomial in + $K(\mathbb R^{\le0})[X_i:i\in I]$. + -/) + (proof := /-- + By \ref{fact:principal-subring-tensor-decomposition}, every element of the + associated graded ring comes from a polynomial over + $K(\mathbb R^{\le0})$ in the $x_i\otimes1$. By \ref{thm:polynomial}, its + weighted homogeneous components are the initial forms of the corresponding + values at the $b_i$. Thus every + associated-graded element is a finite sum of initial forms of elements in + the range of evaluation. Apply + \ref{lem:initial-forms-generate-subalgebra} to that range and the separated + degree to conclude that evaluation is surjective. + -/)] +theorem evalAtLifts_surjective : Function.Surjective (evalAtLifts σ) := fun t ↦ + (AlgHom.mem_range _).mp + (MaxAddDegree.mem_of_forall_exists_sum_initialForm (degreeValuation_isSeparated K) + (exists_eq_sum_initialForm_evalAtLifts hx σ) t) + +/-- The polynomial presentation of the series ring: evaluation `X_i ↦ b_i` on `K_fin[X_i]` has +image the whole ring, `K((ℝ^{≤0})) = K_fin[b_i]`. -/ +theorem range_evalAtLifts_eq_top : (evalAtLifts σ).range = ⊤ := + eq_top_iff.mpr fun t _ ↦ (AlgHom.mem_range _).mpr (evalAtLifts_surjective hx σ t) + +/-- **The series ring is a polynomial ring over the series with finite support.** +`K_fin[X_i] ≅ K((ℝ^{≤0}))`, `X_i ↦ b_i`, for the lifts `b_i` of a minimal system of homogeneous +generators of `P̂`. -/ +@[blueprint "thm:hahn-series-polynomial-algebra" + (phase := "Polynomial presentations") + (title := "Polynomial presentation of the series ring") + (statement := /-- + Let $K$ be a field of characteristic zero, and let $(x_i)_{i\in I}$ be a + minimal homogeneous generating system of $\widehat{\mathrm P}$, with + $x_i\in\mathrm P_{w_i}$. For each $i$, choose a series + $b_i\in K((\mathbb R^{\le0}))$ of degree $w_i$ whose initial form is the + image of $x_i\otimes1$ under + $\widehat{\mathrm P}\otimes_KK(\mathbb R^{\le0}) + \simeq\widehat{\mathrm{RV}}$. Evaluation at the $b_i$ is an isomorphism + of $K(\mathbb R^{\le0})$-algebras + \[ + K(\mathbb R^{\le0})[X_i:i\in I]\simeq K((\mathbb R^{\le0})), + \] + sending $X_i$ to $b_i$. + -/) + (proof := /-- + Evaluation is injective by + \ref{thm:series-lifts-algebraically-independent} and surjective by + \ref{thm:series-lifts-generate-series-ring}; hence it defines the stated + algebra isomorphism. + -/) + (highlight)] +def polynomialRingEquiv : + MvPolynomial ι (FiniteSupportRing (K := K)) ≃ₐ[FiniteSupportRing (K := K)] Series K := + AlgEquiv.ofBijective (evalAtLifts σ) ⟨evalAtLifts_injective hx σ, evalAtLifts_surjective hx σ⟩ + +/-- The isomorphism `K_fin[X_i] ≅ K((ℝ^{≤0}))` is `F ↦ F(b)`. -/ +theorem polynomialRingEquiv_apply (F : MvPolynomial ι (FiniteSupportRing (K := K))) : + polynomialRingEquiv hx σ F = evalAtLifts σ F := + (rfl) + +/-- `K((ℝ^{≤0})) ≅ K_fin[X_i]`: the series ring is a polynomial ring over `K_fin` on variables +indexed by a minimal system of homogeneous generators of `P̂`, the inverse of +`polynomialRingEquiv`. -/ +def seriesPolynomialRingEquiv : + Series K ≃ₐ[FiniteSupportRing (K := K)] MvPolynomial ι (FiniteSupportRing (K := K)) := + (polynomialRingEquiv hx σ).symm + +/-- The inverse isomorphism sends `F(b)` back to `F`. -/ +theorem seriesPolynomialRingEquiv_evalAtLifts (F : MvPolynomial ι (FiniteSupportRing (K := K))) : + seriesPolynomialRingEquiv hx σ (evalAtLifts σ F) = F := + (polynomialRingEquiv hx σ).symm_apply_apply F + +omit hx + +/-! ### Existence of a minimal system and of its lifts -/ + +variable (K) in +/-- `P̂` has a minimal system of homogeneous generators, and any such system has lifts: there are +series `b_i` of degrees `wt i` forming a polynomial presentation `K((ℝ^{≤0})) = K_fin[b_i]`. -/ +theorem exists_isMinimalSystem_and_generatorLifts : + ∃ (ι' : Type (max v 1)) (wt' : ι' → NatOrdinal) (x' : ι' → PrincipalSubring K), + IsMinimalSystem (Berarducci.principalGrading K) wt' x' ∧ + Nonempty (GeneratorLifts wt' x') := by + obtain ⟨ι', wt', x', hx⟩ := + exists_isMinimalSystem (Berarducci.principalGrading K) + exact ⟨ι', wt', x', hx, exists_generatorLifts hx.mem hx.apply_ne_zero⟩ + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests.lean new file mode 100644 index 0000000000..0dbee91428 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests.GCDMonoid +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests.PolynomialRing + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests/GCDMonoid.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests/GCDMonoid.lean new file mode 100644 index 0000000000..6bc1b2e157 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests/GCDMonoid.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.GCDMonoid + +/-! +# API checks for greatest common divisors in the series ring + +Pre-Schreier refinement alone does not provide a greatest common divisor for each pair. The first +check extracts exactly that stronger conclusion from the public GCD-domain theorem. The second +specializes it to `(0, a)` and checks both the zero boundary and the orientation of the universal +property: the chosen gcd is associated to `a`. +-/ + +public noncomputable section + +namespace Tests + +open Berarducci + +universe v + +variable {K : Type v} [Field K] [CharZero K] + +/-- Every pair of series has a greatest common divisor. -/ +theorem series_pairwise_gcd_exists (a b : Series K) : + ∃ d : Series K, ∀ e : Series K, e ∣ a ∧ e ∣ b ↔ e ∣ d := by + obtain ⟨inst⟩ := Berarducci.nonemptyGCDMonoid (K := K) + letI : GCDMonoid (Series K) := inst + exact ⟨gcd a b, fun e ↦ (dvd_gcd_iff e a b).symm⟩ + +/-- A gcd of `(0, a)` is associated to `a` and has the expected universal property. -/ +theorem series_gcd_zero_left (a : Series K) : + ∃ d : Series K, (d ∣ a ∧ a ∣ d) ∧ ∀ e : Series K, e ∣ 0 ∧ e ∣ a ↔ e ∣ d := by + obtain ⟨d, hd⟩ := series_pairwise_gcd_exists (0 : Series K) a + refine ⟨d, ⟨?_, ?_⟩, hd⟩ + · exact ((hd d).mpr dvd_rfl).2 + · exact (hd a).mp ⟨dvd_zero _, dvd_rfl⟩ + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests/PolynomialRing.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests/PolynomialRing.lean new file mode 100644 index 0000000000..bcfd91a809 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests/PolynomialRing.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Primality + +/-! +# API checks for the polynomial presentation of the series ring + +The polynomial presentation `K((ℝ^{≤0})) = K_fin[b_i]` of the whole series ring over its subring +`K_fin = K(ℝ^{≤0})` of series with finite support [LM24, Not. 2.1.5], on the lifts `b_i` of a +minimal system of homogeneous generators of `P̂`, differs from the presentation +`S = K_fin[b_B : B ∈ 𝓑]` of the ring of series of finite degree in its scope: there every value +`F(b_𝓑)` has degree below `ω`, here every series, of whatever degree, is a value `F(b)`. The +checks record this separation, the two directions of the isomorphism on the variables, and that +the lifts are not scalars: `b_i` has the positive degree `wt i`, hence infinite support. The +factorisation consequences are recorded on an arbitrary series: every series is primal, and an +irreducible series is prime with no hypothesis on its degree or support. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries HahnSeries.Nonpositive Berarducci OrdinalGraded + +open scoped MaxAddDegree + +universe v w + +variable {K : Type v} [Field K] [CharZero K] +variable {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} +variable (hx : IsMinimalSystem (Berarducci.principalGrading K) wt x) + (σ : GeneratorLifts wt x) +include hx + +/-- Every series of degree at least `ω` is a value `F(b)`: the presentation covers what the +presentation of `S` leaves out. -/ +theorem exists_evalAtLifts_eq_of_omega_le_degree {t : Series K} + (_ : (NatOrdinal.of Ordinal.omega0 : WithBot NatOrdinal) ≤ (t : K⟦ℝ⟧).degree) : + ∃ F : MvPolynomial ι (FiniteSupportRing (K := K)), evalAtLifts σ F = t := + evalAtLifts_surjective hx σ t + +/-- The isomorphism `K_fin[X_i] ≅ K((ℝ^{≤0}))` sends `X_i` to `b_i`. -/ +theorem polynomialRingEquiv_X (i : ι) : polynomialRingEquiv hx σ (MvPolynomial.X i) = σ.lift i := by + rw [polynomialRingEquiv_apply, evalAtLifts_X] + +/-- The inverse isomorphism `K((ℝ^{≤0})) ≅ K_fin[X_i]` sends `b_i` to `X_i`. -/ +theorem seriesPolynomialRingEquiv_lift (i : ι) : + seriesPolynomialRingEquiv hx σ (σ.lift i) = MvPolynomial.X i := by + rw [← evalAtLifts_X σ i, seriesPolynomialRingEquiv_evalAtLifts] + +omit hx in +/-- `deg b_i = wt i`, and `wt i` is positive. -/ +theorem degree_lift_pos (hwt : ∀ i, wt i ≠ 0) (i : ι) : + degreeValuation K (σ.lift i) = (wt i : WithBot NatOrdinal) ∧ + 0 < degreeValuation K (σ.lift i) := by + refine ⟨σ.degreeValuation_lift i, ?_⟩ + rw [σ.degreeValuation_lift i, ← WithBot.coe_zero, WithBot.coe_lt_coe] + exact pos_iff_ne_zero.mpr (hwt i) + +/-- A lift `b_i` has infinite support: the presentation is not the scalar ring `K_fin`. -/ +theorem lift_support_infinite (i : ι) : ¬ ((σ.lift i : Series K) : K⟦ℝ⟧).support.Finite := by + intro hfin + have hle : degreeValuation K (σ.lift i) ≤ 0 := by + rw [degreeValuation_apply] + exact HahnSeries.degree_le_zero_iff.mpr hfin + exact absurd (lt_of_lt_of_le (degree_lift_pos σ hx.ne_zero i).2 hle) (lt_irrefl _) + +omit hx + +/-- Every series is primal, with no hypothesis on its degree or support. -/ +theorem isPrimal' (a : Series K) : IsPrimal a := + Berarducci.isPrimal a + +/-- An irreducible series of degree at least `ω` is prime: the hypothesis `deg a < ω` of the +finite-degree theorem is gone. -/ +theorem prime_of_irreducible_of_omega_le_degree {a : Series K} (ha : Irreducible a) + (_ : (NatOrdinal.of Ordinal.omega0 : WithBot NatOrdinal) ≤ (a : K⟦ℝ⟧).degree) : Prime a := + prime_of_irreducible ha + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality.lean new file mode 100644 index 0000000000..deee39588f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality.lean @@ -0,0 +1,15 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Consequences +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.DegreeOne +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.GCDMonoid +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.OrdinalValueQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Primality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Random +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.SupportOrderTypeFactorization + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Consequences.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Consequences.lean new file mode 100644 index 0000000000..58e7cd8e32 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Consequences.lean @@ -0,0 +1,227 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Polynomiality +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.Extension +public import Mathlib.RingTheory.Polynomial.UniqueFactorization + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalGraded +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFraction + +/-! +# Consequences of the polynomiality of `P̂` + +By the polynomiality of `P̂`, evaluation `K[X_B : B ∈ 𝓑] → P̂` at a minimal system `𝓑` of +homogeneous generators is injective (`Berarducci.aeval_injective_of_isMinimalSystem`), and it +is surjective since the generators span. Hence: + +* `P̂` is a polynomial algebra over `K` on any minimal system of homogeneous generators + (`algEquivOfIsMinimalSystem`), so `P̂` is a unique factorisation domain; +* every family of homogeneous elements of positive degrees whose members of each degree `β` are + linearly independent modulo `(P̂_+)² ∩ P_β` (the decomposable elements, `decomposableAt`) is + algebraically independent: it extends to a minimal system of homogeneous generators + (`OrdinalGraded.exists_isMinimalSystem_extension`); +* at an additively principal degree `ω^γ` the space `(P̂_+)² ∩ P_{ω^γ}` is zero — no two nonzero + degrees have natural sum `ω^γ` — so every `K`-linearly independent family in `P_{ω^γ}`, in + particular every `K`-basis of `P_ω`, is algebraically independent in `P̂`; +* every nonzero element of `P_{ω^γ}` is prime in `P̂`, being a variable of a polynomial + presentation: the analogue at every additively principal degree of [LM24, Cor. 7.2.8], principal + elements of degree one are prime. +-/ + +universe u v w o + +open scoped NatOrdinal +open MvPolynomial OrdinalGraded Berarducci + +public noncomputable section + +namespace OrdinalGraded + +variable {E : Type u} {R : Type v} [Field E] [CommRing R] [Algebra E R] +variable (𝒜 : NatOrdinal.{o} → Submodule E R) + +/-- At an additively principal degree `ω^γ` the square of the ideal of positive degree has zero +component, `(A_+)² ∩ A_{ω^γ} = 0`: two nonzero degrees have natural sum below `ω^γ` or above it. -/ +theorem decomposableAt_wpow_eq_bot (γ : NatOrdinal.{o}) : decomposableAt 𝒜 (ω^ γ) = ⊥ := by + refine le_bot_iff.mp (decomposableAt_le 𝒜 fun i j hi hj hij ↦ ?_) + exfalso + have hi' : i < ω^ γ := by + rw [← hij]; exact lt_add_of_pos_right i (pos_iff_ne_zero.mpr hj) + have hj' : j < ω^ γ := by + rw [← hij]; exact lt_add_of_pos_left j (pos_iff_ne_zero.mpr hi) + exact (NatOrdinal.add_lt_wpow hi' hj').ne hij + +end OrdinalGraded + +namespace MvPolynomial + +variable {σ : Type*} {R : Type*} [CommRing R] [IsDomain R] + +/-- A variable is prime in a polynomial ring over a domain: separating it, the ring is +`R[X_j : j ≠ i][X_i]`, where `X_i` is prime. -/ +theorem prime_X (i : σ) : Prime (X i : MvPolynomial σ R) := by + classical + let e : MvPolynomial σ R ≃ₐ[R] Polynomial (MvPolynomial {j // j ≠ i} R) := + (renameEquiv R (Equiv.optionSubtypeNe i).symm).trans (optionEquivLeft R {j // j ≠ i}) + have he : e (X i) = Polynomial.X := by + simp only [e, AlgEquiv.trans_apply, renameEquiv_apply, rename_X, + Equiv.optionSubtypeNe_symm_self, optionEquivLeft_X_none] + rw [← MulEquiv.prime_iff e, he] + exact Polynomial.prime_X + +end MvPolynomial + +namespace Berarducci + +variable {K : Type v} [Field K] [CharZero K] {ι : Type w} {wt : ι → NatOrdinal} + {x : ι → PrincipalSubring K} + +/-! ### `P̂` is a polynomial algebra -/ + +/-- Evaluation at any minimal homogeneous generating system gives a polynomial presentation of +`P̂` over `K`. -/ +@[expose, blueprint "cor:principal-subring-polynomial-algebra" + (phase := "Polynomial presentations") + (title := "Polynomial presentation of $\\Ph$") + (statement := /-- + Let $K$ be a field of characteristic $0$, and let + $\calB=(B_i)_{i\in I}$ be a minimal homogeneous generating system of + $\Ph$. Evaluation $X_i\mapsto B_i$ is a $K$-algebra isomorphism + $K[X_i:i\in I]\simeq\Ph$. + -/) + (proof := /-- + Principal representatives identify $\Prin_0$ with $K$. The homogeneous + generation theorem then makes evaluation at $\calB$ surjective, while + \ref{thm:polynomial} makes it injective. Hence + evaluation is a $K$-algebra isomorphism. + -/)] +def algEquivOfIsMinimalSystem (hx : IsMinimalSystem (principalGrading K) wt x) : + MvPolynomial ι K ≃ₐ[K] PrincipalSubring K := + AlgEquiv.ofBijective (aeval x) + ⟨aeval_injective_of_isMinimalSystem hx, + hx.aeval_surjective (principalGrading_gradeZeroScalars K)⟩ + +theorem algEquivOfIsMinimalSystem_apply (hx : IsMinimalSystem (principalGrading K) wt x) + (F : MvPolynomial ι K) : algEquivOfIsMinimalSystem hx F = aeval x F := + rfl + +/-- `P̂` is a unique factorisation domain: it is a polynomial algebra over the field `K`. -/ +instance : UniqueFactorizationMonoid (PrincipalSubring K) := by + obtain ⟨ι', wt', x', hx⟩ := exists_isMinimalSystem (principalGrading K) + exact (algEquivOfIsMinimalSystem hx).toMulEquiv.uniqueFactorizationMonoid inferInstance + +/-! ### Algebraic independence of independent homogeneous families -/ + +/-- An indexed homogeneous family of positive degrees that is linearly independent degree by +degree modulo `(P̂_+)²` is algebraically independent. -/ +@[blueprint "cor:independent-homogeneous-family" + (phase := "Polynomial presentations") + (title := "Algebraic independence of homogeneous families in $\\Ph$") + (statement := /-- + Let $K$ be a field of characteristic $0$, and let $(x_i)_{i\in I}$ be a + family in $\Ph$ with positive weights $w_i$ and + $x_i\in\Prin_{w_i}$. Suppose that for every $\beta$, the images of the + indexed subfamily $(x_i)_{w_i=\beta}$ in + $\Prin_\beta/((\Ph_+)^2\cap\Prin_\beta)$ are $K$-linearly independent. + Then evaluation $X_i\mapsto x_i$ is injective; equivalently, $(x_i)$ is + algebraically independent over $K$. + -/) + (proof := /-- + \ref{lem:extend-to-minimal-system} enlarges the given + indexed family, degree by degree, to a minimal homogeneous generating system. + \ref{thm:polynomial} makes this extended system + algebraically independent. Algebraic independence passes to the original + indexed subfamily. + -/)] +theorem aeval_injective_of_independent_mod_decomposableAt (hwt : ∀ i, wt i ≠ 0) + (hmem : ∀ i, x i ∈ principalGrading K (wt i)) + (hind : ∀ (β : NatOrdinal) (c : ι →₀ K), (∀ i ∈ c.support, wt i = β) → + Finsupp.linearCombination K x c ∈ decomposableAt (principalGrading K) β → c = 0) : + Function.Injective (aeval x : MvPolynomial ι K →ₐ[K] PrincipalSubring K) := by + obtain ⟨ι', wt', x', e, he, -, hx', hmin⟩ := + exists_isMinimalSystem_extension (principalGrading K) hwt hmem hind + intro F G hFG + apply rename_injective e he + apply aeval_injective_of_isMinimalSystem hmin + have hxe : x' ∘ e = x := funext hx' + rw [aeval_rename, aeval_rename, hxe] + exact hFG + +/-- Every `K`-linearly independent family in an additively principal degree `P_{ω^γ}` is +algebraically independent in `P̂`. -/ +@[blueprint "cor:principal-degree-linear-independence" + (phase := "Polynomial presentations") + (title := "Algebraic independence in additively principal degree") + (statement := /-- + Let $K$ be a field of characteristic $0$ and $\gamma<\omega_1$. Every + $K$-linearly independent family $(x_i)_{i\in I}$ in + $\Prin_{\omega^\gamma}$ is algebraically independent over $K$ in $\Ph$. + -/) + (proof := /-- + No two positive degrees have Hessenberg's natural sum $\omega^\gamma$, so the + decomposable subspace in that degree is zero. Linear independence therefore + gives independence modulo $(\Ph_+)^2$. Then + \ref{cor:independent-homogeneous-family} gives algebraic independence. + -/)] +theorem aeval_injective_of_linearIndependent_of_mem_principalGrading_wpow + (γ : NatOrdinal) + (hmem : ∀ i, x i ∈ principalGrading K (ω^ γ)) (hli : LinearIndependent K x) : + Function.Injective (aeval x : MvPolynomial ι K →ₐ[K] PrincipalSubring K) := + aeval_injective_of_independent_mod_decomposableAt + (wt := fun _ ↦ ω^ γ) (fun _ ↦ (NatOrdinal.wpow_pos γ).ne') hmem fun β c hc hdec ↦ by + rcases c.support.eq_empty_or_nonempty with h | ⟨i, hi⟩ + · exact Finsupp.support_eq_empty.mp h + · obtain rfl : β = ω^ γ := (hc i hi).symm + rw [decomposableAt_wpow_eq_bot, Submodule.mem_bot] at hdec + exact linearIndependent_iff.mp hli c hdec + +/-! ### Homogeneous elements of an additively principal degree are prime -/ + +/-- Every nonzero element of an additively principal degree `P_{ω^γ}` is prime in `P̂`. This is +the analogue at every additively principal degree of [LM24, Cor. 7.2.8], which treats degree one. -/ +@[blueprint "cor:prime-at-principal-degree" + (phase := "Polynomial presentations") + (title := "Prime elements of additively principal degree") + (statement := /-- + Let $K$ be a field of characteristic $0$ and $\gamma<\omega_1$. Every + nonzero element of $\Prin_{\omega^\gamma}$ is prime in $\Ph$. + -/) + (proof := /-- + No two positive degrees have Hessenberg's natural sum $\omega^\gamma$, so the + decomposable subspace in that degree is zero and the nonzero singleton $y$ + is independent modulo it. By \ref{lem:extend-to-minimal-system}, this + singleton extends to a minimal homogeneous generating system. By + \ref{cor:principal-subring-polynomial-algebra}, $y$ corresponds to one of the + polynomial variables, which is prime; the isomorphism therefore makes $y$ prime + in $\Ph$. + -/)] +theorem prime_of_mem_principalGrading_wpow {γ : NatOrdinal} {y : PrincipalSubring K} + (hy : y ∈ principalGrading K (ω^ γ)) (hy0 : y ≠ 0) : Prime y := by + obtain ⟨ι', wt', x', e, -, -, hx', hmin⟩ := + exists_isMinimalSystem_extension (principalGrading K) (wt := fun _ : Unit ↦ ω^ γ) + (x := fun _ ↦ y) (fun _ ↦ (NatOrdinal.wpow_pos γ).ne') (fun _ ↦ hy) fun β c hc hdec ↦ by + rcases c.support.eq_empty_or_nonempty with h | ⟨i, hi⟩ + · exact Finsupp.support_eq_empty.mp h + · obtain rfl : β = ω^ γ := (hc i hi).symm + rw [decomposableAt_wpow_eq_bot, Submodule.mem_bot, Finsupp.linearCombination_unique, + smul_eq_zero] at hdec + have h0 : c default = 0 := hdec.resolve_right hy0 + exact Finsupp.ext fun u ↦ by rw [Subsingleton.elim u default, h0, Finsupp.zero_apply] + have hX : algEquivOfIsMinimalSystem hmin (X (e ())) = y := by + rw [algEquivOfIsMinimalSystem_apply, aeval_X, hx'] + rw [← hX] + exact (MulEquiv.prime_iff (algEquivOfIsMinimalSystem hmin)).mpr (MvPolynomial.prime_X _) + +/-- Every nonzero element of `P_{ω^γ}` is irreducible in `P̂`. -/ +theorem irreducible_of_mem_principalGrading_wpow {γ : NatOrdinal} {y : PrincipalSubring K} + (hy : y ∈ principalGrading K (ω^ γ)) (hy0 : y ≠ 0) : Irreducible y := + (prime_of_mem_principalGrading_wpow hy hy0).irreducible + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/DegreeOne.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/DegreeOne.lean new file mode 100644 index 0000000000..6efab445ca --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/DegreeOne.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Primality +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialPresentation + +/-! +# Primes of degree one + +A series of degree one is prime exactly when it has no non-unit divisor with finite support. +Primality below degree `ω` makes such a series primal, and a factorisation into two non-units +would, by the degree formula, give one factor of degree zero, that is, of finite support; an +irreducible primal element is prime. Conversely a prime is irreducible, so in `b = p q` with `p` +of finite support one factor is a unit, and it is not `q`: that would force `deg b = deg p = 0`. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +public section + +namespace Berarducci + +open Berarducci HahnSeries HahnSeries.Nonpositive + +variable {K : Type v} [Field K] [CharZero K] + +/-- An ordinal (in `NatOrdinal`) at most `1` is `0` or `1`. -/ +private theorem natOrdinal_eq_zero_or_one_of_le_one {a : NatOrdinal} (h : a ≤ 1) : + a = 0 ∨ a = 1 := + Order.le_one_iff.mp h + +/-- A series of degree one is prime if and only if every finite-support divisor of it is a unit. -/ +@[blueprint "cor:degree-one" + (phase := "Primality and factorisation for real exponents") + (title := "Primality criterion for series of degree one") + (statement := /-- + Let $K$ be a field of characteristic $0$ and + $b\in K((\mathbb R^{\le 0}))$ a series with $\deg(b)=1$. Then $b$ is prime + in $K((\mathbb R^{\le 0}))$ if and only if every divisor of $b$ with finite + support is a unit. + -/) + (proof := /-- + Suppose first that $b$ is prime and write $b=pq$ with $p$ of finite support. + Irreducibility makes $p$ or $q$ a unit. If $q$ were a unit, multiplicativity + of the degree would give $\deg(p)=1$, contradicting the finite support of $p$; + hence $p$ is a unit. Conversely, assume that every finite-support divisor of + $b$ is a unit. In a factorisation $b=cd$ into nonzero factors, degree + multiplicativity gives $\deg(c)+\deg(d)=1$, so one factor has degree $0$ and + therefore finite support. The hypothesis makes that factor a unit, proving + that $b$ is irreducible. Every series is primal by + \ref{thm:hahn-series-primality}, so $b$ is prime. + -/)] +theorem prime_iff_of_degree_eq_one {b : Series K} + (hb : (b : K⟦ℝ⟧).degree = (1 : NatOrdinal)) : + Prime b ↔ ∀ p : Series K, p ∣ b → (p : K⟦ℝ⟧).support.Finite → IsUnit p := by + have hb0 : b ≠ 0 := fun h ↦ by + rw [h] at hb; simp at hb + have hbdeg : degreeValuation K b = (1 : NatOrdinal) := by rw [degreeValuation_apply, hb] + constructor + · -- a prime is irreducible, so in `b = p q` one factor is a unit; it is not `q`, since then + -- `deg b = deg p = 0` + intro hprime p hpb hpfin + obtain ⟨q, rfl⟩ := hpb + refine (hprime.irreducible.isUnit_or_isUnit rfl).resolve_right fun hq ↦ ?_ + have hpdeg : degreeValuation K p ≤ 0 := by + rw [degreeValuation_apply]; exact degree_le_zero_iff.mpr hpfin + have hmul := (degreeValuation K).map_mul p q + rw [hbdeg, seriesDegree_eq_zero_of_isUnit hq, add_zero] at hmul + exact absurd (hmul ▸ hpdeg) (by simp) + · intro hdiv + have hprimal : IsPrimal b := Berarducci.isPrimal b + refine Irreducible.prime_of_isPrimal ⟨fun hu ↦ ?_, fun c d hcd ↦ ?_⟩ hprimal + · have := seriesDegree_eq_zero_of_isUnit hu + rw [hbdeg] at this + exact absurd this (by simp) + · -- a factorisation `b = c d` into non-units has a factor of degree zero + by_contra hnot + push Not at hnot + have hc0 : c ≠ 0 := fun h ↦ hb0 (by rw [hcd, h, zero_mul]) + have hd0 : d ≠ 0 := fun h ↦ hb0 (by rw [hcd, h, mul_zero]) + have hsum : degreeValuation K c + degreeValuation K d = (1 : NatOrdinal) := by + rw [← (degreeValuation K).map_mul, ← hcd, hbdeg] + obtain ⟨γ, hγ⟩ := WithBot.ne_bot_iff_exists.mp + ((degreeValuation K).map_ne_bot_of_ne_zero (degreeValuation_isSeparated K) hc0) + obtain ⟨δ, hδ⟩ := WithBot.ne_bot_iff_exists.mp + ((degreeValuation K).map_ne_bot_of_ne_zero (degreeValuation_isSeparated K) hd0) + rw [← hγ, ← hδ, ← WithBot.coe_add, WithBot.coe_inj] at hsum + have hγle : γ ≤ 1 := hsum ▸ (NatOrdinal.le_add_right : γ ≤ γ + δ) + have hδle : δ ≤ 1 := hsum ▸ (NatOrdinal.le_add_left : δ ≤ γ + δ) + -- the factor of degree zero has finite support, hence is a unit by hypothesis + have hfin : ∀ {x : Series K}, degreeValuation K x = (0 : NatOrdinal) → + (x : K⟦ℝ⟧).support.Finite := fun hx ↦ by + rw [degreeValuation_apply] at hx + exact degree_le_zero_iff.mp hx.le + rcases natOrdinal_eq_zero_or_one_of_le_one hγle with hγ0 | hγ1 + · exact hnot.1 (hdiv c (Dvd.intro d hcd.symm) (hfin (by rw [← hγ, hγ0]))) + · rcases natOrdinal_eq_zero_or_one_of_le_one hδle with hδ0 | hδ1 + · exact hnot.2 (hdiv d (Dvd.intro_left c hcd.symm) (hfin (by rw [← hδ, hδ0]))) + · rw [hγ1, hδ1] at hsum + exact absurd (add_left_cancel (a := (1 : NatOrdinal)) (hsum.trans (add_zero 1).symm)) + one_ne_zero + +end Berarducci + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/GCDMonoid.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/GCDMonoid.lean new file mode 100644 index 0000000000..f1b0f8b4ef --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/GCDMonoid.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialRing +public import Mathlib.Algebra.GCDMonoid.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.GCDMonoid +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalizedGCD + +/-! +# Greatest common divisors in the series ring + +The polynomial presentation identifies `K((ℝ^{≤0}))` with an arbitrary-variable polynomial +ring over its finite-support subring `K_fin`. LM24, Fact 2.5.2 makes `K_fin` a GCD domain, and +the multivariate Gauss theorem in +`ConwayRefinement.Algebra.MvPolynomial.GCDMonoid` transfers greatest common divisors +to the polynomial ring. The presentation then transports them to the +series ring. +-/ + +open HahnSeries HahnSeries.Nonpositive Berarducci MvPolynomial OrdinalGraded + +universe v w + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] [CharZero K] +variable {ι : Type w} {wt : ι → NatOrdinal} {x : ι → PrincipalSubring K} + +/-- A polynomial presentation supplied by a particular minimal system and its lifts transports +greatest common divisors from the corresponding polynomial ring to the series ring. -/ +theorem GeneratorLifts.nonemptyGCDMonoid + (hx : IsMinimalSystem (principalGrading K) wt x) (σ : GeneratorLifts wt x) : + Nonempty (GCDMonoid (Series K)) := by + letI : Nonempty (NormalizedGCDMonoid (FiniteSupportRing (K := K))) := + nonemptyNormalizedGCDMonoid_finiteSupport + letI : Nonempty (GCDMonoid (MvPolynomial ι (FiniteSupportRing (K := K)))) := + MvPolynomial.nonemptyGCDMonoid + exact MulEquiv.nonemptyGCDMonoid (polynomialRingEquiv hx σ).symm.toMulEquiv + +/-- The nonpositive real series ring over a characteristic-zero field is a GCD domain. The result +is stated through `Nonempty` because `GCDMonoid` contains a choice of gcd operation. -/ +@[blueprint "thm:hahn-series-gcd-domain" + (phase := "Primality and factorisation for real exponents") + (title := "Greatest common divisors in $K((\\mathbb R^{\\le 0}))$") + (statement := /-- + Let $K$ be a field of characteristic $0$. The ring + $K((\mathbb R^{\le 0}))$ of generalised power series with nonpositive real + exponents is a GCD domain. + -/) + (proof := /-- + By \ref{lem:extend-to-minimal-system}, choose a minimal homogeneous generating + system of $\widehat{\mathrm P}$ together with principal-series representatives + of its generators. By \ref{thm:hahn-series-polynomial-algebra}, + $K((\mathbb R^{\le 0}))$ is a polynomial ring over the finite-support + subring $K(\mathbb R^{\le 0})$. By \ref{fact:finite-support-hahn-gcd}, + the coefficient ring is a GCD domain. Normalising each nonzero greatest + common divisor by the coefficient of $t^{\sup(p)}$ supplies the hypothesis + required by \ref{lem:multivariate-polynomial-gcd}. Transport the + resulting gcd operation across the isomorphism. + -/) + (highlight)] +theorem nonemptyGCDMonoid : Nonempty (GCDMonoid (Series K)) := by + obtain ⟨ι, wt, x, hx, ⟨σ⟩⟩ := exists_isMinimalSystem_and_generatorLifts K + exact σ.nonemptyGCDMonoid hx + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/OrdinalValueQuotient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/OrdinalValueQuotient.lean new file mode 100644 index 0000000000..8a81dfbb52 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/OrdinalValueQuotient.lean @@ -0,0 +1,250 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Consequences +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue + +/-! +# The ordinal-value quotient by `J` is a polynomial algebra + +Let `K((ℝ^{≤0}))/J` be Berarducci's quotient ring (`Berarducci.Germ`). For a minimal system of +homogeneous generators `Y` of `P̂` with lifts `b_B`, the map `K[X_B] → K((ℝ^{≤0}))/J`, +`F ↦ F(b_𝓑) + J`, is a homomorphism of `K`-algebras. It is surjective: every series `u` is +congruent modulo `J` to a value `F(b_𝓑)`, namely to that of its polynomial `pol(u)` +(`Lifts.exists_degreeLT_toGerm_aeval_eq`). It is injective: for `F ≠ 0` the ordinal value of +`F(b_𝓑)` is `ω^{deg F}`, the degree formula, which rests on Conjecture (P); so `F(b_𝓑) ∉ J`. +Hence `K((ℝ^{≤0}))/J ≃ K[X_B] ≃ P̂` (`Lifts.ordinalValueQuotientAlgEquiv`), the class of a series +`u` of ordinal value below `ω^α` going to `pol(u)`, and the quotient admits unique factorisation. +This is the conjecture of Berarducci as stated in [LM17, Conjecture 1.5]: every nonzero germ +admits a unique factorisation into irreducibles. + +The classes of the series of ordinal value below `ω^α` are the classes of the values `F(b_𝓑)` with +every monomial of `F` of degree below `α` (`Lifts.toGerm_image_ordinalValue_lt_eq`). +-/ + +universe v w + +open scoped NatOrdinal +open MvPolynomial OrdinalGraded Berarducci HahnSeries.Nonpositive + +public noncomputable section + +namespace NatOrdinal + +/-- Every ordinal lies below `ω^(α + 1)`. -/ +theorem lt_wpow_add_one_self (a : NatOrdinal) : a < ω^ (a + 1) := by + have h : a ≤ ω^ a := + NatOrdinal.of.le_iff_le.mpr (Ordinal.right_le_opow a.val Ordinal.one_lt_omega0) + exact h.trans_lt (wpow_lt_wpow.mpr (lt_add_one a)) + +end NatOrdinal + +namespace Berarducci + +variable {K : Type v} [Field K] [CharZero K] {ι : Type w} {wt : ι → NatOrdinal} + {x : ι → PrincipalSubring K} + +namespace Lifts + +variable (σ : Lifts wt x) (hx : IsMinimalSystem (principalGrading K) wt x) + +/-- Evaluation at the lifts, read in the quotient by `J`: `F ↦ F(b_𝓑) + J`. -/ +def ordinalValueQuotientAlgHom : MvPolynomial ι K →ₐ[K] Germ K := + (Ideal.Quotient.mkₐ K (negativeMonomialIdeal K)).comp (aeval σ.lift) + +omit [CharZero K] in +theorem ordinalValueQuotientAlgHom_apply (F : MvPolynomial ι K) : + σ.ordinalValueQuotientAlgHom F = toGerm (aeval σ.lift F) := by + change Ideal.Quotient.mkₐ K _ (aeval σ.lift F) = _ + rw [Ideal.Quotient.mkₐ_eq_mk, toGerm_apply] + +include hx + +omit [CharZero K] in +/-- Every class modulo `J` is represented by a value `F(b_𝓑)`. -/ +@[blueprint "lem:ordinal-value-quotient-evaluation-surjective" + (phase := "Polynomial presentations") + (title := "Surjectivity of evaluation modulo $J$") + (statement := /-- + Let $K$ be a field. Let $(x_i)$ be a minimal homogeneous generating system + of $\widehat{\mathrm P}$, with $x_i\in\mathrm P_{w_i}$, and choose + $b_i\in K((\mathbb R^{\le0}))$ representing $x_i$ in degree $w_i$. + Every class in $K((\mathbb R^{\le0}))/J$ is the class of $F(b_i)$ for some + polynomial $F\in K[X_i:i\in I]$. + -/) + (proof := /-- + For a representative $u$ of the class, choose + $\alpha>v_J(u)$. By + \ref{prop:polynomial-representative-exists}, there is a polynomial $F$ + of weighted degree below $\alpha$ such that $F(b_i)\equiv u\pmod J$. + -/)] +theorem ordinalValueQuotientAlgHom_surjective : + Function.Surjective σ.ordinalValueQuotientAlgHom := by + intro g + obtain ⟨u, rfl⟩ := Ideal.Quotient.mk_surjective g + obtain ⟨F, -, hF⟩ := σ.exists_degreeLT_toGerm_aeval_eq hx (ordinalValue u + 1) u + (NatOrdinal.lt_wpow_add_one_self _) + refine ⟨F, ?_⟩ + rw [ordinalValueQuotientAlgHom_apply, hF, toGerm_apply] + +/-- A nonzero polynomial has a value `F(b_𝓑)` outside `J`: its ordinal value is `ω^{deg F}`, the +degree formula, by Conjecture (P). -/ +@[blueprint "lem:ordinal-value-quotient-evaluation-injective" + (phase := "Polynomial presentations") + (title := "Injectivity of evaluation modulo $J$") + (statement := /-- + Let $K$ be a field of characteristic zero. Let $(x_i)$ be a minimal + homogeneous generating system of $\widehat{\mathrm P}$, with + $x_i\in\mathrm P_{w_i}$, and choose + $b_i\in K((\mathbb R^{\le0}))$ representing $x_i$ in degree $w_i$. + If the class of $F(b_i)$ is zero in $K((\mathbb R^{\le0}))/J$, then + $F=0$. + -/) + (proof := /-- + By \ref{lem:principal-representatives-cantor-bendixson}, the chosen representatives + give a minimal homogeneous generating system for the Cantor--Bendixson + associated graded ring. The two relation hypotheses of + \ref{thm:cantor-bendixson-polynomiality} are supplied by + \ref{lem:linear-occurrence} and + \ref{lem:real-translated-truncation-partials}. Thus evaluation at $(x_i)$ + is injective. If $F\ne0$, its top + homogeneous component therefore evaluates nontrivially, so the + ordinal-value calculation gives + $v_J(F(b_i))=\omega^{\deg_w(F)}\ne0$. Hence $F(b_i)\notin J$, contrary to + the vanishing of its class. + -/)] +theorem ordinalValueQuotientAlgHom_injective : Function.Injective σ.ordinalValueQuotientAlgHom := by + rw [injective_iff_map_eq_zero] + intro F hF + by_contra hF0 + have hval := σ.ordinalValue_aeval_eq_wpow_weightedTotalDegree + (injectiveAt_of_isMinimalSystem hx _) hF0 + rw [ordinalValueQuotientAlgHom_apply, toGerm_apply, Ideal.Quotient.eq_zero_iff_mem, + ← ordinalValue_eq_zero_iff, hval] at hF + exact NatOrdinal.wpow_ne_zero _ hF + +/-- **The quotient by `J` is a polynomial algebra**: `K((ℝ^{≤0}))/J ≃ K[X_B]`, with the +class of `F(b_𝓑)` mapping to `F`. -/ +@[blueprint "thm:ordinal-value-quotient" + (phase := "Polynomial presentations") + (title := "Polynomial presentation of the quotient by $J$") + (statement := /-- + Let $K$ be a field of characteristic $0$. Let $(x_i)_{i\in\iota}$ be a + minimal homogeneous generating system of $\widehat{\mathrm P}$, with + $x_i\in\mathrm P_{w_i}$, and choose + $b_i\in K((\mathbb R^{\le0}))$ representing $x_i$ in degree $w_i$. + There is a $K$-algebra isomorphism + \[ + K((\mathbb R^{\le 0}))/J \longrightarrow K[X_i:i\in\iota] + \] + whose inverse sends $F$ to the class of $F(b_i)$ modulo $J$. + -/) + (proof := /-- + Evaluation followed by passage to the quotient is surjective by + \ref{lem:ordinal-value-quotient-evaluation-surjective} and injective by + \ref{lem:ordinal-value-quotient-evaluation-injective}. Its inverse is the + stated $K$-algebra isomorphism. + -/)] +def ordinalValueQuotientAlgEquiv : Germ K ≃ₐ[K] MvPolynomial ι K := + (AlgEquiv.ofBijective σ.ordinalValueQuotientAlgHom + ⟨σ.ordinalValueQuotientAlgHom_injective hx, + σ.ordinalValueQuotientAlgHom_surjective hx⟩).symm + +theorem ordinalValueQuotientAlgEquiv_symm_apply (F : MvPolynomial ι K) : + (σ.ordinalValueQuotientAlgEquiv hx).symm F = toGerm (aeval σ.lift F) := by + simp only [ordinalValueQuotientAlgEquiv, AlgEquiv.symm_symm, AlgEquiv.ofBijective_apply, + ordinalValueQuotientAlgHom_apply] + +theorem ordinalValueQuotientAlgEquiv_toGerm_aeval (F : MvPolynomial ι K) : + σ.ordinalValueQuotientAlgEquiv hx (toGerm (aeval σ.lift F)) = F := by + rw [← σ.ordinalValueQuotientAlgEquiv_symm_apply hx F] + exact (σ.ordinalValueQuotientAlgEquiv hx).apply_symm_apply F + +/-- The class of a series `u` of ordinal value below `ω^α` goes to its polynomial `pol(u)` +modulo `J`. -/ +@[blueprint "thm:ordinal-value-quotient-polynomial-representative" + (phase := "Polynomial presentations") + (title := "Polynomial representative of a germ") + (statement := /-- + Let $K$ be a field of characteristic $0$. Let $(x_i)_{i\in\iota}$ be a + minimal homogeneous generating system of $\widehat{\mathrm P}$, with + $x_i\in\mathrm P_{w_i}$, and choose + $b_i\in K((\mathbb R^{\le0}))$ representing $x_i$ in degree $w_i$. + For every $\alpha<\omega_1$ and every $u\in K((\mathbb R^{\le 0}))$ with + $v_J(u)<\omega^\alpha$, the polynomial presentation of the quotient by $J$ + sends the class of $u$ to its polynomial representative + $\operatorname{pol}_\alpha(u)$. + -/) + (proof := /-- + By definition, $\operatorname{pol}_\alpha(u)$ has value congruent to $u$ + modulo $J$. The inverse description in + \ref{thm:ordinal-value-quotient} therefore sends this polynomial to the class + of $u$; applying the isomorphism gives the stated formula. + -/)] +theorem ordinalValueQuotientAlgEquiv_toGerm {α : NatOrdinal} {u : Series K} + (hu : ordinalValue u < ω^ α) : + σ.ordinalValueQuotientAlgEquiv hx (toGerm u) = σ.pol hx α u := by + rw [← σ.toGerm_aeval_pol hx hu] + exact σ.ordinalValueQuotientAlgEquiv_toGerm_aeval hx _ + +/-- `K((ℝ^{≤0}))/J ≃ P̂`: the composite with the polynomial presentation of `P̂`. -/ +def ordinalValueQuotientAlgEquivPrincipalSubring : Germ K ≃ₐ[K] PrincipalSubring K := + (σ.ordinalValueQuotientAlgEquiv hx).trans (algEquivOfIsMinimalSystem hx) + +omit [CharZero K] in +/-- The classes modulo `J` of series of ordinal value below `ω^α` are exactly the classes of +values `F(b_𝓑)` whose monomials all have weighted degree below `α`. -/ +@[blueprint "thm:ordinal-value-quotient-filtration" + (phase := "Polynomial presentations") + (title := "Polynomial representatives below an ordinal-value bound") + (statement := /-- + Let $K$ be a field. Let $(x_i)_{i\in\iota}$ be a minimal homogeneous + generating system of $\widehat{\mathrm P}$, with + $x_i\in\mathrm P_{w_i}$, and choose + $b_i\in K((\mathbb R^{\le0}))$ representing $x_i$ in degree $w_i$. + For every $\alpha<\omega_1$, + \[ + \{u+J:v_J(u)<\omega^\alpha\} + =\{F(b_i)+J:\text{every monomial of }F\text{ has weighted degree}<\alpha\}. + \] + -/) + (proof := /-- + The forward inclusion follows from + \ref{prop:polynomial-representative-exists}. Conversely, if every monomial + of $F$ has weighted degree below $\alpha$, then + $v_J(F(b_i))<\omega^\alpha$, so the class of $F(b_i)$ belongs to the + left-hand set. + -/)] +theorem toGerm_image_ordinalValue_lt_eq (α : NatOrdinal) : + toGerm '' {u : Series K | ordinalValue u < ω^ α} = + (fun F ↦ toGerm (aeval σ.lift F)) '' {F : MvPolynomial ι K | DegreeLT wt F α} := by + ext g + constructor + · rintro ⟨u, hu, rfl⟩ + obtain ⟨F, hF, h⟩ := σ.exists_degreeLT_toGerm_aeval_eq hx α u hu + exact ⟨F, hF, h⟩ + · rintro ⟨F, hF, rfl⟩ + exact ⟨_, σ.ordinalValue_aeval_lt_of_degreeLT hF, rfl⟩ + +end Lifts + +/-! ### Unique factorisation in the quotient by `J` -/ + +/-- The quotient by `J` is a domain: `J` is prime (Berarducci, Corollary 9.8). -/ +instance : IsDomain (Germ K) := + (Ideal.Quotient.isDomain_iff_prime _).mpr negativeMonomialIdeal_isPrime + +/-- **Berarducci's conjecture [LM17, Conjecture 1.5].** The quotient +`K((ℝ^{≤0}))/J` admits unique factorisation: it is a polynomial algebra over `K`. -/ +instance : UniqueFactorizationMonoid (Germ K) := by + obtain ⟨ι', wt', x', hx⟩ := exists_isMinimalSystem (principalGrading K) + obtain ⟨σ⟩ := exists_lifts hx.mem + exact (σ.ordinalValueQuotientAlgEquiv hx).toMulEquiv.symm.uniqueFactorizationMonoid inferInstance + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Primality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Primality.lean new file mode 100644 index 0000000000..5871cf94c7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Primality.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.GCDMonoid +public import Mathlib.Algebra.Prime.Defs + +import Mathlib.RingTheory.UniqueFactorizationDomain.Basic + +/-! +# Factorisation in the series ring + +Let `K((ℝ^{≤0}))` be the series ring over a field `K` of characteristic zero and `K(ℝ^{≤0})` its +subring of series with finite support [LM24, Not. 2.1.5], written `K_fin` below. The polynomial +presentation identifies `K((ℝ^{≤0}))` with an arbitrary-variable polynomial ring over `K_fin`. +The GCD-domain structure established in `ConwayRefinement.HahnSeries.Primality.GCDMonoid` therefore +gives Mathlib's `DecompositionMonoid` structure on the series ring. Thus every series is primal, +every +irreducible series is prime, and factorisations into irreducibles are unique up to order and +units. +-/ + +open Berarducci + +universe v + +public noncomputable section + +namespace Berarducci + +variable {K : Type v} [Field K] [CharZero K] + +/-! ### Pre-Schreier consequences of greatest common divisors -/ + +/-- `K((ℝ^{≤0}))` is pre-Schreier (Mathlib's `DecompositionMonoid`) because it is a GCD +domain. -/ +instance decompositionMonoid : DecompositionMonoid (Series K) := by + letI : Nonempty (GCDMonoid (Series K)) := nonemptyGCDMonoid + infer_instance + +/-- Every series is primal in `K((ℝ^{≤0}))`. -/ +@[blueprint "thm:hahn-series-primality" + (phase := "Primality and factorisation for real exponents") + (title := "Primality of generalised power series") + (statement := /-- + Let $K$ be a field of characteristic $0$. Every element of + $K((\mathbb R^{\le 0}))$ is primal in $K((\mathbb R^{\le 0}))$. + -/) + (proof := /-- + By \ref{thm:hahn-series-gcd-domain}, the series ring is a GCD domain. Every + GCD domain is pre-Schreier [LM24, Fact 2.5.1], and every element of a + pre-Schreier domain is primal [LM24, §2.5]. + -/)] +theorem isPrimal (a : Series K) : IsPrimal a := + DecompositionMonoid.primal a + +/-- Every irreducible series is prime in `K((ℝ^{≤0}))`. -/ +@[blueprint "cor:hahn-series-irreducible-is-prime" + (phase := "Primality and factorisation for real exponents") + (title := "Irreducible series are prime") + (statement := /-- + Let $K$ be a field of characteristic $0$. Every irreducible element of + $K((\mathbb R^{\le 0}))$ is prime in $K((\mathbb R^{\le 0}))$. + -/) + (proof := /-- + Every series is primal by \ref{thm:hahn-series-primality}, and an irreducible + primal element is prime. + -/)] +theorem prime_of_irreducible {a : Series K} (ha : Irreducible a) : Prime a := + ha.prime_of_isPrimal (isPrimal a) + +/-- Unique factorisation in `K((ℝ^{≤0}))`: two factorisations of a series into irreducibles agree +up to order and units, that is, the two multisets of factors are related by association. -/ +theorem factorization_unique {f g : Multiset (Series K)} (hf : ∀ x ∈ f, Irreducible x) + (hg : ∀ x ∈ g, Irreducible x) (hfg : Associated f.prod g.prod) : + Multiset.Rel Associated f g := + prime_factors_unique (fun x hx ↦ prime_of_irreducible (hf x hx)) + (fun x hx ↦ prime_of_irreducible (hg x hx)) hfg + +end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Random.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Random.lean new file mode 100644 index 0000000000..aba5cff467 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Random.lean @@ -0,0 +1,156 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Primality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.MainTheorem + +/-! +# Random series of finite degree are prime + +Fornasiero, Lavi, L'Innocente and Mantova prove that a random series `b` with `sup(b) = 0` and +`ot(b) = ω^n · m + β`, `1 ≤ m, n < ω`, `β < ω^n`, is irreducible, as is `b + r` for every `r` +with `ot(r) < ω^n` and `sup(b + r) = 0` (FLLM24, Theorem 1.8), and that a random principal +series of finite degree `n ≥ 1` is irreducible (FLLM24, Corollary 1.5). These series have +degree below `ω`, so the finite-degree theorem makes them prime. +-/ + +open scoped HahnSeries NatOrdinal + +universe v + +public noncomputable section + +namespace Berarducci + +open Berarducci HahnSeries HahnSeries.Nonpositive FLLM24 + +variable {K : Type v} [Field K] + +/-- `ω^n · m + β < ω^(n + 1)` when `β < ω^n`. -/ +theorem omega0_opow_mul_add_lt_opow_succ {n m : ℕ} {β : Ordinal} + (hβ : β < Ordinal.omega0 ^ (n : Ordinal)) : + Ordinal.omega0 ^ (n : Ordinal) * m + β < Ordinal.omega0 ^ ((n + 1 : ℕ) : Ordinal) := by + calc Ordinal.omega0 ^ (n : Ordinal) * m + β + < Ordinal.omega0 ^ (n : Ordinal) * m + Ordinal.omega0 ^ (n : Ordinal) := + (add_lt_add_iff_left _).mpr hβ + _ = Ordinal.omega0 ^ (n : Ordinal) * ((m + 1 : ℕ) : Ordinal) := by + rw [Nat.cast_succ, mul_add_one] + _ ≤ Ordinal.omega0 ^ (n : Ordinal) * Ordinal.omega0 := + mul_le_mul_right (Ordinal.natCast_lt_omega0 (m + 1)).le _ + _ = Ordinal.omega0 ^ ((n + 1 : ℕ) : Ordinal) := by + rw [Nat.cast_succ, Ordinal.opow_add, Ordinal.opow_one] + +/-- A series of order type `ω^n · m + β` with `β < ω^n` has degree below `n + 1`. -/ +theorem degree_lt_succ_of_supportOrderType_eq {n m : ℕ} {β : Ordinal} + (hβ : β < Ordinal.omega0 ^ (n : Ordinal)) {b : Series K} + (hot : (b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (n : Ordinal) * m + β) : + (b : K⟦ℝ⟧).degree < (((n + 1 : ℕ) : NatOrdinal) : WithBot NatOrdinal) := by + rw [degree_lt_coe_iff_supportOrderType_lt_wpow, NatOrdinal.val_wpow, NatOrdinal.val_natCast, hot] + exact omega0_opow_mul_add_lt_opow_succ hβ + +/-- Degree below a natural number is degree below `ω`. -/ +theorem degree_lt_omega_of_lt_natCast {x : K⟦ℝ⟧} {n : ℕ} + (h : x.degree < ((n : NatOrdinal) : WithBot NatOrdinal)) : + x.degree < (NatOrdinal.of Ordinal.omega0 : WithBot NatOrdinal) := + h.trans (WithBot.coe_lt_coe.mpr (NatOrdinal.lt_omega0.mpr ⟨n, rfl⟩)) + +variable [CharZero K] + +/-- A random series `b` with `sup(b) = 0` and `ot(b) = ω^n · m + β`, `1 ≤ m, n < ω`, +`β < ω^n`, is prime: irreducible by FLLM24 Theorem 1.8, of degree `n < ω`. -/ +@[blueprint "cor:random-series-prime" + (phase := "Primality and factorisation for real exponents") + (title := "Random series of finite Cantor degree are prime") + (statement := /-- + Let $K$ be a field of characteristic $0$. Let $m,n\ge1$, let + $\beta<\omega^n$, and let $b\in K((\mathbb R^{\le0}))$ be random. If + \[ + \sup(b)=0, + \qquad + \operatorname{ot}(\operatorname{supp}(b))=\omega^n\cdot m+\beta, + \] + then $b$ is prime in $K((\mathbb R^{\le0}))$. + -/) + (proof := /-- + \cite[Theorem~1.8]{FLLM} makes $b$ irreducible. By + \ref{cor:hahn-series-irreducible-is-prime}, every irreducible series in + $K((\mathbb R^{\le0}))$ is prime. + -/)] +theorem prime_of_isRandom {n m : ℕ} (hn : 1 ≤ n) (hm : 1 ≤ m) {β : Ordinal} + (hβ : β < Ordinal.omega0 ^ (n : Ordinal)) {b : Series K} (hb : IsRandom b) + (hsup : supportSup b = 0) + (hot : (b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (n : Ordinal) * m + β) : + Prime b := + Berarducci.prime_of_irreducible (irreducible_of_isRandom hn hm hβ hb hsup hot) + +/-- For `b` as in `prime_of_isRandom`, `b + r` is prime for every `r` with `ot(r) < ω^n` and +`sup(b + r) = 0`. -/ +@[blueprint "cor:random-series-small-perturbation" + (phase := "Primality and factorisation for real exponents") + (title := "Lower-order perturbations of random series are prime") + (statement := /-- + Let $K$ be a field of characteristic $0$. Let $m,n\ge1$ and + $\beta<\omega^n$. Suppose that $b\in K((\mathbb R^{\le0}))$ is random and + \[ + \operatorname{ot}(\operatorname{supp}(b))=\omega^n\cdot m+\beta. + \] + If $r\in K((\mathbb R^{\le0}))$ satisfies + \[ + \operatorname{ot}(\operatorname{supp}(r))<\omega^n, + \qquad + \sup(b+r)=0, + \] + then $b+r$ is prime in $K((\mathbb R^{\le0}))$. + -/) + (proof := /-- + \cite[Theorem~1.8]{FLLM} makes $b+r$ irreducible. Apply + \ref{cor:hahn-series-irreducible-is-prime}. + -/)] +theorem prime_add_of_isRandom {n m : ℕ} (hn : 1 ≤ n) (hm : 1 ≤ m) {β : Ordinal} + (hβ : β < Ordinal.omega0 ^ (n : Ordinal)) {b : Series K} (hb : IsRandom b) + (hot : (b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (n : Ordinal) * m + β) + {r : Series K} (hr : (r : K⟦ℝ⟧).supportOrderType < Ordinal.omega0 ^ (n : Ordinal)) + (hsup : supportSup (b + r) = 0) : + Prime (b + r) := + Berarducci.prime_of_irreducible (irreducible_add_of_isRandom hn hm hβ hb hot hr hsup) + +/-- A random principal series of positive finite degree is prime: irreducible by FLLM24 +Corollary 1.5, of degree below `ω`. -/ +@[blueprint "cor:random-principal-series-prime" + (phase := "Primality and factorisation for real exponents") + (title := "Random principal series of positive finite degree are prime") + (statement := /-- + Let $K$ be a field of characteristic $0$. Every random principal series + $b\in K((\mathbb R^{\le0}))$ with + \[ + 0<\deg(b)<\omega + \] + is prime in $K((\mathbb R^{\le0}))$. + -/) + (proof := /-- + Write $\deg(b)=n$ with $1\le n<\omega$. \cite[Corollary~1.5]{FLLM} makes $b$ + irreducible, so \ref{cor:hahn-series-irreducible-is-prime} makes it prime. + -/)] +theorem prime_of_isRandom_of_isPrincipal {b : Series K} (hb : IsRandom b) (hp : IsPrincipal b) + (hpos : 0 < (b : K⟦ℝ⟧).degree) + (hfin : (b : K⟦ℝ⟧).degree < (NatOrdinal.of Ordinal.omega0 : WithBot NatOrdinal)) : + Prime b := by + obtain ⟨d, hd⟩ := WithBot.ne_bot_iff_exists.mp (ne_bot_of_gt hpos) + have hfin' := hfin + have hpos' := hpos + rw [← hd] at hfin' hpos' + obtain ⟨n, rfl⟩ := NatOrdinal.lt_omega0.mp (WithBot.coe_lt_coe.mp hfin') + have hn : 1 ≤ n := Nat.one_le_iff_ne_zero.mpr fun h ↦ by + subst h + simp at hpos' + exact Berarducci.prime_of_irreducible (irreducible_of_isRandom_of_isPrincipal hn hb hp hd.symm) + +end Berarducci + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/SupportOrderTypeFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/SupportOrderTypeFactorization.lean new file mode 100644 index 0000000000..48792c5459 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/SupportOrderTypeFactorization.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Primality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GermLike + +import Mathlib.RingTheory.UniqueFactorizationDomain.Basic + +/-! +# Unique factorisation under the LM17 support-order alternatives + +L'Innocente--Mantova, Theorem 4.8 gives existence of irreducible factorisations for nonzero +series whose support order type is their ordinal value, or is their ordinal value plus one when +that value is greater than one. Polynomiality makes every irreducible series prime, so any two +such factorisations agree up to order and units. This proves LM17, Conjecture 1.6 without carrying +the paper's auxiliary predicate into the current API. + +## References + +* S. L'Innocente, V. Mantova, *Factorisation of germ-like series*, J. Log. Anal. 9 (2017), + paper no. 3, cited as [LM17]. +-/ + +universe v + +open scoped HahnSeries + +public noncomputable section + +namespace LM17 + +open Berarducci + +variable {K : Type v} [Field K] [CharZero K] + +/-- LM17, Conjecture 1.6: a nonzero series satisfying either support-order alternative in +LM17, Definition 4.1 admits an irreducible factorisation, unique up to order and association of +the factors. -/ +@[blueprint "cor:lm17-support-order" + (phase := "Primality and factorisation for real exponents") + (title := "Unique factorisation under support-order conditions") + (statement := /-- + Let $K$ be a field of characteristic $0$ and + $a\in K((\mathbb R^{\le 0}))$ a non-zero series. Suppose that + $\operatorname{ot}(a)=v_J(a)$, or that $v_J(a)>1$ and + $\operatorname{ot}(a)=v_J(a)+1$. Then $a$ admits a factorisation into + irreducibles, unique up to reordering and up to multiplication of the + factors by non-zero elements of $K$. These are the two alternatives of + \cite[Definition~4.1]{LM17}. + -/) + (proof := /-- + Under either support-order hypothesis, \cite[Theorem~4.8]{LM17} gives a finite + factorisation into irreducibles. By + \ref{cor:hahn-series-irreducible-is-prime}, every such irreducible is prime. + Uniqueness of finite prime factorisations then shows that any two multisets of + factors are related, after reordering, by association. + -/)] +theorem exists_unique_factorization_of_supportOrderType_eq_ordinalValue_or_add_one + {a : Series K} + (ha : (a : K⟦ℝ⟧).supportOrderType = (ordinalValue a).val ∨ + (1 < ordinalValue a ∧ + (a : K⟦ℝ⟧).supportOrderType = (ordinalValue a).val + 1)) + (ha0 : a ≠ 0) : + (∃ f : Multiset (Series K), + (∀ b ∈ f, Irreducible b) ∧ Associated f.prod a) ∧ + ∀ f g : Multiset (Series K), + (∀ b ∈ f, Irreducible b) → + (∀ b ∈ g, Irreducible b) → + Associated f.prod a → Associated g.prod a → + Multiset.Rel Associated f g := by + have haLM17 : IsGermLike a := isGermLike_iff.mpr ha + refine ⟨haLM17.exists_factorization ha0, ?_⟩ + intro f g hf hg hfa hga + exact prime_factors_unique + (fun b hb ↦ Berarducci.prime_of_irreducible (hf b hb)) + (fun b hb ↦ Berarducci.prime_of_irreducible (hg b hb)) + (hfa.trans hga.symm) + +end LM17 diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PrincipalAddition.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PrincipalAddition.lean new file mode 100644 index 0000000000..b11a1c1f13 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PrincipalAddition.lean @@ -0,0 +1,340 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Multiplicativity +import Mathlib.Tactic.Abel + +/-! +# Addition of principal series + +This module proves the corrected form of LM24, Proposition 3.6.2. The printed proposition assumes +only that `b`, `c` are principal and `deg (b + c) = deg b`. That statement is false: if `b` is a +principal series of positive degree and `c = 1`, then `deg (b + c) = deg b`, but the terminal +constant makes `b + c` nonprincipal. +`ConwayRefinement.HahnSeries.Tests.PrincipalAddition` preserves this counterexample. + +After being shown the counterexample, Mantova confirmed in correspondence that imposing +`deg b = deg c` repairs the proposition. He also suggested the potentially more general +hypothesis that the two degrees are either both zero or both nonzero. This module proves and +uses only the equal-degree version; the broader version is not treated as established. + +Both later uses in LM24 have the additional equality `deg c = deg b`. Under the proved +hypotheses + +`deg b = deg c = deg (b + c)`, + +the source argument is valid. Every proper negative truncation of each summand has degree below +the common degree, so the same holds for the sum. This forces the support supremum of the sum to +be zero and bounds each closed initial segment of its support below the corresponding power of +`ω`. The generic initial-segment criterion then identifies the full support order type with that +power. +-/ + +universe v + +open scoped HahnSeries NatOrdinal + +public noncomputable section + +namespace HahnSeries.Nonpositive + +open HahnSeries + +variable {K : Type v} [Field K] + +/-- Negation preserves principality. -/ +@[simp] +theorem IsPrincipal.neg {p : Nonpositive ℝ K} (hp : IsPrincipal p) : + IsPrincipal (-p) := by + rw [isPrincipal_iff] + constructor + · change HahnSeries.IsWeaklyPrincipal (-(p : K⟦ℝ⟧)) + rw [HahnSeries.isWeaklyPrincipal_iff, HahnSeries.supportOrderType_neg] + exact HahnSeries.isWeaklyPrincipal_iff.mp hp.isWeaklyPrincipal + · simpa only [supportSup_neg] using hp.supportSup_eq_zero + +/-- Multiplication by a nonzero coefficient, embedded as a constant Hahn series, preserves +principality. -/ +theorem IsPrincipal.const_mul {p : Nonpositive ℝ K} (hp : IsPrincipal p) + {k : K} (hk : k ≠ 0) : + IsPrincipal ((C : K →+* Nonpositive ℝ K) k * p) := by + have hsupport : + ((((C : K →+* Nonpositive ℝ K) k * p : Nonpositive ℝ K) : + K⟦ℝ⟧).support) = (p : K⟦ℝ⟧).support := by + rw [Subring.coe_mul, coe_C, HahnSeries.C_mul_eq_smul] + ext x + simp [HahnSeries.mem_support, HahnSeries.coeff_smul, hk] + have htype : + HahnSeries.supportOrderType + (↑((C : K →+* Nonpositive ℝ K) k * p) : K⟦ℝ⟧) = + (p : K⟦ℝ⟧).supportOrderType := by + rw [HahnSeries.supportOrderType_eq_setOrderType, + HahnSeries.supportOrderType_eq_setOrderType] + exact Set.IsPWO.orderType_congr _ _ hsupport + rw [isPrincipal_iff] + constructor + · rw [HahnSeries.isWeaklyPrincipal_iff, htype] + exact HahnSeries.isWeaklyPrincipal_iff.mp hp.isWeaklyPrincipal + · have hproductNe : (C : K →+* Nonpositive ℝ K) k * p ≠ 0 := + mul_ne_zero (isPrincipal_C hk).ne_zero hp.ne_zero + calc + supportSup ((C : K →+* Nonpositive ℝ K) k * p) = supportSup p := by + rw [supportSup_of_ne hproductNe, supportSup_of_ne hp.ne_zero, hsupport] + _ = 0 := hp.supportSup_eq_zero + +/-- A principal series of degree `α` has support order type `ω^α`. -/ +theorem IsPrincipal.supportOrderType_eq_wpow_of_degree_eq + {p : Nonpositive ℝ K} (hp : IsPrincipal p) {α : NatOrdinal} + (hpDegree : (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) : + (p : K⟦ℝ⟧).supportOrderType = (ω^ α).val := by + obtain ⟨e, he⟩ := Ordinal.isAdditivelyPrincipal_iff.mp + (HahnSeries.isWeaklyPrincipal_iff.mp hp.isWeaklyPrincipal) + have hdegree : (NatOrdinal.of e : WithBot NatOrdinal) = α := by + rw [HahnSeries.degree_eq_cantorDegree, he, + Ordinal.cantorDegree_of_ne_zero + (Ordinal.opow_ne_zero e Ordinal.omega0_ne_zero), + Ordinal.log_opow Ordinal.one_lt_omega0] at hpDegree + exact hpDegree + have hdegree' : NatOrdinal.of e = α := WithBot.coe_eq_coe.mp hdegree + rw [he, ← hdegree'] + simp + +/-- A principal series of positive degree has zero constant coefficient. -/ +theorem IsPrincipal.constantCoeff_eq_zero_of_degree_pos + {p : Nonpositive ℝ K} (hp : IsPrincipal p) {α : NatOrdinal} + (hpDegree : (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) + (hα : 0 < α) : + constantCoeff p = 0 := by + have hpType := hp.supportOrderType_eq_wpow_of_degree_eq hpDegree + rw [constantCoeff_apply] + apply not_ne_iff.mp + intro hcoeff + have hzeroSupport : 0 ∈ (p : K⟦ℝ⟧).support := + (HahnSeries.mem_support _ _).mpr hcoeff + have hlimit : Order.IsSuccLimit (p : K⟦ℝ⟧).isPWO_support.orderType := by + rw [← supportOrderType_eq_setOrderType, hpType, NatOrdinal.val_wpow] + exact Ordinal.isSuccLimit_opow_left Ordinal.isSuccLimit_omega0 + (NatOrdinal.val.strictMono hα).ne' + obtain ⟨y, hy, hypos⟩ := + (p : K⟦ℝ⟧).isPWO_support.exists_gt_of_isSuccLimit_orderType + hlimit hzeroSupport + exact (not_lt_of_ge (support_subset p hy)) hypos + +private theorem truncLE_ne_self_of_isPrincipal + {p : Nonpositive ℝ K} (hp : IsPrincipal p) {x : ℝ} (hx : x < 0) : + truncLE x (p : K⟦ℝ⟧) ≠ p := by + have hpLUB : IsLUB (p : K⟦ℝ⟧).support 0 := + (supportSup_eq_coe_iff.mp hp.supportSup_eq_zero).2 + obtain ⟨y, hy, hxy, -⟩ := hpLUB.exists_between hx + intro heq + have hyTrunc : y ∈ (truncLE x (p : K⟦ℝ⟧)).support := by + rw [heq] + exact hy + rw [support_truncLE] at hyTrunc + exact (not_lt_of_ge hyTrunc.2) hxy + +/-- Every negative weak truncation of a principal series has degree below its degree. -/ +theorem IsPrincipal.degree_truncLE_lt_of_degree_eq + {p : Nonpositive ℝ K} (hp : IsPrincipal p) {α : NatOrdinal} + (hpDegree : (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) + {x : ℝ} (hx : x < 0) : + (truncLE x (p : K⟦ℝ⟧)).degree < (α : WithBot NatOrdinal) := by + rw [← hpDegree] + exact degree_lt_of_supportOrderType_lt_of_isWeaklyPrincipal + hp.isWeaklyPrincipal + (supportOrderType_truncLE_lt x (truncLE_ne_self_of_isPrincipal hp hx)) + +private theorem support_subsingleton_of_supportOrderType_eq_one + {p : K⟦ℝ⟧} (hpType : p.supportOrderType = 1) : + p.support.Subsingleton := by + intro x hx y hy + apply le_antisymm + · apply le_of_not_gt + intro hyx + let hbelow := p.isPWO_support.mono + (s := p.support ∩ Set.Iio x) Set.inter_subset_left + have hbelowLt := p.isPWO_support.orderType_inter_Iio_lt hx + rw [← supportOrderType_eq_setOrderType, hpType] at hbelowLt + have hbelowZero : hbelow.orderType = 0 := by simpa using hbelowLt + have hbelowEmpty := hbelow.orderType_eq_zero.mp hbelowZero + have : y ∈ p.support ∩ Set.Iio x := ⟨hy, hyx⟩ + rw [hbelowEmpty] at this + exact this + · apply le_of_not_gt + intro hxy + let hbelow := p.isPWO_support.mono + (s := p.support ∩ Set.Iio y) Set.inter_subset_left + have hbelowLt := p.isPWO_support.orderType_inter_Iio_lt hy + rw [← supportOrderType_eq_setOrderType, hpType] at hbelowLt + have hbelowZero : hbelow.orderType = 0 := by simpa using hbelowLt + have hbelowEmpty := hbelow.orderType_eq_zero.mp hbelowZero + have : x ∈ p.support ∩ Set.Iio y := ⟨hx, hxy⟩ + rw [hbelowEmpty] at this + exact this + +/-- A principal series of degree zero is exactly its constant coefficient. -/ +theorem IsPrincipal.eq_C_constantCoeff_of_degree_zero + {p : Nonpositive ℝ K} (hp : IsPrincipal p) + (hpDegree : (p : K⟦ℝ⟧).degree = (0 : WithBot NatOrdinal)) : + p = C (constantCoeff p) := by + have hpType : (p : K⟦ℝ⟧).supportOrderType = 1 := by + simpa using hp.supportOrderType_eq_wpow_of_degree_eq hpDegree + have hpSubsingleton := support_subsingleton_of_supportOrderType_eq_one hpType + have hpNe : (p : K⟦ℝ⟧) ≠ 0 := by simpa using hp.ne_zero + obtain ⟨z, hz⟩ := HahnSeries.support_nonempty_iff.mpr hpNe + have hpSupport : (p : K⟦ℝ⟧).support = {z} := by + ext y + constructor + · intro hy + exact Set.mem_singleton_iff.mpr (hpSubsingleton hy hz) + · intro hy + exact Set.mem_singleton_iff.mp hy ▸ hz + have hpLUB : IsLUB (p : K⟦ℝ⟧).support 0 := + (supportSup_eq_coe_iff.mp hp.supportSup_eq_zero).2 + have hz0 : z = 0 := by + rw [hpSupport] at hpLUB + exact isLUB_singleton.unique hpLUB + apply Subtype.ext + ext x + by_cases hx : x = 0 + · subst x + simp [constantCoeff_apply] + · have hxSupport : x ∉ (p : K⟦ℝ⟧).support := by + rw [hpSupport, hz0, Set.mem_singleton_iff] + exact hx + have hxCoeff : (p : K⟦ℝ⟧).coeff x = 0 := by + rwa [← not_ne_iff, ← HahnSeries.mem_support] + simp [coe_C, hx, hxCoeff] + +private theorem add_of_same_degree_coe + {b c : Nonpositive ℝ K} (hb : IsPrincipal b) (hc : IsPrincipal c) + {α : NatOrdinal} + (hbDegree : (b : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) + (hcDegree : (c : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) + (hsumDegree : ((b + c : Nonpositive ℝ K) : K⟦ℝ⟧).degree = + (α : WithBot NatOrdinal)) : + IsPrincipal (b + c) := by + have hsumNe : b + c ≠ 0 := by + intro hzero + have : ((b + c : Nonpositive ℝ K) : K⟦ℝ⟧).degree = ⊥ := by + rw [hzero] + exact degree_zero + exact WithBot.bot_ne_coe (this.symm.trans hsumDegree) + rcases eq_or_ne α 0 with rfl | hα + · have hbC := hb.eq_C_constantCoeff_of_degree_zero hbDegree + have hcC := hc.eq_C_constantCoeff_of_degree_zero hcDegree + rw [hbC, hcC, ← map_add] + apply isPrincipal_C + intro hcoeff + apply hsumNe + rw [hbC, hcC, ← map_add, hcoeff, map_zero] + · have hαpos : 0 < α := bot_lt_iff_ne_bot.mpr hα + have hbZeroCoeff := hb.constantCoeff_eq_zero_of_degree_pos hbDegree hαpos + have hcZeroCoeff := hc.constantCoeff_eq_zero_of_degree_pos hcDegree hαpos + have hsumZeroCoeff : constantCoeff (b + c) = 0 := by + rw [map_add, hbZeroCoeff, hcZeroCoeff, add_zero] + have htruncDegree : ∀ x : ℝ, x < 0 → + (truncLE x (((b + c : Nonpositive ℝ K) : K⟦ℝ⟧))).degree < + (α : WithBot NatOrdinal) := by + intro x hx + change (truncLE x ((b : K⟦ℝ⟧) + (c : K⟦ℝ⟧))).degree < + (α : WithBot NatOrdinal) + rw [truncLE_add] + apply (degree_add_le _ _).trans_lt + exact max_lt + (hb.degree_truncLE_lt_of_degree_eq hbDegree hx) + (hc.degree_truncLE_lt_of_degree_eq hcDegree hx) + have hsumSup : supportSup (b + c) = 0 := by + apply le_antisymm (supportSup_le_zero (b + c)) + apply le_of_not_gt + intro hsupLt + rw [supportSup_of_ne hsumNe] at hsupLt + have hsupLtReal : sSup (((b + c : Nonpositive ℝ K) : K⟦ℝ⟧).support) < 0 := + WithBot.coe_lt_coe.mp hsupLt + obtain ⟨x, hsx, hx0⟩ := exists_between hsupLtReal + have hsupportLE : (((b + c : Nonpositive ℝ K) : K⟦ℝ⟧).support) ⊆ + Set.Iic x := by + intro y hy + exact (le_csSup (bddAbove_support (b + c)) hy).trans hsx.le + have htruncSelf : + truncLE x (((b + c : Nonpositive ℝ K) : K⟦ℝ⟧)) = b + c := + truncLE_eq_self_of_support_subset_Iic hsupportLE + have hsumDegree' : ((b : K⟦ℝ⟧) + (c : K⟦ℝ⟧)).degree = + (α : WithBot NatOrdinal) := by + simpa using hsumDegree + have hlt := htruncDegree x hx0 + rw [htruncSelf, hsumDegree'] at hlt + exact (lt_irrefl _ hlt) + rw [isPrincipal_iff] + refine ⟨?_, hsumSup⟩ + rw [HahnSeries.isWeaklyPrincipal_iff] + have htypeLE : (((b + c : Nonpositive ℝ K) : K⟦ℝ⟧).supportOrderType) ≤ + (ω^ α).val := by + rw [supportOrderType_eq_setOrderType] + apply Set.IsPWO.orderType_le_of_forall_inter_Iic_lt + (((b + c : Nonpositive ℝ K) : K⟦ℝ⟧).isPWO_support) + intro x hx + have hx0 : x < 0 := by + have hxle := support_subset (b + c) hx + exact lt_of_le_of_ne hxle fun hxzero ↦ by + subst x + exact (HahnSeries.mem_support _ _).mp hx (by + simpa [constantCoeff_apply] using hsumZeroCoeff) + have hsupportTrunc : + (truncLE x (((b + c : Nonpositive ℝ K) : K⟦ℝ⟧))).support = + (((b + c : Nonpositive ℝ K) : K⟦ℝ⟧).support ∩ Set.Iic x) := by + rw [support_truncLE] + rfl + let hInter := + (((b + c : Nonpositive ℝ K) : K⟦ℝ⟧).isPWO_support).mono + (s := ((b + c : Nonpositive ℝ K) : K⟦ℝ⟧).support ∩ Set.Iic x) + Set.inter_subset_left + let hTrunc := + (truncLE x (((b + c : Nonpositive ℝ K) : K⟦ℝ⟧))).isPWO_support + change hInter.orderType < (ω^ α).val + calc + hInter.orderType = hTrunc.orderType := + hInter.orderType_congr hTrunc hsupportTrunc.symm + _ = (truncLE x (((b + c : Nonpositive ℝ K) : K⟦ℝ⟧))).supportOrderType := + (supportOrderType_eq_setOrderType _).symm + _ < (ω^ α).val := + (degree_lt_coe_iff_supportOrderType_lt_wpow _ α).mp + (htruncDegree x hx0) + have htypeGE : (ω^ α).val ≤ + (((b + c : Nonpositive ℝ K) : K⟦ℝ⟧).supportOrderType) := by + have hsumNe' : (((b + c : Nonpositive ℝ K) : K⟦ℝ⟧)) ≠ 0 := by + intro hzero + exact hsumNe (Subtype.ext hzero) + have h := (coe_le_degree_iff (x := + ((b + c : Nonpositive ℝ K) : K⟦ℝ⟧)) (a := α.val) hsumNe').mp + (by rw [hsumDegree]; simp) + simpa only [NatOrdinal.val_wpow] using h + rw [le_antisymm htypeLE htypeGE] + exact Ordinal.isAdditivelyPrincipal_omega0_opow α.val + +/-- Corrected LM24, Proposition 3.6.2: a sum of two principal series of the same degree is +principal if the degree of the sum is unchanged. -/ +theorem IsPrincipal.add_of_degree_eq + {b c : Nonpositive ℝ K} (hb : IsPrincipal b) (hc : IsPrincipal c) + (hcDegree : (c : K⟦ℝ⟧).degree = (b : K⟦ℝ⟧).degree) + (hsumDegree : ((b + c : Nonpositive ℝ K) : K⟦ℝ⟧).degree = + (b : K⟦ℝ⟧).degree) : + IsPrincipal (b + c) := by + have hbDegreeNe : (b : K⟦ℝ⟧).degree ≠ ⊥ := by + intro hbot + have hbZero : (b : K⟦ℝ⟧) = 0 := degree_eq_bot.mp hbot + exact hb.ne_zero (Subtype.ext hbZero) + let α := (b : K⟦ℝ⟧).degree.unbot hbDegreeNe + have hbDegree : (b : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal) := by + exact (WithBot.coe_unbot _ hbDegreeNe).symm + apply add_of_same_degree_coe hb hc hbDegree + · exact hcDegree.trans hbDegree + · exact hsumDegree.trans hbDegree + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/RealSupportSupremum.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/RealSupportSupremum.lean new file mode 100644 index 0000000000..219074fa30 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/RealSupportSupremum.lean @@ -0,0 +1,118 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEmbedding +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportSupremum +public import Mathlib.Algebra.Order.Monoid.Submonoid + +/-! +# Real support supremum for subgroup-exponent Hahn series + +For an additive subgroup `H ⊆ ℝ`, LM24, Section 6.5 uses the supremum in `ℝ` of the +support of a series in `K((H^{≤ 0}))`. We first embed the exponent domain into `ℝ`, and then +apply the existing real Hahn-series support supremum. Thus the value is `⊥` exactly at zero and +otherwise is characterized intrinsically as the least upper bound in `ℝ` of the coerced +support. +-/ + +open scoped HahnSeries + +universe v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable (H : AddSubgroup ℝ) {K : Type v} [Field K] + +/-- Regard a nonpositive Hahn series over `H ⊆ ℝ` as a real-exponent Hahn series. -/ +def mapDomainToReal : Nonpositive H K →+* Nonpositive ℝ K := + mapDomain H.subtype Subtype.val_injective fun _ _ ↦ Iff.rfl + +/-- The underlying series of `mapDomainToReal` is Mathlib's exponent-domain embedding. -/ +@[simp] +theorem coe_mapDomainToReal (b : Nonpositive H K) : + (mapDomainToReal H b : K⟦ℝ⟧) = HahnSeries.embDomain + (⟨⟨H.subtype, Subtype.val_injective⟩, by + intro a b + exact Subtype.coe_le_coe⟩ : H ↪o ℝ) + (b : K⟦H⟧) := + coe_mapDomain H.subtype Subtype.val_injective (fun _ _ ↦ Iff.rfl) b + +/-- The real-domain embedding maps support by the subgroup inclusion. -/ +theorem support_mapDomainToReal (b : Nonpositive H K) : + (mapDomainToReal H b : K⟦ℝ⟧).support = + ((fun h : H ↦ (h : ℝ)) '' (b : K⟦H⟧).support) := + support_mapDomain H.subtype Subtype.val_injective (fun _ _ ↦ Iff.rfl) b + +/-- The real-domain embedding is injective. -/ +theorem mapDomainToReal_injective : + Function.Injective (mapDomainToReal (K := K) H) := + mapDomain_injective H.subtype Subtype.val_injective fun _ _ ↦ Iff.rfl + +/-- The real-domain embedding preserves the constant coefficient. -/ +theorem constantCoeff_mapDomainToReal (b : Nonpositive H K) : + constantCoeff (mapDomainToReal H b) = constantCoeff b := by + have hmap : mapDomainToReal H b = + mapDomain H.subtype Subtype.val_injective (fun _ _ ↦ Iff.rfl) b := by + apply Subtype.ext + rw [coe_mapDomainToReal, coe_mapDomain] + rw [hmap] + exact constantCoeff_mapDomain H.subtype Subtype.val_injective + (fun _ _ ↦ Iff.rfl) b + +/-- The supremum in `ℝ` of the support of a nonpositive series with exponents in `H`. -/ +def realSupportSup (b : Nonpositive H K) : WithBot ℝ := + supportSup (mapDomainToReal H b) + +/-- The real support supremum of zero is `⊥`. -/ +@[simp] +theorem realSupportSup_zero : + realSupportSup H (0 : Nonpositive H K) = ⊥ := by + rw [realSupportSup, map_zero, supportSup_zero] + +/-- The real support supremum is `⊥` exactly at zero. -/ +@[simp] +theorem realSupportSup_eq_bot {b : Nonpositive H K} : + realSupportSup H b = ⊥ ↔ b = 0 := by + rw [realSupportSup, supportSup_eq_bot] + constructor + · intro hb + exact mapDomainToReal_injective H (hb.trans (map_zero _).symm) + · rintro rfl + exact map_zero _ + +/-- A finite real support supremum is precisely a least upper bound of the coerced support. -/ +theorem realSupportSup_eq_coe_iff {b : Nonpositive H K} {a : ℝ} : + realSupportSup H b = (a : WithBot ℝ) ↔ + b ≠ 0 ∧ IsLUB ((fun h : H ↦ (h : ℝ)) '' (b : K⟦H⟧).support) a := by + rw [realSupportSup, supportSup_eq_coe_iff, support_mapDomainToReal] + constructor + · rintro ⟨hb, hlub⟩ + exact ⟨fun hzero ↦ hb (hzero ▸ map_zero _), hlub⟩ + · rintro ⟨hb, hlub⟩ + exact ⟨fun hzero ↦ + hb (mapDomainToReal_injective H (hzero.trans (map_zero _).symm)), hlub⟩ + +/-- The real support supremum of a nonzero monomial is its real exponent. -/ +theorem realSupportSup_single {g : H} {k : K} (hk : k ≠ 0) (hg : g ≤ 0) : + realSupportSup H (single g k hg) = (g : ℝ) := by + rw [realSupportSup, mapDomainToReal, mapDomain_single] + exact supportSup_single hk (by exact_mod_cast hg) + +/-- The multiplicative identity has real support supremum zero. -/ +@[simp] +theorem realSupportSup_one : + realSupportSup H (1 : Nonpositive H K) = 0 := by + rw [realSupportSup, map_one] + rw [show (1 : Nonpositive ℝ K) = single 0 1 le_rfl by + apply Subtype.ext + rw [coe_single] + rfl] + exact supportSup_single one_ne_zero le_rfl + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SeparatedPieceSum.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SeparatedPieceSum.lean new file mode 100644 index 0000000000..d4d2b47003 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SeparatedPieceSum.lean @@ -0,0 +1,171 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.IncreasingSequenceUnion +public import Mathlib.RingTheory.HahnSeries.Summable + +/-! +# Hahn sums of order-separated families + +A family of Hahn series whose supports are strictly separated along a partially well-ordered +index is summable: the support union is partially well ordered by the ordered-union lemma, and +each exponent meets at most one member. This drops the half-open interval bookkeeping of the +ordered interval sums; any family carried by pairwise disjoint ordered convex pieces qualifies. +The support of the sum is exactly the union of the member supports, and each coefficient is read +off its unique contributing member. +-/ + +universe u v w + +open Set + +public noncomputable section + +namespace HahnSeries + +variable {Γ : Type u} {R : Type v} {ι : Type w} + [LinearOrder Γ] [AddCommMonoid R] [LinearOrder ι] + +/-- Hahn series with strictly separated supports along a partially well-ordered index form a +summable family. -/ +def separatedSummableFamily (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦Γ⟧) + (hsep : ∀ i j, i < j → ∀ a ∈ (f i).support, ∀ b ∈ (f j).support, a < b) : + SummableFamily Γ R ι where + toFun := f + isPWO_iUnion_support' := + Set.IsPWO.iUnion_of_ordered_index hι (fun i ↦ (f i).support) + (fun i ↦ (f i).isPWO_support) fun i j hij x hx y hy ↦ hsep i j hij x hx y hy + finite_co_support' x := by + refine Set.Subsingleton.finite fun i hi j hj ↦ ?_ + by_contra hne + have hix : x ∈ (f i).support := (mem_support _ _).mpr hi + have hjx : x ∈ (f j).support := (mem_support _ _).mpr hj + rcases lt_or_gt_of_ne hne with hij | hji + · exact lt_irrefl x (hsep i j hij x hix x hjx) + · exact lt_irrefl x (hsep j i hji x hjx x hix) + +/-- The separated family evaluates to the original series at each index. -/ +@[simp] +theorem separatedSummableFamily_apply (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦Γ⟧) + (hsep : ∀ i j, i < j → ∀ a ∈ (f i).support, ∀ b ∈ (f j).support, a < b) (i : ι) : + separatedSummableFamily hι f hsep i = f i := (rfl) + +/-- The Hahn sum of an order-separated family. -/ +def separatedHsum (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦Γ⟧) + (hsep : ∀ i j, i < j → ∀ a ∈ (f i).support, ∀ b ∈ (f j).support, a < b) : R⟦Γ⟧ := + (separatedSummableFamily hι f hsep).hsum + +/-- Order separation prevents coefficient cancellation, so the support of the sum is exactly the +union of the member supports. -/ +theorem support_separatedHsum (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦Γ⟧) + (hsep : ∀ i j, i < j → ∀ a ∈ (f i).support, ∀ b ∈ (f j).support, a < b) : + (separatedHsum hι f hsep).support = ⋃ i, (f i).support := by + apply Set.Subset.antisymm SummableFamily.support_hsum_subset + intro g hg + rw [Set.mem_iUnion] at hg + obtain ⟨i, hi⟩ := hg + rw [mem_support] at hi ⊢ + rw [SummableFamily.coeff_hsum, finsum_eq_single _ i] + · exact hi + · intro j hji + by_contra hj + have hjx : g ∈ (f j).support := (mem_support _ _).mpr fun h ↦ hj (by + rw [separatedSummableFamily_apply, h]) + rcases lt_or_gt_of_ne hji with hji' | hij' + · exact lt_irrefl g (hsep j i hji' g hjx g hi) + · exact lt_irrefl g (hsep i j hij' g hi g hjx) + +/-- Each coefficient of an order-separated sum is the coefficient of its unique contributing +member. -/ +theorem coeff_separatedHsum_eq (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦Γ⟧) + (hsep : ∀ i j, i < j → ∀ a ∈ (f i).support, ∀ b ∈ (f j).support, a < b) + (i : ι) (g : Γ) (hg : ∀ j, j ≠ i → g ∉ (f j).support) : + (separatedHsum hι f hsep).coeff g = (f i).coeff g := by + have hsingle := finsum_eq_single + (fun j ↦ ((separatedSummableFamily hι f hsep) j).coeff g) i fun j hji ↦ by + rw [separatedSummableFamily_apply] + by_contra hj + exact hg j hji ((mem_support _ _).mpr hj) + rw [separatedHsum, SummableFamily.coeff_hsum, hsingle, separatedSummableFamily_apply] + +/-- A coefficient outside every member support vanishes in an order-separated sum. -/ +theorem coeff_separatedHsum_eq_zero (hι : (Set.univ : Set ι).IsPWO) + (f : ι → R⟦Γ⟧) + (hsep : ∀ i j, i < j → ∀ a ∈ (f i).support, ∀ b ∈ (f j).support, a < b) + (g : Γ) (hg : ∀ j, g ∉ (f j).support) : + (separatedHsum hι f hsep).coeff g = 0 := by + by_contra hne + have hmem : g ∈ (separatedHsum hι f hsep).support := (mem_support _ _).mpr hne + rw [support_separatedHsum, Set.mem_iUnion] at hmem + obtain ⟨j, hj⟩ := hmem + exact hg j hj + +/-- The restriction of a Hahn series to a set of exponents. -/ +def setRestrict (s : Set Γ) [DecidablePred (· ∈ s)] (b : R⟦Γ⟧) : R⟦Γ⟧ where + coeff g := if g ∈ s then b.coeff g else 0 + isPWO_support' := b.isPWO_support.mono fun g hg ↦ by + by_contra hgb + apply hg + change (if g ∈ s then b.coeff g else 0) = 0 + rcases Classical.em (g ∈ s) with hgs | hgs + · rw [if_pos hgs] + exact of_not_not fun h ↦ hgb ((mem_support _ _).mpr h) + · rw [if_neg hgs] + +@[simp] +theorem coeff_setRestrict (s : Set Γ) [DecidablePred (· ∈ s)] (b : R⟦Γ⟧) (g : Γ) : + (setRestrict s b).coeff g = if g ∈ s then b.coeff g else 0 := (rfl) + +theorem support_setRestrict (s : Set Γ) [DecidablePred (· ∈ s)] (b : R⟦Γ⟧) : + (setRestrict s b).support = b.support ∩ s := by + ext g + simp only [mem_support, coeff_setRestrict, Set.mem_inter_iff] + constructor + · intro h + rcases Classical.em (g ∈ s) with hgs | hgs + · rw [if_pos hgs] at h + exact ⟨(mem_support _ _).mpr h, hgs⟩ + · rw [if_neg hgs] at h + exact absurd rfl h + · rintro ⟨hb, hgs⟩ + rw [if_pos hgs] + exact (mem_support _ _).mp hb + +open Classical in +/-- A Hahn series whose support is covered by the pairwise disjoint ordered pieces of a +separated family is the sum of its restrictions to the pieces. -/ +theorem separatedHsum_setRestrict_eq (hι : (Set.univ : Set ι).IsPWO) + (C : ι → Set Γ) (b : R⟦Γ⟧) + (hcov : b.support ⊆ ⋃ i, C i) + (hdisj : ∀ i j, i ≠ j → Disjoint (C i) (C j)) + (hord : ∀ i j, i < j → ∀ a ∈ C i, ∀ c ∈ C j, a < c) : + separatedHsum hι (fun i ↦ setRestrict (C i) b) + (fun i j hij a ha c hc ↦ hord i j hij a + ((support_setRestrict (C i) b ▸ ha : a ∈ b.support ∩ C i)).2 c + ((support_setRestrict (C j) b ▸ hc : c ∈ b.support ∩ C j)).2) = b := by + ext g + by_cases hgb : g ∈ b.support + · obtain ⟨i, hgi⟩ := Set.mem_iUnion.mp (hcov hgb) + rw [coeff_separatedHsum_eq _ _ _ i g ?_, coeff_setRestrict, if_pos hgi] + intro j hji + rw [support_setRestrict] + rintro ⟨-, hgj⟩ + exact Set.disjoint_left.mp (hdisj j i hji) hgj hgi + · have hz : ∀ j, g ∉ (setRestrict (C j) b).support := by + intro j + rw [support_setRestrict] + rintro ⟨hb, -⟩ + exact hgb hb + rw [coeff_separatedHsum_eq_zero _ _ _ g hz] + exact (not_not.mp fun h ↦ hgb ((mem_support _ _).mpr h)).symm + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SeparatedSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SeparatedSupport.lean new file mode 100644 index 0000000000..cf7de49acd --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SeparatedSupport.lean @@ -0,0 +1,150 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Data.List.Chain +public import Mathlib.RingTheory.HahnSeries.Addition + +/-! +# Strictly separated supports of Hahn series + +`HahnSeries.SupportBelow x y` means that every exponent in the support of `x` is strictly below +every exponent in the support of `y`. This is the support orientation used in LM24, Proposition +3.2.1 and Definition 3.3.2. The generic lemmas below show that such supports cannot cancel under +addition and propagate the relation through finite sums. + +The generic declarations follow Mathlib's Hahn-series namespace and assumptions. Adjacent and +pairwise separation of finite lists are expressed with `List.IsChain` and `List.Pairwise.isChain`. +-/ + +universe u v + +public noncomputable section + +namespace HahnSeries + +variable {R : Type v} {G : Type u} [PartialOrder G] + +section Zero + +variable [Zero R] + +/-- Every exponent in the support of `x` is strictly below every exponent in the support of `y`. -/ +def SupportBelow (x y : R⟦G⟧) : Prop := + ∀ i ∈ x.support, ∀ j ∈ y.support, i < j + +/-- Elementwise characterization of strict support separation. -/ +theorem supportBelow_iff {x y : R⟦G⟧} : + SupportBelow x y ↔ ∀ i ∈ x.support, ∀ j ∈ y.support, i < j := + (Iff.rfl) + +/-- Extract the strict inequality between two supported exponents. -/ +theorem SupportBelow.lt {x y : R⟦G⟧} (h : SupportBelow x y) {i j : G} + (hi : i ∈ x.support) (hj : j ∈ y.support) : i < j := + supportBelow_iff.mp h i hi j hj + +/-- Strict support separation is transitive when the intermediate series is nonzero. -/ +theorem supportBelow_trans_of_ne_zero {x y z : R⟦G⟧} (hy : y ≠ 0) + (hxy : SupportBelow x y) (hyz : SupportBelow y z) : SupportBelow x z := by + have hsupport : y.support.Nonempty := by + rw [Set.nonempty_iff_ne_empty] + exact fun h ↦ hy (support_eq_empty_iff.mp h) + obtain ⟨j, hj⟩ := hsupport + rw [supportBelow_iff] + intro i hi k hk + exact (hxy.lt hi hj).trans (hyz.lt hj hk) + +/-- An adjacent chain of nonzero series with strictly separated supports is pairwise separated. -/ +theorem pairwise_supportBelow_of_isChain {l : List R⟦G⟧} + (hne : ∀ x ∈ l, x ≠ 0) (hchain : l.IsChain SupportBelow) : + l.Pairwise SupportBelow := by + induction l with + | nil => exact List.Pairwise.nil + | cons a l ih => + cases l with + | nil => exact List.Pairwise.cons (by simp) List.Pairwise.nil + | cons b l => + have htail : (b :: l).IsChain SupportBelow := hchain.tail + have hpair : (b :: l).Pairwise SupportBelow := + ih (fun x hx ↦ hne x (by simp [hx])) htail + rw [List.pairwise_cons] + refine ⟨?_, hpair⟩ + intro c hc + simp only [List.mem_cons] at hc + rcases hc with rfl | hc + · exact hchain.rel_head + · exact supportBelow_trans_of_ne_zero (hne b (by simp)) hchain.rel_head + ((List.pairwise_cons.mp hpair).1 c hc) + +end Zero + +section AddMonoid + +variable [AddMonoid R] + +/-- Strict support separation prevents cancellation in the support of a sum. -/ +theorem support_add_eq_union_of_supportBelow (x y : R⟦G⟧) (hxy : SupportBelow x y) : + (x + y).support = x.support ∪ y.support := by + have hdisjoint : Disjoint x.support y.support := by + rw [Set.disjoint_left] + intro i hi hj + exact (hxy.lt hi hj).false + apply Set.Subset.antisymm (support_add_subset x y) + rintro i (hi | hi) + · rw [mem_support, coeff_add] + have hy : y.coeff i = 0 := by + rw [← not_ne_iff, ← mem_support] + exact Set.disjoint_left.mp hdisjoint hi + simpa [hy] using (mem_support x i).mp hi + · rw [mem_support, coeff_add] + have hx : x.coeff i = 0 := by + rw [← not_ne_iff, ← mem_support] + exact Set.disjoint_left.mp hdisjoint.symm hi + simpa [hx] using (mem_support y i).mp hi + +/-- A series below every member of a list is below the sum of that list. -/ +theorem supportBelow_list_sum {x : R⟦G⟧} {l : List R⟦G⟧} + (h : ∀ y ∈ l, SupportBelow x y) : SupportBelow x l.sum := by + rw [supportBelow_iff] + intro i hi j hj + induction l with + | nil => simp at hj + | cons y ys ih => + rw [List.sum_cons] at hj + rcases support_add_subset y ys.sum hj with hj | hj + · exact (h y (by simp)).lt hi hj + · exact ih (fun z hz ↦ h z (by simp [hz])) hj + +/-- A sum of series each below `y` is itself below `y`. -/ +theorem list_sum_supportBelow {l : List R⟦G⟧} {y : R⟦G⟧} + (h : ∀ x ∈ l, SupportBelow x y) : SupportBelow l.sum y := by + rw [supportBelow_iff] + intro i hi j hj + induction l with + | nil => simp at hi + | cons x xs ih => + rw [List.sum_cons] at hi + rcases support_add_subset x xs.sum hi with hi | hi + · exact (h x (by simp)).lt hi hj + · exact ih (fun z hz ↦ h z (by simp [hz])) hi + +/-- In a pairwise support-separated list, every summand support is contained in the sum support. -/ +theorem support_subset_list_sum_of_mem {x : R⟦G⟧} {l : List R⟦G⟧} + (hpair : l.Pairwise SupportBelow) (hx : x ∈ l) : x.support ⊆ l.sum.support := by + induction l with + | nil => simp at hx + | cons y ys ih => + rw [List.pairwise_cons] at hpair + have hbelow : SupportBelow y ys.sum := supportBelow_list_sum hpair.1 + rw [List.sum_cons, support_add_eq_union_of_supportBelow y ys.sum hbelow] + simp only [List.mem_cons] at hx + rcases hx with rfl | hx + · exact Set.subset_union_left + · exact (ih hpair.2 hx).trans Set.subset_union_right + +end AddMonoid + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SourceStatements.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SourceStatements.lean new file mode 100644 index 0000000000..2a02ab10e3 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SourceStatements.lean @@ -0,0 +1,31 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.MainLemma +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.OrdinalValueDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ResidualPoint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeResidue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.Factorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.FiniteSupportFactorUniqueness +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteSupportDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalDivisibilityReflection +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringFraction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalScalarRedistribution +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalMaximalDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesMaximalFiniteSupportDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesPrimality + +/-! +# Published statements from LM24 and its prerequisites + +This root exposes the theorem declarations with the hypotheses, quantifiers, and conclusions used +in LM24, together with explicit prerequisites where a proof depends on them. +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupAlgebra.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupAlgebra.lean new file mode 100644 index 0000000000..e6721e59a4 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupAlgebra.lean @@ -0,0 +1,158 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.EPrimitive +public import Mathlib.Algebra.MonoidAlgebra.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupSupport + +/-! +# Series supported in a subgroup as a group ring + +The finite-support series supported in a subgroup `H` of the exponents are the group ring of `H`. +The identification is the algebra map sending a group element to its monomial, so multiplication +is matched by the monomial rule and no convolution computation is needed. + +This is what carries unique factorisation, and with it least common multiples, from the group ring +of a free abelian group of finite rank into the series ring. +-/ + +open scoped HahnSeries + +universe u v + +public noncomputable section + +namespace HahnSeries + +variable {G : Type u} {K : Type v} +variable [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] +variable [Field K] + +/-- Monomials with exponent in a subgroup, as a monoid homomorphism. -/ +def subgroupMonomialHom (H : AddSubgroup G) : Multiplicative H →* K⟦G⟧ where + toFun h := single ((Multiplicative.toAdd h : H) : G) (1 : K) + map_one' := by simp + map_mul' a b := by + rw [HahnSeries.single_mul_single, one_mul] + rfl + +/-- The group ring of a subgroup of the exponents, mapped into the series ring. -/ +def subgroupAlgebraHom (H : AddSubgroup G) : AddMonoidAlgebra K H →ₐ[K] K⟦G⟧ := + AddMonoidAlgebra.lift K (K⟦G⟧) H (subgroupMonomialHom H) + +@[simp] +theorem subgroupAlgebraHom_single (H : AddSubgroup G) (a : H) (b : K) : + subgroupAlgebraHom H (Finsupp.single a b) = single (a : G) b := by + rw [subgroupAlgebraHom, AddMonoidAlgebra.lift_single] + ext g + simp [subgroupMonomialHom, HahnSeries.coeff_single] + +open Classical in +/-- The coefficients of a monomial image. -/ +private theorem coeff_subgroupAlgebraHom_single (H : AddSubgroup G) (a : H) (b : K) (g : G) : + (subgroupAlgebraHom H (Finsupp.single a b)).coeff g + = if hg : g ∈ H then (Finsupp.single a b : H →₀ K) ⟨g, hg⟩ else 0 := by + rw [subgroupAlgebraHom_single, HahnSeries.coeff_single] + by_cases hg : g ∈ H + · rw [dif_pos hg, Finsupp.single_apply] + by_cases hga : g = (a : G) + · rw [if_pos hga, if_pos (Subtype.ext hga.symm : a = ⟨g, hg⟩)] + · rw [if_neg hga, if_neg (fun h : a = ⟨g, hg⟩ ↦ hga (congrArg Subtype.val h).symm)] + · rw [dif_neg hg, if_neg] + rintro rfl + exact hg a.2 + +open Classical in +/-- The coefficients of the image are the coefficients of the group-ring element. -/ +theorem coeff_subgroupAlgebraHom (H : AddSubgroup G) (f : AddMonoidAlgebra K H) (g : G) : + (subgroupAlgebraHom H f).coeff g = if hg : g ∈ H then f ⟨g, hg⟩ else 0 := by + induction f using AddMonoidAlgebra.induction_on with + | hM m => + have hof : (AddMonoidAlgebra.of K H (Multiplicative.ofAdd m) : AddMonoidAlgebra K H) + = Finsupp.single m 1 := rfl + rw [hof] + exact coeff_subgroupAlgebraHom_single H m 1 g + | hadd x y hx hy => + rw [map_add, HahnSeries.coeff_add, hx, hy] + by_cases hg : g ∈ H <;> simp [hg] + | hsmul r x hx => + rw [map_smul, HahnSeries.coeff_smul, hx] + by_cases hg : g ∈ H <;> simp [hg] + +open Classical in +theorem subgroupAlgebraHom_injective (H : AddSubgroup G) : + Function.Injective (subgroupAlgebraHom H (K := K)) := by + intro f₁ f₂ h + ext a + have hc := congrArg (fun x : K⟦G⟧ ↦ x.coeff (a : G)) h + simp only [coeff_subgroupAlgebraHom, dif_pos a.2] at hc + simpa using hc + +open Classical in +theorem support_subgroupAlgebraHom_subset (H : AddSubgroup G) (f : AddMonoidAlgebra K H) : + (subgroupAlgebraHom H f).support ⊆ (H : Set G) := by + intro g hg + rw [HahnSeries.mem_support, coeff_subgroupAlgebraHom] at hg + by_cases hgH : g ∈ H + · exact hgH + · rw [dif_neg hgH] at hg + exact absurd rfl hg + +open Classical in +theorem support_subgroupAlgebraHom_finite (H : AddSubgroup G) (f : AddMonoidAlgebra K H) : + (subgroupAlgebraHom H f).support.Finite := by + refine Set.Finite.subset ((f.support : Finset H).finite_toSet.image ((↑) : H → G)) ?_ + intro g hg + rw [HahnSeries.mem_support, coeff_subgroupAlgebraHom] at hg + by_cases hgH : g ∈ H + · rw [dif_pos hgH] at hg + exact ⟨⟨g, hgH⟩, Finsupp.mem_support_iff.mpr hg, rfl⟩ + · rw [dif_neg hgH] at hg + exact absurd rfl hg + +open Classical in +/-- Every finite-support series supported in `H` comes from the group ring of `H`. -/ +theorem exists_subgroupAlgebraHom_eq + (H : AddSubgroup G) {x : K⟦G⟧} (hfin : x.support.Finite) + (hsub : x.support ⊆ (H : Set G)) : + ∃ f : AddMonoidAlgebra K H, subgroupAlgebraHom H f = x := by + set xf : G →₀ K := Finsupp.onFinset hfin.toFinset x.coeff + (fun a ha ↦ hfin.mem_toFinset.mpr ha) with hxf + have hinj : Set.InjOn ((↑) : H → G) (((↑) : H → G) ⁻¹' xf.support) := + fun a _ b _ hab ↦ Subtype.ext hab + refine ⟨Finsupp.comapDomain ((↑) : H → G) xf hinj, ?_⟩ + ext g + rw [coeff_subgroupAlgebraHom] + by_cases hgH : g ∈ H + · rw [dif_pos hgH, Finsupp.comapDomain_apply, hxf, Finsupp.onFinset_apply] + · rw [dif_neg hgH] + by_contra hne + exact hgH (hsub ((HahnSeries.mem_support _ _).mpr (Ne.symm hne))) + +/-- Divisibility in the group ring of `H` matches divisibility of the images. -/ +theorem dvd_iff_dvdFS_subgroupAlgebraHom (H : AddSubgroup G) (a b : AddMonoidAlgebra K H) : + a ∣ b ↔ DvdFS (subgroupAlgebraHom H a) (subgroupAlgebraHom H b) := by + constructor + · rintro ⟨c, rfl⟩ + exact dvdFS_iff.mpr ⟨subgroupAlgebraHom H c, support_subgroupAlgebraHom_finite H c, + by rw [map_mul]⟩ + · intro h + obtain ⟨w, hwf, hw⟩ := dvdFS_iff.mp h + rcases eq_or_ne (subgroupAlgebraHom H a) 0 with h0 | h0 + · have ha : a = 0 := subgroupAlgebraHom_injective H (by rw [h0, map_zero]) + refine ⟨0, ?_⟩ + refine subgroupAlgebraHom_injective H ?_ + rw [map_mul, map_zero, mul_zero, hw, h0, zero_mul] + · have hwsub : w.support ⊆ (H : Set G) := + support_subset_of_mul_eq (support_subgroupAlgebraHom_subset H a) h0 + (support_subgroupAlgebraHom_subset H b) hw + obtain ⟨c, hc⟩ := exists_subgroupAlgebraHom_eq H hwf hwsub + refine ⟨c, subgroupAlgebraHom_injective H ?_⟩ + rw [map_mul, hc, hw] + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupGCD.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupGCD.lean new file mode 100644 index 0000000000..103adfec48 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupGCD.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.EPrimitive + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupSupport + +/-! +# Transferring least common multiples out of a subgroup of the exponents + +Gilmer and Parker, Theorem 5.2 computes a least common multiple inside a finitely generated +subgroup of the exponents and observes that it stays one in the whole ring, because the ring is a +free module over the subring on coset representatives. + +The same conclusion is reached here without modules. A common multiple is peeled one coset at a +time: multiplying by a factor supported in the subgroup commutes with restricting to a coset, so +each restriction is again a common multiple, and translating it back into the subgroup puts it in +the range of the hypothesis. The remaining part has strictly smaller support, which drives the +induction. +-/ + +open scoped HahnSeries + +universe u v + +public noncomputable section + +namespace HahnSeries + +variable {G : Type u} {K : Type v} +variable [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] +variable [Field K] + +theorem dvdFS_zero (e : K⟦G⟧) : DvdFS e 0 := dvdFS_iff.mpr ⟨0, by simp, by simp⟩ + +theorem DvdFS.add {e a b : K⟦G⟧} (ha : DvdFS e a) (hb : DvdFS e b) : DvdFS e (a + b) := by + obtain ⟨u, huf, hu⟩ := dvdFS_iff.mp ha + obtain ⟨v, hvf, hv⟩ := dvdFS_iff.mp hb + exact dvdFS_iff.mpr ⟨u + v, (huf.union hvf).subset (HahnSeries.support_add_subset u v), + by rw [hu, hv, mul_add]⟩ + +theorem DvdFS.trans {e a b : K⟦G⟧} (h1 : DvdFS e a) (h2 : DvdFS a b) : DvdFS e b := by + obtain ⟨u, huf, hu⟩ := dvdFS_iff.mp h1 + obtain ⟨v, hvf, hv⟩ := dvdFS_iff.mp h2 + refine dvdFS_iff.mpr ⟨u * v, ?_, by rw [hv, hu, mul_assoc]⟩ + exact (huf.add hvf).subset HahnSeries.support_mul_subset + +theorem DvdFS.sub {e a b : K⟦G⟧} (ha : DvdFS e a) (hb : DvdFS e b) : DvdFS e (a - b) := by + obtain ⟨u, huf, hu⟩ := dvdFS_iff.mp ha + obtain ⟨v, hvf, hv⟩ := dvdFS_iff.mp hb + refine dvdFS_iff.mpr ⟨u - v, ?_, by rw [hu, hv, mul_sub]⟩ + refine (huf.union hvf).subset ?_ + rw [sub_eq_add_neg] + refine (HahnSeries.support_add_subset u (-v)).trans ?_ + rw [HahnSeries.support_neg] + +omit [LinearOrder G] [IsOrderedAddMonoid G] in +/-- Membership in a fixed coset is invariant under translation by the subgroup. -/ +private theorem coset_invariant (H : AddSubgroup G) (s : G) : + ∀ i ∈ H, ∀ j : G, (i + j - s ∈ H ↔ j - s ∈ H) := by + intro i hi j + constructor + · intro hij + have hrw : j - s = i + j - s - i := by abel + rw [hrw] + exact H.sub_mem hij hi + · intro hj + have hrw : i + j - s = i + (j - s) := by abel + rw [hrw] + exact H.add_mem hi hj + +open Classical in +/-- Gilmer and Parker, Theorem 5.2: a common multiple property verified inside a subgroup of the +exponents holds against every finite-support common multiple. -/ +theorem dvdFS_of_forall_subgroup {H : AddSubgroup G} {f g h : K⟦G⟧} + (hf : f.support ⊆ (H : Set G)) (hg : g.support ⊆ (H : Set G)) + (hlcm : ∀ m : K⟦G⟧, m.support.Finite → m.support ⊆ (H : Set G) → + DvdFS f m → DvdFS g m → DvdFS h m) + {m : K⟦G⟧} (hmfin : m.support.Finite) (h1 : DvdFS f m) (h2 : DvdFS g m) : DvdFS h m := by + suffices key : ∀ (n : ℕ) (S : Finset G) (w : K⟦G⟧), + S.card ≤ n → w.support ⊆ (S : Set G) → DvdFS f w → DvdFS g w → DvdFS h w by + exact key hmfin.toFinset.card hmfin.toFinset m le_rfl (by simp) h1 h2 + intro n + induction n with + | zero => + intro S w hcard hsub _ _ + have hS : S = ∅ := Finset.card_eq_zero.mp (Nat.le_zero.mp hcard) + rw [hS] at hsub + have hw : w = 0 := by + rw [← HahnSeries.support_eq_empty_iff] + exact Set.subset_empty_iff.mp (by simpa using hsub) + rw [hw] + exact dvdFS_zero h + | succ n ih => + intro S w hcard hsub hfw hgw + rcases eq_or_ne w 0 with rfl | hw0 + · exact dvdFS_zero h + obtain ⟨s, hs⟩ := HahnSeries.support_nonempty_iff.mpr hw0 + have hsS : s ∈ S := by simpa using hsub hs + have hwfin : w.support.Finite := (S.finite_toSet).subset hsub + have hinv := coset_invariant H s + -- restrict to the coset of `s`; the rest is the difference + have hdvd : ∀ e : K⟦G⟧, e.support ⊆ (H : Set G) → DvdFS e w → + DvdFS e (filter (fun g ↦ g - s ∈ H) w) := by + intro e he hew + obtain ⟨u, huf, rfl⟩ := dvdFS_iff.mp hew + exact dvdFS_iff.mpr ⟨filter (fun g ↦ g - s ∈ H) u, + huf.subset (HahnSeries.support_filter_subset _ u), + filter_mul_of_invariant he (fun g ↦ g - s ∈ H) hinv⟩ + have hf₀ := hdvd f hf hfw + have hg₀ := hdvd g hg hgw + have hcoeff : ∀ x : G, + (w - filter (fun g ↦ g - s ∈ H) w).coeff x = if x - s ∈ H then 0 else w.coeff x := by + intro x + rw [HahnSeries.coeff_sub, HahnSeries.coeff_filter] + by_cases hx : x - s ∈ H <;> simp [hx] + -- the remaining part misses `s`, so its support fits in a smaller finset + have hrest : DvdFS h (w - filter (fun g ↦ g - s ∈ H) w) := by + refine ih (S.erase s) _ ?_ ?_ (hfw.sub hf₀) (hgw.sub hg₀) + · have := Finset.card_erase_of_mem hsS + omega + · intro x hx + rw [HahnSeries.mem_support, hcoeff x] at hx + by_cases hxp : x - s ∈ H + · exact absurd (if_pos hxp) hx + · rw [if_neg hxp] at hx + refine Finset.mem_coe.mpr (Finset.mem_erase.mpr ⟨?_, ?_⟩) + · rintro rfl + exact hxp (by simp) + · simpa using hsub ((HahnSeries.mem_support _ _).mpr hx) + -- the coset part translates into the subgroup, where the hypothesis applies + have hcoset : DvdFS h (filter (fun g ↦ g - s ∈ H) w) := by + set w₀ := filter (fun g ↦ g - s ∈ H) w with hw₀ + have hback : translate s (translate (-s) w₀) = w₀ := by + rw [HahnSeries.translate_add_apply] + simp + have hsupp : (translate (-s) w₀).support ⊆ (H : Set G) := by + rw [HahnSeries.support_translate] + rintro _ ⟨x, hx, rfl⟩ + rw [hw₀, HahnSeries.support_filter] at hx + change -s + x ∈ (H : Set G) + rw [show -s + x = x - s from by abel] + exact hx.2 + have hfin : (translate (-s) w₀).support.Finite := by + rw [HahnSeries.support_translate] + exact (hwfin.subset (hw₀ ▸ HahnSeries.support_filter_subset _ w)).image _ + have hkey := hlcm _ hfin hsupp + (by rw [← hback] at hf₀; exact dvdFS_translate_iff.mp hf₀) + (by rw [← hback] at hg₀; exact dvdFS_translate_iff.mp hg₀) + rw [← hback] + exact dvdFS_translate_iff.mpr hkey + have hsum : filter (fun g ↦ g - s ∈ H) w + (w - filter (fun g ↦ g - s ∈ H) w) = w := by + abel + rw [← hsum] + exact hcoset.add hrest + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupSupport.lean new file mode 100644 index 0000000000..f92f252e14 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupSupport.lean @@ -0,0 +1,143 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Truncation +public import Mathlib.RingTheory.HahnSeries.Multiplication + +/-! +# Series supported in a subgroup of the exponents + +Splitting a series into the part supported in a subgroup `H` and the rest is compatible with +multiplication by a series supported in `H`, because `H` and its complement are separated by +translation: adding an element of `H` cannot move an exponent into `H` from outside it. + +The consequence recorded here is that divisibility descends: if a series supported in `H` divides +another one in the whole ring, the quotient is again supported in `H`. This is the reason a +finitely generated subgroup of the exponents may be fixed once and for all when computing +divisors, and it replaces the free-module argument of Gilmer and Parker, Proposition 5.1 for the +purpose of comparing divisibility. +-/ + +open scoped HahnSeries + +universe u v + +public noncomputable section + +namespace HahnSeries + +variable {G : Type u} {K : Type v} +variable [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] +variable [Field K] + +omit [AddCommGroup G] [IsOrderedAddMonoid G] in +open Classical in +/-- Restricting to the exponents satisfying a predicate and to those failing it splits a +series. -/ +theorem filter_add_filter_not (p : G → Prop) (x : K⟦G⟧) : + filter p x + filter (fun g ↦ ¬ p g) x = x := by + ext g + rw [HahnSeries.coeff_add, HahnSeries.coeff_filter, HahnSeries.coeff_filter] + by_cases hg : p g <;> simp [hg] + +/-- A product of a series supported in `H` with one supported outside `H` is supported outside +`H`. -/ +private theorem support_mul_subset_compl {H : AddSubgroup G} {e y : K⟦G⟧} + (he : e.support ⊆ (H : Set G)) (hy : ∀ g ∈ y.support, g ∉ H) : + ∀ g ∈ (e * y).support, g ∉ H := by + intro g hg + obtain ⟨i, hi, j, hj, rfl⟩ := HahnSeries.support_mul_subset hg + intro hmem + exact hy j hj (by simpa using H.sub_mem hmem (he hi)) + +/-- Divisibility descends to a subgroup of the exponents: a quotient of two series supported in +`H` is again supported in `H`. -/ +theorem support_subset_of_mul_eq {H : AddSubgroup G} {e u f : K⟦G⟧} + (he : e.support ⊆ (H : Set G)) (he0 : e ≠ 0) + (hf : f.support ⊆ (H : Set G)) (hmul : f = e * u) : + u.support ⊆ (H : Set G) := by + classical + set u₀ := filter (fun g ↦ g ∈ H) u with hu₀ + set u₁ := filter (fun g ↦ g ∉ H) u with hu₁ + have hsplit : u₀ + u₁ = u := filter_add_filter_not _ u + have h₀ : u₀.support ⊆ (H : Set G) := by + rw [hu₀, HahnSeries.support_filter] + exact fun g hg ↦ hg.2 + have h₁ : ∀ g ∈ u₁.support, g ∉ H := by + rw [hu₁] + intro g hg + rw [HahnSeries.support_filter] at hg + exact hg.2 + have hprod₀ : (e * u₀).support ⊆ (H : Set G) := by + intro g hg + obtain ⟨i, hi, j, hj, rfl⟩ := HahnSeries.support_mul_subset hg + exact H.add_mem (he hi) (h₀ hj) + have hprod₁ := support_mul_subset_compl he h₁ + have hzero : e * u₁ = 0 := by + ext g + by_cases hg : g ∈ H + · by_contra hne + exact hprod₁ g ((HahnSeries.mem_support _ _).mpr hne) hg + · have hfg : f.coeff g = 0 := by + by_contra hne + exact hg (hf ((HahnSeries.mem_support _ _).mpr hne)) + have h₀g : (e * u₀).coeff g = 0 := by + by_contra hne + exact hg (hprod₀ ((HahnSeries.mem_support _ _).mpr hne)) + have hexp : f = e * u₀ + e * u₁ := by rw [hmul, ← mul_add, hsplit] + have := congrArg (fun s : K⟦G⟧ ↦ s.coeff g) hexp + simp only [HahnSeries.coeff_add, hfg, h₀g, zero_add] at this + simpa using this.symm + have hu₁zero : u₁ = 0 := by + rcases mul_eq_zero.mp hzero with h | h + · exact absurd h he0 + · exact h + intro g hg + rw [← hsplit, hu₁zero, add_zero] at hg + exact h₀ hg + +open Classical in +/-- Multiplying by a series supported in `H` commutes with restricting to the exponents satisfying +a predicate that is invariant under translation by `H`. -/ +theorem filter_mul_of_invariant {H : AddSubgroup G} {f u : K⟦G⟧} + (hf : f.support ⊆ (H : Set G)) + (p : G → Prop) + (hp : ∀ i ∈ H, ∀ j : G, p (i + j) ↔ p j) : + filter p (f * u) = f * filter p u := by + ext c + rw [HahnSeries.coeff_filter, HahnSeries.coeff_mul, HahnSeries.coeff_mul] + have hsub : Finset.addAntidiagonal f.isPWO_support (filter p u).isPWO_support c + ⊆ Finset.addAntidiagonal f.isPWO_support u.isPWO_support c := by + intro b hb + rw [Finset.mem_addAntidiagonal] at hb ⊢ + exact ⟨hb.1, HahnSeries.support_filter_subset _ u hb.2.1, hb.2.2⟩ + have hrestrict : ∀ b ∈ Finset.addAntidiagonal f.isPWO_support (filter p u).isPWO_support c, + f.coeff b.1 * (filter p u).coeff b.2 = f.coeff b.1 * u.coeff b.2 := by + intro b hb + rw [Finset.mem_addAntidiagonal] at hb + rw [HahnSeries.support_filter] at hb + rw [HahnSeries.coeff_filter, if_pos hb.2.1.2] + by_cases hc : p c + · rw [if_pos hc] + refine Finset.sum_congr ?_ (fun b hb ↦ (hrestrict b hb).symm) + refine Finset.Subset.antisymm (fun b hb ↦ ?_) hsub + rw [Finset.mem_addAntidiagonal] at hb ⊢ + obtain ⟨hb1, hb2, hb0⟩ := hb + refine ⟨hb1, ?_, hb0⟩ + rw [HahnSeries.support_filter] + refine ⟨hb2, ?_⟩ + exact (hp b.1 (hf hb1) b.2).mp (by rw [hb0]; exact hc) + · rw [if_neg hc] + refine (Finset.sum_eq_zero fun b hb ↦ ?_).symm + rw [Finset.mem_addAntidiagonal] at hb + rw [HahnSeries.support_filter] at hb + refine absurd ?_ hc + have hb0 := hb.2.2 + rw [← hb0] + exact (hp b.1 (hf hb.1) b.2).mpr hb.2.1.2 + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SupportArchimedeanClasses.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SupportArchimedeanClasses.lean new file mode 100644 index 0000000000..6d2f19a346 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SupportArchimedeanClasses.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +public import Mathlib.Algebra.Order.Archimedean.Class +public import Mathlib.Order.WellFounded +public import Mathlib.RingTheory.HahnSeries.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.FinitePWOUnion +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Archimedean classes met by a nonpositive Hahn support + +The Archimedean-class order puts elements of smaller magnitude in higher classes. Consequently, +on nonpositive exponents the class map is monotone: moving an exponent toward zero moves its class +up. The Archimedean classes met by a well-founded nonpositive support are therefore well ordered +in the ascending class order. + +This orientation is the one needed by the Conway induction. Restriction to the closed class ball at +`c` keeps classes at least `c`; its complement consists of classes strictly below `c`, a proper +initial segment when the support meets `c`. +-/ + +universe u + +open Set + +namespace ArchimedeanClass + +variable {G : Type u} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + +public section + +/-- On nonpositive elements, the Archimedean-class map is monotone. -/ +theorem mk_le_mk_of_le_of_nonpos {a b : G} (hab : a ≤ b) (hb : b ≤ 0) : + ArchimedeanClass.mk a ≤ ArchimedeanClass.mk b := by + refine ArchimedeanClass.mk_le_mk_of_abs ?_ + rw [abs_of_nonpos hb, abs_of_nonpos (hab.trans hb)] + exact neg_le_neg hab + +/-- An element outside the closed class ball at `c` has class strictly below `c`. -/ +theorem mk_lt_of_not_mem_closedBallAddSubgroup {c : ArchimedeanClass G} {g : G} + (hg : g ∉ closedBallAddSubgroup c) : ArchimedeanClass.mk g < c := by + rw [mem_closedBallAddSubgroup_iff] at hg + exact lt_of_not_ge hg + +end + +end ArchimedeanClass + +namespace HahnSeries + +variable {G : Type u} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + +public section + +/-- The Archimedean classes of the nonzero exponents in a nonpositive Hahn series. Exponent zero +is excluded because the complementary factor has constant coefficient one; including its class +would prevent the induction rank from decreasing. -/ +def Nonpositive.nonzeroSupportArchimedeanClasses + {R : Type*} [Ring R] (x : Nonpositive G R) : Set (ArchimedeanClass G) := + ArchimedeanClass.mk '' ((x : R⟦G⟧).support \ {0}) + +/-- Membership among the Archimedean classes of the nonzero support. -/ +theorem Nonpositive.mem_nonzeroSupportArchimedeanClasses_iff + {R : Type*} [Ring R] {x : Nonpositive G R} {c : ArchimedeanClass G} : + c ∈ x.nonzeroSupportArchimedeanClasses ↔ + ∃ g ∈ (x : R⟦G⟧).support, g ≠ 0 ∧ ArchimedeanClass.mk g = c := by + rw [nonzeroSupportArchimedeanClasses] + constructor + · rintro ⟨g, ⟨hg, hg0⟩, hgc⟩ + exact ⟨g, hg, by simpa only [Set.mem_singleton_iff] using hg0, hgc⟩ + · rintro ⟨g, hg, hg0, hgc⟩ + exact ⟨g, ⟨hg, by simpa only [Set.mem_singleton_iff] using hg0⟩, hgc⟩ + +/-- The Archimedean classes met by a well-founded nonpositive set are well ordered ascending. -/ +theorem exists_min_mem_image_mk_of_isWF {S : Set G} (hS : S.IsWF) (hS0 : S ⊆ Set.Iic 0) + {T : Set (ArchimedeanClass G)} (hT : T ⊆ ArchimedeanClass.mk '' S) (hne : T.Nonempty) : + ∃ c ∈ T, ∀ d ∈ T, c ≤ d := by + classical + let P : Set G := {g ∈ S | ArchimedeanClass.mk g ∈ T} + have hPS : P ⊆ S := fun _ hg ↦ hg.1 + have hPne : P.Nonempty := by + obtain ⟨c, hc⟩ := hne + obtain ⟨g, hgS, hgc⟩ := hT hc + exact ⟨g, hgS, by rw [hgc]; exact hc⟩ + have hPwf : P.IsWF := hS.subset hPS + refine ⟨ArchimedeanClass.mk (hPwf.min hPne), (hPwf.min_mem hPne).2, fun d hd ↦ ?_⟩ + obtain ⟨g, hgS, rfl⟩ := hT hd + exact ArchimedeanClass.mk_le_mk_of_le_of_nonpos + (hPwf.min_le hPne ⟨hgS, hd⟩) (hS0 hgS) + +/-- The Archimedean classes met by a nonpositive Hahn support are well ordered ascending. -/ +theorem exists_min_mem_image_mk_support {R : Type*} [Zero R] (x : R⟦G⟧) + (hx : x.support ⊆ Set.Iic 0) {T : Set (ArchimedeanClass G)} + (hT : T ⊆ ArchimedeanClass.mk '' x.support) (hne : T.Nonempty) : + ∃ c ∈ T, ∀ d ∈ T, c ≤ d := + exists_min_mem_image_mk_of_isWF x.isWF_support hx hT hne + +/-- The classes met by a nonpositive Hahn support have well-founded strict order. -/ +theorem wellFounded_supportArchimedeanClasses {R : Type*} [Zero R] (x : R⟦G⟧) + (hx : x.support ⊆ Set.Iic 0) : + WellFounded ((· < ·) : + {c : ArchimedeanClass G // c ∈ ArchimedeanClass.mk '' x.support} → + {c : ArchimedeanClass G // c ∈ ArchimedeanClass.mk '' x.support} → Prop) := by + rw [WellFounded.wellFounded_iff_has_min] + intro U hU + let V : Set (ArchimedeanClass G) := Subtype.val '' U + have hVne : V.Nonempty := by + obtain ⟨c, hc⟩ := hU + exact ⟨c, c, hc, rfl⟩ + have hVsub : V ⊆ ArchimedeanClass.mk '' x.support := by + rintro _ ⟨c, -, rfl⟩ + exact c.2 + obtain ⟨c, hcV, hcmin⟩ := exists_min_mem_image_mk_support x hx hVsub hVne + obtain ⟨c', hc'U, hc'c⟩ := hcV + refine ⟨c', hc'U, ?_⟩ + intro d hdU hdc + exact (not_lt_of_ge (hcmin d ⟨d, hdU, rfl⟩)) (hc'c ▸ hdc) + +/-- The Archimedean classes met by a nonpositive Hahn series are partially well ordered. -/ +theorem Nonpositive.isPWO_supportArchimedeanClasses + {R : Type*} [Ring R] (x : Nonpositive G R) : + (ArchimedeanClass.mk '' (x : R⟦G⟧).support).IsPWO := by + apply (x : R⟦G⟧).isPWO_support.image_of_monotoneOn + intro a ha b hb hab + exact ArchimedeanClass.mk_le_mk_of_abs (by + rw [abs_of_nonpos (Nonpositive.support_subset x hb), + abs_of_nonpos (Nonpositive.support_subset x ha)] + exact neg_le_neg hab) + +/-- The Archimedean classes of the nonzero support are partially well ordered. -/ +theorem Nonpositive.isPWO_nonzeroSupportArchimedeanClasses + {R : Type*} [Ring R] (x : Nonpositive G R) : + x.nonzeroSupportArchimedeanClasses.IsPWO := by + apply x.isPWO_supportArchimedeanClasses.mono + exact Set.image_mono Set.sdiff_subset + +/-- If the nonzero support classes of one series lie strictly below a support class of another, +their order type is strictly smaller. -/ +@[blueprint "lem:support-class-order-type-strict-decrease" + (phase := "Refinement over Archimedean classes") + (title := "Strict decrease of support-class order type") + (statement := /-- + Let $x,y\in K((G^{\le0}))$. If $c$ is a nonzero Archimedean class met by + $\operatorname{supp}(x)$ and every nonzero class met by + $\operatorname{supp}(y)$ is a class met by $\operatorname{supp}(x)$ and is + strictly below $c$, then the order type of the nonzero support classes of + $y$ is strictly + smaller than that of $x$. + -/) + (proof := /-- + The classes met by either nonpositive support are partially well ordered. + Monotonicity of order type embeds the classes of $y$ into the initial + segment of the classes of $x$ below $c$, and a proper initial segment of a + well-order has strictly smaller order type. + -/)] +theorem Nonpositive.orderType_nonzeroSupportArchimedeanClasses_lt + {R : Type*} [Ring R] (x y : Nonpositive G R) + {c : ArchimedeanClass G} (hc : c ∈ x.nonzeroSupportArchimedeanClasses) + (hsub : y.nonzeroSupportArchimedeanClasses ⊆ + x.nonzeroSupportArchimedeanClasses ∩ Set.Iio c) : + y.isPWO_nonzeroSupportArchimedeanClasses.orderType < + x.isPWO_nonzeroSupportArchimedeanClasses.orderType := by + let hxbelow := x.isPWO_nonzeroSupportArchimedeanClasses.mono + (s := x.nonzeroSupportArchimedeanClasses ∩ Set.Iio c) Set.inter_subset_left + exact (y.isPWO_nonzeroSupportArchimedeanClasses.orderType_mono hxbelow hsub).trans_lt + (x.isPWO_nonzeroSupportArchimedeanClasses.orderType_inter_Iio_lt hc) + +/-- For a finite family of nonpositive Hahn series, the classes met by their supports are either +finite or split into an initial block of nonzero limit order type and a finite final block. -/ +theorem Nonpositive.finite_or_exists_limit_initial_finite_final_supportArchimedeanClasses + {R : Type*} [Ring R] {ι : Type*} [Finite ι] (x : ι → Nonpositive G R) : + let s := ⋃ i, ArchimedeanClass.mk '' (x i : R⟦G⟧).support + s.Finite ∨ + ∃ (s₀ s₁ : Set (ArchimedeanClass G)) (hs₀ : s₀.IsPWO) (_ : s₁.IsPWO), + s₀ ⊆ s ∧ + s₁ ⊆ s ∧ + (∀ a ∈ s₀, ∀ b ∈ s₁, a < b) ∧ + Order.IsSuccLimit hs₀.orderType ∧ + s₁.Finite ∧ + s = s₀ ∪ s₁ := by + dsimp only + apply Set.IsPWO.finite_or_exists_limit_initial_finite_final + exact Set.IsPWO.iUnion_of_finite _ fun i ↦ + Nonpositive.isPWO_supportArchimedeanClasses (x i) + +end + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SupportSupremum.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SupportSupremum.lean new file mode 100644 index 0000000000..dd500181d0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SupportSupremum.lean @@ -0,0 +1,226 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Translation +public import Mathlib.Algebra.Order.Archimedean.Real.Basic + +/-! +# Supremum of the support of a nonpositive real Hahn series + +For a Hahn series supported in `ℝ⁽≤0⁾`, `HahnSeries.Nonpositive.supportSup` is the +supremum from LM24, Definition 3.1.3. Its codomain is `WithBot ℝ`: the zero series has value +`⊥`, while a nonzero series has the ordinary real supremum of its nonempty, bounded support. +The least-upper-bound characterization certifies this semantic identification directly. + +The addition and multiplication inequalities are LM24, Proposition 3.1.4. Normalization translates +a series by the negative of its real support supremum. A nonzero normalized series is again +nonpositive and has support supremum zero; this is the normalization used in the proof of LM24, +Proposition 3.3.7. + +This operation is deliberately not extended to arbitrary real Hahn series. An unbounded support +has no value in `WithBot ℝ`, and LM24, Remark 3.3.9 uses precisely this obstruction to show that +arbitrary real Hahn series need not have normal forms. + +The construction uses conditional completeness of the reals. Its public characterization and +monomial formula avoid exposing the underlying supremum calculation. +-/ + +universe v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {R : Type v} [Ring R] + +/-- The supremum of a nonpositive real Hahn-series support, with value `⊥` at zero. -/ +def supportSup (x : Nonpositive ℝ R) : WithBot ℝ := + sSup ((fun a : ℝ ↦ (a : WithBot ℝ)) '' (x : R⟦ℝ⟧).support) + +/-- Negation preserves the support supremum. -/ +@[simp] +theorem supportSup_neg (x : Nonpositive ℝ R) : supportSup (-x) = supportSup x := by + simp only [supportSup, Subring.coe_neg, HahnSeries.support_neg] + +/-- A nonpositive real Hahn-series support is bounded above by zero. -/ +theorem bddAbove_support (x : Nonpositive ℝ R) : + BddAbove (x : R⟦ℝ⟧).support := + ⟨0, support_subset x⟩ + +@[simp] +theorem supportSup_zero : supportSup (0 : Nonpositive ℝ R) = ⊥ := by + rw [supportSup] + simp + +/-- On a nonzero series, `supportSup` is the ordinary real supremum of the support. -/ +theorem supportSup_of_ne {x : Nonpositive ℝ R} (hx : x ≠ 0) : + supportSup x = (sSup (x : R⟦ℝ⟧).support : ℝ) := by + rw [supportSup] + have hx' : (x : R⟦ℝ⟧) ≠ 0 := by simpa using hx + exact (WithBot.coe_sSup' (support_nonempty_iff.mpr hx') (bddAbove_support x)).symm + +/-- The support supremum is `⊥` exactly at the zero series. -/ +@[simp] +theorem supportSup_eq_bot {x : Nonpositive ℝ R} : supportSup x = ⊥ ↔ x = 0 := by + constructor + · intro h + by_contra hx + rw [supportSup_of_ne hx] at h + exact WithBot.coe_ne_bot h + · rintro rfl + exact supportSup_zero + +/-- Characterization of a finite support-supremum value by the least-upper-bound property. -/ +theorem supportSup_eq_coe_iff {x : Nonpositive ℝ R} {a : ℝ} : + supportSup x = (a : WithBot ℝ) ↔ + x ≠ 0 ∧ IsLUB (x : R⟦ℝ⟧).support a := by + constructor + · intro h + have hx : x ≠ 0 := by + intro hzero + subst x + simp at h + have hx' : (x : R⟦ℝ⟧) ≠ 0 := by simpa using hx + rw [supportSup_of_ne hx, WithBot.coe_eq_coe] at h + exact ⟨hx, h ▸ isLUB_csSup (support_nonempty_iff.mpr hx') (bddAbove_support x)⟩ + · rintro ⟨hx, ha⟩ + have hx' : (x : R⟦ℝ⟧) ≠ 0 := by simpa using hx + rw [supportSup_of_ne hx, WithBot.coe_eq_coe] + exact ha.csSup_eq (support_nonempty_iff.mpr hx') + +/-- The support supremum of a nonpositive series is at most zero. -/ +theorem supportSup_le_zero (x : Nonpositive ℝ R) : supportSup x ≤ 0 := by + by_cases hx : x = 0 + · subst x + simp + · rw [supportSup_of_ne hx] + norm_cast + have hx' : (x : R⟦ℝ⟧) ≠ 0 := by simpa using hx + exact csSup_le (support_nonempty_iff.mpr hx') (support_subset x) + +/-- The support supremum of a nonzero monomial is its exponent. -/ +theorem supportSup_single {x : ℝ} {r : R} (hr : r ≠ 0) (hx : x ≤ 0) : + supportSup (single x r hx) = x := by + have hne : single x r hx ≠ 0 := by + intro h + have h' : HahnSeries.single x r = (0 : R⟦ℝ⟧) := by + simpa only [coe_single, Subring.coe_zero] using congrArg Subtype.val h + exact HahnSeries.single_ne_zero hr h' + rw [supportSup_of_ne hne] + norm_cast + rw [coe_single, HahnSeries.support_single_of_ne hr, csSup_singleton] + +/-- Support supremum satisfies the ultrametric addition inequality. This is LM24, Proposition +3.1.4(1). -/ +theorem supportSup_add_le (x y : Nonpositive ℝ R) : + supportSup (x + y) ≤ max (supportSup x) (supportSup y) := by + by_cases hsum : x + y = 0 + · rw [hsum, supportSup_zero] + exact bot_le + by_cases hx : x = 0 + · subst x + simp + by_cases hy : y = 0 + · subst y + simp + rw [supportSup_of_ne hsum, supportSup_of_ne hx, supportSup_of_ne hy] + norm_cast + have hsum' : ((x + y : Nonpositive ℝ R) : R⟦ℝ⟧) ≠ 0 := + fun h ↦ hsum (Subtype.ext h) + apply csSup_le (support_nonempty_iff.mpr hsum') + intro g hg + rcases support_add_subset (x : R⟦ℝ⟧) y hg with hg | hg + · exact (le_csSup (bddAbove_support x) hg).trans (le_max_left _ _) + · exact (le_csSup (bddAbove_support y) hg).trans (le_max_right _ _) + +/-- Support supremum is submultiplicative. This is LM24, Proposition 3.1.4(2). -/ +theorem supportSup_mul_le (x y : Nonpositive ℝ R) : + supportSup (x * y) ≤ supportSup x + supportSup y := by + by_cases hxy : x * y = 0 + · rw [hxy, supportSup_zero] + exact bot_le + have hx : x ≠ 0 := fun h ↦ hxy (h ▸ zero_mul y) + have hy : y ≠ 0 := fun h ↦ hxy (h ▸ mul_zero x) + rw [supportSup_of_ne hxy, supportSup_of_ne hx, supportSup_of_ne hy] + norm_cast + have hxy' : ((x * y : Nonpositive ℝ R) : R⟦ℝ⟧) ≠ 0 := + fun h ↦ hxy (Subtype.ext h) + apply csSup_le (support_nonempty_iff.mpr hxy') + intro g hg + obtain ⟨i, hi, j, hj, rfl⟩ := support_mul_subset hg + exact add_le_add (le_csSup (bddAbove_support x) hi) + (le_csSup (bddAbove_support y) hj) + +end HahnSeries.Nonpositive + +namespace HahnSeries + +variable {R : Type v} [Ring R] + +/-- Translating a nonzero bounded real Hahn-series support translates its real supremum. -/ +theorem csSup_support_translate {x : R⟦ℝ⟧} (hx : x ≠ 0) + (hbounded : BddAbove x.support) (a : ℝ) : + sSup (translate a x).support = a + sSup x.support := by + rw [support_translate] + exact ((OrderIso.addLeft a).map_csSup' (support_nonempty_iff.mpr hx) hbounded).symm + +namespace Nonpositive + +/-- Translate a nonpositive series by the negative of the real supremum of its support. For a +nonzero series, the result has support supremum zero. -/ +def normalize (x : Nonpositive ℝ R) : Nonpositive ℝ R := + ⟨translate (-sSup (x : R⟦ℝ⟧).support) x, by + rw [mem_nonpositiveSubring, support_translate] + rintro _ ⟨g, hg, rfl⟩ + have hgSup : g ≤ sSup (x : R⟦ℝ⟧).support := + le_csSup (bddAbove_support x) hg + simpa [sub_eq_add_neg, add_comm] using sub_nonpos.mpr hgSup⟩ + +@[simp] +theorem coe_normalize (x : Nonpositive ℝ R) : + (normalize x : R⟦ℝ⟧) = translate (-sSup (x : R⟦ℝ⟧).support) x := + (rfl) + +@[simp] +theorem normalize_zero : normalize (0 : Nonpositive ℝ R) = 0 := by + apply Subtype.ext + simp + +/-- Normalization preserves nonzeroness. -/ +theorem normalize_ne_zero {x : Nonpositive ℝ R} (hx : x ≠ 0) : normalize x ≠ 0 := by + intro hzero + have hval := congrArg Subtype.val hzero + change translate (-sSup (x : R⟦ℝ⟧).support) (x : R⟦ℝ⟧) = (0 : R⟦ℝ⟧) at hval + have hxval : (x : R⟦ℝ⟧) = 0 := + (translate _).injective (hval.trans (map_zero _).symm) + exact hx (Subtype.ext hxval) + +/-- Translating a normalized series back by its original support supremum recovers the series. -/ +theorem translate_csSup_normalize (x : Nonpositive ℝ R) : + translate (sSup (x : R⟦ℝ⟧).support) (normalize x : R⟦ℝ⟧) = x := by + rw [coe_normalize, translate_add_apply] + simp + +/-- Normalization preserves ordinary support order type. -/ +theorem supportOrderType_normalize (x : Nonpositive ℝ R) : + (normalize x : R⟦ℝ⟧).supportOrderType = (x : R⟦ℝ⟧).supportOrderType := by + rw [coe_normalize, supportOrderType_translate] + +/-- A nonzero normalized series has support supremum zero. -/ +theorem supportSup_normalize {x : Nonpositive ℝ R} (hx : x ≠ 0) : + supportSup (normalize x) = 0 := by + rw [supportSup_of_ne (normalize_ne_zero hx)] + norm_cast + rw [coe_normalize, csSup_support_translate] + · simp + · simpa using hx + · exact bddAbove_support x + +end Nonpositive + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests.lean new file mode 100644 index 0000000000..fd01aa4089 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests.lean @@ -0,0 +1,24 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.ArchimedeanSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.CardinalTruncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportGCD +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportResidue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportScalarExtension +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Iterate +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Multiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NegativePresentation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NonpositiveDomainEquiv +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.OrderTypeDegree +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.PrincipalAddition +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Truncation +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.TruncationIntegerPartPrimal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.WeakNormalForm + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/ArchimedeanSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/ArchimedeanSplitting.lean new file mode 100644 index 0000000000..4fad872c31 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/ArchimedeanSplitting.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ArchimedeanSplitting + +/-! +# API checks for the Hahn-series Archimedean splitting + +The check is polymorphic in independent stratum and ball coordinates and verifies that a monomial +on their sum becomes a nested monomial coefficient at exactly those two coordinates. In +particular, it certifies the dominant-then-infinitesimal orientation without unfolding either +equivalence. +-/ + +public noncomputable section + +namespace Tests + +open FiniteArchimedeanClass + +variable {K M : Type*} [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup M] [LinearOrder M] [IsOrderedAddMonoid M] +variable [Module K M] [IsOrderedModule K M] + +open HahnEmbedding in +theorem archimedeanSeriesSplitting_monomial_coeff + (u : ArchimedeanStrata K M) (c : FiniteArchimedeanClass M) + (s : u.stratum c) (b : ball K c) : + ((HahnSeries.archimedeanSplitRingEquiv u c + (HahnSeries.single + (ArchimedeanStrata.stratumLexBallEquivClosedBall u c (toLex (s, b))) (13 : ℤ))).coeff + s).coeff b = 13 := by + rw [HahnSeries.archimedeanSplitRingEquiv_coeff] + simp + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/CardinalTruncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/CardinalTruncation.lean new file mode 100644 index 0000000000..ef8ca67f0e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/CardinalTruncation.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation + +/-! +# API checks for cardinal-bounded Hahn truncation integer parts + +This separately compiled client exercises the support-cofinality and zero-exponent-group +fraction-field branches. These checks certify the public interfaces; the cofinality proof itself +provides the nondegenerate semantic content by constructing a monomial denominator for an +arbitrary bounded series. +-/ + +universe u v + +public noncomputable section + +open Cardinal + +namespace Tests + +open HahnSeries + +theorem cardSuppLTTruncation_fraction_of_cofinality + {G : Type u} {R : Type v} {κ : Cardinal.{u}} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Field R] + [Fact (ℵ₀ < κ)] (Z : Subring R) (hcof : κ ≤ Order.cof G) : + Subring.fracSubring + (cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) = ⊤ := + fracSubring_cardSuppLTTruncationIntegerPart_eq_top_of_le_cof Z hcof + +theorem cardSuppLTTruncation_fraction_of_zero_exponent_group + {G : Type u} {R : Type v} {κ : Cardinal.{u}} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Subsingleton G] [Field R] + [Fact (ℵ₀ < κ)] (Z : Subring R) (hfrac : Subring.fracSubring Z = ⊤) : + Subring.fracSubring + (cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) = ⊤ := + fracSubring_cardSuppLTTruncationIntegerPart_eq_top_of_subsingleton Z hfrac + +theorem zero_mem_cardSuppLTTruncationIntegerPart + {G : Type u} {R : Type v} {κ : Cardinal.{u}} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Field R] + [Fact (ℵ₀ < κ)] (Z : Subring R) : + (0 : CardSuppLTField (G := G) (R := R) (κ := κ)) ∈ + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z := by + rw [mem_cardSuppLTTruncationIntegerPart] + simp + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportGCD.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportGCD.lean new file mode 100644 index 0000000000..d5b0e225f6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportGCD.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit + +/-! +# API checks for LM24, Fact 2.5.2 + +The monomial `t⁻¹` is a unit in the finite-support ring on the whole exponent group `ℤ`, with +inverse `t`. The same underlying Hahn series is not a unit in the nonpositive finite-support +ring, because its inverse has positive exponent. This distinguishes LM24's unit statement from +the nearby incorrect statement for the full group ring. + +The gcd fixture uses the pair `(0, t⁻¹)`, with a witness associated to `t⁻¹`. Its exact +characterization is `e ∣ 0 ∧ e ∣ t⁻¹ ↔ e ∣ d`. This checks the zero boundary and the +greatest-common-divisor orientation in the second part of Fact 2.5.2. +-/ + +open scoped HahnSeries + +public noncomputable section + +namespace Tests + +abbrev IntegerNonpositiveFiniteSupportRing := + HahnSeries.Nonpositive.finiteSupportSubring (G := ℤ) (K := ℚ) + +abbrev IntegerFiniteSupportRing := + (HahnSeries.finiteSupportSubring : Subring ℚ⟦ℤ⟧) + +/-- The nonpositive exponent `-1`. -/ +def negativeExponent : HahnSeries.Nonpositive.exponentMonoid ℤ := + ⟨-1, by norm_num⟩ + +/-- The monomial `t⁻¹` in the nonpositive finite-support ring. -/ +def nonpositiveNegativeMonomial : IntegerNonpositiveFiniteSupportRing := + HahnSeries.Nonpositive.finiteSupportMonomial (K := ℚ) negativeExponent + +/-- The monomial `t⁻¹` is not a unit in the nonpositive finite-support ring. -/ +theorem nonpositiveNegativeMonomial_not_isUnit : + ¬ IsUnit nonpositiveNegativeMonomial := by + rw [HahnSeries.Nonpositive.isUnit_finiteSupport_iff_exists_scalar] + rintro ⟨k, -, h⟩ + have hcoeff := congrArg + (fun p : IntegerNonpositiveFiniteSupportRing ↦ + (((p : HahnSeries.Nonpositive ℤ ℚ) : ℚ⟦ℤ⟧).coeff (-1))) h + simp [nonpositiveNegativeMonomial, negativeExponent] at hcoeff + +/-- The monomial `t⁻¹` in the finite-support ring on the whole exponent group. -/ +def fullNegativeMonomial : IntegerFiniteSupportRing := + ⟨HahnSeries.single (-1) 1, by + rw [HahnSeries.mem_finiteSupportSubring_iff] + exact Set.Finite.subset (Set.finite_singleton (-1)) + HahnSeries.support_single_subset⟩ + +/-- The monomial `t` in the finite-support ring on the whole exponent group. -/ +def fullPositiveMonomial : IntegerFiniteSupportRing := + ⟨HahnSeries.single 1 1, by + rw [HahnSeries.mem_finiteSupportSubring_iff] + exact Set.Finite.subset (Set.finite_singleton 1) + HahnSeries.support_single_subset⟩ + +theorem fullNegativeMonomial_mul_fullPositiveMonomial : + fullNegativeMonomial * fullPositiveMonomial = 1 := by + apply Subtype.ext + simp [fullNegativeMonomial, fullPositiveMonomial, HahnSeries.single_mul_single] + +theorem fullPositiveMonomial_mul_fullNegativeMonomial : + fullPositiveMonomial * fullNegativeMonomial = 1 := by + apply Subtype.ext + simp [fullNegativeMonomial, fullPositiveMonomial, HahnSeries.single_mul_single] + +/-- In the full exponent-group finite-support ring, `t⁻¹` is a unit with inverse `t`. -/ +theorem fullNegativeMonomial_isUnit : IsUnit fullNegativeMonomial := by + exact ⟨{ + val := fullNegativeMonomial + inv := fullPositiveMonomial + val_inv := fullNegativeMonomial_mul_fullPositiveMonomial + inv_val := fullPositiveMonomial_mul_fullNegativeMonomial + }, rfl⟩ + +/-- The full-ring and nonpositive-ring fixtures have the same underlying Hahn series. -/ +theorem fullNegativeMonomial_eq_nonpositiveNegativeMonomial : + (fullNegativeMonomial : ℚ⟦ℤ⟧) = + ((nonpositiveNegativeMonomial : HahnSeries.Nonpositive ℤ ℚ) : ℚ⟦ℤ⟧) := by + simp [fullNegativeMonomial, nonpositiveNegativeMonomial, negativeExponent] + +/-- The gcd supplied for `(0, t⁻¹)` is associated to `t⁻¹` and satisfies the exact defining +orientation from LM24, Fact 2.5.2. -/ +theorem finiteSupportGCD_zero_left : + ∃ d : IntegerNonpositiveFiniteSupportRing, + (d ∣ nonpositiveNegativeMonomial ∧ nonpositiveNegativeMonomial ∣ d) ∧ + ∀ e : IntegerNonpositiveFiniteSupportRing, + e ∣ 0 ∧ e ∣ nonpositiveNegativeMonomial ↔ e ∣ d := by + obtain ⟨d, hd⟩ := HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists + (0 : IntegerNonpositiveFiniteSupportRing) nonpositiveNegativeMonomial + refine ⟨d, ⟨?_, ?_⟩, hd⟩ + · exact ((hd d).mpr dvd_rfl).2 + · exact (hd nonpositiveNegativeMonomial).mp ⟨dvd_zero _, dvd_rfl⟩ + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportResidue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportResidue.lean new file mode 100644 index 0000000000..0106a2f8e3 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportResidue.lean @@ -0,0 +1,129 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportResidue + +/-! +# API checks for the degree-zero residue ring + +A two-term nonpositive series belongs to the finite-support subring and has a nonzero coefficient +at exponent `-1`, so this subring cannot be replaced by the constants. The approach-to-zero +series has support order type `ω` and is excluded, so the finite-support subring cannot be replaced +by the whole nonpositive Hahn ring. For any valuation realizing degree, the residue equivalence +sends the two-term series to a nonzero class. +-/ + +public noncomputable section + +open scoped DirectSum HahnSeries + +namespace Tests + +/-- A nonconstant two-term nonpositive Hahn series. -/ +def finiteSupportTwoTerm : HahnSeries.Nonpositive ℝ ℚ := + HahnSeries.Nonpositive.C 1 + + HahnSeries.Nonpositive.single (-1) 1 (by norm_num) + +/-- The two-term fixture has a nonzero coefficient at exponent `-1`. -/ +theorem finiteSupportTwoTerm_coeff_neg_one : + (finiteSupportTwoTerm : ℚ⟦ℝ⟧).coeff (-1) = 1 := by + simp [finiteSupportTwoTerm] + +/-- The two-term fixture has constant coefficient one. -/ +theorem finiteSupportTwoTerm_coeff_zero : + (finiteSupportTwoTerm : ℚ⟦ℝ⟧).coeff 0 = 1 := by + simp [finiteSupportTwoTerm] + +/-- The two-term fixture belongs to the finite-support subring. -/ +theorem finiteSupportTwoTerm_mem : + finiteSupportTwoTerm ∈ + (HahnSeries.Nonpositive.finiteSupportSubring : + Subring (HahnSeries.Nonpositive ℝ ℚ)) := by + rw [HahnSeries.Nonpositive.mem_finiteSupportSubring_iff] + apply Set.Finite.subset + ((Set.finite_singleton 0).union (Set.finite_singleton (-1))) + intro x hx + rcases HahnSeries.support_add_subset _ _ hx with hx | hx + · left + rw [HahnSeries.Nonpositive.coe_C] at hx + exact HahnSeries.support_single_subset hx + · right + rw [HahnSeries.Nonpositive.coe_single] at hx + exact HahnSeries.support_single_subset hx + +/-- The finite-support subring contains more than the constant series. -/ +theorem finiteSupportTwoTerm_not_constant : + ∀ q : ℚ, finiteSupportTwoTerm ≠ HahnSeries.Nonpositive.C q := by + intro q h + have hcoeff := congrArg + (fun b : HahnSeries.Nonpositive ℝ ℚ ↦ (b : ℚ⟦ℝ⟧).coeff (-1)) h + have hconstant : + ((HahnSeries.Nonpositive.C q : HahnSeries.Nonpositive ℝ ℚ) : + ℚ⟦ℝ⟧).coeff (-1) = 0 := by + rw [HahnSeries.Nonpositive.coe_C, HahnSeries.C_apply] + simp + rw [finiteSupportTwoTerm_coeff_neg_one, hconstant] at hcoeff + exact one_ne_zero hcoeff + +/-- An infinite nonpositive support is not in the finite-support subring. -/ +theorem approachZero_not_mem_finiteSupportSubring : + approachZeroNonpositive ∉ + (HahnSeries.Nonpositive.finiteSupportSubring : + Subring (HahnSeries.Nonpositive ℝ ℚ)) := by + rw [HahnSeries.Nonpositive.mem_finiteSupportSubring_iff] + intro hfinite + have hlt := HahnSeries.support_finite_iff_supportOrderType_lt_omega.mp hfinite + rw [coe_approachZeroNonpositive, approachZero_supportOrderType] at hlt + exact (lt_irrefl Ordinal.omega0) hlt + +section Residue + +variable (w : MaxAddDegree (HahnSeries.Nonpositive ℝ ℚ) NatOrdinal) + (hvalue : ∀ b, w b = (b : ℚ⟦ℝ⟧).degree) + +/-- The two-term fixture as an element of the finite-support subring. -/ +def finiteSupportTwoTermInSubring : + (HahnSeries.Nonpositive.finiteSupportSubring : + Subring (HahnSeries.Nonpositive ℝ ℚ)) := + ⟨finiteSupportTwoTerm, finiteSupportTwoTerm_mem⟩ + +/-- The residue equivalence does not kill the nonconstant two-term fixture. -/ +theorem finiteSupportTwoTerm_residue_ne_zero : + HahnSeries.Nonpositive.finiteSupportResidueEquiv w hvalue + finiteSupportTwoTermInSubring ≠ 0 := by + intro himage + have hzero : finiteSupportTwoTermInSubring = 0 := by + apply (HahnSeries.Nonpositive.finiteSupportResidueEquiv w hvalue).injective + rw [himage, map_zero] + have hcoeff := congrArg + (fun b : HahnSeries.Nonpositive ℝ ℚ ↦ (b : ℚ⟦ℝ⟧).coeff (-1)) + (congrArg Subtype.val hzero) + simp [finiteSupportTwoTermInSubring, finiteSupportTwoTerm_coeff_neg_one] at hcoeff + +/-- The transported `rv` class agrees with the residue isomorphism on the two-term fixture. -/ +theorem finiteSupportTwoTerm_rv_residue_compatibility [w.IsMultiplicative] : + (w.rvEquivHomogeneous (w.rv finiteSupportTwoTerm) : w.AssociatedGraded) = + w.residueRingHom + (HahnSeries.Nonpositive.finiteSupportResidueEquiv w hvalue + finiteSupportTwoTermInSubring) := + HahnSeries.Nonpositive.coe_rvEquivHomogeneous_rv_eq_residueRingHom_finiteSupportResidueEquiv + w hvalue finiteSupportTwoTermInSubring + +/-- The RV/residue compatibility includes the bottom-valued zero class. -/ +theorem finiteSupportZero_rv_residue_compatibility [w.IsMultiplicative] : + (w.rvEquivHomogeneous (w.rv (0 : HahnSeries.Nonpositive ℝ ℚ)) : + w.AssociatedGraded) = + w.residueRingHom + (HahnSeries.Nonpositive.finiteSupportResidueEquiv w hvalue + (0 : HahnSeries.Nonpositive.finiteSupportSubring)) := + HahnSeries.Nonpositive.coe_rvEquivHomogeneous_rv_eq_residueRingHom_finiteSupportResidueEquiv + w hvalue 0 + +end Residue + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportScalarExtension.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportScalarExtension.lean new file mode 100644 index 0000000000..f3fd68ec3d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportScalarExtension.lean @@ -0,0 +1,198 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarExtension + +/-! +# API checks for finite-support coefficient extension + +The integer fixture has nonzero coefficients at exponents `0` and `-1`. Its scalar extension to +the rationals retains both coefficients, so it rejects maps that preserve only constants, delete +the nonconstant term, or move its exponent. The rational fixture with coefficient `1 / 2` at +exponent `-1` is not in the image of integer scalar extension; this separates the exact +coefficientwise range from the full rational finite-support ring and from a support-only test. + +The diagonal map `ℚ → ℚ × ℚ` supplies a separate scalar-recovery test. Multiplying the +extended nonzero fixture by the constant `(1, 0)` leaves the image, because that coefficient is +not diagonal. This exercises the step in Remark 6.3.5 which recovers a redistributed scalar from +one nonzero coefficient. An identity-map fixture then exercises the generic divisibility-reflection +reduction with an explicit scalar-redistribution witness. +-/ + +open scoped HahnSeries + +namespace Tests.HahnSeries.FiniteSupportScalarExtension + +public noncomputable section + +/-- The nonpositive exponent `-1` used by the coefficient-extension fixtures. -/ +def negativeOne : HahnSeries.Nonpositive.exponentMonoid ℤ := + ⟨-1, by norm_num⟩ + +/-- A finite-support integer series with coefficients `3` at `0` and `2` at `-1`. -/ +def integerFixture : + HahnSeries.Nonpositive.FiniteSupportRing (G := ℤ) (K := ℤ) := + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℤ) 3 + + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℤ) 2 * + HahnSeries.Nonpositive.finiteSupportMonomial (K := ℤ) negativeOne + +/-- The coefficientwise extension of `integerFixture` from `ℤ` to `ℚ`. -/ +def rationalFixture : + HahnSeries.Nonpositive.FiniteSupportRing (G := ℤ) (K := ℚ) := + HahnSeries.Nonpositive.finiteSupportScalarExtension + (G := ℤ) (K := ℤ) (L := ℚ) integerFixture + +/-- Scalar extension maps both coefficients and preserves the nonconstant exponent. -/ +theorem rationalFixture_eq : + rationalFixture = + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℤ) (3 : ℚ) + + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℤ) (2 : ℚ) * + HahnSeries.Nonpositive.finiteSupportMonomial (K := ℚ) negativeOne := by + rw [rationalFixture, integerFixture, map_add, map_mul, + HahnSeries.Nonpositive.finiteSupportScalarExtension_scalar, + HahnSeries.Nonpositive.finiteSupportScalarExtension_scalar, + HahnSeries.Nonpositive.finiteSupportScalarExtension_monomial] + norm_num + +/-- The nonconstant coefficient survives scalar extension and is mapped to `2 : ℚ`. -/ +theorem rationalFixture_negativeOne_coeff : + HahnSeries.Nonpositive.finiteSupportCoefficients rationalFixture negativeOne = 2 := by + rw [rationalFixture_eq, + ← HahnSeries.Nonpositive.smul_finiteSupport_eq_scalar_mul, + map_add, map_smul] + simp [HahnSeries.Nonpositive.finiteSupportCoefficients_apply, + HahnSeries.Nonpositive.coe_finiteSupportScalarHom, negativeOne] + +/-- The constant coefficient survives scalar extension and is mapped to `3 : ℚ`. -/ +theorem rationalFixture_zero_coeff : + HahnSeries.Nonpositive.finiteSupportCoefficients rationalFixture + (0 : HahnSeries.Nonpositive.exponentMonoid ℤ) = 3 := by + rw [rationalFixture_eq, + ← HahnSeries.Nonpositive.smul_finiteSupport_eq_scalar_mul, + map_add, map_smul] + simp [HahnSeries.Nonpositive.finiteSupportCoefficients_apply, + HahnSeries.Nonpositive.coe_finiteSupportScalarHom, negativeOne] + +/-- The scalar-extended integer fixture belongs to the image by construction. -/ +theorem rationalFixture_mem_range : + rationalFixture ∈ Set.range + (HahnSeries.Nonpositive.finiteSupportScalarExtension + (G := ℤ) (K := ℤ) (L := ℚ)) := + ⟨integerFixture, rfl⟩ + +/-- A rational finite-support series whose nonconstant coefficient is not an integer. -/ +def rationalOutside : + HahnSeries.Nonpositive.FiniteSupportRing (G := ℤ) (K := ℚ) := + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℤ) 3 + + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℤ) (1 / 2 : ℚ) * + HahnSeries.Nonpositive.finiteSupportMonomial (K := ℚ) negativeOne + +/-- The coefficient of `rationalOutside` at exponent `-1` is `1 / 2`. -/ +theorem rationalOutside_negativeOne_coeff : + HahnSeries.Nonpositive.finiteSupportCoefficients rationalOutside negativeOne = 1 / 2 := by + rw [rationalOutside, + ← HahnSeries.Nonpositive.smul_finiteSupport_eq_scalar_mul, + map_add, map_smul] + simp [HahnSeries.Nonpositive.finiteSupportCoefficients_apply, + HahnSeries.Nonpositive.coe_finiteSupportScalarHom, negativeOne] + +/-- A nonintegral coefficient prevents membership in the image of integer scalar extension. -/ +theorem rationalOutside_not_mem_range : + rationalOutside ∉ Set.range + (HahnSeries.Nonpositive.finiteSupportScalarExtension + (G := ℤ) (K := ℤ) (L := ℚ)) := by + rw [HahnSeries.Nonpositive.mem_range_finiteSupportScalarExtension_iff] + push Not + refine ⟨negativeOne, ?_⟩ + rw [rationalOutside_negativeOne_coeff] + rintro ⟨z, hz⟩ + change (z : ℚ) = 1 / 2 at hz + have hz' : (2 : ℚ) * (z : ℚ) = 1 := by + rw [hz] + norm_num + have hzInt : 2 * z = 1 := by + exact_mod_cast hz' + omega + +/-- Scalar extension from integer to rational finite-support series is injective. -/ +theorem integer_scalarExtension_injective : + Function.Injective + (HahnSeries.Nonpositive.finiteSupportScalarExtension + (G := ℤ) (K := ℤ) (L := ℚ)) := + HahnSeries.Nonpositive.finiteSupportScalarExtension_injective + (Int.cast_injective : Function.Injective (algebraMap ℤ ℚ)) + +/-- The diagonal embedding of the rationals into the product ring. -/ +def rationalDiagonal : ℚ →+* ℚ × ℚ := + (RingHom.id ℚ).prod (RingHom.id ℚ) + +/-- The scalar `(1, 0)` does not belong to the image of the diagonal embedding. -/ +theorem one_zero_not_mem_rationalDiagonal_range : + (1, 0) ∉ Set.range rationalDiagonal := by + rintro ⟨q, hq⟩ + have hfirst := congrArg Prod.fst hq + have hsecond := congrArg Prod.snd hq + change q = 1 at hfirst + change q = 0 at hsecond + exact zero_ne_one (hsecond.symm.trans hfirst) + +/-- The rational fixture is nonzero, witnessed by its coefficient at exponent `-1`. -/ +theorem rationalFixture_ne_zero : rationalFixture ≠ 0 := by + intro hzero + have hcoeff := congrArg + (fun p : HahnSeries.Nonpositive.FiniteSupportRing (G := ℤ) (K := ℚ) ↦ + HahnSeries.Nonpositive.finiteSupportCoefficients p negativeOne) hzero + rw [rationalFixture_negativeOne_coeff] at hcoeff + simp at hcoeff + +/-- Multiplication by the non-diagonal scalar `(1, 0)` takes the extended nonzero fixture out of +the diagonal coefficient image. -/ +theorem diagonalFixture_mul_one_zero_not_mem_range : + HahnSeries.Nonpositive.finiteSupportMap rationalDiagonal rationalFixture * + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℤ) (1, 0) ∉ + Set.range (HahnSeries.Nonpositive.finiteSupportMap (G := ℤ) rationalDiagonal) := by + intro hmem + have hscalar := + HahnSeries.Nonpositive.coefficient_mem_range_of_map_mul_scalar_mem_range + (Field.toIsField ℚ) rationalDiagonal rationalFixture_ne_zero hmem + exact one_zero_not_mem_rationalDiagonal_range hscalar + +/-- Scalar redistribution is immediate for the identity coefficient map: choose the scalar one. -/ +theorem identity_exists_scalarRedistribution : + ∀ {p₁ p₂ : HahnSeries.Nonpositive.FiniteSupportRing (G := ℤ) (K := ℚ)}, + p₁ ≠ 0 → p₂ ≠ 0 → + p₁ * p₂ ∈ Set.range + (HahnSeries.Nonpositive.finiteSupportMap (G := ℤ) (RingHom.id ℚ)) → + ∃ B : ℚ, + B ≠ 0 ∧ + p₁ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℤ) B ∈ + Set.range (HahnSeries.Nonpositive.finiteSupportMap + (G := ℤ) (RingHom.id ℚ)) ∧ + p₂ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℤ) B⁻¹ ∈ + Set.range (HahnSeries.Nonpositive.finiteSupportMap + (G := ℤ) (RingHom.id ℚ)) := by + intro p₁ p₂ _ _ _ + refine ⟨1, one_ne_zero, ⟨p₁, ?_⟩, ⟨p₂, ?_⟩⟩ <;> + simp [HahnSeries.Nonpositive.finiteSupportMap_id] + +/-- The generic reduction recovers a nonconstant divisibility relation from its image under the +identity coefficient map. -/ +theorem identity_reflects_nonconstant_divisibility : + rationalFixture ∣ rationalFixture * rationalOutside := by + have hlarge : + HahnSeries.Nonpositive.finiteSupportMap (RingHom.id ℚ) rationalFixture ∣ + HahnSeries.Nonpositive.finiteSupportMap (RingHom.id ℚ) + (rationalFixture * rationalOutside) := by + rw [HahnSeries.Nonpositive.finiteSupportMap_id] + exact dvd_mul_right _ _ + exact (HahnSeries.Nonpositive.finiteSupportMap_dvd_iff_of_scalarRedistribution + (RingHom.id ℚ) Function.injective_id identity_exists_scalarRedistribution + rationalFixture (rationalFixture * rationalOutside)).mp hlarge + +end + +end Tests.HahnSeries.FiniteSupportScalarExtension diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Fixtures.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Fixtures.lean new file mode 100644 index 0000000000..a47b53909d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Fixtures.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Fixtures/ApproachZero.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Fixtures/ApproachZero.lean new file mode 100644 index 0000000000..35cd4a361f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Fixtures/ApproachZero.lean @@ -0,0 +1,168 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Domain + +/-! +# A principal Hahn series approaching exponent zero + +This module provides the shared nondegenerate fixture + +``` +∑ n : ℕ, t ^ (-1 / (n + 1)). +``` + +Its support has ordinary order type `ω`, is cofinal in zero, and does not contain zero. Thus its +support supremum is an unattained least upper bound, and the series is principal in the sense of +LM24. API-client modules use these proved properties to test normal forms, truncation bounds, +the negative-monomial ideal, and multiplicativity without duplicating the series. + +This is shared example infrastructure for the checks, not part of the mathematical API. +-/ + +public noncomputable section + +namespace Tests + +open scoped HahnSeries NatOrdinal + +/-- The coefficient-one Hahn series on `ℕ`. -/ +def natOnes : ℚ⟦ℕ⟧ where + coeff _ := 1 + isPWO_support' := by + simpa [Function.support] using Set.IsPWO.of_linearOrder (Set.univ : Set ℕ) + +/-- Every coefficient of `natOnes` is one. -/ +@[simp] +theorem natOnes_coeff (n : ℕ) : natOnes.coeff n = 1 := + (rfl) + +/-- The support of `natOnes` is all of `ℕ`. -/ +@[simp] +theorem natOnes_support : natOnes.support = Set.univ := by + ext n + simp [HahnSeries.mem_support] + +private theorem approachZero_strictMono : + StrictMono (fun n : ℕ ↦ -(1 / (n + 1 : ℝ))) := + strictMono_nat_of_lt_succ fun n ↦ by + apply neg_lt_neg + apply one_div_lt_one_div_of_lt + · positivity + · norm_num + +/-- The order embedding `n ↦ -1/(n+1)`. -/ +def approachZeroEmbedding : ℕ ↪o ℝ := + OrderEmbedding.ofStrictMono _ approachZero_strictMono + +/-- Evaluation of the exponent embedding used by `approachZero`. -/ +@[simp] +theorem approachZeroEmbedding_apply (n : ℕ) : + approachZeroEmbedding n = -(1 / (n + 1 : ℝ)) := + (rfl) + +/-- The coefficient-one series on the support `{-1/(n+1) | n ∈ ℕ}`. -/ +def approachZero : ℚ⟦ℝ⟧ := + HahnSeries.embDomain approachZeroEmbedding natOnes + +/-- The coefficient at every embedded exponent is one. -/ +theorem approachZero_coeff_embedding (n : ℕ) : + approachZero.coeff (approachZeroEmbedding n) = 1 := by + rw [approachZero, HahnSeries.embDomain_coeff, natOnes_coeff] + +/-- The support of `approachZero` is exactly the range of its exponent embedding. -/ +theorem approachZero_support : + approachZero.support = Set.range approachZeroEmbedding := by + rw [approachZero, HahnSeries.support_embDomain, natOnes_support, + Set.image_univ] + +/-- `approachZero` regarded as a nonpositive Hahn series. -/ +def approachZeroNonpositive : HahnSeries.Nonpositive ℝ ℚ := + ⟨approachZero, by + rw [HahnSeries.mem_nonpositiveSubring, approachZero_support] + rintro _ ⟨n, rfl⟩ + exact neg_nonpos.mpr (by + change 0 ≤ 1 / (n + 1 : ℝ) + positivity)⟩ + +/-- Coercing `approachZeroNonpositive` recovers the underlying real Hahn series. -/ +@[simp] +theorem coe_approachZeroNonpositive : + (approachZeroNonpositive : ℚ⟦ℝ⟧) = approachZero := + (rfl) + +/-- The nonpositive `approachZero` series is nonzero. -/ +theorem approachZero_ne_zero : approachZeroNonpositive ≠ 0 := by + intro hzero + have hval := congrArg Subtype.val hzero + change approachZero = (0 : ℚ⟦ℝ⟧) at hval + have hmem : approachZeroEmbedding 0 ∈ approachZero.support := by + rw [approachZero_support] + exact Set.mem_range_self 0 + exact (HahnSeries.support_nonempty_iff.mp ⟨_, hmem⟩) hval + +private theorem approachZero_isLUB : IsLUB approachZero.support 0 := by + rw [approachZero_support] + constructor + · rintro _ ⟨n, rfl⟩ + exact neg_nonpos.mpr (by + change 0 ≤ 1 / (n + 1 : ℝ) + positivity) + · intro a ha + by_contra hnot + have haNeg : a < 0 := lt_of_not_ge hnot + obtain ⟨n, hn⟩ := exists_nat_one_div_lt (neg_pos.mpr haNeg) + have hmem : approachZeroEmbedding n ∈ Set.range approachZeroEmbedding := ⟨n, rfl⟩ + have hle := ha hmem + change -(1 / (n + 1 : ℝ)) ≤ a at hle + linarith + +/-- The support supremum of `approachZero` is zero, although zero is not in its support. -/ +theorem approachZero_supportSup : + HahnSeries.Nonpositive.supportSup approachZeroNonpositive = 0 := by + apply HahnSeries.Nonpositive.supportSup_eq_coe_iff.mpr + exact ⟨approachZero_ne_zero, approachZero_isLUB⟩ + +/-- The supremum zero of `approachZero` is not attained by its support. -/ +theorem zero_not_mem_approachZero_support : 0 ∉ approachZero.support := by + rw [approachZero_support] + rintro ⟨n, hn⟩ + have hneg : approachZeroEmbedding n < 0 := by + change -(1 / (n + 1 : ℝ)) < 0 + exact neg_lt_zero.mpr (by positivity) + exact hneg.ne hn + +/-- The support of `approachZero` has ordinary order type `ω`. -/ +theorem approachZero_supportOrderType : + approachZero.supportOrderType = Ordinal.omega0 := by + rw [HahnSeries.supportOrderType_eq_setOrderType] + have e : approachZero.support ≃o ℕ := + (OrderIso.setCongr approachZero.support (Set.range approachZeroEmbedding) + approachZero_support).trans approachZeroEmbedding.orderIso.symm + exact approachZero.isPWO_support.orderType_eq_typeLT_of_orderIso e |>.trans + Ordinal.type_nat_lt + +/-- The Hahn-series degree of `approachZero` is one. -/ +theorem approachZero_degree_eq_one : + (approachZeroNonpositive : ℚ⟦ℝ⟧).degree = + (1 : WithBot NatOrdinal) := by + rw [HahnSeries.degree_eq_cantorDegree, coe_approachZeroNonpositive, + approachZero_supportOrderType, Ordinal.cantorDegree_omega] + +/-- `approachZero` is a nonconstant principal series of support order type `ω`. -/ +theorem approachZero_isPrincipal : + HahnSeries.Nonpositive.IsPrincipal approachZeroNonpositive := by + rw [HahnSeries.Nonpositive.isPrincipal_iff] + constructor + · rw [HahnSeries.isWeaklyPrincipal_iff, coe_approachZeroNonpositive, + approachZero_supportOrderType] + simpa using Ordinal.isAdditivelyPrincipal_omega0_opow 1 + · exact approachZero_supportSup + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Iterate.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Iterate.lean new file mode 100644 index 0000000000..7347fa5346 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Iterate.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Iterate +public import Mathlib.Algebra.Order.Group.Int + +/-! +# API checks for iterated Hahn series + +This file checks the public ring equivalence on nested monomials. Both exponent coordinates are +nonzero and unequal. Their product appears at the coordinatewise sum in outer-then-inner order and +not at the swapped coordinate, separating the intended flattening from the nearest orientation +error. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries + +/-- A nested monomial with outer exponent `2` and inner exponent `3`. -/ +def firstIteratedMonomial : ℚ⟦ℤ⟧⟦ℤ⟧ := single 2 (single 3 5) + +/-- A nested monomial with outer exponent `7` and inner exponent `11`. -/ +def secondIteratedMonomial : ℚ⟦ℤ⟧⟦ℤ⟧ := single 7 (single 11 13) + +theorem iterateRingEquiv_product_coeff : + (iterateRingEquiv (firstIteratedMonomial * secondIteratedMonomial)).coeff + (toLex ((9 : ℤ), (14 : ℤ))) = 65 := by + simp [firstIteratedMonomial, secondIteratedMonomial, single_mul_single] + norm_num + +theorem iterateRingEquiv_product_coeff_swapped : + (iterateRingEquiv (firstIteratedMonomial * secondIteratedMonomial)).coeff + (toLex ((14 : ℤ), (9 : ℤ))) = 0 := by + simp [firstIteratedMonomial, secondIteratedMonomial, single_mul_single] + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Multiplicativity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Multiplicativity.lean new file mode 100644 index 0000000000..c6c3f8ce6e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Multiplicativity.lean @@ -0,0 +1,165 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Multiplicativity + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree + +/-! +# API checks for LM24 degree multiplicativity + +The zero-factor certificate exposes the missing nonzero hypothesis in the printed first case of +LM24, Lemma 3.4.2: the empty support is strictly above every cutoff, but the claimed strict degree +inequality becomes `⊥ < ⊥`. + +The nonzero monomial certificate exercises the repaired strict-support case at a genuinely +separated cutoff. A separate endpoint theorem shows that replacing `Set.Ioi` by `Set.Ici` would +incorrectly admit the monomial at its own exponent when its degree is zero. + +The final two certificates exercise both the parameterized reduction in LM24, Proposition 3.4.3 +and the characteristic-zero theorem on the same non-weakly-principal series. +-/ + +public noncomputable section + +namespace Tests + +open scoped HahnSeries + +/-- The coefficient-one monomial at exponent `-1`, regarded as nonpositive. -/ +def negativeOneMonomial : HahnSeries.Nonpositive ℝ ℚ := + HahnSeries.Nonpositive.single (-1) 1 (by norm_num) + +@[simp] +theorem negativeOneMonomial_coe : + (negativeOneMonomial : ℚ⟦ℝ⟧) = HahnSeries.single (-1) 1 := + by + simpa only [negativeOneMonomial] using + HahnSeries.Nonpositive.coe_single (-1 : ℝ) (1 : ℚ) (by norm_num) + +theorem negativeOneMonomial_ne_zero : negativeOneMonomial ≠ 0 := by + intro hzero + have hcoeff := congrArg + (fun x : HahnSeries.Nonpositive ℝ ℚ ↦ (x : ℚ⟦ℝ⟧).coeff (-1)) hzero + norm_num [negativeOneMonomial] at hcoeff + +/-- The monomial support lies strictly above the cutoff `-2`. -/ +theorem negativeOneMonomial_support_subset_Ioi_neg_two : + (negativeOneMonomial : ℚ⟦ℝ⟧).support ⊆ Set.Ioi (-2) := by + intro i hi + rw [negativeOneMonomial_coe] at hi + have hi' : i = -1 := HahnSeries.eq_of_mem_support_single hi + rw [hi'] + norm_num + +/-- Repaired LM24, Lemma 3.4.2(1) applies to a nonzero separated monomial. -/ +theorem strictSupport_truncation_degree_lt : + (HahnSeries.truncLE (-2) + (((1 : HahnSeries.Nonpositive ℝ ℚ) * negativeOneMonomial : + HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧)).degree < + ((1 : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).degree + + (negativeOneMonomial : ℚ⟦ℝ⟧).degree := by + exact HahnSeries.Nonpositive.degree_truncLE_mul_lt + HahnSeries.Nonpositive.isPrincipal_one negativeOneMonomial_ne_zero + (Or.inl negativeOneMonomial_support_subset_Ioi_neg_two) + +/-- At its own exponent, the monomial support is weakly but not strictly above the cutoff. -/ +theorem negativeOneMonomial_endpoint_separator : + (negativeOneMonomial : ℚ⟦ℝ⟧).support ⊆ Set.Ici (-1) ∧ + ¬(negativeOneMonomial : ℚ⟦ℝ⟧).support ⊆ Set.Ioi (-1) := by + constructor + · intro i hi + rw [negativeOneMonomial_coe] at hi + rw [HahnSeries.eq_of_mem_support_single hi] + exact (le_rfl : (-1 : ℝ) ≤ -1) + · intro h + have hmem : + (-1 : ℝ) ∈ (negativeOneMonomial : ℚ⟦ℝ⟧).support := by + rw [negativeOneMonomial_coe, HahnSeries.support_single_of_ne one_ne_zero] + simp + exact (lt_irrefl (-1 : ℝ)) (h hmem) + +/-- Counterexample to the first case of the printed LM24, Lemma 3.4.2 when `c = 0`. -/ +theorem printed_degree_truncLE_mul_lt_case_one_zero_counterexample (x : ℝ) : + ((0 : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).support ⊆ Set.Ioi x ∧ + ¬(HahnSeries.truncLE x + (((1 : HahnSeries.Nonpositive ℝ ℚ) * 0 : + HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧)).degree < + ((1 : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).degree + + ((0 : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).degree := by + constructor + · simp + · simp + +/-- A two-term nonpositive series whose support order type is two. -/ +def twoTermNonprincipal : HahnSeries.Nonpositive ℝ ℚ := + negativeOneMonomial + 1 + +private theorem twoTermNonprincipal_coe : + (twoTermNonprincipal : ℚ⟦ℝ⟧) = + HahnSeries.single (-1) 1 + HahnSeries.single 0 1 := by + ext i + simp [twoTermNonprincipal, negativeOneMonomial] + +theorem twoTermNonprincipal_supportOrderType : + (twoTermNonprincipal : ℚ⟦ℝ⟧).supportOrderType = 2 := by + have hbelow : + HahnSeries.SupportBelow + (HahnSeries.single (-1 : ℝ) (1 : ℚ)) + (HahnSeries.single 0 (1 : ℚ)) := by + rw [HahnSeries.supportBelow_iff] + intro i hi j hj + rw [HahnSeries.eq_of_mem_support_single hi, + HahnSeries.eq_of_mem_support_single hj] + norm_num + rw [twoTermNonprincipal_coe] + have htype := (HahnSeries.supportOrderType_eq_add_iff + (HahnSeries.single (-1 : ℝ) (1 : ℚ) + HahnSeries.single 0 1) + 1 1).mpr + ⟨HahnSeries.single (-1) 1, HahnSeries.single 0 1, hbelow, + HahnSeries.supportOrderType_single one_ne_zero, + HahnSeries.supportOrderType_single one_ne_zero, + rfl⟩ + calc + (HahnSeries.single (-1 : ℝ) (1 : ℚ) + + HahnSeries.single 0 1).supportOrderType = + (1 : Ordinal) + 1 := htype + _ = 2 := by norm_num + +/-- The two-term series is not weakly principal; support order type two is not a power of `ω`. -/ +theorem twoTermNonprincipal_not_isWeaklyPrincipal : + ¬HahnSeries.IsWeaklyPrincipal (twoTermNonprincipal : ℚ⟦ℝ⟧) := by + intro hprincipal + have hp := + (Ordinal.isAdditivelyPrincipal_iff_ne_zero_and_isPrincipal_add.mp + (HahnSeries.isWeaklyPrincipal_iff.mp hprincipal)).2 + rw [twoTermNonprincipal_supportOrderType] at hp + have hone : (1 : Ordinal) < 2 := by norm_num + have hfalse := hp hone hone + norm_num at hfalse + +/-- The parameterized LM24, Proposition 3.4.3 applies beyond weakly principal factors. -/ +theorem twoTermNonprincipal_square_degree_of_orderTypeMultiplicative + (h : + HahnSeries.Nonpositive.OrderTypeMultiplicativeOnWeaklyPrincipal ℚ) : + ((twoTermNonprincipal * twoTermNonprincipal : + HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).degree = + (twoTermNonprincipal : ℚ⟦ℝ⟧).degree + + (twoTermNonprincipal : ℚ⟦ℝ⟧).degree := + HahnSeries.Nonpositive.degree_mul_of_orderTypeMultiplicativeOnWeaklyPrincipal + h twoTermNonprincipal twoTermNonprincipal + +/-- LM24, Theorem D applies beyond the weakly-principal input class used in its Berarducci +prerequisite. -/ +theorem twoTermNonprincipal_square_degree : + ((twoTermNonprincipal * twoTermNonprincipal : + HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).degree = + (twoTermNonprincipal : ℚ⟦ℝ⟧).degree + + (twoTermNonprincipal : ℚ⟦ℝ⟧).degree := + HahnSeries.Nonpositive.degree_mul _ _ + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NegativePresentation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NegativePresentation.lean new file mode 100644 index 0000000000..89dfee48f3 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NegativePresentation.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Negative +public import Mathlib.Algebra.Order.Ring.Rat +import Mathlib.Tactic.NormNum + +/-! +# API checks for the strictly negative presentation + +This file checks the public presentation of a truncation integer part as the pointwise sum of +integral constants and strictly negative Hahn series. The examples distinguish strict-negative +support from nonpositive support, exercise multiplication in the nonunital negative ring, and +verify existence and uniqueness for a nonconstant element of `TIP(ℤ, ℚ, ℚ)`. +-/ + +public noncomputable section + +namespace Tests + +open scoped Pointwise + +open HahnSeries + +/-- The monomial `3t⁻¹`, regarded as a strictly negative rational Hahn series. -/ +def negativeMonomial : Negative ℚ ℚ := + Negative.single (-1) 3 (by norm_num) + +theorem negativeMonomial_coeff_neg_one : + (negativeMonomial : HahnSeries ℚ ℚ).coeff (-1) = 3 := by + simp [negativeMonomial] + +theorem negativeMonomial_constantCoeff : + Nonpositive.constantCoeff (Γ := ℚ) (R := ℚ) negativeMonomial = 0 := + Negative.constantCoeff_eq_zero negativeMonomial + +theorem one_not_mem_negativeIdeal : + (1 : Nonpositive ℚ ℚ) ∉ negativeIdeal ℚ ℚ := by + intro h + have hzero := Negative.constantCoeff_eq_zero + (⟨1, h⟩ : Negative ℚ ℚ) + simp at hzero + +theorem negativeMonomial_mul_self_coeff_neg_two : + (((negativeMonomial * negativeMonomial : Negative ℚ ℚ) : Nonpositive ℚ ℚ) : + HahnSeries ℚ ℚ).coeff (-2) = 9 := by + norm_num [negativeMonomial] + +/-- The series `2 + 3t⁻¹` in the nonpositive rational Hahn ring. -/ +def presentedIntegerPartSeries : Nonpositive ℚ ℚ := + Nonpositive.C (Γ := ℚ) (R := ℚ) 2 + (negativeMonomial : Nonpositive ℚ ℚ) + +theorem presentedIntegerPartSeries_mem : + presentedIntegerPartSeries ∈ truncationIntegerPart ℚ (⊥ : Subring ℚ) := by + apply (mem_truncationIntegerPart_iff_exists_add_negative + (Γ := ℚ) (R := ℚ)).mpr + exact ⟨2, negativeMonomial, rfl⟩ + +theorem presentedIntegerPartSeries_negativePart : + Nonpositive.negativePart ℚ ℚ presentedIntegerPartSeries = negativeMonomial := by + simp [presentedIntegerPartSeries] + +theorem presentedIntegerPartSeries_decomposition_unique + (z : (⊥ : Subring ℚ)) (n : Negative ℚ ℚ) + (h : presentedIntegerPartSeries = + Nonpositive.C (Γ := ℚ) (R := ℚ) z + (n : Nonpositive ℚ ℚ)) : + z = 2 ∧ n = negativeMonomial := by + apply (constant_add_negative_eq_iff (Γ := ℚ) (R := ℚ)).mp + have htwo : ((2 : (⊥ : Subring ℚ)) : ℚ) = 2 := + Subring.coe_natCast (⊥ : Subring ℚ) 2 + simpa only [presentedIntegerPartSeries, htwo] using h.symm + +theorem rational_truncationIntegerPart_carrier : + (truncationIntegerPart ℚ (⊥ : Subring ℚ) : Set (Nonpositive ℚ ℚ)) = + (constantSubring ℚ ℚ (⊥ : Subring ℚ) : Set (Nonpositive ℚ ℚ)) + + (negativeIdeal ℚ ℚ : Set (Nonpositive ℚ ℚ)) := + coe_truncationIntegerPart_eq_constantSubring_add_negativeIdeal ℚ ℚ + (⊥ : Subring ℚ) + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NonpositiveDomainEquiv.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NonpositiveDomainEquiv.lean new file mode 100644 index 0000000000..b6341bc22b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NonpositiveDomainEquiv.lean @@ -0,0 +1,57 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveDomainEquiv + +/-! +# API checks for nonpositive Hahn-series exponent equivalences + +The negative monomial below is nonconstant and has genuinely negative support. The checks show +that exponent reindexing preserves its selected coefficient and that the inverse recovers the +series. A polymorphic theorem separately exercises the cross-universe support-order-type API. +-/ + +public noncomputable section + +open scoped HahnSeries + +namespace Tests + +open HahnSeries.Nonpositive + +def integerExponentEquiv : ℤ ≃+o ℤ := + OrderAddMonoidIso.refl ℤ + +def negativeIntegerMonomial : HahnSeries.Nonpositive ℤ ℚ := + single (-2) 7 (by omega) + +theorem negativeIntegerMonomial_reindex_coeff : + ((embDomainRingEquiv integerExponentEquiv negativeIntegerMonomial : + HahnSeries.Nonpositive ℤ ℚ) : HahnSeries ℤ ℚ).coeff + (integerExponentEquiv (-2)) = 7 := by + rw [coe_embDomainRingEquiv, HahnSeries.embDomainRingEquiv_coeff] + simp [negativeIntegerMonomial] + +theorem negativeIntegerMonomial_reindex_roundtrip : + (embDomainRingEquiv integerExponentEquiv).symm + (embDomainRingEquiv integerExponentEquiv negativeIntegerMonomial) = + negativeIntegerMonomial := + (embDomainRingEquiv integerExponentEquiv).symm_apply_apply negativeIntegerMonomial + +universe u v w + +theorem reindex_lift_supportOrderType + {G : Type u} {H : Type v} {K : Type w} + [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] + [LinearOrder H] [AddCommGroup H] [IsOrderedAddMonoid H] [CommRing K] + (e : G ≃+o H) (x : HahnSeries.Nonpositive G K) : + Ordinal.lift.{u, v} + (HahnSeries.supportOrderType (embDomainRingEquiv e x : K⟦H⟧)) = + Ordinal.lift.{v, u} (HahnSeries.supportOrderType (x : K⟦G⟧)) := + lift_supportOrderType_embDomainRingEquiv e x + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NormalForm.lean new file mode 100644 index 0000000000..97e97cdfc9 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NormalForm.lean @@ -0,0 +1,180 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Domain +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Multiplicativity + +/-! +# API checks for LM24 principal series and normal forms + +The series `approachZero` has coefficient one at every exponent `-1/(n+1)`. Its support has order +type `ω`, has supremum zero, and does not contain zero. It therefore certifies that support +supremum is a genuine least upper bound rather than a maximum and gives a nonconstant principal +series. + +Adding the constant term gives the exact example from LM24, Remark 3.3.10. Its normal form has an +infinite principal coefficient at exponent zero followed by the constant principal coefficient at +the same exponent. This separates the source definition from the incorrect variant requiring +strictly increasing exponents. + +The series supported on `ℕ ⊆ ℝ` is unbounded above. The final certificate proves that it has +no finite normal form, exercising the obstruction in LM24, Remark 3.3.9 instead of merely checking +the existence theorem on its nonpositive domain. + +The same `approachZero` fixture exercises the weak-support, positive-degree branch of the repaired +LM24, Lemma 3.4.2 at its minimum exponent. +-/ + +public noncomputable section + +namespace Tests + +open scoped HahnSeries + +/-- The empty list is the normal form of the zero series. -/ +theorem zero_normalForm : + HahnSeries.IsNormalForm (0 : ℚ⟦ℝ⟧) [] := by + rw [HahnSeries.isNormalForm_iff] + simp [List.sortedLE_iff_pairwise, List.sortedGE_iff_pairwise] + +/-- Every normal form of the zero series is empty. -/ +theorem zero_normalForm_unique (terms : List (HahnSeries.NormalForm.Term ℚ)) + (hterms : HahnSeries.IsNormalForm (0 : ℚ⟦ℝ⟧) terms) : + terms = [] := + hterms.unique zero_normalForm + +private theorem approachZero_support_subset_Ici_neg_one : + (approachZeroNonpositive : ℚ⟦ℝ⟧).support ⊆ Set.Ici (-1) := by + rw [coe_approachZeroNonpositive, approachZero_support] + rintro _ ⟨n, rfl⟩ + rw [approachZeroEmbedding_apply] + change -1 ≤ -(1 / (n + 1 : ℝ)) + apply neg_le_neg + simpa using one_div_le_one_div_of_le (a := (1 : ℝ)) + (b := n + 1) (by norm_num) (by norm_num) + +private theorem approachZero_degree : + (approachZeroNonpositive : ℚ⟦ℝ⟧).degree = + (1 : WithBot NatOrdinal) := by + rw [HahnSeries.degree_eq_cantorDegree, coe_approachZeroNonpositive, + approachZero_supportOrderType, Ordinal.cantorDegree_omega] + +/-- The positive-degree branch of repaired LM24, Lemma 3.4.2 applies at the attained minimum +exponent of the infinite principal series. -/ +theorem approachZero_positiveDegree_truncation_degree_lt : + (HahnSeries.truncLE (-1) + (((1 : HahnSeries.Nonpositive ℝ ℚ) * approachZeroNonpositive : + HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧)).degree < + ((1 : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).degree + + (approachZeroNonpositive : ℚ⟦ℝ⟧).degree := by + apply HahnSeries.Nonpositive.degree_truncLE_mul_lt + · exact HahnSeries.Nonpositive.isPrincipal_one + · exact approachZero_ne_zero + · right + refine ⟨approachZero_support_subset_Ici_neg_one, ?_⟩ + rw [approachZero_degree] + norm_num + +/-- The constant series one in the nonpositive Hahn ring. -/ +def constantOneNonpositive : HahnSeries.Nonpositive ℝ ℚ := + HahnSeries.Nonpositive.C 1 + +private theorem constantOne_supportOrderType : + (constantOneNonpositive : ℚ⟦ℝ⟧).supportOrderType = 1 := by + simpa [constantOneNonpositive, HahnSeries.Nonpositive.coe_C, + HahnSeries.C_apply] using + HahnSeries.supportOrderType_single (a := (0 : ℝ)) (r := (1 : ℚ)) one_ne_zero + +/-- The constant series one is principal. -/ +theorem constantOne_isPrincipal : + HahnSeries.Nonpositive.IsPrincipal constantOneNonpositive := by + exact HahnSeries.Nonpositive.isPrincipal_C one_ne_zero + +/-- The infinite principal term at exponent zero. -/ +def approachZeroTerm : HahnSeries.NormalForm.Term ℚ := + ⟨approachZeroNonpositive, 0⟩ + +/-- The constant principal term at exponent zero. -/ +def constantOneTerm : HahnSeries.NormalForm.Term ℚ := + ⟨constantOneNonpositive, 0⟩ + +/-- LM24's `ω + 1` example has a two-term normal form in which exponent zero occurs twice. -/ +theorem repeatedZeroExponentNormalForm : + HahnSeries.IsNormalForm + (approachZero + 1) [approachZeroTerm, constantOneTerm] := by + rw [HahnSeries.isNormalForm_iff_isChain] + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · ext x + simp [approachZeroTerm, constantOneTerm, + coe_approachZeroNonpositive, constantOneNonpositive] + · simp [approachZeroTerm, constantOneTerm, List.sortedLE_iff_pairwise] + · intro t ht + simp only [List.mem_cons, List.not_mem_nil, or_false] at ht + rcases ht with rfl | rfl + · exact approachZero_isPrincipal + · exact constantOne_isPrincipal + · simp only [approachZeroTerm, constantOneTerm, List.map_cons, List.map_nil, + constantOne_supportOrderType, coe_approachZeroNonpositive, + approachZero_supportOrderType] + rw [List.sortedGE_iff_pairwise] + simp [Ordinal.one_lt_omega0.le] + · apply List.isChain_pair.mpr + rw [HahnSeries.supportBelow_iff] + intro i hi j hj + have hj0 : j = 0 := by + simpa [constantOneTerm, constantOneNonpositive, + HahnSeries.NormalForm.Term.series_eq_translate] using hj + subst j + rw [approachZeroTerm, HahnSeries.NormalForm.Term.series_eq_translate, + HahnSeries.translate_zero_apply] at hi + rw [coe_approachZeroNonpositive, approachZero_support] at hi + obtain ⟨n, rfl⟩ := hi + rw [approachZeroEmbedding_apply] + change -(1 / (n + 1 : ℝ)) < 0 + exact neg_lt_zero.mpr (by positivity) + +/-- The order embedding of the natural numbers into the reals. -/ +def natCastEmbedding : ℕ ↪o ℝ := + OrderEmbedding.ofStrictMono _ Nat.strictMono_cast + +/-- The coefficient-one series on the unbounded support `ℕ ⊆ ℝ`. -/ +def unboundedSeries : ℚ⟦ℝ⟧ := + HahnSeries.embDomain natCastEmbedding natOnes + +private theorem unboundedSeries_support : + unboundedSeries.support = Set.range natCastEmbedding := by + rw [unboundedSeries, HahnSeries.support_embDomain] + simp + +private theorem unboundedSeries_supportOrderType : + unboundedSeries.supportOrderType = Ordinal.omega0 := by + rw [HahnSeries.supportOrderType_eq_setOrderType] + have e : unboundedSeries.support ≃o ℕ := + (OrderIso.setCongr unboundedSeries.support (Set.range natCastEmbedding) + unboundedSeries_support).trans natCastEmbedding.orderIso.symm + exact unboundedSeries.isPWO_support.orderType_eq_typeLT_of_orderIso e |>.trans + Ordinal.type_nat_lt + +/-- The unbounded coefficient-one series is weakly principal of support order type `ω`. -/ +theorem unboundedSeries_isWeaklyPrincipal : + HahnSeries.IsWeaklyPrincipal unboundedSeries := by + rw [HahnSeries.isWeaklyPrincipal_iff, unboundedSeries_supportOrderType] + simpa using Ordinal.isAdditivelyPrincipal_omega0_opow 1 + +/-- The unbounded weakly principal series in LM24, Remark 3.3.9 has no finite normal form. -/ +theorem unboundedSeries_has_no_normalForm : + ∀ terms : List (HahnSeries.NormalForm.Term ℚ), + ¬HahnSeries.IsNormalForm unboundedSeries terms := by + intro terms hnormal + obtain ⟨a, ha⟩ := hnormal.bddAbove_support + rw [unboundedSeries_support] at ha + obtain ⟨n, hn⟩ := exists_nat_gt a + have hle := ha ⟨n, rfl⟩ + exact (not_le_of_gt hn) hle + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/OrderTypeDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/OrderTypeDegree.lean new file mode 100644 index 0000000000..2c269c53ec --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/OrderTypeDegree.lean @@ -0,0 +1,358 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Degree +public import Mathlib.Data.Prod.Lex +public import Mathlib.Data.Sum.Order + +import Mathlib.Data.Finsupp.Basic +import Mathlib.Data.Finsupp.Single + +/-! +# API checks for support order type and degree + +This client imports the public order-type and degree interface from a separate module. Its +coefficient-one series have supports of ordinary ordinal types `1 + ω = ω`, `ω + ω`, and +`(ω + 1) * ω = ω²`. The asymmetric sum and product distinguish ordinary ordinal arithmetic from +Hessenberg arithmetic at the level of order type. The degree certificates separately distinguish +LM24's leading-Cantor-exponent degree from the support order type itself and from the incorrect rule +that two consecutive infinite blocks have degree two. + +The `ω + ω` fixture tests the ordinal calculation independently of any displayed real-exponent +series. The finite fixture has two support points, while the zero fixture is checked separately, +so degree zero cannot accidentally include the zero series. +-/ + +universe u + +public noncomputable section + +namespace Tests + +open Ordinal +open scoped HahnSeries + +/-- A Hessenberg sum of terms of degrees two and one has degree two, not three. -/ +theorem naturalSumDegree_separator : + NatOrdinal.cantorDegree (ω^ (2 : NatOrdinal) + ω^ (1 : NatOrdinal)) = 2 := by + rw [NatOrdinal.cantorDegree_add, NatOrdinal.cantorDegree_wpow, + NatOrdinal.cantorDegree_wpow] + simp + +/-- The absorbing bottom value records that a Hessenberg product with zero is zero. -/ +theorem naturalProductDegree_zero : + NatOrdinal.cantorDegree ((0 : NatOrdinal) * ω^ (2 : NatOrdinal)) = ⊥ := by + simp + +private theorem naturalProductDegree_asymmetric : + NatOrdinal.cantorDegree + (ω^ (1 : NatOrdinal) * ω^ NatOrdinal.of Ordinal.omega0) = + (NatOrdinal.of (Ordinal.omega0 + 1) : WithBot NatOrdinal) := by + rw [NatOrdinal.cantorDegree_mul, NatOrdinal.cantorDegree_wpow, + NatOrdinal.cantorDegree_wpow, ← WithBot.coe_add, WithBot.coe_eq_coe, + add_comm, ← NatOrdinal.of_add_one] + +private theorem ordinaryProductDegree_asymmetric : + Ordinal.cantorDegree + (Ordinal.omega0 * Ordinal.omega0 ^ Ordinal.omega0) = + (NatOrdinal.of Ordinal.omega0 : WithBot NatOrdinal) := by + have hproduct : Ordinal.omega0 * Ordinal.omega0 ^ Ordinal.omega0 = + Ordinal.omega0 ^ Ordinal.omega0 := by + calc + Ordinal.omega0 * Ordinal.omega0 ^ Ordinal.omega0 = + Ordinal.omega0 ^ (1 : Ordinal) * + Ordinal.omega0 ^ Ordinal.omega0 := by + rw [Ordinal.opow_one] + _ = Ordinal.omega0 ^ ((1 : Ordinal) + Ordinal.omega0) := by + exact (Ordinal.opow_add Ordinal.omega0 1 Ordinal.omega0).symm + _ = Ordinal.omega0 ^ Ordinal.omega0 := by rw [Ordinal.one_add_omega0] + rw [hproduct, + Ordinal.cantorDegree_of_ne_zero + (Ordinal.opow_ne_zero Ordinal.omega0 Ordinal.omega0_ne_zero), + Ordinal.log_opow Ordinal.one_lt_omega0] + +/-- Hessenberg and ordinary multiplication can have different leading Cantor exponents. -/ +theorem naturalProductDegree_ne_ordinaryProductDegree : + NatOrdinal.cantorDegree + (ω^ (1 : NatOrdinal) * ω^ NatOrdinal.of Ordinal.omega0) ≠ + Ordinal.cantorDegree + (Ordinal.omega0 * Ordinal.omega0 ^ Ordinal.omega0) := by + rw [naturalProductDegree_asymmetric, ordinaryProductDegree_asymmetric] + intro h + have h' : NatOrdinal.of (Ordinal.omega0 + 1) = + NatOrdinal.of Ordinal.omega0 := WithBot.coe_eq_coe.mp h + exact (lt_add_one Ordinal.omega0).ne' (NatOrdinal.of.injective h') + +private def cancelingSeries : ℤ⟦ℤ⟧ := + HahnSeries.single 0 1 + +private theorem cancelingSeries_ne_zero : cancelingSeries ≠ 0 := by + simp [cancelingSeries] + +private theorem cancelingSeries_support_finite : cancelingSeries.support.Finite := + (Set.finite_singleton 0).subset HahnSeries.support_single_subset + +private theorem cancelingSeries_degree : cancelingSeries.degree = 0 := + HahnSeries.degree_eq_zero.mpr + ⟨cancelingSeries_ne_zero, cancelingSeries_support_finite⟩ + +private theorem neg_cancelingSeries_degree : (-cancelingSeries).degree = 0 := by + apply HahnSeries.degree_eq_zero.mpr + constructor + · simpa using cancelingSeries_ne_zero + · exact cancelingSeries_support_finite.subset (HahnSeries.support_neg_subset _) + +/-- LM24's additive degree inequality applies in a cancellation case and can be strict. -/ +theorem degree_add_cancellation_boundary : + ∃ x : ℤ⟦ℤ⟧, + (x + -x).degree ≤ max x.degree (-x).degree ∧ + (x + -x).degree < max x.degree (-x).degree := by + refine ⟨cancelingSeries, HahnSeries.degree_add_le _ _, ?_⟩ + rw [add_neg_cancel, HahnSeries.degree_zero, cancelingSeries_degree, + neg_cancelingSeries_degree] + simp + +private def twoTermCoeffs : ℤ →₀ ℕ := + Finsupp.single 0 1 + Finsupp.single 1 1 + +/-- The Hahn series with coefficient one at exponents `0` and `1`. -/ +def twoTermOrderTypeSeries : ℕ⟦ℤ⟧ := + HahnSeries.ofFinsupp twoTermCoeffs + +/-- `twoTermOrderTypeSeries` has support `{0, 1}`. -/ +@[simp] +theorem twoTermOrderTypeSeries_support : + twoTermOrderTypeSeries.support = {0, 1} := by + classical + ext z + by_cases hz0 : z = 0 + · simp [twoTermOrderTypeSeries, twoTermCoeffs, hz0] + by_cases hz1 : z = 1 + · simp [twoTermOrderTypeSeries, twoTermCoeffs, hz1] + · simp [twoTermOrderTypeSeries, twoTermCoeffs, hz0, hz1] + +theorem twoTermOrderTypeSeries_ne_zero : twoTermOrderTypeSeries ≠ 0 := by + apply HahnSeries.support_nonempty_iff.mp + rw [twoTermOrderTypeSeries_support] + simp + +theorem twoTermOrderTypeSeries_support_finite : + twoTermOrderTypeSeries.support.Finite := by + rw [twoTermOrderTypeSeries_support] + simp + +/-- A nonzero series with two support points has degree zero. -/ +theorem twoTermOrderTypeSeries_degree : + twoTermOrderTypeSeries.degree = (0 : WithBot NatOrdinal) := + HahnSeries.degree_eq_zero.mpr + ⟨twoTermOrderTypeSeries_ne_zero, twoTermOrderTypeSeries_support_finite⟩ + +/-- Interface smoke test: the multiplicative degree bound applies to two nonzero series whose +supports each have exactly two points. -/ +theorem twoTermOrderTypeSeries_square_degree_le : + twoTermOrderTypeSeries ≠ 0 ∧ + (twoTermOrderTypeSeries * twoTermOrderTypeSeries).degree ≤ + twoTermOrderTypeSeries.degree + twoTermOrderTypeSeries.degree := + ⟨twoTermOrderTypeSeries_ne_zero, HahnSeries.degree_mul_le _ _⟩ + +/-- The zero series has degree `⊥`, rather than degree zero. -/ +theorem zeroOrderTypeSeries_degree : + (0 : ℕ⟦ℤ⟧).degree = ⊥ := + HahnSeries.degree_zero + +private instance : WellFoundedLT (Unit ⊕ₗ ℕ) := + (Sum.Lex.toLexRelIsoLT (α := Unit) (β := ℕ)).symm.toRelEmbedding.isWellFounded + +/-- The coefficient-one Hahn series on the ordered sum of `Unit` and `ℕ`. -/ +def oneAddOmegaOrderTypeSeries : ℕ⟦Unit ⊕ₗ ℕ⟧ where + coeff _ := 1 + isPWO_support' := by + simpa [Function.support] using + Set.IsPWO.of_linearOrder (Set.univ : Set (Unit ⊕ₗ ℕ)) + +@[simp] +theorem oneAddOmegaOrderTypeSeries_support : + oneAddOmegaOrderTypeSeries.support = Set.univ := by + ext n + simp [oneAddOmegaOrderTypeSeries] + +theorem oneAddOmegaOrderTypeSeries_supportOrderType : + oneAddOmegaOrderTypeSeries.supportOrderType = Ordinal.omega0 := by + calc + oneAddOmegaOrderTypeSeries.supportOrderType = typeLT (Unit ⊕ₗ ℕ) := by + let e : oneAddOmegaOrderTypeSeries.support ≃o Unit ⊕ₗ ℕ := + (OrderIso.setCongr oneAddOmegaOrderTypeSeries.support Set.univ + oneAddOmegaOrderTypeSeries_support).trans + (OrderIso.Set.univ (α := Unit ⊕ₗ ℕ)) + exact HahnSeries.supportOrderType_eq_typeLT e + _ = Ordinal.type (Sum.Lex (· < · : Unit → Unit → Prop) + (· < · : ℕ → ℕ → Prop)) := + (Sum.Lex.toLexRelIsoLT (α := Unit) (β := ℕ)).ordinalType_congr.symm + _ = Ordinal.omega0 := by + rw [Ordinal.type_sum_lex, Ordinal.type_nat_lt] + simp + +theorem oneAddOmegaOrderTypeSeries_degree : + oneAddOmegaOrderTypeSeries.degree = (1 : WithBot NatOrdinal) := by + rw [HahnSeries.degree_eq_cantorDegree, oneAddOmegaOrderTypeSeries_supportOrderType, + Ordinal.cantorDegree_omega] + +/-- Ordinary `1 + ω` differs from the Hessenberg sum of `1` and `ω`. -/ +theorem naturalOneAddOmega_ne_supportOrderType : + NatOrdinal.of (1 : Ordinal) + NatOrdinal.of Ordinal.omega0 ≠ + NatOrdinal.of oneAddOmegaOrderTypeSeries.supportOrderType := by + rw [oneAddOmegaOrderTypeSeries_supportOrderType] + intro h + rw [add_comm] at h + have hone : NatOrdinal.of (1 : Ordinal) = 1 := rfl + rw [hone, ← NatOrdinal.of_add_one] at h + exact (lt_add_one Ordinal.omega0).ne' (NatOrdinal.of.injective h) + +private instance : WellFoundedLT (ℕ ⊕ₗ ℕ) := + (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := ℕ)).symm.toRelEmbedding.isWellFounded + +/-- The coefficient-one Hahn series on the ordered sum of two copies of `ℕ`. -/ +def omegaAddOmegaOrderTypeSeries : ℕ⟦ℕ ⊕ₗ ℕ⟧ where + coeff _ := 1 + isPWO_support' := by + simpa [Function.support] using + Set.IsPWO.of_linearOrder (Set.univ : Set (ℕ ⊕ₗ ℕ)) + +@[simp] +theorem omegaAddOmegaOrderTypeSeries_support : + omegaAddOmegaOrderTypeSeries.support = Set.univ := by + ext n + simp [omegaAddOmegaOrderTypeSeries] + +theorem omegaAddOmegaOrderTypeSeries_supportOrderType : + omegaAddOmegaOrderTypeSeries.supportOrderType = + Ordinal.omega0 + Ordinal.omega0 := by + calc + omegaAddOmegaOrderTypeSeries.supportOrderType = typeLT (ℕ ⊕ₗ ℕ) := by + let e : omegaAddOmegaOrderTypeSeries.support ≃o ℕ ⊕ₗ ℕ := + (OrderIso.setCongr omegaAddOmegaOrderTypeSeries.support Set.univ + omegaAddOmegaOrderTypeSeries_support).trans + (OrderIso.Set.univ (α := ℕ ⊕ₗ ℕ)) + exact HahnSeries.supportOrderType_eq_typeLT e + _ = Ordinal.type (Sum.Lex (· < ·) (· < ·)) := + (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := ℕ)).ordinalType_congr.symm + _ = Ordinal.omega0 + Ordinal.omega0 := by + rw [Ordinal.type_sum_lex, Ordinal.type_nat_lt] + +/-- A support of ordinary ordinal type `ω + ω` has degree one. -/ +theorem omegaAddOmegaOrderTypeSeries_degree : + omegaAddOmegaOrderTypeSeries.degree = (1 : WithBot NatOrdinal) := by + rw [HahnSeries.degree_eq_cantorDegree, omegaAddOmegaOrderTypeSeries_supportOrderType, + Ordinal.cantorDegree_omega_add_omega] + +private instance : WellFoundedLT (ℕ ⊕ₗ Unit) := + (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := Unit)).symm.toRelEmbedding.isWellFounded + +/-- A coefficient-one Hahn series whose support has ordinary type `(ω + 1) * ω`. -/ +def omegaSuccTimesOmegaOrderTypeSeries : ℕ⟦ℕ ×ₗ (ℕ ⊕ₗ Unit)⟧ where + coeff _ := 1 + isPWO_support' := by + simpa [Function.support] using + Set.IsPWO.of_linearOrder (Set.univ : Set (ℕ ×ₗ (ℕ ⊕ₗ Unit))) + +@[simp] +theorem omegaSuccTimesOmegaOrderTypeSeries_support : + omegaSuccTimesOmegaOrderTypeSeries.support = Set.univ := by + ext n + simp [omegaSuccTimesOmegaOrderTypeSeries] + +theorem omegaSuccTimesOmegaOrderTypeSeries_supportOrderType : + omegaSuccTimesOmegaOrderTypeSeries.supportOrderType = + Ordinal.omega0 ^ (2 : Ordinal) := by + calc + omegaSuccTimesOmegaOrderTypeSeries.supportOrderType = + typeLT (ℕ ×ₗ (ℕ ⊕ₗ Unit)) := by + let e : omegaSuccTimesOmegaOrderTypeSeries.support ≃o ℕ ×ₗ (ℕ ⊕ₗ Unit) := + (OrderIso.setCongr omegaSuccTimesOmegaOrderTypeSeries.support Set.univ + omegaSuccTimesOmegaOrderTypeSeries_support).trans + (OrderIso.Set.univ (α := ℕ ×ₗ (ℕ ⊕ₗ Unit))) + exact HahnSeries.supportOrderType_eq_typeLT e + _ = (typeLT (ℕ ⊕ₗ Unit)) * (typeLT ℕ) := by + -- The strict order on the lexicographic product synonym is definitionally `Prod.Lex`. + change Ordinal.type + (Prod.Lex (· < · : ℕ → ℕ → Prop) + (· < · : (ℕ ⊕ₗ Unit) → (ℕ ⊕ₗ Unit) → Prop)) = _ + exact Ordinal.type_prod_lex (· < ·) (· < ·) + _ = (Ordinal.omega0 + 1) * Ordinal.omega0 := by + rw [Ordinal.type_nat_lt] + congr 1 + calc + typeLT (ℕ ⊕ₗ Unit) = + Ordinal.type (Sum.Lex (· < · : ℕ → ℕ → Prop) + (· < · : Unit → Unit → Prop)) := + (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := Unit)).ordinalType_congr.symm + _ = Ordinal.omega0 + 1 := by + rw [Ordinal.type_sum_lex, Ordinal.type_nat_lt] + simp + _ = Ordinal.omega0 * Ordinal.omega0 := + Ordinal.add_mul_of_isSuccLimit Ordinal.one_add_omega0 + Ordinal.isSuccLimit_omega0 + _ = Ordinal.omega0 ^ (2 : Ordinal) := by + have hsucc : Order.succ (1 : Ordinal) = 2 := one_add_one_eq_two + rw [← hsucc, Ordinal.opow_succ, Ordinal.opow_one] + +/-- A support of ordinary ordinal type `ω²` has degree two. -/ +theorem omegaSuccTimesOmegaOrderTypeSeries_degree : + omegaSuccTimesOmegaOrderTypeSeries.degree = (2 : WithBot NatOrdinal) := by + rw [HahnSeries.degree_eq_cantorDegree, + omegaSuccTimesOmegaOrderTypeSeries_supportOrderType, + Ordinal.cantorDegree_omega_sq] + +/-- Ordinary `(ω + 1) * ω` differs from the corresponding Hessenberg product. -/ +theorem naturalOmegaSuccTimesOmega_ne_supportOrderType : + NatOrdinal.of (Ordinal.omega0 + 1) * NatOrdinal.of Ordinal.omega0 ≠ + NatOrdinal.of omegaSuccTimesOmegaOrderTypeSeries.supportOrderType := by + rw [omegaSuccTimesOmegaOrderTypeSeries_supportOrderType] + have hfactor : + NatOrdinal.of Ordinal.omega0 < NatOrdinal.of (Ordinal.omega0 + 1) := + NatOrdinal.of.lt_iff_lt.mpr (lt_add_one Ordinal.omega0) + have homega : (0 : NatOrdinal) < NatOrdinal.of Ordinal.omega0 := + NatOrdinal.of.lt_iff_lt.mpr Ordinal.omega0_pos + have hproduct : + NatOrdinal.of Ordinal.omega0 * NatOrdinal.of Ordinal.omega0 < + NatOrdinal.of (Ordinal.omega0 + 1) * NatOrdinal.of Ordinal.omega0 := + mul_lt_mul_of_pos_right hfactor homega + have hord : Ordinal.omega0 * Ordinal.omega0 = + Ordinal.omega0 ^ (2 : Ordinal) := by + have hsucc : Order.succ (1 : Ordinal) = 2 := one_add_one_eq_two + rw [← hsucc, Ordinal.opow_succ, Ordinal.opow_one] + have hordinary : NatOrdinal.of (Ordinal.omega0 ^ (2 : Ordinal)) ≤ + NatOrdinal.of Ordinal.omega0 * NatOrdinal.of Ordinal.omega0 := by + rw [← hord] + simpa using NatOrdinal.omul_le_mul + (NatOrdinal.of Ordinal.omega0) (NatOrdinal.of Ordinal.omega0) + exact (hordinary.trans_lt hproduct).ne' + +/-- A surreal Hahn monomial, used only to check the small-support degree interface. -/ +def surrealHahnMonomial : SurrealHahnSeries.{u} := + SurrealHahnSeries.single 0 1 + +theorem surrealHahnMonomial_ne_zero : + (surrealHahnMonomial : SurrealHahnSeries.{u}) ≠ 0 := by + intro h + have hcoeff := congrArg + (fun x : SurrealHahnSeries.{u} ↦ x.coeff (0 : Surreal.{u})) h + simp [surrealHahnMonomial] at hcoeff + +theorem surrealHahnMonomial_support_finite : + (surrealHahnMonomial : SurrealHahnSeries.{u}).support.Finite := + (Set.finite_singleton 0).subset SurrealHahnSeries.support_single_subset + +/-- Interface smoke test: a nonzero surreal Hahn monomial has degree zero. -/ +theorem surrealHahnMonomial_supportDegree : + (surrealHahnMonomial : SurrealHahnSeries.{u}).supportDegree = + (0 : WithBot NatOrdinal) := + SurrealHahnSeries.supportDegree_eq_zero.mpr + ⟨surrealHahnMonomial_ne_zero, surrealHahnMonomial_support_finite⟩ + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/PrincipalAddition.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/PrincipalAddition.lean new file mode 100644 index 0000000000..925adb4252 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/PrincipalAddition.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition + +/-! +# API checks for addition of principal series + +The approach-zero series and the constant one give a compiled counterexample to LM24, +Proposition 3.6.2 as printed: both summands are principal and the degree of the sum equals the +degree of the first summand, but the nonzero terminal constant makes the sum nonprincipal. + +Adding the approach-zero series to itself exercises the corrected equal-degree theorem on a +nonconstant, infinite-support example. This is the author-confirmed repair used by later LM24 +arguments; the broader author-suggested repair for two simultaneously zero or nonzero degrees is +not assumed here. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries +open scoped NatOrdinal + +private theorem one_nonpositive_degree_eq_zero : + ((1 : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).degree = + (0 : WithBot NatOrdinal) := by + rw [← map_one (HahnSeries.Nonpositive.C : + ℚ →+* HahnSeries.Nonpositive ℝ ℚ), HahnSeries.Nonpositive.coe_C] + change (HahnSeries.C (Γ := ℝ) (1 : ℚ)).degree = + (0 : WithBot NatOrdinal) + rw [HahnSeries.C_apply, HahnSeries.degree_eq_cantorDegree, + HahnSeries.supportOrderType_single one_ne_zero, + Ordinal.cantorDegree_one] + +private theorem approachZero_add_one_degree_eq_one : + (((approachZeroNonpositive + 1 : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧)).degree = + (1 : WithBot NatOrdinal) := by + have h := HahnSeries.degree_add_eq_left_of_lt + (x := (approachZeroNonpositive : ℚ⟦ℝ⟧)) + (y := ((1 : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧)) + (by rw [approachZero_degree_eq_one, one_nonpositive_degree_eq_zero]; norm_num) + simpa using h.trans approachZero_degree_eq_one + +private theorem approachZero_constantCoeff_eq_zero : + HahnSeries.Nonpositive.constantCoeff approachZeroNonpositive = 0 := by + rw [HahnSeries.Nonpositive.constantCoeff_apply, coe_approachZeroNonpositive] + apply not_ne_iff.mp + simpa [HahnSeries.mem_support] using zero_not_mem_approachZero_support + +/-- The printed formulation of LM24, Proposition 3.6.2 is false. -/ +theorem printed_proposition_3_6_2_counterexample : + ∃ b c : HahnSeries.Nonpositive ℝ ℚ, + HahnSeries.Nonpositive.IsPrincipal b ∧ + HahnSeries.Nonpositive.IsPrincipal c ∧ + (((b + c : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧)).degree = + (b : ℚ⟦ℝ⟧).degree ∧ + ¬HahnSeries.Nonpositive.IsPrincipal (b + c) := by + refine ⟨approachZeroNonpositive, 1, approachZero_isPrincipal, + HahnSeries.Nonpositive.isPrincipal_one, ?_, ?_⟩ + · rw [approachZero_add_one_degree_eq_one, approachZero_degree_eq_one] + · intro hprincipal + have hconstant := hprincipal.constantCoeff_eq_zero_of_degree_pos + approachZero_add_one_degree_eq_one (by norm_num) + rw [map_add, approachZero_constantCoeff_eq_zero, map_one, zero_add] at hconstant + exact one_ne_zero hconstant + +private theorem approachZero_add_self_degree_eq_one : + (((approachZeroNonpositive + approachZeroNonpositive : + HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧)).degree = + (1 : WithBot NatOrdinal) := by + have hsupport : + (((approachZeroNonpositive + approachZeroNonpositive : + HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧)).support = + (approachZeroNonpositive : ℚ⟦ℝ⟧).support := by + ext x + simp only [HahnSeries.mem_support, Subring.coe_add, HahnSeries.coeff_add] + rw [coe_approachZeroNonpositive] + constructor + · intro hsum hzero + exact hsum (by simp [hzero]) + · intro hcoeff hsum + apply hcoeff + linarith + have htype : + (((approachZeroNonpositive + approachZeroNonpositive : + HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧)).supportOrderType = + (approachZeroNonpositive : ℚ⟦ℝ⟧).supportOrderType := + HahnSeries.supportOrderType_eq_setOrderType _ |>.trans + (((approachZeroNonpositive + approachZeroNonpositive : + HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).isPWO_support.orderType_congr + (approachZeroNonpositive : ℚ⟦ℝ⟧).isPWO_support hsupport) |>.trans + (HahnSeries.supportOrderType_eq_setOrderType _).symm + calc + (((approachZeroNonpositive + approachZeroNonpositive : + HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧)).degree = + Ordinal.cantorDegree + (((approachZeroNonpositive + approachZeroNonpositive : + HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧)).supportOrderType := + HahnSeries.degree_eq_cantorDegree _ + _ = Ordinal.cantorDegree + (approachZeroNonpositive : ℚ⟦ℝ⟧).supportOrderType := congrArg _ htype + _ = (approachZeroNonpositive : ℚ⟦ℝ⟧).degree := + (HahnSeries.degree_eq_cantorDegree _).symm + _ = (1 : WithBot NatOrdinal) := approachZero_degree_eq_one + +/-- The corrected equal-degree theorem applies to two genuine infinite principal series. -/ +theorem approachZero_add_self_isPrincipal : + HahnSeries.Nonpositive.IsPrincipal + (approachZeroNonpositive + approachZeroNonpositive) := by + apply approachZero_isPrincipal.add_of_degree_eq approachZero_isPrincipal + · rfl + · rw [approachZero_add_self_degree_eq_one, approachZero_degree_eq_one] + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Truncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Truncation.lean new file mode 100644 index 0000000000..d03e063269 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Truncation.lean @@ -0,0 +1,265 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType + +import Mathlib.Data.Finsupp.Basic +import Mathlib.Data.Finsupp.Single +import Mathlib.Data.Sum.Order + +/-! +# API checks for Hahn-series truncations + +This client uses only the public Hahn-series interface. Its series has nonzero coefficients exactly +at `-1`, `0`, and `1`, and is truncated at `0`. The four exact support calculations distinguish the +intended intervals `< 0`, `≤ 0`, `≥ 0`, and `> 0`; in particular, they reject the nearby wrong +definitions obtained by interchanging strict and weak endpoints. The extreme cuts at `-1` and `1` +exercise the empty-summand cases. + +The order-type and uniqueness checks exercise LM24, Fact 2.2.3(1), Proposition 3.2.1, and +Definition 3.2.2 through their public consequences. The root `LM24` module does not import this +client module. +-/ + +public noncomputable section + +namespace Tests + +open scoped HahnSeries + +private def threeTermCoeffs : ℤ →₀ ℚ := + Finsupp.single (-1) 1 + Finsupp.single 0 2 + Finsupp.single 1 3 + +/-- A Hahn series with nonzero coefficients precisely at `-1`, `0`, and `1`. -/ +def threeTermTruncationSeries : ℚ⟦ℤ⟧ := + HahnSeries.ofFinsupp threeTermCoeffs + +@[simp] +theorem threeTermTruncationSeries_support : + threeTermTruncationSeries.support = {-1, 0, 1} := by + classical + ext z + by_cases hneg : z = -1 + · simp [threeTermTruncationSeries, threeTermCoeffs, hneg] + by_cases hzero : z = 0 + · simp [threeTermTruncationSeries, threeTermCoeffs, hzero] + by_cases hone : z = 1 + · simp [threeTermTruncationSeries, threeTermCoeffs, hone] + · simp [threeTermTruncationSeries, threeTermCoeffs, hneg, hzero, hone] + +/-- Strict lower truncation at zero keeps exactly the exponent `-1`. -/ +theorem threeTermTruncationSeries_support_truncLT : + (HahnSeries.truncLT 0 threeTermTruncationSeries).support = {-1} := by + rw [HahnSeries.support_truncLT, threeTermTruncationSeries_support] + ext z + simp only [Set.mem_setOf_eq, Set.mem_insert_iff, Set.mem_singleton_iff] + omega + +/-- Weak lower truncation at zero keeps exactly the exponents `-1` and `0`. -/ +theorem threeTermTruncationSeries_support_truncLE : + (HahnSeries.truncLE 0 threeTermTruncationSeries).support = {-1, 0} := by + rw [HahnSeries.support_truncLE, threeTermTruncationSeries_support] + ext z + simp only [Set.mem_setOf_eq, Set.mem_insert_iff, Set.mem_singleton_iff] + omega + +/-- Weak upper truncation at zero keeps exactly the exponents `0` and `1`. -/ +theorem threeTermTruncationSeries_support_truncGE : + (HahnSeries.truncGE 0 threeTermTruncationSeries).support = {0, 1} := by + rw [HahnSeries.support_truncGE, threeTermTruncationSeries_support] + ext z + simp only [Set.mem_setOf_eq, Set.mem_insert_iff, Set.mem_singleton_iff] + omega + +/-- Strict upper truncation at zero keeps exactly the exponent `1`. -/ +theorem threeTermTruncationSeries_support_truncGT : + (HahnSeries.truncGT 0 threeTermTruncationSeries).support = {1} := by + rw [HahnSeries.support_truncGT, threeTermTruncationSeries_support] + ext z + simp only [Set.mem_setOf_eq, Set.mem_insert_iff, Set.mem_singleton_iff] + omega + +/-- At the cut exponent, the weak truncations keep the coefficient and the strict truncations +discard it. -/ +theorem threeTermTruncationSeries_endpoint_coefficients : + (HahnSeries.truncLT 0 threeTermTruncationSeries).coeff 0 = 0 ∧ + (HahnSeries.truncLE 0 threeTermTruncationSeries).coeff 0 = 2 ∧ + (HahnSeries.truncGE 0 threeTermTruncationSeries).coeff 0 = 2 ∧ + (HahnSeries.truncGT 0 threeTermTruncationSeries).coeff 0 = 0 := by + norm_num [threeTermTruncationSeries, threeTermCoeffs] + +/-- Both complementary pairs of truncations reconstruct the original nonconstant series. -/ +theorem threeTermTruncationSeries_splits : + HahnSeries.truncLT 0 threeTermTruncationSeries + + HahnSeries.truncGE 0 threeTermTruncationSeries = threeTermTruncationSeries ∧ + HahnSeries.truncLE 0 threeTermTruncationSeries + + HahnSeries.truncGT 0 threeTermTruncationSeries = threeTermTruncationSeries := + ⟨HahnSeries.truncLT_add_truncGE 0 threeTermTruncationSeries, + HahnSeries.truncLE_add_truncGT 0 threeTermTruncationSeries⟩ + +/-- The weak lower truncation at zero is proper because it discards the term at exponent `1`. -/ +theorem threeTermTruncationSeries_truncLE_ne : + HahnSeries.truncLE 0 threeTermTruncationSeries ≠ threeTermTruncationSeries := by + intro h + have hcoeff := congrArg (fun x : ℚ⟦ℤ⟧ => x.coeff 1) h + simp [threeTermTruncationSeries, threeTermCoeffs] at hcoeff + +/-- The proper weak lower truncation has strictly smaller support order type. -/ +theorem threeTermTruncationSeries_truncLE_orderType_lt : + (HahnSeries.truncLE 0 threeTermTruncationSeries).supportOrderType < + threeTermTruncationSeries.supportOrderType := + HahnSeries.supportOrderType_truncLE_lt 0 threeTermTruncationSeries_truncLE_ne + +/-- Both support-order-type decompositions use ordinary ordinal addition in lower-to-upper order. -/ +theorem threeTermTruncationSeries_orderType_splits : + threeTermTruncationSeries.supportOrderType = + (HahnSeries.truncLT 0 threeTermTruncationSeries).supportOrderType + + (HahnSeries.truncGE 0 threeTermTruncationSeries).supportOrderType ∧ + threeTermTruncationSeries.supportOrderType = + (HahnSeries.truncLE 0 threeTermTruncationSeries).supportOrderType + + (HahnSeries.truncGT 0 threeTermTruncationSeries).supportOrderType := + ⟨HahnSeries.supportOrderType_eq_truncLT_add_truncGE 0 threeTermTruncationSeries, + HahnSeries.supportOrderType_eq_truncLE_add_truncGT 0 threeTermTruncationSeries⟩ + +/-- Truncation at the least and greatest support exponents exercises both empty-summand cases. -/ +theorem threeTermTruncationSeries_boundary_truncations : + HahnSeries.truncLT (-1) threeTermTruncationSeries = 0 ∧ + HahnSeries.truncGE (-1) threeTermTruncationSeries = threeTermTruncationSeries ∧ + HahnSeries.truncLE 1 threeTermTruncationSeries = threeTermTruncationSeries ∧ + HahnSeries.truncGT 1 threeTermTruncationSeries = 0 := by + have hlt : HahnSeries.truncLT (-1) threeTermTruncationSeries = 0 := by + rw [← HahnSeries.support_eq_empty_iff, HahnSeries.support_truncLT, + threeTermTruncationSeries_support] + ext z + simp only [Set.mem_setOf_eq, Set.mem_empty_iff_false, iff_false, Set.mem_insert_iff, + Set.mem_singleton_iff] + omega + have hgt : HahnSeries.truncGT 1 threeTermTruncationSeries = 0 := by + rw [← HahnSeries.support_eq_empty_iff, HahnSeries.support_truncGT, + threeTermTruncationSeries_support] + ext z + simp only [Set.mem_setOf_eq, Set.mem_empty_iff_false, iff_false, Set.mem_insert_iff, + Set.mem_singleton_iff] + omega + refine ⟨hlt, ?_, ?_, hgt⟩ + · simpa [hlt] using + HahnSeries.truncLT_add_truncGE (-1) threeTermTruncationSeries + · simpa [hgt] using + HahnSeries.truncLE_add_truncGT 1 threeTermTruncationSeries + +/-- Any separated decomposition with the same lower order type as the cut at zero is that cut. -/ +theorem threeTermTruncationSeries_decomposition_unique (x y : ℚ⟦ℤ⟧) + (hxy : ∀ i ∈ x.support, ∀ j ∈ y.support, i < j) + (htype : x.supportOrderType = + (HahnSeries.truncLE 0 threeTermTruncationSeries).supportOrderType) + (hsum : x + y = threeTermTruncationSeries) : + x = HahnSeries.truncLE 0 threeTermTruncationSeries ∧ + y = HahnSeries.truncGT 0 threeTermTruncationSeries := by + have htrunc : ∀ i ∈ (HahnSeries.truncLE 0 threeTermTruncationSeries).support, + ∀ j ∈ (HahnSeries.truncGT 0 threeTermTruncationSeries).support, i < j := by + intro i hi j hj + rw [HahnSeries.support_truncLE] at hi + rw [HahnSeries.support_truncGT] at hj + exact hi.2.trans_lt hj.2 + apply HahnSeries.add_decomposition_unique (HahnSeries.supportBelow_iff.mpr hxy) + (HahnSeries.supportBelow_iff.mpr htrunc) htype + exact hsum.trans (HahnSeries.truncLE_add_truncGT 0 threeTermTruncationSeries).symm + +private instance : WellFoundedLT (Unit ⊕ₗ ℕ) := + (Sum.Lex.toLexRelIsoLT (α := Unit) (β := ℕ)).symm.toRelEmbedding.isWellFounded + +/-- The coefficient-one series on an ordered singleton followed by `ℕ`. -/ +def oneAddOmegaSplitSeries : ℚ⟦Unit ⊕ₗ ℕ⟧ where + coeff _ := 1 + isPWO_support' := by + simpa [Function.support] using + Set.IsPWO.of_linearOrder (Set.univ : Set (Unit ⊕ₗ ℕ)) + +/-- The singleton first part of `oneAddOmegaSplitSeries`. -/ +def oneAddOmegaLower : ℚ⟦Unit ⊕ₗ ℕ⟧ := + HahnSeries.filter (fun x ↦ x.isLeft) oneAddOmegaSplitSeries + +/-- The `ℕ`-indexed second part of `oneAddOmegaSplitSeries`. -/ +def oneAddOmegaUpper : ℚ⟦Unit ⊕ₗ ℕ⟧ := + HahnSeries.filter (fun x ↦ x.isRight) oneAddOmegaSplitSeries + +private theorem oneAddOmegaLower_support : oneAddOmegaLower.support = Set.range Sum.inlₗ := by + rw [oneAddOmegaLower, HahnSeries.support_filter] + ext x + rcases x with x | x + · constructor + · intro _ + exact ⟨x, rfl⟩ + · intro _ + simp [oneAddOmegaSplitSeries] + · constructor + · intro h + simp at h + · rintro ⟨y, h⟩ + have hlt : Sum.inlₗ y < Sum.inrₗ x := Sum.Lex.inl_lt_inr y x + exact (hlt.ne h).elim + +private theorem oneAddOmegaUpper_support : oneAddOmegaUpper.support = Set.range Sum.inrₗ := by + rw [oneAddOmegaUpper, HahnSeries.support_filter] + ext x + rcases x with x | x + · constructor + · intro h + simp at h + · rintro ⟨y, h⟩ + have hlt : Sum.inlₗ x < Sum.inrₗ y := Sum.Lex.inl_lt_inr x y + exact (hlt.ne h.symm).elim + · constructor + · intro _ + exact ⟨x, rfl⟩ + · intro _ + simp [oneAddOmegaSplitSeries] + +private theorem oneAddOmegaLower_supportOrderType : oneAddOmegaLower.supportOrderType = 1 := by + rw [HahnSeries.supportOrderType_eq_setOrderType] + have e : oneAddOmegaLower.support ≃o Unit := + (OrderIso.setCongr oneAddOmegaLower.support (Set.range Sum.inlₗ) + oneAddOmegaLower_support).trans + (OrderEmbedding.ofStrictMono Sum.inlₗ Sum.Lex.inl_strictMono).orderIso.symm + exact oneAddOmegaLower.isPWO_support.orderType_eq_typeLT_of_orderIso e |>.trans + Ordinal.type_unit + +private theorem oneAddOmegaUpper_supportOrderType : + oneAddOmegaUpper.supportOrderType = Ordinal.omega0 := by + rw [HahnSeries.supportOrderType_eq_setOrderType] + have e : oneAddOmegaUpper.support ≃o ℕ := + (OrderIso.setCongr oneAddOmegaUpper.support (Set.range Sum.inrₗ) + oneAddOmegaUpper_support).trans + (OrderEmbedding.ofStrictMono Sum.inrₗ Sum.Lex.inr_strictMono).orderIso.symm + exact oneAddOmegaUpper.isPWO_support.orderType_eq_typeLT_of_orderIso e |>.trans + Ordinal.type_nat_lt + +/-- The source decomposition uses ordinary `1 + ω = ω`, not the Hessenberg sum `ω + 1`. -/ +theorem oneAddOmega_decomposition_uses_ordinary_addition : + (oneAddOmegaLower + oneAddOmegaUpper).supportOrderType = Ordinal.omega0 ∧ + NatOrdinal.of oneAddOmegaLower.supportOrderType + + NatOrdinal.of oneAddOmegaUpper.supportOrderType ≠ + NatOrdinal.of (oneAddOmegaLower + oneAddOmegaUpper).supportOrderType := by + have hsep : ∀ i ∈ oneAddOmegaLower.support, ∀ j ∈ oneAddOmegaUpper.support, i < j := by + rw [oneAddOmegaLower_support, oneAddOmegaUpper_support] + rintro _ ⟨i, rfl⟩ _ ⟨j, rfl⟩ + exact Sum.Lex.inl_lt_inr i j + have hord := (HahnSeries.supportOrderType_eq_add_iff + (oneAddOmegaLower + oneAddOmegaUpper) 1 Ordinal.omega0).mpr + ⟨oneAddOmegaLower, oneAddOmegaUpper, HahnSeries.supportBelow_iff.mpr hsep, + oneAddOmegaLower_supportOrderType, oneAddOmegaUpper_supportOrderType, rfl⟩ + constructor + · simpa using hord + · rw [oneAddOmegaLower_supportOrderType, oneAddOmegaUpper_supportOrderType, hord, + Ordinal.one_add_omega0] + intro h + rw [add_comm] at h + have hone : NatOrdinal.of (1 : Ordinal) = 1 := rfl + rw [hone, ← NatOrdinal.of_add_one] at h + exact (lt_add_one Ordinal.omega0).ne' (NatOrdinal.of.injective h) + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/TruncationIntegerPartPrimal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/TruncationIntegerPartPrimal.lean new file mode 100644 index 0000000000..962e82019d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/TruncationIntegerPartPrimal.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.TruncationIntegerPartPrimal + +/-! +# API checks for truncation-integer-part primality + +This separately compiled client checks the Hahn-series specialization of LM24, Lemma 9.2.1. +-/ + +public noncomputable section + +namespace Tests + +open HahnSeries + +theorem truncationIntegerPart_primality_cases + {G L : Type*} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Field L] + (Z : Subring L) (b : truncationIntegerPart G Z) : + IsPrimal b ↔ + (Nonpositive.constantCoeffAlgHom (b : Nonpositive G L) ≠ 0 ∧ + IsPrimal (⟨Nonpositive.constantCoeffAlgHom (b : Nonpositive G L), by + rw [Nonpositive.constantCoeffAlgHom_apply] + exact (mem_truncationIntegerPart (R := L) (Γ := G)).mp b.2⟩ : Z) ∧ + IsPrimal (b : Nonpositive G L)) ∨ + (Nonpositive.constantCoeffAlgHom (b : Nonpositive G L) = 0 ∧ + IsPrimal (⟨(b : Nonpositive G L), Subring.le_fracSubring (by + change Nonpositive.constantCoeffAlgHom (b : Nonpositive G L) ∈ Z + rw [Nonpositive.constantCoeffAlgHom_apply] + exact (mem_truncationIntegerPart (R := L) (Γ := G)).mp b.2)⟩ : + Subring.residueSubring Nonpositive.constantCoeffAlgHom + (Subring.fracSubring Z))) := + Nonpositive.isPrimal_truncationIntegerPart_iff Z b + +theorem truncationIntegerPart_primality_at_one + {G L : Type*} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Field L] + (Z : Subring L) (b : truncationIntegerPart G Z) + (hb : Nonpositive.constantCoeffAlgHom (b : Nonpositive G L) = 1) : + IsPrimal b ↔ IsPrimal (b : Nonpositive G L) := + Nonpositive.isPrimal_truncationIntegerPart_iff_of_constantCoeff_eq_one Z b hb + +theorem truncationIntegerPart_primality_at_zero + {G L : Type*} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Field L] + (Z : Subring L) (hfrac : Subring.fracSubring Z = ⊤) + (b : truncationIntegerPart G Z) + (hb : Nonpositive.constantCoeffAlgHom (b : Nonpositive G L) = 0) : + IsPrimal b ↔ IsPrimal (b : Nonpositive G L) := + Nonpositive.isPrimal_truncationIntegerPart_iff_of_constantCoeff_eq_zero Z hfrac b hb + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/WeakNormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/WeakNormalForm.lean new file mode 100644 index 0000000000..a202ba5d97 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/WeakNormalForm.lean @@ -0,0 +1,225 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.WeakNormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorTermCount + +import Mathlib.Data.Sum.Order + +/-! +# API checks for LM24 weak normal forms + +The ordinal certificates separate LM24's positive additive-principal convention from Mathlib's +convention, which includes zero, and refute the false indecomposability clause printed in LM24, +Definition 3.3.1, using `1 + ω = ω`. + +The main Hahn-series fixture has coefficient one at every point of the lexicographic sum +`ℕ ⊕ₗ ℕ`. Its lower and upper components both have support order type `ω`, yet form two +strictly support-separated blocks. Hence its weak normal form has equal consecutive block order +types. This distinguishes LM24, Definition 3.3.2 from the nearby incorrect definition requiring +strict decrease, and it verifies that the uncompressed Cantor-term list retains repeated terms. +The exact terminal truncation also exercises LM24, Corollary 3.3.5 on a nonconstant, +infinite-support series. +-/ + +public noncomputable section + +namespace Tests + +open scoped HahnSeries + +/-- Zero distinguishes LM24's positive additive-principal convention from Mathlib's convention. -/ +theorem zero_separates_LM24_from_mathlib_principal : + ¬Ordinal.IsAdditivelyPrincipal 0 ∧ Ordinal.IsPrincipal (· + ·) 0 := by + constructor + · intro h + exact h.ne_zero rfl + · exact Ordinal.isPrincipal_zero + +/-- The additive-principal ordinal `ω` refutes the false printed indecomposability clause because +`1 + ω = ω` although neither summand is zero. -/ +theorem omega_refutes_printed_indecomposability : + Ordinal.IsAdditivelyPrincipal Ordinal.omega0 ∧ + ¬(∀ b c : Ordinal, Ordinal.omega0 = b + c → b = 0 ∨ c = 0) := by + constructor + · simpa using Ordinal.isAdditivelyPrincipal_omega0_opow 1 + · intro h + rcases h 1 Ordinal.omega0 (by simp) with h | h + · norm_num at h + · exact Ordinal.omega0_ne_zero h + +/-- The empty block list is the weak normal form of the zero series. -/ +theorem zero_weakNormalForm : + HahnSeries.IsWeakNormalForm (0 : ℚ⟦ℤ⟧) [] := by + rw [HahnSeries.isWeakNormalForm_iff] + simp [List.sortedGE_iff_pairwise] + +private instance : WellFoundedLT (ℕ ⊕ₗ ℕ) := + (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := ℕ)).symm.toRelEmbedding.isWellFounded + +/-- The coefficient-one Hahn series on the lexicographic sum of two copies of `ℕ`. -/ +def twoOmegaSeries : ℚ⟦ℕ ⊕ₗ ℕ⟧ where + coeff _ := 1 + isPWO_support' := by + simpa [Function.support] using Set.IsPWO.of_linearOrder (Set.univ : Set (ℕ ⊕ₗ ℕ)) + +/-- The first `ℕ`-indexed component of `twoOmegaSeries`. -/ +def twoOmegaLower : ℚ⟦ℕ ⊕ₗ ℕ⟧ := + HahnSeries.filter (fun x ↦ x.isLeft) twoOmegaSeries + +/-- The second `ℕ`-indexed component of `twoOmegaSeries`. -/ +def twoOmegaUpper : ℚ⟦ℕ ⊕ₗ ℕ⟧ := + HahnSeries.filter (fun x ↦ x.isRight) twoOmegaSeries + +private theorem twoOmegaLower_support : twoOmegaLower.support = Set.range Sum.inlₗ := by + rw [twoOmegaLower, HahnSeries.support_filter] + ext x + rcases x with x | x + · constructor + · intro _ + exact ⟨x, rfl⟩ + · intro _ + simp [twoOmegaSeries] + · constructor + · intro h + simp at h + · rintro ⟨y, h⟩ + exact ((Sum.Lex.inl_lt_inr y x).ne h).elim + +private theorem twoOmegaUpper_support : twoOmegaUpper.support = Set.range Sum.inrₗ := by + rw [twoOmegaUpper, HahnSeries.support_filter] + ext x + rcases x with x | x + · constructor + · intro h + simp at h + · rintro ⟨y, h⟩ + exact ((Sum.Lex.inl_lt_inr x y).ne h.symm).elim + · constructor + · intro _ + exact ⟨x, rfl⟩ + · intro _ + simp [twoOmegaSeries] + +private theorem twoOmegaLower_supportOrderType : + twoOmegaLower.supportOrderType = Ordinal.omega0 := by + rw [HahnSeries.supportOrderType_eq_setOrderType] + have e : twoOmegaLower.support ≃o ℕ := + (OrderIso.setCongr twoOmegaLower.support (Set.range Sum.inlₗ) + twoOmegaLower_support).trans + (OrderEmbedding.ofStrictMono Sum.inlₗ Sum.Lex.inl_strictMono).orderIso.symm + exact twoOmegaLower.isPWO_support.orderType_eq_typeLT_of_orderIso e |>.trans + Ordinal.type_nat_lt + +private theorem twoOmegaUpper_supportOrderType : + twoOmegaUpper.supportOrderType = Ordinal.omega0 := by + rw [HahnSeries.supportOrderType_eq_setOrderType] + have e : twoOmegaUpper.support ≃o ℕ := + (OrderIso.setCongr twoOmegaUpper.support (Set.range Sum.inrₗ) + twoOmegaUpper_support).trans + (OrderEmbedding.ofStrictMono Sum.inrₗ Sum.Lex.inr_strictMono).orderIso.symm + exact twoOmegaUpper.isPWO_support.orderType_eq_typeLT_of_orderIso e |>.trans + Ordinal.type_nat_lt + +private theorem twoOmega_supportBelow : + HahnSeries.SupportBelow twoOmegaLower twoOmegaUpper := by + rw [HahnSeries.supportBelow_iff, twoOmegaLower_support, twoOmegaUpper_support] + rintro _ ⟨i, rfl⟩ _ ⟨j, rfl⟩ + exact Sum.Lex.inl_lt_inr i j + +private theorem twoOmegaLower_add_upper : + twoOmegaLower + twoOmegaUpper = twoOmegaSeries := by + ext x + rcases x with x | x <;> simp [twoOmegaLower, twoOmegaUpper, twoOmegaSeries] + +private theorem twoOmegaLower_isWeaklyPrincipal : + HahnSeries.IsWeaklyPrincipal twoOmegaLower := by + rw [HahnSeries.isWeaklyPrincipal_iff, twoOmegaLower_supportOrderType] + simpa using Ordinal.isAdditivelyPrincipal_omega0_opow 1 + +private theorem twoOmegaUpper_isWeaklyPrincipal : + HahnSeries.IsWeaklyPrincipal twoOmegaUpper := by + rw [HahnSeries.isWeaklyPrincipal_iff, twoOmegaUpper_supportOrderType] + simpa using Ordinal.isAdditivelyPrincipal_omega0_opow 1 + +/-- The two equal-order-type components form an LM24 weak normal form. -/ +theorem twoOmega_weakNormalForm : + HahnSeries.IsWeakNormalForm twoOmegaSeries [twoOmegaLower, twoOmegaUpper] := by + rw [HahnSeries.isWeakNormalForm_iff_isChain] + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa using twoOmegaLower_add_upper + · intro b hb + simp only [List.mem_cons, List.not_mem_nil, or_false] at hb + rcases hb with rfl | rfl + · exact twoOmegaLower_isWeaklyPrincipal + · exact twoOmegaUpper_isWeaklyPrincipal + · simp [twoOmegaLower_supportOrderType, twoOmegaUpper_supportOrderType, + List.sortedGE_iff_pairwise] + · exact List.isChain_pair.mpr twoOmega_supportBelow + +/-- The support order type of the two-block fixture is the ordinary ordinal sum `ω + ω`. -/ +theorem twoOmegaSeries_supportOrderType : + twoOmegaSeries.supportOrderType = Ordinal.omega0 + Ordinal.omega0 := by + apply (HahnSeries.supportOrderType_eq_add_iff _ _ _).mpr + exact ⟨twoOmegaLower, twoOmegaUpper, twoOmega_supportBelow, + twoOmegaLower_supportOrderType, twoOmegaUpper_supportOrderType, + twoOmegaLower_add_upper.symm⟩ + +/-- Equal consecutive block order types are permitted by LM24's nonincreasing condition. -/ +theorem twoOmega_weakNormalForm_has_equal_block_orderTypes : + HahnSeries.IsWeakNormalForm twoOmegaSeries [twoOmegaLower, twoOmegaUpper] ∧ + twoOmegaLower.supportOrderType = twoOmegaUpper.supportOrderType := by + exact ⟨twoOmega_weakNormalForm, + twoOmegaLower_supportOrderType.trans twoOmegaUpper_supportOrderType.symm⟩ + +/-- The uncompressed Cantor-term list retains the two repeated `ω` terms. -/ +theorem twoOmega_repeated_additivePrincipalTerms : + twoOmegaSeries.supportOrderType.additivePrincipalTerms = + [Ordinal.omega0, Ordinal.omega0] := by + have h := twoOmega_weakNormalForm.supportOrderTypes_eq_additivePrincipalTerms + simpa only [List.map_cons, List.map_nil, twoOmegaLower_supportOrderType, + twoOmegaUpper_supportOrderType] using h.symm + +/-- Counting the uncompressed Cantor terms retains both repeated copies of `ω`. -/ +theorem twoOmega_cantorTermCount : + NatOrdinal.cantorTermCount + (NatOrdinal.of twoOmegaSeries.supportOrderType) = 2 := by + rw [NatOrdinal.cantorTermCount_of, twoOmega_repeated_additivePrincipalTerms] + rfl + +/-- The public uniqueness theorem identifies any weak normal form of the fixture. -/ +theorem twoOmega_weakNormalForm_unique (blocks : List ℚ⟦ℕ ⊕ₗ ℕ⟧) + (hblocks : HahnSeries.IsWeakNormalForm twoOmegaSeries blocks) : + blocks = [twoOmegaLower, twoOmegaUpper] := + hblocks.unique twoOmega_weakNormalForm + +/-- At the first exponent of the upper block, weak upper truncation returns exactly that block. -/ +theorem twoOmega_terminal_truncation : + HahnSeries.truncGE (Sum.inrₗ 0) twoOmegaSeries = twoOmegaUpper := by + ext x + induction x using Lex.rec with + | h x => + rcases x with x | x + · rw [HahnSeries.coeff_truncGE_of_lt (Sum.Lex.inl_lt_inr x 0)] + rw [twoOmegaUpper, HahnSeries.coeff_filter] + rfl + · have hle : (Sum.inrₗ 0 : ℕ ⊕ₗ ℕ) ≤ Sum.inrₗ x := + Sum.Lex.inr_le_inr_iff.mpr (Nat.zero_le x) + rw [HahnSeries.coeff_truncGE_of_le hle] + rw [twoOmegaUpper, HahnSeries.coeff_filter] + rfl + +/-- The explicit terminal truncation is nonzero and weakly principal, as in LM24, Corollary +3.3.5. -/ +theorem twoOmega_terminal_truncation_certificate : + HahnSeries.truncGE (Sum.inrₗ 0) twoOmegaSeries ≠ 0 ∧ + HahnSeries.IsWeaklyPrincipal + (HahnSeries.truncGE (Sum.inrₗ 0) twoOmegaSeries) := by + rw [twoOmega_terminal_truncation] + exact ⟨twoOmegaUpper_isWeaklyPrincipal.ne_zero, twoOmegaUpper_isWeaklyPrincipal⟩ + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Translation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Translation.lean new file mode 100644 index 0000000000..a0beace824 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Translation.lean @@ -0,0 +1,192 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +public import Mathlib.Algebra.Order.Group.OrderIso + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Domain + +/-! +# Translation of Hahn-series exponents + +An order isomorphism between exponent types induces an additive equivalence between the +corresponding Hahn-series types. Translation by `a` is the specialization to the order +isomorphism `g ↦ a + g`. Its support is the translate of the original support, and it preserves +support order type. + +For a semiring of coefficients, translation agrees with multiplication on either side by the +coefficient-one monomial at `a`. Thus `HahnSeries.translate a x` is the operation denoted by +`t^a x` or `x t^a` in LM24. + +The construction uses `HahnSeries.embDomain`; the exact support formula comes from the +domain-embedding interface. +-/ + +universe u v w + +public noncomputable section + +namespace HahnSeries + +section Reindex + +variable {R : Type w} {G : Type u} {H : Type v} +variable [PartialOrder G] [PartialOrder H] [AddMonoid R] + +/-- Reindex Hahn-series exponents along an order isomorphism. -/ +def embDomainAddEquiv (e : G ≃o H) : R⟦G⟧ ≃+ R⟦H⟧ where + toFun := embDomain e.toOrderEmbedding + invFun := embDomain e.symm.toOrderEmbedding + left_inv x := by + ext g + have outer := embDomain_coeff (f := e.symm.toOrderEmbedding) + (x := embDomain e.toOrderEmbedding x) (a := e g) + have inner := embDomain_coeff (f := e.toOrderEmbedding) (x := x) (a := g) + simpa using outer.trans inner + right_inv x := by + ext h + have outer := embDomain_coeff (f := e.toOrderEmbedding) + (x := embDomain e.symm.toOrderEmbedding x) (a := e.symm h) + have inner := embDomain_coeff (f := e.symm.toOrderEmbedding) (x := x) (a := h) + simpa using outer.trans inner + map_add' := embDomain_add e.toOrderEmbedding + +@[simp] +theorem coeff_embDomainAddEquiv (e : G ≃o H) (x : R⟦G⟧) (g : G) : + (embDomainAddEquiv e x).coeff (e g) = x.coeff g := + embDomain_coeff + +end Reindex + +section OrderType + +variable {R : Type v} {G H : Type u} +variable [LinearOrder G] [LinearOrder H] [AddMonoid R] + +/-- Reindexing along an order isomorphism preserves ordinary support order type. -/ +@[simp] +theorem supportOrderType_embDomainAddEquiv (e : G ≃o H) (x : R⟦G⟧) : + (embDomainAddEquiv e x).supportOrderType = x.supportOrderType := by + rw [supportOrderType_eq_setOrderType, supportOrderType_eq_setOrderType] + letI : WellFoundedLT x.support := ⟨x.isWF_support⟩ + let supportEquiv : (embDomainAddEquiv e x).support ≃o x.support := + (OrderIso.setCongr _ (e '' x.support) (support_embDomain e.toOrderEmbedding x)).trans + (StrictMonoOn.orderIso e x.support (e.strictMono.strictMonoOn x.support)).symm + exact (embDomainAddEquiv e x).isPWO_support.orderType_eq_typeLT_of_orderIso supportEquiv |>.trans + (x.isPWO_support.orderType_eq_typeLT_of_orderIso (OrderIso.refl x.support)).symm + +end OrderType + +section Translation + +variable {R : Type v} {G : Type u} +variable [PartialOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] [AddMonoid R] + +/-- Translate every exponent in a Hahn series by `a`. -/ +def translate (a : G) : R⟦G⟧ ≃+ R⟦G⟧ := + embDomainAddEquiv (OrderIso.addLeft a) + +theorem coeff_translate_add (a g : G) (x : R⟦G⟧) : + (translate a x).coeff (a + g) = x.coeff g := + coeff_embDomainAddEquiv _ _ _ + +/-- Translation evaluates at `g` by reading the original coefficient at `g - a`. -/ +@[simp] +theorem coeff_translate (a g : G) (x : R⟦G⟧) : + (translate a x).coeff g = x.coeff (g - a) := by + simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using + coeff_translate_add a (g - a) x + +/-- The support of a translated Hahn series is the corresponding translate of its support. -/ +theorem support_translate (a : G) (x : R⟦G⟧) : + (translate a x).support = (a + ·) '' x.support := + support_embDomain _ _ + +@[simp] +theorem translate_zero_apply (x : R⟦G⟧) : translate 0 x = x := by + ext g + simp + +@[simp] +theorem translate_add_apply (a b : G) (x : R⟦G⟧) : + translate a (translate b x) = translate (a + b) x := by + ext g + simp [sub_sub] + +theorem translate_neg_apply (a : G) (x : R⟦G⟧) : + translate (-a) (translate a x) = x := by + rw [translate_add_apply, neg_add_cancel, translate_zero_apply] + +end Translation + +section TranslationOrderType + +variable {R : Type v} {G : Type u} +variable [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] [AddMonoid R] + +/-- Translation preserves ordinary support order type. -/ +@[simp] +theorem supportOrderType_translate (a : G) (x : R⟦G⟧) : + (translate a x).supportOrderType = x.supportOrderType := + supportOrderType_embDomainAddEquiv (R := R) _ _ + +/-- Translation preserves LM24 degree. -/ +@[simp] +theorem degree_translate (a : G) (x : R⟦G⟧) : + (translate a x).degree = x.degree := by + rw [degree_eq_cantorDegree, supportOrderType_translate, ← degree_eq_cantorDegree] + +/-- Weak lower truncation commutes with translation after shifting the cutoff. -/ +theorem truncLE_translate (a c : G) (x : R⟦G⟧) : + truncLE c (translate a x) = translate a (truncLE (c - a) x) := by + ext g + simp only [HahnSeries.coeff_truncLE, coeff_translate] + by_cases hgc : g ≤ c + · have hsub : g - a ≤ c - a := sub_le_sub_right hgc a + simp [hgc, hsub] + · have hsub : ¬g - a ≤ c - a := fun h ↦ hgc ((sub_le_sub_iff_right a).mp h) + simp [hgc, hsub] + +end TranslationOrderType + +section Monomial + +variable {R : Type v} {G : Type u} +variable [PartialOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] [Semiring R] + +/-- Left multiplication by the coefficient-one monomial at `a` translates exponents by `a`. -/ +theorem single_one_mul_eq_translate (a : G) (x : R⟦G⟧) : + single a 1 * x = translate a x := by + ext g + rw [coeff_single_mul, coeff_translate, one_mul] + +/-- Right multiplication by the coefficient-one monomial at `a` translates exponents by `a`. -/ +theorem mul_single_one_eq_translate (x : R⟦G⟧) (a : G) : + x * single a 1 = translate a x := by + ext g + rw [coeff_mul_single, coeff_translate, mul_one] + +/-- The product of two translated Hahn series is the translate of their product by the sum of +the two shifts. -/ +theorem translate_mul_translate (a b : G) (x y : R⟦G⟧) : + translate a x * translate b y = translate (a + b) (x * y) := by + calc + translate a x * translate b y = + (single a 1 * x) * (single b 1 * y) := by + rw [single_one_mul_eq_translate, single_one_mul_eq_translate] + _ = single a 1 * (x * single b 1) * y := by simp only [mul_assoc] + _ = single a 1 * translate b x * y := by + rw [mul_single_one_eq_translate x b] + _ = single a 1 * (single b 1 * x) * y := by + rw [single_one_mul_eq_translate b x] + _ = (single a 1 * single b 1) * (x * y) := by simp only [mul_assoc] + _ = single (a + b) 1 * (x * y) := by rw [single_mul_single, one_mul] + _ = translate (a + b) (x * y) := single_one_mul_eq_translate _ _ + +end Monomial + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Truncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Truncation.lean new file mode 100644 index 0000000000..a6496d3de6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Truncation.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.RingTheory.HahnSeries.Addition + +/-! +# Coefficient restrictions and truncations of Hahn series + +This module restricts a Hahn series to an arbitrary decidable predicate on its exponents. The four +interval restrictions specialize this operation to LM24, Definition 3.2.2. Mathlib already +provides the strict lower truncation `HahnSeries.truncLT`; the definitions here add the weak lower, +weak upper, and strict upper truncations with the same argument order and `ZeroHom` interface. +Every resulting support is a subset of the original support, so these operations preserve any +fixed upper bound on support cardinality used in LM24. + +The inequalities use the ambient order on the exponents. Thus `truncLE c x` retains the coefficient +of `x` at `i` exactly when `i ≤ c`; no reversal of the support order occurs. + +Mathlib supplies `HahnSeries.truncLT`, which is reused directly. `Finsupp.filter` cannot apply to an +arbitrary well-ordered, possibly infinite support, and CombinatorialGames' surreal truncation uses +its reverse-support representation. The operations here therefore work directly with Hahn-series +coefficients and support proofs. +-/ + +universe u v + +public noncomputable section + +namespace HahnSeries + +variable {R : Type v} {G : Type u} + +section Zero + +variable [PartialOrder G] [Zero R] + +/-- Keep exactly the coefficients whose indices satisfy `p`. -/ +def filter (p : G → Prop) [DecidablePred p] : ZeroHom R⟦G⟧ R⟦G⟧ where + toFun x := + { coeff i := if p i then x.coeff i else 0 + isPWO_support' := x.isPWO_support.mono (by simp) } + map_zero' := by ext; simp + +@[simp] +protected theorem coeff_filter (p : G → Prop) [DecidablePred p] (x : R⟦G⟧) (i : G) : + (filter p x).coeff i = if p i then x.coeff i else 0 := + (rfl) + +/-- The support of a coefficient restriction is the corresponding subset of the original support. -/ +theorem support_filter (p : G → Prop) [DecidablePred p] (x : R⟦G⟧) : + (filter p x).support = {i ∈ x.support | p i} := by + ext i + simp [and_comm] + +theorem support_filter_subset (p : G → Prop) [DecidablePred p] (x : R⟦G⟧) : + (filter p x).support ⊆ x.support := by + rw [support_filter] + exact Set.sep_subset _ _ + +/-- Keeps exactly the coefficients at indices `i` satisfying `i ≤ c`. -/ +def truncLE [DecidableLE G] (c : G) : ZeroHom R⟦G⟧ R⟦G⟧ := + filter (· ≤ c) + +/-- Keeps exactly the coefficients at indices `i` satisfying `c ≤ i`. -/ +def truncGE [DecidableLE G] (c : G) : ZeroHom R⟦G⟧ R⟦G⟧ := + filter (c ≤ ·) + +/-- Keeps exactly the coefficients at indices `i` satisfying `c < i`. -/ +def truncGT [DecidableLT G] (c : G) : ZeroHom R⟦G⟧ R⟦G⟧ := + filter (c < ·) + +@[simp] +protected theorem coeff_truncLE [DecidableLE G] (c : G) (x : R⟦G⟧) (i : G) : + (truncLE c x).coeff i = if i ≤ c then x.coeff i else 0 := + (rfl) + +@[simp] +protected theorem coeff_truncGE [DecidableLE G] (c : G) (x : R⟦G⟧) (i : G) : + (truncGE c x).coeff i = if c ≤ i then x.coeff i else 0 := + (rfl) + +@[simp] +protected theorem coeff_truncGT [DecidableLT G] (c : G) (x : R⟦G⟧) (i : G) : + (truncGT c x).coeff i = if c < i then x.coeff i else 0 := + (rfl) + +theorem coeff_truncLE_of_le [DecidableLE G] {c i : G} (h : i ≤ c) (x : R⟦G⟧) : + (truncLE c x).coeff i = x.coeff i := by + simp [h] + +theorem coeff_truncLE_of_lt [DecidableLE G] {c i : G} (h : c < i) (x : R⟦G⟧) : + (truncLE c x).coeff i = 0 := by + simp [not_le_of_gt h] + +theorem coeff_truncGE_of_le [DecidableLE G] {c i : G} (h : c ≤ i) (x : R⟦G⟧) : + (truncGE c x).coeff i = x.coeff i := by + simp [h] + +theorem coeff_truncGE_of_lt [DecidableLE G] {c i : G} (h : i < c) (x : R⟦G⟧) : + (truncGE c x).coeff i = 0 := by + simp [not_le_of_gt h] + +theorem coeff_truncGT_of_lt [DecidableLT G] {c i : G} (h : c < i) (x : R⟦G⟧) : + (truncGT c x).coeff i = x.coeff i := by + simp [h] + +theorem coeff_truncGT_of_le [DecidableLT G] {c i : G} (h : i ≤ c) (x : R⟦G⟧) : + (truncGT c x).coeff i = 0 := by + simp [not_lt_of_ge h] + +theorem support_truncLE [DecidableLE G] (c : G) (x : R⟦G⟧) : + (truncLE c x).support = {i ∈ x.support | i ≤ c} := + support_filter _ _ + +theorem support_truncGE [DecidableLE G] (c : G) (x : R⟦G⟧) : + (truncGE c x).support = {i ∈ x.support | c ≤ i} := + support_filter _ _ + +theorem support_truncGT [DecidableLT G] (c : G) (x : R⟦G⟧) : + (truncGT c x).support = {i ∈ x.support | c < i} := + support_filter _ _ + +theorem support_truncLE_subset [DecidableLE G] (c : G) (x : R⟦G⟧) : + (truncLE c x).support ⊆ x.support := + support_filter_subset _ _ + +theorem support_truncGE_subset [DecidableLE G] (c : G) (x : R⟦G⟧) : + (truncGE c x).support ⊆ x.support := + support_filter_subset _ _ + +theorem support_truncGT_subset [DecidableLT G] (c : G) (x : R⟦G⟧) : + (truncGT c x).support ⊆ x.support := + support_filter_subset _ _ + +/-- A weak lower truncation is the original series when the support lies below its cutoff. -/ +theorem truncLE_eq_self_of_support_subset_Iic [DecidableLE G] + {c : G} {x : R⟦G⟧} (h : x.support ⊆ Set.Iic c) : + truncLE c x = x := by + ext i + by_cases hi : i ∈ x.support + · exact coeff_truncLE_of_le (h hi) x + · have hcoeff : x.coeff i = 0 := not_ne_iff.mp hi + simp [hcoeff] + +end Zero + +section AddMonoid + +variable [PartialOrder G] [AddMonoid R] + +theorem filter_add (p : G → Prop) [DecidablePred p] (x y : R⟦G⟧) : + filter p (x + y) = filter p x + filter p y := by + ext i + by_cases hi : p i <;> simp [hi] + +theorem truncLE_add [DecidableLE G] (c : G) (x y : R⟦G⟧) : + truncLE c (x + y) = truncLE c x + truncLE c y := + filter_add _ _ _ + +theorem truncGE_add [DecidableLE G] (c : G) (x y : R⟦G⟧) : + truncGE c (x + y) = truncGE c x + truncGE c y := + filter_add _ _ _ + +theorem truncGT_add [DecidableLT G] (c : G) (x y : R⟦G⟧) : + truncGT c (x + y) = truncGT c x + truncGT c y := + filter_add _ _ _ + +end AddMonoid + +section LinearOrder + +variable [LinearOrder G] [AddMonoid R] + +/-- A Hahn series is the sum of its strict lower and weak upper truncations. -/ +theorem truncLT_add_truncGE (c : G) (x : R⟦G⟧) : + truncLT c x + truncGE c x = x := by + ext i + by_cases hi : i < c + · simp [hi, not_le_of_gt hi] + · simp [hi, le_of_not_gt hi] + +/-- A Hahn series is the sum of its weak lower and strict upper truncations. -/ +theorem truncLE_add_truncGT (c : G) (x : R⟦G⟧) : + truncLE c x + truncGT c x = x := by + ext i + by_cases hi : i ≤ c + · simp [hi, not_lt_of_ge hi] + · simp [hi, lt_of_not_ge hi] + +end LinearOrder + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/TruncationIntegerPartPrimal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/TruncationIntegerPartPrimal.lean new file mode 100644 index 0000000000..0c7c5cd2ec --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/TruncationIntegerPartPrimal.lean @@ -0,0 +1,169 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Negative + +/-! +# Primality in a Hahn-series truncation integer part + +This module specializes the generic residue-preimage form of LM24, Lemma 9.2.1 to +`Z + L((H^{<0}))`, represented intrinsically as the nonpositive Hahn series whose coefficient at +zero belongs to `Z`. The coefficient-at-zero map is an algebra retraction of constant series. +-/ + +universe u v + +public noncomputable section + +namespace HahnSeries.Nonpositive + +variable {G : Type u} {L : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Field L] + +/-- Nonpositive Hahn series form an algebra over their coefficient field by constant series. -/ +instance : Algebra L (Nonpositive G L) where + algebraMap := C + smul r x := C r * x + commutes' _ _ := mul_comm _ _ + smul_def' _ _ := rfl + +/-- The coefficient-field algebra map is the constant-series embedding. -/ +@[simp] +theorem algebraMap_apply (r : L) : + algebraMap L (Nonpositive G L) r = C r := (rfl) + +/-- Scalar multiplication commutes with the coercion to Hahn series. -/ +@[simp, norm_cast] +theorem coe_smul (r : L) (x : Nonpositive G L) : + ((r • x : Nonpositive G L) : L⟦G⟧) = r • (x : L⟦G⟧) := by + rw [Algebra.smul_def, algebraMap_apply, Subring.coe_mul, coe_C, + HahnSeries.C_mul_eq_smul] + +/-- Coefficient at exponent zero as an algebra retraction of the constant-series embedding. -/ +def constantCoeffAlgHom : Nonpositive G L →ₐ[L] L where + __ := constantCoeff + commutes' r := by + change constantCoeff (C r : Nonpositive G L) = r + simp + +@[simp] +theorem constantCoeffAlgHom_apply (x : Nonpositive G L) : + constantCoeffAlgHom x = (x : L⟦G⟧).coeff 0 := + constantCoeff_apply x + +/-- The truncation integer part is definitionally the residue preimage under coefficient at +zero. -/ +theorem truncationIntegerPart_eq_residueSubring (Z : Subring L) : + truncationIntegerPart G Z = + Subring.residueSubring (constantCoeffAlgHom (G := G) (L := L)) Z := + by + ext x + rw [mem_truncationIntegerPart, Subring.mem_residueSubring, + constantCoeffAlgHom_apply] + +/-- The canonical identity-on-elements equivalence with the residue-preimage presentation. -/ +def truncationIntegerPartEquivResidueSubring (Z : Subring L) : + truncationIntegerPart G Z ≃+* + Subring.residueSubring (constantCoeffAlgHom (G := G) (L := L)) Z where + toFun x := ⟨x, by rw [← truncationIntegerPart_eq_residueSubring Z]; exact x.2⟩ + invFun x := ⟨x, by rw [truncationIntegerPart_eq_residueSubring Z]; exact x.2⟩ + left_inv _ := rfl + right_inv _ := rfl + map_mul' _ _ := rfl + map_add' _ _ := rfl + +/-- LM24, Lemma 9.2.1 specialized to `Z + L((G^{<0}))`. -/ +theorem isPrimal_truncationIntegerPart_iff (Z : Subring L) + (b : truncationIntegerPart G Z) : + IsPrimal b ↔ + (constantCoeffAlgHom (b : Nonpositive G L) ≠ 0 ∧ + IsPrimal (⟨constantCoeffAlgHom (b : Nonpositive G L), by + rw [constantCoeffAlgHom_apply] + exact (mem_truncationIntegerPart (R := L) (Γ := G)).mp b.2⟩ : Z) ∧ + IsPrimal (b : Nonpositive G L)) ∨ + (constantCoeffAlgHom (b : Nonpositive G L) = 0 ∧ + IsPrimal (⟨(b : Nonpositive G L), Subring.le_fracSubring (by + change constantCoeffAlgHom (b : Nonpositive G L) ∈ Z + rw [constantCoeffAlgHom_apply] + exact (mem_truncationIntegerPart (R := L) (Γ := G)).mp b.2)⟩ : + Subring.residueSubring constantCoeffAlgHom (Subring.fracSubring Z))) := + by + let e := truncationIntegerPartEquivResidueSubring (G := G) (L := L) Z + rw [← RingEquiv.isPrimal_iff e b] + exact Subring.isPrimal_residueSubring_iff (e b).2 + +/-- At constant coefficient one, primality in the truncation integer part is exactly primality +in the ambient nonpositive Hahn ring. This is the nonzero-residue case used in LM24, +Proposition 9.2.2. -/ +theorem isPrimal_truncationIntegerPart_iff_of_constantCoeff_eq_one + (Z : Subring L) (b : truncationIntegerPart G Z) + (hb : constantCoeffAlgHom (b : Nonpositive G L) = 1) : + IsPrimal b ↔ IsPrimal (b : Nonpositive G L) := by + constructor + · intro h + rcases (isPrimal_truncationIntegerPart_iff Z b).mp h with hnonzero | hzero + · exact hnonzero.2.2 + · exact (one_ne_zero (hb.symm.trans hzero.1)).elim + · intro h + apply (isPrimal_truncationIntegerPart_iff Z b).mpr + left + refine ⟨?_, ?_, h⟩ + · rw [hb] + exact one_ne_zero + · have hone : (⟨constantCoeffAlgHom (b : Nonpositive G L), by + rw [constantCoeffAlgHom_apply] + exact (mem_truncationIntegerPart (R := L) (Γ := G)).mp b.2⟩ : Z) = 1 := by + apply Subtype.ext + exact hb + rw [hone] + intro c d _ + exact ⟨1, 1, one_dvd _, one_dvd _, (mul_one 1).symm⟩ + +/-- At constant coefficient zero, if the fraction field generated by the coefficient subring is +the whole coefficient field, primality in the truncation integer part is exactly ambient +primality. This is the zero-residue case used in LM24, Proposition 9.2.2. -/ +theorem isPrimal_truncationIntegerPart_iff_of_constantCoeff_eq_zero + (Z : Subring L) (hfrac : Subring.fracSubring Z = ⊤) + (b : truncationIntegerPart G Z) + (hb : constantCoeffAlgHom (b : Nonpositive G L) = 0) : + IsPrimal b ↔ IsPrimal (b : Nonpositive G L) := by + let e : Subring.residueSubring + (constantCoeffAlgHom (G := G) (L := L)) (Subring.fracSubring Z) ≃+* + Nonpositive G L := { + toFun x := x + invFun x := ⟨x, by rw [Subring.mem_residueSubring, hfrac]; exact Subring.mem_top _⟩ + left_inv _ := rfl + right_inv _ := rfl + map_mul' _ _ := rfl + map_add' _ _ := rfl } + constructor + · intro h + rcases (isPrimal_truncationIntegerPart_iff Z b).mp h with hnonzero | hzero + · exact (hnonzero.1 hb).elim + · let b' : Subring.residueSubring + (constantCoeffAlgHom (G := G) (L := L)) (Subring.fracSubring Z) := + ⟨b, Subring.le_fracSubring (by + change constantCoeffAlgHom (b : Nonpositive G L) ∈ Z + rw [constantCoeffAlgHom_apply] + exact (mem_truncationIntegerPart (R := L) (Γ := G)).mp b.2)⟩ + have hb' : IsPrimal b' := by exact hzero.2 + exact (RingEquiv.isPrimal_iff e b').mpr hb' + · intro h + apply (isPrimal_truncationIntegerPart_iff Z b).mpr + right + refine ⟨hb, ?_⟩ + let b' : Subring.residueSubring + (constantCoeffAlgHom (G := G) (L := L)) (Subring.fracSubring Z) := + ⟨b, Subring.le_fracSubring (by + change constantCoeffAlgHom (b : Nonpositive G L) ∈ Z + rw [constantCoeffAlgHom_apply] + exact (mem_truncationIntegerPart (R := L) (Γ := G)).mp b.2)⟩ + have hb' := (RingEquiv.isPrimal_iff e b').mp h + exact hb' + +end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/WeakNormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/WeakNormalForm.lean new file mode 100644 index 0000000000..d915595fb3 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/WeakNormalForm.lean @@ -0,0 +1,232 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal + +/-! +# Weak normal forms of Hahn series + +This module formalizes LM24, Definitions 3.3.1 and 3.3.2, Proposition 3.3.4, and Corollary +3.3.5. A weakly principal Hahn series has positive additive-principal support order type. A weak +normal form is a finite lower-to-upper decomposition into weakly principal blocks whose support +order types are nonincreasing. The definition uses pairwise support separation; the +`isWeakNormalForm_iff_isChain` theorem proves that this is exactly the adjacent chain printed in +LM24 because every weakly principal block is nonzero. + +The order-type condition is deliberately nonstrict. Repeated equal powers of `ω` represent finite +coefficients in Cantor normal form and must produce distinct consecutive blocks. The zero series +has the empty weak normal form. + +The existence and uniqueness theorem is generalized from field coefficients and LM24's fixed +support-cardinality bound to additive-monoid coefficients and unrestricted Hahn series. Every +constructed block has support contained in the original support, so the construction restricts to +the source's bounded-support regime. +-/ + +universe u v + +public noncomputable section + +namespace HahnSeries + +variable {R : Type v} {G : Type u} [LinearOrder G] [AddMonoid R] + +/-- A weakly principal Hahn series has positive additive-principal support order type. -/ +def IsWeaklyPrincipal (x : R⟦G⟧) : Prop := + x.supportOrderType.IsAdditivelyPrincipal + +/-- Characterization of weakly principal Hahn series by their support order type. -/ +theorem isWeaklyPrincipal_iff {x : R⟦G⟧} : + IsWeaklyPrincipal x ↔ x.supportOrderType.IsAdditivelyPrincipal := + (Iff.rfl) + +/-- A weakly principal Hahn series is nonzero. -/ +theorem IsWeaklyPrincipal.ne_zero {x : R⟦G⟧} (hx : IsWeaklyPrincipal x) : x ≠ 0 := by + intro hzero + subst x + exact (Ordinal.IsAdditivelyPrincipal.ne_zero (isWeaklyPrincipal_iff.mp hx)) + supportOrderType_zero + +/-- The four clauses defining an LM24 weak normal form. -/ +def IsWeakNormalForm (x : R⟦G⟧) (blocks : List R⟦G⟧) : Prop := + blocks.sum = x ∧ + (∀ b ∈ blocks, IsWeaklyPrincipal b) ∧ + (blocks.map supportOrderType).SortedGE ∧ + blocks.Pairwise SupportBelow + +/-- Characterization of an LM24 weak normal form by its sum, blocks, order types, and supports. -/ +theorem isWeakNormalForm_iff {x : R⟦G⟧} {blocks : List R⟦G⟧} : + IsWeakNormalForm x blocks ↔ + blocks.sum = x ∧ + (∀ b ∈ blocks, IsWeaklyPrincipal b) ∧ + (blocks.map supportOrderType).SortedGE ∧ + blocks.Pairwise SupportBelow := + (Iff.rfl) + +/-- Source-form characterization using the adjacent support chain printed in LM24, Definition +3.3.2. Nonzeroness of weakly principal blocks makes this equivalent to pairwise separation. -/ +theorem isWeakNormalForm_iff_isChain {x : R⟦G⟧} {blocks : List R⟦G⟧} : + IsWeakNormalForm x blocks ↔ + blocks.sum = x ∧ + (∀ b ∈ blocks, IsWeaklyPrincipal b) ∧ + (blocks.map supportOrderType).SortedGE ∧ + blocks.IsChain SupportBelow := by + rw [isWeakNormalForm_iff] + constructor + · rintro ⟨hsum, hprincipal, hsorted, hpair⟩ + exact ⟨hsum, hprincipal, hsorted, hpair.isChain⟩ + · rintro ⟨hsum, hprincipal, hsorted, hchain⟩ + refine ⟨hsum, hprincipal, hsorted, ?_⟩ + apply pairwise_supportBelow_of_isChain + · exact fun b hb ↦ (hprincipal b hb).ne_zero + · exact hchain + +private theorem exists_orderType_blocks (x : R⟦G⟧) (types : List Ordinal) + (htype : x.supportOrderType = types.sum) : + ∃ blocks : List R⟦G⟧, + blocks.sum = x ∧ + blocks.map supportOrderType = types ∧ + blocks.Pairwise SupportBelow := by + induction types generalizing x with + | nil => + have hx : x = 0 := supportOrderType_eq_zero.mp (by simpa using htype) + subst x + exact ⟨[], by simp⟩ + | cons a types ih => + have hsplit : x.supportOrderType = a + types.sum := by + simpa only [List.sum_cons] using htype + obtain ⟨y, z, hyz, hya, hztypes, hx⟩ := + (supportOrderType_eq_add_iff x a types.sum).mp hsplit + obtain ⟨blocks, hsum, htypes, hpair⟩ := ih z hztypes + refine ⟨y :: blocks, ?_, ?_, ?_⟩ + · rw [List.sum_cons, hsum] + exact hx.symm + · simp only [List.map_cons, hya, htypes] + · rw [List.pairwise_cons] + refine ⟨?_, hpair⟩ + intro b hb + rw [supportBelow_iff] + intro i hi j hj + have hbsub : b.support ⊆ z.support := by + have hsubset := support_subset_list_sum_of_mem hpair hb + rwa [hsum] at hsubset + exact hyz.lt hi (hbsub hj) + +/-- Every Hahn series has a weak normal form. This is the existence part of LM24, Proposition +3.3.4. -/ +theorem exists_isWeakNormalForm (x : R⟦G⟧) : + ∃ blocks : List R⟦G⟧, IsWeakNormalForm x blocks := by + obtain ⟨blocks, hsum, htypes, hpair⟩ := exists_orderType_blocks x + x.supportOrderType.additivePrincipalTerms + (Ordinal.additivePrincipalTerms_sum x.supportOrderType).symm + refine ⟨blocks, isWeakNormalForm_iff.mpr ⟨hsum, ?_, ?_, hpair⟩⟩ + · intro b hb + rw [isWeaklyPrincipal_iff] + apply Ordinal.isAdditivelyPrincipal_of_mem_additivePrincipalTerms + rw [← htypes] + exact List.mem_map.mpr ⟨b, hb, rfl⟩ + · rw [htypes] + exact Ordinal.additivePrincipalTerms_sortedGE _ + +/-- The support order types of a weak normal form are the uncompressed Cantor terms of the whole +support order type. -/ +theorem IsWeakNormalForm.supportOrderTypes_eq_additivePrincipalTerms + {x : R⟦G⟧} {blocks : List R⟦G⟧} (h : IsWeakNormalForm x blocks) : + blocks.map supportOrderType = x.supportOrderType.additivePrincipalTerms := by + obtain ⟨hsum, hprincipal, hsorted, hpair⟩ := isWeakNormalForm_iff.mp h + apply Ordinal.additivePrincipalTerms_unique + · calc + (blocks.map supportOrderType).sum = blocks.sum.supportOrderType := + (supportOrderType_list_sum hpair).symm + _ = x.supportOrderType := congrArg supportOrderType hsum + · intro a ha + obtain ⟨b, hb, rfl⟩ := List.mem_map.mp ha + exact isWeaklyPrincipal_iff.mp (hprincipal b hb) + · exact hsorted + +private theorem eq_of_pairwise_sum_and_orderTypes {xs ys : List R⟦G⟧} + (hxpair : xs.Pairwise SupportBelow) (hypair : ys.Pairwise SupportBelow) + (hsum : xs.sum = ys.sum) (htypes : xs.map supportOrderType = ys.map supportOrderType) : + xs = ys := by + induction xs generalizing ys with + | nil => simpa using htypes + | cons x xs ih => + cases ys with + | nil => simp at htypes + | cons y ys => + rw [List.pairwise_cons] at hxpair hypair + simp only [List.map_cons, List.cons.injEq] at htypes + have hxbelow : SupportBelow x xs.sum := supportBelow_list_sum hxpair.1 + have hybelow : SupportBelow y ys.sum := supportBelow_list_sum hypair.1 + have hdecomp := add_decomposition_unique hxbelow hybelow htypes.1 (by + simpa only [List.sum_cons] using hsum) + rw [hdecomp.1] + congr 1 + exact ih hxpair.2 hypair.2 hdecomp.2 htypes.2 + +/-- Two weak normal forms of the same series are equal. This is the uniqueness part of LM24, +Proposition 3.3.4. -/ +theorem IsWeakNormalForm.unique {x : R⟦G⟧} {blocks other : List R⟦G⟧} + (hblocks : IsWeakNormalForm x blocks) (hother : IsWeakNormalForm x other) : + blocks = other := by + obtain ⟨hsum, _, _, hpair⟩ := isWeakNormalForm_iff.mp hblocks + obtain ⟨hotherSum, _, _, hotherPair⟩ := isWeakNormalForm_iff.mp hother + apply eq_of_pairwise_sum_and_orderTypes hpair hotherPair + · exact hsum.trans hotherSum.symm + · exact hblocks.supportOrderTypes_eq_additivePrincipalTerms.trans + hother.supportOrderTypes_eq_additivePrincipalTerms.symm + +/-- Every Hahn series has exactly one weak normal form. This is LM24, Proposition 3.3.4. -/ +theorem existsUnique_isWeakNormalForm (x : R⟦G⟧) : + ∃! blocks : List R⟦G⟧, IsWeakNormalForm x blocks := by + obtain ⟨blocks, hblocks⟩ := exists_isWeakNormalForm x + exact ⟨blocks, hblocks, fun other hother ↦ (hblocks.unique hother).symm⟩ + +/-- Every nonzero Hahn series has a nonzero weakly principal weak upper truncation. This is LM24, +Corollary 3.3.5, generalized from ordered-group exponents to a linearly ordered type with zero. -/ +theorem exists_nonzero_isWeaklyPrincipal_truncGE [Zero G] {x : R⟦G⟧} (hx : x ≠ 0) : + ∃ c : G, truncGE c x ≠ 0 ∧ IsWeaklyPrincipal (truncGE c x) := by + obtain ⟨blocks, hblocks⟩ := exists_isWeakNormalForm x + obtain ⟨hsum, hprincipal, _, hpair⟩ := isWeakNormalForm_iff.mp hblocks + have hblocksne : blocks ≠ [] := by + intro hzero + rw [hzero] at hsum + exact hx (by simpa using hsum.symm) + let last := blocks.getLast hblocksne + have hlastMem : last ∈ blocks := List.getLast_mem hblocksne + have hlastPrincipal : IsWeaklyPrincipal last := hprincipal last hlastMem + have hlastNe : last ≠ 0 := hlastPrincipal.ne_zero + have hlastOrderMem : last.order ∈ last.support := + (mem_support last last.order).mpr (coeff_order_eq_zero.not.mpr hlastNe) + have hprefixBelow : SupportBelow blocks.dropLast.sum last := by + apply list_sum_supportBelow + intro b hb + exact hpair.rel_dropLast_getLast hb + have hprefixTrunc : truncGE last.order blocks.dropLast.sum = 0 := by + rw [← support_eq_empty_iff, support_truncGE] + ext i + simp only [Set.mem_setOf_eq, Set.mem_empty_iff_false, iff_false, not_and] + intro hi + exact fun hle ↦ (not_lt_of_ge hle) (hprefixBelow.lt hi hlastOrderMem) + have hlastTrunc : truncGE last.order last = last := by + ext i + by_cases hi : last.coeff i = 0 + · simp [hi] + · simp [order_le_of_coeff_ne_zero hi] + have hxsplit : blocks.dropLast.sum + last = x := by + calc + blocks.dropLast.sum + last = (blocks.dropLast ++ [last]).sum := by simp + _ = blocks.sum := congrArg List.sum (List.dropLast_append_getLast hblocksne) + _ = x := hsum + refine ⟨last.order, ?_, ?_⟩ + · rw [← hxsplit, truncGE_add, hprefixTrunc, hlastTrunc, zero_add] + exact hlastNe + · rw [← hxsplit, truncGE_add, hprefixTrunc, hlastTrunc, zero_add] + exact hlastPrincipal + +end HahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra.lean b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra.lean new file mode 100644 index 0000000000..63f1da6f54 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra.lean @@ -0,0 +1,12 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.AlgebraicIndependentDet +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.FiniteSpanRelation +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.IndicatorFinsupp +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/AlgebraicIndependentDet.lean b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/AlgebraicIndependentDet.lean new file mode 100644 index 0000000000..b222c400e8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/AlgebraicIndependentDet.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.RingTheory.AlgebraicIndependent.Defs +public import Mathlib.LinearAlgebra.Matrix.Determinant.Basic + +import Mathlib.Algebra.MvPolynomial.Basic + +/-! +# Determinants of matrices of algebraically independent entries + +A square matrix whose entries are either `0` or members of an algebraically independent family, +with no member used twice and every diagonal entry a member, has nonzero determinant. The +determinant is the image of the determinant of the symbolic matrix, which is a nonzero +polynomial: specializing the diagonal variables to `1` and all others to `0` evaluates it to +`det 1 = 1`. + +The zero pattern is recorded by a function `v : n → n → Option V`; the entry at `(i, j)` is +`f w` when `v i j = some w` and `0` when `v i j = none`. +-/ + +universe u v w + +public section + +namespace Matrix + +variable {R : Type u} {A : Type v} [CommRing R] [Nontrivial R] [CommRing A] [Algebra R A] + +/-- A matrix of distinct algebraically independent entries and zeros, with a full diagonal of +entries, has nonzero determinant. -/ +theorem det_ne_zero_of_algebraicIndependent {V : Type w} {f : V → A} + (hf : AlgebraicIndependent R f) {n : Type*} [Fintype n] [DecidableEq n] + (v : n → n → Option V) (M : Matrix n n A) (hM : ∀ i j, M i j = (v i j).elim 0 f) + (hdiag : ∀ i, (v i i).isSome) + (hdistinct : ∀ i j i' j' w, v i j = some w → v i' j' = some w → i = i' ∧ j = j') : + M.det ≠ 0 := by + classical + intro hdet + let Msym : Matrix n n (MvPolynomial V R) := Matrix.of fun i j ↦ (v i j).elim 0 MvPolynomial.X + have hmap : (MvPolynomial.aeval f).mapMatrix Msym = M := by + ext i j + rw [AlgHom.mapMatrix_apply, Matrix.map_apply, hM i j] + simp only [Msym, Matrix.of_apply] + cases v i j <;> simp + have hdetSym : MvPolynomial.aeval f Msym.det = 0 := by + rw [AlgHom.map_det, hmap, hdet] + have hzero : Msym.det = 0 := hf.eq_zero_of_aeval_eq_zero _ hdetSym + let e : V → R := fun w ↦ if ∃ i, v i i = some w then 1 else 0 + have heval : (MvPolynomial.eval e).mapMatrix Msym = 1 := by + ext i j + rw [RingHom.mapMatrix_apply, Matrix.map_apply, Matrix.one_apply] + simp only [Msym, Matrix.of_apply] + by_cases hij : i = j + · subst hij + obtain ⟨w, hw⟩ := Option.isSome_iff_exists.mp (hdiag i) + rw [hw, if_pos rfl] + simp only [Option.elim, MvPolynomial.eval_X, e] + rw [if_pos ⟨i, hw⟩] + · rw [if_neg hij] + cases hv : v i j with + | none => simp + | some w => + simp only [Option.elim, MvPolynomial.eval_X, e] + rw [if_neg] + rintro ⟨i', hi'⟩ + obtain ⟨h1, h2⟩ := hdistinct i j i' i' w hv hi' + exact hij (h1.trans h2.symm) + have hone : MvPolynomial.eval e Msym.det = 1 := by + rw [RingHom.map_det, heval, Matrix.det_one] + rw [hzero, map_zero] at hone + exact zero_ne_one hone + +end Matrix + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/FiniteSpanRelation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/FiniteSpanRelation.lean new file mode 100644 index 0000000000..fb44c7568e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/FiniteSpanRelation.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.LinearAlgebra.Dimension.Constructions +public import Mathlib.LinearAlgebra.Dimension.Finite + +/-! +# A nontrivial relation among too many vectors of a finite span + +More vectors than generators are linearly dependent: if a family `w : Γ → V` of vectors lies in +the span of `M` generators and `Γ` has more than `M` elements, then some finite nontrivial +`K`-linear combination of the `w γ` vanishes. The vectors `w γ` need not be distinct. +-/ + +universe u v w + +public section + +namespace Module + +variable {K : Type u} {V : Type v} [Field K] [AddCommGroup V] [Module K V] + +/-- A family of more than `M` vectors in the span of `M` generators admits a nontrivial vanishing +linear combination. -/ +theorem exists_nontrivial_relation_of_mem_span_range {ι : Type w} [Fintype ι] (gens : ι → V) + {Γ : Type*} [Fintype Γ] (w : Γ → V) + (hw : ∀ γ, w γ ∈ Submodule.span K (Set.range gens)) (hcard : Fintype.card ι < Fintype.card Γ) : + ∃ (s : Finset Γ) (δ : Γ → K), ∑ γ ∈ s, δ γ • w γ = 0 ∧ ∃ γ ∈ s, δ γ ≠ 0 := by + by_contra hrel + rw [← not_linearIndependent_iff, not_not] at hrel + let w' : Γ → Submodule.span K (Set.range gens) := fun γ ↦ ⟨w γ, hw γ⟩ + have hw' : LinearIndependent K w' := by + refine LinearIndependent.of_comp (Submodule.span K (Set.range gens)).subtype ?_ + exact hrel + haveI : Module.Finite K (Submodule.span K (Set.range gens)) := + Module.Finite.span_of_finite K (Set.finite_range gens) + have hle := hw'.fintype_card_le_finrank + have hrank := finrank_range_le_card (R := K) gens + exact absurd (hle.trans hrank) (not_le.mpr hcard) + +end Module + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/IndicatorFinsupp.lean b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/IndicatorFinsupp.lean new file mode 100644 index 0000000000..cdda28fa25 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/IndicatorFinsupp.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.LinearAlgebra.Finsupp.LinearCombination +public import Mathlib.LinearAlgebra.LinearIndependent.Defs + +/-! +# Indicators in the free module on a set + +For a set `L` in a module `M` over `R`, the indicator of `y ∈ M` is the basis vector of +`L →₀ R` at `y` when `y ∈ L`, and `0` otherwise. Its linear combination along the inclusion +`L → M` is `y` when `y ∈ L` and `0` otherwise. When `L` is linearly independent, a vanishing +combination of elements of `L` lifts to the free module, where it can be evaluated at a chosen +basis vector; this is how relations among elements of an independent set are resolved. +-/ + +universe u v + +public section + +namespace Set + +variable {R : Type u} {M : Type v} [Semiring R] + +open scoped Classical in +/-- The indicator of `y` in the free `R`-module on `L`: the basis vector at `y` when `y ∈ L`, +and `0` otherwise. -/ +noncomputable def indicatorFinsupp (L : Set M) (R : Type u) [Semiring R] (y : M) : L →₀ R := + if h : y ∈ L then Finsupp.single ⟨y, h⟩ 1 else 0 + +open scoped Classical in +theorem indicatorFinsupp_apply_of_mem (L : Set M) {y : M} (h : y ∈ L) (z : L) : + L.indicatorFinsupp R y z = if (z : M) = y then 1 else 0 := by + rw [indicatorFinsupp, dif_pos h, Finsupp.single_apply] + by_cases hz : (z : M) = y + · rw [if_pos hz, if_pos (Subtype.ext hz).symm] + · rw [if_neg hz, if_neg fun h' ↦ hz (congrArg Subtype.val h').symm] + +theorem indicatorFinsupp_apply_of_notMem (L : Set M) {y : M} (h : y ∉ L) (z : L) : + L.indicatorFinsupp R y z = 0 := by + rw [indicatorFinsupp, dif_neg h, Finsupp.zero_apply] + +/-- The indicator of `y` evaluated at the basis vector of `y` itself is `1`. -/ +theorem indicatorFinsupp_apply_self (L : Set M) {y : M} (h : y ∈ L) : + L.indicatorFinsupp R y ⟨y, h⟩ = 1 := by + classical + rw [indicatorFinsupp_apply_of_mem L h, if_pos rfl] + +/-- The indicator of `y` vanishes at a basis vector other than `y`. -/ +theorem indicatorFinsupp_apply_of_ne (L : Set M) (y : M) (z : L) (hz : (z : M) ≠ y) : + L.indicatorFinsupp R y z = 0 := by + classical + by_cases h : y ∈ L + · rw [indicatorFinsupp_apply_of_mem L h, if_neg hz] + · exact indicatorFinsupp_apply_of_notMem L h z + +theorem indicatorFinsupp_apply_nonneg [PartialOrder R] [IsOrderedRing R] (L : Set M) (y : M) + (z : L) : 0 ≤ L.indicatorFinsupp R y z := by + classical + by_cases h : y ∈ L + · rw [indicatorFinsupp_apply_of_mem L h] + split_ifs + · exact zero_le_one + · exact le_rfl + · rw [indicatorFinsupp_apply_of_notMem L h] + +variable [AddCommMonoid M] [Module R M] + +variable (R) in +open scoped Classical in +theorem linearCombination_indicatorFinsupp (L : Set M) (y : M) : + Finsupp.linearCombination R (fun z : L ↦ (z : M)) (L.indicatorFinsupp R y) = + if y ∈ L then y else 0 := by + by_cases h : y ∈ L + · rw [indicatorFinsupp, dif_pos h, Finsupp.linearCombination_single, one_smul, if_pos h] + · rw [indicatorFinsupp, dif_neg h, map_zero, if_neg h] + +variable (R) in +/-- The linear combination of the indicator of a member of `L` is that member. -/ +theorem linearCombination_indicatorFinsupp_of_mem (L : Set M) {y : M} (h : y ∈ L) : + Finsupp.linearCombination R (fun z : L ↦ (z : M)) (L.indicatorFinsupp R y) = y := by + rw [linearCombination_indicatorFinsupp, if_pos h] + +variable (R) in +/-- The linear combination of the indicator of `0` is `0`, whether or not `0 ∈ L`. -/ +theorem linearCombination_indicatorFinsupp_zero (L : Set M) : + Finsupp.linearCombination R (fun z : L ↦ (z : M)) (L.indicatorFinsupp R 0) = 0 := by + rw [linearCombination_indicatorFinsupp] + split_ifs <;> rfl + +end Set + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct.lean b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct.lean new file mode 100644 index 0000000000..5db674dea3 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.Content +import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.SubalgebraBasis + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/Content.lean b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/Content.lean new file mode 100644 index 0000000000..c4bad8bfa5 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/Content.lean @@ -0,0 +1,330 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.GCDMonoid.Basic +public import Mathlib.Algebra.Algebra.Defs +public import Mathlib.LinearAlgebra.TensorProduct.Map + +import Mathlib.Algebra.GCDMonoid.Finset +import Mathlib.LinearAlgebra.Basis.VectorSpace +import Mathlib.LinearAlgebra.TensorProduct.Basis + +/-! +# Content of a tensor over a GCD algebra + +Let `K` be a field, let `D` be a commutative `K`-algebra, and let `V` be a `K`-vector space. +For `z : V ⊗[K] D`, a class `a : Associates D` is the content of `z` when, for every `q : D`, +`q` divides `a` exactly when `z` is obtained by multiplying the right tensor factor by `q`. + +This divisibility property is the public definition. Existence over a GCD monoid is proved by +choosing a basis of `V` internally and taking the greatest common divisor of the finitely many +nonzero coordinates. The resulting associate class is independent of both that basis and the +chosen `GCDMonoid` structure. +-/ + +open scoped TensorProduct + +universe u v w x + +namespace TensorProduct + +public noncomputable section + +variable {K : Type u} {D : Type v} {V : Type w} +variable [Field K] [CommRing D] [IsDomain D] [Algebra K D] +variable [AddCommGroup V] [Module K V] + +/-- Multiply the right tensor factor by `q`. -/ +def mulRightFactor (q : D) : V ⊗[K] D →ₗ[K] V ⊗[K] D := + LinearMap.lTensor (R := K) V (LinearMap.mulLeft K (A := D) q) + +omit [IsDomain D] in +/-- Multiplication on the right tensor factor sends `x ⊗ d` to `x ⊗ qd`. -/ +@[simp] +theorem mulRightFactor_tmul (q d : D) (x : V) : + mulRightFactor (K := K) (D := D) (V := V) q (x ⊗ₜ[K] d) = + x ⊗ₜ[K] (q * d) := by + simp [mulRightFactor] + +/-- `a` is the associate class of the greatest common divisor of the coefficients of `z`. + +The right-hand side is intrinsic: it does not mention a basis or chosen coordinates. -/ +def IsContent (z : V ⊗[K] D) (a : Associates D) : Prop := + ∀ q : D, Associates.mk q ≤ a ↔ + ∃ y : V ⊗[K] D, mulRightFactor (K := K) q y = z + +omit [IsDomain D] in +/-- The intrinsic divisibility characterization of tensor content. -/ +theorem isContent_iff (z : V ⊗[K] D) (a : Associates D) : + IsContent z a ↔ + ∀ q : D, Associates.mk q ≤ a ↔ + ∃ y : V ⊗[K] D, mulRightFactor (K := K) q y = z := + Iff.rfl + +omit [IsDomain D] in +/-- Applying a linear map to the left tensor factor commutes with multiplication on the right +tensor factor. -/ +theorem rTensor_mulRightFactor + {W : Type x} [AddCommGroup W] [Module K W] + (f : V →ₗ[K] W) (q : D) (z : V ⊗[K] D) : + f.rTensor D (mulRightFactor (K := K) q z) = + mulRightFactor (K := K) q (f.rTensor D z) := by + induction z using TensorProduct.induction_on with + | zero => simp + | tmul y d => simp + | add y z hy hz => simp [map_add, hy, hz] + +omit [IsDomain D] in +/-- An injective linear change of the left tensor factor preserves the intrinsic content +property. -/ +theorem isContent_rTensor_iff_of_injective + {W : Type x} [AddCommGroup W] [Module K W] + (f : V →ₗ[K] W) (hf : Function.Injective f) + (z : V ⊗[K] D) (a : Associates D) : + IsContent (f.rTensor D z) a ↔ IsContent z a := by + let hker : f.ker = ⊥ := LinearMap.ker_eq_bot.mpr hf + let g := f.leftInverse + have hgf : g.comp f = LinearMap.id := f.leftInverse_comp_of_inj hker + have hgfTensor (y : V ⊗[K] D) : g.rTensor D (f.rTensor D y) = y := by + rw [← LinearMap.rTensor_comp_apply, hgf, LinearMap.rTensor_id] + rfl + constructor + · intro h + rw [isContent_iff] at h ⊢ + intro q + constructor + · intro hqa + obtain ⟨y, hy⟩ := (h q).mp hqa + refine ⟨g.rTensor D y, ?_⟩ + calc + mulRightFactor (K := K) q (g.rTensor D y) = + g.rTensor D (mulRightFactor (K := K) q y) := + (rTensor_mulRightFactor g q y).symm + _ = g.rTensor D (f.rTensor D z) := congrArg (g.rTensor D) hy + _ = z := hgfTensor z + · rintro ⟨y, hy⟩ + apply (h q).mpr + refine ⟨f.rTensor D y, ?_⟩ + calc + mulRightFactor (K := K) q (f.rTensor D y) = + f.rTensor D (mulRightFactor (K := K) q y) := + (rTensor_mulRightFactor f q y).symm + _ = f.rTensor D z := congrArg (f.rTensor D) hy + · intro h + rw [isContent_iff] at h ⊢ + intro q + constructor + · intro hqa + obtain ⟨y, hy⟩ := (h q).mp hqa + refine ⟨f.rTensor D y, ?_⟩ + calc + mulRightFactor (K := K) q (f.rTensor D y) = + f.rTensor D (mulRightFactor (K := K) q y) := + (rTensor_mulRightFactor f q y).symm + _ = f.rTensor D z := congrArg (f.rTensor D) hy + · rintro ⟨y, hy⟩ + apply (h q).mpr + refine ⟨g.rTensor D y, ?_⟩ + calc + mulRightFactor (K := K) q (g.rTensor D y) = + g.rTensor D (mulRightFactor (K := K) q y) := + (rTensor_mulRightFactor g q y).symm + _ = g.rTensor D (f.rTensor D z) := congrArg (g.rTensor D) hy + _ = z := hgfTensor z + +/-- The intrinsic content property determines at most one associate class. -/ +theorem IsContent.eq {z : V ⊗[K] D} {a b : Associates D} + (ha : IsContent z a) (hb : IsContent z b) : a = b := by + induction a using Quotient.inductionOn with + | _ a => + induction b using Quotient.inductionOn with + | _ b => + apply le_antisymm + · exact (hb a).2 ((ha a).1 le_rfl) + · exact (ha b).2 ((hb b).1 le_rfl) + +@[implicit_reducible] +private noncomputable def normalizedAssociatesGCDMonoid + (gcdStructure : GCDMonoid D) : + NormalizedGCDMonoid (Associates D) := by + classical + letI : GCDMonoid D := gcdStructure + letI : GCDMonoid (Associates D) := inferInstance + exact normalizedGCDMonoidOfExistsGCD fun a b ↦ + ⟨gcd a b, fun d ↦ (dvd_gcd_iff d a b).symm⟩ + +private noncomputable def contentBasis : + Module.Basis (Module.Free.ChooseBasisIndex K V) K V := + Module.Free.chooseBasis K V + +private noncomputable def contentCoordinates : + V ⊗[K] D ≃ₗ[K] Module.Free.ChooseBasisIndex K V →₀ D := + TensorProduct.equivFinsuppOfBasisLeft + (contentBasis (K := K) (V := V)) + +omit [IsDomain D] in +private theorem contentCoordinates_mulRightFactor_apply + (q : D) (z : V ⊗[K] D) + (i : Module.Free.ChooseBasisIndex K V) : + contentCoordinates (K := K) (D := D) (V := V) + (mulRightFactor (K := K) q z) i = + q * contentCoordinates (K := K) (D := D) (V := V) z i := by + induction z using TensorProduct.induction_on with + | zero => simp [mulRightFactor] + | tmul x d => + rw [mulRightFactor_tmul] + simp only [contentCoordinates, + TensorProduct.equivFinsuppOfBasisLeft_apply_tmul_apply] + rw [_root_.Algebra.smul_def, _root_.Algebra.smul_def] + ring + | add x y hx hy => simp [map_add, hx, hy, mul_add] + +omit [IsDomain D] in +private theorem exists_mulRightFactor_eq_iff + (q : D) (z : V ⊗[K] D) : + (∃ y : V ⊗[K] D, mulRightFactor (K := K) q y = z) ↔ + ∀ i, q ∣ contentCoordinates (K := K) (D := D) (V := V) z i := by + constructor + · rintro ⟨y, rfl⟩ i + exact ⟨contentCoordinates (K := K) (D := D) (V := V) y i, + contentCoordinates_mulRightFactor_apply (K := K) q y i⟩ + · intro h + let c := contentCoordinates (K := K) (D := D) (V := V) z + let c' : Module.Free.ChooseBasisIndex K V →₀ D := + Finsupp.onFinset c.support + (fun i ↦ if hi : i ∈ c.support then Classical.choose (h i) else 0) + (fun i hi ↦ by + by_contra hnot + simp [hnot] at hi) + refine ⟨(contentCoordinates (K := K) (D := D) (V := V)).symm c', ?_⟩ + apply (contentCoordinates (K := K) (D := D) (V := V)).injective + ext i + rw [contentCoordinates_mulRightFactor_apply, + LinearEquiv.apply_symm_apply] + by_cases hi : i ∈ c.support + · rw [show c' i = Classical.choose (h i) by simp [c', hi]] + exact (Classical.choose_spec (h i)).symm + · rw [show c' i = 0 by simp [c', hi], mul_zero] + exact Finsupp.notMem_support_iff.mp hi |>.symm + +omit [IsDomain D] in +/-- The zero tensor has zero content. -/ +theorem isContent_zero : IsContent (0 : V ⊗[K] D) 0 := by + intro q + constructor + · intro _ + exact ⟨0, (mulRightFactor (K := K) q).map_zero⟩ + · intro _ + change Associates.mk q ≤ Associates.mk 0 + exact Associates.mk_le_mk_of_dvd (dvd_zero q) + +omit [IsDomain D] in +/-- A pure tensor with nonzero left factor has the content of its right factor. -/ +theorem isContent_tmul_of_ne_zero (x : V) (hx : x ≠ 0) (d : D) : + IsContent (x ⊗ₜ[K] d) (Associates.mk d) := by + classical + intro q + rw [Associates.mk_le_mk_iff_dvd] + constructor + · rintro ⟨e, he⟩ + refine ⟨x ⊗ₜ[K] e, ?_⟩ + rw [mulRightFactor_tmul, he] + · intro hfactor + have hcoordinates := + (exists_mulRightFactor_eq_iff (K := K) q (x ⊗ₜ[K] d)).mp hfactor + have hrepr : (contentBasis (K := K) (V := V)).repr x ≠ 0 := by + intro hzero + apply hx + apply (contentBasis (K := K) (V := V)).repr.injective + simpa using hzero + obtain ⟨i, hi⟩ := Finsupp.support_nonempty_iff.mpr hrepr + have hqi := hcoordinates i + simp only [contentCoordinates, + TensorProduct.equivFinsuppOfBasisLeft_apply_tmul_apply] at hqi + have hunit : IsUnit + (algebraMap K D ((contentBasis (K := K) (V := V)).repr x i)) := + (isUnit_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hi)).map + (algebraMap K D) + rw [_root_.Algebra.smul_def] at hqi + exact hunit.dvd_mul_left.mp hqi + +omit [IsDomain D] in +/-- A nonzero pure tensor `x ⊗ 1` has unit content. -/ +theorem isContent_tmul_one_of_ne_zero (x : V) (hx : x ≠ 0) : + IsContent (x ⊗ₜ[K] (1 : D)) 1 := by + simpa using isContent_tmul_of_ne_zero (D := D) x hx (1 : D) + +private noncomputable def contentAux + (gcdStructure : GCDMonoid D) (z : V ⊗[K] D) : Associates D := by + letI : GCDMonoid D := gcdStructure + letI : NormalizedGCDMonoid (Associates D) := + normalizedAssociatesGCDMonoid gcdStructure + let c := contentCoordinates (K := K) (D := D) (V := V) z + exact c.support.gcd fun i ↦ Associates.mk (c i) + +private theorem contentAux_isContent + (gcdStructure : GCDMonoid D) (z : V ⊗[K] D) : + IsContent z (contentAux gcdStructure z) := by + letI : GCDMonoid D := gcdStructure + letI : NormalizedGCDMonoid (Associates D) := + normalizedAssociatesGCDMonoid gcdStructure + intro q + change Associates.mk q ∣ contentAux gcdStructure z ↔ _ + rw [contentAux, Finset.dvd_gcd_iff, + exists_mulRightFactor_eq_iff] + constructor + · intro h i + by_cases hi : i ∈ + (contentCoordinates (K := K) (D := D) (V := V) z).support + · exact Associates.mk_le_mk_iff_dvd.mp (h i hi) + · rw [Finsupp.notMem_support_iff.mp hi] + exact dvd_zero q + · intro h i hi + exact Associates.mk_le_mk_of_dvd (h i) + +/-- Over a GCD monoid, every tensor has a unique intrinsic content class. -/ +theorem existsUnique_isContent + (gcdStructure : GCDMonoid D) (z : V ⊗[K] D) : + ∃! a : Associates D, IsContent z a := + ⟨contentAux gcdStructure z, contentAux_isContent gcdStructure z, + fun _a ha ↦ ha.eq (contentAux_isContent gcdStructure z)⟩ + +/-- Pairwise existence of greatest common divisors suffices for every tensor to have a unique +intrinsic content class. -/ +theorem existsUnique_isContent_of_exists_gcd + (h : ∀ a b : D, ∃ c : D, ∀ d : D, + d ∣ a ∧ d ∣ b ↔ d ∣ c) + (z : V ⊗[K] D) : + ∃! a : Associates D, IsContent z a := by + classical + exact existsUnique_isContent (gcdMonoidOfExistsGCD h) z + +/-- The intrinsic content class of a tensor, for an explicit `GCDMonoid` structure on `D`. -/ +def content (gcdStructure : GCDMonoid D) (z : V ⊗[K] D) : Associates D := + Classical.choose (existsUnique_isContent gcdStructure z) + +/-- The content class satisfies its intrinsic divisibility characterization. -/ +theorem content_isContent (gcdStructure : GCDMonoid D) (z : V ⊗[K] D) : + IsContent z (content gcdStructure z) := + Classical.choose_spec (existsUnique_isContent gcdStructure z) |>.1 + +/-- Any class satisfying the content property is the chosen content class. -/ +theorem content_eq_of_isContent (gcdStructure : GCDMonoid D) + {z : V ⊗[K] D} {a : Associates D} (ha : IsContent z a) : + content gcdStructure z = a := + (content_isContent gcdStructure z).eq ha + +/-- The content class does not depend on the chosen `GCDMonoid` structure. -/ +theorem content_independent (gcdStructure₁ gcdStructure₂ : GCDMonoid D) + (z : V ⊗[K] D) : + content gcdStructure₁ z = content gcdStructure₂ z := + (content_isContent gcdStructure₁ z).eq + (content_isContent gcdStructure₂ z) + +end + +end TensorProduct diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/SubalgebraBasis.lean b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/SubalgebraBasis.lean new file mode 100644 index 0000000000..10aeb4168c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/SubalgebraBasis.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.RingTheory.TensorProduct.Maps +public import Mathlib.LinearAlgebra.DirectSum.Finsupp +public import Mathlib.LinearAlgebra.Basis.Basic + +/-! +# Base change of a basis over a subalgebra + +Let `Ĝ` be a commutative `K`-algebra, `S ⊆ Ĝ` a `K`-subalgebra, and `B` an `S`-basis of `Ĝ`. +For any commutative `K`-algebra `L`, the elements `B i ⊗ 1` are a basis of `Ĝ ⊗[K] L` over the +image of `S ⊗[K] L`: every element is uniquely a finite sum `∑ j(xᵢ) (B i ⊗ 1)` with +`xᵢ ∈ S ⊗[K] L`, where `j : S ⊗[K] L → Ĝ ⊗[K] L` is induced by the inclusion. +-/ + +universe u v w x + +open scoped TensorProduct + +public noncomputable section + +namespace Subalgebra + +variable {K : Type u} {G : Type v} {L : Type w} {ι : Type x} +variable [CommRing K] [CommRing G] [Algebra K G] [CommRing L] [Algebra K L] +variable (S : Subalgebra K G) (B : Module.Basis ι S G) + +/-- The inclusion `S ⊗[K] L → Ĝ ⊗[K] L`. -/ +def tensorInclusion : S ⊗[K] L →ₐ[K] G ⊗[K] L := + Algebra.TensorProduct.map S.val (AlgHom.id K L) + +theorem tensorInclusion_tmul (s : S) (l : L) : + S.tensorInclusion (s ⊗ₜ[K] l) = (s : G) ⊗ₜ[K] l := + Algebra.TensorProduct.map_tmul _ _ _ _ + +theorem tensorInclusion_zero : S.tensorInclusion (0 : S ⊗[K] L) = 0 := + map_zero _ + +theorem tensorInclusion_add (x y : S ⊗[K] L) : + S.tensorInclusion (x + y) = S.tensorInclusion x + S.tensorInclusion y := + map_add _ x y + +theorem tensorInclusion_mul (x y : S ⊗[K] L) : + S.tensorInclusion (x * y) = S.tensorInclusion x * S.tensorInclusion y := + map_mul _ x y + +variable [DecidableEq ι] + +/-- The coordinate equivalence `Ĝ ⊗[K] L ≃ ι →₀ (S ⊗[K] L)` induced by the basis. -/ +def tensorBasisRepr : G ⊗[K] L ≃ₗ[K] ι →₀ (S ⊗[K] L) := + (LinearEquiv.rTensor L (B.repr.restrictScalars K)) ≪≫ₗ + TensorProduct.finsuppLeft K K S L ι + +theorem tensorBasisRepr_tmul (g : G) (l : L) : + S.tensorBasisRepr B (g ⊗ₜ[K] l) = + (B.repr g).sum fun i s ↦ Finsupp.single i (s ⊗ₜ[K] l) := by + rw [tensorBasisRepr, LinearEquiv.trans_apply, LinearEquiv.rTensor_tmul, + TensorProduct.finsuppLeft_apply_tmul] + rfl + +/-- The key formula: the coordinates of `j(x) · (B i ⊗ 1)` are `single i x`. -/ +theorem tensorBasisRepr_tensorInclusion_mul (x : S ⊗[K] L) (i : ι) : + S.tensorBasisRepr B (S.tensorInclusion x * (B i ⊗ₜ[K] 1)) = Finsupp.single i x := by + induction x using TensorProduct.induction_on with + | zero => rw [map_zero, zero_mul, map_zero, Finsupp.single_zero] + | tmul s l => + rw [tensorInclusion_tmul, Algebra.TensorProduct.tmul_mul_tmul, mul_one, tensorBasisRepr_tmul] + have hsmul : (s : G) * B i = s • B i := rfl + rw [hsmul, map_smul, Module.Basis.repr_self, Finsupp.smul_single, smul_eq_mul, mul_one, + Finsupp.sum_single_index] + rw [TensorProduct.zero_tmul, Finsupp.single_zero] + | add x y hx hy => + rw [map_add, add_mul, map_add, hx, hy, Finsupp.single_add] + +theorem tensorBasisRepr_sum (s : Finset ι) (x : ι → S ⊗[K] L) : + S.tensorBasisRepr B (∑ i ∈ s, S.tensorInclusion (x i) * (B i ⊗ₜ[K] 1)) = + ∑ i ∈ s, Finsupp.single i (x i) := by + rw [map_sum] + exact Finset.sum_congr rfl fun i _ ↦ S.tensorBasisRepr_tensorInclusion_mul B (x i) i + +omit [DecidableEq ι] in +/-- Linear independence of `B i ⊗ 1` over `S ⊗[K] L`. -/ +theorem eq_zero_of_sum_tensorInclusion_mul_eq_zero (s : Finset ι) (x : ι → S ⊗[K] L) + (h : ∑ i ∈ s, S.tensorInclusion (x i) * (B i ⊗ₜ[K] 1) = 0) : ∀ i ∈ s, x i = 0 := by + classical + intro i hi + have h1 := congrArg (S.tensorBasisRepr B) h + rw [S.tensorBasisRepr_sum B, map_zero] at h1 + have h2 := congrArg (fun f : ι →₀ (S ⊗[K] L) ↦ f i) h1 + simp only [Finsupp.finsetSum_apply, Finsupp.coe_zero, Pi.zero_apply] at h2 + rw [Finset.sum_eq_single i (fun j _ hj ↦ Finsupp.single_eq_of_ne hj.symm) + (fun hni ↦ absurd hi hni), Finsupp.single_eq_same] at h2 + exact h2 + +omit [DecidableEq ι] in +/-- Spanning: every element of `Ĝ ⊗[K] L` is a combination of the `B i ⊗ 1` over +`S ⊗[K] L`. -/ +theorem exists_eq_sum_tensorInclusion_mul (g : G ⊗[K] L) : + ∃ (s : Finset ι) (x : ι → S ⊗[K] L), + g = ∑ i ∈ s, S.tensorInclusion (x i) * (B i ⊗ₜ[K] 1) := by + classical + refine ⟨(S.tensorBasisRepr B g).support, fun i ↦ S.tensorBasisRepr B g i, ?_⟩ + apply (S.tensorBasisRepr B).injective + rw [S.tensorBasisRepr_sum B] + exact (Finsupp.sum_single (S.tensorBasisRepr B g)).symm + +end Subalgebra diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order.lean new file mode 100644 index 0000000000..4d7bbabd23 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Archimedean +import LeanPool.ConwayRefinement.ConwayRefinement.Order.DifferenceAvoidance +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Archimedean.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Archimedean.lean new file mode 100644 index 0000000000..060ed8a957 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Archimedean.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.Order.Archimedean.Basic +public import Mathlib.Data.Set.Countable +public import Mathlib.Order.WellFoundedSet + +import Mathlib.Data.Real.Embedding +import Mathlib.Topology.Order.Basic +import Mathlib.Topology.Instances.Real.Lemmas + +/-! +# Countability in Archimedean ordered groups + +Every partially well-ordered subset of an Archimedean linearly ordered additive group is +countable. The proof embeds the group into `ℝ` and assigns to each point the gap before its +successor in the subset; second countability of `ℝ` makes the resulting disjoint family of +intervals countable. +-/ + +universe u + +public section + +variable {G : Type u} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Archimedean G] + +open TopologicalSpace + +namespace Set.IsPWO + +/-- A partially well-ordered subset of an Archimedean ordered additive group is countable. -/ +theorem countable_of_archimedean {s : Set G} (hs : s.IsPWO) : s.Countable := by + obtain ⟨f, hf⟩ := Archimedean.exists_orderAddMonoidHom_real_injective G + have hfstrict : StrictMono f := f.monotone'.strictMono_of_injective hf + have hcount := countable_image_lt_image_Ioi_within (t := s) f + apply hcount.mono + intro x hx + refine ⟨hx, ?_⟩ + by_cases hupper : ({y ∈ s | x < y} : Set G).Nonempty + · obtain ⟨y, hy⟩ := (hs.mono fun z hz => hz.1).exists_minimal hupper + refine ⟨f y, ?_, ?_⟩ + · exact hfstrict hy.1.2 + · intro z hz hxz + exact f.monotone' ((le_total y z).elim id fun hzy => hy.2 ⟨hz, hxz⟩ hzy) + · refine ⟨f x + 1, by linarith, ?_⟩ + intro y hy hxy + exact (hupper ⟨y, hy, hxy⟩).elim + +end Set.IsPWO diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/DifferenceAvoidance.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/DifferenceAvoidance.lean new file mode 100644 index 0000000000..7b4f742da9 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/DifferenceAvoidance.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Data.Set.Finite.Basic +public import Mathlib.Data.Finset.Lattice.Fold +public import Mathlib.Algebra.Group.Basic + +import Mathlib.Data.Finset.Image +import Mathlib.Data.Finset.Union + +/-! +# Choosing points with differences outside a finite set + +Given finitely many infinite subsets `E i` of a commutative additive group and a finite set `D`, +one can pick one point from each `E i` so that no difference of two chosen points lies in `D`. +The points are chosen one at a time; at each step only finitely many values are excluded. +-/ + +universe u v + +public section + +/-- From finitely many infinite sets one can choose one point each with all pairwise differences +outside a given finite set. -/ +theorem exists_forall_mem_forall_sub_notMem {α : Type u} [AddCommGroup α] {ι : Type v} + (s : Finset ι) (E : ι → Set α) (hE : ∀ i, (E i).Infinite) (D : Finset α) : + ∃ x : ι → α, (∀ i ∈ s, x i ∈ E i) ∧ ∀ i ∈ s, ∀ j ∈ s, i ≠ j → x i - x j ∉ D := by + classical + induction s using Finset.induction_on with + | empty => + refine ⟨fun i ↦ (hE i).nonempty.choose, fun i hi ↦ absurd hi (Finset.notMem_empty i), + fun i hi ↦ absurd hi (Finset.notMem_empty i)⟩ + | insert a s ha ih => + obtain ⟨x, hxE, hxD⟩ := ih + -- The values excluded for the new point: `x j + d` and `x j - d` for `j ∈ s`, `d ∈ D`. + let F : Finset α := s.biUnion fun j ↦ D.image (fun d ↦ x j + d) ∪ D.image (fun d ↦ x j - d) + obtain ⟨y, hyE, hyF⟩ := (hE a).exists_notMem_finset F + refine ⟨Function.update x a y, fun i hi ↦ ?_, fun i hi j hj hij ↦ ?_⟩ + · rcases Finset.mem_insert.mp hi with hia | hi + · rw [hia, Function.update_self]; exact hyE + · rw [Function.update_of_ne (fun h ↦ ha (by rw [← h]; exact hi))]; exact hxE i hi + · rcases Finset.mem_insert.mp hi with hia | hi + · rcases Finset.mem_insert.mp hj with hja | hj + · exact absurd (hia.trans hja.symm) hij + · rw [hia, Function.update_self, + Function.update_of_ne (fun h ↦ ha (by rw [← h]; exact hj))] + intro hd + apply hyF + refine Finset.mem_biUnion.mpr ⟨j, hj, Finset.mem_union_left _ ?_⟩ + exact Finset.mem_image.mpr ⟨y - x j, hd, add_sub_cancel (x j) y⟩ + · rcases Finset.mem_insert.mp hj with hja | hj + · rw [hja, Function.update_self, + Function.update_of_ne (fun h ↦ ha (by rw [← h]; exact hi))] + intro hd + apply hyF + refine Finset.mem_biUnion.mpr ⟨i, hi, Finset.mem_union_right _ ?_⟩ + exact Finset.mem_image.mpr ⟨x i - y, hd, sub_sub_cancel (x i) y⟩ + · rw [Function.update_of_ne (fun h ↦ ha (by rw [← h]; exact hi)), + Function.update_of_ne (fun h ↦ ha (by rw [← h]; exact hj))] + exact hxD i hi j hj hij + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter.lean new file mode 100644 index 0000000000..940b14d65d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Germ +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Tests + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/FunAtZeroMinus.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/FunAtZeroMinus.lean new file mode 100644 index 0000000000..07468ffc8d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/FunAtZeroMinus.lean @@ -0,0 +1,382 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Germ.LinearMap +public import Mathlib.Algebra.Module.Submodule.Range +public import Mathlib.Topology.MetricSpace.Pseudo.Defs +public import Mathlib.LinearAlgebra.TensorProduct.Map + +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood +import Mathlib.LinearAlgebra.TensorProduct.RightExactness +import Mathlib.LinearAlgebra.Basis.VectorSpace +import Mathlib.RingTheory.Flat.Basic +import Mathlib.Topology.MetricSpace.Pseudo.Lemmas +import Mathlib.Tactic.Linarith + +/-! +# Functions at `0⁻` with values in a vector space + +`Fun_{0⁻}(V)` is the space of `V`-valued functions at `0⁻`: functions defined on some interval +`(η, 0)`, identified when they agree for all `γ < 0` sufficiently close to `0`. In Lean it is +Mathlib's `Filter.Germ` at `𝓝[<] 0`. The paper's section on functions at `0⁻` says of the word +this construction avoids: "In the language of analysis these classes are the germs at `0⁻` of +`V`-valued functions; we avoid the word, which in this subject denotes a class of series modulo +`J` [Berarducci, Def. 5.1]." + +For a subspace `U ⊆ V` the map `Fun_{0⁻}(U) → Fun_{0⁻}(V)` is injective, and its image consists +of the functions taking values in `U` near `0`. Such a function lifts uniquely to `Fun_{0⁻}(U)`, +where a linear map defined on `U` can be applied pointwise; this gives the maps +`Fun_{0⁻}(U) → Fun_{0⁻}(U/U')` used by the compatibility lemmas. + +Pointwise pure tensors give the paper's map `θ`: a linear map `u : U → Fun_{0⁻}(V)` extends to +`U ⊗[K] E → Fun_{0⁻}(V ⊗[K] E)` as the canonical map +`θ : Fun_{0⁻}(V) ⊗[K] E → Fun_{0⁻}(V ⊗[K] E)` after `u ⊗ 1`. Over a field both factors are +injective when `u` is, so the extension preserves injectivity. +-/ + +open Filter Topology +open scoped TensorProduct + +universe u v w + +public noncomputable section + +/-- `Fun_{0⁻}(V)`, the `V`-valued functions at `0⁻`: functions on an interval `(η, 0)`, identified +when they agree for all `γ < 0` sufficiently close to `0` (Mathlib's `Filter.Germ` at `𝓝[<] 0`). -/ +abbrev FunAtZeroMinus (V : Type v) := Filter.Germ (𝓝[<] (0 : ℝ)) V + +/-- Two functions represent the same element of `Fun_{0⁻}(V)` exactly when they agree on some +interval `(-ε, 0)`. -/ +theorem funAtZeroMinus_coe_eq_iff_exists {V : Type v} (f g : ℝ → V) : + (f : FunAtZeroMinus V) = (g : FunAtZeroMinus V) ↔ + ∃ ε > 0, ∀ γ : ℝ, -ε < γ → γ < 0 → f γ = g γ := by + rw [Filter.Germ.coe_eq] + change (∀ᶠ γ in 𝓝[<] (0 : ℝ), f γ = g γ) ↔ _ + rw [eventually_nhdsLT_iff_exists] + constructor + · rintro ⟨l, hl, h⟩ + refine ⟨-l, by linarith, fun γ hγ hγ0 ↦ ?_⟩ + exact h γ (by linarith) hγ0 + · rintro ⟨ε, hε, h⟩ + refine ⟨-ε, by linarith, fun γ hγ hγ0 ↦ ?_⟩ + exact h γ (by linarith) hγ0 + +section Submodule + +variable {K : Type u} {V : Type v} [Semiring K] [AddCommMonoid V] [Module K V] + +/-- The injective linear map `Fun_{0⁻}(W) → Fun_{0⁻}(V)` induced by the inclusion of a submodule +`W ⊆ V`. -/ +def funAtZeroMinusSubmoduleMap (W : Submodule K V) : + FunAtZeroMinus W →ₗ[K] FunAtZeroMinus V := + Filter.Germ.mapLinear W.subtype + +/-- The inclusion of a submodule `W ⊆ V` induces an injective map `Fun_{0⁻}(W) → Fun_{0⁻}(V)`. -/ +theorem funAtZeroMinusSubmoduleMap_injective (W : Submodule K V) : + Function.Injective (funAtZeroMinusSubmoduleMap W) := + Filter.Germ.mapLinear_injective W.subtype W.injective_subtype + +/-- Evaluation of `Fun_{0⁻}(W) → Fun_{0⁻}(V)` on the class of a function `f : ℝ → W`. -/ +@[simp] +theorem funAtZeroMinusSubmoduleMap_coe (W : Submodule K V) (f : ℝ → W) : + funAtZeroMinusSubmoduleMap W (f : FunAtZeroMinus W) = + ((fun γ ↦ (f γ : V)) : FunAtZeroMinus V) := by + rw [funAtZeroMinusSubmoduleMap, Filter.Germ.mapLinear_coe] + rfl + +/-- `Fun_{0⁻}(W) ⊆ Fun_{0⁻}(V)`: the functions taking values in `W` near `0`, as the image of +`Fun_{0⁻}(W) → Fun_{0⁻}(V)`. -/ +def funAtZeroMinusSubmodule (W : Submodule K V) : Submodule K (FunAtZeroMinus V) := + LinearMap.range (funAtZeroMinusSubmoduleMap W) + +theorem funAtZeroMinusSubmodule_eq_range (W : Submodule K V) : + funAtZeroMinusSubmodule W = LinearMap.range (funAtZeroMinusSubmoduleMap W) := (rfl) + +/-- A function at `0⁻` lies in `Fun_{0⁻}(W) ⊆ Fun_{0⁻}(V)` exactly when it takes values in `W` +for all `γ < 0` sufficiently close to `0`. -/ +theorem mem_funAtZeroMinusSubmodule_iff (W : Submodule K V) (f : FunAtZeroMinus V) : + f ∈ funAtZeroMinusSubmodule W ↔ Filter.Germ.LiftPred (· ∈ W) f := by + classical + constructor + · rintro ⟨g, rfl⟩ + induction g using Filter.Germ.inductionOn with + | _ g => + rw [funAtZeroMinusSubmoduleMap, Filter.Germ.mapLinear_coe, + Filter.Germ.liftPred_coe] + exact Filter.Eventually.of_forall fun x ↦ (g x).property + · intro hf + induction f using Filter.Germ.inductionOn with + | _ f => + rw [Filter.Germ.liftPred_coe] at hf + let g : ℝ → W := fun x ↦ if hx : f x ∈ W then ⟨f x, hx⟩ else 0 + refine ⟨(g : FunAtZeroMinus W), ?_⟩ + rw [funAtZeroMinusSubmoduleMap, Filter.Germ.mapLinear_coe, + Filter.Germ.coe_eq] + exact hf.mono fun x hx ↦ by simp [g, hx] + +/-- The class of a function `f : ℝ → V` lies in `Fun_{0⁻}(W) ⊆ Fun_{0⁻}(V)` exactly when +`f γ ∈ W` for all `γ < 0` sufficiently close to `0`. -/ +theorem coe_mem_funAtZeroMinusSubmodule_iff (W : Submodule K V) (f : ℝ → V) : + (f : FunAtZeroMinus V) ∈ funAtZeroMinusSubmodule W ↔ + ∀ᶠ x in 𝓝[<] (0 : ℝ), f x ∈ W := by + rw [mem_funAtZeroMinusSubmodule_iff, Filter.Germ.liftPred_coe] + +/-- The class of a function `f : ℝ → V` lies in `Fun_{0⁻}(W) ⊆ Fun_{0⁻}(V)` exactly when `f` is +`W`-valued throughout some interval `(-ε, 0)`. -/ +theorem coe_mem_funAtZeroMinusSubmodule_iff_exists (W : Submodule K V) (f : ℝ → V) : + (f : FunAtZeroMinus V) ∈ funAtZeroMinusSubmodule W ↔ + ∃ ε > 0, ∀ γ : ℝ, -ε < γ → γ < 0 → f γ ∈ W := by + rw [coe_mem_funAtZeroMinusSubmodule_iff, eventually_nhdsLT_iff_exists] + constructor + · rintro ⟨l, hl, h⟩ + refine ⟨-l, by linarith, fun γ hγ hγ0 ↦ ?_⟩ + exact h γ (by linarith) hγ0 + · rintro ⟨ε, hε, h⟩ + refine ⟨-ε, by linarith, fun γ hγ hγ0 ↦ ?_⟩ + exact h γ (by linarith) hγ0 + +/-- An element of `Fun_{0⁻}(W) ⊆ Fun_{0⁻}(V)` has a representative valued in `W` everywhere. -/ +theorem exists_coe_eq_of_mem_funAtZeroMinusSubmodule (W : Submodule K V) {g : FunAtZeroMinus V} + (hg : g ∈ funAtZeroMinusSubmodule W) : + ∃ f : ℝ → V, (∀ γ, f γ ∈ W) ∧ g = (f : FunAtZeroMinus V) := by + classical + induction g using Filter.Germ.inductionOn with + | _ f => + rw [coe_mem_funAtZeroMinusSubmodule_iff] at hg + refine ⟨fun γ ↦ if f γ ∈ W then f γ else 0, fun γ ↦ ?_, ?_⟩ + · by_cases h : f γ ∈ W + · simp [h] + · simp [h] + · rw [Filter.Germ.coe_eq] + exact hg.mono fun γ hγ ↦ by simp [hγ] + +/-- The pointwise image of a function at `0⁻` under a linear map `f` takes values in the range +of `f`. -/ +theorem mapLinear_mem_funAtZeroMinusSubmodule_range {U : Type*} [AddCommMonoid U] [Module K U] + (f : U →ₗ[K] V) (g : FunAtZeroMinus U) : + Filter.Germ.mapLinear f g ∈ funAtZeroMinusSubmodule (LinearMap.range f) := by + induction g using Filter.Germ.inductionOn with + | _ h => + rw [Filter.Germ.mapLinear_coe, coe_mem_funAtZeroMinusSubmodule_iff] + exact Filter.Eventually.of_forall fun γ ↦ LinearMap.mem_range_self f (h γ) + +/-- A function at `0⁻` lying in both `Fun_{0⁻}(W)` and `Fun_{0⁻}(W')` lies in +`Fun_{0⁻}(W ⊓ W')`. -/ +theorem mem_funAtZeroMinusSubmodule_inf (W W' : Submodule K V) {g : FunAtZeroMinus V} + (hg : g ∈ funAtZeroMinusSubmodule W) (hg' : g ∈ funAtZeroMinusSubmodule W') : + g ∈ funAtZeroMinusSubmodule (W ⊓ W') := by + rw [mem_funAtZeroMinusSubmodule_iff] at hg hg' ⊢ + induction g using Filter.Germ.inductionOn with + | _ f => + rw [Filter.Germ.liftPred_coe] at hg hg' ⊢ + exact (hg.and hg').mono fun γ hγ ↦ Submodule.mem_inf.mpr hγ + +end Submodule + +section TensorProduct + +variable {K : Type u} {U : Type*} {V : Type v} {E : Type w} +variable [CommSemiring K] +variable [AddCommMonoid U] [AddCommMonoid V] [AddCommMonoid E] +variable [Module K U] [Module K V] [Module K E] + +/-- The paper's composite `V ⊗ V' → V ⊗ Fun_{0⁻}(W) → Fun_{0⁻}(V ⊗ W)` of +lem:germ-linear-algebra (second map `θ`), with the tensor factor on the right: a linear map +`u : U → Fun_{0⁻}(V)` extends to `U ⊗[K] E → Fun_{0⁻}(V ⊗[K] E)`, sending `x ⊗ e` to the class +of the pointwise tensors `γ ↦ u(x)(γ) ⊗ e`. -/ +def funAtZeroMinusTensorId (u : U →ₗ[K] FunAtZeroMinus V) : + U ⊗[K] E →ₗ[K] FunAtZeroMinus (V ⊗[K] E) := + (Filter.Germ.tensorProduct (l := 𝓝[<] (0 : ℝ))).comp + (TensorProduct.map u LinearMap.id) + +/-- Evaluation of the tensor extension on a pure tensor. -/ +@[simp] +theorem funAtZeroMinusTensorId_tmul (u : U →ₗ[K] FunAtZeroMinus V) (x : U) (e : E) : + funAtZeroMinusTensorId (E := E) u (x ⊗ₜ[K] e) = + Filter.Germ.mapLinear ((TensorProduct.mk K V E).flip e) (u x) := by + rw [funAtZeroMinusTensorId, LinearMap.comp_apply, TensorProduct.map_tmul, + Filter.Germ.tensorProduct_tmul] + rfl + +/-- If a value of `u` is represented by `f`, then its tensor extension is represented by +the pointwise pure-tensor function. -/ +theorem funAtZeroMinusTensorId_tmul_of_eq_coe + (u : U →ₗ[K] FunAtZeroMinus V) (x : U) (e : E) (f : ℝ → V) + (h : u x = (f : FunAtZeroMinus V)) : + funAtZeroMinusTensorId (E := E) u (x ⊗ₜ[K] e) = + (fun γ ↦ f γ ⊗ₜ[K] e : FunAtZeroMinus (V ⊗[K] E)) := by + rw [funAtZeroMinusTensorId_tmul, h, Filter.Germ.mapLinear_coe] + rfl + +end TensorProduct + +section SubmoduleQuotient + +variable {K : Type u} {V : Type v} [Semiring K] [AddCommMonoid V] [Module K V] + +/-- `Fun_{0⁻}(W) ⊆ Fun_{0⁻}(W')` inside `Fun_{0⁻}(V)` when `W ⊆ W'`. -/ +theorem funAtZeroMinusSubmodule_mono {W W' : Submodule K V} (hWW : W ≤ W') {x : FunAtZeroMinus V} + (hx : x ∈ funAtZeroMinusSubmodule W) : x ∈ funAtZeroMinusSubmodule W' := by + rw [mem_funAtZeroMinusSubmodule_iff] at hx ⊢ + induction x using Filter.Germ.inductionOn with + | _ f => + rw [Filter.Germ.liftPred_coe] at hx ⊢ + exact hx.mono fun gamma hgamma ↦ hWW hgamma + +/-- The map `Fun_{0⁻}(W) → Fun_{0⁻}(V)` with codomain restricted to its image +`Fun_{0⁻}(W) ⊆ Fun_{0⁻}(V)`. -/ +def funAtZeroMinusSubmoduleOf (W : Submodule K V) : + FunAtZeroMinus W →ₗ[K] funAtZeroMinusSubmodule W := + (funAtZeroMinusSubmoduleMap W).codRestrict (funAtZeroMinusSubmodule W) fun g ↦ by + rw [mem_funAtZeroMinusSubmodule_iff] + induction g using Filter.Germ.inductionOn with + | _ f => + rw [funAtZeroMinusSubmoduleMap_coe, Filter.Germ.liftPred_coe] + exact Filter.Eventually.of_forall fun x ↦ (f x).property + +/-- `Fun_{0⁻}(W) ≃ Fun_{0⁻}(W) ⊆ Fun_{0⁻}(V)`: the functions at `0⁻` with values in `W` are +linearly equivalent to their image in `Fun_{0⁻}(V)`, the identification the paper makes. -/ +def funAtZeroMinusSubmoduleEquiv (W : Submodule K V) : + FunAtZeroMinus W ≃ₗ[K] funAtZeroMinusSubmodule W := + LinearEquiv.ofBijective (funAtZeroMinusSubmoduleOf W) (by + constructor + · intro g g' hgg + apply funAtZeroMinusSubmoduleMap_injective W + exact congrArg Subtype.val hgg + · rintro ⟨f, hf⟩ + classical + rw [mem_funAtZeroMinusSubmodule_iff] at hf + induction f using Filter.Germ.inductionOn with + | _ f => + rw [Filter.Germ.liftPred_coe] at hf + let g : ℝ → W := fun x ↦ if hx : f x ∈ W then ⟨f x, hx⟩ else 0 + refine ⟨(g : FunAtZeroMinus W), Subtype.ext ?_⟩ + change funAtZeroMinusSubmoduleMap W (g : FunAtZeroMinus W) = (f : FunAtZeroMinus V) + rw [funAtZeroMinusSubmoduleMap_coe, Filter.Germ.coe_eq] + exact hf.mono fun x hx ↦ by simp [g, hx]) + +/-- The equivalence `Fun_{0⁻}(W) ≃ Fun_{0⁻}(W) ⊆ Fun_{0⁻}(V)` is the map +`Fun_{0⁻}(W) → Fun_{0⁻}(V)` on underlying functions at `0⁻`. -/ +theorem coe_funAtZeroMinusSubmoduleEquiv_apply (W : Submodule K V) (g : FunAtZeroMinus W) : + ((funAtZeroMinusSubmoduleEquiv W g : funAtZeroMinusSubmodule W) : FunAtZeroMinus V) = + funAtZeroMinusSubmoduleMap W g := (rfl) + +/-- `Fun_{0⁻}(W) → Fun_{0⁻}(Q)` along a linear map `q : W → Q`, applied pointwise to a function +at `0⁻` taking values in `W` near `0`; for `q` a quotient map this is +`Fun_{0⁻}(W) → Fun_{0⁻}(W/W')`. -/ +def funAtZeroMinusQuotientMap (W : Submodule K V) {Q : Type w} [AddCommMonoid Q] [Module K Q] + (q : W →ₗ[K] Q) : funAtZeroMinusSubmodule W →ₗ[K] FunAtZeroMinus Q := + (Filter.Germ.mapLinear q).comp (funAtZeroMinusSubmoduleEquiv W).symm.toLinearMap + +/-- Evaluation of `Fun_{0⁻}(W) → Fun_{0⁻}(Q)` on the class of a `W`-valued function `f`: the +class of `γ ↦ q (f γ)`. -/ +theorem funAtZeroMinusQuotientMap_coe (W : Submodule K V) {Q : Type w} + [AddCommMonoid Q] [Module K Q] (q : W →ₗ[K] Q) (f : ℝ → W) + (hf : ((fun γ ↦ (f γ : V)) : FunAtZeroMinus V) ∈ funAtZeroMinusSubmodule W) : + funAtZeroMinusQuotientMap W q ⟨((fun γ ↦ (f γ : V)) : FunAtZeroMinus V), hf⟩ = + ((fun γ ↦ q (f γ)) : FunAtZeroMinus Q) := by + have hsymm : (funAtZeroMinusSubmoduleEquiv W).symm + ⟨((fun γ ↦ (f γ : V)) : FunAtZeroMinus V), hf⟩ = (f : FunAtZeroMinus W) := by + apply (funAtZeroMinusSubmoduleEquiv W).injective + rw [LinearEquiv.apply_symm_apply] + apply Subtype.ext + change ((fun γ ↦ (f γ : V)) : FunAtZeroMinus V) = + funAtZeroMinusSubmoduleMap W (f : FunAtZeroMinus W) + rw [funAtZeroMinusSubmoduleMap_coe] + rw [funAtZeroMinusQuotientMap, LinearMap.comp_apply, LinearEquiv.coe_toLinearMap, hsymm, + Filter.Germ.mapLinear_coe] + rfl + +/-- The image in `Fun_{0⁻}(Q)` vanishes exactly when the function takes values in the kernel +submodule `W'` for all `γ < 0` sufficiently close to `0`. -/ +theorem funAtZeroMinusQuotientMap_eq_zero_iff (W W' : Submodule K V) {Q : Type w} + [AddCommMonoid Q] [Module K Q] (q : W →ₗ[K] Q) + (hker : ∀ w : W, q w = 0 ↔ (w : V) ∈ W') + (g : funAtZeroMinusSubmodule W) : + funAtZeroMinusQuotientMap W q g = 0 ↔ (g : FunAtZeroMinus V) ∈ funAtZeroMinusSubmodule W' := by + obtain ⟨u, rfl⟩ := (funAtZeroMinusSubmoduleEquiv W).surjective g + induction u using Filter.Germ.inductionOn with + | _ f => + have hcoe : ((funAtZeroMinusSubmoduleEquiv W (f : FunAtZeroMinus W) : + funAtZeroMinusSubmodule W) : FunAtZeroMinus V) = + ((fun γ ↦ (f γ : V)) : FunAtZeroMinus V) := by + change funAtZeroMinusSubmoduleMap W (f : FunAtZeroMinus W) = + ((fun γ ↦ (f γ : V)) : FunAtZeroMinus V) + rw [funAtZeroMinusSubmoduleMap_coe] + rw [funAtZeroMinusQuotientMap, LinearMap.comp_apply, LinearEquiv.coe_toLinearMap, + LinearEquiv.symm_apply_apply, Filter.Germ.mapLinear_coe, hcoe, + coe_mem_funAtZeroMinusSubmodule_iff, + show (0 : FunAtZeroMinus Q) = ((fun _ : ℝ ↦ (0 : Q)) : FunAtZeroMinus Q) from rfl, + Filter.Germ.coe_eq] + exact ⟨fun h ↦ h.mono fun γ hγ ↦ (hker (f γ)).mp hγ, + fun h ↦ h.mono fun γ hγ ↦ (hker (f γ)).mpr hγ⟩ + +end SubmoduleQuotient + +section Injectivity + +/-- Tensor extension by the identity preserves injectivity for linear maps into functions at `0⁻` +over a field: the paper's canonical map `θ : Fun_{0⁻}(V) ⊗[K] E → Fun_{0⁻}(V ⊗[K] E)` is +injective, and so is `u ⊗ 1` by flatness. -/ +theorem funAtZeroMinusTensorId_injective_of_injective + {K : Type u} {U : Type*} {V : Type v} {E : Type w} + [Field K] + [AddCommGroup U] [AddCommGroup V] [AddCommGroup E] + [Module K U] [Module K V] [Module K E] + (u : U →ₗ[K] FunAtZeroMinus V) (hu : Function.Injective u) : + Function.Injective (funAtZeroMinusTensorId (E := E) u) := + Filter.Germ.tensorProduct_injective.comp + (Module.Flat.rTensor_preserves_injective_linearMap (M := E) u hu) + +/-- Naturality of the tensor extension in the second factor. -/ +theorem mapLinear_lTensor_funAtZeroMinusTensorId + {K : Type u} {U : Type*} {V : Type v} {E E' : Type*} + [CommSemiring K] + [AddCommMonoid U] [AddCommMonoid V] [AddCommMonoid E] [AddCommMonoid E'] + [Module K U] [Module K V] [Module K E] [Module K E'] + (u : U →ₗ[K] FunAtZeroMinus V) (f : E →ₗ[K] E') (T : U ⊗[K] E) : + Filter.Germ.mapLinear (f.lTensor V) (funAtZeroMinusTensorId u T) = + funAtZeroMinusTensorId u (f.lTensor U T) := by + induction T with + | zero => simp + | tmul x e => + rw [LinearMap.lTensor_tmul, funAtZeroMinusTensorId_tmul, funAtZeroMinusTensorId_tmul] + induction u x using Filter.Germ.inductionOn with + | _ g => + rw [Filter.Germ.mapLinear_coe, Filter.Germ.mapLinear_coe, Filter.Germ.mapLinear_coe] + rfl + | add x y hx hy => simp only [map_add, hx, hy] + +/-- Exactness for the tensor extension into `Fun_{0⁻}(V ⊗[K] E)`: if `u` is injective and +`(u ⊗ 1) T` is represented by values in the image of `1 ⊗ m`, then `T` itself lies in the image +of `1 ⊗ m`. -/ +theorem exists_eq_lTensor_of_funAtZeroMinusTensorId_eq + {K : Type u} {U : Type*} {V : Type v} {E A : Type*} + [Field K] + [AddCommGroup U] [AddCommGroup V] [AddCommGroup E] [AddCommGroup A] + [Module K U] [Module K V] [Module K E] [Module K A] + (u : U →ₗ[K] FunAtZeroMinus V) (hu : Function.Injective u) (m : A →ₗ[K] E) + (T : U ⊗[K] E) (g : FunAtZeroMinus (V ⊗[K] A)) + (h : funAtZeroMinusTensorId u T = Filter.Germ.mapLinear (m.lTensor V) g) : + ∃ T' : U ⊗[K] A, T = m.lTensor U T' := by + set π := (LinearMap.range m).mkQ + have hπ : (π.lTensor V).comp (m.lTensor V) = 0 := by + rw [← LinearMap.lTensor_comp, LinearMap.range_mkQ_comp, LinearMap.lTensor_zero] + have h1 := congrArg (Filter.Germ.mapLinear (π.lTensor V)) h + rw [mapLinear_lTensor_funAtZeroMinusTensorId] at h1 + have h2 : Filter.Germ.mapLinear (π.lTensor V) (Filter.Germ.mapLinear (m.lTensor V) g) = 0 := by + rw [Filter.Germ.mapLinear_comp, hπ] + exact Filter.Germ.mapLinear_zero_apply g + rw [h2] at h1 + have h3 : π.lTensor U T = 0 := + funAtZeroMinusTensorId_injective_of_injective u hu (by rw [h1, map_zero]) + exact ((lTensor_exact U (LinearMap.exact_map_mkQ_range m) + (Submodule.mkQ_surjective _)) T).mp h3 |>.imp fun T' hT' ↦ hT'.symm + +end Injectivity + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/FunAtZeroMinus/Pointwise.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/FunAtZeroMinus/Pointwise.lean new file mode 100644 index 0000000000..8b8b6bdbf4 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/FunAtZeroMinus/Pointwise.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus + +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood +import Mathlib.Topology.Instances.Real.Lemmas + +/-! +# Pointwise identities in `Fun_{0⁻}(V)` + +An equation in `Fun_{0⁻}(V)` is an equation between representatives for all `γ < 0` sufficiently +close to `0`. This module collects the forms in which such equations arise: a function at `0⁻` +vanishing, or equal to a constant function, or equal to a constant times a function at `0⁻`, each +reduced to a statement about the representatives on some interval `(-ε, 0)`. A `K`-algebra `A` +acts on `Fun_{0⁻}(A)` through constant functions, and that action is scalar multiplication. +-/ + +open Filter Topology + +public section + +universe v + +namespace FunAtZeroMinus + +variable {V : Type v} + +/-- A function at `0⁻` is zero exactly when its representatives vanish near zero. -/ +theorem coe_eq_zero_iff [Zero V] (f : ℝ → V) : + ((f : ℝ → V) : FunAtZeroMinus V) = 0 ↔ ∀ᶠ γ in 𝓝[<] (0 : ℝ), f γ = 0 := + Filter.Germ.coe_eq + +/-- A function at `0⁻` is zero exactly when its representatives vanish on some `(-ε, 0)`. -/ +theorem coe_eq_zero_iff_exists [Zero V] (f : ℝ → V) : + ((f : ℝ → V) : FunAtZeroMinus V) = 0 ↔ ∃ η < (0 : ℝ), ∀ γ, η < γ → γ < 0 → f γ = 0 := by + rw [coe_eq_zero_iff, eventually_nhdsLT_iff_exists] + +/-- A function at `0⁻` equals a constant function exactly when its representatives take that +value near zero. -/ +theorem coe_eq_const_iff (f : ℝ → V) (x : V) : + ((f : ℝ → V) : FunAtZeroMinus V) = (x : FunAtZeroMinus V) ↔ ∀ᶠ γ in 𝓝[<] (0 : ℝ), f γ = x := + Filter.Germ.coe_eq + +/-- Two functions at `0⁻` are equal when their representatives agree near zero; the converse is +`Filter.Germ.coe_eq`. -/ +theorem coe_eq_coe_of_eventually {f g : ℝ → V} (h : ∀ᶠ γ in 𝓝[<] (0 : ℝ), f γ = g γ) : + ((f : ℝ → V) : FunAtZeroMinus V) = (g : ℝ → V) := + Filter.Germ.coe_eq.mpr h + +/-- Addition of constant functions. -/ +theorem const_add [Add V] (x y : V) : + ((x + y : V) : FunAtZeroMinus V) = (x : FunAtZeroMinus V) + (y : FunAtZeroMinus V) := rfl + +/-- The constant function `0`. -/ +theorem const_zero [Zero V] : ((0 : V) : FunAtZeroMinus V) = 0 := rfl + +section Ring + +variable {R : Type v} [Semiring R] + +/-- A constant function times a function at `0⁻` is the class of the pointwise products. -/ +theorem const_mul_coe (x : R) (f : ℝ → R) : + (x : FunAtZeroMinus R) * ((f : ℝ → R) : FunAtZeroMinus R) = + ((fun γ ↦ x * f γ : ℝ → R) : FunAtZeroMinus R) := + rfl + +/-- A function at `0⁻` times a constant function is the class of the pointwise products. -/ +theorem coe_mul_const (f : ℝ → R) (x : R) : + ((f : ℝ → R) : FunAtZeroMinus R) * (x : FunAtZeroMinus R) = + ((fun γ ↦ f γ * x : ℝ → R) : FunAtZeroMinus R) := + rfl + +/-- A constant function times a function at `0⁻` is zero exactly when the pointwise products +vanish near zero. -/ +theorem const_mul_coe_eq_zero_iff (x : R) (f : ℝ → R) : + (x : FunAtZeroMinus R) * ((f : ℝ → R) : FunAtZeroMinus R) = 0 ↔ + ∀ᶠ γ in 𝓝[<] (0 : ℝ), x * f γ = 0 := by + rw [const_mul_coe, coe_eq_zero_iff] + +end Ring + +section Algebra + +variable {K : Type*} {A : Type v} [CommSemiring K] [Semiring A] [Algebra K A] + +/-- The constant function of a scalar acts on `Fun_{0⁻}(A)`, `A` a `K`-algebra, by scalar +multiplication. -/ +theorem const_algebraMap_mul (k : K) (g : FunAtZeroMinus A) : + ((algebraMap K A k : A) : FunAtZeroMinus A) * g = k • g := by + induction g using Filter.Germ.inductionOn with + | _ f => + rw [← Filter.Germ.coe_smul, const_mul_coe] + exact congrArg _ (funext fun γ ↦ (Algebra.smul_def k (f γ)).symm) + +/-- An element of `Fun_{0⁻}(A)`, `A` a `K`-algebra, times the constant function of a scalar is +scalar multiplication. -/ +theorem mul_const_algebraMap (k : K) (g : FunAtZeroMinus A) : + g * ((algebraMap K A k : A) : FunAtZeroMinus A) = k • g := by + induction g using Filter.Germ.inductionOn with + | _ f => + rw [← Filter.Germ.coe_smul, coe_mul_const] + exact congrArg _ (funext fun γ ↦ (Algebra.commutes k (f γ)).symm.trans + (Algebra.smul_def k (f γ)).symm) + +end Algebra + +end FunAtZeroMinus + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ.lean new file mode 100644 index 0000000000..442ad0418c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Germ.LinearMap + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ/LinearMap.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ/LinearMap.lean new file mode 100644 index 0000000000..da4147b319 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ/LinearMap.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.LinearAlgebra.TensorProduct.Basic +public import Mathlib.Order.Filter.Germ.Basic + +import Mathlib.LinearAlgebra.Basis.VectorSpace +import Mathlib.LinearAlgebra.TensorProduct.Basis + +/-! +# Linear maps on filter germs + +A linear map acts pointwise on germs of functions at a filter. Pointwise pure tensors also +induce a canonical linear map from a tensor product with a germ space to a germ space with +tensor-product values. Over a field that canonical map is injective: a kernel element expanded +along a basis of the second factor has germ coordinates that are killed by the dual coordinate +functionals, applied pointwise. +-/ + +open Filter +open scoped TensorProduct + +universe u v w + +namespace Filter.Germ + +public section + +variable {R : Type u} {M : Type v} {N : Type w} +variable [Semiring R] [AddCommMonoid M] [AddCommMonoid N] +variable [Module R M] [Module R N] +variable {α : Type*} {l : Filter α} + +instance instIsScalarTower {S : Type*} [SMul S R] [SMul S M] [IsScalarTower S R M] : + IsScalarTower S R (Germ l M) where + smul_assoc s r x := by + induction x using inductionOn with + | _ x => + rw [← coe_smul, ← coe_smul, ← coe_smul] + exact EventuallyEq.germ_eq <| Eventually.of_forall fun a ↦ smul_assoc s r (x a) + +instance instSMulCommClass {S : Type*} [SMul S M] [SMulCommClass S R M] : + SMulCommClass S R (Germ l M) where + smul_comm s r x := by + induction x using inductionOn with + | _ x => + rw [← coe_smul, ← coe_smul, ← coe_smul, ← coe_smul] + exact EventuallyEq.germ_eq <| Eventually.of_forall fun a ↦ smul_comm s r (x a) + +/-- The pointwise action of a linear map on germs at a filter. -/ +def mapLinear (f : M →ₗ[R] N) : Germ l M →ₗ[R] Germ l N where + toFun := map f + map_add' x y := by + induction x using inductionOn with + | _ x => + induction y using inductionOn with + | _ y => + rw [← coe_add, map_coe, map_coe, map_coe] + exact EventuallyEq.germ_eq <| Eventually.of_forall fun a ↦ f.map_add (x a) (y a) + map_smul' c x := by + induction x using inductionOn with + | _ x => + rw [← coe_smul, map_coe, map_coe] + exact EventuallyEq.germ_eq <| Eventually.of_forall fun a ↦ f.map_smul c (x a) + +/-- Pointwise evaluation of `mapLinear` on a representative. -/ +@[simp] +theorem mapLinear_coe (f : M →ₗ[R] N) (g : α → M) : + mapLinear f (g : Germ l M) = (f ∘ g : α → N) := + (rfl) + +/-- `mapLinear` is functorial. -/ +theorem mapLinear_comp {P : Type*} [AddCommMonoid P] [Module R P] (f : M →ₗ[R] N) + (g : N →ₗ[R] P) (x : Germ l M) : + mapLinear g (mapLinear f x) = mapLinear (g.comp f) x := by + induction x using inductionOn with + | _ x => rfl + +/-- The zero map acts as zero on germs. -/ +theorem mapLinear_zero_apply (x : Germ l M) : mapLinear (0 : M →ₗ[R] N) x = 0 := by + induction x using inductionOn with + | _ x => + rw [mapLinear_coe] + exact EventuallyEq.germ_eq <| Eventually.of_forall fun a ↦ rfl + +/-- An injective linear map acts injectively on germs. -/ +theorem mapLinear_injective (f : M →ₗ[R] N) (hf : Function.Injective f) : + Function.Injective (mapLinear (l := l) f) := by + intro x y hxy + induction x using inductionOn with + | _ x => + induction y using inductionOn with + | _ y => + rw [mapLinear_coe, mapLinear_coe, coe_eq] at hxy + rw [coe_eq] + exact hxy.mono fun _ hx ↦ hf hx + +section TensorProduct + +variable {K : Type u} {V : Type v} {E : Type w} +variable [CommSemiring K] [AddCommMonoid V] [AddCommMonoid E] +variable [Module K V] [Module K E] + +/-- The bilinear pointwise pure-tensor map on germs. -/ +def tensorBilinear : + Germ l V →ₗ[K] E →ₗ[K] Germ l (V ⊗[K] E) := + LinearMap.mk₂ K + (fun g e ↦ mapLinear ((TensorProduct.mk K V E).flip e) g) + (fun g₁ g₂ e ↦ (mapLinear ((TensorProduct.mk K V E).flip e)).map_add g₁ g₂) + (fun c g e ↦ (mapLinear ((TensorProduct.mk K V E).flip e)).map_smul c g) + (by + intro g e₁ e₂ + induction g using inductionOn with + | _ g => + rw [mapLinear_coe, mapLinear_coe, mapLinear_coe, ← coe_add, coe_eq] + exact Eventually.of_forall fun x ↦ by simp) + (by + intro c g e + induction g using inductionOn with + | _ g => + rw [mapLinear_coe, mapLinear_coe, ← coe_smul, coe_eq] + exact Eventually.of_forall fun x ↦ by simp) + +/-- Pointwise tensoring of a germ with a fixed vector, extended linearly over a tensor product. -/ +def tensorProduct : + Germ l V ⊗[K] E →ₗ[K] Germ l (V ⊗[K] E) := + TensorProduct.lift tensorBilinear + +/-- On a pure tensor, `tensorProduct` is represented by pointwise pure tensors. -/ +@[simp] +theorem tensorProduct_tmul (g : Germ l V) (e : E) : + tensorProduct (l := l) (g ⊗ₜ[K] e) = + mapLinear ((TensorProduct.mk K V E).flip e) g := by + rw [tensorProduct, TensorProduct.lift.tmul] + rfl + +/-- Contraction of the right tensor factor against a functional. -/ +private def tensorRightContraction (lambda : E →ₗ[K] K) : V ⊗[K] E →ₗ[K] V := + (TensorProduct.rid K V).toLinearMap.comp (lambda.lTensor V) + +@[simp] +private theorem tensorRightContraction_tmul (lambda : E →ₗ[K] K) (v : V) (e : E) : + tensorRightContraction lambda (v ⊗ₜ[K] e) = lambda e • v := by + simp [tensorRightContraction] + +private theorem mapLinear_tensorRightContraction_tensorProduct (lambda : E →ₗ[K] K) + (T : Germ l V ⊗[K] E) : + mapLinear (tensorRightContraction lambda) (tensorProduct (l := l) T) = + tensorRightContraction lambda T := by + induction T with + | zero => simp + | tmul g e => + rw [tensorProduct_tmul, tensorRightContraction_tmul] + induction g using inductionOn with + | _ f => + rw [mapLinear_coe, mapLinear_coe] + rfl + | add x y hx hy => simp only [map_add, hx, hy] + +end TensorProduct + +section Injective + +variable {K : Type u} {V : Type v} {E : Type w} +variable [Field K] [AddCommGroup V] [AddCommGroup E] +variable [Module K V] [Module K E] + +/-- Over a field, the canonical map `Germ(V) ⊗[K] E → Germ(V ⊗[K] E)` is injective. -/ +theorem tensorProduct_injective : + Function.Injective (tensorProduct (l := l) (K := K) (V := V) (E := E)) := by + let C := Module.Free.chooseBasis K E + rw [← LinearMap.ker_eq_bot] + refine eq_bot_iff.mpr fun T hT ↦ ?_ + change T = 0 + change tensorProduct (l := l) T = 0 at hT + let c := TensorProduct.equivFinsuppOfBasisRight C T + have hc : c = 0 := by + apply Finsupp.ext + intro i + have hcontract := congrArg (mapLinear (tensorRightContraction (C.coord i))) hT + rw [mapLinear_tensorRightContraction_tensorProduct, map_zero] at hcontract + simpa [c, tensorRightContraction, TensorProduct.equivFinsuppOfBasisRight_apply] using hcontract + apply (TensorProduct.equivFinsuppOfBasisRight C).injective + simp [c, hc] + +end Injective + +end + +end Filter.Germ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Tests.lean new file mode 100644 index 0000000000..ef9bb5715e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Tests.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Tests.FunAtZeroMinus + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Tests/FunAtZeroMinus.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Tests/FunAtZeroMinus.lean new file mode 100644 index 0000000000..7f48c6aeca --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Tests/FunAtZeroMinus.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus + +import Mathlib.Topology.MetricSpace.Pseudo.Lemmas +import Mathlib.Tactic.Linarith +import Mathlib.Tactic.NormNum + +/-! +# API checks for functions at `0⁻` + +A function that vanishes near zero represents `0` in `Fun_{0⁻}(ℚ)` even when it is globally +nonzero. A second fixture is eventually valued in a proper coordinate subspace but leaves it +away from zero. These distinguish eventual equality and membership from their global versions. +A nonzero constant function remains nonzero, and the tensor check evaluates the pointwise +representative formula on a nonconstant real-valued function at `0⁻`. +-/ + +open Filter Topology +open scoped TensorProduct + +namespace Tests + +public noncomputable section + +/-- A rational-valued function that vanishes throughout `(-1, 0)` but not globally. -/ +def tailZero (γ : ℝ) : ℚ := + if γ < -1 then 1 else 0 + +/-- The test function is globally nonzero. -/ +theorem tailZero_neg_two : tailZero (-2) = 1 := by + norm_num [tailZero] + +/-- Agreement near `0`, rather than global equality, makes the test function `0` in +`Fun_{0⁻}(ℚ)`. -/ +theorem tailZero_funAtZeroMinus_eq_zero : + (tailZero : FunAtZeroMinus ℚ) = 0 := by + change (tailZero : FunAtZeroMinus ℚ) = ((fun _ : ℝ ↦ (0 : ℚ)) : FunAtZeroMinus ℚ) + rw [funAtZeroMinus_coe_eq_iff_exists] + refine ⟨1, by norm_num, fun γ hγ _ ↦ ?_⟩ + rw [tailZero, if_neg] + linarith + +/-- Constant functions remain distinct in `Fun_{0⁻}(ℚ)`. -/ +theorem funAtZeroMinus_one_ne_zero : + (1 : FunAtZeroMinus ℚ) ≠ 0 := by + change ((1 : ℚ) : FunAtZeroMinus ℚ) ≠ ((0 : ℚ) : FunAtZeroMinus ℚ) + intro h + exact one_ne_zero (Filter.Germ.const_inj.mp h) + +/-- The first coordinate axis in `ℚ × ℚ`. -/ +def firstAxis : Submodule ℚ (ℚ × ℚ) where + carrier := {x | x.2 = 0} + zero_mem' := rfl + add_mem' {x y} hx hy := by + change x.2 = 0 at hx + change y.2 = 0 at hy + change x.2 + y.2 = 0 + rw [hx, hy, add_zero] + smul_mem' c x hx := by + change x.2 = 0 at hx + change c * x.2 = 0 + rw [hx, mul_zero] + +/-- Membership in the first coordinate axis is vanishing of the second coordinate. -/ +@[simp] +theorem mem_firstAxis_iff (x : ℚ × ℚ) : + x ∈ firstAxis ↔ x.2 = 0 := by + change x.2 = 0 ↔ x.2 = 0 + rfl + +/-- A function that enters the first coordinate axis on `(-1, 0)`. -/ +def eventuallyFirstAxis (γ : ℝ) : ℚ × ℚ := + if γ < -1 then (0, 1) else (1, 0) + +/-- The subspace-valued test function does not lie in the first axis globally. -/ +theorem eventuallyFirstAxis_neg_two_not_mem : + eventuallyFirstAxis (-2) ∉ firstAxis := by + simp [eventuallyFirstAxis] + +/-- Taking values in the subspace near `0` suffices for membership of the function at `0⁻` in +`Fun_{0⁻}(W) ⊆ Fun_{0⁻}(V)`. -/ +theorem eventuallyFirstAxis_funAtZeroMinus_mem : + (eventuallyFirstAxis : FunAtZeroMinus (ℚ × ℚ)) ∈ funAtZeroMinusSubmodule firstAxis := by + rw [coe_mem_funAtZeroMinusSubmodule_iff_exists] + refine ⟨1, by norm_num, fun γ hγ _ ↦ ?_⟩ + rw [eventuallyFirstAxis, if_neg] + · simp + · linarith + +/-- Tensor extension is represented by pointwise pure tensors on a nonconstant function at +`0⁻`. -/ +theorem funAtZeroMinusTensorId_identity_tmul : + funAtZeroMinusTensorId (E := ℝ) + (LinearMap.id : FunAtZeroMinus ℝ →ₗ[ℝ] FunAtZeroMinus ℝ) + (((fun γ : ℝ ↦ γ) : FunAtZeroMinus ℝ) ⊗ₜ[ℝ] (2 : ℝ)) = + ((fun γ : ℝ ↦ γ ⊗ₜ[ℝ] (2 : ℝ)) : FunAtZeroMinus (ℝ ⊗[ℝ] ℝ)) := by + apply funAtZeroMinusTensorId_tmul_of_eq_coe + rfl + +end + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory.lean b/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory.lean new file mode 100644 index 0000000000..f754c9c6cf --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LaurentTower +import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LocalizationUFM + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory/LaurentTower.lean b/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory/LaurentTower.lean new file mode 100644 index 0000000000..4482b0e941 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory/LaurentTower.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.Polynomial.Laurent + +import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LocalizationUFM +import Mathlib.RingTheory.Polynomial.UniqueFactorization + +/-! +# Unique factorisation in the group ring of a free abelian group of finite rank + +The group ring of `ℤ ^ k` over a field is reached from the field by `k` Laurent extensions. Each +one is a polynomial extension, which preserves unique factorisation, followed by a localization at +the powers of the variable, which preserves it as well. +-/ + +universe u v + +public noncomputable section + +namespace LaurentPolynomial + +/-- A Laurent polynomial ring over a unique factorisation domain is a unique factorisation +domain. -/ +theorem uniqueFactorizationMonoid {A : Type u} [CommRing A] [IsDomain A] + [UniqueFactorizationMonoid A] : UniqueFactorizationMonoid (LaurentPolynomial A) := by + have hle : Submonoid.powers (Polynomial.X : Polynomial A) ≤ nonZeroDivisors (Polynomial A) := by + rintro _ ⟨n, rfl⟩ + exact mem_nonZeroDivisors_of_ne_zero (pow_ne_zero n Polynomial.X_ne_zero) + exact IsLocalization.uniqueFactorizationMonoid + (B := LaurentPolynomial A) (Submonoid.powers (Polynomial.X : Polynomial A)) hle + +end LaurentPolynomial + +namespace AddMonoidAlgebra + +/-- Splitting off the first coordinate of a tuple of integers. -/ +def finSuccAddEquiv (n : ℕ) : ((Fin (n + 1)) → ℤ) ≃+ (ℤ × (Fin n → ℤ)) where + toFun f := (f 0, fun i ↦ f i.succ) + invFun p := Fin.cons p.1 p.2 + left_inv f := by + funext i + refine Fin.cases ?_ ?_ i + · simp + · intro j + simp + right_inv p := by + ext + · simp + · simp + map_add' f g := by + ext + · simp + · simp + +/-- The group ring of `ℤ ^ k` over a field is a unique factorisation domain. -/ +theorem uniqueFactorizationMonoid_finInt (K : Type v) [Field K] : + ∀ k : ℕ, UniqueFactorizationMonoid (AddMonoidAlgebra K (Fin k → ℤ)) + | 0 => by + refine MulEquiv.uniqueFactorizationMonoid + (AddMonoidAlgebra.uniqueAlgEquiv (R := K) (A := K) + (M := (Fin 0 → ℤ))).symm.toRingEquiv.toMulEquiv ?_ + infer_instance + | (k + 1) => by + have ih := uniqueFactorizationMonoid_finInt K k + have hlaurent : UniqueFactorizationMonoid + (LaurentPolynomial (AddMonoidAlgebra K (Fin k → ℤ))) := + LaurentPolynomial.uniqueFactorizationMonoid + have f : AddMonoidAlgebra K (Fin (k + 1) → ℤ) ≃+* + LaurentPolynomial (AddMonoidAlgebra K (Fin k → ℤ)) := + RingEquiv.trans + (AddMonoidAlgebra.domCongr (R := K) (A := K) (e := finSuccAddEquiv k)).toRingEquiv + (AddMonoidAlgebra.curryAlgEquiv (R := K) (A := K) (M := ℤ) + (N := (Fin k → ℤ))).toRingEquiv + exact MulEquiv.uniqueFactorizationMonoid f.symm.toMulEquiv hlaurent + +end AddMonoidAlgebra diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory/LocalizationUFM.lean b/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory/LocalizationUFM.lean new file mode 100644 index 0000000000..c1a449d57b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory/LocalizationUFM.lean @@ -0,0 +1,123 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.RingTheory.Localization.Defs +public import Mathlib.RingTheory.UniqueFactorizationDomain.Defs + +import Mathlib.RingTheory.UniqueFactorizationDomain.Basic + +/-! +# Localizations of unique factorisation domains + +A localization of a unique factorisation domain at a submonoid of nonzerodivisors is again one. +A prime of the base either becomes a unit or stays prime, so a factorisation of a numerator +becomes one after the primes that turned into units are dropped. + +Mathlib has the corresponding statements for polynomial rings and for principal ideal rings, but +none for localizations. The Laurent polynomial ring is a localization of the polynomial ring, so +this is what carries unique factorisation along the tower of Laurent extensions reaching the group +ring of a finitely generated free abelian group. +-/ + +universe u v + +public noncomputable section + +namespace IsLocalization + +variable {A : Type u} [CommRing A] [IsDomain A] +variable {B : Type v} [CommRing B] [IsDomain B] [Algebra A B] +variable (S : Submonoid A) [IsLocalization S B] + +omit [IsDomain A] [IsDomain B] in +/-- Divisibility after localization comes from divisibility up to a denominator. -/ +theorem exists_dvd_mul_of_dvd_algebraMap {p a : A} + (h : algebraMap A B p ∣ algebraMap A B a) : ∃ s ∈ S, p ∣ a * s := by + obtain ⟨c, hc⟩ := h + obtain ⟨⟨c₁, v⟩, hv⟩ := IsLocalization.surj (M := S) c + have hmap : algebraMap A B (a * v) = algebraMap A B (p * c₁) := by + rw [map_mul, map_mul, hc, mul_assoc, hv] + obtain ⟨w, hw⟩ := IsLocalization.exists_of_eq (M := S) hmap + refine ⟨(v : A) * (w : A), mul_mem v.2 w.2, ⟨c₁ * (w : A), ?_⟩⟩ + calc a * ((v : A) * (w : A)) = (w : A) * (a * (v : A)) := by ring + _ = (w : A) * (p * c₁) := hw + _ = p * (c₁ * (w : A)) := by ring + +omit [IsDomain A] [IsDomain B] in +/-- A prime of the base ring stays prime after localization unless it becomes a unit. -/ +theorem prime_algebraMap_of_prime (hS : S ≤ nonZeroDivisors A) {p : A} (hp : Prime p) + (hnu : ¬ IsUnit (algebraMap A B p)) : Prime (algebraMap A B p) := by + refine ⟨fun h ↦ hp.ne_zero (IsLocalization.injective B hS (by simpa using h)), hnu, ?_⟩ + intro y z hyz + obtain ⟨⟨y₁, t⟩, ht⟩ := IsLocalization.surj (M := S) y + obtain ⟨⟨z₁, u⟩, hu⟩ := IsLocalization.surj (M := S) z + have hdvd : algebraMap A B p ∣ algebraMap A B (y₁ * z₁) := by + have hrw : algebraMap A B (y₁ * z₁) + = (y * z) * (algebraMap A B (t : A) * algebraMap A B (u : A)) := by + rw [map_mul, ← ht, ← hu] + ring + rw [hrw] + exact hyz.mul_right _ + obtain ⟨s, hs, hps⟩ := exists_dvd_mul_of_dvd_algebraMap S hdvd + have hpns : ¬ p ∣ s := fun hd ↦ + hnu (isUnit_of_dvd_unit (map_dvd (algebraMap A B) hd) + (IsLocalization.map_units B ⟨s, hs⟩)) + rcases hp.dvd_mul.mp hps with hprod | hcon + · rcases hp.dvd_mul.mp hprod with hy | hz + · refine Or.inl ((IsUnit.dvd_mul_right (IsLocalization.map_units B t)).mp ?_) + rw [ht] + exact map_dvd _ hy + · refine Or.inr ((IsUnit.dvd_mul_right (IsLocalization.map_units B u)).mp ?_) + rw [hu] + exact map_dvd _ hz + · exact absurd hcon hpns + +omit [IsDomain A] [IsDomain B] in +/-- Mapping a list of primes into the localization and dropping those that become units leaves a +prime factorisation of the image. -/ +private theorem exists_prime_factors_algebraMap [UniqueFactorizationMonoid A] + (hS : S ≤ nonZeroDivisors A) (f : Multiset A) (hf : ∀ p ∈ f, Prime p) : + ∃ g : Multiset B, (∀ q ∈ g, Prime q) ∧ Associated g.prod (algebraMap A B f.prod) := by + induction f using Multiset.induction with + | empty => exact ⟨0, by simp, by simp⟩ + | cons p f ih => + obtain ⟨g, hgp, hga⟩ := ih fun q hq ↦ hf q (Multiset.mem_cons_of_mem hq) + have hp : Prime p := hf p (Multiset.mem_cons_self p f) + by_cases hu : IsUnit (algebraMap A B p) + · refine ⟨g, hgp, hga.trans ⟨hu.unit, ?_⟩⟩ + rw [Multiset.prod_cons, map_mul, IsUnit.unit_spec] + ring + · refine ⟨algebraMap A B p ::ₘ g, ?_, ?_⟩ + · intro q hq + rcases Multiset.mem_cons.mp hq with rfl | hq + · exact prime_algebraMap_of_prime S hS hp hu + · exact hgp q hq + · rw [Multiset.prod_cons, Multiset.prod_cons, map_mul] + exact hga.mul_left _ + +omit [IsDomain A] in +/-- A localization of a unique factorisation domain at a submonoid of nonzerodivisors is again a +unique factorisation domain. -/ +theorem uniqueFactorizationMonoid [UniqueFactorizationMonoid A] + (hS : S ≤ nonZeroDivisors A) : UniqueFactorizationMonoid B := by + refine UniqueFactorizationMonoid.of_exists_prime_factors (α := B) fun b hb ↦ ?_ + obtain ⟨⟨x, s⟩, hs⟩ := IsLocalization.surj (M := S) b + have hunit : IsUnit (algebraMap A B (s : A)) := IsLocalization.map_units B s + have hx0 : x ≠ 0 := by + intro h + rw [h, map_zero] at hs + rcases mul_eq_zero.mp hs with h' | h' + · exact hb h' + · exact hunit.ne_zero h' + obtain ⟨f, hfp, hfa⟩ := UniqueFactorizationMonoid.exists_prime_factors x hx0 + obtain ⟨g, hgp, hga⟩ := exists_prime_factors_algebraMap (B := B) S hS f hfp + refine ⟨g, hgp, hga.trans ?_⟩ + refine (hfa.map (algebraMap A B)).trans (Associated.symm ⟨hunit.unit, ?_⟩) + rw [IsUnit.unit_spec] + exact hs + +end IsLocalization diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory.lean new file mode 100644 index 0000000000..ecd9fa92c7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.FinitePWOUnion +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/FinitePWOUnion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/FinitePWOUnion.lean new file mode 100644 index 0000000000..dc2f706e1c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/FinitePWOUnion.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Order.WellFoundedSet + +/-! +# Finite unions of partially well-ordered sets + +A union indexed by a finite type is partially well ordered when every member is. This is the +finite-family form of closure of partially well-ordered subsets of a linear order under union. +-/ + +universe u v + +namespace Set.IsPWO + +variable {α : Type u} {ι : Type v} [LinearOrder α] + +public section + +/-- A finite union of partially well-ordered sets is partially well ordered. -/ +theorem iUnion_of_finite [Finite ι] (S : ι → Set α) (hS : ∀ i, (S i).IsPWO) : + (⋃ i, S i).IsPWO := by + classical + cases nonempty_fintype ι + have hfin : ∀ t : Finset ι, (⋃ i ∈ t, S i).IsPWO := by + intro t + induction t using Finset.induction_on with + | empty => simp + | @insert i t hi ht => + rw [Finset.set_biUnion_insert] + exact (hS i).union ht + simpa using hfin Finset.univ + +end + +end Set.IsPWO diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal.lean new file mode 100644 index 0000000000..bc883ac3c8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal.lean @@ -0,0 +1,30 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AlgebraicOrder +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorBendixson +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorTermCount +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.GeneralFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.IncreasingSequenceUnion +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTerm +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTermSup +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.MultiplicativelyPrincipal +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalOrder +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPowerFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPrincipal +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.OrderedUnion +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.PairBounds +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Separation +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Split +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SuccessorFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Sumset +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/AdditivelyPrincipal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/AdditivelyPrincipal.lean new file mode 100644 index 0000000000..86842c2691 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/AdditivelyPrincipal.lean @@ -0,0 +1,426 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow +public import Mathlib.SetTheory.Ordinal.Principal +import Mathlib.Algebra.Order.BigOperators.Group.List + +/-! +# Positive additive principal ordinals + +LM24, Definition 3.3.1 calls an ordinal additively principal when it is of the form +`Ordinal.omega0 ^ e`. In particular, LM24 excludes zero. Mathlib's more general predicate +`Ordinal.IsPrincipal (· + ·)` includes zero, so `Ordinal.IsAdditivelyPrincipal` records the +source convention explicitly and the bridge theorem retains the necessary nonzero condition. + +The purported second equivalence printed in Definition 3.3.1 is false for ordinary ordinal +addition: `1 + ω = ω`. The correct closure condition is Mathlib's +`Ordinal.IsPrincipal (· + ·)`, together with nonzeroness. + +The list `Ordinal.additivePrincipalTerms o` is the uncompressed Cantor normal form of `o`: each +finite coefficient is represented by repeated powers of `ω`. Thus repeated equal terms are +retained, as required by LM24's weak normal forms. + +The Cantor terms also settle when ordinary and Hessenberg multiplication by a power of `ω` agree. +The Hessenberg product `ω ^ x ⊙ ω ^ w` equals the ordinary product `ω ^ x * ω ^ w` exactly +when `w` is at most every Cantor term of `x`; the weaker `ω ^ w ≤ ω ^ x` does not suffice, as +`x = ω + 1`, `w = ω` gives `ω ^ (ω * 2)` against `ω ^ (ω * 2 + 1)`. Berarducci, Lemma 8.2 uses +this conversion silently, and its hypothesis on principal values supplies the term condition. + +Mathlib supplies `Ordinal.IsPrincipal`, its exact power-of-`ω` characterization, ordinal logarithm, +and compressed Cantor normal form. The uncompressed list is defined by repeatedly removing the +largest power of `ω`, which preserves repeated terms. +-/ + +universe u + +open scoped NatOrdinal + +public noncomputable section + +namespace Ordinal + +/-- An LM24 additive principal ordinal: a positive ordinal of the form `ω ^ e`. -/ +def IsAdditivelyPrincipal (o : Ordinal) : Prop := + ∃ e : Ordinal, o = omega0 ^ e + +/-- Characterization of LM24 additive principal ordinals by powers of `ω`. -/ +theorem isAdditivelyPrincipal_iff {o : Ordinal} : + IsAdditivelyPrincipal o ↔ ∃ e : Ordinal, o = omega0 ^ e := + (Iff.rfl) + +/-- The difference between LM24's positive convention and Mathlib's additive-principal predicate. -/ +theorem isAdditivelyPrincipal_iff_ne_zero_and_isPrincipal_add {o : Ordinal} : + IsAdditivelyPrincipal o ↔ o ≠ 0 ∧ IsPrincipal (· + ·) o := by + constructor + · rintro ⟨e, rfl⟩ + exact ⟨opow_ne_zero _ omega0_ne_zero, isPrincipal_add_omega0_opow e⟩ + · rintro ⟨ho, hp⟩ + rw [isPrincipal_add_iff_zero_or_omega0_opow] at hp + rcases hp with hzero | ⟨e, he⟩ + · exact (ho hzero).elim + · exact ⟨e, he.symm⟩ + +/-- Every power of `ω` is additive principal in the LM24 convention. -/ +theorem isAdditivelyPrincipal_omega0_opow (e : Ordinal) : + IsAdditivelyPrincipal (omega0 ^ e) := + ⟨e, rfl⟩ + +/-- An LM24 additive principal ordinal is nonzero. -/ +theorem IsAdditivelyPrincipal.ne_zero {o : Ordinal} (ho : IsAdditivelyPrincipal o) : o ≠ 0 := + (isAdditivelyPrincipal_iff_ne_zero_and_isPrincipal_add.mp ho).1 + +/-- Every proper initial segment of `ρ * (α + 1)` leaves a remainder of at least `ρ` when `ρ` is +additive principal. This is the principal-part computation used in Berarducci, Lemma 6.8. -/ +theorem IsAdditivelyPrincipal.le_of_add_eq_mul_succ {o a b c : Ordinal} + (ho : IsAdditivelyPrincipal o) (hb : b < o * (a + 1)) (h : b + c = o * (a + 1)) : + o ≤ c := by + by_contra hlt + rw [not_le] at hlt + have hprincipal := + (isAdditivelyPrincipal_iff_ne_zero_and_isPrincipal_add.mp ho).2 + rcases le_or_gt (o * a) b with hge | hlt2 + · set d := b - o * a with hd + have hbd : o * a + d = b := Ordinal.add_sub_cancel_of_le hge + rw [mul_add_one] at hb + have hdlt : d < o := by + rw [← hbd] at hb + exact lt_of_add_lt_add_left hb + have hsum : o * a + (d + c) < o * a + o := + (add_lt_add_iff_left _).mpr (hprincipal hdlt hlt) + rw [← add_assoc, hbd, h, mul_add_one] at hsum + exact lt_irrefl _ hsum + · have h1 : b + c ≤ o * a + c := by gcongr + have h2 : o * a + c < o * a + o := (add_lt_add_iff_left _).mpr hlt + rw [h, mul_add_one] at h1 + exact lt_irrefl _ (h1.trans_lt h2) + +/-- A positive additive-principal ordinal strictly above one is at least `ω`. -/ +theorem IsAdditivelyPrincipal.omega0_le_of_one_lt {o : Ordinal} + (ho : IsAdditivelyPrincipal o) (hone : 1 < o) : omega0 ≤ o := by + obtain ⟨e, rfl⟩ := isAdditivelyPrincipal_iff.mp ho + rw [one_lt_opow] at hone + simpa [opow_one] using + opow_le_opow_right omega0_pos (Order.one_le_iff_ne_zero.mpr hone.2) + +/-- An additive-principal ordinal strictly greater than one is a nonzero limit ordinal. -/ +theorem IsAdditivelyPrincipal.isSuccLimit_of_one_lt {o : Ordinal} + (ho : IsAdditivelyPrincipal o) (hone : 1 < o) : Order.IsSuccLimit o := by + obtain ⟨e, rfl⟩ := isAdditivelyPrincipal_iff.mp ho + rw [one_lt_opow] at hone + exact isSuccLimit_opow_left isSuccLimit_omega0 hone.2 + +/-- The finite list of additive principal terms in the uncompressed Cantor normal form of `o`. -/ +noncomputable def additivePrincipalTerms (o : Ordinal) : List Ordinal := + if o = 0 then [] + else omega0 ^ log omega0 o :: additivePrincipalTerms (o - omega0 ^ log omega0 o) +termination_by o +decreasing_by exact sub_omega0_opow_log_lt (by assumption) + +@[simp] +theorem additivePrincipalTerms_zero : additivePrincipalTerms 0 = [] := by + rw [additivePrincipalTerms] + simp + +theorem additivePrincipalTerms_of_ne_zero {o : Ordinal} (ho : o ≠ 0) : + additivePrincipalTerms o = + omega0 ^ log omega0 o :: additivePrincipalTerms (o - omega0 ^ log omega0 o) := by + rw [additivePrincipalTerms] + simp only [if_neg ho] + +/-- A finite ordinary sum of ordinals below a positive additive-principal ordinal remains below +that ordinal. -/ +theorem IsAdditivelyPrincipal.list_sum_lt {o : Ordinal} (ho : IsAdditivelyPrincipal o) + {l : List Ordinal} (hl : ∀ a ∈ l, a < o) : l.sum < o := by + have hp := (isAdditivelyPrincipal_iff_ne_zero_and_isPrincipal_add.mp ho).2 + induction l with + | nil => simpa using (ho.ne_zero.bot_lt) + | cons a l ih => + rw [List.sum_cons] + apply hp (hl a (by simp)) + exact ih fun b hb ↦ hl b (by simp [hb]) + +/-- The ordinary ordinal sum of the uncompressed Cantor terms is the original ordinal. -/ +theorem additivePrincipalTerms_sum (o : Ordinal) : o.additivePrincipalTerms.sum = o := by + induction o using additivePrincipalTerms.induct with + | case1 => simp + | case2 o ho ih => + rw [additivePrincipalTerms_of_ne_zero ho, List.sum_cons, ih] + exact Ordinal.add_sub_cancel_of_le (opow_log_le_self omega0 ho) + +/-- Every term in the uncompressed Cantor normal form is LM24 additive principal. -/ +theorem isAdditivelyPrincipal_of_mem_additivePrincipalTerms {o a : Ordinal} + (ha : a ∈ o.additivePrincipalTerms) : IsAdditivelyPrincipal a := by + induction o using additivePrincipalTerms.induct with + | case1 => simp at ha + | case2 o ho ih => + rw [additivePrincipalTerms_of_ne_zero ho] at ha + simp only [List.mem_cons] at ha + rcases ha with rfl | ha + · exact isAdditivelyPrincipal_omega0_opow _ + · exact ih ha + +/-- The uncompressed Cantor terms occur in nonincreasing order. -/ +theorem additivePrincipalTerms_sortedGE (o : Ordinal) : + o.additivePrincipalTerms.SortedGE := by + induction o using additivePrincipalTerms.induct with + | case1 => simp [List.sortedGE_iff_pairwise] + | case2 o ho ih => + rw [additivePrincipalTerms_of_ne_zero ho] + rw [List.sortedGE_iff_pairwise] at ih ⊢ + rw [List.pairwise_cons] + refine ⟨?_, ih⟩ + intro a ha + obtain ⟨e, rfl⟩ := isAdditivelyPrincipal_of_mem_additivePrincipalTerms ha + apply opow_le_opow_right omega0_pos + apply le_log_of_opow_le one_lt_omega0 + calc + omega0 ^ e ≤ (o - omega0 ^ log omega0 o).additivePrincipalTerms.sum := + List.le_sum_of_mem ha + _ = o - omega0 ^ log omega0 o := additivePrincipalTerms_sum _ + _ ≤ o := sub_le_self _ _ + +/-- A sorted ordinary sum of positive powers of `ω` agrees with the corresponding Hessenberg +sum in `NatOrdinal`. -/ +theorem natOrdinal_of_sum_eq_sum_map_of_sorted {l : List Ordinal} + (hprincipal : ∀ a ∈ l, IsAdditivelyPrincipal a) + (hsorted : l.SortedGE) : + NatOrdinal.of l.sum = (l.map NatOrdinal.of).sum := by + induction l with + | nil => simp + | cons a l ih => + have haPrincipal := hprincipal a (by simp) + obtain ⟨e, rfl⟩ := isAdditivelyPrincipal_iff.mp haPrincipal + have hpairwise := List.sortedGE_iff_pairwise.mp hsorted + have htailSorted : l.SortedGE := + List.sortedGE_iff_pairwise.mpr (List.pairwise_cons.mp hpairwise).2 + have htailPrincipal : ∀ b ∈ l, IsAdditivelyPrincipal b := + fun b hb ↦ hprincipal b (by simp [hb]) + have htailBound : l.sum < omega0 ^ (e + 1) := by + apply (isAdditivelyPrincipal_omega0_opow _).list_sum_lt + intro b hb + have hble : b ≤ omega0 ^ e := (List.pairwise_cons.mp hpairwise).1 b hb + exact hble.trans_lt <| + (opow_lt_opow_iff_right one_lt_omega0).mpr (Order.lt_succ e) + rw [List.sum_cons, List.map_cons, List.sum_cons, + ← ih htailPrincipal htailSorted, NatOrdinal.of_omega0_opow] + symm + apply NatOrdinal.wpow_add_of_lt + rw [NatOrdinal.wpow_def, NatOrdinal.val_add_one, NatOrdinal.val_of] + exact NatOrdinal.of.lt_iff_lt.mpr htailBound + +/-- The uncompressed Cantor terms are the unique nonincreasing finite list of positive additive +principal ordinals whose ordinary ordinal sum is `o`. -/ +theorem additivePrincipalTerms_unique {o : Ordinal} {l : List Ordinal} + (hsum : l.sum = o) (hprincipal : ∀ a ∈ l, IsAdditivelyPrincipal a) + (hsorted : l.SortedGE) : l = o.additivePrincipalTerms := by + have canonicalSum := additivePrincipalTerms_sum o + have canonicalPrincipal : ∀ a ∈ o.additivePrincipalTerms, IsAdditivelyPrincipal a := + fun _ ha ↦ isAdditivelyPrincipal_of_mem_additivePrincipalTerms ha + have canonicalSorted := additivePrincipalTerms_sortedGE o + suffices hunique : ∀ {l m : List Ordinal}, l.sum = m.sum → + (∀ a ∈ l, IsAdditivelyPrincipal a) → l.SortedGE → + (∀ a ∈ m, IsAdditivelyPrincipal a) → m.SortedGE → l = m by + exact hunique (hsum.trans canonicalSum.symm) hprincipal hsorted canonicalPrincipal + canonicalSorted + intro l + induction l with + | nil => + intro m hsum _ _ hmPrincipal _ + cases m with + | nil => rfl + | cons b bs => + have hbpos : 0 < b := (hmPrincipal b (by simp)).ne_zero.bot_lt + have hble : b ≤ (b :: bs).sum := List.le_sum_of_mem (by simp) + rw [← hsum] at hble + have : b ≤ 0 := by simpa only [List.sum_nil] using hble + exact (not_lt_of_ge this hbpos).elim + | cons a as ih => + intro m hsum hlPrincipal hlSorted hmPrincipal hmSorted + cases m with + | nil => + have hapos : 0 < a := (hlPrincipal a (by simp)).ne_zero.bot_lt + have hale : a ≤ (a :: as).sum := List.le_sum_of_mem (by simp) + rw [hsum] at hale + have : a ≤ 0 := by simpa only [List.sum_nil] using hale + exact (not_lt_of_ge this hapos).elim + | cons b bs => + have hlPairwise : (a :: as).Pairwise (· ≥ ·) := + List.sortedGE_iff_pairwise.mp hlSorted + have hmPairwise : (b :: bs).Pairwise (· ≥ ·) := + List.sortedGE_iff_pairwise.mp hmSorted + have hal : ∀ x ∈ as, x ≤ a := (List.pairwise_cons.mp hlPairwise).1 + have hbl : ∀ x ∈ bs, x ≤ b := (List.pairwise_cons.mp hmPairwise).1 + have hab : a = b := by + apply le_antisymm + · apply le_of_not_gt + intro hba + have hlt : (b :: bs).sum < a := + (hlPrincipal a (by simp)).list_sum_lt (by + intro x hx + simp only [List.mem_cons] at hx + rcases hx with rfl | hx + · exact hba + · exact (hbl x hx).trans_lt hba) + have hale : a ≤ (a :: as).sum := List.le_sum_of_mem (by simp) + exact (not_lt_of_ge (hale.trans_eq hsum)) hlt + · apply le_of_not_gt + intro hab + have hlt : (a :: as).sum < b := + (hmPrincipal b (by simp)).list_sum_lt (by + intro x hx + simp only [List.mem_cons] at hx + rcases hx with rfl | hx + · exact hab + · exact (hal x hx).trans_lt hab) + have hble : b ≤ (b :: bs).sum := List.le_sum_of_mem (by simp) + exact (not_lt_of_ge (hble.trans_eq hsum.symm)) hlt + subst b + congr 1 + apply ih + · have htail : a + as.sum = a + bs.sum := by + simpa only [List.sum_cons] using hsum + exact add_left_cancel htail + · exact fun x hx ↦ hlPrincipal x (by simp [hx]) + · exact List.sortedGE_iff_pairwise.mpr (List.pairwise_cons.mp hlPairwise).2 + · exact fun x hx ↦ hmPrincipal x (by simp [hx]) + · exact List.sortedGE_iff_pairwise.mpr (List.pairwise_cons.mp hmPairwise).2 + +/-- If every uncompressed Cantor term of `u` is at least the additive-principal ordinal `w`, then +appending `w` does not reorder the terms, so the ordinary and Hessenberg sums agree. -/ +theorem natOrdinal_of_add_eq_add_of_forall_le {u w : Ordinal} + (hw : IsAdditivelyPrincipal w) + (hle : ∀ a ∈ u.additivePrincipalTerms, w ≤ a) : + NatOrdinal.of (u + w) = NatOrdinal.of u + NatOrdinal.of w := by + set l := u.additivePrincipalTerms with hldef + have hlprincipal : ∀ a ∈ l, IsAdditivelyPrincipal a := fun a ha ↦ + isAdditivelyPrincipal_of_mem_additivePrincipalTerms ha + have hlsorted : l.SortedGE := additivePrincipalTerms_sortedGE u + have hallprincipal : ∀ a ∈ l ++ [w], IsAdditivelyPrincipal a := by + intro a ha + rcases List.mem_append.mp ha with ha | ha + · exact hlprincipal a ha + · rw [List.mem_singleton] at ha + exact ha ▸ hw + have hsorted : (l ++ [w]).SortedGE := by + rw [List.sortedGE_iff_pairwise, List.pairwise_append] + refine ⟨List.sortedGE_iff_pairwise.mp hlsorted, by simp, ?_⟩ + intro a ha b hb + rw [List.mem_singleton] at hb + exact hb ▸ hle a ha + have hsum : (l ++ [w]).sum = u + w := by + rw [List.sum_append, List.sum_singleton, hldef, additivePrincipalTerms_sum] + have h1 := natOrdinal_of_sum_eq_sum_map_of_sorted hallprincipal hsorted + have h2 := natOrdinal_of_sum_eq_sum_map_of_sorted hlprincipal hlsorted + rw [hsum] at h1 + rw [h1, List.map_append, List.sum_append, ← h2, hldef, additivePrincipalTerms_sum] + simp + + +/-- The uncompressed Cantor terms of a Hessenberg sum of additive-principal ordinals are exactly +the summands. -/ +theorem mem_of_mem_additivePrincipalTerms_natSum {L : List Ordinal} + (hL : ∀ a ∈ L, IsAdditivelyPrincipal a) {a : Ordinal} + (ha : a ∈ (((L.map NatOrdinal.of).sum).val).additivePrincipalTerms) : a ∈ L := by + classical + set L' := L.mergeSort (fun x y ↦ decide (y ≤ x)) with hL'def + have hperm : L'.Perm L := List.mergeSort_perm L _ + have hsorted : L'.SortedGE := List.sortedGE_mergeSort + have hL'principal : ∀ x ∈ L', IsAdditivelyPrincipal x := + fun x hx ↦ hL x (hperm.mem_iff.mp hx) + have hmapsum : (L'.map NatOrdinal.of).sum = (L.map NatOrdinal.of).sum := + (hperm.map NatOrdinal.of).sum_eq + have hsum : NatOrdinal.of L'.sum = (L.map NatOrdinal.of).sum := by + rw [natOrdinal_of_sum_eq_sum_map_of_sorted hL'principal hsorted, hmapsum] + have hval : L'.sum = ((L.map NatOrdinal.of).sum).val := by + rw [← hsum, NatOrdinal.val_of] + have huniq := additivePrincipalTerms_unique (o := L'.sum) rfl hL'principal hsorted + rw [hval] at huniq + exact hperm.mem_iff.mp (huniq ▸ ha) + + +/-- Hessenberg and ordinary multiplication by `ω ^ w` agree on a power of `ω` whose exponent is a +Hessenberg sum of additive-principal ordinals all at least `w`. The hypothesis cannot be weakened +to `ω ^ w ≤ ω ^ x`: for `x = ω + 1` and `w = ω` the two products are `ω ^ (ω * 2)` and +`ω ^ (ω * 2 + 1)`. -/ +theorem natOrdinal_of_mul_wpow_eq_mul {w : Ordinal} {M : List Ordinal} + (hw : IsAdditivelyPrincipal w) + (hM : ∀ u ∈ M, IsAdditivelyPrincipal u ∧ w ≤ u) : + NatOrdinal.of (omega0 ^ ((M.map NatOrdinal.of).sum).val * omega0 ^ w) = + NatOrdinal.of (omega0 ^ ((M.map NatOrdinal.of).sum).val) * + NatOrdinal.of (omega0 ^ w) := by + set x := ((M.map NatOrdinal.of).sum).val with hxdef + have hterms : ∀ a ∈ x.additivePrincipalTerms, w ≤ a := by + intro a ha + exact (hM a (mem_of_mem_additivePrincipalTerms_natSum (fun u hu ↦ (hM u hu).1) ha)).2 + rw [← opow_add, NatOrdinal.of_omega0_opow, NatOrdinal.of_omega0_opow, + NatOrdinal.of_omega0_opow, natOrdinal_of_add_eq_add_of_forall_le hw hterms, + NatOrdinal.wpow_add] + +theorem IsAdditivelyPrincipal.opow_log_self {o : Ordinal} (ho : IsAdditivelyPrincipal o) : + omega0 ^ log omega0 o = o := by + obtain ⟨e, rfl⟩ := isAdditivelyPrincipal_iff.mp ho + rw [log_opow one_lt_omega0] + +theorem natOrdinal_of_eq_wpow_log {o : Ordinal} (ho : IsAdditivelyPrincipal o) : + NatOrdinal.of o = ω^ (NatOrdinal.of (log omega0 o)) := by + conv_lhs => rw [← ho.opow_log_self] + rw [NatOrdinal.of_omega0_opow] + +theorem natOrdinal_of_log_eq_sum_terms (o : Ordinal) : + NatOrdinal.of (log omega0 o) = + (((log omega0 o).additivePrincipalTerms).map NatOrdinal.of).sum := by + conv_lhs => rw [← additivePrincipalTerms_sum (log omega0 o)] + exact natOrdinal_of_sum_eq_sum_map_of_sorted + (fun _ ha ↦ isAdditivelyPrincipal_of_mem_additivePrincipalTerms ha) + (additivePrincipalTerms_sortedGE _) + +/-- The uncompressed Cantor terms of the logarithm of a Hessenberg product come from the two +factors. -/ +theorem mem_additivePrincipalTerms_log_natMul {o₁ o₂ : Ordinal} + (h₁ : IsAdditivelyPrincipal o₁) (h₂ : IsAdditivelyPrincipal o₂) {t : Ordinal} + (ht : t ∈ + (log omega0 ((NatOrdinal.of o₁ * NatOrdinal.of o₂).val)).additivePrincipalTerms) : + t ∈ (log omega0 o₁).additivePrincipalTerms ∨ + t ∈ (log omega0 o₂).additivePrincipalTerms := by + have hprod : NatOrdinal.of o₁ * NatOrdinal.of o₂ = + ω^ (NatOrdinal.of (log omega0 o₁) + NatOrdinal.of (log omega0 o₂)) := by + rw [NatOrdinal.wpow_add, ← natOrdinal_of_eq_wpow_log h₁, ← natOrdinal_of_eq_wpow_log h₂] + have hlog : log omega0 ((NatOrdinal.of o₁ * NatOrdinal.of o₂).val) = + (NatOrdinal.of (log omega0 o₁) + NatOrdinal.of (log omega0 o₂)).val := by + rw [hprod, NatOrdinal.val_wpow, log_opow one_lt_omega0] + set M := (log omega0 o₁).additivePrincipalTerms ++ (log omega0 o₂).additivePrincipalTerms + with hMdef + have hM : ∀ u ∈ M, IsAdditivelyPrincipal u := by + intro u hu + rcases List.mem_append.mp hu with hu | hu <;> + exact isAdditivelyPrincipal_of_mem_additivePrincipalTerms hu + have hsum : (M.map NatOrdinal.of).sum = + NatOrdinal.of (log omega0 o₁) + NatOrdinal.of (log omega0 o₂) := by + rw [hMdef, List.map_append, List.sum_append, ← natOrdinal_of_log_eq_sum_terms, + ← natOrdinal_of_log_eq_sum_terms] + rw [hlog, ← hsum] at ht + exact List.mem_append.mp (mem_of_mem_additivePrincipalTerms_natSum hM ht) + + +theorem additivePrincipalTerms_of_isAdditivelyPrincipal {o : Ordinal} + (ho : IsAdditivelyPrincipal o) : o.additivePrincipalTerms = [o] := by + rw [additivePrincipalTerms_of_ne_zero ho.ne_zero, ho.opow_log_self, Ordinal.sub_self, + additivePrincipalTerms_zero] + +/-- Ordinary and Hessenberg multiplication by `ω ^ w` agree on an additive-principal ordinal each +of whose canonical multiplicative factors is at least `ω ^ w`. -/ +theorem natOrdinal_of_mul_wpow_eq_mul_of_log_terms {w o : Ordinal} + (hw : IsAdditivelyPrincipal w) (ho : IsAdditivelyPrincipal o) + (hterms : ∀ t ∈ (log omega0 o).additivePrincipalTerms, w ≤ t) : + NatOrdinal.of (o * omega0 ^ w) = NatOrdinal.of o * NatOrdinal.of (omega0 ^ w) := by + have h1 : o * omega0 ^ w = omega0 ^ (log omega0 o + w) := by + rw [opow_add, ho.opow_log_self] + rw [h1, NatOrdinal.of_omega0_opow, natOrdinal_of_add_eq_add_of_forall_le hw hterms, + NatOrdinal.wpow_add, ← natOrdinal_of_eq_wpow_log ho, ← NatOrdinal.of_omega0_opow] + +end Ordinal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/AlgebraicOrder.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/AlgebraicOrder.lean new file mode 100644 index 0000000000..4c2fcf7bd8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/AlgebraicOrder.lean @@ -0,0 +1,345 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Separation + +/-! +# The algebraic order for Hessenberg addition + +The algebraic order of a commutative monoid is `a ≼ b` when `a + c = b` for some `c`. Here the +operation is Hessenberg addition `⊕`, which is cancellative and strictly increasing in each +argument. Thus there is at most one `c` with `a ⊕ c = b`; when it exists, `b ⊖ a` denotes this +Hessenberg difference. Under the isomorphism +`(On, ⊕, ⊙) ≅ (ℕ[X_0, X_1, …], +, ·)` of [LM24, §2.2], `a ≼ b` exactly when each term in the +Cantor normal form of `a` occurs in that of `b` at least as often. This is not ordinal subtraction: +`ω ⊖ 1` is undefined although `1 + ω = ω`. + +The relation is reflexive and transitive, preserved by `⊕` on both sides and cancellable, and it +holds part by part for the parts `b_{≥β}`, `b_{<β}` of `Split.lean`. The last section relates it +to the separation condition (n) of `Separation.lean`: if `c ≠ 0` has last term `ω^ε` in its Cantor +normal form, `b ⊕ c = h` and `h_{≥ε} ≤ τ`, then `b ⊕ θ < τ` for every `θ < c`. +-/ + +universe u w + +open Ordinal + +public noncomputable section + +namespace NatOrdinal + +/-- `a` precedes `b` in the algebraic order for Hessenberg addition: there is `c` with +`a ⊕ c = b`. Equivalently, every Cantor term of `a` occurs in `b` at least as often. -/ +def AlgebraicLE (a b : NatOrdinal.{u}) : Prop := ∃ c, a + c = b + +theorem algebraicLE_iff {a b : NatOrdinal.{u}} : AlgebraicLE a b ↔ ∃ c, a + c = b := (Iff.rfl) + +theorem AlgebraicLE.le {a b : NatOrdinal.{u}} (h : AlgebraicLE a b) : a ≤ b := by + obtain ⟨c, rfl⟩ := h + exact le_add_of_nonneg_right zero_le + +theorem algebraicLE_refl (a : NatOrdinal.{u}) : AlgebraicLE a a := ⟨0, add_zero a⟩ + +theorem algebraicLE_zero (a : NatOrdinal.{u}) : AlgebraicLE 0 a := ⟨a, zero_add a⟩ + +theorem AlgebraicLE.trans {a b c : NatOrdinal.{u}} (hab : AlgebraicLE a b) + (hbc : AlgebraicLE b c) : + AlgebraicLE a c := by + obtain ⟨d, rfl⟩ := hab + obtain ⟨e, rfl⟩ := hbc + exact ⟨d + e, (add_assoc _ _ _).symm⟩ + +theorem algebraicLE_add_right (a b : NatOrdinal.{u}) : AlgebraicLE a (a + b) := ⟨b, rfl⟩ + +theorem algebraicLE_add_left (a b : NatOrdinal.{u}) : AlgebraicLE b (a + b) := ⟨a, add_comm b a⟩ + +theorem AlgebraicLE.add {a b a' b' : NatOrdinal.{u}} (h : AlgebraicLE a b) + (h' : AlgebraicLE a' b') : + AlgebraicLE (a + a') (b + b') := by + obtain ⟨c, rfl⟩ := h + obtain ⟨c', rfl⟩ := h' + exact ⟨c + c', (add_add_add_comm _ _ _ _).symm⟩ + +theorem AlgebraicLE.add_right_cancel {a b c : NatOrdinal.{u}} (h : AlgebraicLE (a + c) (b + c)) : + AlgebraicLE a b := by + obtain ⟨d, hd⟩ := h + exact ⟨d, by rw [add_right_comm] at hd; exact _root_.add_right_cancel hd⟩ + +/-- The algebraic order for Hessenberg addition is preserved by taking parts at or above `β`. -/ +theorem AlgebraicLE.partGE {a b : NatOrdinal.{u}} (h : AlgebraicLE a b) (β : NatOrdinal.{u}) : + AlgebraicLE (partGE β a) (partGE β b) := by + obtain ⟨c, rfl⟩ := h + rw [partGE_add] + exact algebraicLE_add_right _ _ + +/-- The algebraic order for Hessenberg addition is preserved by taking parts below `β`. -/ +theorem AlgebraicLE.partLT {a b : NatOrdinal.{u}} (h : AlgebraicLE a b) (β : NatOrdinal.{u}) : + AlgebraicLE (partLT β a) (partLT β b) := by + obtain ⟨c, rfl⟩ := h + rw [partLT_add] + exact algebraicLE_add_right _ _ + +/-- Algebraic-order comparisons above and below `β` combine into one comparison. -/ +theorem algebraicLE_of_partGE_of_partLT {a b β : NatOrdinal.{u}} + (hGE : AlgebraicLE (partGE β a) (partGE β b)) + (hLT : AlgebraicLE (partLT β a) (partLT β b)) : AlgebraicLE a b := by + have := hGE.add hLT + rwa [partGE_add_partLT, partGE_add_partLT] at this + +/-- The part `a_{≥β}` precedes `a` in the algebraic order for Hessenberg addition. -/ +theorem algebraicLE_partGE (β a : NatOrdinal.{u}) : AlgebraicLE (partGE β a) a := + ⟨partLT β a, partGE_add_partLT β a⟩ + +/-- The part `a_{<β}` precedes `a` in the algebraic order for Hessenberg addition. -/ +theorem algebraicLE_partLT (β a : NatOrdinal.{u}) : AlgebraicLE (partLT β a) a := + ⟨partGE β a, by rw [add_comm]; exact partGE_add_partLT β a⟩ + +/-! ### Ordinals below `c` and the last term of `c` -/ + +/-- If every term of the Cantor normal form of `c` is at least `ω^ε` and `θ < c`, then +`θ_{≥ε} ⊕ ω^ε ≤ c`. -/ +theorem partGE_add_wpow_le_of_lt {c ε θ : NatOrdinal.{u}} + (hc : ∀ t ∈ c.val.additivePrincipalTerms, (ω^ ε).val ≤ t) (hθ : θ < c) : + partGE ε θ + ω^ ε ≤ c := by + have hcGE : partGE ε c = c := partGE_eq_self_of_forall_le hc + have hlt : partGE ε θ < partGE ε c := by + rw [hcGE] + refine lt_of_le_of_ne ((partGE_mono hθ.le).trans hcGE.le) fun heq ↦ ?_ + exact absurd ((partGE_le ε θ).trans' heq.ge) (not_le.mpr hθ) + have h := add_le_of_dvd_of_lt (exists_val_partGE_eq_mul ε θ) + (exists_val_partGE_eq_mul ε c) (NatOrdinal.val.lt_iff_lt.mpr hlt) + rw [hcGE] at h + rw [partGE_add_wpow, ← NatOrdinal.of_val c, NatOrdinal.of.le_iff_le] + exact h + +/-- If `c ≠ 0` has last term `ω^ε` in its Cantor normal form and the sum of the terms in the +Cantor normal form of `b ⊕ c` at exponents at least `ε` is at most `τ`, then +`b ⊕ θ < τ` for every `θ < c`. -/ +@[blueprint "lem:separation" + (phase := "Algebraic and ordinal preliminaries") + (title := "Separation below the last Cantor term") + (statement := /-- + Let $\sigma\neq0$, let $\omega^\beta$ be its last Cantor term, and write + $\rho\oplus\sigma=h$. If the sum of the terms in the Cantor normal form + of $h$ at exponents at least $\beta$ is at most $\tau$, then + $\rho\oplus\theta<\tau$ for every $\theta<\sigma$. + -/) + (proof := /-- + Split each Cantor normal form at exponent $\beta$. For $\theta<\sigma$, + the terms of $\theta$ at exponents at least $\beta$, followed by one + further $\omega^\beta$, are bounded by $\sigma$. Hence + $\rho\oplus\theta$ is strictly below the assumed bound for the terms of + $\rho\oplus\sigma$ at those exponents, and therefore below $\tau$. + -/)] +theorem add_lt_of_lt_of_partGE_le {b c h τ ε : NatOrdinal.{u}} (hc0 : c ≠ 0) + (hε : leastTerm c = ω^ ε) (hbc : b + c = h) (hτ : partGE ε h ≤ τ) {θ : NatOrdinal.{u}} + (hθ : θ < c) : b + θ < τ := by + have hcterms : ∀ t ∈ c.val.additivePrincipalTerms, (ω^ ε).val ≤ t := + fun _ ht ↦ wpow_le_of_mem_additivePrincipalTerms_of_leastTerm_eq hc0 hε ht + have hθc := partGE_add_wpow_le_of_lt hcterms hθ + -- the part of `b ⊕ θ` at or above `ε`, plus `ω^ε`, is at most `h_{≥ε}` + have hhigh : partGE ε (b + θ) + ω^ ε ≤ partGE ε h := by + rw [partGE_add, add_assoc, ← hbc, partGE_add, + partGE_eq_self_of_forall_le hcterms] + exact add_le_add_right hθc _ + -- hence `b ⊕ θ < (b ⊕ θ)_{≥ε} + ω^ε ≤ h_{≥ε} ≤ τ` + calc b + θ = partGE ε (b + θ) + partLT ε (b + θ) := (partGE_add_partLT _ _).symm + _ < partGE ε (b + θ) + ω^ ε := add_lt_add_right (partLT_lt ε _) _ + _ ≤ partGE ε h := hhigh + _ ≤ τ := hτ + +/-- For `ε ≤ β`, the part at or above `ε` of the part at or above `β` is the part at or above `β` +itself. -/ +theorem partGE_partGE_of_ge {β ε : NatOrdinal} (h : ε ≤ β) (a : NatOrdinal) : + partGE ε (partGE β a) = partGE β a := + partGE_eq_self_of_forall_le fun _ hs ↦ + (NatOrdinal.val.le_iff_le.mpr (wpow_le_wpow.mpr h)).trans + (wpow_le_of_mem_additivePrincipalTerms_partGE hs) + +/-- The last term of the Cantor normal form of a natural ordinal is at most the ordinal. -/ +theorem leastTerm_le {a : NatOrdinal} (ha : a ≠ 0) : leastTerm a ≤ a := + of_le_of_mem_additivePrincipalTerms (val_leastTerm_mem ha) + +/-- The last term of the Cantor normal form of the part at or above `β` is at least `ω^β`. -/ +theorem wpow_le_leastTerm_partGE {β a : NatOrdinal} (ha : partGE β a ≠ 0) : + ω^ β ≤ leastTerm (partGE β a) := + NatOrdinal.val.le_iff_le.mp + (wpow_le_of_mem_additivePrincipalTerms_partGE (val_leastTerm_mem ha)) + +/-- When the part below `β` is nonzero, the last term of the Cantor normal form is the last term +of that part. -/ +theorem leastTerm_eq_leastTerm_partLT {β a : NatOrdinal} (h : partLT β a ≠ 0) : + leastTerm a = leastTerm (partLT β a) := by + conv_lhs => rw [← partGE_add_partLT β a] + rcases eq_or_ne (partGE β a) 0 with h0 | h0 + · rw [h0, zero_add] + · rw [leastTerm_add h0 h, min_eq_right] + exact ((leastTerm_le h).trans (partLT_lt β a).le).trans (wpow_le_leastTerm_partGE h0) + +/-- For `β ≤ ε`, the part at or above `ε` of the part at or above `β` is the part at or above +`ε`. -/ +theorem partGE_partGE_of_le {β ε : NatOrdinal} (h : β ≤ ε) (a : NatOrdinal) : + partGE ε (partGE β a) = partGE ε a := by + conv_rhs => rw [← partGE_add_partLT β a] + rw [partGE_add, + partGE_eq_zero_of_lt ((partLT_lt β a).trans_le (wpow_le_wpow.mpr h)), add_zero] + +theorem partGE_le_partGE_of_le {β ε : NatOrdinal} (h : β ≤ ε) (a : NatOrdinal) : + partGE ε a ≤ partGE β a := by + rw [← partGE_partGE_of_le h a] + exact partGE_le _ _ + +/-! ### Windows for the separation condition + +The bound `h_{≥ε} ≤ h_{≥β} ⊕ λ'` that `add_lt_of_lt_of_partGE_le` consumes splits into two cases +according to where the exponent `ε` of the last Cantor term sits relative to the cutoff `β`. Above +the cutoff the bound is monotonicity alone; below it the parts of `h` on either side of the cutoff +have to be compared with `λ'`, which the hypothesis relating them supplies. +-/ + +/-- **The window above the cutoff.** If the last Cantor term of a nonzero `c` has exponent at +least the cutoff -- which happens exactly when `c` has no part below the cutoff -- then the part of +any `h` at or above that exponent is bounded by its part at or above the cutoff. -/ +theorem partGE_le_partGE_add_of_partLT_eq_zero {β ε c : NatOrdinal.{u}} (hc0 : c ≠ 0) + (hcLT : partLT β c = 0) (hε : leastTerm c = ω^ ε) (h lam : NatOrdinal.{u}) : + partGE ε h ≤ partGE β h + lam := by + have hcGE : partGE β c = c := by + have := partGE_add_partLT β c + rwa [hcLT, add_zero] at this + have hβε : β ≤ ε := by + have h1 := wpow_le_leastTerm_partGE (β := β) (a := c) (by rw [hcGE]; exact hc0) + rw [hcGE, hε, wpow_le_wpow] at h1 + exact h1 + exact (partGE_le_partGE_of_le hβε h).trans (le_add_of_nonneg_right zero_le) + +/-- **The window below the cutoff.** If the exponent is at most the cutoff and the part of `λ'` at +or above it agrees with that of the part of `h` below the cutoff, then the part of `h` at or above +the exponent is again bounded by its part at or above the cutoff, together with `λ'`. + +Splitting `h` at the cutoff, the piece above it is unmoved by the coarser cut and the piece below +it is what `λ'` accounts for. -/ +theorem partGE_le_partGE_add_of_le_of_partGE_eq {β ε h lam : NatOrdinal.{u}} (hεβ : ε ≤ β) + (hlamε : partGE ε lam = partGE ε (partLT β h)) : + partGE ε h ≤ partGE β h + lam := + calc partGE ε h + = partGE ε (partGE β h) + partGE ε (partLT β h) := by + conv_lhs => rw [← partGE_add_partLT β h] + rw [partGE_add] + _ = partGE β h + partGE ε lam := by rw [partGE_partGE_of_ge hεβ, hlamε] + _ ≤ partGE β h + lam := add_le_add_right (partGE_le _ _) _ + +/-- The exponent of the last Cantor term of a nonzero part below the cutoff is at most the cutoff: +that part is itself below `ω^β`. -/ +theorem le_of_leastTerm_partLT_eq_wpow {β ε c : NatOrdinal.{u}} + (hne : partLT β c ≠ 0) (hε : leastTerm (partLT β c) = ω^ ε) : ε ≤ β := by + have h1 := leastTerm_le hne + rw [hε] at h1 + exact (wpow_lt_wpow.mp (h1.trans_lt (partLT_lt _ _))).le + +/-- **The cofactor-degree function from separation data.** Given finitely many generator degrees +with a common separation condition against a floor, there is a cofactor-degree function assigning +to each stage of the correction the degree its cofactors must have, agreeing with the prescribed +degree at the top stage. This is exactly the data the well-founded correction consumes: the +grading identity at every stage above the floor, and the separation inequality at the top. + +The separation lemma supplies, for each stage above the floor, a cofactor degree below the +prescribed one whose shift by the generator degree is that stage. -/ +theorem exists_cofactorDegree_of_separation {κ' : Type w} + (σQ ρQ : κ' → NatOrdinal.{u}) (τ μ : NatOrdinal.{u}) + (hσ : ∀ j, σQ j ≠ 0) + (hgrade : ∀ j, ρQ j + σQ j = μ) + (hsep : ∀ j, ∀ θ, θ < σQ j → ρQ j + θ < τ) : + ∃ P : κ' → NatOrdinal.{u} → NatOrdinal.{u}, + (∀ j β, τ < β → β ≤ μ → P j β + σQ j = β) ∧ + (∀ j θ, θ < σQ j → P j μ + θ < τ) := by + classical + have hchoice : ∀ j : κ', ∀ β : NatOrdinal.{u}, ∃ r : NatOrdinal.{u}, + (τ < β → β ≤ μ → r ≤ ρQ j ∧ r + σQ j = β) ∧ (β = μ → r = ρQ j) := by + intro j β + by_cases hβ : τ < β ∧ β ≤ μ + · obtain ⟨r, hrle, hreq⟩ := + exists_le_add_eq_of_forall_add_lt (hσ j) (hsep j) hβ.1 + (by rw [hgrade j]; exact hβ.2) + refine ⟨r, fun _ _ ↦ ⟨hrle, hreq⟩, fun hβμ ↦ ?_⟩ + -- At the top stage the shift determines the cofactor degree by cancellation. + have : r + σQ j = ρQ j + σQ j := by rw [hreq, hβμ, hgrade j] + exact add_right_cancel this + · refine ⟨ρQ j, fun h1 h2 ↦ absurd ⟨h1, h2⟩ hβ, fun hβμ ↦ rfl⟩ + choose P hP using hchoice + refine ⟨P, fun j β h1 h2 ↦ ((hP j β).1 h1 h2).2, fun j θ hθ ↦ ?_⟩ + rw [(hP j μ).2 rfl] + exact hsep j θ hθ + +/-- **Separation from a window.** A window bound at the exponent of the last Cantor term of the +generator degree gives the separation inequality directly. -/ +theorem separation_of_forall_partGE_le {b c h τ : NatOrdinal.{u}} (hc0 : c ≠ 0) + (hbc : b + c = h) (hwin : ∀ ε, leastTerm c = ω^ ε → partGE ε h ≤ τ) : + ∀ θ, θ < c → b + θ < τ := by + obtain ⟨ε, hε⟩ := exists_leastTerm_eq_wpow hc0 + exact fun θ hθ ↦ add_lt_of_lt_of_partGE_le hc0 hε hbc (hwin ε hε) hθ + +/-- **The cofactor-degree function from windows.** Combining the two steps: window bounds at the +generator degrees give the separation condition, which gives the cofactor-degree function the +correction consumes. -/ +theorem exists_cofactorDegree_of_forall_partGE_le {κ' : Type w} + (σQ ρQ : κ' → NatOrdinal.{u}) (τ μ : NatOrdinal.{u}) + (hσ : ∀ j, σQ j ≠ 0) + (hgrade : ∀ j, ρQ j + σQ j = μ) + (hwin : ∀ j, ∀ ε, leastTerm (σQ j) = ω^ ε → partGE ε μ ≤ τ) : + ∃ P : κ' → NatOrdinal.{u} → NatOrdinal.{u}, + (∀ j β, τ < β → β ≤ μ → P j β + σQ j = β) ∧ + (∀ j θ, θ < σQ j → P j μ + θ < τ) := + exists_cofactorDegree_of_separation σQ ρQ τ μ hσ hgrade + fun j ↦ separation_of_forall_partGE_le (hσ j) (hgrade j) (hwin j) + +/-! ### The windows at the two kinds of generator + +A generator degree `c` complementary to a variable weight `w`, in the sense `c ⊕ w = α`, meets its +window in one of two ways. If the variable carries all of `α`'s part below the cutoff, then `c` has +none, and the window above the cutoff applies. Otherwise the window below the cutoff applies, and +what it needs is that the bound `λ'` agrees with the part of `h` below the cutoff at or above the +exponent -- which follows from the corresponding agreement one level up. +-/ + +/-- A complementary degree has no part below the cutoff when its variable carries all of it. -/ +theorem partLT_eq_zero_of_partLT_eq {β α c w : NatOrdinal.{u}} (hc : c + w = α) + (hV2 : partLT β w = partLT β α) : partLT β c = 0 := by + have h1 : partLT β c + partLT β w = partLT β α := by rw [← partLT_add, hc] + rw [hV2] at h1 + exact add_right_cancel (h1.trans (zero_add _).symm) + +/-- **The window at a generator whose variable carries the whole part below the cutoff.** -/ +theorem partGE_le_of_partLT_eq {β α c w h lam : NatOrdinal.{u}} (hc0 : c ≠ 0) (hc : c + w = α) + (hV2 : partLT β w = partLT β α) {ε : NatOrdinal.{u}} (hε : leastTerm c = ω^ ε) : + partGE ε h ≤ partGE β h + lam := + partGE_le_partGE_add_of_partLT_eq_zero hc0 (partLT_eq_zero_of_partLT_eq hc hV2) hε h lam + +/-- The bound agrees with the part of `h` below the cutoff, at or above an exponent, as soon as it +does one level up: both are complements of the same part below the cutoff. -/ +theorem partGE_eq_partGE_partLT_of_partGE_eq {β α h w lam lam₀ ε : NatOrdinal.{u}} + (hh : h + w = α) (hlam : partLT β w + lam = lam₀) + (hlam₀ : partGE ε lam₀ = partGE ε (partLT β α)) : + partGE ε lam = partGE ε (partLT β h) := by + have e1 : partGE ε (partLT β w) + partGE ε lam = partGE ε lam₀ := by + rw [← partGE_add, hlam] + have e2 : partGE ε (partLT β h) + partGE ε (partLT β w) = partGE ε (partLT β α) := by + rw [← partGE_add, ← partLT_add, hh] + rw [hlam₀, ← e2, add_comm (partGE ε (partLT β h))] at e1 + exact add_left_cancel e1 + +/-- **The window at a generator whose variable leaves part of the cutoff level behind.** -/ +theorem partGE_le_of_partGE_eq {β α h w lam lam₀ c ε : NatOrdinal.{u}} + (hne : partLT β c ≠ 0) (hε : leastTerm (partLT β c) = ω^ ε) + (hh : h + w = α) (hlam : partLT β w + lam = lam₀) + (hlam₀ : partGE ε lam₀ = partGE ε (partLT β α)) : + partGE ε h ≤ partGE β h + lam := + partGE_le_partGE_add_of_le_of_partGE_eq (le_of_leastTerm_partLT_eq_wpow hne hε) + (partGE_eq_partGE_partLT_of_partGE_eq hh hlam hlam₀) + +end NatOrdinal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorBendixson.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorBendixson.lean new file mode 100644 index 0000000000..61d2b7466e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorBendixson.lean @@ -0,0 +1,257 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonRank +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.PairBounds +public import Mathlib.SetTheory.Ordinal.Exponential +public import Mathlib.SetTheory.Ordinal.Topology + +import Mathlib.Topology.Maps.Basic + +/-! +# Cantor–Bendixson derivatives of ordinals + +A normal function on the ordinals is a closed topological embedding. Consequently the +`a`-th derivative of the ordinal space consists, apart from stage zero, of the positive +multiples of `ω ^ a`. +-/ + +open Cardinal Filter Order Set Topology + +universe u + +public noncomputable section + +namespace Order.IsNormal + +/-- A normal ordinal function is a closed map. -/ +theorem isClosedMap {f : Ordinal.{u} → Ordinal.{u}} (hf : IsNormal f) : IsClosedMap f := by + intro s hs + rw [Ordinal.isClosed_iff_iSup] + intro ι hι g hg + choose x hx hfx using hg + have hxsup : ⨆ i, x i ∈ s := by + rw [Ordinal.mem_iff_iSup_of_isClosed hs] + exact ⟨ι, hι, x, hx, rfl⟩ + refine ⟨⨆ i, x i, hxsup, ?_⟩ + have hbounded : BddAbove (range x) := Ordinal.bddAbove_of_small + rw [hf.map_iSup hbounded] + exact iSup_congr hfx + +/-- A normal ordinal function is a closed topological embedding. -/ +theorem isClosedEmbedding {f : Ordinal.{u} → Ordinal.{u}} (hf : IsNormal f) : + IsClosedEmbedding f := by + rw [IsClosedEmbedding.isClosedEmbedding_iff_continuous_injective_isClosedMap] + exact ⟨hf.continuous, hf.strictMono.injective, hf.isClosedMap⟩ + +end Order.IsNormal + +namespace NatOrdinal + +private theorem wpow_dvd_val_iff_le_lastExponent {a : NatOrdinal.{u}} (ha : a ≠ 0) + {β e : NatOrdinal.{u}} (he : leastTerm a = ω^ e) : + (ω^ β).val ∣ a.val ↔ β ≤ e := by + rw [wpow_dvd_val_iff_partLT_eq_zero] + constructor + · intro hzero + by_contra hnot + exact partLT_ne_zero_of_leastTerm_lt ha he (lt_of_not_ge hnot) hzero + · intro hβe + apply partLT_eq_zero_of_forall_le + intro t ht + calc + (ω^ β).val ≤ (ω^ e).val := + (Ordinal.opow_le_opow_iff_right Ordinal.one_lt_omega0).mpr + (NatOrdinal.val.le_iff_le.mpr hβe) + _ = (leastTerm a).val := congrArg NatOrdinal.val he.symm + _ ≤ t := val_leastTerm_le_of_mem ha ht + +end NatOrdinal + +namespace Ordinal + +private theorem derivedSet_univ_eq : + derivedSet (Set.univ : Set Ordinal.{u}) = {x | IsSuccLimit x} := by + ext x + rw [mem_derivedSet, AccPt] + simp only [principal_univ, inf_top_eq, mem_setOf_eq] + rw [← not_iff_not, not_neBot, ← isOpen_singleton_iff_punctured_nhds] + exact SuccOrder.isOpen_singleton_iff + +private theorem derivedSet_Ioi_zero_eq : + derivedSet (Ioi (0 : Ordinal.{u})) = {x | IsSuccLimit x} := by + have huniv : (Set.univ : Set Ordinal.{u}) = {0} ∪ Ioi 0 := by + ext x + simp + have hsingle : derivedSet ({0} : Set Ordinal.{u}) = ∅ := by + ext x + simp only [mem_derivedSet, mem_empty_iff_false, iff_false] + exact fun h ↦ (finite_singleton (0 : Ordinal.{u})).not_infinite + (Set.Infinite.of_accPt h) + rw [← derivedSet_univ_eq, huniv, derivedSet_union, hsingle, empty_union] + +def positivePrincipalMultiples (a : Ordinal.{u}) : Set Ordinal.{u} := + (fun x ↦ omega0 ^ a * x) '' Ioi 0 + +/-- Membership in the positive multiples of `ω ^ a`. -/ +theorem mem_positivePrincipalMultiples {a x : Ordinal.{u}} : + x ∈ positivePrincipalMultiples a ↔ ∃ q > 0, omega0 ^ a * q = x := Iff.rfl + +private theorem positivePrincipalMultiples_isClosed (a : Ordinal.{u}) : + IsClosed (positivePrincipalMultiples a) := by + apply (isNormal_mul_right (opow_pos a omega0_pos)).isClosedMap + have hset : Ioi (0 : Ordinal.{u}) = Ici 1 := by + ext x + change 0 < x ↔ (1 : Ordinal.{u}) ≤ x + exact one_le_iff_pos.symm + rw [hset] + exact isClosed_Ici + +private theorem derivedSet_positivePrincipalMultiples (a : Ordinal.{u}) : + derivedSet (positivePrincipalMultiples a) = positivePrincipalMultiples (a + 1) := by + let f : Ordinal.{u} → Ordinal.{u} := fun x ↦ omega0 ^ a * x + have hf : IsNormal f := isNormal_mul_right (opow_pos a omega0_pos) + have himage : derivedSet (f '' Ioi 0) = f '' derivedSet (Ioi 0) := by + apply Set.Subset.antisymm + · exact hf.isClosedMap.derivedSet_image_subset _ + · exact hf.continuous.image_derivedSet hf.strictMono.injective + rw [positivePrincipalMultiples, himage, derivedSet_Ioi_zero_eq, + positivePrincipalMultiples] + ext x + constructor + · rintro ⟨y, hy, rfl⟩ + change IsSuccLimit y at hy + obtain ⟨z, rfl⟩ := isSuccPrelimit_iff_omega0_dvd.mp hy.isSuccPrelimit + refine ⟨z, ?_, ?_⟩ + · change 0 < z + exact pos_iff_ne_zero.mpr fun hz ↦ hy.ne_bot (by simp [hz]) + · symm + change omega0 ^ a * (omega0 * z) = omega0 ^ (a + 1) * z + rw [show a + 1 = Order.succ a by simp, opow_succ, mul_assoc] + · rintro ⟨z, hz, rfl⟩ + refine ⟨omega0 * z, ?_, ?_⟩ + · change IsSuccLimit (omega0 * z) + refine ⟨?_, + isSuccPrelimit_iff_omega0_dvd.mpr (dvd_mul_right _ _)⟩ + rw [isMin_iff_eq_bot, Ordinal.bot_eq_zero] + exact mul_ne_zero omega0_ne_zero hz.ne' + · change omega0 ^ a * (omega0 * z) = omega0 ^ (a + 1) * z + rw [show a + 1 = Order.succ a by simp, opow_succ, mul_assoc] + +private theorem iInter_positivePrincipalMultiples {a : Ordinal.{u}} (ha : IsSuccLimit a) : + (⋂ i : Iio a, positivePrincipalMultiples i.1) = positivePrincipalMultiples a := by + ext x + constructor + · intro hx + have hxi (i : Iio a) : x ∈ positivePrincipalMultiples i.1 := mem_iInter.mp hx i + have hx0 : x ≠ 0 := by + let i : Iio a := ⟨0, ha.bot_lt⟩ + obtain ⟨y, hy, hxy⟩ := hxi i + rw [← hxy] + exact mul_ne_zero (opow_ne_zero _ omega0_ne_zero) hy.ne' + let n : NatOrdinal.{u} := NatOrdinal.of x + have hn0 : n ≠ 0 := by + intro hn + apply hx0 + have := congrArg NatOrdinal.val hn + simpa [n] using this + obtain ⟨e, he⟩ := NatOrdinal.exists_leastTerm_eq_wpow + (a := n) hn0 + have hie : ∀ i < a, NatOrdinal.of i ≤ e := by + intro i hi + obtain ⟨y, hy, hxy⟩ := hxi ⟨i, hi⟩ + apply (NatOrdinal.wpow_dvd_val_iff_le_lastExponent + (a := n) hn0 he).mp + change omega0 ^ i ∣ x + exact ⟨y, hxy.symm⟩ + have hae : a ≤ e.val := by + by_contra hnot + have hea : e.val < a := lt_of_not_ge hnot + have hsucc : e.val + 1 < a := ha.succ_lt hea + have := NatOrdinal.val.le_iff_le.mpr (hie (e.val + 1) hsucc) + simpa using (not_le_of_gt (Order.lt_succ e.val)) this + obtain ⟨q, hq⟩ := (NatOrdinal.wpow_dvd_val_iff_le_lastExponent + (a := n) (β := NatOrdinal.of a) hn0 he).mpr + (NatOrdinal.val.le_iff_le.mp hae) + refine ⟨q, ?_, ?_⟩ + · change 0 < q + apply pos_iff_ne_zero.mpr + intro hq0 + apply hx0 + calc + x = (ω^ (NatOrdinal.of a)).val * q := by simpa only [n, NatOrdinal.val_of] using hq + _ = 0 := by rw [hq0, mul_zero] + · change omega0 ^ a * q = x + simpa only [n, NatOrdinal.val_wpow, NatOrdinal.val_of] using hq.symm + · intro hx + apply mem_iInter.mpr + intro i + obtain ⟨y, hy, hxy⟩ := hx + refine ⟨(omega0 ^ (a - i.1)) * y, ?_, ?_⟩ + · exact mul_pos (opow_pos _ omega0_pos) hy + · change omega0 ^ i.1 * (omega0 ^ (a - i.1) * y) = x + rw [← mul_assoc, ← opow_add, Ordinal.add_sub_cancel_of_le i.2.le] + exact hxy + +private theorem positivePrincipalMultiples_zero : + positivePrincipalMultiples (0 : Ordinal.{u}) = Ioi 0 := by + ext x + simp [positivePrincipalMultiples] + +/-- The `a`-th derivative of the ordinal space is the set of positive multiples of `ω ^ a`, +except that stage zero is the whole space. -/ +theorem cantorBendixson_top_eq (a : Ordinal.{u}) : + ((⊤ : TopologicalSpace.Closeds Ordinal.{u}).cantorBendixson a : Set Ordinal.{u}) = + if a = 0 then Set.univ else positivePrincipalMultiples a := by + induction a using Ordinal.limitRecOn with + | zero => simp + | add_one a ih => + rw [TopologicalSpace.Closeds.cantorBendixson_add_one] + rw [TopologicalSpace.Closeds.coe_derived] + rw [ih] + by_cases ha : a = 0 + · subst a + simp only [zero_add, if_true, if_neg one_ne_zero] + rw [derivedSet_univ_eq, ← derivedSet_Ioi_zero_eq, + ← positivePrincipalMultiples_zero, + derivedSet_positivePrincipalMultiples] + simp + · simp only [if_neg ha] + rw [derivedSet_positivePrincipalMultiples] + simp [ha] + | limit a ha ih => + rw [TopologicalSpace.Closeds.cantorBendixson_limit _ _ ha] + simp only [TopologicalSpace.Closeds.coe_iInf] + ext x + simp only [mem_iInter] + simp only [if_neg (show a ≠ 0 from ha.ne_bot)] + constructor + · intro hx + apply (Set.ext_iff.mp (iInter_positivePrincipalMultiples ha) x).mp + apply mem_iInter.mpr + intro i + by_cases hi : i.1 = 0 + · rw [hi, positivePrincipalMultiples_zero] + have h1a : (1 : Ordinal.{u}) < a := by + simpa using ha.succ_lt ha.bot_lt + have hstage := hx ⟨(1 : Ordinal.{u}), h1a⟩ + rw [ih (1 : Ordinal.{u}) h1a, if_neg one_ne_zero] at hstage + obtain ⟨y, hy, hxy⟩ := hstage + change 0 < x + exact pos_iff_ne_zero.mpr fun hx0 ↦ by + rw [hx0] at hxy + exact (mul_ne_zero (opow_ne_zero _ omega0_ne_zero) hy.ne') hxy + · simpa only [ih i.1 i.2, if_neg hi] using hx i + · intro hx i + rw [ih i.1 i.2] + by_cases hi : i.1 = 0 + · simp [hi] + · rw [if_neg hi] + have hall := (Set.ext_iff.mp (iInter_positivePrincipalMultiples ha) x).mpr hx + exact mem_iInter.mp hall i + +end Ordinal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorTermCount.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorTermCount.lean new file mode 100644 index 0000000000..938fc7c60c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorTermCount.lean @@ -0,0 +1,148 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal + +import Mathlib.Data.List.Sort + +/-! +# Number of terms in an uncompressed Cantor normal form + +LM24, Proposition 5.6.1 bounds the number of infinite-support irreducible factors by the number +of terms in the Cantor normal form of the degree. Finite coefficients are counted with +multiplicity: for example, `ω + ω` has two terms. + +`NatOrdinal.cantorTermCount` is therefore the length of +`Ordinal.additivePrincipalTerms`. Its characteristic arithmetic theorem says that this count is +additive under Hessenberg sum, exactly as required when a series factorisation splits its degree. +-/ + +open scoped NatOrdinal + +public noncomputable section + +namespace NatOrdinal + +/-- The number of terms in the uncompressed Cantor normal form of a natural ordinal. -/ +def cantorTermCount (a : NatOrdinal) : ℕ := + a.val.additivePrincipalTerms.length + +/-- Evaluation of the Cantor term count on an ordinary ordinal. -/ +@[simp] +theorem cantorTermCount_of (o : Ordinal) : + cantorTermCount (NatOrdinal.of o) = o.additivePrincipalTerms.length := by + rw [cantorTermCount, NatOrdinal.val_of] + +@[simp] +theorem cantorTermCount_zero : cantorTermCount 0 = 0 := by + simp [cantorTermCount] + +/-- A nonzero natural ordinal has at least one Cantor term. -/ +theorem cantorTermCount_pos {a : NatOrdinal} (ha : a ≠ 0) : + 0 < cantorTermCount a := by + rw [cantorTermCount, List.length_pos_iff_ne_nil] + intro hnil + have hsum := Ordinal.additivePrincipalTerms_sum a.val + rw [hnil] at hsum + apply ha + apply NatOrdinal.val.injective + simpa using hsum.symm + +/-- A natural ordinal has no Cantor terms exactly when it is zero. -/ +@[simp] +theorem cantorTermCount_eq_zero {a : NatOrdinal} : + cantorTermCount a = 0 ↔ a = 0 := by + constructor + · intro hcount + by_contra ha + exact (Nat.ne_of_gt (cantorTermCount_pos ha)) hcount + · rintro rfl + exact cantorTermCount_zero + +private def mergedTerms (a b : NatOrdinal) : List Ordinal := + (a.val.additivePrincipalTerms ++ b.val.additivePrincipalTerms).insertionSort (· ≥ ·) + +private theorem mergedTerms_sorted (a b : NatOrdinal) : + (mergedTerms a b).SortedGE := by + exact List.sortedGE_insertionSort + +private theorem mergedTerms_perm (a b : NatOrdinal) : + List.Perm (mergedTerms a b) + (a.val.additivePrincipalTerms ++ b.val.additivePrincipalTerms) := by + exact List.perm_insertionSort _ _ + +private theorem mergedTerms_principal (a b : NatOrdinal) : + ∀ o ∈ mergedTerms a b, Ordinal.IsAdditivelyPrincipal o := by + intro o ho + have ho' := (mergedTerms_perm a b).mem_iff.mp ho + rw [List.mem_append] at ho' + exact ho'.elim Ordinal.isAdditivelyPrincipal_of_mem_additivePrincipalTerms + Ordinal.isAdditivelyPrincipal_of_mem_additivePrincipalTerms + +private theorem mergedTerms_naturalSum (a b : NatOrdinal) : + ((mergedTerms a b).map NatOrdinal.of).sum = a + b := by + calc + ((mergedTerms a b).map NatOrdinal.of).sum = + ((a.val.additivePrincipalTerms ++ + b.val.additivePrincipalTerms).map NatOrdinal.of).sum := + ((mergedTerms_perm a b).map NatOrdinal.of).sum_eq + _ = (a.val.additivePrincipalTerms.map NatOrdinal.of).sum + + (b.val.additivePrincipalTerms.map NatOrdinal.of).sum := by + rw [List.map_append, List.sum_append] + _ = NatOrdinal.of a.val + NatOrdinal.of b.val := by + rw [← Ordinal.natOrdinal_of_sum_eq_sum_map_of_sorted + (fun _ h ↦ Ordinal.isAdditivelyPrincipal_of_mem_additivePrincipalTerms h) + (Ordinal.additivePrincipalTerms_sortedGE a.val), + ← Ordinal.natOrdinal_of_sum_eq_sum_map_of_sorted + (fun _ h ↦ Ordinal.isAdditivelyPrincipal_of_mem_additivePrincipalTerms h) + (Ordinal.additivePrincipalTerms_sortedGE b.val), + Ordinal.additivePrincipalTerms_sum, + Ordinal.additivePrincipalTerms_sum] + _ = a + b := by simp + +private theorem mergedTerms_eq_additivePrincipalTerms (a b : NatOrdinal) : + mergedTerms a b = (a + b).val.additivePrincipalTerms := by + apply Ordinal.additivePrincipalTerms_unique + · apply NatOrdinal.of.injective + calc + NatOrdinal.of (mergedTerms a b).sum = + ((mergedTerms a b).map NatOrdinal.of).sum := + Ordinal.natOrdinal_of_sum_eq_sum_map_of_sorted + (mergedTerms_principal a b) (mergedTerms_sorted a b) + _ = a + b := mergedTerms_naturalSum a b + _ = NatOrdinal.of (a + b).val := by simp + · exact mergedTerms_principal a b + · exact mergedTerms_sorted a b + +theorem additivePrincipalTerms_add_perm (a b : NatOrdinal) : + List.Perm (a + b).val.additivePrincipalTerms + (a.val.additivePrincipalTerms ++ b.val.additivePrincipalTerms) := by + rw [← mergedTerms_eq_additivePrincipalTerms] + exact mergedTerms_perm a b + +/-- The number of uncompressed Cantor terms is additive under Hessenberg sum. -/ +@[simp] +theorem cantorTermCount_add (a b : NatOrdinal) : + cantorTermCount (a + b) = cantorTermCount a + cantorTermCount b := by + rw [cantorTermCount, cantorTermCount, cantorTermCount, + ← mergedTerms_eq_additivePrincipalTerms] + calc + (mergedTerms a b).length = + (a.val.additivePrincipalTerms ++ + b.val.additivePrincipalTerms).length := + (mergedTerms_perm a b).length_eq + _ = a.val.additivePrincipalTerms.length + + b.val.additivePrincipalTerms.length := List.length_append + +-- Not a simp lemma: `simp` normalizes `r • a` to `↑r * a`. +theorem cantorTermCount_nsmul (r : ℕ) (a : NatOrdinal) : + cantorTermCount (r • a) = r * cantorTermCount a := by + induction r with + | zero => simp + | succ r ih => rw [succ_nsmul, cantorTermCount_add, ih, Nat.succ_mul] + +end NatOrdinal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Degree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Degree.lean new file mode 100644 index 0000000000..0b635f2a23 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Degree.lean @@ -0,0 +1,335 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow +public import Mathlib.SetTheory.Ordinal.Exponential + +import Mathlib.Algebra.Order.SuccPred +import Mathlib.SetTheory.Ordinal.Principal + +/-! +# Leading Cantor exponent of an ordinal + +For a nonzero ordinal `o`, LM24 defines its degree to be the largest ordinal `a` such that +`Ordinal.omega0 ^ a ≤ o`; equivalently, it is the leading exponent in the Cantor normal form of +`o`. The value at zero is `⊥`, representing LM24's `-∞` convention. We call the resulting +function `Ordinal.cantorDegree` to distinguish this invariant from unrelated notions of degree. + +The codomain is `WithBot NatOrdinal`: the order comes from ordinals, while addition and +multiplication on non-bottom values are Hessenberg's natural operations. This is the convention of +LM24, Sections 1.5 and 2.2. + +The transported function `NatOrdinal.cantorDegree` lets the same invariant interact directly with +the dependency's Hessenberg addition and multiplication. Its arithmetic theorems formalize LM24, +Fact 2.2.2. +-/ + +universe u v + +public noncomputable section + +namespace Ordinal + +/-- The leading exponent in the Cantor normal form of a nonzero ordinal, and `⊥` at zero. -/ +def cantorDegree (o : Ordinal.{u}) : WithBot NatOrdinal.{u} := + if o = 0 then ⊥ else (NatOrdinal.of (log ω o) : WithBot NatOrdinal) + +@[simp] +theorem cantorDegree_zero : cantorDegree (0 : Ordinal.{u}) = ⊥ := by + simp [cantorDegree] + +/-- Away from zero, `cantorDegree` is the ordinal logarithm in base `ω`. -/ +theorem cantorDegree_of_ne_zero {o : Ordinal.{u}} (ho : o ≠ 0) : + cantorDegree o = NatOrdinal.of (log ω o) := by + simp [cantorDegree, ho] + +@[simp] +theorem cantorDegree_eq_bot {o : Ordinal.{u}} : cantorDegree o = ⊥ ↔ o = 0 := by + by_cases ho : o = 0 + · simp [ho] + · simp [cantorDegree, ho] + +/-- This is LM24's maximum characterization of the leading Cantor exponent. -/ +theorem coe_le_cantorDegree_iff {o a : Ordinal.{u}} (ho : o ≠ 0) : + (NatOrdinal.of a : WithBot NatOrdinal) ≤ cantorDegree o ↔ ω ^ a ≤ o := by + rw [cantorDegree_of_ne_zero ho, WithBot.coe_le_coe, NatOrdinal.of_le_iff] + exact (opow_le_iff_le_log one_lt_omega0 ho).symm + +theorem cantorDegree_mono : Monotone (cantorDegree : Ordinal.{u} → WithBot NatOrdinal) := by + intro a b hab + by_cases ha : a = 0 + · simp [ha] + have hb : b ≠ 0 := by + intro hb + subst b + exact ha (bot_unique hab) + rw [cantorDegree_of_ne_zero ha, cantorDegree_of_ne_zero hb, WithBot.coe_le_coe, + NatOrdinal.of_le_iff] + exact log_mono_right ω hab + +/-- An ordinal has degree zero exactly when it is nonzero and finite. -/ +@[simp] +theorem cantorDegree_eq_zero {o : Ordinal.{u}} : + cantorDegree o = (0 : WithBot NatOrdinal) ↔ o ≠ 0 ∧ o < ω := by + by_cases ho : o = 0 + · simp [ho] + rw [cantorDegree_of_ne_zero ho] + have hzero : (0 : WithBot NatOrdinal) = ((0 : NatOrdinal) : WithBot NatOrdinal) := rfl + rw [hzero, WithBot.coe_eq_coe, NatOrdinal.of_eq_zero] + constructor + · intro hlog + refine ⟨ho, ?_⟩ + have hlt : o < ω ^ Order.succ (0 : Ordinal) := by + simpa only [hlog] using lt_opow_succ_log_self one_lt_omega0 o + simpa using hlt + · exact fun h ↦ log_eq_zero h.2 + +@[simp] +theorem cantorDegree_one : cantorDegree (1 : Ordinal.{u}) = 0 := by + rw [cantorDegree_of_ne_zero one_ne_zero, log_one_right] + rfl + +@[simp] +theorem cantorDegree_omega : cantorDegree (ω : Ordinal.{u}) = 1 := by + have hlog : log ω ω = (1 : Ordinal) := by + simpa only [opow_one] using log_opow one_lt_omega0 (1 : Ordinal) + rw [cantorDegree_of_ne_zero omega0_ne_zero, hlog] + rfl + +/-- The ordinary ordinal sum `ω + ω` has degree one, not degree two. -/ +theorem cantorDegree_omega_add_omega : + cantorDegree ((ω : Ordinal.{u}) + ω) = 1 := by + have htwo : (2 : Ordinal.{u}) ≠ 0 := by + exact OfNat.ofNat_ne_zero 2 + have hlogTwo : log ω (2 : Ordinal.{u}) = 0 := + log_eq_zero (natCast_lt_omega0 2) + have hlog : log ω (ω + ω) = (1 : Ordinal) := by + simpa only [opow_one, Ordinal.mul_two, hlogTwo, add_zero] using + log_opow_mul one_lt_omega0 1 htwo + have hne : (ω : Ordinal.{u}) + ω ≠ 0 := fun h ↦ + omega0_ne_zero (left_eq_zero_of_add_eq_zero h) + rw [cantorDegree_of_ne_zero hne, hlog] + rfl + +/-- The ordinal `ω²` has degree two. -/ +theorem cantorDegree_omega_sq : + cantorDegree ((ω : Ordinal.{u}) ^ (2 : Ordinal)) = 2 := by + rw [cantorDegree_of_ne_zero (opow_ne_zero 2 omega0_ne_zero), + log_opow one_lt_omega0] + rfl + +/-! ### Finite powers of `ω` and `ω ^ ω` across universes -/ + +/-- Universe lifting commutes with finite powers of `ω`. -/ +theorem lift_omega0_opow_natCast (n : ℕ) : + lift.{u, v} ((ω : Ordinal.{v}) ^ (n : Ordinal)) = (ω : Ordinal.{max u v}) ^ (n : Ordinal) := by + rw [opow_natCast, opow_natCast] + induction n with + | zero => simp + | succ n ih => simp [pow_succ, lift_mul, ih] + +/-- Universe lifting fixes `ω ^ ω`. -/ +theorem lift_omega0_opow_omega0 : + lift.{u, v} ((ω : Ordinal.{v}) ^ (ω : Ordinal.{v})) = + (ω : Ordinal.{max u v}) ^ (ω : Ordinal.{max u v}) := by + apply le_antisymm + · apply le_of_forall_lt + intro c hc + obtain ⟨d, hd, rfl⟩ := lt_lift_iff.mp hc + obtain ⟨m, hm, hdm⟩ := (lt_opow_of_isSuccLimit omega0_ne_zero isSuccLimit_omega0).mp hd + obtain ⟨n, rfl⟩ := lt_omega0.mp hm + calc + lift.{u, v} d < lift.{u, v} ((ω : Ordinal.{v}) ^ (n : Ordinal)) := lift_lt.mpr hdm + _ = (ω : Ordinal.{max u v}) ^ (n : Ordinal) := lift_omega0_opow_natCast n + _ < ω ^ ω := (opow_lt_opow_iff_right one_lt_omega0).mpr (natCast_lt_omega0 n) + · apply le_of_forall_lt + intro c hc + obtain ⟨m, hm, hcm⟩ := (lt_opow_of_isSuccLimit omega0_ne_zero isSuccLimit_omega0).mp hc + obtain ⟨n, rfl⟩ := lt_omega0.mp hm + calc + c < (ω : Ordinal.{max u v}) ^ (n : Ordinal) := hcm + _ = lift.{u, v} ((ω : Ordinal.{v}) ^ (n : Ordinal)) := (lift_omega0_opow_natCast n).symm + _ ≤ lift.{u, v} ((ω : Ordinal.{v}) ^ (ω : Ordinal.{v})) := + lift_le.mpr ((opow_lt_opow_iff_right one_lt_omega0).mpr (natCast_lt_omega0 n)).le + +/-- Finite powers of `ω` lie below `ω ^ ω`. -/ +theorem omega0_opow_natCast_lt_omega0_opow_omega0 (n : ℕ) : + (ω : Ordinal.{u}) ^ (n : Ordinal) < ω ^ ω := + (opow_lt_opow_iff_right one_lt_omega0).mpr (natCast_lt_omega0 n) + +/-- One more than a finite power of `ω` still lies below `ω ^ ω`; this is the support order type +of a series with `ω ^ n` terms followed by one constant term. -/ +theorem omega0_opow_natCast_add_one_lt_omega0_opow_omega0 (n : ℕ) : + (ω : Ordinal.{u}) ^ (n : Ordinal) + 1 < ω ^ ω := + isPrincipal_add_omega0_opow ω (omega0_opow_natCast_lt_omega0_opow_omega0 n) + (one_lt_opow.mpr ⟨one_lt_omega0, omega0_ne_zero⟩) + +end Ordinal + +namespace NatOrdinal + +/-- The leading Cantor exponent of a natural ordinal, with value `⊥` at zero. -/ +def cantorDegree (a : NatOrdinal.{u}) : WithBot NatOrdinal.{u} := + Ordinal.cantorDegree a.val + +/-- `NatOrdinal.cantorDegree` is `Ordinal.cantorDegree` transported along `NatOrdinal.val`. -/ +theorem cantorDegree_eq_ordinalCantorDegree (a : NatOrdinal.{u}) : + cantorDegree a = Ordinal.cantorDegree a.val := + (rfl) + +/-- Transporting an ordinal into `NatOrdinal` does not change its leading Cantor exponent. -/ +@[simp] +theorem cantorDegree_of (a : Ordinal.{u}) : + cantorDegree (of a) = Ordinal.cantorDegree a := + (rfl) + +@[simp] +theorem cantorDegree_zero : cantorDegree (0 : NatOrdinal.{u}) = ⊥ := by + rw [cantorDegree_eq_ordinalCantorDegree, val_zero, Ordinal.cantorDegree_zero] + +@[simp] +theorem cantorDegree_eq_bot {a : NatOrdinal.{u}} : cantorDegree a = ⊥ ↔ a = 0 := by + rw [cantorDegree_eq_ordinalCantorDegree, Ordinal.cantorDegree_eq_bot] + exact val_eq_zero + +/-- Away from zero, `NatOrdinal.cantorDegree` is the ordinal logarithm in base `ω`. -/ +theorem cantorDegree_of_ne_zero {a : NatOrdinal.{u}} (ha : a ≠ 0) : + cantorDegree a = (of (Ordinal.log Ordinal.omega0 a.val) : WithBot NatOrdinal) := by + rw [cantorDegree_eq_ordinalCantorDegree, Ordinal.cantorDegree_of_ne_zero] + exact val_ne_zero.mpr ha + +/-- The leading Cantor exponent of `ω` raised to a natural ordinal is that ordinal. -/ +@[simp] +theorem cantorDegree_wpow (a : NatOrdinal.{u}) : + cantorDegree (ω^ a) = (a : WithBot NatOrdinal) := by + rw [cantorDegree_of_ne_zero (wpow_ne_zero a), WithBot.coe_eq_coe, + val_wpow, Ordinal.log_opow Ordinal.one_lt_omega0] + exact of_val a + +/-- An ordinal's leading Cantor exponent is at most `d` exactly when the ordinal lies below the +next power of `ω`. The statement includes the zero ordinal through the bottom convention. -/ +theorem cantorDegree_le_coe_iff (a d : NatOrdinal.{u}) : + cantorDegree a ≤ (d : WithBot NatOrdinal) ↔ a < ω^ (d + 1) := by + by_cases ha : a = 0 + · simp [ha, wpow_pos] + rw [cantorDegree_of_ne_zero ha, WithBot.coe_le_coe, of_le_iff, + ← val.lt_iff_lt] + simp only [val_wpow, val_add_one] + rw [Ordinal.lt_opow_iff_log_lt Ordinal.one_lt_omega0 + (val_ne_zero.mpr ha), ← Order.succ_eq_add_one, Order.lt_succ_iff] + +/-- An ordinal's leading Cantor exponent is strictly below `d` exactly when the ordinal lies +below `ω^d`. The statement includes the zero ordinal through the bottom convention. -/ +theorem cantorDegree_lt_coe_iff (a d : NatOrdinal.{u}) : + cantorDegree a < (d : WithBot NatOrdinal) ↔ a < ω^ d := by + by_cases ha : a = 0 + · simp [ha, wpow_pos] + rw [cantorDegree_of_ne_zero ha, WithBot.coe_lt_coe, of_lt_iff, + ← val.lt_iff_lt] + simp only [val_wpow] + exact (Ordinal.lt_opow_iff_log_lt Ordinal.one_lt_omega0 + (val_ne_zero.mpr ha)).symm + +/-- The degree of a Hessenberg sum is the maximum of the degrees. This is LM24, Fact 2.2.2(1), +with the equality noted parenthetically in the paper. -/ +theorem cantorDegree_add (a b : NatOrdinal.{u}) : + cantorDegree (a + b) = max (cantorDegree a) (cantorDegree b) := by + obtain rfl | ha := eq_or_ne a 0 + · simp + obtain rfl | hb := eq_or_ne b 0 + · simp + have hab : a + b ≠ 0 := by simp [ha, hb] + rw [cantorDegree_of_ne_zero hab, cantorDegree_of_ne_zero ha, + cantorDegree_of_ne_zero hb, ← WithBot.coe_max, WithBot.coe_eq_coe] + let da : NatOrdinal := of (Ordinal.log Ordinal.omega0 a.val) + let db : NatOrdinal := of (Ordinal.log Ordinal.omega0 b.val) + change of (Ordinal.log Ordinal.omega0 (a + b).val) = max da db + apply le_antisymm + · rw [← Order.lt_succ_iff, Order.succ_eq_add_one] + have ha_lt : a < ω^ (da + 1) := by + apply val.lt_iff_lt.mp + simp only [val_wpow, val_add_one, da, val_of] + exact Ordinal.lt_opow_succ_log_self Ordinal.one_lt_omega0 a.val + have hb_lt : b < ω^ (db + 1) := by + apply val.lt_iff_lt.mp + simp only [val_wpow, val_add_one, db, val_of] + exact Ordinal.lt_opow_succ_log_self Ordinal.one_lt_omega0 b.val + have ha_max : a < ω^ (max da db + 1) := + ha_lt.trans_le (wpow_le_wpow.mpr (add_le_add (le_max_left da db) le_rfl)) + have hb_max : b < ω^ (max da db + 1) := + hb_lt.trans_le (wpow_le_wpow.mpr (add_le_add (le_max_right da db) le_rfl)) + have hab_lt : a + b < ω^ (max da db + 1) := add_lt_wpow ha_max hb_max + apply val.lt_iff_lt.mp + apply (Ordinal.lt_opow_iff_log_lt' Ordinal.one_lt_omega0 (by simp)).mp + simpa only [val_wpow] using val.lt_iff_lt.mpr hab_lt + · apply max_le + · exact of.monotone + (Ordinal.log_mono_right Ordinal.omega0 (val.monotone le_add_right)) + · exact of.monotone + (Ordinal.log_mono_right Ordinal.omega0 (val.monotone le_add_left)) + +/-- The degree of a Hessenberg sum is at most the maximum of the degrees. This is the inequality +printed as LM24, Fact 2.2.2(1). -/ +theorem cantorDegree_add_le (a b : NatOrdinal.{u}) : + cantorDegree (a + b) ≤ max (cantorDegree a) (cantorDegree b) := + (cantorDegree_add a b).le + +/-- The degree of a Hessenberg product is the Hessenberg sum of the degrees. This is LM24, +Fact 2.2.2(2), including the paper's absorbing convention for `⊥`. -/ +theorem cantorDegree_mul (a b : NatOrdinal.{u}) : + cantorDegree (a * b) = cantorDegree a + cantorDegree b := by + obtain rfl | ha := eq_or_ne a 0 + · simp + obtain rfl | hb := eq_or_ne b 0 + · simp + have hab : a * b ≠ 0 := + (mul_pos (pos_iff_ne_zero.mpr ha) (pos_iff_ne_zero.mpr hb)).ne' + rw [cantorDegree_of_ne_zero hab, cantorDegree_of_ne_zero ha, + cantorDegree_of_ne_zero hb, ← WithBot.coe_add, WithBot.coe_eq_coe] + let da : NatOrdinal := of (Ordinal.log Ordinal.omega0 a.val) + let db : NatOrdinal := of (Ordinal.log Ordinal.omega0 b.val) + change of (Ordinal.log Ordinal.omega0 (a * b).val) = da + db + apply le_antisymm + · rw [← Order.lt_succ_iff, Order.succ_eq_add_one] + have ha_lt : a < ω^ (da + 1) := by + apply val.lt_iff_lt.mp + simp only [val_wpow, val_add_one, da, val_of] + exact Ordinal.lt_opow_succ_log_self Ordinal.one_lt_omega0 a.val + have hb_lt : b < ω^ (db + 1) := by + apply val.lt_iff_lt.mp + simp only [val_wpow, val_add_one, db, val_of] + exact Ordinal.lt_opow_succ_log_self Ordinal.one_lt_omega0 b.val + obtain ⟨n, han⟩ := lt_wpow_add_one_iff.mp ha_lt + obtain ⟨m, hbm⟩ := lt_wpow_add_one_iff.mp hb_lt + have hab_lt : a * b < ω^ (da + db + 1) := by + calc + a * b < (ω^ da * n) * (ω^ db * m) := + mul_lt_mul_of_pos han hbm (pos_iff_ne_zero.mpr ha) + ((pos_iff_ne_zero.mpr hb).trans hbm) + _ = ω^ (da + db) * ((n * m : ℕ) : NatOrdinal) := by + rw [mul_mul_mul_comm, ← Nat.cast_mul, ← wpow_add] + _ < ω^ (da + db + 1) := wpow_mul_natCast_lt (lt_add_one _) (n * m) + apply val.lt_iff_lt.mp + apply (Ordinal.lt_opow_iff_log_lt' Ordinal.one_lt_omega0 (by simp)).mp + simpa only [val_wpow] using val.lt_iff_lt.mpr hab_lt + · have hwa : ω^ da ≤ a := by + apply val.le_iff_le.mp + simp only [val_wpow, da, val_of] + exact Ordinal.opow_log_le_self Ordinal.omega0 (val_ne_zero.mpr ha) + have hwb : ω^ db ≤ b := by + apply val.le_iff_le.mp + simp only [val_wpow, db, val_of] + exact Ordinal.opow_log_le_self Ordinal.omega0 (val_ne_zero.mpr hb) + have hleading : ω^ (da + db) ≤ a * b := by + rw [wpow_add] + exact mul_le_mul hwa hwb bot_le bot_le + apply val_le_iff.mp + apply (Ordinal.opow_le_iff_le_log Ordinal.one_lt_omega0 + (val_ne_zero.mpr hab)).mp + simpa only [val_wpow] using val.monotone hleading + +end NatOrdinal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/FinitePart.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/FinitePart.lean new file mode 100644 index 0000000000..3329a90850 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/FinitePart.lean @@ -0,0 +1,353 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow +public import Mathlib.SetTheory.Ordinal.CantorNormalForm + +/-! +# Finite Cantor coefficients of natural ordinals + +The constant Cantor coefficient of an ordinal is the coefficient of `ω ^ 0` in its Cantor +normal form. For a natural ordinal, this coefficient is a natural number. This module defines it +as the remainder after ordinal division by `ω` and proves that this agrees with Mathlib's Cantor +normal form. + +The complementary `limitPart` is divisible by `ω`. When `n` does not exceed the constant +coefficient, `removeNat a n` removes exactly `n` copies of the constant term; it is characterized +as the unique natural ordinal `b` satisfying `b + n = a`, where addition is Hessenberg addition. + +The final estimate bounds a Hessenberg product of two ordinals of finite Cantor degree. These +elementary facts support finite-degree arguments built on the LM24 degree and graded-ring +machinery. +-/ + +universe u + +public noncomputable section + +namespace Ordinal.CNF + +/-- The coefficient of `ω ^ 0` in the Cantor normal form of `a` is the remainder of `a` modulo +`ω`. -/ +theorem coeff_omega0_zero (a : Ordinal.{u}) : + coeff Ordinal.omega0 a 0 = a % Ordinal.omega0 := by + refine Ordinal.CNF.rec Ordinal.omega0 ?_ (fun o ho IH ↦ ?_) a + · simp + by_cases he : Ordinal.log Ordinal.omega0 o = 0 + · have ho_lt : o < Ordinal.omega0 := by + by_contra h + have hlog := Ordinal.log_pos Ordinal.one_lt_omega0 ho (le_of_not_gt h) + exact (ne_of_gt hlog) he + have hmem : (0, o) ∈ Ordinal.CNF Ordinal.omega0 o := by + rw [Ordinal.CNF.of_lt ho ho_lt] + simp + rw [coeff_of_mem_CNF hmem, Ordinal.mod_eq_of_lt ho_lt] + · have hx : o / Ordinal.omega0 ^ Ordinal.log Ordinal.omega0 o ≠ 0 := + (Ordinal.div_opow_log_pos Ordinal.omega0 ho).ne' + have hcoeff := coeff_opow_mul_add + (b := Ordinal.omega0) (e := Ordinal.log Ordinal.omega0 o) + (x := o / Ordinal.omega0 ^ Ordinal.log Ordinal.omega0 o) + (y := o % Ordinal.omega0 ^ Ordinal.log Ordinal.omega0 o) + Ordinal.one_lt_omega0 hx + (Ordinal.div_opow_log_lt o Ordinal.one_lt_omega0) + (Ordinal.mod_lt o <| Ordinal.opow_ne_zero + (Ordinal.log Ordinal.omega0 o) Ordinal.omega0_ne_zero) + have hdecomp := Ordinal.div_add_mod o + (Ordinal.omega0 ^ Ordinal.log Ordinal.omega0 o) + have hcoeff_zero : + coeff Ordinal.omega0 o 0 = + coeff Ordinal.omega0 + (o % Ordinal.omega0 ^ Ordinal.log Ordinal.omega0 o) 0 := by + calc + coeff Ordinal.omega0 o 0 = + coeff Ordinal.omega0 + (Ordinal.omega0 ^ Ordinal.log Ordinal.omega0 o * + (o / Ordinal.omega0 ^ Ordinal.log Ordinal.omega0 o) + + o % Ordinal.omega0 ^ Ordinal.log Ordinal.omega0 o) 0 := + congrArg (fun z ↦ coeff Ordinal.omega0 z 0) hdecomp.symm + _ = coeff Ordinal.omega0 + (o % Ordinal.omega0 ^ Ordinal.log Ordinal.omega0 o) 0 := by + rw [hcoeff] + simp [he] + rw [hcoeff_zero, IH] + apply Ordinal.mod_mod_of_dvd + simpa using Ordinal.opow_dvd_opow Ordinal.omega0 + (Order.one_le_iff_ne_zero.mpr he) + +end Ordinal.CNF + +namespace NatOrdinal + +/-- The coefficient of `ω ^ 0` in the Cantor normal form of a natural ordinal. -/ +def constantCoeff (a : NatOrdinal.{u}) : ℕ := + Classical.choose <| Ordinal.lt_omega0.mp <| + Ordinal.mod_lt a.val Ordinal.omega0_ne_zero + +/-- The constant Cantor coefficient, coerced to an ordinal, is the remainder modulo `ω`. -/ +@[simp] +theorem coe_constantCoeff (a : NatOrdinal.{u}) : + (a.constantCoeff : Ordinal) = a.val % Ordinal.omega0 := by + exact (Classical.choose_spec (Ordinal.lt_omega0.mp <| + Ordinal.mod_lt a.val Ordinal.omega0_ne_zero)).symm + +/-- `constantCoeff` agrees with Mathlib's coefficient at exponent zero in Cantor normal form. -/ +theorem coe_constantCoeff_eq_CNF_coeff (a : NatOrdinal.{u}) : + (a.constantCoeff : Ordinal) = Ordinal.CNF.coeff Ordinal.omega0 a.val 0 := by + rw [coe_constantCoeff, Ordinal.CNF.coeff_omega0_zero] + +@[simp] +theorem constantCoeff_zero : (0 : NatOrdinal.{u}).constantCoeff = 0 := by + apply Nat.cast_injective (R := Ordinal) + rw [coe_constantCoeff] + simp + +/-- The part of a natural ordinal whose constant Cantor coefficient is zero. -/ +def limitPart (a : NatOrdinal.{u}) : NatOrdinal.{u} := + NatOrdinal.of (Ordinal.omega0 * (a.val / Ordinal.omega0)) + +/-- A natural ordinal is the Hessenberg sum of its limit part and constant coefficient. -/ +theorem limitPart_add_constantCoeff (a : NatOrdinal.{u}) : + a.limitPart + a.constantCoeff = a := by + apply NatOrdinal.val.injective + rw [limitPart, val_add_natCast, val_of, coe_constantCoeff] + exact Ordinal.div_add_mod a.val Ordinal.omega0 + +/-- A natural ordinal is a successor prelimit exactly when its constant Cantor coefficient +vanishes. -/ +theorem isSuccPrelimit_iff_constantCoeff_eq_zero (a : NatOrdinal.{u}) : + Order.IsSuccPrelimit a ↔ a.constantCoeff = 0 := by + change Order.IsSuccPrelimit a.val ↔ _ + rw [Ordinal.isSuccPrelimit_iff_omega0_dvd, + Ordinal.dvd_iff_mod_eq_zero, ← coe_constantCoeff] + norm_cast + +/-- A positive power of `ω` has zero constant Cantor coefficient. -/ +theorem constantCoeff_wpow {a : NatOrdinal.{u}} (ha : a ≠ 0) : + (ω^ a).constantCoeff = 0 := by + rw [← isSuccPrelimit_iff_constantCoeff_eq_zero] + change Order.IsSuccPrelimit (ω^ a).val + rw [NatOrdinal.val_wpow, Ordinal.isSuccPrelimit_iff_omega0_dvd] + have hval : a.val ≠ 0 := by + intro hval + apply ha + apply NatOrdinal.val.injective + simpa using hval + simpa only [Ordinal.opow_one] using + Ordinal.opow_dvd_opow Ordinal.omega0 + (Order.one_le_iff_ne_zero.mpr hval) + +/-- The Hessenberg sum of two successor prelimits is a successor prelimit. -/ +theorem isSuccPrelimit_add {a b : NatOrdinal.{u}} + (ha : Order.IsSuccPrelimit a) (hb : Order.IsSuccPrelimit b) : + Order.IsSuccPrelimit (a + b) := by + rw [Order.isSuccPrelimit_iff_succ_lt] + intro c hc + rcases NatOrdinal.lt_add_iff.mp hc with + ⟨a', ha', hca⟩ | ⟨b', hb', hcb⟩ + · calc + Order.succ c ≤ Order.succ (a' + b) := Order.succ_mono hca + _ = (a' + b) + 1 := Order.succ_eq_add_one _ + _ = (a' + 1) + b := by ac_rfl + _ < a + b := by + simpa [add_comm] using add_lt_add_right (ha.add_one_lt ha') b + · calc + Order.succ c ≤ Order.succ (a + b') := Order.succ_mono hcb + _ = (a + b') + 1 := Order.succ_eq_add_one _ + _ = a + (b' + 1) := by ac_rfl + _ < a + b := by + simpa [add_comm] using add_lt_add_left (hb.add_one_lt hb') a + +/-- The limit part of a natural ordinal is a successor prelimit. -/ +theorem isSuccPrelimit_limitPart (a : NatOrdinal.{u}) : + Order.IsSuccPrelimit a.limitPart := by + rw [isSuccPrelimit_iff_constantCoeff_eq_zero] + apply Nat.cast_injective (R := Ordinal) + rw [coe_constantCoeff, limitPart, val_of, Ordinal.mul_mod] + simp + +/-- Adding a finite natural ordinal adds it to the constant Cantor coefficient. -/ +theorem constantCoeff_add_natCast (a : NatOrdinal.{u}) (n : ℕ) : + (a + n).constantCoeff = a.constantCoeff + n := by + apply Nat.cast_injective (R := Ordinal) + rw [coe_constantCoeff, val_add_natCast, Nat.cast_add, coe_constantCoeff] + nth_rw 1 [← Ordinal.div_add_mod a.val Ordinal.omega0] + rw [add_assoc, Ordinal.mul_add_mod_self, + Ordinal.mod_eq_of_lt + (Ordinal.isSuccLimit_omega0.add_natCast_lt + (Ordinal.mod_lt a.val Ordinal.omega0_ne_zero) n)] + +/-- The constant Cantor coefficient of a finite natural ordinal is that natural number. -/ +@[simp] +theorem constantCoeff_natCast (n : ℕ) : + (n : NatOrdinal.{u}).constantCoeff = n := by + simpa using constantCoeff_add_natCast (0 : NatOrdinal.{u}) n + +/-- Hessenberg addition adds constant Cantor coefficients. -/ +theorem constantCoeff_add (a b : NatOrdinal.{u}) : + (a + b).constantCoeff = a.constantCoeff + b.constantCoeff := by + have hbase : Order.IsSuccPrelimit (a.limitPart + b.limitPart) := + isSuccPrelimit_add (isSuccPrelimit_limitPart a) (isSuccPrelimit_limitPart b) + have hzero : (a.limitPart + b.limitPart).constantCoeff = 0 := + (isSuccPrelimit_iff_constantCoeff_eq_zero _).mp hbase + have hdecomp : + a + b = (a.limitPart + b.limitPart) + + (a.constantCoeff + b.constantCoeff : ℕ) := by + calc + a + b = (a.limitPart + a.constantCoeff) + + (b.limitPart + b.constantCoeff) := by + rw [limitPart_add_constantCoeff, limitPart_add_constantCoeff] + _ = (a.limitPart + b.limitPart) + + (a.constantCoeff + b.constantCoeff : ℕ) := by + rw [Nat.cast_add] + ac_rfl + rw [hdecomp, constantCoeff_add_natCast, hzero, zero_add] + +/-- Remove `n` copies of the constant Cantor term. This operation represents finite ordinal +predecessor only under the hypothesis `n ≤ a.constantCoeff`. -/ +def removeNat (a : NatOrdinal.{u}) (n : ℕ) : NatOrdinal.{u} := + a.limitPart + (a.constantCoeff - n : ℕ) + +/-- Removing `n` copies of the constant term subtracts `n` from the constant coefficient. -/ +theorem constantCoeff_removeNat (a : NatOrdinal.{u}) (n : ℕ) : + (a.removeNat n).constantCoeff = a.constantCoeff - n := by + rw [removeNat, constantCoeff_add_natCast, + (isSuccPrelimit_iff_constantCoeff_eq_zero _).mp + (isSuccPrelimit_limitPart a), zero_add] + +/-- If `n` does not exceed the constant coefficient, adding `n` after removing it recovers the +original natural ordinal. -/ +theorem removeNat_add_natCast {a : NatOrdinal.{u}} {n : ℕ} + (hn : n ≤ a.constantCoeff) : a.removeNat n + n = a := by + rw [removeNat] + calc + a.limitPart + ↑(a.constantCoeff - n) + ↑n = + a.limitPart + ↑((a.constantCoeff - n) + n) := by + rw [Nat.cast_add] + ac_rfl + _ = a.limitPart + a.constantCoeff := by rw [Nat.sub_add_cancel hn] + _ = a := limitPart_add_constantCoeff a + +/-- Removing zero copies of the constant term leaves a natural ordinal unchanged. -/ +@[simp] +theorem removeNat_zero (a : NatOrdinal.{u}) : a.removeNat 0 = a := by + simpa using removeNat_add_natCast (a := a) (n := 0) (Nat.zero_le a.constantCoeff) + +/-- Finite removal is the unique solution to addition by the removed natural ordinal. -/ +theorem eq_removeNat_iff_add_natCast_eq {a eta : NatOrdinal.{u}} {n : ℕ} + (hn : n ≤ a.constantCoeff) : eta = a.removeNat n ↔ eta + n = a := by + constructor + · rintro rfl + exact removeNat_add_natCast hn + · intro heta + apply add_right_cancel (b := (n : NatOrdinal)) + rw [heta, removeNat_add_natCast hn] + +/-- Removing a finite constant term from the left summand commutes with adding a right summand. -/ +theorem removeNat_add_right (a b : NatOrdinal.{u}) {n : ℕ} + (hn : n ≤ a.constantCoeff) : + (a + b).removeNat n = a.removeNat n + b := by + apply add_right_cancel (b := (n : NatOrdinal)) + rw [removeNat_add_natCast (hn.trans <| by + rw [constantCoeff_add] + exact Nat.le_add_right _ _)] + symm + calc + a.removeNat n + b + n = a.removeNat n + n + b := by ac_rfl + _ = a + b := by rw [removeNat_add_natCast hn] + +/-- Finite predecessor in the left summand commutes with adding a right summand. -/ +theorem removeOne_add_right (a b : NatOrdinal.{u}) (ha : 0 < a.constantCoeff) : + (a + b).removeNat 1 = a.removeNat 1 + b := + removeNat_add_right a b ha + +/-- If `a < ω ^ (p + 1)` and `b < ω ^ (q + 1)`, then their Hessenberg product is less than +`ω ^ (p + q + 1)`. -/ +theorem mul_lt_wpow_natCast_add_one {a b : NatOrdinal.{u}} {p q : ℕ} + (ha : a < ω^ ((p + 1 : ℕ) : NatOrdinal)) + (hb : b < ω^ ((q + 1 : ℕ) : NatOrdinal)) : + a * b < ω^ ((p + q + 1 : ℕ) : NatOrdinal) := by + have ha' : a < ω^ ((p : NatOrdinal) + 1) := by simpa using ha + have hb' : b < ω^ ((q : NatOrdinal) + 1) := by simpa using hb + obtain ⟨n, han⟩ := NatOrdinal.lt_wpow_add_one_iff.mp ha' + obtain ⟨m, hbm⟩ := NatOrdinal.lt_wpow_add_one_iff.mp hb' + by_cases haZero : a = 0 + · subst a + simp + by_cases hbZero : b = 0 + · subst b + simp + have hnZero : n ≠ 0 := by + intro hn + subst n + simp at han + have hboundPos : 0 < ω^ (p : NatOrdinal) * n := by + apply mul_pos (NatOrdinal.wpow_pos _) + exact_mod_cast Nat.pos_of_ne_zero hnZero + have hproduct : + a * b < (ω^ (p : NatOrdinal) * n) * (ω^ (q : NatOrdinal) * m) := by + calc + a * b < (ω^ (p : NatOrdinal) * n) * b := + mul_lt_mul_of_pos_right han (pos_iff_ne_zero.mpr hbZero) + _ < (ω^ (p : NatOrdinal) * n) * (ω^ (q : NatOrdinal) * m) := + mul_lt_mul_of_pos_left hbm hboundPos + have hrewrite : + (ω^ (p : NatOrdinal) * n) * (ω^ (q : NatOrdinal) * m) = + ω^ ((p + q : ℕ) : NatOrdinal) * (n * m) := by + rw [Nat.cast_add, NatOrdinal.wpow_add] + ac_rfl + rw [hrewrite] at hproduct + have hnext : + ω^ ((p + q : ℕ) : NatOrdinal) * (n * m : ℕ) < + ω^ ((p + q + 1 : ℕ) : NatOrdinal) := by + apply NatOrdinal.wpow_mul_natCast_lt + exact_mod_cast Nat.lt_succ_self (p + q) + exact hproduct.trans (by simpa only [Nat.cast_mul] using hnext) + +/-- The constant Cantor coefficient of an `r`-fold Hessenberg sum is `r` times the constant +Cantor coefficient. -/ +theorem constantCoeff_nsmul (r : ℕ) (alpha : NatOrdinal.{u}) : + (r • alpha).constantCoeff = r * alpha.constantCoeff := by + induction r with + | zero => simp + | succ r ih => + rw [succ_nsmul, constantCoeff_add, ih, Nat.succ_mul] + +/-- For a natural ordinal with positive constant Cantor coefficient, removing one constant term +from an `r`-fold Hessenberg sum removes it from a single summand. -/ +theorem removeNat_one_nsmul {alpha : NatOrdinal.{u}} + (halpha : 0 < alpha.constantCoeff) {r : ℕ} (hr : 1 ≤ r) : + alpha.removeNat 1 + (r - 1) • alpha = (r • alpha).removeNat 1 := by + obtain ⟨s, rfl⟩ : ∃ s, r = s + 1 := ⟨r - 1, by omega⟩ + have hcc : 1 ≤ ((s + 1) • alpha).constantCoeff := by + rw [constantCoeff_nsmul] + exact Nat.one_le_iff_ne_zero.mpr (Nat.mul_ne_zero (by omega) (by omega)) + rw [eq_removeNat_iff_add_natCast_eq hcc] + have hsimp : s + 1 - 1 = s := by omega + rw [hsimp] + calc + alpha.removeNat 1 + s • alpha + ((1 : ℕ) : NatOrdinal) + = (alpha.removeNat 1 + ((1 : ℕ) : NatOrdinal)) + s • alpha := by ac_rfl + _ = alpha + s • alpha := by rw [removeNat_add_natCast halpha] + _ = (s + 1) • alpha := by rw [succ_nsmul, add_comm] + +/-- Removing one constant term and then `j - 1` further ones removes `j` constant terms. -/ +theorem removeNat_one_removeNat_pred {delta : NatOrdinal.{u}} {j : ℕ} + (hjpos : 1 ≤ j) (hj : j ≤ delta.constantCoeff) : + (delta.removeNat 1).removeNat (j - 1) = delta.removeNat j := by + have hone : 1 ≤ delta.constantCoeff := hjpos.trans hj + have hpred : j - 1 ≤ (delta.removeNat 1).constantCoeff := by + rw [constantCoeff_removeNat] + omega + have hsplit : ((j : ℕ) : NatOrdinal) = + ((j - 1 : ℕ) : NatOrdinal) + ((1 : ℕ) : NatOrdinal) := by + rw [← Nat.cast_add] + congr 1 + omega + rw [eq_removeNat_iff_add_natCast_eq hj, hsplit, ← add_assoc, + removeNat_add_natCast hpred, removeNat_add_natCast hone] + +end NatOrdinal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/GeneralFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/GeneralFactorization.lean new file mode 100644 index 0000000000..1fa5ff2fa0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/GeneralFactorization.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.MultiplicativelyPrincipal + +/-! +# Canonical multiplicative factors of a power of `ω`, at every exponent + +The canonical multiplicatively principal factors of `ω ^ α` are `ω` raised to the Cantor terms +of `α`, so the residual factor deletes the least such term. `SuccessorFactorization` is the +case of positive constant Cantor coefficient, where deleting the least term is deleting `1`. +-/ + +open Ordinal List + +universe u + +public noncomputable section + +namespace Ordinal + +private theorem dropLast_map_opow (l : List Ordinal.{u}) : + (l.map (fun a ↦ omega0 ^ a)).dropLast = l.dropLast.map (fun a ↦ omega0 ^ a) := by + induction l with + | nil => simp + | cons a t ih => + cases t with + | nil => simp + | cons b u => simp + +private theorem prod_map_opow (l : List Ordinal.{u}) : + (l.map (fun a ↦ omega0 ^ a)).prod = omega0 ^ l.sum := by + induction l with + | nil => simp + | cons a t ih => rw [List.map_cons, List.prod_cons, ih, List.sum_cons, opow_add] + +theorem multiplicativePrincipalFactors_omega0_opow (alpha : Ordinal.{u}) : + (omega0 ^ alpha).multiplicativePrincipalFactors = + alpha.additivePrincipalTerms.map (fun a ↦ omega0 ^ a) := by + symm + apply multiplicativePrincipalFactors_unique + · exact isAdditivelyPrincipal_omega0_opow alpha + · rw [prod_map_opow, additivePrincipalTerms_sum] + · intro f hf + rw [List.mem_map] at hf + obtain ⟨a, ha, rfl⟩ := hf + obtain ⟨e, rfl⟩ := + isAdditivelyPrincipal_iff.mp (isAdditivelyPrincipal_of_mem_additivePrincipalTerms ha) + exact isMultiplicativelyPrincipal_omega0_opow_opow e + · intro f hf + rw [List.mem_map] at hf + obtain ⟨a, ha, rfl⟩ := hf + obtain ⟨e, rfl⟩ := + isAdditivelyPrincipal_iff.mp (isAdditivelyPrincipal_of_mem_additivePrincipalTerms ha) + calc (1 : Ordinal) < omega0 := one_lt_omega0 + _ = omega0 ^ (1 : Ordinal) := (opow_one _).symm + _ ≤ omega0 ^ (omega0 ^ e) := + opow_le_opow_right omega0_pos (Order.one_le_iff_pos.mpr (opow_pos e omega0_pos)) + · have hs := additivePrincipalTerms_sortedGE alpha + rw [List.sortedGE_iff_pairwise] at hs ⊢ + exact hs.map _ fun _ _ hxy ↦ opow_le_opow_right omega0_pos hxy + +theorem residualFactor_omega0_opow (alpha : Ordinal.{u}) + (hadd : IsAdditivelyPrincipal (omega0 ^ alpha)) (hone : 1 < omega0 ^ alpha) : + AdditivePrincipalAboveOne.residualFactor ⟨omega0 ^ alpha, hadd, hone⟩ = + omega0 ^ alpha.additivePrincipalTerms.dropLast.sum := by + rw [AdditivePrincipalAboveOne.residualFactor_eq_dropLast_prod, + multiplicativePrincipalFactors_omega0_opow, dropLast_map_opow, prod_map_opow] + +theorem principalFactor_omega0_opow (alpha : Ordinal.{u}) + (hadd : IsAdditivelyPrincipal (omega0 ^ alpha)) (hone : 1 < omega0 ^ alpha) + (hne : alpha.additivePrincipalTerms ≠ []) : + AdditivePrincipalAboveOne.principalFactor ⟨omega0 ^ alpha, hadd, hone⟩ = + omega0 ^ alpha.additivePrincipalTerms.getLast hne := by + rw [AdditivePrincipalAboveOne.principalFactor_eq_getLast] + simp only [multiplicativePrincipalFactors_omega0_opow] + exact List.getLast_map _ + +end Ordinal + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/IncreasingSequenceUnion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/IncreasingSequenceUnion.lean new file mode 100644 index 0000000000..f717565798 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/IncreasingSequenceUnion.lean @@ -0,0 +1,298 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +public import Mathlib.SetTheory.Ordinal.Arithmetic +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPrincipal + +/-! +# The union of an increasing sequence of well-ordered sets + +A sequence `Y_0 < Y_1 < Y_2 < ⋯` of subsets of a linear order (Lean `B : ℕ → Set α`) is +*increasing* if every element of a later member lies strictly above every element of an earlier +one (the hypothesis `hord`). The union of an increasing sequence of partially well-ordered sets is +partially well ordered (`iUnion_of_ordered`): a strictly decreasing sequence in the union has +non-increasing indices of members, so from some point on it lies in a single member. Its order type +is bounded by any ordinal greater than every finite Hessenberg sum of copies of `ρ` when every +member has order type at most `ρ` (`orderType_iUnion_le_of_ordered`), and at most `ω^e` when every +member has order type below `ω^e` +(`orderType_iUnion_le_wpow_of_ordered`). + +[Ber00, Lem. 4.1] is the case of two sets; [Ber00, Lem. 4.7], formalised in +`ConwayRefinement.SetTheory.Ordinal.OrderedUnion`, bounds a union indexed by an ordinal +from below. +-/ + +universe u v + +open Order Ordinal +open scoped NatOrdinal + +public noncomputable section + +namespace Set.IsPWO + +variable {α : Type u} [LinearOrder α] {B : ℕ → Set α} + +/-- The union of a family of partially well-ordered sets, ordered by a partially well-ordered +linear index, is partially well ordered. -/ +theorem iUnion_of_ordered_index {ι : Type v} [LinearOrder ι] + (hι : (Set.univ : Set ι).IsPWO) (B : ι → Set α) (hB : ∀ i, (B i).IsPWO) + (hord : ∀ i j, i < j → ∀ x ∈ B i, ∀ y ∈ B j, x < y) : + (⋃ i, B i).IsPWO := by + classical + rw [Set.isPWO_iff_isWF, Set.isWF_iff_no_descending_seq] + intro f hf hmem + have hidx : ∀ n, ∃ i, f n ∈ B i := fun n ↦ Set.mem_iUnion.mp (hmem n) + choose idx hidx using hidx + have hanti : ∀ m n, m ≤ n → idx n ≤ idx m := by + intro m n hmn + by_contra hlt + rw [not_le] at hlt + rcases eq_or_lt_of_le hmn with rfl | hmn' + · exact hlt.false + · exact absurd (hord _ _ hlt (f m) (hidx m) (f n) (hidx n)) (hf hmn').not_gt + have hrange : (Set.range idx).IsWF := + Set.IsWF.mono hι.isWF (Set.subset_univ (Set.range idx)) + have hrange_ne : (Set.range idx).Nonempty := Set.range_nonempty idx + obtain ⟨N, hNval⟩ := hrange.min_mem hrange_ne + have hNval' : idx N = hrange.min hrange_ne := hNval + have hN : ∀ n, N ≤ n → idx n = idx N := by + intro n hn + exact le_antisymm (hanti N n hn) + (not_lt.mp fun h ↦ hrange.not_lt_min hrange_ne ⟨n, rfl⟩ (hNval' ▸ h)) + have htail : ∀ n, f (N + n) ∈ B (idx N) := fun n ↦ by + have := hidx (N + n) + rwa [hN (N + n) (Nat.le_add_right N n)] at this + have hstrict : StrictAnti fun n ↦ f (N + n) := fun m n hmn ↦ hf (by omega) + exact (Set.isWF_iff_no_descending_seq.mp (hB (idx N)).isWF) _ hstrict htail + +/-- The members of an increasing sequence of sets are pairwise disjoint. -/ +theorem ordered_disjoint (hord : ∀ j k, j < k → ∀ x ∈ B j, ∀ y ∈ B k, x < y) {j k : ℕ} + (hjk : j ≠ k) {x : α} (hj : x ∈ B j) (hk : x ∈ B k) : False := by + rcases hjk.lt_or_gt with h | h + · exact (hord j k h x hj x hk).false + · exact (hord k j h x hk x hj).false + +/-- An element of the union of an increasing sequence of sets lies in exactly one member. -/ +theorem exists_unique_index (hord : ∀ j k, j < k → ∀ x ∈ B j, ∀ y ∈ B k, x < y) {x : α} + (hx : x ∈ ⋃ k, B k) : ∃! k, x ∈ B k := by + obtain ⟨k, hk⟩ := Set.mem_iUnion.mp hx + exact ⟨k, hk, fun j hj ↦ by + by_contra hne + exact ordered_disjoint hord hne hj hk⟩ + +/-- The union of an ordered sequence of well-ordered subsets of a linear order is well ordered. -/ +@[blueprint "lem:increasing-union" + (phase := "Algebraic and ordinal preliminaries") + (title := "Well-ordering of a countable ordered union") + (statement := /-- + Let $(Y_n)$ be well-ordered subsets of a linear order, and suppose $x simp + | succ n ih => + have : (⋃ k ∈ Finset.range (n + 1), B k) = (⋃ k ∈ Finset.range n, B k) ∪ B n := by + ext x + simp only [Set.mem_iUnion, Finset.mem_range, Set.mem_union, exists_prop] + constructor + · rintro ⟨k, hk, hx⟩ + rcases Nat.lt_succ_iff_lt_or_eq.mp hk with hk | rfl + · exact Or.inl ⟨k, hk, hx⟩ + · exact Or.inr hx + · rintro (⟨k, hk, hx⟩ | hx) + · exact ⟨k, by omega, hx⟩ + · exact ⟨n, by omega, hx⟩ + rw [this] + exact ih.union (hB n) + +/-- The order type of the union of the first `n` members is at most the natural sum of `n` copies +of a common bound `ρ`. -/ +private theorem orderType_iUnion_lt_le (hB : ∀ k, (B k).IsPWO) (hρ : ∀ k, (hB k).orderType ≤ ρ) + (n : ℕ) : (isPWO_iUnion_lt hB n).orderType ≤ (n • NatOrdinal.of ρ).val := by + classical + induction n with + | zero => + have hempty : (⋃ k ∈ Finset.range 0, B k) = (∅ : Set α) := by simp + rw [Set.IsPWO.orderType_congr _ (Set.isPWO_empty) hempty, zero_nsmul] + simp [(Set.isPWO_empty (α := α)).orderType_eq_zero.mpr rfl] + | succ n ih => + have hsplit : (⋃ k ∈ Finset.range (n + 1), B k) = (⋃ k ∈ Finset.range n, B k) ∪ B n := by + ext x + simp only [Set.mem_iUnion, Finset.mem_range, Set.mem_union, exists_prop] + constructor + · rintro ⟨k, hk, hx⟩ + rcases Nat.lt_succ_iff_lt_or_eq.mp hk with hk | rfl + · exact Or.inl ⟨k, hk, hx⟩ + · exact Or.inr hx + · rintro (⟨k, hk, hx⟩ | hx) + · exact ⟨k, by omega, hx⟩ + · exact ⟨n, by omega, hx⟩ + rw [Set.IsPWO.orderType_congr _ ((isPWO_iUnion_lt hB n).union (hB n)) hsplit] + refine ((isPWO_iUnion_lt hB n).orderType_union_le_naturalAdd (hB n)).trans ?_ + rw [succ_nsmul] + exact NatOrdinal.val.le_iff_le.mpr + (add_le_add (NatOrdinal.of.le_iff_le.mpr ih) (NatOrdinal.of.le_iff_le.mpr (hρ n))) + +/-- **The order type of the union of an increasing sequence of sets** is at most any `o` exceeding +every natural sum of finitely many copies of a common bound `ρ` on the order types of the +members. -/ +@[blueprint "lem:increasing-union-order-type" + (phase := "Algebraic and ordinal preliminaries") + (title := "Order type of a countable ordered union") + (statement := /-- + Let $(Y_n)$ be well-ordered subsets of a linear order, and suppose $x + have hempty : (⋃ k ∈ Finset.range 0, B k) = (∅ : Set α) := by simp + rw [Set.IsPWO.orderType_congr _ (Set.isPWO_empty) hempty, + (Set.isPWO_empty (α := α)).orderType_eq_zero.mpr rfl] + exact Ordinal.opow_pos _ Ordinal.omega0_pos + | succ n ih => + have hsplit : (⋃ k ∈ Finset.range (n + 1), B k) = (⋃ k ∈ Finset.range n, B k) ∪ B n := by + ext x + simp only [Set.mem_iUnion, Finset.mem_range, Set.mem_union, exists_prop] + constructor + · rintro ⟨k, hk, hx⟩ + rcases Nat.lt_succ_iff_lt_or_eq.mp hk with hk | rfl + · exact Or.inl ⟨k, hk, hx⟩ + · exact Or.inr hx + · rintro (⟨k, hk, hx⟩ | hx) + · exact ⟨k, by omega, hx⟩ + · exact ⟨n, by omega, hx⟩ + rw [Set.IsPWO.orderType_congr _ ((isPWO_iUnion_lt hB n).union (hB n)) hsplit] + refine ((isPWO_iUnion_lt hB n).orderType_union_le_naturalAdd (hB n)).trans_lt ?_ + have h1 : NatOrdinal.of (isPWO_iUnion_lt hB n).orderType < ω^ e := by + rw [← NatOrdinal.of_val (ω^ e)] + exact NatOrdinal.of.lt_iff_lt.mpr ih + have h2 : NatOrdinal.of (hB n).orderType < ω^ e := by + rw [← NatOrdinal.of_val (ω^ e)] + exact NatOrdinal.of.lt_iff_lt.mpr (hρ n) + exact NatOrdinal.val.lt_iff_lt.mpr (NatOrdinal.add_lt_wpow h1 h2) + refine hU.orderType_le_of_forall_inter_Iic_lt fun x hx ↦ ?_ + obtain ⟨k, hk⟩ := Set.mem_iUnion.mp hx + have hsub : (⋃ j, B j) ∩ Set.Iic x ⊆ ⋃ j ∈ Finset.range (k + 1), B j := by + rintro y ⟨hy, hyx⟩ + obtain ⟨j, hj⟩ := Set.mem_iUnion.mp hy + refine Set.mem_iUnion.mpr ⟨j, Set.mem_iUnion.mpr ⟨?_, hj⟩⟩ + rw [Finset.mem_range] + by_contra hjk + rw [not_lt, Nat.succ_le_iff] at hjk + exact absurd (hord k j hjk x hk y hj) (not_lt.mpr hyx) + calc (hU.mono (s := (⋃ j, B j) ∩ Set.Iic x) Set.inter_subset_left).orderType + ≤ (isPWO_iUnion_lt hB (k + 1)).orderType := + Set.IsPWO.orderType_mono _ _ hsub + _ < (ω^ e).val := hfin (k + 1) + +end Set.IsPWO diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/LeastTerm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/LeastTerm.lean new file mode 100644 index 0000000000..95f02e543e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/LeastTerm.lean @@ -0,0 +1,445 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorTermCount +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart + +/-! +# Deleting the least Cantor term + +The least additive-principal term of a natural ordinal, its deletion, and the properties of +that deletion: it splits a nonzero grade as `removeLeastTerm a + leastTerm a = a`, it drops +`cantorTermCount` by exactly one, and it agrees with `NatOrdinal.removeNat _ 1` exactly on the +grades carrying a finite part. +-/ + +open Ordinal + +universe u + +public noncomputable section + +namespace NatOrdinal + +def leastTerm (a : NatOrdinal.{u}) : NatOrdinal.{u} := + NatOrdinal.of (a.val.additivePrincipalTerms.getLastD 0) + +def removeLeastTerm (a : NatOrdinal.{u}) : NatOrdinal.{u} := + NatOrdinal.of a.val.additivePrincipalTerms.dropLast.sum + +@[simp] +theorem val_removeLeastTerm (a : NatOrdinal.{u}) : + (removeLeastTerm a).val = a.val.additivePrincipalTerms.dropLast.sum := by + rw [removeLeastTerm, NatOrdinal.val_of] + +@[simp] +theorem leastTerm_zero : leastTerm (0 : NatOrdinal.{u}) = 0 := by + rw [leastTerm, show (0 : NatOrdinal.{u}).val = 0 from rfl, + Ordinal.additivePrincipalTerms_zero] + rfl + +@[simp] +theorem removeLeastTerm_zero : removeLeastTerm (0 : NatOrdinal.{u}) = 0 := by + rw [removeLeastTerm, show (0 : NatOrdinal.{u}).val = 0 from rfl, + Ordinal.additivePrincipalTerms_zero] + rfl + +theorem additivePrincipalTerms_ne_nil {a : NatOrdinal.{u}} (ha : a ≠ 0) : + a.val.additivePrincipalTerms ≠ [] := by + intro hnil + apply ha + apply NatOrdinal.val.injective + have hsum := Ordinal.additivePrincipalTerms_sum a.val + rw [hnil] at hsum + simpa using hsum.symm + +theorem val_leastTerm {a : NatOrdinal.{u}} (hne : a.val.additivePrincipalTerms ≠ []) : + (leastTerm a).val = a.val.additivePrincipalTerms.getLast hne := by + rw [leastTerm, NatOrdinal.val_of, List.getLastD_eq_getLast?, + List.getLast?_eq_some_getLast hne] + rfl + +theorem isAdditivelyPrincipal_leastTerm {a : NatOrdinal.{u}} (ha : a ≠ 0) : + IsAdditivelyPrincipal (leastTerm a).val := by + rw [val_leastTerm (additivePrincipalTerms_ne_nil ha)] + exact Ordinal.isAdditivelyPrincipal_of_mem_additivePrincipalTerms + (List.getLast_mem _) + +theorem removeLeastTerm_add_leastTerm (a : NatOrdinal.{u}) : + removeLeastTerm a + leastTerm a = a := by + rcases eq_or_ne a 0 with rfl | ha + · simp + have hne : a.val.additivePrincipalTerms ≠ [] := additivePrincipalTerms_ne_nil ha + set l := a.val.additivePrincipalTerms with hl + have hsplit : l.dropLast ++ [l.getLast hne] = l := List.dropLast_append_getLast hne + have hprincipal : ∀ x ∈ l, IsAdditivelyPrincipal x := fun _ hx ↦ + Ordinal.isAdditivelyPrincipal_of_mem_additivePrincipalTerms hx + have hsorted : l.SortedGE := Ordinal.additivePrincipalTerms_sortedGE a.val + have hdropPrincipal : ∀ x ∈ l.dropLast, IsAdditivelyPrincipal x := fun _ hx ↦ + hprincipal _ (List.dropLast_subset _ hx) + have hdropSorted : l.dropLast.SortedGE := by + rw [List.sortedGE_iff_pairwise] at hsorted ⊢ + exact hsorted.sublist (List.dropLast_sublist _) + apply NatOrdinal.val.injective + have hmain : NatOrdinal.of l.sum = removeLeastTerm a + leastTerm a := by + rw [Ordinal.natOrdinal_of_sum_eq_sum_map_of_sorted hprincipal hsorted] + conv_lhs => rw [← hsplit] + rw [List.map_append, List.sum_append] + congr 1 + · rw [removeLeastTerm, ← hl, + Ordinal.natOrdinal_of_sum_eq_sum_map_of_sorted hdropPrincipal hdropSorted] + · show (List.map (⇑NatOrdinal.of) [l.getLast hne]).sum = leastTerm a + simp only [List.map_cons, List.map_nil, List.sum_cons, List.sum_nil, add_zero] + apply NatOrdinal.val.injective + rw [NatOrdinal.val_of, val_leastTerm hne] + rw [← hmain, NatOrdinal.val_of, hl] + exact Ordinal.additivePrincipalTerms_sum a.val + +theorem cantorTermCount_leastTerm {a : NatOrdinal.{u}} (ha : a ≠ 0) : + cantorTermCount (leastTerm a) = 1 := by + have hself : leastTerm a = NatOrdinal.of (leastTerm a).val := rfl + rw [hself, cantorTermCount_of, + Ordinal.additivePrincipalTerms_of_isAdditivelyPrincipal + (isAdditivelyPrincipal_leastTerm ha)] + rfl + +theorem cantorTermCount_removeLeastTerm {a : NatOrdinal.{u}} (ha : a ≠ 0) : + cantorTermCount (removeLeastTerm a) + 1 = cantorTermCount a := by + conv_rhs => rw [← removeLeastTerm_add_leastTerm a] + rw [cantorTermCount_add, cantorTermCount_leastTerm ha] + +theorem cantorTermCount_removeLeastTerm_lt {a : NatOrdinal.{u}} (ha : a ≠ 0) : + cantorTermCount (removeLeastTerm a) < cantorTermCount a := by + rw [← cantorTermCount_removeLeastTerm ha] + omega + +theorem removeLeastTerm_eq_zero_iff {a : NatOrdinal.{u}} (ha : a ≠ 0) : + removeLeastTerm a = 0 ↔ cantorTermCount a = 1 := by + constructor + · intro hzero + have hcount := cantorTermCount_removeLeastTerm ha + rw [hzero, cantorTermCount_zero] at hcount + omega + · intro hone + have hcount := cantorTermCount_removeLeastTerm ha + rw [hone] at hcount + exact cantorTermCount_eq_zero.mp (by omega) + +theorem cantorTermCount_eq_one_iff {a : NatOrdinal.{u}} (ha : a ≠ 0) : + cantorTermCount a = 1 ↔ Ordinal.IsAdditivelyPrincipal a.val := by + constructor + · intro hone + have hne := additivePrincipalTerms_ne_nil ha + have hlen : a.val.additivePrincipalTerms.length = 1 := by + have hself : a = NatOrdinal.of a.val := rfl + rw [hself, cantorTermCount_of] at hone + exact hone + obtain ⟨x, hx⟩ := List.length_eq_one_iff.mp hlen + have hsum := Ordinal.additivePrincipalTerms_sum a.val + rw [hx, List.sum_cons, List.sum_nil, add_zero] at hsum + rw [← hsum] + exact Ordinal.isAdditivelyPrincipal_of_mem_additivePrincipalTerms + (by rw [hx]; simp) + · intro hprin + have hself : a = NatOrdinal.of a.val := rfl + rw [hself, cantorTermCount_of, + Ordinal.additivePrincipalTerms_of_isAdditivelyPrincipal hprin] + rfl + +/-! ### The least term of a sum -/ + +private theorem getLast_le_of_mem : + ∀ (l : List Ordinal.{u}), l.SortedGE → ∀ (hne : l ≠ []) (y : Ordinal.{u}), + y ∈ l → l.getLast hne ≤ y := by + intro l + induction l with + | nil => intro _ hne; exact absurd rfl hne + | cons c t ih => + intro hs hne y hy + cases t with + | nil => + rw [List.mem_singleton] at hy + subst hy + simp + | cons d u => + have hcons : (d :: u) ≠ [] := by simp + rw [List.getLast_cons hcons] + have hpair := List.sortedGE_iff_pairwise.mp hs + have hst : (d :: u).SortedGE := + List.sortedGE_iff_pairwise.mpr hpair.tail + rcases List.mem_cons.mp hy with rfl | hy' + · exact List.rel_of_pairwise_cons hpair (List.getLast_mem hcons) + · exact ih hst hcons y hy' + +theorem val_leastTerm_mem {a : NatOrdinal.{u}} (ha : a ≠ 0) : + (leastTerm a).val ∈ a.val.additivePrincipalTerms := by + rw [val_leastTerm (additivePrincipalTerms_ne_nil ha)] + exact List.getLast_mem _ + +theorem val_leastTerm_le_of_mem {a : NatOrdinal.{u}} (ha : a ≠ 0) + {y : Ordinal.{u}} (hy : y ∈ a.val.additivePrincipalTerms) : + (leastTerm a).val ≤ y := by + rw [val_leastTerm (additivePrincipalTerms_ne_nil ha)] + exact getLast_le_of_mem _ (Ordinal.additivePrincipalTerms_sortedGE a.val) _ y hy + +theorem leastTerm_add {a b : NatOrdinal.{u}} (ha : a ≠ 0) (hb : b ≠ 0) : + leastTerm (a + b) = min (leastTerm a) (leastTerm b) := by + have hab : a + b ≠ 0 := by + intro hzero + apply ha + have := cantorTermCount_add a b + rw [hzero, cantorTermCount_zero] at this + exact cantorTermCount_eq_zero.mp (by omega) + have hperm := additivePrincipalTerms_add_perm a b + have hmemA : (leastTerm a).val ∈ (a + b).val.additivePrincipalTerms := by + rw [hperm.mem_iff, List.mem_append] + exact Or.inl (val_leastTerm_mem ha) + have hmemB : (leastTerm b).val ∈ (a + b).val.additivePrincipalTerms := by + rw [hperm.mem_iff, List.mem_append] + exact Or.inr (val_leastTerm_mem hb) + have hle : (leastTerm (a + b)).val ≤ min (leastTerm a).val (leastTerm b).val := + le_min (val_leastTerm_le_of_mem hab hmemA) (val_leastTerm_le_of_mem hab hmemB) + have hge : min (leastTerm a).val (leastTerm b).val ≤ (leastTerm (a + b)).val := by + have hmem := val_leastTerm_mem hab + rw [hperm.mem_iff, List.mem_append] at hmem + rcases hmem with h | h + · exact (min_le_left _ _).trans (val_leastTerm_le_of_mem ha h) + · exact (min_le_right _ _).trans (val_leastTerm_le_of_mem hb h) + apply NatOrdinal.val.injective + rcases le_total (leastTerm a) (leastTerm b) with hab' | hab' + · rw [min_eq_left hab'] + exact le_antisymm (hle.trans (min_le_left _ _)) + ((le_min (le_refl _) hab').trans hge) + · rw [min_eq_right hab'] + exact le_antisymm (hle.trans (min_le_right _ _)) + ((le_min hab' (le_refl _)).trans hge) + +theorem removeLeastTerm_add_of_leastTerm_le {a b : NatOrdinal.{u}} + (ha : a ≠ 0) (hb : b ≠ 0) (hle : leastTerm a ≤ leastTerm b) : + removeLeastTerm (a + b) = removeLeastTerm a + b := by + have hab : a + b ≠ 0 := by + intro hzero + apply ha + have hcount := cantorTermCount_add a b + rw [hzero, cantorTermCount_zero] at hcount + exact cantorTermCount_eq_zero.mp (by omega) + have hmin : leastTerm (a + b) = leastTerm a := by + rw [leastTerm_add ha hb, min_eq_left hle] + apply _root_.add_right_cancel (b := leastTerm a) + calc removeLeastTerm (a + b) + leastTerm a + = removeLeastTerm (a + b) + leastTerm (a + b) := by rw [hmin] + _ = a + b := removeLeastTerm_add_leastTerm (a + b) + _ = (removeLeastTerm a + leastTerm a) + b := by + rw [removeLeastTerm_add_leastTerm a] + _ = removeLeastTerm a + b + leastTerm a := by ac_rfl + +theorem nsmul_ne_zero_of_ne_zero {a : NatOrdinal.{u}} (ha : a ≠ 0) {r : ℕ} + (hr : 1 ≤ r) : r • a ≠ 0 := by + intro hzero + apply ha + have hcount : r * cantorTermCount a = 0 := by + rw [← cantorTermCount_nsmul, hzero, cantorTermCount_zero] + refine cantorTermCount_eq_zero.mp ?_ + rcases Nat.mul_eq_zero.mp hcount with h | h + · omega + · exact h + +theorem leastTerm_nsmul {a : NatOrdinal.{u}} (ha : a ≠ 0) {r : ℕ} (hr : 1 ≤ r) : + leastTerm (r • a) = leastTerm a := by + induction r with + | zero => omega + | succ r ih => + rcases Nat.eq_zero_or_pos r with rfl | hrpos + · simp + · rw [succ_nsmul, leastTerm_add (nsmul_ne_zero_of_ne_zero ha hrpos) ha, + ih hrpos, min_self] + +theorem removeLeastTerm_nsmul {a : NatOrdinal.{u}} (ha : a ≠ 0) {r : ℕ} + (hr : 1 ≤ r) : + removeLeastTerm a + (r - 1) • a = removeLeastTerm (r • a) := by + obtain ⟨s, rfl⟩ : ∃ s, r = s + 1 := ⟨r - 1, by omega⟩ + have hsimp : s + 1 - 1 = s := by omega + rw [hsimp] + rcases Nat.eq_zero_or_pos s with rfl | hspos + · simp + · have hs : s • a ≠ 0 := nsmul_ne_zero_of_ne_zero ha hspos + have hle : leastTerm a ≤ leastTerm (s • a) := by + rw [leastTerm_nsmul ha hspos] + rw [succ_nsmul, add_comm (s • a) a, + ← removeLeastTerm_add_of_leastTerm_le ha hs hle] + +theorem removeLeastTerm_add_of_leastTerm_ge {a b : NatOrdinal.{u}} + (ha : a ≠ 0) (hb : b ≠ 0) (hle : leastTerm b ≤ leastTerm a) : + removeLeastTerm (a + b) = a + removeLeastTerm b := by + rw [add_comm a b, removeLeastTerm_add_of_leastTerm_le hb ha hle, add_comm] + +theorem leastTerm_eq_self_of_isAdditivelyPrincipal {a : NatOrdinal.{u}} (ha : a ≠ 0) + (hprin : Ordinal.IsAdditivelyPrincipal a.val) : leastTerm a = a := by + have hzero : removeLeastTerm a = 0 := + (removeLeastTerm_eq_zero_iff ha).mpr + ((cantorTermCount_eq_one_iff ha).mpr hprin) + have hsplit := removeLeastTerm_add_leastTerm a + rwa [hzero, zero_add] at hsplit + +/-! ### Deletion on a sum with a repeated summand + +The grade `k • alpha + beta` has least Cantor term `min (leastTerm alpha) (leastTerm beta)`, by +`leastTerm_add` and `leastTerm_nsmul`, so deletion falls on whichever side attains the minimum. +The two lemmas below name the two outcomes, and the third says the second outcome can repeat only +finitely often. -/ + +theorem removeLeastTerm_nsmul_add_of_le {alpha beta : NatOrdinal.{u}} + (ha : alpha ≠ 0) (hb : beta ≠ 0) {k : ℕ} (hk : 1 ≤ k) + (hle : leastTerm alpha ≤ leastTerm beta) : + removeLeastTerm (k • alpha + beta) = + (removeLeastTerm alpha + (k - 1) • alpha) + beta := by + have hk0 : k • alpha ≠ 0 := nsmul_ne_zero_of_ne_zero ha hk + have hle' : leastTerm (k • alpha) ≤ leastTerm beta := by + rwa [leastTerm_nsmul ha hk] + rw [removeLeastTerm_add_of_leastTerm_le hk0 hb hle', removeLeastTerm_nsmul ha hk] + +theorem removeLeastTerm_nsmul_add_of_ge {alpha beta : NatOrdinal.{u}} + (ha : alpha ≠ 0) (hb : beta ≠ 0) {k : ℕ} (hk : 1 ≤ k) + (hle : leastTerm beta ≤ leastTerm alpha) : + removeLeastTerm (k • alpha + beta) = k • alpha + removeLeastTerm beta := by + have hk0 : k • alpha ≠ 0 := nsmul_ne_zero_of_ne_zero ha hk + have hle' : leastTerm beta ≤ leastTerm (k • alpha) := by + rwa [leastTerm_nsmul ha hk] + exact removeLeastTerm_add_of_leastTerm_ge hk0 hb hle' + +theorem exists_iterate_removeLeastTerm (alpha : NatOrdinal.{u}) (beta : NatOrdinal.{u}) : + ∃ j : ℕ, removeLeastTerm^[j] beta = 0 ∨ + leastTerm alpha ≤ leastTerm (removeLeastTerm^[j] beta) := by + generalize hn : cantorTermCount beta = n + induction n using Nat.strong_induction_on generalizing beta with + | _ n ih => + rcases eq_or_ne beta 0 with rfl | hb + · exact ⟨0, Or.inl rfl⟩ + rcases le_or_gt (leastTerm alpha) (leastTerm beta) with hle | hgt + · exact ⟨0, Or.inr hle⟩ + · have hlt : cantorTermCount (removeLeastTerm beta) < n := by + rw [← hn] + exact cantorTermCount_removeLeastTerm_lt hb + obtain ⟨j, hj⟩ := ih _ hlt (removeLeastTerm beta) rfl + refine ⟨j + 1, ?_⟩ + rwa [Function.iterate_succ_apply] + +theorem removeLeastTerm_add_one_eq_self_iff {a : NatOrdinal.{u}} : + removeLeastTerm a + 1 = a ↔ leastTerm a = 1 := by + constructor + · intro h + conv_rhs at h => rw [← removeLeastTerm_add_leastTerm a] + exact (_root_.add_right_injective _ h).symm + · intro h + rw [← h, removeLeastTerm_add_leastTerm] + +theorem add_ne_of_isAdditivelyPrincipal {a i j : NatOrdinal.{u}} + (ha : Ordinal.IsAdditivelyPrincipal a.val) (hi : i ≠ 0) (hj : j ≠ 0) : + i + j ≠ a := by + intro hij + have ha0 : a ≠ 0 := by + intro hzero + rw [hzero] at hij + exact hi (le_antisymm (hij ▸ le_add_right) zero_le) + have hcount : cantorTermCount a = 1 := (cantorTermCount_eq_one_iff ha0).mpr ha + rw [← hij, cantorTermCount_add] at hcount + have hi1 : cantorTermCount i ≠ 0 := fun h ↦ hi (cantorTermCount_eq_zero.mp h) + have hj1 : cantorTermCount j ≠ 0 := fun h ↦ hj (cantorTermCount_eq_zero.mp h) + omega + +theorem leastTerm_ne_zero {a : NatOrdinal.{u}} (ha : a ≠ 0) : leastTerm a ≠ 0 := by + intro hzero + have hcount := cantorTermCount_leastTerm ha + rw [hzero, cantorTermCount_zero] at hcount + omega + +theorem one_le_leastTerm {a : NatOrdinal.{u}} (ha : a ≠ 0) : 1 ≤ leastTerm a := + Order.one_le_iff_ne_zero.mpr (leastTerm_ne_zero ha) + +@[simp] +theorem leastTerm_one : leastTerm (1 : NatOrdinal.{u}) = 1 := + leastTerm_eq_self_of_isAdditivelyPrincipal one_ne_zero + (Ordinal.isAdditivelyPrincipal_iff.mpr ⟨0, by simp⟩) + +@[simp] +theorem removeLeastTerm_one : removeLeastTerm (1 : NatOrdinal.{u}) = 0 := by + have h := removeLeastTerm_add_leastTerm (1 : NatOrdinal.{u}) + rw [leastTerm_one] at h + simpa using h + +theorem removeLeastTerm_add_one {a : NatOrdinal.{u}} : + removeLeastTerm (a + 1) = a := by + rcases eq_or_ne a 0 with rfl | ha + · simp + · rw [removeLeastTerm_add_of_leastTerm_ge ha one_ne_zero + (by rw [leastTerm_one]; exact one_le_leastTerm ha), removeLeastTerm_one, add_zero] + +/-- Deletion is not strictly monotone below a grade whose least Cantor term exceeds `1`: the +grade `removeLeastTerm a + 1` is strictly below `a`, yet deletion sends it to `removeLeastTerm a` +rather than below it. -/ +theorem exists_lt_removeLeastTerm_not_lt {a : NatOrdinal.{u}} (ha : 1 < leastTerm a) : + ∃ b : NatOrdinal.{u}, b ≠ 0 ∧ b < a ∧ removeLeastTerm a ≤ removeLeastTerm b := by + refine ⟨removeLeastTerm a + 1, ?_, ?_, ?_⟩ + · intro hzero + have : (1 : NatOrdinal.{u}) ≤ removeLeastTerm a + 1 := le_add_left + rw [hzero] at this + exact absurd (le_antisymm this zero_le) one_ne_zero + · conv_rhs => rw [← removeLeastTerm_add_leastTerm a] + exact add_lt_add_of_le_of_lt le_rfl ha + · rw [removeLeastTerm_add_one] + +/-! ### Agreement with the finite-part operation -/ + +theorem additivePrincipalTerms_eq_append_one {a : NatOrdinal.{u}} + (ha : 0 < a.constantCoeff) : + (a.removeNat 1).val.additivePrincipalTerms ++ [1] = a.val.additivePrincipalTerms := by + set terms := (a.removeNat 1).val.additivePrincipalTerms with hterms + have hpred : (a.removeNat 1).val + (1 : Ordinal) = a.val := by + have h := congrArg NatOrdinal.val (removeNat_add_natCast (n := 1) ha) + calc + (a.removeNat 1).val + (1 : Ordinal) = + (a.removeNat 1).val + ((1 : ℕ) : Ordinal) := by rw [Nat.cast_one] + _ = (a.removeNat 1 + ((1 : ℕ) : NatOrdinal)).val := + (NatOrdinal.val_add_natCast (a.removeNat 1) 1).symm + _ = a.val := h + have hsum : (terms ++ [1]).sum = a.val := by + rw [List.sum_append, List.sum_singleton, hterms, + Ordinal.additivePrincipalTerms_sum] + exact hpred + have hprincipal : ∀ x ∈ terms ++ [1], IsAdditivelyPrincipal x := by + intro x hx + rw [List.mem_append, List.mem_singleton] at hx + rcases hx with hx | rfl + · exact Ordinal.isAdditivelyPrincipal_of_mem_additivePrincipalTerms hx + · simpa using Ordinal.isAdditivelyPrincipal_omega0_opow 0 + have hsorted : (terms ++ [1]).SortedGE := by + rw [List.sortedGE_iff_pairwise, List.pairwise_append] + refine ⟨List.sortedGE_iff_pairwise.mp (Ordinal.additivePrincipalTerms_sortedGE _), + by simp, ?_⟩ + intro x hx y hy + simp only [List.mem_singleton] at hy + subst y + exact Order.one_le_iff_ne_zero.mpr + (Ordinal.isAdditivelyPrincipal_of_mem_additivePrincipalTerms hx).ne_zero + exact Ordinal.additivePrincipalTerms_unique hsum hprincipal hsorted + +theorem leastTerm_eq_one_of_constantCoeff_pos {a : NatOrdinal.{u}} + (ha : 0 < a.constantCoeff) : leastTerm a = 1 := by + apply NatOrdinal.val.injective + rw [leastTerm, NatOrdinal.val_of, ← additivePrincipalTerms_eq_append_one ha] + simp + +theorem removeLeastTerm_eq_removeNat_one {a : NatOrdinal.{u}} + (ha : 0 < a.constantCoeff) : removeLeastTerm a = a.removeNat 1 := by + apply NatOrdinal.val.injective + rw [removeLeastTerm, NatOrdinal.val_of, ← additivePrincipalTerms_eq_append_one ha, + List.dropLast_concat] + exact Ordinal.additivePrincipalTerms_sum _ + +end NatOrdinal + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/LeastTermSup.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/LeastTermSup.lean new file mode 100644 index 0000000000..a6270b336a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/LeastTermSup.lean @@ -0,0 +1,142 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTerm +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorTermCount + +/-! +# Approaching a natural sum from below in one summand + +Let `λ ≠ 0` and let `σ` be an ordinal every term of whose Cantor normal form is at least the last +term `ω^e` of that of `λ`. Then every `τ < λ ⊕ σ` is bounded by some `ρ ⊕ σ` with `ρ < λ`: +`sup_{ρ < λ} (ρ ⊕ σ) = λ ⊕ σ`. Writing `λ = λ' + ω^e`, the natural sum `λ ⊕ σ` is the ordinal sum +`(λ' ⊕ σ) + ω^e`, because all terms of `λ' ⊕ σ` are at least `ω^e`; so `τ < λ' ⊕ σ`, in which +case `ρ = λ'` serves, or `τ = (λ' ⊕ σ) + ξ` with `ξ < ω^e`, in which case `ρ = λ' ⊕ ξ < λ` and +`ρ ⊕ σ ≥ τ`. Without the hypothesis on `σ` the supremum can be smaller: `sup_{ρ < ω} (ρ ⊕ 1) = ω`, +not `ω ⊕ 1`. +-/ + +open Ordinal + +universe u + +public noncomputable section + +namespace NatOrdinal + +/-- Every term of the Cantor normal form of `a ≠ 0`, with repeated terms, is at least its last +term. -/ +theorem leastTerm_le_of_mem {a : NatOrdinal.{u}} (ha : a ≠ 0) {y : Ordinal.{u}} + (hy : y ∈ a.val.additivePrincipalTerms) : leastTerm a ≤ NatOrdinal.of y := + NatOrdinal.val.le_iff_le.mp (by simpa using val_leastTerm_le_of_mem ha hy) + +/-- The terms of a natural sum are the terms of the summands. -/ +theorem mem_additivePrincipalTerms_add_iff (a b : NatOrdinal.{u}) (y : Ordinal.{u}) : + y ∈ (a + b).val.additivePrincipalTerms ↔ + y ∈ a.val.additivePrincipalTerms ∨ y ∈ b.val.additivePrincipalTerms := by + rw [(additivePrincipalTerms_add_perm a b).mem_iff, List.mem_append] + +/-- If every term of `σ` is at least the last term of `λ ≠ 0`, then every term of `λ ⊕ σ` is. -/ +theorem leastTerm_le_of_mem_add {lam sigma : NatOrdinal.{u}} (hlam : lam ≠ 0) + (hsigma : sigma = 0 ∨ leastTerm lam ≤ leastTerm sigma) {y : Ordinal.{u}} + (hy : y ∈ (lam + sigma).val.additivePrincipalTerms) : leastTerm lam ≤ NatOrdinal.of y := by + rcases (mem_additivePrincipalTerms_add_iff lam sigma y).mp hy with h | h + · exact leastTerm_le_of_mem hlam h + · rcases hsigma with rfl | hle + · rw [NatOrdinal.val_zero, additivePrincipalTerms_zero] at h + exact absurd h List.not_mem_nil + · exact hle.trans (leastTerm_le_of_mem (by rintro rfl; simp at h) h) + +/-- Let `λ ≠ 0` and let every term of the Cantor normal form of `σ` be at least the last term of +that of `λ`. Then every `τ < λ ⊕ σ` is at most `ρ ⊕ σ` for some `ρ < λ`. -/ +@[blueprint "lem:natural-sum-approach" + (phase := "Algebraic and ordinal preliminaries") + (title := "Cofinality below a Hessenberg sum") + (statement := /-- + Let $\lambda\neq0$ and $\sigma$ be ordinals such that $\sigma=0$ or every + term of the Cantor normal form of $\sigma$ is at least the last term of the + Cantor normal form of $\lambda$. Then for every $\tau<\lambda\nsum\sigma$ + there is $\rho<\lambda$ with $\tau\le\rho\nsum\sigma$. + -/) + (proof := /-- + Write $\lambda=\lambda'\mathbin\oplus\omega^e$, where $\omega^e$ is its last + Cantor-normal-form term. The hypothesis on $\sigma$ gives + $\lambda\mathbin\oplus\sigma=(\lambda'\mathbin\oplus\sigma)+\omega^e$. + If $\tau$ lies below $\lambda'\mathbin\oplus\sigma$, take $\rho=\lambda'$. + Otherwise write $\tau=(\lambda'\mathbin\oplus\sigma)+\nu$ with + $\nu<\omega^e$ and take $\rho=\lambda'\mathbin\oplus\nu$; strict + monotonicity gives $\rho<\lambda$, and ordinary addition is bounded by the + natural sum. + -/)] +theorem exists_lt_le_add_of_lastCantorTerm_le {lam sigma tau : NatOrdinal.{u}} (hlam : lam ≠ 0) + (hsigma : sigma = 0 ∨ leastTerm lam ≤ leastTerm sigma) (htau : tau < lam + sigma) : + ∃ rho < lam, tau ≤ rho + sigma := by + obtain ⟨L, hL⟩ : ∃ L, leastTerm lam = L := ⟨_, rfl⟩ + obtain ⟨lam', hlam'⟩ : ∃ lam', removeLeastTerm lam = lam' := ⟨_, rfl⟩ + have hsplit : lam' + L = lam := by rw [← hL, ← hlam']; exact removeLeastTerm_add_leastTerm lam + have hLne : L ≠ 0 := hL ▸ leastTerm_ne_zero hlam + have hLprin : IsAdditivelyPrincipal L.val := hL ▸ isAdditivelyPrincipal_leastTerm hlam + have hlam'lt : lam' < lam := by + rw [← hsplit] + exact lt_add_of_pos_right lam' (pos_iff_ne_zero.mpr hLne) + obtain ⟨A, hA⟩ : ∃ A, lam' + sigma = A := ⟨_, rfl⟩ + -- `λ ⊕ σ = A ⊕ L` is the ordinal sum `A.val + L.val`, as every term of `A` is at least `L`. + have hterms : ∀ y ∈ A.val.additivePrincipalTerms, L.val ≤ y := by + intro y hy + have hy' : y ∈ (lam + sigma).val.additivePrincipalTerms := by + rw [← hsplit, add_right_comm, hA, mem_additivePrincipalTerms_add_iff] + exact Or.inl hy + have := leastTerm_le_of_mem_add hlam hsigma hy' + rw [hL] at this + simpa using NatOrdinal.val.le_iff_le.mpr this + have hsum : lam + sigma = NatOrdinal.of (A.val + L.val) := by + rw [natOrdinal_of_add_eq_add_of_forall_le hLprin hterms, NatOrdinal.of_val, NatOrdinal.of_val, + ← hA, ← hsplit, add_right_comm] + have htau' : tau.val < A.val + L.val := by + have := NatOrdinal.val.lt_iff_lt.mpr htau + rwa [hsum, NatOrdinal.val_of] at this + rcases lt_or_ge tau.val A.val with hlt | hge + · -- `τ < A`: take `ρ = λ'`. + exact ⟨lam', hlam'lt, hA ▸ (NatOrdinal.val.lt_iff_lt.mp hlt).le⟩ + · -- `τ = A + ξ` with `ξ < L`: take `ρ = λ' ⊕ ξ`. + obtain ⟨ξ, hξ⟩ : ∃ ξ, tau.val - A.val = ξ := ⟨_, rfl⟩ + have hτξ : A.val + ξ = tau.val := by rw [← hξ]; exact Ordinal.add_sub_cancel_of_le hge + have hξL : ξ < L.val := by + rw [← hξ, Ordinal.sub_lt_of_le hge] + exact htau' + refine ⟨lam' + NatOrdinal.of ξ, ?_, ?_⟩ + · have hξL' : NatOrdinal.of ξ < L := by + rw [← NatOrdinal.val.lt_iff_lt, NatOrdinal.val_of] + exact hξL + calc lam' + NatOrdinal.of ξ < lam' + L := by gcongr + _ = lam := hsplit + · calc tau = NatOrdinal.of (A.val + ξ) := by rw [hτξ, NatOrdinal.of_val] + _ ≤ A + NatOrdinal.of ξ := by + have := oadd_le_add A (NatOrdinal.of ξ) + rwa [NatOrdinal.val_of] at this + _ = lam' + NatOrdinal.of ξ + sigma := by rw [← hA, add_right_comm] + +/-- For a successor `λ`, every `τ < λ ⊕ σ` is at most `ρ ⊕ σ` with `ρ := λ ⊖ 1 < λ`, whatever +`σ`. -/ +theorem exists_lt_le_add_of_constantCoeff_pos {lam sigma tau : NatOrdinal.{u}} + (hlam : 0 < lam.constantCoeff) (htau : tau < lam + sigma) : + ∃ rho < lam, tau ≤ rho + sigma := by + have hrho : lam = removeLeastTerm lam + 1 := by + have := removeLeastTerm_add_leastTerm lam + rwa [leastTerm_eq_one_of_constantCoeff_pos hlam, eq_comm] at this + refine ⟨removeLeastTerm lam, ?_, ?_⟩ + · calc removeLeastTerm lam < removeLeastTerm lam + 1 := lt_add_one _ + _ = lam := hrho.symm + · have htau' : tau < removeLeastTerm lam + sigma + 1 := by + calc tau < lam + sigma := htau + _ = removeLeastTerm lam + 1 + sigma := by rw [← hrho] + _ = removeLeastTerm lam + sigma + 1 := add_right_comm _ _ _ + exact Order.lt_add_one_iff.mp htau' + +end NatOrdinal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/MultiplicativelyPrincipal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/MultiplicativelyPrincipal.lean new file mode 100644 index 0000000000..821c395861 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/MultiplicativelyPrincipal.lean @@ -0,0 +1,610 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal + +import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow +import Mathlib.Algebra.Order.SuccPred +import Mathlib.Tactic.NormNum + +/-! +# Multiplicatively principal ordinal factors + +Berarducci, Definition 3.6 calls a positive ordinal multiplicatively principal when the ordinals +strictly below it are closed under ordinary ordinal multiplication. Under that exact definition, +the finite ordinal `2` is multiplicatively principal. Thus Berarducci, Fact 3.8 omits the case `2` +when it lists only `1` and ordinals of the form `ω ^ (ω ^ e)`. This module records the exact +classification, including `2`, and separately names the infinite multiplicatively principal +ordinals used as factors in Definition 6.4. + +For a positive additive-principal ordinal above one, its exponent has a nonempty uncompressed +Cantor normal form. Exponentiating those Cantor terms by `ω` gives the unique nonincreasing list +of multiplicatively principal factors greater than one. The ordinary ordinal product of the list +is the original ordinal. The corresponding Hessenberg product in `NatOrdinal` has the same value, +as asserted in Berarducci, Remark 6.5. + +The subtype `Ordinal.AdditivePrincipalAboveOne` is the exact domain of Berarducci's principal and +residual factor operations. Consequently neither operation uses an arbitrary value outside its +mathematical domain. The residual factor is the product of all but the final factor, so it is one +when the factor list is a singleton. + +Mathlib supplies the ordinary principal-ordinal classification and ordinal logarithm. +CombinatorialGames supplies Hessenberg arithmetic on `NatOrdinal`. Neither dependency supplies the +finite factor list or the principal and residual projections. +-/ + +universe u + +open scoped NatOrdinal + +public noncomputable section + +namespace Ordinal + +/-- Berarducci's positive convention for multiplicatively principal ordinals. -/ +def IsMultiplicativelyPrincipal (o : Ordinal) : Prop := + 0 < o ∧ IsPrincipal (· * ·) o + +/-- The exact relationship with Mathlib's convention, which also includes zero. -/ +theorem isMultiplicativelyPrincipal_iff_pos_and_isPrincipal_mul {o : Ordinal} : + IsMultiplicativelyPrincipal o ↔ 0 < o ∧ IsPrincipal (· * ·) o := + Iff.rfl + +/-- One is multiplicatively principal in Berarducci's convention. -/ +theorem isMultiplicativelyPrincipal_one : + IsMultiplicativelyPrincipal 1 := + ⟨zero_lt_one, isPrincipal_mul_one⟩ + +/-- Two is multiplicatively principal under the predicate printed in Berarducci, Definition 3.6. -/ +theorem isMultiplicativelyPrincipal_two : + IsMultiplicativelyPrincipal 2 := + ⟨by norm_num, isPrincipal_mul_two⟩ + +/-- Every ordinal of the infinite shape in Berarducci, Fact 3.8 is multiplicatively principal. -/ +theorem isMultiplicativelyPrincipal_omega0_opow_opow (e : Ordinal) : + IsMultiplicativelyPrincipal (omega0 ^ omega0 ^ e) := + ⟨opow_pos _ omega0_pos, isPrincipal_mul_omega0_opow_opow e⟩ + +/-- Corrected classification of Berarducci's multiplicatively principal ordinals. The additional +case `2` is forced by the printed predicate. -/ +theorem isMultiplicativelyPrincipal_iff_one_or_two_or_omega0_opow_opow + {o : Ordinal} : + IsMultiplicativelyPrincipal o ↔ + o = 1 ∨ o = 2 ∨ ∃ e : Ordinal, o = omega0 ^ omega0 ^ e := by + rw [IsMultiplicativelyPrincipal, isPrincipal_mul_iff_le_two_or_omega0_opow_opow] + constructor + · rintro ⟨ho, hsmall | ⟨e, he⟩⟩ + · obtain rfl | rfl | rfl := Order.le_two_iff.mp hsmall + · exact (lt_irrefl 0 ho).elim + · exact Or.inl rfl + · exact Or.inr (Or.inl rfl) + · exact Or.inr (Or.inr ⟨e, he.symm⟩) + · rintro (rfl | rfl | ⟨e, rfl⟩) + · exact ⟨zero_lt_one, Or.inl (by norm_num)⟩ + · exact ⟨by norm_num, Or.inl le_rfl⟩ + · exact ⟨opow_pos _ omega0_pos, Or.inr ⟨e, rfl⟩⟩ + +/-- An infinite multiplicatively principal ordinal, namely an ordinal of the form +`ω ^ (ω ^ e)`. These are the factors occurring in Berarducci, Definition 6.4. -/ +def IsInfiniteMultiplicativelyPrincipal (o : Ordinal) : Prop := + ∃ e : Ordinal, o = omega0 ^ omega0 ^ e + +/-- Characterization of infinite multiplicatively principal ordinals by their defining shape. -/ +theorem isInfiniteMultiplicativelyPrincipal_iff {o : Ordinal} : + IsInfiniteMultiplicativelyPrincipal o ↔ ∃ e : Ordinal, o = omega0 ^ omega0 ^ e := + (Iff.rfl) + +/-- Every ordinal of the defining infinite shape is infinite multiplicatively principal. -/ +theorem isInfiniteMultiplicativelyPrincipal_omega0_opow_opow (e : Ordinal) : + IsInfiniteMultiplicativelyPrincipal (omega0 ^ omega0 ^ e) := + ⟨e, rfl⟩ + +/-- Every infinite multiplicatively principal ordinal is a nonzero limit ordinal. -/ +theorem IsInfiniteMultiplicativelyPrincipal.isSuccLimit {o : Ordinal} + (ho : IsInfiniteMultiplicativelyPrincipal o) : + Order.IsSuccLimit o := by + obtain ⟨e, rfl⟩ := ho + exact isSuccLimit_opow_left isSuccLimit_omega0 (opow_ne_zero e omega0_ne_zero) + +/-- Every infinite multiplicatively principal ordinal is additively principal. -/ +theorem IsInfiniteMultiplicativelyPrincipal.isAdditivelyPrincipal {o : Ordinal} + (ho : IsInfiniteMultiplicativelyPrincipal o) : + IsAdditivelyPrincipal o := by + obtain ⟨e, rfl⟩ := ho + exact isAdditivelyPrincipal_omega0_opow (omega0 ^ e) + +/-- Infinite multiplicative principality is multiplicative principality together with exclusion +of the exceptional values one and two. -/ +theorem isInfiniteMultiplicativelyPrincipal_iff_two_lt_and_isMultiplicativelyPrincipal + {o : Ordinal} : + IsInfiniteMultiplicativelyPrincipal o ↔ + 2 < o ∧ IsMultiplicativelyPrincipal o := by + constructor + · rintro ⟨e, rfl⟩ + refine ⟨?_, isMultiplicativelyPrincipal_omega0_opow_opow e⟩ + apply (natCast_lt_omega0 2).trans_le + simpa [opow_one] using + (opow_le_opow_right omega0_pos (Order.one_le_iff_ne_zero.mpr <| + opow_ne_zero e omega0_ne_zero)) + · rintro ⟨htwo, hp⟩ + rcases isMultiplicativelyPrincipal_iff_one_or_two_or_omega0_opow_opow.mp hp with + rfl | rfl | ⟨e, he⟩ + · exact (not_lt_of_ge (by norm_num) htwo).elim + · exact (lt_irrefl 2 htwo).elim + · exact ⟨e, he⟩ + +/-- The multiplicatively principal factors obtained from the uncompressed Cantor normal form of +the exponent of `o`. -/ +noncomputable def multiplicativePrincipalFactors (o : Ordinal) : List Ordinal := + (additivePrincipalTerms (log omega0 o)).map (omega0 ^ ·) + +private theorem prod_map_omega0_opow (l : List Ordinal) : + (l.map (omega0 ^ ·)).prod = omega0 ^ l.sum := by + induction l with + | nil => simp + | cons a l ih => + simp only [List.map_cons, List.prod_cons, List.sum_cons, ih, opow_add] + +/-- The ordinary product of the canonical factors of an additive-principal ordinal is the +original ordinal. -/ +theorem multiplicativePrincipalFactors_prod {o : Ordinal} + (ho : IsAdditivelyPrincipal o) : + o.multiplicativePrincipalFactors.prod = o := by + obtain ⟨e, rfl⟩ := isAdditivelyPrincipal_iff.mp ho + rw [multiplicativePrincipalFactors, log_opow one_lt_omega0, + prod_map_omega0_opow, additivePrincipalTerms_sum] + +/-- An additive-principal ordinal above one has at least one canonical multiplicative factor. -/ +theorem multiplicativePrincipalFactors_ne_nil {o : Ordinal} + (ho : IsAdditivelyPrincipal o) (hone : 1 < o) : + o.multiplicativePrincipalFactors ≠ [] := by + obtain ⟨e, rfl⟩ := isAdditivelyPrincipal_iff.mp ho + have he : e ≠ 0 := by + intro he + subst e + simp at hone + rw [multiplicativePrincipalFactors, log_opow one_lt_omega0] + intro hnil + have hterms : additivePrincipalTerms e = [] := List.map_eq_nil_iff.mp hnil + have hsum := additivePrincipalTerms_sum e + rw [hterms] at hsum + exact he hsum.symm + +/-- The canonical multiplicative factors occur in nonincreasing order. -/ +theorem multiplicativePrincipalFactors_sortedGE (o : Ordinal) : + o.multiplicativePrincipalFactors.SortedGE := by + rw [multiplicativePrincipalFactors, List.sortedGE_iff_pairwise, List.pairwise_map] + have hsorted := additivePrincipalTerms_sortedGE (log omega0 o) + rw [List.sortedGE_iff_pairwise] at hsorted + exact hsorted.imp fun hab ↦ opow_le_opow_right omega0_pos hab + +/-- Every canonical factor is an infinite multiplicatively principal ordinal. -/ +theorem isInfiniteMultiplicativelyPrincipal_of_mem_multiplicativePrincipalFactors + {o f : Ordinal} (hf : f ∈ o.multiplicativePrincipalFactors) : + IsInfiniteMultiplicativelyPrincipal f := by + rw [multiplicativePrincipalFactors, List.mem_map] at hf + obtain ⟨e, he, rfl⟩ := hf + obtain ⟨a, rfl⟩ := + isAdditivelyPrincipal_iff.mp + (isAdditivelyPrincipal_of_mem_additivePrincipalTerms he) + exact ⟨a, rfl⟩ + +/-- Every canonical factor is multiplicatively principal under the exact source predicate. -/ +theorem isMultiplicativelyPrincipal_of_mem_multiplicativePrincipalFactors + {o f : Ordinal} (hf : f ∈ o.multiplicativePrincipalFactors) : + IsMultiplicativelyPrincipal f := + (isInfiniteMultiplicativelyPrincipal_iff_two_lt_and_isMultiplicativelyPrincipal.mp + (isInfiniteMultiplicativelyPrincipal_of_mem_multiplicativePrincipalFactors hf)).2 + +/-- Every canonical factor is strictly greater than one. -/ +theorem one_lt_of_mem_multiplicativePrincipalFactors + {o f : Ordinal} (hf : f ∈ o.multiplicativePrincipalFactors) : + 1 < f := + (show (1 : Ordinal) < 2 by norm_num).trans <| + (isInfiniteMultiplicativelyPrincipal_iff_two_lt_and_isMultiplicativelyPrincipal.mp + (isInfiniteMultiplicativelyPrincipal_of_mem_multiplicativePrincipalFactors hf)).1 + +private theorem multiplicativePrincipalFactors_unique_of_infinite + {o : Ordinal} {l : List Ordinal} + (hsum : l.prod = o) + (hprincipal : ∀ f ∈ l, IsInfiniteMultiplicativelyPrincipal f) + (hsorted : l.SortedGE) : + l = o.multiplicativePrincipalFactors := by + let exponents := l.map (log omega0) + have hprincipalExponents : ∀ e ∈ exponents, IsAdditivelyPrincipal e := by + intro e he + change e ∈ l.map (log omega0) at he + rw [List.mem_map] at he + obtain ⟨f, hf, rfl⟩ := he + obtain ⟨a, rfl⟩ := hprincipal f hf + rw [log_opow one_lt_omega0] + exact isAdditivelyPrincipal_omega0_opow a + have hsortedExponents : exponents.SortedGE := by + change (l.map (log omega0)).SortedGE + rw [List.sortedGE_iff_pairwise, List.pairwise_map] + have hpairwise := List.sortedGE_iff_pairwise.mp hsorted + exact hpairwise.imp fun hab ↦ log_mono_right omega0 hab + have hprod : l.prod = omega0 ^ exponents.sum := by + have hreconstruct : l = l.map (fun f ↦ omega0 ^ log omega0 f) := by + have hmap : l.map id = l.map (fun f ↦ omega0 ^ log omega0 f) := by + apply List.map_congr_left + intro f hf + obtain ⟨a, rfl⟩ := hprincipal f hf + simp [log_opow one_lt_omega0] + simpa using hmap + calc + l.prod = (l.map fun f ↦ omega0 ^ log omega0 f).prod := + congrArg List.prod hreconstruct + _ = omega0 ^ (l.map (log omega0)).sum := by + simpa [Function.comp_def] using + prod_map_omega0_opow (l.map (log omega0)) + _ = omega0 ^ exponents.sum := rfl + have hoPrincipal : IsAdditivelyPrincipal o := + isAdditivelyPrincipal_iff.mpr ⟨exponents.sum, hsum.symm.trans hprod⟩ + obtain ⟨e, rfl⟩ := isAdditivelyPrincipal_iff.mp hoPrincipal + have hexponents : exponents = additivePrincipalTerms e := by + apply additivePrincipalTerms_unique + · apply (opow_right_inj one_lt_omega0).mp + calc + omega0 ^ exponents.sum = l.prod := hprod.symm + _ = omega0 ^ e := hsum + · exact hprincipalExponents + · exact hsortedExponents + rw [multiplicativePrincipalFactors, log_opow one_lt_omega0, ← hexponents] + change l = (l.map (log omega0)).map (omega0 ^ ·) + rw [List.map_map] + have hmap : l.map id = l.map ((omega0 ^ ·) ∘ log omega0) := by + apply List.map_congr_left + intro f hf + obtain ⟨a, rfl⟩ := hprincipal f hf + simp [Function.comp_apply, log_opow one_lt_omega0] + simpa using hmap + +/-- The canonical factor list is the unique nonincreasing list of source-multiplicatively-principal +ordinals greater than one with the prescribed additive-principal product. -/ +theorem multiplicativePrincipalFactors_unique {o : Ordinal} {l : List Ordinal} + (ho : IsAdditivelyPrincipal o) + (hsum : l.prod = o) + (hprincipal : ∀ f ∈ l, IsMultiplicativelyPrincipal f) + (hone : ∀ f ∈ l, 1 < f) + (hsorted : l.SortedGE) : + l = o.multiplicativePrincipalFactors := by + have hnoTwo : (2 : Ordinal) ∉ l := by + intro htwo + have hne : l ≠ [] := List.ne_nil_of_mem htwo + let last := l.getLast hne + have hlastMem : last ∈ l := List.getLast_mem hne + have hpairwise := List.sortedGE_iff_pairwise.mp hsorted + have hlastLe : last ≤ 2 := hpairwise.rel_getLast htwo + have htwoLe : (2 : Ordinal) ≤ last := by + simpa [one_add_one_eq_two] using + (Order.add_one_le_iff.mpr (hone last hlastMem)) + have hlast : last = 2 := le_antisymm hlastLe htwoLe + let front := l.dropLast + have hfrontPos : 0 < front.prod := by + have hprodPos : ∀ (m : List Ordinal), + (∀ f ∈ m, 0 < f) → 0 < m.prod := by + intro m hm + induction m with + | nil => exact zero_lt_one + | cons f m ih => + rw [List.prod_cons] + exact mul_pos (hm f (by simp)) + (ih fun g hg ↦ hm g (by simp [hg])) + apply hprodPos + intro f hf + exact zero_lt_one.trans (hone f (List.mem_of_mem_dropLast hf)) + have hsplit : front.prod * last = l.prod := by + calc + front.prod * last = (front ++ [last]).prod := by simp + _ = l.prod := by + congr 1 + exact List.dropLast_append_getLast hne + have hfrontMulTwo : front.prod * 2 = o := by + rw [← hlast, hsplit, hsum] + have hfrontLt : front.prod < o := by + rw [← hfrontMulTwo] + simpa using mul_lt_mul_of_pos_left (show (1 : Ordinal) < 2 by norm_num) + hfrontPos + have hclosed := + (isAdditivelyPrincipal_iff_ne_zero_and_isPrincipal_add.mp ho).2 hfrontLt hfrontLt + change front.prod + front.prod < o at hclosed + rw [← Ordinal.mul_two, hfrontMulTwo] at hclosed + exact lt_irrefl o hclosed + apply multiplicativePrincipalFactors_unique_of_infinite hsum + · intro f hf + rcases isMultiplicativelyPrincipal_iff_one_or_two_or_omega0_opow_opow.mp + (hprincipal f hf) with rfl | rfl | ⟨e, he⟩ + · exact (lt_irrefl 1 (hone 1 hf)).elim + · exact (hnoTwo hf).elim + · exact ⟨e, he⟩ + · exact hsorted + +/-- An infinite multiplicatively principal ordinal has itself as its sole canonical factor. -/ +theorem multiplicativePrincipalFactors_eq_singleton + {o : Ordinal} (ho : IsInfiniteMultiplicativelyPrincipal o) : + o.multiplicativePrincipalFactors = [o] := by + symm + apply multiplicativePrincipalFactors_unique_of_infinite (o := o) + · simp + · intro f hf + rw [List.mem_singleton] at hf + subst f + exact ho + · simp [List.sortedGE_iff_pairwise] + +private theorem naturalProd_map_omega0_opow (l : List Ordinal) : + (l.map (fun e ↦ NatOrdinal.of (omega0 ^ e))).prod = + ω^ (l.map NatOrdinal.of).sum := by + induction l with + | nil => simp + | cons a l ih => + rw [List.map_cons, List.prod_cons, ih, List.map_cons, List.sum_cons, + NatOrdinal.of_omega0_opow, NatOrdinal.wpow_add] + +private theorem naturalProd_factors_eq_of_ordinaryProd {l : List Ordinal} + (hprincipal : ∀ a ∈ l, IsAdditivelyPrincipal a) + (hsorted : l.SortedGE) : + (l.map (fun e ↦ NatOrdinal.of (omega0 ^ e))).prod = + NatOrdinal.of (l.map (omega0 ^ ·)).prod := by + rw [naturalProd_map_omega0_opow, prod_map_omega0_opow, + NatOrdinal.of_omega0_opow, + natOrdinal_of_sum_eq_sum_map_of_sorted hprincipal hsorted] + +private theorem multiplicativePrincipalFactors_naturalProd_eq_of_prod (o : Ordinal) : + (o.multiplicativePrincipalFactors.map NatOrdinal.of).prod = + NatOrdinal.of o.multiplicativePrincipalFactors.prod := by + rw [multiplicativePrincipalFactors, List.map_map] + apply naturalProd_factors_eq_of_ordinaryProd + · exact fun _ ha ↦ isAdditivelyPrincipal_of_mem_additivePrincipalTerms ha + · exact additivePrincipalTerms_sortedGE _ + +/-- The Hessenberg product of the canonical factors agrees with their ordinary product and equals +the original additive-principal ordinal. This is the product agreement used in Berarducci, +Remark 6.5. -/ +theorem multiplicativePrincipalFactors_naturalProd {o : Ordinal} + (ho : IsAdditivelyPrincipal o) : + (o.multiplicativePrincipalFactors.map NatOrdinal.of).prod = NatOrdinal.of o := by + rw [multiplicativePrincipalFactors_naturalProd_eq_of_prod, + multiplicativePrincipalFactors_prod ho] + +/-- The exact domain on which Berarducci's principal and residual factors are defined. -/ +abbrev AdditivePrincipalAboveOne := + {o : Ordinal // IsAdditivelyPrincipal o ∧ 1 < o} + +namespace AdditivePrincipalAboveOne + +private theorem sortedGE_dropLast {l : List Ordinal} (hl : l.SortedGE) : + l.dropLast.SortedGE := by + rw [List.sortedGE_iff_pairwise] at hl ⊢ + induction l with + | nil => simp + | cons a l ih => + cases l with + | nil => simp + | cons b l => + rw [List.dropLast_cons_of_ne_nil (by simp), List.pairwise_cons] + exact ⟨fun c hc ↦ (List.pairwise_cons.mp hl).1 c + (List.mem_of_mem_dropLast hc), + ih (List.pairwise_cons.mp hl).2⟩ + +/-- The final, hence least, factor in the canonical multiplicative factor list. -/ +noncomputable def principalFactor (o : AdditivePrincipalAboveOne) : Ordinal := + o.1.multiplicativePrincipalFactors.getLast + (multiplicativePrincipalFactors_ne_nil o.2.1 o.2.2) + +/-- The ordinary product of all canonical multiplicative factors except the final one. -/ +noncomputable def residualFactor (o : AdditivePrincipalAboveOne) : Ordinal := + o.1.multiplicativePrincipalFactors.dropLast.prod + +/-- The principal factor is the final element of the nonempty canonical factor list. -/ +theorem principalFactor_eq_getLast (o : AdditivePrincipalAboveOne) : + o.principalFactor = o.1.multiplicativePrincipalFactors.getLast + (multiplicativePrincipalFactors_ne_nil o.2.1 o.2.2) := + (rfl) + +/-- The residual factor is the ordinary product of the canonical factor list without its final +element. -/ +theorem residualFactor_eq_dropLast_prod (o : AdditivePrincipalAboveOne) : + o.residualFactor = o.1.multiplicativePrincipalFactors.dropLast.prod := + (rfl) + +/-- The ordinary product of the residual and principal factors recovers the original ordinal. -/ +theorem residualFactor_mul_principalFactor (o : AdditivePrincipalAboveOne) : + o.residualFactor * o.principalFactor = o.1 := by + let hne := multiplicativePrincipalFactors_ne_nil o.2.1 o.2.2 + calc + o.residualFactor * o.principalFactor = + (o.1.multiplicativePrincipalFactors.dropLast ++ + [o.1.multiplicativePrincipalFactors.getLast hne]).prod := by + simp [residualFactor, principalFactor] + _ = o.1.multiplicativePrincipalFactors.prod := by + rw [List.dropLast_append_getLast hne] + _ = o.1 := multiplicativePrincipalFactors_prod o.2.1 + +/-- The principal factor belongs to the canonical factor list. -/ +theorem principalFactor_mem_factors (o : AdditivePrincipalAboveOne) : + o.principalFactor ∈ o.1.multiplicativePrincipalFactors := by + rw [principalFactor] + exact List.getLast_mem _ + +/-- The principal factor is an infinite multiplicatively principal ordinal. -/ +theorem principalFactor_isInfiniteMultiplicativelyPrincipal + (o : AdditivePrincipalAboveOne) : + IsInfiniteMultiplicativelyPrincipal o.principalFactor := + isInfiniteMultiplicativelyPrincipal_of_mem_multiplicativePrincipalFactors + o.principalFactor_mem_factors + +/-- The principal factor is multiplicatively principal under Berarducci's exact predicate. -/ +theorem principalFactor_isMultiplicativelyPrincipal (o : AdditivePrincipalAboveOne) : + IsMultiplicativelyPrincipal o.principalFactor := + isMultiplicativelyPrincipal_of_mem_multiplicativePrincipalFactors + o.principalFactor_mem_factors + +/-- The principal factor is strictly greater than one. -/ +theorem one_lt_principalFactor (o : AdditivePrincipalAboveOne) : + 1 < o.principalFactor := + one_lt_of_mem_multiplicativePrincipalFactors o.principalFactor_mem_factors + +/-- The residual factor is positive additive principal; in particular, it may equal one. -/ +theorem residualFactor_isAdditivelyPrincipal (o : AdditivePrincipalAboveOne) : + IsAdditivelyPrincipal o.residualFactor := by + apply isAdditivelyPrincipal_iff.mpr + refine ⟨(additivePrincipalTerms (log omega0 o.1)).dropLast.sum, ?_⟩ + have hdrop : + ((additivePrincipalTerms (log omega0 o.1)).map (omega0 ^ ·)).dropLast = + (additivePrincipalTerms (log omega0 o.1)).dropLast.map (omega0 ^ ·) := by + induction additivePrincipalTerms (log omega0 o.1) with + | nil => rfl + | cons a l ih => cases l <;> simp_all + rw [residualFactor, multiplicativePrincipalFactors, hdrop, prod_map_omega0_opow] + +/-- If the original ordinal is already infinite multiplicatively principal, its principal factor +is the ordinal itself. -/ +theorem principalFactor_eq_self_of_isInfiniteMultiplicativelyPrincipal + (o : AdditivePrincipalAboveOne) + (ho : IsInfiniteMultiplicativelyPrincipal o.1) : + o.principalFactor = o.1 := by + rw [principalFactor] + let hne := multiplicativePrincipalFactors_ne_nil o.2.1 o.2.2 + calc + o.1.multiplicativePrincipalFactors.getLast hne = + [o.1].getLast (by simp) := + List.getLast_congr _ _ (multiplicativePrincipalFactors_eq_singleton ho) + _ = o.1 := rfl + +/-- If the original ordinal is already infinite multiplicatively principal, its residual factor +is one, as stipulated in Berarducci, Definition 6.4. -/ +theorem residualFactor_eq_one_of_isInfiniteMultiplicativelyPrincipal + (o : AdditivePrincipalAboveOne) + (ho : IsInfiniteMultiplicativelyPrincipal o.1) : + o.residualFactor = 1 := by + rw [residualFactor, multiplicativePrincipalFactors_eq_singleton ho] + rfl + +private theorem naturalProd_dropLastFactors_eq_residualFactor + (o : AdditivePrincipalAboveOne) : + (o.1.multiplicativePrincipalFactors.dropLast.map NatOrdinal.of).prod = + NatOrdinal.of o.residualFactor := by + let terms := additivePrincipalTerms (log omega0 o.1) + have hdrop : + (terms.map (omega0 ^ ·)).dropLast = terms.dropLast.map (omega0 ^ ·) := by + induction terms with + | nil => rfl + | cons a l ih => cases l <;> simp_all + rw [residualFactor, multiplicativePrincipalFactors, show + additivePrincipalTerms (log omega0 o.1) = terms from rfl, hdrop, List.map_map] + apply naturalProd_factors_eq_of_ordinaryProd + · intro a ha + exact isAdditivelyPrincipal_of_mem_additivePrincipalTerms + (List.mem_of_mem_dropLast ha) + · exact sortedGE_dropLast (additivePrincipalTerms_sortedGE _) + +/-- The Hessenberg product of the residual and principal factors also recovers the original +ordinal. -/ +theorem naturalResidual_mul_naturalPrincipal (o : AdditivePrincipalAboveOne) : + NatOrdinal.of o.residualFactor * NatOrdinal.of o.principalFactor = + NatOrdinal.of o.1 := by + let factors := o.1.multiplicativePrincipalFactors + let hne := multiplicativePrincipalFactors_ne_nil o.2.1 o.2.2 + calc + NatOrdinal.of o.residualFactor * NatOrdinal.of o.principalFactor = + (factors.dropLast.map NatOrdinal.of).prod * + NatOrdinal.of (factors.getLast hne) := by + rw [naturalProd_dropLastFactors_eq_residualFactor, principalFactor] + _ = (factors.dropLast.map NatOrdinal.of ++ + [NatOrdinal.of (factors.getLast hne)]).prod := by simp + _ = (factors.map NatOrdinal.of).prod := by + have hmap : factors.dropLast.map NatOrdinal.of ++ + [NatOrdinal.of (factors.getLast hne)] = factors.map NatOrdinal.of := by + rw [← List.map_singleton, ← List.map_append, + List.dropLast_append_getLast hne] + rw [hmap] + _ = NatOrdinal.of factors.prod := + multiplicativePrincipalFactors_naturalProd_eq_of_prod o.1 + _ = NatOrdinal.of o.1 := by rw [multiplicativePrincipalFactors_prod o.2.1] + +/-- The principal factor is the least canonical factor. -/ +theorem principalFactor_le_of_mem_factors (o : AdditivePrincipalAboveOne) + {f : Ordinal} (hf : f ∈ o.1.multiplicativePrincipalFactors) : + o.principalFactor ≤ f := by + rw [principalFactor] + have hpairwise := List.sortedGE_iff_pairwise.mp + (multiplicativePrincipalFactors_sortedGE o.1) + exact hpairwise.rel_getLast hf + +/-- The canonical multiplicative factors are the powers of `ω` at the Cantor terms of the +logarithm. -/ +theorem multiplicativePrincipalFactors_eq (o : AdditivePrincipalAboveOne) : + o.1.multiplicativePrincipalFactors = + (log omega0 o.1).additivePrincipalTerms.map (omega0 ^ ·) := + (rfl) + +theorem log_principalFactor_le_of_mem_terms (o : AdditivePrincipalAboveOne) + {t : Ordinal} (ht : t ∈ (log omega0 o.1).additivePrincipalTerms) : + log omega0 o.principalFactor ≤ t := by + have hmem : omega0 ^ t ∈ o.1.multiplicativePrincipalFactors := by + rw [multiplicativePrincipalFactors_eq] + exact List.mem_map_of_mem ht + have hle := o.principalFactor_le_of_mem_factors hmem + have hprin : IsAdditivelyPrincipal o.principalFactor := + o.principalFactor_isInfiniteMultiplicativelyPrincipal.isAdditivelyPrincipal + rw [← hprin.opow_log_self] at hle + exact (opow_le_opow_iff_right one_lt_omega0).mp hle + +theorem log_principalFactor_mem_terms (o : AdditivePrincipalAboveOne) : + log omega0 o.principalFactor ∈ (log omega0 o.1).additivePrincipalTerms := by + have hmem := o.principalFactor_mem_factors + rw [multiplicativePrincipalFactors_eq, List.mem_map] at hmem + obtain ⟨t, ht, hteq⟩ := hmem + rw [← hteq, log_opow one_lt_omega0] + exact ht + +theorem mem_terms_of_mem_terms_log_residualFactor (o : AdditivePrincipalAboveOne) + {t : Ordinal} (ht : t ∈ (log omega0 o.residualFactor).additivePrincipalTerms) : + t ∈ (log omega0 o.1).additivePrincipalTerms := by + set L := (log omega0 o.1).additivePrincipalTerms with hLdef + have hdrop : (L.map (omega0 ^ ·)).dropLast = L.dropLast.map (omega0 ^ ·) := by + induction L with + | nil => rfl + | cons a l ih => cases l <;> simp_all + have hres : o.residualFactor = omega0 ^ L.dropLast.sum := by + rw [residualFactor_eq_dropLast_prod, multiplicativePrincipalFactors_eq, ← hLdef, hdrop, + prod_map_omega0_opow] + have hlog : log omega0 o.residualFactor = L.dropLast.sum := by + rw [hres, log_opow one_lt_omega0] + have hsub : L.dropLast.Sublist L := List.dropLast_sublist L + have hsorted : L.dropLast.SortedGE := + List.sortedGE_iff_pairwise.mpr + ((List.sortedGE_iff_pairwise.mp (additivePrincipalTerms_sortedGE _)).sublist hsub) + have hprin : ∀ a ∈ L.dropLast, IsAdditivelyPrincipal a := fun a ha ↦ + isAdditivelyPrincipal_of_mem_additivePrincipalTerms (hsub.mem ha) + have huniq := additivePrincipalTerms_unique (o := L.dropLast.sum) rfl hprin hsorted + rw [hlog, ← huniq] at ht + exact hsub.mem ht + +/-- Berarducci, Remark 6.7: the principal factor of the residual factor is at least the principal +factor itself. -/ +theorem principalFactor_le_principalFactor_of_eq_residualFactor + (o r : AdditivePrincipalAboveOne) (hr : r.1 = o.residualFactor) : + o.principalFactor ≤ r.principalFactor := by + have hmem := r.principalFactor_mem_factors + rw [multiplicativePrincipalFactors_eq] at hmem + obtain ⟨t, ht, hteq⟩ := List.mem_map.mp hmem + rw [hr] at ht + have htO : t ∈ (log omega0 o.1).additivePrincipalTerms := + o.mem_terms_of_mem_terms_log_residualFactor ht + have hle := o.log_principalFactor_le_of_mem_terms htO + have hprin : IsAdditivelyPrincipal o.principalFactor := + o.principalFactor_isInfiniteMultiplicativelyPrincipal.isAdditivelyPrincipal + calc o.principalFactor = omega0 ^ log omega0 o.principalFactor := hprin.opow_log_self.symm + _ ≤ omega0 ^ t := opow_le_opow_right omega0_pos hle + _ = r.principalFactor := hteq + +end AdditivePrincipalAboveOne + +end Ordinal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/NaturalOrder.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/NaturalOrder.lean new file mode 100644 index 0000000000..8ab07f471c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/NaturalOrder.lean @@ -0,0 +1,27 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Basic +public import Mathlib.Algebra.Order.GroupWithZero.Canonical + +/-! +# The ordered multiplicative monoid of natural ordinals + +Natural ordinal multiplication is commutative and strictly order-preserving away from zero. +This supplies the bundled ordered monoid with zero used by Mathlib valuations, retaining the +existing natural operations and order. +-/ + +public noncomputable section +namespace NatOrdinal + +instance instLinearOrderedCommMonoidWithZero : LinearOrderedCommMonoidWithZero NatOrdinal where + bot := 0 + bot_le := fun _ ↦ zero_le + isBot_zero := fun _ ↦ zero_le + +end NatOrdinal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/NaturalPowerFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/NaturalPowerFactorization.lean new file mode 100644 index 0000000000..3a54204552 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/NaturalPowerFactorization.lean @@ -0,0 +1,140 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.MultiplicativelyPrincipal + +/-! +# Canonical factors in natural powers + +The natural power of an additive-principal ordinal, multiplied by its residual factor, +has no canonical multiplicative factor below the original principal factor. Ordinary and natural +multiplication by that principal factor therefore agree. An additional ordinal with a larger +principal factor preserves this assertion. + +These are the ordinal calculations used in the cancellation argument of Berarducci, Lemma 8.2; +they do not depend on a series ring or a valuation. +-/ + +public noncomputable section +open Ordinal +universe u + +namespace Ordinal +private def GoodAt (w : Ordinal.{u}) (Y : NatOrdinal.{u}) : Prop := + IsAdditivelyPrincipal Y.val ∧ + ∀ t ∈ (log omega0 Y.val).additivePrincipalTerms, w ≤ t + +private theorem GoodAt.one (w : Ordinal.{u}) : GoodAt w 1 := by + refine ⟨isAdditivelyPrincipal_iff.mpr ⟨0, by simp⟩, fun t ht ↦ ?_⟩ + rw [show ((1 : NatOrdinal.{u}).val) = 1 from rfl, log_one_right, + additivePrincipalTerms_zero] at ht + exact absurd ht List.not_mem_nil + +private theorem GoodAt.mul {w : Ordinal.{u}} {Y Z : NatOrdinal.{u}} + (hY : GoodAt w Y) (hZ : GoodAt w Z) : GoodAt w (Y * Z) := by + have hprod : (NatOrdinal.of Y.val * NatOrdinal.of Z.val).val = (Y * Z).val := by + rw [NatOrdinal.of_val, NatOrdinal.of_val] + constructor + · obtain ⟨e, he⟩ := isAdditivelyPrincipal_iff.mp hY.1 + obtain ⟨f, hf⟩ := isAdditivelyPrincipal_iff.mp hZ.1 + refine isAdditivelyPrincipal_iff.mpr ⟨(NatOrdinal.of e + NatOrdinal.of f).val, ?_⟩ + rw [← hprod, he, hf, NatOrdinal.of_omega0_opow, NatOrdinal.of_omega0_opow, + ← NatOrdinal.wpow_add, NatOrdinal.val_wpow] + · intro t ht + rw [← hprod] at ht + rcases mem_additivePrincipalTerms_log_natMul hY.1 hZ.1 ht with h | h + · exact hY.2 t h + · exact hZ.2 t h + +private theorem GoodAt.pow {w : Ordinal.{u}} {Y : NatOrdinal.{u}} (hY : GoodAt w Y) (n : ℕ) : + GoodAt w (Y ^ n) := by + induction n with + | zero => simpa using GoodAt.one w + | succ n ih => rw [pow_succ]; exact ih.mul hY + +namespace AdditivePrincipalAboveOne +private theorem goodAt_value (B : AdditivePrincipalAboveOne.{u}) : + GoodAt (log omega0 B.principalFactor) (NatOrdinal.of B.val) := + ⟨B.2.1, fun _ ht ↦ B.log_principalFactor_le_of_mem_terms ht⟩ + +private theorem goodAt_residual (B : AdditivePrincipalAboveOne.{u}) : + GoodAt (log omega0 B.principalFactor) (NatOrdinal.of B.residualFactor) := + ⟨B.residualFactor_isAdditivelyPrincipal, + fun _ ht ↦ B.log_principalFactor_le_of_mem_terms + (B.mem_terms_of_mem_terms_log_residualFactor ht)⟩ + +/-- A natural power times the residual factor is additive principal, and ordinary multiplication +by the principal factor agrees with natural multiplication. -/ +theorem power_residual_factorization (B : AdditivePrincipalAboveOne.{u}) (m : ℕ) : + IsAdditivelyPrincipal (NatOrdinal.of B.val ^ m * NatOrdinal.of B.residualFactor).val ∧ + ((NatOrdinal.of B.val ^ m * NatOrdinal.of B.residualFactor) * + NatOrdinal.of B.principalFactor).val = + (NatOrdinal.of B.val ^ m * NatOrdinal.of B.residualFactor).val * B.principalFactor := by + have h := (B.goodAt_value.pow m).mul B.goodAt_residual + refine ⟨h.1, ?_⟩ + obtain ⟨e, he⟩ := isInfiniteMultiplicativelyPrincipal_iff.mp + B.principalFactor_isInfiniteMultiplicativelyPrincipal + have hp : IsAdditivelyPrincipal (log omega0 B.principalFactor) := by + rw [he, log_opow one_lt_omega0] + exact isAdditivelyPrincipal_omega0_opow e + have hh := natOrdinal_of_mul_wpow_eq_mul_of_log_terms hp h.1 h.2 + rw [B.principalFactor_isInfiniteMultiplicativelyPrincipal.isAdditivelyPrincipal.opow_log_self, + NatOrdinal.of_val] at hh + exact (congrArg NatOrdinal.val hh).symm + +/-- The same factorisation holds after adjoining a factor with no smaller principal factor. -/ +theorem power_residual_mul_factorization (B C : AdditivePrincipalAboveOne.{u}) + (hp : B.principalFactor ≤ C.principalFactor) (m : ℕ) : + IsAdditivelyPrincipal + (NatOrdinal.of B.val ^ m * NatOrdinal.of B.residualFactor * NatOrdinal.of C.val).val ∧ + ((NatOrdinal.of B.val ^ m * NatOrdinal.of B.residualFactor * NatOrdinal.of C.val) * + NatOrdinal.of B.principalFactor).val = + (NatOrdinal.of B.val ^ m * NatOrdinal.of B.residualFactor * NatOrdinal.of C.val).val * + B.principalFactor := by + have hC : GoodAt (log omega0 B.principalFactor) (NatOrdinal.of C.val) := + ⟨C.2.1, fun _ ht ↦ (log_mono_right omega0 hp).trans + (C.log_principalFactor_le_of_mem_terms ht)⟩ + have h := ((B.goodAt_value.pow m).mul B.goodAt_residual).mul hC + refine ⟨h.1, ?_⟩ + obtain ⟨e, he⟩ := isInfiniteMultiplicativelyPrincipal_iff.mp + B.principalFactor_isInfiniteMultiplicativelyPrincipal + have hb : IsAdditivelyPrincipal (log omega0 B.principalFactor) := by + rw [he, log_opow one_lt_omega0] + exact isAdditivelyPrincipal_omega0_opow e + have hh := natOrdinal_of_mul_wpow_eq_mul_of_log_terms hb h.1 h.2 + rw [B.principalFactor_isInfiniteMultiplicativelyPrincipal.isAdditivelyPrincipal.opow_log_self, + NatOrdinal.of_val] at hh + exact (congrArg NatOrdinal.val hh).symm +/-- A natural product of factors with no smaller principal factor also has no smaller principal +factor, whenever that product is greater than one. -/ +theorem principalFactor_le_of_naturalProd (B C : AdditivePrincipalAboveOne.{u}) + (l : Multiset AdditivePrincipalAboveOne.{u}) + (hl : ∀ y ∈ l, B.principalFactor ≤ y.principalFactor) + (hC : NatOrdinal.of C.val = (l.map fun y ↦ NatOrdinal.of y.val).prod) : + B.principalFactor ≤ C.principalFactor := by + have hgood : GoodAt (log omega0 B.principalFactor) + (l.map fun y ↦ NatOrdinal.of y.val).prod := by + clear hC + induction l using Multiset.induction with + | empty => simpa using GoodAt.one (log omega0 B.principalFactor) + | cons a t ih => + rw [Multiset.map_cons, Multiset.prod_cons] + apply GoodAt.mul + · exact ⟨a.2.1, fun z hz ↦ + (log_mono_right omega0 (hl a (Multiset.mem_cons_self a t))).trans + (a.log_principalFactor_le_of_mem_terms hz)⟩ + · exact ih fun y hy ↦ hl y (Multiset.mem_cons_of_mem hy) + rw [← hC] at hgood + have h := hgood.2 _ C.log_principalFactor_mem_terms + have hpow := opow_le_opow_right omega0_pos h + simpa only + [B.principalFactor_isInfiniteMultiplicativelyPrincipal.isAdditivelyPrincipal.opow_log_self, + C.principalFactor_isInfiniteMultiplicativelyPrincipal.isAdditivelyPrincipal.opow_log_self] + using hpow + +end AdditivePrincipalAboveOne +end Ordinal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/NaturalPrincipal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/NaturalPrincipal.lean new file mode 100644 index 0000000000..ed97df5b95 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/NaturalPrincipal.lean @@ -0,0 +1,135 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.MultiplicativelyPrincipal + +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Degree +import Mathlib.Tactic.Ring + +/-! +# Principality of the natural operations + +Berarducci, Fact 3.7: an additive-principal ordinal is closed under the natural sum of two +strictly smaller ordinals, and a multiplicative-principal ordinal is closed under their natural +product. Both statements are strictly stronger than the closure under the ordinary operations used +to define the two predicates, and both are what the ordinal estimates in Berarducci, Lemma 7.7 and +Lemma 8.2 actually require. + +The natural operations are carried by `NatOrdinal`, so each statement converts its arguments with +`NatOrdinal.of` and reads the result back with `NatOrdinal.val`. Convenience forms stated entirely +inside `NatOrdinal` are supplied alongside. + +The multiplicative case reduces to `NatOrdinal.cantorDegree_mul` and `NatOrdinal.add_lt_wpow` +through the corrected classification of Berarducci's multiplicative-principal predicate, whose +finite cases `1` and `2` are handled directly. +-/ + +universe u + +open scoped NatOrdinal + +public noncomputable section + +namespace NatOrdinal + +/-- A power of `ω` whose exponent is again a power of `ω` is closed under Hessenberg products. -/ +theorem mul_lt_wpow_wpow {a b e : NatOrdinal.{u}} + (ha : a < ω^ (ω^ e)) (hb : b < ω^ (ω^ e)) : a * b < ω^ (ω^ e) := by + obtain rfl | ha0 := eq_or_ne a 0 + · simp [wpow_pos] + obtain rfl | hb0 := eq_or_ne b 0 + · simp [wpow_pos] + rw [← cantorDegree_lt_coe_iff] at ha hb ⊢ + rw [cantorDegree_mul] + obtain ⟨x, hx⟩ := WithBot.ne_bot_iff_exists.mp (cantorDegree_eq_bot.not.mpr ha0) + obtain ⟨y, hy⟩ := WithBot.ne_bot_iff_exists.mp (cantorDegree_eq_bot.not.mpr hb0) + rw [← hx] at ha ⊢ + rw [← hy] at hb ⊢ + rw [← WithBot.coe_add, WithBot.coe_lt_coe] at * + exact add_lt_wpow ha hb + +end NatOrdinal + +namespace Ordinal + +/-- Berarducci, Fact 3.7, additive case: an additive-principal ordinal is closed under the natural +sum of two strictly smaller ordinals. -/ +theorem IsAdditivelyPrincipal.naturalAdd_lt {o b c : Ordinal.{u}} + (ho : IsAdditivelyPrincipal o) (hb : b < o) (hc : c < o) : + (NatOrdinal.of b + NatOrdinal.of c).val < o := by + obtain ⟨e, rfl⟩ := isAdditivelyPrincipal_iff.mp ho + rw [show (omega0 ^ e) = (NatOrdinal.of (omega0 ^ e)).val from + (NatOrdinal.val_of _).symm, NatOrdinal.val.lt_iff_lt] + simp only [NatOrdinal.of_omega0_opow] + exact NatOrdinal.add_lt_wpow (by simpa using NatOrdinal.of.lt_iff_lt.mpr hb) + (by simpa using NatOrdinal.of.lt_iff_lt.mpr hc) + +/-- Berarducci, Fact 3.7, multiplicative case: a multiplicative-principal ordinal is closed under +the natural product of two strictly smaller ordinals. -/ +theorem IsMultiplicativelyPrincipal.naturalMul_lt {o b c : Ordinal.{u}} + (ho : IsMultiplicativelyPrincipal o) (hb : b < o) (hc : c < o) : + (NatOrdinal.of b * NatOrdinal.of c).val < o := by + rw [show o = (NatOrdinal.of o).val from (NatOrdinal.val_of o).symm, + NatOrdinal.val.lt_iff_lt] + rcases isMultiplicativelyPrincipal_iff_one_or_two_or_omega0_opow_opow.mp ho with + rfl | rfl | ⟨e, rfl⟩ + · rw [Order.lt_one_iff] at hb hc + subst hb + subst hc + simp + · have hb1 : NatOrdinal.of b ≤ 1 := by + have h : b ≤ 1 := + Order.lt_succ_iff.mp (by rwa [Order.succ_eq_add_one, one_add_one_eq_two]) + simpa using NatOrdinal.of.monotone h + have hc1 : NatOrdinal.of c ≤ 1 := by + have h : c ≤ 1 := + Order.lt_succ_iff.mp (by rwa [Order.succ_eq_add_one, one_add_one_eq_two]) + simpa using NatOrdinal.of.monotone h + calc NatOrdinal.of b * NatOrdinal.of c ≤ 1 := by simpa using mul_le_mul' hb1 hc1 + _ < NatOrdinal.of 2 := by simp + · simp only [NatOrdinal.of_omega0_opow] + exact NatOrdinal.mul_lt_wpow_wpow (by simpa using NatOrdinal.of.lt_iff_lt.mpr hb) + (by simpa using NatOrdinal.of.lt_iff_lt.mpr hc) + +end Ordinal + +namespace NatOrdinal + +/-- Berarducci, Fact 3.7, additive case, stated inside `NatOrdinal`. -/ +theorem add_lt_of_isAdditivelyPrincipal {o a b : NatOrdinal.{u}} + (ho : Ordinal.IsAdditivelyPrincipal o.val) (ha : a < o) (hb : b < o) : a + b < o := by + have h := ho.naturalAdd_lt (val.lt_iff_lt.mpr ha) (val.lt_iff_lt.mpr hb) + simpa using val.lt_iff_lt.mp (by simpa using h) + +/-- Berarducci, Fact 3.7, multiplicative case, stated inside `NatOrdinal`. -/ +theorem mul_lt_of_isMultiplicativelyPrincipal {o a b : NatOrdinal.{u}} + (ho : Ordinal.IsMultiplicativelyPrincipal o.val) (ha : a < o) (hb : b < o) : a * b < o := by + have h := ho.naturalMul_lt (val.lt_iff_lt.mpr ha) (val.lt_iff_lt.mpr hb) + simpa using val.lt_iff_lt.mp (by simpa using h) + +/-- The natural product of two ordinary products stays strictly below the natural +product of the two multipliers with a multiplicative-principal bound. This is the ordinal +estimate of Berarducci, Lemma 7.7 and Lemma 8.2. -/ +theorem naturalMul_mul_lt_of_lt {ρ₁ ρ₂ π₁ π₂ α₁ α₂ : NatOrdinal} + (hmp : Ordinal.IsMultiplicativelyPrincipal π₂.val) + (hπ : π₁ ≤ π₂) (hα₁ : α₁ < π₁) (hα₂ : α₂ < π₂) + (hρ : 0 < ρ₁ * ρ₂) : + NatOrdinal.of (ρ₁.val * α₁.val) * NatOrdinal.of (ρ₂.val * α₂.val) < + ρ₁ * ρ₂ * π₂ := by + have h₁ : NatOrdinal.of (ρ₁.val * α₁.val) ≤ ρ₁ * α₁ := by + simpa using NatOrdinal.of.le_iff_le.mpr (NatOrdinal.omul_le_mul' ρ₁.val α₁.val) + have h₂ : NatOrdinal.of (ρ₂.val * α₂.val) ≤ ρ₂ * α₂ := by + simpa using NatOrdinal.of.le_iff_le.mpr (NatOrdinal.omul_le_mul' ρ₂.val α₂.val) + calc NatOrdinal.of (ρ₁.val * α₁.val) * NatOrdinal.of (ρ₂.val * α₂.val) + ≤ (ρ₁ * α₁) * (ρ₂ * α₂) := mul_le_mul' h₁ h₂ + _ = (ρ₁ * ρ₂) * (α₁ * α₂) := by ring + _ < (ρ₁ * ρ₂) * π₂ := by + refine mul_lt_mul_of_pos_left ?_ hρ + exact mul_lt_of_isMultiplicativelyPrincipal hmp (hα₁.trans_le hπ) hα₂ + +end NatOrdinal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/OrderedUnion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/OrderedUnion.lean new file mode 100644 index 0000000000..4b5927f088 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/OrderedUnion.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +public import Mathlib.SetTheory.Ordinal.Arithmetic + +/-! +# Order type of a separated indexed union + +This module formalizes the order-theoretic estimate in Berarducci, Lemma 4.7. A family indexed by +a limit ordinal has union of order type at least `ρ * l` when every nonempty final segment of +each member has order type at least `ρ` and every later member contains an element strictly above +each earlier member. The product is ordinary ordinal multiplication, with the within-block order +in the left factor and the index order in the right factor. + +The proof uses the successor indices and replaces each corresponding member by its final segment +strictly above all earlier members. Strictness makes the resulting blocks disjoint and ordered even +when the original family members overlap. + +-/ + +universe u + +open Function Order Ordinal + +public noncomputable section + +namespace Ordinal + +/-- The successor positions in the canonical well-order of a limit ordinal have the same order +type as the ordinal. This is Berarducci, Lemma 4.6. -/ +theorem typeLT_range_succ_toType (l : Ordinal.{u}) (hl : IsSuccLimit l) : + typeLT (Set.range (Order.succ : l.ToType → l.ToType)) = l := by + have hpre : IsSuccPrelimit (typeLT l.ToType) := by + rw [type_toType] + exact hl.isSuccPrelimit + letI : NoMaxOrder l.ToType := isSuccPrelimit_type_lt_iff.mp hpre + let f : l.ToType → Set.range (Order.succ : l.ToType → l.ToType) := + fun i ↦ ⟨Order.succ i, ⟨i, rfl⟩⟩ + have hf : StrictMono f := fun _ _ hij ↦ Order.succ_strictMono hij + have hsurjective : Surjective f := by + rintro ⟨_, i, rfl⟩ + exact ⟨i, rfl⟩ + let e : l.ToType ≃o Set.range (Order.succ : l.ToType → l.ToType) := + hf.orderIsoOfSurjective f hsurjective + calc + typeLT (Set.range (Order.succ : l.ToType → l.ToType)) = typeLT l.ToType := + e.symm.toRelIsoLT.ordinalType_congr + _ = l := type_toType l + +end Ordinal + +namespace Set.IsPWO + +private abbrev successorRange (l : Ordinal.{u}) : Set l.ToType := + Set.range Order.succ + +private theorem successorRange_orderType (l : Ordinal.{u}) (hl : IsSuccLimit l) : + typeLT (successorRange l) = l := by + simpa only [successorRange] using Ordinal.typeLT_range_succ_toType l hl + +private def separatedBlock {α ι : Type u} [LinearOrder α] [LinearOrder ι] + (B : ι → Set α) (i : ι) : Set α := + {x | x ∈ B i ∧ ∀ j < i, ∀ y ∈ B j, y < x} + +/-- Let `l` be a limit ordinal and let `B` be an `l`-indexed family of well-ordered subsets. If +every later member contains an element strictly above every element of each earlier member, every +nonempty final segment of every member has order type at least `ρ`, and the union is well ordered, +then its order type is at least the ordinary ordinal product `ρ * l`. This is Berarducci, +Lemma 4.7. -/ +theorem mul_le_orderType_iUnion_of_isSuccLimit + {α : Type u} [LinearOrder α] {l ρ : Ordinal.{u}} + (hl : IsSuccLimit l) (B : l.ToType → Set α) + (hB : ∀ i, (B i).IsPWO) + (hseparated : ∀ {i j}, i < j → ∃ y ∈ B j, ∀ x ∈ B i, x < y) + (hfinal : ∀ (i : l.ToType) (C : Set α) + (hC : IsRelUpperSet C (· ∈ B i)), C.Nonempty → + ρ ≤ ((hB i).mono fun _ hx ↦ (hC hx).1).orderType) + (hUnion : (⋃ i, B i).IsPWO) : + ρ * l ≤ hUnion.orderType := by + have hpre : IsSuccPrelimit (typeLT l.ToType) := by + rw [type_toType] + exact hl.isSuccPrelimit + letI : NoMaxOrder l.ToType := isSuccPrelimit_type_lt_iff.mp hpre + let predecessor : successorRange l → l.ToType := + fun i ↦ Classical.choose i.2 + have successor_predecessor (i : successorRange l) : + Order.succ (predecessor i) = i.1 := + Classical.choose_spec i.2 + have predecessor_lt (i : successorRange l) : predecessor i < i.1 := by + rw [← successor_predecessor i] + exact Order.lt_succ _ + have block_upper (i : successorRange l) : + IsRelUpperSet (separatedBlock B i.1) (· ∈ B i.1) := by + intro x hx + refine ⟨hx.1, fun y hxy hy ↦ ⟨hy, ?_⟩⟩ + intro j hji z hz + exact (hx.2 j hji z hz).trans_le hxy + have block_nonempty (i : successorRange l) : + (separatedBlock B i.1).Nonempty := by + obtain ⟨x, hx, hxabove⟩ := hseparated (predecessor_lt i) + refine ⟨x, hx, ?_⟩ + intro j hji y hy + have hjle : j ≤ predecessor i := by + rw [← successor_predecessor i] at hji + exact Order.le_of_lt_succ hji + rcases hjle.eq_or_lt with rfl | hjlt + · exact hxabove y hy + · obtain ⟨z, hz, hzabove⟩ := hseparated hjlt + exact (hzabove y hy).trans (hxabove z hz) + have block_isPWO (i : successorRange l) : + (separatedBlock B i.1).IsPWO := + (hB i.1).mono fun _ hx ↦ hx.1 + have block_embedding_exists (i : successorRange l) : + Nonempty (ρ.ToType ↪o separatedBlock B i.1) := by + let hblock := block_isPWO i + letI : WellFoundedLT (separatedBlock B i.1) := ⟨hblock.isWF⟩ + have hle : typeLT ρ.ToType ≤ typeLT (separatedBlock B i.1) := by + calc + typeLT ρ.ToType = ρ := type_toType ρ + _ ≤ hblock.orderType := hfinal i.1 _ (block_upper i) (block_nonempty i) + _ = typeLT (separatedBlock B i.1) := + hblock.orderType_eq_typeLT_of_orderIso (OrderIso.refl _) + obtain ⟨e⟩ := Ordinal.type_le_iff'.mp hle + exact ⟨e.orderEmbeddingOfLTEmbedding⟩ + let blockEmbedding (i : successorRange l) : + ρ.ToType ↪o separatedBlock B i.1 := + Classical.choice (block_embedding_exists i) + have block_lt_block {i j : successorRange l} (hij : i < j) + {x y : α} (hx : x ∈ separatedBlock B i.1) + (hy : y ∈ separatedBlock B j.1) : x < y := + hy.2 i.1 hij x hx.1 + let unionEmbedding : successorRange l ×ₗ ρ.ToType ↪o (⋃ i, B i) := + OrderEmbedding.ofStrictMono + (fun p ↦ + let q := ofLex p + let x := blockEmbedding q.1 q.2 + ⟨x.1, Set.mem_iUnion.mpr ⟨q.1.1, x.2.1⟩⟩) + (by + intro p q hpq + rw [Prod.Lex.lt_iff] at hpq + rcases hpq with hpq | ⟨hpq, hpq'⟩ + · exact block_lt_block hpq (blockEmbedding (ofLex p).1 (ofLex p).2).2 + (blockEmbedding (ofLex q).1 (ofLex q).2).2 + · change ((blockEmbedding (ofLex p).1 (ofLex p).2).1 : α) < + (blockEmbedding (ofLex q).1 (ofLex q).2).1 + rw [hpq] + exact (blockEmbedding (ofLex q).1).strictMono hpq') + have hdomain : typeLT (successorRange l ×ₗ ρ.ToType) = ρ * l := by + change type (Prod.Lex (· < · : successorRange l → successorRange l → Prop) + (· < · : ρ.ToType → ρ.ToType → Prop)) = ρ * l + rw [type_prod_lex, type_toType, successorRange_orderType l hl] + letI : WellFoundedLT (⋃ i, B i) := ⟨hUnion.isWF⟩ + calc + ρ * l = typeLT (successorRange l ×ₗ ρ.ToType) := hdomain.symm + _ ≤ typeLT (⋃ i, B i) := unionEmbedding.ltEmbedding.ordinal_type_le + _ = hUnion.orderType := + (hUnion.orderType_eq_typeLT_of_orderIso (OrderIso.refl _)).symm + +end Set.IsPWO diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/PairBounds.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/PairBounds.lean new file mode 100644 index 0000000000..d0e7d57bec --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/PairBounds.lean @@ -0,0 +1,434 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AlgebraicOrder +import Mathlib.Tactic.Abel + +/-! +# Natural sums with two summands lowered + +Let `μ = O ⊕ t₁ ⊕ t₂` with `t₁, t₂ ≠ 0`, and let `ω^{e₁}`, `ω^{e₂}` be the last terms of the Cantor +normal forms of `t₁`, `t₂`. The natural sums `O ⊕ ρ₁ ⊕ ρ₂` with `ρ₁ < t₁`, `ρ₂ < t₂` are bounded +strictly below `μ` (`exists_lt_forall_add_add_le`), and an upper bound `λ₀ < μ` of all of them +has `(λ₀)_{≥e₂} = μ_{≥e₂}` when `e₁ < e₂`—so `t₂ ≼ λ₀` in the algebraic order—and both `t₁` +and `t₂` precede `λ₀` in that order when `e₁ = e₂ ≠ 0` (`partGE_eq_of_forall_add_add_le`, +`algebraicLE_of_forall_add_add_le`, `algebraicLE_left_of_forall_add_add_le`). +-/ + +universe u + +open Ordinal + +public noncomputable section + +namespace NatOrdinal + +/-! ### Tools -/ + +theorem removeLeastTerm_lt {a : NatOrdinal.{u}} (ha : a ≠ 0) : removeLeastTerm a < a := by + conv_rhs => rw [← removeLeastTerm_add_leastTerm a] + exact lt_add_of_pos_right _ (pos_iff_ne_zero.mpr (leastTerm_ne_zero ha)) + +/-- Removing the last term `ω^e` of the Cantor normal form of `a` leaves an ordinal all of whose +terms are at least `ω^e`: it is its own part at or above `e`. -/ +theorem partGE_removeLeastTerm {a e : NatOrdinal.{u}} (ha : a ≠ 0) (he : leastTerm a = ω^ e) : + partGE e (removeLeastTerm a) = removeLeastTerm a := by + refine partGE_eq_self_of_forall_le fun t ht ↦ ?_ + refine wpow_le_of_mem_additivePrincipalTerms_of_leastTerm_eq ha he ?_ + rw [← removeLeastTerm_add_leastTerm a, mem_additivePrincipalTerms_add_iff] + exact Or.inl ht + +/-- Removing the last term `ω^e`, `e < e'`, does not change the part at or above `e'`. -/ +theorem partGE_removeLeastTerm_of_lt {a e e' : NatOrdinal.{u}} (he : leastTerm a = ω^ e) + (hlt : e < e') : partGE e' (removeLeastTerm a) = partGE e' a := by + conv_rhs => rw [← removeLeastTerm_add_leastTerm a] + rw [partGE_add, he, partGE_eq_zero_of_lt (wpow_lt_wpow.mpr hlt), add_zero] + +/-- `ω^e` is a limit for `e ≠ 0`: `x < ω^e` gives `x + 1 < ω^e`. -/ +theorem add_one_lt_wpow_of_lt {x e : NatOrdinal.{u}} (he : e ≠ 0) (hx : x < ω^ e) : + x + 1 < ω^ e := + add_lt_wpow hx (by rw [← wpow_zero]; exact wpow_lt_wpow.mpr (pos_iff_ne_zero.mpr he)) + +/-- Every natural ordinal is below its part at or above `e`, plus `ω^e`. -/ +theorem lt_partGE_add_wpow (e a : NatOrdinal.{u}) : a < partGE e a + ω^ e := by + conv_lhs => rw [← partGE_add_partLT e a] + exact add_lt_add_right (partLT_lt e a) _ + +/-- Between two distinct parts at or above `e` there is room for `ω^e`. -/ +theorem partGE_add_wpow_le_of_partGE_lt {e a b : NatOrdinal.{u}} + (h : partGE e a < partGE e b) : partGE e a + ω^ e ≤ partGE e b := by + have h1 := add_le_of_dvd_of_lt (exists_val_partGE_eq_mul e a) + (exists_val_partGE_eq_mul e b) (NatOrdinal.val.lt_iff_lt.mpr h) + rw [partGE_add_wpow, ← NatOrdinal.of_val (partGE e b), NatOrdinal.of.le_iff_le] + exact h1 + +/-- An ordinal with all terms at or above `e` that lies in `[C, C + ω^e]`, `C` likewise, is `C` or +`C + ω^e`. -/ +theorem eq_or_eq_add_wpow_of_le_of_le {e C X : NatOrdinal.{u}} (hC : partGE e C = C) + (hX : partGE e X = X) (h1 : C ≤ X) (h2 : X ≤ C + ω^ e) : X = C ∨ X = C + ω^ e := by + rcases eq_or_lt_of_le h1 with h | h + · exact Or.inl h.symm + · right + refine le_antisymm h2 ?_ + have := partGE_add_wpow_le_of_partGE_lt (e := e) (a := C) (b := X) (by rwa [hC, hX]) + rwa [hC, hX] at this + +/-- Below `A_{≥e} + ω^e` every ordinal is exceeded by `A ⊕ ξ` for some `ξ < ω^e`. -/ +theorem exists_lt_add_of_lt_partGE_add_wpow {A l e : NatOrdinal.{u}} (he : e ≠ 0) + (h : l < partGE e A + ω^ e) : ∃ ξ, ξ < ω^ e ∧ l < A + ξ := by + rcases lt_or_ge l (partGE e A) with hlt | hge + · exact ⟨0, wpow_pos e, by rw [add_zero]; exact hlt.trans_le (partGE_le e A)⟩ + · -- `l = A_{≥e} + ξ₀` with `ξ₀ < ω^e` + set ξ₀ : Ordinal := l.val - (partGE e A).val with hξ₀def + have hξ₀ : (partGE e A).val + ξ₀ = l.val := + Ordinal.add_sub_cancel_of_le (NatOrdinal.val.le_iff_le.mpr hge) + have hξ₀lt : ξ₀ < (ω^ e).val := by + rw [hξ₀def, Ordinal.sub_lt_of_le (NatOrdinal.val.le_iff_le.mpr hge)] + have := NatOrdinal.val.lt_iff_lt.mpr h + rwa [partGE_add_wpow, NatOrdinal.val_of] at this + have hξ₀' : NatOrdinal.of ξ₀ < ω^ e := by + rw [← NatOrdinal.of_val (ω^ e)] + exact NatOrdinal.of.lt_iff_lt.mpr hξ₀lt + have hl : l = partGE e A + NatOrdinal.of ξ₀ := by + have := of_add_of_eq_add_of_forall_lt (w := (ω^ e).val) + (u := (partGE e A).val) (t := ξ₀) + (fun _ hs ↦ wpow_le_of_mem_additivePrincipalTerms_partGE hs) + (fun s hs ↦ by + have h1 : NatOrdinal.of s ≤ NatOrdinal.of ξ₀ := + of_le_of_mem_additivePrincipalTerms (a := NatOrdinal.of ξ₀) hs + exact (NatOrdinal.of.le_iff_le.mp h1).trans_lt hξ₀lt) + rw [NatOrdinal.of_val, hξ₀, NatOrdinal.of_val] at this + exact this.symm + refine ⟨NatOrdinal.of ξ₀ + 1, add_one_lt_wpow_of_lt he hξ₀', ?_⟩ + calc l < l + 1 := lt_add_one l + _ = partGE e A + NatOrdinal.of ξ₀ + 1 := by rw [hl] + _ ≤ A + NatOrdinal.of ξ₀ + 1 := + add_le_add_left (add_le_add_left (partGE_le e A) _) _ + _ = A + (NatOrdinal.of ξ₀ + 1) := add_assoc _ _ _ + +/-! ### Lowering one summand -/ + +variable {t e : NatOrdinal.{u}} + +/-- If `ω^e` is the last term of the Cantor normal form of `t` and `ρ < t`, then +`ρ_{≥e} ⊕ ω^e ≤ t`. -/ +theorem partGE_add_wpow_le_of_lt_of_leastTerm_eq (ht : t ≠ 0) (he : leastTerm t = ω^ e) + {ρ : NatOrdinal.{u}} (hρ : ρ < t) : partGE e ρ + ω^ e ≤ t := + partGE_add_wpow_le_of_lt + (fun _ hs ↦ wpow_le_of_mem_additivePrincipalTerms_of_leastTerm_eq ht he hs) hρ + +theorem partGE_eq_self_of_leastTerm_eq (ht : t ≠ 0) (he : leastTerm t = ω^ e) : + partGE e t = t := + partGE_eq_self_of_forall_le + fun _ hs ↦ wpow_le_of_mem_additivePrincipalTerms_of_leastTerm_eq ht he hs +theorem removeLeastTerm_add_wpow (he : leastTerm t = ω^ e) : + removeLeastTerm t + ω^ e = t := by + rw [← he]; exact removeLeastTerm_add_leastTerm t + +/-! ### Lowering two summands -/ + +variable {O t₁ t₂ e₁ e₂ : NatOrdinal.{u}} + +/-- With the last term of `t₂` equal to `ω^{e₂}`, every `O ⊕ ρ₁ ⊕ ρ₂` with `ρ₁ ≤ t₁`, `ρ₂ < t₂` +lies below `(O ⊕ t₁ ⊕ t₂)_{≥e₂}`. -/ +theorem add_add_lt_partGE_of_lt (ht₂ : t₂ ≠ 0) (he₂ : leastTerm t₂ = ω^ e₂) + {ρ₁ ρ₂ : NatOrdinal.{u}} (hρ₁ : ρ₁ ≤ t₁) (hρ₂ : ρ₂ < t₂) : + O + ρ₁ + ρ₂ < partGE e₂ (O + t₁ + t₂) := by + refine (lt_partGE_add_wpow e₂ _).trans_le ?_ + rw [partGE_add, partGE_add, partGE_add, partGE_add, add_assoc, + partGE_eq_self_of_leastTerm_eq ht₂ he₂] + exact add_le_add (add_le_add_right (partGE_mono hρ₁) _) + (partGE_add_wpow_le_of_lt_of_leastTerm_eq ht₂ he₂ hρ₂) + +/-- `t₁` has a term below `ω^{e₂}` when its last term `ω^{e₁}` has `e₁ < e₂`. -/ +theorem partLT_ne_zero_of_leastTerm_lt (ht₁ : t₁ ≠ 0) (he₁ : leastTerm t₁ = ω^ e₁) + (hlt : e₁ < e₂) : partLT e₂ t₁ ≠ 0 := by + intro h0 + have hGE : partGE e₂ t₁ = t₁ := by + have := partGE_add_partLT e₂ t₁ + rwa [h0, add_zero] at this + have hmem := val_leastTerm_mem ht₁ + rw [he₁] at hmem + have hmem' : (ω^ e₁).val ∈ (partGE e₂ t₁).val.additivePrincipalTerms := by + rw [hGE]; exact hmem + have := wpow_le_of_mem_additivePrincipalTerms_partGE hmem' + exact absurd (NatOrdinal.val.le_iff_le.mp this) (not_le.mpr (wpow_lt_wpow.mpr hlt)) + +/-- **Two summands lowered, `e₁ ≤ e₂`.** The sums `O ⊕ ρ₁ ⊕ ρ₂`, `ρ₁ < t₁`, `ρ₂ < t₂`, are +bounded strictly below `O ⊕ t₁ ⊕ t₂`. -/ +theorem exists_lt_forall_add_add_le_of_le (ht₁ : t₁ ≠ 0) (ht₂ : t₂ ≠ 0) + (he₁ : leastTerm t₁ = ω^ e₁) (he₂ : leastTerm t₂ = ω^ e₂) (hle : e₁ ≤ e₂) : + ∃ B, B < O + t₁ + t₂ ∧ ∀ ρ₁ ρ₂ : NatOrdinal.{u}, ρ₁ < t₁ → ρ₂ < t₂ → O + ρ₁ + ρ₂ ≤ B := by + rcases eq_or_lt_of_le hle with heq | hlt + · -- equal last terms: each of `ρ₁ < t₁`, `ρ₂ < t₂` loses a whole `ω^e` + subst heq + refine ⟨partGE e₁ O + removeLeastTerm t₁ + removeLeastTerm t₂ + ω^ e₁, ?_, ?_⟩ + · -- `B + ω^e = (O ⊕ t₁ ⊕ t₂)_{≥e} ≤ O ⊕ t₁ ⊕ t₂` + have : partGE e₁ O + removeLeastTerm t₁ + removeLeastTerm t₂ + ω^ e₁ + ω^ e₁ = + partGE e₁ (O + t₁ + t₂) := by + rw [partGE_add, partGE_add, partGE_eq_self_of_leastTerm_eq ht₁ he₁, + partGE_eq_self_of_leastTerm_eq ht₂ he₂] + conv_rhs => rw [← removeLeastTerm_add_wpow he₁, ← removeLeastTerm_add_wpow he₂] + abel + calc partGE e₁ O + removeLeastTerm t₁ + removeLeastTerm t₂ + ω^ e₁ + < partGE e₁ O + removeLeastTerm t₁ + removeLeastTerm t₂ + ω^ e₁ + ω^ e₁ := + lt_add_of_pos_right _ (wpow_pos e₁) + _ = partGE e₁ (O + t₁ + t₂) := this + _ ≤ O + t₁ + t₂ := partGE_le e₁ _ + · intro ρ₁ ρ₂ hρ₁ hρ₂ + have h1 := partGE_add_wpow_le_of_lt_of_leastTerm_eq ht₁ he₁ hρ₁ + have h2 := partGE_add_wpow_le_of_lt_of_leastTerm_eq ht₂ he₂ hρ₂ + rw [← removeLeastTerm_add_wpow he₁] at h1 + rw [← removeLeastTerm_add_wpow he₂] at h2 + have h1' := le_of_add_le_add_right h1 + have h2' := le_of_add_le_add_right h2 + refine (lt_partGE_add_wpow e₁ _).le.trans ?_ + rw [partGE_add, partGE_add] + exact add_le_add_left (add_le_add (add_le_add_right h1' _) h2') _ + · -- `e₁ < e₂`: `(O ⊕ t₁ ⊕ t₂)_{≥e₂}` is already below `O ⊕ t₁ ⊕ t₂` + refine ⟨partGE e₂ (O + t₁ + t₂), ?_, fun ρ₁ ρ₂ hρ₁ hρ₂ ↦ + (add_add_lt_partGE_of_lt ht₂ he₂ hρ₁.le hρ₂).le⟩ + have hne : partLT e₂ (O + t₁ + t₂) ≠ 0 := by + have hle : partLT e₂ t₁ ≤ partLT e₂ (O + t₁ + t₂) := by + rw [partLT_add, partLT_add] + exact (le_add_of_nonneg_left zero_le).trans (le_add_of_nonneg_right zero_le) + exact (lt_of_lt_of_le (pos_iff_ne_zero.mpr + (partLT_ne_zero_of_leastTerm_lt ht₁ he₁ hlt)) hle).ne' + conv_rhs => rw [← partGE_add_partLT e₂ (O + t₁ + t₂)] + exact lt_add_of_pos_right _ (pos_iff_ne_zero.mpr hne) + +/-- If `t₁` and `t₂` are nonzero, the sums `O ⊕ ρ₁ ⊕ ρ₂` with `ρ₁ < t₁` and `ρ₂ < t₂` +have a common upper bound strictly below `O ⊕ t₁ ⊕ t₂`. -/ +@[blueprint "lem:two-lowerings-have-strict-bound" + (phase := "Algebraic and ordinal preliminaries") + (title := "Uniform bound for simultaneous decreases in a Hessenberg sum") + (statement := /-- + Let $\sigma_1,\sigma_2\neq0$, with last Cantor terms + $\omega^{e_1}$ and $\omega^{e_2}$. There is + $\mu'<\rho\oplus\sigma_1\oplus\sigma_2$ such that + \[ + \rho\oplus\theta_1\oplus\theta_2\le\mu' + \] + for all $\theta_1<\sigma_1$ and $\theta_2<\sigma_2$. + -/) + (proof := /-- + Interchange the indices if necessary so that $e_1\le e_2$. If $e_1=e_2$, + retain the terms of $\rho$ at exponents at least $e_1$, remove the last + term from each $\sigma_i$, and retain one copy of $\omega^{e_1}$. If + $e_1 rw [← removeLeastTerm_add_wpow he₁, ← removeLeastTerm_add_wpow he₂] + abel + have hCt₂ : AlgebraicLE t₂ C := by + rw [hCdef, hAGE, add_assoc, removeLeastTerm_add_wpow he₂] + exact algebraicLE_add_left _ _ + -- `C ≤ (λ₀)_{≥e}` + have hCl : C ≤ partGE e l := by + by_contra h + rw [not_le] at h + have h1 : partGE e l + ω^ e ≤ C := by + have := partGE_add_wpow_le_of_partGE_lt (e := e) (a := l) (b := C) (by rwa [hCGE]) + rwa [hCGE] at this + have hl' : l < partGE e A + ω^ e := + (lt_partGE_add_wpow e l).trans_le (h1.trans hCdef.le) + obtain ⟨ξ, hξ, hlξ⟩ := exists_lt_add_of_lt_partGE_add_wpow he hl' + have := hall (removeLeastTerm t₁ + ξ) (removeLeastTerm t₂) (by + calc removeLeastTerm t₁ + ξ < removeLeastTerm t₁ + ω^ e := add_lt_add_right hξ _ + _ = t₁ := removeLeastTerm_add_wpow he₁) (removeLeastTerm_lt ht₂) + have hre : A + ξ = O + (removeLeastTerm t₁ + ξ) + removeLeastTerm t₂ := by rw [hAdef]; abel + rw [hre] at hlξ + exact absurd hlξ (not_lt.mpr this) + -- `(λ₀)_{≥e} ≤ C + ω^e`, so it is `C` or `C + ω^e` + have hlC : partGE e l ≤ C + ω^ e := by rw [hCμ]; exact partGE_mono hl.le + rcases eq_or_eq_add_wpow_of_le_of_le hCGE (partGE_partGE e l) hCl hlC with h | h + · rw [← h] at hCt₂ + exact hCt₂.trans (algebraicLE_partGE e l) + · exact (hCt₂.trans (algebraicLE_add_right _ _)).trans (h ▸ algebraicLE_partGE e l) + +/-- Suppose `t₁` and `t₂` are nonzero with the same last Cantor term `ω^e`, where `e ≠ 0`. +If `λ₀ < O ⊕ t₁ ⊕ t₂` bounds every `O ⊕ ρ₁ ⊕ ρ₂` with `ρᵢ < tᵢ`, then +`t₁ ⊕ ν = λ₀` for some `ν`. -/ +theorem algebraicLE_left_of_forall_add_add_le (ht₁ : t₁ ≠ 0) (ht₂ : t₂ ≠ 0) + (he₁ : leastTerm t₁ = ω^ e) (he₂ : leastTerm t₂ = ω^ e) (he : e ≠ 0) {l : NatOrdinal.{u}} + (hl : l < O + t₁ + t₂) (hall : ∀ ρ₁ ρ₂ : NatOrdinal.{u}, ρ₁ < t₁ → ρ₂ < t₂ → O + ρ₁ + ρ₂ ≤ l) : + AlgebraicLE t₁ l := + algebraicLE_of_forall_add_add_le (O := O) ht₂ ht₁ he₂ he₁ he (by rwa [add_right_comm] at hl) + fun ρ₂ ρ₁ hρ₂ hρ₁ ↦ by rw [add_right_comm]; exact hall ρ₁ ρ₂ hρ₁ hρ₂ + +/-! ### The comparison forced by failure of the algebraic-order relation -/ + +/-- **The exponents are strictly ordered, and the bound agrees above the larger one.** Suppose +`λ₀ < O ⊕ t₁ ⊕ t₂` bounds every `O ⊕ ρ₁ ⊕ ρ₂` with `ρ₁ < t₁` and `ρ₂ < t₂`, that the last Cantor +terms of `t₁` and `t₂` are `ω^{e₁}` and `ω^{e₂}` with `e₁ ≠ 0`, and that `t₁` is *not* a natural +summand of `λ₀`. Then `e₁ < e₂`, and `(λ₀)_{≥e₂} = (O ⊕ t₁ ⊕ t₂)_{≥e₂}`. + +Equal exponents would give `t₁ ≼ λ₀`, and so would the reverse comparison, so +the failure forces the order; the agreement above the larger exponent then follows. -/ +theorem lt_and_partGE_eq_of_not_algebraicLE (ht₁ : t₁ ≠ 0) (ht₂ : t₂ ≠ 0) + (he₁ : leastTerm t₁ = ω^ e₁) (he₂ : leastTerm t₂ = ω^ e₂) (he₁0 : e₁ ≠ 0) + {l : NatOrdinal.{u}} (hl : l < O + t₁ + t₂) + (hall : ∀ ρ₁ ρ₂ : NatOrdinal.{u}, ρ₁ < t₁ → ρ₂ < t₂ → O + ρ₁ + ρ₂ ≤ l) + (hdiff : ¬ AlgebraicLE t₁ l) : + e₁ < e₂ ∧ partGE e₂ l = partGE e₂ (O + t₁ + t₂) := by + have hl' : l < O + t₂ + t₁ := by rwa [add_right_comm] at hl + have hall' : ∀ ρ₂ ρ₁ : NatOrdinal.{u}, ρ₂ < t₂ → ρ₁ < t₁ → O + ρ₂ + ρ₁ ≤ l := + fun ρ₂ ρ₁ hρ₂ hρ₁ ↦ by rw [add_right_comm]; exact hall ρ₁ ρ₂ hρ₁ hρ₂ + have hlt : e₁ < e₂ := by + rcases lt_trichotomy e₁ e₂ with h | h | h + · exact h + · subst h + exact absurd + (algebraicLE_of_forall_add_add_le (O := O) ht₂ ht₁ he₂ he₁ he₁0 hl' hall') hdiff + · exact absurd + (algebraicLE_right_of_forall_add_add_le (O := O) ht₂ ht₁ he₂ he₁ h hl' hall') hdiff + exact ⟨hlt, partGE_eq_of_forall_add_add_le ht₁ ht₂ he₁ he₂ hlt hl hall⟩ + +/-! ### A uniform bound over a finite family -/ + +/-- **Finitely many bounds below a common ceiling have a common bound below it.** For a property +that only weakens as the bound grows, a family of bounds indexed by a finite set can be replaced by +their maximum. -/ +theorem exists_lt_forall_of_forall_exists_lt {ι' : Type*} (s : Finset ι') {μ : NatOrdinal.{u}} + (hμ : 0 < μ) (P : ι' → NatOrdinal.{u} → Prop) + (hmono : ∀ x, ∀ {B B' : NatOrdinal.{u}}, B ≤ B' → P x B → P x B') + (h : ∀ x ∈ s, ∃ B, B < μ ∧ P x B) : + ∃ B, B < μ ∧ ∀ x ∈ s, P x B := by + classical + revert h + induction s using Finset.induction_on with + | empty => exact fun _ ↦ ⟨0, hμ, fun x hx ↦ absurd hx (Finset.notMem_empty x)⟩ + | insert a s ha ih => + intro h + obtain ⟨B₁, hB₁, hP₁⟩ := h a (Finset.mem_insert_self a s) + obtain ⟨B₂, hB₂, hP₂⟩ := ih fun x hx ↦ h x (Finset.mem_insert_of_mem hx) + refine ⟨max B₁ B₂, max_lt hB₁ hB₂, fun x hx ↦ ?_⟩ + rcases Finset.mem_insert.mp hx with rfl | hx + · exact hmono x (le_max_left _ _) hP₁ + · exact hmono x (le_max_right _ _) (hP₂ x hx) + +end NatOrdinal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Separation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Separation.lean new file mode 100644 index 0000000000..461dd57928 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Separation.lean @@ -0,0 +1,277 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Split +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTermSup + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# The separation condition + +For ordinals `b`, `c`, `τ` with `c ≠ 0` (in the vocabulary of degrees: `b` the degree of a cofactor, +`c` the degree of a generator) the *separation condition* (n) reads + + (n) `b ⊕ θ < τ` for every `θ < c`. + +Writing `ω^β` for the last term of the Cantor normal form of `c`, the condition (n) forces +`(b ⊕ c)_{≥β} ≤ τ` (`partGE_add_wpow_le_of_forall_add_lt`): the natural sums `b ⊕ θ`, `θ < c`, +approach `(b ⊕ c)_{≥β}` from below. Consequently every degree `h'` with `τ < h' ≤ b ⊕ c` has the +same part at or above `β` as `b ⊕ c`, and `c ≼ h'` in the algebraic order: `h' = b' ⊕ c` with +`b' = b_{≥β} ⊕ h'_{<β} ≤ b` (`exists_le_add_eq_of_forall_add_lt`). The condition can hold with +`τ < b ⊕ c` only because `sup_{θ < c} (b ⊕ θ)` may fall short of `b ⊕ c`, as for +`sup_{θ < ω} (θ ⊕ 1) = ω < ω ⊕ 1`. +-/ + +universe u + +open Ordinal + +public noncomputable section + +namespace NatOrdinal + +/-- The natural sum of an ordinal all of whose Cantor terms are at least `w` and an ordinal all of +whose Cantor terms are at most `w` is their ordinal sum. -/ +theorem of_add_of_eq_add_of_forall_le {u t : Ordinal.{u}} {w : Ordinal.{u}} + (hu : ∀ s ∈ u.additivePrincipalTerms, w ≤ s) (ht : ∀ s ∈ t.additivePrincipalTerms, s ≤ w) : + NatOrdinal.of u + NatOrdinal.of t = NatOrdinal.of (u + t) := by + have hsorted : (u.additivePrincipalTerms ++ t.additivePrincipalTerms).SortedGE := by + rw [List.sortedGE_iff_pairwise, List.pairwise_append] + refine ⟨List.sortedGE_iff_pairwise.mp (additivePrincipalTerms_sortedGE u), + List.sortedGE_iff_pairwise.mp (additivePrincipalTerms_sortedGE t), fun s hs s' hs' ↦ ?_⟩ + exact (ht s' hs').trans (hu s hs) + have hprincipal : ∀ s ∈ u.additivePrincipalTerms ++ t.additivePrincipalTerms, + IsAdditivelyPrincipal s := fun s hs ↦ by + rcases List.mem_append.mp hs with h | h + · exact isAdditivelyPrincipal_of_mem_additivePrincipalTerms h + · exact isAdditivelyPrincipal_of_mem_additivePrincipalTerms h + have h := natOrdinal_of_sum_eq_sum_map_of_sorted hprincipal hsorted + have hu' := sum_map_of_additivePrincipalTerms (NatOrdinal.of u) + have ht' := sum_map_of_additivePrincipalTerms (NatOrdinal.of t) + rw [NatOrdinal.val_of] at hu' ht' + rw [List.sum_append, additivePrincipalTerms_sum, additivePrincipalTerms_sum, List.map_append, + List.sum_append, hu', ht'] at h + exact h.symm + +/-- If every term of the Cantor normal form of `a` is at least `ω^β`, the part of `a` below `β` +is `0`. -/ +theorem partLT_eq_zero_of_forall_le {β a : NatOrdinal.{u}} + (h : ∀ t ∈ a.val.additivePrincipalTerms, (ω^ β).val ≤ t) : partLT β a = 0 := by + by_contra hne + have hmem : (leastTerm (partLT β a)).val ∈ + (partGE β a + partLT β a).val.additivePrincipalTerms := + (mem_additivePrincipalTerms_add_iff _ _ _).mpr (Or.inr (val_leastTerm_mem hne)) + rw [partGE_add_partLT] at hmem + exact absurd (h _ hmem) + (not_le.mpr (lt_wpow_of_mem_additivePrincipalTerms_partLT (val_leastTerm_mem hne))) + +/-- If every term of the Cantor normal form of `a` is at least `ω^β`, then `a` is its own part at +or above `β`. -/ +theorem partGE_eq_self_of_forall_le {β a : NatOrdinal.{u}} + (h : ∀ t ∈ a.val.additivePrincipalTerms, (ω^ β).val ≤ t) : partGE β a = a := by + have := partGE_add_partLT β a + rwa [partLT_eq_zero_of_forall_le h, add_zero] at this + +/-- Taking the part at or above `β` is idempotent. -/ +theorem partGE_partGE (β a : NatOrdinal.{u}) : + partGE β (partGE β a) = partGE β a := + partGE_eq_self_of_forall_le fun _ ht ↦ wpow_le_of_mem_additivePrincipalTerms_partGE ht + +/-- The part of `a` at or above `β` is at most `a`. -/ +theorem partGE_le (β a : NatOrdinal.{u}) : partGE β a ≤ a := by + conv_rhs => rw [← partGE_add_partLT β a] + exact le_add_of_nonneg_right zero_le + +/-- The natural sum of the two parts of `a` at `β` is their ordinal sum. -/ +theorem val_partGE_add_val_partLT (β a : NatOrdinal.{u}) : + partGE β a + partLT β a = NatOrdinal.of ((partGE β a).val + (partLT β a).val) := + of_add_of_eq_add_of_forall_lt + (fun _ hs ↦ wpow_le_of_mem_additivePrincipalTerms_partGE hs) + (fun _ hs ↦ lt_wpow_of_mem_additivePrincipalTerms_partLT hs) + +/-- A power of `ω` divides an ordinal exactly when the lower part of its Cantor normal form +vanishes. -/ +theorem wpow_dvd_val_iff_partLT_eq_zero (β a : NatOrdinal.{u}) : + (ω^ β).val ∣ a.val ↔ partLT β a = 0 := by + rw [Ordinal.dvd_iff_mod_eq_zero] + obtain ⟨q, hq⟩ := exists_val_partGE_eq_mul β a + have hsplit := val_eq_val_partGE_add_val_partLT β a + have hlt : (partLT β a).val < (ω^ β).val := + NatOrdinal.val.lt_iff_lt.mpr (partLT_lt β a) + rw [hsplit, hq, Ordinal.mul_add_mod_self, Ordinal.mod_eq_of_lt hlt] + exact NatOrdinal.val_eq_zero + +/-- Adding `ω^β` to a part at or above `β` is an ordinal sum. -/ +theorem partGE_add_wpow (β a : NatOrdinal.{u}) : + partGE β a + ω^ β = NatOrdinal.of ((partGE β a).val + (ω^ β).val) := + of_add_of_eq_add_of_forall_le + (fun _ hs ↦ wpow_le_of_mem_additivePrincipalTerms_partGE hs) + (fun s hs ↦ by + have hs' : s ∈ (ω ^ β.val).additivePrincipalTerms := hs + rw [additivePrincipalTerms_of_isAdditivelyPrincipal + (Ordinal.isAdditivelyPrincipal_iff.mpr ⟨β.val, rfl⟩), List.mem_singleton] at hs' + exact hs'.le) + +/-- `ω^β` is its own part at or above `β`. -/ +theorem partGE_wpow (β : NatOrdinal.{u}) : partGE β (ω^ β) = ω^ β := + partGE_eq_self_of_forall_le fun s hs ↦ by + have hs' : s ∈ (ω ^ β.val).additivePrincipalTerms := hs + rw [additivePrincipalTerms_of_isAdditivelyPrincipal + (Ordinal.isAdditivelyPrincipal_iff.mpr ⟨β.val, rfl⟩), List.mem_singleton] at hs' + exact hs'.ge + +/-- Every term of the Cantor normal form of `a ≠ 0` is at least its last term, written `ω^β`. -/ +theorem wpow_le_of_mem_additivePrincipalTerms_of_leastTerm_eq {a β : NatOrdinal.{u}} (ha : a ≠ 0) + (hβ : leastTerm a = ω^ β) {t : Ordinal.{u}} (ht : t ∈ a.val.additivePrincipalTerms) : + (ω^ β).val ≤ t := by + have := leastTerm_le_of_mem ha ht + rw [hβ] at this + exact NatOrdinal.val.le_iff_le.mpr this + +/-- The last term of the Cantor normal form of `a ≠ 0` is a power `ω^β`. -/ +theorem exists_leastTerm_eq_wpow {a : NatOrdinal.{u}} (ha : a ≠ 0) : + ∃ β : NatOrdinal.{u}, leastTerm a = ω^ β := by + obtain ⟨e, he⟩ := Ordinal.isAdditivelyPrincipal_iff.mp (isAdditivelyPrincipal_leastTerm ha) + exact ⟨NatOrdinal.of e, NatOrdinal.val.injective (by rw [he]; rfl)⟩ + +/-- If `g ⊕ x < τ` for every `x < ω^β`, then the sum of the terms in the Cantor normal form of +`g ⊕ ω^β` whose exponents are at least `β` is at most `τ`. -/ +@[blueprint "lem:separation-bounds-high-part" + (phase := "Algebraic and ordinal preliminaries") + (title := "Upper Cantor-term bound for a Hessenberg sum") + (statement := /-- + If $\rho\oplus\theta<\tau$ for every $\theta<\omega^\beta$, then the + sum of the terms in the Cantor normal form of $\rho\oplus\omega^\beta$ + whose exponents are at least $\beta$ is at most $\tau$. + -/) + (proof := /-- + If this sum exceeded $\tau$, monotonicity would force the sums of the + terms in the Cantor normal forms of $\rho$ and $\tau$ at exponents at + least $\beta$ to agree. + Decomposing $\tau$ at $\beta$ would then give + $\tau\le\rho\oplus\tau_{<\beta}$, where $\tau_{<\beta}<\omega^\beta$ + is the sum of its remaining terms, contradicting the hypothesis. + -/)] +theorem partGE_add_wpow_le_of_forall_add_lt {g β τ : NatOrdinal.{u}} + (h : ∀ x, x < ω^ β → g + x < τ) : partGE β (g + ω^ β) ≤ τ := by + by_contra hlt + rw [not_le, partGE_add, partGE_wpow] at hlt + -- `g ≤ τ`, so the part of `τ` at or above `β` is at least that of `g`; it cannot exceed it. + have hgτ : g ≤ τ := by + have := h 0 (NatOrdinal.wpow_pos β) + rw [add_zero] at this + exact this.le + have hτg : partGE β τ = partGE β g := by + refine le_antisymm ?_ (partGE_mono hgτ) + by_contra hgt + rw [not_le] at hgt + have h1 := add_le_of_dvd_of_lt (exists_val_partGE_eq_mul β g) + (exists_val_partGE_eq_mul β τ) (NatOrdinal.val.lt_iff_lt.mpr hgt) + have h2 : partGE β g + ω^ β ≤ partGE β τ := by + rw [partGE_add_wpow, ← NatOrdinal.of_val (partGE β τ), NatOrdinal.of.le_iff_le] + exact h1 + exact absurd (h2.trans (partGE_le β τ)) (not_le.mpr hlt) + -- write `τ = τ_{≥β} + τ_{<β}` and compare with `g ⊕ τ_{<β}`. + have hτ : partGE β g + partLT β τ = τ := by + rw [← hτg, val_partGE_add_val_partLT, ← val_eq_val_partGE_add_val_partLT, + NatOrdinal.of_val] + have h3 : partGE β g + partLT β τ ≤ g + partLT β τ := + add_le_add_left (partGE_le β g) _ + rw [hτ] at h3 + exact absurd h3 (not_le.mpr (h _ (partLT_lt β τ))) + +/-- If `c ≠ 0`, `b ⊕ θ < τ` for every `θ < c`, and `τ < h' ≤ b ⊕ c`, then +`h' = b' ⊕ c` for some `b' ≤ b`. -/ +@[blueprint "lem:intermediate-ordinal-hessenberg-decomposition" + (phase := "Algebraic and ordinal preliminaries") + (title := "Intermediate ordinals below a Hessenberg sum") + (statement := /-- + Let $\sigma\ne0$ and suppose + $\rho\oplus\theta<\tau$ for every $\theta<\sigma$. If + $\tau rw [← partGE_add_partLT β a] + rw [constantCoeff_add, constantCoeff_partGE hβ, zero_add] + + +/-- The last term of the Cantor normal form of a nonzero limit natural ordinal is `ω^e` with +`e ≠ 0`. -/ +theorem exists_leastTerm_eq_wpow_ne_zero {a : NatOrdinal} (ha : a ≠ 0) (hcc : a.constantCoeff = 0) : + ∃ e, e ≠ 0 ∧ leastTerm a = ω^ e := by + obtain ⟨e, he⟩ := exists_leastTerm_eq_wpow ha + refine ⟨e, fun he0 ↦ ?_, he⟩ + rw [he0, wpow_zero, ← removeLeastTerm_add_one_eq_self_iff] at he + rw [← he, show (1 : NatOrdinal) = ((1 : ℕ) : NatOrdinal) by rw [Nat.cast_one], + constantCoeff_add_natCast] at hcc + omega + +end NatOrdinal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/SetOrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/SetOrderType.lean new file mode 100644 index 0000000000..48c1f5476a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/SetOrderType.lean @@ -0,0 +1,613 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Basic +public import Mathlib.Order.WellFoundedSet +public import Mathlib.SetTheory.Ordinal.Principal +public import Mathlib.SetTheory.Cardinal.Aleph + +import Mathlib.Data.Sum.Order +import Mathlib.Order.Hom.Set + +/-! +# Order type of a partially well-ordered set + +A partially well-ordered subset of a linear order is well-ordered by the induced strict order. +This module assigns it that ordinary ordinal order type. The order is always the ambient order, +with no reversal. + +The union theorem proves a slightly more general form of LM24, Fact 2.2.3(2): the two sets need not +first be exhibited as subsets of a common well-ordered set. Its right-hand side uses addition in +`NatOrdinal`, hence Hessenberg's natural sum rather than ordinary ordinal addition. + +Mathlib supplies `Ordinal.type_sum_lex`, `Ordinal.type_eq`, `OrderIso.sumLexIioIci`, and ordinal +enumeration, but no theorem equivalent to LM24, Fact 2.2.3(1), nor its uniqueness consequence. +The proof reuses the lexicographic-sum and order-isomorphism infrastructure rather than defining +a new ordinal representation. +-/ + +universe u + +public noncomputable section + +namespace Set.IsPWO + +open Ordinal + +variable {α : Type u} [LinearOrder α] {s t : Set α} + +@[reducible] private def isWellOrder (hs : s.IsPWO) : + IsWellOrder s (Subrel (· < ·) (· ∈ s)) where + wf := hs.isWF + trichotomous := fun _ _ hab hba ↦ + Subtype.ext (le_antisymm (le_of_not_gt hba) (le_of_not_gt hab)) + +/-- The ordinary ordinal order type of a partially well-ordered subset of a linear order. -/ +def orderType (hs : s.IsPWO) : Ordinal.{u} := + @Ordinal.type s (Subrel (· < ·) (· ∈ s)) (isWellOrder hs) + +/-- A countable partially well-ordered set has order type below `ω₁`. -/ +theorem orderType_lt_omega_one_of_countable (hs : s.IsPWO) (hc : s.Countable) : + hs.orderType < ω₁ := by + rw [orderType, Cardinal.lt_omega_iff_card_lt, card_type, Cardinal.lt_aleph_one_iff, + Cardinal.le_aleph0_iff_set_countable] + exact hc + +/-- The order type does not depend on the proof that the set is partially well-ordered. -/ +theorem orderType_proof_irrel (hs ht : s.IsPWO) : hs.orderType = ht.orderType := by + rfl + +/-- A partially well-ordered set has order type zero exactly when it is empty. -/ +@[simp] +theorem orderType_eq_zero (hs : s.IsPWO) : hs.orderType = 0 ↔ s = ∅ := by + letI := isWellOrder hs + rw [orderType, Ordinal.type_eq_zero_iff_isEmpty, isEmpty_subtype] + exact Set.eq_empty_iff_forall_notMem.symm + +/-- For a globally well-ordered ambient type, `orderType` agrees with `typeLT` on the subtype. -/ +theorem orderType_eq_typeLT [WellFoundedLT α] (hs : s.IsPWO) : + hs.orderType = typeLT s := by + rfl + +/-- Compute the order type through an order isomorphism from the set to a well-ordered type. -/ +theorem orderType_eq_typeLT_of_orderIso {A : Type u} [LinearOrder A] [WellFoundedLT A] + (hs : s.IsPWO) (e : s ≃o A) : hs.orderType = typeLT A := by + letI := isWellOrder hs + let er : Subrel (· < ·) (· ∈ s) ≃r (· < · : A → A → Prop) := + e.toRelIsoLT + exact er.ordinalType_congr + +/-- A partially well-ordered set is order-isomorphic to the canonical well order of its ordinary +order type. -/ +theorem nonempty_orderIso_toType (hs : s.IsPWO) : Nonempty (hs.orderType.ToType ≃o s) := by + letI : WellFoundedLT s := ⟨hs.isWF⟩ + have htypes : typeLT hs.orderType.ToType = typeLT s := by + rw [type_toType] + exact hs.orderType_eq_typeLT_of_orderIso (OrderIso.refl s) + exact ⟨OrderIso.ofRelIsoLT (Classical.choice (Ordinal.type_eq.mp htypes))⟩ + +/-- Compute the order type through a relation isomorphism from the set to an arbitrary +well-order. -/ +theorem orderType_eq_type_of_relIso {A : Type u} {r : A → A → Prop} + [IsWellOrder A r] (hs : s.IsPWO) + (e : Subrel (· < ·) (· ∈ s) ≃r r) : + hs.orderType = Ordinal.type r := by + letI := isWellOrder hs + exact e.ordinalType_congr + +/-- Equal subsets have equal order types. -/ +theorem orderType_congr (hs : s.IsPWO) (ht : t.IsPWO) (h : s = t) : + hs.orderType = ht.orderType := by + subst t + rfl + +/-- Inclusion of partially well-ordered subsets cannot decrease their ordinary order type. -/ +theorem orderType_mono (hs : s.IsPWO) (ht : t.IsPWO) (h : s ⊆ t) : + hs.orderType ≤ ht.orderType := by + letI := isWellOrder hs + letI := isWellOrder ht + exact (Subrel.inclusionEmbedding (· < ·) h).ordinal_type_le + +/-- A strictly increasing image has the same ordinary order type as the original partially +well-ordered set. -/ +theorem orderType_image_of_strictMonoOn {B : Type u} [LinearOrder B] + (hs : s.IsPWO) {f : α → B} (hf : StrictMonoOn f s) : + (hs.image_of_monotoneOn hf.monotoneOn).orderType = hs.orderType := by + letI : WellFoundedLT s := ⟨hs.isWF⟩ + let e : s ≃o f '' s := + StrictMonoOn.orderIso f s hf + exact + ((hs.image_of_monotoneOn hf.monotoneOn).orderType_eq_typeLT_of_orderIso e.symm).trans + (hs.orderType_eq_typeLT_of_orderIso (OrderIso.refl s)).symm + +/-- A well-ordered set has order type `a + b` exactly when it is the union of a set of order +type `a` followed strictly by a set of order type `b`. This is LM24, Fact 2.2.3(1). -/ +theorem orderType_eq_add_iff (hs : s.IsPWO) (a b : Ordinal.{u}) : + hs.orderType = a + b ↔ + ∃ (s₀ s₁ : Set α) (hs₀ : s₀.IsPWO) (hs₁ : s₁.IsPWO), + s₀ ⊆ s ∧ + s₁ ⊆ s ∧ + (∀ x ∈ s₀, ∀ y ∈ s₁, x < y) ∧ + hs₀.orderType = a ∧ + hs₁.orderType = b ∧ + s = s₀ ∪ s₁ := by + constructor + · intro htype + letI : WellFoundedLT s := ⟨hs.isWF⟩ + letI : WellFoundedLT (a.ToType ⊕ₗ b.ToType) := + ⟨Sum.lex_wf wellFounded_lt wellFounded_lt⟩ + have htypes : typeLT s = typeLT (a.ToType ⊕ₗ b.ToType) := by + calc + typeLT s = hs.orderType := + (hs.orderType_eq_typeLT_of_orderIso (OrderIso.refl s)).symm + _ = a + b := htype + _ = typeLT (a.ToType ⊕ₗ b.ToType) := by + symm + calc + typeLT (a.ToType ⊕ₗ b.ToType) = + Ordinal.type (Sum.Lex (· < · : a.ToType → a.ToType → Prop) + (· < · : b.ToType → b.ToType → Prop)) := + (Sum.Lex.toLexRelIsoLT (α := a.ToType) + (β := b.ToType)).ordinalType_congr.symm + _ = a + b := by + rw [Ordinal.type_sum_lex, Ordinal.type_toType, Ordinal.type_toType] + let e : s ≃o a.ToType ⊕ₗ b.ToType := + OrderIso.ofRelIsoLT (Classical.choice (Ordinal.type_eq.mp htypes)) + let left : a.ToType ↪o α := + OrderEmbedding.ofStrictMono + (fun x ↦ (e.symm (Sum.inlₗ x)).1) + (fun _ _ hxy ↦ e.symm.strictMono (Sum.Lex.inl_strictMono hxy)) + let right : b.ToType ↪o α := + OrderEmbedding.ofStrictMono + (fun x ↦ (e.symm (Sum.inrₗ x)).1) + (fun _ _ hxy ↦ e.symm.strictMono (Sum.Lex.inr_strictMono hxy)) + let s₀ : Set α := Set.range left + let s₁ : Set α := Set.range right + have hs₀s : s₀ ⊆ s := by + rintro x ⟨y, rfl⟩ + exact (e.symm (Sum.inlₗ y)).2 + have hs₁s : s₁ ⊆ s := by + rintro x ⟨y, rfl⟩ + exact (e.symm (Sum.inrₗ y)).2 + let hs₀ : s₀.IsPWO := hs.mono hs₀s + let hs₁ : s₁.IsPWO := hs.mono hs₁s + have hs₀type : hs₀.orderType = a := by + rw [hs₀.orderType_eq_typeLT_of_orderIso left.orderIso.symm, + Ordinal.type_toType] + have hs₁type : hs₁.orderType = b := by + rw [hs₁.orderType_eq_typeLT_of_orderIso right.orderIso.symm, + Ordinal.type_toType] + have hbefore : ∀ x ∈ s₀, ∀ y ∈ s₁, x < y := by + rintro _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ + exact e.symm.strictMono (Sum.Lex.inl_lt_inr x y) + have hunion : s = s₀ ∪ s₁ := by + apply Set.Subset.antisymm + · intro x hx + rcases heq : e ⟨x, hx⟩ with y | y + · left + refine ⟨y, ?_⟩ + change (e.symm (Sum.inlₗ y)).1 = x + have h := e.symm_apply_apply ⟨x, hx⟩ + rw [heq] at h + exact congrArg Subtype.val h + · right + refine ⟨y, ?_⟩ + change (e.symm (Sum.inrₗ y)).1 = x + have h := e.symm_apply_apply ⟨x, hx⟩ + rw [heq] at h + exact congrArg Subtype.val h + · exact Set.union_subset hs₀s hs₁s + exact ⟨s₀, s₁, hs₀, hs₁, hs₀s, hs₁s, hbefore, hs₀type, hs₁type, hunion⟩ + · rintro ⟨s₀, s₁, hs₀, hs₁, hs₀s, hs₁s, hbefore, hs₀type, hs₁type, hunion⟩ + let f : s₀ ⊕ₗ s₁ → s + | Sum.inlₗ x => ⟨x, hs₀s x.2⟩ + | Sum.inrₗ x => ⟨x, hs₁s x.2⟩ + have hf : StrictMono f := by + intro x y hxy + rcases x with x | x <;> rcases y with y | y + · have hxy' : x < y := + (Sum.Lex.inl_lt_inl_iff (α := s₀) (β := s₁)).mp hxy + exact hxy' + · exact hbefore x x.2 y y.2 + · exact (Sum.Lex.not_inr_lt_inl hxy).elim + · have hxy' : x < y := + (Sum.Lex.inr_lt_inr_iff (α := s₀) (β := s₁)).mp hxy + exact hxy' + have hsurj : Function.Surjective f := by + rintro ⟨x, hx⟩ + rw [hunion] at hx + rcases hx with hx | hx + · exact ⟨Sum.inlₗ ⟨x, hx⟩, rfl⟩ + · exact ⟨Sum.inrₗ ⟨x, hx⟩, rfl⟩ + let e : s₀ ⊕ₗ s₁ ≃o s := hf.orderIsoOfSurjective f hsurj + letI : WellFoundedLT s₀ := ⟨hs₀.isWF⟩ + letI : WellFoundedLT s₁ := ⟨hs₁.isWF⟩ + letI : WellFoundedLT (s₀ ⊕ₗ s₁) := + ⟨Sum.lex_wf wellFounded_lt wellFounded_lt⟩ + calc + hs.orderType = typeLT (s₀ ⊕ₗ s₁) := + hs.orderType_eq_typeLT_of_orderIso e.symm + _ = typeLT s₀ + typeLT s₁ := Ordinal.type_sum_lex _ _ + _ = hs₀.orderType + hs₁.orderType := by + rw [hs₀.orderType_eq_typeLT_of_orderIso (OrderIso.refl s₀), + hs₁.orderType_eq_typeLT_of_orderIso (OrderIso.refl s₁)] + _ = a + b := by rw [hs₀type, hs₁type] + +/-- A partially well-ordered set is finite exactly when its order type is below `ω`. -/ +theorem finite_iff_orderType_lt_omega (hs : s.IsPWO) : + s.Finite ↔ hs.orderType < Ordinal.omega0 := by + letI := isWellOrder hs + rw [Set.Finite, ← Cardinal.mk_lt_aleph0_iff] + rw [orderType, ← Ordinal.card_type (Subrel (· < ·) (· ∈ s)), Ordinal.card_lt_aleph0] + +/-- Every infinite partially well-ordered set is an initial block of nonzero limit order type +followed by a finite final block. The split removes the finite remainder after ordinal division of +the order type by `ω`. -/ +theorem finite_or_exists_limit_initial_finite_final (hs : s.IsPWO) : + s.Finite ∨ + ∃ (s₀ s₁ : Set α) (hs₀ : s₀.IsPWO) (_ : s₁.IsPWO), + s₀ ⊆ s ∧ + s₁ ⊆ s ∧ + (∀ x ∈ s₀, ∀ y ∈ s₁, x < y) ∧ + Order.IsSuccLimit hs₀.orderType ∧ + s₁.Finite ∧ + s = s₀ ∪ s₁ := by + by_cases hfinite : s.Finite + · exact Or.inl hfinite + · right + have homega : Ordinal.omega0 ≤ hs.orderType := by + exact le_of_not_gt (hfinite ∘ hs.finite_iff_orderType_lt_omega.mpr) + have hdivpos : 0 < hs.orderType / Ordinal.omega0 := by + exact (Ordinal.div_pos Ordinal.omega0_ne_zero).mpr homega + have hlimit : Order.IsSuccLimit + (Ordinal.omega0 * (hs.orderType / Ordinal.omega0)) := + Ordinal.isSuccLimit_mul_left Ordinal.isSuccLimit_omega0 hdivpos + have hmodlt : hs.orderType % Ordinal.omega0 < Ordinal.omega0 := + Ordinal.mod_lt hs.orderType Ordinal.omega0_ne_zero + have hdecomp : + hs.orderType = Ordinal.omega0 * (hs.orderType / Ordinal.omega0) + + hs.orderType % Ordinal.omega0 := + (Ordinal.div_add_mod hs.orderType Ordinal.omega0).symm + obtain ⟨s₀, s₁, hs₀, hs₁, hs₀s, hs₁s, hbefore, hs₀type, hs₁type, hunion⟩ := + (hs.orderType_eq_add_iff + (Ordinal.omega0 * (hs.orderType / Ordinal.omega0)) + (hs.orderType % Ordinal.omega0)).mp hdecomp + refine ⟨s₀, s₁, hs₀, hs₁, hs₀s, hs₁s, hbefore, ?_, ?_, hunion⟩ + · rwa [hs₀type] + · rw [hs₁.finite_iff_orderType_lt_omega, hs₁type] + exact hmodlt + +private def belowRelIso {x : α} (hx : x ∈ s) : + Subrel (· < ·) (· ∈ s ∩ Set.Iio x) ≃r + Subrel (Subrel (· < ·) (· ∈ s)) + (Subrel (· < ·) (· ∈ s) · ⟨x, hx⟩) where + toFun a := ⟨⟨a.1, a.2.1⟩, a.2.2⟩ + invFun a := ⟨a.1.1, a.1.2, a.2⟩ + left_inv _ := rfl + right_inv _ := rfl + map_rel_iff' := Iff.rfl + +private def interIioOrderIso {x : α} (hx : x ∈ s) : + ↥(s ∩ Set.Iio x) ≃o Set.Iio (⟨x, hx⟩ : s) where + toFun z := ⟨⟨z.1, z.2.1⟩, z.2.2⟩ + invFun z := ⟨z.1.1, z.1.2, z.2⟩ + left_inv _ := rfl + right_inv _ := rfl + map_rel_iff' := Iff.rfl + +private def interIciOrderIso {x : α} (hx : x ∈ s) : + ↥(s ∩ Set.Ici x) ≃o Set.Ici (⟨x, hx⟩ : s) where + toFun z := ⟨⟨z.1, z.2.1⟩, z.2.2⟩ + invFun z := ⟨z.1.1, z.1.2, z.2⟩ + left_inv _ := rfl + right_inv _ := rfl + map_rel_iff' := Iff.rfl + +/-- The part of a partially well-ordered set strictly below one of its elements has order type +equal to the index of that element. -/ +theorem orderType_inter_Iio_eq_typein [WellFoundedLT s] + (hs : s.IsPWO) {x : α} (hx : x ∈ s) : + (hs.mono (s := s ∩ Set.Iio x) Set.inter_subset_left).orderType = + Ordinal.typein (· < · : s → s → Prop) ⟨x, hx⟩ := by + letI : WellFoundedLT s := ⟨hs.isWF⟩ + rw [orderType_eq_typeLT_of_orderIso _ (interIioOrderIso hx), ← Ordinal.type_Iio_lt] + +/-- Splitting a partially well-ordered set at one of its elements splits its order type. -/ +theorem orderType_inter_Iio_add_inter_Ici [WellFoundedLT s] + (hs : s.IsPWO) {x : α} (hx : x ∈ s) : + (hs.mono (s := s ∩ Set.Iio x) Set.inter_subset_left).orderType + + (hs.mono (s := s ∩ Set.Ici x) Set.inter_subset_left).orderType = + hs.orderType := by + letI : WellFoundedLT (Set.Iio (⟨x, hx⟩ : s) ⊕ₗ Set.Ici (⟨x, hx⟩ : s)) := + ⟨Sum.lex_wf wellFounded_lt wellFounded_lt⟩ + rw [orderType_eq_typeLT_of_orderIso _ (interIioOrderIso hx), + orderType_eq_typeLT_of_orderIso _ (interIciOrderIso hx), + ← Ordinal.type_sum_lex] + calc + _ = typeLT s := + (OrderIso.sumLexIioIci (⟨x, hx⟩ : s)).toRelIsoLT.ordinalType_congr + _ = hs.orderType := + (orderType_eq_typeLT_of_orderIso hs (OrderIso.refl s)).symm + +/-- Every ordinal below the order type is realized as the order type of the part strictly below +some element. -/ +theorem exists_orderType_inter_Iio_eq (hs : s.IsPWO) {k : Ordinal.{u}} + (hk : k < hs.orderType) : + ∃ x, ∃ _ : x ∈ s, + (hs.mono (s := s ∩ Set.Iio x) Set.inter_subset_left).orderType = k := by + letI : WellFoundedLT s := ⟨hs.isWF⟩ + have htype : k < Ordinal.type (· < · : s → s → Prop) := by + rwa [← hs.orderType_eq_typeLT_of_orderIso (OrderIso.refl s)] + obtain ⟨y, hy⟩ := Ordinal.typein_surj (· < · : s → s → Prop) htype + exact ⟨y.1, y.2, (orderType_inter_Iio_eq_typein hs y.2).trans (by simpa using hy)⟩ + +/-- The part of a partially well-ordered set strictly below one of its elements has strictly smaller +order type. -/ +theorem orderType_inter_Iio_lt (hs : s.IsPWO) {x : α} (hx : x ∈ s) : + (hs.mono (s := s ∩ Set.Iio x) Set.inter_subset_left).orderType < hs.orderType := by + letI := isWellOrder hs + let hbelow := hs.mono (s := s ∩ Set.Iio x) Set.inter_subset_left + letI := isWellOrder hbelow + calc + hbelow.orderType = Ordinal.type + (Subrel (Subrel (· < ·) (· ∈ s)) + (Subrel (· < ·) (· ∈ s) · ⟨x, hx⟩)) := + (belowRelIso hx).ordinalType_congr + _ = Ordinal.typein (Subrel (· < ·) (· ∈ s)) ⟨x, hx⟩ := + Ordinal.type_subrel _ _ + _ < hs.orderType := Ordinal.typein_lt_type _ _ + +/-- If every closed initial segment has order type below `o`, then the whole partially +well-ordered set has order type at most `o`. -/ +theorem orderType_le_of_forall_inter_Iic_lt (hs : s.IsPWO) {o : Ordinal} + (h : ∀ x ∈ s, + (hs.mono (s := s ∩ Set.Iic x) Set.inter_subset_left).orderType < o) : + hs.orderType ≤ o := by + by_contra hle + have ho : o < hs.orderType := lt_of_not_ge hle + letI := isWellOrder hs + obtain ⟨x, hx⟩ := + Ordinal.typein_surj (Subrel (· < ·) (· ∈ s)) ho + let hbelow := hs.mono (s := s ∩ Set.Iio x.1) Set.inter_subset_left + letI := isWellOrder hbelow + have hiio : + (hs.mono (s := s ∩ Set.Iio x.1) Set.inter_subset_left).orderType = o := by + calc + hbelow.orderType = Ordinal.type + (Subrel (Subrel (· < ·) (· ∈ s)) + (Subrel (· < ·) (· ∈ s) · x)) := + (belowRelIso x.2).ordinalType_congr + _ = Ordinal.typein (Subrel (· < ·) (· ∈ s)) x := + Ordinal.type_subrel _ _ + _ = o := hx + have hsubset : s ∩ Set.Iio x.1 ⊆ s ∩ Set.Iic x.1 := by + intro y hy + exact ⟨hy.1, hy.2.le⟩ + have hmono := + (hs.mono (s := s ∩ Set.Iio x.1) Set.inter_subset_left).orderType_mono + (hs.mono (s := s ∩ Set.Iic x.1) Set.inter_subset_left) hsubset + exact (not_lt_of_ge (hiio ▸ hmono)) (h x.1 x.2) + +/-- If the ordinary order type is a limit ordinal, every member has a strictly larger member. -/ +theorem exists_gt_of_isSuccLimit_orderType + (hs : s.IsPWO) (hlimit : Order.IsSuccLimit hs.orderType) + {x : α} (hx : x ∈ s) : + ∃ y ∈ s, x < y := by + letI : WellFoundedLT s := ⟨hs.isWF⟩ + have hprelimit : Order.IsSuccPrelimit + (Ordinal.type (fun x y : s ↦ x < y)) := by + rw [← hs.orderType_eq_typeLT_of_orderIso (OrderIso.refl s)] + exact hlimit.isSuccPrelimit + letI : NoMaxOrder s := + Ordinal.isSuccPrelimit_type_lt_iff.mp hprelimit + obtain ⟨y, hxy⟩ : ∃ y : s, (⟨x, hx⟩ : s) < y := + exists_gt (⟨x, hx⟩ : s) + exact ⟨y.1, y.2, hxy⟩ + +/-- A nonempty partially well-ordered set with no maximum has successor-limit order type. This is +the converse of `Set.IsPWO.exists_gt_of_isSuccLimit_orderType`. -/ +theorem isSuccLimit_orderType_of_forall_exists_gt + (hs : s.IsPWO) (hne : s.Nonempty) (hgt : ∀ x ∈ s, ∃ y ∈ s, x < y) : + Order.IsSuccLimit hs.orderType := by + letI : WellFoundedLT s := ⟨hs.isWF⟩ + have hnomax : NoMaxOrder s := by + constructor + rintro ⟨x, hx⟩ + obtain ⟨y, hy, hxy⟩ := hgt x hx + exact ⟨⟨y, hy⟩, hxy⟩ + refine ⟨?_, ?_⟩ + · rw [isMin_iff_eq_bot, Ordinal.bot_eq_zero, hs.orderType_eq_zero] + obtain ⟨x, hx⟩ := hne + intro hempty + rw [hempty] at hx + exact hx + · rw [hs.orderType_eq_typeLT_of_orderIso (OrderIso.refl s)] + exact Ordinal.isSuccPrelimit_type_lt_iff.mpr hnomax + +/-- A nonempty final segment of a partially well-ordered set of additively principal order type +has the same order type as the whole set. -/ +theorem orderType_inter_Ioi_eq_of_isPrincipal + (hs : s.IsPWO) (hprincipal : IsPrincipal (fun a b ↦ a + b) hs.orderType) + {x : α} (hupper : ∃ y ∈ s, x < y) : + (hs.mono (s := s ∩ Set.Ioi x) Set.inter_subset_left).orderType = hs.orderType := by + let lower : Set α := s ∩ Set.Iic x + let upper : Set α := s ∩ Set.Ioi x + let hlower : lower.IsPWO := hs.mono Set.inter_subset_left + let hupperPWO : upper.IsPWO := hs.mono Set.inter_subset_left + change hupperPWO.orderType = hs.orderType + have hlowerBeforeUpper : ∀ a ∈ lower, ∀ b ∈ upper, a < b := by + intro a ha b hb + exact ha.2.trans_lt hb.2 + have hsUnion : s = lower ∪ upper := by + ext a + simp only [lower, upper, Set.mem_union, Set.mem_inter_iff, Set.mem_Iic, Set.mem_Ioi] + constructor + · intro ha + rcases le_or_gt a x with hax | hxa + · exact Or.inl ⟨ha, hax⟩ + · exact Or.inr ⟨ha, hxa⟩ + · rintro (⟨ha, _⟩ | ⟨ha, _⟩) <;> exact ha + have hsplit : hs.orderType = hlower.orderType + hupperPWO.orderType := by + apply (hs.orderType_eq_add_iff hlower.orderType hupperPWO.orderType).mpr + exact ⟨lower, upper, hlower, hupperPWO, Set.inter_subset_left, + Set.inter_subset_left, hlowerBeforeUpper, rfl, rfl, hsUnion⟩ + obtain ⟨y, hyS, hxy⟩ := hupper + have hlowerSubset : lower ⊆ s ∩ Set.Iio y := by + intro a ha + exact ⟨ha.1, ha.2.trans_lt hxy⟩ + have hlowerLt : hlower.orderType < hs.orderType := + (hlower.orderType_mono + (hs.mono (s := s ∩ Set.Iio y) Set.inter_subset_left) hlowerSubset).trans_lt + (hs.orderType_inter_Iio_lt hyS) + apply le_antisymm + · exact hupperPWO.orderType_mono hs Set.inter_subset_left + · apply le_of_not_gt + intro hupperLt + have hsumLt := hprincipal hlowerLt hupperLt + change hlower.orderType + hupperPWO.orderType < hs.orderType at hsumLt + rw [← hsplit] at hsumLt + exact (lt_irrefl hs.orderType) hsumLt + +/-- Two decompositions into a first part followed strictly by a second part are equal when their +first parts have the same order type. -/ +theorem orderType_split_unique {s₀ s₁ t₀ t₁ : Set α} + (hs₀ : s₀.IsPWO) (ht₀ : t₀.IsPWO) + (hsBefore : ∀ x ∈ s₀, ∀ y ∈ s₁, x < y) + (htBefore : ∀ x ∈ t₀, ∀ y ∈ t₁, x < y) + (hsUnion : s = s₀ ∪ s₁) (htUnion : s = t₀ ∪ t₁) + (htype : hs₀.orderType = ht₀.orderType) : + s₀ = t₀ ∧ s₁ = t₁ := by + have hs₀t₀ : s₀ ⊆ t₀ := by + intro x hx + by_contra hxt₀ + have hxs : x ∈ s := by + rw [hsUnion] + exact Set.mem_union_left s₁ hx + rw [htUnion] at hxs + have hxt₁ : x ∈ t₁ := hxs.resolve_left hxt₀ + have ht₀sub : t₀ ⊆ s₀ ∩ Set.Iio x := by + intro y hyt₀ + have hyx : y < x := htBefore y hyt₀ x hxt₁ + have hys : y ∈ s := by + rw [htUnion] + exact Set.mem_union_left t₁ hyt₀ + rw [hsUnion] at hys + refine ⟨?_, hyx⟩ + exact hys.resolve_right fun hys₁ ↦ (hsBefore x hx y hys₁).not_gt hyx + have hlt : ht₀.orderType < hs₀.orderType := + (orderType_mono ht₀ + (hs₀.mono (s := s₀ ∩ Set.Iio x) Set.inter_subset_left) ht₀sub).trans_lt + (orderType_inter_Iio_lt hs₀ hx) + exact hlt.ne htype.symm + have ht₀s₀ : t₀ ⊆ s₀ := by + intro x hx + by_contra hxs₀ + have hxs : x ∈ s := by + rw [htUnion] + exact Set.mem_union_left t₁ hx + rw [hsUnion] at hxs + have hxs₁ : x ∈ s₁ := hxs.resolve_left hxs₀ + have hs₀sub : s₀ ⊆ t₀ ∩ Set.Iio x := by + intro y hys₀ + have hyx : y < x := hsBefore y hys₀ x hxs₁ + have hys : y ∈ s := by + rw [hsUnion] + exact Set.mem_union_left s₁ hys₀ + rw [htUnion] at hys + refine ⟨?_, hyx⟩ + exact hys.resolve_right fun hyt₁ ↦ (htBefore x hx y hyt₁).not_gt hyx + have hlt : hs₀.orderType < ht₀.orderType := + (orderType_mono hs₀ + (ht₀.mono (s := t₀ ∩ Set.Iio x) Set.inter_subset_left) hs₀sub).trans_lt + (orderType_inter_Iio_lt ht₀ hx) + exact hlt.ne htype + have hs₀eq : s₀ = t₀ := Set.Subset.antisymm hs₀t₀ ht₀s₀ + refine ⟨hs₀eq, Set.Subset.antisymm ?_ ?_⟩ + · intro x hxs₁ + have hxs : x ∈ s := by + rw [hsUnion] + exact Set.mem_union_right s₀ hxs₁ + rw [htUnion] at hxs + exact hxs.resolve_left fun hxt₀ ↦ + (hsBefore x (hs₀eq ▸ hxt₀) x hxs₁).false + · intro x hxt₁ + have hxs : x ∈ s := by + rw [htUnion] + exact Set.mem_union_right t₀ hxt₁ + rw [hsUnion] at hxs + exact hxs.resolve_left fun hxs₀ ↦ + (htBefore x (hs₀eq ▸ hxs₀) x hxt₁).false + +private theorem orderType_inter_Iio_mono (hs : s.IsPWO) {x y : α} (hxy : x ≤ y) : + (hs.mono Set.inter_subset_left (s := s ∩ Set.Iio x)).orderType ≤ + (hs.mono Set.inter_subset_left (s := s ∩ Set.Iio y)).orderType := by + apply orderType_mono + intro z hz + exact ⟨hz.1, hz.2.trans_le hxy⟩ + +private theorem orderType_inter_Iio_lt_inter_Iio (hs : s.IsPWO) {x y : α} + (hx : x ∈ s) (hxy : x < y) : + (hs.mono Set.inter_subset_left (s := s ∩ Set.Iio x)).orderType < + (hs.mono Set.inter_subset_left (s := s ∩ Set.Iio y)).orderType := by + let hsy : (s ∩ Set.Iio y).IsPWO := hs.mono Set.inter_subset_left + have hxsy : x ∈ s ∩ Set.Iio y := ⟨hx, hxy⟩ + have hlt := hsy.orderType_inter_Iio_lt hxsy + have heq : (s ∩ Set.Iio y) ∩ Set.Iio x = s ∩ Set.Iio x := by + ext z + constructor + · exact fun hz ↦ ⟨hz.1.1, hz.2⟩ + · exact fun hz ↦ ⟨⟨hz.1, hz.2.trans hxy⟩, hz.2⟩ + rw [orderType_congr _ _ heq] at hlt + exact hlt + +/-- The order type of a union is at most the Hessenberg sum of the two order types. This +specializes to LM24, Fact 2.2.3(2). -/ +theorem orderType_union_le_naturalAdd (hs : s.IsPWO) (ht : t.IsPWO) : + (hs.union ht).orderType ≤ + (NatOrdinal.of hs.orderType + NatOrdinal.of ht.orderType).val := by + let hsBelow (x : α) : (s ∩ Set.Iio x).IsPWO := + hs.mono Set.inter_subset_left + let htBelow (x : α) : (t ∩ Set.Iio x).IsPWO := + ht.mono Set.inter_subset_left + let rankS (x : α) : NatOrdinal := NatOrdinal.of (hsBelow x).orderType + let rankT (x : α) : NatOrdinal := NatOrdinal.of (htBelow x).orderType + let total : NatOrdinal := NatOrdinal.of hs.orderType + NatOrdinal.of ht.orderType + have rank_lt_total (x : α) (hx : x ∈ s ∪ t) : rankS x + rankT x < total := by + have hsle : rankS x ≤ NatOrdinal.of hs.orderType := + NatOrdinal.of.monotone (orderType_mono (hsBelow x) hs Set.inter_subset_left) + have htle : rankT x ≤ NatOrdinal.of ht.orderType := + NatOrdinal.of.monotone (orderType_mono (htBelow x) ht Set.inter_subset_left) + rcases hx with hxs | hxt + · exact add_lt_add_of_lt_of_le + (NatOrdinal.of.strictMono (orderType_inter_Iio_lt hs hxs)) htle + · exact add_lt_add_of_le_of_lt hsle + (NatOrdinal.of.strictMono (orderType_inter_Iio_lt ht hxt)) + let rank (x : ↥(s ∪ t)) : total.val.ToType := + Ordinal.ToType.mk ⟨(rankS x.1 + rankT x.1).val, + NatOrdinal.val.lt_iff_lt.mpr (rank_lt_total x.1 x.2)⟩ + have rank_strict {x y : ↥(s ∪ t)} (hxy : x < y) : rank x < rank y := by + have hsle : rankS x.1 ≤ rankS y.1 := + NatOrdinal.of.monotone (orderType_inter_Iio_mono hs hxy.le) + have htle : rankT x.1 ≤ rankT y.1 := + NatOrdinal.of.monotone (orderType_inter_Iio_mono ht hxy.le) + have hsum : rankS x.1 + rankT x.1 < rankS y.1 + rankT y.1 := by + rcases x.2 with hxs | hxt + · exact add_lt_add_of_lt_of_le + (NatOrdinal.of.strictMono + (orderType_inter_Iio_lt_inter_Iio hs hxs hxy)) htle + · exact add_lt_add_of_le_of_lt hsle + (NatOrdinal.of.strictMono + (orderType_inter_Iio_lt_inter_Iio ht hxt hxy)) + exact Ordinal.ToType.mk.lt_iff_lt.mpr (NatOrdinal.val.lt_iff_lt.mpr hsum) + let e : Subrel (· < ·) (· ∈ s ∪ t) ↪r + (· < · : total.val.ToType → total.val.ToType → Prop) := + RelEmbedding.ofMonotone rank fun _ _ hxy ↦ rank_strict hxy + letI := isWellOrder (hs.union ht) + change Ordinal.type (Subrel (· < ·) (· ∈ s ∪ t)) ≤ total.val + simpa only [Ordinal.type_toType] using e.ordinal_type_le + +end Set.IsPWO diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Split.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Split.lean new file mode 100644 index 0000000000..2141c92403 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Split.lean @@ -0,0 +1,322 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorTermCount +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPrincipal +public import Mathlib.Algebra.Order.BigOperators.Group.List + +/-! +# The parts of an ordinal at or above, and below, an exponent + +For a natural ordinal `a` and an exponent `β`, write the Cantor normal form of `a` with repeated +terms [LM24, §2.2] as `a = ω^{e_1} + ⋯ + ω^{e_r}` with `e_1 ≥ ⋯ ≥ e_r`, and let `a_{≥β}` be the sum +of the terms with `e_i ≥ β` and `a_{<β}` the sum of those with `e_i < β` — the *part of `a` at or +above `β`* (Lean `partGE β a`) and the *part of `a` below `β`* (`partLT β a`). Then +`a = a_{≥β} + a_{<β} = a_{≥β} ⊕ a_{<β}`, `a_{<β} < ω^β`, `a_{≥β}` is a multiple of `ω^β`, and both +parts are additive for the natural sum `⊕`, the Cantor normal form of a natural sum being the merge +of the two normal forms. This is the bookkeeping used when a grading by ordinals is split at an +exponent. +-/ + +universe u + +open Ordinal + +public noncomputable section + +namespace NatOrdinal + +open scoped Classical in +/-- The part `a_{≥β}` of `a` at or above `β`: the sum of the terms `ω^e` of the Cantor normal form +of `a` with `e ≥ β`. -/ +def partGE (β a : NatOrdinal.{u}) : NatOrdinal.{u} := + ((a.val.additivePrincipalTerms.filter fun t ↦ (ω^ β).val ≤ t).map NatOrdinal.of).sum + +open scoped Classical in +/-- The part `a_{<β}` of `a` below `β`: the sum of the terms `ω^e` of the Cantor normal form of `a` +with `e < β`. -/ +def partLT (β a : NatOrdinal.{u}) : NatOrdinal.{u} := + ((a.val.additivePrincipalTerms.filter fun t ↦ t < (ω^ β).val).map NatOrdinal.of).sum + +/-- A natural ordinal is the natural sum of its Cantor terms. -/ +theorem sum_map_of_additivePrincipalTerms (a : NatOrdinal.{u}) : + (a.val.additivePrincipalTerms.map NatOrdinal.of).sum = a := by + rw [← natOrdinal_of_sum_eq_sum_map_of_sorted + (fun t ht ↦ isAdditivelyPrincipal_of_mem_additivePrincipalTerms ht) + (additivePrincipalTerms_sortedGE _), additivePrincipalTerms_sum, NatOrdinal.of_val] + +/-- Splitting a list sum along a predicate. -/ +theorem sum_map_filter_add_sum_map_filter_not {l : List Ordinal.{u}} (p : Ordinal.{u} → Prop) + [DecidablePred p] : + ((l.filter p).map NatOrdinal.of).sum + ((l.filter fun t ↦ ¬ p t).map NatOrdinal.of).sum = + (l.map NatOrdinal.of).sum := by + induction l with + | nil => simp + | cons a l ih => + by_cases ha : p a + · rw [List.filter_cons_of_pos (by simpa using ha), List.filter_cons_of_neg (by simpa using ha), + List.map_cons, List.sum_cons, List.map_cons, List.sum_cons, add_assoc, ih] + · rw [List.filter_cons_of_neg (by simpa using ha), List.filter_cons_of_pos (by simpa using ha), + List.map_cons, List.sum_cons, List.map_cons, List.sum_cons, add_left_comm, ih] + +/-- `a = a_{≥β} + a_{<β}`. -/ +theorem partGE_add_partLT (β a : NatOrdinal.{u}) : + partGE β a + partLT β a = a := by + classical + rw [partGE, partLT] + have h := sum_map_filter_add_sum_map_filter_not (l := a.val.additivePrincipalTerms) + fun t ↦ (ω^ β).val ≤ t + simp only [not_le] at h + rw [h, sum_map_of_additivePrincipalTerms] + +/-- The sum of the `of` of a list of ordinals is invariant under permutation. -/ +theorem sum_map_of_perm {l l' : List Ordinal.{u}} (h : l.Perm l') : + (l.map NatOrdinal.of).sum = (l'.map NatOrdinal.of).sum := + (h.map NatOrdinal.of).sum_eq + +/-- The part at or above `β` is additive for the natural sum. -/ +theorem partGE_add (β a b : NatOrdinal.{u}) : + partGE β (a + b) = partGE β a + partGE β b := by + classical + rw [partGE, partGE, partGE, ← List.sum_append, ← List.map_append, + ← List.filter_append] + exact sum_map_of_perm ((additivePrincipalTerms_add_perm a b).filter _) + +/-- The part below `β` is additive for the natural sum. -/ +theorem partLT_add (β a b : NatOrdinal.{u}) : + partLT β (a + b) = partLT β a + partLT β b := by + classical + rw [partLT, partLT, partLT, ← List.sum_append, ← List.map_append, + ← List.filter_append] + exact sum_map_of_perm ((additivePrincipalTerms_add_perm a b).filter _) + +/-- A natural sum of finitely many ordinals below `ω^β` is below `ω^β`. -/ +theorem sum_map_of_lt_wpow {l : List Ordinal.{u}} {β : NatOrdinal.{u}} + (h : ∀ t ∈ l, t < (ω^ β).val) : (l.map NatOrdinal.of).sum < ω^ β := by + induction l with + | nil => simp [NatOrdinal.wpow_pos] + | cons a l ih => + rw [List.map_cons, List.sum_cons] + refine add_lt_of_isAdditivelyPrincipal ?_ ?_ (ih fun t ht ↦ h t (List.mem_cons_of_mem a ht)) + · rw [NatOrdinal.val_wpow] + exact isAdditivelyPrincipal_omega0_opow _ + · rw [← NatOrdinal.of_val (ω^ β)] + exact NatOrdinal.of.lt_iff_lt.mpr (h a (List.mem_cons_self ..)) + +/-- The part of `a` below `β` is below `ω^β`. -/ +theorem partLT_lt (β a : NatOrdinal.{u}) : partLT β a < ω^ β := by + classical + rw [partLT] + exact sum_map_of_lt_wpow fun t ht ↦ of_decide_eq_true (List.mem_filter.mp ht).2 + +@[simp] +theorem partGE_zero (β : NatOrdinal.{u}) : partGE β 0 = 0 := by + classical + simp [partGE] + +@[simp] +theorem partLT_zero (β : NatOrdinal.{u}) : partLT β 0 = 0 := by + classical + simp [partLT] + +/-- Taking the part at or above `β`, as an endomorphism of the natural-sum monoid. -/ +def partGEAddMonoidHom (β : NatOrdinal.{u}) : NatOrdinal.{u} →+ NatOrdinal.{u} where + toFun := partGE β + map_zero' := partGE_zero β + map_add' := partGE_add β + +/-- Taking the part below `β`, as an endomorphism of the natural-sum monoid. -/ +def partLTAddMonoidHom (β : NatOrdinal.{u}) : NatOrdinal.{u} →+ NatOrdinal.{u} where + toFun := partLT β + map_zero' := partLT_zero β + map_add' := partLT_add β + +@[simp] +theorem partGEAddMonoidHom_apply (β a : NatOrdinal.{u}) : partGEAddMonoidHom β a = partGE β a := + (rfl) + +@[simp] +theorem partLTAddMonoidHom_apply (β a : NatOrdinal.{u}) : partLTAddMonoidHom β a = partLT β a := + (rfl) + +theorem partGE_nsmul (β : NatOrdinal.{u}) (n : ℕ) (a : NatOrdinal.{u}) : + partGE β (n • a) = n • partGE β a := by + simpa using (partGEAddMonoidHom β).map_nsmul n a + +theorem partLT_nsmul (β : NatOrdinal.{u}) (n : ℕ) (a : NatOrdinal.{u}) : + partLT β (n • a) = n • partLT β a := by + simpa using (partLTAddMonoidHom β).map_nsmul n a + +theorem partGE_sum {ι : Type*} (β : NatOrdinal.{u}) (s : Finset ι) (f : ι → NatOrdinal.{u}) : + partGE β (∑ i ∈ s, f i) = ∑ i ∈ s, partGE β (f i) := by + rw [← partGEAddMonoidHom_apply β (∑ i ∈ s, f i), map_sum] + exact Finset.sum_congr rfl fun i _ ↦ partGEAddMonoidHom_apply β (f i) + +theorem partLT_sum {ι : Type*} (β : NatOrdinal.{u}) (s : Finset ι) (f : ι → NatOrdinal.{u}) : + partLT β (∑ i ∈ s, f i) = ∑ i ∈ s, partLT β (f i) := by + rw [← partLTAddMonoidHom_apply β (∑ i ∈ s, f i), map_sum] + exact Finset.sum_congr rfl fun i _ ↦ partLTAddMonoidHom_apply β (f i) + +/-- Every Cantor term of `a` is at most `a`. -/ +theorem of_le_of_mem_additivePrincipalTerms {a : NatOrdinal.{u}} {t : Ordinal.{u}} + (ht : t ∈ a.val.additivePrincipalTerms) : NatOrdinal.of t ≤ a := by + have h := sum_map_of_additivePrincipalTerms a + rw [← h] + exact List.single_le_sum (fun _ _ ↦ zero_le) _ (List.mem_map_of_mem ht) + +/-- An ordinal below `ω^β` has part `0` at or above `β`. -/ +theorem partGE_eq_zero_of_lt {β a : NatOrdinal.{u}} (ha : a < ω^ β) : partGE β a = 0 := by + classical + rw [partGE, List.filter_eq_nil_iff.mpr, List.map_nil, List.sum_nil] + intro t ht + rw [decide_eq_true_eq, not_le] + have h := (of_le_of_mem_additivePrincipalTerms ht).trans_lt ha + rw [← NatOrdinal.of_val (ω^ β)] at h + exact NatOrdinal.of.lt_iff_lt.mp h + +/-- An ordinal below `ω^β` is its own part below `β`. -/ +theorem partLT_eq_self_of_lt {β a : NatOrdinal.{u}} (ha : a < ω^ β) : partLT β a = a := by + have h := partGE_add_partLT β a + rwa [partGE_eq_zero_of_lt ha, zero_add] at h + +/-! ### The part at or above `β` is a multiple of `ω^β`; the two parts add as an ordinal sum -/ + +/-- The part of `a` at or above `β` is a multiple of `ω^β`: all its terms are at least `ω^β`. -/ +theorem exists_val_partGE_eq_mul (β a : NatOrdinal.{u}) : + ∃ q : Ordinal.{u}, (partGE β a).val = (ω^ β).val * q := by + classical + rw [partGE] + have hsorted : (a.val.additivePrincipalTerms.filter fun t ↦ (ω^ β).val ≤ t).SortedGE := + List.sortedGE_iff_pairwise.mpr + ((List.sortedGE_iff_pairwise.mp (additivePrincipalTerms_sortedGE _)).sublist + List.filter_sublist) + have hprincipal : ∀ t ∈ a.val.additivePrincipalTerms.filter fun t ↦ (ω^ β).val ≤ t, + IsAdditivelyPrincipal t := fun t ht ↦ + isAdditivelyPrincipal_of_mem_additivePrincipalTerms (List.mem_of_mem_filter ht) + rw [← natOrdinal_of_sum_eq_sum_map_of_sorted hprincipal hsorted, NatOrdinal.val_of] + -- every term is a power `ω^e` with `e ≥ β` + have hterm : ∀ t ∈ a.val.additivePrincipalTerms.filter fun t ↦ (ω^ β).val ≤ t, + ∃ q, t = (ω^ β).val * q := fun t ht ↦ by + have hle : (ω^ β).val ≤ t := of_decide_eq_true (List.mem_filter.mp ht).2 + obtain ⟨e, rfl⟩ := isAdditivelyPrincipal_iff.mp (hprincipal t ht) + rw [NatOrdinal.val_wpow] at hle ⊢ + have hβe : β.val ≤ e := (opow_le_opow_iff_right one_lt_omega0).mp hle + exact ⟨ω ^ (e - β.val), by rw [← opow_add, Ordinal.add_sub_cancel_of_le hβe]⟩ + have hmul : ∀ l : List Ordinal.{u}, (∀ t ∈ l, ∃ q, t = (ω^ β).val * q) → + ∃ q, l.sum = (ω^ β).val * q := by + intro l hl + induction l with + | nil => exact ⟨0, by simp⟩ + | cons t l ih => + obtain ⟨q₁, hq₁⟩ := hl t (List.mem_cons_self ..) + obtain ⟨q₂, hq₂⟩ := ih fun t' ht' ↦ hl t' (List.mem_cons_of_mem t ht') + exact ⟨q₁ + q₂, by rw [List.sum_cons, hq₁, hq₂, mul_add]⟩ + exact hmul _ hterm + +/-- Two multiples of `w` are at least `w` apart. -/ +theorem add_le_of_dvd_of_lt {w u v : Ordinal.{u}} (hu : ∃ q, u = w * q) (hv : ∃ q, v = w * q) + (huv : u < v) : u + w ≤ v := by + obtain ⟨qu, rfl⟩ := hu + obtain ⟨qv, rfl⟩ := hv + have hw : 0 < w := by + rcases eq_or_ne w 0 with rfl | h + · simp at huv + · exact pos_iff_ne_zero.mpr h + have hq : qu < qv := by + by_contra hle + rw [not_lt] at hle + exact absurd huv (not_lt.mpr (mul_le_mul_right hle w)) + calc w * qu + w = w * Order.succ qu := (Ordinal.mul_succ w qu).symm + _ ≤ w * qv := mul_le_mul_right (Order.succ_le_of_lt hq) w + +/-- The natural sum of an ordinal all of whose Cantor terms are at least `w` and an ordinal all of +whose Cantor terms are below `w` is their ordinal sum. -/ +theorem of_add_of_eq_add_of_forall_lt {u t : Ordinal.{u}} {w : Ordinal.{u}} + (hu : ∀ s ∈ u.additivePrincipalTerms, w ≤ s) (ht : ∀ s ∈ t.additivePrincipalTerms, s < w) : + NatOrdinal.of u + NatOrdinal.of t = NatOrdinal.of (u + t) := by + have hsorted : (u.additivePrincipalTerms ++ t.additivePrincipalTerms).SortedGE := by + rw [List.sortedGE_iff_pairwise, List.pairwise_append] + refine ⟨List.sortedGE_iff_pairwise.mp (additivePrincipalTerms_sortedGE u), + List.sortedGE_iff_pairwise.mp (additivePrincipalTerms_sortedGE t), fun s hs s' hs' ↦ ?_⟩ + exact ((ht s' hs').trans_le (hu s hs)).le + have hprincipal : ∀ s ∈ u.additivePrincipalTerms ++ t.additivePrincipalTerms, + IsAdditivelyPrincipal s := fun s hs ↦ by + rcases List.mem_append.mp hs with h | h + · exact isAdditivelyPrincipal_of_mem_additivePrincipalTerms h + · exact isAdditivelyPrincipal_of_mem_additivePrincipalTerms h + have h := natOrdinal_of_sum_eq_sum_map_of_sorted hprincipal hsorted + have hu' := sum_map_of_additivePrincipalTerms (NatOrdinal.of u) + have ht' := sum_map_of_additivePrincipalTerms (NatOrdinal.of t) + rw [NatOrdinal.val_of] at hu' ht' + rw [List.sum_append, additivePrincipalTerms_sum, additivePrincipalTerms_sum, List.map_append, + List.sum_append, hu', ht'] at h + exact h.symm + +/-- The terms of the Cantor normal form of `a_{≥β}` are at least `ω^β`. -/ +theorem wpow_le_of_mem_additivePrincipalTerms_partGE {β a : NatOrdinal.{u}} {s : Ordinal.{u}} + (hs : s ∈ (partGE β a).val.additivePrincipalTerms) : (ω^ β).val ≤ s := by + classical + have hmem := mem_of_mem_additivePrincipalTerms_natSum + (L := a.val.additivePrincipalTerms.filter fun t ↦ (ω^ β).val ≤ t) + (fun t ht ↦ isAdditivelyPrincipal_of_mem_additivePrincipalTerms (List.mem_of_mem_filter ht)) + (by rwa [partGE] at hs) + exact of_decide_eq_true (List.mem_filter.mp hmem).2 + +/-- The terms of the Cantor normal form of `a_{<β}` are below `ω^β`. -/ +theorem lt_wpow_of_mem_additivePrincipalTerms_partLT {β a : NatOrdinal.{u}} {s : Ordinal.{u}} + (hs : s ∈ (partLT β a).val.additivePrincipalTerms) : s < (ω^ β).val := by + classical + have hmem := mem_of_mem_additivePrincipalTerms_natSum + (L := a.val.additivePrincipalTerms.filter fun t ↦ t < (ω^ β).val) + (fun t ht ↦ isAdditivelyPrincipal_of_mem_additivePrincipalTerms (List.mem_of_mem_filter ht)) + (by rwa [partLT] at hs) + exact of_decide_eq_true (List.mem_filter.mp hmem).2 + +/-- `a = a_{≥β} + a_{<β}` as an ordinal sum. -/ +theorem val_eq_val_partGE_add_val_partLT (β a : NatOrdinal.{u}) : + a.val = (partGE β a).val + (partLT β a).val := by + have h := of_add_of_eq_add_of_forall_lt (w := (ω^ β).val) + (fun s hs ↦ wpow_le_of_mem_additivePrincipalTerms_partGE (β := β) (a := a) hs) + (fun s hs ↦ lt_wpow_of_mem_additivePrincipalTerms_partLT (β := β) (a := a) hs) + rw [NatOrdinal.of_val, NatOrdinal.of_val, partGE_add_partLT] at h + have := congrArg NatOrdinal.val h + rwa [NatOrdinal.val_of] at this + +/-- The part at or above `β` is monotone. -/ +theorem partGE_mono {β a b : NatOrdinal.{u}} (hab : a ≤ b) : + partGE β a ≤ partGE β b := by + by_contra hlt + rw [not_le] at hlt + have h1 := add_le_of_dvd_of_lt (exists_val_partGE_eq_mul β b) + (exists_val_partGE_eq_mul β a) (NatOrdinal.val.lt_iff_lt.mpr hlt) + have h2 : b.val < a.val := by + calc b.val = (partGE β b).val + (partLT β b).val := + val_eq_val_partGE_add_val_partLT β b + _ < (partGE β b).val + (ω^ β).val := + (add_lt_add_iff_left _).mpr (NatOrdinal.val.lt_iff_lt.mpr (partLT_lt β b)) + _ ≤ (partGE β a).val := h1 + _ ≤ a.val := by + rw [val_eq_val_partGE_add_val_partLT β a] + exact le_self_add + exact absurd (NatOrdinal.val.lt_iff_lt.mp h2) (not_lt.mpr hab) + +/-- Ordinals with the same part at or above `β` are ordered by their parts below `β`. -/ +theorem partLT_lt_of_lt_of_partGE_eq {β a b : NatOrdinal.{u}} (hab : a < b) + (hGE : partGE β a = partGE β b) : partLT β a < partLT β b := by + have h := NatOrdinal.val.lt_iff_lt.mpr hab + rw [val_eq_val_partGE_add_val_partLT β a, val_eq_val_partGE_add_val_partLT β b, + hGE, add_lt_add_iff_left] at h + exact NatOrdinal.val.lt_iff_lt.mp h + +/-- A smaller part at or above `β` forces a smaller ordinal. -/ +theorem lt_of_partGE_lt {β a b : NatOrdinal.{u}} (h : partGE β a < partGE β b) : + a < b := + lt_of_not_ge fun hba ↦ absurd (partGE_mono (β := β) hba) (not_le.mpr h) + +end NatOrdinal + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/SuccessorFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/SuccessorFactorization.lean new file mode 100644 index 0000000000..80a4c83d1d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/SuccessorFactorization.lean @@ -0,0 +1,180 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.MultiplicativelyPrincipal + +import Mathlib.Tactic.NormNum + +/-! +# Multiplicative factors at successor exponents + +Let `alpha` be a natural ordinal whose constant Cantor coefficient is positive. The final +multiplicatively principal factor of `omega ^ alpha` is `omega`; deleting that factor leaves +`omega ^ (alpha.removeNat 1)`. These are the ordinal identities behind Berarducci's principal +and residual values for a principal series of successor degree. + +The proof uses the canonical factorisation from Berarducci, Definition 6.4. It appends `omega` +to the factorisation at the predecessor exponent and invokes the uniqueness theorem for the +nonincreasing factor list. +-/ + +open scoped NatOrdinal + +public noncomputable section + +namespace Ordinal + +private theorem omega0_isMultiplicativelyPrincipal : + IsMultiplicativelyPrincipal omega0 := by + simpa using isMultiplicativelyPrincipal_omega0_opow_opow 0 + +private theorem multiplicativePrincipalFactors_wpow_eq_append_omega0 + (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) : + (omega0 ^ alpha.val).multiplicativePrincipalFactors = + (omega0 ^ (alpha.removeNat 1).val).multiplicativePrincipalFactors ++ [omega0] := by + let factors := (omega0 ^ (alpha.removeNat 1).val).multiplicativePrincipalFactors + have halphaOne : 1 ≤ alpha.constantCoeff := halpha + have hpred : (alpha.removeNat 1).val + ((1 : ℕ) : Ordinal) = alpha.val := by + have h := congrArg NatOrdinal.val (NatOrdinal.removeNat_add_natCast halphaOne) + calc + (alpha.removeNat 1).val + ((1 : ℕ) : Ordinal) = + (alpha.removeNat 1 + (1 : ℕ)).val := + (NatOrdinal.val_add_natCast (alpha.removeNat 1) 1).symm + _ = alpha.val := h + have htargetPrincipal : IsAdditivelyPrincipal (omega0 ^ alpha.val) := + isAdditivelyPrincipal_omega0_opow alpha.val + have hfactorsProd : factors.prod = omega0 ^ (alpha.removeNat 1).val := + multiplicativePrincipalFactors_prod + (isAdditivelyPrincipal_omega0_opow (alpha.removeNat 1).val) + have hprod : (factors ++ [omega0]).prod = omega0 ^ alpha.val := by + rw [List.prod_append, List.prod_singleton, hfactorsProd] + calc + omega0 ^ (alpha.removeNat 1).val * omega0 = + omega0 ^ (alpha.removeNat 1).val * omega0 ^ (1 : Ordinal) := by + congr 1 + exact (opow_one omega0).symm + _ = omega0 ^ ((alpha.removeNat 1).val + (1 : Ordinal)) := + (opow_add _ _ _).symm + _ = omega0 ^ alpha.val := by + apply congrArg (omega0 ^ ·) + simpa using hpred + have hprincipal : ∀ f ∈ factors ++ [omega0], IsMultiplicativelyPrincipal f := by + intro f hf + rw [List.mem_append, List.mem_singleton] at hf + rcases hf with hf | rfl + · exact isMultiplicativelyPrincipal_of_mem_multiplicativePrincipalFactors hf + · exact omega0_isMultiplicativelyPrincipal + have hone : ∀ f ∈ factors ++ [omega0], 1 < f := by + intro f hf + rw [List.mem_append, List.mem_singleton] at hf + rcases hf with hf | rfl + · exact one_lt_of_mem_multiplicativePrincipalFactors hf + · exact one_lt_omega0 + have hsorted : (factors ++ [omega0]).SortedGE := by + rw [List.sortedGE_iff_pairwise, List.pairwise_append] + refine ⟨List.sortedGE_iff_pairwise.mp + (multiplicativePrincipalFactors_sortedGE _), by simp, ?_⟩ + intro f hf g hg + simp only [List.mem_singleton] at hg + subst g + have hinfinite := + isInfiniteMultiplicativelyPrincipal_of_mem_multiplicativePrincipalFactors hf + exact hinfinite.isAdditivelyPrincipal.omega0_le_of_one_lt + (one_lt_of_mem_multiplicativePrincipalFactors hf) + exact + (multiplicativePrincipalFactors_unique + htargetPrincipal hprod hprincipal hone hsorted).symm + +/-- A positive constant Cantor coefficient contributes a final term `1` to the uncompressed +Cantor normal form. -/ +theorem one_mem_additivePrincipalTerms_of_constantCoeff_pos + (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) : + (1 : Ordinal) ∈ alpha.val.additivePrincipalTerms := by + let terms := (alpha.removeNat 1).val.additivePrincipalTerms + have halphaOne : 1 ≤ alpha.constantCoeff := halpha + have hpred : (alpha.removeNat 1).val + (1 : Ordinal) = alpha.val := by + have h := congrArg NatOrdinal.val (NatOrdinal.removeNat_add_natCast halphaOne) + calc + (alpha.removeNat 1).val + (1 : Ordinal) = + (alpha.removeNat 1).val + ((1 : ℕ) : Ordinal) := by norm_num + _ = (alpha.removeNat 1 + (1 : ℕ)).val := + (NatOrdinal.val_add_natCast (alpha.removeNat 1) 1).symm + _ = alpha.val := h + have hsum : (terms ++ [1]).sum = alpha.val := by + rw [List.sum_append, List.sum_singleton, additivePrincipalTerms_sum] + exact hpred + have hprincipal : ∀ a ∈ terms ++ [1], IsAdditivelyPrincipal a := by + intro a ha + rw [List.mem_append, List.mem_singleton] at ha + rcases ha with ha | rfl + · exact isAdditivelyPrincipal_of_mem_additivePrincipalTerms ha + · simpa using isAdditivelyPrincipal_omega0_opow 0 + have hsorted : (terms ++ [1]).SortedGE := by + rw [List.sortedGE_iff_pairwise, List.pairwise_append] + refine ⟨List.sortedGE_iff_pairwise.mp (additivePrincipalTerms_sortedGE _), by simp, ?_⟩ + intro a ha b hb + simp only [List.mem_singleton] at hb + subst b + exact Order.one_le_iff_ne_zero.mpr + (isAdditivelyPrincipal_of_mem_additivePrincipalTerms ha).ne_zero + have hterms : terms ++ [1] = alpha.val.additivePrincipalTerms := + additivePrincipalTerms_unique hsum hprincipal hsorted + rw [← hterms] + simp + +/-- The principal factor of `omega ^ alpha` is `omega` when `alpha` has positive constant +Cantor coefficient. -/ +theorem AdditivePrincipalAboveOne.principalFactor_wpow_of_constantCoeff_pos + (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) + (hadd : IsAdditivelyPrincipal (omega0 ^ alpha.val)) + (hone : 1 < omega0 ^ alpha.val) : + AdditivePrincipalAboveOne.principalFactor + (⟨omega0 ^ alpha.val, hadd, hone⟩ : AdditivePrincipalAboveOne) = omega0 := by + rw [AdditivePrincipalAboveOne.principalFactor_eq_getLast] + let source := (omega0 ^ alpha.val).multiplicativePrincipalFactors + let target := + (omega0 ^ (alpha.removeNat 1).val).multiplicativePrincipalFactors ++ [omega0] + have hsource : source = target := + multiplicativePrincipalFactors_wpow_eq_append_omega0 alpha halpha + calc + source.getLast (multiplicativePrincipalFactors_ne_nil hadd hone) = + target.getLast (by simp [target]) := + List.getLast_congr _ _ hsource + _ = omega0 := by + simp [target] + +/-- The residual factor of `omega ^ alpha` is the power at the predecessor exponent when +`alpha` has positive constant Cantor coefficient. -/ +theorem AdditivePrincipalAboveOne.residualFactor_wpow_of_constantCoeff_pos + (alpha : NatOrdinal) (halpha : 0 < alpha.constantCoeff) + (hadd : IsAdditivelyPrincipal (omega0 ^ alpha.val)) + (hone : 1 < omega0 ^ alpha.val) : + AdditivePrincipalAboveOne.residualFactor + (⟨omega0 ^ alpha.val, hadd, hone⟩ : AdditivePrincipalAboveOne) = + omega0 ^ (alpha.removeNat 1).val := by + rw [AdditivePrincipalAboveOne.residualFactor_eq_dropLast_prod] + let factors := (omega0 ^ (alpha.removeNat 1).val).multiplicativePrincipalFactors + have hsource : (omega0 ^ alpha.val).multiplicativePrincipalFactors = + factors ++ [omega0] := + multiplicativePrincipalFactors_wpow_eq_append_omega0 alpha halpha + rw [hsource] + have hdrop : (factors ++ [omega0]).dropLast = factors := by + induction factors with + | nil => rfl + | cons a factors ih => + cases factors with + | nil => rfl + | cons b factors => + change (a :: b :: (factors ++ [omega0])).dropLast = a :: b :: factors + rw [List.dropLast_cons_cons] + exact congrArg (List.cons a) ih + rw [hdrop] + exact multiplicativePrincipalFactors_prod + (isAdditivelyPrincipal_omega0_opow (alpha.removeNat 1).val) + +end Ordinal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Sumset.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Sumset.lean new file mode 100644 index 0000000000..59060a92df --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Sumset.lean @@ -0,0 +1,334 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +public import Mathlib.Data.Finset.MulAntidiagonal + +import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow +import Mathlib.Data.Sum.Order +import Mathlib.Order.Hom.Lex +import Mathlib.SetTheory.Ordinal.Principal + +/-! +# Order type of a sumset + +For partially well-ordered subsets of a linearly ordered cancellative commutative additive monoid, +this module bounds the ordinary order type of their pointwise sum by the Hessenberg product of +their order types. The result specializes to LM24, Fact 2.2.3(3), where the ambient type is an +ordered abelian group. + +The proof follows the principal-block induction underlying the cited result. If both order types +are additive principal, every proper initial segment of the sumset is covered by two smaller +sumsets. Otherwise, a nonprincipal factor is split after its leading Cantor monomial, compatibly +with Hessenberg addition, and distributivity reduces the claim to strictly smaller products. +-/ + +universe u + +public noncomputable section + +open scoped Pointwise + +namespace Set.IsPWO + +open Ordinal + +variable {α : Type u} [LinearOrder α] {s : Set α} + +private theorem orderType_le_of_forall_inter_Iio_lt (hs : s.IsPWO) {o : Ordinal} + (h : ∀ x ∈ s, + (hs.mono (s := s ∩ Set.Iio x) Set.inter_subset_left).orderType < o) : + hs.orderType ≤ o := by + apply le_of_forall_lt + intro c hc + letI : WellFoundedLT s := ⟨hs.isWF⟩ + have hType : typeLT s = hs.orderType := + (orderType_eq_typeLT_of_orderIso hs (OrderIso.refl s)).symm + have hc' : c < typeLT s := hc.trans_eq hType.symm + let x : s := Ordinal.enum (· < ·) ⟨c, hc'⟩ + have hxRank : Ordinal.typein (· < · : s → s → Prop) x = c := + Ordinal.typein_enum _ hc' + simpa only [orderType_inter_Iio_eq_typein hs x.2, hxRank] using h x.1 x.2 + +private theorem exists_naturalAdd_split (hs : s.IsPWO) (hzero : hs.orderType ≠ 0) + (hnot : ¬Ordinal.IsPrincipal (· + ·) hs.orderType) : + ∃ (s₀ s₁ : Set α) (hs₀ : s₀.IsPWO) (hs₁ : s₁.IsPWO), + s₀ ∪ s₁ = s ∧ + NatOrdinal.of hs.orderType = + NatOrdinal.of hs₀.orderType + NatOrdinal.of hs₁.orderType ∧ + hs₀.orderType < hs.orderType ∧ hs₁.orderType < hs.orderType := by + let d : Ordinal := Ordinal.log Ordinal.omega0 hs.orderType + let p : Ordinal := Ordinal.omega0 ^ d + have hp_le : p ≤ hs.orderType := Ordinal.opow_log_le_self Ordinal.omega0 hzero + have hp_ne : p ≠ hs.orderType := by + intro hp + apply hnot + rw [hp.symm] + exact Ordinal.isPrincipal_add_omega0_opow d + have hp_lt : p < hs.orderType := hp_le.lt_of_ne hp_ne + letI : WellFoundedLT s := ⟨hs.isWF⟩ + have hType : typeLT s = hs.orderType := + (orderType_eq_typeLT_of_orderIso hs (OrderIso.refl s)).symm + have hp_type : p < typeLT s := hp_lt.trans_eq hType.symm + let x : s := Ordinal.enum (· < ·) ⟨p, hp_type⟩ + let s₀ : Set α := s ∩ Set.Iio x.1 + let s₁ : Set α := s ∩ Set.Ici x.1 + let hs₀ : s₀.IsPWO := hs.mono Set.inter_subset_left + let hs₁ : s₁.IsPWO := hs.mono Set.inter_subset_left + have hs₀_orderType : hs₀.orderType = p := by + rw [orderType_inter_Iio_eq_typein hs x.2] + exact Ordinal.typein_enum _ hp_type + have hsplit : hs₀.orderType + hs₁.orderType = hs.orderType := + orderType_inter_Iio_add_inter_Ici hs x.2 + have hs₁_orderType : hs₁.orderType = hs.orderType - p := by + rw [hs₀_orderType] at hsplit + exact (Ordinal.sub_eq_of_add_eq hsplit).symm + have hs₁_lt : hs₁.orderType < hs.orderType := by + rw [hs₁_orderType] + exact (Ordinal.isLeast_sub_lt_omega0_opow_log hzero).1 + have htail_bound : hs.orderType - p < Ordinal.omega0 ^ (d + 1) := by + apply (Ordinal.sub_le_self _ _).trans_lt + exact Ordinal.lt_opow_succ_log_self Ordinal.one_lt_omega0 hs.orderType + have hnatural : NatOrdinal.of hs.orderType = + NatOrdinal.of hs₀.orderType + NatOrdinal.of hs₁.orderType := by + have htail_bound' : NatOrdinal.of (hs.orderType - p) < + ω^ (NatOrdinal.of d + 1) := by + simpa only [NatOrdinal.of_omega0_opow, NatOrdinal.of_add_one] using + NatOrdinal.of.strictMono htail_bound + calc + NatOrdinal.of hs.orderType = NatOrdinal.of (p + (hs.orderType - p)) := by + rw [Ordinal.add_sub_cancel_of_le hp_le] + _ = ω^ NatOrdinal.of d + NatOrdinal.of (hs.orderType - p) := by + exact (NatOrdinal.wpow_add_of_lt htail_bound').symm + _ = NatOrdinal.of hs₀.orderType + NatOrdinal.of hs₁.orderType := by + rw [hs₀_orderType, hs₁_orderType, NatOrdinal.of_omega0_opow] + refine ⟨s₀, s₁, hs₀, hs₁, ?_, hnatural, hs₀_orderType ▸ hp_lt, hs₁_lt⟩ + ext z + simp only [s₀, s₁, Set.mem_union, Set.mem_inter_iff, Set.mem_Iio, Set.mem_Ici] + constructor + · rintro (⟨hz, -⟩ | ⟨hz, -⟩) <;> exact hz + · intro hz + exact (lt_or_ge z x.1).imp (And.intro hz) (And.intro hz) + +/-- Covering a proper initial segment of a sumset: every element of `s + t` below `x + y` lies in +`(s ∩ Iio x) + t` or in `s + (t ∩ Iio y)`. -/ +private theorem add_inter_Iio_subset_union [AddCommMonoid α] [IsOrderedCancelAddMonoid α] + {s t : Set α} (x y : α) : + (s + t) ∩ Set.Iio (x + y) ⊆ (s ∩ Set.Iio x + t) ∪ (s + t ∩ Set.Iio y) := by + rintro z ⟨hz, hzlt⟩ + rcases Set.mem_add.mp hz with ⟨x', hx's, y', hy't, rfl⟩ + by_cases hx' : x' < x + · left + exact Set.mem_add.mpr ⟨x', ⟨hx's, hx'⟩, y', hy't, rfl⟩ + · right + apply Set.mem_add.mpr + refine ⟨x', hx's, y', ⟨hy't, ?_⟩, rfl⟩ + by_contra hy' + exact (not_le_of_gt hzlt) (add_le_add (le_of_not_gt hx') (le_of_not_gt hy')) + +/-- The principal case of the sumset bound. If both order types are additive principal, hence +powers `ω ^ d` and `ω ^ e`, every proper initial segment of `s + t` is covered by two sumsets +whose Hessenberg products are strictly below `ω ^ d ⊗ ω ^ e = ω ^ (d ⊕ e)`, and that power is +closed under Hessenberg addition. The bounds for the smaller products are the induction +hypothesis `ih`. -/ +private theorem orderType_add_le_naturalMul_of_isPrincipal [AddCommMonoid α] + [IsOrderedCancelAddMonoid α] {s t : Set α} (hs : s.IsPWO) (ht : t.IsPWO) + (hsZero : hs.orderType ≠ 0) (htZero : ht.orderType ≠ 0) + (hsPrincipal : Ordinal.IsPrincipal (· + ·) hs.orderType) + (htPrincipal : Ordinal.IsPrincipal (· + ·) ht.orderType) + (ih : ∀ {s' t' : Set α} (hs' : s'.IsPWO) (ht' : t'.IsPWO), + NatOrdinal.of hs'.orderType * NatOrdinal.of ht'.orderType < + NatOrdinal.of hs.orderType * NatOrdinal.of ht.orderType → + (hs'.add ht').orderType ≤ + (NatOrdinal.of hs'.orderType * NatOrdinal.of ht'.orderType).val) : + (hs.add ht).orderType ≤ + (NatOrdinal.of hs.orderType * NatOrdinal.of ht.orderType).val := by + let a : NatOrdinal := NatOrdinal.of hs.orderType + let b : NatOrdinal := NatOrdinal.of ht.orderType + change (hs.add ht).orderType ≤ (a * b).val + have ha : 0 < a := pos_iff_ne_zero.mpr (NatOrdinal.of_ne_zero.mpr hsZero) + have hb : 0 < b := pos_iff_ne_zero.mpr (NatOrdinal.of_ne_zero.mpr htZero) + rcases Ordinal.isPrincipal_add_iff_zero_or_omega0_opow.mp hsPrincipal with + hsZero' | ⟨d, hd⟩ + · exact (hsZero hsZero').elim + rcases Ordinal.isPrincipal_add_iff_zero_or_omega0_opow.mp htPrincipal with + htZero' | ⟨e, he⟩ + · exact (htZero htZero').elim + have hsPower : hs.orderType = Ordinal.omega0 ^ d := hd.symm + have htPower : ht.orderType = Ordinal.omega0 ^ e := he.symm + have hproduct : a * b = ω^ (NatOrdinal.of d + NatOrdinal.of e) := by + simp only [a, b, hsPower, htPower, NatOrdinal.of_omega0_opow] + exact (NatOrdinal.wpow_add _ _).symm + apply orderType_le_of_forall_inter_Iio_lt (hs.add ht) + intro z hz + rcases Set.mem_add.mp hz with ⟨x, hxs, y, hyt, rfl⟩ + let sx : Set α := s ∩ Set.Iio x + let ty : Set α := t ∩ Set.Iio y + let hsx : sx.IsPWO := hs.mono Set.inter_subset_left + let hty : ty.IsPWO := ht.mono Set.inter_subset_left + let hInitial : ((s + t) ∩ Set.Iio (x + y)).IsPWO := + (hs.add ht).mono Set.inter_subset_left + have hsx_lt : hsx.orderType < hs.orderType := orderType_inter_Iio_lt hs hxs + have hty_lt : hty.orderType < ht.orderType := orderType_inter_Iio_lt ht hyt + have hleftProduct : NatOrdinal.of hsx.orderType * b < a * b := + mul_lt_mul_of_pos_right (NatOrdinal.of.strictMono hsx_lt) hb + have hrightProduct : a * NatOrdinal.of hty.orderType < a * b := + mul_lt_mul_of_pos_left (NatOrdinal.of.strictMono hty_lt) ha + have hleft' : NatOrdinal.of (hsx.add ht).orderType ≤ + NatOrdinal.of hsx.orderType * b := by + simpa only [b, NatOrdinal.of_val] using NatOrdinal.of.monotone (ih hsx ht hleftProduct) + have hright' : NatOrdinal.of (hs.add hty).orderType ≤ + a * NatOrdinal.of hty.orderType := by + simpa only [a, NatOrdinal.of_val] using NatOrdinal.of.monotone (ih hs hty hrightProduct) + calc + hInitial.orderType ≤ ((hsx.add ht).union (hs.add hty)).orderType := + orderType_mono hInitial ((hsx.add ht).union (hs.add hty)) + (add_inter_Iio_subset_union x y) + _ ≤ (NatOrdinal.of (hsx.add ht).orderType + + NatOrdinal.of (hs.add hty).orderType).val := + orderType_union_le_naturalAdd (hsx.add ht) (hs.add hty) + _ ≤ (NatOrdinal.of hsx.orderType * b + + a * NatOrdinal.of hty.orderType).val := by + apply NatOrdinal.val.monotone + exact add_le_add hleft' hright' + _ < (a * b).val := by + apply NatOrdinal.val.lt_iff_lt.mpr + rw [hproduct] + exact NatOrdinal.add_lt_wpow (hleftProduct.trans_eq hproduct) + (hrightProduct.trans_eq hproduct) + +/-- The distributivity step of the sumset bound, splitting the left factor. If `s = s₀ ∪ s₁` +with `ot(s) = ot(s₀) ⊕ ot(s₁)` and both pieces of strictly smaller order type, then +`s + t = (s₀ + t) ∪ (s₁ + t)`, and the union bound together with the induction hypothesis `ih` +for the two smaller products gives the bound for `s + t`. -/ +private theorem orderType_add_le_naturalMul_of_union_left [AddCommMonoid α] + [IsOrderedCancelAddMonoid α] {s t : Set α} (hs : s.IsPWO) (ht : t.IsPWO) + {s₀ s₁ : Set α} (hs₀ : s₀.IsPWO) (hs₁ : s₁.IsPWO) (hsUnion : s₀ ∪ s₁ = s) + (hsNatural : NatOrdinal.of hs.orderType = + NatOrdinal.of hs₀.orderType + NatOrdinal.of hs₁.orderType) + (hs₀_lt : hs₀.orderType < hs.orderType) (hs₁_lt : hs₁.orderType < hs.orderType) + (htZero : ht.orderType ≠ 0) + (ih : ∀ {s' t' : Set α} (hs' : s'.IsPWO) (ht' : t'.IsPWO), + NatOrdinal.of hs'.orderType * NatOrdinal.of ht'.orderType < + NatOrdinal.of hs.orderType * NatOrdinal.of ht.orderType → + (hs'.add ht').orderType ≤ + (NatOrdinal.of hs'.orderType * NatOrdinal.of ht'.orderType).val) : + (hs.add ht).orderType ≤ + (NatOrdinal.of hs.orderType * NatOrdinal.of ht.orderType).val := by + let a : NatOrdinal := NatOrdinal.of hs.orderType + let b : NatOrdinal := NatOrdinal.of ht.orderType + change (hs.add ht).orderType ≤ (a * b).val + have hb : 0 < b := pos_iff_ne_zero.mpr (NatOrdinal.of_ne_zero.mpr htZero) + have h₀Measure : NatOrdinal.of hs₀.orderType * b < a * b := + mul_lt_mul_of_pos_right (NatOrdinal.of.strictMono hs₀_lt) hb + have h₁Measure : NatOrdinal.of hs₁.orderType * b < a * b := + mul_lt_mul_of_pos_right (NatOrdinal.of.strictMono hs₁_lt) hb + have h₀' : NatOrdinal.of (hs₀.add ht).orderType ≤ + NatOrdinal.of hs₀.orderType * b := by + simpa only [b, NatOrdinal.of_val] using NatOrdinal.of.monotone (ih hs₀ ht h₀Measure) + have h₁' : NatOrdinal.of (hs₁.add ht).orderType ≤ + NatOrdinal.of hs₁.orderType * b := by + simpa only [b, NatOrdinal.of_val] using NatOrdinal.of.monotone (ih hs₁ ht h₁Measure) + calc + (hs.add ht).orderType = ((hs₀.add ht).union (hs₁.add ht)).orderType := by + apply orderType_congr + rw [← Set.union_add, hsUnion] + _ ≤ (NatOrdinal.of (hs₀.add ht).orderType + + NatOrdinal.of (hs₁.add ht).orderType).val := + orderType_union_le_naturalAdd (hs₀.add ht) (hs₁.add ht) + _ ≤ (NatOrdinal.of hs₀.orderType * b + + NatOrdinal.of hs₁.orderType * b).val := by + apply NatOrdinal.val.monotone + exact add_le_add h₀' h₁' + _ = (a * b).val := by rw [← add_mul, ← hsNatural] + +/-- The distributivity step of the sumset bound, splitting the right factor. If `t = t₀ ∪ t₁` +with `ot(t) = ot(t₀) ⊕ ot(t₁)` and both pieces of strictly smaller order type, then +`s + t = (s + t₀) ∪ (s + t₁)`, and the union bound together with the induction hypothesis `ih` +for the two smaller products gives the bound for `s + t`. -/ +private theorem orderType_add_le_naturalMul_of_union_right [AddCommMonoid α] + [IsOrderedCancelAddMonoid α] {s t : Set α} (hs : s.IsPWO) (ht : t.IsPWO) + {t₀ t₁ : Set α} (ht₀ : t₀.IsPWO) (ht₁ : t₁.IsPWO) (htUnion : t₀ ∪ t₁ = t) + (htNatural : NatOrdinal.of ht.orderType = + NatOrdinal.of ht₀.orderType + NatOrdinal.of ht₁.orderType) + (ht₀_lt : ht₀.orderType < ht.orderType) (ht₁_lt : ht₁.orderType < ht.orderType) + (hsZero : hs.orderType ≠ 0) + (ih : ∀ {s' t' : Set α} (hs' : s'.IsPWO) (ht' : t'.IsPWO), + NatOrdinal.of hs'.orderType * NatOrdinal.of ht'.orderType < + NatOrdinal.of hs.orderType * NatOrdinal.of ht.orderType → + (hs'.add ht').orderType ≤ + (NatOrdinal.of hs'.orderType * NatOrdinal.of ht'.orderType).val) : + (hs.add ht).orderType ≤ + (NatOrdinal.of hs.orderType * NatOrdinal.of ht.orderType).val := by + let a : NatOrdinal := NatOrdinal.of hs.orderType + let b : NatOrdinal := NatOrdinal.of ht.orderType + change (hs.add ht).orderType ≤ (a * b).val + have ha : 0 < a := pos_iff_ne_zero.mpr (NatOrdinal.of_ne_zero.mpr hsZero) + have h₀Measure : a * NatOrdinal.of ht₀.orderType < a * b := + mul_lt_mul_of_pos_left (NatOrdinal.of.strictMono ht₀_lt) ha + have h₁Measure : a * NatOrdinal.of ht₁.orderType < a * b := + mul_lt_mul_of_pos_left (NatOrdinal.of.strictMono ht₁_lt) ha + have h₀' : NatOrdinal.of (hs.add ht₀).orderType ≤ + a * NatOrdinal.of ht₀.orderType := by + simpa only [a, NatOrdinal.of_val] using NatOrdinal.of.monotone (ih hs ht₀ h₀Measure) + have h₁' : NatOrdinal.of (hs.add ht₁).orderType ≤ + a * NatOrdinal.of ht₁.orderType := by + simpa only [a, NatOrdinal.of_val] using NatOrdinal.of.monotone (ih hs ht₁ h₁Measure) + calc + (hs.add ht).orderType = ((hs.add ht₀).union (hs.add ht₁)).orderType := by + apply orderType_congr + rw [← Set.add_union, htUnion] + _ ≤ (NatOrdinal.of (hs.add ht₀).orderType + + NatOrdinal.of (hs.add ht₁).orderType).val := + orderType_union_le_naturalAdd (hs.add ht₀) (hs.add ht₁) + _ ≤ (a * NatOrdinal.of ht₀.orderType + + a * NatOrdinal.of ht₁.orderType).val := by + apply NatOrdinal.val.monotone + exact add_le_add h₀' h₁' + _ = (a * b).val := by rw [← mul_add, ← htNatural] + +/-- The order type of a pointwise sum is at most the Hessenberg product of the two order types. +This specializes to LM24, Fact 2.2.3(3). -/ +theorem orderType_add_le_naturalMul [AddCommMonoid α] [IsOrderedCancelAddMonoid α] + {s t : Set α} (hs : s.IsPWO) (ht : t.IsPWO) : + (hs.add ht).orderType ≤ + (NatOrdinal.of hs.orderType * NatOrdinal.of ht.orderType).val := by + by_cases hsZero : hs.orderType = 0 + · have hsEmpty : s = ∅ := hs.orderType_eq_zero.mp hsZero + have hsumEmpty : s + t = ∅ := by rw [hsEmpty, Set.empty_add] + rw [(hs.add ht).orderType_eq_zero.mpr hsumEmpty, hsZero] + simp + by_cases htZero : ht.orderType = 0 + · have htEmpty : t = ∅ := ht.orderType_eq_zero.mp htZero + have hsumEmpty : s + t = ∅ := by rw [htEmpty, Set.add_empty] + rw [(hs.add ht).orderType_eq_zero.mpr hsumEmpty, htZero] + simp + have ih : ∀ {s' t' : Set α} (hs' : s'.IsPWO) (ht' : t'.IsPWO), + NatOrdinal.of hs'.orderType * NatOrdinal.of ht'.orderType < + NatOrdinal.of hs.orderType * NatOrdinal.of ht.orderType → + (hs'.add ht').orderType ≤ + (NatOrdinal.of hs'.orderType * NatOrdinal.of ht'.orderType).val := + fun hs' ht' _ ↦ orderType_add_le_naturalMul hs' ht' + by_cases hsPrincipal : Ordinal.IsPrincipal (· + ·) hs.orderType + · by_cases htPrincipal : Ordinal.IsPrincipal (· + ·) ht.orderType + · exact orderType_add_le_naturalMul_of_isPrincipal hs ht hsZero htZero + hsPrincipal htPrincipal ih + · obtain ⟨t₀, t₁, ht₀, ht₁, htUnion, htNatural, ht₀_lt, ht₁_lt⟩ := + exists_naturalAdd_split ht htZero htPrincipal + exact orderType_add_le_naturalMul_of_union_right hs ht ht₀ ht₁ htUnion htNatural + ht₀_lt ht₁_lt hsZero ih + · obtain ⟨s₀, s₁, hs₀, hs₁, hsUnion, hsNatural, hs₀_lt, hs₁_lt⟩ := + exists_naturalAdd_split hs hsZero hsPrincipal + exact orderType_add_le_naturalMul_of_union_left hs ht hs₀ hs₁ hsUnion hsNatural + hs₀_lt hs₁_lt htZero ih +termination_by NatOrdinal.of hs.orderType * NatOrdinal.of ht.orderType +decreasing_by + all_goals + change _ < _ + assumption + +end Set.IsPWO diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests.lean new file mode 100644 index 0000000000..1b1a8d8f41 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests.lean @@ -0,0 +1,16 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.GeneralFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.NaturalPrincipal +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrderedUnion +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalFactors +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalFinitePart +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalSuccessorFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.SetOrderType +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.Sumset + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/GeneralFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/GeneralFactorization.lean new file mode 100644 index 0000000000..28a91a080b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/GeneralFactorization.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.GeneralFactorization + +/-! +# Certificate: the residual factor deletes the least Cantor term, not `1` + +The nearest plausible wrong reading of `residualFactor_omega0_opow` is the shape proved in +`ConwayRefinement.SetTheory.Ordinal.SuccessorFactorization`, where the residual factor +is `ω ^ (α.removeNat 1)`. That deletes a finite amount from the exponent, so at `α = ω` it must +leave `ω` and predict residual factor `ω ^ ω`. + +The theorem gives `1`, and `1 ≠ ω ^ ω` is checked below. The limit case is therefore not an +instance of the successor shape but a genuine strengthening, and it is what makes truncation a +descent at a grade with no finite part. + +The degenerate case `α = 1` is included because there the two readings agree, so it certifies +that the generalization did not break the case it generalizes. +-/ + +open Ordinal + +public noncomputable section + +namespace Tests + +theorem one_lt_omega0_opow {a : Ordinal} (ha : a ≠ 0) : 1 < Ordinal.omega0 ^ a := + calc (1 : Ordinal) < Ordinal.omega0 := one_lt_omega0 + _ = Ordinal.omega0 ^ (1 : Ordinal) := (opow_one _).symm + _ ≤ Ordinal.omega0 ^ a := + opow_le_opow_right omega0_pos (Order.one_le_iff_ne_zero.mpr ha) + +theorem residualFactor_omega0_opow_omega0 : + AdditivePrincipalAboveOne.residualFactor + ⟨Ordinal.omega0 ^ Ordinal.omega0, isAdditivelyPrincipal_omega0_opow _, + one_lt_omega0_opow omega0_ne_zero⟩ = 1 := by + rw [residualFactor_omega0_opow Ordinal.omega0 (isAdditivelyPrincipal_omega0_opow _) + (one_lt_omega0_opow omega0_ne_zero)] + have hw : (Ordinal.omega0 : Ordinal) = Ordinal.omega0 ^ (1 : Ordinal) := (opow_one _).symm + rw [hw, additivePrincipalTerms_of_isAdditivelyPrincipal (isAdditivelyPrincipal_omega0_opow 1)] + simp + +theorem one_ne_omega0_opow_omega0 : (1 : Ordinal) ≠ Ordinal.omega0 ^ Ordinal.omega0 := + (one_lt_omega0_opow omega0_ne_zero).ne + +theorem residualFactor_omega0_opow_one : + AdditivePrincipalAboveOne.residualFactor + ⟨Ordinal.omega0 ^ (1 : Ordinal), isAdditivelyPrincipal_omega0_opow _, + one_lt_omega0_opow one_ne_zero⟩ = 1 := by + rw [residualFactor_omega0_opow (1 : Ordinal) (isAdditivelyPrincipal_omega0_opow _) + (one_lt_omega0_opow one_ne_zero)] + have h1 : (1 : Ordinal) = Ordinal.omega0 ^ (0 : Ordinal) := by simp + rw [h1, additivePrincipalTerms_of_isAdditivelyPrincipal (isAdditivelyPrincipal_omega0_opow 0)] + simp + +end Tests + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/NaturalPrincipal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/NaturalPrincipal.lean new file mode 100644 index 0000000000..c4b2e524d5 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/NaturalPrincipal.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal + +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPrincipal + +/-! +# API checks for principality of the natural operations + +These certificates separate Berarducci, Fact 3.7 from two weaker readings: the multiplicative case +with only additive principality assumed, and either case read with the ordinary ordinal operations +in place of the natural ones. +-/ + +universe u + +open scoped NatOrdinal + +public noncomputable section + +namespace Tests + +/-- `ω ^ ω` is multiplicative principal, so it is closed under natural products. -/ +theorem naturalMul_lt_omega0_opow_omega0 {b c : Ordinal} + (hb : b < Ordinal.omega0 ^ Ordinal.omega0) + (hc : c < Ordinal.omega0 ^ Ordinal.omega0) : + (NatOrdinal.of b * NatOrdinal.of c).val < Ordinal.omega0 ^ Ordinal.omega0 := by + have hmp := Ordinal.isMultiplicativelyPrincipal_omega0_opow_opow 1 + rw [Ordinal.opow_one] at hmp + exact hmp.naturalMul_lt hb hc + +/-- Additive principality alone does not give closure under natural products, since +`ω ⊙ ω = ω ^ 2`. -/ +theorem naturalMul_lt_needs_multiplicativelyPrincipal : + ∃ o a : Ordinal, + Ordinal.IsAdditivelyPrincipal o ∧ a < o ∧ + ¬(NatOrdinal.of a * NatOrdinal.of a).val < o := by + refine ⟨Ordinal.omega0 ^ (2 : Ordinal), Ordinal.omega0, + Ordinal.isAdditivelyPrincipal_omega0_opow 2, ?_, ?_⟩ + · calc Ordinal.omega0 = Ordinal.omega0 ^ (1 : Ordinal) := (Ordinal.opow_one _).symm + _ < Ordinal.omega0 ^ (2 : Ordinal) := + (Ordinal.opow_lt_opow_iff_right Ordinal.one_lt_omega0).mpr one_lt_two + · have hval : (NatOrdinal.of Ordinal.omega0 * NatOrdinal.of Ordinal.omega0).val = + Ordinal.omega0 ^ (2 : Ordinal) := by + have hof : NatOrdinal.of Ordinal.omega0 = ω^ (1 : NatOrdinal) := by + rw [← Ordinal.opow_one Ordinal.omega0, NatOrdinal.of_omega0_opow] + simp + rw [hof, ← NatOrdinal.wpow_add, NatOrdinal.val_wpow] + congr 1 + rw [one_add_one_eq_two] + rfl + rw [hval] + exact lt_irrefl _ + +/-- Fact 3.7 is stated for the natural sum, which differs from the ordinary ordinal sum on the +same arguments: `1 ⊕ ω = ω + 1` while `1 + ω = ω`. -/ +theorem naturalAdd_ne_ordinalAdd : + ∃ b c : Ordinal, (NatOrdinal.of b + NatOrdinal.of c).val ≠ b + c := by + refine ⟨1, Ordinal.omega0, ?_⟩ + rw [Ordinal.one_add_omega0] + have hlt : NatOrdinal.of Ordinal.omega0 < + NatOrdinal.of 1 + NatOrdinal.of Ordinal.omega0 := by + refine lt_add_of_pos_left _ ?_ + simp + exact (NatOrdinal.val.lt_iff_lt.mpr hlt).ne' + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/OrderedUnion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/OrderedUnion.lean new file mode 100644 index 0000000000..1e108ac689 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/OrderedUnion.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType + +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.OrderedUnion +import Mathlib.SetTheory.Ordinal.Principal + +/-! +# API certificate for the separated indexed-union estimate + +This client applies Berarducci's ordered-union estimate at the infinite factors +`ρ = ω` and `l = ω * 2`. It also proves that the source conclusion `ρ * l` differs from the +reversed product `l * ρ` at these values. Thus the certificate detects a silent reversal of +ordinary ordinal multiplication; a finite or symmetric test would not. +-/ + +universe u + +open Order Ordinal + +public noncomputable section + +namespace Tests + +/-- At `ρ = ω` and `l = ω * 2`, the ordinary product in Berarducci, Lemma 4.7 differs +from the product with its factors reversed. -/ +theorem omega_mul_omega_mul_two_ne_omega_mul_two_mul_omega : + Ordinal.omega0.{u} * (Ordinal.omega0 * 2) ≠ + (Ordinal.omega0 * 2) * Ordinal.omega0 := by + have htwo : (2 : Ordinal.{u}) * Ordinal.omega0 = Ordinal.omega0 := + Ordinal.natCast_mul_omega0 (n := 2) (by simp) + have hright : (Ordinal.omega0 * 2) * Ordinal.omega0 = + Ordinal.omega0 * Ordinal.omega0 := by + calc + (Ordinal.omega0 * 2) * Ordinal.omega0 = + Ordinal.omega0 * (2 * Ordinal.omega0) := mul_assoc _ _ _ + _ = Ordinal.omega0 * Ordinal.omega0 := by rw [htwo] + have hpos : 0 < Ordinal.omega0.{u} * Ordinal.omega0.{u} := + mul_pos Ordinal.omega0_pos Ordinal.omega0_pos + have hleft : Ordinal.omega0 * Ordinal.omega0 < + Ordinal.omega0 * (Ordinal.omega0 * 2) := by + rw [← mul_assoc] + simpa only [mul_one] using + (mul_lt_mul_of_pos_left (show (1 : Ordinal.{u}) < 2 by simp) hpos) + exact hright ▸ ne_of_gt hleft + +/-- The public ordered-union interface produces the source's ordinary product in the +noncommuting test case `ρ = ω` and `l = ω * 2`. -/ +theorem omega_mul_omega_mul_two_le_orderType_iUnion + {α : Type u} [LinearOrder α] + (B : (Ordinal.omega0.{u} * 2).ToType → Set α) + (hB : ∀ i, (B i).IsPWO) + (hseparated : ∀ {i j}, i < j → ∃ y ∈ B j, ∀ x ∈ B i, x < y) + (hfinal : ∀ (i : (Ordinal.omega0.{u} * 2).ToType) (C : Set α) + (hC : IsRelUpperSet C (· ∈ B i)), C.Nonempty → + Ordinal.omega0 ≤ ((hB i).mono fun _ hx ↦ (hC hx).1).orderType) + (hUnion : (⋃ i, B i).IsPWO) : + Ordinal.omega0.{u} * (Ordinal.omega0 * 2) ≤ hUnion.orderType := by + exact Set.IsPWO.mul_le_orderType_iUnion_of_isSuccLimit + (l := Ordinal.omega0.{u} * 2) (ρ := Ordinal.omega0.{u}) + (Ordinal.isSuccLimit_mul_left Ordinal.isSuccLimit_omega0 (by simp)) + B hB hseparated hfinal hUnion + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/OrdinalFactors.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/OrdinalFactors.lean new file mode 100644 index 0000000000..b61ff3cfd6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/OrdinalFactors.lean @@ -0,0 +1,186 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.MultiplicativelyPrincipal + +import Mathlib.Tactic.NormNum + +/-! +# API checks for multiplicatively principal ordinal factors + +The first certificate exposes the exceptional ordinal `2`: it satisfies Berarducci's printed +multiplicative-principality predicate but is not one of the infinite factors described in the +paper's classification. This prevents the exact source predicate from being silently replaced by +the incomplete classification. + +The value `ω ^ 3` has three equal factors, while `ω ^ (ω + 1)` has the asymmetric factor list +`[ω ^ ω, ω]`. The latter example distinguishes the final principal factor from the initial +factor and verifies the residual factor simultaneously. A singleton example checks Berarducci's +convention that the residual factor is one when the value is already infinite multiplicatively +principal. The final certificate exercises the equality between ordinary and Hessenberg products. +-/ + +open scoped NatOrdinal + +public noncomputable section + +namespace Tests + +open Ordinal + +/-- The finite ordinal two separates Berarducci's exact predicate from the infinite factor +shape asserted by the paper's incomplete classification. -/ +theorem two_multiplicativePrincipal_boundary : + IsMultiplicativelyPrincipal (2 : Ordinal) ∧ + ¬IsInfiniteMultiplicativelyPrincipal 2 := by + constructor + · exact isMultiplicativelyPrincipal_two + · rw [isInfiniteMultiplicativelyPrincipal_iff_two_lt_and_isMultiplicativelyPrincipal] + simp + +private theorem omegaCubed_product : + [omega0, omega0, omega0].prod = omega0 ^ (3 : Ordinal) := by + simp only [List.prod_cons, List.prod_nil, mul_one] + rw [← opow_one omega0, ← opow_add, ← opow_add] + norm_num + +/-- The canonical multiplicative factor list of `ω ^ 3` consists of three copies of `ω`. -/ +theorem omegaCubed_multiplicativePrincipalFactors : + [omega0, omega0, omega0] = + (omega0 ^ (3 : Ordinal)).multiplicativePrincipalFactors := by + apply multiplicativePrincipalFactors_unique + · exact isAdditivelyPrincipal_omega0_opow 3 + · exact omegaCubed_product + · intro f hf + rw [List.mem_cons, List.mem_cons, List.mem_singleton] at hf + rcases hf with rfl | rfl | rfl + all_goals simpa [opow_zero, opow_one] using + isMultiplicativelyPrincipal_omega0_opow_opow 0 + · intro f hf + rw [List.mem_cons, List.mem_cons, List.mem_singleton] at hf + rcases hf with rfl | rfl | rfl + all_goals exact one_lt_omega0 + · simp [List.sortedGE_iff_pairwise] + +/-- The additive-principal value `ω ^ 3`, packaged in the exact domain of the principal and +residual factor operations. -/ +def omegaCubedValue : AdditivePrincipalAboveOne.{0} := + ⟨omega0 ^ (3 : Ordinal), isAdditivelyPrincipal_omega0_opow 3, + by rw [one_lt_opow]; exact ⟨one_lt_omega0, by norm_num⟩⟩ + +/-- Berarducci's example `ω ^ 3` has principal factor `ω` and residual factor `ω ^ 2`. -/ +theorem omegaCubed_principal_residual : + omegaCubedValue.principalFactor = omega0 ∧ + omegaCubedValue.residualFactor = omega0 ^ (2 : Ordinal) := by + constructor + · rw [omegaCubedValue.principalFactor_eq_getLast] + change (omega0 ^ (3 : Ordinal)).multiplicativePrincipalFactors.getLast _ = omega0 + calc + (omega0 ^ (3 : Ordinal)).multiplicativePrincipalFactors.getLast _ = + [omega0, omega0, omega0].getLast (by simp) := + List.getLast_congr _ _ omegaCubed_multiplicativePrincipalFactors.symm + _ = omega0 := rfl + · rw [omegaCubedValue.residualFactor_eq_dropLast_prod] + change (omega0 ^ (3 : Ordinal)).multiplicativePrincipalFactors.dropLast.prod = + omega0 ^ (2 : Ordinal) + rw [omegaCubed_multiplicativePrincipalFactors.symm] + simp only [List.dropLast_cons_cons, List.dropLast_singleton, List.prod_cons, + List.prod_nil, mul_one] + rw [← opow_one omega0, ← opow_add] + norm_num + +private theorem omegaOmegaMulOmega_product : + [omega0 ^ omega0, omega0].prod = + omega0 ^ (omega0 + 1) := by + simp only [List.prod_cons, List.prod_nil, mul_one] + simp + +/-- The canonical factor list of `ω ^ (ω + 1)` is the asymmetric list `[ω ^ ω, ω]`. -/ +theorem omegaOmegaAddOne_multiplicativePrincipalFactors : + [omega0 ^ omega0, omega0] = + (omega0 ^ (omega0 + 1)).multiplicativePrincipalFactors := by + apply multiplicativePrincipalFactors_unique + · exact isAdditivelyPrincipal_omega0_opow (omega0 + 1) + · exact omegaOmegaMulOmega_product + · intro f hf + rw [List.mem_cons, List.mem_singleton] at hf + rcases hf with rfl | rfl + · simpa [opow_one] using isMultiplicativelyPrincipal_omega0_opow_opow 1 + · simpa [opow_zero, opow_one] using + isMultiplicativelyPrincipal_omega0_opow_opow 0 + · intro f hf + rw [List.mem_cons, List.mem_singleton] at hf + rcases hf with rfl | rfl + · rw [one_lt_opow] + exact ⟨one_lt_omega0, omega0_ne_zero⟩ + · exact one_lt_omega0 + · rw [List.sortedGE_iff_pairwise, List.pairwise_cons] + constructor + · intro f hf + rw [List.mem_singleton] at hf + subst f + simpa [opow_one] using + opow_le_opow_right omega0_pos (show (1 : Ordinal) ≤ omega0 by + exact one_lt_omega0.le) + · exact List.pairwise_singleton _ _ + +/-- The additive-principal value `ω ^ (ω + 1)`, packaged in the exact factor domain. -/ +def omegaOmegaAddOneValue : AdditivePrincipalAboveOne.{0} := + ⟨omega0 ^ (omega0 + 1), + isAdditivelyPrincipal_omega0_opow (omega0 + 1), + by rw [one_lt_opow]; exact ⟨one_lt_omega0, by simp⟩⟩ + +/-- The asymmetric example has final principal factor `ω` and residual factor `ω ^ ω`. -/ +theorem omegaOmegaAddOne_principal_residual : + omegaOmegaAddOneValue.principalFactor = omega0 ∧ + omegaOmegaAddOneValue.residualFactor = omega0 ^ omega0 := by + constructor + · rw [omegaOmegaAddOneValue.principalFactor_eq_getLast] + change (omega0 ^ (omega0 + 1)).multiplicativePrincipalFactors.getLast _ = + omega0 + calc + (omega0 ^ (omega0 + 1)).multiplicativePrincipalFactors.getLast _ = + [omega0 ^ omega0, omega0].getLast (by simp) := + List.getLast_congr _ _ + omegaOmegaAddOne_multiplicativePrincipalFactors.symm + _ = omega0 := rfl + · rw [omegaOmegaAddOneValue.residualFactor_eq_dropLast_prod] + change (omega0 ^ (omega0 + 1)).multiplicativePrincipalFactors.dropLast.prod = + omega0 ^ omega0 + rw [omegaOmegaAddOne_multiplicativePrincipalFactors.symm] + simp + +/-- The infinite multiplicatively principal value `ω ^ ω`, packaged in the exact factor +domain. -/ +def omegaOmegaValue : AdditivePrincipalAboveOne.{0} := + ⟨omega0 ^ omega0, isAdditivelyPrincipal_omega0_opow omega0, + by rw [one_lt_opow]; exact ⟨one_lt_omega0, omega0_ne_zero⟩⟩ + +/-- A singleton factor list gives principal factor equal to the value and residual factor one. -/ +theorem omegaOmega_principal_residual : + omegaOmegaValue.principalFactor = omega0 ^ omega0 ∧ + omegaOmegaValue.residualFactor = 1 := by + have hprincipal : IsInfiniteMultiplicativelyPrincipal (omega0 ^ omega0) := by + simpa [opow_one] using isInfiniteMultiplicativelyPrincipal_omega0_opow_opow 1 + have hprincipal' : IsInfiniteMultiplicativelyPrincipal omegaOmegaValue.1 := by + simpa [omegaOmegaValue] using hprincipal + exact ⟨omegaOmegaValue.principalFactor_eq_self_of_isInfiniteMultiplicativelyPrincipal + hprincipal', + omegaOmegaValue.residualFactor_eq_one_of_isInfiniteMultiplicativelyPrincipal + hprincipal'⟩ + +/-- In the asymmetric example, the Hessenberg product of the residual and principal factors +equals the same ordinal as their ordinary product. -/ +theorem omegaOmegaAddOne_natural_factorization : + NatOrdinal.of ((omega0 : Ordinal.{0}) ^ omega0) * NatOrdinal.of omega0 = + NatOrdinal.of ((omega0 : Ordinal.{0}) ^ (omega0 + 1)) := by + have h := omegaOmegaAddOneValue.naturalResidual_mul_naturalPrincipal + rw [omegaOmegaAddOne_principal_residual.1, + omegaOmegaAddOne_principal_residual.2] at h + simpa [omegaOmegaAddOneValue] using h + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/OrdinalFinitePart.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/OrdinalFinitePart.lean new file mode 100644 index 0000000000..2b002a3c4e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/OrdinalFinitePart.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart + +import Mathlib.Tactic.NormNum + +/-! +# API checks for finite Cantor coefficients + +The first two fixtures have constant Cantor coefficients five and seven. Their Hessenberg sum has +constant coefficient twelve; ordinary ordinal addition would instead discard the first constant +coefficient and produce seven. The first fixture is also checked directly against Mathlib's +Cantor-normal-form coefficient. + +Finite removal is exercised away from both zero and the entire constant coefficient. The product +fixture has exact value `ω ^ 3 * 6`: it satisfies the proved `ω ^ 4` bound but is not below +`ω ^ 3`, distinguishing the required `p + q + 1` exponent from the nearby off-by-one bound. +-/ + +public noncomputable section + +namespace Tests + +/-- A natural ordinal with a nonzero degree-two term and constant coefficient five. -/ +def degreeTwoWithFive : NatOrdinal := + ω^ (2 : NatOrdinal) + 5 + +/-- A natural ordinal with a nonzero degree-one term and constant coefficient seven. -/ +def degreeOneWithSeven : NatOrdinal := + ω^ (1 : NatOrdinal) + 7 + +theorem degreeTwoWithFive_constantCoeff : degreeTwoWithFive.constantCoeff = 5 := by + rw [degreeTwoWithFive] + change (ω^ (2 : NatOrdinal) + (5 : ℕ)).constantCoeff = 5 + rw [NatOrdinal.constantCoeff_add_natCast, + NatOrdinal.constantCoeff_wpow] + norm_num + +theorem degreeOneWithSeven_constantCoeff : degreeOneWithSeven.constantCoeff = 7 := by + rw [degreeOneWithSeven] + change (ω^ (1 : NatOrdinal) + (7 : ℕ)).constantCoeff = 7 + rw [NatOrdinal.constantCoeff_add_natCast, + NatOrdinal.constantCoeff_wpow] + norm_num + +/-- Hessenberg addition adds both nonzero constant Cantor coefficients. -/ +theorem asymmetricSum_constantCoeff : + (degreeTwoWithFive + degreeOneWithSeven).constantCoeff = 12 := by + rw [NatOrdinal.constantCoeff_add, degreeTwoWithFive_constantCoeff, + degreeOneWithSeven_constantCoeff] + +/-- The remainder agrees concretely with Mathlib's Cantor-normal-form +coefficient. -/ +theorem degreeTwoWithFive_CNF_coeff_zero : + Ordinal.CNF.coeff Ordinal.omega0 degreeTwoWithFive.val 0 = 5 := by + rw [← NatOrdinal.coe_constantCoeff_eq_CNF_coeff, + degreeTwoWithFive_constantCoeff] + norm_num + +/-- Removing three constant terms leaves exactly two constant terms. -/ +theorem degreeTwoWithFive_removeThree : + degreeTwoWithFive.removeNat 3 = ω^ (2 : NatOrdinal) + 2 := by + symm + apply (NatOrdinal.eq_removeNat_iff_add_natCast_eq (a := degreeTwoWithFive) + (eta := ω^ (2 : NatOrdinal) + 2) (n := 3) (by + rw [degreeTwoWithFive_constantCoeff] + norm_num)).mpr + rw [degreeTwoWithFive] + rw [add_assoc] + congr 1 + norm_num + +/-- Removing the predecessor term from the left summand commutes with adding the right +summand. -/ +theorem asymmetricSum_removeOne : + (degreeTwoWithFive + degreeOneWithSeven).removeNat 1 = + degreeTwoWithFive.removeNat 1 + degreeOneWithSeven := by + apply NatOrdinal.removeOne_add_right + rw [degreeTwoWithFive_constantCoeff] + norm_num + +/-- A degree-two natural ordinal with leading coefficient two. -/ +def productLeft : NatOrdinal := + ω^ (2 : NatOrdinal) * 2 + +/-- A degree-one natural ordinal with leading coefficient three. -/ +def productRight : NatOrdinal := + ω^ (1 : NatOrdinal) * 3 + +theorem productLeft_lt_wpow_three : productLeft < ω^ (3 : NatOrdinal) := by + rw [productLeft] + exact NatOrdinal.wpow_mul_natCast_lt (by norm_num) 2 + +theorem productRight_lt_wpow_two : productRight < ω^ (2 : NatOrdinal) := by + rw [productRight] + exact NatOrdinal.wpow_mul_natCast_lt (by norm_num) 3 + +/-- The asymmetric product has a nonzero term at exponent three. -/ +theorem product_exact : + productLeft * productRight = ω^ (3 : NatOrdinal) * 6 := by + rw [productLeft, productRight] + calc + (ω^ (2 : NatOrdinal) * 2) * (ω^ (1 : NatOrdinal) * 3) = + (ω^ (2 : NatOrdinal) * ω^ (1 : NatOrdinal)) * (2 * 3) := by + ac_rfl + _ = ω^ ((2 : NatOrdinal) + 1) * 6 := by + rw [NatOrdinal.wpow_add] + norm_num + _ = ω^ (3 : NatOrdinal) * 6 := by norm_num + +/-- The product is not below the nearby incorrect ceiling `ω ^ 3`. -/ +theorem product_not_lt_wpow_three : + ¬productLeft * productRight < ω^ (3 : NatOrdinal) := by + rw [product_exact] + apply not_lt_of_ge + calc + ω^ (3 : NatOrdinal) = ω^ (3 : NatOrdinal) * 1 := (mul_one _).symm + _ ≤ ω^ (3 : NatOrdinal) * 6 := + mul_le_mul_right (show (1 : NatOrdinal) ≤ 6 by norm_num) _ + +/-- The finite-degree product estimate places the same product strictly below `ω ^ 4`. -/ +theorem product_lt_wpow_four : + productLeft * productRight < ω^ (4 : NatOrdinal) := by + have h := NatOrdinal.mul_lt_wpow_natCast_add_one + (p := 2) (q := 1) productLeft_lt_wpow_three productRight_lt_wpow_two + norm_num at h + exact h + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/OrdinalSuccessorFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/OrdinalSuccessorFactorization.lean new file mode 100644 index 0000000000..7d445764a1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/OrdinalSuccessorFactorization.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SuccessorFactorization + +import Mathlib.Tactic.NormNum + +/-! +# API checks for successor-exponent factorisation + +The successor fixture has exponent `omega + 1`. Its principal factor is `omega`, while its +residual factor is `omega ^ omega`. This separates the intended last-factor convention from +using the entire power as the principal factor or assigning residual value one at every +successor exponent. + +The neighboring limit fixture has exponent `omega`; its full power is already infinitely +multiplicatively principal and is therefore its own principal factor. This checks that the +positive-constant-coefficient hypothesis is essential. +-/ + +open scoped NatOrdinal +open Ordinal + +public noncomputable section + +namespace Tests + +/-- The limit exponent `omega`. -/ +abbrev successorFactorLimitExponent : NatOrdinal := ω^ (1 : NatOrdinal) + +/-- The successor exponent `omega + 1`. -/ +abbrev successorFactorLimitSuccessorExponent : NatOrdinal := + successorFactorLimitExponent + (1 : ℕ) + +theorem successorFactorLimitSuccessorExponent_constantCoeff : + successorFactorLimitSuccessorExponent.constantCoeff = 1 := by + rw [successorFactorLimitSuccessorExponent, NatOrdinal.constantCoeff_add_natCast] + rw [successorFactorLimitExponent, NatOrdinal.constantCoeff_wpow] + simp + +theorem successorFactorLimitSuccessorExponent_removeOne : + successorFactorLimitSuccessorExponent.removeNat 1 = successorFactorLimitExponent := by + symm + apply (NatOrdinal.eq_removeNat_iff_add_natCast_eq + (a := successorFactorLimitSuccessorExponent) + (eta := successorFactorLimitExponent) (n := 1) (by + rw [successorFactorLimitSuccessorExponent_constantCoeff])).mpr + rfl + +private theorem successorFactorLimitSuccessorExponent_ne_zero : + successorFactorLimitSuccessorExponent ≠ 0 := by + intro hzero + have h := congrArg NatOrdinal.constantCoeff hzero + rw [successorFactorLimitSuccessorExponent_constantCoeff, + NatOrdinal.constantCoeff_zero] at h + norm_num at h + +/-- The power at exponent `omega + 1` lies in the domain of the factor projections. -/ +theorem one_lt_wpow_successorFactorLimitSuccessor : + 1 < Ordinal.omega0 ^ successorFactorLimitSuccessorExponent.val := by + rw [Ordinal.one_lt_opow] + exact ⟨Ordinal.one_lt_omega0, + NatOrdinal.val_ne_zero.mpr successorFactorLimitSuccessorExponent_ne_zero⟩ + +/-- At exponent `omega + 1`, the final multiplicatively principal factor is `omega`. -/ +theorem principalFactor_wpow_successorFactorLimitSuccessor : + Ordinal.AdditivePrincipalAboveOne.principalFactor + (⟨Ordinal.omega0 ^ successorFactorLimitSuccessorExponent.val, + Ordinal.isAdditivelyPrincipal_omega0_opow + successorFactorLimitSuccessorExponent.val, + one_lt_wpow_successorFactorLimitSuccessor⟩ : + Ordinal.AdditivePrincipalAboveOne) = Ordinal.omega0 := + Ordinal.AdditivePrincipalAboveOne.principalFactor_wpow_of_constantCoeff_pos + successorFactorLimitSuccessorExponent + (by rw [successorFactorLimitSuccessorExponent_constantCoeff]; norm_num) + (Ordinal.isAdditivelyPrincipal_omega0_opow + successorFactorLimitSuccessorExponent.val) + one_lt_wpow_successorFactorLimitSuccessor + +/-- At exponent `omega + 1`, deleting the final factor leaves `omega ^ omega`. -/ +theorem residualFactor_wpow_successorFactorLimitSuccessor : + Ordinal.AdditivePrincipalAboveOne.residualFactor + (⟨Ordinal.omega0 ^ successorFactorLimitSuccessorExponent.val, + Ordinal.isAdditivelyPrincipal_omega0_opow + successorFactorLimitSuccessorExponent.val, + one_lt_wpow_successorFactorLimitSuccessor⟩ : + Ordinal.AdditivePrincipalAboveOne) = + Ordinal.omega0 ^ successorFactorLimitExponent.val := by + rw [Ordinal.AdditivePrincipalAboveOne.residualFactor_wpow_of_constantCoeff_pos + successorFactorLimitSuccessorExponent + (by rw [successorFactorLimitSuccessorExponent_constantCoeff]; norm_num) + (Ordinal.isAdditivelyPrincipal_omega0_opow + successorFactorLimitSuccessorExponent.val) + one_lt_wpow_successorFactorLimitSuccessor] + rw [successorFactorLimitSuccessorExponent_removeOne] + +private theorem successorFactorLimitExponent_ne_zero : successorFactorLimitExponent ≠ 0 := + NatOrdinal.wpow_ne_zero 1 + +/-- The power at exponent `omega` lies in the domain of the factor projections. -/ +theorem one_lt_wpow_successorFactorLimit : + 1 < Ordinal.omega0 ^ successorFactorLimitExponent.val := by + rw [Ordinal.one_lt_opow] + exact ⟨Ordinal.one_lt_omega0, + NatOrdinal.val_ne_zero.mpr successorFactorLimitExponent_ne_zero⟩ + +private theorem wpow_successorFactorLimit_isInfiniteMultiplicativelyPrincipal : + Ordinal.IsInfiniteMultiplicativelyPrincipal + (Ordinal.omega0 ^ successorFactorLimitExponent.val) := by + simpa only [NatOrdinal.val_wpow, NatOrdinal.val_one] using + Ordinal.isInfiniteMultiplicativelyPrincipal_omega0_opow_opow 1 + +/-- At the neighboring limit exponent `omega`, the principal factor is not `omega`; it is the +entire power `omega ^ omega`. -/ +theorem principalFactor_wpow_successorFactorLimit_ne_omega0 : + Ordinal.AdditivePrincipalAboveOne.principalFactor + (⟨Ordinal.omega0 ^ successorFactorLimitExponent.val, + Ordinal.isAdditivelyPrincipal_omega0_opow successorFactorLimitExponent.val, + one_lt_wpow_successorFactorLimit⟩ : Ordinal.AdditivePrincipalAboveOne) ≠ + Ordinal.omega0 := by + rw [AdditivePrincipalAboveOne.principalFactor_eq_self_of_isInfiniteMultiplicativelyPrincipal + _ wpow_successorFactorLimit_isInfiniteMultiplicativelyPrincipal] + apply ne_of_gt + change Ordinal.omega0 < Ordinal.omega0 ^ (Ordinal.omega0 ^ (1 : Ordinal)) + simpa only [Ordinal.opow_one] using + (Ordinal.opow_lt_opow_iff_right Ordinal.one_lt_omega0).mpr + Ordinal.one_lt_omega0 + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/SetOrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/SetOrderType.lean new file mode 100644 index 0000000000..6a816fa42e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/SetOrderType.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +public import Mathlib.Data.Sum.Order + +/-! +# API check for order type of a union + +This client partitions the well-order `ω + 1` into its final point and its initial copy of `ω`. +Listing the final point first gives ordinary ordinal sum `1 + ω = ω`, which is too small to bound +the union. The Hessenberg sum is `1 ⊕ ω = ω + 1`, and the generic union theorem is sharp. + +The example therefore distinguishes the theorem from the plausible but false replacement of +Hessenberg addition by ordinary ordinal addition. It imports only the public set-order-type API. +-/ + +public noncomputable section + +namespace Tests + +open Ordinal + +private instance : WellFoundedLT (ℕ ⊕ₗ Unit) := + (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := Unit)).symm.toRelEmbedding.isWellFounded + +private def initialOmega : Set (ℕ ⊕ₗ Unit) := + Set.range (fun n : ℕ ↦ Sum.inlₗ n) + +private def finalPoint : Set (ℕ ⊕ₗ Unit) := + Set.range (fun u : Unit ↦ Sum.inrₗ u) + +private def initialOmegaOrderIso : ℕ ≃o initialOmega where + toEquiv := Equiv.ofInjective (fun n : ℕ ↦ Sum.inlₗ n) + Sum.Lex.inl_strictMono.injective + map_rel_iff' := Sum.Lex.inl_le_inl_iff + +private def finalPointOrderIso : Unit ≃o finalPoint where + toEquiv := Equiv.ofInjective (fun u : Unit ↦ Sum.inrₗ u) + Sum.Lex.inr_strictMono.injective + map_rel_iff' := Sum.Lex.inr_le_inr_iff + +private theorem finalPoint_union_initialOmega : + finalPoint ∪ initialOmega = Set.univ := by + ext x + induction x using Lex.rec with + | h x => + cases x <;> simp [finalPoint, initialOmega] + +private def unionOrderIso : ↥(finalPoint ∪ initialOmega) ≃o (ℕ ⊕ₗ Unit) := + (OrderIso.setCongr _ _ finalPoint_union_initialOmega).trans OrderIso.Set.univ + +private theorem initialOmega_orderType : + (Set.IsPWO.of_linearOrder initialOmega).orderType = Ordinal.omega0 := by + rw [Set.IsPWO.orderType_eq_typeLT_of_orderIso _ initialOmegaOrderIso.symm, + Ordinal.type_nat_lt] + +private theorem finalPoint_orderType : + (Set.IsPWO.of_linearOrder finalPoint).orderType = 1 := by + rw [Set.IsPWO.orderType_eq_typeLT_of_orderIso _ finalPointOrderIso.symm] + simp + +private theorem union_orderType : + ((Set.IsPWO.of_linearOrder finalPoint).union + (Set.IsPWO.of_linearOrder initialOmega)).orderType = + Ordinal.omega0 + 1 := by + rw [Set.IsPWO.orderType_eq_typeLT_of_orderIso _ unionOrderIso] + calc + typeLT (ℕ ⊕ₗ Unit) = + Ordinal.type (Sum.Lex (· < · : ℕ → ℕ → Prop) + (· < · : Unit → Unit → Prop)) := + (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := Unit)).ordinalType_congr.symm + _ = Ordinal.omega0 + 1 := by + rw [Ordinal.type_sum_lex, Ordinal.type_nat_lt] + simp + +/-- The Hessenberg union bound can be sharp when the corresponding ordinary ordinal sum is too +small. -/ +theorem naturalUnionBound_distinguishes_ordinaryAdd : + ∃ (s t : Set (ℕ ⊕ₗ Unit)) (hs : s.IsPWO) (ht : t.IsPWO), + (hs.union ht).orderType = + (NatOrdinal.of hs.orderType + NatOrdinal.of ht.orderType).val ∧ + ¬(hs.union ht).orderType ≤ hs.orderType + ht.orderType := by + let hs : finalPoint.IsPWO := Set.IsPWO.of_linearOrder finalPoint + let ht : initialOmega.IsPWO := Set.IsPWO.of_linearOrder initialOmega + refine ⟨finalPoint, initialOmega, hs, ht, ?_, ?_⟩ + · apply le_antisymm + · exact Set.IsPWO.orderType_union_le_naturalAdd hs ht + · rw [union_orderType, finalPoint_orderType, initialOmega_orderType] + rw [add_comm] + change (NatOrdinal.of Ordinal.omega0 + 1).val ≤ Ordinal.omega0 + 1 + rw [← NatOrdinal.of_add_one, NatOrdinal.val_of] + · rw [union_orderType, finalPoint_orderType, initialOmega_orderType, + Ordinal.one_add_omega0] + exact not_le_of_gt (lt_add_one Ordinal.omega0) + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/Sumset.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/Sumset.lean new file mode 100644 index 0000000000..6e49917c46 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/Sumset.lean @@ -0,0 +1,279 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Sumset +public import Mathlib.Algebra.Order.Group.Int +public import Mathlib.Algebra.Order.Monoid.Prod +public import Mathlib.Data.Finset.MulAntidiagonal + +import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow +import Mathlib.Data.Sum.Order + +/-! +# API check for order type of a sumset + +This client embeds supports of order types `ω + 1` and `ω` into the lexicographically +ordered group `ℤ ×ₗ (ℤ ×ₗ ℤ)`. Their pointwise sum has order type `ω² + ω`, so the +Hessenberg-product bound of LM24, Fact 2.2.3(3), is attained. Ordinary ordinal multiplication +would instead give `(ω + 1) * ω = ω²`, which is too small. + +The example therefore distinguishes the theorem from the plausible but false replacement of +Hessenberg multiplication by ordinary ordinal multiplication. Its auxiliary supports and order +isomorphisms are private. +-/ + +public noncomputable section + +open Ordinal +open scoped Pointwise + +namespace Tests + +private instance : WellFoundedLT (ℕ ⊕ₗ Unit) := + (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := Unit)).symm.toRelEmbedding.isWellFounded + +private instance : WellFoundedLT ((ℕ ×ₗ ℕ) ⊕ₗ ℕ) := + (Sum.Lex.toLexRelIsoLT (α := ℕ ×ₗ ℕ) (β := ℕ)).symm.toRelEmbedding.isWellFounded + +private abbrev SumsetExponentGroup := ℤ ×ₗ (ℤ ×ₗ ℤ) + +private def triple (a b c : ℤ) : SumsetExponentGroup := + toLex (a, toLex (b, c)) + +private def leftMap (q : ℕ ⊕ₗ Unit) : SumsetExponentGroup := + match ofLex q with + | Sum.inl n => triple 0 n 0 + | Sum.inr _ => triple 1 0 0 + +private def rightMap (m : ℕ) : SumsetExponentGroup := + triple 0 0 m + +private def sumMap (q : (ℕ ×ₗ ℕ) ⊕ₗ ℕ) : SumsetExponentGroup := + match ofLex q with + | Sum.inl p => triple 0 (ofLex p).1 (ofLex p).2 + | Sum.inr m => triple 1 0 m + +private def leftSupport : Set SumsetExponentGroup := + Set.range leftMap + +private def rightSupport : Set SumsetExponentGroup := + Set.range rightMap + +private def sumSupport : Set SumsetExponentGroup := + Set.range sumMap + +private theorem triple_add (a b c a' b' c' : ℤ) : + triple a b c + triple a' b' c' = triple (a + a') (b + b') (c + c') := by + rfl + +private theorem leftMap_strictMono : StrictMono leftMap := by + intro a b hab + induction a using Lex.rec with + | h a => + induction b using Lex.rec with + | h b => + cases a with + | inl n => + cases b with + | inl m => + simp only [Sum.Lex.toLex_lt_toLex, lt_self_iff_false, + Sum.lex_inl_inl, leftMap, ofLex_toLex, triple, + Prod.Lex.lt_iff, and_false, or_false, true_and, + false_or] at hab ⊢ + exact_mod_cast hab + | inr u => + simp only [Sum.Lex.toLex_lt_toLex, lt_self_iff_false, + Sum.Lex.sep, leftMap, ofLex_toLex, triple, + Prod.Lex.lt_iff, zero_lt_one, zero_ne_one, + Int.natCast_eq_zero, and_false, or_false, + false_and] at hab ⊢ + | inr u => + cases b with + | inl n => + simp only [Sum.Lex.toLex_lt_toLex, lt_self_iff_false, + Sum.lex_inr_inl] at hab + | inr v => simp only [lt_self_iff_false] at hab + +private theorem rightMap_strictMono : StrictMono rightMap := by + intro a b hab + simpa [rightMap, triple, Prod.Lex.lt_iff] using hab + +private theorem sumMap_strictMono : StrictMono sumMap := by + intro a b hab + induction a using Lex.rec with + | h a => + induction b using Lex.rec with + | h b => + cases a with + | inl p => + cases b with + | inl q => + simp only [Sum.Lex.toLex_lt_toLex, Prod.Lex.lt_iff, + Sum.lex_inl_inl, sumMap, ofLex_toLex, triple, + lt_self_iff_false, true_and, false_or] at hab ⊢ + exact_mod_cast hab + | inr m => + simp only [Sum.Lex.toLex_lt_toLex, Prod.Lex.lt_iff, + Sum.Lex.sep, sumMap, ofLex_toLex, triple, + zero_lt_one, zero_ne_one, Int.natCast_eq_zero, + false_and, or_false] at hab ⊢ + | inr m => + cases b with + | inl p => + simp only [Sum.Lex.toLex_lt_toLex, Prod.Lex.lt_iff, + Sum.lex_inr_inl] at hab + | inr n => + simp only [Sum.Lex.toLex_lt_toLex, Prod.Lex.lt_iff, + Sum.lex_inr_inr, sumMap, ofLex_toLex, triple, + lt_self_iff_false, true_and, + false_or] at hab ⊢ + exact_mod_cast hab + +private def leftOrderIso : (ℕ ⊕ₗ Unit) ≃o leftSupport where + toEquiv := Equiv.ofInjective leftMap leftMap_strictMono.injective + map_rel_iff' := leftMap_strictMono.le_iff_le + +private def rightOrderIso : ℕ ≃o rightSupport where + toEquiv := Equiv.ofInjective rightMap rightMap_strictMono.injective + map_rel_iff' := rightMap_strictMono.le_iff_le + +private def sumOrderIso : ((ℕ ×ₗ ℕ) ⊕ₗ ℕ) ≃o sumSupport where + toEquiv := Equiv.ofInjective sumMap sumMap_strictMono.injective + map_rel_iff' := sumMap_strictMono.le_iff_le + +private theorem leftSupport_isPWO : leftSupport.IsPWO := by + simpa [leftSupport] using + (Set.IsPWO.of_linearOrder (Set.univ : Set (ℕ ⊕ₗ Unit))).image_of_monotone + leftMap_strictMono.monotone + +private theorem rightSupport_isPWO : rightSupport.IsPWO := by + simpa [rightSupport] using + (Set.IsPWO.of_linearOrder (Set.univ : Set ℕ)).image_of_monotone + rightMap_strictMono.monotone + +private theorem sumSupport_isPWO : sumSupport.IsPWO := by + simpa [sumSupport] using + (Set.IsPWO.of_linearOrder + (Set.univ : Set ((ℕ ×ₗ ℕ) ⊕ₗ ℕ))).image_of_monotone + sumMap_strictMono.monotone + +private theorem add_supports : leftSupport + rightSupport = sumSupport := by + ext z + constructor + · rintro ⟨x, ⟨a, rfl⟩, y, ⟨b, rfl⟩, rfl⟩ + induction a using Lex.rec with + | h a => + cases a with + | inl n => + refine ⟨Sum.inlₗ (toLex (n, b)), ?_⟩ + simp only [sumMap, leftMap, rightMap, ofLex_toLex] + rw [triple_add] + simp + | inr u => + refine ⟨Sum.inrₗ b, ?_⟩ + simp only [sumMap, leftMap, rightMap, ofLex_toLex] + rw [triple_add] + simp + · rintro ⟨q, rfl⟩ + induction q using Lex.rec with + | h q => + cases q with + | inl p => + apply Set.mem_add.mpr + refine ⟨leftMap (Sum.inlₗ (ofLex p).1), ⟨_, rfl⟩, + rightMap (ofLex p).2, ⟨_, rfl⟩, ?_⟩ + simp only [leftMap, rightMap, sumMap, ofLex_toLex] + rw [triple_add] + simp + | inr m => + apply Set.mem_add.mpr + refine ⟨leftMap (Sum.inrₗ ()), ⟨_, rfl⟩, + rightMap m, ⟨_, rfl⟩, ?_⟩ + simp only [leftMap, rightMap, sumMap, ofLex_toLex] + rw [triple_add] + simp + +private theorem left_orderType : + leftSupport_isPWO.orderType = Ordinal.omega0 + 1 := by + rw [Set.IsPWO.orderType_eq_typeLT_of_orderIso + leftSupport_isPWO leftOrderIso.symm] + calc + typeLT (ℕ ⊕ₗ Unit) = + Ordinal.type (Sum.Lex (· < · : ℕ → ℕ → Prop) + (· < · : Unit → Unit → Prop)) := + (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := Unit)).ordinalType_congr.symm + _ = Ordinal.omega0 + 1 := by + rw [Ordinal.type_sum_lex, Ordinal.type_nat_lt] + simp + +private theorem right_orderType : + rightSupport_isPWO.orderType = Ordinal.omega0 := by + rw [Set.IsPWO.orderType_eq_typeLT_of_orderIso + rightSupport_isPWO rightOrderIso.symm, + Ordinal.type_nat_lt] + +private theorem sum_orderType : + sumSupport_isPWO.orderType = + Ordinal.omega0 ^ (2 : Ordinal) + Ordinal.omega0 := by + rw [Set.IsPWO.orderType_eq_typeLT_of_orderIso + sumSupport_isPWO sumOrderIso.symm] + calc + typeLT ((ℕ ×ₗ ℕ) ⊕ₗ ℕ) = + typeLT (ℕ ×ₗ ℕ) + typeLT ℕ := by + rw [← Ordinal.type_sum_lex] + exact (Sum.Lex.toLexRelIsoLT (α := ℕ ×ₗ ℕ) (β := ℕ)).ordinalType_congr.symm + _ = (typeLT ℕ) * (typeLT ℕ) + typeLT ℕ := by + congr 1 + _ = Ordinal.omega0 * Ordinal.omega0 + Ordinal.omega0 := by + rw [Ordinal.type_nat_lt] + _ = Ordinal.omega0 ^ (2 : Ordinal) + Ordinal.omega0 := by + have hsucc : Order.succ (1 : Ordinal) = 2 := one_add_one_eq_two + rw [← hsucc, Ordinal.opow_succ, Ordinal.opow_one] + +private theorem naturalProduct_value : + (NatOrdinal.of (Ordinal.omega0 + 1) * NatOrdinal.of Ordinal.omega0).val = + Ordinal.omega0 ^ (2 : Ordinal) + Ordinal.omega0 := by + have homega : NatOrdinal.of Ordinal.omega0 = ω^ (1 : NatOrdinal) := by + rw [NatOrdinal.wpow_def, NatOrdinal.val_one, Ordinal.opow_one] + rw [NatOrdinal.of_add_one, homega, add_mul, one_mul, + ← NatOrdinal.wpow_add, one_add_one_eq_two, + NatOrdinal.wpow_add_wpow (show (1 : NatOrdinal) ≤ 2 by simp)] + rw [NatOrdinal.val_of] + change Ordinal.omega0 ^ (2 : Ordinal) + + Ordinal.omega0 ^ (1 : Ordinal) = _ + rw [Ordinal.opow_one] + +/-- The Hessenberg sumset bound is sharp when the corresponding ordinary ordinal product is too +small. -/ +theorem naturalSumsetBound_distinguishes_ordinaryMul : + ∃ (s t : Set (ℤ ×ₗ (ℤ ×ₗ ℤ))) (hs : s.IsPWO) (ht : t.IsPWO), + (hs.add ht).orderType = + (NatOrdinal.of hs.orderType * NatOrdinal.of ht.orderType).val ∧ + ¬(hs.add ht).orderType ≤ hs.orderType * ht.orderType := by + let hs : leftSupport.IsPWO := leftSupport_isPWO + let ht : rightSupport.IsPWO := rightSupport_isPWO + refine ⟨leftSupport, rightSupport, hs, ht, ?_, ?_⟩ + · apply le_antisymm + · exact Set.IsPWO.orderType_add_le_naturalMul hs ht + · rw [Set.IsPWO.orderType_congr (hs.add ht) + sumSupport_isPWO add_supports, + sum_orderType, left_orderType, right_orderType] + exact naturalProduct_value.le + · rw [Set.IsPWO.orderType_congr (hs.add ht) + sumSupport_isPWO add_supports, + sum_orderType, left_orderType, right_orderType] + have hordinary : (Ordinal.omega0 + 1) * Ordinal.omega0 = + Ordinal.omega0 ^ (2 : Ordinal) := by + rw [Ordinal.add_mul_of_isSuccLimit Ordinal.one_add_omega0 + Ordinal.isSuccLimit_omega0] + have hsucc : Order.succ (1 : Ordinal) = 2 := one_add_one_eq_two + rw [← hsucc, Ordinal.opow_succ, Ordinal.opow_one] + rw [hordinary] + exact not_le_of_gt (lt_add_of_pos_right _ Ordinal.omega0_pos) + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC.lean new file mode 100644 index 0000000000..9d8e65d51f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Game +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.GameOperations +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Game.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Game.lean new file mode 100644 index 0000000000..47bb53434f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Game.lean @@ -0,0 +1,211 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.IGame +public import Mathlib.SetTheory.ZFC.Basic + +/-! +# Games coded by ZFC sets + +A game code is a Kuratowski ordered pair of sets of game codes, representing its left and right +options. This grammar is stated independently of `IGame`. Coding and decoding preserve literal +pregame equality, not just equality of game values. +-/ + +universe u + +public noncomputable section + +namespace ZFSet + +/-- A well-founded game tree coded as an ordered pair of sets of game codes. -/ +inductive IsGameCode : ZFSet.{u} → Prop + | mk (L R : ZFSet.{u}) + (left : ∀ x ∈ L, IsGameCode x) (right : ∀ x ∈ R, IsGameCode x) : + IsGameCode (pair L R) + +/-- A game code has a left-option set and a right-option set of game codes. -/ +theorem IsGameCode.exists_eq_pair {z : ZFSet.{u}} (h : IsGameCode z) : + ∃ L R, z = pair L R ∧ (∀ x ∈ L, IsGameCode x) ∧ (∀ x ∈ R, IsGameCode x) := by + cases h with + | mk L R hL hR => exact ⟨L, R, rfl, hL, hR⟩ + +@[simp] +theorem isGameCode_pair_iff (L R : ZFSet.{u}) : + IsGameCode (pair L R) ↔ (∀ x ∈ L, IsGameCode x) ∧ (∀ x ∈ R, IsGameCode x) := by + constructor + · intro h + obtain ⟨L', R', heq, hL, hR⟩ := h.exists_eq_pair + obtain ⟨rfl, rfl⟩ := pair_inj.1 heq + exact ⟨hL, hR⟩ + · rintro ⟨hL, hR⟩ + exact .mk L R hL hR + +/-- The ZFC sets satisfying the independent game-code grammar. -/ +def GameCode : Type (u + 1) := {x : ZFSet.{u} // IsGameCode x} + +namespace GameCode + +/-- Make a game code from a ZFC set satisfying the grammar. -/ +def mk (x : ZFSet.{u}) (h : IsGameCode x) : GameCode.{u} := ⟨x, h⟩ + +/-- The underlying ZFC set of a game code. -/ +def val (x : GameCode.{u}) : ZFSet.{u} := x.1 + +instance : Coe GameCode.{u} ZFSet.{u} := ⟨val⟩ + +@[simp] +theorem coe_mk (x : ZFSet.{u}) (h : IsGameCode x) : (mk x h : ZFSet.{u}) = x := (rfl) + +/-- Every game code satisfies its defining grammar. -/ +theorem isGameCode (x : GameCode.{u}) : IsGameCode (x : ZFSet.{u}) := x.2 + +@[ext] +theorem ext {x y : GameCode.{u}} (h : (x : ZFSet.{u}) = (y : ZFSet.{u})) : x = y := + Subtype.ext h + +@[simp] +theorem mk_coe (x : GameCode.{u}) : mk (x : ZFSet.{u}) x.isGameCode = x := by + apply ext + rfl + +end GameCode +end ZFSet + +namespace IGame + +/-- Encode a game as an ordered pair of the ZFC sets of recursively encoded options. -/ +def toZFSet (x : IGame.{u}) : ZFSet.{u} := + IGame.moveRecOn x fun z ih ↦ + ZFSet.pair (ZFSet.range fun y : z.moves left ↦ ih left y.1 y.2) + (ZFSet.range fun y : z.moves right ↦ ih right y.1 y.2) + +/-- The set of codes of a game's options for one player. -/ +def optionsZFSet (p : Player) (x : IGame.{u}) : ZFSet.{u} := + ZFSet.range fun y : x.moves p ↦ toZFSet y.1 + +@[simp] +theorem mem_optionsZFSet {p : Player} {x : IGame.{u}} {z : ZFSet.{u}} : + z ∈ optionsZFSet p x ↔ ∃ y ∈ x.moves p, toZFSet y = z := by + simp [optionsZFSet] + +/-- The code's first and second components encode the left and right options. -/ +theorem toZFSet_eq_pair (x : IGame.{u}) : + toZFSet x = ZFSet.pair (optionsZFSet left x) (optionsZFSet right x) := by + rw [toZFSet, IGame.moveRecOn_eq] + rfl + +@[simp] +theorem toZFSet_ofSets (s t : Set IGame.{u}) [Small.{u} s] [Small.{u} t] : + toZFSet !{s | t} = ZFSet.pair + (ZFSet.range fun y : s ↦ toZFSet y.1) (ZFSet.range fun y : t ↦ toZFSet y.1) := by + rw [toZFSet_eq_pair] + apply congrArg₂ ZFSet.pair <;> apply ZFSet.ext <;> intro z <;> + simp [mem_optionsZFSet] + +@[simp] +theorem toZFSet_zero : toZFSet (0 : IGame.{u}) = ZFSet.pair ∅ ∅ := by + rw [toZFSet_eq_pair] + apply congrArg₂ ZFSet.pair <;> apply ZFSet.ext <;> intro z <;> + simp + +/-- Every encoded game satisfies the independent ZFC grammar. -/ +theorem isGameCode_toZFSet (x : IGame.{u}) : ZFSet.IsGameCode (toZFSet x) := by + induction x using IGame.moveRecOn with + | ind x ih => + rw [toZFSet_eq_pair] + apply ZFSet.IsGameCode.mk + · intro z hz + obtain ⟨y, hy, rfl⟩ := mem_optionsZFSet.1 hz + exact ih left y hy + · intro z hz + obtain ⟨y, hy, rfl⟩ := mem_optionsZFSet.1 hz + exact ih right y hy + +/-- Coding distinguishes literal games, including their complete option sets. -/ +theorem toZFSet_injective : Function.Injective (toZFSet.{u}) := by + intro x + induction x using IGame.moveRecOn with + | ind x ih => + intro y h + have hp : ∀ p, optionsZFSet p x = optionsZFSet p y := by + rw [toZFSet_eq_pair x, toZFSet_eq_pair y, ZFSet.pair_inj] at h + intro p + cases p + · exact h.1 + · exact h.2 + apply IGame.ext + intro p + ext a + constructor + · intro ha + have hcode : toZFSet a ∈ optionsZFSet p y := by + rw [← hp p] + exact mem_optionsZFSet.2 ⟨a, ha, rfl⟩ + obtain ⟨b, hb, hab⟩ := mem_optionsZFSet.1 hcode + exact (ih p a ha hab.symm) ▸ hb + · intro ha + have hcode : toZFSet a ∈ optionsZFSet p x := by + rw [hp p] + exact mem_optionsZFSet.2 ⟨a, ha, rfl⟩ + obtain ⟨b, hb, hab⟩ := mem_optionsZFSet.1 hcode + exact (ih p b hb hab) ▸ hb + +/-- Every set generated by the ZFC grammar is the code of a game. -/ +theorem exists_toZFSet_eq_of_isGameCode {z : ZFSet.{u}} (hz : ZFSet.IsGameCode z) : + ∃ x : IGame.{u}, toZFSet x = z := by + induction hz with + | mk L R _ _ ihL ihR => + let l : L → IGame.{u} := fun a ↦ Classical.choose (ihL a.1 a.2) + let r : R → IGame.{u} := fun a ↦ Classical.choose (ihR a.1 a.2) + have hl (a : L) : toZFSet (l a) = a.1 := Classical.choose_spec (ihL a.1 a.2) + have hr (a : R) : toZFSet (r a) = a.1 := Classical.choose_spec (ihR a.1 a.2) + refine ⟨!{Set.range l | Set.range r}, ?_⟩ + rw [toZFSet_eq_pair] + apply congrArg₂ ZFSet.pair + · apply ZFSet.ext + intro z + simp only [mem_optionsZFSet, moves_ofSets, Set.mem_range] + constructor + · rintro ⟨g, ⟨a, rfl⟩, h⟩ + rw [hl a] at h + exact h ▸ a.2 + · intro h + exact ⟨l ⟨z, h⟩, ⟨⟨z, h⟩, rfl⟩, hl ⟨z, h⟩⟩ + · apply ZFSet.ext + intro z + simp only [mem_optionsZFSet, moves_ofSets, Set.mem_range] + constructor + · rintro ⟨g, ⟨a, rfl⟩, h⟩ + rw [hr a] at h + exact h ▸ a.2 + · intro h + exact ⟨r ⟨z, h⟩, ⟨⟨z, h⟩, rfl⟩, hr ⟨z, h⟩⟩ + +/-- Literal games are equivalent to the ZFC sets satisfying the independent game-code grammar. -/ +def zfSetEquiv : IGame.{u} ≃ ZFSet.GameCode.{u} where + toFun x := ZFSet.GameCode.mk (toZFSet x) (isGameCode_toZFSet x) + invFun z := Classical.choose (exists_toZFSet_eq_of_isGameCode z.isGameCode) + left_inv x := toZFSet_injective + (Classical.choose_spec (exists_toZFSet_eq_of_isGameCode (isGameCode_toZFSet x))) + right_inv z := ZFSet.GameCode.ext + (Classical.choose_spec (exists_toZFSet_eq_of_isGameCode z.isGameCode)) + +@[simp] +theorem coe_zfSetEquiv (x : IGame.{u}) : (zfSetEquiv x : ZFSet.{u}) = toZFSet x := (rfl) + +@[simp] +theorem toZFSet_zfSetEquiv_symm (z : ZFSet.GameCode.{u}) : + toZFSet (zfSetEquiv.symm z) = (z : ZFSet.{u}) := + Classical.choose_spec (exists_toZFSet_eq_of_isGameCode z.isGameCode) + +@[simp] +theorem zfSetEquiv_symm_mk (x : IGame.{u}) : + zfSetEquiv.symm (ZFSet.GameCode.mk (toZFSet x) (isGameCode_toZFSet x)) = x := + zfSetEquiv.symm_apply_apply x + +end IGame diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/GameOperations.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/GameOperations.lean new file mode 100644 index 0000000000..69c9ced888 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/GameOperations.lean @@ -0,0 +1,303 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Game +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Classes + +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Multiplication + +/-! +# Comparison and arithmetic of ZFC game codes + +The coding equivalence transports comparison and the raw game operations. These are operations on +pregames: game equivalence is `AntisymmRel (· ≤ ·)`, and no ring structure is asserted on raw codes. +-/ + +universe u + +public noncomputable section + +open Set + +namespace ZFSet.GameCode + +/-- Encode a literal game as a valid ZFC game code. -/ +def ofIGame (x : IGame.{u}) : GameCode.{u} := IGame.zfSetEquiv x + +/-- Decode a valid ZFC game code as a literal game. -/ +def toIGame (x : GameCode.{u}) : IGame.{u} := IGame.zfSetEquiv.symm x + +@[simp] +theorem toIGame_ofIGame (x : IGame.{u}) : toIGame (ofIGame x) = x := + IGame.zfSetEquiv.symm_apply_apply x + +@[simp] +theorem ofIGame_toIGame (x : GameCode.{u}) : ofIGame (toIGame x) = x := + IGame.zfSetEquiv.apply_symm_apply x + +@[simp] +theorem coe_ofIGame (x : IGame.{u}) : (ofIGame x : ZFSet.{u}) = IGame.toZFSet x := + IGame.coe_zfSetEquiv x + +@[simp] +theorem toZFSet_toIGame (x : GameCode.{u}) : IGame.toZFSet x.toIGame = (x : ZFSet.{u}) := + IGame.toZFSet_zfSetEquiv_symm x + +/-- Decoding game codes is injective. -/ +theorem toIGame_injective : Function.Injective (toIGame.{u}) := + IGame.zfSetEquiv.symm.injective + +@[simp] +theorem toIGame_inj {x y : GameCode.{u}} : x.toIGame = y.toIGame ↔ x = y := + toIGame_injective.eq_iff + +@[simp] +theorem ofIGame_inj {x y : IGame.{u}} : ofIGame x = ofIGame y ↔ x = y := + IGame.zfSetEquiv.injective.eq_iff + +instance : Preorder GameCode.{u} := Preorder.lift toIGame + +@[simp] +theorem toIGame_le_toIGame (x y : GameCode.{u}) : x.toIGame ≤ y.toIGame ↔ x ≤ y := (Iff.rfl) + +@[simp] +theorem toIGame_lt_toIGame (x y : GameCode.{u}) : x.toIGame < y.toIGame ↔ x < y := (Iff.rfl) + +@[simp] +theorem ofIGame_le_ofIGame (x y : IGame.{u}) : ofIGame x ≤ ofIGame y ↔ x ≤ y := by + change toIGame (ofIGame x) ≤ toIGame (ofIGame y) ↔ x ≤ y + simp + +@[simp] +theorem ofIGame_lt_ofIGame (x y : IGame.{u}) : ofIGame x < ofIGame y ↔ x < y := by + change toIGame (ofIGame x) < toIGame (ofIGame y) ↔ x < y + simp + +@[simp] +theorem toIGame_equiv_toIGame (x y : GameCode.{u}) : x.toIGame ≈ y.toIGame ↔ x ≈ y := (Iff.rfl) + +instance : Zero GameCode.{u} := ⟨ofIGame 0⟩ +instance : One GameCode.{u} := ⟨ofIGame 1⟩ +instance : Neg GameCode.{u} := ⟨fun x ↦ ofIGame (-x.toIGame)⟩ +instance : Add GameCode.{u} := ⟨fun x y ↦ ofIGame (x.toIGame + y.toIGame)⟩ +instance : Sub GameCode.{u} := ⟨fun x y ↦ ofIGame (x.toIGame - y.toIGame)⟩ +instance : Mul GameCode.{u} := ⟨fun x y ↦ ofIGame (x.toIGame * y.toIGame)⟩ + +@[simp] theorem toIGame_zero : (0 : GameCode.{u}).toIGame = 0 := toIGame_ofIGame _ +@[simp] theorem toIGame_one : (1 : GameCode.{u}).toIGame = 1 := toIGame_ofIGame _ + +@[simp] +theorem toIGame_neg (x : GameCode.{u}) : (-x).toIGame = -x.toIGame := toIGame_ofIGame _ + +@[simp] +theorem toIGame_add (x y : GameCode.{u}) : (x + y).toIGame = x.toIGame + y.toIGame := + toIGame_ofIGame _ + +@[simp] +theorem toIGame_sub (x y : GameCode.{u}) : (x - y).toIGame = x.toIGame - y.toIGame := + toIGame_ofIGame _ + +@[simp] +theorem toIGame_mul (x y : GameCode.{u}) : (x * y).toIGame = x.toIGame * y.toIGame := + toIGame_ofIGame _ + +@[simp] +theorem ofIGame_neg (x : IGame.{u}) : ofIGame (-x) = -ofIGame x := by + apply toIGame_injective + simp + +@[simp] +theorem ofIGame_add (x y : IGame.{u}) : ofIGame (x + y) = ofIGame x + ofIGame y := by + apply toIGame_injective + simp + +@[simp] +theorem ofIGame_sub (x y : IGame.{u}) : ofIGame (x - y) = ofIGame x - ofIGame y := by + apply toIGame_injective + simp + +@[simp] +theorem ofIGame_mul (x y : IGame.{u}) : ofIGame (x * y) = ofIGame x * ofIGame y := by + apply toIGame_injective + simp + +/-- A code is numeric when all its game positions are numbers in Conway's sense. -/ +def IsNumeric (x : GameCode.{u}) : Prop := IGame.Numeric x.toIGame + +theorem isNumeric_iff (x : GameCode.{u}) : IsNumeric x ↔ IGame.Numeric x.toIGame := (Iff.rfl) + +@[simp] +theorem isNumeric_ofIGame (x : IGame.{u}) : IsNumeric (ofIGame x) ↔ IGame.Numeric x := by + simp [IsNumeric] + +@[simp] +theorem isNumeric_zero : IsNumeric (0 : GameCode.{u}) := by + simp [IsNumeric] + +@[simp] +theorem isNumeric_one : IsNumeric (1 : GameCode.{u}) := by + simp [IsNumeric] + +/-- Negation preserves numeric game codes. -/ +theorem IsNumeric.neg {x : GameCode.{u}} (h : IsNumeric x) : IsNumeric (-x) := by + letI : IGame.Numeric x.toIGame := (isNumeric_iff x).1 h + simpa [IsNumeric] using (inferInstance : IGame.Numeric (-x.toIGame)) + +/-- Addition preserves numeric game codes. -/ +theorem IsNumeric.add {x y : GameCode.{u}} (hx : IsNumeric x) (hy : IsNumeric y) : + IsNumeric (x + y) := by + letI : IGame.Numeric x.toIGame := (isNumeric_iff x).1 hx + letI : IGame.Numeric y.toIGame := (isNumeric_iff y).1 hy + simpa [IsNumeric] using (inferInstance : IGame.Numeric (x.toIGame + y.toIGame)) + +/-- Subtraction preserves numeric game codes. -/ +theorem IsNumeric.sub {x y : GameCode.{u}} (hx : IsNumeric x) (hy : IsNumeric y) : + IsNumeric (x - y) := by + letI : IGame.Numeric x.toIGame := (isNumeric_iff x).1 hx + letI : IGame.Numeric y.toIGame := (isNumeric_iff y).1 hy + simpa [IsNumeric] using (inferInstance : IGame.Numeric (x.toIGame - y.toIGame)) + +/-- Multiplication preserves numeric game codes. -/ +theorem IsNumeric.mul {x y : GameCode.{u}} (hx : IsNumeric x) (hy : IsNumeric y) : + IsNumeric (x * y) := by + letI : IGame.Numeric x.toIGame := (isNumeric_iff x).1 hx + letI : IGame.Numeric y.toIGame := (isNumeric_iff y).1 hy + simpa [IsNumeric] using (inferInstance : IGame.Numeric (x.toIGame * y.toIGame)) + +/-- The option codes for one player, with no identification of equivalent options. -/ +def moves (p : Player) (x : GameCode.{u}) : Set GameCode.{u} := + ofIGame '' x.toIGame.moves p + +instance (p : Player) (x : GameCode.{u}) : Small.{u} (x.moves p) := + inferInstanceAs (Small.{u} (ofIGame '' x.toIGame.moves p)) + +@[simp] +theorem mem_moves {p : Player} {x y : GameCode.{u}} : + y ∈ x.moves p ↔ y.toIGame ∈ x.toIGame.moves p := by + constructor + · rintro ⟨z, hz, rfl⟩ + simpa using hz + · intro h + exact ⟨y.toIGame, h, ofIGame_toIGame y⟩ + +/-- Form a code from small left- and right-option sets. -/ +def ofSets (s t : Set GameCode.{u}) [Small.{u} s] [Small.{u} t] : GameCode.{u} := + ofIGame !{toIGame '' s | toIGame '' t} + +@[simp] +theorem toIGame_ofSets (s t : Set GameCode.{u}) [Small.{u} s] [Small.{u} t] : + (ofSets s t).toIGame = !{toIGame '' s | toIGame '' t} := toIGame_ofIGame _ + +@[simp] +theorem moves_ofSets_left (s t : Set GameCode.{u}) [Small.{u} s] [Small.{u} t] : + (ofSets s t).moves Player.left = s := by + simp [moves, image_image] + +@[simp] +theorem moves_ofSets_right (s t : Set GameCode.{u}) [Small.{u} s] [Small.{u} t] : + (ofSets s t).moves Player.right = t := by + simp [moves, image_image] + +/-- The ZFC set of option codes for one player. -/ +def optionCodes (p : Player) (x : GameCode.{u}) : ZFSet.{u} := + ZFSet.range fun y : x.moves p ↦ (y.1 : ZFSet.{u}) + +@[simp] +theorem mem_optionCodes {p : Player} {x : GameCode.{u}} {z : ZFSet.{u}} : + z ∈ optionCodes p x ↔ ∃ y ∈ x.moves p, (y : ZFSet.{u}) = z := by + simp [optionCodes] + +/-- A code is an option exactly when its underlying set belongs to the corresponding option set. -/ +theorem coe_mem_optionCodes {p : Player} {x y : GameCode.{u}} : + (y : ZFSet.{u}) ∈ optionCodes p x ↔ y ∈ x.moves p := by + rw [mem_optionCodes] + constructor + · rintro ⟨z, hz, h⟩ + exact (GameCode.ext h) ▸ hz + · intro h + exact ⟨y, h, rfl⟩ + +/-- The intrinsic option sets agree with the components of the pregame encoding. -/ +theorem optionCodes_eq_optionsZFSet (p : Player) (x : GameCode.{u}) : + optionCodes p x = IGame.optionsZFSet p x.toIGame := by + apply ZFSet.ext + intro z + rw [mem_optionCodes, IGame.mem_optionsZFSet] + constructor + · rintro ⟨y, hy, h⟩ + exact ⟨y.toIGame, mem_moves.1 hy, (toZFSet_toIGame y).trans h⟩ + · rintro ⟨y, hy, h⟩ + refine ⟨ofIGame y, ?_, ?_⟩ + · simpa using hy + · simpa using h + +/-- A code's Kuratowski-pair components are exactly its option sets. -/ +theorem coe_eq_pair (x : GameCode.{u}) : + (x : ZFSet.{u}) = ZFSet.pair (optionCodes Player.left x) (optionCodes Player.right x) := by + rw [optionCodes_eq_optionsZFSet, optionCodes_eq_optionsZFSet, ← IGame.toZFSet_eq_pair] + exact (toZFSet_toIGame x).symm + +/-- Membership in an option set can be read directly from the code's ordered-pair components. -/ +theorem mem_moves_of_coe_eq_pair {x y : GameCode.{u}} {L R : ZFSet.{u}} + (h : (x : ZFSet.{u}) = ZFSet.pair L R) (p : Player) : + y ∈ x.moves p ↔ (y : ZFSet.{u}) ∈ Player.cases L R p := by + obtain ⟨hL, hR⟩ := ZFSet.pair_inj.1 ((coe_eq_pair x).symm.trans h) + cases p + · rw [← hL] + exact coe_mem_optionCodes.symm + · rw [← hR] + exact coe_mem_optionCodes.symm + +/-- Forming a game code from option sets produces their intrinsic Kuratowski ordered pair. -/ +theorem coe_ofSets (s t : Set GameCode.{u}) [Small.{u} s] [Small.{u} t] : + (ofSets s t : ZFSet.{u}) = ZFSet.pair + (ZFSet.range fun y : s ↦ (y.1 : ZFSet.{u})) + (ZFSet.range fun y : t ↦ (y.1 : ZFSet.{u})) := by + rw [coe_eq_pair] + apply congrArg₂ ZFSet.pair <;> apply ZFSet.ext <;> intro z <;> simp + +/-- Conway comparison is the recursive comparison of the two option sets. -/ +theorem le_iff_forall_not_le (x y : GameCode.{u}) : + x ≤ y ↔ (∀ z ∈ x.moves Player.left, ¬ y ≤ z) ∧ + (∀ z ∈ y.moves Player.right, ¬ z ≤ x) := by + rw [← toIGame_le_toIGame, IGame.le_iff_forall_lf] + simp only [moves, Set.forall_mem_image, ← toIGame_le_toIGame, toIGame_ofIGame] + +/-- Numeric codes have numeric options, with every left option below every right option. -/ +theorem isNumeric_iff_options (x : GameCode.{u}) : + IsNumeric x ↔ + (∀ y ∈ x.moves Player.left, ∀ z ∈ x.moves Player.right, y < z) ∧ + (∀ p, ∀ y ∈ x.moves p, IsNumeric y) := by + rw [isNumeric_iff, IGame.numeric_def] + simp only [moves, Set.forall_mem_image, ofIGame_lt_ofIGame, isNumeric_ofIGame] + +@[simp] +theorem moves_neg (p : Player) (x : GameCode.{u}) : + (-x).moves p = Neg.neg '' x.moves (-p) := by + simp only [moves, toIGame_neg, IGame.moves_neg, ← Set.image_neg_eq_neg, image_image] + exact Set.image_congr fun a _ ↦ ofIGame_neg a + +@[simp] +theorem moves_add (p : Player) (x y : GameCode.{u}) : + (x + y).moves p = (· + y) '' x.moves p ∪ (x + ·) '' y.moves p := by + simp [moves, image_union, image_image] + +/-- The usual option expression for the product of two game codes. -/ +def mulOption (x y a b : GameCode.{u}) : GameCode.{u} := a * y + x * b - a * b + +@[simp] +theorem toIGame_mulOption (x y a b : GameCode.{u}) : + (mulOption x y a b).toIGame = IGame.mulOption x.toIGame y.toIGame a.toIGame b.toIGame := by + simp [mulOption, IGame.mulOption] + +@[simp] +theorem moves_mul (p : Player) (x y : GameCode.{u}) : + (x * y).moves p = (fun a ↦ mulOption x y a.1 a.2) '' + (x.moves Player.left ×ˢ y.moves p ∪ x.moves Player.right ×ˢ y.moves (-p)) := by + simp [moves, mulOption, IGame.mulOption, image_union, prod_image_image_eq, image_image] + +end ZFSet.GameCode diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Tests.lean new file mode 100644 index 0000000000..92e20b3827 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Tests.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests.Game +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests.GameOperations + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Tests/Game.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Tests/Game.lean new file mode 100644 index 0000000000..273fadaaa5 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Tests/Game.lean @@ -0,0 +1,57 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Game +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Basic +import Mathlib.Data.Set.Finite.Basic + +/-! +# Public interface checks for ZFC game codes + +The grammar excludes arbitrary ZFC sets. Its coding distinguishes complete pregame trees and +supports genuinely infinite option sets, not just finite trees or numeral examples. +-/ + +universe u + +noncomputable section + +example : ZFSet.IsGameCode (ZFSet.pair (∅ : ZFSet.{u}) ∅) := by simp + +example : ¬ ZFSet.IsGameCode (∅ : ZFSet.{u}) := by + intro h + obtain ⟨L, R, heq, _, _⟩ := h.exists_eq_pair + have hm : ({L} : ZFSet.{u}) ∈ (∅ : ZFSet.{u}) := by rw [heq]; simp [ZFSet.pair] + exact ZFSet.notMem_empty _ hm + +example (z : ZFSet.{u}) (hz : ZFSet.IsGameCode z) : + IGame.toZFSet (IGame.zfSetEquiv.symm (ZFSet.GameCode.mk z hz)) = z := by + simp + +example (g : IGame.{u}) : IGame.zfSetEquiv.symm (IGame.zfSetEquiv g) = g := by + simp + +example {x y : ZFSet.GameCode.{u}} (h : (x : ZFSet.{u}) = (y : ZFSet.{u})) : x = y := + ZFSet.GameCode.ext h + +example (n : ℕ) : + IGame.toZFSet (n : IGame.{u}) ∈ IGame.optionsZFSet Player.left + !{Set.range (fun k : ℕ ↦ (k : IGame.{u})) | ∅} := by + simp + +example : + Set.Infinite (IGame.optionsZFSet Player.left + !{Set.range (fun k : ℕ ↦ (k : IGame.{u})) | ∅} : Set ZFSet.{u}) := by + have heq : + (IGame.optionsZFSet Player.left + !{Set.range (fun k : ℕ ↦ (k : IGame.{u})) | ∅} : Set ZFSet.{u}) = + Set.range (fun k : ℕ ↦ IGame.toZFSet (k : IGame.{u})) := by + ext z + simp + rw [heq] + exact Set.infinite_range_of_injective + (IGame.toZFSet_injective.comp (Nat.cast_injective (R := IGame.{u}))) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Tests/GameOperations.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Tests/GameOperations.lean new file mode 100644 index 0000000000..045422f727 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Tests/GameOperations.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.GameOperations + +/-! +# ZFC game-operation interface checks + +These checks distinguish Conway comparison from a vacuous relation, numeric codes from arbitrary +game codes, and literal pregame equality from equality of game values. +-/ + +universe u + +noncomputable section + +open ZFSet.GameCode + +example (x y : ZFSet.GameCode.{u}) : + (x + y * x).toIGame = x.toIGame + y.toIGame * x.toIGame := by + simp + +example (x y : ZFSet.GameCode.{u}) (hx : IsNumeric x) (hy : IsNumeric y) : + IsNumeric (-x + y * x) := hx.neg.add (hy.mul hx) + +example : (0 : ZFSet.GameCode.{u}) < 1 := by + rw [← toIGame_lt_toIGame] + simp + +example : ¬ IsNumeric (ofSets ({0} : Set ZFSet.GameCode.{u}) {0}) := by + rw [isNumeric_iff_options] + simp + +example : (ofSets ({-1} : Set ZFSet.GameCode.{u}) {1}) ≈ 0 := by + rw [← toIGame_equiv_toIGame] + simp only [toIGame_ofSets, toIGame_zero, Set.image_singleton, toIGame_neg, toIGame_one] + simp only [AntisymmRel] + constructor <;> rw [IGame.le_iff_forall_lf] <;> simp + +example : ofSets ({-1} : Set ZFSet.GameCode.{u}) {1} ≠ 0 := by + intro h + have hm : (-1 : ZFSet.GameCode.{u}) ∈ (0 : ZFSet.GameCode.{u}).moves Player.left := by + rw [← h] + simp + simp at hm + +example (x y : ZFSet.GameCode.{u}) (L R : ZFSet.{u}) + (h : (x : ZFSet.{u}) = ZFSet.pair L R) : + y ∈ x.moves Player.left ↔ (y : ZFSet.{u}) ∈ L := + mem_moves_of_coe_eq_pair h Player.left + +example (x y a b : ZFSet.GameCode.{u}) + (ha : a ∈ x.moves Player.left) (hb : b ∈ y.moves Player.right) : + mulOption x y a b ∈ (x * y).moves Player.right := by + rw [moves_mul] + exact ⟨(a, b), Or.inl ⟨ha, hb⟩, rfl⟩ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone.lean new file mode 100644 index 0000000000..a99548f0b5 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames.lean new file mode 100644 index 0000000000..592b718008 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames.lean @@ -0,0 +1,14 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependenceProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/ConwayRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/ConwayRefinement.lean new file mode 100644 index 0000000000..892a63f061 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/ConwayRefinement.lean @@ -0,0 +1,57 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Multiplication + +/-! +# Conway's refinement conjecture for cut-defined omnific integers + +An omnific integer is a surreal number satisfying Conway's cut equation +`x = {x - 1 | x + 1}`. Conway's refinement conjecture says that every equation +`a * b = c * d` among +omnific integers admits the four-factor decomposition displayed below. Zero inputs are allowed; +there are no support, reducedness, or cardinality hypotheses. +-/ + +public noncomputable section + +universe u + +namespace ConwayRefinement.Standalone.Oz + + +/-- Conway's definition: `x` is an omnific integer when it is the cut with sole left option +`x - 1` and sole right option `x + 1`. -/ +abbrev IsConwayOmnificInteger (x : Surreal.{u}) : Prop := + x = !{{x - 1} | {x + 1}}' (by + simp only [Set.mem_singleton_iff] + rintro _ rfl _ rfl + simp [sub_eq_add_neg]) + +/-- Conway's refinement conjecture: every equality `a * b = c * d` of +cut-defined omnific integers has an omnific refinement +`a = e * f`, `b = g * h`, `c = e * g`, `d = f * h`. +All four inputs may be zero. -/ +abbrev ConwayConjecture : Prop := + ∀ a b c d : Surreal.{u}, + IsConwayOmnificInteger a → IsConwayOmnificInteger b → + IsConwayOmnificInteger c → IsConwayOmnificInteger d → a * b = c * d → + ∃ e f g h : Surreal.{u}, + IsConwayOmnificInteger e ∧ IsConwayOmnificInteger f ∧ + IsConwayOmnificInteger g ∧ IsConwayOmnificInteger h ∧ + a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h + + +end ConwayRefinement.Standalone.Oz + +/-! +## Formal proof + +Proof module: `ConwayRefinementProof`. + +* `ConwayConjecture` → `ConwayConjecture.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/ConwayRefinementProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/ConwayRefinementProof.lean new file mode 100644 index 0000000000..6bc764e0f2 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/ConwayRefinementProof.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayNormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Refinement.ConwayRefinement +/-! +# Proof of Conway's refinement conjecture + +The native omnific-integer theorem is transported to Conway's cut definition. +-/ + +public noncomputable section + +universe u + +namespace ConwayRefinement.Standalone.Oz.ConwayConjecture + +/-- Every equality of products of cut-defined omnific integers has an omnific four-factor +refinement. -/ +@[blueprint "thm:conway-refinement" + (phase := "Surreal numbers and omnific integers") + (title := "Conway's refinement theorem for omnific integers") + (statement := /-- + Let $a,b,c,d$ be surreal numbers satisfying Conway's cut equation + $x=\{x-1\mid x+1\}$. If $ab=cd$, then there are surreal numbers + $e,f,g,h$, each satisfying the same cut equation, such that + \[ + a=ef,\qquad b=gh,\qquad c=eg,\qquad d=fh. + \] + -/) + (proof := /-- + By \ref{thm:conway-cut-subring-equivalence}, Conway's cut-defined + statement is equivalent to the refinement property of the omnific-integer + subring. Apply \ref{thm:omnific-integer-refinement-property}. + -/) + (highlight)] +theorem proof : ConwayRefinement.Standalone.Oz.ConwayConjecture.{u} := by + rw [ConwayRefinement.Standalone.Oz.conwayConjecture_iff_native] + exact Surreal.OmnificInteger.conwayRefinement + +end ConwayRefinement.Standalone.Oz.ConwayConjecture diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples.lean new file mode 100644 index 0000000000..ec0e238d13 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples.lean @@ -0,0 +1,20 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrimeProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamily +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamilyProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundary +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundaryProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRoots +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRootsProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorizationProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrimeProof + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/DegreeTwoPrime.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/DegreeTwoPrime.lean new file mode 100644 index 0000000000..0421b295cd --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/DegreeTwoPrime.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.DegreeTwoExample +public import Mathlib.Algebra.Prime.Defs + +/-! +# An explicit degree-two prime in `Oz` + +Let + +`x = 1 + ∑ m n, ω ^ (1 / (m + 1) + 1 / ((m + 1) * (m + 2) * (n + 1)))`, + +where every coefficient in the Conway normal form is one. For each `m`, the `n`-th row decreases +to `1 / (m + 1)`, and the rows decrease to zero. Thus its support has exact order type +`ω ^ 2 + 1`, and hence it has degree two. + +This literal omnific integer is prime. The mathematical inputs are the PS06 three-germ +irreducibility criterion and the LM24 transfer from one Archimedean class. Every claim is stated +in the surreal numbers of an arbitrary universe `u`. + +For comparison, `degreeTwoFoil = 2 * x` has exactly the same support and merely replaces every +displayed coefficient by two. Both factors are nonunits, so the foil is reducible. The pair shows +that the two-dimensional support geometry alone does not force primeness: the coefficient germs +distinguished by PS06 carry essential information. + +## References + +* J. Pommersheim, S. Shahriari, *Unique factorization in generalized power series rings*, +Proc. Amer. Math. Soc. 134 (2006), 1277–1287, cited as [PS06]. +* S. L'Innocente, V. Mantova, *A factorisation theory for generalised power series and omnific + integers*, Adv. Math. 442 (2024) 109513, cited as [LM24]. +-/ + +universe u + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.Oz.DegreeTwoExample + +open Ordinal + +/-- The exponents displayed in the normal form: zero and the row-column exponents above. -/ +def IsDisplayedExponent (i : Surreal.{u}) : Prop := + i = 0 ∨ ∃ m n : ℕ, + i = ((1 / (m + 1 : ℝ) + + 1 / ((m + 1 : ℝ) * (m + 2 : ℝ) * (n + 1 : ℝ)) : ℝ) : Surreal) + +/-- The named omnific integer is exactly the normal form displayed above: its coefficients are +one at zero and at the row-column exponents, and zero everywhere else. -/ +def HasDisplayedCoefficients : Prop := + (∀ i : Surreal.{u}, IsDisplayedExponent i → degreeTwoOz.{u}.1.coeff i = 1) ∧ + ∀ i : Surreal.{u}, ¬ IsDisplayedExponent i → degreeTwoOz.{u}.1.coeff i = 0 + +/-- The displayed normal form has exact support order type `ω ^ 2 + 1`. -/ +def HasExactSupportOrderType : Prop := + degreeTwoOz.{u}.1.length = ω ^ (2 : Ordinal) + 1 + +/-- The displayed omnific integer is prime. -/ +def IsPrime : Prop := + Prime degreeTwoOz.{u} + +/-- The coefficient-doubled foil still has exact support order type `ω ^ 2 + 1`. -/ +def FoilHasExactSupportOrderType : Prop := + degreeTwoFoil.{u}.1.length = ω ^ (2 : Ordinal) + 1 + +/-- The comparison element is literally twice the displayed prime. -/ +def FoilIsCoefficientDouble : Prop := + degreeTwoFoil.{u} = 2 * degreeTwoOz.{u} + +/-- The coefficient-doubled foil admits a factorisation into two nonunits. -/ +def FoilHasNontrivialFactorization : Prop := + ∃ a b : Oz.OmnificInteger.{u}, + degreeTwoFoil = a * b ∧ ¬ IsUnit a ∧ ¬ IsUnit b + +end ConwayRefinement.Standalone.Oz.DegreeTwoExample + +/-! +## Formal proof + +Proof module: `DegreeTwoPrimeProof`. + +* `HasExactSupportOrderType` → `HasExactSupportOrderType.proof` +* `HasDisplayedCoefficients` → `HasDisplayedCoefficients.proof` +* `IsPrime` → `IsPrime.proof` +* `FoilHasExactSupportOrderType` → `FoilHasExactSupportOrderType.proof` +* `FoilIsCoefficientDouble` → `FoilIsCoefficientDouble.proof` +* `FoilHasNontrivialFactorization` → `FoilHasNontrivialFactorization.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/DegreeTwoPrimeProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/DegreeTwoPrimeProof.lean new file mode 100644 index 0000000000..dfc64e2c50 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/DegreeTwoPrimeProof.lean @@ -0,0 +1,143 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoPrime + +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayNormalForm + +/-! +# Proofs for the explicit degree-two prime + +The normal-form ring equivalence identifies the displayed series with the reduced omnific +integer whose irreducibility and primeness follow from the PS06 criterion and the one-class +transfer. +-/ + +universe u + +public noncomputable section + +namespace ConwayRefinement.Standalone.Oz.DegreeTwoExample + +/-- The independent displayed normal form agrees with the one used by the main proof. -/ +private theorem normalForm_eq_main : DegreeTwoExample.normalForm.{u} = + Surreal.OmnificInteger.DegreeTwoExample.normalForm := by + rfl + +namespace HasExactSupportOrderType + +/-- The displayed normal form has support order type `ω ^ 2 + 1`. -/ +theorem proof : DegreeTwoExample.HasExactSupportOrderType.{u} := by + rw [DegreeTwoExample.HasExactSupportOrderType, DegreeTwoExample.degreeTwoOz_val] + rw [normalForm_eq_main] + rw [← Surreal.OmnificInteger.DegreeTwoExample.degreeTwoOz_toHahnSeries, + Surreal.length_toHahnSeries] + exact Surreal.OmnificInteger.DegreeTwoExample.degreeTwoOz_length + +end HasExactSupportOrderType + +private theorem normalFormRingEquiv_degreeTwoOz : + ConwayRefinement.Standalone.Oz.normalFormRingEquiv + DegreeTwoExample.degreeTwoOz.{u} = + Surreal.OmnificInteger.DegreeTwoExample.degreeTwoOz := by + apply Subtype.ext + rw [← Surreal.toHahnSeries_inj] + rw [ConwayRefinement.Standalone.Oz.toHahnSeries_normalFormRingEquiv, + DegreeTwoExample.degreeTwoOz_val, + normalForm_eq_main, + Surreal.OmnificInteger.DegreeTwoExample.degreeTwoOz_toHahnSeries] + +namespace IsPrime + +/-- The displayed degree-two omnific integer is prime. -/ +theorem proof : DegreeTwoExample.IsPrime.{u} := by + rw [DegreeTwoExample.IsPrime] + have hmap : Prime + (ConwayRefinement.Standalone.Oz.normalFormRingEquiv + DegreeTwoExample.degreeTwoOz) := by + rw [normalFormRingEquiv_degreeTwoOz] + exact Surreal.OmnificInteger.DegreeTwoExample.degreeTwoOz_prime + exact (MulEquiv.prime_iff + ConwayRefinement.Standalone.Oz.normalFormRingEquiv.toMulEquiv).mp hmap + +end IsPrime + +namespace FoilHasExactSupportOrderType + +/-- The coefficient-doubled foil has the same exact support order type. -/ +theorem proof : DegreeTwoExample.FoilHasExactSupportOrderType.{u} := by + rw [DegreeTwoExample.FoilHasExactSupportOrderType] + have hlength : DegreeTwoExample.degreeTwoFoil.1.length = + DegreeTwoExample.degreeTwoOz.1.length := by + apply le_antisymm + · apply SurrealHahnSeries.length_mono + rw [DegreeTwoExample.degreeTwoFoil_support] + · apply SurrealHahnSeries.length_mono + rw [DegreeTwoExample.degreeTwoFoil_support] + exact hlength.trans HasExactSupportOrderType.proof.{u} + +end FoilHasExactSupportOrderType + +private theorem two_not_isUnit : + ¬ IsUnit (2 : Oz.OmnificInteger.{u}) := by + intro h + have hmap : IsUnit + (Oz.integerConstantCoeffRingHom (2 : Oz.OmnificInteger)) := + h.map Oz.integerConstantCoeffRingHom + have heq : Oz.integerConstantCoeffRingHom + (2 : Oz.OmnificInteger) = 2 := + map_natCast Oz.integerConstantCoeffRingHom 2 + rw [heq, Int.isUnit_iff] at hmap + omega + +namespace FoilHasNontrivialFactorization + +/-- The displayed factorisation has the nonunits `2` and `degreeTwoOz`. -/ +theorem proof : DegreeTwoExample.FoilHasNontrivialFactorization.{u} := by + rw [DegreeTwoExample.FoilHasNontrivialFactorization] + exact ⟨2, DegreeTwoExample.degreeTwoOz, rfl, two_not_isUnit, + IsPrime.proof.not_unit⟩ + +end FoilHasNontrivialFactorization + +namespace FoilIsCoefficientDouble + +/-- The foil's defining equation is `degreeTwoFoil = 2 * degreeTwoOz`. -/ +theorem proof : DegreeTwoExample.FoilIsCoefficientDouble.{u} := rfl + +end FoilIsCoefficientDouble + +namespace HasDisplayedCoefficients + +/-- The concrete construction has the displayed coefficient function. -/ +theorem proof : HasDisplayedCoefficients.{u} := by + classical + have hcoeff (i : Surreal.{u}) : degreeTwoOz.{u}.1.coeff i = + if IsDisplayedExponent i then 1 else 0 := by + rw [degreeTwoOz_val, normalForm_coeff] + unfold coefficient IsDisplayedExponent + congr 1 + apply propext + constructor + · rintro ⟨p, rfl⟩ + induction p using WithTop.recTopCoe with + | top => exact Or.inl rfl + | coe p => exact Or.inr ⟨(ofLex p).1, (ofLex p).2, by simp [exponentAtIndex]⟩ + · rintro (rfl | ⟨m, n, rfl⟩) + · exact ⟨⊤, by simp [exponentAtIndex]⟩ + · exact ⟨((toLex (m, n) : Lex (ℕ × ℕ)) : Index), + by simp [exponentAtIndex, exponent_apply]⟩ + constructor + · intro i hi + rw [hcoeff, if_pos hi] + · intro i hi + rw [hcoeff, if_neg hi] + +end HasDisplayedCoefficients + +end ConwayRefinement.Standalone.Oz.DegreeTwoExample diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/FiniteDegreeFamily.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/FiniteDegreeFamily.lean new file mode 100644 index 0000000000..d58f0f037e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/FiniteDegreeFamily.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamily + +/-! +# Omnific integers at every finite power of omega + +For every natural number `n`, there is an omnific integer whose Conway normal form has support +order type exactly `ω ^ n + 1` and which is primal. Thus primality occurs at every finite degree; +the statement does not assert that these examples are irreducible. +-/ + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.Oz.FiniteDegreeExamples + +open Ordinal + +/-- Every finite power `ω ^ n + 1` occurs as the exact Conway length of a primal omnific +integer. -/ +def EveryFinitePowerOccurs : Prop := + ∀ n : ℕ, ∃ x : Oz.OmnificInteger.{0}, + x.1.length = (omega0 : Ordinal.{0}) ^ (n : Ordinal.{0}) + 1 ∧ IsPrimal x + +end ConwayRefinement.Standalone.Oz.FiniteDegreeExamples + +/-! +## Formal proof + +Proof module: `FiniteDegreeFamilyProof`. + +* `EveryFinitePowerOccurs` → `EveryFinitePowerOccurs.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/FiniteDegreeFamilyProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/FiniteDegreeFamilyProof.lean new file mode 100644 index 0000000000..5157edcca1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/FiniteDegreeFamilyProof.lean @@ -0,0 +1,25 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamily +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamilyProof + +/-! # Finite Degree Family Proof -/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.Oz.FiniteDegreeExamples.EveryFinitePowerOccurs + +/-- The coefficient-one finite-power family supplies the examples. -/ +theorem proof : FiniteDegreeExamples.EveryFinitePowerOccurs := by + rw [FiniteDegreeExamples.EveryFinitePowerOccurs] + intro n + refine ⟨FinitePowerFamily.finitePowerOz n, ?_, FinitePowerFamily.PrimalFamily.proof n⟩ + rw [FinitePowerFamily.finitePowerOz_val, + FinitePowerFamily.finitePowerNormalForm_length] + +end ConwayRefinement.Standalone.Oz.FiniteDegreeExamples.EveryFinitePowerOccurs diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmegaOmegaBoundary.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmegaOmegaBoundary.lean new file mode 100644 index 0000000000..39b354dae6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmegaOmegaBoundary.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmegaOmegaBoundary + +/-! +# The boundary at Conway length `ω ^ ω` + +There is a reduced, nonordinary omnific integer whose Conway normal form has support order type +exactly `ω ^ ω`. It therefore lies exactly at the first limit excluded by the strict +finite-degree hypothesis. This statement makes no primality or nonprimality claim about it. +-/ + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.Oz.OmegaOmegaBoundaryExample + +open Ordinal + +/-- An omnific integer is ordinary when its normal form is an integer constant. -/ +def IsOrdinary (x : Oz.OmnificInteger.{0}) : Prop := + ∃ z : ℤ, x.1 = (z : SurrealHahnSeries) + +/-- Reducedness means that `x` is nonzero and the exponents shared by `x` and `x - 1` lie in one +Archimedean class. -/ +def IsReduced (x : Oz.OmnificInteger.{0}) : Prop := + x ≠ 0 ∧ ∃ c : ArchimedeanClass Surreal, + x.1.support ∩ (x.1 - 1).support ⊆ {i | ArchimedeanClass.mk i = c} + +/-- Finite degree is the strict Conway-length bound below `ω ^ ω`. -/ +def HasFiniteDegree (x : Oz.OmnificInteger.{0}) : Prop := + Ordinal.lift.{1, 0} x.1.length < (omega0 : Ordinal.{1}) ^ (omega0 : Ordinal.{1}) + +/-- A reduced nonordinary omnific integer exists exactly at the `ω ^ ω` boundary. -/ +def ExistsAtBoundary : Prop := + ∃ x : Oz.OmnificInteger.{0}, + ¬ IsOrdinary x ∧ IsReduced x ∧ + x.1.length = (omega0 : Ordinal.{0}) ^ (omega0 : Ordinal.{0}) ∧ + ¬ HasFiniteDegree x + +end ConwayRefinement.Standalone.Oz.OmegaOmegaBoundaryExample + +/-! +## Formal proof + +Proof module: `OmegaOmegaBoundaryProof`. + +* `ExistsAtBoundary` → `ExistsAtBoundary.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmegaOmegaBoundaryProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmegaOmegaBoundaryProof.lean new file mode 100644 index 0000000000..495db9a707 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmegaOmegaBoundaryProof.lean @@ -0,0 +1,28 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundary + +/-! # Omega Omega Boundary Proof -/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.Oz.OmegaOmegaBoundaryExample.ExistsAtBoundary + +/-- The coefficient-one boundary normal form supplies the example. -/ +theorem proof : OmegaOmegaBoundaryExample.ExistsAtBoundary := by + rw [OmegaOmegaBoundaryExample.ExistsAtBoundary] + refine ⟨OmegaOmegaBoundary.boundaryOz, ?_, ?_, ?_, ?_⟩ + · simpa only [OmegaOmegaBoundaryExample.IsOrdinary, Oz.IsOrdinaryInteger] using + OmegaOmegaBoundary.boundaryOz_not_isOrdinaryInteger + · simpa only [OmegaOmegaBoundaryExample.IsReduced, Oz.IsReduced] using + OmegaOmegaBoundary.boundaryOz_isReduced + · exact OmegaOmegaBoundary.boundaryOz_length + · simpa only [OmegaOmegaBoundaryExample.HasFiniteDegree, Oz.HasFiniteDegree] using + OmegaOmegaBoundary.boundaryOz_not_hasFiniteDegree + +end ConwayRefinement.Standalone.Oz.OmegaOmegaBoundaryExample.ExistsAtBoundary diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmegaRoots.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmegaRoots.lean new file mode 100644 index 0000000000..0de82b4720 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmegaRoots.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificIntegers + +/-! +# Roots of omega in the omnific integers + +In Conway normal form, `ω` is the monomial with exponent `1`. For every positive integer `n`, +the monomial with exponent `1/n` is a nonunit omnific integer whose `n`th power is `ω`. +Thus one element admits factorisations into arbitrarily many nonunits. +-/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.Oz.OmegaRoots + +universe u + +/-- The coefficient-one Conway monomial `ω^x`, as an omnific integer. -/ +def monomial (x : Surreal.{u}) (hx : 0 ≤ x) : Oz.OmnificInteger.{u} := + ⟨SurrealHahnSeries.single x 1, Oz.single_one_mem_omnificIntegers x hx⟩ + +/-- The Conway monomial `ω`. -/ +def omega : Oz.OmnificInteger.{u} := monomial 1 zero_le_one + +/-- The normal form of `omega` is the coefficient-one monomial at exponent `1`. -/ +theorem coe_omega : omega.1 = SurrealHahnSeries.single 1 1 := (rfl) + +/-- The Conway monomial `ω^(1/n)`. -/ +def nthRoot (n : ℕ) : Oz.OmnificInteger.{u} := + monomial (n : Surreal)⁻¹ (inv_nonneg.mpr (Nat.cast_nonneg n)) + +/-- The normal form of `nthRoot n` is the coefficient-one monomial at exponent `1/n`. -/ +theorem coe_nthRoot (n : ℕ) : + (nthRoot.{u} n).1 = SurrealHahnSeries.single (n : Surreal)⁻¹ 1 := (rfl) + +/-- The omnific integer `ω` has a nonunit `n`th root for every positive integer `n`. -/ +abbrev OmegaHasRootsOfEveryPositiveOrder : Prop := + ∀ (n : ℕ), 0 < n → + ¬IsUnit (nthRoot.{u} n) ∧ nthRoot.{u} n ^ n = omega.{u} + +end ConwayRefinement.Standalone.Oz.OmegaRoots + +/-! +## Formal proof + +Proof module: `OmegaRootsProof`. + +* `OmegaHasRootsOfEveryPositiveOrder` → `OmegaHasRootsOfEveryPositiveOrder.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmegaRootsProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmegaRootsProof.lean new file mode 100644 index 0000000000..55a1a0f133 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmegaRootsProof.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRoots + +/-! # Omega Roots Proof -/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.Oz.OmegaRoots.OmegaHasRootsOfEveryPositiveOrder + +universe u + +/-- The exponent identity `(ω^(1/n))^n = ω` gives the roots; the zero constant coefficient +prevents them from being units. -/ +theorem proof : OmegaHasRootsOfEveryPositiveOrder.{u} := by + intro n hn + constructor + · intro hunit + have hcoeff : Oz.integerConstantCoeff (nthRoot n) = 0 := by + apply Int.cast_injective (α := ℝ) + rw [Oz.coe_integerConstantCoeff] + rw [coe_nthRoot, SurrealHahnSeries.coeff_single_of_ne] + · simp + · exact inv_ne_zero (Nat.cast_ne_zero.mpr hn.ne') + have := hunit.map Oz.integerConstantCoeffRingHom + rw [Oz.integerConstantCoeffRingHom_apply, hcoeff] at this + exact not_isUnit_zero this + · apply Subtype.ext + change (nthRoot n).1 ^ n = omega.1 + rw [coe_nthRoot, coe_omega] + rw [Oz.single_one_pow] + congr 2 + simp [nsmul_eq_mul, Nat.cast_ne_zero.mpr hn.ne'] + +end ConwayRefinement.Standalone.Oz.OmegaRoots.OmegaHasRootsOfEveryPositiveOrder diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmnificFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmnificFactorization.lean new file mode 100644 index 0000000000..0fc52e53b1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmnificFactorization.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificIntegers +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinement +public import Mathlib.Algebra.Prime.Defs + +/-! +# Factorisation in the omnific integers + +CombinatorialGames provides the types `Surreal` and `SurrealHahnSeries`, but not the normal-form +ring equivalence between them or the subring `Oz`. + +**Identification.** Conway defines `Oz` by `x = {x - 1 | x + 1}`. The normal-form ring +equivalence sends precisely these surreals to the series with nonnegative exponents and an integer +constant coefficient. + +**Primality.** Every omnific integer is primal: whenever it divides a product, it splits as a +product of one divisor of each factor. This is the pre-Schreier form of Conway's refinement +conjecture. + +**Factorisation.** Every irreducible omnific integer is prime, and two factorisations of an +omnific integer into irreducibles agree up to order and units. + +## References + +* S. L'Innocente, V. Mantova, *A factorisation theory for generalised power series and omnific + integers*, Adv. Math. 442 (2024) 109513, , cited + as [LM24]. +-/ + +universe u + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.Oz + +/-- Membership in the normal-form ring `Oz`: nonnegative support and an integer coefficient at +exponent zero. -/ +theorem mem_normalFormOmnificIntegers_iff (x : SurrealHahnSeries.{u}) : + x ∈ omnificIntegers ↔ + x.support ⊆ Set.Ici 0 ∧ ∃ z : ℤ, (z : ℝ) = x.coeff 0 := by + rw [mem_omnificIntegers, Set.mem_range] + +/-- A ring equivalence from surreal numbers to surreal Hahn series identifies Conway's +cut-defined omnific integers with the normal-form subring `omnificIntegers`. -/ +def NormalFormIdentifiesOmnificIntegers : Prop := + ∃ e : Surreal.{u} ≃+* SurrealHahnSeries.{u}, + ∀ x : Surreal.{u}, IsConwayOmnificInteger x ↔ e x ∈ omnificIntegers + +/-- Every omnific integer is primal. Equivalently, `Oz` is a pre-Schreier ring. -/ +def EveryOmnificIntegerIsPrimal : Prop := + ∀ x : (omnificIntegers : Subring SurrealHahnSeries.{u}), IsPrimal x + +/-- Every irreducible omnific integer is prime. -/ +def IrreducibleIsPrime : Prop := + ∀ x : (omnificIntegers : Subring SurrealHahnSeries.{u}), Irreducible x → Prime x + +/-- Unique factorisation: two products of irreducible omnific integers that agree up to a unit +have the same factors up to order and association. -/ +def IrreducibleFactorizationsAreUnique : Prop := + ∀ f g : Multiset (omnificIntegers : Subring SurrealHahnSeries.{u}), + (∀ x ∈ f, Irreducible x) → (∀ x ∈ g, Irreducible x) → + Associated f.prod g.prod → Multiset.Rel Associated f g + +end ConwayRefinement.Standalone.Oz + +/-! +## Formal proof + +Proof module: `OmnificFactorizationProof`. + +* `NormalFormIdentifiesOmnificIntegers` → `NormalFormIdentifiesOmnificIntegers.proof` +* `EveryOmnificIntegerIsPrimal` → `EveryOmnificIntegerIsPrimal.proof` +* `IrreducibleIsPrime` → `IrreducibleIsPrime.proof` +* `IrreducibleFactorizationsAreUnique` → `IrreducibleFactorizationsAreUnique.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmnificFactorizationProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmnificFactorizationProof.lean new file mode 100644 index 0000000000..a56c720a3e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OmnificFactorizationProof.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFactorizationProof + +/-! # Omnific Factorization Proof -/ + +public noncomputable section + +universe u + +namespace ConwayRefinement.Standalone.Oz + +namespace NormalFormIdentifiesOmnificIntegers + +/-- Conway's cut definition and the normal-form definition determine the same subring. -/ +theorem proof : Oz.NormalFormIdentifiesOmnificIntegers.{u} := + of_normalForm + +end NormalFormIdentifiesOmnificIntegers + +namespace EveryOmnificIntegerIsPrimal + +/-- Every omnific integer is primal. -/ +theorem proof : Oz.EveryOmnificIntegerIsPrimal.{u} := + of_refinement + +end EveryOmnificIntegerIsPrimal + +namespace IrreducibleIsPrime + +/-- Every irreducible omnific integer is prime. -/ +theorem proof : Oz.IrreducibleIsPrime.{u} := + of_primality + +end IrreducibleIsPrime + +namespace IrreducibleFactorizationsAreUnique + +/-- Irreducible factorisations in `Oz` are unique up to order and units. -/ +theorem proof : Oz.IrreducibleFactorizationsAreUnique.{u} := + of_primality + +end IrreducibleFactorizationsAreUnique + +end ConwayRefinement.Standalone.Oz diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OneRowPrime.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OneRowPrime.lean new file mode 100644 index 0000000000..27839dd4d4 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OneRowPrime.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OneRowExample +public import Mathlib.Algebra.Prime.Defs + +/-! +# Conway's one-row prime in `Oz` + +Let + +`x = 1 + Σ n : ℕ, ω ^ (1 / (n + 1))`, + +with every coefficient in the Conway normal form equal to one. The positive exponents decrease +to zero, so the support is a single row of order type `ω` followed by the constant term. + +This omnific integer has exact support order type `ω + 1` and is prime, the concrete form of +LM24, Example 9.2.8. + +## References + +* S. L'Innocente, V. Mantova, *A factorisation theory for generalised power series and omnific + integers*, Adv. Math. 442 (2024) 109513, cited as [LM24]. +-/ + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.Oz.OneRowExample + +open Ordinal + +/-- The exponents displayed in the normal form: zero and `1/(n+1)` for `n ≥ 0`. -/ +def IsDisplayedExponent (i : Surreal) : Prop := + i = 0 ∨ ∃ n : ℕ, i = ((1 / (n + 1 : ℝ) : ℝ) : Surreal) + +/-- The named omnific integer is exactly the normal form displayed above: its coefficients are +one at zero and at the exponents `1/(n+1)`, and zero everywhere else. -/ +def HasDisplayedCoefficients : Prop := + (∀ i : Surreal, IsDisplayedExponent i → oneRowOz.1.coeff i = 1) ∧ + ∀ i : Surreal, ¬ IsDisplayedExponent i → oneRowOz.1.coeff i = 0 + +/-- The displayed normal form has exact support order type `ω + 1`. -/ +def HasExactSupportOrderType : Prop := + oneRowOz.1.length = omega0 + 1 + +/-- Conway's displayed one-row omnific integer is prime. -/ +def IsPrime : Prop := + Prime oneRowOz + +end ConwayRefinement.Standalone.Oz.OneRowExample + +/-! +## Formal proof + +Proof module: `OneRowPrimeProof`. + +* `HasExactSupportOrderType` → `HasExactSupportOrderType.proof` +* `HasDisplayedCoefficients` → `HasDisplayedCoefficients.proof` +* `IsPrime` → `IsPrime.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OneRowPrimeProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OneRowPrimeProof.lean new file mode 100644 index 0000000000..3a3df29971 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OneRowPrimeProof.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowPrime + +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayNormalForm + +/-! +# Proofs for Conway's one-row prime + +The normal-form ring equivalence identifies the displayed series with the +cut-defined omnific integer whose irreducibility and primeness are proved from Berarducci's +theorem and the finite-degree primality theorem. +-/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.Oz.OneRowExample + +/-- The independent displayed normal form agrees with the one used by the main proof. -/ +private theorem normalForm_eq_main : OneRowExample.normalForm = + Surreal.OmnificInteger.OneRowExample.normalForm := by + rfl + +namespace HasDisplayedCoefficients + +/-- The concrete construction has the displayed coefficient function. -/ +theorem proof : HasDisplayedCoefficients := by + classical + have hcoeff (i : Surreal) : oneRowOz.1.coeff i = + if IsDisplayedExponent i then 1 else 0 := by + rw [oneRowOz_val, normalForm_coeff] + unfold coefficient IsDisplayedExponent + congr 1 + apply propext + constructor + · rintro ⟨p, rfl⟩ + induction p using WithTop.recTopCoe with + | top => exact Or.inl rfl + | coe n => exact Or.inr ⟨n, by simp [exponentAtIndex]⟩ + · rintro (rfl | ⟨n, rfl⟩) + · exact ⟨⊤, by simp [exponentAtIndex]⟩ + · exact ⟨(n : Index), by simp [exponentAtIndex, exponent_apply]⟩ + constructor + · intro i hi + rw [hcoeff, if_pos hi] + · intro i hi + rw [hcoeff, if_neg hi] + +end HasDisplayedCoefficients + +namespace HasExactSupportOrderType + +/-- The displayed normal form has support order type `ω + 1`. -/ +theorem proof : OneRowExample.HasExactSupportOrderType := by + rw [OneRowExample.HasExactSupportOrderType, OneRowExample.oneRowOz_val] + rw [normalForm_eq_main] + rw [← Surreal.OmnificInteger.OneRowExample.oneRowOz_toHahnSeries, + Surreal.length_toHahnSeries] + exact Surreal.OmnificInteger.OneRowExample.oneRowOz_length + +end HasExactSupportOrderType + +private theorem normalFormRingEquiv_oneRowOz : + ConwayRefinement.Standalone.Oz.normalFormRingEquiv + OneRowExample.oneRowOz = + Surreal.OmnificInteger.OneRowExample.oneRowOz := by + apply Subtype.ext + rw [← Surreal.toHahnSeries_inj] + rw [ConwayRefinement.Standalone.Oz.toHahnSeries_normalFormRingEquiv, + OneRowExample.oneRowOz_val, + normalForm_eq_main, + Surreal.OmnificInteger.OneRowExample.oneRowOz_toHahnSeries] + +namespace IsPrime + +/-- Conway's displayed one-row omnific integer is prime. -/ +theorem proof : OneRowExample.IsPrime := by + rw [OneRowExample.IsPrime] + have hmap : Prime + (ConwayRefinement.Standalone.Oz.normalFormRingEquiv + OneRowExample.oneRowOz) := by + rw [normalFormRingEquiv_oneRowOz] + exact Surreal.OmnificInteger.OneRowExample.oneRowOz_prime + exact (MulEquiv.prime_iff + ConwayRefinement.Standalone.Oz.normalFormRingEquiv.toMulEquiv).mp hmap + +end IsPrime + +end ConwayRefinement.Standalone.Oz.OneRowExample diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/PrincipalRVAlgebraicIndependence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/PrincipalRVAlgebraicIndependence.lean new file mode 100644 index 0000000000..505d94d62c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/PrincipalRVAlgebraicIndependence.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Data.Real.Basic +public import Mathlib.RingTheory.HahnSeries.Multiplication +public import Mathlib.RingTheory.MvPolynomial.WeightedHomogeneous +public import Mathlib.Algebra.MvPolynomial.Eval +public import Mathlib.Order.WellFoundedSet +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow + +/-! +# Algebraic independence in $\widehat{\mathrm P}$ + +`K((ℝ^{≤0}))` is the ring of Hahn series with real exponents `≤ 0` over a field `K` +[LM24, §1.2]. Berarducci's *ordinal value* `v_J` [Ber00, Def. 5.2] is determined by the class of +a series modulo `J + K`: `v_J(b) = 0` if `b ∈ J`, the ideal generated by the monomials `t^x`, +`x < 0` [Ber00, Def. 5.1]; `v_J(b) = 1` if `b ∈ (J + K) \ J`; otherwise `v_J(b)` is the least +order type of the support of a series congruent to `b` modulo `J + K`. Its values are `0` or +additively principal ordinals `ω^α`, and `J_{ω^α} := {b : v_J(b) < ω^α}`. + +For each `α`, `P_α := J_{ω^(α+1)} / J_{ω^α}` is the vector space of principal RV-elements of +degree `α`. Their direct sum is +`P̂ := ⨁_α P_α`, graded by the natural sum of ordinals: `v_J(bc) ≤ v_J(b) ⊕ v_J(c)` +[Ber00, Thm. 5.8], so the product of classes of degrees `α` and `β` is a class of degree `α ⊕ β`. +A *minimal homogeneous family* in `P̂` is a family of classes `B ∈ P_{deg B}` of positive +degrees whose members of each degree `β` are linearly independent modulo +`(P̂_+)² ∩ P_β = ∑_{i ⊕ j = β, i, j ≠ 0} P_i P_j`, the square of the ideal of positive degree in +degree `β` (the decomposable elements, `IsDecomposable`). + +**Algebraic independence** (the injective half of the polynomiality of `P̂`). Every minimal +homogeneous family `𝓑` is algebraically independent. Thus the +subalgebra it generates is a polynomial algebra; if `𝓑` generates `P̂`, then `P̂` itself is a +polynomial algebra. In terms of series: a polynomial `F` homogeneous of degree `α` (for +`deg X_B = deg B`) with `v_J(F(b_𝓑)) < ω^α`, where `b_B` represents `B`, is zero. + +The proposition `MinimalFamiliesAlgebraicallyIndependent` expresses this statement through +representatives: a class of degree `α` is a series `b` with `v_J(b) < ω^(α+1)`, and two such +series represent the same class exactly when their difference lies in `J_{ω^α}`. + +## References + +* A. Berarducci, *Factorization in generalized power series*, Trans. Amer. Math. Soc. 352 (2000) + 553–577, cited as [Ber00]. +* S. L'Innocente, V. Mantova, *A factorisation theory for generalised power series and omnific + integers*, Adv. Math. 442 (2024) 109513, cited as [LM24]. +-/ + +open Ordinal +open scoped NatOrdinal + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.PrincipalRVAlgebraicIndependence + +universe u v + +variable {K : Type u} [Field K] + +/-! ### The ring -/ + +variable (K) in +/-- `K((ℝ^{≤0}))`: Hahn series with real exponents `≤ 0` [LM24, §1.2], as a `K`-subalgebra of +`K((ℝ))`. -/ +def nonpos : Subalgebra K (HahnSeries ℝ K) where + carrier := {x | x.support ⊆ Set.Iic 0} + algebraMap_mem' k := by + intro g hg + rw [HahnSeries.algebraMap_apply] at hg + have hg0 : g = 0 := HahnSeries.support_single_subset hg + simp [hg0] + add_mem' := fun {x y} hx hy g hg ↦ by + rcases HahnSeries.support_add_subset x y hg with h | h + exacts [hx h, hy h] + mul_mem' := fun {x y} hx hy g hg ↦ by + obtain ⟨i, hi, j, hj, rfl⟩ := HahnSeries.support_mul_subset hg + exact Set.mem_Iic.mpr (add_nonpos (Set.mem_Iic.mp (hx hi)) (Set.mem_Iic.mp (hy hj))) + +/-- `<` well-orders the support, as a generalised power series requires [LM24, §1.2]. -/ +theorem supportIsWellOrder (x : HahnSeries ℝ K) : + IsWellOrder x.support (Subrel (· < ·) (· ∈ x.support)) := by + refine { wf := x.isPWO_support.isWF, trichotomous := fun _ _ hab hba ↦ ?_ } + exact Subtype.ext (le_antisymm (le_of_not_gt hba) (le_of_not_gt hab)) + +/-- The order type of the well-ordered support of `x` [LM24, §2.2]. -/ +def ot (x : HahnSeries ℝ K) : Ordinal.{0} := + @Ordinal.type x.support (Subrel (· < ·) (· ∈ x.support)) (supportIsWellOrder x) + +/-! ### The ordinal value -/ + +/-- The ideal `J` generated by the monomials `t^x`, `x < 0` [Ber00, Def. 5.1]: the series whose +support is bounded away from `0`. -/ +def MemJ (x : nonpos K) : Prop := + ∃ s < (0 : ℝ), (x : HahnSeries ℝ K).support ⊆ Set.Iic s + +/-- Congruence to a constant modulo `J`: membership in Berarducci's subgroup `J + K`. -/ +def IsNearConstant (x : nonpos K) : Prop := + ∃ k : K, MemJ (x - algebraMap K (nonpos K) k) + +open scoped Classical in +/-- **Berarducci's ordinal value** `v_J` [Ber00, Def. 5.2]: `0` on `J`, `1` on `(J + K) \ J`, and +otherwise the least order type of the support of a series congruent to `x` modulo `J + K`. -/ +def ordinalValue (x : nonpos K) : NatOrdinal := + if MemJ x then 0 + else if IsNearConstant x then 1 + else sInf {o | ∃ c : nonpos K, + IsNearConstant (x - c) ∧ NatOrdinal.of (ot (c : HahnSeries ℝ K)) = o} + +/-! ### Classes, decomposables, and minimal homogeneous families -/ + +variable {ι : Type v} + +/-- `x` is *decomposable at degree `α`*: modulo `J_{ω^α}`, a finite sum of products `u_k w_k` of +representatives of classes of positive degrees `β_k ⊕ β'_k = α` — a representative of an element +of `(P̂_+)² ∩ P_α = ∑_{i ⊕ j = α, i, j ≠ 0} P_i P_j`, the square of the ideal of positive degree +in degree `α`. -/ +def IsDecomposable (α : NatOrdinal) (x : nonpos K) : Prop := + ∃ (n : ℕ) (β β' : Fin n → NatOrdinal) (u w : Fin n → nonpos K), + (∀ k, β k ≠ 0 ∧ β' k ≠ 0 ∧ β k + β' k = α) ∧ + (∀ k, ordinalValue (u k) < ω^ (β k + 1)) ∧ (∀ k, ordinalValue (w k) < ω^ (β' k + 1)) ∧ + ordinalValue (x - ∑ k, u k * w k) < ω^ α + +/-- A minimal homogeneous family in `P̂`, through representatives: `b i` represents a class of +positive degree `deg i`, and the classes of any fixed degree are linearly independent modulo the +decomposables of that degree. -/ +structure IsMinimalHomogeneousFamily (deg : ι → NatOrdinal) (b : ι → nonpos K) : Prop where + /-- Every generator has positive degree. -/ + ne_zero : ∀ i, deg i ≠ 0 + /-- `b i` represents a class of degree `deg i`. -/ + mem : ∀ i, ordinalValue (b i) < ω^ (deg i + 1) + /-- The generators of degree `β` are linearly independent modulo the decomposables. -/ + independent : ∀ (β : NatOrdinal) (c : ι →₀ K), (∀ i ∈ c.support, deg i = β) → + IsDecomposable β (c.sum fun i k ↦ algebraMap K (nonpos K) k * b i) → c = 0 + +variable (K) in +/-- **Algebraic independence in `P̂`.** For every minimal homogeneous family, given through +representatives `b i` of classes of degrees `deg i`, a polynomial `F ∈ K[X_i]` homogeneous of +degree `α` whose evaluation `F(b)` lies in `J_{ω^α}` is zero. + +The conclusion is asserted in characteristic zero. -/ +abbrev MinimalFamiliesAlgebraicallyIndependent : Prop := + CharZero K → + ∀ {ι : Type} (deg : ι → NatOrdinal) (b : ι → nonpos K), + IsMinimalHomogeneousFamily deg b → + ∀ (α : NatOrdinal) (F : MvPolynomial ι K), MvPolynomial.IsWeightedHomogeneous deg F α → + ordinalValue (MvPolynomial.aeval b F) < ω^ α → F = 0 + +end ConwayRefinement.Standalone.PrincipalRVAlgebraicIndependence + +/-! +## Formal proof + +Proof module: `PrincipalRVAlgebraicIndependenceProof`. + +* `MinimalFamiliesAlgebraicallyIndependent` → `MinimalFamiliesAlgebraicallyIndependent.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/PrincipalRVAlgebraicIndependenceProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/PrincipalRVAlgebraicIndependenceProof.lean new file mode 100644 index 0000000000..f1846fa74b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/PrincipalRVAlgebraicIndependenceProof.lean @@ -0,0 +1,28 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependence +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.PrincipalRVAlgebraicIndependenceProof + +/-! # Principal RVAlgebraic Independence Proof -/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.PrincipalRVAlgebraicIndependence + +namespace MinimalFamiliesAlgebraicallyIndependent + +universe u + +/-- Every minimal homogeneous family in `P̂` is algebraically independent. -/ +theorem proof (K : Type u) [Field K] : + PrincipalRVAlgebraicIndependence.MinimalFamiliesAlgebraicallyIndependent K := by + exact of_algebraicIndependence K + +end MinimalFamiliesAlgebraicallyIndependent + +end ConwayRefinement.Standalone.PrincipalRVAlgebraicIndependence diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support.lean new file mode 100644 index 0000000000..eb215f4489 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support.lean @@ -0,0 +1,19 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayNormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayRefinementConsequences +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.DegreeTwoExample +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamily +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamilyProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmegaOmegaBoundary +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFactorizationProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFiniteDegree +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificIntegers +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OneRowExample +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.PrincipalRVAlgebraicIndependenceProof + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/ConwayNormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/ConwayNormalForm.lean new file mode 100644 index 0000000000..a39277f0bc --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/ConwayNormalForm.lean @@ -0,0 +1,186 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayRefinementConsequences +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFiniteDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OrdinaryIntegers +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduced +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.RefinementConjecture +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.DenominatorIdeal + +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Degree +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.DegreeTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Conway cuts and the normal-form presentation of omnific integers + +Conway normal forms give a ring equivalence between the cut-defined omnific integers and the +generalised-power-series presentation used by the standalone factorisation statements. +-/ + +public noncomputable section + +open Cardinal FiniteArchimedeanClass +open scoped HahnSeries NatOrdinal + +universe u + +namespace ConwayRefinement.Standalone.Oz + +/-- The standalone cut predicate agrees with membership in the omnific-integer subring. -/ +theorem isConwayOmnificInteger_iff_mem {x : Surreal.{u}} : + IsConwayOmnificInteger x ↔ x ∈ Surreal.omnificIntegers := by + rw [isConwayOmnificInteger_iff, Surreal.mem_omnificIntegers, Surreal.isOmnificInteger_iff, + Surreal.omnificIntegerCut_eq] + +/-- The cut-defined and subring formulations of Conway's refinement conjecture are equivalent. -/ +@[blueprint "thm:conway-cut-subring-equivalence" + (phase := "Surreal numbers and omnific integers") + (title := "Equivalence of the cut and subring formulations of Conway's refinement conjecture") + (statement := /-- + Conway's refinement conjecture for cut-defined omnific integers is + equivalent to the refinement property of the omnific-integer subring of + the surreal numbers. + -/) + (proof := /-- + The cut predicate for omnific integers is equivalent to membership in the + omnific-integer subring. Substitute this equivalence into the two + four-factor statements; their equations and quantifiers are identical. + -/)] +theorem conwayConjecture_iff_native : ConwayConjecture.{u} ↔ ConwayRefinementConjecture.{u} := by + rw [conwayConjecture_iff, conwayRefinementConjecture_def, ← hasFourFactorRefinement_def] + simpa only [isConwayOmnificInteger_iff_mem] using + (Subring.hasFourFactorRefinement_iff Surreal.omnificIntegers).symm + +/-- Conway's refinement conjecture is equivalent to primality of every omnific integer. -/ +theorem conwayConjecture_iff_forall_isPrimal : + ConwayConjecture.{u} ↔ ∀ b : Surreal.OmnificInteger.{u}, IsPrimal b := by + rw [conwayConjecture_iff_native, conwayRefinementConjecture_def, + ← hasFourFactorRefinement_def, hasFourFactorRefinement_iff_forall_isPrimal] + +/-- Conway's refinement conjecture is equivalent to the pre-Schreier property of the omnific +integers. -/ +theorem conwayConjecture_iff_decompositionMonoid : + ConwayConjecture.{u} ↔ DecompositionMonoid Surreal.OmnificInteger.{u} := by + rw [conwayConjecture_iff_forall_isPrimal, decompositionMonoid_iff] + +/-- Conway's refinement conjecture is equivalent to the common-divisor criterion for denominator +ideals. -/ +theorem conwayConjecture_iff_forall_denominatorIdeal_exists_commonDivisor : + ConwayConjecture.{u} ↔ + ∀ (ξ : Surreal.{u}) + (x y : Subring.denominatorIdeal Surreal.omnificIntegers ξ), + ∃ s : Subring.denominatorIdeal Surreal.omnificIntegers ξ, + (s : Surreal.OmnificInteger) ∣ (x : Surreal.OmnificInteger) ∧ + (s : Surreal.OmnificInteger) ∣ (y : Surreal.OmnificInteger) := by + rw [conwayConjecture_iff_native, conwayRefinementConjecture_def, + ← hasFourFactorRefinement_def, + Subring.hasFourFactorRefinement_iff_forall_denominatorIdeal_exists_common_divisor] + +/-- The Conway normal-form equivalence identifies the two definitions of omnific integers. -/ +theorem normalFormIdentifiesOmnificIntegers : + NormalFormIdentifiesOmnificIntegers.{u} := by + refine ⟨Surreal.toHahnSeriesRingEquiv, ?_⟩ + intro x + rw [Surreal.toHahnSeriesRingEquiv_apply, isConwayOmnificInteger_iff, + mem_omnificIntegers, Surreal.support_toHahnSeries, + congrFun (Surreal.coeff_toHahnSeries x) 0, + ← Surreal.isOmnificInteger_iff_normalForm, Surreal.isOmnificInteger_iff, + Surreal.omnificIntegerCut_eq] + +/-- The normal-form and cut-defined omnific-integer rings are isomorphic. -/ +def normalFormRingEquiv : OmnificInteger.{u} ≃+* Surreal.OmnificInteger.{u} := + Surreal.toHahnSeriesRingEquiv.symm.restrict + omnificIntegers Surreal.omnificIntegers fun x ↦ by + rw [mem_omnificIntegers, Surreal.mem_omnificIntegers, + Surreal.isOmnificInteger_iff_normalForm] + simp only [Surreal.toHahnSeriesRingEquiv_symm_apply, + SurrealHahnSeries.support_toSurreal, SurrealHahnSeries.coeff_toSurreal] + +@[simp] +theorem coe_normalFormRingEquiv (x : OmnificInteger.{u}) : + (normalFormRingEquiv x : Surreal.{u}) = x.1.toSurreal := + Surreal.toHahnSeriesRingEquiv_symm_apply x.1 + +theorem toHahnSeries_normalFormRingEquiv (x : OmnificInteger.{u}) : + (normalFormRingEquiv x : Surreal.{u}).toHahnSeries = x.1 := by + rw [coe_normalFormRingEquiv] + exact SurrealHahnSeries.toHahnSeries_toSurreal x.1 + +theorem normalFormRingEquiv_not_isOrdinaryInteger + (x : OmnificInteger.{u}) (hx : ¬ IsOrdinaryInteger x) : + ¬ Surreal.OmnificInteger.IsOrdinaryInteger (normalFormRingEquiv x) := by + intro hordinary + apply hx + rw [Surreal.OmnificInteger.isOrdinaryInteger_iff] at hordinary + obtain ⟨z, hz⟩ := hordinary + have htarget : normalFormRingEquiv x = (z : Surreal.OmnificInteger.{u}) := + Subtype.ext hz + have hsource : x = (z : OmnificInteger.{u}) := by + apply normalFormRingEquiv.injective + simpa using htarget + exact ⟨z, congrArg Subtype.val hsource⟩ + +theorem normalFormRingEquiv_isReduced + (x : OmnificInteger.{u}) (hx : IsReduced x) : + HahnSeries.Nonpositive.IsReduced + (normalFormRingEquiv x).toSignedNonpositiveHahn := by + obtain ⟨hx0, c, hclass⟩ := hx + have hy0 : normalFormRingEquiv x ≠ 0 := + normalFormRingEquiv.map_eq_zero_iff.not.mpr hx0 + refine HahnSeries.Nonpositive.isReduced_of_support_inter_support_sub_one_subset + ?_ c ?_ + · intro hzero + apply hy0 + apply Subtype.ext + apply Surreal.toSignedFullHahnSeries_injective + have hraw := congrArg (fun q : HahnSeries.Nonpositive Surreal ℝ ↦ + (q : HahnSeries Surreal ℝ)) hzero + rw [Surreal.OmnificInteger.coe_toSignedNonpositiveHahn] at hraw + exact hraw.trans Surreal.toSignedFullHahnSeries_zero.symm + · intro g hg + have hgSource : g ∈ + (normalFormRingEquiv x).1.toSignedFullHahnSeries.support := by + rw [← Surreal.OmnificInteger.coe_toSignedNonpositiveHahn] + exact hg.1 + have hsub : + ((((normalFormRingEquiv x).toSignedNonpositiveHahn - 1 : + HahnSeries.Nonpositive Surreal ℝ)) : HahnSeries Surreal ℝ) = + ((normalFormRingEquiv x).1 - 1).toSignedFullHahnSeries := by + calc + _ = ((normalFormRingEquiv x).toSignedNonpositiveHahn : + HahnSeries Surreal ℝ) - 1 := rfl + _ = (normalFormRingEquiv x).1.toSignedFullHahnSeries - 1 := by + rw [Surreal.OmnificInteger.coe_toSignedNonpositiveHahn] + _ = ((normalFormRingEquiv x).1 - 1).toSignedFullHahnSeries := by + rw [Surreal.toSignedFullHahnSeries_sub] + congr 1 + simpa using (Surreal.toSignedFullHahnSeries_realCast (1 : ℝ)).symm + have hgSub : g ∈ + ((normalFormRingEquiv x).1 - 1).toSignedFullHahnSeries.support := by + rw [← hsub] + exact hg.2 + have huSource : -g ∈ x.1.support := by + have hu : -g ∈ (normalFormRingEquiv x).1.support := by + simpa using (Surreal.mem_support_toSignedFullHahnSeries.mp hgSource) + rw [← toHahnSeries_normalFormRingEquiv x] + simpa using hu + have hnormalSub : + ((normalFormRingEquiv x).1 - 1).toHahnSeries = x.1 - 1 := by + rw [← Surreal.toHahnSeriesRingEquiv_apply, map_sub, + Surreal.toHahnSeriesRingEquiv_apply, toHahnSeries_normalFormRingEquiv, + map_one] + have huSub : -g ∈ (x.1 - 1).support := by + have hu : -g ∈ ((normalFormRingEquiv x).1 - 1).support := by + simpa using (Surreal.mem_support_toSignedFullHahnSeries.mp hgSub) + rw [← hnormalSub, Surreal.support_toHahnSeries] + exact hu + simpa using hclass ⟨huSource, huSub⟩ + +end ConwayRefinement.Standalone.Oz diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/ConwayRefinementConsequences.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/ConwayRefinementConsequences.lean new file mode 100644 index 0000000000..92636361e6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/ConwayRefinementConsequences.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinement + +/-! # Conway Refinement Consequences -/ + +public noncomputable section + +universe u + +namespace ConwayRefinement.Standalone.Oz + +/-- Membership unfolds to Conway's defining cut equation. -/ +theorem isConwayOmnificInteger_iff (x : Surreal.{u}) : + IsConwayOmnificInteger x ↔ + x = !{{x - 1} | {x + 1}}' (by + simp only [Set.mem_singleton_iff] + rintro _ rfl _ rfl + simp [sub_eq_add_neg]) := (Iff.rfl) + +/-- The proposition unfolds to the displayed four-factor refinement. -/ +theorem conwayConjecture_iff : ConwayConjecture.{u} ↔ + ∀ a b c d : Surreal.{u}, + IsConwayOmnificInteger a → IsConwayOmnificInteger b → + IsConwayOmnificInteger c → IsConwayOmnificInteger d → a * b = c * d → + ∃ e f g h : Surreal.{u}, + IsConwayOmnificInteger e ∧ IsConwayOmnificInteger f ∧ + IsConwayOmnificInteger g ∧ IsConwayOmnificInteger h ∧ + a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h := + (Iff.rfl) + +end ConwayRefinement.Standalone.Oz diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/DegreeTwoExample.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/DegreeTwoExample.lean new file mode 100644 index 0000000000..a0561bd766 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/DegreeTwoExample.lean @@ -0,0 +1,221 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificIntegers +public import Mathlib.Data.Prod.Lex +public import Mathlib.SetTheory.Ordinal.Arithmetic + +import all LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic + +/-! +# A concrete degree-two omnific integer + +The nonconstant exponents of the explicit element are + +`1 / (m + 1) + 1 / ((m + 1) * (m + 2) * (n + 1))`, + +for `m n : ℕ`, and every displayed coefficient is one. For fixed `m` these exponents decrease to +`1 / (m + 1)`; the rows themselves decrease to zero. The final constant term is also one. + +The construction is universe-polymorphic: the normal form is written in the surreal numbers of +every universe `u`. Its support order type and primeness are stated in `DegreeTwoPrime`. +-/ + +universe u + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.Oz.DegreeTwoExample + +open Set + +/-- The positive Conway exponent in row `m` and column `n`. -/ +def exponent (m n : ℕ) : ℝ := + 1 / (m + 1 : ℝ) + + 1 / ((m + 1 : ℝ) * (m + 2 : ℝ) * (n + 1 : ℝ)) + +@[simp] +theorem exponent_apply (m n : ℕ) : + exponent m n = + 1 / (m + 1 : ℝ) + + 1 / ((m + 1 : ℝ) * (m + 2 : ℝ) * (n + 1 : ℝ)) := by + rfl + +private def cutoff (m : ℕ) : ℝ := + 1 / (m + 1 : ℝ) + +private theorem exponent_strictAnti_second (m : ℕ) : + StrictAnti (exponent m) := by + apply strictAnti_nat_of_succ_lt + intro n + rw [exponent_apply, exponent_apply] + gcongr + omega + +private theorem cutoff_lt_exponent (m n : ℕ) : + cutoff m < exponent m n := by + rw [cutoff, exponent_apply] + have : 0 < + 1 / ((m + 1 : ℝ) * (m + 2 : ℝ) * (n + 1 : ℝ)) := by + positivity + linarith + +private theorem next_exponent_zero_lt_cutoff (m : ℕ) : + exponent (m + 1) 0 < cutoff m := by + rw [exponent_apply, cutoff] + field_simp + norm_num [Nat.cast_add, Nat.cast_one] + ring_nf + nlinarith + +private theorem exponent_gt_of_first_lt + {m m' n n' : ℕ} (hmm' : m < m') : + exponent m n > exponent m' n' := by + calc + exponent m' n' ≤ exponent (m + 1) 0 := by + by_cases hsucc : m + 1 = m' + · subst m' + exact (exponent_strictAnti_second (m + 1)).antitone (Nat.zero_le n') + · have hfirst : m + 1 < m' := lt_of_le_of_ne (Nat.succ_le_iff.mpr hmm') hsucc + exact (exponent_gt_of_first_lt hfirst).le + _ < cutoff m := next_exponent_zero_lt_cutoff m + _ < exponent m n := cutoff_lt_exponent m n +termination_by m' - m + +private theorem exponent_strictAnti_lex : + StrictAnti (fun p : Lex (ℕ × ℕ) ↦ exponent (ofLex p).1 (ofLex p).2) := by + intro p q hpq + rw [Prod.Lex.lt_iff] at hpq + rcases hpq with hfirst | ⟨hfirst, hsecond⟩ + · exact exponent_gt_of_first_lt hfirst + · change exponent (ofLex p).1 (ofLex p).2 > exponent (ofLex q).1 (ofLex q).2 + rw [hfirst] + exact exponent_strictAnti_second _ hsecond + +/-- The row-column index, followed by one final index for the constant term. -/ +abbrev Index := WithTop (Lex (ℕ × ℕ)) + +/-- The exponent sequence of the concrete Conway normal form. -/ +def exponentAtIndex : Index → Surreal.{u} + | ⊤ => 0 + | (p : Lex (ℕ × ℕ)) => (exponent (ofLex p).1 (ofLex p).2 : ℝ) + +private theorem exponent_pos (m n : ℕ) : 0 < exponent m n := by + rw [exponent_apply] + positivity + +private theorem exponentAtIndex_strictAnti : StrictAnti exponentAtIndex.{u} := by + intro p q hpq + induction p using WithTop.recTopCoe with + | top => exact (not_lt_of_ge le_top hpq).elim + | coe p => + induction q using WithTop.recTopCoe with + | top => + change (0 : Surreal) < (exponent (ofLex p).1 (ofLex p).2 : ℝ) + exact_mod_cast exponent_pos (ofLex p).1 (ofLex p).2 + | coe q => + change ((exponent (ofLex q).1 (ofLex q).2 : ℝ) : Surreal) < + (exponent (ofLex p).1 (ofLex p).2 : ℝ) + exact_mod_cast exponent_strictAnti_lex (WithTop.coe_lt_coe.mp hpq) + +/-- The coefficient function of the explicit normal form. -/ +def coefficient (i : Surreal.{u}) : ℝ := + by + classical + exact if i ∈ range exponentAtIndex then 1 else 0 + +private theorem support_coefficient : + Function.support coefficient.{u} = range exponentAtIndex := by + classical + ext i + simp [Function.support, coefficient] + +/-- The displayed coefficient support is small enough for `SurrealHahnSeries` in every +universe. -/ +theorem small_support_coefficient : + Small.{u} (Function.support coefficient.{u}) := by + rw [support_coefficient] + infer_instance + +/-- The displayed exponents are reverse well-ordered. -/ +theorem wellFoundedOn_support_coefficient : + (Function.support coefficient.{u}).WellFoundedOn (· > ·) := by + rw [support_coefficient, wellFoundedOn_range] + convert wellFounded_lt (α := Index) using 1 + ext p q + exact exponentAtIndex_strictAnti.lt_iff_gt + +/-- The explicit Conway normal form with all coefficients equal to one. -/ +def normalForm : SurrealHahnSeries.{u} := + SurrealHahnSeries.mk coefficient small_support_coefficient + wellFoundedOn_support_coefficient + +@[simp] +theorem normalForm_coeff (i : Surreal.{u}) : + normalForm.coeff i = coefficient i := by + rw [normalForm, SurrealHahnSeries.coeff_mk, coefficient] + +@[simp] +theorem normalForm_support : normalForm.{u}.support = range exponentAtIndex := by + rw [normalForm, SurrealHahnSeries.support_mk, support_coefficient] + +theorem normalForm_coeff_exponent (m n : ℕ) : + normalForm.{u}.coeff (exponent m n : ℝ) = 1 := by + classical + rw [normalForm_coeff, coefficient, if_pos] + exact ⟨(↑(toLex (m, n)) : Index), rfl⟩ + +theorem normalForm_coeff_zero : normalForm.{u}.coeff 0 = 1 := by + classical + rw [normalForm_coeff, coefficient, if_pos] + exact ⟨⊤, rfl⟩ + +private theorem normalForm_support_nonnegative : normalForm.{u}.support ⊆ Ici 0 := by + rw [normalForm_support] + rintro i ⟨p, rfl⟩ + induction p using WithTop.recTopCoe with + | top => exact le_rfl + | coe p => + rw [mem_Ici] + change (0 : Surreal) ≤ (exponent (ofLex p).1 (ofLex p).2 : ℝ) + exact_mod_cast (exponent_pos (ofLex p).1 (ofLex p).2).le + +/-- The explicit normal form, regarded as an omnific integer. -/ +def degreeTwoOz : Oz.OmnificInteger.{u} := + ⟨normalForm, by + rw [Oz.mem_omnificIntegers] + exact ⟨normalForm_support_nonnegative, ⟨1, by simpa using normalForm_coeff_zero.symm⟩⟩⟩ + +@[simp] +theorem degreeTwoOz_val : degreeTwoOz.{u}.1 = normalForm := by + rfl + +/-- The coefficient-doubled comparison element. It has the same support as `degreeTwoOz`, but its +factorisation as `2 * degreeTwoOz` is visible in the definition. -/ +def degreeTwoFoil : Oz.OmnificInteger.{u} := + 2 * degreeTwoOz + +@[simp] +theorem degreeTwoFoil_val : degreeTwoFoil.{u}.1 = 2 * normalForm := by + rfl + +/-- Doubling every nonzero coefficient does not change the Conway support. -/ +theorem degreeTwoFoil_support : + degreeTwoFoil.{u}.1.support = degreeTwoOz.1.support := by + rw [degreeTwoFoil_val, degreeTwoOz_val, two_mul] + ext i + simp only [SurrealHahnSeries.mem_support_iff, + SurrealHahnSeries.coeff_add_apply] + constructor + · intro h hzero + apply h + rw [hzero, zero_add] + · intro h hsum + apply h + linarith + +end ConwayRefinement.Standalone.Oz.DegreeTwoExample diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamily.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamily.lean new file mode 100644 index 0000000000..2955cd76b1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamily.lean @@ -0,0 +1,622 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFiniteDegree +public import Mathlib.Data.Prod.Lex +public import Mathlib.Data.Real.Basic +public import Mathlib.Data.Sum.Order +public import Mathlib.SetTheory.Ordinal.Arithmetic +public import Mathlib.SetTheory.Ordinal.Exponential + +import all LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic +import Mathlib.Tactic.Linarith +import Mathlib.Tactic.NormNum +import Mathlib.Tactic.Positivity + +/-! +# Omnific integers at every finite power of omega + +For each natural number `n`, let `FiniteLex n` be the lexicographic order on natural tuples of +length `n`. Its order type is `ω ^ n`. Define negative real numbers recursively by + +`E 0 * = -1`, + +`E (n + 1) (m, p) = -(1 / 3) ^ m + (1 / 3) ^ (m + 1) E n p`. + +The intervals occupied by successive values of `m` are disjoint, so `E n` is a strict order +embedding. Negating these values and adjoining a final zero gives a strictly decreasing sequence +of Conway exponents of order type `ω ^ n + 1`. + +The normal form `finitePowerOz n` has coefficient one at every exponent in this sequence. It is a +nonordinary reduced omnific integer, its Conway length is exactly `ω ^ n + 1`, and it has finite +degree. Consequently, every member of the family is primal. + +This construction does not assert irreducibility. At degree two, coefficients contain information +not determined by support geometry alone, as illustrated by the PS06 example. Within this family, +doubling every coefficient preserves the support but destroys reducedness. + +## References + +* S. L'Innocente, V. Mantova, *A factorisation theory for generalised power series and omnific + integers*, Adv. Math. 442 (2024) 109513, , cited + as [LM24]. +* J. Pommersheim, S. Shahriari, *Unique factorization in generalized power series rings*, +Proc. Amer. Math. Soc. 134 (2006), 1277–1287, cited as [PS06]. +-/ + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.Oz.FinitePowerFamily + +open Ordinal + +/-- Natural tuples of length `n`, ordered lexicographically from the first coordinate. -/ +abbrev FiniteLex : ℕ → Type + | .zero => Unit + | .succ n => Lex (ℕ × FiniteLex n) + +noncomputable instance finiteLexLinearOrder : (n : ℕ) → LinearOrder (FiniteLex n) + | .zero => inferInstanceAs (LinearOrder Unit) + | .succ n => by + letI : LinearOrder (FiniteLex n) := finiteLexLinearOrder n + exact Prod.Lex.instLinearOrder ℕ (FiniteLex n) + +instance finiteLexWellFoundedLT : (n : ℕ) → WellFoundedLT (FiniteLex n) + | .zero => by + change WellFoundedLT Unit + exact ⟨Finite.wellFounded_of_trans_of_irrefl (· < ·)⟩ + | .succ n => by + letI : WellFoundedLT (FiniteLex n) := finiteLexWellFoundedLT n + exact inferInstanceAs (WellFoundedLT (Lex (ℕ × FiniteLex n))) + +/-- The lexicographic natural tuples of length `n` have order type `ω ^ n`. -/ +theorem typeLT_finiteLex (n : ℕ) : + Ordinal.type ((· < ·) : FiniteLex n → FiniteLex n → Prop) = + (Ordinal.omega0 : Ordinal.{0}) ^ (n : Ordinal.{0}) := by + induction n with + | zero => simp [FiniteLex] + | succ n ih => + change Ordinal.type + (Prod.Lex ((· < ·) : ℕ → ℕ → Prop) + ((· < ·) : FiniteLex n → FiniteLex n → Prop)) = _ + rw [Ordinal.type_prod_lex, Ordinal.type_nat_lt] + rw [ih] + rw [← Ordinal.opow_succ] + congr 2 + +/-- The contraction factor separating consecutive lexicographic blocks. -/ +def scale : ℝ := 1 / 3 + +@[simp] +theorem scale_eq_one_div_three : scale = (1 / 3 : ℝ) := by + rfl + +private theorem scale_pos : 0 < scale := by norm_num [scale] + +private theorem scale_le_one : scale ≤ 1 := by norm_num [scale] + +/-- A bounded negative real realization of the lexicographic tuple order. -/ +def finitePowerExponent : (n : ℕ) → FiniteLex n → ℝ + | .zero, _ => -1 + | .succ n, p => + -scale ^ (ofLex p).1 + + scale ^ ((ofLex p).1 + 1) * finitePowerExponent n (ofLex p).2 + +@[simp] +theorem finitePowerExponent_zero (p : FiniteLex 0) : + finitePowerExponent 0 p = -1 := by + rfl + +@[simp] +theorem finitePowerExponent_succ (n : ℕ) (p : FiniteLex (n + 1)) : + finitePowerExponent (n + 1) p = + -scale ^ (ofLex p).1 + + scale ^ ((ofLex p).1 + 1) * finitePowerExponent n (ofLex p).2 := by + rfl + +theorem finitePowerExponent_neg : ∀ (n : ℕ) (p : FiniteLex n), + finitePowerExponent n p < 0 + | 0, _ => by simp [finitePowerExponent] + | n + 1, p => by + have htail := finitePowerExponent_neg n (ofLex p).2 + have hpow : 0 < scale ^ ((ofLex p).1 + 1) := pow_pos scale_pos _ + have hmul : + scale ^ ((ofLex p).1 + 1) * finitePowerExponent n (ofLex p).2 < 0 := + mul_neg_of_pos_of_neg hpow htail + have hfirst : 0 < scale ^ (ofLex p).1 := pow_pos scale_pos _ + simp only [finitePowerExponent] + linarith + +/-- Every finite-tuple exponent lies weakly above `-3 / 2`. -/ +theorem finitePowerExponent_lowerBound : + ∀ (n : ℕ) (p : FiniteLex n), + -(3 / 2 : ℝ) ≤ finitePowerExponent n p + | 0, _ => by norm_num [finitePowerExponent] + | n + 1, p => by + have htail := finitePowerExponent_lowerBound n (ofLex p).2 + have hpowNonneg : 0 ≤ scale ^ ((ofLex p).1 + 1) := (pow_pos scale_pos _).le + have htailMul : + scale ^ ((ofLex p).1 + 1) * (-(3 / 2 : ℝ)) ≤ + scale ^ ((ofLex p).1 + 1) * finitePowerExponent n (ofLex p).2 := + mul_le_mul_of_nonneg_left htail hpowNonneg + have hfirst : scale ^ (ofLex p).1 ≤ 1 := by + simpa using pow_le_pow_of_le_one scale_pos.le scale_le_one + (Nat.zero_le (ofLex p).1) + have hsecond : scale ^ ((ofLex p).1 + 1) ≤ scale := by + simpa using pow_le_pow_of_le_one scale_pos.le scale_le_one + (Nat.succ_le_succ (Nat.zero_le (ofLex p).1)) + simp only [finitePowerExponent] + norm_num [scale] at htailMul hfirst hsecond ⊢ + linarith + +private theorem finitePowerExponent_succ_lt_blockLimit + (n : ℕ) (p : FiniteLex (n + 1)) : + finitePowerExponent (n + 1) p < -scale ^ (ofLex p).1 := by + have htail := finitePowerExponent_neg n (ofLex p).2 + have hpow : 0 < scale ^ ((ofLex p).1 + 1) := pow_pos scale_pos _ + simp only [finitePowerExponent] + nlinarith + +private theorem finitePowerExponent_succ_blockLowerBound + (n : ℕ) (p : FiniteLex (n + 1)) : + -(3 / 2 : ℝ) * scale ^ (ofLex p).1 ≤ finitePowerExponent (n + 1) p := by + have htail := finitePowerExponent_lowerBound n (ofLex p).2 + have hpowNonneg : 0 ≤ scale ^ ((ofLex p).1 + 1) := (pow_pos scale_pos _).le + have htailMul : + scale ^ ((ofLex p).1 + 1) * (-(3 / 2 : ℝ)) ≤ + scale ^ ((ofLex p).1 + 1) * finitePowerExponent n (ofLex p).2 := + mul_le_mul_of_nonneg_left htail hpowNonneg + simp only [finitePowerExponent] + rw [pow_succ] at htailMul ⊢ + norm_num [scale] at htailMul ⊢ + linarith + +/-- The real realization preserves the lexicographic order. -/ +theorem finitePowerExponent_strictMono (n : ℕ) : StrictMono (finitePowerExponent n) := by + induction n with + | zero => + intro p q hpq + exact (lt_irrefl p hpq).elim + | succ n ih => + intro p q hpq + rcases p with ⟨m, p⟩ + rcases q with ⟨m', q⟩ + rw [Prod.Lex.lt_iff'] at hpq + rcases hpq with ⟨hfirstLe, htailOfEq⟩ + change m ≤ m' at hfirstLe + change m = m' → p < q at htailOfEq + rcases hfirstLe.eq_or_lt with hfirst | hfirst + · have htail := htailOfEq hfirst + change -scale ^ m + scale ^ (m + 1) * finitePowerExponent n p < + -scale ^ m' + scale ^ (m' + 1) * finitePowerExponent n q + subst m' + simpa only [add_comm] using + (add_lt_add_left + (mul_lt_mul_of_pos_left (ih htail) (pow_pos scale_pos (m + 1))) + (-scale ^ m)) + · have hpUpper := finitePowerExponent_succ_lt_blockLimit n (toLex (m, p)) + have hqLower := finitePowerExponent_succ_blockLowerBound n (toLex (m', q)) + have hpow : scale ^ m' ≤ scale ^ (m + 1) := + pow_le_pow_of_le_one scale_pos.le scale_le_one (Nat.succ_le_iff.mpr hfirst) + rw [pow_succ] at hpow + norm_num [scale] at hpow + have hpPowPos : 0 < (1 / 3 : ℝ) ^ m := by positivity + have hsep : -scale ^ m < -(3 / 2 : ℝ) * scale ^ m' := by + norm_num [scale] + nlinarith [hpPowPos] + calc + finitePowerExponent (n + 1) (toLex (m, p)) < -scale ^ m := hpUpper + _ < -(3 / 2 : ℝ) * scale ^ m' := hsep + _ ≤ finitePowerExponent (n + 1) (toLex (m', q)) := hqLower + +/-- The order embedding of the finite lexicographic tuples into the negative reals. -/ +def finitePowerExponentEmbedding (n : ℕ) : FiniteLex n ↪o ℝ := + OrderEmbedding.ofStrictMono _ (finitePowerExponent_strictMono n) + +/-- The all-zero tuple in the `n`-coordinate lexicographic index. -/ +def finitePowerZeroIndex : (n : ℕ) → FiniteLex n + | .zero => () + | .succ n => toLex (0, finitePowerZeroIndex n) + +/-- The positive real Conway exponent attached to a finite tuple. -/ +def finitePowerConwayExponent (n : ℕ) (p : FiniteLex n) : ℝ := + -finitePowerExponent n p + +@[simp] +theorem finitePowerConwayExponent_apply (n : ℕ) (p : FiniteLex n) : + finitePowerConwayExponent n p = -finitePowerExponent n p := by + rfl + +theorem finitePowerConwayExponent_pos (n : ℕ) (p : FiniteLex n) : + 0 < finitePowerConwayExponent n p := by + exact neg_pos.mpr (finitePowerExponent_neg n p) + +theorem finitePowerConwayExponent_strictAnti (n : ℕ) : + StrictAnti (finitePowerConwayExponent n) := by + intro p q hpq + exact neg_lt_neg ((finitePowerExponent_strictMono n) hpq) + +/-- The tuple exponents followed by the constant exponent. -/ +abbrev ConwayIndex (n : ℕ) := WithTop (FiniteLex n) + +theorem typeLT_conwayIndex (n : ℕ) : + Ordinal.type ((· < ·) : ConwayIndex n → ConwayIndex n → Prop) = + (Ordinal.omega0 : Ordinal.{0}) ^ (n : Ordinal.{0}) + 1 := by + letI : WellFoundedLT (FiniteLex n ⊕ₗ PUnit) := + (WithTop.orderIsoSumLexPUnit (α := FiniteLex n)).symm.toOrderEmbedding.wellFoundedLT + calc + Ordinal.type ((· < ·) : ConwayIndex n → ConwayIndex n → Prop) = + Ordinal.type ((· < ·) : (FiniteLex n ⊕ₗ PUnit) → + (FiniteLex n ⊕ₗ PUnit) → Prop) := + (WithTop.orderIsoSumLexPUnit (α := FiniteLex n)).toRelIsoLT.ordinalType_congr + _ = (Ordinal.omega0 : Ordinal.{0}) ^ (n : Ordinal.{0}) + 1 := by + change Ordinal.type + (Sum.Lex ((· < ·) : FiniteLex n → FiniteLex n → Prop) + ((· < ·) : PUnit → PUnit → Prop)) = _ + rw [Ordinal.type_sum_lex, typeLT_finiteLex] + simp + +/-- The exponent sequence of the `n`-th Conway normal form. -/ +def finitePowerConwayExponentAtIndex (n : ℕ) : ConwayIndex n → Surreal.{0} + | ⊤ => 0 + | (p : FiniteLex n) => (finitePowerConwayExponent n p : ℝ) + +@[simp] +theorem finitePowerConwayExponentAtIndex_top (n : ℕ) : + finitePowerConwayExponentAtIndex n ⊤ = 0 := by + rfl + +@[simp] +theorem finitePowerConwayExponentAtIndex_coe (n : ℕ) (p : FiniteLex n) : + finitePowerConwayExponentAtIndex n (p : ConwayIndex n) = + (finitePowerConwayExponent n p : ℝ) := by + rfl + +theorem finitePowerConwayExponentAtIndex_strictAnti (n : ℕ) : + StrictAnti (finitePowerConwayExponentAtIndex n) := by + intro p q hpq + induction p using WithTop.recTopCoe with + | top => exact (not_lt_of_ge le_top hpq).elim + | coe p => + induction q using WithTop.recTopCoe with + | top => + change (0 : Surreal) < (finitePowerConwayExponent n p : ℝ) + exact_mod_cast finitePowerConwayExponent_pos n p + | coe q => + change ((finitePowerConwayExponent n q : ℝ) : Surreal) < + (finitePowerConwayExponent n p : ℝ) + exact_mod_cast finitePowerConwayExponent_strictAnti n + (WithTop.coe_lt_coe.mp hpq) + +/-- The coefficient function of the `n`-th Conway normal form. -/ +def finitePowerCoefficient (n : ℕ) (i : Surreal.{0}) : ℝ := + by + classical + exact if i ∈ Set.range (finitePowerConwayExponentAtIndex n) then 1 else 0 + +private theorem support_finitePowerCoefficient (n : ℕ) : + Function.support (finitePowerCoefficient n) = + Set.range (finitePowerConwayExponentAtIndex n) := by + classical + ext i + simp [Function.support, finitePowerCoefficient] + +/-- The coefficient support is a small set. -/ +theorem small_support_finitePowerCoefficient (n : ℕ) : + Small.{0} (Function.support (finitePowerCoefficient n)) := by + rw [support_finitePowerCoefficient] + infer_instance + +/-- The coefficient support is reverse well-ordered. -/ +theorem wellFoundedOn_support_finitePowerCoefficient (n : ℕ) : + (Function.support (finitePowerCoefficient n)).WellFoundedOn (· > ·) := by + rw [support_finitePowerCoefficient, Set.wellFoundedOn_range] + convert wellFounded_lt (α := ConwayIndex n) using 1 + ext p q + exact (finitePowerConwayExponentAtIndex_strictAnti n).lt_iff_gt + +/-- The coefficient-one Conway normal form of support type `ω ^ n + 1`. -/ +def finitePowerNormalForm (n : ℕ) : SurrealHahnSeries.{0} := + SurrealHahnSeries.mk (finitePowerCoefficient n) + (small_support_finitePowerCoefficient n) + (wellFoundedOn_support_finitePowerCoefficient n) + +@[simp] +theorem finitePowerNormalForm_coeff (n : ℕ) (i : Surreal) : + (finitePowerNormalForm n).coeff i = finitePowerCoefficient n i := by + rw [finitePowerNormalForm, SurrealHahnSeries.coeff_mk, finitePowerCoefficient] + +@[simp] +theorem finitePowerNormalForm_support (n : ℕ) : + (finitePowerNormalForm n).support = + Set.range (finitePowerConwayExponentAtIndex n) := by + rw [finitePowerNormalForm, SurrealHahnSeries.support_mk, + support_finitePowerCoefficient] + +/-- The `n`-th Conway normal form has length exactly `ω ^ n + 1`. -/ +theorem finitePowerNormalForm_length (n : ℕ) : + (finitePowerNormalForm n).length = + (Ordinal.omega0 : Ordinal.{0}) ^ (n : Ordinal.{0}) + 1 := by + let f : ConwayIndex n → Surrealᵒᵈ := + fun p ↦ OrderDual.toDual (finitePowerConwayExponentAtIndex n p) + have hf : StrictMono f := by + intro p q hpq + exact finitePowerConwayExponentAtIndex_strictAnti n hpq + let eRange : ConwayIndex n ≃o Set.range f := hf.orderIso f + let eSupport : (finitePowerNormalForm n).support ≃ Set.range f := { + toFun x := ⟨OrderDual.toDual x.1, by + have hx : x.1 ∈ Set.range (finitePowerConwayExponentAtIndex n) := by + rw [← finitePowerNormalForm_support] + exact x.2 + obtain ⟨p, hp⟩ := hx + exact ⟨p, congrArg OrderDual.toDual hp⟩⟩ + invFun x := ⟨OrderDual.ofDual x.1, by + rw [finitePowerNormalForm_support] + obtain ⟨p, hp⟩ := x.2 + exact ⟨p, congrArg OrderDual.ofDual hp⟩⟩ + left_inv x := Subtype.ext rfl + right_inv x := Subtype.ext rfl } + let eSupportRel : + (· > · : (finitePowerNormalForm n).support → + (finitePowerNormalForm n).support → Prop) ≃r + (· < · : Set.range f → Set.range f → Prop) := { + toEquiv := eSupport + map_rel_iff' := by intro x y; rfl } + let e : + (· > · : (finitePowerNormalForm n).support → + (finitePowerNormalForm n).support → Prop) ≃r + (· < · : ConwayIndex n → ConwayIndex n → Prop) := + eSupportRel.trans eRange.symm.toRelIsoLT + have htype : + Ordinal.type (α := (finitePowerNormalForm n).support) (· > ·) = + Ordinal.lift.{1, 0} + (Ordinal.type ((· < ·) : ConwayIndex n → ConwayIndex n → Prop)) := by + simpa only [Ordinal.lift_id'] using e.ordinal_lift_type_eq + have hsupport := SurrealHahnSeries.type_support (finitePowerNormalForm n) + rw [htype, typeLT_conwayIndex] at hsupport + exact Ordinal.lift_inj.mp hsupport.symm + +theorem finitePowerNormalForm_coeff_exponent (n : ℕ) (p : FiniteLex n) : + (finitePowerNormalForm n).coeff (finitePowerConwayExponent n p : ℝ) = 1 := by + classical + rw [finitePowerNormalForm_coeff, finitePowerCoefficient, if_pos] + exact ⟨(↑p : ConwayIndex n), rfl⟩ + +theorem finitePowerNormalForm_coeff_zero (n : ℕ) : + (finitePowerNormalForm n).coeff 0 = 1 := by + classical + rw [finitePowerNormalForm_coeff, finitePowerCoefficient, if_pos] + exact ⟨⊤, rfl⟩ + +private theorem finitePowerNormalForm_support_nonnegative (n : ℕ) : + (finitePowerNormalForm n).support ⊆ Set.Ici 0 := by + rw [finitePowerNormalForm_support] + rintro i ⟨p, rfl⟩ + induction p using WithTop.recTopCoe with + | top => exact Set.mem_Ici.mpr (le_refl (0 : Surreal)) + | coe p => + rw [Set.mem_Ici] + change (0 : Surreal) ≤ (finitePowerConwayExponent n p : ℝ) + exact_mod_cast (finitePowerConwayExponent_pos n p).le + +/-- The `n`-th coefficient-one normal form as an omnific integer. -/ +def finitePowerOz (n : ℕ) : Oz.OmnificInteger.{0} := + ⟨finitePowerNormalForm n, by + rw [Oz.mem_omnificIntegers] + exact ⟨finitePowerNormalForm_support_nonnegative n, + ⟨1, by simpa using (finitePowerNormalForm_coeff_zero n).symm⟩⟩⟩ + +@[simp] +theorem finitePowerOz_val (n : ℕ) : + (finitePowerOz n).1 = finitePowerNormalForm n := by + rfl + +theorem finitePowerOz_support (n : ℕ) : + (finitePowerOz n).1.support = + Set.range (finitePowerConwayExponentAtIndex n) := by + rw [finitePowerOz_val, finitePowerNormalForm_support] + +/-- The `n`-th member of the family has Conway length exactly `ω ^ n + 1`. -/ +theorem finitePowerOz_length (n : ℕ) : + (finitePowerOz n).1.length = + (Ordinal.omega0 : Ordinal.{0}) ^ (n : Ordinal.{0}) + 1 := by + rw [finitePowerOz_val, finitePowerNormalForm_length] + +/-- Distinct natural numbers give distinct omnific integers in the family. -/ +theorem finitePowerOz_injective : Function.Injective finitePowerOz := by + intro m n hmn + have hlength := congrArg (fun x : Oz.OmnificInteger ↦ x.1.length) hmn + rw [finitePowerOz_length, finitePowerOz_length] at hlength + change Order.succ (Ordinal.omega0 ^ (m : Ordinal)) = + Order.succ (Ordinal.omega0 ^ (n : Ordinal)) at hlength + have hpower := Order.succ_injective hlength + have hexponent := + (Ordinal.opow_right_inj Ordinal.one_lt_omega0).mp hpower + exact_mod_cast hexponent + +/-- Subtracting one removes the constant exponent from the `n`-th normal form. -/ +theorem zero_not_mem_finitePowerOz_sub_one_support (n : ℕ) : + 0 ∉ ((finitePowerOz n).1 - 1).support := by + rw [SurrealHahnSeries.mem_support_iff, + SurrealHahnSeries.coeff_sub_apply, finitePowerOz_val, + finitePowerNormalForm_coeff_zero, + Oz.one_eq_single_zero, + SurrealHahnSeries.coeff_single_self] + norm_num + +/-- No member of the family is an ordinary integer. -/ +theorem finitePowerOz_not_isOrdinaryInteger (n : ℕ) : + ¬ Oz.IsOrdinaryInteger (finitePowerOz n) := by + rw [Oz.IsOrdinaryInteger] + rintro ⟨z, hz⟩ + let p := finitePowerZeroIndex n + let e : Surreal := (finitePowerConwayExponent n p : ℝ) + have he0 : e ≠ 0 := by + change ((finitePowerConwayExponent n p : ℝ) : Surreal) ≠ 0 + exact_mod_cast (finitePowerConwayExponent_pos n p).ne' + have hcoeff := congrArg (fun q : SurrealHahnSeries ↦ q.coeff e) hz + have hleft : (finitePowerOz n).1.coeff e = 1 := by + rw [finitePowerOz_val] + exact finitePowerNormalForm_coeff_exponent n p + have hright : (z : SurrealHahnSeries).coeff e = 0 := by + rw [Oz.intCast_eq_single_zero] + exact SurrealHahnSeries.coeff_single_of_ne he0.symm _ + rw [hleft, hright] at hcoeff + norm_num at hcoeff + +/-- Every member of the family is reduced. -/ +theorem finitePowerOz_isReduced (n : ℕ) : + Oz.IsReduced (finitePowerOz n) := by + rw [Oz.IsReduced] + constructor + · intro hzero + apply finitePowerOz_not_isOrdinaryInteger n + refine ⟨0, ?_⟩ + rw [hzero] + rw [Oz.intCast_eq_single_zero] + norm_num + · refine ⟨0, ?_⟩ + intro i hi + have hiSupport := hi.1 + rw [finitePowerOz_val, finitePowerNormalForm_support] at hiSupport + obtain ⟨p, hp⟩ := hiSupport + induction p using WithTop.recTopCoe with + | top => + simp only [finitePowerConwayExponentAtIndex] at hp + have hi0 : i = 0 := hp.symm + subst i + exact (zero_not_mem_finitePowerOz_sub_one_support n hi.2).elim + | coe p => + change ArchimedeanClass.mk i = 0 + rw [← hp] + exact Surreal.mk_realCast (finitePowerConwayExponent_pos n p).ne' + +universe w + +private theorem omega_opow_nat_add_one_lt_omega_opow_omega (n : ℕ) : + (Ordinal.omega0 : Ordinal.{w}) ^ (n : Ordinal.{w}) + 1 < + (Ordinal.omega0 : Ordinal.{w}) ^ (Ordinal.omega0 : Ordinal.{w}) := by + cases n with + | zero => + rw [Nat.cast_zero, Ordinal.opow_zero] + calc + (1 : Ordinal.{w}) + 1 = 2 := by norm_num + _ < Ordinal.omega0 := Ordinal.natCast_lt_omega0 2 + _ = Ordinal.omega0 ^ (1 : Ordinal.{w}) := by rw [Ordinal.opow_one] + _ < Ordinal.omega0 ^ Ordinal.omega0 := + (Ordinal.opow_lt_opow_iff_right Ordinal.one_lt_omega0).2 + Ordinal.one_lt_omega0 + | succ n => + have hw : (1 : Ordinal.{w}) < + Ordinal.omega0 ^ ((n + 1 : ℕ) : Ordinal.{w}) := + (Ordinal.one_lt_opow).2 ⟨Ordinal.one_lt_omega0, by simp⟩ + simpa only [mul_one] using + (Ordinal.opow_mul_add_lt_opow + (b := (Ordinal.omega0 : Ordinal.{w})) + (u := ((n + 1 : ℕ) : Ordinal.{w})) + (v := 1) (w := 1) (x := Ordinal.omega0) + Ordinal.one_lt_omega0 hw (Ordinal.natCast_lt_omega0 (n + 1))) + +private theorem lift_omega0_opow_natCast (n : ℕ) : + Ordinal.lift.{1, 0} ((Ordinal.omega0 : Ordinal.{0}) ^ (n : Ordinal)) = + (Ordinal.omega0 : Ordinal.{1}) ^ (n : Ordinal) := by + rw [Ordinal.opow_natCast, Ordinal.opow_natCast] + induction n with + | zero => simp + | succ n ih => simp [pow_succ, Ordinal.lift_mul, ih] + +/-- Every member of the family has Conway length below `ω ^ ω`. -/ +theorem finitePowerOz_hasFiniteDegree (n : ℕ) : + Oz.HasFiniteDegree (finitePowerOz n) := by + rw [Oz.HasFiniteDegree, finitePowerOz_val, + finitePowerNormalForm_length, Ordinal.lift_add, Ordinal.lift_one, + lift_omega0_opow_natCast] + exact omega_opow_nat_add_one_lt_omega_opow_omega n + +/-- Every coefficient-one omnific integer `finitePowerOz n` is primal. -/ +def PrimalFamily : Prop := + ∀ n : ℕ, IsPrimal (finitePowerOz n) + +/- +## Formal proof + +Proof module: `Support.FinitePowerFamilyProof`. + +* `PrimalFamily` → `PrimalFamily.proof` +-/ + +/-- Twice the `n`-th normal form. -/ +def finitePowerFoil (n : ℕ) : Oz.OmnificInteger := + 2 * finitePowerOz n + +@[simp] +theorem finitePowerFoil_val (n : ℕ) : + (finitePowerFoil n).1 = 2 * finitePowerNormalForm n := by + rfl + +/-- Doubling all nonzero coefficients leaves the exponent support unchanged. -/ +theorem finitePowerFoil_support (n : ℕ) : + (finitePowerFoil n).1.support = (finitePowerOz n).1.support := by + rw [finitePowerFoil_val, finitePowerOz_val, two_mul] + ext i + simp only [SurrealHahnSeries.mem_support_iff, + SurrealHahnSeries.coeff_add_apply] + constructor + · intro h hzero + apply h + rw [hzero, zero_add] + · intro h hsum + apply h + linarith + +/-- The doubled normal form is not reduced: its constant exponent survives subtraction by one. -/ +theorem finitePowerFoil_not_isReduced (n : ℕ) : + ¬ Oz.IsReduced (finitePowerFoil n) := by + rw [Oz.IsReduced] + rintro ⟨_, c, hc⟩ + let p := finitePowerZeroIndex n + let e : Surreal := (finitePowerConwayExponent n p : ℝ) + have he0 : e ≠ 0 := by + change ((finitePowerConwayExponent n p : ℝ) : Surreal) ≠ 0 + exact_mod_cast (finitePowerConwayExponent_pos n p).ne' + have hzeroFoil : 0 ∈ (finitePowerFoil n).1.support := by + rw [finitePowerFoil_support, finitePowerOz_support] + exact ⟨⊤, rfl⟩ + have hzeroSub : 0 ∈ ((finitePowerFoil n).1 - 1).support := by + rw [SurrealHahnSeries.mem_support_iff, + SurrealHahnSeries.coeff_sub_apply, finitePowerFoil_val, two_mul, + SurrealHahnSeries.coeff_add_apply, finitePowerNormalForm_coeff_zero, + Oz.one_eq_single_zero, + SurrealHahnSeries.coeff_single_self] + norm_num + have heFoil : e ∈ (finitePowerFoil n).1.support := by + rw [finitePowerFoil_support, finitePowerOz_support] + exact ⟨(↑p : ConwayIndex n), rfl⟩ + have hone : (1 : SurrealHahnSeries).coeff e = 0 := by + rw [Oz.one_eq_single_zero] + exact SurrealHahnSeries.coeff_single_of_ne he0.symm _ + have heSub : e ∈ ((finitePowerFoil n).1 - 1).support := by + rw [SurrealHahnSeries.mem_support_iff, + SurrealHahnSeries.coeff_sub_apply, finitePowerFoil_val, two_mul, + SurrealHahnSeries.coeff_add_apply, + finitePowerNormalForm_coeff_exponent, hone] + norm_num + have hclassZero := hc ⟨hzeroFoil, hzeroSub⟩ + have hclassE := hc ⟨heFoil, heSub⟩ + change ArchimedeanClass.mk (0 : Surreal) = c at hclassZero + change ArchimedeanClass.mk e = c at hclassE + have hmkE : ArchimedeanClass.mk e = 0 := by + change ArchimedeanClass.mk ((finitePowerConwayExponent n p : ℝ) : Surreal) = 0 + exact Surreal.mk_realCast (finitePowerConwayExponent_pos n p).ne' + have hmkZero : ArchimedeanClass.mk (0 : Surreal) ≠ 0 := by simp + apply hmkZero + calc + ArchimedeanClass.mk (0 : Surreal) = c := hclassZero + _ = ArchimedeanClass.mk e := hclassE.symm + _ = 0 := hmkE + +end ConwayRefinement.Standalone.Oz.FinitePowerFamily diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamilyProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamilyProof.lean new file mode 100644 index 0000000000..51fe1d2bf7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamilyProof.lean @@ -0,0 +1,28 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamily +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorizationProof + +/-! +# Primality of the finite-power family + +Every `finitePowerOz n` is nonordinary, reduced, and has Conway length below `ω ^ ω`. +Finite-degree primality for omnific integers therefore applies to every natural number `n`. +-/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.Oz.FinitePowerFamily.PrimalFamily + +/-- Every coefficient-one omnific integer `finitePowerOz n` is primal. -/ +theorem proof : FinitePowerFamily.PrimalFamily := by + rw [FinitePowerFamily.PrimalFamily] + intro n + exact Oz.EveryOmnificIntegerIsPrimal.proof (FinitePowerFamily.finitePowerOz n) + +end ConwayRefinement.Standalone.Oz.FinitePowerFamily.PrimalFamily diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmegaOmegaBoundary.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmegaOmegaBoundary.lean new file mode 100644 index 0000000000..b9fe11c740 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmegaOmegaBoundary.lean @@ -0,0 +1,516 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamily +public import Mathlib.Data.Sigma.Order + +import Mathlib.SetTheory.Ordinal.Family +import Mathlib.Tactic.Linarith +import Mathlib.Tactic.NormNum + +/-! +# An omnific integer at the `ω ^ ω` boundary + +Let `BoundaryIndex` be the lexicographic sum over `n : ℕ` of the natural tuples `FiniteLex n`. +Its order type is + +`∑ n < ω, ω ^ n = ω ^ ω`. + +The `n`-th tuple block is placed in the negative real interval + +`[-(1 / 3) ^ n, -(1 / 3) ^ (n + 1))`. + +These intervals occur consecutively and approach zero. Negating gives a strictly decreasing +sequence of positive Conway exponents. The coefficient-one normal form on this sequence is a +purely infinite omnific integer: its coefficient at exponent zero is zero. + +The resulting omnific integer is nonordinary and reduced, and its Conway length is exactly +`ω ^ ω`. Thus it lies at, rather than below, the strict length bound in the finite-degree +primality theorem. No primality or nonprimality assertion is made about this boundary element. + +## References + +* J. H. Conway, *On Numbers and Games*, 2nd ed., A K Peters, 2001. +* S. L'Innocente, V. Mantova, *A factorisation theory for generalised power series and omnific + integers*, Adv. Math. 442 (2024) 109513, cited as [LM24]. +-/ + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.Oz.OmegaOmegaBoundary + +open Ordinal +open ConwayRefinement.Standalone.Oz.FinitePowerFamily + +/-- The lexicographic sum of the finite-tuple orders of types `ω ^ n`. -/ +abbrev BoundaryIndex := Σₗ n : ℕ, FiniteLex n + +instance : WellFoundedLT BoundaryIndex where + wf := by + change WellFounded + (Sigma.Lex (· < ·) fun n => (· < · : FiniteLex n → FiniteLex n → Prop)) + let e := Equiv.psigmaEquivSigma (fun n : ℕ => FiniteLex n) + let f : + (Sigma.Lex (· < ·) fun n => (· < · : FiniteLex n → FiniteLex n → Prop)) ↪r + (PSigma.Lex (· < ·) fun n => (· < · : FiniteLex n → FiniteLex n → Prop)) := { + toFun := e.symm + inj' := e.symm.injective + map_rel_iff' := by + rintro ⟨i, a⟩ ⟨j, b⟩ + simp only [PSigma.lex_iff, Sigma.lex_iff] + rfl } + exact f.wellFounded + (WellFounded.psigma_lex wellFounded_lt fun n => (finiteLexWellFoundedLT n).wf) + +private theorem fiber_type_le_boundary (n : ℕ) : + (Ordinal.omega0 : Ordinal) ^ (n : Ordinal) ≤ + Ordinal.type ((· < ·) : BoundaryIndex → BoundaryIndex → Prop) := by + rw [← typeLT_finiteLex] + apply Ordinal.type_le_iff'.mpr + refine ⟨{ + toFun := fun p => ⟨n, p⟩ + inj' := by intro p q h; cases h; rfl + map_rel_iff' := by + intro p q + change Sigma.Lex (· < ·) (fun n => (· < ·)) ⟨n, p⟩ ⟨n, q⟩ ↔ p < q + exact ⟨fun h => by cases h with + | left _ _ hn => exact (lt_irrefl n hn).elim + | right _ _ hpq => exact hpq, + fun hpq => Sigma.Lex.right p q hpq⟩ }⟩ + +private theorem omegaPowOmega_le_boundaryType : + (Ordinal.omega0 : Ordinal) ^ Ordinal.omega0 ≤ + Ordinal.type ((· < ·) : BoundaryIndex → BoundaryIndex → Prop) := by + rw [Ordinal.opow_limit Ordinal.omega0_ne_zero Ordinal.isSuccLimit_omega0] + apply Ordinal.iSup_le + intro i + obtain ⟨n, hn⟩ := Ordinal.lt_omega0.mp i.2 + rw [hn] + exact fiber_type_le_boundary n + +private def boundaryRank (x : BoundaryIndex) : Ordinal := + let p := ofLex x + Ordinal.omega0 ^ ((p.1 + 1 : ℕ) : Ordinal) + + Ordinal.typein ((· < ·) : FiniteLex p.1 → FiniteLex p.1 → Prop) p.2 + +@[simp] +private theorem boundaryRank_mk (n : ℕ) (p : FiniteLex n) : + boundaryRank (toLex ⟨n, p⟩) = + Ordinal.omega0 ^ ((n + 1 : ℕ) : Ordinal) + + Ordinal.typein ((· < ·) : FiniteLex n → FiniteLex n → Prop) p := by + rfl + +private theorem typein_finiteLex_lt_opow (n : ℕ) (p : FiniteLex n) : + Ordinal.typein ((· < ·) : FiniteLex n → FiniteLex n → Prop) p < + Ordinal.omega0 ^ (n : Ordinal) := by + rw [← typeLT_finiteLex] + exact Ordinal.typein_lt_type _ p + +private theorem boundaryRank_lt_stage (n : ℕ) (p : FiniteLex n) : + boundaryRank (toLex ⟨n, p⟩) < + Ordinal.omega0 ^ ((n + 2 : ℕ) : Ordinal) := by + rw [boundaryRank_mk] + simpa only [mul_one] using + (Ordinal.opow_mul_add_lt_opow + (b := Ordinal.omega0) + (u := ((n + 1 : ℕ) : Ordinal)) + (v := 1) + (w := Ordinal.typein ((· < ·) : FiniteLex n → FiniteLex n → Prop) p) + (x := ((n + 2 : ℕ) : Ordinal)) + Ordinal.one_lt_omega0 + ((typein_finiteLex_lt_opow n p).trans + ((Ordinal.opow_lt_opow_iff_right Ordinal.one_lt_omega0).mpr (by + exact_mod_cast Nat.lt_succ_self n))) + (by exact_mod_cast (show n + 1 < n + 2 by omega))) + +private theorem boundaryRank_lt_omegaPowOmega (x : BoundaryIndex) : + boundaryRank x < Ordinal.omega0 ^ Ordinal.omega0 := by + induction x using Lex.rec with + | h x => + obtain ⟨n, p⟩ := x + exact (boundaryRank_lt_stage n p).trans + ((Ordinal.opow_lt_opow_iff_right Ordinal.one_lt_omega0).mpr + (Ordinal.natCast_lt_omega0 (n + 2))) + +private theorem boundaryRank_strictMono : StrictMono boundaryRank := by + intro x y hxy + induction x using Lex.rec with + | h x => + induction y using Lex.rec with + | h y => + obtain ⟨n, p⟩ := x + obtain ⟨m, q⟩ := y + change Sigma.Lex (· < ·) (fun n => (· < ·)) ⟨n, p⟩ ⟨m, q⟩ at hxy + cases hxy with + | left _ _ hnm => + apply (boundaryRank_lt_stage n p).trans_le + calc + Ordinal.omega0 ^ ((n + 2 : ℕ) : Ordinal) ≤ + Ordinal.omega0 ^ ((m + 1 : ℕ) : Ordinal) := + Ordinal.opow_le_opow_right Ordinal.omega0_pos (by + exact_mod_cast (show n + 2 ≤ m + 1 by omega)) + _ ≤ boundaryRank (toLex ⟨m, q⟩) := by + rw [boundaryRank_mk] + exact le_add_right (le_refl _) + | right _ _ hpq => + rw [boundaryRank_mk, boundaryRank_mk] + exact add_lt_add_right + ((Ordinal.typein_lt_typein + ((· < ·) : FiniteLex n → FiniteLex n → Prop)).mpr hpq) _ + +private def boundaryRankToType (x : BoundaryIndex) : + (Ordinal.omega0 ^ Ordinal.omega0).ToType := + Ordinal.enum + ((· < ·) : + (Ordinal.omega0 ^ Ordinal.omega0).ToType → + (Ordinal.omega0 ^ Ordinal.omega0).ToType → Prop) + ⟨boundaryRank x, by + rw [Ordinal.type_toType] + exact boundaryRank_lt_omegaPowOmega x⟩ + +private theorem boundaryRankToType_strictMono : StrictMono boundaryRankToType := by + intro x y hxy + unfold boundaryRankToType + apply (Ordinal.enum_lt_enum + (r := ((· < ·) : + (Ordinal.omega0 ^ Ordinal.omega0).ToType → + (Ordinal.omega0 ^ Ordinal.omega0).ToType → Prop))).mpr + exact boundaryRank_strictMono hxy + +private theorem boundaryType_le_omegaPowOmega : + Ordinal.type ((· < ·) : BoundaryIndex → BoundaryIndex → Prop) ≤ + Ordinal.omega0 ^ Ordinal.omega0 := by + rw [← Ordinal.type_toType (Ordinal.omega0 ^ Ordinal.omega0)] + apply Ordinal.type_le_iff'.mpr + exact ⟨(OrderEmbedding.ofStrictMono boundaryRankToType + boundaryRankToType_strictMono).ltEmbedding⟩ + +/-- The lexicographic sum of the finite-tuple orders has order type `ω ^ ω`. -/ +theorem typeLT_boundaryIndex : + Ordinal.type ((· < ·) : BoundaryIndex → BoundaryIndex → Prop) = + Ordinal.omega0 ^ Ordinal.omega0 := by + exact le_antisymm boundaryType_le_omegaPowOmega omegaPowOmega_le_boundaryType + +private theorem boundary_scale_pos : 0 < scale := by + norm_num [scale] + +private theorem boundary_scale_le_one : scale ≤ 1 := by + norm_num [scale] + +/-- The increasing negative real sequence used before reversing the Conway exponents. -/ +def boundarySignedExponent (x : BoundaryIndex) : ℝ := + match ofLex x with + | ⟨n, p⟩ => + -scale ^ (n + 1) + + (4 / 9 : ℝ) * scale ^ n * finitePowerExponent n p + +@[simp] +theorem boundarySignedExponent_mk (n : ℕ) (p : FiniteLex n) : + boundarySignedExponent (toLex ⟨n, p⟩) = + -scale ^ (n + 1) + + (4 / 9 : ℝ) * scale ^ n * finitePowerExponent n p := by + rfl + +private theorem boundarySignedExponent_lt_blockLimit (n : ℕ) (p : FiniteLex n) : + boundarySignedExponent (toLex ⟨n, p⟩) < -scale ^ (n + 1) := by + have hp := finitePowerExponent_neg n p + have hs : 0 < (4 / 9 : ℝ) * scale ^ n := + mul_pos (by norm_num) (pow_pos boundary_scale_pos n) + rw [boundarySignedExponent_mk] + nlinarith + +private theorem boundarySignedExponent_blockLowerBound (n : ℕ) (p : FiniteLex n) : + -scale ^ n ≤ boundarySignedExponent (toLex ⟨n, p⟩) := by + have hp := finitePowerExponent_lowerBound n p + have hs : 0 ≤ (4 / 9 : ℝ) * scale ^ n := + (mul_pos (by norm_num) (pow_pos boundary_scale_pos n)).le + have hmul := mul_le_mul_of_nonneg_left hp hs + rw [boundarySignedExponent_mk, pow_succ] + norm_num [scale] at hmul ⊢ + nlinarith + +/-- The `n`-th block lies in the interval +`[-scale ^ n, -scale ^ (n + 1))`. -/ +theorem boundarySignedExponent_mem_block (n : ℕ) (p : FiniteLex n) : + boundarySignedExponent (toLex ⟨n, p⟩) ∈ + Set.Ico (-scale ^ n) (-scale ^ (n + 1)) := by + exact ⟨boundarySignedExponent_blockLowerBound n p, + boundarySignedExponent_lt_blockLimit n p⟩ + +/-- Every signed exponent is negative. -/ +theorem boundarySignedExponent_neg (x : BoundaryIndex) : + boundarySignedExponent x < 0 := by + induction x using Lex.rec with + | h x => + obtain ⟨n, p⟩ := x + exact (boundarySignedExponent_lt_blockLimit n p).trans + (neg_lt_zero.mpr (pow_pos boundary_scale_pos _)) + +/-- The signed exponent sequence preserves the boundary-index order. -/ +theorem boundarySignedExponent_strictMono : StrictMono boundarySignedExponent := by + intro x y hxy + induction x using Lex.rec with + | h x => + induction y using Lex.rec with + | h y => + obtain ⟨n, p⟩ := x + obtain ⟨m, q⟩ := y + change Sigma.Lex (· < ·) (fun n => (· < ·)) ⟨n, p⟩ ⟨m, q⟩ at hxy + cases hxy with + | left _ _ hnm => + apply (boundarySignedExponent_lt_blockLimit n p).trans_le + calc + -scale ^ (n + 1) ≤ -scale ^ m := by + exact neg_le_neg + (pow_le_pow_of_le_one boundary_scale_pos.le + boundary_scale_le_one (by omega)) + _ ≤ boundarySignedExponent (toLex ⟨m, q⟩) := + boundarySignedExponent_blockLowerBound m q + | right _ _ hpq => + rw [boundarySignedExponent_mk, boundarySignedExponent_mk] + have hs : 0 < (4 / 9 : ℝ) * scale ^ n := + mul_pos (by norm_num) (pow_pos boundary_scale_pos n) + exact add_lt_add_right + (mul_lt_mul_of_pos_left (finitePowerExponent_strictMono n hpq) hs) _ + +/-- The positive real Conway exponent obtained by reversing the signed exponent sequence. -/ +def boundaryConwayExponent (x : BoundaryIndex) : ℝ := + -boundarySignedExponent x + +@[simp] +theorem boundaryConwayExponent_apply (x : BoundaryIndex) : + boundaryConwayExponent x = -boundarySignedExponent x := by + rfl + +/-- Every boundary Conway exponent is positive. -/ +theorem boundaryConwayExponent_pos (x : BoundaryIndex) : + 0 < boundaryConwayExponent x := by + exact neg_pos.mpr (boundarySignedExponent_neg x) + +/-- The boundary Conway exponents strictly decrease along the index order. -/ +theorem boundaryConwayExponent_strictAnti : StrictAnti boundaryConwayExponent := by + intro x y hxy + exact neg_lt_neg (boundarySignedExponent_strictMono hxy) + +/-- The positive Conway exponents in the `n`-th block lie in +`(scale ^ (n + 1), scale ^ n]`. -/ +theorem boundaryConwayExponent_mem_block (n : ℕ) (p : FiniteLex n) : + boundaryConwayExponent (toLex ⟨n, p⟩) ∈ + Set.Ioc (scale ^ (n + 1)) (scale ^ n) := by + rw [Set.mem_Ioc, boundaryConwayExponent_apply] + exact ⟨by + simpa using neg_lt_neg (boundarySignedExponent_lt_blockLimit n p), + by simpa using neg_le_neg (boundarySignedExponent_blockLowerBound n p)⟩ + +/-- The surreal Conway exponent associated to an index. -/ +def boundaryExponentAtIndex (x : BoundaryIndex) : Surreal.{0} := + (boundaryConwayExponent x : ℝ) + +/-- Every surreal boundary exponent is positive. -/ +theorem boundaryExponentAtIndex_pos (x : BoundaryIndex) : + 0 < boundaryExponentAtIndex x := by + simpa only [boundaryExponentAtIndex, Real.toSurreal_pos_iff] using + boundaryConwayExponent_pos x + +/-- The surreal boundary exponents strictly decrease along the index order. -/ +theorem boundaryExponentAtIndex_strictAnti : StrictAnti boundaryExponentAtIndex := by + intro x y hxy + simpa only [boundaryExponentAtIndex, Real.toSurreal_lt_iff] using + boundaryConwayExponent_strictAnti hxy + +/-- The coefficient function equal to one exactly on the boundary exponents. -/ +def boundaryCoefficient (i : Surreal.{0}) : ℝ := + by + classical + exact if i ∈ Set.range boundaryExponentAtIndex then 1 else 0 + +private theorem support_boundaryCoefficient : + Function.support boundaryCoefficient = Set.range boundaryExponentAtIndex := by + classical + ext i + simp [Function.support, boundaryCoefficient] + +/-- The boundary coefficient support is a small set. -/ +theorem small_support_boundaryCoefficient : + Small.{0} (Function.support boundaryCoefficient) := by + rw [support_boundaryCoefficient] + infer_instance + +/-- The boundary coefficient support is reverse well-ordered. -/ +theorem wellFoundedOn_support_boundaryCoefficient : + (Function.support boundaryCoefficient).WellFoundedOn (· > ·) := by + rw [support_boundaryCoefficient, Set.wellFoundedOn_range] + convert wellFounded_lt (α := BoundaryIndex) using 1 + ext x y + exact boundaryExponentAtIndex_strictAnti.lt_iff_gt + +/-- The coefficient-one Conway normal form whose support has order type `ω ^ ω`. -/ +def boundaryNormalForm : SurrealHahnSeries.{0} := + SurrealHahnSeries.mk boundaryCoefficient + small_support_boundaryCoefficient + wellFoundedOn_support_boundaryCoefficient + +@[simp] +theorem boundaryNormalForm_coeff (i : Surreal.{0}) : + boundaryNormalForm.coeff i = boundaryCoefficient i := by + rw [boundaryNormalForm, SurrealHahnSeries.coeff_mk, boundaryCoefficient] + +@[simp] +theorem boundaryNormalForm_support : + boundaryNormalForm.support = Set.range boundaryExponentAtIndex := by + rw [boundaryNormalForm, SurrealHahnSeries.support_mk, support_boundaryCoefficient] + +/-- The boundary normal form has Conway length exactly `ω ^ ω`. -/ +theorem boundaryNormalForm_length : + boundaryNormalForm.length = Ordinal.omega0 ^ Ordinal.omega0 := by + let f : BoundaryIndex → Surrealᵒᵈ := + fun x ↦ OrderDual.toDual (boundaryExponentAtIndex x) + have hf : StrictMono f := by + intro x y hxy + exact boundaryExponentAtIndex_strictAnti hxy + let eRange : BoundaryIndex ≃o Set.range f := hf.orderIso f + let eSupport : boundaryNormalForm.support ≃ Set.range f := { + toFun x := ⟨OrderDual.toDual x.1, by + have hx : x.1 ∈ Set.range boundaryExponentAtIndex := by + rw [← boundaryNormalForm_support] + exact x.2 + obtain ⟨p, hp⟩ := hx + exact ⟨p, congrArg OrderDual.toDual hp⟩⟩ + invFun x := ⟨OrderDual.ofDual x.1, by + rw [boundaryNormalForm_support] + obtain ⟨p, hp⟩ := x.2 + exact ⟨p, congrArg OrderDual.ofDual hp⟩⟩ + left_inv x := Subtype.ext rfl + right_inv x := Subtype.ext rfl } + let eSupportRel : + (· > · : boundaryNormalForm.support → boundaryNormalForm.support → Prop) ≃r + (· < · : Set.range f → Set.range f → Prop) := { + toEquiv := eSupport + map_rel_iff' := by intro x y; rfl } + let e : + (· > · : boundaryNormalForm.support → boundaryNormalForm.support → Prop) ≃r + (· < · : BoundaryIndex → BoundaryIndex → Prop) := + eSupportRel.trans eRange.symm.toRelIsoLT + have htype : + Ordinal.type (α := boundaryNormalForm.support) (· > ·) = + Ordinal.lift.{1, 0} + (Ordinal.type ((· < ·) : BoundaryIndex → BoundaryIndex → Prop)) := by + simpa only [Ordinal.lift_id'] using e.ordinal_lift_type_eq + have hsupport := SurrealHahnSeries.type_support boundaryNormalForm + rw [htype, typeLT_boundaryIndex] at hsupport + exact Ordinal.lift_inj.mp hsupport.symm + +theorem boundaryNormalForm_coeff_exponent (x : BoundaryIndex) : + boundaryNormalForm.coeff (boundaryExponentAtIndex x) = 1 := by + classical + rw [boundaryNormalForm_coeff, boundaryCoefficient, if_pos] + exact ⟨x, rfl⟩ + +theorem boundaryNormalForm_coeff_zero : boundaryNormalForm.coeff 0 = 0 := by + classical + rw [boundaryNormalForm_coeff, boundaryCoefficient, if_neg] + rintro ⟨x, hx⟩ + have hxpos := boundaryExponentAtIndex_pos x + rw [hx] at hxpos + exact (lt_irrefl 0 hxpos).elim + +private theorem boundaryNormalForm_support_nonnegative : + boundaryNormalForm.support ⊆ Set.Ici 0 := by + rw [boundaryNormalForm_support] + rintro i ⟨x, rfl⟩ + exact (boundaryExponentAtIndex_pos x).le + +/-- The purely infinite coefficient-one normal form as an omnific integer. -/ +def boundaryOz : Oz.OmnificInteger.{0} := + ⟨boundaryNormalForm, by + rw [Oz.mem_omnificIntegers] + exact ⟨boundaryNormalForm_support_nonnegative, + ⟨0, by simpa using boundaryNormalForm_coeff_zero.symm⟩⟩⟩ + +@[simp] +theorem boundaryOz_val : boundaryOz.1 = boundaryNormalForm := by + rfl + +theorem boundaryOz_support : + boundaryOz.1.support = Set.range boundaryExponentAtIndex := by + rw [boundaryOz_val, boundaryNormalForm_support] + +theorem boundaryOz_coeff_exponent (x : BoundaryIndex) : + boundaryOz.1.coeff (boundaryExponentAtIndex x) = 1 := by + rw [boundaryOz_val, boundaryNormalForm_coeff_exponent] + +theorem boundaryOz_coeff_zero : boundaryOz.1.coeff 0 = 0 := by + rw [boundaryOz_val, boundaryNormalForm_coeff_zero] + +/-- The boundary omnific integer has Conway length exactly `ω ^ ω`. -/ +theorem boundaryOz_length : + boundaryOz.1.length = Ordinal.omega0 ^ Ordinal.omega0 := by + rw [boundaryOz_val, boundaryNormalForm_length] + +/-- The boundary omnific integer is not an integer constant. -/ +theorem boundaryOz_not_isOrdinaryInteger : + ¬ Oz.IsOrdinaryInteger boundaryOz := by + rw [Oz.IsOrdinaryInteger] + rintro ⟨z, hz⟩ + let x : BoundaryIndex := toLex ⟨0, ()⟩ + let e : Surreal := boundaryExponentAtIndex x + have he0 : e ≠ 0 := (boundaryExponentAtIndex_pos x).ne' + have hcoeff := congrArg (fun q : SurrealHahnSeries ↦ q.coeff e) hz + have hleft : boundaryOz.1.coeff e = 1 := by + rw [boundaryOz_val] + exact boundaryNormalForm_coeff_exponent x + have hright : (z : SurrealHahnSeries).coeff e = 0 := by + rw [Oz.intCast_eq_single_zero] + exact SurrealHahnSeries.coeff_single_of_ne he0.symm _ + rw [hleft, hright] at hcoeff + norm_num at hcoeff + +private theorem boundaryOz_ne_zero : boundaryOz ≠ 0 := by + intro hzero + apply boundaryOz_not_isOrdinaryInteger + refine ⟨0, ?_⟩ + rw [hzero, Oz.intCast_eq_single_zero] + norm_num + +/-- The boundary omnific integer is reduced. -/ +theorem boundaryOz_isReduced : Oz.IsReduced boundaryOz := by + rw [Oz.IsReduced] + refine ⟨boundaryOz_ne_zero, 0, ?_⟩ + intro i hi + change ArchimedeanClass.mk i = 0 + have hiSupport := hi.1 + rw [boundaryOz_support] at hiSupport + obtain ⟨x, hx⟩ := hiSupport + rw [← hx, boundaryExponentAtIndex] + exact Surreal.mk_realCast (boundaryConwayExponent_pos x).ne' + +private theorem lift_omega0_opow_natCast_boundary (n : ℕ) : + Ordinal.lift.{1, 0} ((Ordinal.omega0 : Ordinal.{0}) ^ (n : Ordinal)) = + (Ordinal.omega0 : Ordinal.{1}) ^ (n : Ordinal) := by + rw [Ordinal.opow_natCast, Ordinal.opow_natCast] + induction n with + | zero => simp + | succ n ih => simp [pow_succ, Ordinal.lift_mul, ih] + +private theorem omegaPowOmega_le_lift_boundaryOz_length : + (Ordinal.omega0 : Ordinal.{1}) ^ (Ordinal.omega0 : Ordinal.{1}) ≤ + Ordinal.lift.{1, 0} boundaryOz.1.length := by + rw [Ordinal.opow_limit Ordinal.omega0_ne_zero Ordinal.isSuccLimit_omega0] + apply Ordinal.iSup_le + intro i + obtain ⟨n, hn⟩ := Ordinal.lt_omega0.mp i.2 + rw [hn, ← lift_omega0_opow_natCast_boundary] + rw [Ordinal.lift_le, boundaryOz_length] + exact Ordinal.opow_le_opow_right Ordinal.omega0_pos + (Ordinal.natCast_lt_omega0 n).le + +/-- The boundary omnific integer does not satisfy the strict finite-degree inequality. -/ +theorem boundaryOz_not_hasFiniteDegree : ¬ Oz.HasFiniteDegree boundaryOz := by + rw [Oz.HasFiniteDegree] + exact not_lt_of_ge omegaPowOmega_le_lift_boundaryOz_length + +end ConwayRefinement.Standalone.Oz.OmegaOmegaBoundary diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmnificFactorizationProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmnificFactorizationProof.lean new file mode 100644 index 0000000000..399c057781 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmnificFactorizationProof.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinementProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayNormalForm + +/-! +# Proofs of factorisation statements for omnific integers + +The normal-form equivalence identifies this presentation of `Oz` with the omnific integer +subring. Primality and factorisation therefore pass across the equivalence. +-/ + +universe u + +public noncomputable section + +namespace ConwayRefinement.Standalone.Oz + +namespace NormalFormIdentifiesOmnificIntegers + +/-- Conway's cut definition and the normal-form definition determine the same subring. -/ +theorem of_normalForm : Oz.NormalFormIdentifiesOmnificIntegers.{u} := by + exact normalFormIdentifiesOmnificIntegers + +end NormalFormIdentifiesOmnificIntegers + +namespace EveryOmnificIntegerIsPrimal + +/-- Conway's refinement conjecture implies that every normal-form omnific integer is primal. -/ +theorem of_refinement : Oz.EveryOmnificIntegerIsPrimal.{u} := by + intro x + have hnative : IsPrimal + (normalFormRingEquiv x) := + (conwayConjecture_iff_forall_isPrimal.mp ConwayConjecture.proof) _ + exact (RingEquiv.isPrimal_iff + normalFormRingEquiv x).mp hnative + +end EveryOmnificIntegerIsPrimal + +namespace IrreducibleIsPrime + +/-- Every irreducible omnific integer is prime. -/ +theorem of_primality : Oz.IrreducibleIsPrime.{u} := by + intro x hx + exact hx.prime_of_isPrimal (EveryOmnificIntegerIsPrimal.of_refinement x) + +end IrreducibleIsPrime + +namespace IrreducibleFactorizationsAreUnique + +/-- Irreducible factorisations in `Oz` are unique up to order and units. -/ +theorem of_primality : Oz.IrreducibleFactorizationsAreUnique.{u} := by + intro f g hf hg hfg + exact prime_factors_unique + (fun x hx ↦ IrreducibleIsPrime.of_primality x (hf x hx)) + (fun x hx ↦ IrreducibleIsPrime.of_primality x (hg x hx)) + hfg + +end IrreducibleFactorizationsAreUnique + +end ConwayRefinement.Standalone.Oz diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmnificFiniteDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmnificFiniteDegree.lean new file mode 100644 index 0000000000..6ac8a3fa3d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmnificFiniteDegree.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorization +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow + +/-! +# Finite-degree predicates for omnific integers + +These predicates state the finite-degree examples in `Examples/`. +-/ + +universe u + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.Oz + +open Ordinal + +/-- An omnific integer is ordinary when its Conway normal form is an integer constant. -/ +def IsOrdinaryInteger (x : OmnificInteger.{u}) : Prop := + ∃ z : ℤ, x.1 = (z : SurrealHahnSeries) + +/-- LM24 reducedness: `x` is nonzero, and the exponents occurring in both `x` and `x - 1` lie in +one Archimedean class. -/ +def IsReduced (x : OmnificInteger.{u}) : Prop := + x ≠ 0 ∧ ∃ c : ArchimedeanClass Surreal, + x.1.support ∩ (x.1 - 1).support ⊆ {i | ArchimedeanClass.mk i = c} + +/-- Every nonordinary reduced omnific integer is primal. -/ +def ReducedIsPrimal : Prop := + ∀ x : OmnificInteger.{u}, ¬ IsOrdinaryInteger x → IsReduced x → IsPrimal x + +/-- The Conway normal form has finite degree when its support order type is below `ω ^ ω`. -/ +def HasFiniteDegree (x : OmnificInteger.{u}) : Prop := + Ordinal.lift.{u + 1, u} x.1.length < + (ω : Ordinal.{u + 1}) ^ (ω : Ordinal.{u + 1}) + +/-- Every irreducible, nonordinary, reduced omnific integer is prime. -/ +def ReducedIrreducibleIsPrime : Prop := + ∀ x : OmnificInteger.{u}, ¬ IsOrdinaryInteger x → IsReduced x → Irreducible x → Prime x + +/-- Every nonordinary reduced omnific integer of finite degree is primal. -/ +def FiniteDegreeIsPrimal : Prop := + ∀ x : OmnificInteger.{u}, ¬ IsOrdinaryInteger x → + IsReduced x → HasFiniteDegree x → IsPrimal x + +/-- Every irreducible, nonordinary, reduced omnific integer of finite degree is prime. -/ +def FiniteDegreeIrreducibleIsPrime : Prop := + ∀ x : OmnificInteger.{u}, ¬ IsOrdinaryInteger x → + IsReduced x → HasFiniteDegree x → Irreducible x → Prime x + +/-- Every irreducible, nonordinary, reduced omnific integer of support order type `ω ^ 2` is +prime. -/ +def DegreeTwoIrreducibleIsPrime : Prop := + ∀ x : OmnificInteger.{u}, ¬ IsOrdinaryInteger x → + IsReduced x → Ordinal.lift.{u + 1, u} x.1.length = + (ω : Ordinal.{u + 1}) ^ (2 : Ordinal.{u + 1}) → + Irreducible x → Prime x + +end ConwayRefinement.Standalone.Oz diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmnificIntegers.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmnificIntegers.lean new file mode 100644 index 0000000000..ccdd482b4b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmnificIntegers.lean @@ -0,0 +1,266 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic +public import Mathlib.Algebra.Ring.Subring.Defs + +import all LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic + +/-! +# Omnific integers in Conway normal-form coordinates + +CombinatorialGames supplies `SurrealHahnSeries`, the target of Conway normal form. In these +coordinates, the omnific integers are exactly the series whose exponents are nonnegative and whose +constant coefficient is an integer [LM24, §1.1]. + +This module constructs that subring using only Mathlib and CombinatorialGames. It does not assume a +normal-form map from surreals; the statement module next to it formulates the identification with +Conway's cut definition of `Oz`. + +## References + +* S. L'Innocente, V. Mantova, *A factorisation theory for generalised power series and omnific + integers*, Adv. Math. 442 (2024) 109513, , cited + as [LM24]. +-/ + +universe u + +public noncomputable section + +namespace ConwayRefinement.Standalone.Oz + +open Order Set + +private theorem ofLex_coe_mul (x y : SurrealHahnSeries) : + ofLex (x * y).1 = ofLex x.1 * ofLex y.1 := by + with_unfolding_all rfl + +private theorem ofLex_coe_single (p : Surreal) (r : ℝ) : + ofLex (SurrealHahnSeries.single p r).1 = + HahnSeries.single (OrderDual.toDual p) r := by + apply HahnSeries.ext + funext k + rw [HahnSeries.coeff_single] + unfold SurrealHahnSeries.single SurrealHahnSeries.mk + by_cases hk : k = OrderDual.toDual p + · subst k + simp + · have hk' : k.ofDual ≠ p := fun h ↦ hk (by simpa using congrArg OrderDual.toDual h) + simp [hk, hk'] + +private theorem mem_support_ofLex_coe_iff (x : SurrealHahnSeries) (k : Surreal) : + OrderDual.toDual k ∈ (ofLex x.1).support ↔ k ∈ x.support := by + rfl + +private theorem exists_add_eq_of_mem_support_mul + {x y : SurrealHahnSeries.{u}} {k : Surreal} + (hk : k ∈ (x * y).support) : + ∃ p ∈ x.support, ∃ q ∈ y.support, p + q = k := by + have hk' : OrderDual.toDual k ∈ (ofLex (x * y).1).support := + (mem_support_ofLex_coe_iff (x * y) k).2 hk + rw [ofLex_coe_mul] at hk' + obtain ⟨p, hp, q, hq, hpq⟩ := HahnSeries.support_mul_subset hk' + refine ⟨p.ofDual, (mem_support_ofLex_coe_iff x p.ofDual).1 ?_, + q.ofDual, (mem_support_ofLex_coe_iff y q.ofDual).1 ?_, ?_⟩ + · simpa using hp + · simpa using hq + · simpa using congrArg OrderDual.ofDual hpq + +private theorem support_mul_subset_Ici {x y : SurrealHahnSeries} + (hx : x.support ⊆ Ici 0) (hy : y.support ⊆ Ici 0) : + (x * y).support ⊆ Ici 0 := by + intro k hk + obtain ⟨p, hp, q, hq, rfl⟩ := exists_add_eq_of_mem_support_mul hk + rw [mem_Ici] + exact add_nonneg (show 0 ≤ p by simpa only [mem_Ici] using hx hp) + (show 0 ≤ q by simpa only [mem_Ici] using hy hq) + +private theorem single_mul_single (p q : Surreal.{u}) (r s : ℝ) : + SurrealHahnSeries.single p r * SurrealHahnSeries.single q s = + SurrealHahnSeries.single (p + q) (r * s) := by + apply Subtype.ext + rw [← ofLex_inj, ofLex_coe_mul, ofLex_coe_single, ofLex_coe_single, + HahnSeries.single_mul_single, ofLex_coe_single] + congr 2 + +private theorem coeff_mul_zero_of_support_subsets {x y : SurrealHahnSeries} + (hx : x.support ⊆ Ioi 0) (hy : y.support ⊆ Ici 0) : + (x * y).coeff 0 = 0 := by + rw [← not_ne_iff] + intro hcoeff + have hzero : 0 ∈ (x * y).support := + SurrealHahnSeries.mem_support_iff.mpr hcoeff + obtain ⟨p, hp, q, hq, hpq⟩ := exists_add_eq_of_mem_support_mul hzero + have hpPos : 0 < p := hx hp + have hqNonneg : 0 ≤ q := hy hq + have : 0 < p + q := add_pos_of_pos_of_nonneg hpPos hqNonneg + rw [hpq] at this + exact this.false + +private theorem coeff_zero_mul_of_support_subset_Ici {x y : SurrealHahnSeries} + (hx : x.support ⊆ Ici 0) (hy : y.support ⊆ Ici 0) : + (x * y).coeff 0 = x.coeff 0 * y.coeff 0 := by + have hxSplit : x.trunc 0 + SurrealHahnSeries.single 0 (x.coeff 0) = x := + SurrealHahnSeries.trunc_add_single fun i hi ↦ hx hi + have hySplit : y.trunc 0 + SurrealHahnSeries.single 0 (y.coeff 0) = y := + SurrealHahnSeries.trunc_add_single fun i hi ↦ hy hi + conv_lhs => rw [← hxSplit, ← hySplit] + rw [add_mul, mul_add, mul_add, + SurrealHahnSeries.coeff_add_apply, SurrealHahnSeries.coeff_add_apply, + SurrealHahnSeries.coeff_add_apply] + have hxTrunc : (x.trunc 0).support ⊆ Ioi 0 := by + intro i hi + rw [SurrealHahnSeries.support_trunc] at hi + exact hi.2 + have hyTrunc : (y.trunc 0).support ⊆ Ioi 0 := by + intro i hi + rw [SurrealHahnSeries.support_trunc] at hi + exact hi.2 + have hxTruncNonneg : (x.trunc 0).support ⊆ Ici 0 := by + intro i hi + rw [mem_Ici] + exact (show 0 < i by simpa only [mem_Ioi] using hxTrunc hi).le + have hyTruncNonneg : (y.trunc 0).support ⊆ Ici 0 := by + intro i hi + rw [mem_Ici] + exact (show 0 < i by simpa only [mem_Ioi] using hyTrunc hi).le + have hsingleNonneg (r : ℝ) : + (SurrealHahnSeries.single 0 r).support ⊆ Ici 0 := by + intro i hi + have hi' := SurrealHahnSeries.support_single_subset hi + rw [mem_Ici] + have : i = 0 := by simpa only [mem_singleton_iff] using hi' + simp [this] + rw [coeff_mul_zero_of_support_subsets hxTrunc hyTruncNonneg, + coeff_mul_zero_of_support_subsets hxTrunc (hsingleNonneg _)] + have hsingleTrunc : + (SurrealHahnSeries.single 0 (x.coeff 0) * y.trunc 0).coeff 0 = 0 := by + rw [mul_comm] + exact coeff_mul_zero_of_support_subsets hyTrunc (hsingleNonneg _) + rw [hsingleTrunc, single_mul_single] + simp [SurrealHahnSeries.coeff_single_self] + +/-- The Conway normal form of an integer is concentrated at exponent zero. -/ +theorem intCast_eq_single_zero (z : ℤ) : + (z : SurrealHahnSeries) = SurrealHahnSeries.single 0 (z : ℝ) := by + apply Subtype.ext + rw [← ofLex_inj, ofLex_coe_single] + with_unfolding_all rfl + +/-- The Conway normal form of one has coefficient one at exponent zero. -/ +theorem one_eq_single_zero : + (1 : SurrealHahnSeries) = SurrealHahnSeries.single 0 1 := by + apply Subtype.ext + rw [← ofLex_inj, ofLex_coe_single] + with_unfolding_all rfl + +/-- The omnific integers in Conway normal-form coordinates: surreal Hahn series with nonnegative +exponents and an integer constant coefficient [LM24, §1.1]. -/ +def omnificIntegers : Subring SurrealHahnSeries.{u} where + carrier := {x | x.support ⊆ Ici 0 ∧ x.coeff 0 ∈ range ((↑) : ℤ → ℝ)} + zero_mem' := by + refine ⟨by simp [SurrealHahnSeries.support_zero], ⟨0, by simp⟩⟩ + one_mem' := by + rw [one_eq_single_zero] + refine ⟨?_, ⟨1, by simp⟩⟩ + intro i hi + have hi' := SurrealHahnSeries.support_single_subset hi + rw [mem_Ici] + have : i = 0 := by simpa only [mem_singleton_iff] using hi' + simp [this] + add_mem' := by + rintro x y ⟨hxSupport, ⟨m, hm⟩⟩ ⟨hySupport, ⟨n, hn⟩⟩ + refine ⟨?_, ⟨m + n, ?_⟩⟩ + · exact SurrealHahnSeries.support_add_subset.trans + (union_subset hxSupport hySupport) + · rw [SurrealHahnSeries.coeff_add_apply, ← hm, ← hn] + simp + neg_mem' := by + rintro x ⟨hxSupport, ⟨m, hm⟩⟩ + refine ⟨?_, ⟨-m, ?_⟩⟩ + · intro i hi + apply hxSupport + rw [SurrealHahnSeries.mem_support_iff] at hi ⊢ + simpa only [SurrealHahnSeries.coeff_neg, Pi.neg_apply, neg_ne_zero] using hi + · rw [show (-x).coeff 0 = -x.coeff 0 by + exact congrFun (SurrealHahnSeries.coeff_neg x) 0, ← hm] + simp + mul_mem' := by + rintro x y ⟨hxSupport, ⟨m, hm⟩⟩ ⟨hySupport, ⟨n, hn⟩⟩ + refine ⟨support_mul_subset_Ici hxSupport hySupport, ⟨m * n, ?_⟩⟩ + rw [coeff_zero_mul_of_support_subset_Ici hxSupport hySupport, ← hm, ← hn] + simp + +/-- Membership in the normal-form presentation of the omnific integers. -/ +theorem mem_omnificIntegers {x : SurrealHahnSeries.{u}} : + x ∈ omnificIntegers ↔ + x.support ⊆ Ici 0 ∧ x.coeff 0 ∈ range ((↑) : ℤ → ℝ) := by + rfl + +/-- The omnific integers in Conway normal-form coordinates. -/ +abbrev OmnificInteger := ↥(omnificIntegers : Subring SurrealHahnSeries.{u}) + +/-- The integer coefficient of `ω ^ 0` in an omnific integer's Conway normal form. -/ +def integerConstantCoeff (x : OmnificInteger.{u}) : ℤ := + Classical.choose x.2.2 + +/-- The chosen integer really is the coefficient of `ω ^ 0`. -/ +@[simp] +theorem coe_integerConstantCoeff (x : OmnificInteger.{u}) : + (integerConstantCoeff x : ℝ) = x.1.coeff 0 := by + exact Classical.choose_spec x.2.2 + +/-- Taking the integer constant coefficient is a ring homomorphism `Oz →+* ℤ`. -/ +def integerConstantCoeffRingHom : OmnificInteger.{u} →+* ℤ where + toFun := integerConstantCoeff + map_zero' := by + apply Int.cast_injective (α := ℝ) + rw [coe_integerConstantCoeff] + simp + map_one' := by + apply Int.cast_injective (α := ℝ) + rw [coe_integerConstantCoeff] + rw [show (1 : OmnificInteger).1 = (1 : SurrealHahnSeries) by rfl, + one_eq_single_zero] + simp + map_add' x y := by + apply Int.cast_injective (α := ℝ) + rw [coe_integerConstantCoeff, Int.cast_add, coe_integerConstantCoeff, + coe_integerConstantCoeff] + exact SurrealHahnSeries.coeff_add_apply x.1 y.1 0 + map_mul' x y := by + apply Int.cast_injective (α := ℝ) + rw [coe_integerConstantCoeff, Int.cast_mul, coe_integerConstantCoeff, + coe_integerConstantCoeff] + exact coeff_zero_mul_of_support_subset_Ici x.2.1 y.2.1 + +@[simp] +theorem integerConstantCoeffRingHom_apply (x : OmnificInteger.{u}) : + integerConstantCoeffRingHom x = integerConstantCoeff x := (rfl) + +/-- A monomial with nonnegative exponent and coefficient one is an omnific integer. -/ +theorem single_one_mem_omnificIntegers (p : Surreal.{u}) (hp : 0 ≤ p) : + SurrealHahnSeries.single p 1 ∈ omnificIntegers := by + rw [mem_omnificIntegers] + refine ⟨fun i hi ↦ ?_, ?_⟩ + · have hip := SurrealHahnSeries.support_single_subset hi + have hiEq : i = p := by simpa only [Set.mem_singleton_iff] using hip + simpa only [Set.mem_Ici, hiEq] using hp + · by_cases hp0 : p = 0 + · subst p + exact ⟨1, by simp [SurrealHahnSeries.coeff_single_self]⟩ + · exact ⟨0, by simp [SurrealHahnSeries.coeff_single_of_ne hp0]⟩ + +/-- Powers of coefficient-one monomials multiply their exponent by the power. -/ +theorem single_one_pow (p : Surreal.{u}) (n : ℕ) : + (SurrealHahnSeries.single p 1) ^ n = SurrealHahnSeries.single (n • p) 1 := by + induction n with + | zero => rw [pow_zero, zero_nsmul, one_eq_single_zero] + | succ n ih => rw [pow_succ, ih, single_mul_single, succ_nsmul, one_mul] + +end ConwayRefinement.Standalone.Oz diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OneRowExample.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OneRowExample.lean new file mode 100644 index 0000000000..601835fb53 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OneRowExample.lean @@ -0,0 +1,142 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificIntegers + +import all LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic + +/-! +# Conway's one-row omnific integer + +This module writes the normal form + +`1 + Σ n : ℕ, ω ^ (1 / (n + 1))`, + +with every displayed coefficient equal to one. Its positive exponents form one decreasing row +converging to zero, followed by the final constant term. The sibling statement `OneRowPrime` +records its arithmetic properties using only Mathlib and CombinatorialGames. +-/ + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.Oz.OneRowExample + +open Set + +/-- The `n`-th positive exponent in Conway's one-row normal form. -/ +def exponent (n : ℕ) : ℝ := + 1 / (n + 1 : ℝ) + +@[simp] +theorem exponent_apply (n : ℕ) : exponent n = 1 / (n + 1 : ℝ) := by + rfl + +private theorem exponent_strictAnti : StrictAnti exponent := by + refine strictAnti_nat_of_succ_lt fun n ↦ ?_ + rw [exponent_apply, exponent_apply] + apply one_div_lt_one_div_of_lt + · positivity + · norm_num + +/-- The natural-number row followed by the final constant-term index. -/ +abbrev Index := WithTop ℕ + +/-- The exponent at an index of the displayed normal form. -/ +def exponentAtIndex : Index → Surreal + | ⊤ => 0 + | (n : ℕ) => (exponent n : ℝ) + +private theorem exponent_pos (n : ℕ) : 0 < exponent n := by + rw [exponent_apply] + positivity + +private theorem exponentAtIndex_strictAnti : StrictAnti exponentAtIndex := by + intro p q hpq + induction p using WithTop.recTopCoe with + | top => exact (not_lt_of_ge le_top hpq).elim + | coe p => + induction q using WithTop.recTopCoe with + | top => + change (0 : Surreal) < (exponent p : ℝ) + exact_mod_cast exponent_pos p + | coe q => + change ((exponent q : ℝ) : Surreal) < (exponent p : ℝ) + exact_mod_cast exponent_strictAnti (WithTop.coe_lt_coe.mp hpq) + +/-- The coefficient function supported on the displayed exponents. -/ +def coefficient (i : Surreal) : ℝ := + by + classical + exact if i ∈ range exponentAtIndex then 1 else 0 + +private theorem support_coefficient : + Function.support coefficient = range exponentAtIndex := by + classical + ext i + simp [Function.support, coefficient] + +/-- The displayed coefficient support is small enough for a surreal Hahn series. -/ +theorem small_support_coefficient : + Small.{0} (Function.support coefficient) := by + rw [support_coefficient] + infer_instance + +/-- The displayed exponents are reverse well-ordered. -/ +theorem wellFoundedOn_support_coefficient : + (Function.support coefficient).WellFoundedOn (· > ·) := by + rw [support_coefficient, wellFoundedOn_range] + convert wellFounded_lt (α := Index) using 1 + ext p q + exact exponentAtIndex_strictAnti.lt_iff_gt + +/-- Conway's coefficient-one normal form `1 + Σ n, ω ^ (1 / (n + 1))`. -/ +def normalForm : SurrealHahnSeries := + SurrealHahnSeries.mk coefficient small_support_coefficient + wellFoundedOn_support_coefficient + +@[simp] +theorem normalForm_coeff (i : Surreal) : + normalForm.coeff i = coefficient i := by + rw [normalForm, SurrealHahnSeries.coeff_mk, coefficient] + +@[simp] +theorem normalForm_support : normalForm.support = range exponentAtIndex := by + rw [normalForm, SurrealHahnSeries.support_mk, support_coefficient] + +theorem normalForm_coeff_exponent (n : ℕ) : + normalForm.coeff (exponent n : ℝ) = 1 := by + classical + rw [normalForm_coeff, coefficient, if_pos] + exact ⟨(n : Index), rfl⟩ + +theorem normalForm_coeff_zero : normalForm.coeff 0 = 1 := by + classical + rw [normalForm_coeff, coefficient, if_pos] + exact ⟨⊤, rfl⟩ + +private theorem normalForm_support_nonnegative : normalForm.support ⊆ Ici 0 := by + rw [normalForm_support] + rintro i ⟨p, rfl⟩ + induction p using WithTop.recTopCoe with + | top => exact le_rfl + | coe n => + rw [mem_Ici] + change (0 : Surreal) ≤ (exponent n : ℝ) + exact_mod_cast (exponent_pos n).le + +/-- Conway's one-row normal form, regarded as an omnific integer. -/ +def oneRowOz : Oz.OmnificInteger := + ⟨normalForm, by + rw [Oz.mem_omnificIntegers] + exact ⟨normalForm_support_nonnegative, + ⟨1, by simpa using normalForm_coeff_zero.symm⟩⟩⟩ + +@[simp] +theorem oneRowOz_val : oneRowOz.1 = normalForm := by + rfl + +end ConwayRefinement.Standalone.Oz.OneRowExample diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/PrincipalRVAlgebraicIndependenceProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/PrincipalRVAlgebraicIndependenceProof.lean new file mode 100644 index 0000000000..09ac0a322d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/PrincipalRVAlgebraicIndependenceProof.lean @@ -0,0 +1,376 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependence +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Polynomiality + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportSupremum +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NegativeMonomialIdeal +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationExpansion +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.Extension + +/-! +# Proof of algebraic independence in `P̂` + +The standalone ring `nonpos K` is `K((ℝ^{≤0}))`, and its `ordinalValue` is Berarducci's ordinal +value. Standalone decomposability agrees with membership in +`(P̂_+)² ∩ P_β = ∑_{i ⊕ j = β, i, j ≠ 0} P_i P_j`. A minimal homogeneous family extends to a +minimal homogeneous generating system of `P̂`; polynomiality of that system gives algebraic +independence of the original family. +-/ + +universe u + +open scoped NatOrdinal HahnSeries +open Berarducci HahnSeries MvPolynomial OrdinalGraded + +public noncomputable section + +namespace ConwayRefinement.Standalone.PrincipalRVAlgebraicIndependence + +variable {K : Type u} [Field K] + +/-! ### The ring -/ + +/-- The standalone and development presentations of `K((ℝ^{≤0}))` are the same `K`-algebra. -/ +@[expose] def seriesAlgEquiv : nonpos K ≃ₐ[K] Series K where + toFun a := ⟨(a : HahnSeries ℝ K), (HahnSeries.mem_nonpositiveSubring ℝ K).mpr a.2⟩ + invFun s := ⟨(s : HahnSeries ℝ K), (HahnSeries.mem_nonpositiveSubring ℝ K).mp s.2⟩ + left_inv _ := rfl + right_inv _ := rfl + map_add' _ _ := rfl + map_mul' _ _ := rfl + commutes' k := by + rw [HahnSeries.Nonpositive.algebraMap_apply] + exact Subtype.ext <| by + rw [Subalgebra.coe_algebraMap, HahnSeries.algebraMap_apply, Algebra.algebraMap_self, + RingHom.id_apply, HahnSeries.Nonpositive.coe_C] + +/-- Regard the standalone presentation as Berarducci's series ring. -/ +abbrev toSeries (a : nonpos K) : Series K := seriesAlgEquiv a + +/-- Regard Berarducci's series ring in the standalone presentation. -/ +abbrev ofSeries (s : Series K) : nonpos K := seriesAlgEquiv.symm s + +@[simp] theorem coe_toSeries (a : nonpos K) : + ((toSeries a : Series K) : HahnSeries ℝ K) = (a : HahnSeries ℝ K) := rfl + +@[simp] theorem toSeries_ofSeries (s : Series K) : toSeries (ofSeries s) = s := rfl + +theorem toSeries_algebraMap (k : K) : + toSeries (algebraMap K (nonpos K) k) = HahnSeries.Nonpositive.C k := by + rw [← HahnSeries.Nonpositive.algebraMap_apply] + exact seriesAlgEquiv.commutes k + +theorem toSeries_sub (a b : nonpos K) : toSeries (a - b) = toSeries a - toSeries b := + map_sub seriesAlgEquiv a b + +theorem toSeries_add (a b : nonpos K) : toSeries (a + b) = toSeries a + toSeries b := + map_add seriesAlgEquiv a b + +theorem toSeries_mul (a b : nonpos K) : toSeries (a * b) = toSeries a * toSeries b := + map_mul seriesAlgEquiv a b + +theorem toSeries_sum {ι : Type*} (s : Finset ι) (f : ι → nonpos K) : + toSeries (∑ i ∈ s, f i) = ∑ i ∈ s, toSeries (f i) := + map_sum seriesAlgEquiv f s + +theorem toSeries_aeval {ι : Type*} (b : ι → nonpos K) (F : MvPolynomial ι K) : + toSeries (aeval b F) = aeval (fun i ↦ toSeries (b i)) F := by + change seriesAlgEquiv.toAlgHom (aeval b F) = aeval (fun i ↦ seriesAlgEquiv (b i)) F + rw [← AlgHom.comp_apply, MvPolynomial.comp_aeval] + rfl + +/-! ### The ordinal value -/ + +theorem ot_eq (x : HahnSeries ℝ K) : ot x = HahnSeries.supportOrderType x := by + haveI : WellFoundedLT x.support := ⟨(supportIsWellOrder x).wf⟩ + exact (HahnSeries.supportOrderType_eq_typeLT (OrderIso.refl _)).symm + +theorem memJ_iff (a : nonpos K) : + MemJ a ↔ toSeries a ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K := by + rw [HahnSeries.Nonpositive.mem_negativeMonomialIdeal_iff_supportSup_lt_zero] + rcases eq_or_ne (toSeries a) 0 with h0 | h0 + · rw [h0, HahnSeries.Nonpositive.supportSup_zero] + refine ⟨fun _ ↦ WithBot.bot_lt_coe 0, fun _ ↦ ⟨-1, by norm_num, fun y hy ↦ ?_⟩⟩ + have : (a : HahnSeries ℝ K) = 0 := by + have := congrArg (fun s : Series K ↦ (s : HahnSeries ℝ K)) h0 + simpa using this + rw [this, HahnSeries.support_zero] at hy + exact absurd hy (Set.notMem_empty y) + · have h0' : (a : HahnSeries ℝ K) ≠ 0 := fun h ↦ h0 (Subtype.ext h) + rw [HahnSeries.Nonpositive.supportSup_of_ne h0, ← WithBot.coe_zero, WithBot.coe_lt_coe] + constructor + · rintro ⟨s, hs, hsupp⟩ + exact (csSup_le (HahnSeries.support_nonempty_iff.mpr h0') hsupp).trans_lt hs + · intro h + exact ⟨_, h, fun y hy ↦ le_csSup (HahnSeries.Nonpositive.bddAbove_support (toSeries a)) hy⟩ + +theorem isNearConstant_iff (a : nonpos K) : + IsNearConstant a ↔ toSeries a ∈ Berarducci.nearConstantSubgroup K := by + rw [Berarducci.mem_nearConstantSubgroup_iff] + constructor + · rintro ⟨k, hk⟩ + refine ⟨toSeries (a - algebraMap K (nonpos K) k), (memJ_iff _).mp hk, k, ?_⟩ + rw [toSeries_sub, toSeries_algebraMap, sub_add_cancel] + · rintro ⟨j, hj, k, hjk⟩ + refine ⟨k, (memJ_iff _).mpr ?_⟩ + rw [toSeries_sub, toSeries_algebraMap, ← hjk, add_sub_cancel_right] + exact hj + +/-- The standalone ordinal value is Berarducci's. -/ +theorem ordinalValue_eq (a : nonpos K) : ordinalValue a = Berarducci.ordinalValue (toSeries a) := by + classical + unfold ordinalValue + by_cases hJ : MemJ a + · rw [if_pos hJ, Berarducci.ordinalValue_of_mem_negativeMonomialIdeal ((memJ_iff a).mp hJ)] + rw [if_neg hJ] + by_cases hN : IsNearConstant a + · rw [if_pos hN, + Berarducci.ordinalValue_of_mem_nearConstantSubgroup_of_not_mem_negativeMonomialIdeal + ((isNearConstant_iff a).mp hN) (fun h ↦ hJ ((memJ_iff a).mpr h))] + rw [if_neg hN, + Berarducci.ordinalValue_of_not_mem_nearConstantSubgroup + (fun h ↦ hN ((isNearConstant_iff a).mpr h))] + congr 1 + ext o + simp only [Set.mem_setOf_eq, Berarducci.mem_representativeOrderTypes_iff] + constructor + · rintro ⟨c, hc, rfl⟩ + refine ⟨toSeries c, ?_, by rw [ot_eq]; rfl⟩ + have := (isNearConstant_iff _).mp hc + rwa [toSeries_sub] at this + · rintro ⟨c, hc, rfl⟩ + refine ⟨ofSeries c, ?_, by rw [ot_eq]; rfl⟩ + rw [isNearConstant_iff, toSeries_sub, toSeries_ofSeries] + exact hc + +/-! ### Decomposables -/ + +/-- A representative of the sum of two classes differs from the sum of representatives by a +series of small value. -/ +theorem ordinalValue_sub_lt_of_represents {a a₁ a₂ : Series K} {β : NatOrdinal} + {y₁ y₂ : PrincipalSubring K} (h : Represents a β (y₁ + y₂)) (h₁ : Represents a₁ β y₁) + (h₂ : Represents a₂ β y₂) : Berarducci.ordinalValue (a - (a₁ + a₂)) < ω^ β := by + have h12 := h₁.add h₂ + obtain ⟨ha, hae⟩ := represents_iff.mp h + obtain ⟨ha12, ha12e⟩ := represents_iff.mp h12 + have := DirectSum.of_injective β (hae.trans ha12e.symm) + exact (principalComponentMk_eq_iff β _ _ ha ha12).mp this + +/-- The standalone decomposables contain every series representing an element of +`(P̂_+)² ∩ P_β` (`decomposableAt`). -/ +theorem isDecomposable_of_mem_decomposableAt {β : NatOrdinal} {y : PrincipalSubring K} + (hy : y ∈ decomposableAt (principalGrading K) β) {a : nonpos K} + (ha : Represents (toSeries a) β y) : IsDecomposable β a := by + classical + -- the submodule of elements of `P_β` all of whose representatives are decomposable + let N : Submodule K (PrincipalSubring K) := + { carrier := {y | y ∈ principalGrading K β ∧ + ∀ a : nonpos K, Represents (toSeries a) β y → IsDecomposable β a} + zero_mem' := by + refine ⟨zero_mem _, fun a ha ↦ ?_⟩ + refine ⟨0, Fin.elim0, Fin.elim0, Fin.elim0, Fin.elim0, fun k ↦ k.elim0, fun k ↦ k.elim0, + fun k ↦ k.elim0, ?_⟩ + rw [Finset.univ_eq_empty, Finset.sum_empty, sub_zero, ordinalValue_eq] + exact ha.ordinalValue_lt_of_eq_zero + add_mem' := by + rintro y₁ y₂ ⟨hy₁, h₁⟩ ⟨hy₂, h₂⟩ + refine ⟨add_mem hy₁ hy₂, fun a ha ↦ ?_⟩ + -- representatives of `y₁`, `y₂` + obtain ⟨z₁, rfl⟩ := (DirectSum.mem_rangeLof_iff K _ _ y₁).mp hy₁ + obtain ⟨z₂, rfl⟩ := (DirectSum.mem_rangeLof_iff K _ _ y₂).mp hy₂ + simp only [DirectSum.lof_eq_of] at h₁ h₂ ha + obtain ⟨s₁, hs₁, hz₁⟩ := exists_principalComponentMk β z₁ + obtain ⟨s₂, hs₂, hz₂⟩ := exists_principalComponentMk β z₂ + have hr₁ : Represents (toSeries (ofSeries s₁)) β + (DirectSum.of (PrincipalComponent K) β z₁) := by + rw [toSeries_ofSeries]; exact represents_iff.mpr ⟨hs₁, congrArg _ hz₁⟩ + have hr₂ : Represents (toSeries (ofSeries s₂)) β + (DirectSum.of (PrincipalComponent K) β z₂) := by + rw [toSeries_ofSeries]; exact represents_iff.mpr ⟨hs₂, congrArg _ hz₂⟩ + obtain ⟨n₁, β₁, β₁', u₁, w₁, hβ₁, hu₁, hw₁, hv₁⟩ := h₁ _ hr₁ + obtain ⟨n₂, β₂, β₂', u₂, w₂, hβ₂, hu₂, hw₂, hv₂⟩ := h₂ _ hr₂ + refine ⟨n₁ + n₂, Fin.append β₁ β₂, Fin.append β₁' β₂', Fin.append u₁ u₂, Fin.append w₁ w₂, + fun k ↦ ?_, fun k ↦ ?_, fun k ↦ ?_, ?_⟩ + · refine Fin.addCases (fun k ↦ ?_) (fun k ↦ ?_) k + · simp only [Fin.append_left]; exact hβ₁ k + · simp only [Fin.append_right]; exact hβ₂ k + · refine Fin.addCases (fun k ↦ ?_) (fun k ↦ ?_) k + · simp only [Fin.append_left]; exact hu₁ k + · simp only [Fin.append_right]; exact hu₂ k + · refine Fin.addCases (fun k ↦ ?_) (fun k ↦ ?_) k + · simp only [Fin.append_left]; exact hw₁ k + · simp only [Fin.append_right]; exact hw₂ k + · rw [Fin.sum_univ_add] + simp only [Fin.append_left, Fin.append_right] + rw [ordinalValue_eq] at hv₁ hv₂ ⊢ + simp only [toSeries_sub, toSeries_add, toSeries_sum, toSeries_ofSeries] at hv₁ hv₂ ⊢ + have hsmall := ordinalValue_sub_lt_of_represents ha hr₁ hr₂ + rw [toSeries_ofSeries, toSeries_ofSeries] at hsmall + have heq : toSeries a - (∑ k, toSeries (u₁ k * w₁ k) + ∑ k, toSeries (u₂ k * w₂ k)) = + (toSeries a - (s₁ + s₂)) + (s₁ - ∑ k, toSeries (u₁ k * w₁ k)) + + (s₂ - ∑ k, toSeries (u₂ k * w₂ k)) := by abel + rw [heq] + refine (ordinalValue_add_le_max _ _).trans_lt (max_lt ?_ hv₂) + exact (ordinalValue_add_le_max _ _).trans_lt (max_lt hsmall hv₁) + smul_mem' := by + rintro k y ⟨hy, h⟩ + refine ⟨Submodule.smul_mem _ k hy, fun a ha ↦ ?_⟩ + obtain ⟨z, rfl⟩ := (DirectSum.mem_rangeLof_iff K _ _ y).mp hy + rw [DirectSum.lof_eq_of] at h ha + obtain ⟨s, hs, hz⟩ := exists_principalComponentMk β z + have hr : Represents (toSeries (ofSeries s)) β + (DirectSum.of (PrincipalComponent K) β z) := by + rw [toSeries_ofSeries]; exact represents_iff.mpr ⟨hs, congrArg _ hz⟩ + obtain ⟨n, β₀, β₀', u, w, hβ₀, hu, hw, hv⟩ := h _ hr + -- `C k · s` represents `k • y` + have hrk : Represents (HahnSeries.Nonpositive.C k * s) β + (k • DirectSum.of (PrincipalComponent K) β z) := by + have hr' : Represents s β (DirectSum.of (PrincipalComponent K) β z) := by + rw [← toSeries_ofSeries s]; exact hr + have := (represents_C (K := K) k).mul hr' + rw [zero_add] at this + rw [Algebra.smul_def] + exact this + refine ⟨n, β₀, β₀', fun i ↦ algebraMap K (nonpos K) k * u i, w, hβ₀, fun i ↦ ?_, hw, ?_⟩ + · rw [ordinalValue_eq, toSeries_mul, toSeries_algebraMap] + have hui := hu i + rw [ordinalValue_eq] at hui + exact Lifts.ordinalValue_C_mul_lt k hui + · rw [ordinalValue_eq, toSeries_sub, toSeries_sum] + rw [ordinalValue_eq, toSeries_sub, toSeries_sum, toSeries_ofSeries] at hv + have hsmall : + Berarducci.ordinalValue (toSeries a - HahnSeries.Nonpositive.C k * s) < ω^ β := by + obtain ⟨h1, h1e⟩ := represents_iff.mp ha + obtain ⟨h2, h2e⟩ := represents_iff.mp hrk + exact (principalComponentMk_eq_iff β _ _ h1 h2).mp + (DirectSum.of_injective β (h1e.trans h2e.symm)) + have heq : toSeries a - ∑ i, toSeries (algebraMap K (nonpos K) k * u i * w i) = + (toSeries a - HahnSeries.Nonpositive.C k * s) + + HahnSeries.Nonpositive.C k * (s - ∑ i, toSeries (u i * w i)) := by + simp only [toSeries_mul, toSeries_algebraMap, mul_sub, Finset.mul_sum, mul_assoc] + abel + rw [heq] + exact (ordinalValue_add_le_max _ _).trans_lt + (max_lt hsmall (Lifts.ordinalValue_C_mul_lt k hv)) } + -- the decomposables lie in `N` + have hle : decomposableAt (principalGrading K) β ≤ N := by + refine decomposableAt_le (principalGrading K) fun i j hi hj hij ↦ + Submodule.mul_le.mpr fun m hm n hn ↦ ?_ + refine ⟨hij ▸ SetLike.mul_mem_graded hm hn, fun a ha ↦ ?_⟩ + obtain ⟨zm, rfl⟩ := (DirectSum.mem_rangeLof_iff K _ _ m).mp hm + obtain ⟨zn, rfl⟩ := (DirectSum.mem_rangeLof_iff K _ _ n).mp hn + simp only [DirectSum.lof_eq_of] at ha + obtain ⟨sm, hsm, hzm⟩ := exists_principalComponentMk i zm + obtain ⟨sn, hsn, hzn⟩ := exists_principalComponentMk j zn + have hrm : Represents sm i (DirectSum.of (PrincipalComponent K) i zm) := + represents_iff.mpr ⟨hsm, congrArg _ hzm⟩ + have hrn : Represents sn j (DirectSum.of (PrincipalComponent K) j zn) := + represents_iff.mpr ⟨hsn, congrArg _ hzn⟩ + have hrmn := (hrm.mul hrn).of_eq hij + refine ⟨1, fun _ ↦ i, fun _ ↦ j, fun _ ↦ ofSeries sm, fun _ ↦ ofSeries sn, + fun _ ↦ ⟨hi, hj, hij⟩, fun _ ↦ ?_, fun _ ↦ ?_, ?_⟩ + · rw [ordinalValue_eq, toSeries_ofSeries]; exact hsm + · rw [ordinalValue_eq, toSeries_ofSeries]; exact hsn + · rw [Fin.sum_univ_one, ordinalValue_eq, toSeries_sub, toSeries_mul, toSeries_ofSeries, + toSeries_ofSeries] + obtain ⟨h1, h1e⟩ := represents_iff.mp ha + obtain ⟨h2, h2e⟩ := represents_iff.mp hrmn + exact (principalComponentMk_eq_iff β _ _ h1 h2).mp + (DirectSum.of_injective β (h1e.trans h2e.symm)) + exact (hle hy).2 a ha + +/-! ### Minimal homogeneous families -/ + +variable {ι : Type} (deg : ι → NatOrdinal) (b : ι → nonpos K) + (hB : IsMinimalHomogeneousFamily deg b) +include hB + +theorem ordinalValue_toSeries_lt (i : ι) : + Berarducci.ordinalValue (toSeries (b i)) < ω^ (deg i + 1) := by + rw [← ordinalValue_eq]; exact hB.mem i + +/-- The classes of the generators. -/ +def classes (i : ι) : PrincipalSubring K := + DirectSum.of (PrincipalComponent K) (deg i) + (principalComponentMk (deg i) (toSeries (b i)) (ordinalValue_toSeries_lt deg b hB i)) + +/-- The lifts of the classes: the series themselves. -/ +def lifts : Lifts deg (classes deg b hB) where + lift i := toSeries (b i) + represents i := represents_iff.mpr ⟨ordinalValue_toSeries_lt deg b hB i, rfl⟩ + +/-- The classes of the given family are independent modulo the decomposables. -/ +theorem independent_classes (β : NatOrdinal) (c : ι →₀ K) (hc : ∀ i ∈ c.support, deg i = β) + (hdec : Finsupp.linearCombination K (classes deg b hB) c ∈ + decomposableAt (principalGrading K) β) : c = 0 := by + classical + refine hB.independent β c hc ?_ + refine isDecomposable_of_mem_decomposableAt hdec ?_ + rw [Finsupp.linearCombination_apply, Finsupp.sum, Finsupp.sum, toSeries_sum] + refine represents_sum _ _ _ _ fun i hi ↦ ?_ + rw [toSeries_mul, toSeries_algebraMap, Algebra.smul_def] + have := (represents_C (K := K) (c i)).mul ((lifts deg b hB).represents i) + rw [zero_add, hc i hi] at this + exact this + +omit hB in +/-- Renaming the variables along a degree-preserving map preserves homogeneity. -/ +theorem isWeightedHomogeneous_rename {ι' : Type*} {e : ι → ι'} {wt' : ι' → NatOrdinal} + (hwt : ∀ i, wt' (e i) = deg i) {F : MvPolynomial ι K} {α : NatOrdinal} + (hF : IsWeightedHomogeneous deg F α) : IsWeightedHomogeneous wt' (rename e F) α := by + intro d hd + obtain ⟨u, rfl, hu⟩ := coeff_rename_ne_zero e F d hd + rw [← hF hu, Finsupp.weight_apply, Finsupp.weight_apply, + Finsupp.sum_mapDomain_index (h := fun i c ↦ c • wt' i) (fun _ ↦ zero_smul ℕ _) + (fun _ _ _ ↦ add_smul _ _ _)] + exact Finsupp.sum_congr fun i _ ↦ by rw [hwt] + +end ConwayRefinement.Standalone.PrincipalRVAlgebraicIndependence + +namespace ConwayRefinement.Standalone.PrincipalRVAlgebraicIndependence + +namespace MinimalFamiliesAlgebraicallyIndependent + +open ConwayRefinement.Standalone.PrincipalRVAlgebraicIndependence + +/-- Every minimal homogeneous family in `P̂` is algebraically independent. -/ +theorem of_algebraicIndependence (K : Type u) [Field K] : + PrincipalRVAlgebraicIndependence.MinimalFamiliesAlgebraicallyIndependent K := by + intro hK + letI := hK + intro ι deg b hB α F hF hval + -- Extend the family to a minimal homogeneous generating system of `P̂`. + obtain ⟨ι', wt', x', e, he, hwt', hx', hmin⟩ := + exists_isMinimalSystem_extension (principalGrading K) hB.ne_zero + (fun i ↦ of_mem_principalGrading _ _) (independent_classes deg b hB) + have hinj := Berarducci.injectiveAt_of_isMinimalSystem hmin α + -- `F(classes) = 0` in `P̂` + have hrep := (lifts deg b hB).aeval_represents hF + have h0 : Berarducci.ordinalValue (aeval (lifts deg b hB).lift F) < ω^ α := by + have : aeval (lifts deg b hB).lift F = toSeries (aeval b F) := (toSeries_aeval b F).symm + rw [this, ← ordinalValue_eq] + exact hval + obtain ⟨hu, heq⟩ := represents_iff.mp hrep + have hzero : aeval (classes deg b hB) F = 0 := by + rw [← heq, (principalComponentMk_eq_zero_iff α _ hu).mpr h0, map_zero] + -- hence `F`, read in the extended variables, vanishes, so `F = 0` + have hren : rename e F = 0 := by + refine (injectiveAt_iff α).mp hinj _ (isWeightedHomogeneous_rename deg hwt' hF) ?_ + rw [aeval_rename] + have : x' ∘ e = classes deg b hB := funext hx' + rw [this] + exact hzero + exact rename_injective e he (by rw [hren, map_zero]) + +end MinimalFamiliesAlgebraicallyIndependent + +end ConwayRefinement.Standalone.PrincipalRVAlgebraicIndependence diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib.lean new file mode 100644 index 0000000000..8bb9485e13 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib.lean @@ -0,0 +1,22 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGerm +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGermProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRing +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRingProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCD +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRing +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRingProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/CompleteHahnGerm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/CompleteHahnGerm.lean new file mode 100644 index 0000000000..7a6de99115 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/CompleteHahnGerm.lean @@ -0,0 +1,96 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.MvPolynomial.Equiv +public import Mathlib.Algebra.Order.Archimedean.Class +public import Mathlib.RingTheory.HahnSeries.Multiplication +public import Mathlib.RingTheory.Ideal.Quotient.Operations +public import Mathlib.Topology.Algebra.IsUniformGroup.Defs +public import Mathlib.Topology.Order.Basic +public import Mathlib.Topology.UniformSpace.Cauchy + +/-! +# Hahn germs over a Cauchy-complete exponent group + +Let `K((G^{≤ 0}))` be the ring of Hahn series supported in the nonpositive cone of `G`, and +identify two series when they agree on some interval immediately below zero. If `G` is Cauchy +complete for an order-compatible uniformity, dense, has no endpoints, and has no smallest nonzero +Archimedean magnitude, then this germ ring is a polynomial algebra over `K`. Consequently it has +four-factor refinement. +-/ + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.CompleteHahnGerm + +universe u v + +variable (G : Type u) (K : Type v) +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [NoMinOrder G] [Field K] + +/-- The Hahn-series `K`-algebra `K((G^{≤ 0}))`. -/ +def NonpositiveSeries : Subalgebra K (HahnSeries G K) where + carrier := {x | x.support ⊆ Set.Iic 0} + algebraMap_mem' k := by + intro g hg + rw [HahnSeries.algebraMap_apply] at hg + have hg0 : g = 0 := HahnSeries.support_single_subset hg + simp [hg0] + add_mem' := fun hx hy ↦ + (HahnSeries.support_add_subset _ _).trans (Set.union_subset hx hy) + mul_mem' := fun hx hy ↦ HahnSeries.support_mul_subset.trans fun _ ⟨i, hi, j, hj, h⟩ ↦ + h ▸ show i + j ≤ 0 from add_nonpos (hx hi) (hy hj) + +/-- The ideal of series whose support is bounded away from zero. -/ +def BoundedAwayIdeal : Ideal (NonpositiveSeries G K) where + carrier := {x | ∃ r < (0 : G), (x : HahnSeries G K).support ⊆ Set.Iic r} + zero_mem' := by + obtain ⟨r, hr⟩ := exists_lt (0 : G) + exact ⟨r, hr, by simp⟩ + add_mem' := by + rintro x y ⟨r, hr, hxr⟩ ⟨s, hs, hys⟩ + refine ⟨max r s, max_lt hr hs, ?_⟩ + intro q hq + rcases HahnSeries.support_add_subset (x : HahnSeries G K) y hq with hqx | hqy + · exact (hxr hqx).trans (le_max_left r s) + · exact (hys hqy).trans (le_max_right r s) + smul_mem' := by + rintro x y ⟨r, hr, hyr⟩ + refine ⟨r, hr, HahnSeries.support_mul_subset.trans ?_⟩ + rintro _ ⟨i, hi, j, hj, rfl⟩ + simpa only [Set.mem_Iic, zero_add] using add_le_add (x.2 hi) (hyr hj) + +/-- The germ ring `K((G^{≤ 0}))` modulo series supported away from zero. -/ +abbrev Germ := NonpositiveSeries G K ⧸ BoundedAwayIdeal G K + +/-- The germ ring is isomorphic to a polynomial algebra over `K`. -/ +abbrev IsPolynomialRing : Prop := + ∀ [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] + [Nontrivial G] [CompleteSpace G] [DenselyOrdered G] [NoMaxOrder G] + [NoMaxOrder (FiniteArchimedeanClass G)] [CharZero K], + ∃ ι : Type (max (u + 1) v), Nonempty (MvPolynomial ι K ≃ₐ[K] Germ G K) + +/-- Every equation of four germs admits a four-factor refinement. -/ +abbrev HasRefinement : Prop := + ∀ [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] + [Nontrivial G] [CompleteSpace G] [DenselyOrdered G] [NoMaxOrder G] + [NoMaxOrder (FiniteArchimedeanClass G)] [CharZero K], + ∀ a b c d : Germ G K, a * b = c * d → + ∃ e f g h : Germ G K, + a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h + +end ConwayRefinement.Standalone.CompleteHahnGerm + +/-! +## Formal proof + +Proof module: `CompleteHahnGermProof`. + +* `IsPolynomialRing` → `IsPolynomialRing.proof` +* `HasRefinement` → `HasRefinement.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/CompleteHahnGermProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/CompleteHahnGermProof.lean new file mode 100644 index 0000000000..0a9f87f310 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/CompleteHahnGermProof.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGerm +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.CompleteHahnGermProof + +/-! # Complete Hahn Germ Proof -/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.CompleteHahnGerm + +universe u v + +namespace IsPolynomialRing + +/-- The germ ring is a polynomial ring over its coefficient field. -/ +theorem proof (G : Type u) (K : Type v) + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [NoMinOrder G] [Field K] : + IsPolynomialRing G K := Support.isPolynomialRing G K + +end IsPolynomialRing + +namespace HasRefinement + +/-- Polynomiality gives the four-factor refinement of germs. -/ +theorem proof (G : Type u) (K : Type v) + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [NoMinOrder G] [Field K] : + HasRefinement G K := Support.hasRefinement G K + +end HasRefinement + +end ConwayRefinement.Standalone.CompleteHahnGerm diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples.lean new file mode 100644 index 0000000000..7f2b78981a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples.lean @@ -0,0 +1,14 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrimeProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterion +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterionProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRoots +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRootsProof + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/DegreeTwoPrime.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/DegreeTwoPrime.lean new file mode 100644 index 0000000000..2369bc2bb2 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/DegreeTwoPrime.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.Prime.Defs +public import Mathlib.Data.Real.Basic +public import Mathlib.RingTheory.HahnSeries.Multiplication + +/-! +# An explicit degree-two prime Hahn series + +The coefficient-one series on the displayed two-dimensional support is prime in +`K((ℝ^{≤ 0}))` over every field of characteristic zero. Its rows converge to +`-1 / (m + 1)`, and those row limits converge to zero. +-/ + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.Hahn.DegreeTwoExample + +universe u + +/-- Hahn series over `K` supported in the nonpositive real exponents. -/ +def NonpositiveSeries (K : Type u) [Field K] : Subring (HahnSeries ℝ K) where + carrier := {x | x.support ⊆ Set.Iic 0} + zero_mem' := by simp + one_mem' := fun _ hg ↦ (HahnSeries.support_single_subset hg).le + add_mem' := fun hx hy ↦ + (HahnSeries.support_add_subset _ _).trans (Set.union_subset hx hy) + neg_mem' := fun hx ↦ (HahnSeries.support_neg_subset _).trans hx + mul_mem' := fun hx hy ↦ HahnSeries.support_mul_subset.trans fun _ ⟨i, hi, j, hj, h⟩ ↦ + h ▸ show i + j ≤ 0 from add_nonpos (hx hi) (hy hj) + +/-- The exponent in row `m` and column `n` of the displayed support. -/ +def exponent (m n : ℕ) : ℝ := + -(1 / (m + 1 : ℝ)) - + 1 / ((m + 1 : ℝ) * (m + 2 : ℝ) * (n + 1 : ℝ)) + +/-- The support consists exactly of zero and the displayed row-column exponents. -/ +def IsDisplayedExponent (r : ℝ) : Prop := + r = 0 ∨ ∃ m n : ℕ, r = exponent m n + +/-- Over every characteristic-zero field there is a prime series whose coefficient is one at +exactly the displayed exponents and zero elsewhere. -/ +def ExistsPrime (K : Type u) [Field K] : Prop := + CharZero K → ∃ x : NonpositiveSeries K, + (∀ r : ℝ, IsDisplayedExponent r → (x : HahnSeries ℝ K).coeff r = 1) ∧ + (∀ r : ℝ, ¬ IsDisplayedExponent r → (x : HahnSeries ℝ K).coeff r = 0) ∧ + Prime x + +end ConwayRefinement.Standalone.Hahn.DegreeTwoExample + +/-! +## Formal proof + +Proof module: `DegreeTwoPrimeProof`. + +* `ExistsPrime` → `ExistsPrime.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/DegreeTwoPrimeProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/DegreeTwoPrimeProof.lean new file mode 100644 index 0000000000..5a37a33af8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/DegreeTwoPrimeProof.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwoExample + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Primality + +/-! # Degree Two Prime Proof -/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.Hahn.DegreeTwoExample + +open PommersheimShahriari.DegreeTwoExample + +universe u + +variable {K : Type u} [Field K] + +private theorem nonpositiveSeries_eq : + NonpositiveSeries K = HahnSeries.nonpositiveSubring ℝ K := by + ext x + rfl + +private theorem coeff_eq_one_of_isDisplayedExponent {r : ℝ} (hr : IsDisplayedExponent r) : + ((degreeTwoWithConstant (K := K) : Berarducci.Series K) : HahnSeries ℝ K).coeff r = 1 := by + rcases hr with rfl | ⟨m, n, rfl⟩ + · exact degreeTwoWithConstant_coeff_zero + · simpa only [exponent, degreeTwoExponentEmbedding_apply, + degreeTwoExponentPair_apply] using + degreeTwoWithConstant_coeff_embedding (K := K) m n + +private theorem coeff_eq_zero_of_not_isDisplayedExponent {r : ℝ} + (hr : ¬ IsDisplayedExponent r) : + ((degreeTwoWithConstant (K := K) : Berarducci.Series K) : HahnSeries ℝ K).coeff r = 0 := by + apply degreeTwoWithConstant_coeff_eq_zero + · rintro ⟨p, rfl⟩ + rcases p with ⟨m, n⟩ + apply hr + exact Or.inr ⟨m, n, by + change degreeTwoExponentEmbedding (toLex (m, n)) = exponent m n + rw [degreeTwoExponentEmbedding_apply, degreeTwoExponentPair_apply] + rfl⟩ + · intro hzero + exact hr (Or.inl hzero) + +namespace ExistsPrime + +/-- The displayed coefficient-one Hahn series is prime. -/ +theorem proof (K : Type u) [Field K] : ExistsPrime K := by + intro hK + letI : CharZero K := hK + let E : NonpositiveSeries K ≃+* HahnSeries.Nonpositive ℝ K := + RingEquiv.subringCongr nonpositiveSeries_eq + let x : NonpositiveSeries K := E.symm (degreeTwoWithConstant (K := K)) + refine ⟨x, ?_, ?_, ?_⟩ + · intro r hr + rw [show (x : HahnSeries ℝ K) = + ((degreeTwoWithConstant (K := K) : Berarducci.Series K) : HahnSeries ℝ K) by rfl] + exact coeff_eq_one_of_isDisplayedExponent hr + · intro r hr + rw [show (x : HahnSeries ℝ K) = + ((degreeTwoWithConstant (K := K) : Berarducci.Series K) : HahnSeries ℝ K) by rfl] + exact coeff_eq_zero_of_not_isDisplayedExponent hr + · apply (MulEquiv.prime_iff E.toMulEquiv).mp + change Prime (degreeTwoWithConstant (K := K)) + exact Berarducci.prime_of_irreducible degreeTwoWithConstant_irreducible + +end ExistsPrime + +end ConwayRefinement.Standalone.Hahn.DegreeTwoExample diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/HahnIntegerPartRefinementCriterion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/HahnIntegerPartRefinementCriterion.lean new file mode 100644 index 0000000000..66ff663814 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/HahnIntegerPartRefinementCriterion.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnLimitTailQuotient +public import Mathlib.Algebra.Divisibility.Basic +public import Mathlib.Algebra.Order.Module.HahnEmbedding +public import Mathlib.Data.Real.Basic +public import Mathlib.RingTheory.HahnSeries.Cardinal +public import Mathlib.SetTheory.Cardinal.Cofinality.Basic +public import Mathlib.SetTheory.Cardinal.Regular + +/-! +# A criterion for refinement in bounded Hahn integer parts + +Conditions `(A1)`--`(A3)` of LM24, together with two conditions on every common tail at a limit of +Archimedean classes, imply four-factor refinement in a cardinal-bounded Hahn integer part. +-/ + +public noncomputable section + +open Cardinal + +namespace ConwayRefinement.Standalone.Hahn + +universe u v + +variable {G : Type u} {R : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module ℚ G] [IsOrderedModule ℚ G] +variable [Field R] + +/-- The cardinal-bounded Hahn integer part +`Z + {x : R((G)) | supp(x) ⊆ G^{<0} and #supp(x) < κ}`. -/ +abbrev hahnIntegerPart (Z : Subring R) (κ : Cardinal.{u}) : Set (HahnSeries G R) := + {x | x.cardSupp < κ ∧ x.support ⊆ Set.Iic 0 ∧ x.coeff 0 ∈ Z} + +/-- The bounded Hahn field is the fraction field of its bounded Hahn integer part. -/ +abbrev IsFractionFieldOfHahnIntegerPart (Z : Subring R) (κ : Cardinal.{u}) : Prop := + ∀ x : HahnSeries G R, x.cardSupp < κ → + ∃ a b : HahnSeries G R, + a ∈ hahnIntegerPart Z κ ∧ b ∈ hahnIntegerPart Z κ ∧ b ≠ 0 ∧ x = a / b + +/-- Condition `(A1)`: every nonzero Archimedean stratum is order additively isomorphic to +`ℝ`. -/ +abbrev AssumptionA1 (s : HahnEmbedding.ArchimedeanStrata ℚ G) : Prop := + ∀ c : FiniteArchimedeanClass G, Nonempty (s.stratum c ≃+o ℝ) + +/-- The coefficient field is generated by fractions of elements of `Z`. -/ +abbrev GeneratesFractionField (Z : Subring R) : Prop := + ∀ x : R, ∃ a b : Z, b ≠ 0 ∧ x = (a : R) / (b : R) + +/-- Condition `(A2)` at every nonzero Archimedean class. The second alternative is the +degenerate case in which the strict inner ball is zero. -/ +abbrev AssumptionA2 (Z : Subring R) (κ : Cardinal.{u}) : Prop := + ∀ c : FiniteArchimedeanClass G, + κ ≤ Order.cof ↑(FiniteArchimedeanClass.ball ℚ c) ∨ + (Subsingleton ↑(FiniteArchimedeanClass.ball ℚ c) ∧ GeneratesFractionField Z) + +/-- Condition `(A3)`: every element of the coefficient ring is primal. -/ +abbrev AssumptionA3 (Z : Subring R) : Prop := + ∀ z a b : Z, z ∣ a * b → + ∃ z₁ z₂ : Z, z₁ ∣ a ∧ z₂ ∣ b ∧ z = z₁ * z₂ + +/-- A nonempty family of nonzero Archimedean classes with no least member in the magnitude +order. -/ +abbrev IsLimitFamily (T : Set (FiniteArchimedeanClass G)) : Prop := + T.Nonempty ∧ ∀ c ∈ T, ∃ d ∈ T, c < d + +/-- The exponents lying beyond every Archimedean class in `T`. -/ +abbrev commonTail (T : Set (FiniteArchimedeanClass G)) : Submodule ℚ G := + FiniteArchimedeanClass.tailSubmodule ℚ T + +/-- An exponent belongs to the common tail exactly when its Archimedean magnitude lies beyond +every class in `T`. -/ +theorem mem_commonTail_iff {T : Set (FiniteArchimedeanClass G)} {x : G} : + x ∈ commonTail T ↔ ∀ c : T, c.1.1 ≤ ArchimedeanClass.mk x := by + rw [FiniteArchimedeanClass.mem_tailSubmodule_iff, + FiniteArchimedeanClass.mem_tailKernel_iff] + +/-- Cauchy completeness and fraction-field equality for common tails of limit families. -/ +structure LimitTailConditions (Z : Subring R) (κ : Cardinal.{u}) : Prop where + cauchy_complete_quotient (T : Set (FiniteArchimedeanClass G)) (hT : IsLimitFamily T) + (hTcard : #T < κ) : + Nonempty (CompleteSpace (G ⧸ commonTail T)) + fraction_field_commonTail (T : Set (FiniteArchimedeanClass G)) + (hT : IsLimitFamily T) (hTcard : #T < κ) : + IsFractionFieldOfHahnIntegerPart (G := commonTail T) Z κ + +/-- **Four-factor refinement from `(A1)`--`(A3)` and the common-tail conditions.** Every equality +`a * b = c * d` in `Z + R((G^{<0}))_κ` has a four-factor refinement. -/ +abbrev HahnIntegerPartRefinementCriterion : Prop := + CharZero R → ∀ (κ : Cardinal.{u}), ℵ₀ < κ → κ.IsRegular → + ∀ (Z : Subring R) (s : HahnEmbedding.ArchimedeanStrata ℚ G), + AssumptionA1 s → AssumptionA2 (G := G) Z κ → AssumptionA3 Z → + LimitTailConditions (G := G) Z κ → + ∀ a b c d : HahnSeries G R, + a ∈ hahnIntegerPart Z κ → b ∈ hahnIntegerPart Z κ → + c ∈ hahnIntegerPart Z κ → d ∈ hahnIntegerPart Z κ → a * b = c * d → + ∃ e f g h : HahnSeries G R, + e ∈ hahnIntegerPart Z κ ∧ f ∈ hahnIntegerPart Z κ ∧ + g ∈ hahnIntegerPart Z κ ∧ h ∈ hahnIntegerPart Z κ ∧ + a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h + +end ConwayRefinement.Standalone.Hahn + +/-! +## Formal proof + +Proof module: `HahnIntegerPartRefinementCriterionProof`. + +* `HahnIntegerPartRefinementCriterion` → `HahnIntegerPartRefinementCriterion.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/HahnIntegerPartRefinementCriterionProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/HahnIntegerPartRefinementCriterionProof.lean new file mode 100644 index 0000000000..d58091d3df --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/HahnIntegerPartRefinementCriterionProof.lean @@ -0,0 +1,28 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterion +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnIntegerPartRefinementProof + +/-! # Hahn Integer Part Refinement Criterion Proof -/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.Hahn.HahnIntegerPartRefinementCriterion + +universe u v + +variable {G : Type u} {R : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module ℚ G] [IsOrderedModule ℚ G] +variable [Field R] + +/-- Conditions `(A1)`--`(A3)` and the common-tail conditions imply four-factor refinement. -/ +theorem proof : HahnIntegerPartRefinementCriterion (G := G) (R := R) := + HahnIntegerPartRefinement.of_assumptions + +end ConwayRefinement.Standalone.Hahn.HahnIntegerPartRefinementCriterion diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/NegativeMonomialRoots.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/NegativeMonomialRoots.lean new file mode 100644 index 0000000000..b8d470f957 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/NegativeMonomialRoots.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCD + +/-! +# Arbitrarily long factorisations of a Hahn monomial + +In the ring `ℚ((ℝ^{≤0}))`, the nonunit monomial `t⁻¹` is the `n`-th power of the nonunit +monomial `t⁻¹⁄ⁿ` for every positive integer `n`. This is a useful boundary example: the GCD and +primality theorems impose no bound on factorisation length. This example by itself makes no +atomicity claim. +-/ + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.Hahn.NegativeMonomialExample + +/-- The Hahn-series ring `ℚ((ℝ^{≤0}))`. -/ +abbrev Ring := Hahn.nonpos ℚ + +/-- The elements of `ℚ((ℝ^{≤0}))` are exactly the Hahn series supported in `(-∞, 0]`. -/ +theorem mem_ring_iff (x : HahnSeries ℝ ℚ) : + x ∈ Ring ↔ x.support ⊆ Set.Iic 0 := (Iff.rfl) + +/-- The monomial `tˣ`, for `x ≤ 0`, as an element of `ℚ((ℝ^{≤0}))`. -/ +def monomial (x : ℝ) (hx : x ≤ 0) : Ring := + ⟨HahnSeries.single x 1, fun y hy ↦ by + rw [HahnSeries.eq_of_mem_support_single hy] + exact hx⟩ + +/-- The monomial `t⁻¹⁄ⁿ`. -/ +def nthRoot (n : ℕ) : Ring := + monomial (-(n : ℝ)⁻¹) (neg_nonpos.mpr (inv_nonneg.mpr (Nat.cast_nonneg n))) + +/-- The monomial `t⁻¹`. -/ +def negativeOne : Ring := monomial (-1) (by norm_num) + +/-- For every `n > 0`, `t⁻¹⁄ⁿ` is a nonunit and `(t⁻¹⁄ⁿ)ⁿ = t⁻¹`. -/ +def NegativeMonomialHasAllRoots : Prop := + ∀ (n : ℕ), 0 < n → ¬ IsUnit (nthRoot n) ∧ nthRoot n ^ n = negativeOne + +end ConwayRefinement.Standalone.Hahn.NegativeMonomialExample + +/-! +## Formal proof + +Proof module: `NegativeMonomialRootsProof`. + +* `NegativeMonomialHasAllRoots` → `NegativeMonomialHasAllRoots.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/NegativeMonomialRootsProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/NegativeMonomialRootsProof.lean new file mode 100644 index 0000000000..cd56678c46 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/NegativeMonomialRootsProof.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRoots + +import Mathlib.Tactic.FieldSimp +import Mathlib.Tactic.Linarith + +/-! # Negative Monomial Roots Proof -/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.Hahn.NegativeMonomialExample + +private theorem eq_zero_of_mem_addAntidiagonal_zero {x y : Ring} {ij : ℝ × ℝ} + (hij : ij ∈ Finset.addAntidiagonal x.1.isPWO_support y.1.isPWO_support 0) : + ij = (0, 0) := by + rcases Finset.mem_addAntidiagonal.mp hij with ⟨hi, hj, hij⟩ + have hi_zero := eq_zero_of_add_nonneg_left (x.2 hi) (y.2 hj) hij.ge + have hj_zero := eq_zero_of_add_nonneg_right (x.2 hi) (y.2 hj) hij.ge + exact Prod.ext hi_zero hj_zero + +private def constantCoeff : Ring →+* ℚ where + toFun x := x.1.coeff 0 + map_one' := by simp + map_zero' := by simp + map_add' x y := by simp + map_mul' x y := by + change (x.1 * y.1).coeff 0 = x.1.coeff 0 * y.1.coeff 0 + rw [HahnSeries.coeff_mul] + by_cases hx : x.1.coeff 0 = 0 + · rw [hx, zero_mul] + apply Finset.sum_eq_zero + intro ij hij + rw [eq_zero_of_mem_addAntidiagonal_zero hij] + simp [hx] + · by_cases hy : y.1.coeff 0 = 0 + · rw [hy, mul_zero] + apply Finset.sum_eq_zero + intro ij hij + rw [eq_zero_of_mem_addAntidiagonal_zero hij] + simp [hy] + · apply Finset.sum_eq_single (0, 0) + · intro ij hij hne + exact (hne (eq_zero_of_mem_addAntidiagonal_zero hij)).elim + · simp [Finset.mem_addAntidiagonal, HahnSeries.mem_support, hx, hy] + +private theorem nthRoot_not_unit (n : ℕ) (hn : 0 < n) : ¬ IsUnit (nthRoot n) := by + intro h + have hu := h.map constantCoeff + have hz : constantCoeff (nthRoot n) = 0 := by + change ((HahnSeries.single (-(n : ℝ)⁻¹)) 1).coeff 0 = 0 + rw [HahnSeries.coeff_single_of_ne] + exact fun hzero ↦ by + have : (n : ℝ)⁻¹ = 0 := by linarith + exact inv_ne_zero (Nat.cast_ne_zero.mpr (Nat.ne_of_gt hn)) this + rw [hz] at hu + exact not_isUnit_zero hu + +private theorem nthRoot_pow (n : ℕ) (hn : 0 < n) : + nthRoot n ^ n = negativeOne := by + apply Subtype.ext + simp [nthRoot, negativeOne, monomial, HahnSeries.single_pow] + field_simp + +namespace NegativeMonomialHasAllRoots + +/-- The exponent identity `n(-1/n) = -1` gives the factorisation; the zero coefficient shows +that each factor is a nonunit. -/ +theorem proof : NegativeMonomialExample.NegativeMonomialHasAllRoots := by + intro n hn + exact ⟨nthRoot_not_unit n hn, nthRoot_pow n hn⟩ + +end NegativeMonomialHasAllRoots + +end ConwayRefinement.Standalone.Hahn.NegativeMonomialExample diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/GermPolynomialRing.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/GermPolynomialRing.lean new file mode 100644 index 0000000000..6c6528d47f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/GermPolynomialRing.lean @@ -0,0 +1,104 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.MvPolynomial.Equiv +public import Mathlib.Data.Real.Basic +public import Mathlib.RingTheory.HahnSeries.Multiplication +public import Mathlib.RingTheory.Ideal.Quotient.Operations +public import Mathlib.RingTheory.Ideal.Span +public import Mathlib.RingTheory.UniqueFactorizationDomain.Defs + +/-! +# The ring of germs is a polynomial ring + +Let `J` be the ideal of `K((ℝ^{≤0}))` generated by the monomials `t^x`, `x < 0`. +The quotient `K((ℝ^{≤0}))/J` is Berarducci's ring of germs. In characteristic zero it is +isomorphic as a ring to a polynomial ring with coefficient field `K`; in particular it has +unique factorisation. + +The polynomial presentation proves Berarducci's factorisation conjecture as stated in +[LM17, Conjecture 1.5]. + +## References + +* A. Berarducci, *Factorization in generalized power series*, Trans. Amer. Math. Soc. 352 (2000), + 553–577, cited as [Ber00]. +* S. L'Innocente, V. Mantova, *Factorisation of germ-like series*, J. Log. Anal. 9 (2017), cited + as [LM17]. +-/ + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.GermPolynomial + +universe u + +variable {K : Type u} [Field K] + +/-- The Hahn-series ring `K((ℝ^{≤0}))`. -/ +def nonpos (K : Type u) [Field K] : Subring (HahnSeries ℝ K) where + carrier := {x | x.support ⊆ Set.Iic 0} + zero_mem' := by simp + one_mem' := by + intro g hg + have hg0 : g = 0 := HahnSeries.support_single_subset hg + simp [hg0] + add_mem' := fun {x y} hx hy => by + intro g hg + rcases HahnSeries.support_add_subset x y hg with hg | hg + · exact hx hg + · exact hy hg + neg_mem' := fun {x} hx => (HahnSeries.support_neg_subset x).trans hx + mul_mem' := fun {x y} hx hy => by + intro g hg + obtain ⟨i, hi, j, hj, rfl⟩ := HahnSeries.support_mul_subset hg + exact add_nonpos (show i ≤ 0 from hx hi) (show j ≤ 0 from hy hj) + +/-- The elements of `K((ℝ^{≤0}))` are exactly the Hahn series supported in `(-∞, 0]`. -/ +theorem mem_nonpos_iff (x : HahnSeries ℝ K) : + x ∈ nonpos K ↔ x.support ⊆ Set.Iic 0 := (Iff.rfl) + +variable (K) in +/-- Berarducci's ideal `J`: the ideal of `K((ℝ^{≤0}))` generated by the monomials `t^x`, `x < 0`. -/ +def J : Ideal (nonpos K) := + Ideal.span {m : nonpos K | + ∃ x : ℝ, x < 0 ∧ (m : HahnSeries ℝ K) = HahnSeries.single x 1} + +variable (K) in +/-- Berarducci's ring of germs `K((ℝ^{≤0}))/J`. -/ +abbrev Germ := nonpos K ⧸ J K + +variable (K) in +/-- **Polynomial presentation of the ring of germs.** For some set `ι`, the ring +`K((ℝ^{≤0}))/J` is ring-isomorphic to `K[X_i : i ∈ ι]`. -/ +abbrev GermIsPolynomialRing : Prop := + CharZero K → ∃ ι : Type (max u 1), Nonempty (MvPolynomial ι K ≃+* Germ K) + +variable (K) in +/-- **Unique factorisation in the ring of germs** [LM17, Conjecture 1.5]: the ring of germs is a +domain; every nonzero germ is, up to a unit, a product of irreducible germs; and two products of +irreducible germs that agree up to a unit have the same factors up to order and associates. + +The conclusion is asserted in characteristic zero. -/ +abbrev GermHasUniqueFactorization : Prop := + CharZero K → + IsDomain (Germ K) ∧ + (∀ a : Germ K, a ≠ 0 → + ∃ f : Multiset (Germ K), (∀ b ∈ f, Irreducible b) ∧ Associated f.prod a) ∧ + ∀ f g : Multiset (Germ K), (∀ b ∈ f, Irreducible b) → (∀ b ∈ g, Irreducible b) → + Associated f.prod g.prod → Multiset.Rel Associated f g + +end ConwayRefinement.Standalone.GermPolynomial + +/-! +## Formal proof + +Proof module: `GermPolynomialRingProof`. + +* `GermIsPolynomialRing` → `GermIsPolynomialRing.proof` +* `GermHasUniqueFactorization` → `GermHasUniqueFactorization.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/GermPolynomialRingProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/GermPolynomialRingProof.lean new file mode 100644 index 0000000000..3dee10d524 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/GermPolynomialRingProof.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRing +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.GermPolynomialRingProof + +/-! # Germ Polynomial Ring Proof -/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.GermPolynomial + +universe u + +namespace GermIsPolynomialRing + +/-- The ring of germs is a polynomial ring over its coefficient field. -/ +theorem proof (K : Type u) [Field K] : GermIsPolynomialRing K := by + exact of_polynomiality K + +end GermIsPolynomialRing + +namespace GermHasUniqueFactorization + +/-- Every nonzero germ factors uniquely into irreducibles, up to order and association. -/ +theorem proof (K : Type u) [Field K] : GermHasUniqueFactorization K := by + exact of_polynomiality K + +end GermHasUniqueFactorization + +end ConwayRefinement.Standalone.GermPolynomial diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnIntegerPartRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnIntegerPartRefinement.lean new file mode 100644 index 0000000000..a5a38541b1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnIntegerPartRefinement.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.Order.Module.HahnEmbedding +public import Mathlib.RingTheory.HahnSeries.Cardinal +public import Mathlib.SetTheory.Cardinal.Regular + +/-! +# Refinement over saturated exponent groups + +An uncountably saturated ordered rational vector space gives four-factor refinement in the +cardinal-bounded generalised-power-series integer part with integer constant coefficients. +-/ + +public noncomputable section + +open Cardinal + +namespace ConwayRefinement.Standalone.Hahn + +universe u v + +variable {G : Type u} {R : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Field R] + +/-- The cardinal-bounded integer part +`ℤ + {x : R((G)) | supp(x) ⊆ G^{<0} and #supp(x) < κ}`. -/ +abbrev integerHahnPart (κ : Cardinal.{u}) : Set (HahnSeries G R) := + {x | x.cardSupp < κ ∧ x.support ⊆ Set.Iic 0 ∧ ∃ z : ℤ, (z : R) = x.coeff 0} + +/-- The ordered set `G` is `κ`-saturated. -/ +abbrev IsKappaSaturated (κ : Cardinal.{u}) : Prop := + ∀ L R : Set G, #L < κ → #R < κ → + (∀ l ∈ L, ∀ r ∈ R, l < r) → + ∃ x : G, (∀ l ∈ L, l < x) ∧ ∀ r ∈ R, x < r + +/-- **Four-factor refinement over a saturated exponent group.** Let `κ` be regular and +uncountable, let `G` be a `κ`-saturated ordered rational vector space, and let `R` be a field of +characteristic zero. Every equality `a * b = c * d` in +`ℤ + R((G^{<0}))_κ` has four-factor refinement. -/ +abbrev HahnIntegerPartRefinement + [Module ℚ G] [IsOrderedModule ℚ G] [CharZero R] : Prop := + ∀ (κ : Cardinal.{u}), ℵ₀ < κ → κ.IsRegular → IsKappaSaturated (G := G) κ → + ∀ a b c d : HahnSeries G R, + a ∈ integerHahnPart κ → b ∈ integerHahnPart κ → + c ∈ integerHahnPart κ → d ∈ integerHahnPart κ → a * b = c * d → + ∃ e f g h : HahnSeries G R, + e ∈ integerHahnPart κ ∧ f ∈ integerHahnPart κ ∧ + g ∈ integerHahnPart κ ∧ h ∈ integerHahnPart κ ∧ + a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h + +end ConwayRefinement.Standalone.Hahn + +/-! +## Formal proof + +Proof module: `HahnIntegerPartRefinementProof`. + +* `HahnIntegerPartRefinement` → `HahnIntegerPartRefinement.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnIntegerPartRefinementProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnIntegerPartRefinementProof.lean new file mode 100644 index 0000000000..2fc5afb218 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnIntegerPartRefinementProof.lean @@ -0,0 +1,27 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnIntegerPartRefinementProof + +/-! # Hahn Integer Part Refinement Proof -/ +public noncomputable section + +namespace ConwayRefinement.Standalone.Hahn.HahnIntegerPartRefinement + +universe u v + +variable {G : Type u} {R : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Field R] +variable [Module ℚ G] [IsOrderedModule ℚ G] [CharZero R] + +/-- Refinement for Hahn series with integer constant coefficient. -/ +theorem proof : HahnIntegerPartRefinement (G := G) (R := R) := + of_saturation_integer_coefficients + +end ConwayRefinement.Standalone.Hahn.HahnIntegerPartRefinement diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesGCD.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesGCD.lean new file mode 100644 index 0000000000..f06cd40b4e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesGCD.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.Divisibility.Basic +public import Mathlib.Data.Real.Basic +public import Mathlib.RingTheory.HahnSeries.Multiplication + +/-! +# Greatest common divisors and factorisation in `K((ℝ^{≤0}))` + +`nonpos K` is the Hahn-series ring `K((ℝ^{≤0}))`. In characteristic zero it is a GCD domain and +pre-Schreier. Consequently every irreducible series is prime, and any two irreducible +factorisations are the same up to order and units. LM24, Corollary 6.4.2 proves that these two +ring properties are equivalent to every irreducible series with infinite support being prime; +the theorems below establish the properties themselves. + +## References + +* S. L'Innocente, V. Mantova, *A factorisation theory for generalised power series and omnific + integers*, Adv. Math. 442 (2024) 109513, , cited + as [LM24]. +-/ + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.Hahn + +universe u + +variable (K : Type u) [Field K] + +/-- `K((ℝ^{≤0}))`: Hahn series with real exponents `≤ 0` [LM24, §1.2]. -/ +def nonpos : Subring (HahnSeries ℝ K) where + carrier := {x | x.support ⊆ Set.Iic 0} + zero_mem' := by simp + one_mem' := fun _ hg ↦ (HahnSeries.support_single_subset hg).le + add_mem' := fun hx hy ↦ + (HahnSeries.support_add_subset _ _).trans (Set.union_subset hx hy) + neg_mem' := fun hx ↦ (HahnSeries.support_neg_subset _).trans hx + mul_mem' := fun hx hy ↦ HahnSeries.support_mul_subset.trans fun _ ⟨i, hi, j, hj, h⟩ ↦ + h ▸ show i + j ≤ 0 from add_nonpos (hx hi) (hy hj) + +/-- Every pair of series in `K((ℝ^{≤0}))` has a greatest common divisor. -/ +abbrev SeriesHasGCDs : Prop := + CharZero K → + ∀ a b : nonpos K, ∃ d : nonpos K, ∀ e : nonpos K, e ∣ a ∧ e ∣ b ↔ e ∣ d + +/-- Every series in `K((ℝ^{≤0}))` is primal, in the sense of LM24, §2.5. -/ +abbrev SeriesIsPrimal : Prop := + CharZero K → ∀ a : nonpos K, IsPrimal a + +/-- Every irreducible series in `K((ℝ^{≤0}))` is prime. -/ +abbrev SeriesIrreduciblesArePrime : Prop := + CharZero K → ∀ a : nonpos K, Irreducible a → Prime a + +/-- Two products of irreducibles that agree up to a unit have the same factors up to order and +association. -/ +abbrev SeriesFactorizationsAreUnique : Prop := + CharZero K → + ∀ f g : Multiset (nonpos K), (∀ x ∈ f, Irreducible x) → (∀ x ∈ g, Irreducible x) → + Associated f.prod g.prod → Multiset.Rel Associated f g + +end ConwayRefinement.Standalone.Hahn + +/-! +## Formal proof + +Proof module: `HahnSeriesGCDProof`. + +* `SeriesHasGCDs` → `SeriesHasGCDs.proof` +* `SeriesIsPrimal` → `SeriesIsPrimal.proof` +* `SeriesIrreduciblesArePrime` → `SeriesIrreduciblesArePrime.proof` +* `SeriesFactorizationsAreUnique` → `SeriesFactorizationsAreUnique.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesGCDProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesGCDProof.lean new file mode 100644 index 0000000000..79d3422525 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesGCDProof.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCD +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesGCDProof + +/-! # Hahn Series GCDProof -/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.Hahn + +universe u + +namespace SeriesHasGCDs + +/-- Every pair of series in `K((ℝ^{≤0}))` has a greatest common divisor. -/ +theorem proof (K : Type u) [Field K] : SeriesHasGCDs K := by + exact of_polynomiality K + +end SeriesHasGCDs + +namespace SeriesIsPrimal + +/-- Every series in `K((ℝ^{≤0}))` is primal. -/ +theorem proof (K : Type u) [Field K] : SeriesIsPrimal K := by + exact of_gcds K + +end SeriesIsPrimal + +namespace SeriesIrreduciblesArePrime + +/-- Every irreducible series is prime. -/ +theorem proof (K : Type u) [Field K] : SeriesIrreduciblesArePrime K := by + exact of_primality K + +end SeriesIrreduciblesArePrime + +namespace SeriesFactorizationsAreUnique + +/-- Irreducible factorisations are unique up to order and units. -/ +theorem proof (K : Type u) [Field K] : SeriesFactorizationsAreUnique K := by + exact of_primality K + +end SeriesFactorizationsAreUnique + +end ConwayRefinement.Standalone.Hahn diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesPolynomialRing.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesPolynomialRing.lean new file mode 100644 index 0000000000..bb518e8e16 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesPolynomialRing.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.MvPolynomial.Equiv +public import Mathlib.Data.Real.Basic +public import Mathlib.RingTheory.HahnSeries.Cardinal + +/-! +# The Hahn-series ring is a polynomial ring + +Let `K_fin` be the subring of `K((ℝ^{≤0}))` consisting of the series with finite support. In +characteristic zero there is a set of indeterminates `ι` for which + +`K_fin[X_i : i ∈ ι] ≅ K((ℝ^{≤0}))`. + +Both rings are defined below in ordinary Mathlib language; the statement does not mention the +principal graded ring or a chosen generating system. +-/ + +open Cardinal + +@[expose] public noncomputable section + +namespace ConwayRefinement.Standalone.HahnPolynomial + +universe u + +variable (K : Type u) [Field K] + +/-- The Hahn-series ring `K((ℝ^{≤0}))`. -/ +def Series : Subring (HahnSeries ℝ K) where + carrier := {x | x.support ⊆ Set.Iic 0} + zero_mem' := by simp + one_mem' := fun _ hg ↦ (HahnSeries.support_single_subset hg).le + add_mem' := fun hx hy ↦ + (HahnSeries.support_add_subset _ _).trans (Set.union_subset hx hy) + neg_mem' := fun hx ↦ (HahnSeries.support_neg_subset _).trans hx + mul_mem' := fun hx hy ↦ HahnSeries.support_mul_subset.trans fun _ ⟨i, hi, j, hj, h⟩ ↦ + h ▸ show i + j ≤ 0 from add_nonpos (hx hi) (hy hj) + +/-- The elements of `K((ℝ^{≤0}))` are exactly the Hahn series supported in `(-∞, 0]`. -/ +theorem mem_series_iff (x : HahnSeries ℝ K) : + x ∈ Series K ↔ x.support ⊆ Set.Iic 0 := (Iff.rfl) + +/-- The subring `K_fin` of nonpositive Hahn series with finite support. -/ +def FiniteSupport : Subring (Series K) := + let _ : Fact (aleph0 ≤ aleph0) := ⟨le_rfl⟩ + (HahnSeries.cardSuppLTSubring ℝ K aleph0).comap (Series K).subtype + +/-- Membership in `K_fin` is exactly finiteness of the Hahn-series support. -/ +theorem mem_finiteSupport_iff (x : Series K) : + x ∈ FiniteSupport K ↔ x.1.support.Finite := by + letI : Fact (aleph0 ≤ aleph0) := ⟨le_rfl⟩ + rw [FiniteSupport, Subring.mem_comap, HahnSeries.mem_cardSuppLTSubring, + HahnSeries.cardSupp] + exact Cardinal.lt_aleph0_iff_set_finite + +/-- **Polynomial presentation of the full series ring.** For some set `ι`, the polynomial algebra +over the finite-support series is isomorphic to the full nonpositive Hahn-series ring. -/ +abbrev IsPolynomialRing : Prop := + CharZero K → ∃ ι : Type (max u 1), + Nonempty (MvPolynomial ι (FiniteSupport K) ≃ₐ[FiniteSupport K] Series K) + +end ConwayRefinement.Standalone.HahnPolynomial + +/-! +## Formal proof + +Proof module: `HahnSeriesPolynomialRingProof`. + +* `IsPolynomialRing` → `IsPolynomialRing.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesPolynomialRingProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesPolynomialRingProof.lean new file mode 100644 index 0000000000..2e8b978e69 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesPolynomialRingProof.lean @@ -0,0 +1,24 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRing +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesPolynomialRingProof + +/-! # Hahn Series Polynomial Ring Proof -/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.HahnPolynomial.IsPolynomialRing + +universe u + +/-- The nonpositive Hahn-series ring is a polynomial ring over its finite-support subring. -/ +theorem proof (K : Type u) [Field K] : + ConwayRefinement.Standalone.HahnPolynomial.IsPolynomialRing K := by + exact of_polynomiality K + +end ConwayRefinement.Standalone.HahnPolynomial.IsPolynomialRing diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/InlineConwayRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/InlineConwayRefinement.lean new file mode 100644 index 0000000000..5c87a50049 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/InlineConwayRefinement.lean @@ -0,0 +1,269 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Copyright (c) 2025 Aaron Liu. All rights reserved. +Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. +Copyright (c) 2025 Yuyang Zhao. All rights reserved. +Copyright (c) 2024 Theodore Hwa. All rights reserved. +Copyright (c) 2019 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov, Aaron Liu, Apurva Nakade, Fox Thomson, František Silváši, +Isabel Longbottom, Junyan Xu, Kim Morrison, Mario Carneiro, Reid Barton, Theodore Hwa, +Violeta Hernández Palacios, Yuyang Zhao +-/ +/- +Adapted and modified from the Apache-2.0-licensed CombinatorialGames construction: +https://github.com/vihdzp/combinatorial-games +-/ +module + +public import Mathlib.Order.GameAdd + +/-! +# Conway's refinement conjecture from first principles + +This file gives, in order, the complete definitions needed to read Conway's refinement conjecture: + +1. a well-founded game with small left and right option families; +2. Conway recursion for negation, addition, multiplication, and order; +3. numeric games and equality of games; +4. surreal-number representatives and Conway's omnific-integer cut; +5. Conway's eight-variable refinement statement. + +Surreals are presented by numeric games. `Game.Equivalent` is equality in their quotient, so the +four displayed product equations below are exactly the corresponding quotient equations. +`InlineConwayRefinementProof` proves that the recursive operations preserve numericity and +equivalence and then proves the final proposition. +-/ + +public noncomputable section + +universe u + +namespace ConwayRefinement.Standalone.InlineConwayRefinement + +/-- A well-founded Conway game, built from small left and right option families. -/ +inductive Game : Type (u + 1) where + | mk (Left Right : Type u) (left : Left → Game) (right : Right → Game) + +namespace Game + +/-- A direct move selects either a left or a right option. -/ +inductive Move : Game → Game → Prop + | left {Left Right : Type u} {left : Left → Game} {right : Right → Game} + (i : Left) : Move (left i) (.mk Left Right left right) + | right {Left Right : Type u} {left : Left → Game} {right : Right → Game} + (i : Right) : Move (right i) (.mk Left Right left right) + +/-- Direct descent through options is well founded. -/ +theorem move_wf : WellFounded Move := by + constructor + intro x + induction x with + | mk Left Right left right ihLeft ihRight => + constructor + intro y hy + cases hy with + | left i => exact ihLeft i + | right i => exact ihRight i + +/-- Well-founded recursion on an ordered pair of games. -/ +noncomputable def pairRec {C : Game → Game → Sort*} + (step : ∀ x y, + (∀ x' y', Prod.Lex Move Move (x', y') (x, y) → C x' y') → C x y) + (x y : Game) : C x y := + @WellFounded.fix (Game × Game) (fun p ↦ C p.1 p.2) _ (move_wf.prod_lex move_wf) + (fun p rec ↦ step p.1 p.2 (fun x' y' h ↦ rec (x', y') h)) (x, y) + +/-- The characteristic equation for recursion on a pair of games. -/ +theorem pairRec_eq {C : Game → Game → Sort*} + (step : ∀ x y, + (∀ x' y', Prod.Lex Move Move (x', y') (x, y) → C x' y') → C x y) + (x y : Game) : + pairRec step x y = step x y fun x' y' _ ↦ pairRec step x' y' := + WellFounded.fix_eq .. + +/-- Negation interchanges the players and negates every option. -/ +@[expose] def neg : Game → Game + | .mk Left Right left right => + .mk Right Left (fun i ↦ neg (right i)) (fun i ↦ neg (left i)) + +/-- The defining option equation for negation. -/ +theorem neg_mk (Left Right : Type u) (left : Left → Game) (right : Right → Game) : + neg (.mk Left Right left right) = + .mk Right Left (fun i ↦ neg (right i)) (fun i ↦ neg (left i)) := + (rfl) + +/-- Conway addition: either player moves in exactly one summand. -/ +@[expose] noncomputable def add : Game → Game → Game := + pairRec fun x y rec ↦ + match x, y with + | .mk Lx Rx lx rx, .mk Ly Ry ly ry => + let x := Game.mk Lx Rx lx rx + let y := Game.mk Ly Ry ly ry + .mk (Lx ⊕ Ly) (Rx ⊕ Ry) + (Sum.elim + (fun i ↦ rec (lx i) y (Prod.Lex.left y y (Move.left i))) + (fun j ↦ rec x (ly j) (Prod.Lex.right x (Move.left j)))) + (Sum.elim + (fun i ↦ rec (rx i) y (Prod.Lex.left y y (Move.right i))) + (fun j ↦ rec x (ry j) (Prod.Lex.right x (Move.right j)))) + +/-- The defining option equation for Conway addition. -/ +theorem add_mk (Lx Rx Ly Ry : Type u) (lx : Lx → Game) (rx : Rx → Game) + (ly : Ly → Game) (ry : Ry → Game) : + add (.mk Lx Rx lx rx) (.mk Ly Ry ly ry) = + .mk (Lx ⊕ Ly) (Rx ⊕ Ry) + (Sum.elim (fun i ↦ add (lx i) (.mk Ly Ry ly ry)) + (fun j ↦ add (.mk Lx Rx lx rx) (ly j))) + (Sum.elim (fun i ↦ add (rx i) (.mk Ly Ry ly ry)) + (fun j ↦ add (.mk Lx Rx lx rx) (ry j))) := by + rw [add, pairRec_eq] + +/-- The zero game `{ | }`. -/ +@[expose] def zero : Game.{u} := .mk (ULift.{u} Empty) (ULift.{u} Empty) nofun nofun + +/-- The zero game has no options. -/ +theorem zero_eq : zero = + .mk (ULift.{u} Empty) (ULift.{u} Empty) nofun nofun := (rfl) + +/-- The unit game `{0 | }`. -/ +@[expose] def one : Game.{u} := + .mk PUnit.{u + 1} (ULift.{u} Empty) (fun _ ↦ zero) nofun + +/-- The unit game has zero as its sole left option. -/ +theorem one_eq : one = + .mk PUnit.{u + 1} (ULift.{u} Empty) (fun _ ↦ zero) nofun := (rfl) + +/-- Conway multiplication. Its option from options `a` of `x` and `b` of `y` is +`a * y + x * b - a * b`; equal-side moves are left options and opposite-side moves are right +options. -/ +@[expose] noncomputable def mul : Game → Game → Game := + pairRec fun x y rec ↦ + match x, y with + | .mk Lx Rx lx rx, .mk Ly Ry ly ry => + let x := Game.mk Lx Rx lx rx + let y := Game.mk Ly Ry ly ry + let option (a b : Game) (ha : Move a x) (hb : Move b y) := + add (add (rec a y (Prod.Lex.left y y ha)) + (rec x b (Prod.Lex.right x hb))) + (neg (rec a b (Prod.Lex.left b y ha))) + .mk ((Lx × Ly) ⊕ (Rx × Ry)) ((Lx × Ry) ⊕ (Rx × Ly)) + (Sum.elim + (fun ij ↦ option (lx ij.1) (ly ij.2) (Move.left ij.1) (Move.left ij.2)) + (fun ij ↦ option (rx ij.1) (ry ij.2) (Move.right ij.1) (Move.right ij.2))) + (Sum.elim + (fun ij ↦ option (lx ij.1) (ry ij.2) (Move.left ij.1) (Move.right ij.2)) + (fun ij ↦ option (rx ij.1) (ly ij.2) (Move.right ij.1) (Move.left ij.2))) + +/-- The defining option equation for Conway multiplication. -/ +theorem mul_mk (Lx Rx Ly Ry : Type u) (lx : Lx → Game) (rx : Rx → Game) + (ly : Ly → Game) (ry : Ry → Game) : + mul (.mk Lx Rx lx rx) (.mk Ly Ry ly ry) = + let x := Game.mk Lx Rx lx rx + let y := Game.mk Ly Ry ly ry + let option (a b : Game) := add (add (mul a y) (mul x b)) (neg (mul a b)) + .mk ((Lx × Ly) ⊕ (Rx × Ry)) ((Lx × Ry) ⊕ (Rx × Ly)) + (Sum.elim (fun ij ↦ option (lx ij.1) (ly ij.2)) + (fun ij ↦ option (rx ij.1) (ry ij.2))) + (Sum.elim (fun ij ↦ option (lx ij.1) (ry ij.2)) + (fun ij ↦ option (rx ij.1) (ly ij.2))) := by + rw [mul, pairRec_eq] + +/-- Conway's recursive order: `x ≤ y` when no left option of `x` is at least `y`, and no right +option of `y` is at most `x`. -/ +@[expose] noncomputable def Le : Game → Game → Prop := + Sym2.GameAdd.recursion move_wf fun x y rec ↦ + match x, y with + | .mk Lx Rx lx rx, .mk Ly Ry ly ry => + let x := Game.mk Lx Rx lx rx + let y := Game.mk Ly Ry ly ry + (∀ i : Lx, ¬rec y (lx i) (Sym2.GameAdd.snd_fst (Move.left i))) ∧ + (∀ j : Ry, ¬rec (ry j) x (Sym2.GameAdd.fst_snd (Move.right j))) + +/-- The defining option equation for Conway's order. -/ +theorem le_mk (Lx Rx Ly Ry : Type u) (lx : Lx → Game) (rx : Rx → Game) + (ly : Ly → Game) (ry : Ry → Game) : + Le (.mk Lx Rx lx rx) (.mk Ly Ry ly ry) ↔ + (∀ i, ¬Le (.mk Ly Ry ly ry) (lx i)) ∧ + (∀ j, ¬Le (ry j) (.mk Lx Rx lx rx)) := by + exact propext_iff.1 <| Sym2.GameAdd.recursion_eq .. + +/-- Conway equivalence, the equality relation on games. -/ +def Equivalent (x y : Game) : Prop := Le x y ∧ Le y x + +/-- Conway equivalence unfolds to the two order inequalities. -/ +theorem equivalent_iff (x y : Game) : Equivalent x y ↔ Le x y ∧ Le y x := (Iff.rfl) + +/-- Conway's strict order on numeric games. -/ +def Less (x y : Game) : Prop := Le x y ∧ ¬Le y x + +/-- Conway's strict order unfolds to an inequality and failure of its reverse. -/ +theorem less_iff (x y : Game) : Less x y ↔ Le x y ∧ ¬Le y x := (Iff.rfl) + +/-- A game is numeric when all its options are numeric and every left option is strictly below +every right option. -/ +inductive Numeric : Game → Prop where + | mk {Left Right : Type u} {left : Left → Game} {right : Right → Game} : + (∀ i j, Less (left i) (right j)) → + (∀ i, Numeric (left i)) → + (∀ j, Numeric (right j)) → + Numeric (.mk Left Right left right) + +end Game + +/-- A surreal-number representative is a numeric well-founded Conway game. Two representatives +denote the same surreal number precisely when their games are `Game.Equivalent`. -/ +structure Surreal : Type (u + 1) where + game : Game.{u} + numeric : Game.Numeric game + +namespace Surreal + +/-- The singleton Conway cut `{x - 1 | x + 1}` at game level. -/ +noncomputable def singletonIntegerCut (x : Game.{u}) : Game.{u} := + .mk PUnit PUnit (fun _ ↦ Game.add x (Game.neg Game.one)) + (fun _ ↦ Game.add x Game.one) + +/-- The singleton-cut construction unfolds to its two displayed options. -/ +theorem singletonIntegerCut_eq (x : Game.{u}) : + singletonIntegerCut x = + .mk PUnit PUnit (fun _ ↦ Game.add x (Game.neg Game.one)) + (fun _ ↦ Game.add x Game.one) := (rfl) + +/-- Conway's cut equation defining an omnific integer. -/ +def IsConwayOmnificInteger (x : Surreal.{u}) : Prop := + Game.Equivalent x.game (singletonIntegerCut x.game) + +/-- Membership unfolds to Conway's defining cut equation. -/ +theorem isConwayOmnificInteger_iff (x : Surreal.{u}) : + IsConwayOmnificInteger x ↔ Game.Equivalent x.game (singletonIntegerCut x.game) := + (Iff.rfl) + +/-- Conway's four-factor statement. Every equation `a * b = c * d` of omnific integers has +omnific integers `e`, `f`, `g`, `h` with +`a = e * f`, `b = g * h`, `c = e * g`, and `d = f * h`. All equations are equality in the +quotient of numeric games, written directly as `Game.Equivalent`. -/ +abbrev ConwayConjecture : Prop := + ∀ a b c d : Surreal.{u}, + IsConwayOmnificInteger a → IsConwayOmnificInteger b → + IsConwayOmnificInteger c → IsConwayOmnificInteger d → + Game.Equivalent (Game.mul a.game b.game) (Game.mul c.game d.game) → + ∃ e f g h : Surreal.{u}, + IsConwayOmnificInteger e ∧ IsConwayOmnificInteger f ∧ + IsConwayOmnificInteger g ∧ IsConwayOmnificInteger h ∧ + Game.Equivalent a.game (Game.mul e.game f.game) ∧ + Game.Equivalent b.game (Game.mul g.game h.game) ∧ + Game.Equivalent c.game (Game.mul e.game g.game) ∧ + Game.Equivalent d.game (Game.mul f.game h.game) + +end Surreal + +end ConwayRefinement.Standalone.InlineConwayRefinement + +/-! +## Formal proof + +Proof module: `InlineConwayRefinementProof`. + +* `ConwayConjecture` → `ConwayConjecture.proof` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/InlineConwayRefinementProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/InlineConwayRefinementProof.lean new file mode 100644 index 0000000000..67d568d98c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/InlineConwayRefinementProof.lean @@ -0,0 +1,22 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineConwayRefinementProof + +/-! # Inline Conway Refinement Proof -/ +public noncomputable section + +universe u + +namespace ConwayRefinement.Standalone.InlineConwayRefinement.Surreal.ConwayConjecture + +/-- Conway's refinement theorem for the fully displayed Mathlib construction of surreal numbers. -/ +theorem proof : ConwayConjecture.{u} := + ConwayRefinement.Standalone.InlineConwayRefinement.Surreal.conwayRefinementProof + +end ConwayRefinement.Standalone.InlineConwayRefinement.Surreal.ConwayConjecture diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support.lean new file mode 100644 index 0000000000..86d1250de6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support.lean @@ -0,0 +1,23 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ArchimedeanQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.CompleteHahnGermProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotientSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.GermPolynomialRingProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnIntegerPartRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnLimitTailQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesPolynomialRingProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineConwayRefinementProof +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineSurreal +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.OrderedAddGroup +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.SeriesConsequences + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ArchimedeanQuotient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ArchimedeanQuotient.lean new file mode 100644 index 0000000000..c159451165 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ArchimedeanQuotient.lean @@ -0,0 +1,267 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotient +public import Mathlib.Algebra.Group.Subgroup.Lattice +public import Mathlib.Algebra.Order.Archimedean.Class + +/-! +# Archimedean classes in subgroups and limit quotients + +A positively coinitial subgroup of an ordered abelian group inherits the absence of a largest +finite Archimedean class from the ambient group. The ambient hypothesis is essential: positive +coinitiality alone does not create new Archimedean classes. + +There is a separate construction suited to a limit family of classes. For a set `T` of finite +Archimedean classes, `FiniteArchimedeanClass.tailKernel T` is the intersection of their closed +Archimedean balls. If every member of `T` has a strictly later member, the quotient by this convex +subgroup has no largest finite Archimedean class. This is the quotient used at a limit of support +support classes. +-/ + +open Set + +universe u + +public noncomputable section + +namespace ConwayRefinement.Standalone.Hahn + +namespace AddSubgroup + +variable {C : Type u} [AddCommGroup C] [LinearOrder C] [IsOrderedAddMonoid C] + +/-- An additive subgroup of an ordered abelian group inherits the ordered-additive structure. -/ +instance instIsOrderedAddMonoid (S : AddSubgroup C) : IsOrderedAddMonoid S where + add_le_add_left a b h z := + show (a : C) + (z : C) ≤ (b : C) + (z : C) from by + simpa [add_comm] using + add_le_add_left (show (a : C) ≤ (b : C) from h) (z : C) + +/-- A positively coinitial subgroup inherits the absence of a largest finite Archimedean class +from its ambient ordered group. -/ +theorem finiteArchimedeanClass_noMax_of_pos_coinitial + [NoMaxOrder (FiniteArchimedeanClass C)] (S : AddSubgroup C) + (hS : ∀ y : C, 0 < y → ∃ x : S, 0 < (x : C) ∧ (x : C) ≤ y) : + NoMaxOrder (FiniteArchimedeanClass S) := by + constructor + intro c + induction c using FiniteArchimedeanClass.ind with + | mk x hx => + obtain ⟨d, hxd⟩ := exists_gt + (FiniteArchimedeanClass.mk (x : C) (Subtype.coe_ne_coe.mpr hx)) + induction d using FiniteArchimedeanClass.ind with + | mk y hy => + obtain ⟨z, hzpos, hzy⟩ := hS |y| (abs_pos.mpr hy) + have hz0 : z ≠ 0 := fun hz ↦ hzpos.ne' (Subtype.ext_iff.mp hz) + refine ⟨FiniteArchimedeanClass.mk z hz0, ?_⟩ + let e : S →+o C := + { toFun := fun z ↦ (z : C) + map_zero' := rfl + map_add' := fun _ _ ↦ rfl + monotone' := fun _ _ h ↦ h } + change ArchimedeanClass.mk (e x) < ArchimedeanClass.mk (e z) + rw [← ArchimedeanClass.orderHom_mk e x, ← ArchimedeanClass.orderHom_mk e z] + apply ((ArchimedeanClass.orderHom e).monotone.strictMono_of_injective + (ArchimedeanClass.orderHom_injective Subtype.val_injective)).lt_iff_lt.mpr + change ArchimedeanClass.mk (x : C) < ArchimedeanClass.mk (z : C) + change ArchimedeanClass.mk (x : C) < ArchimedeanClass.mk y at hxd + refine hxd.trans_le ?_ + apply ArchimedeanClass.mk_le_mk_of_abs + simpa [abs_of_pos hzpos] using hzy + +end AddSubgroup + +namespace FiniteArchimedeanClass + +variable {G : Type u} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + +/-- The elements lying in the closed ball of every class in `T`. -/ +def tailKernel (T : Set (FiniteArchimedeanClass G)) : AddSubgroup G := + ⨅ c : T, ArchimedeanClass.closedBallAddSubgroup c.1.1 + +/-- Membership in the tail kernel means having class at least every class in `T`. -/ +theorem mem_tailKernel_iff {T : Set (FiniteArchimedeanClass G)} {x : G} : + x ∈ tailKernel T ↔ ∀ c : T, c.1.1 ≤ ArchimedeanClass.mk x := by + rw [tailKernel, AddSubgroup.mem_iInf] + exact forall_congr' fun c ↦ ArchimedeanClass.mem_closedBallAddSubgroup_iff + +/-- The common tail kernel of a family of Archimedean classes is convex. -/ +instance tailKernel_isConvex (T : Set (FiniteArchimedeanClass G)) : + ConvexQuotient.IsConvex (tailKernel T) where + ordConnected := by + constructor + intro a ha b hb x hx + apply mem_tailKernel_iff.mpr + intro c + exact (le_min (mem_tailKernel_iff.mp ha c) (mem_tailKernel_iff.mp hb c)).trans + (ArchimedeanClass.min_le_mk_of_le_of_le hx.1 hx.2) + +/-- Absolute value commutes with projection to a convex tail quotient. -/ +theorem quotient_abs (T : Set (FiniteArchimedeanClass G)) (x : G) : + |(x : G ⧸ tailKernel T)| = ((|x| : G) : G ⧸ tailKernel T) := by + rcases le_total 0 x with hx | hx + · have hxq : (0 : G ⧸ tailKernel T) ≤ (x : G ⧸ tailKernel T) := by + rw [← QuotientAddGroup.mk_zero] + exact ConvexQuotient.mk_le_mk hx + rw [abs_of_nonneg hx, abs_of_nonneg hxq] + · have hxq : (x : G ⧸ tailKernel T) ≤ (0 : G ⧸ tailKernel T) := by + rw [← QuotientAddGroup.mk_zero] + exact ConvexQuotient.mk_le_mk hx + rw [abs_of_nonpos hx, abs_of_nonpos hxq, ← QuotientAddGroup.mk_neg] + +/-- A strict comparison of Archimedean classes in a common-tail quotient reflects to any chosen +representatives. -/ +theorem archimedeanClass_mk_lt_of_quotient_mk_lt + (T : Set (FiniteArchimedeanClass G)) {x y : G} + (h : ArchimedeanClass.mk (x : G ⧸ tailKernel T) < + ArchimedeanClass.mk (y : G ⧸ tailKernel T)) : + ArchimedeanClass.mk x < ArchimedeanClass.mk y := by + rw [ArchimedeanClass.mk_lt_mk] at h ⊢ + intro n + have hn := h n + have hn' : ((n • |y| : G) : G ⧸ tailKernel T) < + ((|x| : G) : G ⧸ tailKernel T) := by + simpa only [quotient_abs, QuotientAddGroup.mk_nsmul] using hn + exact ConvexQuotient.lt_of_mk_lt_mk hn' + +/-- A nonzero natural multiple of an absolute value stays in the same Archimedean class. -/ +theorem mk_nsmul_abs {x : G} {n : ℕ} (hn : n ≠ 0) : + ArchimedeanClass.mk (n • |x|) = ArchimedeanClass.mk x := by + apply ArchimedeanClass.mk_eq_mk.mpr + constructor + · refine ⟨1, ?_⟩ + rw [one_nsmul, abs_nsmul, abs_abs] + obtain ⟨k, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hn + simpa [succ_nsmul] using + (le_add_of_nonneg_left (nsmul_nonneg (abs_nonneg x) k) : + |x| ≤ k • |x| + |x|) + · refine ⟨n, ?_⟩ + rw [abs_nsmul, abs_abs] + +/-- If `T` has no least member in the magnitude order, its common tail quotient has no least +nonzero Archimedean class in the magnitude order. -/ +theorem quotient_noMax_of_forall_exists_gt (T : Set (FiniteArchimedeanClass G)) + (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) : + NoMaxOrder (FiniteArchimedeanClass (G ⧸ tailKernel T)) := by + constructor + intro c + induction c using FiniteArchimedeanClass.ind with + | mk x hx => + induction x using QuotientAddGroup.induction_on with + | H x => + have hxH : x ∉ tailKernel T := by + simpa using (show (x : G ⧸ tailKernel T) ≠ 0 from hx) + rw [mem_tailKernel_iff] at hxH + push Not at hxH + obtain ⟨d, hxd⟩ := hxH + obtain ⟨e, heT, hde⟩ := hT d.1 d.2 + obtain ⟨f, hfT, hef⟩ := hT e heT + let y : G := e.1.out + have hyclass : ArchimedeanClass.mk y = e.1 := ArchimedeanClass.mk_out e.1 + have hy0 : y ≠ 0 := ArchimedeanClass.mk_eq_top_iff.not.mp + (hyclass.trans_ne e.2) + have hyH : y ∉ tailKernel T := by + intro hy + have hf_le_y : f.1 ≤ ArchimedeanClass.mk y := + mem_tailKernel_iff.mp hy ⟨f, hfT⟩ + rw [hyclass] at hf_le_y + exact (not_le_of_gt hef) hf_le_y + refine ⟨FiniteArchimedeanClass.mk (y : G ⧸ tailKernel T) (by simpa using hyH), ?_⟩ + change ArchimedeanClass.mk (x : G ⧸ tailKernel T) < + ArchimedeanClass.mk (y : G ⧸ tailKernel T) + rw [ArchimedeanClass.mk_lt_mk] + intro n + have hclass : ArchimedeanClass.mk x < ArchimedeanClass.mk y := by + rw [hyclass] + exact hxd.trans hde + have hxy : n • |y| < |x| := ArchimedeanClass.mk_lt_mk.mp hclass n + have hquot : ((n • |y| : G) : G ⧸ tailKernel T) < + ((|x| : G) : G ⧸ tailKernel T) := by + apply ConvexQuotient.mk_lt_mk_iff.mpr + refine ⟨hxy, ?_⟩ + intro hmem + have hdiff : d.1 ≤ ArchimedeanClass.mk (|x| - n • |y|) := + mem_tailKernel_iff.mp hmem d + have hdiffclass : ArchimedeanClass.mk (|x| - n • |y|) = + ArchimedeanClass.mk x := by + by_cases hn : n = 0 + · simp [hn] + rw [ArchimedeanClass.mk_sub_eq_mk_left] + · exact ArchimedeanClass.mk_abs x + · simpa only [ArchimedeanClass.mk_abs, mk_nsmul_abs hn] using hclass + rw [hdiffclass] at hdiff + exact (not_le_of_gt hxd) hdiff + simpa only [quotient_abs, QuotientAddGroup.mk_nsmul] using hquot + +/-- The no-largest-class theorem for a quotient by any additive subgroup whose carrier is the +tail kernel. -/ +theorem quotient_noMax_of_eq_tailKernel (T : Set (FiniteArchimedeanClass G)) + (H : AddSubgroup G) [ConvexQuotient.IsConvex H] (hH : H = tailKernel T) + (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) : + NoMaxOrder (FiniteArchimedeanClass (G ⧸ H)) := by + subst H + exact quotient_noMax_of_forall_exists_gt T hT + +/-- A canonical positive representative of a finite Archimedean class. -/ +def positiveRepresentative (c : FiniteArchimedeanClass G) : G := + |c.1.out| + +/-- The canonical representative of a finite class is positive. -/ +theorem positiveRepresentative_pos (c : FiniteArchimedeanClass G) : + 0 < positiveRepresentative c := by + rw [positiveRepresentative, abs_pos] + intro h + have := congrArg ArchimedeanClass.mk h + rw [ArchimedeanClass.mk_out, ArchimedeanClass.mk_zero] at this + exact c.2 this + +/-- The canonical positive representative represents the requested class. -/ +theorem mk_positiveRepresentative (c : FiniteArchimedeanClass G) : + ArchimedeanClass.mk (positiveRepresentative c) = c.1 := by + rw [positiveRepresentative, ArchimedeanClass.mk_abs, ArchimedeanClass.mk_out] + +/-- At a limit family, each canonical representative survives the common tail quotient. -/ +theorem positiveRepresentative_not_mem_tailKernel {T : Set (FiniteArchimedeanClass G)} + (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) (c : T) : + positiveRepresentative c.1 ∉ tailKernel T := by + obtain ⟨d, hdT, hcd⟩ := hT c.1 c.2 + intro hmem + have := mem_tailKernel_iff.mp hmem ⟨d, hdT⟩ + rw [mk_positiveRepresentative] at this + exact (not_le_of_gt hcd) this + +/-- The image of a canonical representative in its limit quotient is positive. -/ +theorem quotient_positiveRepresentative_pos {T : Set (FiniteArchimedeanClass G)} + (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) (c : T) : + 0 < ((positiveRepresentative c.1 : G) : G ⧸ tailKernel T) := by + rw [← QuotientAddGroup.mk_zero] + exact ConvexQuotient.mk_lt_mk_iff.mpr ⟨positiveRepresentative_pos c.1, + by simpa using positiveRepresentative_not_mem_tailKernel hT c⟩ + +/-- The canonical representatives of a limit family are coinitial among the positive elements of +the common tail quotient. -/ +theorem exists_quotient_positiveRepresentative_le {T : Set (FiniteArchimedeanClass G)} + {x : G ⧸ tailKernel T} (hx : 0 < x) : + ∃ c : T, ((positiveRepresentative c.1 : G) : G ⧸ tailKernel T) ≤ x := by + induction x using QuotientAddGroup.induction_on with + | H x => + have hxq : ((0 : G) : G ⧸ tailKernel T) < (x : G ⧸ tailKernel T) := by + simpa using hx + have hx0 : 0 < x := ConvexQuotient.lt_of_mk_lt_mk hxq + have hxH : x ∉ tailKernel T := by + simpa using (ConvexQuotient.mk_lt_mk_iff.mp hxq).2 + rw [mem_tailKernel_iff] at hxH + push Not at hxH + obtain ⟨c, hxc⟩ := hxH + refine ⟨c, ConvexQuotient.mk_le_mk ?_⟩ + apply (ArchimedeanClass.lt_of_mk_lt_mk_of_nonneg ?_ hx0.le).le + rwa [mk_positiveRepresentative] + +end FiniteArchimedeanClass + +end ConwayRefinement.Standalone.Hahn diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/CompleteHahnGermProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/CompleteHahnGermProof.lean new file mode 100644 index 0000000000..1d6dc25cf3 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/CompleteHahnGermProof.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGerm +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CompleteGermRefinement + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement +import Mathlib.Algebra.Ring.Hom.InjSurj + +/-! # Complete Hahn Germ Proof -/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.CompleteHahnGerm.Support + +universe u v + +variable {G : Type u} {K : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Field K] + +private def seriesRingEquiv : + NonpositiveSeries G K ≃+* HahnSeries.Nonpositive G K where + toFun x := ⟨x, x.2⟩ + invFun x := ⟨x, x.2⟩ + left_inv _ := rfl + right_inv _ := rfl + map_add' _ _ := rfl + map_mul' _ _ := rfl + +private def seriesAlgEquiv : + NonpositiveSeries G K ≃ₐ[K] HahnSeries.Nonpositive G K := + AlgEquiv.ofRingEquiv (f := seriesRingEquiv) fun k ↦ by + apply Subtype.ext + change (algebraMap K (HahnSeries G K)) k = + ((HahnSeries.Nonpositive.C (Γ := G) k : HahnSeries.Nonpositive G K) : HahnSeries G K) + rw [HahnSeries.Nonpositive.coe_C, HahnSeries.algebraMap_apply, Algebra.algebraMap_self, + RingHom.id_apply] + +@[simp] private theorem coe_seriesEquiv (x : NonpositiveSeries G K) : + ((seriesAlgEquiv x : HahnSeries.Nonpositive G K) : HahnSeries G K) = x := rfl + +variable [NoMinOrder G] +variable [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] +variable [Nontrivial G] [CompleteSpace G] [CharZero K] + +private theorem boundedAwayIdeal_map_eq : + (HahnSeries.Nonpositive.cantorBendixsonValuation (G := G) (R := K)).supp = + (BoundedAwayIdeal G K).map seriesAlgEquiv := by + ext y + rw [HahnSeries.Nonpositive.mem_cantorBendixsonValuation_supp, + Ideal.mem_map_iff_of_surjective seriesAlgEquiv seriesAlgEquiv.surjective] + constructor + · rintro ⟨r, hr, hyr⟩ + refine ⟨seriesAlgEquiv.symm y, ⟨r, hr, ?_⟩, seriesAlgEquiv.apply_symm_apply y⟩ + change (y : HahnSeries G K).support ⊆ Set.Iic r + exact hyr + · rintro ⟨x, ⟨r, hr, hxr⟩, rfl⟩ + exact ⟨r, hr, by simpa only [coe_seriesEquiv] using hxr⟩ + +/-- The internal Cantor–Bendixson construction gives the standalone polynomial presentation. -/ +theorem isPolynomialRing (G : Type u) (K : Type v) + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [NoMinOrder G] [Field K] : + IsPolynomialRing G K := by + intro _ _ _ _ _ _ _ _ _ + obtain ⟨ι, ⟨equiv⟩⟩ := + HahnSeries.Nonpositive.exists_mvPolynomial_algEquiv_germ (G := G) (K := K) + let quotientEquiv : Germ G K ≃ₐ[K] + HahnSeries.Nonpositive G K ⧸ + (HahnSeries.Nonpositive.cantorBendixsonValuation (G := G) (R := K)).supp := + Ideal.quotientEquivAlg (BoundedAwayIdeal G K) + (HahnSeries.Nonpositive.cantorBendixsonValuation (G := G) (R := K)).supp + seriesAlgEquiv boundedAwayIdeal_map_eq + exact ⟨ι, ⟨equiv.trans quotientEquiv.symm⟩⟩ + +/-- A polynomial presentation gives four-factor refinement. -/ +theorem hasRefinement (G : Type u) (K : Type v) + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [NoMinOrder G] [Field K] : + HasRefinement G K := by + intro _ _ _ _ _ _ _ _ _ + obtain ⟨ι, ⟨equiv⟩⟩ := isPolynomialRing G K + letI : IsDomain (Germ G K) := + Function.Injective.isDomain equiv.symm.toRingHom equiv.symm.injective + letI : DecompositionMonoid (Germ G K) := + MulEquiv.decompositionMonoid equiv.symm.toMulEquiv + intro a b c d habcd + exact (hasFourFactorRefinement_of_decompositionMonoid (R := Germ G K)).refine habcd + +end ConwayRefinement.Standalone.CompleteHahnGerm.Support diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConvexQuotient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConvexQuotient.lean new file mode 100644 index 0000000000..336d488992 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConvexQuotient.lean @@ -0,0 +1,185 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.Order.Group.Defs +public import Mathlib.GroupTheory.QuotientGroup.Defs +public import Mathlib.Order.Interval.Set.OrdConnected +import Mathlib.Tactic.Abel + +/-! +# The quotient of an ordered group by a convex subgroup + +A subgroup of a linearly ordered abelian group that is order-connected as a set is *convex*, and +the quotient by it inherits a linear order: one coset lies below another when some representative +of the first lies below some representative of the second. Convexity is exactly what makes that +relation antisymmetric, because an element trapped between zero and a subgroup element belongs to +the subgroup. + +The projection is monotone and reflects the strict order (`mk_le_mk`, `lt_of_mk_lt_mk`). Those +two facts are what let order-theoretic hypotheses be transported to the quotient — filling cuts, +in the intended application, where the quotient is taken to gain a small coinitial family of +positive elements that the group itself lacks. +-/ + +universe u + +open Set + +public section + +namespace ConwayRefinement.Standalone.Hahn + +namespace ConvexQuotient + +variable {G : Type u} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + +/-- A subgroup of an ordered group is convex when it is order-connected. -/ +class IsConvex (H : AddSubgroup G) : Prop where + /-- The carrier of a convex subgroup is order-connected. -/ + ordConnected : (H : Set G).OrdConnected + +omit [IsOrderedAddMonoid G] in +/-- A nonnegative element below an element of a convex subgroup lies in the subgroup. -/ +theorem mem_of_nonneg_of_le (H : AddSubgroup G) [IsConvex H] {x y : G} (hx : 0 ≤ x) + (hxy : x ≤ y) (hy : y ∈ H) : x ∈ H := + IsConvex.ordConnected.out H.zero_mem hy ⟨hx, hxy⟩ + +variable {G : Type u} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + {H : AddSubgroup G} [IsConvex H] + +/-- One coset lies below another when some representative of the first lies below some +representative of the second. -/ +instance instLE : LE (G ⧸ H) where + le x y := ∃ a b : G, (a : G ⧸ H) = x ∧ (b : G ⧸ H) = y ∧ a ≤ b + +/-- **Comparing cosets.** One coset lies below another exactly when the chosen representatives are +already comparable or differ by a subgroup element. Convexity supplies the forward direction: were +the representatives reversed, their difference would be trapped between zero and the subgroup +element relating the two choices. -/ +theorem mk_le_mk_iff {a b : G} : + ((a : G ⧸ H) ≤ (b : G ⧸ H)) ↔ a ≤ b ∨ b - a ∈ H := by + constructor + · rintro ⟨a', b', ha', hb', hab⟩ + rw [QuotientAddGroup.eq_iff_sub_mem] at ha' hb' + rcases le_or_gt a b with h | h + · exact Or.inl h + refine Or.inr ?_ + have hsub : a - b ≤ (b' - b) - (a' - a) := by + rw [← sub_nonneg] + have heq : (b' - b) - (a' - a) - (a - b) = b' - a' := by abel + rw [heq] + exact sub_nonneg.mpr hab + have hmem := mem_of_nonneg_of_le H (sub_nonneg.mpr h.le) hsub + (H.sub_mem hb' ha') + simpa using H.neg_mem hmem + · rintro (h | h) + · exact ⟨a, b, rfl, rfl, h⟩ + · exact ⟨a, a, rfl, + QuotientAddGroup.eq_iff_sub_mem.mpr (by simpa using H.neg_mem h), le_rfl⟩ + +/-- The projection is monotone. -/ +theorem mk_le_mk {a b : G} (h : a ≤ b) : (a : G ⧸ H) ≤ (b : G ⧸ H) := + mk_le_mk_iff.mpr (Or.inl h) + +open Classical in +noncomputable instance instLinearOrder : LinearOrder (G ⧸ H) where + le := (· ≤ ·) + le_refl := by + refine fun x ↦ QuotientAddGroup.induction_on x fun a ↦ ?_ + exact mk_le_mk le_rfl + le_trans := by + refine fun x y z ↦ QuotientAddGroup.induction_on x fun a ↦ QuotientAddGroup.induction_on y + fun b ↦ QuotientAddGroup.induction_on z fun c hab hbc ↦ ?_ + rw [mk_le_mk_iff] at hab hbc ⊢ + rcases hab with hab | hab + · rcases hbc with hbc | hbc + · exact Or.inl (hab.trans hbc) + -- `c` and `b` differ in the subgroup, so `a ≤ c` unless `a - c` is trapped below `b - c`. + · rcases le_or_gt a c with h | h + · exact Or.inl h + refine Or.inr ?_ + have hbc' : b - c ∈ H := by simpa using H.neg_mem hbc + have hmem := mem_of_nonneg_of_le H (sub_nonneg.mpr h.le) + (sub_le_sub_right hab c) hbc' + simpa using H.neg_mem hmem + · rcases hbc with hbc | hbc + · rcases le_or_gt a c with h | h + · exact Or.inl h + refine Or.inr ?_ + have hab' : a - b ∈ H := by simpa using H.neg_mem hab + have hmem := mem_of_nonneg_of_le H (sub_nonneg.mpr h.le) + (sub_le_sub_left hbc a) hab' + simpa using H.neg_mem hmem + · exact Or.inr (by simpa using H.add_mem hbc hab) + le_antisymm := by + refine fun x y ↦ QuotientAddGroup.induction_on x fun a ↦ QuotientAddGroup.induction_on y + fun b hab hba ↦ ?_ + rw [mk_le_mk_iff] at hab hba + rw [QuotientAddGroup.eq_iff_sub_mem] + rcases hab with hab | hab + · rcases hba with hba | hba + · rw [le_antisymm hab hba, sub_self] + exact H.zero_mem + · exact hba + · simpa using H.neg_mem hab + le_total := by + refine fun x y ↦ QuotientAddGroup.induction_on x fun a ↦ QuotientAddGroup.induction_on y + fun b ↦ ?_ + rcases le_total a b with h | h + · exact Or.inl (mk_le_mk h) + · exact Or.inr (mk_le_mk h) + toDecidableLE := Classical.decRel _ + +instance instIsOrderedAddMonoid : IsOrderedAddMonoid (G ⧸ H) where + add_le_add_left := by + refine fun x y ↦ QuotientAddGroup.induction_on x fun a ↦ QuotientAddGroup.induction_on y + fun b hab z ↦ QuotientAddGroup.induction_on z fun c ↦ ?_ + rw [mk_le_mk_iff] at hab + have hc : ((a + c : G) : G ⧸ H) ≤ ((b + c : G) : G ⧸ H) := by + rw [mk_le_mk_iff] + rcases hab with hab | hab + · exact Or.inl (add_le_add hab le_rfl) + · exact Or.inr (by simpa using hab) + simpa using hc + +/-- **The projection reflects the strict order.** Two representatives whose cosets are strictly +comparable are themselves strictly comparable. -/ +theorem lt_of_mk_lt_mk {a b : G} (h : (a : G ⧸ H) < (b : G ⧸ H)) : a < b := by + rcases mk_le_mk_iff.mp h.le with hab | hab + · refine hab.lt_of_ne fun hEq ↦ ?_ + exact absurd (le_of_eq (congrArg _ hEq.symm)) (not_le.mpr h) + · exact absurd (mk_le_mk_iff.mpr (Or.inr (by simpa using H.neg_mem hab))) (not_le.mpr h) + +/-- One coset lies strictly below another exactly when the representatives do and their difference +escapes the subgroup. -/ +theorem mk_lt_mk_iff {a b : G} : + ((a : G ⧸ H) < (b : G ⧸ H)) ↔ a < b ∧ b - a ∉ H := by + refine ⟨fun h ↦ ⟨lt_of_mk_lt_mk h, fun hmem ↦ ?_⟩, fun ⟨hab, hmem⟩ ↦ ?_⟩ + · exact absurd (mk_le_mk_iff.mpr (Or.inr (by simpa using H.neg_mem hmem))) (not_le.mpr h) + · refine lt_of_le_of_ne (mk_le_mk hab.le) fun hEq ↦ hmem ?_ + simpa using H.neg_mem (QuotientAddGroup.eq_iff_sub_mem.mp hEq) + +/-- **Halving descends to the quotient.** If every positive element of `G` is twice a positive +element, the same holds in the quotient: a representative's half stays outside the subgroup, +since otherwise the representative itself would lie inside it. -/ +theorem exists_half_of_pos (hG : ∀ x : G, 0 < x → ∃ y, 0 < y ∧ y + y = x) {c : G ⧸ H} + (hc : 0 < c) : ∃ d : G ⧸ H, 0 < d ∧ d + d ≤ c := by + induction c using QuotientAddGroup.induction_on with + | H x => + have hpos : ((0 : G) : G ⧸ H) < (x : G ⧸ H) := by + rw [QuotientAddGroup.mk_zero] + exact hc + have hxH : x ∉ H := by simpa using (mk_lt_mk_iff.mp hpos).2 + obtain ⟨y, hy, hyx⟩ := hG x (lt_of_mk_lt_mk hpos) + have hyH : y ∉ H := fun hmem ↦ hxH (hyx ▸ H.add_mem hmem hmem) + refine ⟨(y : G ⧸ H), ?_, ?_⟩ + · exact mk_lt_mk_iff.mpr ⟨hy, by simpa using hyH⟩ + · rw [← QuotientAddGroup.mk_add, hyx] + +end ConvexQuotient + +end ConwayRefinement.Standalone.Hahn diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConvexQuotientSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConvexQuotientSplitting.lean new file mode 100644 index 0000000000..cf9cb51765 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConvexQuotientSplitting.lean @@ -0,0 +1,177 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ArchimedeanQuotient +public import Mathlib.Algebra.Order.Module.Archimedean +public import Mathlib.Algebra.Order.Monoid.Prod +public import Mathlib.LinearAlgebra.Basis.VectorSpace +public import Mathlib.LinearAlgebra.Projection + +/-! +# Ordered splitting by a convex subspace + +A subspace of a vector space over a field has an algebraic complement. If the ambient additive +group is linearly ordered and the subspace is convex, this complement presents the ambient group +as the lexicographic product of the ordered quotient and the subspace. The quotient coordinate is +dominant. This additive splitting is what permits Hahn series to be regrouped by quotient cosets +without introducing a cocycle. + +For a family of finite Archimedean classes, `FiniteArchimedeanClass.tailSubmodule` equips their +common tail kernel with its natural subspace structure. Thus the generic splitting applies to the +limit-tail quotients used in the Cantor–Bendixson argument. +-/ + +open Set + +universe u v + +public noncomputable section + +namespace ConwayRefinement.Standalone.Hahn + +namespace FiniteArchimedeanClass + +variable (K : Type v) {G : Type u} +variable [Field K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [PosSMulMono K G] + +/-- The common tail kernel of `T`, equipped with its natural `K`-subspace structure. -/ +def tailSubmodule (T : Set (FiniteArchimedeanClass G)) : Submodule K G where + __ := tailKernel T + smul_mem' k x hx := by + apply mem_tailKernel_iff.mpr + intro c + exact (mem_tailKernel_iff.mp hx c).trans (ArchimedeanClass.mk_le_mk_smul x k) + +/-- Membership in the common-tail subspace is membership in the underlying common-tail +kernel. -/ +@[simp] +theorem mem_tailSubmodule_iff {T : Set (FiniteArchimedeanClass G)} {x : G} : + x ∈ tailSubmodule K T ↔ x ∈ tailKernel T := + (Iff.rfl) + +@[simp] +theorem tailSubmodule_toAddSubgroup (T : Set (FiniteArchimedeanClass G)) : + (tailSubmodule K T).toAddSubgroup = tailKernel T := + (rfl) + +/-- The subspace form of the common tail kernel is convex. -/ +instance tailSubmodule_isConvex (T : Set (FiniteArchimedeanClass G)) : + ConvexQuotient.IsConvex (tailSubmodule K T).toAddSubgroup := by + rw [tailSubmodule_toAddSubgroup K T] + infer_instance + +end FiniteArchimedeanClass + +namespace Submodule + +variable {K : Type v} {G : Type u} +variable [Field K] [AddCommGroup G] [Module K G] +variable [LinearOrder G] [IsOrderedAddMonoid G] + +variable (P : Submodule K G) + +/-- A chosen linear complement of `P`. -/ +noncomputable def linearComplement : Submodule K G := + Classical.choose P.exists_isCompl + +omit [LinearOrder G] [IsOrderedAddMonoid G] in +/-- The chosen complement is complementary to `P`. -/ +theorem isCompl_linearComplement : IsCompl P (linearComplement P) := + Classical.choose_spec P.exists_isCompl + +/-- The quotient by `P`, identified linearly with the chosen complement. -/ +noncomputable def quotientLinearEquivComplement : (G ⧸ P) ≃ₗ[K] linearComplement P := + P.quotientEquivOfIsCompl (linearComplement P) (isCompl_linearComplement P) + +/-- Reassemble a quotient coordinate and a `P`-coordinate in the ambient vector space. -/ +noncomputable def quotientProdLinearEquiv : ((G ⧸ P) × P) ≃ₗ[K] G := + ((quotientLinearEquivComplement P).prodCongr (LinearEquiv.refl K P)).trans + ((linearComplement P).prodEquivOfIsCompl P (isCompl_linearComplement P).symm) + +omit [LinearOrder G] [IsOrderedAddMonoid G] in +/-- Reassembly has the prescribed quotient coordinate. -/ +@[simp] +theorem mk_quotientProdLinearEquiv (x : (G ⧸ P) × P) : + _root_.Submodule.Quotient.mk (quotientProdLinearEquiv P x) = x.1 := by + rw [quotientProdLinearEquiv, LinearEquiv.trans_apply, LinearEquiv.prodCongr_apply, + Submodule.coe_prodEquivOfIsCompl'] + change QuotientAddGroup.mk' P.toAddSubgroup + ((quotientLinearEquivComplement P x.1 : G) + (x.2 : G)) = x.1 + rw [map_add, show QuotientAddGroup.mk' P.toAddSubgroup (x.2 : G) = 0 by + exact (Submodule.Quotient.mk_eq_zero P).mpr x.2.property, add_zero] + exact P.mk_quotientEquivOfIsCompl_apply (isCompl_linearComplement P) x.1 + +omit [LinearOrder G] [IsOrderedAddMonoid G] in +/-- Reassembling a zero quotient coordinate returns the subspace coordinate. -/ +@[simp] +theorem quotientProdLinearEquiv_zero_left (p : P) : + quotientProdLinearEquiv P (0, p) = (p : G) := by + rw [quotientProdLinearEquiv, LinearEquiv.trans_apply, LinearEquiv.prodCongr_apply, + Submodule.coe_prodEquivOfIsCompl'] + simp [quotientLinearEquivComplement] + +noncomputable local instance quotientLinearOrder [ConvexQuotient.IsConvex P.toAddSubgroup] : + LinearOrder (G ⧸ P) := + ConvexQuotient.instLinearOrder (H := P.toAddSubgroup) + +local instance submoduleIsOrderedAddMonoid : IsOrderedAddMonoid P := + AddSubgroup.instIsOrderedAddMonoid P.toAddSubgroup + +/-- A linearly ordered vector space is the lexicographic product of the quotient by a convex +subspace and that subspace. The quotient is the dominant coordinate. -/ +noncomputable def quotientLexEquiv [ConvexQuotient.IsConvex P.toAddSubgroup] : + ((G ⧸ P) ×ₗ P) ≃+o G := + { (quotientProdLinearEquiv P).toAddEquiv with + map_le_map_iff' := by + intro x y + apply (show StrictMono + (fun x : ((G ⧸ P) ×ₗ P) ↦ quotientProdLinearEquiv P (ofLex x)) by + intro x y hxy + rcases Prod.Lex.lt_iff.mp hxy with houter | ⟨houter, hinner⟩ + · have hq : + ((quotientProdLinearEquiv P (ofLex x) : G) : G ⧸ P.toAddSubgroup) < + ((quotientProdLinearEquiv P (ofLex y) : G) : G ⧸ P.toAddSubgroup) := by + change (_root_.Submodule.Quotient.mk (quotientProdLinearEquiv P (ofLex x)) : + G ⧸ P) < + _root_.Submodule.Quotient.mk (quotientProdLinearEquiv P (ofLex y)) + rw [mk_quotientProdLinearEquiv, mk_quotientProdLinearEquiv] + exact houter + exact ConvexQuotient.lt_of_mk_lt_mk hq + · change quotientProdLinearEquiv P (ofLex x) < quotientProdLinearEquiv P (ofLex y) + simp only [quotientProdLinearEquiv, LinearEquiv.trans_apply, + LinearEquiv.prodCongr_apply, Submodule.coe_prodEquivOfIsCompl'] + rw [show (ofLex x).1 = (ofLex y).1 from houter] + simpa only [LinearEquiv.refl_apply, add_comm] using + add_lt_add_left (show ((ofLex x).2 : G) < ((ofLex y).2 : G) from hinner) + (quotientLinearEquivComplement P (ofLex y).1 : G)).le_iff_le } + +@[simp] +theorem quotientLexEquiv_apply [ConvexQuotient.IsConvex P.toAddSubgroup] + (x : (G ⧸ P) ×ₗ P) : + quotientLexEquiv P x = quotientProdLinearEquiv P (ofLex x) := + (rfl) + +end Submodule + +namespace FiniteArchimedeanClass + +variable (K : Type v) {G : Type u} +variable [Field K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [PosSMulMono K G] + +/-- The ambient group split lexicographically into the quotient by its tail subspace and that +subspace. Its additive subgroup is propositionally equal to `tailKernel T`. -/ +noncomputable def tailQuotientLexEquiv (T : Set (FiniteArchimedeanClass G)) : + ((G ⧸ (tailSubmodule K T).toAddSubgroup) ×ₗ tailSubmodule K T) ≃+o G := + Submodule.quotientLexEquiv (tailSubmodule K T) + +end FiniteArchimedeanClass + +end ConwayRefinement.Standalone.Hahn diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConwayRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConwayRefinement.lean new file mode 100644 index 0000000000..b1f6bd8d5a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConwayRefinement.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.Group.Defs + +/-! +# Conway's four-factor refinement statement + +This file records the logical form of Conway's statement without choosing a construction of the +surreal numbers or the omnific integers. Given a predicate `P` on a type with multiplication, the +statement says that every equation `a * b = c * d` among `P`-elements admits Conway's +four-factor refinement. + +Concrete developments may instantiate `P` by Conway's cut definition of the omnific integers or +by membership in a Hahn integer part. This module imports only Mathlib. +-/ + +public section + +namespace ConwayRefinement.Standalone + +universe u + +variable {R : Type u} [Mul R] + +/-- Conway's four-factor refinement schema for a predicate `P`: from `a * b = c * d`, produce +`a = e * f`, `b = g * h`, `c = e * g`, and `d = f * h`, with all eight entries satisfying `P`. -/ +def ConwayRefinement (P : R → Prop) : Prop := + ∀ a b c d : R, + P a → P b → P c → P d → a * b = c * d → + ∃ e f g h : R, + P e ∧ P f ∧ P g ∧ P h ∧ + a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h + +/-- The standalone proposition unfolds to the four equations in Conway's refinement conjecture. -/ +theorem conwayRefinement_iff (P : R → Prop) : ConwayRefinement P ↔ + ∀ a b c d : R, + P a → P b → P c → P d → a * b = c * d → + ∃ e f g h : R, + P e ∧ P f ∧ P g ∧ P h ∧ + a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h := (Iff.rfl) + +end ConwayRefinement.Standalone + +/-! +## Formal proof + +Proof module: `ConwayRefinementProof`. + +* `ConwayRefinement` → `ConwayRefinement.refine` +-/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConwayRefinementProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConwayRefinementProof.lean new file mode 100644 index 0000000000..4e7616572d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConwayRefinementProof.lean @@ -0,0 +1,33 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinement + +/-! +# Public interface for four-factor refinement + +This proof sibling supplies the module-safe eliminator for the standalone proposition. +-/ + +public section + +namespace ConwayRefinement.Standalone.ConwayRefinement + +universe u + +variable {R : Type u} [Mul R] {P : R → Prop} + +/-- Apply four-factor refinement to one product equation. -/ +theorem refine (hc : ConwayRefinement P) + {a b c d : R} (ha : P a) (hb : P b) (hc' : P c) (hd : P d) + (heq : a * b = c * d) : + ∃ e f g h : R, + P e ∧ P f ∧ P g ∧ P h ∧ + a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h := by + exact conwayRefinement_iff P |>.mp hc a b c d ha hb hc' hd heq + +end ConwayRefinement.Standalone.ConwayRefinement diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/GermPolynomialRingProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/GermPolynomialRingProof.lean new file mode 100644 index 0000000000..fab49f6bd1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/GermPolynomialRingProof.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRing +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NegativeMonomialIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.OrdinalValueQuotient +import Mathlib.Algebra.Ring.Hom.InjSurj +import Mathlib.RingTheory.Ideal.Quotient.Operations +import Mathlib.RingTheory.UniqueFactorizationDomain.Basic + +/-! +# Proof that the ring of germs is a polynomial ring + +The standalone ideal `J` is `negativeMonomialIdeal`, so its quotient is Berarducci's `Germ K`. +A minimal homogeneous generating system gives a polynomial presentation and hence unique +factorisation. +-/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.GermPolynomial + +universe u + +variable {K : Type u} [Field K] + +/-- The ideal `J` is the span of the monomials `t^x` with `x < 0`. -/ +theorem J_eq : J K = HahnSeries.Nonpositive.negativeMonomialIdeal K := by + rw [HahnSeries.Nonpositive.negativeMonomialIdeal_def] + unfold J + congr 1 + ext m + constructor + · rintro ⟨x, hx, hm⟩ + exact HahnSeries.Nonpositive.mem_negativeMonomials_iff.mpr + ⟨⟨x, hx⟩, Subtype.ext (by rw [HahnSeries.Nonpositive.coe_single]; exact hm.symm)⟩ + · intro h + obtain ⟨⟨x, hx⟩, rfl⟩ := HahnSeries.Nonpositive.mem_negativeMonomials_iff.mp h + exact ⟨x, hx, HahnSeries.Nonpositive.coe_single _ _ _⟩ + +variable (K) in +/-- The standalone ring of germs is ring-equivalent to Berarducci's germ ring. -/ +def germRingEquiv : Germ K ≃+* Berarducci.Germ K := + Ideal.quotEquivOfEq J_eq + +namespace GermIsPolynomialRing + +/-- The germ ring is a polynomial ring over its coefficient field. -/ +theorem of_polynomiality (K : Type u) [Field K] : GermIsPolynomialRing K := by + intro hK + letI := hK + obtain ⟨ι, wt, x, hx⟩ := + OrdinalGraded.exists_isMinimalSystem (Berarducci.principalGrading K) + obtain ⟨σ⟩ := Berarducci.exists_lifts hx.mem + exact ⟨ι, ⟨(σ.ordinalValueQuotientAlgEquiv hx).symm.toRingEquiv.trans (germRingEquiv K).symm⟩⟩ + +end GermIsPolynomialRing + +namespace GermHasUniqueFactorization + +/-- Every nonzero germ factors uniquely into irreducibles, up to order and association. -/ +theorem of_polynomiality (K : Type u) [Field K] : + GermHasUniqueFactorization K := by + intro hK + letI := hK + obtain ⟨ι, ⟨equiv⟩⟩ := GermIsPolynomialRing.of_polynomiality K hK + haveI hdom : IsDomain (Germ K) := + Function.Injective.isDomain equiv.symm.toRingHom equiv.symm.injective + haveI : UniqueFactorizationMonoid (Germ K) := + equiv.toMulEquiv.uniqueFactorizationMonoid inferInstance + refine ⟨hdom, fun a ha ↦ ?_, fun f g hf hg h ↦ UniqueFactorizationMonoid.factors_unique hf hg h⟩ + obtain ⟨f, hf, hfa⟩ := UniqueFactorizationMonoid.exists_prime_factors a ha + exact ⟨f, fun b hb ↦ (hf b hb).irreducible, hfa⟩ + +end GermHasUniqueFactorization + +end ConwayRefinement.Standalone.GermPolynomial diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnIntegerPartRefinementProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnIntegerPartRefinementProof.lean new file mode 100644 index 0000000000..d3fa9ae20c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnIntegerPartRefinementProof.lean @@ -0,0 +1,943 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterion + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ArchimedeanBallSplitting +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CoinitialComplete +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.LimitTailPrimality +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanBall +import Mathlib.Algebra.Module.Rat +import Mathlib.Algebra.GCDMonoid.Nat +import Mathlib.Data.Real.Embedding +import Mathlib.SetTheory.Cardinal.Rat + +/-! +# Proof of refinement in cardinal-bounded Hahn integer parts + +The finite-class argument uses conditions `(A1)`--`(A3)` from LM24. The common-tail hypotheses +extend primality to every bounded generalised-power-series integer part, and primality gives the +four-factor refinement property. +-/ + +public noncomputable section + +open Cardinal +open HahnSeries.CardSuppLTTruncationIntegerPart + +namespace ConwayRefinement.Standalone.Hahn.HahnIntegerPartRefinement + +universe u v + +variable {G : Type u} {R : Type v} +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module ℚ G] [IsOrderedModule ℚ G] +variable [Field R] + +local instance : PosSMulStrictMono ℚ G := PosSMulMono.toPosSMulStrictMono + +omit [IsOrderedAddMonoid G] [Module ℚ G] [IsOrderedModule ℚ G] in +theorem mem_hahnIntegerPart_iff {Z : Subring R} {κ : Cardinal.{u}} {x : HahnSeries G R} : + x ∈ hahnIntegerPart Z κ ↔ + x.cardSupp < κ ∧ x.support ⊆ Set.Iic 0 ∧ x.coeff 0 ∈ Z := + Iff.rfl + +omit [Module ℚ G] [IsOrderedModule ℚ G] in +theorem isFractionFieldOfHahnIntegerPart_iff {Z : Subring R} {κ : Cardinal.{u}} : + IsFractionFieldOfHahnIntegerPart (G := G) Z κ ↔ + ∀ x : HahnSeries G R, x.cardSupp < κ → + ∃ a b : HahnSeries G R, + a ∈ hahnIntegerPart Z κ ∧ b ∈ hahnIntegerPart Z κ ∧ b ≠ 0 ∧ x = a / b := + Iff.rfl + +omit [IsOrderedAddMonoid G] [Module ℚ G] [IsOrderedModule ℚ G] in +theorem mem_integerHahnPart_iff {κ : Cardinal.{u}} {x : HahnSeries G R} : + x ∈ integerHahnPart κ ↔ + x.cardSupp < κ ∧ x.support ⊆ Set.Iic 0 ∧ ∃ z : ℤ, (z : R) = x.coeff 0 := + Iff.rfl + +theorem assumptionA1_iff {s : HahnEmbedding.ArchimedeanStrata ℚ G} : + AssumptionA1 s ↔ + ∀ c : FiniteArchimedeanClass G, Nonempty (s.stratum c ≃+o ℝ) := + Iff.rfl + +theorem generatesFractionField_iff {Z : Subring R} : + GeneratesFractionField Z ↔ + ∀ x : R, ∃ a b : Z, b ≠ 0 ∧ x = (a : R) / (b : R) := + Iff.rfl + +theorem assumptionA2_iff {Z : Subring R} {κ : Cardinal.{u}} : + AssumptionA2 (G := G) Z κ ↔ + ∀ c : FiniteArchimedeanClass G, + κ ≤ Order.cof ↑(FiniteArchimedeanClass.ball ℚ c) ∨ + (Subsingleton ↑(FiniteArchimedeanClass.ball ℚ c) ∧ GeneratesFractionField Z) := + Iff.rfl + +theorem assumptionA3_iff {Z : Subring R} : + AssumptionA3 Z ↔ + ∀ z a b : Z, z ∣ a * b → + ∃ z₁ z₂ : Z, z₁ ∣ a ∧ z₂ ∣ b ∧ z = z₁ * z₂ := + Iff.rfl + +omit [Module ℚ G] [IsOrderedModule ℚ G] in +theorem isLimitFamily_iff {T : Set (FiniteArchimedeanClass G)} : + IsLimitFamily T ↔ T.Nonempty ∧ ∀ c ∈ T, ∃ d ∈ T, c < d := + Iff.rfl + +omit [AddCommGroup G] [IsOrderedAddMonoid G] [Module ℚ G] [IsOrderedModule ℚ G] in +theorem isKappaSaturated_iff {κ : Cardinal.{u}} : + IsKappaSaturated (G := G) κ ↔ + ∀ L R : Set G, #L < κ → #R < κ → + (∀ l ∈ L, ∀ r ∈ R, l < r) → + ∃ x : G, (∀ l ∈ L, l < x) ∧ ∀ r ∈ R, x < r := + Iff.rfl + +/-- The standalone common-tail definition agrees with the canonical common-tail subspace used by +the proof. -/ +theorem commonTail_eq_tailSubmodule + (T : Set (FiniteArchimedeanClass G)) : + commonTail T = _root_.FiniteArchimedeanClass.tailSubmodule ℚ T := by + ext x + rw [mem_commonTail_iff, + _root_.FiniteArchimedeanClass.mem_tailSubmodule_iff, + _root_.FiniteArchimedeanClass.mem_tailKernel_iff] + +/-- The standalone and canonical common-tail subspaces are order-isomorphic. -/ +def commonTailSubtypeOrderIso (T : Set (FiniteArchimedeanClass G)) : + commonTail T ≃o _root_.FiniteArchimedeanClass.tailSubmodule ℚ T where + toFun x := ⟨x, by + rw [← commonTail_eq_tailSubmodule (G := G) T] + exact x.2⟩ + invFun x := ⟨x, by + rw [commonTail_eq_tailSubmodule (G := G) T] + exact x.2⟩ + left_inv _ := rfl + right_inv _ := rfl + map_rel_iff' := Iff.rfl + +/-- The two independently stated common-tail quotients are the same ordered additive group. -/ +noncomputable def commonTailOrderAddMonoidIso + (T : Set (FiniteArchimedeanClass G)) : + (G ⧸ commonTail T) ≃+o + (G ⧸ _root_.FiniteArchimedeanClass.tailSubmodule ℚ T) := by + let h := commonTail_eq_tailSubmodule (G := G) T + refine { (Submodule.quotEquivOfEq (commonTail T) + (_root_.FiniteArchimedeanClass.tailSubmodule ℚ T) h).toAddEquiv with + map_le_map_iff' := ?_ } + intro a b + refine Submodule.Quotient.induction_on (commonTail T) a fun a ↦ ?_ + refine Submodule.Quotient.induction_on (commonTail T) b fun b ↦ ?_ + change + ((Submodule.Quotient.mk a : + G ⧸ _root_.FiniteArchimedeanClass.tailSubmodule ℚ T) ≤ + Submodule.Quotient.mk b) ↔ + ((Submodule.Quotient.mk a : G ⧸ commonTail T) ≤ + Submodule.Quotient.mk b) + have htarget : + ((Submodule.Quotient.mk a : + G ⧸ _root_.FiniteArchimedeanClass.tailSubmodule ℚ T) ≤ + Submodule.Quotient.mk b) ↔ + a ≤ b ∨ b - a ∈ _root_.FiniteArchimedeanClass.tailSubmodule ℚ T := by + exact _root_.ConvexQuotient.mk_le_mk_iff + have hsource : + ((Submodule.Quotient.mk a : G ⧸ commonTail T) ≤ + Submodule.Quotient.mk b) ↔ a ≤ b ∨ b - a ∈ commonTail T := by + exact ConvexQuotient.mk_le_mk_iff + exact htarget.trans ((or_congr Iff.rfl (by rw [h])).trans hsource.symm) + +/-- The independent common-tail quotient presentations have the same additive uniformity. -/ +noncomputable def commonTailUniformEquiv + (T : Set (FiniteArchimedeanClass G)) : + (G ⧸ commonTail T) ≃ᵤ + (G ⧸ _root_.FiniteArchimedeanClass.tailSubmodule ℚ T) := by + let e := commonTailOrderAddMonoidIso (G := G) T + exact + { e.toEquiv with + uniformContinuous_toFun := + uniformContinuous_of_continuousAt_zero e.toAddEquiv + e.toOrderIso.continuous.continuousAt + uniformContinuous_invFun := + uniformContinuous_of_continuousAt_zero e.symm.toAddEquiv + e.symm.toOrderIso.continuous.continuousAt } + +omit [AddCommGroup G] [IsOrderedAddMonoid G] [Module ℚ G] [IsOrderedModule ℚ G] in +private theorem fillsCuts_of_isKappaSaturated {κ : Cardinal.{u}} + (hG : IsKappaSaturated (G := G) κ) {ι : Type u} (hι : #ι < κ) : + FillsCuts ι G := by + rw [isKappaSaturated_iff] at hG + rw [fillsCuts_iff] + intro L R hLR + have hL : #(Set.range L) < κ := Cardinal.mk_range_le.trans_lt hι + have hR : #(Set.range R) < κ := Cardinal.mk_range_le.trans_lt hι + obtain ⟨x, hxL, hxR⟩ := hG (Set.range L) (Set.range R) hL hR + (by rintro _ ⟨i, rfl⟩ _ ⟨j, rfl⟩; exact hLR i j) + exact ⟨x, fun i ↦ (hxL _ ⟨i, rfl⟩).le, fun j ↦ (hxR _ ⟨j, rfl⟩).le⟩ + +@[blueprint "lem:saturated-archimedean-strata-real" + (phase := "Bounded generalised-power-series integer parts") + (title := "Archimedean strata of saturated ordered groups") + (statement := /-- + Let $\kappa>\aleph_0$ and let $G$ be a $\kappa$-saturated ordered rational + vector space. Every Archimedean stratum in any Hahn splitting of $G$ is + order additively isomorphic to $\mathbb R$. + -/) + (proof := /-- + Embed a stratum order additively into $\mathbb R$ and fix a positive + element whose image is $\rho>0$. For $y\in\mathbb R$, the rational + multiples $q\rhoy$ define two countable subsets of $G$. + Saturation supplies an element between them. It lies in the corresponding + closed Archimedean ball; project it to the stratum using the lexicographic + splitting of that ball. Comparison with every rational multiple forces + the projected element to map to $y$. Thus the embedding is surjective. + -/)] +private theorem stratum_orderAddEquiv_real_of_isKappaSaturated + {κ : Cardinal.{u}} (hκ : ℵ₀ < κ) (hG : IsKappaSaturated (G := G) κ) + (s : HahnEmbedding.ArchimedeanStrata ℚ G) (c : FiniteArchimedeanClass G) : + Nonempty (s.stratum c ≃+o ℝ) := by + rw [isKappaSaturated_iff] at hG + let S := s.stratum c + obtain ⟨f, hf⟩ := Archimedean.exists_orderAddMonoidHom_real_injective S + have hfmono : StrictMono f := + (OrderHomClass.monotone f).strictMono_of_injective hf + obtain ⟨a₀, ha₀⟩ := exists_ne (0 : S) + let a : S := |a₀| + have ha : 0 < a := abs_pos.mpr ha₀ + let ρ : ℝ := f a + have hρ : 0 < ρ := by + change 0 < f a + simpa using hfmono ha + have hsurj : Function.Surjective f := by + intro y + let L : Set G := {x | ∃ q : ℚ, (q : ℝ) * ρ < y ∧ x = (q • a : S)} + let R : Set G := {x | ∃ q : ℚ, y < (q : ℝ) * ρ ∧ x = (q • a : S)} + have hLcard : #L < κ := by + refine (Cardinal.mk_le_mk_of_subset (s := L) + (t := Set.range (fun q : ULift.{u} ℚ ↦ ((q.down • a : S) : G))) ?_).trans_lt ?_ + · rintro x ⟨q, -, rfl⟩ + exact ⟨ULift.up q, rfl⟩ + · refine Cardinal.mk_range_le.trans_lt ?_ + rw [Cardinal.mk_uLift, Cardinal.mkRat, Cardinal.lift_aleph0] + exact hκ + have hRcard : #R < κ := by + refine (Cardinal.mk_le_mk_of_subset (s := R) + (t := Set.range (fun q : ULift.{u} ℚ ↦ ((q.down • a : S) : G))) ?_).trans_lt ?_ + · rintro x ⟨q, -, rfl⟩ + exact ⟨ULift.up q, rfl⟩ + · refine Cardinal.mk_range_le.trans_lt ?_ + rw [Cardinal.mk_uLift, Cardinal.mkRat, Cardinal.lift_aleph0] + exact hκ + have hLR : ∀ l ∈ L, ∀ r ∈ R, l < r := by + rintro l ⟨q, hqy, rfl⟩ r ⟨q', hyq', rfl⟩ + apply Subtype.coe_lt_coe.mp + apply hfmono.lt_iff_lt.mp + rw [map_rat_smul, map_rat_smul] + change (q : ℝ) * ρ < (q' : ℝ) * ρ + exact hqy.trans hyq' + obtain ⟨x, hxL, hxR⟩ := hG L R hLcard hRcard hLR + obtain ⟨qₗ, hqₗ⟩ := exists_rat_lt (y / ρ) + obtain ⟨qᵣ, hqᵣ⟩ := exists_rat_gt (y / ρ) + have hqₗ' : (qₗ : ℝ) * ρ < y := by rwa [lt_div_iff₀ hρ] at hqₗ + have hqᵣ' : y < (qᵣ : ℝ) * ρ := by rwa [div_lt_iff₀ hρ] at hqᵣ + have hqₗL : ((qₗ • a : S) : G) ∈ L := ⟨qₗ, hqₗ', rfl⟩ + have hqᵣR : ((qᵣ • a : S) : G) ∈ R := ⟨qᵣ, hqᵣ', rfl⟩ + have hstratumClosed (z : S) : (z : G) ∈ FiniteArchimedeanClass.closedBall ℚ c := by + rw [← s.ball_sup_stratum_eq c] + exact Submodule.mem_sup_right z.2 + have hxclosed : x ∈ FiniteArchimedeanClass.closedBall ℚ c := by + have hl := hstratumClosed (qₗ • a) + have hr := hstratumClosed (qᵣ • a) + exact FiniteArchimedeanClass.closedBall_ordConnected c |>.out hl hr + ⟨(hxL _ hqₗL).le, (hxR _ hqᵣR).le⟩ + let xClosed : FiniteArchimedeanClass.closedBall ℚ c := ⟨x, hxclosed⟩ + let p := s.closedBallEquivStratumLexBall c xClosed + let z : S := (ofLex p).1 + have hfirst_le_of_mem_L (q : ℚ) (hq : (q : ℝ) * ρ < y) : q • a ≤ z := by + have hqL : ((q • a : S) : G) ∈ L := ⟨q, hq, rfl⟩ + let qClosed : FiniteArchimedeanClass.closedBall ℚ c := + ⟨((q • a : S) : G), hstratumClosed (q • a)⟩ + have hqClosed : s.stratumLexBallEquivClosedBall c + (toLex (q • a, (0 : FiniteArchimedeanClass.ball ℚ c))) = qClosed := by + apply Subtype.ext + rw [s.stratumLexBallEquivClosedBall_apply] + simp [qClosed] + have hlt : s.closedBallEquivStratumLexBall c qClosed < p := by + change s.closedBallEquivStratumLexBall c qClosed < + s.closedBallEquivStratumLexBall c xClosed + apply (s.closedBallEquivStratumLexBall c).toOrderIso.lt_iff_lt.mpr + exact hxL _ hqL + rw [← hqClosed, + s.closedBallEquivStratumLexBall_stratumLexBallEquivClosedBall] at hlt + exact (Prod.Lex.lt_iff.mp hlt).elim (fun h ↦ h.le) (fun h ↦ h.1.le) + have hfirst_ge_of_mem_R (q : ℚ) (hq : y < (q : ℝ) * ρ) : z ≤ q • a := by + have hqR : ((q • a : S) : G) ∈ R := ⟨q, hq, rfl⟩ + let qClosed : FiniteArchimedeanClass.closedBall ℚ c := + ⟨((q • a : S) : G), hstratumClosed (q • a)⟩ + have hqClosed : s.stratumLexBallEquivClosedBall c + (toLex (q • a, (0 : FiniteArchimedeanClass.ball ℚ c))) = qClosed := by + apply Subtype.ext + rw [s.stratumLexBallEquivClosedBall_apply] + simp [qClosed] + have hlt : p < s.closedBallEquivStratumLexBall c qClosed := by + change s.closedBallEquivStratumLexBall c xClosed < + s.closedBallEquivStratumLexBall c qClosed + apply (s.closedBallEquivStratumLexBall c).toOrderIso.lt_iff_lt.mpr + exact hxR _ hqR + rw [← hqClosed, + s.closedBallEquivStratumLexBall_stratumLexBallEquivClosedBall] at hlt + exact (Prod.Lex.lt_iff.mp hlt).elim (fun h ↦ h.le) (fun h ↦ h.1.le) + refine ⟨z, le_antisymm ?_ ?_⟩ + · by_contra hnot + have hyfz : y < f z := lt_of_not_ge hnot + obtain ⟨q, hq₁, hq₂⟩ := + exists_rat_btwn ((div_lt_div_iff_of_pos_right hρ).mpr hyfz) + have hyq : y < (q : ℝ) * ρ := (div_lt_iff₀ hρ).mp hq₁ + have hqfz : (q : ℝ) * ρ < f z := (lt_div_iff₀ hρ).mp hq₂ + have hzq := hfirst_ge_of_mem_R q hyq + have := hfmono.monotone hzq + rw [map_rat_smul] at this + exact (not_le_of_gt hqfz) this + · by_contra hnot + have hfzy : f z < y := lt_of_not_ge hnot + obtain ⟨q, hq₁, hq₂⟩ := + exists_rat_btwn ((div_lt_div_iff_of_pos_right hρ).mpr hfzy) + have hfzq : f z < (q : ℝ) * ρ := (div_lt_iff₀ hρ).mp hq₁ + have hqy : (q : ℝ) * ρ < y := (lt_div_iff₀ hρ).mp hq₂ + have hqz := hfirst_le_of_mem_L q hqy + have := hfmono.monotone hqz + rw [map_rat_smul] at this + exact (not_le_of_gt hfzq) this + exact ⟨{ AddEquiv.ofBijective f ⟨hf, hsurj⟩ with + map_le_map_iff' := hfmono.le_iff_le }⟩ + +@[blueprint "lem:saturated-common-tail-quotient-complete" + (phase := "Bounded generalised-power-series integer parts") + (title := "Cauchy completeness of common-tail quotients") + (statement := /-- + Let $G$ be a $\kappa$-saturated ordered rational vector space. Let $T$ be + a nonempty set of fewer than $\kappa$ nonzero Archimedean classes with no + least member in the magnitude order, and let $H_T$ consist of the + exponents beyond every class in $T$. Then $G/H_T$ is Cauchy complete for + its additive uniformity. + -/) + (proof := /-- + Positive representatives of the classes in $T$ descend to a coinitial + family in $G/H_T$, and rational halving gives arbitrarily small doubled + scales. Every cut between two $T$-indexed families in $G$ is filled by + $\kappa$-saturation; by + \ref{lem:cut-filling-order-reflecting-surjection}, the monotone quotient + map, which reflects strict inequalities, transfers this cut-filling + property to $G/H_T$. Apply + \ref{lem:complete-of-coinitial-scales-and-cut-filling}. + -/)] +private theorem completeSpace_tailQuotient_of_isKappaSaturated + {κ : Cardinal.{u}} (hG : IsKappaSaturated (G := G) κ) + (T : Set (FiniteArchimedeanClass G)) (hT : IsLimitFamily T) (hTcard : #T < κ) : + Nonempty (CompleteSpace (G ⧸ commonTail T)) := by + rw [isLimitFamily_iff] at hT + letI : Nonempty T := Set.nonempty_coe_sort.mpr hT.1 + let Q := G ⧸ commonTail T + let ε : T → Q := fun c ↦ + Submodule.Quotient.mk (FiniteArchimedeanClass.positiveRepresentative c.1) + have hε : ∀ c, 0 < ε c := by + intro c + apply ConvexQuotient.mk_lt_mk_iff.mpr + refine ⟨FiniteArchimedeanClass.positiveRepresentative_pos c.1, ?_⟩ + intro hmem + have hmem' : FiniteArchimedeanClass.positiveRepresentative c.1 ∈ + (commonTail T).toAddSubgroup := by + simpa only [sub_zero] using hmem + have hmem'' : FiniteArchimedeanClass.positiveRepresentative c.1 ∈ commonTail T := hmem' + obtain ⟨d, hdT, hcd⟩ := hT.2 c.1 c.2 + have hdle := mem_commonTail_iff.mp hmem'' ⟨d, hdT⟩ + rw [FiniteArchimedeanClass.mk_positiveRepresentative] at hdle + exact (not_le_of_gt hcd) hdle + have hcoinitial : ∀ x : Q, 0 < x → ∃ c, ε c ≤ x := by + intro x hx + exact FiniteArchimedeanClass.exists_tailQuotient_positiveRepresentative_le hx + have hhalf : ∀ x : Q, 0 < x → ∃ y : Q, 0 < y ∧ y + y ≤ x := by + intro x hx + refine ⟨(2 : ℚ)⁻¹ • x, smul_pos (by norm_num) hx, ?_⟩ + rw [← add_smul] + norm_num + have hfillG : FillsCuts T G := fillsCuts_of_isKappaSaturated hG hTcard + have hfillQ : FillsCuts T Q := FillsCuts.of_surjective + (Submodule.Quotient.mk_surjective (commonTail T)) + (fun _ _ h ↦ ConvexQuotient.mk_le_mk h) + (fun _ _ h ↦ ConvexQuotient.lt_of_mk_lt_mk h) hfillG + exact ⟨completeSpace_of_coinitial_of_exists_half ε hε hcoinitial hhalf hfillQ⟩ + +@[blueprint "lem:saturated-common-tail-cofinality" + (phase := "Bounded generalised-power-series integer parts") + (title := "Cofinality of common tails in saturated ordered groups") + (statement := /-- + Let $\kappa>\aleph_0$, let $G$ be a $\kappa$-saturated ordered rational + vector space, and let $T$ be a nonempty set of fewer than $\kappa$ + nonzero Archimedean classes with no least member in the magnitude order. + Then the common tail $H_T$ has cofinality at least $\kappa$. + -/) + (proof := /-- + If a set $S\subseteq H_T$ of cardinality less than $\kappa$ were cofinal, + use $S\cup\{0\}$ as the left side of a cut. On the right put all rational + fractions of positive representatives of classes in $T$. Saturation + fills the cut by a positive element of $H_T$ lying strictly above every + member of $S$, a contradiction. + -/)] +private theorem cofinal_commonTail_of_isKappaSaturated + {κ : Cardinal.{u}} (hκ : ℵ₀ < κ) (hG : IsKappaSaturated (G := G) κ) + (T : Set (FiniteArchimedeanClass G)) (hT : IsLimitFamily T) (hTcard : #T < κ) : + κ ≤ Order.cof ↑(commonTail T) := by + rw [isKappaSaturated_iff] at hG + rw [isLimitFamily_iff] at hT + rw [Order.le_cof_iff] + intro s hs + by_contra hcard + have hscard : #s < κ := lt_of_not_ge hcard + let L : Set G := {0} ∪ ((↑) : commonTail T → G) '' s + let R : Set G := Set.range fun p : T × ℕ ↦ + ((p.2 + 1 : ℚ)⁻¹) • FiniteArchimedeanClass.positiveRepresentative p.1.1 + have hLcard : #L < κ := by + refine (Cardinal.mk_union_le _ _).trans_lt ?_ + apply Cardinal.add_lt_of_lt hκ.le + · simpa using Cardinal.one_lt_aleph0.trans hκ + · exact Cardinal.mk_image_le.trans_lt hscard + have hprod : #(T × ℕ) < κ := by + simpa using Cardinal.mul_lt_of_lt hκ.le hTcard hκ + have hRcard : #R < κ := Cardinal.mk_range_le.trans_lt hprod + have hLR : ∀ x ∈ L, ∀ y ∈ R, x < y := by + intro x hx y hy + obtain rfl | ⟨z, hz, rfl⟩ := hx + · obtain ⟨⟨c, n⟩, rfl⟩ := hy + exact smul_pos (inv_pos.mpr (by positivity)) + (FiniteArchimedeanClass.positiveRepresentative_pos c.1) + · obtain ⟨⟨c, n⟩, rfl⟩ := hy + by_cases hz0 : (z : G) = 0 + · rw [hz0] + exact smul_pos (inv_pos.mpr (by positivity)) + (FiniteArchimedeanClass.positiveRepresentative_pos c.1) + obtain ⟨d, hdT, hcd⟩ := hT.2 c.1 c.2 + have hzTail : (z : G) ∈ FiniteArchimedeanClass.tailKernel T := + (FiniteArchimedeanClass.mem_tailSubmodule_iff (K := ℚ)).mp z.2 + have hdz : d.1 ≤ ArchimedeanClass.mk (z : G) := + FiniteArchimedeanClass.mem_tailKernel_iff.mp hzTail ⟨d, hdT⟩ + have hcd' : c.1.1 < d.1 := hcd + have hcz : c.1.1 < ArchimedeanClass.mk (z : G) := hcd'.trans_le hdz + rcases le_total (z : G) 0 with hzneg | hznonneg + · exact hzneg.trans_lt (smul_pos (inv_pos.mpr (by positivity)) + (FiniteArchimedeanClass.positiveRepresentative_pos c.1)) + · apply ArchimedeanClass.lt_of_mk_lt_mk_of_nonneg + · rw [ArchimedeanClass.mk_smul _ (inv_ne_zero (by positivity)), + FiniteArchimedeanClass.mk_positiveRepresentative] + exact hcz + · exact smul_nonneg (inv_nonneg.mpr (by positivity)) + (FiniteArchimedeanClass.positiveRepresentative_pos c.1).le + obtain ⟨y, hyL, hyR⟩ := hG L R hLcard hRcard hLR + have hypos : 0 < y := hyL 0 (Set.mem_union_left _ (Set.mem_singleton 0)) + have hyright (c : T) (n : ℕ) : + y < ((n + 1 : ℚ)⁻¹) • FiniteArchimedeanClass.positiveRepresentative c.1 := + hyR _ (Set.mem_range_self (c, n)) + have hyTail : y ∈ commonTail T := by + rw [FiniteArchimedeanClass.mem_tailSubmodule_iff, + FiniteArchimedeanClass.mem_tailKernel_iff] + intro c + obtain ⟨d, hdT, hcd⟩ := hT.2 c.1 c.2 + have hcd' : c.1.1 < d.1 := hcd + apply hcd'.le.trans + rw [← FiniteArchimedeanClass.mk_positiveRepresentative d, + ArchimedeanClass.mk_le_mk] + refine ⟨1, ?_⟩ + rw [abs_of_pos (FiniteArchimedeanClass.positiveRepresentative_pos d), abs_of_pos hypos] + simpa using (hyright ⟨d, hdT⟩ 0).le + have hnot : ¬ IsCofinal s := by + rw [not_isCofinal_iff] + exact ⟨⟨y, hyTail⟩, fun z hz ↦ + hyL (z : G) (Set.mem_union_right _ (Set.mem_image_of_mem _ hz))⟩ + exact hnot hs + +@[blueprint "lem:saturated-inner-ball-cofinality" + (phase := "Bounded generalised-power-series integer parts") + (title := "Cofinality of Archimedean inner balls in saturated ordered groups") + (statement := /-- + Let $\kappa>\aleph_0$ and let $G$ be a $\kappa$-saturated ordered rational + vector space. At every nonzero Archimedean class, the strict inner ball + has cofinality at least $\kappa$. + -/) + (proof := /-- + If a set $S$ of cardinality less than $\kappa$ were cofinal in the strict + inner ball below the class of $a\ne0$, place $S\cup\{0\}$ on the left of a + cut and the elements $|a|/(n+1)$ on the right. Saturation gives a positive + element still in the strict inner ball and strictly above $S$, a + contradiction. + -/)] +private theorem le_cof_ball_of_isKappaSaturated + {κ : Cardinal.{u}} (hκ : ℵ₀ < κ) (hG : IsKappaSaturated (G := G) κ) + (c : FiniteArchimedeanClass G) : + κ ≤ Order.cof ↑(FiniteArchimedeanClass.ball ℚ c) := by + rw [isKappaSaturated_iff] at hG + induction c using FiniteArchimedeanClass.ind with + | mk a ha => + rw [Order.le_cof_iff] + intro s hs + by_contra hcard + have hscard : #s < κ := lt_of_not_ge hcard + let L : Set G := {0} ∪ + (fun z : FiniteArchimedeanClass.ball ℚ (FiniteArchimedeanClass.mk a ha) ↦ + (z : G)) '' s + let R : Set G := Set.range fun n : ℕ ↦ ((n + 1 : ℚ)⁻¹) • |a| + have hLcard : #L < κ := by + refine (Cardinal.mk_union_le _ _).trans_lt ?_ + apply Cardinal.add_lt_of_lt hκ.le + · simpa using Cardinal.one_lt_aleph0.trans hκ + · exact Cardinal.mk_image_le.trans_lt hscard + have hRle : #R ≤ Cardinal.lift.{u} #ℕ := by + simpa only [R, Cardinal.lift_uzero] using + Cardinal.lift_mk_le_lift_mk_of_surjective + (Set.rangeFactorization_surjective + (f := fun n : ℕ ↦ ((n + 1 : ℚ)⁻¹) • |a|)) + have hRcard : #R < κ := hRle.trans_lt (by + rw [Cardinal.mk_nat, Cardinal.lift_aleph0] + exact hκ) + have hLR : ∀ x ∈ L, ∀ y ∈ R, x < y := by + intro x hx y hy + obtain rfl | ⟨z, hz, rfl⟩ := hx + · obtain ⟨n, rfl⟩ := hy + exact smul_pos (inv_pos.mpr (by positivity)) (abs_pos.mpr ha) + · obtain ⟨n, rfl⟩ := hy + by_cases hz0 : (z : G) = 0 + · change (z : G) < ((n + 1 : ℚ)⁻¹) • |a| + rw [hz0] + exact smul_pos (inv_pos.mpr (by positivity)) (abs_pos.mpr ha) + have hzclass : ArchimedeanClass.mk a < ArchimedeanClass.mk (z : G) := by + have hzclass' := (FiniteArchimedeanClass.mem_ball_iff ℚ).mp z.property hz0 + exact hzclass' + apply ArchimedeanClass.lt_of_mk_lt_mk_of_nonneg + · rw [ArchimedeanClass.mk_smul _ (inv_ne_zero (by positivity)), + ArchimedeanClass.mk_abs] + exact hzclass + · exact smul_nonneg (inv_nonneg.mpr (by positivity)) (abs_nonneg a) + obtain ⟨y, hyL, hyR⟩ := hG L R hLcard hRcard hLR + have hypos : 0 < y := hyL 0 (Set.mem_union_left _ (Set.mem_singleton 0)) + have hyright (n : ℕ) : y < ((n + 1 : ℚ)⁻¹) • |a| := + hyR _ (Set.mem_range_self n) + have hyball : y ∈ FiniteArchimedeanClass.ball ℚ + (FiniteArchimedeanClass.mk a ha) := by + rw [FiniteArchimedeanClass.mem_ball_iff] + intro hy0 + rw [FiniteArchimedeanClass.mk_lt_mk ha hy0, ArchimedeanClass.mk_lt_mk] + intro n + rw [abs_of_pos hypos] + obtain rfl | hn := n.eq_zero_or_pos + · simpa using abs_pos.mpr ha + · have hbound := hyright (n - 1) + have hcast : (((n - 1 : ℕ) : ℚ) + 1) = n := by + exact_mod_cast Nat.sub_add_cancel hn + rw [hcast] at hbound + have hnQ : (0 : ℚ) < n := by exact_mod_cast hn + have hnQ0 : (n : ℚ) ≠ 0 := by exact_mod_cast hn.ne' + have hmul := smul_lt_smul_of_pos_left hbound hnQ + simpa only [smul_smul, mul_inv_cancel₀ hnQ0, one_smul, + Nat.cast_smul_eq_nsmul] using hmul + have hnot : ¬ IsCofinal s := by + rw [not_isCofinal_iff] + exact ⟨⟨y, hyball⟩, fun z hz ↦ + hyL (z : G) (Set.mem_union_right _ (Set.mem_image_of_mem _ hz))⟩ + exact hnot hs + +/-- The standalone form of `(A1)` is exactly LM24's condition at every nonzero class. -/ +theorem assumptionA1_iff_lm24 (s : HahnEmbedding.ArchimedeanStrata ℚ G) : + AssumptionA1 s ↔ ∀ c, LM24.AssumptionA1AtFiniteClass s c := by + rw [assumptionA1_iff] + exact forall_congr' fun c ↦ (LM24.assumptionA1AtFiniteClass_iff s c).symm + +/-- Generating `R` by fractions is equivalent to the fraction subring being all of `R`. -/ +theorem generatesFractionField_iff_fracSubring_eq_top (Z : Subring R) : + GeneratesFractionField Z ↔ Subring.fracSubring Z = ⊤ := by + rw [generatesFractionField_iff] + constructor + · intro h + apply top_unique + intro x _ + obtain ⟨a, b, _hb, rfl⟩ := h x + rw [div_eq_mul_inv] + exact (Subring.fracSubring Z).mul_mem (Subring.le_fracSubring a.2) + (Subring.inv_mem_fracSubring (Subring.le_fracSubring b.2)) + · intro h x + have hx : x ∈ Subring.fracSubring Z := by rw [h]; trivial + obtain ⟨b, hb, hb0, hbx⟩ := Subring.exists_den hx + have hbZ0 : (⟨b, hb⟩ : Z) ≠ 0 := fun hzero ↦ hb0 (congrArg Subtype.val hzero) + refine ⟨⟨b * x, hbx⟩, ⟨b, hb⟩, hbZ0, ?_⟩ + change x = (b * x) / b + exact (mul_div_cancel_left₀ x hb0).symm + +omit [Module ℚ G] [IsOrderedModule ℚ G] in +/-- The standalone fraction-field condition is the corresponding fraction-subring equality. -/ +theorem isFractionFieldOfHahnIntegerPart_iff_fracSubring_eq_top + {κ : Cardinal} [Fact (ℵ₀ < κ)] (Z : Subring R) : + IsFractionFieldOfHahnIntegerPart (G := G) Z κ ↔ + Subring.fracSubring (HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z) = ⊤ := by + rw [isFractionFieldOfHahnIntegerPart_iff] + let S := HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z + constructor + · intro h + apply top_unique + intro x _ + obtain ⟨a₀, b₀, ha₀, hb₀, hb₀ne, hx⟩ := h (x : HahnSeries G R) x.2 + have ha₀' := (mem_hahnIntegerPart_iff.mp ha₀) + have hb₀' := (mem_hahnIntegerPart_iff.mp hb₀) + let a : HahnSeries.CardSuppLTField (G := G) (R := R) (κ := κ) := ⟨a₀, ha₀'.1⟩ + let b : HahnSeries.CardSuppLTField (G := G) (R := R) (κ := κ) := ⟨b₀, hb₀'.1⟩ + have haS : a ∈ S := by + rw [HahnSeries.mem_cardSuppLTTruncationIntegerPart] + exact ⟨ha₀'.2.1, ha₀'.2.2⟩ + have hbS : b ∈ S := by + rw [HahnSeries.mem_cardSuppLTTruncationIntegerPart] + exact ⟨hb₀'.2.1, hb₀'.2.2⟩ + have hxb : x = a / b := by + apply Subtype.ext + exact hx + rw [hxb, div_eq_mul_inv] + exact (Subring.fracSubring S).mul_mem (Subring.le_fracSubring haS) + (Subring.inv_mem_fracSubring (Subring.le_fracSubring hbS)) + · intro h x hx + let X : HahnSeries.CardSuppLTField (G := G) (R := R) (κ := κ) := ⟨x, hx⟩ + have hXF : X ∈ Subring.fracSubring S := by + rw [h] + trivial + obtain ⟨b, hbS, hb0, hbX⟩ := Subring.exists_den hXF + have hb0' : (b : HahnSeries G R) ≠ 0 := by + intro hzero + apply hb0 + exact Subtype.ext hzero + refine ⟨((b * X : HahnSeries.CardSuppLTField (G := G) (R := R) (κ := κ)) : + HahnSeries G R), (b : HahnSeries G R), ?_, ?_, hb0', ?_⟩ + · rw [mem_hahnIntegerPart_iff] + exact ⟨(b * X).2, + (HahnSeries.mem_cardSuppLTTruncationIntegerPart.mp hbX).1, + (HahnSeries.mem_cardSuppLTTruncationIntegerPart.mp hbX).2⟩ + · rw [mem_hahnIntegerPart_iff] + exact ⟨b.2, + (HahnSeries.mem_cardSuppLTTruncationIntegerPart.mp hbS).1, + (HahnSeries.mem_cardSuppLTTruncationIntegerPart.mp hbS).2⟩ + · change x = ((b : HahnSeries G R) * x) / (b : HahnSeries G R) + exact (mul_div_cancel_left₀ x hb0').symm + +/-- Saturation supplies the two common-tail hypotheses of the bounded Hahn theorem. -/ +@[blueprint "lem:saturated-common-tail-conditions" + (phase := "Bounded generalised-power-series integer parts") + (title := "Common-tail conditions in saturated ordered groups") + (statement := /-- + Let $\kappa>\aleph_0$, let $G$ be a $\kappa$-saturated ordered rational + vector space, and let $Z$ be a subring of a field $R$. For every nonempty + set $T$ of fewer than $\kappa$ nonzero Archimedean classes with no least + member in the magnitude order, the quotient $G/H_T$ is Cauchy complete in + its additive uniformity, and the bounded Hahn field $R((H_T))_\kappa$ is + the fraction field of $Z+R((H_T^{<0}))_\kappa$. + -/) + (proof := /-- + Quotient completeness follows from + \ref{lem:saturated-common-tail-quotient-complete}. By + \ref{lem:saturated-common-tail-cofinality}, + $\kappa\le\operatorname{cof}(H_T)$; hence + \ref{thm:bounded-hahn-integer-part-fraction-field} gives the asserted + fraction-field equality. + -/)] +private theorem limitTailConditions_of_isKappaSaturated + {κ : Cardinal.{u}} [Fact (ℵ₀ < κ)] (Z : Subring R) + (hG : IsKappaSaturated (G := G) κ) : LimitTailConditions (G := G) Z κ := by + constructor + · intro T hT hTcard + exact completeSpace_tailQuotient_of_isKappaSaturated hG T hT hTcard + · intro T hT hTcard + apply (isFractionFieldOfHahnIntegerPart_iff_fracSubring_eq_top + (G := commonTail T) Z).mpr + exact HahnSeries.fracSubring_cardSuppLTTruncationIntegerPart_eq_top_of_le_cof Z + (cofinal_commonTail_of_isKappaSaturated Fact.out hG T hT hTcard) + +/-- The standalone disjunction `(A2)` is exactly LM24's condition at every nonzero class. -/ +theorem assumptionA2_iff_lm24 (Z : Subring R) (κ : Cardinal) : + AssumptionA2 (G := G) Z κ ↔ + ∀ c : FiniteArchimedeanClass G, + LM24.AssumptionA2AtFiniteClass (K := ℚ) κ Z c := by + rw [assumptionA2_iff] + apply forall_congr' + intro c + rw [LM24.assumptionA2AtFiniteClass_iff] + constructor + · rintro (hcof | ⟨hzero, hfrac⟩) + · exact Or.inl hcof + · exact Or.inr ⟨hzero, (generatesFractionField_iff_fracSubring_eq_top Z).mp hfrac⟩ + · rintro (hcof | ⟨hzero, hfrac⟩) + · exact Or.inl hcof + · exact Or.inr ⟨hzero, (generatesFractionField_iff_fracSubring_eq_top Z).mpr hfrac⟩ + +/-- The standalone form of `(A3)` says exactly that `Z` is pre-Schreier. -/ +theorem assumptionA3_iff_decompositionMonoid (Z : Subring R) : + AssumptionA3 Z ↔ DecompositionMonoid Z := by + rw [assumptionA3_iff] + constructor + · intro h + rw [decompositionMonoid_iff] + intro z a b hab + exact h z a b hab + · intro h + rw [decompositionMonoid_iff] at h + intro z a b hab + exact h z hab + +/-- Conditions `(A1)`--`(A3)` and the common-tail conditions make the bounded Hahn integer part +pre-Schreier. -/ +@[blueprint "thm:hahn-integer-part-pre-schreier" + (phase := "Bounded generalised-power-series integer parts") + (title := "Pre-Schreier property of bounded Hahn integer parts") + (statement := /-- + Let $G$ be an ordered rational vector space, $R$ a field of characteristic + zero, $\kappa>\aleph_0$ a regular cardinal, and $Z\subseteq R$ a + pre-Schreier subring. Choose an additive complement to the strict inner + ball at every nonzero Archimedean class. Assume every complement is order + additively isomorphic to $\mathbb R$, and that at each such class either + the strict inner ball has cofinality at least $\kappa$, or it is zero and + every element of $R$ is a fraction of elements of $Z$. + + For every nonempty set $T$ of fewer than $\kappa$ nonzero Archimedean + classes having no least member in the magnitude order, let $H_T$ be the + rational subspace of exponents lying beyond every class in $T$. Assume + that $G/H_T$ is Cauchy complete for its additive uniformity and that the + bounded Hahn field on $H_T$ is the fraction field of its bounded Hahn + integer part. Then $Z+R((G^{<0}))_\kappa$ is pre-Schreier. + -/) + (proof := /-- + The real-complement and inner-ball hypotheses are LM24 conditions $(A1)$ + and $(A2)$, while the pre-Schreier hypothesis on $Z$ is condition $(A3)$. + By \ref{thm:hahn-integer-part-primality}, every element of the bounded Hahn + integer part is primal. This is exactly the pre-Schreier property. + -/)] +theorem decompositionMonoid_of_assumptions [CharZero R] + {κ : Cardinal} [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + (Z : Subring R) (s : HahnEmbedding.ArchimedeanStrata ℚ G) + (hA1 : AssumptionA1 s) (hA2 : AssumptionA2 (G := G) Z κ) + (hA3 : AssumptionA3 Z) (hlimit : LimitTailConditions (G := G) Z κ) : + DecompositionMonoid (HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z) := by + letI : DecompositionMonoid Z := (assumptionA3_iff_decompositionMonoid Z).mp hA3 + rw [decompositionMonoid_iff] + intro x + apply isPrimal_of_finite_class_assumptions_and_limit_tail_conditions Z s + ((assumptionA1_iff_lm24 s).mp hA1) ((assumptionA2_iff_lm24 Z κ).mp hA2) + · intro T hTne hTgt hTcard + obtain ⟨hcomplete⟩ := + hlimit.cauchy_complete_quotient T (isLimitFamily_iff.mpr ⟨hTne, hTgt⟩) hTcard + letI := hcomplete + exact ⟨(commonTailUniformEquiv (G := G) T).completeSpace_iff.mp inferInstance⟩ + · intro T hTne hTgt hTcard + have hfraction := hlimit.fraction_field_commonTail T + (isLimitFamily_iff.mpr ⟨hTne, hTgt⟩) hTcard + rw [commonTail_eq_tailSubmodule] at hfraction + exact (isFractionFieldOfHahnIntegerPart_iff_fracSubring_eq_top + (G := _root_.FiniteArchimedeanClass.tailSubmodule ℚ T) Z).mp hfraction + +/-- Saturation makes the bounded Hahn integer part pre-Schreier. -/ +@[blueprint "cor:hahn-integer-part-pre-schreier-of-saturation" + (phase := "Bounded generalised-power-series integer parts") + (title := "Pre-Schreier Hahn integer parts over saturated exponent groups") + (statement := /-- + Let $\kappa>\aleph_0$ be regular, let $G$ be a $\kappa$-saturated ordered + rational vector space, let $R$ be a field of characteristic zero, and let + $Z\subseteq R$ be pre-Schreier. Then + $Z+R((G^{<0}))_\kappa$ is pre-Schreier. + -/) + (proof := /-- + Saturation gives real Archimedean strata by + \ref{lem:saturated-archimedean-strata-real}, the cofinal alternative in + condition $(A2)$ by \ref{lem:saturated-inner-ball-cofinality}, and the + completeness and fraction-field conditions at common tails by + \ref{lem:saturated-common-tail-conditions}. These are the hypotheses of + \ref{thm:hahn-integer-part-pre-schreier}. + -/)] +theorem decompositionMonoid_of_saturation [CharZero R] + {κ : Cardinal} [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + (Z : Subring R) (hA3 : AssumptionA3 Z) (hG : IsKappaSaturated (G := G) κ) : + DecompositionMonoid (HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z) := by + let s : HahnEmbedding.ArchimedeanStrata ℚ G := Classical.choice inferInstance + have hA1 : AssumptionA1 s := by + rw [assumptionA1_iff] + exact stratum_orderAddEquiv_real_of_isKappaSaturated Fact.out hG s + have hA2 : AssumptionA2 (G := G) Z κ := by + rw [assumptionA2_iff] + intro c + exact Or.inl (le_cof_ball_of_isKappaSaturated Fact.out hG c) + have hlimit := limitTailConditions_of_isKappaSaturated Z hG + exact decompositionMonoid_of_assumptions Z s hA1 hA2 hA3 hlimit + +/-- Conditions `(A1)`--`(A3)` and the common-tail conditions imply four-factor refinement. -/ +@[blueprint "thm:hahn-integer-part-refinement" + (phase := "Bounded generalised-power-series integer parts") + (title := "Refinement of bounded generalised-power-series integer parts") + (statement := /-- + Under the hypotheses of \ref{thm:hahn-integer-part-pre-schreier}, every + equality $ab=cd$ in $Z+R((G^{<0}))_\kappa$ admits elements + $e,f,g,h$ in the same ring such that + \[ + a=ef,\qquad b=gh,\qquad c=eg,\qquad d=fh. + \] + -/) + (proof := /-- + By \ref{thm:hahn-integer-part-pre-schreier}, the bounded + generalised-power-series integer part is pre-Schreier. The standard + equivalence between primality of every element and four-factor refinement + gives the displayed factors, which are then viewed as elements of the + ambient generalised-power-series field. + -/) + (highlight)] +theorem of_assumptions : HahnIntegerPartRefinementCriterion (G := G) (R := R) := by + intro hR + letI : CharZero R := hR + intro κ hκcountable hκregular Z s hA1 hA2 hA3 hlimit + letI : Fact (ℵ₀ < κ) := ⟨hκcountable⟩ + letI : Fact κ.IsRegular := ⟨hκregular⟩ + let S := HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z + letI : DecompositionMonoid S := + decompositionMonoid_of_assumptions Z s hA1 hA2 hA3 hlimit + let inclusion : HahnSeries.CardSuppLTField (G := G) (R := R) (κ := κ) →+* + HahnSeries G R := (HahnSeries.cardSuppLTSubfield G R κ).subtype + let E := Subring.equivMapOfInjective S inclusion Subtype.val_injective + letI : DecompositionMonoid (S.map inclusion) := + MulEquiv.decompositionMonoid E.symm.toMulEquiv + have hmem (x : HahnSeries G R) : x ∈ S.map inclusion ↔ x ∈ hahnIntegerPart Z κ := by + rw [Subring.mem_map, mem_hahnIntegerPart_iff] + constructor + · rintro ⟨y, hy, rfl⟩ + have hy' := (HahnSeries.mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp hy + exact ⟨y.2, hy'.1, hy'.2⟩ + · rintro ⟨hxcard, hxsupp, hxzero⟩ + refine ⟨⟨x, hxcard⟩, ?_, rfl⟩ + exact (HahnSeries.mem_cardSuppLTTruncationIntegerPart (Z := Z)).mpr ⟨hxsupp, hxzero⟩ + intro a b c d ha hb hc hd habcd + simpa only [hmem] using + Subring.exists_fourFactorRefinement_of_decompositionMonoid (S.map inclusion) + (hmem a |>.mpr ha) (hmem b |>.mpr hb) (hmem c |>.mpr hc) (hmem d |>.mpr hd) habcd + +/-- Saturation supplies `(A1)`, `(A2)`, quotient completeness, and the common-tail +fraction-field condition. -/ +@[blueprint "cor:hahn-integer-part-refinement-of-saturation" + (phase := "Bounded generalised-power-series integer parts") + (title := "Refinement over saturated exponent groups") + (statement := /-- + Let $\kappa>\aleph_0$ be regular, let $G$ be a $\kappa$-saturated ordered + rational vector space, let $R$ be a field of characteristic zero, and let + $Z\subseteq R$ be pre-Schreier. Then every equality + $ab=cd$ in $Z+R((G^{<0}))_\kappa$ has a refinement + \[ + a=ef,\qquad b=gh,\qquad c=eg,\qquad d=fh + \] + in the same ring. + -/) + (proof := /-- + By \ref{lem:saturated-archimedean-strata-real}, saturation supplies + condition $(A1)$. By \ref{lem:saturated-inner-ball-cofinality}, it also + supplies the cofinal alternative in condition $(A2)$ at every nonzero + Archimedean class. For each limit family, + \ref{lem:saturated-common-tail-conditions} supplies quotient completeness + and says that every bounded common-tail series is a fraction of two + elements of the bounded common-tail Hahn integer part. These are all the + hypotheses of + \ref{thm:hahn-integer-part-refinement}. + -/)] +theorem of_saturation [CharZero R] + {κ : Cardinal.{u}} (hκcount : ℵ₀ < κ) (hκregular : κ.IsRegular) + (Z : Subring R) (hA3 : AssumptionA3 Z) (hG : IsKappaSaturated (G := G) κ) : + ∀ a b c d : HahnSeries G R, + a ∈ hahnIntegerPart Z κ → b ∈ hahnIntegerPart Z κ → + c ∈ hahnIntegerPart Z κ → d ∈ hahnIntegerPart Z κ → a * b = c * d → + ∃ e f g h : HahnSeries G R, + e ∈ hahnIntegerPart Z κ ∧ f ∈ hahnIntegerPart Z κ ∧ + g ∈ hahnIntegerPart Z κ ∧ h ∈ hahnIntegerPart Z κ ∧ + a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h := by + letI : Fact (ℵ₀ < κ) := ⟨hκcount⟩ + letI : Fact κ.IsRegular := ⟨hκregular⟩ + let s : HahnEmbedding.ArchimedeanStrata ℚ G := Classical.choice inferInstance + have hA1 : AssumptionA1 s := by + rw [assumptionA1_iff] + exact stratum_orderAddEquiv_real_of_isKappaSaturated hκcount hG s + have hA2 : AssumptionA2 (G := G) Z κ := by + rw [assumptionA2_iff] + intro c + exact Or.inl (le_cof_ball_of_isKappaSaturated hκcount hG c) + have hlimit := limitTailConditions_of_isKappaSaturated Z hG + exact of_assumptions (inferInstance : CharZero R) κ hκcount hκregular + Z s hA1 hA2 hA3 hlimit + +private def integerCoefficientSubring : Subring R := + (Int.castRingHom R).range + +private noncomputable def integerCoefficientSubringEquiv [CharZero R] : + ℤ ≃+* integerCoefficientSubring (R := R) := + RingEquiv.ofBijective (Int.castRingHom R).rangeRestrict + ⟨Int.cast_injective, RingHom.rangeRestrict_surjective _⟩ + +private theorem integerCoefficientSubring_preSchreier [CharZero R] : + AssumptionA3 (integerCoefficientSubring (R := R)) := by + apply assumptionA3_iff.mpr + intro z + let e := integerCoefficientSubringEquiv (R := R) + change IsPrimal z + rw [← e.apply_symm_apply z] + exact (RingEquiv.isPrimal_iff e (e.symm z)).mpr + (DecompositionMonoid.primal (e.symm z)) + +omit [IsOrderedAddMonoid G] [Module ℚ G] [IsOrderedModule ℚ G] in +private theorem mem_hahnIntegerPart_integerCoefficientSubring_iff + {κ : Cardinal.{u}} {x : HahnSeries G R} : + x ∈ hahnIntegerPart (integerCoefficientSubring (R := R)) κ ↔ + x ∈ integerHahnPart κ := by + rw [mem_hahnIntegerPart_iff, mem_integerHahnPart_iff] + constructor + · rintro ⟨hcard, hsupp, ⟨z, hz⟩⟩ + exact ⟨hcard, hsupp, z, hz⟩ + · rintro ⟨hcard, hsupp, z, hz⟩ + exact ⟨hcard, hsupp, ⟨z, hz⟩⟩ + +/-- Uncountable regular saturation implies refinement with integer constant coefficients. -/ +@[blueprint "cor:integer-hahn-refinement-of-saturation" + (phase := "Bounded generalised-power-series integer parts") + (title := "Refinement of saturated Hahn integer parts with integer constants") + (statement := /-- + Let $\kappa>\aleph_0$ be regular, let $G$ be a $\kappa$-saturated ordered + rational vector space, and let $R$ be a field of characteristic zero. + Then every equality $ab=cd$ in + $\mathbb Z+R((G^{<0}))_\kappa$ has a refinement + \[ + a=ef,\qquad b=gh,\qquad c=eg,\qquad d=fh + \] + in the same ring. + -/) + (proof := /-- + The image of $\mathbb Z$ in $R$ is pre-Schreier. Apply + \ref{cor:hahn-integer-part-refinement-of-saturation} with + this coefficient ring and rewrite membership as the requirement that the + constant coefficient be an integer. + -/)] +theorem of_saturation_integer_coefficients [CharZero R] : + HahnIntegerPartRefinement (G := G) (R := R) := by + intro κ hκcount hκregular hG a b c d ha hb hc hd habcd + have hrefine := of_saturation (G := G) (R := R) hκcount hκregular + (integerCoefficientSubring (R := R)) + (integerCoefficientSubring_preSchreier (R := R)) hG + simpa only [mem_hahnIntegerPart_integerCoefficientSubring_iff] using + hrefine a b c d + (mem_hahnIntegerPart_integerCoefficientSubring_iff.mpr ha) + (mem_hahnIntegerPart_integerCoefficientSubring_iff.mpr hb) + (mem_hahnIntegerPart_integerCoefficientSubring_iff.mpr hc) + (mem_hahnIntegerPart_integerCoefficientSubring_iff.mpr hd) habcd + +end ConwayRefinement.Standalone.Hahn.HahnIntegerPartRefinement diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnLimitTailQuotient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnLimitTailQuotient.lean new file mode 100644 index 0000000000..adcaddc0c4 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnLimitTailQuotient.lean @@ -0,0 +1,149 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotientSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.OrderedAddGroup +public import Mathlib.Algebra.Algebra.Rat +public import Mathlib.Algebra.Order.Module.Rat +public import Mathlib.Topology.Algebra.IsUniformGroup.Basic + +/-! +# Ordered common-tail quotients + +A family of finite Archimedean classes determines a common convex rational subspace. Its quotient +is ordered by representatives and carries its order topology and right uniformity. These are the +explicit Hahn exponent quotients used in the limit hypothesis of the standalone Conway theorem. +-/ + +open Set + +universe u + +public noncomputable section + +namespace ConwayRefinement.Standalone.Hahn + +namespace FiniteArchimedeanClass + +variable {G : Type u} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module ℚ G] [PosSMulMono ℚ G] + +/-- The ordered rational quotient by the common tail of a family of finite Archimedean +classes. -/ +abbrev TailQuotient (T : Set (FiniteArchimedeanClass G)) := G ⧸ tailSubmodule ℚ T + +noncomputable instance tailQuotientLinearOrder (T : Set (FiniteArchimedeanClass G)) : + LinearOrder (TailQuotient T) := + ConvexQuotient.instLinearOrder (H := (tailSubmodule ℚ T).toAddSubgroup) + +instance tailQuotientIsOrderedAddMonoid (T : Set (FiniteArchimedeanClass G)) : + IsOrderedAddMonoid (TailQuotient T) := + ConvexQuotient.instIsOrderedAddMonoid (H := (tailSubmodule ℚ T).toAddSubgroup) + +instance tailQuotientPosSMulMono (T : Set (FiniteArchimedeanClass G)) : + PosSMulMono ℚ (TailQuotient T) where + smul_le_smul_of_nonneg_left q hq x y hxy := by + change ∃ a b : G, Submodule.Quotient.mk a = x ∧ + Submodule.Quotient.mk b = y ∧ a ≤ b at hxy + obtain ⟨a, b, ha, hb, hab⟩ := hxy + change ∃ a b : G, Submodule.Quotient.mk a = q • x ∧ + Submodule.Quotient.mk b = q • y ∧ a ≤ b + refine ⟨q • a, q • b, ?_, ?_, smul_le_smul_of_nonneg_left hab hq⟩ + · simpa only [Submodule.Quotient.mk_smul] using congrArg (q • ·) ha + · simpa only [Submodule.Quotient.mk_smul] using congrArg (q • ·) hb + +instance tailQuotientPosSMulStrictMono (T : Set (FiniteArchimedeanClass G)) : + PosSMulStrictMono ℚ (TailQuotient T) := PosSMulMono.toPosSMulStrictMono + +noncomputable instance tailQuotientTopologicalSpace (T : Set (FiniteArchimedeanClass G)) : + TopologicalSpace (TailQuotient T) := Preorder.topology (TailQuotient T) + +instance tailQuotientOrderTopology (T : Set (FiniteArchimedeanClass G)) : + OrderTopology (TailQuotient T) := ⟨rfl⟩ + +instance tailQuotientDenselyOrdered (T : Set (FiniteArchimedeanClass G)) : + DenselyOrdered (TailQuotient T) := by + constructor + intro a b hab + refine ⟨(2 : ℚ)⁻¹ • (a + b), ?_, ?_⟩ + · calc + a = (2 : ℚ)⁻¹ • (a + a) := by rw [smul_add, ← add_smul]; norm_num + _ < (2 : ℚ)⁻¹ • (a + b) := smul_lt_smul_of_pos_left + (add_lt_add_left hab a |>.trans_eq (add_comm _ _)) (by norm_num) + · calc + (2 : ℚ)⁻¹ • (a + b) < (2 : ℚ)⁻¹ • (b + b) := + smul_lt_smul_of_pos_left + (by simpa [add_comm] using add_lt_add_left hab b) (by norm_num) + _ = b := by rw [smul_add, ← add_smul]; norm_num + +instance tailQuotientIsTopologicalAddGroup (T : Set (FiniteArchimedeanClass G)) : + IsTopologicalAddGroup (TailQuotient T) where + toContinuousAdd := continuousAdd_of_orderTopology (TailQuotient T) + toContinuousNeg := continuousNeg_of_orderTopology (TailQuotient T) + +noncomputable instance tailQuotientUniformSpace (T : Set (FiniteArchimedeanClass G)) : + UniformSpace (TailQuotient T) := + IsTopologicalAddGroup.rightUniformSpace (TailQuotient T) + +instance tailQuotientIsUniformAddGroup (T : Set (FiniteArchimedeanClass G)) : + IsUniformAddGroup (TailQuotient T) := isUniformAddGroup_of_addCommGroup + +/-- Absolute value commutes with projection to a rational tail quotient. -/ +theorem tailQuotient_abs (T : Set (FiniteArchimedeanClass G)) (x : G) : + |(Submodule.Quotient.mk x : TailQuotient T)| = Submodule.Quotient.mk |x| := by + rcases le_total 0 x with hx | hx + · have hxq : (0 : TailQuotient T) ≤ Submodule.Quotient.mk x := by + rw [← Submodule.Quotient.mk_zero] + exact ConvexQuotient.mk_le_mk hx + rw [abs_of_nonneg hx, abs_of_nonneg hxq] + · have hxq : (Submodule.Quotient.mk x : TailQuotient T) ≤ 0 := by + rw [← Submodule.Quotient.mk_zero] + exact ConvexQuotient.mk_le_mk hx + rw [abs_of_nonpos hx, abs_of_nonpos hxq, ← Submodule.Quotient.mk_neg] + +/-- A strict class comparison in a rational tail quotient reflects to representatives. -/ +theorem archimedeanClass_mk_lt_of_tailQuotient_mk_lt + (T : Set (FiniteArchimedeanClass G)) {x y : G} + (h : ArchimedeanClass.mk (Submodule.Quotient.mk x : TailQuotient T) < + ArchimedeanClass.mk (Submodule.Quotient.mk y : TailQuotient T)) : + ArchimedeanClass.mk x < ArchimedeanClass.mk y := by + rw [ArchimedeanClass.mk_lt_mk] at h ⊢ + intro n + have hn := h n + have hn' : (Submodule.Quotient.mk (n • |y|) : TailQuotient T) < + Submodule.Quotient.mk |x| := by + have heq : (Submodule.Quotient.mk (n • |y|) : TailQuotient T) = + n • Submodule.Quotient.mk |y| := by + change QuotientAddGroup.mk' _ (n • |y|) = n • QuotientAddGroup.mk' _ |y| + exact map_nsmul (QuotientAddGroup.mk' _) n |y| + rw [heq] + simpa only [tailQuotient_abs] using hn + exact ConvexQuotient.lt_of_mk_lt_mk hn' + +/-- Canonical representatives of a limit family are coinitial in its rational tail quotient. -/ +theorem exists_tailQuotient_positiveRepresentative_le + {T : Set (FiniteArchimedeanClass G)} + {x : TailQuotient T} (hx : 0 < x) : + ∃ c : T, (Submodule.Quotient.mk (positiveRepresentative c.1) : TailQuotient T) ≤ x := by + induction x using Submodule.Quotient.induction_on with + | H x => + have hxq : (Submodule.Quotient.mk (0 : G) : TailQuotient T) < + Submodule.Quotient.mk x := by + simpa using hx + have hx0 : 0 < x := ConvexQuotient.lt_of_mk_lt_mk hxq + have hxP : x ∉ tailSubmodule ℚ T := by + simpa using (ConvexQuotient.mk_lt_mk_iff.mp hxq).2 + rw [mem_tailSubmodule_iff, mem_tailKernel_iff] at hxP + push Not at hxP + obtain ⟨c, hxc⟩ := hxP + refine ⟨c, ConvexQuotient.mk_le_mk ?_⟩ + apply (ArchimedeanClass.lt_of_mk_lt_mk_of_nonneg ?_ hx0.le).le + rwa [mk_positiveRepresentative] + +end FiniteArchimedeanClass + +end ConwayRefinement.Standalone.Hahn diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesGCDProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesGCDProof.lean new file mode 100644 index 0000000000..a94e3bb1bf --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesGCDProof.lean @@ -0,0 +1,89 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCD +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.SeriesConsequences +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Primality + +/-! +# Proofs of the Mathlib-only gcd and primality statements + +The standalone ring `nonpos K` is `K((ℝ^{≤0}))`, the type `Berarducci.Series K` used by the proof +modules. The polynomial presentation supplies its GCD structure. The gcd operation proves +`SeriesHasGCDs`; Mathlib then turns the existence of gcds into a +`DecompositionMonoid`, proving `SeriesIsPrimal`. +-/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.Hahn + +universe u + +namespace SeriesHasGCDs + +/-- Every pair of series in `K((ℝ^{≤0}))` has a greatest common divisor. -/ +theorem of_polynomiality (K : Type u) [Field K] : SeriesHasGCDs K := by + intro hK + letI := hK + obtain ⟨hGCD⟩ := Berarducci.nonemptyGCDMonoid (K := K) + letI : GCDMonoid (nonpos K) := hGCD + intro a b + refine ⟨gcd a b, fun e ↦ ?_⟩ + constructor + · rintro ⟨hea, heb⟩ + exact dvd_gcd hea heb + · intro hed + exact ⟨hed.trans (gcd_dvd_left a b), hed.trans (gcd_dvd_right a b)⟩ + +end SeriesHasGCDs + +namespace SeriesIsPrimal + +/-- Every series in `K((ℝ^{≤0}))` is primal, as a consequence of the existence of gcds. -/ +theorem of_gcds (K : Type u) [Field K] : SeriesIsPrimal K := by + intro hK + letI := hK + letI : DecidableEq (nonpos K) := Classical.decEq _ + letI : Nonempty (GCDMonoid (nonpos K)) := + ⟨gcdMonoidOfExistsGCD (SeriesHasGCDs.of_polynomiality K inferInstance)⟩ + intro a + exact DecompositionMonoid.primal a + +end SeriesIsPrimal + +namespace SeriesIrreduciblesArePrime + +/-- Every irreducible series is prime. -/ +theorem of_primality (K : Type u) [Field K] : + SeriesIrreduciblesArePrime K := by + intro hK + letI := hK + intro a ha + exact prime_of_irreducible_of (SeriesIsPrimal.of_gcds K) ha + +end SeriesIrreduciblesArePrime + +namespace SeriesFactorizationsAreUnique + +/-- Irreducible factorisations are unique up to order and units. -/ +theorem of_primality (K : Type u) [Field K] : + SeriesFactorizationsAreUnique K := by + intro hK + letI := hK + intro f g hf hg hfg + exact factorization_unique_of (SeriesIsPrimal.of_gcds K) hf hg hfg + +end SeriesFactorizationsAreUnique + +/-- The pre-Schreier, or `DecompositionMonoid`, structure on `K((ℝ^{≤0}))`. -/ +instance (K : Type u) [Field K] [CharZero K] : DecompositionMonoid (nonpos K) := + decompositionMonoid_of (SeriesIsPrimal.of_gcds K) + +end ConwayRefinement.Standalone.Hahn diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesPolynomialRingProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesPolynomialRingProof.lean new file mode 100644 index 0000000000..fad87f7fc6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesPolynomialRingProof.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRing +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialRing + +/-! # Hahn Series Polynomial Ring Proof -/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.HahnPolynomial + +universe u + +private def seriesEquiv (K : Type u) [Field K] : + Series K ≃+* Berarducci.Series K := by + have h : Series K = HahnSeries.nonpositiveSubring ℝ K := by + ext x + rfl + rw [h] + +private def finiteSupportEquiv (K : Type u) [Field K] : + FiniteSupport K ≃+* + HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K) where + toFun x := ⟨seriesEquiv K x.1, by + rw [HahnSeries.Nonpositive.mem_finiteSupportSubring_iff] + exact (mem_finiteSupport_iff K x.1).mp x.2⟩ + invFun x := ⟨(seriesEquiv K).symm x.1, by + rw [mem_finiteSupport_iff] + exact (HahnSeries.Nonpositive.mem_finiteSupportSubring_iff x.1).mp x.2⟩ + left_inv _ := rfl + right_inv _ := rfl + map_add' _ _ := rfl + map_mul' _ _ := rfl + +namespace IsPolynomialRing + +/-- A minimal homogeneous system and lifts of its generators supply the polynomial variables. -/ +theorem of_polynomiality (K : Type u) [Field K] : + HahnPolynomial.IsPolynomialRing K := by + intro hK + letI := hK + obtain ⟨ι, weight, generators, hminimal, ⟨lifts⟩⟩ := + Berarducci.exists_isMinimalSystem_and_generatorLifts K + let ringEquiv : MvPolynomial ι (FiniteSupport K) ≃+* Series K := + (MvPolynomial.mapEquiv ι (finiteSupportEquiv K)).trans + ((Berarducci.polynomialRingEquiv hminimal lifts).toRingEquiv.trans + (seriesEquiv K).symm) + let algEquiv : MvPolynomial ι (FiniteSupport K) ≃ₐ[FiniteSupport K] Series K := + AlgEquiv.ofRingEquiv (f := ringEquiv) fun x ↦ by + change ringEquiv (MvPolynomial.C x) = (x : Series K) + simp only [ringEquiv, RingEquiv.trans_apply, MvPolynomial.mapEquiv_apply, + MvPolynomial.map_C] + change (seriesEquiv K).symm + (Berarducci.polynomialRingEquiv hminimal lifts + (MvPolynomial.C (finiteSupportEquiv K x))) = (x : Series K) + rw [Berarducci.polynomialRingEquiv_apply, Berarducci.evalAtLifts_C] + rfl + exact ⟨ι, ⟨algEquiv⟩⟩ + +end IsPolynomialRing + +end ConwayRefinement.Standalone.HahnPolynomial diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean new file mode 100644 index 0000000000..bb05f73205 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean @@ -0,0 +1,1242 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +module +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineSurreal +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayRefinementConsequences +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Functor +import Mathlib.Tactic.Linarith +import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinementProof + +/-! # Inline Conway Refinement Proof -/ + +public noncomputable section + +namespace ConwayRefinement.Standalone.InlineConwayRefinement + +universe u + +abbrev SupportGame := ConwayRefinement.Standalone.InlineSurreal.IGame + +noncomputable def Game.toSupport : Game.{u} → SupportGame.{u} + | .mk Left Right left right => + ConwayRefinement.Standalone.InlineSurreal.ofSets + (ConwayRefinement.Standalone.InlineSurreal.Player.cases + (Set.range fun i : Left ↦ Game.toSupport (left i)) + (Set.range fun i : Right ↦ Game.toSupport (right i))) trivial + +@[expose] noncomputable def Game.fromSupport (x : SupportGame.{u}) : Game.{u} := + ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn x fun s t _ _ hs ht ↦ + .mk (Shrink s) (Shrink t) + (fun i ↦ + let z := (equivShrink s).symm i + hs z.1 z.2) + (fun i ↦ + let z := (equivShrink t).symm i + ht z.1 z.2) + +theorem Game.fromSupport_ofSets (s t : Set SupportGame.{u}) [Small.{u} s] [Small.{u} t] : + Game.fromSupport + (ConwayRefinement.Standalone.InlineSurreal.ofSets + (ConwayRefinement.Standalone.InlineSurreal.Player.cases s t) trivial) = + .mk (Shrink s) (Shrink t) + (fun i ↦ Game.fromSupport ((equivShrink s).symm i).1) + (fun i ↦ Game.fromSupport ((equivShrink t).symm i).1) := by + rw [Game.fromSupport, + ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn_ofSets] + simp only [Game.fromSupport] + +theorem Game.toSupport_fromSupport (x : SupportGame.{u}) : + Game.toSupport (Game.fromSupport x) = x := by + induction x using ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn with + | ofSets s t ihs iht => + simp only [Game.fromSupport, + ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn_ofSets, Game.toSupport] + apply ConwayRefinement.Standalone.InlineSurreal.IGame.ext + intro p + simp only [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] + cases p + · ext z + constructor + · rintro ⟨i, rfl⟩ + let y := (equivShrink s).symm i + change Game.toSupport (Game.fromSupport y.1) ∈ s + rw [ihs y.1 y.2] + exact y.2 + · intro hz + let i := equivShrink s ⟨z, hz⟩ + refine ⟨i, ?_⟩ + simpa only [i, Equiv.symm_apply_apply, Game.fromSupport] using ihs z hz + · ext z + constructor + · rintro ⟨i, rfl⟩ + let y := (equivShrink t).symm i + change Game.toSupport (Game.fromSupport y.1) ∈ t + rw [iht y.1 y.2] + exact y.2 + · intro hz + let i := equivShrink t ⟨z, hz⟩ + refine ⟨i, ?_⟩ + simpa only [i, Equiv.symm_apply_apply, Game.fromSupport] using iht z hz + +theorem Game.toSupport_neg (x : Game.{u}) : + Game.toSupport (Game.neg x) = -Game.toSupport x := by + induction x with + | mk Left Right left right ihLeft ihRight => + rw [Game.neg_mk] + simp only [Game.toSupport] + rw [ConwayRefinement.Standalone.InlineSurreal.IGame.neg_ofSets] + apply ConwayRefinement.Standalone.InlineSurreal.IGame.ext + intro p + simp only [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] + cases p + · calc + Set.range (fun i ↦ Game.toSupport (Game.neg (right i))) = + Set.range (fun i ↦ -Game.toSupport (right i)) := by + congr 1 + funext i + exact ihRight i + _ = -Set.range (fun i ↦ Game.toSupport (right i)) := by + rw [← Set.image_neg_eq_neg] + exact Set.range_comp' _ _ + · calc + Set.range (fun i ↦ Game.toSupport (Game.neg (left i))) = + Set.range (fun i ↦ -Game.toSupport (left i)) := by + congr 1 + funext i + exact ihLeft i + _ = -Set.range (fun i ↦ Game.toSupport (left i)) := by + rw [← Set.image_neg_eq_neg] + exact Set.range_comp' _ _ + +theorem Game.toSupport_le (x y : Game.{u}) : + Game.Le x y ↔ Game.toSupport x ≤ Game.toSupport y := by + induction x, y using Sym2.GameAdd.recursion Game.move_wf with + | _ x y ih => + cases x with + | mk Lx Rx lx rx => + cases y with + | mk Ly Ry ly ry => + rw [Game.le_mk] + rw [ConwayRefinement.Standalone.InlineSurreal.IGame.le_iff_forall_lf] + simp only [Game.toSupport, + ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets, Set.forall_mem_range] + constructor + · rintro ⟨hLeft, hRight⟩ + constructor + · intro i h + exact hLeft i ((ih _ _ (Sym2.GameAdd.snd_fst (Game.Move.left i))).mpr h) + · intro j h + exact hRight j ((ih _ _ (Sym2.GameAdd.fst_snd (Game.Move.right j))).mpr h) + · rintro ⟨hLeft, hRight⟩ + constructor + · intro i h + exact hLeft i ((ih _ _ (Sym2.GameAdd.snd_fst (Game.Move.left i))).mp h) + · intro j h + exact hRight j ((ih _ _ (Sym2.GameAdd.fst_snd (Game.Move.right j))).mp h) + +theorem Game.Numeric.toSupport {x : Game.{u}} (h : Game.Numeric x) : + ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric (Game.toSupport x) := by + induction h with + | mk hOrder hLeft hRight ihLeft ihRight => + rw [ConwayRefinement.Standalone.InlineSurreal.IGame.numeric_def] + simp only [Game.toSupport, + ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets, Set.forall_mem_range] + constructor + · intro i j + obtain ⟨hij, hji⟩ := Game.less_iff _ _ |>.mp (hOrder i j) + rw [lt_iff_le_not_ge] + exact ⟨Game.toSupport_le _ _ |>.mp hij, + fun h ↦ hji (Game.toSupport_le _ _ |>.mpr h)⟩ + · intro p + cases p + · intro y hy + obtain ⟨i, rfl⟩ := hy + exact ihLeft i + · intro y hy + obtain ⟨j, rfl⟩ := hy + exact ihRight j + +theorem Game.Numeric.fromSupport {x : SupportGame.{u}} + (h : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric x) : + Game.Numeric (Game.fromSupport x) := by + revert h + induction x using ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn with + | ofSets s t ihLeft ihRight => + intro h + have hdef := ConwayRefinement.Standalone.InlineSurreal.IGame.numeric_def.mp h + simp only [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] at hdef + rw [Game.fromSupport_ofSets] + apply Game.Numeric.mk + · intro i j + let a := (equivShrink s).symm i + let b := (equivShrink t).symm j + have hab : a.1 < b.1 := hdef.1 a.1 a.2 b.1 b.2 + obtain ⟨hab, hba⟩ := lt_iff_le_not_ge.mp hab + apply Game.less_iff _ _ |>.mpr + constructor + · apply Game.toSupport_le _ _ |>.mpr + simpa only [Game.toSupport_fromSupport] using hab + · intro hrev + apply hba + have := Game.toSupport_le _ _ |>.mp hrev + simpa only [Game.toSupport_fromSupport] using this + · intro i + let a := (equivShrink s).symm i + exact ihLeft a.1 a.2 + (hdef.2 ConwayRefinement.Standalone.InlineSurreal.Player.left a.1 a.2) + · intro j + let b := (equivShrink t).symm j + exact ihRight b.1 b.2 + (hdef.2 ConwayRefinement.Standalone.InlineSurreal.Player.right b.1 b.2) + +theorem Game.toSupport_add (x y : Game.{u}) : + Game.toSupport (Game.add x y) = Game.toSupport x + Game.toSupport y := by + induction x, y using Game.pairRec with + | _ x y ih => + cases x with + | mk Lx Rx lx rx => + cases y with + | mk Ly Ry ly ry => + rw [Game.add_mk] + simp only [Game.toSupport] + rw [ConwayRefinement.Standalone.InlineSurreal.IGame.ofSets_add_ofSets] + apply ConwayRefinement.Standalone.InlineSurreal.IGame.ext + intro p + simp only [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] + cases p + · ext z + simp only [Set.mem_range, Set.mem_union, Set.mem_image] + constructor + · rintro ⟨i | j, rfl⟩ + · left + refine ⟨Game.toSupport (lx i), ⟨i, rfl⟩, ?_⟩ + exact (ih (lx i) (.mk Ly Ry ly ry) + (Prod.Lex.left _ _ (Game.Move.left i))).symm + · right + refine ⟨Game.toSupport (ly j), ⟨j, rfl⟩, ?_⟩ + exact (ih (.mk Lx Rx lx rx) (ly j) + (Prod.Lex.right _ (Game.Move.left j))).symm + · rintro (⟨_, ⟨i, rfl⟩, rfl⟩ | ⟨_, ⟨j, rfl⟩, rfl⟩) + · exact ⟨Sum.inl i, ih _ _ (Prod.Lex.left _ _ (Game.Move.left i))⟩ + · exact ⟨Sum.inr j, ih _ _ (Prod.Lex.right _ (Game.Move.left j))⟩ + · ext z + simp only [Set.mem_range, Set.mem_union, Set.mem_image] + constructor + · rintro ⟨i | j, rfl⟩ + · left + refine ⟨Game.toSupport (rx i), ⟨i, rfl⟩, ?_⟩ + exact (ih (rx i) (.mk Ly Ry ly ry) + (Prod.Lex.left _ _ (Game.Move.right i))).symm + · right + refine ⟨Game.toSupport (ry j), ⟨j, rfl⟩, ?_⟩ + exact (ih (.mk Lx Rx lx rx) (ry j) + (Prod.Lex.right _ (Game.Move.right j))).symm + · rintro (⟨_, ⟨i, rfl⟩, rfl⟩ | ⟨_, ⟨j, rfl⟩, rfl⟩) + · exact ⟨Sum.inl i, ih _ _ (Prod.Lex.left _ _ (Game.Move.right i))⟩ + · exact ⟨Sum.inr j, ih _ _ (Prod.Lex.right _ (Game.Move.right j))⟩ + +theorem Game.toSupport_mul (x y : Game.{u}) : + Game.toSupport (Game.mul x y) = Game.toSupport x * Game.toSupport y := by + induction x, y using Game.pairRec with + | _ x y ih => + cases x with + | mk Lx Rx lx rx => + cases y with + | mk Ly Ry ly ry => + let x := Game.mk Lx Rx lx rx + let y := Game.mk Ly Ry ly ry + have option_eq (a b : Game) (ha : Game.Move a x) (hb : Game.Move b y) : + Game.toSupport + (Game.add (Game.add (Game.mul a y) (Game.mul x b)) + (Game.neg (Game.mul a b))) = + ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption + (Game.toSupport x) (Game.toSupport y) + (Game.toSupport a) (Game.toSupport b) := by + rw [Game.toSupport_add, Game.toSupport_add, Game.toSupport_neg, + ih a y (Prod.Lex.left y y ha), ih x b (Prod.Lex.right x hb), + ih a b (Prod.Lex.left b y ha)] + rfl + rw [Game.mul_mk] + simp only [Game.toSupport] + rw [ConwayRefinement.Standalone.InlineSurreal.IGame.mul_eq] + apply ConwayRefinement.Standalone.InlineSurreal.IGame.ext + intro p + simp only [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] + cases p + · ext z + simp only [Set.mem_range, Set.mem_image, Set.mem_union, Set.mem_prod] + constructor + · rintro ⟨ij | ij, rfl⟩ + · refine ⟨(Game.toSupport (lx ij.1), Game.toSupport (ly ij.2)), ?_, ?_⟩ + · left + exact ⟨⟨ij.1, rfl⟩, ⟨ij.2, rfl⟩⟩ + · exact (option_eq _ _ (Game.Move.left ij.1) (Game.Move.left ij.2)).symm + · refine ⟨(Game.toSupport (rx ij.1), Game.toSupport (ry ij.2)), ?_, ?_⟩ + · right + exact ⟨⟨ij.1, rfl⟩, ⟨ij.2, rfl⟩⟩ + · exact (option_eq _ _ (Game.Move.right ij.1) (Game.Move.right ij.2)).symm + · rintro ⟨⟨a, b⟩, (⟨⟨i, rfl⟩, ⟨j, rfl⟩⟩ | ⟨⟨i, rfl⟩, ⟨j, rfl⟩⟩), rfl⟩ + · exact ⟨Sum.inl (i, j), + option_eq _ _ (Game.Move.left i) (Game.Move.left j)⟩ + · exact ⟨Sum.inr (i, j), + option_eq _ _ (Game.Move.right i) (Game.Move.right j)⟩ + · ext z + simp only [Set.mem_range, Set.mem_image, Set.mem_union, Set.mem_prod] + constructor + · rintro ⟨ij | ij, rfl⟩ + · refine ⟨(Game.toSupport (lx ij.1), Game.toSupport (ry ij.2)), ?_, ?_⟩ + · left + exact ⟨⟨ij.1, rfl⟩, ⟨ij.2, rfl⟩⟩ + · exact (option_eq _ _ (Game.Move.left ij.1) (Game.Move.right ij.2)).symm + · refine ⟨(Game.toSupport (rx ij.1), Game.toSupport (ly ij.2)), ?_, ?_⟩ + · right + exact ⟨⟨ij.1, rfl⟩, ⟨ij.2, rfl⟩⟩ + · exact (option_eq _ _ (Game.Move.right ij.1) (Game.Move.left ij.2)).symm + · rintro ⟨⟨a, b⟩, (⟨⟨i, rfl⟩, ⟨j, rfl⟩⟩ | ⟨⟨i, rfl⟩, ⟨j, rfl⟩⟩), rfl⟩ + · exact ⟨Sum.inl (i, j), + option_eq _ _ (Game.Move.left i) (Game.Move.right j)⟩ + · exact ⟨Sum.inr (i, j), + option_eq _ _ (Game.Move.right i) (Game.Move.left j)⟩ + +noncomputable def Surreal.toSupport (x : Surreal.{u}) : + ConwayRefinement.Standalone.InlineSurreal.Surreal.{u} := + @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk _ x.numeric.toSupport + +theorem Surreal.toSupport_eq (x : Surreal.{u}) : + x.toSupport = @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk _ x.numeric.toSupport := + (rfl) + +noncomputable def Surreal.fromSupport + (x : ConwayRefinement.Standalone.InlineSurreal.Surreal.{u}) : Surreal.{u} := + ⟨Game.fromSupport x.out, Game.Numeric.fromSupport inferInstance⟩ + +theorem Surreal.fromSupport_game + (x : ConwayRefinement.Standalone.InlineSurreal.Surreal.{u}) : + (Surreal.fromSupport x).game = Game.fromSupport x.out := (rfl) + +theorem Surreal.toSupport_fromSupport + (x : ConwayRefinement.Standalone.InlineSurreal.Surreal.{u}) : + (Surreal.fromSupport x).toSupport = x := by + letI : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric + (Game.toSupport (Surreal.fromSupport x).game) := + (Surreal.fromSupport x).numeric.toSupport + rw [Surreal.toSupport_eq] + calc + ConwayRefinement.Standalone.InlineSurreal.Surreal.mk + (Game.toSupport (Surreal.fromSupport x).game) = + ConwayRefinement.Standalone.InlineSurreal.Surreal.mk x.out := by + apply ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq + have heq : Game.toSupport (Surreal.fromSupport x).game = x.out := + congrArg Game.toSupport (Surreal.fromSupport_game x) |>.trans + (Game.toSupport_fromSupport x.out) + rw [heq] + _ = x := ConwayRefinement.Standalone.InlineSurreal.Surreal.out_eq x + +theorem Surreal.gameEquivalent_iff_toSupport_eq (x y : Surreal.{u}) : + Game.Equivalent x.game y.game ↔ x.toSupport = y.toSupport := by + letI : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric (Game.toSupport x.game) := + x.numeric.toSupport + letI : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric (Game.toSupport y.game) := + y.numeric.toSupport + rw [Surreal.toSupport_eq, Surreal.toSupport_eq, + ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk, Game.equivalent_iff] + change (Game.Le x.game y.game ∧ Game.Le y.game x.game) ↔ + (Game.toSupport x.game ≤ Game.toSupport y.game ∧ + Game.toSupport y.game ≤ Game.toSupport x.game) + rw [Game.toSupport_le, Game.toSupport_le] + +/-- The actual quotient of the numeric representatives displayed in the headline file. -/ +def Surreal.QuotientModel : Type (u + 1) := + Quotient + { r := fun x y : Surreal.{u} ↦ Game.Equivalent x.game y.game + iseqv := ⟨ + fun x ↦ Surreal.gameEquivalent_iff_toSupport_eq x x |>.mpr rfl, + fun h ↦ Surreal.gameEquivalent_iff_toSupport_eq _ _ |>.mpr + (Surreal.gameEquivalent_iff_toSupport_eq _ _ |>.mp h).symm, + fun hxy hyz ↦ Surreal.gameEquivalent_iff_toSupport_eq _ _ |>.mpr + ((Surreal.gameEquivalent_iff_toSupport_eq _ _ |>.mp hxy).trans + (Surreal.gameEquivalent_iff_toSupport_eq _ _ |>.mp hyz))⟩ } + +noncomputable def Surreal.QuotientModel.toSupport : Surreal.QuotientModel.{u} → + ConwayRefinement.Standalone.InlineSurreal.Surreal.{u} := + Quotient.lift Surreal.toSupport fun _ _ h ↦ + Surreal.gameEquivalent_iff_toSupport_eq _ _ |>.mp h + +universe v + +theorem Surreal.QuotientModel.toSupport_bijective : + Function.Bijective Surreal.QuotientModel.toSupport.{v} := by + constructor + · intro x y hxy + refine Quotient.inductionOn₂ x y ?_ hxy + intro x y h + apply Quotient.sound + exact Surreal.gameEquivalent_iff_toSupport_eq x y |>.mpr h + · intro (x : ConwayRefinement.Standalone.InlineSurreal.Surreal.{v}) + exact ⟨Quotient.mk _ (Surreal.fromSupport x), Surreal.toSupport_fromSupport x⟩ + +/-- The quotient of the headline's numeric games is equivalent to the fully developed inlined +surreal numbers. -/ +noncomputable def Surreal.quotientEquivSupport : Surreal.QuotientModel.{v} ≃ + ConwayRefinement.Standalone.InlineSurreal.Surreal.{v} := + Equiv.ofBijective Surreal.QuotientModel.toSupport.{v} + Surreal.QuotientModel.toSupport_bijective + +namespace SupportBridge + +def playerToSupport : _root_.Player → ConwayRefinement.Standalone.InlineSurreal.Player + | .left => .left + | .right => .right + +noncomputable def toCG (x : SupportGame.{u}) : _root_.IGame.{u} := + ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn x fun s t _ _ hs ht ↦ + !{Set.range fun y : s ↦ hs y.1 y.2 | Set.range fun y : t ↦ ht y.1 y.2} + +noncomputable def fromCG (x : _root_.IGame.{u}) : SupportGame.{u} := + _root_.IGame.ofSetsRecOn x fun s t _ _ hs ht ↦ + ConwayRefinement.Standalone.InlineSurreal.ofSets + (ConwayRefinement.Standalone.InlineSurreal.Player.cases + (Set.range fun y : s ↦ hs y.1 y.2) + (Set.range fun y : t ↦ ht y.1 y.2)) trivial + +theorem fromCG_toCG (x : SupportGame.{u}) : fromCG (toCG x) = x := by + induction x using ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn with + | ofSets s t ihs iht => + rw [toCG, ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn_ofSets, + fromCG, _root_.IGame.ofSetsRecOn_ofSets] + apply ConwayRefinement.Standalone.InlineSurreal.IGame.ext + intro p + cases p + · rw [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets, + ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] + ext z + constructor + · rintro ⟨y, rfl⟩ + obtain ⟨x, hx⟩ := y.2 + change fromCG y.1 ∈ s + have hxy : fromCG y.1 = x.1 := + (congrArg fromCG hx).symm.trans (ihs x.1 x.2) + rw [hxy] + exact x.2 + · intro hz + refine ⟨⟨toCG z, ⟨⟨z, hz⟩, rfl⟩⟩, ?_⟩ + exact ihs z hz + · rw [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets, + ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] + ext z + constructor + · rintro ⟨y, rfl⟩ + obtain ⟨x, hx⟩ := y.2 + change fromCG y.1 ∈ t + have hxy : fromCG y.1 = x.1 := + (congrArg fromCG hx).symm.trans (iht x.1 x.2) + rw [hxy] + exact x.2 + · intro hz + refine ⟨⟨toCG z, ⟨⟨z, hz⟩, rfl⟩⟩, ?_⟩ + exact iht z hz + +theorem toCG_fromCG (x : _root_.IGame.{u}) : toCG (fromCG x) = x := by + induction x using _root_.IGame.ofSetsRecOn with + | ofSets s t ihs iht => + rw [fromCG, _root_.IGame.ofSetsRecOn_ofSets, + toCG, ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn_ofSets] + apply _root_.IGame.ext + intro p + cases p + · rw [_root_.IGame.moves_ofSets, _root_.IGame.moves_ofSets] + ext z + constructor + · rintro ⟨y, rfl⟩ + obtain ⟨x, hx⟩ := y.2 + change toCG y.1 ∈ s + have hxy : toCG y.1 = x.1 := + (congrArg toCG hx).symm.trans (ihs x.1 x.2) + rw [hxy] + exact x.2 + · intro hz + refine ⟨⟨fromCG z, ⟨⟨z, hz⟩, rfl⟩⟩, ?_⟩ + exact ihs z hz + · rw [_root_.IGame.moves_ofSets, _root_.IGame.moves_ofSets] + ext z + constructor + · rintro ⟨y, rfl⟩ + obtain ⟨x, hx⟩ := y.2 + change toCG y.1 ∈ t + have hxy : toCG y.1 = x.1 := + (congrArg toCG hx).symm.trans (iht x.1 x.2) + rw [hxy] + exact x.2 + · intro hz + refine ⟨⟨fromCG z, ⟨⟨z, hz⟩, rfl⟩⟩, ?_⟩ + exact iht z hz + +theorem moves_toCG (p : _root_.Player) (x : SupportGame.{u}) : + (toCG x).moves p = toCG '' x.moves (playerToSupport p) := by + induction x using ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn with + | ofSets s t _ _ => + cases p <;> simp [toCG, playerToSupport, Set.ext_iff] + +theorem toCG_le (x y : SupportGame.{u}) : x ≤ y ↔ toCG x ≤ toCG y := by + induction x, y using Sym2.GameAdd.recursion + ConwayRefinement.Standalone.InlineSurreal.IGame.subposition_wf with + | _ x y ih => + rw [ConwayRefinement.Standalone.InlineSurreal.IGame.le_iff_forall_lf, + _root_.IGame.le_iff_forall_lf, moves_toCG, moves_toCG] + simp only [playerToSupport, Set.forall_mem_image] + constructor + · rintro ⟨hLeft, hRight⟩ + constructor + · intro z hz h + exact hLeft z hz ((ih _ _ (Sym2.GameAdd.snd_fst + (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hz))).mpr h) + · intro z hz h + exact hRight z hz ((ih _ _ (Sym2.GameAdd.fst_snd + (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hz))).mpr h) + · rintro ⟨hLeft, hRight⟩ + constructor + · intro z hz h + exact hLeft hz ((ih _ _ (Sym2.GameAdd.snd_fst + (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hz))).mp h) + · intro z hz h + exact hRight hz ((ih _ _ (Sym2.GameAdd.fst_snd + (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hz))).mp h) + +theorem playerToSupport_neg (p : _root_.Player) : playerToSupport (-p) = -playerToSupport p := by + cases p <;> rfl + +theorem playerToSupport_mul (p q : _root_.Player) : + playerToSupport (p * q) = playerToSupport p * playerToSupport q := by + cases p <;> cases q <;> rfl + +theorem toCG_neg (x : SupportGame.{u}) : toCG (-x) = -toCG x := by + induction x using ConwayRefinement.Standalone.InlineSurreal.IGame.moveRecOn with + | ind x ih => + apply _root_.IGame.ext + intro p + rw [moves_toCG, ConwayRefinement.Standalone.InlineSurreal.IGame.moves_neg, + _root_.IGame.moves_neg, moves_toCG, playerToSupport_neg] + rw [← Set.image_neg_eq_neg, ← Set.image_neg_eq_neg] + ext z + constructor + · rintro ⟨_, ⟨y, hy, rfl⟩, rfl⟩ + exact ⟨toCG y, ⟨y, hy, rfl⟩, (ih _ y hy).symm⟩ + · rintro ⟨_, ⟨y, hy, rfl⟩, rfl⟩ + exact ⟨-y, ⟨y, hy, rfl⟩, ih _ y hy⟩ + +theorem toCG_add (x y : SupportGame.{u}) : toCG (x + y) = toCG x + toCG y := by + induction x, y using Sym2.GameAdd.recursion + ConwayRefinement.Standalone.InlineSurreal.IGame.subposition_wf with + | _ x y ih => + apply _root_.IGame.ext + intro p + rw [moves_toCG, ConwayRefinement.Standalone.InlineSurreal.IGame.moves_add, + _root_.IGame.moves_add, moves_toCG, moves_toCG] + ext z + simp only [Set.mem_image, Set.mem_union] + constructor + · rintro ⟨_, (⟨a, ha, rfl⟩ | ⟨b, hb, rfl⟩), rfl⟩ + · left + refine ⟨toCG a, ⟨a, ha, rfl⟩, ?_⟩ + exact (ih _ _ (Sym2.GameAdd.fst + (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves ha))).symm + · right + refine ⟨toCG b, ⟨b, hb, rfl⟩, ?_⟩ + exact (ih _ _ (Sym2.GameAdd.snd + (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hb))).symm + · rintro (⟨_, ⟨a, ha, rfl⟩, rfl⟩ | ⟨_, ⟨b, hb, rfl⟩, rfl⟩) + · exact ⟨a + y, Or.inl ⟨a, ha, rfl⟩, + ih _ _ (Sym2.GameAdd.fst + (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves ha))⟩ + · exact ⟨x + b, Or.inr ⟨b, hb, rfl⟩, + ih _ _ (Sym2.GameAdd.snd + (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hb))⟩ + +theorem toCG_zero : toCG (0 : SupportGame.{u}) = 0 := by + apply _root_.IGame.ext + intro p + rw [moves_toCG, ConwayRefinement.Standalone.InlineSurreal.IGame.moves_zero, + _root_.IGame.moves_zero] + simp + +theorem toCG_one : toCG (1 : SupportGame.{u}) = 1 := by + apply _root_.IGame.ext + intro p + rw [moves_toCG] + cases p <;> + simp [ConwayRefinement.Standalone.InlineSurreal.IGame.one_def, _root_.IGame.one_def, + playerToSupport, toCG_zero] + +theorem toCG_mul (x y : SupportGame.{u}) : toCG (x * y) = toCG x * toCG y := by + have option_eq {a b : SupportGame.{u}} + (ha : ∃ q, a ∈ ConwayRefinement.Standalone.InlineSurreal.IGame.moves q x) + (hb : ∃ q, b ∈ ConwayRefinement.Standalone.InlineSurreal.IGame.moves q y) : + toCG (ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption x y a b) = + _root_.IGame.mulOption (toCG x) (toCG y) (toCG a) (toCG b) := by + rw [ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption, _root_.IGame.mulOption, + sub_eq_add_neg, sub_eq_add_neg, toCG_add, toCG_add, toCG_neg, + toCG_mul a y, toCG_mul x b, toCG_mul a b] + apply _root_.IGame.ext + intro p + rw [moves_toCG, ConwayRefinement.Standalone.InlineSurreal.IGame.moves_mul, + _root_.IGame.moves_mul, moves_toCG, moves_toCG, moves_toCG, moves_toCG, + playerToSupport_neg] + ext z + simp only [Set.mem_image, Set.mem_union, Set.mem_prod] + constructor + · rintro ⟨w, ⟨⟨a, b⟩, (⟨ha, hb⟩ | ⟨ha, hb⟩), hmul⟩, hw⟩ + · refine ⟨(toCG a, toCG b), Or.inl ⟨⟨a, ha, rfl⟩, ⟨b, hb, rfl⟩⟩, ?_⟩ + calc + _root_.IGame.mulOption (toCG x) (toCG y) (toCG a) (toCG b) = + toCG (ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption x y a b) := + (option_eq ⟨_, ha⟩ ⟨_, hb⟩).symm + _ = toCG w := congrArg toCG hmul + _ = z := hw + · refine ⟨(toCG a, toCG b), Or.inr ⟨⟨a, ha, rfl⟩, ⟨b, hb, rfl⟩⟩, ?_⟩ + calc + _root_.IGame.mulOption (toCG x) (toCG y) (toCG a) (toCG b) = + toCG (ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption x y a b) := + (option_eq ⟨_, ha⟩ ⟨_, hb⟩).symm + _ = toCG w := congrArg toCG hmul + _ = z := hw + · rintro ⟨⟨qa, qb⟩, + (⟨⟨a, ha, hqa⟩, ⟨b, hb, hqb⟩⟩ | ⟨⟨a, ha, hqa⟩, ⟨b, hb, hqb⟩⟩), hmul⟩ + · refine ⟨ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption x y a b, + ⟨(a, b), Or.inl ⟨ha, hb⟩, rfl⟩, ?_⟩ + calc + toCG (ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption x y a b) = + _root_.IGame.mulOption (toCG x) (toCG y) (toCG a) (toCG b) := + option_eq ⟨_, ha⟩ ⟨_, hb⟩ + _ = _root_.IGame.mulOption (toCG x) (toCG y) qa qb := by rw [hqa, hqb] + _ = z := hmul + · refine ⟨ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption x y a b, + ⟨(a, b), Or.inr ⟨ha, hb⟩, rfl⟩, ?_⟩ + calc + toCG (ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption x y a b) = + _root_.IGame.mulOption (toCG x) (toCG y) (toCG a) (toCG b) := + option_eq ⟨_, ha⟩ ⟨_, hb⟩ + _ = _root_.IGame.mulOption (toCG x) (toCG y) qa qb := by rw [hqa, hqb] + _ = z := hmul +termination_by (x, y) +decreasing_by + all_goals + aesop (add unsafe + [ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves, Prod.Lex.left, + Prod.Lex.right]) + +theorem toCG_numeric {x : SupportGame.{u}} + (h : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric x) : + _root_.IGame.Numeric (toCG x) := by + induction h with + | mk hOrder hMoves ih => + rw [_root_.IGame.numeric_def] + constructor + · intro y hy z hz + rw [moves_toCG] at hy hz + obtain ⟨y, hy, rfl⟩ := hy + obtain ⟨z, hz, rfl⟩ := hz + rw [lt_iff_le_not_ge, ← toCG_le, ← toCG_le] + exact hOrder y hy z hz + · intro p y hy + rw [moves_toCG] at hy + obtain ⟨y, hy, rfl⟩ := hy + exact ih (playerToSupport p) y hy + +theorem fromCG_numeric {x : _root_.IGame.{u}} (h : _root_.IGame.Numeric x) : + ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric (fromCG x) := by + revert h + induction x using _root_.IGame.moveRecOn with + | ind x ih => + intro h + have hdef := _root_.IGame.numeric_def.mp h + rw [ConwayRefinement.Standalone.InlineSurreal.IGame.numeric_def] + constructor + · intro y hy z hz + have hy' : toCG y ∈ x.moves _root_.Player.left := by + rw [← toCG_fromCG x, moves_toCG] + exact ⟨y, by simpa only [playerToSupport] using hy, rfl⟩ + have hz' : toCG z ∈ x.moves _root_.Player.right := by + rw [← toCG_fromCG x, moves_toCG] + exact ⟨z, by simpa only [playerToSupport] using hz, rfl⟩ + have hyz := hdef.1 (toCG y) hy' (toCG z) hz' + rw [lt_iff_le_not_ge, ← toCG_le, ← toCG_le] at hyz + exact hyz + · intro p y hy + cases p + · have hy' : toCG y ∈ x.moves _root_.Player.left := by + rw [← toCG_fromCG x, moves_toCG] + exact ⟨y, by simpa only [playerToSupport] using hy, rfl⟩ + simpa only [fromCG_toCG] using + ih _ (toCG y) hy' (hdef.2 _ (toCG y) hy') + · have hy' : toCG y ∈ x.moves _root_.Player.right := by + rw [← toCG_fromCG x, moves_toCG] + exact ⟨y, by simpa only [playerToSupport] using hy, rfl⟩ + simpa only [fromCG_toCG] using + ih _ (toCG y) hy' (hdef.2 _ (toCG y) hy') + +end SupportBridge + +namespace SupportBridge + +abbrev SupportSurreal := ConwayRefinement.Standalone.InlineSurreal.Surreal +abbrev SupportQuotientGame := ConwayRefinement.Standalone.InlineSurreal.Game + +noncomputable def gameToCG (x : SupportQuotientGame.{u}) : _root_.Game.{u} := + _root_.Game.mk (toCG x.out) + +noncomputable def surrealToCG (x : SupportSurreal.{u}) : _root_.Surreal.{u} := + @_root_.Surreal.mk (toCG x.out) (toCG_numeric inferInstance) + +noncomputable def surrealFromCG (x : _root_.Surreal.{u}) : SupportSurreal.{u} := + @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk (fromCG x.out) + (fromCG_numeric inferInstance) + +theorem toCG_equiv (x y : SupportGame.{u}) : + (x ≤ y ∧ y ≤ x) ↔ (toCG x ≤ toCG y ∧ toCG y ≤ toCG x) := by + rw [toCG_le, toCG_le] + +theorem gameToCG_mk (x : SupportGame.{u}) : + gameToCG (ConwayRefinement.Standalone.InlineSurreal.Game.mk x) = _root_.Game.mk (toCG x) := by + rw [gameToCG, _root_.Game.mk_eq_mk] + apply toCG_equiv _ _ |>.mp + exact ConwayRefinement.Standalone.InlineSurreal.Game.mk_out_equiv x + +theorem gameToCG_singletonCut (l r : SupportQuotientGame.{u}) : + gameToCG !{{l} | {r}} = !{{gameToCG l} | {gameToCG r}} := by + rw [gameToCG] + apply _root_.Game.mk_eq + let sraw : SupportGame.{u} := + ConwayRefinement.Standalone.InlineSurreal.OfSets.ofSets + (ConwayRefinement.Standalone.InlineSurreal.Player.cases {l.out} {r.out}) trivial + have hout : + toCG (ConwayRefinement.Standalone.InlineSurreal.Game.out !{{l} | {r}}) ≤ toCG sraw ∧ + toCG sraw ≤ toCG (ConwayRefinement.Standalone.InlineSurreal.Game.out !{{l} | {r}}) := by + apply toCG_equiv _ _ |>.mp + have hs := ConwayRefinement.Standalone.InlineSurreal.Game.mk_out_equiv sraw + change (ConwayRefinement.Standalone.InlineSurreal.Game.mk sraw).out ≤ sraw ∧ + sraw ≤ (ConwayRefinement.Standalone.InlineSurreal.Game.mk sraw).out at hs + have hcut : ConwayRefinement.Standalone.InlineSurreal.Game.mk sraw = !{{l} | {r}} := by + simpa only [sraw, Set.image_singleton, + ConwayRefinement.Standalone.InlineSurreal.Game.out_eq] using + ConwayRefinement.Standalone.InlineSurreal.Game.mk_ofSets ({l.out} : Set SupportGame.{u}) + ({r.out} : Set SupportGame.{u}) + rw [← hcut] + exact hs + have hraw : + toCG sraw = !{{toCG l.out} | {toCG r.out}} := by + apply _root_.IGame.ext + intro p + rw [moves_toCG] + cases p <;> simp [sraw, playerToSupport] + have htarget : + toCG sraw ≤ !{fun p ↦ _root_.Game.out '' + _root_.Player.cases {gameToCG l} {gameToCG r} p} ∧ + !{fun p ↦ _root_.Game.out '' + _root_.Player.cases {gameToCG l} {gameToCG r} p} ≤ toCG sraw := by + rw [hraw] + apply _root_.IGame.equiv_of_exists <;> + simp only [_root_.IGame.moves_ofSets, Set.mem_singleton_iff, + _root_.Player.apply_cases, Set.mem_image] + · intro a ha + subst a + exact ⟨(gameToCG l).out, ⟨gameToCG l, rfl, rfl⟩, + (_root_.Game.mk_out_equiv (toCG l.out)).symm⟩ + · intro a ha + subst a + exact ⟨(gameToCG r).out, ⟨gameToCG r, rfl, rfl⟩, + (_root_.Game.mk_out_equiv (toCG r.out)).symm⟩ + · intro b hb + obtain ⟨l', hl', rfl⟩ := hb + subst l' + exact ⟨toCG l.out, rfl, (_root_.Game.mk_out_equiv (toCG l.out)).symm⟩ + · intro b hb + obtain ⟨r', hr', rfl⟩ := hb + subst r' + exact ⟨toCG r.out, rfl, (_root_.Game.mk_out_equiv (toCG r.out)).symm⟩ + exact ⟨hout.1.trans htarget.1, htarget.2.trans hout.2⟩ + +theorem surrealToCG_mk (x : SupportGame.{u}) + [ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric x] : + surrealToCG (ConwayRefinement.Standalone.InlineSurreal.Surreal.mk x) = + @_root_.Surreal.mk (toCG x) (toCG_numeric inferInstance) := by + letI := toCG_numeric (x := x) (inferInstance) + letI := toCG_numeric + (x := (ConwayRefinement.Standalone.InlineSurreal.Surreal.mk x).out) (inferInstance) + rw [surrealToCG, _root_.Surreal.mk_eq_mk] + apply toCG_equiv _ _ |>.mp + exact ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_out_equiv x + +theorem toGame_surrealToCG (x : SupportSurreal.{u}) : + _root_.Surreal.toGame (surrealToCG x) = + gameToCG (ConwayRefinement.Standalone.InlineSurreal.Surreal.toGame x) := by + induction x using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with + | mk x => + letI : _root_.IGame.Numeric (toCG x) := toCG_numeric (by infer_instance) + rw [surrealToCG_mk, _root_.Surreal.toGame_mk, + ConwayRefinement.Standalone.InlineSurreal.Surreal.toGame_mk, gameToCG_mk] + +theorem surrealFromCG_mk (x : _root_.IGame.{u}) [x.Numeric] : + surrealFromCG (_root_.Surreal.mk x) = + @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk (fromCG x) + (fromCG_numeric inferInstance) := by + letI := fromCG_numeric (x := x) (inferInstance) + letI := fromCG_numeric (x := (_root_.Surreal.mk x).out) (inferInstance) + rw [surrealFromCG, ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk] + apply toCG_equiv _ _ |>.mpr + rw [toCG_fromCG] + obtain ⟨h₁, h₂⟩ := _root_.Surreal.mk_out_equiv x + constructor + · exact h₁.trans_eq (toCG_fromCG x).symm + · exact (toCG_fromCG x).le.trans h₂ + +theorem surrealToCG_fromCG (x : _root_.Surreal.{u}) : + surrealToCG (surrealFromCG x) = x := by + induction x using _root_.Surreal.ind with + | mk x => + letI := fromCG_numeric (x := x) (inferInstance) + letI := toCG_numeric (x := fromCG x) (inferInstance) + rw [surrealFromCG_mk, surrealToCG_mk] + rw [_root_.Surreal.mk_eq_mk] + change toCG (fromCG x) ≤ x ∧ x ≤ toCG (fromCG x) + rw [toCG_fromCG] + exact ⟨le_rfl, le_rfl⟩ + +theorem surrealFromCG_toCG (x : SupportSurreal.{u}) : + surrealFromCG (surrealToCG x) = x := by + induction x using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with + | mk x => + letI := toCG_numeric (x := x) (inferInstance) + letI := fromCG_numeric (x := toCG x) (inferInstance) + rw [surrealToCG_mk, surrealFromCG_mk] + rw [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk] + apply toCG_equiv _ _ |>.mpr + rw [toCG_fromCG] + exact ⟨le_rfl, le_rfl⟩ + +/-- The fully developed Mathlib-only copy and CombinatorialGames define equivalent surreal +numbers. -/ +noncomputable def surrealEquivCG : SupportSurreal.{u} ≃ _root_.Surreal.{u} where + toFun := surrealToCG + invFun := surrealFromCG + left_inv := surrealFromCG_toCG + right_inv := surrealToCG_fromCG + +theorem surrealToCG_zero : surrealToCG (0 : SupportSurreal.{u}) = 0 := by + letI : _root_.IGame.Numeric (toCG (0 : SupportGame.{u})) := + toCG_numeric (by infer_instance) + rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_zero, surrealToCG_mk, + ← _root_.Surreal.mk_zero, _root_.Surreal.mk_eq_mk] + change toCG 0 ≤ 0 ∧ 0 ≤ toCG 0 + rw [toCG_zero] + exact ⟨le_rfl, le_rfl⟩ + +theorem surrealToCG_one : surrealToCG (1 : SupportSurreal.{u}) = 1 := by + letI : _root_.IGame.Numeric (toCG (1 : SupportGame.{u})) := + toCG_numeric (by infer_instance) + rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_one, surrealToCG_mk, + ← _root_.Surreal.mk_one, _root_.Surreal.mk_eq_mk] + change toCG 1 ≤ 1 ∧ 1 ≤ toCG 1 + rw [toCG_one] + exact ⟨le_rfl, le_rfl⟩ + +theorem surrealToCG_neg (x : SupportSurreal.{u}) : surrealToCG (-x) = -surrealToCG x := by + induction x using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with + | mk x => + letI : _root_.IGame.Numeric (toCG x) := toCG_numeric (by infer_instance) + letI : _root_.IGame.Numeric (toCG (-x)) := toCG_numeric (by infer_instance) + rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_neg, surrealToCG_mk, + surrealToCG_mk, ← _root_.Surreal.mk_neg, _root_.Surreal.mk_eq_mk] + change toCG (-x) ≤ -toCG x ∧ -toCG x ≤ toCG (-x) + rw [toCG_neg] + exact ⟨le_rfl, le_rfl⟩ + +theorem surrealToCG_add (x y : SupportSurreal.{u}) : + surrealToCG (x + y) = surrealToCG x + surrealToCG y := by + induction x using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with + | mk x => + induction y using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with + | mk y => + letI : _root_.IGame.Numeric (toCG x) := toCG_numeric (by infer_instance) + letI : _root_.IGame.Numeric (toCG y) := toCG_numeric (by infer_instance) + letI : _root_.IGame.Numeric (toCG (x + y)) := toCG_numeric (by infer_instance) + rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_add, surrealToCG_mk, + surrealToCG_mk, surrealToCG_mk, ← _root_.Surreal.mk_add, + _root_.Surreal.mk_eq_mk] + change toCG (x + y) ≤ toCG x + toCG y ∧ toCG x + toCG y ≤ toCG (x + y) + rw [toCG_add] + exact ⟨le_rfl, le_rfl⟩ + +theorem surrealToCG_mul (x y : SupportSurreal.{u}) : + surrealToCG (x * y) = surrealToCG x * surrealToCG y := by + induction x using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with + | mk x => + induction y using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with + | mk y => + letI : _root_.IGame.Numeric (toCG x) := toCG_numeric (by infer_instance) + letI : _root_.IGame.Numeric (toCG y) := toCG_numeric (by infer_instance) + letI : _root_.IGame.Numeric (toCG (x * y)) := toCG_numeric (by infer_instance) + rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_mul, surrealToCG_mk, + surrealToCG_mk, surrealToCG_mk, ← _root_.Surreal.mk_mul, + _root_.Surreal.mk_eq_mk] + change toCG (x * y) ≤ toCG x * toCG y ∧ toCG x * toCG y ≤ toCG (x * y) + rw [toCG_mul] + exact ⟨le_rfl, le_rfl⟩ + +theorem surrealToCG_singletonIntegerCut (x : SupportSurreal.{u}) : + surrealToCG (ConwayRefinement.Standalone.InlineSurreal.Surreal.singletonIntegerCut x) = + !{{surrealToCG x - 1} | {surrealToCG x + 1}}' (by + simp only [Set.mem_singleton_iff] + rintro _ rfl _ rfl + simp [sub_eq_add_neg]) := by + rw [ConwayRefinement.Standalone.InlineSurreal.Surreal.singletonIntegerCut] + rw [← _root_.Surreal.toGame_inj, toGame_surrealToCG, + ConwayRefinement.Standalone.InlineSurreal.Surreal.toGame_ofSets] + simp only [Set.image_singleton] + rw [gameToCG_singletonCut, _root_.Surreal.toGame_ofSets] + simp only [Set.image_singleton] + congr 2 + · congr 1 + rw [← toGame_surrealToCG, sub_eq_add_neg, surrealToCG_add, surrealToCG_neg, + surrealToCG_one] + rw [sub_eq_add_neg] + · congr 1 + rw [← toGame_surrealToCG, surrealToCG_add, surrealToCG_one] + +theorem isConwayOmnificInteger_iff (x : SupportSurreal.{u}) : + ConwayRefinement.Standalone.InlineSurreal.Surreal.IsConwayOmnificInteger x ↔ + ConwayRefinement.Standalone.Oz.IsConwayOmnificInteger (surrealToCG x) := by + rw [ConwayRefinement.Standalone.InlineSurreal.Surreal.IsConwayOmnificInteger, + ConwayRefinement.Standalone.Oz.isConwayOmnificInteger_iff] + constructor + · intro hx + calc + surrealToCG x = + surrealToCG (ConwayRefinement.Standalone.InlineSurreal.Surreal.singletonIntegerCut x) := + congrArg surrealToCG hx + _ = !{{surrealToCG x - 1} | {surrealToCG x + 1}}' _ := + surrealToCG_singletonIntegerCut x + · intro hx + apply surrealEquivCG.injective + calc + surrealToCG x = !{{surrealToCG x - 1} | {surrealToCG x + 1}}' _ := hx + _ = surrealToCG (ConwayRefinement.Standalone.InlineSurreal.Surreal.singletonIntegerCut x) := + (surrealToCG_singletonIntegerCut x).symm + +end SupportBridge + +/-- The quotient of the completely visible inline representatives is exactly the surreal-number +type supplied by CombinatorialGames. -/ +noncomputable def Surreal.quotientEquivCombinatorialGames : + Surreal.QuotientModel.{u} ≃ _root_.Surreal.{u} := + Surreal.quotientEquivSupport.trans SupportBridge.surrealEquivCG + +end ConwayRefinement.Standalone.InlineConwayRefinement +namespace ConwayRefinement.Standalone.InlineConwayRefinement.SupportBridge + +universe u + +theorem supportConway : + ConwayRefinement.Standalone.InlineSurreal.Surreal.ConwayConjecture.{u} := by + intro a b c d ha hb hc hd habcd + have ha' := (isConwayOmnificInteger_iff a).mp ha + have hb' := (isConwayOmnificInteger_iff b).mp hb + have hc' := (isConwayOmnificInteger_iff c).mp hc + have hd' := (isConwayOmnificInteger_iff d).mp hd + have habcd' : surrealToCG a * surrealToCG b = surrealToCG c * surrealToCG d := by + rw [← surrealToCG_mul, ← surrealToCG_mul, habcd] + obtain ⟨e, f, g, h, he, hf, hg, hh, hae, hbg, hce, hdf⟩ := + ConwayRefinement.Standalone.Oz.conwayConjecture_iff.mp + ConwayRefinement.Standalone.Oz.ConwayConjecture.proof + (surrealToCG a) (surrealToCG b) (surrealToCG c) (surrealToCG d) + ha' hb' hc' hd' habcd' + refine ⟨surrealFromCG e, surrealFromCG f, surrealFromCG g, surrealFromCG h, + ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · apply (isConwayOmnificInteger_iff _).mpr + simpa only [surrealToCG_fromCG] using he + · apply (isConwayOmnificInteger_iff _).mpr + simpa only [surrealToCG_fromCG] using hf + · apply (isConwayOmnificInteger_iff _).mpr + simpa only [surrealToCG_fromCG] using hg + · apply (isConwayOmnificInteger_iff _).mpr + simpa only [surrealToCG_fromCG] using hh + · apply surrealEquivCG.injective + change surrealToCG a = surrealToCG (surrealFromCG e * surrealFromCG f) + rw [surrealToCG_mul, surrealToCG_fromCG, surrealToCG_fromCG] + exact hae + · apply surrealEquivCG.injective + change surrealToCG b = surrealToCG (surrealFromCG g * surrealFromCG h) + rw [surrealToCG_mul, surrealToCG_fromCG, surrealToCG_fromCG] + exact hbg + · apply surrealEquivCG.injective + change surrealToCG c = surrealToCG (surrealFromCG e * surrealFromCG g) + rw [surrealToCG_mul, surrealToCG_fromCG, surrealToCG_fromCG] + exact hce + · apply surrealEquivCG.injective + change surrealToCG d = surrealToCG (surrealFromCG f * surrealFromCG h) + rw [surrealToCG_mul, surrealToCG_fromCG, surrealToCG_fromCG] + exact hdf + +end ConwayRefinement.Standalone.InlineConwayRefinement.SupportBridge + +namespace ConwayRefinement.Standalone.InlineConwayRefinement + +universe u + +theorem Game.equivalent_iff_toSupport (x y : Game.{u}) : + Game.Equivalent x y ↔ + (Game.toSupport x ≤ Game.toSupport y ∧ Game.toSupport y ≤ Game.toSupport x) := by + rw [Game.equivalent_iff] + rw [Game.toSupport_le, Game.toSupport_le] + +theorem Surreal.productsEqual_iff_toSupport (a b c d : Surreal.{u}) : + Game.Equivalent (Game.mul a.game b.game) (Game.mul c.game d.game) ↔ + a.toSupport * b.toSupport = c.toSupport * d.toSupport := by + letI := a.numeric.toSupport + letI := b.numeric.toSupport + letI := c.numeric.toSupport + letI := d.numeric.toSupport + rw [Game.equivalent_iff_toSupport, Game.toSupport_mul, Game.toSupport_mul] + simp only [Surreal.toSupport_eq] + rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_mul, + ← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_mul] + rw [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk] + rfl + +theorem Surreal.equalsProduct_iff_toSupport (a e f : Surreal.{u}) : + Game.Equivalent a.game (Game.mul e.game f.game) ↔ + a.toSupport = e.toSupport * f.toSupport := by + letI := a.numeric.toSupport + letI := e.numeric.toSupport + letI := f.numeric.toSupport + rw [Game.equivalent_iff_toSupport, Game.toSupport_mul] + simp only [Surreal.toSupport_eq] + rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_mul] + rw [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk] + rfl + +theorem Game.toSupport_mk {Left Right : Type u} + (left : Left → Game.{u}) (right : Right → Game.{u}) : + Game.toSupport (.mk Left Right left right) = + ConwayRefinement.Standalone.InlineSurreal.ofSets + (ConwayRefinement.Standalone.InlineSurreal.Player.cases + (Set.range fun i : Left ↦ Game.toSupport (left i)) + (Set.range fun i : Right ↦ Game.toSupport (right i))) trivial := (rfl) + +theorem Game.toSupport_zero : Game.toSupport (Game.zero : Game.{u}) = + (0 : ConwayRefinement.Standalone.InlineSurreal.IGame.{u}) := by + rw [Game.zero_eq, Game.toSupport_mk] + apply ConwayRefinement.Standalone.InlineSurreal.IGame.ext + intro p + cases p + · rw [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets, + ConwayRefinement.Standalone.InlineSurreal.IGame.moves_zero] + ext z + constructor + · rintro ⟨i, _⟩ + exact nomatch i.down + · simp + · rw [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets, + ConwayRefinement.Standalone.InlineSurreal.IGame.moves_zero] + ext z + constructor + · rintro ⟨i, _⟩ + exact nomatch i.down + · simp + +theorem Game.toSupport_one : Game.toSupport (Game.one : Game.{u}) = + (1 : ConwayRefinement.Standalone.InlineSurreal.IGame.{u}) := by + rw [Game.one_eq, Game.toSupport_mk] + apply ConwayRefinement.Standalone.InlineSurreal.IGame.ext + intro p + cases p + · rw [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] + rw [ConwayRefinement.Standalone.InlineSurreal.IGame.one_def, + ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] + ext z + constructor + · rintro ⟨_, rfl⟩ + exact Game.toSupport_zero + · intro hz + have hz' : z = 0 := by simpa using hz + subst z + exact ⟨PUnit.unit, Game.toSupport_zero⟩ + · rw [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets, + ConwayRefinement.Standalone.InlineSurreal.IGame.one_def, + ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] + ext z + constructor + · rintro ⟨i, _⟩ + exact nomatch i.down + · simp + +theorem Game.toSupport_singletonIntegerCut_numeric (x : Surreal.{u}) : + ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric + (Game.toSupport (Surreal.singletonIntegerCut x.game)) := by + letI := x.numeric.toSupport + rw [Surreal.singletonIntegerCut_eq] + rw [Game.toSupport_mk] + rw [ConwayRefinement.Standalone.InlineSurreal.IGame.numeric_def] + simp only [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets, + Set.forall_mem_range] + constructor + · intro _ _ + change ConwayRefinement.Standalone.InlineConwayRefinement.Game.toSupport + (ConwayRefinement.Standalone.InlineConwayRefinement.Game.add x.game + (ConwayRefinement.Standalone.InlineConwayRefinement.Game.neg + ConwayRefinement.Standalone.InlineConwayRefinement.Game.one)) < + ConwayRefinement.Standalone.InlineConwayRefinement.Game.toSupport + (ConwayRefinement.Standalone.InlineConwayRefinement.Game.add x.game + ConwayRefinement.Standalone.InlineConwayRefinement.Game.one) + rw [ConwayRefinement.Standalone.InlineConwayRefinement.Game.toSupport_add x.game + (ConwayRefinement.Standalone.InlineConwayRefinement.Game.neg + (show Game.{u} from ConwayRefinement.Standalone.InlineConwayRefinement.Game.one)), + ConwayRefinement.Standalone.InlineConwayRefinement.Game.toSupport_add x.game + (show Game.{u} from ConwayRefinement.Standalone.InlineConwayRefinement.Game.one), + ConwayRefinement.Standalone.InlineConwayRefinement.Game.toSupport_neg + (show Game.{u} from ConwayRefinement.Standalone.InlineConwayRefinement.Game.one)] + rw [Game.toSupport_one] + apply ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_lt_mk.mp + simp only [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_add, + ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_neg, + ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_one] + linarith + · intro p y hy + cases p + · obtain ⟨_, rfl⟩ := hy + change ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric + (ConwayRefinement.Standalone.InlineConwayRefinement.Game.toSupport + (ConwayRefinement.Standalone.InlineConwayRefinement.Game.add x.game + (ConwayRefinement.Standalone.InlineConwayRefinement.Game.neg + ConwayRefinement.Standalone.InlineConwayRefinement.Game.one))) + rw [ConwayRefinement.Standalone.InlineConwayRefinement.Game.toSupport_add x.game + (ConwayRefinement.Standalone.InlineConwayRefinement.Game.neg + (show Game.{u} from ConwayRefinement.Standalone.InlineConwayRefinement.Game.one)), + ConwayRefinement.Standalone.InlineConwayRefinement.Game.toSupport_neg + (show Game.{u} from ConwayRefinement.Standalone.InlineConwayRefinement.Game.one)] + rw [Game.toSupport_one] + infer_instance + · obtain ⟨_, rfl⟩ := hy + change ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric + (ConwayRefinement.Standalone.InlineConwayRefinement.Game.toSupport + (ConwayRefinement.Standalone.InlineConwayRefinement.Game.add x.game + ConwayRefinement.Standalone.InlineConwayRefinement.Game.one)) + rw [ConwayRefinement.Standalone.InlineConwayRefinement.Game.toSupport_add x.game + (show Game.{u} from ConwayRefinement.Standalone.InlineConwayRefinement.Game.one)] + rw [Game.toSupport_one] + infer_instance + +theorem Surreal.toSupport_sub_one (x : Surreal.{u}) : + @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk + (Game.toSupport (Game.add x.game (Game.neg Game.one))) (by + letI := x.numeric.toSupport + rw [Game.toSupport_add, Game.toSupport_neg, Game.toSupport_one] + infer_instance) = x.toSupport - 1 := by + letI := x.numeric.toSupport + simp only [Game.toSupport_add, Game.toSupport_neg, Game.toSupport_one] + simpa only [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_neg, + ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_one, Surreal.toSupport_eq, + sub_eq_add_neg] using + (ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_add + (Game.toSupport x.game) (-1 : ConwayRefinement.Standalone.InlineSurreal.IGame.{u})) + +theorem Surreal.toSupport_add_one (x : Surreal.{u}) : + @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk + (Game.toSupport (Game.add x.game Game.one)) (by + letI := x.numeric.toSupport + rw [Game.toSupport_add, Game.toSupport_one] + infer_instance) = x.toSupport + 1 := by + letI := x.numeric.toSupport + simp only [Game.toSupport_add, Game.toSupport_one] + simpa only [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_one, + Surreal.toSupport_eq] using + (ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_add + (Game.toSupport x.game) (1 : ConwayRefinement.Standalone.InlineSurreal.IGame.{u})) + +theorem Surreal.toSupport_singletonIntegerCut (x : Surreal.{u}) : + @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk + (Game.toSupport (Surreal.singletonIntegerCut x.game)) + (Game.toSupport_singletonIntegerCut_numeric x) = + ConwayRefinement.Standalone.InlineSurreal.Surreal.singletonIntegerCut x.toSupport := by + simp only [Surreal.singletonIntegerCut_eq, Game.toSupport_mk] + rw [ConwayRefinement.Standalone.InlineSurreal.Surreal.singletonIntegerCut] + rw [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_ofSets] + congr 2 + · ext z + simp only [Set.mem_range, Set.mem_singleton_iff] + constructor + · rintro ⟨⟨_, ⟨_, rfl⟩⟩, rfl⟩ + exact Surreal.toSupport_sub_one x + · rintro rfl + refine ⟨⟨Game.toSupport (Game.add x.game (Game.neg Game.one)), + ⟨PUnit.unit, rfl⟩⟩, ?_⟩ + exact Surreal.toSupport_sub_one x + · ext z + simp only [Set.mem_range, Set.mem_singleton_iff] + constructor + · rintro ⟨⟨_, ⟨_, rfl⟩⟩, rfl⟩ + exact Surreal.toSupport_add_one x + · rintro rfl + refine ⟨⟨Game.toSupport (Game.add x.game Game.one), + ⟨PUnit.unit, rfl⟩⟩, ?_⟩ + exact Surreal.toSupport_add_one x + +theorem Surreal.isConwayOmnificInteger_iff_toSupport (x : Surreal.{u}) : + IsConwayOmnificInteger x ↔ + ConwayRefinement.Standalone.InlineSurreal.Surreal.IsConwayOmnificInteger x.toSupport := by + letI := x.numeric.toSupport + letI := Game.toSupport_singletonIntegerCut_numeric x + rw [Surreal.isConwayOmnificInteger_iff, + ConwayRefinement.Standalone.InlineSurreal.Surreal.IsConwayOmnificInteger] + constructor + · intro hx + have hraw := Game.equivalent_iff_toSupport _ _ |>.mp hx + have hmk : x.toSupport = + @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk + (Game.toSupport (Surreal.singletonIntegerCut x.game)) inferInstance := by + rw [Surreal.toSupport_eq, + ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk] + exact hraw + exact hmk.trans (Surreal.toSupport_singletonIntegerCut x) + · intro hx + apply Game.equivalent_iff_toSupport _ _ |>.mpr + apply ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk.mp + rw [← Surreal.toSupport_eq] + exact hx.trans (Surreal.toSupport_singletonIntegerCut x).symm + +theorem Surreal.conwayRefinementProof : Surreal.ConwayConjecture.{u} := by + intro a b c d ha hb hc hd habcd + have ha' := (Surreal.isConwayOmnificInteger_iff_toSupport a).mp ha + have hb' := (Surreal.isConwayOmnificInteger_iff_toSupport b).mp hb + have hc' := (Surreal.isConwayOmnificInteger_iff_toSupport c).mp hc + have hd' := (Surreal.isConwayOmnificInteger_iff_toSupport d).mp hd + have habcd' := (Surreal.productsEqual_iff_toSupport a b c d).mp habcd + obtain ⟨e, f, g, h, he, hf, hg, hh, hae, hbg, hce, hdf⟩ := + SupportBridge.supportConway a.toSupport b.toSupport c.toSupport d.toSupport + ha' hb' hc' hd' habcd' + refine ⟨Surreal.fromSupport e, Surreal.fromSupport f, + Surreal.fromSupport g, Surreal.fromSupport h, + ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · apply (Surreal.isConwayOmnificInteger_iff_toSupport _).mpr + simpa only [Surreal.toSupport_fromSupport] using he + · apply (Surreal.isConwayOmnificInteger_iff_toSupport _).mpr + simpa only [Surreal.toSupport_fromSupport] using hf + · apply (Surreal.isConwayOmnificInteger_iff_toSupport _).mpr + simpa only [Surreal.toSupport_fromSupport] using hg + · apply (Surreal.isConwayOmnificInteger_iff_toSupport _).mpr + simpa only [Surreal.toSupport_fromSupport] using hh + · apply (Surreal.equalsProduct_iff_toSupport _ _ _).mpr + simpa only [Surreal.toSupport_fromSupport] using hae + · apply (Surreal.equalsProduct_iff_toSupport _ _ _).mpr + simpa only [Surreal.toSupport_fromSupport] using hbg + · apply (Surreal.equalsProduct_iff_toSupport _ _ _).mpr + simpa only [Surreal.toSupport_fromSupport] using hce + · apply (Surreal.equalsProduct_iff_toSupport _ _ _).mpr + simpa only [Surreal.toSupport_fromSupport] using hdf + +end ConwayRefinement.Standalone.InlineConwayRefinement diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean new file mode 100644 index 0000000000..a5430c0bc4 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean @@ -0,0 +1,3040 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Copyright (c) 2025 Aaron Liu. All rights reserved. +Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. +Copyright (c) 2025 Yuyang Zhao. All rights reserved. +Copyright (c) 2024 Theodore Hwa. All rights reserved. +Copyright (c) 2019 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov, Aaron Liu, Apurva Nakade, Fox Thomson, František Silváši, +Isabel Longbottom, Junyan Xu, Kim Morrison, Mario Carneiro, Reid Barton, Theodore Hwa, +Violeta Hernández Palacios, Yuyang Zhao +-/ +/- +Adapted and modified from the Apache-2.0-licensed CombinatorialGames library: +https://github.com/vihdzp/combinatorial-games +The inlined source modules are named below. +-/ +module + +public import Mathlib.Algebra.Ring.Defs +public import Mathlib.Data.Fintype.Defs +public import Mathlib.Logic.Small.Defs +import Mathlib.Tactic.DeriveFintype +public import Mathlib.Data.QPF.Univariate.Basic +import Mathlib.Logic.Small.Set +import Mathlib.Logic.Relation +import Mathlib.Order.SetNotation +public import Mathlib.Algebra.Group.Pointwise.Set.Small +public import Mathlib.Algebra.Order.ZeroLEOne +public import Mathlib.Order.Comparable +import Mathlib.Lean.PrettyPrinter.Delaborator +public import Mathlib.Logic.Hydra +import Mathlib.Order.GameAdd +public meta import Lean.Elab.Tactic.Basic +public meta import Lean.Meta.Tactic.Assert +public import Mathlib.Algebra.CharZero.Defs +public import Mathlib.Algebra.Order.Monoid.Defs +import Mathlib.Algebra.Order.Ring.Cast +import Mathlib.Tactic.Abel +import Mathlib.Data.Int.Cast.Lemmas +public import Mathlib.Algebra.Order.Hom.Monoid +public import Mathlib.Algebra.Order.Ring.Defs + +/-! +# A minimal concrete construction of surreal numbers + +This file inlines the numeric-game quotient, addition, and multiplication needed to state +Conway's refinement conjecture without importing CombinatorialGames. The construction is adapted +from the Apache-2.0 CombinatorialGames library. General birthdays, ordinal games, division, +and the complete lattice of surreal cuts are deliberately omitted. +-/ + +namespace ConwayRefinement.Standalone.InlineSurreal + +/-! ## Inlined from `CombinatorialGames.Game.Player` -/ + +/-! +# Type of players + +This file implements the two-element type of players (`Left`, `Right`), alongside other basic +notational machinery to be used within game theory. +-/ + +@[expose] public section + +universe u_inline_0 + +/-! ### Players -/ + +/-- Either the Left or Right player. -/ +@[aesop safe cases, grind cases] +inductive Player where + /-- The Left player. -/ + | left : Player + /-- The Right player. -/ + | right : Player +deriving DecidableEq, Fintype, Inhabited + +namespace Player + +/-- Specify a function `Player → α` from its two outputs. -/ +@[simp] +abbrev cases {α : Sort*} (l r : α) : Player → α + | left => l + | right => r + +lemma apply_cases {α β : Sort*} (f : α → β) (l r : α) (p : Player) : + f (cases l r p) = cases (f l) (f r) p := by + cases p <;> rfl + +@[simp] +theorem cases_inj {α : Sort*} {l₁ r₁ l₂ r₂ : α} : + cases l₁ r₁ = cases l₂ r₂ ↔ l₁ = l₂ ∧ r₁ = r₂ := + ⟨fun h ↦ ⟨congr($h left), congr($h right)⟩, fun ⟨hl, hr⟩ ↦ hl ▸ hr ▸ rfl⟩ + +theorem const_of_left_eq_right {α : Sort*} {f : Player → α} (hf : f left = f right) : + ∀ p q, f p = f q + | left, left | right, right => rfl + | left, right => hf + | right, left => hf.symm + +theorem const_of_left_eq_right' {f : Player → Prop} (hf : f left ↔ f right) (p q) : f p ↔ f q := + (const_of_left_eq_right hf.eq ..).to_iff + +@[simp] +protected lemma «forall» {p : Player → Prop} : + (∀ x, p x) ↔ p left ∧ p right := + ⟨fun h ↦ ⟨h left, h right⟩, fun ⟨hl, hr⟩ ↦ fun | left => hl | right => hr⟩ + +@[simp] +protected lemma «exists» {p : Player → Prop} : + (∃ x, p x) ↔ p left ∨ p right := + ⟨fun | ⟨left, h⟩ => .inl h | ⟨right, h⟩ => .inr h, fun | .inl h | .inr h => ⟨_, h⟩⟩ + +instance : Neg Player where + neg := cases right left + +@[simp, grind =] lemma neg_left : -left = right := rfl +@[simp, grind =] lemma neg_right : -right = left := rfl +@[simp] theorem eq_neg : ∀ {p q : Player}, p = -q ↔ p ≠ q := by decide +@[simp] theorem neg_eq : ∀ {p q : Player}, -p = q ↔ p ≠ q := by decide +theorem ne_neg : ∀ {p q : Player}, p ≠ -q ↔ p = q := by decide +theorem neg_ne : ∀ {p q : Player}, -p ≠ q ↔ p = q := by decide +theorem neg_ne_self : ∀ (p : Player), -p ≠ p := by decide +theorem self_ne_neg : ∀ (p : Player), p ≠ -p := by decide + +instance : InvolutiveNeg Player where + neg_neg := by decide + +/-- +The multiplication of `Player`s is used to state the lemmas about the multiplication of +combinatorial games, such as `IGame.mulOption_mem_moves_mul`. +-/ +instance : Mul Player where mul + | left, p => p + | right, p => -p + +@[simp, grind =] lemma left_mul (p : Player) : left * p = p := rfl +@[simp, grind =] lemma right_mul (p : Player) : right * p = -p := rfl +@[simp, grind =] lemma mul_left : ∀ p, p * left = p := by decide +@[simp, grind =] lemma mul_right : ∀ p, p * right = -p := by decide +@[simp, grind =] lemma mul_self : ∀ p, p * p = left := by decide + +instance : HasDistribNeg Player where + neg_mul := by decide + mul_neg := by decide + +instance : CommGroup Player where + one := left + inv := id + mul_assoc := by decide + mul_comm := by decide + one_mul := by decide + mul_one := by decide + inv_mul_cancel := by decide + +@[simp, grind =] lemma one_eq_left : 1 = left := rfl +@[simp, grind =] lemma inv_eq_self (p : Player) : p⁻¹ = p := rfl + +end Player + +open Player + +/-! ### OfSets -/ + +/-- +Type class for the `ofSets` operation. +Used to implement the `!{st}` and `!{s | t}` syntax. +-/ +class OfSets (α : Type (u_inline_0 + 1)) (Valid : outParam ((Player → Set α) → Prop)) where + /-- Construct a combinatorial game from its left and right sets. -/ + ofSets (st : Player → Set α) (h : Valid st) [Small.{u_inline_0} (st left)] + [Small.{u_inline_0} (st right)] : α +export OfSets (ofSets) + +@[inherit_doc OfSets.ofSets] +macro "!{" st:term "}'" h:term:max : term => `(OfSets.ofSets $st $h) + +@[inherit_doc OfSets.ofSets] +macro "!{" s:term " | " t:term "}'" h:term:max : term => `(!{Player.cases $s $t}'$h) + +/-- A tactic which attempts to automatically solve goals which appear on `OfSets`. -/ +macro "ofSetsTactic" : tactic => + `(tactic| first + | done + | trivial + | assumption + | aesop + | fail "failed to prove sets are valid, try to use `!{st}'h` notation instead, \ +where `h` is a proof that sets are valid" + ) + +@[inherit_doc OfSets.ofSets] +macro:max "!{" st:term "}" : term => `(!{$st}'(by ofSetsTactic)) + +@[inherit_doc OfSets.ofSets] +macro:max "!{" s:term " | " t:term "}" : term => `(!{$s | $t}'(by ofSetsTactic)) + +recommended_spelling "ofSets" for "!{st}'h" in [ofSets, «term!{_}'_»] +recommended_spelling "ofSets" for "!{s | t}'h" in [ofSets, «term!{_|_}'_»] +recommended_spelling "ofSets" for "!{st}" in [ofSets, «term!{_}»] +recommended_spelling "ofSets" for "!{s | t}" in [ofSets, «term!{_|_}»] + +open Lean PrettyPrinter Delaborator SubExpr in +/-- Delaborates `ofSets (Player.cases s t)` to `!{s | t}` and `ofSets st` to `!{st}`. -/ +@[app_delab OfSets.ofSets] +meta def delabOfSets : Delab := do + let e ← getExpr + guard <| e.isAppOfArity' ``OfSets.ofSets 7 + withNaryArg 3 do + let e ← getExpr + if e.isAppOfArity' ``Player.cases 3 then + let s ← withNaryArg 1 delab + let t ← withNaryArg 2 delab + `(!{$s | $t}) + else + let st ← delab + `(!{$st}) + +theorem ofSets_eq_ofSets_cases {α} {Valid : (Player → Set α) → Prop} [OfSets α Valid] + (st : Player → Set α) (h : Valid st) [Small (st left)] [Small (st right)] : + !{st} = !{st left | st right}'(by convert h; aesop) := by + congr; ext1 p; cases p <;> rfl + +end + +/-! ## Inlined from `CombinatorialGames.Game.Functor` -/ + +/-! +# Game functor + +The type of games `IGame` is an inductive type, with a single constructor `ofSets` taking in two +small sets of games (one for each player) and outputting a new game. This suggests the definition: + +``` +inductive IGame : Type (u_inline_1 + 1) + | ofSets (st : Player → Set IGame) [∀ p, Small.{u_inline_1} (st p)] : IGame.{u_inline_1} +``` + +However, the kernel does not accept this, as `Set IGame = IGame → Prop` contains a non-positive +occurence of `IGame` (see [counterexamples.org](https://counterexamples.org/strict-positivity.html) +for an explanation of what this is and why it's disallowed). We can get around this technical +limitation using the machinery of `QPF`s (quotients of polynomial functors). We define a functor +`GameFunctor` by + +``` +def GameFunctor (α : Type (u_inline_1 + 1)) : Type (u_inline_1 + 1) := + {st : Player → Set α // Small.{u_inline_1} (st left) ∧ Small.{u_inline_1} (st right)} +``` + +We can prove that this is a `QPF`, which then allows us to build its initial algebra through +`QPF.Fix`, which is exactly the inductive type `IGame`. As a bonus, we're able to describe the +coinductive type of loopy games `LGame` as the final coalgebra `QPF.Cofix` of the exact same +functor. +-/ + +universe u_inline_1 + +@[expose] public section + +/-! ### Game Functor -/ + +/-- The functor from a type into the subtype of small pairs of sets in that type. + +This is the quotient of a polynomial functor. The type `IGame` of well-founded games is defined as +the initial algebra of that `QPF`, while the type `LGame` of loopy games is defined as its final +coalgebra. + +In other words, `IGame` and `LGame` have the following descriptions (which don't work verbatim due +to various Lean limitations): + +``` +inductive IGame : Type (u_inline_1 + 1) + | ofSets (st : Player → Set IGame) [∀ p, Small.{u_inline_1} (st p)] : IGame.{u_inline_1} + +coinductive LGame : Type (u_inline_1 + 1) + | ofSets (st : Player → Set IGame) [∀ p, Small.{u_inline_1} (st p)] : LGame.{u_inline_1} +``` +-/ +def GameFunctor (α : Type (u_inline_1 + 1)) : Type (u_inline_1 + 1) := + {s : Player → Set α // ∀ p, Small.{u_inline_1} (s p)} + +namespace GameFunctor + +@[ext] +theorem ext {α : Type (u_inline_1 + 1)} {x y : GameFunctor α} : x.1 = y.1 → x = y := + Subtype.ext + +instance {α : Type (u_inline_1 + 1)} (x : GameFunctor α) (p : Player) : + Small.{u_inline_1} (x.1 p) := x.2 p + +instance : Functor GameFunctor where + map f s := ⟨(f '' s.1 ·), fun _ ↦ by infer_instance⟩ + +theorem map_def {α β} (f : α → β) (s : GameFunctor α) : + f <$> s = ⟨(f '' s.1 ·), fun _ ↦ by infer_instance⟩ := + rfl +noncomputable instance : QPF GameFunctor where + P := ⟨Player → Type u_inline_1, fun x ↦ Σ p, PLift (x p)⟩ + abs x := ⟨fun p ↦ Set.range (x.2 ∘ .mk p ∘ PLift.up), fun _ ↦ by infer_instance⟩ + repr x := ⟨fun p ↦ Shrink (x.1 p), Sigma.rec (fun _ y ↦ ((equivShrink _).symm y.1).1)⟩ + abs_repr x := by ext; simp [← (equivShrink _).exists_congr_right] + abs_map f := by intro ⟨x, f⟩; ext; simp [PFunctor.map, map_def] + +end GameFunctor + +/-! ## Inlined from `CombinatorialGames.Mathlib.Small` -/ + +/-! +# Tree with small sets of branches is small +-/ + +universe u_inline_2 + +public section + +open Set + +variable {α : Type*} (r : α → α → Prop) [H : ∀ x, Small.{u_inline_2} {y // r x y}] + +private def level (x : α) : ℕ → Set α + | 0 => {x} + | n + 1 => ⋃₀ ((fun x ↦ {y | r x y}) '' level x n) + +private theorem small_level (x : α) : ∀ n, Small.{u_inline_2} (level r x n) + | 0 => small_single _ + | n + 1 => by + refine @small_sUnion _ _ ?_ ?_ + · have := small_level x n + exact small_image .. + · simp_all + +private theorem small_sUnion_level (x : α) : Small.{u_inline_2} (⋃₀ range (level r x)) := by + refine @small_sUnion _ _ ?_ ?_ + · exact small_range .. + · simp [small_level] + +instance small_transGen (x : α) : Small.{u_inline_2} {y // Relation.TransGen r x y} := by + refine @small_subset _ _ _ (fun y hy ↦ ?_) (small_sUnion_level r x) + simp_rw [mem_sUnion, mem_range, exists_exists_eq_and] + induction hy with + | single => + use 1 + simpa [level] + | tail hy hr IH => + obtain ⟨n, hn⟩ := IH + use n + 1 + simpa [level] using ⟨_, hn, hr⟩ + +instance small_transGen' [∀ x, Small.{u_inline_2} {y // r y x}] (x : α) : + Small.{u_inline_2} {y // Relation.TransGen r y x} := by + simp_rw [← Relation.transGen_swap (r := r)] + infer_instance + +instance small_reflTransGen (x : α) : Small.{u_inline_2} {y // Relation.ReflTransGen r x y} := by + simp_rw [Relation.reflTransGen_iff_eq_or_transGen] + exact @small_insert _ _ _ (small_transGen ..) + +instance small_reflTransGen' [∀ x, Small.{u_inline_2} {y // r y x}] (x : α) : + Small.{u_inline_2} {y // Relation.ReflTransGen r y x} := by + simp_rw [← Relation.reflTransGen_swap (r := r)] + infer_instance + +/-! ## Inlined from `CombinatorialGames.Tactic.Register` -/ + + + +/-! ## Inlined from `CombinatorialGames.Game.IGame` -/ + +/-! +# Combinatorial (pre-)games + +The basic theory of combinatorial games, following Conway's book `On Numbers and Games`. + +In ZFC, games are built inductively out of two other sets of games, representing the options for two +players Left and Right. In Lean, we instead define the type of games `IGame` as arising from two +`Small` sets of games, with notation `!{s | t}`. A `u_inline_4`-small type `α : Type v` +is one that is equivalent to some `β : Type u_inline_4`, and the distinction between small and +large types in a given universe closely mimics the ZFC distinction between sets and proper classes. + +This definition requires some amount of setup, since Lean's inductive types aren't powerful enough +to express this on their own. See the docstring on `GameFunctor` for more information. + +We are also interested in further quotients of `IGame`. The quotient of games under equivalence +`x ≈ y ↔ x ≤ y ∧ y ≤ x`, which in the literature is often what is meant by a "combinatorial game", +is defined as `Game` in `CombinatorialGames.Game.Basic`. The surreal numbers `Surreal` are defined +as a quotient (of a subtype) of games in `CombinatorialGames.Surreal.Basic`. + +## Conway induction + +Most constructions within game theory, and as such, many proofs within it, are done by structural +induction. Structural induction on games is sometimes called "Conway induction". + +The most straightforward way to employ Conway induction is by using the termination checker, with +the auxiliary `igame_wf` tactic. This uses `solve_by_elim` to search the context for proofs of the +form `y ∈ xᴸ` or `y ∈ xᴿ`, which prove termination. Alternatively, you can use +the explicit recursion principles `IGame.ofSetsRecOn` or `IGame.moveRecOn`. + +## Order properties + +Pregames have both a `≤` and a `<` relation, satisfying the properties of a `Preorder`. The relation +`0 < x` means that `x` can always be won by Left, while `0 ≤ x` means that `x` can be won by Left as +the second player. Likewise, `x < 0` means that `x` can always be won by Right, while `x ≤ 0` means +that `x` can be won by Right as the second player. + +Note that we don't actually prove these characterizations. Indeed, in Conway's setup, combinatorial +game theory can be done entirely without the concept of a strategy. For instance, `IGame.zero_le` +implies that if `0 ≤ x`, then any move by Right satisfies `¬ x ≤ 0`, and `IGame.zero_lf` implies +that if `¬ x ≤ 0`, then some move by Left satisfies `0 ≤ x`. The strategy is thus already encoded +within these game relations. + +For convenience, we define notation `x ⧏ y` (pronounced "less or fuzzy") for `¬ y ≤ x`, notation +`x ‖ y` for `¬ x ≤ y ∧ ¬ y ≤ x`, and notation `x ≈ y` for `x ≤ y ∧ y ≤ x`. + +You can prove most (simple) inequalities on concrete games through the `game_cmp` tactic, which +repeatedly unfolds the definition of `≤` and applies `simp` until it solves the goal. + +## Algebraic structures + +Most of the usual arithmetic operations can be defined for games. Addition is defined for +`x = !{s₁ | t₁}` and `y = !{s₂ | t₂}` by `x + y = !{s₁ + y, x + s₂ | t₁ + y, x + t₂}`. Negation is +defined by `-!{s | t} = !{-t | -s}`. + +The order structures interact in the expected way with arithmetic. In particular, `Game` is an +`OrderedAddCommGroup`. Meanwhile, `IGame` satisfies the slightly weaker axioms of a +`SubtractionCommMonoid`, since the equation `x - x = 0` is only true up to equivalence. +-/ + +theorem _root_.Relation.transGen_iff_exists {α : Type*} {r : α → α → Prop} {x y : α} : + Relation.TransGen r x y ↔ ∃ z, r z y ∧ (x = z ∨ Relation.TransGen r x z) := by + rw [Relation.transGen_iff] + simp [and_or_left, exists_or, and_comm] + +universe u_inline_4 + +open Set Pointwise + +-- Computations can be performed through the `game_cmp` tactic. +public noncomputable section + +/-! ### Game moves -/ + +/-- Well-founded games up to identity. + +`IGame` uses the set-theoretic notion of equality on games, meaning that two `IGame`s are equal +exactly when their left and right sets of options are. + +This is not the same equivalence as used broadly in combinatorial game theory literature, as a game +like `{0, 1 | 0}` is not *identical* to `{1 | 0}`, despite being equivalent. However, many theorems +can be proven over the 'identical' equivalence relation, and the literature may occasionally +specifically use the 'identical' equivalence relation for this reason. The quotient `Game` of games +up to equality is defined in `CombinatorialGames.Game.Basic`. + +More precisely, `IGame` is the inductive type for the single constructor + +``` + | ofSets (s t : Set IGame.{u_inline_4}) [Small.{u_inline_4} s] + [Small.{u_inline_4} t] : IGame.{u_inline_4} +``` + +(though for technical reasons it's not literally defined as such). A consequence of this is that +there is no infinite line of play. See `LGame` for a definition of loopy games. -/ +def IGame : Type (u_inline_4 + 1) := + QPF.Fix GameFunctor + +namespace IGame +export Player (left right) + +/-- Construct an `IGame` from its left and right sets. + +This function is regrettably noncomputable. Among other issues, sets simply do not carry data in +Lean. To perform computations on `IGame` we can instead make use of the `game_cmp` tactic. -/ +@[no_expose] +instance : OfSets IGame fun _ ↦ True where + ofSets st _ := QPF.Fix.mk ⟨st, by rintro (_ | _) <;> assumption⟩ + +/-- The set of moves of the game. -/ +def moves (p : Player) (x : IGame.{u_inline_4}) : Set IGame.{u_inline_4} := x.dest.1 p + +/-- The set of left moves of the game. -/ +scoped notation:max x:max "ᴸ" => moves left x + +/-- The set of right moves of the game. -/ +scoped notation:max x:max "ᴿ" => moves right x + +instance (p : Player) (x : IGame.{u_inline_4}) : Small.{u_inline_4} (x.moves p) := x.dest.2 p + +@[simp] +theorem moves_ofSets (p) (st : Player → Set IGame) [Small.{u_inline_4} (st left)] + [Small.{u_inline_4} (st right)] : + !{st}.moves p = st p := by + dsimp [ofSets]; ext; rw [moves, QPF.Fix.dest_mk] + +@[simp] +theorem ofSets_moves (x : IGame) : !{x.moves} = x := x.mk_dest + + +theorem leftMoves_ofSets (s t : Set IGame) [Small.{u_inline_4} s] [Small.{u_inline_4} t] : + !{s | t}ᴸ = s := + moves_ofSets .. + + +theorem rightMoves_ofSets (s t : Set IGame) [Small.{u_inline_4} s] [Small.{u_inline_4} t] : + !{s | t}ᴿ = t := + moves_ofSets .. + +@[simp] +theorem ofSets_leftMoves_rightMoves (x : IGame) : !{xᴸ | xᴿ} = x := by + convert x.ofSets_moves with p + cases p <;> rfl + +/-- Two `IGame`s are equal when their move sets are. + +For the weaker but more common notion of equivalence where `x = y` if `x ≤ y` and `y ≤ x`, +use `Game`. -/ +@[ext] +theorem ext {x y : IGame.{u_inline_4}} (h : ∀ p, x.moves p = y.moves p) : + x = y := by + rw [← ofSets_moves x, ← ofSets_moves y] + simp_rw [funext h] + +@[simp] +theorem ofSets_inj' {st₁ st₂ : Player → Set IGame} + [Small (st₁ left)] [Small (st₁ right)] [Small (st₂ left)] [Small (st₂ right)] : + !{st₁} = !{st₂} ↔ st₁ = st₂ := by + simp_rw [IGame.ext_iff, moves_ofSets, funext_iff] + +theorem ofSets_inj {s₁ s₂ t₁ t₂ : Set IGame} [Small s₁] [Small s₂] [Small t₁] [Small t₂] : + !{s₁ | t₁} = !{s₂ | t₂} ↔ s₁ = s₂ ∧ t₁ = t₂ := by + simp + +/-- A (proper) subposition is any game reachable a nonempty sequence of +(not necessarily alternating) left and right moves. -/ +def Subposition : IGame → IGame → Prop := + Relation.TransGen fun x y => x ∈ ⋃ p, y.moves p + +@[aesop unsafe apply 50%] +theorem Subposition.of_mem_moves {p} {x y : IGame} (h : x ∈ y.moves p) : Subposition x y := + Relation.TransGen.single (Set.mem_iUnion_of_mem p h) + +theorem Subposition.trans {x y z : IGame} (h₁ : Subposition x y) (h₂ : Subposition y z) : + Subposition x z := + Relation.TransGen.trans h₁ h₂ + +instance : IsTrans _ Subposition := inferInstanceAs (IsTrans _ (Relation.TransGen _)) + +/-- The set of games reachable from a given game is small. -/ +instance small_setOf_subposition (x : IGame.{u_inline_4}) : + Small.{u_inline_4} {y | Subposition y x} := + small_transGen' _ x + +/-- A variant of `small_setOf_subposition` in simp-normal form -/ +instance small_subtype_subposition (x : IGame.{u_inline_4}) : + Small.{u_inline_4} {y // Subposition y x} := + small_transGen' _ x + +theorem subposition_wf : WellFounded Subposition := by + refine ⟨fun x => Acc.transGen ?_⟩ + apply QPF.Fix.ind + unfold moves + rintro _ ⟨⟨st, hst⟩, rfl⟩ + constructor + rintro y hy + rw [QPF.Fix.dest_mk, mem_iUnion] at hy + obtain ⟨_, ⟨_, h⟩, _, rfl⟩ := hy + exact h + +-- We make no use of `IGame`'s definition from a `QPF` after this point. +attribute [irreducible] IGame + +instance : IsWellFounded _ Subposition := ⟨subposition_wf⟩ +instance : WellFoundedRelation IGame := ⟨Subposition, instIsWellFoundedSubposition.wf⟩ + +theorem Subposition.irrefl (x : IGame) : ¬Subposition x x := _root_.irrefl x + +theorem self_notMem_moves (p : Player) (x : IGame) : x ∉ x.moves p := + fun hx ↦ Subposition.irrefl x (.of_mem_moves hx) + +/-- `WSubposition x y` means that `x` is reachable from `y` by a sequence of moves. +It is the non-strict version of `Subposition`. -/ +def WSubposition (x y : IGame) : Prop := x = y ∨ Subposition x y + +theorem wsubposition_iff_eq_or_subposition {x y : IGame} : + WSubposition x y ↔ x = y ∨ Subposition x y := .rfl + +theorem subposition_iff_exists {x y : IGame} : Subposition x y ↔ + ∃ p, ∃ z ∈ y.moves p, WSubposition x z := by + unfold WSubposition Subposition + rw [Relation.transGen_iff_exists] + simp_rw [mem_iUnion, ← exists_and_right, and_or_left] + exact exists_comm + +/-- The set of games reachable from a given game is small. -/ +instance small_setOf_wsubposition (x : IGame.{u_inline_4}) : + Small.{u_inline_4} {y | WSubposition y x} := + small_insert x {y | Subposition y x} + +/-- A variant of `small_setOf_wsubposition` in simp-normal form -/ +instance small_subtype_wsubposition (x : IGame.{u_inline_4}) : + Small.{u_inline_4} {y // WSubposition y x} := + small_insert x {y | Subposition y x} + +@[simp, refl] theorem WSubposition.refl (x : IGame) : WSubposition x x := .inl rfl +theorem WSubposition.rfl {x : IGame} : WSubposition x x := .refl x +theorem wsubposition_of_eq {x y : IGame} (hxy : x = y) : WSubposition x y := hxy ▸ .rfl + +theorem wsubposition_of_subposition {x y : IGame} (h : Subposition x y) : + WSubposition x y := .inr h + +alias Subposition.wsubposition := wsubposition_of_subposition + +theorem subposition_of_wsubposition_of_subposition {x y z : IGame} + (hxy : WSubposition x y) (hyz : Subposition y z) : Subposition x z := by + obtain rfl | hxy := hxy + · exact hyz + · exact hxy.trans hyz + +theorem subposition_of_subposition_of_wsubposition {x y z : IGame} + (hxy : Subposition x y) (hyz : WSubposition y z) : Subposition x z := by + obtain rfl | hyz := hyz + · exact hxy + · exact hxy.trans hyz + +alias WSubposition.trans_subposition := subposition_of_wsubposition_of_subposition +alias Subposition.trans_wsubposition' := subposition_of_wsubposition_of_subposition +alias Subposition.trans_wsubposition := subposition_of_subposition_of_wsubposition +alias WSubposition.trans_subposition' := subposition_of_subposition_of_wsubposition + +@[trans] theorem wsubposition_trans {x y z : IGame} + (hxy : WSubposition x y) (hyz : WSubposition y z) : WSubposition x z := by + obtain rfl | hyz := hyz + · exact hxy + · exact (hxy.trans_subposition hyz).wsubposition + +alias WSubposition.trans := wsubposition_trans + +instance : Trans Subposition Subposition Subposition := ⟨Subposition.trans⟩ +instance : Trans WSubposition Subposition Subposition := ⟨WSubposition.trans_subposition⟩ +instance : Trans Subposition WSubposition Subposition := ⟨Subposition.trans_wsubposition⟩ +instance : Trans WSubposition WSubposition WSubposition := ⟨WSubposition.trans⟩ + +theorem not_subposition_of_wsubposition {x y : IGame} (hxy : WSubposition x y) : + ¬Subposition y x := fun hyx => Subposition.irrefl x (hxy.trans_subposition hyx) + +theorem not_wsubposition_of_subposition {x y : IGame} (hxy : Subposition x y) : + ¬WSubposition y x := fun hyx => Subposition.irrefl x (hxy.trans_wsubposition hyx) + +alias WSubposition.not_subposition := not_subposition_of_wsubposition +alias Subposition.not_wsubposition := not_wsubposition_of_subposition + +theorem wsubposition_antisymm {x y : IGame} + (hxy : WSubposition x y) (hyx : WSubposition y x) : x = y := + hxy.resolve_right fun h => Subposition.irrefl x (h.trans_wsubposition hyx) + +alias WSubposition.antisymm := wsubposition_antisymm + +theorem wsubposition_antisymm_iff {x y : IGame} : x = y ↔ WSubposition x y ∧ WSubposition y x := + ⟨fun h => h ▸ ⟨.rfl, .rfl⟩, fun h => h.1.antisymm h.2⟩ + +theorem subposition_of_wsubposition_of_ne {x y : IGame} (hw : WSubposition x y) (hne : x ≠ y) : + Subposition x y := hw.resolve_left hne + +theorem subposition_of_wsubposition_not_wsubposition {x y : IGame} + (hxy : WSubposition x y) (hyx : ¬WSubposition y x) : Subposition x y := + hxy.resolve_left fun h => hyx (wsubposition_of_eq h.symm) + +theorem subposition_iff_wsubposition_not_wsubposition {x y : IGame} : + Subposition x y ↔ WSubposition x y ∧ ¬WSubposition y x := + ⟨fun hxy => ⟨hxy.wsubposition, hxy.not_wsubposition⟩, + fun h => subposition_of_wsubposition_not_wsubposition h.1 h.2⟩ + +theorem WSubposition.of_mem_moves {p : Player} {x y : IGame} (hxy : x ∈ y.moves p) : + WSubposition x y := (Subposition.of_mem_moves hxy).wsubposition + +/-- **Conway recursion**: build data for a game by recursively building it on its +left and right sets. You rarely need to use this explicitly, as the termination checker will handle +things for you. + +See `ofSetsRecOn` for an alternate form. -/ +@[elab_as_elim] +def moveRecOn {motive : IGame → Sort*} (x) + (ind : Π x, (Π p, Π y ∈ x.moves p, motive y) → motive x) : + motive x := + subposition_wf.recursion x fun x IH ↦ ind x (fun _ _ h ↦ IH _ (.of_mem_moves h)) + +theorem moveRecOn_eq {motive : IGame → Sort*} (x) + (ind : Π x, (Π p, Π y ∈ x.moves p, motive y) → motive x) : + moveRecOn x ind = ind x (fun _ y _ ↦ moveRecOn y ind) := + subposition_wf.fix_eq .. + +/-- **Conway recursion**: build data for a game by recursively building it on its +left and right sets. You rarely need to use this explicitly, as the termination checker will handle +things for you. + +See `moveRecOn` for an alternate form. -/ +@[elab_as_elim] +def ofSetsRecOn {motive : IGame.{u_inline_4} → Sort*} (x) + (ofSets : Π (s t : Set IGame) [Small s] [Small t], + (Π x ∈ s, motive x) → (Π x ∈ t, motive x) → motive !{s | t}) : + motive x := + cast (by simp) <| moveRecOn (motive := fun x ↦ motive !{xᴸ | xᴿ}) x + fun x IH ↦ ofSets _ _ + (fun y hy ↦ cast (by simp) (IH left y hy)) (fun y hy ↦ cast (by simp) (IH right y hy)) + +@[simp] +theorem ofSetsRecOn_ofSets {motive : IGame.{u_inline_4} → Sort*} + (s t : Set IGame) [Small.{u_inline_4} s] [Small.{u_inline_4} t] + (ofSets : Π (s t : Set IGame) [Small s] [Small t], + (Π x ∈ s, motive x) → (Π x ∈ t, motive x) → motive !{s | t}) : + ofSetsRecOn !{s | t} ofSets = + ofSets _ _ (fun y _ ↦ ofSetsRecOn y ofSets) (fun y _ ↦ ofSetsRecOn y ofSets) := by + rw [ofSetsRecOn, cast_eq_iff_heq, moveRecOn_eq] + simp_rw [ofSetsRecOn] + congr! <;> simp_all + +/-- Discharges proof obligations of the form `⊢ Subposition ..` arising in termination proofs +of definitions using well-founded recursion on `IGame`. -/ +macro "igame_wf" config:Lean.Parser.Tactic.optConfig : tactic => + `(tactic| all_goals solve_by_elim $config + [Prod.Lex.left, Prod.Lex.right, PSigma.Lex.left, PSigma.Lex.right, + Subposition.of_mem_moves, Subposition.trans, Subtype.prop] ) + +/-! ### Basic games -/ + +/-- The game `0 = !{∅ | ∅}`. -/ +instance : Zero IGame := ⟨!{fun _ ↦ ∅}⟩ + +theorem zero_def : (0 : IGame) = !{fun _ ↦ ∅} := rfl + +@[simp] theorem moves_zero (p : Player) : moves p 0 = ∅ := moves_ofSets .. + +instance : Inhabited IGame := ⟨0⟩ + +/-- The game `1 = !{{0} | ∅}`. -/ +instance : One IGame := ⟨!{{0} | ∅}⟩ + +theorem one_def : (1 : IGame) = !{{0} | ∅} := rfl + +@[simp] theorem leftMoves_one : 1ᴸ = {0} := leftMoves_ofSets .. +@[simp] theorem rightMoves_one : 1ᴿ = ∅ := rightMoves_ofSets .. + +/-! ### Order relations -/ + +/-- The less or equal relation on games. + +If `0 ≤ x`, then Left can win `x` as the second player. `x ≤ y` means that `0 ≤ y - x`. -/ +@[no_expose] +instance : LE IGame where + le := Sym2.GameAdd.recursion subposition_wf fun x y le ↦ + (∀ z (h : z ∈ xᴸ), ¬le y z (Sym2.GameAdd.snd_fst (.of_mem_moves h))) ∧ + (∀ z (h : z ∈ yᴿ), ¬le z x (Sym2.GameAdd.fst_snd (.of_mem_moves h))) + +/-- The less or fuzzy relation on games. `x ⧏ y` is notation for `¬ y ≤ x`. + +If `0 ⧏ x`, then Left can win `x` as the first player. `x ⧏ y` means that `0 ⧏ y - x`. -/ +notation:50 x:50 " ⧏ " y:50 => ¬ y ≤ x +recommended_spelling "lf" for "⧏" in [«term_⧏_»] + +/-- Definition of `x ≤ y` on games, in terms of `⧏`. -/ +theorem le_iff_forall_lf {x y : IGame} : + x ≤ y ↔ (∀ z ∈ xᴸ, z ⧏ y) ∧ (∀ z ∈ yᴿ, x ⧏ z) := + propext_iff.1 <| Sym2.GameAdd.recursion_eq .. + +/-- Definition of `x ⧏ y` on games, in terms of `≤`. -/ +theorem lf_iff_exists_le {x y : IGame} : + x ⧏ y ↔ (∃ z ∈ yᴸ, x ≤ z) ∨ (∃ z ∈ xᴿ, z ≤ y) := by + simpa [not_and_or, -not_and] using le_iff_forall_lf.not + +/-- The definition of `0 ≤ x` on games, in terms of `0 ⧏`. -/ +theorem zero_le {x : IGame} : 0 ≤ x ↔ ∀ y ∈ xᴿ, 0 ⧏ y := by + rw [le_iff_forall_lf]; simp + +/-- The definition of `x ≤ 0` on games, in terms of `⧏ 0`. -/ +theorem le_zero {x : IGame} : x ≤ 0 ↔ ∀ y ∈ xᴸ, y ⧏ 0 := by + rw [le_iff_forall_lf]; simp + +/-- The definition of `0 ⧏ x` on games, in terms of `0 ≤`. -/ +theorem zero_lf {x : IGame} : 0 ⧏ x ↔ ∃ y ∈ xᴸ, 0 ≤ y := by + rw [lf_iff_exists_le]; simp + +/-- The definition of `x ⧏ 0` on games, in terms of `≤ 0`. -/ +theorem lf_zero {x : IGame} : x ⧏ 0 ↔ ∃ y ∈ xᴿ, y ≤ 0 := by + rw [lf_iff_exists_le]; simp + +/-- The definition of `x ≤ y` on games, in terms of `≤` two moves later. + +Note that it's often more convenient to use `le_iff_forall_lf`, which only unfolds the definition by +one step. -/ +theorem le_def {x y : IGame} : x ≤ y ↔ + (∀ a ∈ xᴸ, (∃ b ∈ yᴸ, a ≤ b) ∨ (∃ b ∈ aᴿ, b ≤ y)) ∧ + (∀ a ∈ yᴿ, (∃ b ∈ aᴸ, x ≤ b) ∨ (∃ b ∈ xᴿ, b ≤ a)) := by + rw [le_iff_forall_lf] + congr! 2 <;> rw [lf_iff_exists_le] + +/-- The definition of `x ⧏ y` on games, in terms of `⧏` two moves later. + +Note that it's often more convenient to use `lf_iff_exists_le`, which only unfolds the definition by +one step. -/ +theorem lf_def {x y : IGame} : x ⧏ y ↔ + (∃ a ∈ yᴸ, (∀ b ∈ xᴸ, b ⧏ a) ∧ (∀ b ∈ aᴿ, x ⧏ b)) ∨ + (∃ a ∈ xᴿ, (∀ b ∈ aᴸ, b ⧏ y) ∧ (∀ b ∈ yᴿ, a ⧏ b)) := by + rw [lf_iff_exists_le] + congr! <;> rw [le_iff_forall_lf] + +theorem left_lf_of_le {x y z : IGame} (h : x ≤ y) (h' : z ∈ xᴸ) : z ⧏ y := + (le_iff_forall_lf.1 h).1 z h' + +theorem lf_right_of_le {x y z : IGame} (h : x ≤ y) (h' : z ∈ yᴿ) : x ⧏ z := + (le_iff_forall_lf.1 h).2 z h' + +theorem lf_of_le_left {x y z : IGame} (h : x ≤ z) (h' : z ∈ yᴸ) : x ⧏ y := + lf_iff_exists_le.2 <| Or.inl ⟨z, h', h⟩ + +theorem lf_of_right_le {x y z : IGame} (h : z ≤ y) (h' : z ∈ xᴿ) : x ⧏ y := + lf_iff_exists_le.2 <| Or.inr ⟨z, h', h⟩ + +private theorem le_rfl' {x : IGame} : x ≤ x := by + rw [le_iff_forall_lf] + constructor <;> intro y hy + exacts [lf_of_le_left le_rfl' hy, lf_of_right_le le_rfl' hy] +termination_by x +decreasing_by igame_wf + +private theorem le_trans' {x y z : IGame} (h₁ : x ≤ y) (h₂ : y ≤ z) : x ≤ z := by + rw [le_iff_forall_lf] + constructor <;> intro a ha h₃ + exacts [left_lf_of_le h₁ ha (le_trans' h₂ h₃), lf_right_of_le h₂ ha (le_trans' h₃ h₁)] +termination_by subposition_wf.cutExpand.wrap {x, y, z} +decreasing_by + on_goal 1 => convert! Relation.cutExpand_add_single {y, z} (Subposition.of_mem_moves ha) + on_goal 2 => convert Relation.cutExpand_single_add (Subposition.of_mem_moves ha) {x, y} + all_goals simp [← Multiset.singleton_add, add_comm, add_assoc, WellFounded.wrap] + +instance : Preorder IGame where + le_refl _ := private le_rfl' + le_trans x y z := private le_trans' + +theorem left_lf {x y : IGame} (h : y ∈ xᴸ) : y ⧏ x := + lf_of_le_left le_rfl h + +theorem lf_right {x y : IGame} (h : y ∈ xᴿ) : x ⧏ y := + lf_of_right_le le_rfl h + +theorem le_of_forall_moves_right_lf {x y : IGame} + (hx : ∀ z ∈ yᴿ, x ⧏ z) (hl : ∀ z ∈ xᴸ, ∃ w ∈ yᴸ, z ≤ w) : x ≤ y := by + refine le_iff_forall_lf.2 ⟨fun z hz ↦ ?_, hx⟩ + obtain ⟨w, hw, hw'⟩ := hl z hz + exact mt hw'.trans' (left_lf hw) + +theorem le_of_forall_moves_left_lf {x y : IGame} + (hx : ∀ z ∈ yᴸ, z ⧏ x) (hr : ∀ z ∈ xᴿ, ∃ w ∈ yᴿ, w ≤ z) : y ≤ x := by + refine le_iff_forall_lf.2 ⟨hx, fun z hz ↦ ?_⟩ + obtain ⟨w, hw, hw'⟩ := hr z hz + exact mt hw'.trans (lf_right hw) + +/-- The equivalence relation `x ≈ y` means that `x ≤ y` and `y ≤ x`. This is notation for +`AntisymmRel (⬝ ≤ ⬝) x y`. -/ +infix:50 " ≈ " => AntisymmRel (· ≤ ·) +recommended_spelling "equiv" for "≈" in [«term_≈_»] + +/-- The "fuzzy" relation `x ‖ y` means that `x ⧏ y` and `y ⧏ x`. This is notation for +`IncompRel (⬝ ≤ ⬝) x y`. -/ +notation:50 x:50 " ‖ " y:50 => IncompRel (· ≤ ·) x y +recommended_spelling "fuzzy" for "‖" in [«term_‖_»] + +open Lean PrettyPrinter Delaborator SubExpr Qq in +/-- Delaborates `AntisymmRel (· ≤ ·) x y` into `x ≈ y`. -/ +@[delab app.AntisymmRel] +meta def delabEquiv : Delab := do + try + let_expr f@AntisymmRel α r _ _ := ← getExpr | failure + have u_inline_4 := f.constLevels![0]! + have α : Q(Type u_inline_4) := α + have r : Q($α → $α → Prop) := r + let le ← synthInstanceQ q(LE $α) + _ ← assertDefEqQ q(($le).le) q($r) + let x ← withNaryArg 2 delab + let y ← withNaryArg 3 delab + let stx : Term ← do + let info ← Lean.MonadRef.mkInfoFromRefPos + pure { + raw := Lean.Syntax.node3 info + ``ConwayRefinement.Standalone.InlineSurreal.IGame.«term_≈_» x.raw + (Lean.Syntax.atom info "≈") y.raw + } + annotateGoToSyntaxDef stx + catch _ => failure -- fail over to the default delaborator + +open Lean PrettyPrinter Delaborator SubExpr Qq in +/-- Delaborates `IncompRel (· ≤ ·) x y` into `x ‖ y`. -/ +@[delab app.IncompRel] +meta def delabFuzzy : Delab := do + try + let_expr f@IncompRel α r _ _ := ← getExpr | failure + have u_inline_4 := f.constLevels![0]! + have α : Q(Type u_inline_4) := α + have r : Q($α → $α → Prop) := r + let le ← synthInstanceQ q(LE $α) + _ ← assertDefEqQ q(($le).le) q($r) + let x ← withNaryArg 2 delab + let y ← withNaryArg 3 delab + let stx : Term ← do + let info ← Lean.MonadRef.mkInfoFromRefPos + pure { + raw := Lean.Syntax.node3 info + ``ConwayRefinement.Standalone.InlineSurreal.IGame.«term_‖_» x.raw + (Lean.Syntax.atom info "‖") y.raw + } + annotateGoToSyntaxDef stx + catch _ => failure -- fail over to the default delaborator + +theorem equiv_of_forall_lf {x y : IGame} + (hl₁ : ∀ a ∈ xᴸ, a ⧏ y) (hr₁ : ∀ a ∈ xᴿ, y ⧏ a) + (hl₂ : ∀ b ∈ yᴸ, b ⧏ x) (hr₂ : ∀ b ∈ yᴿ, x ⧏ b) : x ≈ y := by + constructor <;> refine le_iff_forall_lf.2 ⟨?_, ?_⟩ <;> assumption + +theorem equiv_of_exists_le {x y : IGame} + (hl₁ : ∀ a ∈ xᴸ, ∃ b ∈ yᴸ, a ≤ b) (hr₁ : ∀ a ∈ xᴿ, ∃ b ∈ yᴿ, b ≤ a) + (hl₂ : ∀ b ∈ yᴸ, ∃ a ∈ xᴸ, b ≤ a) (hr₂ : ∀ b ∈ yᴿ, ∃ a ∈ xᴿ, a ≤ b) : x ≈ y := by + apply equiv_of_forall_lf <;> simp +contextual [hl₁, hl₂, hr₁, hr₂, lf_iff_exists_le] + +theorem equiv_of_exists {x y : IGame} + (hl₁ : ∀ a ∈ xᴸ, ∃ b ∈ yᴸ, a ≈ b) (hr₁ : ∀ a ∈ xᴿ, ∃ b ∈ yᴿ, a ≈ b) + (hl₂ : ∀ b ∈ yᴸ, ∃ a ∈ xᴸ, a ≈ b) (hr₂ : ∀ b ∈ yᴿ, ∃ a ∈ xᴿ, a ≈ b) : x ≈ y := by + apply equiv_of_exists_le <;> grind [AntisymmRel] + +@[simp] +protected theorem zero_lt_one : (0 : IGame) < 1 := by + rw [lt_iff_le_not_ge, le_iff_forall_lf, le_iff_forall_lf] + simp + +instance : ZeroLEOneClass IGame where + zero_le_one := IGame.zero_lt_one.le + +/-! ### Negation -/ + +private def neg' (x : IGame) : IGame := + !{range fun y : xᴿ ↦ neg' y.1 | range fun y : xᴸ ↦ neg' y.1} +termination_by x +decreasing_by igame_wf + +#adaptation_note /-- noncomputable is now needed -/ in +/-- The negative of a game is defined by `-!{s | t} = !{-t | -s}`. -/ +@[no_expose] +noncomputable instance : Neg IGame where + neg := neg' + +private theorem neg_ofSets'' (s t : Set IGame) [Small s] [Small t] : + -!{s | t} = !{Neg.neg '' t | Neg.neg '' s} := by + change neg' _ = _ + rw [neg'] + simp [Neg.neg, Set.ext_iff] + +instance : InvolutiveNeg IGame where + neg_neg x := by + refine ofSetsRecOn x ?_ + aesop (add simp [neg_ofSets'']) + +@[simp] +theorem neg_ofSets (s t : Set IGame) [Small s] [Small t] : -!{s | t} = !{-t | -s} := by + simp_rw [neg_ofSets'', Set.image_neg_eq_neg] + +theorem neg_ofSets' (st : Player → Set IGame) [Small (st left)] [Small (st right)] : + -!{st} = !{fun p ↦ -st (-p)} := by + rw [ofSets_eq_ofSets_cases, ofSets_eq_ofSets_cases fun _ ↦ -_, neg_ofSets] + rfl + +@[simp] +theorem neg_ofSets_const (s : Set IGame) [Small s] : + -!{fun _ ↦ s} = !{fun _ ↦ -s} := by + simp [neg_ofSets'] + +instance : NegZeroClass IGame where + neg_zero := by simp [zero_def] + +theorem neg_eq (x : IGame) : -x = !{-xᴿ | -xᴸ} := by + rw [← neg_ofSets, ofSets_leftMoves_rightMoves] + +theorem neg_eq' (x : IGame) : -x = !{fun p ↦ -x.moves (-p)} := by + rw [neg_eq, ofSets_eq_ofSets_cases (fun _ ↦ -_)]; rfl + +@[simp] +theorem moves_neg (p : Player) (x : IGame) : + (-x).moves p = -x.moves (-p) := by + rw [neg_eq', moves_ofSets] + + +theorem forall_moves_neg {P : IGame → Prop} {p : Player} {x : IGame} : + (∀ y ∈ (-x).moves p, P y) ↔ (∀ y ∈ x.moves (-p), P (-y)) := by + simp + + +theorem exists_moves_neg {P : IGame → Prop} {p : Player} {x : IGame} : + (∃ y ∈ (-x).moves p, P y) ↔ (∃ y ∈ x.moves (-p), P (-y)) := by + simp + +@[simp] +protected theorem neg_le_neg_iff {x y : IGame} : -x ≤ -y ↔ y ≤ x := by + induction x, y using Sym2.GameAdd.recursion subposition_wf with | _ x y IH + rw [le_iff_forall_lf, le_iff_forall_lf, and_comm, forall_moves_neg, forall_moves_neg] + dsimp + congr! 3 with z hz z hz + · rw [IH _ _ (Sym2.GameAdd.fst_snd (.of_mem_moves hz))] + · rw [IH _ _ (Sym2.GameAdd.snd_fst (.of_mem_moves hz))] + +protected theorem neg_le {x y : IGame} : -x ≤ y ↔ -y ≤ x := by + simpa using @IGame.neg_le_neg_iff x (-y) +protected theorem le_neg {x y : IGame} : x ≤ -y ↔ y ≤ -x := by + simpa using @IGame.neg_le_neg_iff (-x) y + +@[simp] +protected theorem neg_lt_neg_iff {x y : IGame} : -x < -y ↔ y < x := by + simp [lt_iff_le_not_ge] + +protected theorem neg_lt {x y : IGame} : -x < y ↔ -y < x := by + simpa using @IGame.neg_lt_neg_iff x (-y) +protected theorem lt_neg {x y : IGame} : x < -y ↔ y < -x := by + simpa using @IGame.neg_lt_neg_iff (-x) y + +@[simp] +theorem neg_equiv_neg_iff {x y : IGame} : -x ≈ -y ↔ x ≈ y := by + simp [AntisymmRel, and_comm] + +theorem neg_equiv {x y : IGame} : -x ≈ y ↔ x ≈ -y := by + simpa using @neg_equiv_neg_iff x (-y) + +alias ⟨_, neg_congr⟩ := neg_equiv_neg_iff + +@[simp] +theorem neg_fuzzy_neg_iff {x y : IGame} : -x ‖ -y ↔ x ‖ y := by + simp [IncompRel, and_comm] + +theorem neg_fuzzy {x y : IGame} : -x ‖ y ↔ x ‖ -y := by + simpa using @neg_fuzzy_neg_iff x (-y) + +@[simp] theorem neg_le_zero {x : IGame} : -x ≤ 0 ↔ 0 ≤ x := by simpa using @IGame.neg_le x 0 +@[simp] theorem zero_le_neg {x : IGame} : 0 ≤ -x ↔ x ≤ 0 := by simpa using @IGame.le_neg 0 x +@[simp] theorem neg_lt_zero {x : IGame} : -x < 0 ↔ 0 < x := by simpa using @IGame.neg_lt x 0 +@[simp] theorem zero_lt_neg {x : IGame} : 0 < -x ↔ x < 0 := by simpa using @IGame.lt_neg 0 x + +@[simp] theorem neg_equiv_zero {x : IGame} : -x ≈ 0 ↔ x ≈ 0 := by + simpa using @IGame.neg_equiv_neg_iff x 0 +@[simp] theorem zero_equiv_neg {x : IGame} : 0 ≈ -x ↔ 0 ≈ x := by + simpa using @IGame.neg_equiv_neg_iff 0 x + +@[simp] theorem neg_fuzzy_zero {x : IGame} : -x ‖ 0 ↔ x ‖ 0 := by + simpa using @IGame.neg_fuzzy_neg_iff x 0 +@[simp] theorem zero_fuzzy_neg {x : IGame} : 0 ‖ -x ↔ 0 ‖ x := by + simpa using @IGame.neg_fuzzy_neg_iff 0 x + +/-! ### Addition and subtraction -/ + +private def add' (x y : IGame) : IGame := + !{(range fun z : xᴸ ↦ add' z y) ∪ (range fun z : yᴸ ↦ add' x z) | + (range fun z : xᴿ ↦ add' z y) ∪ (range fun z : yᴿ ↦ add' x z)} +termination_by (x, y) +decreasing_by igame_wf + +#adaptation_note /-- noncomputable is now needed -/ in +/-- The sum of `x = !{s₁ | t₁}` and `y = !{s₂ | t₂}` is `!{s₁ + y, x + s₂ | t₁ + y, x + t₂}`. -/ +@[no_expose] +noncomputable instance : Add IGame where + add := add' + +theorem add_eq (x y : IGame) : x + y = + !{(· + y) '' xᴸ ∪ (x + ·) '' yᴸ | (· + y) '' xᴿ ∪ (x + ·) '' yᴿ} := by + change add' _ _ = _ + rw [add'] + simp [HAdd.hAdd, Add.add, Set.ext_iff] + +theorem add_eq' (x y : IGame) : x + y = + !{fun p ↦ (· + y) '' x.moves p ∪ (x + ·) '' y.moves p} := by + rw [add_eq, ofSets_eq_ofSets_cases (fun _ ↦ _ ∪ _)] + +theorem ofSets_add_ofSets + (s₁ t₁ s₂ t₂ : Set IGame) [Small s₁] [Small t₁] [Small s₂] [Small t₂] : + !{s₁ | t₁} + !{s₂ | t₂} = + !{(· + !{s₂ | t₂}) '' s₁ ∪ (!{s₁ | t₁} + ·) '' s₂ | + (· + !{s₂ | t₂}) '' t₁ ∪ (!{s₁ | t₁} + ·) '' t₂} := by + rw [add_eq] + simp + +theorem ofSets_add_ofSets' (st₁ st₂ : Player → Set IGame) + [Small (st₁ left)] [Small (st₂ left)] [Small (st₁ right)] [Small (st₂ right)] : + !{st₁} + !{st₂} = + !{fun p ↦ (· + !{st₂}) '' st₁ p ∪ (!{st₁} + ·) '' st₂ p} := by + rw [ofSets_eq_ofSets_cases, ofSets_eq_ofSets_cases st₂, ofSets_eq_ofSets_cases (fun _ ↦ _ ∪ _), + ofSets_add_ofSets] + +@[simp] +theorem moves_add (p : Player) (x y : IGame) : + (x + y).moves p = (· + y) '' x.moves p ∪ (x + ·) '' y.moves p := by + rw [add_eq', moves_ofSets] + +theorem add_left_mem_moves_add {p : Player} {x y : IGame} (h : x ∈ y.moves p) (z : IGame) : + z + x ∈ (z + y).moves p := by + rw [moves_add]; right; use x + +theorem add_right_mem_moves_add {p : Player} {x y : IGame} (h : x ∈ y.moves p) (z : IGame) : + x + z ∈ (y + z).moves p := by + rw [moves_add]; left; use x + + +theorem forall_moves_add {p : Player} {P : IGame → Prop} {x y : IGame} : + (∀ a ∈ (x + y).moves p, P a) ↔ + (∀ a ∈ x.moves p, P (a + y)) ∧ (∀ b ∈ y.moves p, P (x + b)) := by + aesop + + +theorem exists_moves_add {p : Player} {P : IGame → Prop} {x y : IGame} : + (∃ a ∈ (x + y).moves p, P a) ↔ + (∃ a ∈ x.moves p, P (a + y)) ∨ (∃ b ∈ y.moves p, P (x + b)) := by + aesop + +@[simp] +theorem add_eq_zero_iff {x y : IGame} : x + y = 0 ↔ x = 0 ∧ y = 0 := by + constructor <;> simp_all [IGame.ext_iff] + +private theorem add_zero' (x : IGame) : x + 0 = x := by + refine moveRecOn x ?_ + aesop + +private theorem add_comm' (x y : IGame) : x + y = y + x := by + ext + simp only [moves_add, mem_union, mem_image, or_comm] + congr! 3 <;> + · refine and_congr_right_iff.2 fun h ↦ ?_ + rw [add_comm'] +termination_by (x, y) +decreasing_by igame_wf + +private theorem add_assoc' (x y z : IGame) : x + y + z = x + (y + z) := by + ext1 + simp only [moves_add, image_union, image_image, union_assoc] + refine congrArg₂ _ ?_ (congrArg₂ _ ?_ ?_) <;> + · ext + congr! 2 + rw [add_assoc'] +termination_by (x, y, z) +decreasing_by igame_wf + +instance : AddCommMonoid IGame where + add_zero := private add_zero' + zero_add _ := private add_comm' .. ▸ add_zero' _ + add_comm := private add_comm' + add_assoc := private add_assoc' + nsmul := nsmulRec + +/-- The subtraction of `x` and `y` is defined as `x + (-y)`. -/ +instance : SubNegMonoid IGame where + zsmul := zsmulRec + +@[simp] +theorem moves_sub (p : Player) (x y : IGame) : + (x - y).moves p = (· - y) '' x.moves p ∪ (x + ·) '' (-y.moves (-p)) := by + simp [sub_eq_add_neg] + +theorem sub_left_mem_moves_sub {p : Player} {x y : IGame} (h : x ∈ y.moves p) (z : IGame) : + z - x ∈ (z - y).moves (-p) := by + apply add_left_mem_moves_add; simpa + +theorem sub_left_mem_moves_sub_neg {p : Player} {x y : IGame} (h : x ∈ y.moves (-p)) (z : IGame) : + z - x ∈ (z - y).moves p := by + apply add_left_mem_moves_add; simpa + +theorem sub_right_mem_moves_sub {p : Player} {x y : IGame} (h : x ∈ y.moves p) (z : IGame) : + x - z ∈ (y - z).moves p := + add_right_mem_moves_add h _ + +private theorem neg_add' (x y : IGame) : -(x + y) = -x + -y := by + ext + simp only [moves_neg, moves_add, union_neg, mem_union, mem_neg, mem_image, exists_neg_mem] + congr! 3 <;> + · refine and_congr_right_iff.2 fun _ ↦ ?_ + rw [← neg_inj, neg_add', neg_neg] +termination_by (x, y) +decreasing_by igame_wf + +instance : SubtractionCommMonoid IGame where + neg_neg := neg_neg + neg_add_rev x y := by rw [neg_add', add_comm] + neg_eq_of_add := by simp + add_comm := add_comm + +private theorem sub_self_le (x : IGame) : x - x ≤ 0 := by + rw [le_zero, moves_sub] + rintro _ (⟨y, hy, rfl⟩ | ⟨y, hy, rfl⟩) + · exact lf_of_right_le (sub_self_le y) (sub_left_mem_moves_sub hy y) + · apply lf_of_right_le (sub_self_le (-y)) + rw [mem_neg] at hy + rw [sub_neg_eq_add] + exact add_right_mem_moves_add hy _ +termination_by x +decreasing_by igame_wf + +/-- The sum of a game and its negative is equivalent, though not necessarily identical to zero. -/ +theorem sub_self_equiv (x : IGame) : x - x ≈ 0 := by + rw [AntisymmRel, ← neg_le_zero, neg_sub, and_self] + exact sub_self_le x + +/-- The sum of a game and its negative is equivalent, though not necessarily identical to zero. -/ +theorem neg_add_equiv (x : IGame) : -x + x ≈ 0 := by + simpa [add_comm, sub_eq_add_neg] using sub_self_equiv x + +private theorem add_le_add_left' {x y : IGame} (h : x ≤ y) (z : IGame) : z + x ≤ z + y := by + rw [le_iff_forall_lf, moves_add, moves_add] + refine ⟨?_, ?_⟩ <;> rintro a (⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩) + · exact lf_of_le_left (add_le_add_left' h a) (add_right_mem_moves_add ha y) + · obtain (⟨b, hb, hb'⟩ | ⟨b, hb, hb'⟩) := lf_iff_exists_le.1 (left_lf_of_le h ha) + · exact lf_of_le_left (add_le_add_left' hb' z) (add_left_mem_moves_add hb z) + · exact lf_of_right_le (add_le_add_left' hb' z) (add_left_mem_moves_add hb z) + · exact lf_of_right_le (add_le_add_left' h a) (add_right_mem_moves_add ha x) + · obtain (⟨b, hb, hb'⟩ | ⟨b, hb, hb'⟩) := lf_iff_exists_le.1 (lf_right_of_le h ha) + · exact lf_of_le_left (add_le_add_left' hb' z) (add_left_mem_moves_add hb z) + · exact lf_of_right_le (add_le_add_left' hb' z) (add_left_mem_moves_add hb z) +termination_by (x, y, z) +decreasing_by igame_wf (maxDepth := 8) + +private theorem add_le_add_right' {x y : IGame} (h : x ≤ y) (z : IGame) : x + z ≤ y + z := by + simpa [add_comm] using add_le_add_left' h z + +instance : AddLeftMono IGame := ⟨fun x _ _ h ↦ add_le_add_left' h x⟩ +instance : AddRightMono IGame := ⟨fun x _ _ h ↦ add_le_add_right' h x⟩ + +instance : AddLeftReflectLE IGame where + le_of_add_le_add_left {x y} z h := by + rw [← zero_add y, ← zero_add z] + apply (add_le_add_left (neg_add_equiv x).ge y).trans + rw [add_assoc] + apply (add_le_add_right h (-x)).trans + rw [← add_assoc] + exact add_le_add_left (neg_add_equiv x).le z + +instance : AddRightReflectLE IGame := + addRightReflectLE_of_addLeftReflectLE _ + +instance : AddLeftStrictMono IGame where + elim x y z h := by + apply lt_of_le_not_ge (add_le_add_right h.le x) + contrapose! h + exact (le_of_add_le_add_left h).not_gt + +instance : AddRightStrictMono IGame := + addRightStrictMono_of_addLeftStrictMono _ + +instance : AddLeftReflectLT IGame where + elim _ := by simp [lt_iff_le_not_ge] + +instance : AddRightReflectLT IGame := + addRightReflectLT_of_addLeftReflectLT _ + +theorem add_congr {a b : IGame} (h₁ : a ≈ b) {c d : IGame} (h₂ : c ≈ d) : a + c ≈ b + d := + ⟨add_le_add h₁.1 h₂.1, add_le_add h₁.2 h₂.2⟩ + +theorem add_congr_left {a b c : IGame} (h : a ≈ b) : a + c ≈ b + c := + add_congr h .rfl + +theorem add_congr_right {a b c : IGame} (h : a ≈ b) : c + a ≈ c + b := + add_congr .rfl h + +@[simp] +theorem add_fuzzy_add_iff_left {a b c : IGame} : a + b ‖ a + c ↔ b ‖ c := by + simp [IncompRel] + +@[simp] +theorem add_fuzzy_add_iff_right {a b c : IGame} : b + a ‖ c + a ↔ b ‖ c := by + simp [IncompRel] + +theorem sub_congr {a b : IGame} (h₁ : a ≈ b) {c d : IGame} (h₂ : c ≈ d) : a - c ≈ b - d := + add_congr h₁ (neg_congr h₂) + +theorem sub_congr_left {a b c : IGame} (h : a ≈ b) : a - c ≈ b - c := + sub_congr h .rfl + +theorem sub_congr_right {a b c : IGame} (h : a ≈ b) : c - a ≈ c - b := + sub_congr .rfl h + +/-- We define the `NatCast` instance as `↑0 = 0` and `↑(n + 1) = !{{↑n} | ∅}`. + +Note that this is equivalent, but not identical, to the more common definition `↑n = !{Iio n | ∅}`. +For that, use `NatOrdinal.toIGame`. -/ +instance : AddCommMonoidWithOne IGame where + +/-- This version of the theorem is more convenient for the `game_cmp` tactic. -/ +theorem leftMoves_natCast_succ' : ∀ n : ℕ, n.succᴸ = {(n : IGame)} + | 0 => by simp + | n + 1 => by + rw [Nat.cast_succ, moves_add, leftMoves_natCast_succ'] + simp + +@[simp 1100] -- This should trigger before `leftMoves_add`. +theorem leftMoves_natCast_succ (n : ℕ) : (n + 1)ᴸ = {(n : IGame)} := + leftMoves_natCast_succ' n + +@[simp 1100] -- This should trigger before `rightMoves_add`. +theorem rightMoves_natCast : ∀ n : ℕ, nᴿ = ∅ + | 0 => by simp + | n + 1 => by + rw [Nat.cast_succ, moves_add, rightMoves_natCast] + simp + +@[simp 1100] +theorem leftMoves_ofNat (n : ℕ) [n.AtLeastTwo] : ofNat(n)ᴸ = {((n - 1 : ℕ) : IGame)} := by + change nᴸ = _ + rw [← Nat.succ_pred (NeZero.out (n := n)), leftMoves_natCast_succ'] + simp + +@[simp 1100] +theorem rightMoves_ofNat (n : ℕ) [n.AtLeastTwo] : ofNat(n)ᴿ = ∅ := + rightMoves_natCast n + +theorem natCast_succ_eq (n : ℕ) : (n + 1 : IGame) = !{{(n : IGame)} | ∅} := by + ext p; cases p <;> simp + +/-- Every left option of a natural number is equal to a smaller natural number. -/ +theorem eq_natCast_of_mem_leftMoves_natCast {n : ℕ} {x : IGame} (hx : x ∈ nᴸ) : + ∃ m : ℕ, m < n ∧ m = x := by + cases n with + | zero => simp at hx + | succ n => + use n + simp_all + +instance : IntCast IGame where + intCast + | .ofNat n => n + | .negSucc n => -(n + 1) + +@[simp, norm_cast] theorem intCast_nat (n : ℕ) : ((n : ℤ) : IGame) = n := rfl +@[simp] theorem intCast_ofNat (n : ℕ) : ((ofNat(n) : ℤ) : IGame) = n := rfl +@[simp] theorem intCast_negSucc (n : ℕ) : (Int.negSucc n : IGame) = -(n + 1) := rfl + +@[norm_cast] theorem intCast_zero : ((0 : ℤ) : IGame) = 0 := rfl +@[norm_cast] theorem intCast_one : ((1 : ℤ) : IGame) = 1 := by simp + +@[simp, norm_cast] +theorem intCast_neg (n : ℤ) : ((-n : ℤ) : IGame) = -(n : IGame) := by + cases n with + | ofNat n => + cases n with + | zero => simp + | succ n => rfl + | negSucc n => exact (neg_neg _).symm + +theorem eq_sub_one_of_mem_leftMoves_intCast {n : ℤ} {x : IGame} (hx : x ∈ nᴸ) : + x = (n - 1 : ℤ) := by + obtain ⟨n, rfl | rfl⟩ := n.eq_nat_or_neg + · cases n + · simp at hx + · rw [intCast_nat] at hx + simp_all + · simp at hx + +theorem eq_add_one_of_mem_rightMoves_intCast {n : ℤ} {x : IGame} (hx : x ∈ nᴿ) : + x = (n + 1 : ℤ) := by + have : -x ∈ (-n : ℤ)ᴸ := by simpa + rw [← neg_inj] + simpa [← IGame.intCast_neg, add_comm, sub_eq_add_neg] using + eq_sub_one_of_mem_leftMoves_intCast this + +/-- Every left option of an integer is equal to a smaller integer. -/ +theorem eq_intCast_of_mem_leftMoves_intCast {n : ℤ} {x : IGame} (hx : x ∈ nᴸ) : + ∃ m : ℤ, m < n ∧ m = x := by + use n - 1 + simp [eq_sub_one_of_mem_leftMoves_intCast hx] + +/-- Every right option of an integer is equal to a larger integer. -/ +theorem eq_intCast_of_mem_rightMoves_intCast {n : ℤ} {x : IGame} (hx : x ∈ nᴿ) : + ∃ m : ℤ, n < m ∧ m = x := by + use n + 1 + simp [eq_add_one_of_mem_rightMoves_intCast hx] + +/-! ### Multiplication -/ + +attribute [aesop apply unsafe 50%] Prod.Lex.left Prod.Lex.right + +private def mul' (x y : IGame) : IGame := + !{(range fun a : (xᴸ ×ˢ yᴸ ∪ xᴿ ×ˢ yᴿ :) ↦ + mul' a.1.1 y + mul' x a.1.2 - mul' a.1.1 a.1.2) | + (range fun a : (xᴸ ×ˢ yᴿ ∪ xᴿ ×ˢ yᴸ :) ↦ + mul' a.1.1 y + mul' x a.1.2 - mul' a.1.1 a.1.2)} +termination_by (x, y) +decreasing_by all_goals aesop + +#adaptation_note /-- noncomputable is now needed -/ in +/-- The product of `x = !{s₁ | t₁}` and `y = !{s₂ | t₂}` is +`!{a₁ * y + x * b₁ - a₁ * b₁ | a₂ * y + x * b₂ - a₂ * b₂}`, where `(a₁, b₁) ∈ s₁ ×ˢ s₂ ∪ t₁ ×ˢ t₂` +and `(a₂, b₂) ∈ s₁ ×ˢ t₂ ∪ t₁ ×ˢ s₂`. + +Using `IGame.mulOption`, this can alternatively be written as +`x * y = !{mulOption x y a₁ b₁ | mulOption x y a₂ b₂}`. -/ +@[no_expose] +noncomputable instance : Mul IGame where + mul := mul' + +/-- The general option of `x * y` looks like `a * y + x * b - a * b`, for `a` and `b` options of +`x` and `y`, respectively. -/ +@[pp_nodot] +def mulOption (x y a b : IGame) : IGame := + a * y + x * b - a * b + +theorem mul_eq (x y : IGame) : x * y = + !{(fun a ↦ mulOption x y a.1 a.2) '' (xᴸ ×ˢ yᴸ ∪ xᴿ ×ˢ yᴿ) | + (fun a ↦ mulOption x y a.1 a.2) '' (xᴸ ×ˢ yᴿ ∪ xᴿ ×ˢ yᴸ)} := by + change mul' _ _ = _ + rw [mul'] + simp [mulOption, HMul.hMul, Mul.mul, Set.ext_iff] + +theorem mul_eq' (x y : IGame) : x * y = + !{fun p ↦ (fun a ↦ mulOption x y a.1 a.2) '' + (xᴸ ×ˢ y.moves p ∪ xᴿ ×ˢ y.moves (-p))} := by + rw [mul_eq, ofSets_eq_ofSets_cases (fun _ ↦ _ '' _)]; rfl + +theorem ofSets_mul_ofSets (s₁ t₁ s₂ t₂ : Set IGame) [Small s₁] [Small t₁] [Small s₂] [Small t₂] : + !{s₁ | t₁} * !{s₂ | t₂} = + !{(fun a ↦ mulOption !{s₁ | t₁} !{s₂ | t₂} a.1 a.2) '' (s₁ ×ˢ s₂ ∪ t₁ ×ˢ t₂) | + (fun a ↦ mulOption !{s₁ | t₁} !{s₂ | t₂} a.1 a.2) '' (s₁ ×ˢ t₂ ∪ t₁ ×ˢ s₂)} := by + rw [mul_eq] + simp + +@[simp] +theorem moves_mul (p : Player) (x y : IGame) : + (x * y).moves p = (fun a ↦ mulOption x y a.1 a.2) '' + (xᴸ ×ˢ y.moves p ∪ xᴿ ×ˢ y.moves (-p)) := by + rw [mul_eq', moves_ofSets] + +@[simp] +theorem moves_mulOption (p : Player) (x y a b : IGame) : + (mulOption x y a b).moves p = (a * y + x * b - a * b).moves p := + rfl + +theorem mulOption_mem_moves_mul {px py : Player} {x y a b : IGame} + (h₁ : a ∈ x.moves px) (h₂ : b ∈ y.moves py) : mulOption x y a b ∈ (x * y).moves (px * py) := by + rw [moves_mul]; use (a, b); cases px <;> cases py <;> simp_all + + +theorem forall_moves_mul {p : Player} {P : IGame → Prop} {x y : IGame} : + (∀ a ∈ (x * y).moves p, P a) ↔ + (∀ p', ∀ a ∈ x.moves p', ∀ b ∈ y.moves (p' * p), P (mulOption x y a b)) := by + aesop + + +theorem exists_moves_mul {p : Player} {P : IGame → Prop} {x y : IGame} : + (∃ a ∈ (x * y).moves p, P a) ↔ + (∃ p', ∃ a ∈ x.moves p', ∃ b ∈ y.moves (p' * p), P (mulOption x y a b)) := by + aesop + +private theorem zero_mul' (x : IGame) : 0 * x = 0 := by + ext p; cases p <;> simp + +private theorem one_mul' (x : IGame) : 1 * x = x := by + refine moveRecOn x ?_ + aesop (add simp [mulOption, and_assoc, zero_mul']) + +private theorem igameMulComm (x y : IGame) : x * y = y * x := by + ext p + simp only [moves_mul, mem_image, mem_prod, mem_union, Prod.exists] + cases p; all_goals + dsimp + simp only [and_comm, or_comm] + rw [exists_comm] + congr! 4 with b a + rw [and_congr_right_iff] + rintro (⟨_, _⟩ | ⟨_, _⟩) <;> + rw [mulOption, mulOption, igameMulComm x, igameMulComm _ y, add_comm, igameMulComm a b] +termination_by (x, y) +decreasing_by igame_wf + +instance : CommMagma IGame where + mul_comm := private igameMulComm + +instance : MulZeroClass IGame where + zero_mul := private zero_mul' + mul_zero x := private igameMulComm .. ▸ zero_mul' x + +instance : MulZeroOneClass IGame where + one_mul := private one_mul' + mul_one x := private igameMulComm .. ▸ one_mul' x + +theorem mulOption_comm (x y a b : IGame) : mulOption x y a b = mulOption y x b a := by + simp [mulOption, add_comm, mul_comm] + +private theorem neg_mul' (x y : IGame) : -x * y = -(x * y) := by + ext + simp only [moves_mul, moves_neg, mem_image, mem_union, mem_prod, mem_neg, Prod.exists] + rw [← (Equiv.neg _).exists_congr_right] + dsimp only [Player.neg_left, Player.neg_right] + simp only [Equiv.neg_apply, neg_neg, mulOption, or_comm] + congr! 4 + rw [and_congr_right_iff] + rintro (⟨_, _⟩ | ⟨_, _⟩) + all_goals + rw [← neg_inj, neg_mul', neg_mul', neg_mul'] + simp [sub_eq_add_neg, add_comm] +termination_by (x, y) +decreasing_by igame_wf + +instance : HasDistribNeg IGame where + neg_mul := private neg_mul' + mul_neg _ _ := by rw [mul_comm, neg_mul', mul_comm] + +theorem mulOption_neg_left (x y a b : IGame) : mulOption (-x) y a b = -mulOption x y (-a) b := by + simp [mulOption, sub_eq_neg_add, add_comm] + +theorem mulOption_neg_right (x y a b : IGame) : mulOption x (-y) a b = -mulOption x y a (-b) := by + simp [mulOption, sub_eq_neg_add, add_comm] + +theorem mulOption_neg (x y a b : IGame) : mulOption (-x) (-y) a b = mulOption x y (-a) (-b) := by + simp [mulOption, sub_eq_neg_add, add_comm] + +@[simp] +theorem mulOption_zero_left (x y a : IGame) : mulOption x y 0 a = x * a := by + simp [mulOption] + +@[simp] +theorem mulOption_zero_right (x y a : IGame) : mulOption x y a 0 = a * y := by + simp [mulOption] + +/-! Distributivity and associativity only hold up to equivalence; we prove this in +`CombinatorialGames.Game.Basic`. -/ + + +end IGame +end + +/-! ## Inlined from `CombinatorialGames.Tactic.AddInstances` -/ + +/-! +# Eagerly add instances + +Many definitions in game theory are hereditary. For instance, all options of a `Numeric` game are +`Numeric`, all options of an `Impartial` game are `Impartial`, etc. + +The definition `addInstances` provides a tactic which will eagerly apply all passed functions to all +of the hypotheses, creating new ones in the process. The intended usage of this is to, for instance, +apply `Numeric.of_mem_moves` to all hypotheses, and thus build all possible `Numeric` instances. +-/ + +open Lean Meta Elab Tactic + +meta def instances (constants : Array Name) (goal : MVarId) : MetaM (Option MVarId) := + goal.withContext do + let mut goal := goal + for h in ← getLCtx do + if h.isImplementationDetail then continue + ⟨_, goal⟩ ← goal.assertHypotheses =<< constants.filterMapM fun c => do + let hc ← try mkAppM c #[h.toExpr] catch _ => return none + return some { + userName := ← mkFreshUserName `inst + type := ← inferType hc + value := hc + } + return goal + +/-- A tactic that eagerly adds instances by applying the functions in `constants` to every +hypothesis. -/ +public meta def addInstances (constants : Array Name) : TacticM Unit := + liftMetaTactic1 (instances constants) + +/-! ## Inlined from `CombinatorialGames.Game.Classes` -/ + +/-! +# Classes of games + +This file collects multiple basic classes of games, so as to make them available on most files. We +develop their theory elsewhere. + +## Dicotic games + +A game is dicotic when every non-zero subposition has both left and right moves. The Lawnmower +theorem (proven in `CombinatorialGames.Game.Small`) shows that every dicotic game is small. + +## Impartial games + +We define an impartial game as one where every subposition is equivalent to its negative. This is a +weaker definition than that found in the literature (which requires equality, rather than +equivalence), but this is still strong enough to prove the Sprague--Grundy theorem, as well as +closure under the basic arithmetic operations of multiplication and division. + +## Numeric games + +A game is `Numeric` if all the Left options are strictly smaller than all the Right options, and all +those options are themselves numeric. In terms of combinatorial games, the numeric games have +"frozen"; you can only make your position worse by playing, and Left is some definite "number" of +moves ahead (or behind) Right. + +## Short games + +A combinatorial game is `Short` if it has only finitely many subpositions. In particular, this means +there is a finite set of moves at every point. + +The `game_cmp` tactic supplies computation for short combinatorial games. +-/ + +universe u_inline_6 + +@[expose] public section + +namespace IGame + +/-! ### Numeric games -/ + +/-- A game `!{s | t}` is numeric if everything in `s` is less than everything in `t`, and all the +elements of these sets are also numeric. + +The `Surreal` numbers are built as the quotient of numeric games under equivalence. -/ +@[mk_iff numeric_def'] +class inductive Numeric : IGame → Prop where + | mk {x : IGame} : (∀ y ∈ xᴸ, ∀ z ∈ xᴿ, y < z) → (∀ p, ∀ y ∈ x.moves p, Numeric y) → Numeric x + +theorem numeric_def {x : IGame} : Numeric x ↔ + (∀ y ∈ xᴸ, ∀ z ∈ xᴿ, y < z) ∧ (∀ p, ∀ y ∈ x.moves p, Numeric y) := + numeric_def' x + +namespace Numeric +variable {x y z : IGame} + +theorem left_lt_right [h : Numeric x] (hy : y ∈ xᴸ) (hz : z ∈ xᴿ) : y < z := + (numeric_def.1 h).1 y hy z hz + +protected theorem of_mem_moves {p : Player} [h : Numeric x] (hy : y ∈ x.moves p) : Numeric y := + (numeric_def.1 h).2 p y hy + +/-- `numeric` eagerly adds all possible `Numeric` hypotheses. -/ +elab "numeric" : tactic => + addInstances <| .mk [`ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric.of_mem_moves] + +protected theorem subposition [Numeric x] (h : Subposition y x) : Numeric y := by + induction x using IGame.moveRecOn generalizing ‹x.Numeric› with | ind x ih + obtain ⟨p, z, hz, hy⟩ := subposition_iff_exists.1 h + obtain rfl | hy := wsubposition_iff_eq_or_subposition.1 hy + · exact .of_mem_moves hz + · exact @ih p z hz (.of_mem_moves hz) hy + +@[simp] +protected instance zero : Numeric 0 := by + rw [numeric_def]; simp + +@[simp] +protected instance one : Numeric 1 := by + rw [numeric_def]; simp + +protected instance subtype (x : Subtype Numeric) : Numeric x.1 := x.2 +protected instance moves {x : IGame} [Numeric x] {p : Player} (y : x.moves p) : Numeric y := + .of_mem_moves y.2 + +protected theorem le_of_not_le {x y : IGame} [Numeric x] [Numeric y] : ¬ x ≤ y → y ≤ x := by + rw [lf_iff_exists_le, le_iff_forall_lf] + rintro (⟨z, hz, h⟩ | ⟨z, hz, h⟩) <;> constructor <;> intro a ha h' + · numeric + exact left_lf_of_le h' hz (Numeric.le_of_not_le (left_lf_of_le h ha)) + · exact (left_lt_right hz ha).not_ge (h'.trans h) + · exact (left_lt_right ha hz).not_ge (h.trans h') + · numeric + exact lf_right_of_le h' hz (Numeric.le_of_not_le (lf_right_of_le h ha)) +termination_by x +decreasing_by igame_wf + +protected theorem le_total (x y : IGame) [Numeric x] [Numeric y] : x ≤ y ∨ y ≤ x := by + rw [or_iff_not_imp_left] + exact Numeric.le_of_not_le + +protected theorem lt_of_not_ge [Numeric x] [Numeric y] (h : ¬ x ≤ y) : y < x := + (Numeric.le_of_not_le h).lt_of_not_ge h + +@[simp] +protected theorem not_le [Numeric x] [Numeric y] : ¬ x ≤ y ↔ y < x := + ⟨Numeric.lt_of_not_ge, not_le_of_gt⟩ + +@[simp] +protected theorem not_lt [Numeric x] [Numeric y] : ¬ x < y ↔ y ≤ x := + not_iff_comm.1 Numeric.not_le + +protected theorem le_or_gt (x y : IGame) [Numeric x] [Numeric y] : x ≤ y ∨ y < x := by + rw [← Numeric.not_le] + exact em _ + +protected theorem lt_or_ge (x y : IGame) [Numeric x] [Numeric y] : x < y ∨ y ≤ x := by + rw [← Numeric.not_lt] + exact em _ + +theorem not_fuzzy (x y : IGame) [Numeric x] [Numeric y] : ¬ x ‖ y := by + simpa [not_incompRel_iff_symmGen, Relation.SymmGen] using Numeric.le_total x y + +theorem lt_or_equiv_or_gt (x y : IGame) [Numeric x] [Numeric y] : x < y ∨ x ≈ y ∨ y < x := by + simp_rw [← Numeric.not_le]; tauto + +/-- To prove a game is numeric, it suffices to show the left options are less or fuzzy +to the right options. -/ +theorem mk_of_lf (h₁ : ∀ y ∈ xᴸ, ∀ z ∈ xᴿ, y ⧏ z) (h₂ : ∀ p, ∀ y ∈ x.moves p, Numeric y) : + Numeric x := + mk (fun y hy z hz ↦ (@Numeric.not_le z y (h₂ _ z hz) (h₂ _ y hy)).1 (h₁ y hy z hz)) h₂ + +theorem le_iff_forall_lt [Numeric x] [Numeric y] : + x ≤ y ↔ (∀ z ∈ xᴸ, z < y) ∧ (∀ z ∈ yᴿ, x < z) := by + rw [le_iff_forall_lf] + congr! with z hz z hz <;> numeric <;> rw [Numeric.not_le] + +theorem lt_iff_exists_le [Numeric x] [Numeric y] : + x < y ↔ (∃ z ∈ yᴸ, x ≤ z) ∨ (∃ z ∈ xᴿ, z ≤ y) := by + rw [← Numeric.not_le, lf_iff_exists_le] + +theorem left_lt [Numeric x] (h : y ∈ xᴸ) : y < x := by + numeric; simpa using left_lf h + +theorem lt_right [Numeric x] (h : y ∈ xᴿ) : x < y := by + numeric; simpa using lf_right h + +protected instance neg (x : IGame) [Numeric x] : Numeric (-x) := by + refine mk (fun y hy z hz ↦ ?_) ?_ + · rw [← IGame.neg_lt_neg_iff] + apply @left_lt_right x <;> simp_all + · simp_rw [forall_moves_neg] + intro p y hy + numeric + simpa using Numeric.neg y +termination_by x +decreasing_by igame_wf + +@[simp] +theorem neg_iff {x : IGame} : Numeric (-x) ↔ Numeric x := + ⟨fun _ ↦ by simpa using Numeric.neg (-x), fun _ ↦ Numeric.neg x⟩ + +protected instance add (x y : IGame) [Numeric x] [Numeric y] : Numeric (x + y) := by + apply mk <;> simp only [moves_add, Set.mem_union, Set.mem_image] + · rintro _ (⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩) _ (⟨b, hb, rfl⟩ | ⟨b, hb, rfl⟩) + any_goals simpa using left_lt_right ha hb + all_goals + trans (x + y) + · simpa using left_lt ha + · simpa using lt_right hb + · rintro p _ (⟨z, hz, rfl⟩ | ⟨z, hz, rfl⟩) + all_goals numeric; exact Numeric.add .. +termination_by (x, y) +decreasing_by igame_wf + +protected instance sub (x y : IGame) [Numeric x] [Numeric y] : Numeric (x - y) := + inferInstanceAs (Numeric (x + -y)) + +protected instance natCast : ∀ n : ℕ, Numeric n + | 0 => inferInstanceAs (Numeric 0) + | n + 1 => have := Numeric.natCast n; inferInstanceAs (Numeric (n + 1)) + +protected instance ofNat (n : ℕ) [n.AtLeastTwo] : Numeric ofNat(n) := + inferInstanceAs (Numeric n) + +protected instance intCast : ∀ n : ℤ, Numeric n + | .ofNat n => inferInstanceAs (Numeric n) + | .negSucc n => inferInstanceAs (Numeric (-(n + 1))) + +end Numeric + + +end IGame + +/-! ## Inlined from `CombinatorialGames.Game.Basic` -/ + +/-! +# Combinatorial games + +In this file we construct the quotient of games `IGame` under equivalence, and prove that it forms +an `OrderedAddCommGroup`. We take advantage of this structure to prove two particularly tedious +theorems on `IGame`, namely `IGame.mul_add_equiv` and `IGame.mul_assoc_equiv`. + +It might be tempting to write `mk (x * y)` as `mk x * mk y`, but the latter is not well-defined, as +there exist `x₁ ≈ x₂` and `y₁ ≈ y₂` with `x₁ * y₁ ≉ x₂ * y₂`. See +`CombinatorialGames.Counterexamples.Multiplication` for a proof. +-/ + +universe u_inline_7 + +@[expose] public noncomputable section + +open IGame Set Pointwise + +/-- Games up to equivalence. + +If `x` and `y` are combinatorial games (`IGame`), we say that `x ≈ y` when both `x ≤ y` and `y ≤ x`. +Broadly, this means neither player has a preference in playing either game, as a component of a +larger game. This is the standard meaning of `x = y` in the literature, though it is not a strict +equality, e.g. `{0, 1 | 0}` and `{1 | 0}` are equivalent, but not identical as the former has an +extra move for Left. + +In particular, note that a `Game` has no well-defined notion of left and right options. This means +you should prefer `IGame` when analyzing specific games. -/ +def Game : Type (u_inline_7 + 1) := + Antisymmetrization IGame (· ≤ ·) + +namespace Game + +/-- The quotient map from `IGame` into `Game`. -/ +def mk (x : IGame) : Game := Quotient.mk _ x +theorem mk_eq_mk {x y : IGame} : mk x = mk y ↔ x ≈ y := Quotient.eq + +alias ⟨_, mk_eq⟩ := mk_eq_mk + +@[cases_eliminator] +theorem ind {motive : Game → Prop} (mk : ∀ y, motive (mk y)) (x : Game) : motive x := + Quotient.ind mk x + +/-- Choose an element of the equivalence class using the axiom of choice. -/ +@[no_expose] def out (x : Game) : IGame := Quotient.out x +@[simp] theorem out_eq (x : Game) : mk x.out = x := Quotient.out_eq x + +theorem mk_out_equiv (x : IGame) : (mk x).out ≈ x := Quotient.mk_out (s := AntisymmRel.setoid ..) x +theorem equiv_mk_out (x : IGame) : x ≈ (mk x).out := (mk_out_equiv x).symm + +/-- Construct a `Game` from its left and right sets. + +Note that although this function is well-defined, this function isn't injective, nor do equivalence +classes in `Game` have a canonical representative. -/ +instance : OfSets Game.{u_inline_7} fun _ ↦ True where + ofSets st _ := mk !{fun p ↦ out '' (st p)} + +theorem mk_ofSets' (st : Player → Set IGame.{u_inline_7}) + [Small.{u_inline_7} (st left)] [Small.{u_inline_7} (st right)] : + mk !{st} = !{fun p ↦ mk '' st p} := by + refine mk_eq <| IGame.equiv_of_exists ?_ ?_ ?_ ?_ <;> + simpa using fun a ha ↦ ⟨a, ha, equiv_mk_out a⟩ + +@[simp] +theorem mk_ofSets (s t : Set IGame.{u_inline_7}) [Small.{u_inline_7} s] [Small.{u_inline_7} t] : + mk !{s | t} = !{mk '' s | mk '' t} := by + rw [mk_ofSets'] + simp_rw [Player.apply_cases] + +private theorem ofSets_cases (s t : Set Game.{u_inline_7}) [Small.{u_inline_7} s] + [Small.{u_inline_7} t] : + !{s | t} = mk !{out '' s | out '' t} := by + simp [mk_ofSets, image_image] + +instance : Zero Game := ⟨mk 0⟩ +instance : One Game := ⟨mk 1⟩ +instance : Add Game := ⟨Quotient.map₂ _ @add_congr⟩ +instance : Neg Game := ⟨Quotient.map _ @neg_congr⟩ +instance : PartialOrder Game := inferInstanceAs (PartialOrder (Antisymmetrization ..)) +instance : Inhabited Game := ⟨0⟩ + +instance : AddCommGroupWithOne Game where + zero_add := by rintro ⟨x⟩; exact congr(mk $(zero_add _)) + add_zero := by rintro ⟨x⟩; exact congr(mk $(add_zero _)) + add_comm := by rintro ⟨x⟩ ⟨y⟩; exact congr(mk $(add_comm _ _)) + add_assoc := by rintro ⟨x⟩ ⟨y⟩ ⟨z⟩; exact congr(mk $(add_assoc _ _ _)) + neg_add_cancel := by rintro ⟨a⟩; exact mk_eq (neg_add_equiv _) + nsmul := nsmulRec + zsmul := zsmulRec + +instance : IsOrderedAddMonoid Game where + add_le_add_left := by rintro ⟨a⟩ ⟨b⟩ h ⟨c⟩; exact add_le_add_left (α := IGame) h _ + +@[simp] theorem mk_zero : mk 0 = 0 := rfl +@[simp] theorem mk_one : mk 1 = 1 := rfl +@[simp] theorem mk_add (x y : IGame) : mk (x + y) = mk x + mk y := rfl +@[simp] theorem mk_neg (x : IGame) : mk (-x) = -mk x := rfl +@[simp] theorem mk_sub (x y : IGame) : mk (x - y) = mk x - mk y := rfl + +theorem mk_mulOption (x y a b : IGame) : + mk (mulOption x y a b) = mk (a * y) + mk (x * b) - mk (a * b) := + rfl + +@[simp] theorem mk_le_mk {x y : IGame} : mk x ≤ mk y ↔ x ≤ y := .rfl +@[simp] theorem mk_lt_mk {x y : IGame} : mk x < mk y ↔ x < y := .rfl +@[simp] theorem mk_fuzzy_mk {x y : IGame} : mk x ‖ mk y ↔ x ‖ y := .rfl + +@[simp, norm_cast] +theorem mk_natCast : ∀ n : ℕ, mk n = n + | 0 => rfl + | n + 1 => by rw [Nat.cast_add, Nat.cast_add, mk_add, mk_natCast]; rfl + +@[simp, norm_cast] +theorem mk_intCast (n : ℤ) : mk n = n := by + cases n <;> simp + +theorem zero_def : (0 : Game) = !{fun _ ↦ ∅} := by apply (mk_ofSets' ..).trans; simp +theorem one_def : (1 : Game) = !{{0} | ∅} := by apply (mk_ofSets ..).trans; simp + +instance : ZeroLEOneClass Game where + zero_le_one := zero_le_one (α := IGame) + +instance : NeZero (1 : Game) where + out := by apply ne_of_gt; exact IGame.zero_lt_one + +instance : Nontrivial Game := ⟨_, _, zero_ne_one⟩ +instance : CharZero Game := AddMonoidWithOne.toCharZero + +theorem mk_mul_add (x y z : IGame) : mk (x * (y + z)) = mk (x * y) + mk (x * z) := by + rw [← mk_add, add_eq' (x * y), mul_eq'] + simp only [moves_add, moves_mul, prod_union, union_assoc, image_image, image_union, mk_ofSets'] + congr! 2 + ext p + nth_rewrite 2 [union_left_comm] + congrm _ ∈ ?_ ∪ (?_ ∪ (?_ ∪ ?_)) + all_goals + ext + simp only [mulOption, mk_sub, mk_add, mem_image, mem_prod, and_assoc, Prod.exists, + exists_and_left, exists_exists_and_eq_and] + iterate 2 (congr! 2; rw [and_congr_right_iff]; intros) + congr! 1 + rw [mk_mul_add, mk_mul_add, mk_mul_add] + abel +termination_by (x, y, z) +decreasing_by igame_wf + +theorem mk_mul_sub (x y z : IGame) : mk (x * (y - z)) = mk (x * y) - mk (x * z) := by + simpa [sub_eq_add_neg] using mk_mul_add x y (-z) + +theorem mk_add_mul (x y z : IGame) : mk ((x + y) * z) = mk (x * z) + mk (y * z) := by + rw [mul_comm, mk_mul_add, mul_comm, mul_comm z] + +theorem mk_sub_mul (x y z : IGame) : mk ((x - y) * z) = mk (x * z) - mk (y * z) := by + simpa [sub_eq_add_neg] using mk_add_mul x (-y) z + +theorem mk_mul_assoc (x y z : IGame) : mk (x * y * z) = mk (x * (y * z)) := by + induction x using IGame.ofSetsRecOn generalizing y z with | ofSets xL xR ihxl ihxr + induction y using IGame.ofSetsRecOn generalizing z with | ofSets yL yR ihyl ihyr + induction z using IGame.ofSetsRecOn with | ofSets zL zR ihzl ihzr + simp_rw [ofSets_mul_ofSets, mk_ofSets, Set.image_union, Set.image_image, mk_mulOption, + ← Set.image_union, ← ofSets_mul_ofSets, + Set.prod_image_left, Set.prod_image_right, Set.union_prod, Set.prod_union, + ← Equiv.prod_assoc_image, ← Set.image_union, Set.image_image, Equiv.prodAssoc_apply] + have e1 : (xL ×ˢ yL) ×ˢ zL ∪ (xR ×ˢ yR) ×ˢ zL ∪ ((xL ×ˢ yR) ×ˢ zR ∪ (xR ×ˢ yL) ×ˢ zR) = + (xL ×ˢ yL) ×ˢ zL ∪ (xL ×ˢ yR) ×ˢ zR ∪ ((xR ×ˢ yL) ×ˢ zR ∪ (xR ×ˢ yR) ×ˢ zL) := by + ac_rfl + have e2 : (xL ×ˢ yL) ×ˢ zR ∪ (xR ×ˢ yR) ×ˢ zR ∪ ((xL ×ˢ yR) ×ˢ zL ∪ (xR ×ˢ yL) ×ˢ zL) = + (xL ×ˢ yL) ×ˢ zR ∪ (xL ×ˢ yR) ×ˢ zL ∪ ((xR ×ˢ yL) ×ˢ zL ∪ (xR ×ˢ yR) ×ˢ zR) := by + ac_rfl + simp only [e1, e2] + congrm !{?_ | ?_} <;> + · refine Set.image_congr fun ⟨⟨x, y⟩, z⟩ hxyz => ?_ + obtain ⟨hx, hy, hz⟩ : (x ∈ xL ∨ x ∈ xR) ∧ (y ∈ yL ∨ y ∈ yR) ∧ (z ∈ zL ∨ z ∈ zR) := by + simp only [mem_union, mem_prod] at hxyz + tauto + simp only [mulOption, mk_sub_mul, mk_add_mul, mk_mul_sub, mk_mul_add, + hx.elim (ihxl x) (ihxr x), hy.elim (ihyl y) (ihyr y), hz.elim (ihzl z) (ihzr z)] + abel + +theorem lf_ofSets_of_mem_left {s t : Set Game.{u_inline_7}} [Small.{u_inline_7} s] + [Small.{u_inline_7} t] {x : Game.{u_inline_7}} + (h : x ∈ s) : x ⧏ !{s | t} := by + rw [ofSets_cases] + have : x.out ∈ !{out '' s | out '' t}ᴸ := by simpa using mem_image_of_mem _ h + simpa [← mk_le_mk] using left_lf this + +theorem ofSets_lf_of_mem_right {s t : Set Game.{u_inline_7}} [Small.{u_inline_7} s] + [Small.{u_inline_7} t] {x : Game.{u_inline_7}} + (h : x ∈ t) : !{s | t} ⧏ x := by + rw [ofSets_cases] + have : x.out ∈ !{out '' s | out '' t}ᴿ := by simpa using mem_image_of_mem _ h + simpa [← mk_le_mk] using lf_right this + +end Game + +namespace IGame + +protected theorem sub_le_iff_le_add {x y z : IGame} : x - z ≤ y ↔ x ≤ y + z := + @sub_le_iff_le_add Game _ _ _ (.mk x) (.mk y) (.mk z) + +protected theorem le_sub_iff_add_le {x y z : IGame} : x ≤ z - y ↔ x + y ≤ z := + @le_sub_iff_add_le Game _ _ _ (.mk x) (.mk y) (.mk z) + +protected theorem sub_lt_iff_lt_add {x y z : IGame} : x - z < y ↔ x < y + z := + @sub_lt_iff_lt_add Game _ _ _ (.mk x) (.mk y) (.mk z) + +protected theorem lt_sub_iff_add_lt {x y z : IGame} : x < z - y ↔ x + y < z := + @lt_sub_iff_add_lt Game _ _ _ (.mk x) (.mk y) (.mk z) + +protected theorem sub_nonneg {x y : IGame} : 0 ≤ x - y ↔ y ≤ x := + @sub_nonneg Game _ _ _ (.mk x) (.mk y) + +protected theorem sub_nonpos {x y : IGame} : x - y ≤ 0 ↔ x ≤ y := + @sub_nonpos Game _ _ _ (.mk x) (.mk y) + +protected theorem sub_pos {x y : IGame} : 0 < x - y ↔ y < x := + @sub_pos Game _ _ _ (.mk x) (.mk y) + +protected theorem sub_neg {x y : IGame} : x - y < 0 ↔ x < y := + @sub_neg Game _ _ _ (.mk x) (.mk y) + +theorem mul_add_equiv (x y z : IGame) : x * (y + z) ≈ x * y + x * z := + Game.mk_eq_mk.1 (Game.mk_mul_add x y z) + +theorem mul_sub_equiv (x y z : IGame) : x * (y - z) ≈ x * y - x * z := + Game.mk_eq_mk.1 (Game.mk_mul_sub x y z) + +theorem add_mul_equiv (x y z : IGame) : (x + y) * z ≈ x * z + y * z := + Game.mk_eq_mk.1 (Game.mk_add_mul x y z) + +theorem sub_mul_equiv (x y z : IGame) : (x - y) * z ≈ x * z - y * z := + Game.mk_eq_mk.1 (Game.mk_sub_mul x y z) + +theorem mul_assoc_equiv (x y z : IGame) : x * y * z ≈ x * (y * z) := + Game.mk_eq_mk.1 (Game.mk_mul_assoc x y z) + +@[simp, norm_cast] +theorem natCast_le {m n : ℕ} : (m : IGame) ≤ n ↔ m ≤ n := by + simp [← Game.mk_le_mk] + +@[simp, norm_cast] +theorem natCast_lt {m n : ℕ} : (m : IGame) < n ↔ m < n := by + simp [← Game.mk_lt_mk] + +@[simp] +theorem natCast_nonneg (n : ℕ) : 0 ≤ (n : IGame) := + natCast_le.2 n.zero_le + +theorem natCast_strictMono : StrictMono ((↑) : ℕ → IGame) := + fun _ _ h ↦ natCast_lt.2 h + +instance : CharZero IGame where + cast_injective := natCast_strictMono.injective + +@[simp, norm_cast] +theorem natCast_equiv {m n : ℕ} : (m : IGame) ≈ n ↔ m = n := by + simp [AntisymmRel, le_antisymm_iff] + +@[simp, norm_cast] +theorem intCast_le {m n : ℤ} : (m : IGame) ≤ n ↔ m ≤ n := by + simp [← Game.mk_le_mk] + +@[simp, norm_cast] +theorem intCast_lt {m n : ℤ} : (m : IGame) < n ↔ m < n := by + simp [← Game.mk_lt_mk] + +theorem intCast_strictMono : StrictMono ((↑) : ℤ → IGame) := + fun _ _ h ↦ intCast_lt.2 h + +@[simp, norm_cast] +theorem intCast_inj {m n : ℤ} : (m : IGame) = n ↔ m = n := + intCast_strictMono.injective.eq_iff + +@[simp, norm_cast] +theorem intCast_equiv {m n : ℤ} : (m : IGame) ≈ n ↔ m = n := by + simp [AntisymmRel, le_antisymm_iff] + +theorem intCast_add_equiv (m n : ℤ) : ((m + n : ℤ) : IGame) ≈ m + n := by + simp [← Game.mk_eq_mk] + +theorem intCast_sub_equiv (m n : ℤ) : ((m - n : ℤ) : IGame) ≈ m - n := by + simp [← Game.mk_eq_mk] + +@[simp, norm_cast] +theorem zero_lt_intCast {n : ℤ} : 0 < (n : IGame) ↔ 0 < n := by + simpa using intCast_lt (m := 0) + +@[simp, norm_cast] +theorem intCast_lt_zero {n : ℤ} : (n : IGame) < 0 ↔ n < 0 := by + simpa using intCast_lt (n := 0) + +@[simp, norm_cast] +theorem zero_le_intCast {n : ℤ} : 0 ≤ (n : IGame) ↔ 0 ≤ n := by + simpa using intCast_le (m := 0) + +@[simp, norm_cast] +theorem intCast_le_zero {n : ℤ} : (n : IGame) ≤ 0 ↔ n ≤ 0 := by + simpa using intCast_le (n := 0) + +end IGame +end + +/-! ## Inlined from `CombinatorialGames.Surreal.Basic` -/ + +/-! +# Surreal numbers + +The basic theory of surreal numbers, built on top of the theory of combinatorial (pre-)games. A +surreal number is defined as an equivalence class of numeric games. + +Surreal numbers inherit the relations `≤` and `<` from games, and these relations satisfy the axioms +of a linear order. In fact, the surreals form a complete ordered field, containing a copy of the +reals, and much else besides! + +## Algebraic operations + +In this file, we show that the surreals form a linear ordered commutative group. + +In `CombinatorialGames.Surreal.Multiplication`, we define multiplication and show that the surreals +form a linear ordered commutative ring. In `CombinatorialGames.Surreal.Division` we further show the +surreals are a field. +-/ + +universe u_inline_8 + +@[expose] public noncomputable section + +/-! ### Simplicity theorem -/ + +namespace IGame + +/-- `x` fits within `y` when `z ⧏ x` for every `z ∈ yᴸ`, and `x ⧏ z` for every +`z ∈ yᴿ`. + +The simplicity theorem states that if a game fits a numeric game, but none of its options do, then +the games are equivalent. In particular, a numeric game is equivalent to the game of the least +birthday that fits in it -/ +def Fits (x y : IGame) : Prop := + (∀ z ∈ yᴸ, z ⧏ x) ∧ (∀ z ∈ yᴿ, x ⧏ z) + +theorem fits_of_equiv {x y : IGame} (h : x ≈ y) : Fits x y := + ⟨fun _ hz ↦ mt h.ge.trans (left_lf hz), fun _ hz ↦ mt h.le.trans' (lf_right hz) ⟩ + +alias AntisymmRel.Fits := fits_of_equiv + +theorem Fits.refl (x : IGame) : x.Fits x := + fits_of_equiv .rfl + +instance : Std.Refl Fits where + refl := Fits.refl + +theorem Fits.antisymm {x y : IGame} (h₁ : Fits x y) (h₂ : Fits y x) : x ≈ y := by + rw [AntisymmRel, le_iff_forall_lf, le_iff_forall_lf] + exact ⟨⟨h₂.1, h₁.2⟩, ⟨h₁.1, h₂.2⟩⟩ + +@[simp] +theorem fits_neg_iff {x y : IGame} : Fits (-x) (-y) ↔ Fits x y := by + simp [Fits, and_comm] + +alias ⟨_, Fits.neg⟩ := fits_neg_iff + +theorem not_fits_iff {x y : IGame} : + ¬ Fits x y ↔ (∃ z ∈ yᴸ, x ≤ z) ∨ (∃ z ∈ yᴿ, z ≤ x) := by + rw [Fits, not_and_or]; simp + +theorem Fits.congr {x y z : IGame} (h : x ≈ y) (hx : x.Fits z) : y.Fits z := by + constructor <;> intro w hw <;> grw [← h] + exacts [hx.1 w hw, hx.2 w hw] + +theorem fits_congr {x y z : IGame} (h : x ≈ y) : x.Fits z ↔ y.Fits z := + ⟨.congr h, .congr h.symm⟩ + +/-- A variant of the **simplicity theorem** with hypotheses that are easier to show. -/ +theorem Fits.equiv_of_forall_moves {x y : IGame} (hx : x.Fits y) + (hl : ∀ z ∈ xᴸ, ∃ w ∈ yᴸ, z ≤ w) (hr : ∀ z ∈ xᴿ, ∃ w ∈ yᴿ, w ≤ z) : x ≈ y := + ⟨le_of_forall_moves_right_lf hx.2 hl, le_of_forall_moves_left_lf hx.1 hr⟩ + +/-- A variant of the **simplicity theorem**: if a numeric game `x` fits within a game `y`, but none +of its options do, then `x ≈ y`. + +Note that under most circumstances, `Fits.equiv_of_forall_moves` is easier to use. -/ +theorem Fits.equiv_of_forall_not_fits {x y : IGame} [Numeric x] (hx : x.Fits y) + (h : ∀ p, ∀ z ∈ x.moves p, ¬ z.Fits y) : x ≈ y := by + simp_rw [not_fits_iff] at h + apply hx.equiv_of_forall_moves + · refine fun z hz ↦ (h _ z hz).resolve_right ?_ + rintro ⟨w, hw, hwz⟩ + exact hx.2 w hw <| hwz.trans (Numeric.left_lt hz).le + · refine fun z hz ↦ (h _ z hz).resolve_left ?_ + rintro ⟨w, hw, hwz⟩ + exact hx.1 w hw <| (Numeric.lt_right hz).le.trans hwz + +/-- A specialization of the simplicity theorem to `0`. -/ +@[simp] +theorem fits_zero_iff_equiv {x : IGame} : Fits 0 x ↔ x ≈ 0 := + ⟨fun hx ↦ (hx.equiv_of_forall_not_fits <| by simp).symm, fun h ↦ fits_of_equiv h.symm⟩ + +/-- A specialization of the simplicity theorem to `1`. -/ +theorem equiv_one_of_fits {x : IGame} (hx : Fits 1 x) (h : ¬ x ≈ 0) : x ≈ 1 := by + apply (hx.equiv_of_forall_not_fits _).symm + simpa + +end IGame + +/-! ### Surreal numbers -/ + +open IGame + +/-- The type of surreal numbers. These are the numeric games quotiented by the antisymmetrization +relation `x ≈ y ↔ x ≤ y ∧ y ≤ x`. In the quotient, the order becomes a total order. -/ +def Surreal : Type (u_inline_8 + 1) := + Antisymmetrization (Subtype Numeric) (· ≤ ·) + +namespace Surreal + +/-- The quotient map from the subtype of numeric `IGame`s into `Game`. -/ +def mk (x : IGame) [h : Numeric x] : Surreal := Quotient.mk _ ⟨x, h⟩ +theorem mk_eq_mk {x y : IGame} [Numeric x] [Numeric y] : mk x = mk y ↔ x ≈ y := Quotient.eq + +alias ⟨_, mk_eq⟩ := mk_eq_mk + +@[cases_eliminator] +theorem ind {motive : Surreal → Prop} (mk : ∀ y [Numeric y], motive (mk y)) (x : Surreal) : + motive x := Quotient.ind (fun h ↦ @mk _ h.2) x + +/-- Choose an element of the equivalence class using the axiom of choice. -/ +@[no_expose] def out (x : Surreal) : IGame := (Quotient.out x).1 +@[simp] instance (x : Surreal) : Numeric x.out := (Quotient.out x).2 +@[simp] theorem out_eq (x : Surreal) : mk x.out = x := Quotient.out_eq x + +theorem mk_out_equiv (x : IGame) [h : Numeric x] : (mk x).out ≈ x := + Quotient.mk_out (s := AntisymmRel.setoid (Subtype _) (· ≤ ·)) ⟨x, h⟩ + +theorem equiv_mk_out (x : IGame) [Numeric x] : x ≈ (mk x).out := + (mk_out_equiv x).symm + +instance : Zero Surreal := ⟨mk 0⟩ +instance : One Surreal := ⟨mk 1⟩ +instance : Inhabited Surreal := ⟨0⟩ + +instance : Add Surreal where + add := Quotient.map₂ (fun a b ↦ ⟨a.1 + b.1, inferInstance⟩) fun _ _ h₁ _ _ h₂ ↦ add_congr h₁ h₂ + +instance : Neg Surreal where + neg := Quotient.map (fun a ↦ ⟨-a.1, inferInstance⟩) fun _ _ ↦ neg_congr + +instance : PartialOrder Surreal := + inferInstanceAs (PartialOrder (Antisymmetrization ..)) + +instance : LinearOrder Surreal where + le_total := by rintro ⟨x⟩ ⟨y⟩; exact Numeric.le_total x y + toDecidableLE := Classical.decRel _ + +instance : AddCommGroup Surreal where + zero_add := by rintro ⟨x⟩; change mk (0 + x) = mk x; simp_rw [zero_add] + add_zero := by rintro ⟨x⟩; change mk (x + 0) = mk x; simp_rw [add_zero] + add_comm := by rintro ⟨x⟩ ⟨y⟩; change mk (x + y) = mk (y + x); simp_rw [add_comm] + add_assoc := by rintro ⟨x⟩ ⟨y⟩ ⟨z⟩; change mk (x + y + z) = mk (x + (y + z)); simp_rw [add_assoc] + neg_add_cancel := by rintro ⟨a⟩; exact mk_eq (neg_add_equiv _) + nsmul := nsmulRec + zsmul := zsmulRec + +instance : AddGroupWithOne Surreal where + +instance : IsOrderedAddMonoid Surreal where + add_le_add_left := by rintro ⟨a⟩ ⟨b⟩ h ⟨c⟩; exact add_le_add_left (α := IGame) h _ + +@[simp] theorem mk_zero : mk 0 = 0 := rfl +@[simp] theorem mk_one : mk 1 = 1 := rfl +@[simp] theorem mk_add (x y : IGame) [Numeric x] [Numeric y] : mk (x + y) = mk x + mk y := rfl +@[simp] theorem mk_neg (x : IGame) [Numeric x] : mk (-x) = -mk x := rfl +@[simp] theorem mk_sub (x y : IGame) [Numeric x] [Numeric y] : mk (x - y) = mk x - mk y := rfl + +@[simp] theorem mk_le_mk {x y : IGame} [Numeric x] [Numeric y] : mk x ≤ mk y ↔ x ≤ y := Iff.rfl +@[simp] theorem mk_lt_mk {x y : IGame} [Numeric x] [Numeric y] : mk x < mk y ↔ x < y := Iff.rfl + +@[simp] +theorem mk_natCast : ∀ n : ℕ, mk n = n + | 0 => rfl + | n + 1 => by simp_rw [Nat.cast_add_one, mk_add, mk_one, mk_natCast n] + +@[simp] +theorem mk_intCast (n : ℤ) : mk n = n := by + cases n <;> simp + +instance : ZeroLEOneClass Surreal where + zero_le_one := zero_le_one (α := IGame) + +instance : NeZero (1 : Surreal) where + out := by apply ne_of_gt; exact IGame.zero_lt_one + +instance : Nontrivial Surreal := + ⟨_, _, zero_ne_one⟩ + +/-- Casts a `Surreal` number into a `Game`. -/ +def toGame : Surreal ↪o Game where + toFun := Quotient.lift (fun x ↦ .mk x) fun _ _ ↦ Game.mk_eq + inj' x y := by + cases x; cases y; + change Game.mk _ = Game.mk _ → _ + simp [Game.mk_eq_mk, mk_eq_mk] + map_rel_iff' := by rintro ⟨_⟩ ⟨_⟩; rfl + +@[simp] theorem toGame_mk (x : IGame) [Numeric x] : toGame (mk x) = .mk x := rfl +@[simp] theorem toGame_zero : toGame 0 = 0 := rfl +@[simp] theorem toGame_one : toGame 1 = 1 := rfl + +@[simp] +theorem gameMk_out (x : Surreal) : Game.mk x.out = x.toGame := by + conv_rhs => rw [← out_eq x, toGame_mk] + +theorem toGame_le_iff {a b : Surreal} : toGame a ≤ toGame b ↔ a ≤ b := by simp +theorem toGame_lt_iff {a b : Surreal} : toGame a < toGame b ↔ a < b := by simp +theorem toGame_inj {a b : Surreal} : toGame a = toGame b ↔ a = b := by simp + +/-- `Surreal.toGame` as an `OrderAddMonoidHom` -/ +@[simps] +def toGameAddHom : Surreal →+o Game where + toFun := toGame + map_zero' := rfl + map_add' := by rintro ⟨_⟩ ⟨_⟩; rfl + monotone' := toGame.monotone + +@[simp] +theorem toGame_add (x y : Surreal) : toGame (x + y) = toGame x + toGame y := + toGameAddHom.map_add x y + +@[simp] +theorem toGame_neg (x : Surreal) : toGame (-x) = -toGame x := + toGameAddHom.map_neg x + +@[simp] +theorem toGame_sub (x y : Surreal) : toGame (x - y) = toGame x - toGame y := + toGameAddHom.map_sub x y + +@[simp] theorem toGame_natCast (n : ℕ) : toGame n = n := map_natCast' toGameAddHom rfl n +@[simp] theorem toGame_intCast (n : ℤ) : toGame n = n := map_intCast' toGameAddHom rfl n + +/-- Construct a `Surreal` from its left and right sets, and a proof that all elements from the left +set are less than all the elements of the right set. + +Note that although this function is well-defined, this function isn't injective, nor do equivalence +classes in Surreal have a canonical representative. (Note however that every short numeric game has +a unique "canonical" form!) -/ +instance : OfSets Surreal.{u_inline_8} (fun st ↦ ∀ x ∈ st left, ∀ y ∈ st right, x < y) where + ofSets st H _ _ := by + refine @mk !{fun p ↦ out '' st p} (.mk ?_ (by simp)) + rw [moves_ofSets, moves_ofSets] + rintro - ⟨x, hx, rfl⟩ - ⟨y, hy, rfl⟩ + rw [← Surreal.mk_lt_mk, out_eq, out_eq] + exact H x hx y hy + +theorem toGame_ofSets' (st : Player → Set Surreal.{u_inline_8}) + [Small.{u_inline_8} (st left)] [Small.{u_inline_8} (st right)] + {H : ∀ x ∈ st left, ∀ y ∈ st right, x < y} : + toGame !{st} = !{fun p ↦ toGame '' st p} := by + change toGame (@mk _ (_)) = _ + simp_rw [toGame_mk, Game.mk_ofSets', Set.image_image, gameMk_out] + +@[simp] +theorem toGame_ofSets (s t : Set Surreal.{u_inline_8}) [Small.{u_inline_8} s] [Small.{u_inline_8} t] + {H : ∀ x ∈ s, ∀ y ∈ t, x < y} : + toGame !{s | t} = !{toGame '' s | toGame '' t} := by + rw [toGame_ofSets'] + congr; aesop + +theorem mk_ofSets' {st : Player → Set IGame.{u_inline_8}} + [Small.{u_inline_8} (st left)] [Small.{u_inline_8} (st right)] {H : Numeric !{st}} : + mk !{st} = + !{fun p ↦ .range fun x : st p ↦ mk x (h := H.of_mem_moves (p := p) (by simp))}' + (by have := @H.left_lt_right; aesop) := by + change _ = @mk _ (_) + simp_rw [← toGame_inj, toGame_mk, Game.mk_ofSets'] + congr; aesop + +theorem mk_ofSets {s t : Set IGame.{u_inline_8}} [Small.{u_inline_8} s] + [Small.{u_inline_8} t] {H : Numeric !{s | t}} : + mk !{s | t} = + !{.range fun x : s ↦ mk x (h := H.of_mem_moves (p := left) (by simp)) | + .range fun x : t ↦ mk x (h := H.of_mem_moves (p := right) (by simp))}' + (by have := @H.left_lt_right; aesop) := by + rw [mk_ofSets'] + congr!; aesop + +@[aesop apply unsafe] +theorem lt_ofSets_of_mem_left {s t : Set Surreal.{u_inline_8}} [Small.{u_inline_8} s] + [Small.{u_inline_8} t] + {H : ∀ x ∈ s, ∀ y ∈ t, x < y} {x : Surreal} (hx : x ∈ s) : + x < !{s | t} := by + rw [lt_iff_not_ge, ← toGame_le_iff, toGame_ofSets] + exact Game.lf_ofSets_of_mem_left (Set.mem_image_of_mem _ hx) + +@[aesop apply unsafe] +theorem ofSets_lt_of_mem_right {s t : Set Surreal.{u_inline_8}} [Small.{u_inline_8} s] + [Small.{u_inline_8} t] + {H : ∀ x ∈ s, ∀ y ∈ t, x < y} {x : Surreal} (hx : x ∈ t) : + !{s | t} < x := by + rw [lt_iff_not_ge, ← toGame_le_iff, toGame_ofSets] + exact Game.ofSets_lf_of_mem_right (Set.mem_image_of_mem _ hx) + +theorem zero_def : (0 : Surreal) = !{fun _ ↦ ∅} := by apply (mk_ofSets' ..).trans; congr!; simp +theorem one_def : (1 : Surreal) = !{{0} | ∅} := by apply (mk_ofSets ..).trans; congr! <;> aesop + +instance : DenselyOrdered Surreal where + dense a b hab := ⟨!{{a} | {b}}, + lt_ofSets_of_mem_left (Set.mem_singleton a), ofSets_lt_of_mem_right (Set.mem_singleton b)⟩ + +end Surreal +end + +/-! ## Inlined from `CombinatorialGames.Surreal.Multiplication` -/ + +/-! +# Surreal multiplication + +In this file, we show that multiplication of surreal numbers is well-defined, and thus the surreal +numbers form a linear ordered commutative ring. This is Theorem 8 in [Conway2001], or Theorem 3.8 in +[SchleicherStoll]. + +An inductive argument proves the following three main theorems: + +* P1: being numeric is closed under multiplication, +* P2: multiplying a numeric pregame by equivalent numeric pregames results in equivalent pregames, +* P3: the product of two positive numeric pregames is positive (`mul_pos`). + +P1 allows us to define multiplication as an operation on numeric pregames, P2 says that this is +well-defined as an operation on the quotient by `IGame.Equiv`, namely the surreal numbers, and P3 is +an axiom that needs to be satisfied for the surreals to be a `OrderedRing`. + +We follow the proof in [SchleicherStoll], except that we use the well-foundedness of the hydra +relation `CutExpand` on `Multiset IGame` instead of the argument based on a depth function in the +paper. As in said argument, P3 is proven by proxy of an auxiliary P4, which states that for +`x₁ < x₂` and `y`, then `x₁ * y + x₂ * a < x₁ * a + x₂ * y` when `a ∈ yᴸ`, and +`x₁ * b + x₂ * y < x₁ * y + x₂ * b` when `b ∈ yᴿ`. + +## Reducing casework + +This argument is very casework heavy in a way that's difficult to automate. For instance, in P1, we +have to prove four different inequalities of the form +`a ∈ (x * y)ᴸ → b ∈ (x * y)ᴿ → a < b`, and depending on what form the options of +`x * y` take, we have to apply different instantiations of the inductive hypothesis. + +To greatly simplify things, we work uniquely in terms of left options, which we achieve by rewriting +`a ∈ xᴿ` as `-a ∈ (-x)ᴸ`. We then show that our distinct lemmas and inductive +hypotheses are invariant under the appropriate sign changes. In the P1 example, this makes it so +that one case (`mulOption_lt_of_lt`) is enough to conclude the others (`mulOption_lt`), and the same +goes for the other parts of the proof. + +Note also that we express all inequalities in terms of `Game` instead of `IGame`; this allows us to +make use of `abel` and all of the theorems on `OrderedAddCommGroup`. +-/ + +universe u_inline_9 + +open Game IGame Relation WellFounded + +/-- A characterization of left moves of `x * y` in terms only of left moves. -/ +lemma forall_leftMoves_mul' {P : IGame → Prop} {x y : IGame} : + (∀ a ∈ (x * y)ᴸ, P a) ↔ + (∀ a ∈ xᴸ, ∀ b ∈ yᴸ, P (mulOption x y a b)) ∧ + (∀ a ∈ (-x)ᴸ, ∀ b ∈ (-y)ᴸ, P (mulOption (-x) (-y) a b)) := by + rw [forall_moves_mul] + simp [mulOption_neg] + +/-- A characterization of right moves of `x * y` in terms only of left moves. -/ +lemma forall_rightMoves_mul' {P : IGame → Prop} {x y : IGame} : + (∀ a ∈ (x * y)ᴿ, P a) ↔ + (∀ a ∈ xᴸ, ∀ b ∈ (-y)ᴸ, P (-mulOption x (-y) a b)) ∧ + (∀ a ∈ (-x)ᴸ, ∀ b ∈ yᴸ, P (-mulOption (-x) y a b)) := by + rw [forall_moves_mul] + simp [mulOption_neg_right, mulOption_neg_left] + +/-! ### Predicates P1 – P4 -/ + +/-- `P1 x y a b c d` means that `mulOption x y a b < mulOption x y c d`. This is the general form +of the statements needed to prove that `x * y` is numeric. -/ +def P1 (x y a b c d : IGame) := Game.mk (mulOption x y a b) < Game.mk (mulOption x y c d) + +/-- `P2 x₁ x₂ y` states that if `x₁ ≈ x₂`, then `x₁ * y ≈ x₂ * y`. The RHS is stated in terms of +`Game.mk` for rewriting convenience. -/ +def P2 (x₁ x₂ y : IGame) := x₁ ≈ x₂ → Game.mk (x₁ * y) = Game.mk (x₂ * y) + +/-- `P3 x₁ x₂ y₁ y₂` states that `x₁ * y₂ + x₂ * y₁ < x₁ * y₁ + x₂ * y₂`. Using distributivity, this +is equivalent to `(x₁ - x₂) * (y₁ - y₂) > 0`. -/ +def P3 (x₁ x₂ y₁ y₂ : IGame) := + Game.mk (x₁ * y₂) + Game.mk (x₂ * y₁) < Game.mk (x₁ * y₁) + Game.mk (x₂ * y₂) + +/-- `P4 x₁ x₂ y` states that if `x₁ < x₂`, then `P3 x₁ x₂ a y` when `a ∈ yᴸ`, and +`P3 x₁ x₂ b y` when `b ∈ yᴿ`. + +Note that we instead write this second part as `P3 x₁ x₂ b (-y)` when `b ∈ (-y)ᴸ`. See the +module docstring for an explanation. -/ +def P4 (x₁ x₂ y : IGame) := + x₁ < x₂ → (∀ a ∈ yᴸ, P3 x₁ x₂ a y) ∧ (∀ b ∈ (-y)ᴸ, P3 x₁ x₂ b (-y)) + +/-- The conjunction of `P2` and `P4`. Both statements have the same amount of arguments and satisfy +similar symmetry properties, so we can slightly simplify the argument by merging them. -/ +def P24 (x₁ x₂ y : IGame) : Prop := P2 x₁ x₂ y ∧ P4 x₁ x₂ y + +variable {x x₁ x₂ x₃ x' y y₁ y₂ y₃ y' a b c d : IGame.{u_inline_9}} + +/-! #### Symmetry properties of P1 – P4 -/ + +lemma P3_comm : P3 x₁ x₂ y₁ y₂ ↔ P3 y₁ y₂ x₁ x₂ := by + simp [P3, add_comm, mul_comm] + +lemma P3.trans (h₁ : P3 x₁ x₂ y₁ y₂) (h₂ : P3 x₂ x₃ y₁ y₂) : P3 x₁ x₃ y₁ y₂ := by + rw [P3, ← add_lt_add_iff_left (Game.mk (x₂ * y₁) + Game.mk (x₂ * y₂))] + convert add_lt_add h₁ h₂ using 1 <;> abel + +lemma P3_neg : P3 (-x₂) (-x₁) y₁ y₂ ↔ P3 x₁ x₂ y₁ y₂ := by + simp_rw [P3, neg_mul, Game.mk_neg] + rw [← _root_.neg_lt_neg_iff] + abel_nf + +lemma P2_neg_left : P2 (-x₂) (-x₁) y ↔ P2 x₁ x₂ y := by + simp [P2, AntisymmRel, eq_comm] + +lemma P2_neg_right : P2 x₁ x₂ (-y) ↔ P2 x₁ x₂ y := by + simp [P2] + +lemma P4_neg_left : P4 (-x₂) (-x₁) y ↔P4 x₁ x₂ y := by + simp_rw [P4, IGame.neg_lt_neg_iff, P3_neg] + +lemma P4_neg_right : P4 x₁ x₂ (-y) ↔ P4 x₁ x₂ y := by + rw [P4, P4, neg_neg, and_comm] + +lemma P24_neg_left : P24 (-x₂) (-x₁) y ↔ P24 x₁ x₂ y := by rw [P24, P24, P2_neg_left, P4_neg_left] +lemma P24_neg_right : P24 x₁ x₂ (-y) ↔ P24 x₁ x₂ y := by rw [P24, P24, P2_neg_right, P4_neg_right] + +/-! ### Inductive setup -/ + +/-- The type of lists of arguments for `P1`, `P2`, and `P4`. -/ +inductive Args : Type (u_inline_9 + 1) + | P1 (x y : IGame.{u_inline_9}) : Args + | P24 (x₁ x₂ y : IGame.{u_inline_9}) : Args + +/-- The multiset associated to a list of arguments. -/ +def Args.toMultiset : Args → Multiset IGame + | (Args.P1 x y) => {x, y} + | (Args.P24 x₁ x₂ y) => {x₁, x₂, y} + +@[simp] lemma Args.toMultiset_P1 {x y} : (Args.P1 x y).toMultiset = {x, y} := rfl +@[simp] lemma Args.toMultiset_P24 {x₁ x₂ y} : (Args.P24 x₁ x₂ y).toMultiset = {x₁, x₂, y} := rfl + +/-- A list of arguments is numeric if all the arguments are. -/ +def Args.Numeric (a : Args) := ∀ x ∈ a.toMultiset, x.Numeric + +lemma Args.numeric_P1 {x y} : (Args.P1 x y).Numeric ↔ x.Numeric ∧ y.Numeric := by + simp [Args.Numeric, Args.toMultiset] + +lemma Args.numeric_P24 {x₁ x₂ y} : + (Args.P24 x₁ x₂ y).Numeric ↔ x₁.Numeric ∧ x₂.Numeric ∧ y.Numeric := by + simp [Args.Numeric, Args.toMultiset] + +/-- The well-founded relation specifying when a list of game arguments is considered simpler than +another: `ArgsRel a₁ a₂` is true if `a₁`, considered as a multiset, can be obtained from `a₂` by +repeatedly removing a game from `a₂` and adding back one or two options of the game. + +See also `WellFounded.CutExpand`. -/ +def ArgsRel := + InvImage (Relation.TransGen <| CutExpand fun x y => ∃ p, x ∈ y.moves p) Args.toMultiset + +/-- `ArgsRel` is well-founded. -/ +lemma argsRel_wf : WellFounded ArgsRel := + InvImage.wf _ (Subrelation.wf (fun h => h.elim fun _ => Subposition.of_mem_moves) + subposition_wf).cutExpand.transGen +instance : IsWellFounded _ ArgsRel := ⟨argsRel_wf⟩ + +/-- The property that all arguments are numeric is leftward-closed under `ArgsRel`. -/ +lemma ArgsRel.numeric_closed {a' a} : ArgsRel a' a → a.Numeric → a'.Numeric := + Relation.TransGen.closed' <| @cutExpand_closed _ _ + ⟨fun _ h => (h.elim fun _ => Subposition.of_mem_moves).irrefl⟩ _ fun h h' ↦ + h'.subposition (h.elim fun _ => Subposition.of_mem_moves) + +/-- The statement that we will show by induction for all `Numeric` args, using the well-founded +relation `ArgsRel`. + +The inductive hypothesis in the proof will be `∀ a', ArgsRel a' a → P124 a`. -/ +def P124 : Args → Prop + | (Args.P1 x y) => Numeric (x * y) + | (Args.P24 x₁ x₂ y) => P24 x₁ x₂ y + +/-! ### P1 follows from the inductive hypothesis -/ + +lemma numeric_move_mul_of_IH {p : Player} (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) + (h : x' ∈ x.moves p) : (x' * y).Numeric := + IH (Args.P1 x' y) (Relation.TransGen.single <| cutExpand_pair_left ⟨p, h⟩) + +lemma numeric_mul_move_of_IH {p : Player} (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) + (h : y' ∈ y.moves p) : (x * y').Numeric := + IH (Args.P1 x y') (Relation.TransGen.single <| cutExpand_pair_right ⟨p, h⟩) + +lemma numeric_move_mul_move_of_IH {p q : Player} (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) + (hx : x' ∈ x.moves p) (hy : y' ∈ y.moves q) : (x' * y').Numeric := + IH (Args.P1 x' y') + ((Relation.TransGen.single (cutExpand_pair_right ⟨q, hy⟩)).tail (cutExpand_pair_left ⟨p, hx⟩)) + +/-- A specialization of the inductive hypothesis used to prove `P1`. -/ +def IH1 (x y : IGame) : Prop := + ∀ ⦃p q x₁ x₂ y'⦄, x₁ ∈ x.moves p → x₂ ∈ x.moves q → + (y' = y ∨ ∃ u_inline_9, y' ∈ y.moves u_inline_9) → P24 x₁ x₂ y' + +/-- `IH1 x y` follows from the inductive hypothesis for `P1 x y`. -/ +lemma IH1_of_IH (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) : IH1 x y := by + rintro p q x₁ x₂ y' h₁ h₂ (rfl | hy) <;> apply IH (.P24 ..) + on_goal 2 => refine .tail ?_ (cutExpand_pair_right hy) + all_goals exact .single (cutExpand_double_left ⟨p, h₁⟩ ⟨q, h₂⟩) + +/-- `IH1 y x` follows from the inductive hypothesis for `P1 x y`. -/ +lemma IH1_swap_of_IH (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) : IH1 y x := IH1_of_IH <| by + simpa [-Multiset.insert_eq_cons, ArgsRel, InvImage, Multiset.pair_comm] using IH + +lemma IH1_neg_left : IH1 x y → IH1 (-x) y := by + intro h p q x₁ x₂ y' h₁ h₂ hy + rw [moves_neg] at h₁ h₂ + exact P24_neg_left.1 (h h₂ h₁ hy) + +lemma IH1_neg_right : IH1 x y → IH1 x (-y) := by + intro h p q x₁ x₂ y' h₁ h₂ hy + rw [← P24_neg_right] + apply h h₁ h₂ + simpa [neg_eq_iff_eq_neg, or_comm] using hy + +lemma P1_of_equiv (he : x₁ ≈ x₃) (h₁ : P2 x₁ x₃ y₁) (h₃ : P2 x₁ x₃ y₃) (h3 : P3 x₁ x₂ y₂ y₃) : + P1 x₂ y₁ x₁ y₂ x₃ y₃ := by + rw [P1, mk_mulOption, mk_mulOption, ← h₁ he, ← h₃ he, sub_lt_sub_iff] + convert add_lt_add_left h3 (.mk (x₁ * y₁)) using 1 <;> abel + +lemma P1_of_P3 (h₁ : P3 x₃ x₂ y₂ y₃) (h₂ : P3 x₁ x₃ y₂ y₁) : P1 x₂ y₁ x₁ y₂ x₃ y₃ := by + rw [P1, mk_mulOption, mk_mulOption, sub_lt_sub_iff, ← add_lt_add_iff_left (.mk (x₃ * y₂))] + convert add_lt_add h₁ h₂ using 1 <;> abel + +lemma P3_of_IH1 [Numeric y] (ihyx : IH1 y x) + (ha : a ∈ xᴸ) (hb : b ∈ yᴸ) (hd : d ∈ (-y)ᴸ) : P3 a x b (-d) := by + rw [P3_comm] + rw [moves_neg] at hd + refine ((ihyx hb hd (.inl rfl)).2 ?_).1 a ha + exact Numeric.left_lt_right hb hd + +lemma P24_of_IH1 (ihxy : IH1 x y) (ha : a ∈ xᴸ) (hb : b ∈ xᴸ) : P24 a b y := + ihxy ha hb (Or.inl rfl) + +lemma mulOption_lt_iff_P1 : + Game.mk (mulOption x y a b) < -Game.mk (mulOption x (-y) c d) ↔ P1 x y a b c (-d) := by + simp [P1, mulOption, sub_eq_add_neg, add_comm] + +lemma mulOption_lt_of_lt [Numeric y] (ihxy : IH1 x y) (ihyx : IH1 y x) {a b c d} (h : a < c) + (ha : a ∈ xᴸ) (hb : b ∈ yᴸ) (hc : c ∈ xᴸ) (hd : d ∈ (-y)ᴸ) : + Game.mk (mulOption x y a b) < -Game.mk (mulOption x (-y) c d) := by + rw [mulOption_lt_iff_P1] + exact P1_of_P3 (P3_of_IH1 ihyx hc hb hd) <| ((P24_of_IH1 ihxy ha hc).2 h).1 b hb + +lemma mulOption_lt [Numeric x] [Numeric y] (ihxy : IH1 x y) (ihyx : IH1 y x) {a b c d} + (ha : a ∈ xᴸ) (hb : b ∈ yᴸ) (hc : c ∈ xᴸ) (hd : d ∈ (-y)ᴸ) : + Game.mk (mulOption x y a b) < -Game.mk (mulOption x (-y) c d) := by + numeric + obtain (h | h | h) := Numeric.lt_or_equiv_or_gt a c + · exact mulOption_lt_of_lt ihxy ihyx h ha hb hc hd + · exact mulOption_lt_iff_P1.2 (P1_of_equiv h (P24_of_IH1 ihxy ha hc).1 + (ihxy ha hc <| .inr ⟨right, by simpa using hd⟩).1 <| P3_of_IH1 ihyx ha hb hd) + · rw [← neg_neg y] at hb + simpa [lt_neg] using mulOption_lt_of_lt (IH1_neg_right ihxy) (IH1_neg_left ihyx) h hc hd ha hb + +/-- `P1` follows from the induction hypothesis. -/ +lemma P1_of_IH (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) [Numeric x] [Numeric y] : + (x * y).Numeric := by + have ihxy := IH1_of_IH IH + have ihyx := IH1_swap_of_IH IH + have ihxyn := IH1_neg_left (IH1_neg_right ihxy) + have ihyxn := IH1_neg_left (IH1_neg_right ihyx) + refine .mk ?_ ?_ + · simp_rw [forall_leftMoves_mul', forall_rightMoves_mul'] + constructor <;> intro a ha b hb <;> constructor <;> intro c hc d hd + · exact mulOption_lt ihxy ihyx ha hb hc hd + · simpa [mulOption_comm, ← mk_lt_mk] using mulOption_lt ihyx ihxy hb ha hd hc + · rw [← neg_neg x] at hc + simpa [mulOption_comm, ← mk_lt_mk] using mulOption_lt ihyxn ihxyn hb ha hd hc + · rw [← neg_neg y] at hd + simpa [← mk_lt_mk] using mulOption_lt ihxyn ihyxn ha hb hc hd + · intro p + simp only [moves_mul, moves_mul, mulOption, Set.mem_image, Prod.exists, + forall_exists_index, and_imp] + rintro _ a b (⟨ha, hb⟩ | ⟨ha, hb⟩) rfl + all_goals + have := numeric_move_mul_of_IH IH ha + have := numeric_mul_move_of_IH IH hb + have := numeric_move_mul_move_of_IH IH ha hb + infer_instance + +/-! ### P2 follows from the inductive hypothesis -/ + +lemma numeric_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : + (x₁ * y).Numeric ∧ (x₂ * y).Numeric := by + constructor <;> refine IH (.P1 ..) (.single ?_) + · exact (cutExpand_add_right {y}).2 <| (cutExpand_add_left {x₁}).2 cutExpand_zero + · exact (cutExpand_add_right {x₂, y}).2 cutExpand_zero + +/-- A specialization of the inductive hypothesis used to prove `P2` and `P4`. -/ +def IH24 (x₁ x₂ y : IGame) : Prop := + ∀ ⦃p z⦄, + (z ∈ x₁.moves p → P24 z x₂ y) ∧ + (z ∈ x₂.moves p → P24 x₁ z y) ∧ + (z ∈ y.moves p → P24 x₁ x₂ z) + +/-- A specialization of the induction hypothesis used to prove `P4`. -/ +def IH4 (x₁ x₂ y : IGame) : Prop := + ∀ ⦃p q z w⦄, w ∈ y.moves p → (z ∈ x₁.moves q → P2 z x₂ w) ∧ (z ∈ x₂.moves q → P2 x₁ z w) + +/-- `IH24 x₁ x₂ y` follows from the inductive hypothesis for `P24 x₁ x₂ y`. -/ +lemma IH24_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : IH24 x₁ x₂ y := by + rw [IH24] + refine fun p z ↦ ⟨?_, ?_, ?_⟩ <;> refine fun h ↦ IH (.P24 ..) (.single ?_) + · exact (cutExpand_add_right {y}).2 (cutExpand_pair_left ⟨p, h⟩) + · exact (cutExpand_add_left {x₁}).2 (cutExpand_pair_left ⟨p, h⟩) + · exact (cutExpand_add_left {x₁}).2 (cutExpand_pair_right ⟨p, h⟩) + +/-- `IH24 x₂ x₁ y` follows from the inductive hypothesis for `P24 x₁ x₂ y`. -/ +lemma IH24_swap_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : IH24 x₂ x₁ y := by + apply IH24_of_IH + convert IH using 2 + dsimp [ArgsRel, InvImage, Multiset.insert_eq_cons, ← Multiset.singleton_add] + abel_nf + +/-- `IH4 x₁ x₂ y` follows from the inductive hypothesis for `P24 x₁ x₂ y`. -/ +lemma IH4_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : IH4 x₁ x₂ y := by + refine fun p q a b h ↦ ⟨?_, ?_⟩ <;> + refine fun h' ↦ (IH (.P24 ..) <| (Relation.TransGen.single ?_).tail <| + (cutExpand_add_left {x₁}).2 <| cutExpand_pair_right ⟨p, h⟩).1 + · exact (cutExpand_add_right {b}).2 <| cutExpand_pair_left ⟨q, h'⟩ + · exact (cutExpand_add_right {b}).2 <| cutExpand_pair_right ⟨q, h'⟩ + +lemma IH24_neg : IH24 x₁ x₂ y → IH24 (-x₂) (-x₁) y ∧ IH24 x₁ x₂ (-y) := by + simp_rw [IH24, P24_neg_right, moves_neg] + refine fun h ↦ ⟨fun p z ↦ ⟨?_, ?_, ?_⟩, + fun p z ↦ ⟨(@h p z).1, (@h p z).2.1, P24_neg_right.1 ∘ (@h (-p) (-z)).2.2⟩⟩ + all_goals + rw [← P24_neg_left] + simp only [neg_neg] + · exact (@h (-p) (-z)).2.1 + · exact (@h (-p) (-z)).1 + · exact (@h p z).2.2 + +lemma IH4_neg : IH4 x₁ x₂ y → IH4 (-x₂) (-x₁) y ∧ IH4 x₁ x₂ (-y) := by + simp_rw [IH4, moves_neg, Set.mem_neg] + refine fun h ↦ ⟨fun p q z w h' ↦ ?_, fun p q z w h' ↦ ?_⟩ + · convert (h h').symm using 2 <;> rw [← P2_neg_left, neg_neg] + · convert h h' using 2 <;> rw [P2_neg_right] + +lemma mulOption_lt_mul_of_equiv [Numeric x₁] (h : IH24 x₁ x₂ y) (he : x₁ ≈ x₂) + (hi : a ∈ x₁ᴸ) (hj : b ∈ yᴸ) : + Game.mk (mulOption x₁ y a b) < Game.mk (x₂ * y) := by + convert sub_lt_iff_lt_add'.2 (((h.1 hi).2 _).1 b hj) using 1 + · rw [← (h.2.2 hj).1 he] + rfl + · grw [← he] + exact Numeric.left_lt hi + +lemma mul_right_le_of_equiv [Numeric x₁] [Numeric x₂] + (ih₁₂ : IH24 x₁ x₂ y) (ih₂₁ : IH24 x₂ x₁ y) (he : x₁ ≈ x₂) : x₁ * y ≤ x₂ * y := by + have he' := neg_equiv_neg_iff.2 he + rw [IGame.le_iff_forall_lf] + simp_rw [← Game.mk_le_mk] + constructor + · rw [forall_leftMoves_mul'] + constructor <;> intro a ha b hb + · exact (mulOption_lt_mul_of_equiv ih₁₂ he ha hb).not_ge + · simpa using (mulOption_lt_mul_of_equiv (IH24_neg <| (IH24_neg ih₂₁).1).2 he' ha hb).not_ge + · rw [forall_rightMoves_mul'] + constructor <;> intro a ha b hb + · simpa [neg_le] using (mulOption_lt_mul_of_equiv (IH24_neg ih₂₁).2 he.symm ha hb).not_ge + · simpa [neg_le] using (mulOption_lt_mul_of_equiv (IH24_neg ih₁₂).1 he'.symm ha hb).not_ge + +/-- `P2` follows from the induction hypothesis. -/ +lemma P2_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) [Numeric x₁] [Numeric x₂] + (he : x₁ ≈ x₂) : x₁ * y ≈ x₂ * y := + ⟨mul_right_le_of_equiv (IH24_of_IH IH) (IH24_swap_of_IH IH) he, + mul_right_le_of_equiv (IH24_swap_of_IH IH) (IH24_of_IH IH) he.symm⟩ + +/-! ### P4 follows from the inductive hypothesis -/ + +lemma mulOption_lt_mul_iff_P3 : mulOption x y a b < x * y ↔ P3 a x b y := + @sub_lt_iff_lt_add' Game _ _ _ (.mk _) (.mk _) (.mk _) + +/-- A specialization of the induction hypothesis used to prove `P3`. -/ +def IH3 (x₁ x' x₂ y₁ y₂ : IGame) : Prop := + P2 x₁ x' y₁ ∧ P2 x₁ x' y₂ ∧ P3 x' x₂ y₁ y₂ ∧ (x₁ < x' → P3 x₁ x' y₁ y₂) + +/-- `IH3` follows from the induction hypothesis for `P24 x₁ x₂ y`. -/ +lemma IH3_of_IH (ih24 : IH24 x₁ x₂ y) (ih4 : IH4 x₁ x₂ y) + (hi : a ∈ x₂ᴸ) (hb : b ∈ yᴸ) (hl : mulOption x₂ y a b < x₂ * y) : + IH3 x₁ a x₂ b y := + have h24 := ih24.2.1 hi + ⟨(ih4 hb).2 hi, h24.1, + mulOption_lt_mul_iff_P3.1 hl, fun l ↦ (h24.2 l).1 b hb⟩ + +lemma P3_of_le_left {y₁ y₂} (i) (h : IH3 x₁ i x₂ y₁ y₂) (hl : x₁ ≤ i) : P3 x₁ x₂ y₁ y₂ := by + obtain (hl | he) := le_iff_lt_or_antisymmRel.1 hl + · exact (h.2.2.2 hl).trans h.2.2.1 + · rw [P3, h.1 he, h.2.1 he] + exact h.2.2.1 + +/-- P3 follows from `IH3`, so P4 (with `y₁` a left option of `y₂`) follows from the induction +hypothesis. -/ +lemma P3_of_IH3 {y₁ y₂} (h : ∀ i ∈ x₂ᴸ, IH3 x₁ i x₂ y₁ y₂) + (hs : ∀ i ∈ (-x₁)ᴸ, IH3 (-x₂) i (-x₁) y₁ y₂) (hl : x₁ < x₂) : P3 x₁ x₂ y₁ y₂ := by + obtain (⟨i, hi, hi'⟩ | ⟨i, hi, hi'⟩) := lf_iff_exists_le.1 hl.not_ge + · exact P3_of_le_left i (h i hi) hi' + · refine P3_neg.1 <| P3_of_le_left _ (hs (-i) ?_) ?_ <;> simpa + +/-- `P4` follows from the induction hypothesis. -/ +lemma P4_of_IH (IH : ∀ a, ArgsRel a (.P24 x₁ x₂ y) → P124 a) : P4 x₁ x₂ y := by + have h₁₂ := IH24_of_IH IH + have h4 := IH4_of_IH IH + obtain ⟨h₁₂x, h₁₂y⟩ := IH24_neg h₁₂ + obtain ⟨h4x, h4y⟩ := IH4_neg h4 + have := (IH24_neg h₁₂y).1 + have := (IH4_neg h4y).1 + obtain ⟨hn₁, hn₂⟩ := numeric_of_IH IH + have : (-x₁ * y).Numeric := by simpa + have : (-x₁ * -y).Numeric := by simpa + have : (x₂ * -y).Numeric := by simpa + refine fun hl ↦ ⟨?_, ?_⟩ <;> + refine fun a ha ↦ P3_of_IH3 ?_ ?_ hl <;> + intro b hb <;> + apply IH3_of_IH + assumption' + all_goals + exact Numeric.left_lt (mulOption_mem_moves_mul hb ha) + +/-- We tie everything together to complete the induction. -/ +theorem main (a : Args) : a.Numeric → P124 a := by + apply argsRel_wf.induction a + intro a IH ha + replace ih : ∀ a', ArgsRel a' a → P124 a' := fun a' hr ↦ IH a' hr (hr.numeric_closed ha) + cases a with + | P1 x y => + obtain ⟨_, _⟩ := Args.numeric_P1.1 ha + exact P1_of_IH ih + | P24 x₁ x₂ y => + obtain ⟨_, _, _⟩ := Args.numeric_P24.1 ha + constructor + · exact (Game.mk_eq <| P2_of_IH ih ·) + · exact P4_of_IH ih + +lemma main_P24 (x₁ x₂ y : IGame) [hx₁ : Numeric x₁] [hx₂ : Numeric x₂] [hy : Numeric y] : + P24 x₁ x₂ y := + main _ <| Args.numeric_P24.mpr ⟨hx₁, hx₂, hy⟩ + +/-- One additional inductive argument proves `P3`. -/ +lemma P3_of_lt_of_lt {x₁ x₂ y₁ y₂} [Numeric x₁] [Numeric x₂] [Numeric y₁] [Numeric y₂] + (hx : x₁ < x₂) (hy : y₁ < y₂) : P3 x₁ x₂ y₁ y₂ := by + refine P3_of_IH3 ?_ ?_ hx + all_goals + intro i hi + numeric + refine ⟨(main_P24 ..).1, (main_P24 ..).1, P3_comm.2 ?_, fun h ↦ ?_⟩ + · exact ((main_P24 y₁ y₂ x₂).2 hy).1 _ hi + · exact P3_of_lt_of_lt h hy + · exact ((main_P24 y₁ y₂ x₁).2 hy).2 _ hi + · rw [IGame.neg_lt] at h + rw [← P3_neg, neg_neg] + exact P3_of_lt_of_lt h hy +termination_by (x₁, x₂) +decreasing_by all_goals (try rw [moves_neg] at *); igame_wf + +/-! ### Instances and corollaries -/ + +public section + +namespace IGame.Numeric + +variable {x x₁ x₂ y y₁ y₂ : IGame} + +instance mul (x y : IGame) [hx : Numeric x] [hy : Numeric y] : Numeric (x * y) := + main _ <| Args.numeric_P1.mpr ⟨hx, hy⟩ + +protected instance mulOption (x y a b : IGame) [Numeric x] [Numeric y] [Numeric a] [Numeric b] : + Numeric (mulOption x y a b) := + .sub .. + +theorem mul_congr_left [Numeric x₁] [Numeric x₂] [Numeric y] (he : x₁ ≈ x₂) : x₁ * y ≈ x₂ * y := + Game.mk_eq_mk.1 ((main_P24 ..).1 he) + +theorem mul_congr_right [Numeric x] [Numeric y₁] [Numeric y₂] (he : y₁ ≈ y₂) : x * y₁ ≈ x * y₂ := by + rw [mul_comm, mul_comm x]; exact Numeric.mul_congr_left he + +theorem mul_congr [Numeric x₁] [Numeric x₂] [Numeric y₁] [Numeric y₂] + (hx : x₁ ≈ x₂) (hy : y₁ ≈ y₂) : x₁ * y₁ ≈ x₂ * y₂ := + (mul_congr_left hx).trans (mul_congr_right hy) + +protected theorem mul_pos [Numeric x₁] [Numeric x₂] (h₁ : 0 < x₁) (h₂ : 0 < x₂) : 0 < x₁ * x₂ := by + simpa [P3, ← mk_lt_mk] using P3_of_lt_of_lt h₁ h₂ + +end IGame.Numeric + +namespace Surreal + +noncomputable instance : CommRing Surreal where + mul := Quotient.map₂ (fun a b ↦ ⟨a.1 * b.1, inferInstance⟩) fun _ _ h _ _ ↦ Numeric.mul_congr h + zero_mul := by rintro ⟨x⟩; change mk (0 * x) = mk 0; simp_rw [zero_mul] + mul_zero := by rintro ⟨x⟩; change mk (x * 0) = mk 0; simp_rw [mul_zero] + one_mul := by rintro ⟨x⟩; change mk (1 * x) = mk x; simp_rw [one_mul] + mul_one := by rintro ⟨x⟩; change mk (x * 1) = mk x; simp_rw [mul_one] + left_distrib := by rintro ⟨x⟩ ⟨y⟩ ⟨z⟩; exact mk_eq (mul_add_equiv ..) + right_distrib := by rintro ⟨x⟩ ⟨y⟩ ⟨z⟩; exact mk_eq (add_mul_equiv ..) + mul_comm := by rintro ⟨x⟩ ⟨y⟩; change mk (x * y) = mk (y * x); simp_rw [mul_comm] + mul_assoc := by rintro ⟨x⟩ ⟨y⟩ ⟨z⟩; exact mk_eq (mul_assoc_equiv ..) + +instance : IsStrictOrderedRing Surreal := + .of_mul_pos (by rintro ⟨x⟩ ⟨y⟩; exact Numeric.mul_pos) + +@[simp] +theorem mk_mul (x y : IGame) [Numeric x] [Numeric y] : + Surreal.mk (x * y) = Surreal.mk x * Surreal.mk y := + rfl + +end Surreal + +namespace IGame.Numeric + +protected theorem mul_neg_of_pos_of_neg {x y : IGame} [Numeric x] [Numeric y] + (hx : 0 < x) (hy : y < 0) : x * y < 0 := + @mul_neg_of_pos_of_neg Surreal _ (.mk x) (.mk y) _ _ hx hy + +protected theorem mul_neg_of_neg_of_pos {x y : IGame} [Numeric x] [Numeric y] + (hx : x < 0) (hy : 0 < y) : x * y < 0 := + @mul_neg_of_neg_of_pos Surreal _ (.mk x) (.mk y) _ _ hx hy + +protected theorem mul_pos_of_neg_of_neg {x y : IGame} [Numeric x] [Numeric y] + (hx : x < 0) (hy : y < 0) : 0 < x * y := + @mul_pos_of_neg_of_neg Surreal _ _ _ _ _ _ (.mk x) (.mk y) hx hy + +protected theorem mul_nonneg {x y : IGame} [Numeric x] [Numeric y] + (hx : 0 ≤ x) (hy : 0 ≤ y) : 0 ≤ x * y := + @mul_nonneg Surreal _ (.mk x) (.mk y) _ _ hx hy + +protected theorem mul_nonpos_of_nonneg_of_nonpos {x y : IGame} [Numeric x] [Numeric y] + (hx : 0 ≤ x) (hy : y ≤ 0) : x * y ≤ 0 := + @mul_nonpos_of_nonneg_of_nonpos Surreal _ (.mk x) (.mk y) _ _ hx hy + +protected theorem mul_nonpos_of_nonpos_of_nonneg {x y : IGame} [Numeric x] [Numeric y] + (hx : x ≤ 0) (hy : 0 ≤ y) : x * y ≤ 0 := + @mul_nonpos_of_nonpos_of_nonneg Surreal _ (.mk x) (.mk y) _ _ hx hy + +protected theorem mul_nonneg_of_nonpos_of_nonpos {x y : IGame} [Numeric x] [Numeric y] + (hx : x ≤ 0) (hy : y ≤ 0) : 0 ≤ x * y := + @mul_nonneg_of_nonpos_of_nonpos Surreal _ _ (.mk x) (.mk y) _ _ _ _ hx hy + +protected theorem mul_left_cancel {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hx : ¬ x ≈ 0) (h : x * y ≈ x * z) : y ≈ z := by + rw [← Surreal.mk_eq_mk] at * + exact mul_left_cancel₀ hx h + +protected theorem mul_right_cancel {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hx : ¬ x ≈ 0) (h : y * x ≈ z * x) : y ≈ z := by + rw [← Surreal.mk_eq_mk] at * + exact mul_right_cancel₀ hx h + +@[simp] +protected theorem mul_le_mul_iff_left {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hx : 0 < x) : y * x ≤ z * x ↔ y ≤ z := + mul_le_mul_iff_left₀ (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hx + +@[simp] +protected theorem mul_le_mul_iff_right {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hx : 0 < x) : x * y ≤ x * z ↔ y ≤ z := + mul_le_mul_iff_right₀ (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hx + +@[simp] +protected theorem mul_lt_mul_iff_left {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hx : 0 < x) : y * x < z * x ↔ y < z := + mul_lt_mul_iff_left₀ (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hx + +@[simp] +protected theorem mul_lt_mul_iff_right {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hx : 0 < x) : x * y < x * z ↔ y < z := + mul_lt_mul_iff_right₀ (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hx + +@[simp] +protected theorem mul_le_mul_left_of_neg {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hz : z < 0) : z * x ≤ z * y ↔ y ≤ x := + mul_le_mul_left_of_neg (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hz + +@[simp] +protected theorem mul_le_mul_right_of_neg {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hz : z < 0) : x * z ≤ y * z ↔ y ≤ x := + mul_le_mul_right_of_neg (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hz + +@[simp] +protected theorem mul_lt_mul_left_of_neg {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hz : z < 0) : z * x < z * y ↔ y < x := + mul_lt_mul_left_of_neg (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hz + +@[simp] +protected theorem mul_lt_mul_right_of_neg {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] + (hz : z < 0) : x * z < y * z ↔ y < x := + mul_lt_mul_right_of_neg (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hz + +protected theorem mul_le_mul {a b c d : IGame} [Numeric a] [Numeric b] [Numeric c] [Numeric d] : + a ≤ b → c ≤ d → 0 ≤ c → 0 ≤ b → a * c ≤ b * d := + mul_le_mul (a := Surreal.mk a) (b := Surreal.mk b) (c := Surreal.mk c) (d := Surreal.mk d) + +protected theorem mul_lt_mul {a b c d : IGame} [Numeric a] [Numeric b] [Numeric c] [Numeric d] : + a < b → c ≤ d → 0 < c → 0 ≤ b → a * c < b * d := + mul_lt_mul (a := Surreal.mk a) (b := Surreal.mk b) (c := Surreal.mk c) (d := Surreal.mk d) + +@[simp] +protected theorem mul_pos_iff_of_pos_left {a b : IGame} [Numeric a] [Numeric b] : + 0 < a → (0 < a * b ↔ 0 < b) := + mul_pos_iff_of_pos_left (a := Surreal.mk a) (b := Surreal.mk b) + +@[simp] +protected theorem mul_pos_iff_of_pos_right {a b : IGame} [Numeric a] [Numeric b] : + 0 < b → (0 < a * b ↔ 0 < a) := + mul_pos_iff_of_pos_right (a := Surreal.mk a) (b := Surreal.mk b) + +theorem mul_equiv_zero {x y : IGame} [Numeric x] [Numeric y] : x * y ≈ 0 ↔ x ≈ 0 ∨ y ≈ 0 := by + repeat rw [← Surreal.mk_eq_mk] + exact @mul_eq_zero Surreal _ _ (.mk x) (.mk y) + +theorem mulOption_congr₁ {x₁ x₂ y a b : IGame} + [Numeric x₁] [Numeric x₂] [Numeric y] [Numeric a] [Numeric b] (he : x₁ ≈ x₂) : + mulOption x₁ y a b ≈ mulOption x₂ y a b := by + simp_all [← Surreal.mk_eq_mk, mulOption] + +theorem mulOption_congr₂ {x y₁ y₂ a b : IGame} + [Numeric x] [Numeric y₁] [Numeric y₂] [Numeric a] [Numeric b] (he : y₁ ≈ y₂) : + mulOption x y₁ a b ≈ mulOption x y₂ a b := by + simp_all [← Surreal.mk_eq_mk, mulOption] + +theorem mulOption_congr₃ {x y a₁ a₂ b : IGame} + [Numeric x] [Numeric y] [Numeric a₁] [Numeric a₂] [Numeric b] (he : a₁ ≈ a₂) : + mulOption x y a₁ b ≈ mulOption x y a₂ b := by + simp_all [← Surreal.mk_eq_mk, mulOption] + +theorem mulOption_congr₄ {x y a b₁ b₂ : IGame} + [Numeric x] [Numeric y] [Numeric a] [Numeric b₁] [Numeric b₂] (he : b₁ ≈ b₂) : + mulOption x y a b₁ ≈ mulOption x y a b₂ := by + simp_all [← Surreal.mk_eq_mk, mulOption] + +end IGame.Numeric +end + + +public noncomputable section + +universe u + +namespace Surreal + +/-- The singleton Conway cut `{x - 1 | x + 1}`. -/ +def singletonIntegerCut (x : Surreal.{u}) : Surreal.{u} := + !{{x - 1} | {x + 1}}' (by + simp only [Set.mem_singleton_iff] + rintro _ rfl _ rfl + simp [sub_eq_add_neg]) + +/-- Conway's cut equation defining an omnific integer. -/ +def IsConwayOmnificInteger (x : Surreal.{u}) : Prop := + x = singletonIntegerCut x + +/-- Conway's refinement conjecture for the concretely defined surreal numbers. -/ +def ConwayConjecture : Prop := + ∀ a b c d : Surreal.{u}, + IsConwayOmnificInteger a → IsConwayOmnificInteger b → + IsConwayOmnificInteger c → IsConwayOmnificInteger d → a * b = c * d → + ∃ e f g h : Surreal.{u}, + IsConwayOmnificInteger e ∧ IsConwayOmnificInteger f ∧ + IsConwayOmnificInteger g ∧ IsConwayOmnificInteger h ∧ + a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h + +end Surreal + +end + +end + +end + +end + +end ConwayRefinement.Standalone.InlineSurreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/OrderedAddGroup.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/OrderedAddGroup.lean new file mode 100644 index 0000000000..d7ff6ead3d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/OrderedAddGroup.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Topology.Algebra.Group.Defs +public import Mathlib.Topology.Order.MonotoneContinuity +import Mathlib.Tactic.Abel + +/-! +# The order topology on a densely ordered additive group + +Addition and negation are continuous for the order topology of a densely ordered abelian group. +The addition proof uses rectangles cut out by an intermediate point, so it does not assume the +continuity that it is constructing. +-/ + +open Set + +universe u + +public section + +namespace ConwayRefinement.Standalone.Hahn + +variable (G : Type u) [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [TopologicalSpace G] [OrderTopology G] [DenselyOrdered G] + +/-- Addition is continuous in the order topology of a densely ordered abelian group. -/ +theorem continuousAdd_of_orderTopology : ContinuousAdd G := by + constructor + apply OrderTopology.continuous_iff.mpr + intro a + constructor + · rw [isOpen_prod_iff] + intro x y hxy + have hxy' : a - y < x := sub_lt_iff_lt_add.mpr hxy + obtain ⟨d, had, hdx⟩ := exists_between hxy' + refine ⟨Ioi d, Ioi (a - d), isOpen_Ioi, isOpen_Ioi, hdx, ?_, ?_⟩ + · change a - d < y + rw [sub_lt_iff_lt_add, add_comm] + exact sub_lt_iff_lt_add.mp had + · rintro ⟨x', y'⟩ ⟨hx', hy'⟩ + calc + a = d + (a - d) := by abel + _ < x' + y' := add_lt_add hx' hy' + · rw [isOpen_prod_iff] + intro x y hxy + have hxy' : x < a - y := lt_sub_iff_add_lt.mpr hxy + obtain ⟨d, hxd, hda⟩ := exists_between hxy' + refine ⟨Iio d, Iio (a - d), isOpen_Iio, isOpen_Iio, hxd, ?_, ?_⟩ + · change y < a - d + rw [lt_sub_iff_add_lt, add_comm] + exact lt_sub_iff_add_lt.mp hda + · rintro ⟨x', y'⟩ ⟨hx', hy'⟩ + calc + x' + y' < d + (a - d) := add_lt_add hx' hy' + _ = a := by abel + +omit [DenselyOrdered G] in +/-- Negation is continuous in the order topology of an ordered abelian group. -/ +theorem continuousNeg_of_orderTopology : ContinuousNeg G := + ⟨(OrderIso.neg G).continuous⟩ + +end ConwayRefinement.Standalone.Hahn diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/SeriesConsequences.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/SeriesConsequences.lean new file mode 100644 index 0000000000..98a0796fa6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/SeriesConsequences.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCD +public import Mathlib.RingTheory.UniqueFactorizationDomain.Basic + +/-! +# What follows from the primality of every series, in Mathlib's vocabulary + +Every theorem below follows from the proposition `SeriesIsPrimal K` using Mathlib alone. + +The consequences are the forms in which the theorem is used or quoted: `K((ℝ^{≤0}))` is +pre-Schreier (Mathlib's `DecompositionMonoid`); every irreducible series is prime; and any two +factorisations of a series into irreducibles agree up to order and units, the two multisets of +factors being related by association. +-/ + +public section + +namespace ConwayRefinement.Standalone.Hahn + +universe u + +variable {K : Type u} [Field K] [CharZero K] + +/-- `K((ℝ^{≤0}))` is pre-Schreier: every element is primal, Mathlib's `DecompositionMonoid`. -/ +theorem decompositionMonoid_of (h : SeriesIsPrimal K) : DecompositionMonoid (nonpos K) := by + exact ⟨h inferInstance⟩ + +/-- Every irreducible series is prime. -/ +theorem prime_of_irreducible_of (h : SeriesIsPrimal K) {a : nonpos K} (hirr : Irreducible a) : + Prime a := by + exact hirr.prime_of_isPrimal (h inferInstance a) + +/-- Unique factorisation: two products of irreducibles that agree up to a unit have the same +factors up to order and association. -/ +theorem factorization_unique_of (h : SeriesIsPrimal K) {f g : Multiset (nonpos K)} + (hf : ∀ x ∈ f, Irreducible x) (hg : ∀ x ∈ g, Irreducible x) + (hfg : Associated f.prod g.prod) : + Multiset.Rel Associated f g := by + exact prime_factors_unique (fun x hx ↦ prime_of_irreducible_of h (hf x hx)) + (fun x hx ↦ prime_of_irreducible_of h (hg x hx)) hfg + +end ConwayRefinement.Standalone.Hahn + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal.lean new file mode 100644 index 0000000000..51fcb2a8dd --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal.lean @@ -0,0 +1,20 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ArchimedeanAssumptions +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Cardinal +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.CutFilling +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RationalTailQuotient +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealArchimedeanStratum +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealModule +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Round +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.SmallDiscrete +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ArchimedeanAssumptions.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ArchimedeanAssumptions.lean new file mode 100644 index 0000000000..c66343446d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ArchimedeanAssumptions.lean @@ -0,0 +1,430 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealModule +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.SmallDiscrete +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ConvexQuotientSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Assumptions +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Leading +public import Mathlib.Algebra.Order.Module.Rat +public import Mathlib.SetTheory.Cardinal.Regular + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# LM24 assumptions `(A1)_σ` and `(A2)_σ` for surreal Archimedean strata + +Every real-linear complement of one open Archimedean ball in the corresponding closed surreal +ball is order-additively isomorphic to `ℝ`. To construct the isomorphism, choose a positive +element `a` of the stratum and send `x` to the standard part of `x / a`. Elements of the stratum +have the same Archimedean class as `a`, so the quotient is finite; disjointness from the open ball +makes the map injective, while real scalar multiples of `a` make it surjective. + +This proves LM24, Proposition 2.4.3 in the exact form needed for assumption `(A1)_σ` in Theorem +9.0.1. The zero class remains a separate disjunct, following Mathlib's convention that it is `⊤`. + +For `(A2)_σ`, every small family in the open ball has a strict upper bound still in the ball. +The bound is the surreal cut above the family and below every `a / n`, where `a` is a positive +representative of `σ`. Consequently the ball has cofinality at least the universe cardinal that +bounds surreal Hahn supports. This is the universe-bounded form of LM24, Proposition 2.4.4. +-/ + +public noncomputable section + +open ArchimedeanClass FiniteArchimedeanClass + +namespace Surreal + +variable (u : HahnEmbedding.ArchimedeanStrata ℝ Surreal) +variable (c : FiniteArchimedeanClass Surreal) + +private noncomputable def stratumNonzeroElement : u.stratum c := + Classical.choose (exists_ne (0 : u.stratum c)) + +private theorem stratumNonzeroElement_ne_zero : stratumNonzeroElement u c ≠ 0 := + Classical.choose_spec (exists_ne (0 : u.stratum c)) + +private noncomputable def stratumPositiveElement : u.stratum c := + |stratumNonzeroElement u c| + +private theorem stratumPositiveElement_pos : 0 < stratumPositiveElement u c := by + rw [stratumPositiveElement, abs_pos] + exact stratumNonzeroElement_ne_zero u c + +private theorem stratumPositiveElement_ne_zero : stratumPositiveElement u c ≠ 0 := + (stratumPositiveElement_pos u c).ne' + +private theorem stratum_mk_div_positiveElement_eq_zero + (x : u.stratum c) (hx : x ≠ 0) : + ArchimedeanClass.mk ((x : Surreal) / stratumPositiveElement u c) = 0 := by + rw [ArchimedeanClass.mk_div, + u.archimedeanClassMk_of_mem_stratum x.property (by simpa using hx), + u.archimedeanClassMk_of_mem_stratum (stratumPositiveElement u c).property + (by simpa using stratumPositiveElement_ne_zero u c)] + exact LinearOrderedAddCommGroupWithTop.sub_self_eq_zero_of_ne_top c.property + +private theorem stratum_mk_div_positiveElement_nonneg (x : u.stratum c) : + 0 ≤ ArchimedeanClass.mk ((x : Surreal) / stratumPositiveElement u c) := by + by_cases hx : x = 0 + · simp [hx] + · rw [stratum_mk_div_positiveElement_eq_zero u c x hx] + +private noncomputable def stratumStdPartHom : u.stratum c →+ ℝ where + toFun x := ArchimedeanClass.stdPart ((x : Surreal) / stratumPositiveElement u c) + map_zero' := by simp + map_add' x y := by + change ArchimedeanClass.stdPart + (((x : Surreal) + (y : Surreal)) / stratumPositiveElement u c) = _ + rw [add_div, ArchimedeanClass.stdPart_add + (stratum_mk_div_positiveElement_nonneg u c x) + (stratum_mk_div_positiveElement_nonneg u c y)] + +private theorem stratumStdPartHom_pos {x : u.stratum c} (hx : 0 < x) : + 0 < stratumStdPartHom u c x := by + have hquotient : 0 < (x : Surreal) / stratumPositiveElement u c := + div_pos (by exact hx) (by exact stratumPositiveElement_pos u c) + have hnonneg : 0 ≤ stratumStdPartHom u c x := + ArchimedeanClass.stdPart_nonneg hquotient.le + refine lt_of_le_of_ne hnonneg ?_ + intro heq + have hzero : stratumStdPartHom u c x = 0 := heq.symm + have hmkne := ArchimedeanClass.stdPart_eq_zero.mp hzero + exact hmkne (stratum_mk_div_positiveElement_eq_zero u c x hx.ne') + +private theorem stratumStdPartHom_strictMono : StrictMono (stratumStdPartHom u c) := by + intro x y hxy + rw [← sub_pos, ← map_sub] + exact stratumStdPartHom_pos u c (sub_pos.mpr hxy) + +private theorem stratumStdPartHom_surjective : + Function.Surjective (stratumStdPartHom u c) := by + intro r + refine ⟨r • stratumPositiveElement u c, ?_⟩ + change ArchimedeanClass.stdPart + (((r : ℝ) : Surreal) * (stratumPositiveElement u c : Surreal) / + (stratumPositiveElement u c : Surreal)) = r + rw [mul_div_cancel_right₀ _ (by simpa using stratumPositiveElement_ne_zero u c)] + exact ArchimedeanClass.stdPart_map_real Real.toSurrealRingHom r + +/-- A nonzero surreal Archimedean stratum is noncanonically isomorphic to `ℝ` as an ordered +additive group. This is LM24, Proposition 2.4.3. -/ +@[blueprint "fact:surreal-archimedean-strata" + (phase := "Surreal numbers and omnific integers") + (title := "Real structure of surreal Archimedean strata") + (statement := /-- + Every nonzero Archimedean stratum of the surreal numbers is noncanonically + isomorphic to $(\mathbb R,+,<)$ as an ordered additive group + \cite[Proposition~2.4.3]{LM24}. + -/) + (proof := /-- + Choose a positive element $a$ of the stratum and send $x$ to the standard + part of $x/a$. Division by $a$ makes the quotient finite; the chosen + complement to the lower Archimedean ball makes the map injective, and the + real multiples of $a$ make it surjective. + -/)] +noncomputable def stratumOrderAddMonoidIsoReal : u.stratum c ≃+o ℝ := + { AddEquiv.ofBijective (stratumStdPartHom u c) + ⟨(stratumStdPartHom_strictMono u c).injective, + stratumStdPartHom_surjective u c⟩ with + map_le_map_iff' := (stratumStdPartHom_strictMono u c).le_iff_le } + +/-- Every nonzero surreal Archimedean class satisfies LM24 assumption `(A1)_σ`. -/ +theorem assumptionA1AtFiniteClass : LM24.AssumptionA1AtFiniteClass u c := by + rw [LM24.assumptionA1AtFiniteClass_iff] + exact ⟨stratumOrderAddMonoidIsoReal u c⟩ + +/-- Every surreal Archimedean class, including the zero class, satisfies LM24 assumption +`(A1)_σ`. -/ +theorem assumptionA1 (σ : ArchimedeanClass Surreal) : LM24.AssumptionA1 u σ := by + rw [LM24.assumptionA1_iff] + by_cases hσ : σ = ⊤ + · exact Or.inl hσ + · exact Or.inr ⟨⟨σ, hσ⟩, by simp, ⟨stratumOrderAddMonoidIsoReal u ⟨σ, hσ⟩⟩⟩ + +/-- A fixed noncanonical family of real-linear complements to the surreal Archimedean balls. -/ +noncomputable def archimedeanStrata : HahnEmbedding.ArchimedeanStrata ℝ Surreal := + Classical.choice inferInstance + +/-- The fixed surreal strata satisfy LM24 assumption `(A1)_σ` at every class. -/ +theorem archimedeanStrata_assumptionA1 (σ : ArchimedeanClass Surreal) : + LM24.AssumptionA1 archimedeanStrata σ := + assumptionA1 archimedeanStrata σ + +/-! ### Assumption `(A2)_σ` -/ + +universe u v + +/-- The inaccessible universe cardinal that bounds supports of `SurrealHahnSeries.{u}`. -/ +def smallSupportCardinal : Cardinal.{u + 1} := + Cardinal.univ.{u, u + 1} + +/-- The surreal small-support cardinal is the universe cardinal. -/ +theorem smallSupportCardinal_eq_univ : + smallSupportCardinal.{u} = Cardinal.univ.{u, u + 1} := + (rfl) + +/-- The surreal small-support cardinal is uncountable. -/ +theorem aleph0_lt_smallSupportCardinal : + Cardinal.aleph0 < smallSupportCardinal.{u} := + Cardinal.aleph0_lt_univ + +/-- The small-support cardinal carries the uncountability instance used by bounded Hahn fields. -/ +instance smallSupportCardinal_aleph0Fact : + Fact (Cardinal.aleph0 < smallSupportCardinal.{u}) := + ⟨aleph0_lt_smallSupportCardinal⟩ + +/-- The surreal small-support cardinal is regular. -/ +theorem smallSupportCardinal_isRegular : + smallSupportCardinal.{u}.IsRegular := + Cardinal.IsInaccessible.univ.isRegular + +/-- The small-support cardinal carries the regularity instance used by bounded splitting. -/ +instance smallSupportCardinal_isRegularFact : + Fact smallSupportCardinal.{u}.IsRegular := + ⟨smallSupportCardinal_isRegular⟩ + +private theorem ball_not_isCofinal_of_small + {a : Surreal.{u}} (ha : 0 < a) + (s : Set ↥(ball ℝ (FiniteArchimedeanClass.mk a ha.ne'))) + [Small.{u} s] : ¬ IsCofinal s := by + let L : Set Surreal.{u} := + {0} ∪ (fun z : ↥(ball ℝ (FiniteArchimedeanClass.mk a ha.ne')) ↦ (z : Surreal)) '' s + let R : Set Surreal.{u} := Set.range fun n : ℕ ↦ ((n + 1 : ℝ)⁻¹) • a + have hLR : ∀ x ∈ L, ∀ y ∈ R, x < y := by + intro x hx y hy + obtain rfl | ⟨z, hz, rfl⟩ := hx + · obtain ⟨n, rfl⟩ := hy + change 0 < ((n + 1 : ℝ)⁻¹) • a + rw [real_smul_def] + exact mul_pos (Real.toSurreal_pos_iff.mpr (inv_pos.mpr (by positivity))) ha + · obtain ⟨n, rfl⟩ := hy + change (z : Surreal) < ((n + 1 : ℝ)⁻¹) • a + by_cases hz0 : (z : Surreal) = 0 + · rw [hz0, real_smul_def] + exact mul_pos (Real.toSurreal_pos_iff.mpr (inv_pos.mpr (by positivity))) ha + have hzclass : + (FiniteArchimedeanClass.mk a ha.ne').val < ArchimedeanClass.mk (z : Surreal) := + (FiniteArchimedeanClass.mem_ball_iff ℝ).mp z.property hz0 + apply ArchimedeanClass.lt_of_mk_lt_mk_of_nonneg + · rw [ArchimedeanClass.mk_smul _ (inv_ne_zero (by positivity))] + exact hzclass + · exact smul_nonneg (inv_nonneg.mpr (by positivity)) ha.le + let y : Surreal.{u} := !{L | R}' hLR + have hypos : 0 < y := + Surreal.lt_ofSets_of_mem_left (show 0 ∈ L by simp [L]) + have hyright (n : ℕ) : y < ((n + 1 : ℝ)⁻¹) • a := + Surreal.ofSets_lt_of_mem_right + (show ((n + 1 : ℝ)⁻¹) • a ∈ R by exact Set.mem_range_self n) + have hyball : y ∈ ball ℝ (FiniteArchimedeanClass.mk a ha.ne') := by + rw [FiniteArchimedeanClass.mem_ball_iff] + intro hy0 + rw [FiniteArchimedeanClass.mk_lt_mk ha.ne' hy0, ArchimedeanClass.mk_lt_mk] + intro n + rw [abs_of_pos hypos, abs_of_pos ha] + obtain rfl | hn := n.eq_zero_or_pos + · simpa using ha + · have hbound := hyright (n - 1) + have hcast : (((n - 1 : ℕ) : ℝ) + 1) = n := by + exact_mod_cast Nat.sub_add_cancel hn + rw [hcast, real_smul_def] at hbound + have hnSurreal : (0 : Surreal) < n := by exact_mod_cast hn + have hmul := mul_lt_mul_of_pos_left hbound hnSurreal + simpa [mul_assoc, hn.ne'] using hmul + rw [not_isCofinal_iff] + exact ⟨⟨y, hyball⟩, fun z hz ↦ by + apply Surreal.lt_ofSets_of_mem_left + exact Set.mem_union_right _ (Set.mem_image_of_mem _ hz)⟩ + +/-- Every nonzero surreal Archimedean ball has cofinality at least the small-support cardinal. +This is the universe-bounded form of LM24, Proposition 2.4.4. -/ +@[blueprint "fact:surreal-archimedean-ball-cofinality" + (phase := "Surreal numbers and omnific integers") + (title := "Cofinality of surreal Archimedean balls") + (statement := /-- + Fix a universe $u$, let $\kappa_u$ be its universe cardinal, and let $c$ be + a nonzero Archimedean class of $\mathbf{No}_u$. The strict Archimedean ball + below $c$ has cofinality at least $\kappa_u$ + \cite[Proposition~2.4.4]{LM24}. + -/) + (proof := /-- + A cofinal subset of cardinality below $\kappa_u$ is $u$-small. Conway's + cut construction gives a surreal number above that subset but still below + every positive rational multiple of a representative of $c$, contradicting + cofinality. + -/)] +theorem smallSupportCardinal_le_ball_cof (c : FiniteArchimedeanClass Surreal.{u}) : + smallSupportCardinal.{u} ≤ Order.cof ↥(ball ℝ c) := by + induction c using FiniteArchimedeanClass.ind with + | mk a ha => + have hc : FiniteArchimedeanClass.mk |a| (abs_ne_zero.mpr ha) = + FiniteArchimedeanClass.mk a ha := by + apply Subtype.ext + exact ArchimedeanClass.mk_abs a + rw [← hc, Order.le_cof_iff] + intro s hs + by_contra hcard + have hsSmall : Small.{u} s := by + rw [Cardinal.small_iff_lift_mk_lt_univ] + simpa [smallSupportCardinal] using (not_le.mp hcard) + letI : Small.{u} s := hsSmall + exact ball_not_isCofinal_of_small (a := |a|) (abs_pos.mpr ha) s hs + +/-- The common tail of a small limit family of surreal Archimedean classes has cofinality at +least the surreal support cardinal. -/ +@[blueprint "lem:surreal-common-tail-cofinality" + (phase := "Surreal numbers and omnific integers") + (title := "Cofinality of common surreal Archimedean tails") + (statement := /-- + Fix a universe $u$, let $\kappa_u$ be its universe cardinal, and let $T$ be + a $u$-small family of nonzero Archimedean classes with no least member in + the magnitude order. The common tail below $T$ has cofinality at least + $\kappa_u$. + -/) + (proof := /-- + If a $u$-small subset were cofinal in the common tail, form a Conway cut + above it and below the positive rational fractions of representatives of + the classes in $T$. The resulting surreal belongs to the common tail but + is above the proposed cofinal subset. + -/)] +theorem smallSupportCardinal_le_tailSubmodule_cof + (T : Set (FiniteArchimedeanClass Surreal.{u})) [Small.{u} T] + (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) : + smallSupportCardinal.{u} ≤ Order.cof ↥(FiniteArchimedeanClass.tailSubmodule ℚ T) := by + rw [Order.le_cof_iff] + intro s hs + by_contra hcard + have hsSmall : Small.{u} s := by + rw [Cardinal.small_iff_lift_mk_lt_univ] + simpa [smallSupportCardinal] using (not_le.mp hcard) + letI : Small.{u} s := hsSmall + let L : Set Surreal.{u} := {0} ∪ + ((↑) : ↥(FiniteArchimedeanClass.tailSubmodule ℚ T) → Surreal.{u}) '' s + let R : Set Surreal.{u} := Set.range fun p : T × ℕ ↦ + ((p.2 + 1 : ℝ)⁻¹) • FiniteArchimedeanClass.positiveRepresentative p.1.1 + have hLR : ∀ x ∈ L, ∀ y ∈ R, x < y := by + intro x hx y hy + obtain rfl | ⟨z, hz, rfl⟩ := hx + · obtain ⟨⟨c, n⟩, rfl⟩ := hy + dsimp only + rw [real_smul_def] + exact mul_pos (Real.toSurreal_pos_iff.mpr (inv_pos.mpr (by positivity))) + (FiniteArchimedeanClass.positiveRepresentative_pos c.1) + · obtain ⟨⟨c, n⟩, rfl⟩ := hy + by_cases hz0 : (z : Surreal) = 0 + · rw [hz0] + dsimp only + rw [real_smul_def] + exact mul_pos (Real.toSurreal_pos_iff.mpr (inv_pos.mpr (by positivity))) + (FiniteArchimedeanClass.positiveRepresentative_pos c.1) + obtain ⟨d, hdT, hcd⟩ := hT c.1 c.2 + have hzTail : (z : Surreal) ∈ FiniteArchimedeanClass.tailKernel T := by + exact (FiniteArchimedeanClass.mem_tailSubmodule_iff (K := ℚ)).mp z.2 + have hdz : d.1 ≤ ArchimedeanClass.mk (z : Surreal) := + FiniteArchimedeanClass.mem_tailKernel_iff.mp hzTail ⟨d, hdT⟩ + have hcz : c.1.1 < ArchimedeanClass.mk (z : Surreal) := + (show c.1.1 < d.1 from hcd).trans_le hdz + rcases le_total (z : Surreal) 0 with hzneg | hznonneg + · dsimp only + rw [real_smul_def] + exact hzneg.trans_lt (mul_pos + (Real.toSurreal_pos_iff.mpr (inv_pos.mpr (by positivity))) + (FiniteArchimedeanClass.positiveRepresentative_pos c.1)) + · apply ArchimedeanClass.lt_of_mk_lt_mk_of_nonneg + · dsimp only + rw [ArchimedeanClass.mk_smul _ (inv_ne_zero (by positivity)), + FiniteArchimedeanClass.mk_positiveRepresentative] + exact hcz + · exact smul_nonneg (inv_nonneg.mpr (by positivity)) + (FiniteArchimedeanClass.positiveRepresentative_pos c.1).le + let y : Surreal.{u} := !{L | R}' hLR + have hypos : 0 < y := Surreal.lt_ofSets_of_mem_left (show 0 ∈ L by simp [L]) + have hyright (c : T) (n : ℕ) : + y < ((n + 1 : ℝ)⁻¹) • FiniteArchimedeanClass.positiveRepresentative c.1 := + Surreal.ofSets_lt_of_mem_right + (show ((n + 1 : ℝ)⁻¹) • FiniteArchimedeanClass.positiveRepresentative c.1 ∈ R by + exact Set.mem_range_self (c, n)) + have hyTail : y ∈ FiniteArchimedeanClass.tailSubmodule ℚ T := by + rw [FiniteArchimedeanClass.mem_tailSubmodule_iff, + FiniteArchimedeanClass.mem_tailKernel_iff] + intro c + obtain ⟨d, hdT, hcd⟩ := hT c.1 c.2 + apply (show c.1.1 < d.1 from hcd).le.trans + rw [← FiniteArchimedeanClass.mk_positiveRepresentative d] + rw [ArchimedeanClass.mk_le_mk] + refine ⟨1, ?_⟩ + rw [abs_of_pos (FiniteArchimedeanClass.positiveRepresentative_pos d), abs_of_pos hypos] + simpa using (hyright ⟨d, hdT⟩ 0).le + exact (not_isCofinal_iff.mpr ⟨⟨y, hyTail⟩, fun z hz ↦ by + apply Surreal.lt_ofSets_of_mem_left + exact Set.mem_union_right _ (Set.mem_image_of_mem _ hz)⟩) hs + +/-- The bounded integer part on a surreal common tail generates its whole bounded Hahn field. -/ +@[blueprint "thm:surreal-common-tail-integer-part-fraction-field" + (phase := "Surreal numbers and omnific integers") + (title := "Fraction fields of surreal common-tail integer parts") + (statement := /-- + Let $T$ be a $u$-small family of nonzero Archimedean classes of + $\mathbf{No}_u$ with no least member in the magnitude order, and let $H_T$ + be the common tail below $T$. For every field $R$ and subring + $Z\subseteq R$, the bounded Hahn field $R((H_T))_{\kappa_u}$ is the + fraction field of $Z+R((H_T^{<0}))_{\kappa_u}$. + -/) + (proof := /-- + By \ref{lem:surreal-common-tail-cofinality}, + $\kappa_u\leq\operatorname{cof}(H_T)$. Therefore + \ref{thm:bounded-hahn-integer-part-fraction-field} applies to $H_T$. + -/)] +theorem fracSubring_cardSuppLTTruncationIntegerPart_tailSubmodule_eq_top + {R : Type v} [Field R] (Z : Subring R) + (T : Set (FiniteArchimedeanClass Surreal.{u})) [Small.{u} T] + (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) : + Subring.fracSubring (HahnSeries.cardSuppLTTruncationIntegerPart + (G := FiniteArchimedeanClass.tailSubmodule ℚ T) (R := R) + (κ := smallSupportCardinal.{u}) Z) = ⊤ := + HahnSeries.fracSubring_cardSuppLTTruncationIntegerPart_eq_top_of_le_cof Z + (smallSupportCardinal_le_tailSubmodule_cof T hT) + +/-- Every nonzero surreal Archimedean class satisfies LM24 assumption `(A2)_σ` at the cardinal +that bounds surreal Hahn supports. -/ +theorem assumptionA2AtFiniteClass + {R : Type v} [Field R] (Z : Subring R) + (c : FiniteArchimedeanClass Surreal.{u}) : + LM24.AssumptionA2AtFiniteClass (K := ℝ) smallSupportCardinal.{u} Z c := by + rw [LM24.assumptionA2AtFiniteClass_iff] + exact Or.inl (smallSupportCardinal_le_ball_cof c) + +/-- Every surreal Archimedean class, including the zero class, satisfies LM24 assumption +`(A2)_σ` at the cardinal that bounds surreal Hahn supports. -/ +theorem assumptionA2 + {R : Type v} [Field R] (Z : Subring R) (σ : ArchimedeanClass Surreal.{u}) : + LM24.AssumptionA2 smallSupportCardinal.{u} Z σ := by + rw [LM24.assumptionA2_iff] + by_cases hσ : σ = ⊤ + · exact Or.inr (Or.inr hσ) + · let c : FiniteArchimedeanClass Surreal := ⟨σ, hσ⟩ + have hball : (ball ℝ c : Set Surreal) = σ.ballAddSubgroup := by + change ((ball ℝ c).toAddSubgroup : Set Surreal) = σ.ballAddSubgroup + rw [FiniteArchimedeanClass.toAddSubgroup_ball] + ext x + rw [SetLike.mem_coe, SetLike.mem_coe, + FiniteArchimedeanClass.mem_ballAddSubgroup_iff, + ArchimedeanClass.mem_ballAddSubgroup_iff hσ] + by_cases hx : x = 0 + · subst x + constructor + · intro _ + exact lt_top_iff_ne_top.mpr hσ + · intro _ hzero + exact (hzero rfl).elim + · exact ⟨fun h ↦ h hx, fun h _ ↦ h⟩ + let e : ↥(ball ℝ c) ≃o ↥σ.ballAddSubgroup := + OrderIso.setCongr _ _ hball + exact Or.inl (by + rw [← e.cof_congr] + exact smallSupportCardinal_le_ball_cof c) + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Cardinal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Cardinal.lean new file mode 100644 index 0000000000..4a056a16b0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Cardinal.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Basic +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Ordinal +public import Mathlib.SetTheory.Ordinal.Family +public import Mathlib.Logic.Small.Defs + +/-! +# The size of surreal numbers + +The surreal numbers with option sets in universe `u` do not admit an equivalent type in universe +`u`. They contain an injective image of all ordinals in that universe. This certifies the size of +the values, not merely the size of their representations. + +This result is relative to the option-set universe. It does not construct a set-theoretic class +model or identify models across universe levels. +-/ + +universe u + +public section + +namespace Surreal + +/-- Surreal numbers with option sets in universe `u` are not `u`-small. -/ +theorem not_small : ¬Small.{u} Surreal.{u} := by + intro h + letI : Small.{u} Surreal.{u} := h + exact not_injective_of_ordinal (fun o : Ordinal.{u} ↦ (NatOrdinal.of o).toSurreal) + (NatOrdinal.toSurreal.injective.comp NatOrdinal.of.injective) + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/CutFilling.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/CutFilling.lean new file mode 100644 index 0000000000..26bfa023de --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/CutFilling.lean @@ -0,0 +1,125 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Basic +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Division +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ConvexQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CoinitialComplete + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# The surreals fill cuts between small families + +Between any two small families of surreals separated by the order there is a surreal, namely the +one born from those families as its option sets. This is the simplicity theorem in the form the +completeness criterion of `ConwayRefinement.Topology.Order.CoinitialComplete` +consumes, and it is restricted to *small* families for the reason that makes the restriction +essential rather than +technical: a surreal has a set of options, so no construction reaches across a family the size of +the ordinals. + +That restriction is exactly why the surreals themselves are not Cauchy complete — the positive +surreals have no small coinitial family, so a Cauchy filter can outrun every small cut — and why +the route to a complete group runs through a quotient. `FillsCuts.of_surjective` carries the +conclusion below to such a quotient; supplying the small coinitial family there is separate work. +-/ + +universe u + +public section + +namespace Surreal + +/-- **The simplicity theorem for small cuts.** Two small sets of surreals with every member of the +first below every member of the second are strictly separated by a surreal. -/ +@[blueprint "thm:surreal-simplicity-small-cuts" + (phase := "Surreal numbers and omnific integers") + (title := "The simplicity theorem for small cuts") + (statement := /-- + Let $L,R\subseteq\mathbf{No}_u$ be small sets. If $l`, because its exponent is the exponent of +`ω`, rather than the exponent of LM24's variable `t = ω⁻¹`. Its upstream `length` is therefore +the ordinary order type relevant to LM24 after this sign reversal. It also uses `Shrink` to place +the order type in `Ordinal.{u}`; `SurrealHahnSeries.type_support` identifies its lift with the +unrestricted order type of the support in `Ordinal.{u+1}`. + +This file defines degree from that already validated order type. The explicit finite-support +theorem below checks that the universe lowering preserves the source's zero-degree convention. +-/ + +universe u + +public noncomputable section + +namespace SurrealHahnSeries + +open Ordinal + +/-- `deg(ot(b))`, the Cantor degree of `ot(b)`, the order type of the support of a surreal Hahn +series `b` (the upstream `length`); the value at zero is `⊥`. -/ +def supportDegree (x : SurrealHahnSeries.{u}) : WithBot NatOrdinal.{u} := + Ordinal.cantorDegree x.length + +/-- Degree is the leading Cantor exponent of the small support order type. -/ +theorem supportDegree_eq_cantorDegree (x : SurrealHahnSeries.{u}) : + supportDegree x = Ordinal.cantorDegree x.length := + (rfl) + +@[simp] +theorem supportDegree_eq_bot {x : SurrealHahnSeries.{u}} : supportDegree x = ⊥ ↔ x = 0 := by + rw [supportDegree, Ordinal.cantorDegree_eq_bot, length_eq_zero] + +@[simp] +theorem supportDegree_zero : supportDegree (0 : SurrealHahnSeries.{u}) = ⊥ := + supportDegree_eq_bot.mpr rfl + +/-- A surreal Hahn series has finite support exactly when its small order type is below `ω`. -/ +theorem support_finite_iff_length_lt_omega {x : SurrealHahnSeries.{u}} : + x.support.Finite ↔ x.length < (Ordinal.omega0 : Ordinal.{u}) := by + rw [Set.Finite, ← Cardinal.mk_lt_aleph0_iff] + rw [← Ordinal.card_type (· > ·), type_support, Ordinal.card_lt_aleph0] + rw [← (Ordinal.lift_omega0 : + Ordinal.lift.{u + 1, u} (Ordinal.omega0 : Ordinal.{u}) = Ordinal.omega0), + Ordinal.lift_lt] + +/-- Degree zero is equivalent to nonzero finite support. -/ +@[simp] +theorem supportDegree_eq_zero {x : SurrealHahnSeries.{u}} : + supportDegree x = (0 : WithBot NatOrdinal) ↔ x ≠ 0 ∧ x.support.Finite := by + rw [supportDegree, Ordinal.cantorDegree_eq_zero] + constructor + · rintro ⟨hlength, hlt⟩ + exact ⟨length_eq_zero.not.mp hlength, support_finite_iff_length_lt_omega.mpr hlt⟩ + · rintro ⟨hx, hfinite⟩ + exact ⟨length_eq_zero.not.mpr hx, support_finite_iff_length_lt_omega.mp hfinite⟩ + +/-- This is LM24's maximum characterization of degree in the small support universe. -/ +theorem coe_le_supportDegree_iff {x : SurrealHahnSeries.{u}} {a : Ordinal.{u}} (hx : x ≠ 0) : + (NatOrdinal.of a : WithBot NatOrdinal) ≤ supportDegree x ↔ ω ^ a ≤ x.length := by + exact Ordinal.coe_le_cantorDegree_iff (length_eq_zero.not.mpr hx) + +end SurrealHahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/DegreeTransfer.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/DegreeTransfer.lean new file mode 100644 index 0000000000..d8b12ac916 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/DegreeTransfer.lean @@ -0,0 +1,99 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Full +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Degree + +import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Degree + +/-! +# Degree of Conway normal forms in the full Hahn field + +This module identifies the support order type used by LM24 with `ot(b)`, the order type of the +support of a Conway normal form `b` (the upstream `length`). The full Hahn exponent is +`Surrealᵒᵈ`, so its increasing support order is exactly the decreasing Conway-exponent order. The +only universe adjustment is the lift already recorded by `SurrealHahnSeries.type_support`. + +Consequently, the surreal degree is the Cantor degree of the support order type of the full Hahn +image — the finite-degree paper's extension of LM24's degree to Conway's series, not a notion of +LM24 (Remark 3.4.4). It lies below `ω` exactly when the support order type of the normal form lies +below `ω ^ ω`, which is how the omnific-integer theorem states its hypothesis. +-/ + +universe u + +public noncomputable section + +namespace Surreal + +private def fullSupportRelIso (x : Surreal.{u}) : + Subrel (fun a b : Surrealᵒᵈ ↦ a < b) (· ∈ x.toFullHahnSeries.support) ≃r + (fun a b : x.toHahnSeries.support ↦ a > b) where + toFun i := ⟨i.1.ofDual, by + simpa only [support_toHahnSeries] using + mem_support_toFullHahnSeries.mp i.2⟩ + invFun i := ⟨OrderDual.toDual i.1, by + apply mem_support_toFullHahnSeries.mpr + simpa only [OrderDual.ofDual_toDual, support_toHahnSeries] using i.2⟩ + left_inv i := by + apply Subtype.ext + simp + right_inv i := by + apply Subtype.ext + simp + map_rel_iff' := by + intro i j + rfl + +/-- The full Hahn support order type is the lift of `ot(b)`, the order type of the support of the +Conway normal form. -/ +theorem supportOrderType_toFullHahnSeries (x : Surreal.{u}) : + x.toFullHahnSeries.supportOrderType = + Ordinal.lift.{u + 1, u} x.length := by + rw [HahnSeries.supportOrderType_eq_type_of_relIso (fullSupportRelIso x)] + rw [← length_toHahnSeries] + exact SurrealHahnSeries.type_support x.toHahnSeries + +/-- `deg(ot(b))`, the Cantor degree of `ot(b)`, the order type of the support of the Conway normal +form of a surreal `b`, lifted one universe. -/ +def supportDegree (x : Surreal.{u}) : WithBot NatOrdinal.{u + 1} := + Ordinal.cantorDegree (Ordinal.lift.{u + 1, u} x.length) + +/-- Surreal degree is the Cantor degree of the lifted `ot(b)`. -/ +theorem supportDegree_eq_cantorDegree_lift_length (x : Surreal.{u}) : + x.supportDegree = Ordinal.cantorDegree (Ordinal.lift.{u + 1, u} x.length) := + (rfl) + +/-- Passing to the full Conway Hahn series preserves degree exactly. -/ +@[simp] +theorem supportDegree_toFullHahnSeries (x : Surreal.{u}) : + x.toFullHahnSeries.degree = x.supportDegree := by + rw [HahnSeries.degree_eq_cantorDegree, + supportOrderType_toFullHahnSeries, supportDegree_eq_cantorDegree_lift_length] + +/-- A surreal has bottom degree exactly when it is zero. -/ +@[simp] +theorem supportDegree_eq_bot {x : Surreal.{u}} : x.supportDegree = ⊥ ↔ x = 0 := by + rw [← supportDegree_toFullHahnSeries, HahnSeries.degree_eq_bot] + constructor + · intro hx + apply toFullHahnSeries_injective + rw [hx, toFullHahnSeries_zero] + · rintro rfl + exact toFullHahnSeries_zero + +/-- A Conway normal form `b` has degree below `ω` exactly when `ot(b)`, the order type of its +support, lies below `ω ^ ω`. -/ +theorem supportDegree_lt_omega_iff_length_lt_omega0_opow_omega0 (x : Surreal.{u}) : + x.supportDegree < (NatOrdinal.of Ordinal.omega0 : WithBot NatOrdinal) ↔ + x.length < Ordinal.omega0 ^ Ordinal.omega0 := by + rw [← supportDegree_toFullHahnSeries, HahnSeries.degree_lt_coe_iff_supportOrderType_lt_wpow, + supportOrderType_toFullHahnSeries, NatOrdinal.val_wpow, NatOrdinal.val_of, + ← Ordinal.lift_omega0_opow_omega0.{u + 1, u}, Ordinal.lift_lt] + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Full.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Full.lean new file mode 100644 index 0000000000..efc81e2939 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Full.lean @@ -0,0 +1,245 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.RingTheory.HahnSeries.Multiplication +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormMul + +import all LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic + +/-! +# Conway normal forms in the full Hahn field + +The Conway coefficients of a surreal number determine a Hahn series in +`ℝ⟦Surrealᵒᵈ⟧`. The order dual implements LM24's change from Conway's monomial `ω` to +`t = ω⁻¹`: nonnegative Conway exponents become nonpositive Hahn exponents. + +This map preserves the full ring structure. +-/ + +universe u + +public noncomputable section + +namespace Surreal + +/-- The full Hahn series with the Conway coefficients of a surreal number. -/ +def toFullHahnSeries (x : Surreal.{u}) : HahnSeries Surrealᵒᵈ ℝ where + coeff i := x.coeff i.ofDual + isPWO_support' := by + rw [Set.isPWO_iff_isWF] + apply Set.WellFoundedOn.mapsTo (fun i : Surrealᵒᵈ ↦ i.ofDual) _ + x.wellFoundedOn_support + intro i hi + rw [mem_support_iff] + exact hi + +/-- Evaluation of the full Conway Hahn series. -/ +@[simp] +theorem coeff_toFullHahnSeries (x : Surreal.{u}) (i : Surrealᵒᵈ) : + x.toFullHahnSeries.coeff i = x.coeff i.ofDual := + (rfl) + +/-- The support of the full Conway Hahn series is the order dual of the Conway support. -/ +theorem mem_support_toFullHahnSeries {x : Surreal.{u}} {i : Surrealᵒᵈ} : + i ∈ x.toFullHahnSeries.support ↔ i.ofDual ∈ x.support := by + rw [HahnSeries.mem_support x.toFullHahnSeries i, coeff_toFullHahnSeries, + mem_support_iff] + +/-- The full Conway Hahn-series map sends zero to zero. -/ +@[simp] +theorem toFullHahnSeries_zero : (0 : Surreal.{u}).toFullHahnSeries = 0 := by + ext i + rw [coeff_toFullHahnSeries, HahnSeries.coeff_zero] + exact congrFun coeff_zero i.ofDual + +/-- The full Conway Hahn-series map preserves addition. -/ +@[simp] +theorem toFullHahnSeries_add (x y : Surreal.{u}) : + (x + y).toFullHahnSeries = x.toFullHahnSeries + y.toFullHahnSeries := by + ext i + rw [coeff_toFullHahnSeries, HahnSeries.coeff_add, coeff_toFullHahnSeries, + coeff_toFullHahnSeries] + exact congrFun (coeff_add x y) i.ofDual + +/-- The full Conway Hahn-series map preserves negation. -/ +@[simp] +theorem toFullHahnSeries_neg (x : Surreal.{u}) : + (-x).toFullHahnSeries = -x.toFullHahnSeries := by + ext i + rw [coeff_toFullHahnSeries, HahnSeries.coeff_neg, coeff_toFullHahnSeries] + exact congrFun (coeff_neg x) i.ofDual + +/-- The full Conway Hahn-series map as an additive homomorphism. -/ +def toFullHahnSeriesAddMonoidHom : + Surreal.{u} →+ HahnSeries Surrealᵒᵈ ℝ where + toFun := toFullHahnSeries + map_zero' := toFullHahnSeries_zero + map_add' := toFullHahnSeries_add + +/-- Evaluation of the additive full Conway Hahn-series homomorphism. -/ +@[simp] +theorem toFullHahnSeriesAddMonoidHom_apply (x : Surreal.{u}) : + toFullHahnSeriesAddMonoidHom x = x.toFullHahnSeries := + (rfl) + +/-- The additive full Conway Hahn-series map is injective. -/ +theorem toFullHahnSeries_injective : + Function.Injective (toFullHahnSeries : Surreal.{u} → HahnSeries Surrealᵒᵈ ℝ) := by + intro x y hxy + rw [← toHahnSeries_inj] + apply SurrealHahnSeries.ext + funext i + have hcoeff := congrArg (fun q : HahnSeries Surrealᵒᵈ ℝ ↦ + q.coeff (OrderDual.toDual i)) hxy + simpa only [coeff_toFullHahnSeries, OrderDual.ofDual_toDual, + coeff_toHahnSeries] using hcoeff + +private theorem toFullHahnSeries_eq_ofLex_toHahnSeries (x : Surreal.{u}) : + x.toFullHahnSeries = ofLex x.toHahnSeries.1 := by + ext i + rw [coeff_toFullHahnSeries, ← coeff_toHahnSeries] + rfl + +private theorem ofLex_coe_mul (x y : SurrealHahnSeries.{u}) : + ofLex (x * y).1 = ofLex x.1 * ofLex y.1 := by + with_unfolding_all rfl + +/-- The full Conway Hahn-series map preserves arbitrary surreal products. -/ +@[simp] +theorem toFullHahnSeries_mul (x y : Surreal.{u}) : + (x * y).toFullHahnSeries = x.toFullHahnSeries * y.toFullHahnSeries := by + calc + (x * y).toFullHahnSeries = ofLex (x * y).toHahnSeries.1 := + toFullHahnSeries_eq_ofLex_toHahnSeries (x * y) + _ = ofLex (x.toHahnSeries * y.toHahnSeries).1 := by + rw [toHahnSeries_mul] + _ = ofLex x.toHahnSeries.1 * ofLex y.toHahnSeries.1 := + ofLex_coe_mul x.toHahnSeries y.toHahnSeries + _ = x.toFullHahnSeries * y.toFullHahnSeries := by + rw [← toFullHahnSeries_eq_ofLex_toHahnSeries, + ← toFullHahnSeries_eq_ofLex_toHahnSeries] + +/-- The full Conway Hahn series of a real is concentrated at exponent zero. -/ +@[simp] +theorem toFullHahnSeries_realCast (r : ℝ) : + toFullHahnSeries (r : Surreal.{u}) = HahnSeries.single 0 r := by + ext i + rw [coeff_toFullHahnSeries, HahnSeries.coeff_single] + have hcoeff : (r : Surreal.{u}).coeff = Pi.single 0 r := by + rw [← coeff_toHahnSeries, toHahnSeries_realCast, + SurrealHahnSeries.coeff_single] + rw [hcoeff] + by_cases hi : i = 0 + · subst i + simp + · have hi' : i.ofDual ≠ 0 := by + exact fun h ↦ hi (by simpa using congrArg OrderDual.toDual h) + simp [hi, hi'] + +/-- The full Conway Hahn series of `ω ^ x` is its corresponding monomial. -/ +@[simp] +theorem toFullHahnSeries_wpow (x : Surreal.{u}) : + toFullHahnSeries (ω^ x) = HahnSeries.single (OrderDual.toDual x) 1 := by + ext i + rw [coeff_toFullHahnSeries, coeff_wpow, HahnSeries.coeff_single] + by_cases hi : i = OrderDual.toDual x + · subst i + simp + · have hi' : i.ofDual ≠ x := by + exact fun h ↦ hi (by simpa using congrArg OrderDual.toDual h) + simp [hi, hi'] + +/-- A real scalar times a Conway monomial becomes the corresponding full Hahn monomial. -/ +theorem toFullHahnSeries_realCast_mul_wpow (r : ℝ) (i : Surreal.{u}) : + toFullHahnSeries ((r : Surreal) * ω^ i) = + HahnSeries.single (OrderDual.toDual i) r := by + have hcoeff : ((r : Surreal) * ω^ i).coeff = Pi.single i r := by + rw [← coeff_toHahnSeries] + have hnormal : + toHahnSeries ((r : Surreal) * ω^ i) = SurrealHahnSeries.single i r := by + rw [← SurrealHahnSeries.toSurreal_single i r, + SurrealHahnSeries.toHahnSeries_toSurreal] + rw [hnormal, SurrealHahnSeries.coeff_single] + ext j + rw [coeff_toFullHahnSeries, hcoeff, HahnSeries.coeff_single] + by_cases hj : j = OrderDual.toDual i + · subst j + simp + · have hj' : j.ofDual ≠ i := by + exact fun h ↦ hj (by simpa using congrArg OrderDual.toDual h) + simp [hj, hj'] + +/-- A surreal number with finite Conway support is the finite sum of its nonzero Conway +monomials. -/ +theorem eq_sum_coeff_mul_wpow_of_support_finite {x : Surreal.{u}} + (hx : x.support.Finite) : + x = ∑ i ∈ hx.toFinset, (x.coeff i : Surreal) * ω^ i := by + apply toFullHahnSeries_injective + rw [← toFullHahnSeriesAddMonoidHom_apply x, + ← toFullHahnSeriesAddMonoidHom_apply (∑ i ∈ hx.toFinset, + (x.coeff i : Surreal) * ω^ i)] + rw [map_sum] + simp_rw [toFullHahnSeriesAddMonoidHom_apply, + toFullHahnSeries_realCast_mul_wpow] + ext j + rw [coeff_toFullHahnSeries, HahnSeries.coeff_sum] + by_cases hj : j.ofDual ∈ x.support + · rw [Finset.sum_eq_single j.ofDual] + · simp + · intro b hb hne + rw [HahnSeries.coeff_single_of_ne] + exact fun h ↦ hne (by simpa using (congrArg OrderDual.ofDual h).symm) + · exact fun hnot ↦ (hnot (hx.mem_toFinset.mpr hj)).elim + · rw [Finset.sum_eq_zero] + · exact notMem_support_iff.mp hj + · intro b hb + rw [HahnSeries.coeff_single_of_ne] + exact fun h ↦ hj (by + have hb' : b ∈ x.support := hx.mem_toFinset.mp hb + simpa [h] using hb') + +/-- The full Conway Hahn-series map preserves the product of two real scalar monomials. -/ +theorem toFullHahnSeries_mul_monomials (r s : ℝ) (i j : Surreal.{u}) : + toFullHahnSeries + (((r : Surreal) * ω^ i) * ((s : Surreal) * ω^ j)) = + toFullHahnSeries ((r : Surreal) * ω^ i) * + toFullHahnSeries ((s : Surreal) * ω^ j) := by + have hprod : + ((r : Surreal) * ω^ i) * ((s : Surreal) * ω^ j) = + ((r * s : ℝ) : Surreal) * ω^ (i + j) := by + rw [wpow_add, Real.toSurreal_mul] + ring + rw [hprod, toFullHahnSeries_realCast_mul_wpow, + toFullHahnSeries_realCast_mul_wpow, + toFullHahnSeries_realCast_mul_wpow, HahnSeries.single_mul_single] + rfl + +/-- The full Conway Hahn-series map preserves multiplication when both Conway supports are +finite. -/ +theorem toFullHahnSeries_mul_of_support_finite {x y : Surreal.{u}} + (hx : x.support.Finite) (hy : y.support.Finite) : + toFullHahnSeries (x * y) = toFullHahnSeries x * toFullHahnSeries y := by + rw [eq_sum_coeff_mul_wpow_of_support_finite hx, + eq_sum_coeff_mul_wpow_of_support_finite hy] + let f (i : Surreal.{u}) := (x.coeff i : Surreal) * ω^ i + let g (j : Surreal.{u}) := (y.coeff j : Surreal) * ω^ j + change toFullHahnSeries ((∑ i ∈ hx.toFinset, f i) * + (∑ j ∈ hy.toFinset, g j)) = + toFullHahnSeries (∑ i ∈ hx.toFinset, f i) * + toFullHahnSeries (∑ j ∈ hy.toFinset, g j) + rw [Finset.sum_mul] + simp_rw [Finset.mul_sum] + rw [← toFullHahnSeriesAddMonoidHom_apply, map_sum] + simp_rw [toFullHahnSeriesAddMonoidHom_apply] + simp_rw [← toFullHahnSeriesAddMonoidHom_apply, + map_sum, toFullHahnSeriesAddMonoidHom_apply] + dsimp only [f, g] + simp_rw [toFullHahnSeries_mul_monomials] + rw [Finset.sum_mul] + simp_rw [Finset.mul_sum] + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/IntegerPart.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/IntegerPart.lean new file mode 100644 index 0000000000..2cc66bf8fa --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/IntegerPart.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Full +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.NormalForm + +/-! +# Omnific integers in the nonpositive Hahn integer part + +This module packages Conway's normal-form characterization into LM24's Hahn-series orientation. +The order dual implements `t = ω⁻¹`, so a nonnegative Conway exponent becomes a nonpositive +Hahn exponent. The coefficient at exponent zero lands in the image of `ℤ → ℝ`. + +The resulting map is an injective ring map. +-/ + +universe u + +public noncomputable section + +namespace Surreal + +/-- The copy of the integers inside the real coefficient field. -/ +def realIntegerSubring : Subring ℝ := + (Int.castRingHom ℝ).range + +/-- The integer coefficient subring of the reals is isomorphic to `ℤ`. -/ +noncomputable def realIntegerSubringEquiv : ℤ ≃+* realIntegerSubring := + RingEquiv.ofBijective (Int.castRingHom ℝ).rangeRestrict + ⟨Int.cast_injective, RingHom.rangeRestrict_surjective _⟩ + +/-- The integer coefficient subring of the reals is pre-Schreier. -/ +noncomputable instance instDecompositionMonoidRealIntegerSubring : + DecompositionMonoid realIntegerSubring := + MulEquiv.decompositionMonoid realIntegerSubringEquiv.symm.toMulEquiv + +/-- Membership in the real integer coefficient subring. -/ +@[simp] +theorem mem_realIntegerSubring {r : ℝ} : + r ∈ realIntegerSubring ↔ r ∈ Set.range ((↑) : ℤ → ℝ) := + Iff.rfl + +namespace OmnificInteger + +/-- The nonpositive full Hahn series underlying an omnific integer. -/ +def toNonpositiveHahn (x : OmnificInteger.{u}) : + HahnSeries.Nonpositive Surrealᵒᵈ ℝ := + ⟨toFullHahnSeries x.1, fun i hi ↦ by + have hsupport := (isOmnificInteger_iff_normalForm.mp + (mem_omnificIntegers.mp x.2)).1 + exact hsupport (mem_support_toFullHahnSeries.mp hi)⟩ + +/-- Coercing the nonpositive Hahn image recovers the full Conway Hahn series. -/ +@[simp] +theorem coe_toNonpositiveHahn (x : OmnificInteger.{u}) : + (x.toNonpositiveHahn : HahnSeries Surrealᵒᵈ ℝ) = toFullHahnSeries x.1 := + (rfl) + +/-- The nonpositive Hahn image of omnific integers as an additive homomorphism. -/ +def toNonpositiveHahnAddMonoidHom : + OmnificInteger.{u} →+ HahnSeries.Nonpositive Surrealᵒᵈ ℝ where + toFun := toNonpositiveHahn + map_zero' := by + apply Subtype.ext + exact toFullHahnSeries_zero + map_add' x y := by + apply Subtype.ext + exact toFullHahnSeries_add x.1 y.1 + +/-- Evaluation of the additive nonpositive Hahn map. -/ +@[simp] +theorem toNonpositiveHahnAddMonoidHom_apply (x : OmnificInteger.{u}) : + toNonpositiveHahnAddMonoidHom x = x.toNonpositiveHahn := + (rfl) + +/-- The additive nonpositive Hahn map is injective. -/ +theorem toNonpositiveHahn_injective : + Function.Injective (toNonpositiveHahn : + OmnificInteger.{u} → HahnSeries.Nonpositive Surrealᵒᵈ ℝ) := by + intro x y hxy + apply Subtype.ext + apply toFullHahnSeries_injective + have hraw := congrArg (fun q : HahnSeries.Nonpositive Surrealᵒᵈ ℝ ↦ + (q : HahnSeries Surrealᵒᵈ ℝ)) hxy + simpa only [coe_toNonpositiveHahn] using hraw + +/-- The nonpositive Hahn image preserves arbitrary omnific-integer products. -/ +@[simp] +theorem toNonpositiveHahn_mul (x y : OmnificInteger.{u}) : + toNonpositiveHahn (x * y) = toNonpositiveHahn x * toNonpositiveHahn y := by + apply Subtype.ext + exact toFullHahnSeries_mul x.1 y.1 + +/-- The Hahn truncation-integer-part element represented by an omnific integer. -/ +def toTruncationIntegerPart (x : OmnificInteger.{u}) : + HahnSeries.truncationIntegerPart Surrealᵒᵈ realIntegerSubring := + ⟨x.toNonpositiveHahn, by + rw [HahnSeries.mem_truncationIntegerPart] + change (toFullHahnSeries x.1).coeff 0 ∈ realIntegerSubring + rw [coeff_toFullHahnSeries, mem_realIntegerSubring] + change x.1.coeff 0 ∈ Set.range ((↑) : ℤ → ℝ) + exact (isOmnificInteger_iff_normalForm.mp (mem_omnificIntegers.mp x.2)).2⟩ + +/-- Coercing the truncation-integer-part image recovers the nonpositive Hahn image. -/ +@[simp] +theorem coe_toTruncationIntegerPart (x : OmnificInteger.{u}) : + (x.toTruncationIntegerPart : HahnSeries.Nonpositive Surrealᵒᵈ ℝ) = + x.toNonpositiveHahn := + by + apply Subtype.ext + rfl + +/-- The truncation-integer-part image of omnific integers as an additive homomorphism. -/ +def toTruncationIntegerPartAddMonoidHom : + OmnificInteger.{u} →+ + HahnSeries.truncationIntegerPart Surrealᵒᵈ realIntegerSubring where + toFun := toTruncationIntegerPart + map_zero' := by + apply Subtype.ext + change toNonpositiveHahn (0 : OmnificInteger.{u}) = 0 + exact toNonpositiveHahnAddMonoidHom.map_zero + map_add' x y := by + apply Subtype.ext + change toNonpositiveHahn (x + y) = toNonpositiveHahn x + toNonpositiveHahn y + exact toNonpositiveHahnAddMonoidHom.map_add x y + +/-- Evaluation of the additive truncation-integer-part map. -/ +@[simp] +theorem toTruncationIntegerPartAddMonoidHom_apply (x : OmnificInteger.{u}) : + toTruncationIntegerPartAddMonoidHom x = x.toTruncationIntegerPart := + (rfl) + +/-- The additive truncation-integer-part map is injective. -/ +theorem toTruncationIntegerPart_injective : + Function.Injective (toTruncationIntegerPart : OmnificInteger.{u} → + HahnSeries.truncationIntegerPart Surrealᵒᵈ realIntegerSubring) := by + intro x y hxy + apply toNonpositiveHahn_injective + have h := congrArg (fun q : HahnSeries.truncationIntegerPart + Surrealᵒᵈ realIntegerSubring ↦ + (q : HahnSeries.Nonpositive Surrealᵒᵈ ℝ)) hxy + simpa only [coe_toTruncationIntegerPart] using h + +/-- The truncation-integer-part image preserves arbitrary omnific-integer products. -/ +@[simp] +theorem toTruncationIntegerPart_mul (x y : OmnificInteger.{u}) : + toTruncationIntegerPart (x * y) = + toTruncationIntegerPart x * toTruncationIntegerPart y := by + apply Subtype.ext + exact toNonpositiveHahn_mul x y + +end OmnificInteger + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Multiplication.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Multiplication.lean new file mode 100644 index 0000000000..3274536ea4 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Multiplication.lean @@ -0,0 +1,123 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormMul +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.NormalForm + +/-! +# Hahn multiplication of omnific-integer normal forms + +This module records the multiplicative Conway-normal-form bridge needed for the omnific-integer +application in LM24. It proves that the formal Hahn product of two omnific-integer normal forms +again satisfies Conway's support-and-constant characterization of an omnific integer. + +The resulting `normalFormProduct` is the transported multiplication, and multiplicativity of the +Conway normal form identifies it with the ordinary surreal product. +-/ + +universe u + +open Set + +public noncomputable section + +namespace Surreal + +/-- The surreal represented by the Hahn product of two omnific-integer normal forms is an omnific +integer. -/ +theorem IsOmnificInteger.toHahnSeries_mul_toSurreal {x y : Surreal.{u}} + (hx : IsOmnificInteger x) (hy : IsOmnificInteger y) : + IsOmnificInteger ((x.toHahnSeries * y.toHahnSeries).toSurreal) := by + obtain ⟨hxSupport, m, hm⟩ := isOmnificInteger_iff_normalForm.mp hx + obtain ⟨hySupport, n, hn⟩ := isOmnificInteger_iff_normalForm.mp hy + have hxSeriesSupport : x.toHahnSeries.support ⊆ Ici 0 := by + simpa only [support_toHahnSeries] using hxSupport + have hySeriesSupport : y.toHahnSeries.support ⊆ Ici 0 := by + simpa only [support_toHahnSeries] using hySupport + rw [isOmnificInteger_iff_normalForm] + constructor + · simpa only [SurrealHahnSeries.support_toSurreal] using + SurrealHahnSeries.support_mul_subset_Ici hxSeriesSupport hySeriesSupport + · rw [SurrealHahnSeries.coeff_toSurreal, + SurrealHahnSeries.coeff_zero_mul_of_support_subset_Ici hxSeriesSupport hySeriesSupport] + rw [congrFun (coeff_toHahnSeries x) 0, congrFun (coeff_toHahnSeries y) 0, + ← hm, ← hn] + exact ⟨m * n, by simp⟩ + +/-- For omnific integers, Conway/Hahn multiplication compatibility reduces to the product of the +two strictly positive truncations. Integer constant terms and both cross terms are already +handled by additive compatibility. -/ +theorem IsOmnificInteger.toHahnSeries_mul_of_trunc_zero {x y : Surreal.{u}} + (hx : IsOmnificInteger x) (hy : IsOmnificInteger y) + (hpositive : (x.trunc 0 * y.trunc 0).toHahnSeries = + x.toHahnSeries.trunc 0 * y.toHahnSeries.trunc 0) : + (x * y).toHahnSeries = x.toHahnSeries * y.toHahnSeries := by + obtain ⟨hxSupport, m, hm⟩ := isOmnificInteger_iff_normalForm.mp hx + obtain ⟨hySupport, n, hn⟩ := isOmnificInteger_iff_normalForm.mp hy + have hmSurreal : (m : Surreal) = (x.coeff 0 : Surreal) := by + exact_mod_cast hm + have hnSurreal : (n : Surreal) = (y.coeff 0 : Surreal) := by + exact_mod_cast hn + have hxSplit : x.trunc 0 + (m : Surreal) = x := by + rw [hmSurreal, ← sub_trunc_zero_eq_realCast_of_support_subset_Ici hxSupport] + abel + have hySplit : y.trunc 0 + (n : Surreal) = y := by + rw [hnSurreal, ← sub_trunc_zero_eq_realCast_of_support_subset_Ici hySupport] + abel + have hxSeriesSplit : x.toHahnSeries.trunc 0 + + SurrealHahnSeries.single 0 (m : ℝ) = x.toHahnSeries := by + rw [← toHahnSeries_trunc, ← toHahnSeries_intCast, + ← toHahnSeries_add, hxSplit] + have hySeriesSplit : y.toHahnSeries.trunc 0 + + SurrealHahnSeries.single 0 (n : ℝ) = y.toHahnSeries := by + rw [← toHahnSeries_trunc, ← toHahnSeries_intCast, + ← toHahnSeries_add, hySplit] + conv_lhs => rw [← hxSplit, ← hySplit] + rw [add_mul, mul_add, mul_add, toHahnSeries_add, toHahnSeries_add, + toHahnSeries_add, hpositive, toHahnSeries_mul_intCast, + toHahnSeries_intCast_mul, toHahnSeries_mul_intCast, + toHahnSeries_trunc x 0, toHahnSeries_trunc y 0, + toHahnSeries_intCast] + calc + _ = (x.toHahnSeries.trunc 0 + SurrealHahnSeries.single 0 (m : ℝ)) * + (y.toHahnSeries.trunc 0 + SurrealHahnSeries.single 0 (n : ℝ)) := by ring + _ = x.toHahnSeries * y.toHahnSeries := by rw [hxSeriesSplit, hySeriesSplit] + +namespace OmnificInteger + +/-- Multiplication transported from formal Hahn multiplication through Conway normal forms. -/ +def normalFormProduct (x y : OmnificInteger.{u}) : OmnificInteger.{u} := + ⟨(x.1.toHahnSeries * y.1.toHahnSeries).toSurreal, + (mem_omnificIntegers.mpr + ((mem_omnificIntegers.mp x.2).toHahnSeries_mul_toSurreal + (mem_omnificIntegers.mp y.2)))⟩ + +/-- The surreal underlying the transported normal-form product. -/ +theorem coe_normalFormProduct (x y : OmnificInteger.{u}) : + (normalFormProduct x y : Surreal) = + (x.1.toHahnSeries * y.1.toHahnSeries).toSurreal := + (rfl) + +/-- The Conway normal form of the transported product is the formal Hahn product. -/ +theorem toHahnSeries_normalFormProduct (x y : OmnificInteger.{u}) : + (normalFormProduct x y : Surreal).toHahnSeries = + x.1.toHahnSeries * y.1.toHahnSeries := by + rw [coe_normalFormProduct, SurrealHahnSeries.toHahnSeries_toSurreal] + +/-- Multiplication transported through Conway normal forms is ordinary omnific-integer +multiplication. -/ +@[simp] +theorem normalFormProduct_eq_mul (x y : OmnificInteger.{u}) : + normalFormProduct x y = x * y := by + apply Subtype.ext + change (x.1.toHahnSeries * y.1.toHahnSeries).toSurreal = x.1 * y.1 + rw [SurrealHahnSeries.toSurreal_mul, Surreal.toSurreal_toHahnSeries, + Surreal.toSurreal_toHahnSeries] + +end OmnificInteger + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalForm.lean new file mode 100644 index 0000000000..14d107eac0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalForm.lean @@ -0,0 +1,1189 @@ +/- +Copyright (c) 2026 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormRecursion +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormSupport +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Birthday.Basic + +/-! +# Converting between surreal Hahn series and surreals + +This map defines the two-way conversion between `SurrealHahnSeries` and `Surreal`, and proves it an +order isomorphism (`Surreal.toHahnSeriesOrderIso`). This downstream port follows the axiom-free +construction in CombinatorialGames PR #263. Both sides of this conversion are quite +technical constructions which require auxiliary definitions. + +## Hahn series to surreals + +For a given surreal Hahn series `x`, we define two sets `truncLT x` and `truncGT x` of surreal Hahn +series. The set `truncLT x` is generated by truncating `x` at some element `e` of its support, and +adding `single r e` for `r < x.coeff e`. The set `truncGT x` is defined analogously, replacing the +last inequality with `r > x.coeff e`. Both are small sets. + +We first define a map `SurrealHahnSeries → IGame` via limit recursion on the length of the Hahn +series. For a Hahn series of successor length, we define +`toIGame (x + single r e)` = `toIGame x + r * ω^ e`. For a Hahn series of limit (or zero) length, +we define `toIGame x = !{truncLT x | truncGT x}`. This definition is well-founded, as all elements +in `truncLT x` and `truncGT x` have a smaller length than `x`, whenever `x` has a limit length. + +We use mutual induction to show that `toIGame x` is always numeric, and that `toIGame` is strictly +monotone. As a corollary, the equivalence `toIGame x ≈ !{truncLT x | truncGT x}` holds +unconditionally. + +## Surreals to Hahn series + +For a given surreal `x`, we define the type `PartialSum x` of partial sums of `x`. These are surreal +Hahn series `y` characterized by the equation `y.term i = (x - y).leadingTerm` for every +`i < y.length`. The idea is that terms of `PartialSum x` represent successive approximations to the +Hahn series which corresponds to `x`, which will be the longest one. + +We define a `Preorder` instance on `PartialSum x` via the lift of the `length` function. We first +show that `length` is injective on `PartialSum x`, meaning we can lift this to a linear order. We +then show that `PartialSum x` is `Small` via a birthday argument. We build a `CompleteLinearOrder` +instance, by setting the supremum to the directed union of series. Finally, we show that +`⊤ : PartialSum x` must be a Hahn series with `toSurreal ⊤ = x`; if it wasn't, we'd be able to +extend it by at least one entry. +-/ + +universe u + +open IGame Order Set + +public noncomputable section + +/-! ### Hahn series as games -/ + +namespace SurrealHahnSeries + +/-- A common base for both `truncLT` and `truncGT`. -/ +private def truncAux (x : SurrealHahnSeries) (R : ℝ → ℝ → Prop) : Set SurrealHahnSeries := + range fun i : (j : x.support) × {r // R r (x.coeff j)} ↦ x.trunc i.1 + single i.1 i.2 + +/-- We write `x ≺ y` whenever `x = y.trunc i + single i r` for some `i ∈ y.support` and +`r < y.coeff i`. + +When `y.length` is a limit ordinal, the series with `x ≺ y` describe the left options of +`toIGame y`. -/ +def truncLT (x : SurrealHahnSeries) : Set SurrealHahnSeries := + truncAux x (· < ·) + +notation:50 x:50 " ≺ " y:50 => x ∈ truncLT y +recommended_spelling "truncLT" for "≺" in [«term_≺_»] + +/-- We write `x ≻ y` whenever `x = y.trunc i + single i r` for some `i ∈ y.support` and +`r > y.coeff i`. + +When `y.length` is a limit ordinal, the series with `x ≻ y` describe the right options of +`toIGame y`. -/ +def truncGT (x : SurrealHahnSeries) : Set SurrealHahnSeries := + truncAux x (· > ·) + +local notation:50 x:50 " ≻ " y:50 => x ∈ truncGT y +recommended_spelling "truncGT" for "≻" in [«term_≺_»] + +private theorem truncAux_def {x y : SurrealHahnSeries} {R : ℝ → ℝ → Prop} : + x ∈ truncAux y R ↔ ∃ i ∈ y.support, ∃ r : ℝ, R r (y.coeff i) ∧ y.trunc i + single i r = x := by + simp [truncAux] + +theorem truncLT_def {x y : SurrealHahnSeries} : + x ≺ y ↔ ∃ i ∈ y.support, ∃ r : ℝ, r < y.coeff i ∧ y.trunc i + single i r = x := + truncAux_def + +theorem truncGT_def {x y : SurrealHahnSeries} : + x ≻ y ↔ ∃ i ∈ y.support, ∃ r : ℝ, y.coeff i < r ∧ y.trunc i + single i r = x := + truncAux_def + +private theorem forall_mem_truncAux {y : SurrealHahnSeries} + {P : SurrealHahnSeries → Prop} {R : ℝ → ℝ → Prop} : + (∀ x ∈ truncAux y R, P x) ↔ + ∀ i ∈ y.support, ∀ r : ℝ, R r (y.coeff i) → P (y.trunc i + single i r) := by + aesop (add simp [truncAux]) + +theorem forall_mem_truncLT {y : SurrealHahnSeries} {P : SurrealHahnSeries → Prop} : + (∀ x ∈ truncLT y, P x) ↔ + ∀ i ∈ y.support, ∀ r : ℝ, r < y.coeff i → P (y.trunc i + single i r) := + forall_mem_truncAux + +theorem forall_mem_truncGT {y : SurrealHahnSeries} {P : SurrealHahnSeries → Prop} : + (∀ x ∈ truncGT y, P x) ↔ + ∀ i ∈ y.support, ∀ r : ℝ, y.coeff i < r → P (y.trunc i + single i r) := + forall_mem_truncAux + +private theorem exists_mem_truncAux {y : SurrealHahnSeries} + {P : SurrealHahnSeries → Prop} {R : ℝ → ℝ → Prop} : + (∃ x ∈ truncAux y R, P x) ↔ + ∃ i ∈ y.support, ∃ r : ℝ, R r (y.coeff i) ∧ P (y.trunc i + single i r) := by + aesop (add simp [truncAux]) + +theorem exists_mem_truncLT {y : SurrealHahnSeries} {P : SurrealHahnSeries → Prop} : + (∃ x ∈ truncLT y, P x) ↔ + ∃ i ∈ y.support, ∃ r : ℝ, r < y.coeff i ∧ P (y.trunc i + single i r) := + exists_mem_truncAux + +theorem exists_mem_truncGT {y : SurrealHahnSeries} {P : SurrealHahnSeries → Prop} : + (∃ x ∈ truncGT y, P x) ↔ + ∃ i ∈ y.support, ∃ r : ℝ, y.coeff i < r ∧ P (y.trunc i + single i r) := + exists_mem_truncAux + +private theorem truncAux_zero (R : ℝ → ℝ → Prop) : truncAux 0 R = ∅ := by + unfold truncAux; simp + +@[simp] theorem truncLT_zero : truncLT 0 = ∅ := truncAux_zero _ +@[simp] theorem truncGT_zero : truncGT 0 = ∅ := truncAux_zero _ + +private theorem trunc_add_single_truncAux {x : SurrealHahnSeries} {i : Surreal} {r : ℝ} + {R : ℝ → ℝ → Prop} (hi : i ∈ x.support) (hr : R r (x.coeff i)) : + x.trunc i + single i r ∈ truncAux x R := by + unfold truncAux + aesop + +theorem trunc_add_single_truncLT {x : SurrealHahnSeries} {i : Surreal} {r : ℝ} + (hi : i ∈ x.support) (hr : r < x.coeff i) : x.trunc i + single i r ≺ x := + trunc_add_single_truncAux hi hr + +theorem trunc_add_single_truncGT {x : SurrealHahnSeries} {i : Surreal} {r : ℝ} + (hi : i ∈ x.support) (hr : x.coeff i < r) : x.trunc i + single i r ≻ x := + trunc_add_single_truncAux hi hr + +private instance small_truncAux (x : SurrealHahnSeries.{u}) (R : ℝ → ℝ → Prop) : + Small.{u} (truncAux x R) := + by unfold truncAux; infer_instance + +instance small_truncLT (x : SurrealHahnSeries.{u}) : Small.{u} (truncLT x) := small_truncAux .. +instance small_truncGT (x : SurrealHahnSeries.{u}) : Small.{u} (truncGT x) := small_truncAux .. + +private theorem length_le_of_truncAux {x y : SurrealHahnSeries} {R : ℝ → ℝ → Prop} + (h : x ∈ truncAux y R) : x.length ≤ y.length := by + obtain ⟨⟨i, hi⟩, rfl⟩ := h + apply (length_add_single_le ..).trans + · rw [add_one_le_iff] + exact length_trunc_lt i.2 + · simp + +private theorem length_lt_of_truncAux {x y : SurrealHahnSeries} (hy : IsSuccPrelimit y.length) + {R : ℝ → ℝ → Prop} (h : x ∈ truncAux y R) : x.length < y.length := by + obtain ⟨⟨i, hi⟩, rfl⟩ := h + apply (length_add_single_le ..).trans_lt + · exact hy.add_one_lt <| length_trunc_lt i.2 + · simp + +theorem length_le_of_truncLT {x y : SurrealHahnSeries} (h : x ≺ y) : x.length ≤ y.length := + length_le_of_truncAux h + +theorem length_le_of_truncGT {x y : SurrealHahnSeries} (h : x ≻ y) : x.length ≤ y.length := + length_le_of_truncAux h + +theorem length_lt_of_truncLT {x y : SurrealHahnSeries} (hy : IsSuccPrelimit y.length) (h : x ≺ y) : + x.length < y.length := + length_lt_of_truncAux hy h + +theorem length_lt_of_truncGT {x y : SurrealHahnSeries} (hy : IsSuccPrelimit y.length) (h : x ≻ y) : + x.length < y.length := + length_lt_of_truncAux hy h + +theorem lt_of_truncLT {x y : SurrealHahnSeries} (h : x ≺ y) : x < y := by + obtain ⟨⟨⟨i, hi⟩, s, hs⟩, rfl⟩ := h + rw [lt_def] + use i + aesop + +theorem gt_of_truncGT {x y : SurrealHahnSeries} (h : x ≻ y) : y < x := by + obtain ⟨⟨⟨i, hi⟩, s, hs⟩, rfl⟩ := h + rw [lt_def] + use i + aesop + +private theorem truncAux_truncIdx_ssubset {x : SurrealHahnSeries} {R : ℝ → ℝ → Prop} {i : Ordinal} + (h : i < x.length) (hR : ∀ r, ∃ s ≠ 0, R s r) : truncAux (truncIdx x i) R ⊂ truncAux x R := by + constructor + · intro y hy + rw [truncAux_def] at hy ⊢ + obtain ⟨a, ha, r, hr, rfl⟩ := hy + refine ⟨a, support_truncIdx_subset _ _ ha, r, ?_, ?_⟩ + · rwa [coeff_truncIdx_of_mem le_rfl ha] at hr + · rw [trunc_truncIdx_of_mem le_rfl ha] + · rw [not_subset, exists_mem_truncAux] + obtain ⟨s, hs, hs'⟩ := hR (x.coeff ↑(x.exp ⟨i, h⟩)) + refine ⟨x.exp ⟨i, h⟩, Subtype.coe_prop _, s, hs', fun H ↦ (length_le_of_truncAux H).not_gt ?_⟩ + rw [trunc_exp, length_truncIdx_add_single _ hs, length_truncIdx, Order.lt_add_one_iff] + exact min_le_left .. + +private theorem truncAux_truncIdx_subset {x : SurrealHahnSeries} {R : ℝ → ℝ → Prop} {i : Ordinal} + (hR : ∀ r, ∃ s ≠ 0, R s r) : truncAux (truncIdx x i) R ⊆ truncAux x R := by + obtain hi | hi := lt_or_ge i x.length + · exact (truncAux_truncIdx_ssubset hi hR).le + · rw [truncIdx_of_le hi] + +private theorem truncAux_truncIdx_strictMonoOn {x : SurrealHahnSeries} {R : ℝ → ℝ → Prop} + (hR : ∀ r, ∃ s ≠ 0, R s r) : + StrictMonoOn (fun i ↦ truncAux (truncIdx x i) R) (Iio x.length) := by + intro i hi j hj h + dsimp + rw [← min_eq_right h.le, ← truncIdx_truncIdx] + apply truncAux_truncIdx_ssubset _ hR + simp_all + +private theorem truncAux_truncIdx_mono {x : SurrealHahnSeries} {R : ℝ → ℝ → Prop} + (hR : ∀ r, ∃ s ≠ 0, R s r) : + Monotone fun i ↦ truncAux (truncIdx x i) R := by + intro i j h + dsimp + rw [← min_eq_right h, ← truncIdx_truncIdx] + exact truncAux_truncIdx_subset hR + +private theorem truncLT_aux (r : ℝ) : ∃ s ≠ 0, s < r := ⟨min (r - 1) (-1), by grind⟩ +private theorem truncGT_aux (r : ℝ) : ∃ s ≠ 0, r < s := ⟨max (r + 1) 1, by grind⟩ + +theorem truncLT_truncIdx_ssubset {x : SurrealHahnSeries} {i : Ordinal} (h : i < x.length) : + truncLT (truncIdx x i) ⊂ truncLT x := + truncAux_truncIdx_ssubset h truncLT_aux + +theorem truncGT_truncIdx_ssubset {x : SurrealHahnSeries} {i : Ordinal} (h : i < x.length) : + truncGT (truncIdx x i) ⊂ truncGT x := + truncAux_truncIdx_ssubset h truncGT_aux + +theorem truncLT_truncIdx_subset {x : SurrealHahnSeries} {i : Ordinal} : + truncLT (truncIdx x i) ⊆ truncLT x := + truncAux_truncIdx_subset truncLT_aux + +theorem truncGT_truncIdx_subset {x : SurrealHahnSeries} {i : Ordinal} : + truncGT (truncIdx x i) ⊆ truncGT x := + truncAux_truncIdx_subset truncGT_aux + +theorem truncLT_truncIdx_strictMonoOn {x : SurrealHahnSeries} : + StrictMonoOn (fun i ↦ truncLT (truncIdx x i)) (Iio x.length) := + truncAux_truncIdx_strictMonoOn truncLT_aux + +theorem truncGT_truncIdx_strictMonoOn {x : SurrealHahnSeries} : + StrictMonoOn (fun i ↦ truncGT (truncIdx x i)) (Iio x.length) := + truncAux_truncIdx_strictMonoOn truncGT_aux + +theorem truncLT_truncIdx_mono {x : SurrealHahnSeries} : + Monotone fun i ↦ truncLT (truncIdx x i) := + truncAux_truncIdx_mono truncLT_aux + +theorem truncGT_truncIdx_mono {x : SurrealHahnSeries} : + Monotone fun i ↦ truncGT (truncIdx x i) := + truncAux_truncIdx_mono truncGT_aux + +/-- An `IGame` representative of the surreal number encoded by a surreal Hahn series. -/ +@[coe] +def toIGame (x : SurrealHahnSeries.{u}) : IGame.{u} := + lengthRecOn x (fun _ i r _ _ IH ↦ IH + r * ω^ i.out) fun y hy IH ↦ + !{range fun i : truncLT y ↦ IH i <| length_lt_of_truncLT hy i.2 | + range fun i : truncGT y ↦ IH i <| length_lt_of_truncGT hy i.2} + +instance instCoeIGame : Coe SurrealHahnSeries IGame where + coe := toIGame + +theorem toIGame_succ {x : SurrealHahnSeries} + {i : Surreal} {r : ℝ} (hi : ∀ j ∈ x.support, i < j) (hr : r ≠ 0) : + toIGame (x + single i r) = toIGame x + r * ω^ i.out := + lengthRecOn_succ hi hr + +theorem toIGame_succ_equiv {x : SurrealHahnSeries} + {i : Surreal} {r : ℝ} (hi : ∀ j ∈ x.support, i < j) : + toIGame (x + single i r) ≈ toIGame x + r * ω^ i.out := by + obtain rfl | hr := eq_or_ne r 0 + · rw [single_zero, add_zero] + have hz : ((0 : ℝ) : IGame) * ω^ i.out ≈ 0 := by + rw [Numeric.mul_equiv_zero] + exact Or.inl Real.toIGame_zero_equiv + simpa using (IGame.add_congr_right hz).symm + · rw [toIGame_succ hi hr] + +theorem toIGame_limit {x : SurrealHahnSeries.{u}} (hx : IsSuccPrelimit x.length) : + toIGame x = !{toIGame '' truncLT x | toIGame '' truncGT x} := by + simp_rw [image_eq_range] + exact lengthRecOn_limit hx + +@[simp] +theorem toIGame_zero : toIGame 0 = 0 := by + rw [toIGame_limit] <;> aesop + +theorem leftMoves_toIGame_limit {x : SurrealHahnSeries} (hx : IsSuccPrelimit x.length) : + (toIGame x)ᴸ = toIGame '' truncLT x := by + rw [toIGame_limit hx, leftMoves_ofSets] + +theorem rightMoves_toIGame_limit {x : SurrealHahnSeries} (hx : IsSuccPrelimit x.length) : + (toIGame x)ᴿ = toIGame '' truncGT x := by + rw [toIGame_limit hx, rightMoves_ofSets] + +private theorem toIGame_lt_toIGame_of_truncLT {x y : SurrealHahnSeries} (h : x ≺ y) + [hy' : Numeric y] (IH : ∀ z, length z < y.length → Numeric z) : + toIGame x < toIGame y := by + induction y using lengthRecOn generalizing hy' x with + | succ y i r hi hr IH' => + obtain ⟨⟨⟨j, hj⟩, s, hs⟩, rfl⟩ := h + rw [coeff_add_apply] at hs + replace hj := union_subset_union_right y.support support_single_subset (support_add_subset hj) + have hij : i ≤ j := by rw [le_iff_lt_or_eq]; aesop + dsimp + rw [trunc_add, trunc_single_of_le hij, add_zero, toIGame_succ hi hr] + grw [toIGame_succ_equiv (by simp)] + obtain hj | rfl := hj + · replace hij := hi _ hj + rw [coeff_single_of_ne hij.ne, add_zero] at hs + obtain ⟨t, ht, ht'⟩ := exists_between hs + have hst : s * ω^ j.out ≈ t * ω^ j.out + ↑(s - t) * ω^ j.out := by + rw [← Surreal.mk_eq_mk] + simp [← add_mul] + grw [hst, ← add_assoc] + apply add_lt_add _ (Numeric.mul_wpow_lt_mul_wpow_of_neg ..) + · grw [← toIGame_succ_equiv (by simp)] + simp_rw [length_add_single hi hr, lt_add_one_iff] at IH + have := IH _ le_rfl + apply IH' + · rw [truncLT_def] + exact ⟨j, hj, t, ht', rfl⟩ + · exact fun z hz ↦ IH z hz.le + · rwa [sub_neg] + · rw [← Surreal.mk_lt_mk] + simpa + · rw [trunc_eq_self hi] + have : y.coeff j = 0 := by + by_contra h + exact (hi _ h).false + simpa [this] using hs + | limit y hy IH' => + apply Numeric.left_lt + rw [leftMoves_toIGame_limit hy] + exact mem_image_of_mem _ h + +private theorem toIGame_lt_toIGame_of_truncGT {x y : SurrealHahnSeries} (h : x ≻ y) + [hy' : Numeric y] (IH : ∀ z, length z < y.length → Numeric z) : + toIGame y < toIGame x := by + induction y using lengthRecOn generalizing hy' x with + | succ y i r hi hr IH' => + obtain ⟨⟨⟨j, hj⟩, s, hs⟩, rfl⟩ := h + rw [coeff_add_apply] at hs + replace hj := union_subset_union_right y.support support_single_subset (support_add_subset hj) + have hij : i ≤ j := by rw [le_iff_lt_or_eq]; aesop + dsimp + rw [trunc_add, trunc_single_of_le hij, add_zero, toIGame_succ hi hr] + grw [toIGame_succ_equiv (by simp)] + obtain hj | rfl := hj + · replace hij := hi _ hj + rw [coeff_single_of_ne hij.ne, add_zero] at hs + obtain ⟨t, ht', ht⟩ := exists_between hs + have hst : s * ω^ j.out ≈ t * ω^ j.out + ↑(s - t) * ω^ j.out := by + rw [← Surreal.mk_eq_mk] + simp [← add_mul] + grw [hst, ← add_assoc] + apply add_lt_add _ (Numeric.mul_wpow_lt_mul_wpow_of_pos ..) + · grw [← toIGame_succ_equiv (by simp)] + simp_rw [length_add_single hi hr, lt_add_one_iff] at IH + have := IH _ le_rfl + apply IH' + · rw [truncGT_def] + exact ⟨j, hj, t, ht', rfl⟩ + · exact fun z hz ↦ IH z hz.le + · rwa [sub_pos] + · rw [← Surreal.mk_lt_mk] + simpa + · rw [trunc_eq_self hi] + have : y.coeff j = 0 := by + by_contra h + exact (hi _ h).false + simpa [this] using hs + | limit y hy IH' => + apply Numeric.lt_right + rw [rightMoves_toIGame_limit hy] + exact mem_image_of_mem _ h + +private theorem numeric_toIGame' (x : SurrealHahnSeries) + (IH : ∀ {y z}, length y < x.length → length z < x.length → + Numeric y ∧ Numeric z ∧ (y < z → toIGame y < toIGame z)) : Numeric x := by + have IH' {y : SurrealHahnSeries} (hy : y.length < _) := (IH hy hy).1 + cases x using lengthRecOn with + | succ x i r hi hr => + rw [toIGame_succ hi hr] + have hx : x.length < (x + single i r).length := by + rw [length_add_single hi hr, lt_add_one_iff] + have := IH' hx + infer_instance + | limit _ hx => + rw [toIGame_limit hx, numeric_def] + aesop (add apply forward safe [length_lt_of_truncLT, length_lt_of_truncGT, + lt_of_truncLT, gt_of_truncGT, lt_trans]) + +private theorem toIGame_aux {o : Ordinal} {x y : SurrealHahnSeries} + (_ : x.length < o) (_ : y.length < o) : Numeric x ∧ Numeric y ∧ + (x < y → toIGame x < toIGame y) := by + have hx' := numeric_toIGame' x toIGame_aux + have hy' := numeric_toIGame' y toIGame_aux + have IHx (z) (hz : length z < x.length) : Numeric z := (toIGame_aux hz hz).1 + have IHy (z) (hz : length z < y.length) : Numeric z := (toIGame_aux hz hz).1 + refine ⟨hx', hy', fun h ↦ ?_⟩ + obtain ⟨i, hi, hi'⟩ := lt_def.1 h + dsimp at * + obtain hx | hx := eq_or_ne (x.coeff i) 0 <;> obtain hy | hy := eq_or_ne (y.coeff i) 0 + · simp_all + · by_cases! H : ∀ j : x.support, i < j + · apply toIGame_lt_toIGame_of_truncLT _ IHy + rw [truncLT_def] + use i, hy, x.coeff i, hi' + ext j + have (hj : j < i) : x.coeff j = 0 := by + by_contra hj' + exact (H ⟨_, hj'⟩).not_gt hj + have := lt_trichotomy i j + aesop + · obtain ⟨⟨j, hj⟩, (hj' : j ≤ i), hij⟩ := wellFounded_gt.has_min {j : x.support | j ≤ i} H + obtain rfl | hj' := hj'.eq_or_lt + · cases hj hx + · obtain ⟨r, hr⟩ := exists_gt (x.coeff j) + trans ↑(x.trunc j + single j r) + · apply toIGame_lt_toIGame_of_truncGT _ IHx + rw [truncGT_def] + use j, hj, r + · rw [hx] at hi' + obtain ⟨s, hs, hs'⟩ := exists_between hi' + trans ↑(y.trunc i + single i s) + · grw [toIGame_succ_equiv (by simp), toIGame_succ (by simp) hs.ne'] + apply add_lt_add_of_le_of_lt (le_of_eq _) + · apply Numeric.mul_wpow_lt_mul_wpow_of_pos _ hs + simpa [← Surreal.mk_lt_mk] + · congr 1 + trans x.trunc i + · refine trunc_eq_trunc hj'.le fun k hj hi ↦ ?_ + by_contra h + exact hij ⟨_, h⟩ hi hj + · aesop + · apply toIGame_lt_toIGame_of_truncLT _ IHy + rw [truncLT_def] + use i, hy, s + · by_cases! H : ∀ j : y.support, i < j + · apply toIGame_lt_toIGame_of_truncGT _ IHx + rw [truncGT_def] + use i, hx, y.coeff i, hi' + ext j + have (hj : j < i) : y.coeff j = 0 := by + by_contra hj' + exact (H ⟨_, hj'⟩).not_gt hj + have := lt_trichotomy i j + aesop (add safe tactic (by order)) + · obtain ⟨⟨j, hj⟩, (hj' : j ≤ i), hij⟩ := wellFounded_gt.has_min {j : y.support | j ≤ i} H + obtain rfl | hj' := hj'.eq_or_lt + · cases hj hy + · obtain ⟨r, hr⟩ := exists_lt (y.coeff j) + trans ↑(y.trunc j + single j r) + · rw [hy] at hi' + obtain ⟨s, hs', hs⟩ := exists_between hi' + trans ↑(x.trunc i + single i s) + · apply toIGame_lt_toIGame_of_truncGT _ IHx + rw [truncGT_def] + use i, hx, s + · grw [toIGame_succ (by simp) hs.ne, toIGame_succ_equiv (by simp)] + apply add_lt_add_of_le_of_lt (le_of_eq _) + · apply Numeric.mul_wpow_lt_mul_wpow_of_neg _ hs + simpa [← Surreal.mk_lt_mk] + · congr 1 + trans y.trunc i + · aesop + · symm + refine trunc_eq_trunc hj'.le fun k hj hi ↦ ?_ + by_contra h + exact hij ⟨_, h⟩ hi hj + · apply toIGame_lt_toIGame_of_truncLT _ IHy + rw [truncLT_def] + use j, hj, r + · obtain ⟨r, hr, hr'⟩ := exists_between hi' + trans ↑(x.trunc i + single i r) + · apply toIGame_lt_toIGame_of_truncGT _ IHx + rw [truncGT_def] + use i, hx, r + · apply toIGame_lt_toIGame_of_truncLT _ IHy + rw [truncLT_def] + use i, hy, r, hr' + aesop +termination_by o + +instance numeric_toIGame (x : SurrealHahnSeries) : Numeric (toIGame x) := + (toIGame_aux (lt_add_one _) (lt_add_one _)).1 + +theorem toIGame_strictMono : StrictMono toIGame := by + refine fun x y h ↦ (toIGame_aux (o := max (x.length + 1) (y.length + 1)) ?_ ?_).2.2 h <;> simp + +@[simp, norm_cast] +theorem toIGame_lt_toIGame_iff {x y : SurrealHahnSeries} : toIGame x < toIGame y ↔ x < y := + toIGame_strictMono.lt_iff_lt + +@[simp, norm_cast] +theorem toIGame_le_toIGame_iff {x y : SurrealHahnSeries} : toIGame x ≤ toIGame y ↔ x ≤ y := + toIGame_strictMono.le_iff_le + +@[simp, norm_cast] +theorem toIGame_equiv_toIGame_iff {x y : SurrealHahnSeries} : toIGame x ≈ toIGame y ↔ x = y := by + simp [AntisymmRel, le_antisymm_iff] + +@[simp, norm_cast] +theorem toIGame_inj {x y : SurrealHahnSeries} : toIGame x = toIGame y ↔ x = y := + toIGame_strictMono.injective.eq_iff + +theorem toIGame_equiv (x : SurrealHahnSeries) : + toIGame x ≈ !{toIGame '' truncLT x | toIGame '' truncGT x} := by + induction x using lengthRecOn with + | succ x i r hi hr IH => + have hi' : i ∉ x.support := fun hi' ↦ (hi i hi').false + apply Fits.equiv_of_forall_moves_of_equiv ( + !{toIGame '' truncLT x | toIGame '' truncGT x} + + !{(fun s : ℝ ↦ s * ω^ i.out) '' Iio r | (fun s : ℝ ↦ s * ω^ i.out) '' Ioi r}) + · rw [toIGame_succ hi hr] + exact IGame.add_congr IH (Numeric.realCast_mul_wpow_equiv r i.out) + · constructor + all_goals + rw [moves_ofSets, forall_mem_image] + intro y hy + · simpa using lt_of_truncLT hy + · simpa using gt_of_truncGT hy + · simp_rw [forall_moves_add, moves_ofSets, Player.cases, + forall_mem_image, exists_mem_image, forall_mem_truncLT, exists_mem_truncLT, trunc_add] + constructor + · intro j hj s hs + obtain ⟨t, ht⟩ := exists_lt ((x + single i r).coeff i) + refine ⟨i, ?_, t, ht, ?_⟩ + · simp_all + · grw [← Numeric.realCast_mul_wpow_equiv, trunc_single_of_le le_rfl, + ← toIGame_succ_equiv (by aesop), toIGame_le_toIGame_iff] + refine (lt_def.2 ⟨j, fun k hk ↦ ?_, ?_⟩).le + · change + (x.trunc j + single j s + single i r).coeff k = + (x.trunc i + 0 + single i t).coeff k + simp only [coeff_add_apply] + rw [coeff_trunc_of_lt hk, coeff_trunc_of_lt ((hi _ hj).trans hk)] + rw [coeff_single_of_ne hk.ne, + coeff_single_of_ne ((hi _ hj).trans hk).ne] + simpa using coeff_single_of_ne (r := t) ((hi _ hj).trans hk).ne + · aesop + · intro s hs + obtain ⟨t, ht, ht'⟩ := exists_between (α := ℝ) hs + refine ⟨i, ?_, t, ?_, ?_⟩ + · simp_all + · simp_all + · grw [trunc_single_of_le le_rfl, ← IH, toIGame_succ_equiv (by simp), trunc_eq_self hi] + simpa using ht.le + · simp_rw [forall_moves_add, moves_ofSets, Player.cases, + forall_mem_image, exists_mem_image, forall_mem_truncGT, exists_mem_truncGT, trunc_add] + constructor + · intro j hj s hs + obtain ⟨t, ht⟩ := exists_gt ((x + single i r).coeff i) + refine ⟨i, ?_, t, ht, ?_⟩ + · simp_all + · grw [← Numeric.realCast_mul_wpow_equiv, trunc_single_of_le le_rfl, + ← toIGame_succ_equiv (by aesop), toIGame_le_toIGame_iff] + refine (lt_def.2 ⟨j, fun k hk ↦ ?_, ?_⟩).le + · change + (x.trunc i + 0 + single i t).coeff k = + (x.trunc j + single j s + single i r).coeff k + simp only [coeff_add_apply] + rw [coeff_trunc_of_lt hk, coeff_trunc_of_lt ((hi _ hj).trans hk)] + rw [coeff_single_of_ne hk.ne, + coeff_single_of_ne ((hi _ hj).trans hk).ne] + simpa using coeff_single_of_ne (r := r) ((hi _ hj).trans hk).ne + · aesop + · intro s hs + obtain ⟨t, ht, ht'⟩ := exists_between (α := ℝ) hs + refine ⟨i, ?_, t, ?_, ?_⟩ + · simp_all + · simp_all + · grw [trunc_single_of_le le_rfl, ← IH, toIGame_succ_equiv (by simp), trunc_eq_self hi] + simpa using ht'.le + | limit x hx IH => rw [toIGame_limit hx] + +instance numeric_ofSets_truncLT_truncGT (x : SurrealHahnSeries) : + Numeric !{toIGame '' truncLT x | toIGame '' truncGT x} := by + rw [numeric_def] + constructor + · simp_rw [moves_ofSets, Player.cases, forall_mem_image] + intro i hi j hj + exact_mod_cast (lt_of_truncLT hi).trans (gt_of_truncGT hj) + · simp [numeric_toIGame] + +theorem fits_ofSets_truncLT_truncGT (x : SurrealHahnSeries) (i : Ordinal) : + (toIGame x).Fits + !{toIGame '' (x.truncIdx i).truncLT | toIGame '' (x.truncIdx i).truncGT} := by + constructor + all_goals + intro k hk + rw [moves_ofSets] at hk + obtain ⟨k, hk, rfl⟩ := hk + rw [toIGame_le_toIGame_iff, not_le] + exacts [lt_of_truncLT (truncLT_truncIdx_subset hk), gt_of_truncGT (truncGT_truncIdx_subset hk)] + +/-- The surreal that corresponds to a given surreal Hahn series. -/ +@[coe] +def toSurreal (x : SurrealHahnSeries) : Surreal := + .mk x + +@[simp] +theorem mk_toIGame (x : SurrealHahnSeries) : Surreal.mk x.toIGame = toSurreal x := + (rfl) + +instance instCoeSurreal : Coe SurrealHahnSeries Surreal where + coe := toSurreal + +theorem toSurreal_strictMono : StrictMono toSurreal := + toIGame_strictMono + +@[simp, norm_cast] +theorem toSurreal_lt_toSurreal_iff {x y : SurrealHahnSeries} : toSurreal x < toSurreal y ↔ x < y := + toIGame_lt_toIGame_iff + +@[simp, norm_cast] +theorem toSurreal_le_toSurreal_iff {x y : SurrealHahnSeries} : toSurreal x ≤ toSurreal y ↔ x ≤ y := + toIGame_le_toIGame_iff + +@[simp, norm_cast] +theorem toSurreal_inj {x y : SurrealHahnSeries} : toSurreal x = toSurreal y ↔ x = y := + toSurreal_strictMono.injective.eq_iff + +@[simp] +theorem toSurreal_zero : toSurreal 0 = 0 := by simp [toSurreal] + +/-- This is just a special case of `toSurreal_add`. -/ +theorem toSurreal_succ {x : SurrealHahnSeries} + {i : Surreal} {r : ℝ} (hi : ∀ j ∈ x.support, i < j) : + toSurreal (x + single i r) = toSurreal x + r * ω^ i := by + simpa using Surreal.mk_eq (toIGame_succ_equiv hi) + +@[simp] +theorem toSurreal_single (i : Surreal) (r : ℝ) : toSurreal (single i r) = r * ω^ i := by + rw [← zero_add (single i r), toSurreal_succ] <;> simp + +theorem toSurreal_of_length_le_add_one {x : SurrealHahnSeries} {i : Ordinal} + (hi : x.length ≤ i + 1) : toSurreal x = toSurreal (x.truncIdx i) + x.term i := by + obtain hi | hi := hi.eq_or_lt + · conv_lhs => rw [eq_of_length_eq_add_one hi] + rw [toSurreal_succ] + · rw [term_of_lt (by simp [hi])] + · aesop + · rw [Order.lt_add_one_iff] at hi + rw [truncIdx_of_le hi, term_of_le hi, add_zero] + +theorem toSurreal_eq' (x : SurrealHahnSeries) : + toSurreal x = .mk !{toIGame '' truncLT x | toIGame '' truncGT x} := + Surreal.mk_eq <| toIGame_equiv x + +theorem toSurreal_eq (x : SurrealHahnSeries) : + toSurreal x = !{toSurreal '' truncLT x | toSurreal '' truncGT x}'(by + rintro _ ⟨i, hi, rfl⟩ _ ⟨j, hj, rfl⟩ + exact_mod_cast (lt_of_truncLT hi).trans (gt_of_truncGT hj) + ) := by + rw [toSurreal_eq', Surreal.mk_ofSets] + congr <;> aesop + +theorem leadingTerm_sub_truncIdx {x : SurrealHahnSeries} {i : Ordinal} : + Surreal.leadingTerm (x - x.truncIdx i) = x.term i := by + obtain hi | hi := le_or_gt x.length i + · rw [term_of_le hi, truncIdx_of_le hi, sub_self, Surreal.leadingTerm_zero] + · rw [term_of_lt hi] + apply Surreal.leadingTerm_eq (by simpa) <;> refine fun s hs ↦ le_of_lt ?_ + on_goal 1 => rw [lt_sub_iff_add_lt'] + on_goal 2 => rw [sub_lt_iff_lt_add'] + all_goals + rw [← toSurreal_succ (by aesop), toSurreal_lt_toSurreal_iff, lt_def, truncIdx_of_lt hi] + use x.exp ⟨i, hi⟩ + dsimp + refine ⟨fun j hj ↦ ?_, ?_⟩ + · simp only [coeff_add_apply] + rw [coeff_trunc_of_lt hj, coeff_single_of_ne hj.ne] + simp + · rw [coeff_add_apply, coeff_trunc_of_le le_rfl, coeff_single_self, + zero_add, coeff_exp] + exact hs + +theorem birthday_truncIdx_le (x : SurrealHahnSeries) (i : Ordinal) : + Surreal.birthday (x.truncIdx i) ≤ Surreal.birthday x := by + conv_lhs => rw [toSurreal_eq'] + exact (fits_ofSets_truncLT_truncGT ..).birthday_le + +theorem birthday_truncIdx_lt {x : SurrealHahnSeries} {i : Ordinal} (h : i < x.length) : + Surreal.birthday (x.truncIdx i) < Surreal.birthday x := by + conv_lhs => rw [toSurreal_eq'] + apply (fits_ofSets_truncLT_truncGT ..).birthday_lt + grw [← toIGame_equiv, toIGame_equiv_toIGame_iff] + exact (truncIdx_ne h).symm + +theorem birthday_truncIdx_mono (x : SurrealHahnSeries) : + Monotone fun i ↦ Surreal.birthday (truncIdx x i) := by + intro i j h + convert birthday_truncIdx_le (x.truncIdx j) i using 3 + rw [truncIdx_truncIdx, min_eq_right h] + +theorem birthday_truncIdx_strictMonoOn (x : SurrealHahnSeries) : + StrictMonoOn (fun i ↦ Surreal.birthday (truncIdx x i)) (Iio x.length) := by + intro i hi j hj h + convert birthday_truncIdx_lt (x := x.truncIdx j) (i := i) _ using 3 + · rw [truncIdx_truncIdx, min_eq_right h.le] + · simp_all + +theorem birthday_trunc_le (x : SurrealHahnSeries) (i : Surreal) : + Surreal.birthday (x.trunc i) ≤ Surreal.birthday x := by + obtain ⟨j, hj⟩ := trunc_mem_range_truncIdx x i + rw [← hj] + exact birthday_truncIdx_le .. + +theorem birthday_trunc_anti (x : SurrealHahnSeries) : + Antitone fun i ↦ Surreal.birthday (trunc x i) := by + intro i j h + dsimp + convert birthday_trunc_le (x.trunc i) j using 2 + rw [trunc_trunc, max_eq_right h] + +end SurrealHahnSeries + +/-! ### Surreals as Hahn series -/ + +namespace Surreal + +/-- Partial Hahn-series expansions of `x`, ordered by their lengths. -/ +@[ext] +structure PartialSum (x : Surreal) : Type _ where + /-- The underlying `SurrealHahnSeries`. -/ + carrier : SurrealHahnSeries + /-- Every term matches that of `x.toHahnSeries`. -/ + term_eq_leadingTerm_sub {i} (hi : i < carrier.length) : + carrier.term i = (x - carrier.truncIdx i).leadingTerm + +namespace PartialSum +variable {x : Surreal.{u}} + +open SurrealHahnSeries + +instance : Bot (PartialSum x) where + bot := ⟨0, by simp⟩ + +theorem carrier_injective : Function.Injective (carrier (x := x)) := by + intro i j h + ext + rw [h] + +@[simp] +theorem carrier_inj {y z : PartialSum x} : y.carrier = z.carrier ↔ y = z := + carrier_injective.eq_iff + +@[simp] +theorem carrier_bot : carrier (⊥ : PartialSum x) = 0 := + rfl + +/-- The length of the carrier. -/ +def length (y : PartialSum x) : Ordinal := + y.carrier.length + +/-- The length of a partial sum is the length of its Hahn-series carrier. -/ +@[simp] +theorem length_eq_carrier_length (y : PartialSum x) : y.length = y.carrier.length := + (rfl) + +theorem length_bot : length (⊥ : PartialSum x) = 0 := by + simp [length] + +instance : Preorder (PartialSum x) := + .lift length + +instance : WellFoundedLT (PartialSum x) where + wf := InvImage.wf length wellFounded_lt + +instance : WellFoundedRelation (PartialSum x) := + ⟨_, wellFounded_lt⟩ + +theorem length_strictMono : StrictMono (length (x := x)) := + fun _ _ ↦ id + +theorem length_lt_length {y z : PartialSum x} : length y < length z ↔ y < z := .rfl +theorem length_le_length {y z : PartialSum x} : length y ≤ length z ↔ y ≤ z := .rfl + +/-- Truncating the series preserves that it is a partial sum. -/ +def truncIdx (y : PartialSum x) (i : Ordinal) : PartialSum x where + carrier := y.carrier.truncIdx i + term_eq_leadingTerm_sub {j} hj := by + have hj' : j < i := hj.trans_le (by simp) + rw [term_truncIdx_of_lt hj', truncIdx_truncIdx, min_eq_right hj'.le] + apply y.term_eq_leadingTerm_sub (hj.trans_le _) + simp + +@[simp] +theorem carrier_truncIdx (y : PartialSum x) (i : Ordinal) : + (y.truncIdx i).carrier = y.carrier.truncIdx i := + (rfl) + +@[grind =] +theorem length_truncIdx (y : PartialSum x) (i : Ordinal) : (y.truncIdx i).length = min i y.length := + y.carrier.length_truncIdx i + +theorem truncIdx_le (y : PartialSum x) (i : Ordinal) : y.truncIdx i ≤ y := + (length_truncIdx ..).trans_le (min_le_right ..) + +@[simp] +theorem truncIdx_truncIdx (y : PartialSum x) (i j : Ordinal) : + (y.truncIdx i).truncIdx j = y.truncIdx (min i j) := + carrier_injective <| SurrealHahnSeries.truncIdx_truncIdx .. + +theorem truncIdx_length (y : PartialSum x) : y.truncIdx y.length = y := by + apply carrier_injective + rw [carrier_truncIdx, truncIdx_of_le] + rfl + +@[simp] +theorem truncIdx_lt_iff {y : PartialSum x} {i : Ordinal} : y.truncIdx i < y ↔ i < y.length := by + simp [← length_lt_length] + +theorem truncIdx_length_of_le {y z : PartialSum x} (h : y ≤ z) : z.truncIdx y.length = y := by + have hlen : y.length ≤ z.length := h + have IH {i} (hi : i < y.length) : (z.truncIdx y.length).truncIdx i = y.truncIdx i := by + have : y.truncIdx i < y := by simpa + convert truncIdx_length_of_le (y := y.truncIdx i) (z := z) _ using 1 + · simp [min_comm] + · exact (truncIdx_le y i).trans h + refine carrier_injective (term_injective <| funext fun i ↦ ?_) + obtain hi | hi := lt_or_ge i y.length + · rw [term_eq_leadingTerm_sub, term_eq_leadingTerm_sub _ hi] + · congr 3 + rw [← carrier_truncIdx, ← carrier_truncIdx, carrier_inj, IH hi] + · rw [← length_eq_carrier_length, length_truncIdx, min_eq_left hlen] + exact hi + · rw [term_of_le, term_of_le hi] + rw [← length_eq_carrier_length, length_truncIdx, min_eq_left hlen] + exact hi +termination_by y + +theorem length_injective : Function.Injective (length (x := x)) := by + intro y z h + rw [← truncIdx_length_of_le h.le, h, truncIdx_length] + +theorem length_inj {y z : PartialSum x} : length y = length z ↔ y = z := + length_injective.eq_iff + +instance : LinearOrder (PartialSum x) where + le_antisymm y z h₁ h₂ := by + rw [← length_inj] + exact h₁.antisymm h₂ + le_total y z := le_total y.length z.length + toDecidableLE := Classical.decRel _ + +theorem exp_lt_exp {y z : PartialSum x} {i : Iio y.carrier.length} {j : Iio z.carrier.length} + (h : i.1 < j.1) : (z.carrier.exp j).1 < (y.carrier.exp i).1 := by + obtain hyz | hyz := le_total y z + all_goals + rw [exp_congr (carrier_inj.2 (truncIdx_length_of_le hyz).symm), + exp_congr (carrier_truncIdx ..), exp_truncIdx] + simpa + +theorem term_congr {y z : PartialSum x} {i : Ordinal} (hy : i < y.length) (hz : i < z.length) : + term y.carrier i = term z.carrier i := by + obtain hyz | hyz := le_total y z <;> + rwa [← truncIdx_length_of_le hyz, carrier_truncIdx, term_truncIdx_of_lt] + +theorem exp_congr {y z : PartialSum x} {i : Ordinal} (hy : i < y.length) (hz : i < z.length) : + (exp y.carrier ⟨i, by rwa [← length_eq_carrier_length]⟩).1 = + exp z.carrier ⟨i, by rwa [← length_eq_carrier_length]⟩ := by + simp_rw [← wlog_term, term_congr hy hz] + +theorem birthday_strictMono : StrictMono fun y : PartialSum x ↦ birthday y.carrier := by + intro y z h + dsimp + rw [← truncIdx_length_of_le h.le] + exact birthday_truncIdx_lt h + +theorem birthday_le (y : PartialSum x) : birthday y.carrier ≤ birthday x := by + cases x with | mk z + rw [toSurreal_eq'] + apply Fits.birthday_le + unfold truncLT truncGT + constructor + all_goals + rw [moves_ofSets, forall_mem_image, forall_mem_truncAux] + intro i hi r hr + grw [Numeric.not_le, toIGame_succ_equiv (by simp), add_comm] + first | rw [← IGame.lt_sub_iff_add_lt] | rw [← IGame.sub_lt_iff_lt_add] + rw [← Surreal.mk_lt_mk] + apply leadingTerm_mono.reflect_lt + obtain ⟨⟨i, hi'⟩, rfl⟩ := eq_exp_of_mem_support hi + rw [mk_sub, mk_toIGame, trunc_exp, ← term_eq_leadingTerm_sub _ hi', term_of_lt hi'] + simpa using hr + +instance : Small.{u} (PartialSum x) := by + refine small_of_injective (β := Iic x.birthday) (f := fun y ↦ ⟨_, birthday_le y⟩) fun y z h ↦ + birthday_strictMono.injective ?_ + simpa using h + +/-- The term sequence obtained as the supremum of a set of partial Hahn-series expansions. -/ +@[expose] +def sSupAux (s : Set (PartialSum x)) : TermSeq where + length := ⨆ x : s, x.1.length + exp i := + haveI H := (lt_ciSup_iff' Ordinal.bddAbove_of_small).1 i.2 + exp (Classical.choose H).1.1 ⟨_, by + rw [← length_eq_carrier_length] + exact Classical.choose_spec H⟩ + coeff i := + haveI H := (lt_ciSup_iff' Ordinal.bddAbove_of_small).1 i.2 + coeffIdx (Classical.choose H).1.1 i + exp_strictAnti _ _ h := exp_lt_exp h + coeff_ne_zero i := by + generalize_proofs H + rw [ne_eq, coeffIdx_eq_zero_iff, not_le, ← length_eq_carrier_length] + exact Classical.choose_spec H + +@[simp] +theorem length_sSupAux (s : Set (PartialSum x)) : + (sSupAux s).length = ⨆ x : s, x.1.length := + (rfl) + +private theorem term_sSupAux {s : Set (PartialSum x)} {y : PartialSum x} + {i : Ordinal} (hs : i < (sSupAux s).length) (hi : i < y.length) : + term (sSupAux s) i = term y.carrier i := by + have hs' : i < ⨆ x : s, x.1.length := by + rw [← length_sSupAux] + exact hs + unfold sSupAux + generalize_proofs _ H _ + rw [TermSeq.term_coe_of_lt hs', ← term_of_lt (H ⟨i, hs'⟩), + term_congr (by + rw [length_eq_carrier_length] + exact H ⟨i, hs'⟩) hi] + +private theorem truncIdx_sSupAux {s : Set (PartialSum x)} {y : PartialSum x} + {i : Ordinal} (hs : i < (sSupAux s).length) (hy : i < y.length) : + .truncIdx (sSupAux s) i = y.carrier.truncIdx i := by + refine term_injective <| funext fun j ↦ ?_ + obtain hj | hj := lt_or_ge j i + · rw [term_truncIdx_of_lt hj, term_truncIdx_of_lt hj, term_sSupAux (hj.trans hs) (hj.trans hy)] + · rw [term_truncIdx_of_le hj, term_truncIdx_of_le hj] + +/-- Directed union of partial sums. -/ +instance : SupSet (PartialSum x) where + sSup s := ⟨sSupAux s, fun hi ↦ by + have hi' := TermSeq.length_coe (sSupAux s) ▸ hi + obtain ⟨⟨y, hy⟩, hy'⟩ := (lt_ciSup_iff' Ordinal.bddAbove_of_small).1 hi' + rw [truncIdx_sSupAux hi' hy', term_sSupAux hi' hy', term_eq_leadingTerm_sub _ hy'] + ⟩ + +theorem length_sSup (s : Set (PartialSum x)) : (sSup s).length = ⨆ x : s, x.1.length := + TermSeq.length_coe (sSupAux s) + +instance : CompleteSemilatticeSup (PartialSum x) where + __ := instLinearOrder + __ := instSupSet + isLUB_sSup s := ⟨ + fun y hy ↦ by + rw [← length_le_length, length_sSup] + exact le_ciSup Ordinal.bddAbove_of_small (⟨y, hy⟩ : s), + fun y hy ↦ by + rw [← length_le_length, length_sSup, ciSup_le_iff' Ordinal.bddAbove_of_small] + intro a + have ha := hy a.2 + change a.1.length ≤ y.length at ha + exact ha⟩ + +instance : CompleteLattice (PartialSum x) := + completeLatticeOfCompleteSemilatticeSup _ + +instance : CompleteLinearOrder (PartialSum x) where + __ := LinearOrder.toBiheytingAlgebra _ + __ := instCompleteLattice + __ := instLinearOrder + +theorem leadingTerm_sub {y z : PartialSum x} (h : y < z) : + (x - y.carrier).leadingTerm = leadingTerm (z.carrier - y.carrier) := by + rw [← truncIdx_length_of_le h.le, carrier_truncIdx, ← z.term_eq_leadingTerm_sub h, + leadingTerm_sub_truncIdx] + +theorem mk_sub {y z : PartialSum x} (h : y < z) : + ArchimedeanClass.mk (x - y.carrier) = .mk (z.carrier - y.carrier) := by + rw [← mk_leadingTerm, leadingTerm_sub h, mk_leadingTerm] + +theorem mk_le_mk_of_sub {x y : Surreal} (h : ArchimedeanClass.mk x ≤ ArchimedeanClass.mk (x - y)) : + ArchimedeanClass.mk x ≤ .mk y := by + simpa using ArchimedeanClass.mk_left_le_mk_sub h + +theorem mk_sub_strictMono : + StrictMono fun y : PartialSum x ↦ ArchimedeanClass.mk (x - y.carrier) := by + intro y z h + obtain ⟨z, hz⟩ := z + dsimp at * + induction hz' : z.length using SuccOrder.prelimitRecOn generalizing y z with + | succ i _ IH => + have hi : i < z.length := by simp [hz'] + have H : ArchimedeanClass.mk (x - z.truncIdx i) < .mk (x - z) := by + conv_rhs => rw [toSurreal_of_length_le_add_one hz'.le, ← sub_sub] + rw [hz hi] + apply mk_lt_mk_sub_leadingTerm + rwa [ne_eq, ← leadingTerm_eq_zero, ← hz hi, term_eq_zero, not_le] + rw [← length_lt_length] at h + have hy := h.trans_eq hz' + rw [Order.lt_succ_iff] at hy + obtain hy | hy := hy.eq_or_lt + · obtain rfl := hy ▸ truncIdx_length_of_le h.le + exact H + · apply (IH _ (truncIdx ⟨z, hz⟩ i).2 (hy.trans_eq _) _).trans H <;> simp [length, hz'] + | isSuccPrelimit i hi IH => + subst hz' + have hi' := hi.add_one_lt h + apply (IH _ hi' _ (truncIdx ⟨z, hz⟩ (y.length + 1)).2 _ _).trans_le + · apply mk_le_mk_of_sub + simp_rw [sub_sub_sub_cancel_left, ← mk_leadingTerm (_ - _)] + rw [carrier_truncIdx] + rwa [← hz, ← leadingTerm_sub_truncIdx] + · rw [← length_lt_length] + simpa [length] + · simpa + +theorem wlog_sub_lt {y : PartialSum x} (h : x ≠ y.carrier) (i) : + (x - y.carrier).wlog < y.carrier.exp i := by + obtain ⟨i, hi⟩ := i + have hi' : (y.truncIdx i).length = i := by simpa using hi.le + have hy := hi' ▸ hi + rw [← wlog_term, term_eq_leadingTerm_sub _ hi, ← carrier_truncIdx, wlog_leadingTerm] + exact wlog_lt_wlog_of_vlt (by simpa [sub_eq_zero]) (vlt_def.2 <| mk_sub_strictMono hy) + +@[expose] +def succ' (y : PartialSum x) : PartialSum x where + carrier := y.carrier + single (x - y.carrier).wlog (x - y.carrier).leadingCoeff + term_eq_leadingTerm_sub {j} hj := by + obtain hx | hx := eq_or_ne x y.carrier + · simp_all [y.term_eq_leadingTerm_sub] + obtain ⟨y, hy⟩ := y + induction y using termSeqRecOn with | mk s + have hr : (x - ↑↑s).leadingCoeff ≠ 0 := by simpa [sub_eq_zero] + have he : ∀ i, (x - s).wlog < s.exp i := by simpa using wlog_sub_lt hx + rw [← TermSeq.coe_appendSingle hr he] at ⊢ hj + rw [TermSeq.length_coe, TermSeq.appendSingle_length, Order.lt_add_one_iff] at hj + rw [TermSeq.term_coe_of_lt (by simpa), TermSeq.appendSingle_coeff, + ← TermSeq.coe_trunc, TermSeq.trunc_appendSingle hj] + split_ifs with h + · subst h + simp [leadingTerm] + · have hj : j < s.length := hj.lt_of_ne h + rw [TermSeq.coe_trunc, ← hy (by simpa), term_of_lt (by simpa), TermSeq.coeffIdx_coe_of_lt hj] + grind + +private theorem length_succ'_of_ne {y : PartialSum x} (h : x ≠ y.carrier) : + (succ' y).length = y.length + 1 := by + have h' : ¬ x - y.carrier = 0 := by rwa [sub_eq_zero] + apply length_add_single + · intro i hi + obtain ⟨⟨i, hi⟩, rfl⟩ := eq_exp_of_mem_support hi + exact wlog_sub_lt h _ + · rwa [ne_eq, leadingCoeff_eq_zero] + +variable (x) in +/-- The longest partial sum is the one that we're looking for. -/ +theorem coe_carrier_top : (⊤ : PartialSum x).carrier = x := by + by_contra! h + apply (le_top (a := succ' ⊤)).not_gt + rw [← length_lt_length, length_succ'_of_ne h.symm, Order.lt_add_one_iff] + +instance : SuccOrder (PartialSum x) := + .ofCore succ' (by + intro y hy z + rw [isMax_iff_eq_top] at hy + rw [← length_lt_length, ← length_le_length, length_succ'_of_ne, Order.add_one_le_iff] + contrapose! hy + rwa [← carrier_inj, ← toSurreal_inj, coe_carrier_top, eq_comm] + ) (by simp [succ', coe_carrier_top]) + +theorem length_succ_of_ne_top (y : PartialSum x) (h : y ≠ ⊤) : + (succ y).length = y.length + 1 := by + apply length_succ'_of_ne + conv_lhs => rw [← coe_carrier_top x] + rwa [ne_eq, toSurreal_inj, carrier_inj, eq_comm] + +theorem term_succ_length (y : PartialSum x) : + (succ y).carrier.term y.length = (x - y.carrier).leadingTerm := by + obtain rfl | hy := eq_top_or_lt_top y + · rw [succ_top, coe_carrier_top, term_of_le] + · simp + · rfl + · rw [term_eq_leadingTerm_sub] + · rw [← carrier_truncIdx, truncIdx_length_of_le] + exact le_succ y + · exact lt_succ_of_not_isMax hy.not_isMax + +end PartialSum + +variable {x y : Surreal} + +/-- The **Conway normal form** of a surreal number. -/ +@[coe] +def toHahnSeries (x : Surreal) : SurrealHahnSeries := + (⊤ : PartialSum x).carrier + +@[simp] +theorem toSurreal_toHahnSeries (x : Surreal) : x.toHahnSeries = x := + PartialSum.coe_carrier_top x + +@[simp] +theorem PartialSum.carrier_top (x : Surreal) : (⊤ : PartialSum x).carrier = x.toHahnSeries := + (rfl) + +@[simp] +theorem _root_.SurrealHahnSeries.toHahnSeries_toSurreal (x : SurrealHahnSeries) : + x.toSurreal.toHahnSeries = x := by + apply SurrealHahnSeries.toSurreal_strictMono.injective + rw [toSurreal_toHahnSeries] + +/-- `Surreal.toHahnSeries` as an `OrderIso`. -/ +@[simps!, expose] +def toHahnSeriesOrderIso : Surreal ≃o SurrealHahnSeries := + .symm { + toFun := SurrealHahnSeries.toSurreal + invFun := toHahnSeries + left_inv := SurrealHahnSeries.toHahnSeries_toSurreal + right_inv := toSurreal_toHahnSeries + map_rel_iff' := SurrealHahnSeries.toSurreal_le_toSurreal_iff + } + +theorem toHahnSeries_strictMono : StrictMono toHahnSeries := + toHahnSeriesOrderIso.strictMono + +@[simp, norm_cast] +theorem toHahnSeries_lt_toHahnSeries_iff : toHahnSeries x < toHahnSeries y ↔ x < y := + toHahnSeries_strictMono.lt_iff_lt + +@[simp, norm_cast] +theorem toHahnSeries_le_toHahnSeries_iff : toHahnSeries x ≤ toHahnSeries y ↔ x ≤ y := + toHahnSeries_strictMono.le_iff_le + +@[simp, norm_cast] +theorem toHahnSeries_inj : toHahnSeries x = toHahnSeries y ↔ x = y := + toHahnSeries_strictMono.injective.eq_iff + +theorem toHahnSeries_eq {x : Surreal} {y : SurrealHahnSeries} + (h : y.toSurreal = x) : toHahnSeries x = y := by + rw [← h, y.toHahnSeries_toSurreal] + +@[simp, norm_cast] +theorem toHahnSeries_realCast (r : ℝ) : toHahnSeries r = .single 0 r := + toHahnSeries_eq (by simp) + +@[simp, norm_cast] +theorem toHahnSeries_ratCast (q : ℚ) : toHahnSeries q = .single 0 q := + mod_cast toHahnSeries_realCast q + +@[simp, norm_cast] +theorem toHahnSeries_intCast (n : ℤ) : toHahnSeries n = .single 0 n := + mod_cast toHahnSeries_realCast n + +@[simp, norm_cast] +theorem toHahnSeries_natCast (n : ℕ) : toHahnSeries n = .single 0 n := + mod_cast toHahnSeries_realCast n + +@[simp, norm_cast] +theorem toHahnSeries_zero : toHahnSeries 0 = 0 := by + simpa using toHahnSeries_natCast 0 + +@[simp] +theorem toHahnSeries_wpow (x : Surreal) : toHahnSeries (ω^ x) = .single x 1 := + toHahnSeries_eq (by simp) + +@[simp, norm_cast] +theorem toHahnSeries_eq_zero {x : Surreal} : toHahnSeries x = 0 ↔ x = 0 := by + rw [← toHahnSeries_zero, toHahnSeries_inj] + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormAdd.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormAdd.lean new file mode 100644 index 0000000000..f8a783b603 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormAdd.lean @@ -0,0 +1,393 @@ +/- +Copyright (c) 2026 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import Mathlib.Algebra.Order.Hom.Monoid +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Transfer +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Round + +/-! +# Additive compatibility of the surreal Conway normal form + +This module proves that the Conway normal-form order equivalence preserves addition. The argument +follows the additive part of CombinatorialGames PR #263 and fills its unfinished proof obligations +against the pinned dependency. The construction is based on pages 429–431 of Siegel. +-/ + +universe u + +public noncomputable section + +namespace Surreal + +open ArchimedeanClass Order Set SurrealHahnSeries + +namespace PartialSum + +variable {x y : Surreal} (h : x.support ⊆ Ioi y.wlog) + +/-- The Conway series of `x`, regarded as a partial sum of `x + y` when every exponent of `x` +strictly exceeds the leading exponent of `y`. -/ +def ofAdd (x y : Surreal) (h : x.support ⊆ Ioi y.wlog) : PartialSum (x + y) where + carrier := x.toHahnSeries + term_eq_leadingTerm_sub {j} hj := by + rw [← leadingTerm_sub_truncIdx, toSurreal_toHahnSeries] + obtain rfl | hy' := eq_or_ne y 0 + · simp + rw [add_sub_right_comm, leadingTerm_add_eq_left] + nth_rw 1 [← toSurreal_toHahnSeries x] + rw [vlt_def, ← mk_leadingTerm, leadingTerm_sub_truncIdx, mk_term hj, ← vlt_def, + ← wlog_lt_wlog_iff hy' (wpow_ne_zero _), wlog_wpow] + apply h + rw [← support_toHahnSeries] + exact (x.toHahnSeries.exp ⟨j, hj⟩).2 + +@[simp] +theorem carrier_ofAdd : (ofAdd x y h).carrier = x.toHahnSeries := + (rfl) + +theorem length_ofAdd : (ofAdd x y h).length = x.length := by + rw [length_eq_carrier_length, carrier_ofAdd, length_toHahnSeries] + +theorem truncIdx_top_add_length {x y : Surreal} + (h : x.support ⊆ Ioi y.wlog) : + (⊤ : PartialSum (x + y)).truncIdx x.length = ofAdd x y h := + by + rw [← length_ofAdd h] + exact PartialSum.truncIdx_length_of_le (y := ofAdd x y h) le_top + +@[simp] +theorem term_succ_ofAdd_length {x y : Surreal} (h : x.support ⊆ Ioi y.wlog) : + (succ (ofAdd x y h)).carrier.term x.length = y.leadingTerm := by + rw [← length_ofAdd h, term_succ_length, carrier_ofAdd, + toSurreal_toHahnSeries, add_sub_cancel_left] + +end PartialSum + +private theorem truncIdx_add_length_of_subset {x y : Surreal} + (hx : x.support ⊆ Ioi y.wlog) : (x + y).toHahnSeries.truncIdx x.length = x := by + have h := congrArg PartialSum.carrier (PartialSum.truncIdx_top_add_length hx) + have h' := congrArg SurrealHahnSeries.toSurreal h + simpa using h' + +private theorem le_length_add_of_subset {x y : Surreal} + (hx : x.support ⊆ Ioi y.wlog) : x.length ≤ (x + y).length := by + conv_lhs => rw [← truncIdx_add_length_of_subset hx] + simp + +open PartialSum in +private theorem lt_length_add_of_subset {x y : Surreal} + (hx : x.support ⊆ Ioi y.wlog) (hy : y ≠ 0) : x.length < (x + y).length := by + apply (le_length_add_of_subset hx).lt_of_ne + rw [← PartialSum.length_ofAdd hx, ← PartialSum.length_top] + rw [ne_eq, length_inj] + apply_fun carrier + simpa + +private theorem term_add_length_of_subset {x y : Surreal} + (hx : x.support ⊆ Ioi y.wlog) (hy : y ≠ 0) : + (x + y).toHahnSeries.term x.length = y.leadingTerm := by + have hl := lt_length_add_of_subset hx hy + have htop : x.length < (⊤ : PartialSum (x + y)).length := by + simpa using hl + have hbase : PartialSum.ofAdd x y hx < (⊤ : PartialSum (x + y)) := by + rw [← PartialSum.length_lt_length, PartialSum.length_ofAdd, + PartialSum.length_top] + exact hl + have hs : x.length < (succ (PartialSum.ofAdd x y hx)).length := by + rw [← PartialSum.length_ofAdd hx] + exact lt_succ_of_not_isMax hbase.not_isMax + calc + (x + y).toHahnSeries.term x.length = + (⊤ : PartialSum (x + y)).carrier.term x.length := + congrArg (fun q : SurrealHahnSeries ↦ q.term x.length) + (PartialSum.carrier_top (x + y)).symm + _ = (succ (PartialSum.ofAdd x y hx)).carrier.term x.length := + PartialSum.term_congr htop hs + _ = y.leadingTerm := PartialSum.term_succ_ofAdd_length hx + +private theorem exp_add_length_of_subset {x y : Surreal} + (hx : x.support ⊆ Ioi y.wlog) (hy : y ≠ 0) : + ↑((x + y).toHahnSeries.exp ⟨x.length, by + simpa using lt_length_add_of_subset hx hy⟩) = y.wlog := by + rw [← SurrealHahnSeries.wlog_term, term_add_length_of_subset hx hy, + wlog_leadingTerm] + +open PartialSum in +private theorem trunc_add_of_subset {x y i : Surreal} + (hx : x.support ⊆ Ioi i) (hy : y ≤ᵥ ω^ i) : (x + y).trunc i = x := by + obtain rfl | hy' := eq_or_ne y 0 + · rw [add_zero] + exact trunc_eq_self hx + have hy'' : y.wlog ≤ i := by + simpa using wlog_le_wlog_of_vle hy' hy + have hx' : x.support ⊆ Ioi y.wlog := hx.trans (by simpa) + have hl := lt_length_add_of_subset hx' hy' + have hl' : x.length < (x + y).toHahnSeries.length := by + simpa using hl + conv_rhs => rw [← truncIdx_add_length_of_subset hx'] + rw [truncIdx_of_lt hl'] + rw [SurrealHahnSeries.toSurreal_trunc] + rw [toSurreal_toHahnSeries] + let e : Surreal := ↑((x + y).toHahnSeries.exp ⟨x.length, hl'⟩) + have he : e = y.wlog := by + exact exp_add_length_of_subset hx' hy' + apply (trunc_eq_trunc (he.le.trans hy'') _).symm + intro k hek hki + apply notMem_support_iff.mp + intro hk + have hkTrunc : k ∈ ((x + y).trunc e).support := by + rw [support_trunc] + exact ⟨hk, hek⟩ + have htrunc : (x + y).trunc e = x := by + nth_rw 1 [← toSurreal_toHahnSeries (x + y)] + rw [← SurrealHahnSeries.toSurreal_trunc, ← truncIdx_of_lt hl', + truncIdx_add_length_of_subset hx'] + have hkx : k ∈ x.support := by + rwa [htrunc] at hkTrunc + exact (not_lt_of_ge hki) (hx hkx) + +private theorem coeff_add_of_subset {x y i : Surreal} + (hx : x.support ⊆ Ioi i) (hy : y ≤ᵥ ω^ i) : + (x + y).coeff i = stdPart (y / ω^ i) := by + obtain rfl | hy' := eq_or_ne y 0 + · simp only [add_zero, zero_div, stdPart_zero] + apply notMem_support_iff.mp + intro hi + exact (lt_irrefl i) (hx hi) + have hylog : y.wlog ≤ i := by + simpa using wlog_le_wlog_of_vle hy' hy + obtain heq | hlt := hylog.eq_or_lt + · subst i + have hexp := exp_add_length_of_subset hx hy' + rw [← coeff_toHahnSeries, ← hexp, SurrealHahnSeries.coeff_exp, + ← SurrealHahnSeries.leadingCoeff_term, + term_add_length_of_subset hx hy', leadingCoeff_leadingTerm, leadingCoeff, + hexp] + · have hxlog : x.support ⊆ Ioi y.wlog := fun _ hk ↦ hlt.trans (hx hk) + have htrunc : (x + y).trunc y.wlog = x := + trunc_add_of_subset hxlog (wpow_wlog_veq hy').symm.1 + have hcoeff : (x + y).coeff i = 0 := by + apply notMem_support_iff.mp + intro hi + have hiTrunc : i ∈ ((x + y).trunc y.wlog).support := by + rw [support_trunc] + exact ⟨hi, hlt⟩ + rw [htrunc] at hiTrunc + exact (lt_irrefl i) (hx hiTrunc) + rw [hcoeff] + symm + rw [stdPart_eq_zero] + apply ne_of_gt + rw [ArchimedeanClass.mk_div, LinearOrderedAddCommGroupWithTop.sub_pos] + left + apply vlt_def.mp + rw [← wlog_lt_wlog_iff hy' (wpow_ne_zero _), wlog_wpow] + exact hlt + +private theorem sub_trunc_vle_wpow (x i : Surreal) : x - x.trunc i ≤ᵥ ω^ i := by + let s := x.toHahnSeries + obtain ⟨j, hj⟩ := SurrealHahnSeries.trunc_mem_range_truncIdx s i + have hsx : s.toSurreal = x := by + simp [s] + have htr : (s.trunc i).toSurreal = x.trunc i := by + rw [SurrealHahnSeries.toSurreal_trunc, hsx] + have hlead : (x - x.trunc i).leadingTerm = s.term j := by + calc + (x - x.trunc i).leadingTerm = + (s.toSurreal - (s.truncIdx j).toSurreal).leadingTerm := by + rw [hsx, hj, htr] + _ = s.term j := SurrealHahnSeries.leadingTerm_sub_truncIdx + obtain hjlen | hjlen := lt_or_ge j s.length + · have hexpLe : ↑(s.exp ⟨j, hjlen⟩) ≤ i := by + by_contra hle + have hiExp : i < ↑(s.exp ⟨j, hjlen⟩) := lt_of_not_ge hle + have hmem : ↑(s.exp ⟨j, hjlen⟩) ∈ (s.trunc i).support := by + rw [SurrealHahnSeries.support_trunc] + exact ⟨(s.exp ⟨j, hjlen⟩).2, hiExp⟩ + rw [← hj, SurrealHahnSeries.support_truncIdx, dif_pos hjlen] at hmem + have hfalse : ↑(s.exp ⟨j, hjlen⟩) < ↑(s.exp ⟨j, hjlen⟩) := by + simpa using hmem.2 + exact (lt_irrefl _) hfalse + have hrem : x - x.trunc i ≠ 0 := by + intro hzero + have htermNe : s.term j ≠ 0 := by + rw [ne_eq, SurrealHahnSeries.term_eq_zero, not_le] + exact hjlen + apply htermNe + rw [← hlead, hzero, leadingTerm_zero] + rw [← wlog_le_wlog_iff hrem (wpow_ne_zero _), wlog_wpow, + ← wlog_leadingTerm, hlead, SurrealHahnSeries.wlog_term hjlen] + exact hexpLe + · have hzero : x - x.trunc i = 0 := by + rw [← leadingTerm_eq_zero, hlead, SurrealHahnSeries.term_of_le hjlen] + simp [hzero] + +/-- A Conway coefficient is the standard part of the remainder after truncation, divided by its +corresponding monomial. -/ +theorem coeff_eq_stdPart {x i : Surreal} : + x.coeff i = stdPart ((x - x.trunc i) / ω^ i) := by + conv_lhs => rw [← add_sub_cancel (x.trunc i) x] + apply coeff_add_of_subset + · simp + · exact sub_trunc_vle_wpow x i + +theorem support_subset_of_round_eq {x y : Surreal} (hx : x.round y = x) (hy : 0 < y) : + x.support ⊆ Ici y.wlog := by + intro z hzy + rw [mem_Ici] + contrapose! hzy + intro hz + have hz' : z ∈ x.toHahnSeries.support := by + simpa using hz + obtain ⟨i, rfl⟩ := SurrealHahnSeries.eq_exp_of_mem_support hz' + have H : ArchimedeanClass.mk y < .mk (x - x.toHahnSeries.truncIdx i) := by + nth_rw 1 [← toSurreal_toHahnSeries x] + conv_rhs => rw [← mk_leadingTerm, SurrealHahnSeries.leadingTerm_sub_truncIdx, + SurrealHahnSeries.mk_term i.2] + rw [← vlt_def, ← wlog_lt_wlog_iff (by simp) hy.ne'] + simpa + refine (@birthday_round_le x (x.toHahnSeries.truncIdx i) y ⟨?_, ?_⟩).not_gt ?_ + · rw [sub_lt_comm] + exact lt_of_mk_lt_mk_of_nonneg H hy.le + · rw [← sub_lt_iff_lt_add'] + apply lt_of_mk_lt_mk_of_nonneg _ hy.le + rwa [mk_sub_comm] + · apply (SurrealHahnSeries.birthday_truncIdx_lt i.2).trans_eq + simp [hx] + +theorem support_subset_of_round_wpow_eq {x y : Surreal} (h : x.round (ω^ y) = x) : + x.support ⊆ Ici y := by + simpa using support_subset_of_round_eq h + +theorem eq_round_of_support_subset {x y : Surreal} + (hx : x.support ⊆ Ioi y.wlog) (hy : 0 < y) : x.round y = x := by + apply round_eq_of_forall_birthday_le + · simpa + · intro w hw + convert SurrealHahnSeries.birthday_trunc_le w.toHahnSeries y.wlog + · symm + rw [SurrealHahnSeries.toSurreal_trunc, toSurreal_toHahnSeries] + calc + w.trunc y.wlog = (x + (w - x)).trunc y.wlog := by + congr 2 + abel + _ = x := trunc_add_of_subset hx <| by + have habs : |w - x| < y := by + rw [abs_lt] + constructor <;> linarith [hw.1, hw.2] + apply ValuativeRel.vle_trans _ (wpow_wlog_veq hy.ne').symm.1 + rw [vle_def] + exact ArchimedeanClass.mk_le_mk_of_abs (by simpa [abs_of_pos hy] using habs.le) + · exact (toSurreal_toHahnSeries w).symm + +theorem eq_round_wpow_of_support_subset {x y : Surreal} (hx : x.support ⊆ Ioi y) : + x.round (ω^ y) = x := + eq_round_of_support_subset (by simpa) (by simp) + +private theorem support_add_subset_Ioi {x y z : Surreal} + (hx : x.support ⊆ Ioi z) (hy : y.support ⊆ Ioi z) : (x + y).support ⊆ Ioi z := by + apply (support_subset_of_round_wpow_eq (y := !{{z} | x.support ∪ y.support}) _).trans + · aesop + · apply round_add_of_eq + all_goals + refine eq_round_wpow_of_support_subset fun w hw ↦ ?_ + aesop + +/-- The Conway normal-form order equivalence preserves addition. -/ +@[simp] +theorem toHahnSeries_add (x y : Surreal) : + (x + y).toHahnSeries = x.toHahnSeries + y.toHahnSeries := by + ext i + rw [coeff_toHahnSeries, SurrealHahnSeries.coeff_add_apply] + trans ((x.trunc i + y.trunc i) + + ((x - x.trunc i) + (y - y.trunc i))).coeff i + · abel_nf + · rw [coeff_add_of_subset, add_div, stdPart_add] + · rw [coeff_toHahnSeries x, coeff_toHahnSeries y, coeff_eq_stdPart, + coeff_eq_stdPart] + · rw [ArchimedeanClass.mk_div] + obtain heq | hlt := (vle_def.mp (sub_trunc_vle_wpow x i)).eq_or_lt + · rw [heq] + exact LinearOrderedAddCommGroupWithTop.sub_self_nonneg + · exact (LinearOrderedAddCommGroupWithTop.sub_pos.mpr (Or.inl hlt)).le + · rw [ArchimedeanClass.mk_div] + obtain heq | hlt := (vle_def.mp (sub_trunc_vle_wpow y i)).eq_or_lt + · rw [heq] + exact LinearOrderedAddCommGroupWithTop.sub_self_nonneg + · exact (LinearOrderedAddCommGroupWithTop.sub_pos.mpr (Or.inl hlt)).le + · apply support_add_subset_Ioi <;> simp + · apply ValuativeRel.vle_add <;> exact sub_trunc_vle_wpow _ _ + +/-- Conway coefficients are additive. -/ +@[simp] +theorem coeff_add (x y : Surreal) : (x + y).coeff = x.coeff + y.coeff := by + rw [← coeff_toHahnSeries, toHahnSeries_add, + SurrealHahnSeries.coeff_add, coeff_toHahnSeries, coeff_toHahnSeries] + +/-- The Conway support of a sum is contained in the union of the two source supports. -/ +theorem support_add_subset {x y : Surreal} : + (x + y).support ⊆ x.support ∪ y.support := by + intro i hi + have hi' : i ∈ (x.toHahnSeries + y.toHahnSeries).support := by + rw [← toHahnSeries_add] + simpa only [support_toHahnSeries] using hi + have hout := SurrealHahnSeries.support_add_subset hi' + simpa only [support_toHahnSeries] using hout + +/-- The Conway normal form as an order-preserving additive equivalence. -/ +def toHahnSeriesOrderAddMonoidIso : Surreal ≃+o SurrealHahnSeries where + toEquiv := toHahnSeriesOrderIso.toEquiv + map_add' := toHahnSeries_add + map_le_map_iff' := toHahnSeries_le_toHahnSeries_iff + +@[simp] +theorem toHahnSeriesOrderAddMonoidIso_apply (x : Surreal) : + toHahnSeriesOrderAddMonoidIso x = x.toHahnSeries := + (rfl) + +@[simp] +theorem toHahnSeriesOrderAddMonoidIso_symm_apply (x : SurrealHahnSeries) : + toHahnSeriesOrderAddMonoidIso.symm x = x.toSurreal := + (rfl) + +/-- The Conway normal form of one is the singleton series at exponent zero. -/ +@[simp] +theorem toHahnSeries_one : (1 : Surreal).toHahnSeries = .single 0 1 := by + simpa using toHahnSeries_realCast (1 : ℝ) + +/-- The Conway coefficient function of one is supported at exponent zero. -/ +@[simp] +theorem coeff_one : (1 : Surreal).coeff = Pi.single 0 1 := by + rw [← coeff_toHahnSeries, toHahnSeries_one, SurrealHahnSeries.coeff_single] + +/-- Negation of a surreal number agrees with coefficientwise negation of its Conway normal form. -/ +@[simp] +theorem toHahnSeries_neg (x : Surreal) : (-x).toHahnSeries = -x.toHahnSeries := by + apply eq_neg_of_add_eq_zero_left + rw [← toHahnSeries_add, neg_add_cancel, toHahnSeries_zero] + +/-- Conway coefficients commute with negation. -/ +@[simp] +theorem coeff_neg (x : Surreal) : (-x).coeff = -x.coeff := by + rw [← coeff_toHahnSeries, toHahnSeries_neg, + SurrealHahnSeries.coeff_neg, coeff_toHahnSeries] + +/-- Addition of surreal Hahn series agrees with addition of their surreal values. -/ +@[simp] +theorem _root_.SurrealHahnSeries.toSurreal_add (x y : SurrealHahnSeries) : + (x + y).toSurreal = x.toSurreal + y.toSurreal := + toHahnSeriesOrderAddMonoidIso.symm.map_add x y + +/-- Negation of a surreal Hahn series agrees with negation of its surreal value. -/ +@[simp] +theorem _root_.SurrealHahnSeries.toSurreal_neg (x : SurrealHahnSeries) : + (-x).toSurreal = -x.toSurreal := + eq_neg_of_add_eq_zero_left <| by + rw [← SurrealHahnSeries.toSurreal_add, neg_add_cancel, + SurrealHahnSeries.toSurreal_zero] + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormBasic.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormBasic.lean new file mode 100644 index 0000000000..f773d6ca6e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormBasic.lean @@ -0,0 +1,259 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov, Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic + +/-! +# Ordinal-indexed presentations of surreal Hahn series + +This module supplies the sequence presentation used in the Conway normal-form construction. It +follows CombinatorialGames PR #316 by Violeta Hernández Palacios, adapted as a downstream module +so the pinned dependency remains unchanged. +-/ + +universe u + +public noncomputable section + +instance {α β : Type*} {r : α → α → Prop} {s} [IsWellOrder β s] : + Subsingleton (r ≃r s) where + allEq f g := by + ext x + change f.toInitialSeg x = g.toInitialSeg x + congr 1 + subsingleton + +open Order Set + +namespace SurrealHahnSeries + +open Ordinal + +/-- Vanishing of a coefficient is nonmembership in the support. -/ +theorem notMem_support_iff {x : SurrealHahnSeries} {i : Surreal} : + i ∉ x.support ↔ x.coeff i = 0 := + mem_support_iff.not_left + +/-! ### Assemble Hahn series from sequences -/ + +/-- An ordinal-indexed strictly decreasing sequence of exponents with bundled coefficients. -/ +structure TermSeq : Type (u + 1) where + /-- The length of the sequence. -/ + protected length : Ordinal.{u} + /-- The exponents in the sequence. -/ + protected exp : Iio length → Surreal.{u} + /-- The coefficients in the sequence. -/ + protected coeff : Iio length → ℝ + /-- The sequence of exponents must be strictly antitone. -/ + exp_strictAnti : StrictAnti exp + /-- All of the coefficients must be non-zero. -/ + coeff_ne_zero (i) : coeff i ≠ 0 + +namespace TermSeq + +attribute [simp, grind .] coeff_ne_zero + +@[ext] +theorem ext {s t : TermSeq} (hl : s.length = t.length) + (he : ∀ i (hs : i < s.length) (ht : i < t.length), s.exp ⟨i, hs⟩ = t.exp ⟨i, ht⟩) + (hc : ∀ i (hs : i < s.length) (ht : i < t.length), s.coeff ⟨i, hs⟩ = t.coeff ⟨i, ht⟩) : + s = t := by + cases s + cases t + cases hl + simp_rw [mk.injEq, heq_eq_eq, true_and] + constructor <;> ext + · exact he .. + · exact hc .. + +@[simp, grind =] +theorem exp_lt_exp_iff {s : TermSeq} {i j} : s.exp i < s.exp j ↔ j < i := + s.exp_strictAnti.lt_iff_gt + +@[simp, grind =] +theorem exp_le_exp_iff {s : TermSeq} {i j} : s.exp i ≤ s.exp j ↔ j ≤ i := + s.exp_strictAnti.le_iff_ge + +@[simp, grind =] +theorem exp_inj {s : TermSeq} {i j} : s.exp i = s.exp j ↔ i = j := + s.exp_strictAnti.injective.eq_iff + +@[simps] +instance : Zero TermSeq where + zero := .mk 0 0 0 (fun _ ↦ by simp) (by simp) + +@[simp, grind =] +theorem length_eq_zero {s : TermSeq} : s.length = 0 ↔ s = 0 where + mp h := by + ext x _ hx + · rw [h, zero_length] + · simp at hx + · simp at hx + mpr := by simp +contextual + +open Classical in +private theorem toSurrealHahnSeries_aux (o : Ordinal.{u}) (f : Iio o → Surreal.{u} × ℝ) : + Function.support (fun i ↦ if h : ∃ o, (f o).1 = i then (f <| Classical.choose h).2 else 0) ⊆ + range (Prod.fst ∘ f) := by + aesop + +/-- Cast a sequence of terms into a `SurrealHahnSeries`. -/ +@[coe] +def toSurrealHahnSeries (s : TermSeq) : SurrealHahnSeries := + have H := toSurrealHahnSeries_aux s.length fun i ↦ (s.exp i, s.coeff i) + .mk _ (small_subset H) (.subset (by + rw [wellFoundedOn_range] + convert wellFounded_lt (α := Iio s.length) + ext + exact s.exp_strictAnti.lt_iff_gt + ) H) + +instance : Coe TermSeq SurrealHahnSeries where + coe := toSurrealHahnSeries + +/-- Build a `TermSeq` from a `SurrealHahnSeries`. -/ +@[simps, expose] +def ofSurrealHahnSeries (x : SurrealHahnSeries) : TermSeq where + length := x.length + exp := (↑) ∘ x.exp + coeff i := x.coeffIdx i + exp_strictAnti _ := by simp + coeff_ne_zero := by simp + +@[simp, grind =] +theorem coeff_coe {s : TermSeq} (i : Iio s.length) : coeff s (s.exp i) = s.coeff i := by + rw [toSurrealHahnSeries, coeff_mk, dif_pos ⟨i, rfl⟩] + generalize_proofs H + rw [s.exp_strictAnti.injective <| Classical.choose_spec H] + +theorem coeff_coe_of_notMem {s : TermSeq} {x : Surreal} (h : x ∉ range s.exp) : coeff s x = 0 := by + grind [toSurrealHahnSeries] + +@[simp, grind =] +theorem support_coe (s : TermSeq) : support s = range s.exp := by + ext i + by_cases hi : i ∈ range s.exp + · obtain ⟨i, rfl⟩ := hi + simp + · grind [coeff_coe_of_notMem hi] + +/-- Order isomorphism between `Iio x.length` and the range of `x.exp`. -/ +private def relIso' (s : TermSeq) : (· < · : Iio s.length → _) ≃r (· > · : range s.exp → _) := by + refine .ofSurjective ⟨⟨fun i ↦ ⟨s.exp i, ⟨i, rfl⟩⟩, fun a b h ↦ s.exp_strictAnti.injective ?_⟩, + s.exp_lt_exp_iff⟩ fun _ ↦ ?_ <;> aesop + +/-- Order isomorphism between `Iio s.length` and the support of `x`. -/ +private def relIso (s : TermSeq) : (· < · : Iio s.length → _) ≃r (· > · : support s → _) := + (relIso' s).trans (RelIso.subrel (· > ·) (by simp)) + +@[simp, grind =] +theorem length_coe (s : TermSeq) : length s = s.length := by + rw [← lift_inj, ← type_support, ← type_lt_Iio] + exact (relIso s).ordinalType_congr.symm + +@[simp, grind =] +theorem exp_coe (s : TermSeq) (i) : exp s i = s.exp ⟨i, by simpa using i.2⟩ := by + let e : (· < · : Iio (length (s : SurrealHahnSeries)) → _) ≃r + (· > · : support (s : SurrealHahnSeries) → _) := + RelIso.ofSurjective + { toFun := fun j ↦ + ⟨s.exp ⟨j, by simpa using j.2⟩, by + rw [support_coe] + exact ⟨⟨j, by simpa using j.2⟩, rfl⟩⟩ + inj' := fun a b h ↦ by + apply_fun Subtype.val at h + have hab : + (⟨a, by simpa using a.2⟩ : Iio s.length) = + ⟨b, by simpa using b.2⟩ := + s.exp_strictAnti.injective h + exact Subtype.ext (congrArg (fun z : Iio s.length ↦ z.1) hab) + map_rel_iff' := by + intro a b + change s.exp ⟨a, by simpa using a.2⟩ > s.exp ⟨b, by simpa using b.2⟩ ↔ + a < b + constructor + · intro h + exact (s.exp_strictAnti.lt_iff_gt.mp h : _) + · intro h + exact s.exp_strictAnti h } + (by + rintro ⟨j, hj⟩ + rw [support_coe] at hj + obtain ⟨k, rfl⟩ := hj + exact ⟨⟨k, by rw [length_coe]; exact k.2⟩, rfl⟩) + have hexp : exp (s : SurrealHahnSeries) = e := Subsingleton.elim _ _ + rw [hexp] + rfl + +theorem coeffIdx_coe_of_lt {s : TermSeq} {i} (h : i < s.length) : + coeffIdx s i = s.coeff ⟨i, h⟩ := by + rw [coeffIdx_of_lt (by simpa), exp_coe, coeff_coe] + +theorem coeffIdx_coe_of_le {s : TermSeq} {i} (h : s.length ≤ i) : coeffIdx s i = 0 := + coeffIdx_of_le (by simpa) + +@[aesop simp] +theorem coeffIdx_coe (s : TermSeq) (i) : + coeffIdx s i = if h : i < s.length then s.coeff ⟨i, h⟩ else 0 := by + split_ifs with h + · exact coeffIdx_coe_of_lt h + · exact coeffIdx_coe_of_le (le_of_not_gt h) + +theorem term_coe_of_lt {s : TermSeq} {i} (h : i < s.length) : + term s i = s.coeff ⟨i, h⟩ * ω^ s.exp ⟨i, h⟩ := by + rw [term_of_lt (by simpa), coeffIdx_coe_of_lt, exp_coe] + +theorem term_coe_of_le {s : TermSeq} {i} (h : s.length ≤ i) : term s i = 0 := + term_of_le (by simpa) + +@[aesop simp] +theorem term_coe (s : TermSeq) (i) : + term s i = if h : i < s.length then s.coeff ⟨i, h⟩ * ω^ s.exp ⟨i, h⟩ else 0 := by + split_ifs with h + · exact term_coe_of_lt h + · exact term_coe_of_le (le_of_not_gt h) + +/-- `TermSeq` and `SurrealHahnSeries` are alternate representations for the same structure. -/ +@[simps!, expose] +def surrealHahnSeriesEquiv : TermSeq ≃ SurrealHahnSeries where + toFun := toSurrealHahnSeries + invFun := ofSurrealHahnSeries + left_inv s := by + ext x _ h + · simp + · simp + · simp [coeffIdx_coe_of_lt h] + right_inv x := by + ext i + by_cases h : i ∈ x.support + · obtain ⟨i, hi, rfl⟩ := eq_exp_of_mem_support h + apply (coeff_coe (s := ofSurrealHahnSeries x) i).trans + simp + · have hx : x.coeff i = 0 := by rwa [← notMem_support_iff] + rw [coeff_coe_of_notMem, hx] + simpa [ofSurrealHahnSeries] + +@[simp] +theorem coe_ofSurrealHahnSeries (x : SurrealHahnSeries) : ofSurrealHahnSeries x = x := + surrealHahnSeriesEquiv.apply_symm_apply x + +@[simp] +theorem ofSurrealHahnSeries_coe (x : TermSeq) : ofSurrealHahnSeries x = x := + surrealHahnSeriesEquiv.symm_apply_apply x + +@[simp] +theorem coe_inj {x y : TermSeq} : (x : SurrealHahnSeries) = y ↔ x = y := + surrealHahnSeriesEquiv.apply_eq_iff_eq + +@[simp] +theorem ofSurrealHahnSeries_inj {x y : SurrealHahnSeries} : + ofSurrealHahnSeries x = ofSurrealHahnSeries y ↔ x = y := + surrealHahnSeriesEquiv.symm.apply_eq_iff_eq + +end TermSeq + +end SurrealHahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormMul.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormMul.lean new file mode 100644 index 0000000000..1658398a90 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormMul.lean @@ -0,0 +1,1251 @@ +/- +Copyright (c) 2026 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +/- +Continues and modifies the Apache-2.0-licensed Conway normal-form work in CombinatorialGames PR +#263: https://github.com/vihdzp/combinatorial-games/pull/263 +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormAdd + +import all LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic + +/-! +# Multiplicative compatibility of the surreal Conway normal form + +This module develops the multiplication-option comparison needed to prove that the Conway +normal-form equivalence preserves multiplication. The central cofinality lemmas show that every +coefficient truncation on either side of a Hahn product is separated from the product by a Conway +multiplication option formed from coefficient truncations of its factors. + +The two elementary Hahn-series interface lemmas at the start expose multiplication facts that are +currently hidden behind the opaque `SurrealHahnSeries` field instance in CombinatorialGames. +-/ + +universe u + +open IGame Order Set + +public noncomputable section + +namespace SurrealHahnSeries + +private theorem ofLex_coe_mul (x y : SurrealHahnSeries) : + ofLex (x * y).1 = ofLex x.1 * ofLex y.1 := by + with_unfolding_all rfl + +private theorem ofLex_coe_single (p : Surreal) (r : ℝ) : + ofLex (single p r).1 = HahnSeries.single (OrderDual.toDual p) r := by + apply HahnSeries.ext + funext k + rw [HahnSeries.coeff_single] + unfold single mk + by_cases hk : k = OrderDual.toDual p + · subst k + simp + · have hk' : k.ofDual ≠ p := fun h ↦ hk (by simpa using congrArg OrderDual.toDual h) + simp [hk, hk'] + +private theorem mem_support_ofLex_coe_iff (x : SurrealHahnSeries) (k : Surreal) : + OrderDual.toDual k ∈ (ofLex x.1).support ↔ k ∈ x.support := by + rfl + +private theorem ofLex_coe_zero : ofLex (0 : SurrealHahnSeries).1 = 0 := by + with_unfolding_all rfl + +private theorem ofLex_coe_ne_zero {x : SurrealHahnSeries} (hx : x ≠ 0) : + ofLex x.1 ≠ 0 := by + intro hzero + apply hx + apply Subtype.ext + rw [← ofLex_inj, hzero, ofLex_coe_zero] + +private theorem ofLex_coe_order_eq_exp_zero {x : SurrealHahnSeries} (hx : x ≠ 0) : + (ofLex x.1).order = OrderDual.toDual (x.exp ⟨0, by + change 0 < x.length + rw [pos_iff_ne_zero, ne_eq, length_eq_zero] + exact hx⟩).1 := by + have hlength : 0 < x.length := by + rw [pos_iff_ne_zero, ne_eq, length_eq_zero] + exact hx + have hxRaw : ofLex x.1 ≠ 0 := ofLex_coe_ne_zero hx + apply WithTop.coe_inj.mp + rw [HahnSeries.order_eq_orderTop_of_ne_zero hxRaw] + apply HahnSeries.orderTop_eq_of_le + · rw [mem_support_ofLex_coe_iff] + exact (x.exp ⟨0, hlength⟩).2 + · intro k hk + have hk' : k.ofDual ∈ x.support := by + simpa using (mem_support_ofLex_coe_iff x k.ofDual).1 (by simpa using hk) + let j := x.exp.symm ⟨k.ofDual, hk'⟩ + have hj : (⟨0, hlength⟩ : Iio x.length) ≤ j := by + change (0 : Ordinal) ≤ j.1 + exact bot_le + have hexp : x.exp j ≤ x.exp ⟨0, hlength⟩ := x.exp_anti hj + change k.ofDual ≤ (x.exp ⟨0, hlength⟩).1 + change (x.exp j).1 ≤ (x.exp ⟨0, hlength⟩).1 at hexp + dsimp [j] at hexp + simpa only [x.exp.apply_symm_apply] using hexp + +private theorem ofLex_coe_leadingCoeff_eq_coeffIdx_zero {x : SurrealHahnSeries} + (hx : x ≠ 0) : + (ofLex x.1).leadingCoeff = x.coeffIdx 0 := by + rw [HahnSeries.leadingCoeff_eq, ofLex_coe_order_eq_exp_zero hx, + x.coeffIdx_of_lt (by + rw [pos_iff_ne_zero, ne_eq, length_eq_zero] + exact hx)] + rfl + +/-- Lexicographic comparison of surreal Hahn series, stated directly in terms of their public +coefficient function. -/ +theorem lt_iff_exists_coeff {x y : SurrealHahnSeries} : + x < y ↔ ∃ i : Surreal, (∀ j, i < j → x.coeff j = y.coeff j) ∧ + x.coeff i < y.coeff i := by + rfl + +/-- The multiplicative unit is the singleton surreal Hahn series at exponent zero. -/ +theorem one_eq_single_zero : (1 : SurrealHahnSeries) = single 0 1 := by + apply Subtype.ext + rw [← ofLex_inj, ofLex_coe_single] + with_unfolding_all rfl + +/-- An integer cast is the constant singleton surreal Hahn series. -/ +theorem intCast_eq_single_zero (n : ℤ) : + (n : SurrealHahnSeries) = single 0 (n : ℝ) := by + apply Subtype.ext + rw [← ofLex_inj, ofLex_coe_single] + with_unfolding_all rfl + +/-- Conway normal forms preserve multiplication by an integer on the left. -/ +theorem _root_.Surreal.toHahnSeries_intCast_mul (n : ℤ) (x : Surreal) : + ((n : Surreal) * x).toHahnSeries = + SurrealHahnSeries.single 0 (n : ℝ) * x.toHahnSeries := by + have hsource : (n : Surreal) * x = n • x := by + rw [← Int.cast_smul_eq_zsmul Surreal] + rfl + have htarget : SurrealHahnSeries.single 0 (n : ℝ) * x.toHahnSeries = + n • x.toHahnSeries := by + rw [← SurrealHahnSeries.intCast_eq_single_zero, + ← Int.cast_smul_eq_zsmul SurrealHahnSeries] + rfl + rw [hsource, htarget] + calc + (n • x).toHahnSeries = + Surreal.toHahnSeriesOrderAddMonoidIso (n • x) := + (Surreal.toHahnSeriesOrderAddMonoidIso_apply _).symm + _ = n • Surreal.toHahnSeriesOrderAddMonoidIso x := + map_zsmul Surreal.toHahnSeriesOrderAddMonoidIso.toAddEquiv n x + _ = n • x.toHahnSeries := by + rw [Surreal.toHahnSeriesOrderAddMonoidIso_apply] + +/-- Conway normal forms preserve multiplication by an integer on the right. -/ +theorem _root_.Surreal.toHahnSeries_mul_intCast (x : Surreal) (n : ℤ) : + (x * (n : Surreal)).toHahnSeries = + x.toHahnSeries * SurrealHahnSeries.single 0 (n : ℝ) := by + rw [mul_comm x, Surreal.toHahnSeries_intCast_mul, mul_comm] + +/-- The surreal value map commutes with rational scalar multiplication. -/ +theorem toSurreal_rat_smul (q : ℚ) (x : SurrealHahnSeries.{u}) : + (q • x).toSurreal = q • x.toSurreal := by + rw [← Surreal.toHahnSeriesOrderAddMonoidIso_symm_apply (q • x), + ← Surreal.toHahnSeriesOrderAddMonoidIso_symm_apply x] + exact map_rat_smul Surreal.toHahnSeriesOrderAddMonoidIso.symm.toAddMonoidHom q x + +/-- A rational cast is the constant singleton surreal Hahn series. -/ +theorem ratCast_eq_single_zero (q : ℚ) : + (q : SurrealHahnSeries.{u}) = single 0 (q : ℝ) := by + calc + (q : SurrealHahnSeries.{u}) = q • (1 : SurrealHahnSeries) := by simp + _ = q • (1 : Surreal).toHahnSeries := by + exact congrArg (fun z : SurrealHahnSeries ↦ q • z) <| + one_eq_single_zero.trans Surreal.toHahnSeries_one.symm + _ = (q • (1 : Surreal)).toHahnSeries := by + rw [← Surreal.toHahnSeriesOrderAddMonoidIso_apply, + ← Surreal.toHahnSeriesOrderAddMonoidIso_apply] + exact (map_rat_smul + Surreal.toHahnSeriesOrderAddMonoidIso.toAddMonoidHom q 1).symm + _ = (q : Surreal).toHahnSeries := by simp + _ = single 0 (q : ℝ) := Surreal.toHahnSeries_ratCast q + +/-- Conway normal forms preserve multiplication by a rational constant on the left. -/ +theorem toSurreal_single_zero_ratCast_mul (q : ℚ) (x : SurrealHahnSeries.{u}) : + (single 0 (q : ℝ) * x).toSurreal = (q : Surreal) * x.toSurreal := by + rw [← ratCast_eq_single_zero, ← Rat.smul_def, toSurreal_rat_smul] + simp [Rat.smul_def] + +/-- The product of two singleton surreal Hahn series is the singleton at the sum exponent. -/ +theorem single_mul_single (p q : Surreal.{u}) (r s : ℝ) : + single p r * single q s = single (p + q) (r * s) := by + apply Subtype.ext + rw [← ofLex_inj, ofLex_coe_mul, ofLex_coe_single, ofLex_coe_single, + HahnSeries.single_mul_single, ofLex_coe_single] + congr 2 + +/-- Multiplication by a singleton shifts exponents and scales coefficients. -/ +theorem coeff_single_mul (p : Surreal.{u}) (r : ℝ) + (y : SurrealHahnSeries.{u}) (k : Surreal) : + (single p r * y).coeff k = r * y.coeff (k - p) := by + have h := congrArg (fun z : HahnSeries Surrealᵒᵈ ℝ ↦ + z.coeff (OrderDual.toDual k)) (ofLex_coe_mul (single p r) y) + rw [ofLex_coe_single, HahnSeries.coeff_single_mul] at h + exact h + +/-- Truncation commutes with multiplication by a singleton after translating the cutoff. -/ +theorem trunc_single_mul (p q : Surreal.{u}) (r : ℝ) + (y : SurrealHahnSeries.{u}) : + (single p r * y).trunc (p + q) = single p r * y.trunc q := by + ext k + obtain hk | hk := le_or_gt k (p + q) + · rw [coeff_trunc_of_le hk, coeff_single_mul] + rw [coeff_trunc_of_le (sub_le_iff_le_add'.2 (by simpa [add_comm] using hk))] + simp + · rw [coeff_trunc_of_lt hk, coeff_single_mul] + rw [coeff_single_mul, coeff_trunc_of_lt] + exact lt_sub_iff_add_lt.mpr (by simpa [add_comm] using hk) + +/-- A coefficient perturbation of a series becomes the corresponding translated perturbation +after multiplication by a nonzero singleton. -/ +theorem single_mul_trunc_add_single_div (p q : Surreal.{u}) (r s : ℝ) + (y : SurrealHahnSeries.{u}) (hr : r ≠ 0) : + single p r * (y.trunc q + single q (s / r)) = + (single p r * y).trunc (p + q) + single (p + q) s := by + rw [mul_add, trunc_single_mul, single_mul_single, mul_div_cancel₀ s hr] + +/-- The leading indexed term of a formal product is the product of the leading indexed terms. -/ +theorem term_zero_mul (x y : SurrealHahnSeries) : + (x * y).term 0 = x.term 0 * y.term 0 := by + obtain rfl | hx := eq_or_ne x 0 + · rw [zero_mul, term_of_le (by simp), zero_mul] + obtain rfl | hy := eq_or_ne y 0 + · rw [mul_zero, term_of_le (by simp), mul_zero] + have hxy : x * y ≠ 0 := mul_ne_zero hx hy + have hxLength : 0 < x.length := by + rw [pos_iff_ne_zero, ne_eq, length_eq_zero] + exact hx + have hyLength : 0 < y.length := by + rw [pos_iff_ne_zero, ne_eq, length_eq_zero] + exact hy + have hxyLength : 0 < (x * y).length := by + rw [pos_iff_ne_zero, ne_eq, length_eq_zero] + exact hxy + have hxRaw : ofLex x.1 ≠ 0 := ofLex_coe_ne_zero hx + have hyRaw : ofLex y.1 ≠ 0 := ofLex_coe_ne_zero hy + have hleadingNe : + (ofLex x.1).leadingCoeff * (ofLex y.1).leadingCoeff ≠ 0 := by + exact mul_ne_zero (HahnSeries.leadingCoeff_ne_zero.mpr hxRaw) + (HahnSeries.leadingCoeff_ne_zero.mpr hyRaw) + have hexp := HahnSeries.order_mul_of_ne_zero hleadingNe + rw [← ofLex_coe_mul, ofLex_coe_order_eq_exp_zero hxy, + ofLex_coe_order_eq_exp_zero hx, ofLex_coe_order_eq_exp_zero hy] at hexp + have hexp' : + ((x * y).exp ⟨0, hxyLength⟩).1 = + (x.exp ⟨0, hxLength⟩).1 + (y.exp ⟨0, hyLength⟩).1 := by + simpa using congrArg OrderDual.ofDual hexp + have hcoeff := HahnSeries.leadingCoeff_mul_of_ne_zero hleadingNe + rw [← ofLex_coe_mul, ofLex_coe_leadingCoeff_eq_coeffIdx_zero hxy, + ofLex_coe_leadingCoeff_eq_coeffIdx_zero hx, + ofLex_coe_leadingCoeff_eq_coeffIdx_zero hy] at hcoeff + rw [term_of_lt hxyLength, term_of_lt hxLength, term_of_lt hyLength, + hcoeff, hexp', Real.toSurreal_mul, Surreal.wpow_add] + ring + +/-- The leading term of the surreal represented by a series is its zeroth indexed term. -/ +theorem leadingTerm_toSurreal (x : SurrealHahnSeries) : + x.toSurreal.leadingTerm = x.term 0 := by + have h := leadingTerm_sub_truncIdx (x := x) (i := 0) + have hzeroSeries : x.truncIdx 0 = 0 := by + rw [← length_eq_zero, length_truncIdx] + simp + have hzero : (x.truncIdx 0).toSurreal = 0 := by + calc + (x.truncIdx 0).toSurreal = (0 : SurrealHahnSeries).toSurreal := + congrArg toSurreal hzeroSeries + _ = 0 := toSurreal_zero + rw [hzero, sub_zero] at h + exact h + +/-- Formal Hahn multiplication and Conway multiplication have the same leading term. -/ +theorem leadingTerm_toSurreal_mul (x y : SurrealHahnSeries) : + (x * y).toSurreal.leadingTerm = (x.toSurreal * y.toSurreal).leadingTerm := by + rw [leadingTerm_toSurreal, term_zero_mul, ← leadingTerm_toSurreal, + ← leadingTerm_toSurreal, Surreal.leadingTerm_mul] + +/-- Every exponent in the support of a product is a sum of exponents from the two factors. -/ +theorem exists_add_eq_of_mem_support_mul {x y : SurrealHahnSeries.{u}} {k : Surreal} + (hk : k ∈ (x * y).support) : + ∃ p ∈ x.support, ∃ q ∈ y.support, p + q = k := by + have hk' : OrderDual.toDual k ∈ (ofLex (x * y).1).support := + (mem_support_ofLex_coe_iff (x * y) k).2 hk + rw [ofLex_coe_mul] at hk' + obtain ⟨p, hp, q, hq, hpq⟩ := HahnSeries.support_mul_subset hk' + refine ⟨p.ofDual, (mem_support_ofLex_coe_iff x p.ofDual).1 ?_, + q.ofDual, (mem_support_ofLex_coe_iff y q.ofDual).1 ?_, ?_⟩ + · simpa using hp + · simpa using hq + · simpa using congrArg OrderDual.ofDual hpq + +/-- Every left truncation option of a singleton product is the singleton times a truncation +option of the other factor; multiplication by a negative coefficient reverses the side. -/ +theorem exists_eq_single_mul_of_mem_truncLT + {p : Surreal.{u}} {r : ℝ} {y t : SurrealHahnSeries.{u}} + (ht : t ∈ truncLT (single p r * y)) : + (0 < r ∧ ∃ b ∈ truncLT y, single p r * b = t) ∨ + (r < 0 ∧ ∃ b ∈ truncGT y, single p r * b = t) := by + rw [truncLT_def] at ht + obtain ⟨k, hk, s, hs, rfl⟩ := ht + obtain ⟨p', hp', q, hq, hpq⟩ := exists_add_eq_of_mem_support_mul hk + have hp : p' = p := support_single_subset hp' + subst p' + subst k + have hr : r ≠ 0 := by + intro hr + subst r + simp at hp' + have hcoeff : (single p r * y).coeff (p + q) = r * y.coeff q := by + rw [coeff_single_mul] + congr 1 + abel_nf + rw [hcoeff] at hs + obtain hrNeg | hrPos := lt_or_gt_of_ne hr + · right + refine ⟨hrNeg, y.trunc q + single q (s / r), ?_, ?_⟩ + · exact trunc_add_single_truncGT hq <| + (lt_div_iff_of_neg hrNeg).2 (by simpa [mul_comm] using hs) + · exact single_mul_trunc_add_single_div p q r s y hr + · left + refine ⟨hrPos, y.trunc q + single q (s / r), ?_, ?_⟩ + · exact trunc_add_single_truncLT hq <| + (div_lt_iff₀ hrPos).2 (by simpa [mul_comm] using hs) + · exact single_mul_trunc_add_single_div p q r s y hr + +/-- Every right truncation option of a singleton product is the singleton times a truncation +option of the other factor; multiplication by a negative coefficient reverses the side. -/ +theorem exists_eq_single_mul_of_mem_truncGT + {p : Surreal.{u}} {r : ℝ} {y t : SurrealHahnSeries.{u}} + (ht : t ∈ truncGT (single p r * y)) : + (0 < r ∧ ∃ b ∈ truncGT y, single p r * b = t) ∨ + (r < 0 ∧ ∃ b ∈ truncLT y, single p r * b = t) := by + rw [truncGT_def] at ht + obtain ⟨k, hk, s, hs, rfl⟩ := ht + obtain ⟨p', hp', q, hq, hpq⟩ := exists_add_eq_of_mem_support_mul hk + have hp : p' = p := support_single_subset hp' + subst p' + subst k + have hr : r ≠ 0 := by + intro hr + subst r + simp at hp' + have hcoeff : (single p r * y).coeff (p + q) = r * y.coeff q := by + rw [coeff_single_mul] + congr 1 + abel_nf + rw [hcoeff] at hs + obtain hrNeg | hrPos := lt_or_gt_of_ne hr + · right + refine ⟨hrNeg, y.trunc q + single q (s / r), ?_, ?_⟩ + · exact trunc_add_single_truncLT hq <| + (div_lt_iff_of_neg hrNeg).2 (by simpa [mul_comm] using hs) + · exact single_mul_trunc_add_single_div p q r s y hr + · left + refine ⟨hrPos, y.trunc q + single q (s / r), ?_, ?_⟩ + · exact trunc_add_single_truncGT hq <| + (lt_div_iff₀ hrPos).2 (by simpa [mul_comm] using hs) + · exact single_mul_trunc_add_single_div p q r s y hr + +/-- A product of surreal Hahn series supported at nonnegative exponents is again supported at +nonnegative exponents. -/ +theorem support_mul_subset_Ici {x y : SurrealHahnSeries} + (hx : x.support ⊆ Ici 0) (hy : y.support ⊆ Ici 0) : + (x * y).support ⊆ Ici 0 := by + intro k hk + obtain ⟨p, hp, q, hq, rfl⟩ := exists_add_eq_of_mem_support_mul hk + have hpNonneg : 0 ≤ p := by simpa only [mem_Ici] using hx hp + have hqNonneg : 0 ≤ q := by simpa only [mem_Ici] using hy hq + simpa only [mem_Ici] using add_nonneg hpNonneg hqNonneg + +private theorem coeff_mul_zero_of_support_subsets {x y : SurrealHahnSeries} + (hx : x.support ⊆ Ioi 0) (hy : y.support ⊆ Ici 0) : + (x * y).coeff 0 = 0 := by + apply notMem_support_iff.mp + intro hzero + obtain ⟨p, hp, q, hq, hpq⟩ := exists_add_eq_of_mem_support_mul hzero + have hpPos : 0 < p := by simpa only [mem_Ioi] using hx hp + have hqNonneg : 0 ≤ q := by simpa only [mem_Ici] using hy hq + nlinarith + +/-- At exponent zero, multiplication of nonnegative-support surreal Hahn series is multiplication +of their constant coefficients. -/ +theorem coeff_zero_mul_of_support_subset_Ici {x y : SurrealHahnSeries} + (hx : x.support ⊆ Ici 0) (hy : y.support ⊆ Ici 0) : + (x * y).coeff 0 = x.coeff 0 * y.coeff 0 := by + have hxSplit : x.trunc 0 + single 0 (x.coeff 0) = x := + trunc_add_single fun i hi ↦ hx hi + have hySplit : y.trunc 0 + single 0 (y.coeff 0) = y := + trunc_add_single fun i hi ↦ hy hi + conv_lhs => rw [← hxSplit, ← hySplit] + rw [add_mul, mul_add, mul_add, + coeff_add_apply, coeff_add_apply, coeff_add_apply] + have hxTrunc : (x.trunc 0).support ⊆ Ioi 0 := by + intro i hi + rw [support_trunc] at hi + exact hi.2 + have hyTrunc : (y.trunc 0).support ⊆ Ioi 0 := by + intro i hi + rw [support_trunc] at hi + exact hi.2 + have hxTruncNonneg : (x.trunc 0).support ⊆ Ici 0 := fun i hi ↦ by + rw [mem_Ici] + exact (show 0 < i by simpa only [mem_Ioi] using hxTrunc hi).le + have hyTruncNonneg : (y.trunc 0).support ⊆ Ici 0 := fun i hi ↦ by + rw [mem_Ici] + exact (show 0 < i by simpa only [mem_Ioi] using hyTrunc hi).le + have hsingleNonneg (r : ℝ) : (single 0 r).support ⊆ Ici 0 := by + intro i hi + have hi' := support_single_subset hi + simp only [mem_singleton_iff] at hi' + subst i + exact le_refl (0 : Surreal) + rw [coeff_mul_zero_of_support_subsets hxTrunc hyTruncNonneg, + coeff_mul_zero_of_support_subsets hxTrunc (hsingleNonneg _)] + have hsingleTrunc : (single 0 (x.coeff 0) * y.trunc 0).coeff 0 = 0 := by + rw [mul_comm] + exact coeff_mul_zero_of_support_subsets hyTrunc (hsingleNonneg _) + rw [hsingleTrunc, single_mul_single] + simp [coeff_single_self] + +/-- The ring expression occurring in a Conway multiplication option. -/ +def mulOptionValue (x y a b : SurrealHahnSeries) : SurrealHahnSeries := + a * y + x * b - a * b + +/-- Evaluation of the Hahn-series expression attached to a Conway multiplication option. -/ +theorem mulOptionValue_eq (x y a b : SurrealHahnSeries) : + mulOptionValue x y a b = a * y + x * b - a * b := + (rfl) + +/-- Two left approximations give a multiplication option strictly below the product. -/ +theorem mulOptionValue_lt_mul_of_lt_of_lt {x y a b : SurrealHahnSeries} + (ha : a < x) (hb : b < y) : mulOptionValue x y a b < x * y := by + dsimp [mulOptionValue] + nlinarith [mul_pos (sub_pos.mpr ha) (sub_pos.mpr hb)] + +/-- Two right approximations give a multiplication option strictly below the product. -/ +theorem mulOptionValue_lt_mul_of_gt_of_gt {x y a b : SurrealHahnSeries} + (ha : x < a) (hb : y < b) : mulOptionValue x y a b < x * y := by + dsimp [mulOptionValue] + nlinarith [mul_pos_of_neg_of_neg (sub_neg.mpr ha) (sub_neg.mpr hb)] + +/-- A left and a right approximation give a multiplication option strictly above the product. -/ +theorem mul_lt_mulOptionValue_of_lt_of_gt {x y a b : SurrealHahnSeries} + (ha : a < x) (hb : y < b) : x * y < mulOptionValue x y a b := by + dsimp [mulOptionValue] + nlinarith [mul_neg_of_pos_of_neg (sub_pos.mpr ha) (sub_neg.mpr hb)] + +/-- A right and a left approximation give a multiplication option strictly above the product. -/ +theorem mul_lt_mulOptionValue_of_gt_of_lt {x y a b : SurrealHahnSeries} + (ha : x < a) (hb : b < y) : x * y < mulOptionValue x y a b := by + dsimp [mulOptionValue] + nlinarith [mul_neg_of_neg_of_pos (sub_neg.mpr ha) (sub_pos.mpr hb)] + +private theorem sub_leftApprox_pos (x : SurrealHahnSeries) (p : Surreal) (d : ℝ) + (hd : 0 < d) : + 0 < x - (x.trunc p + single p (x.coeff p - d)) := by + rw [lt_iff_exists_coeff] + refine ⟨p, ?_, ?_⟩ + · intro j hpj + rw [coeff_zero, coeff_sub_apply, coeff_add_apply, coeff_trunc_of_lt hpj, + coeff_single_of_ne hpj.ne] + simp + · rw [coeff_zero, coeff_sub_apply, coeff_add_apply, coeff_trunc_of_le le_rfl, + coeff_single_self] + simp only [Pi.zero_apply] + linarith + +private theorem sub_leftApprox_lt_single (x : SurrealHahnSeries) (p : Surreal) + (d C : ℝ) (hdC : d < C) : + x - (x.trunc p + single p (x.coeff p - d)) < single p C := by + rw [lt_iff_exists_coeff] + refine ⟨p, ?_, ?_⟩ + · intro j hpj + rw [coeff_sub_apply, coeff_add_apply, coeff_trunc_of_lt hpj, + coeff_single_of_ne hpj.ne, coeff_single_of_ne hpj.ne] + simp + · rw [coeff_sub_apply, coeff_add_apply, coeff_trunc_of_le le_rfl, + coeff_single_self, coeff_single_self] + linarith + +private theorem rightApprox_sub_pos (x : SurrealHahnSeries) (p : Surreal) (d : ℝ) + (hd : 0 < d) : + 0 < (x.trunc p + single p (x.coeff p + d)) - x := by + rw [lt_iff_exists_coeff] + refine ⟨p, ?_, ?_⟩ + · intro j hpj + rw [coeff_zero, coeff_sub_apply, coeff_add_apply, coeff_trunc_of_lt hpj, + coeff_single_of_ne hpj.ne] + simp + · rw [coeff_zero, coeff_sub_apply, coeff_add_apply, coeff_trunc_of_le le_rfl, + coeff_single_self] + simp only [Pi.zero_apply] + linarith + +private theorem rightApprox_sub_lt_single (x : SurrealHahnSeries) (p : Surreal) + (d C : ℝ) (hdC : d < C) : + (x.trunc p + single p (x.coeff p + d)) - x < single p C := by + rw [lt_iff_exists_coeff] + refine ⟨p, ?_, ?_⟩ + · intro j hpj + rw [coeff_sub_apply, coeff_add_apply, coeff_trunc_of_lt hpj, + coeff_single_of_ne hpj.ne, coeff_single_of_ne hpj.ne] + simp + · rw [coeff_sub_apply, coeff_add_apply, coeff_trunc_of_le le_rfl, + coeff_single_self, coeff_single_self] + linarith + +private theorem exists_small_square {d : ℝ} (hd : 0 < d) : + ∃ e : ℝ, 0 < e ∧ 4 * e ^ 2 < d := by + let e := min 1 (d / 8) + have he1 : e ≤ 1 := min_le_left _ _ + have hed : e ≤ d / 8 := min_le_right _ _ + have he : 0 < e := lt_min zero_lt_one (by linarith) + refine ⟨e, he, ?_⟩ + nlinarith [sq_nonneg e] + +private theorem single_lt_sub_leftApprox (x : SurrealHahnSeries) (k : Surreal) + (r C : ℝ) (hC : C < x.coeff k - r) : + single k C < x - (x.trunc k + single k r) := by + rw [lt_iff_exists_coeff] + refine ⟨k, ?_, ?_⟩ + · intro j hkj + rw [coeff_sub_apply, coeff_add_apply, coeff_trunc_of_lt hkj, + coeff_single_of_ne hkj.ne, coeff_single_of_ne hkj.ne] + simp + · rw [coeff_sub_apply, coeff_add_apply, coeff_trunc_of_le le_rfl, + coeff_single_self, coeff_single_self] + linarith + +private theorem single_lt_rightApprox_sub (x : SurrealHahnSeries) (k : Surreal) + (r C : ℝ) (hC : C < r - x.coeff k) : + single k C < (x.trunc k + single k r) - x := by + rw [lt_iff_exists_coeff] + refine ⟨k, ?_, ?_⟩ + · intro j hkj + rw [coeff_sub_apply, coeff_add_apply, coeff_trunc_of_lt hkj, + coeff_single_of_ne hkj.ne, coeff_single_of_ne hkj.ne] + simp + · rw [coeff_sub_apply, coeff_add_apply, coeff_trunc_of_le le_rfl, + coeff_single_self, coeff_single_self] + linarith + +/-- Every left coefficient truncation of a product is strictly dominated by a same-side +multiplication option, which is itself strictly below the product. -/ +theorem exists_mulOptionValue_between_of_mem_truncLT + {x y t : SurrealHahnSeries} (ht : t ∈ truncLT (x * y)) : + ∃ a ∈ truncLT x, ∃ b ∈ truncLT y, + t < mulOptionValue x y a b ∧ mulOptionValue x y a b < x * y := by + rw [truncLT_def] at ht + obtain ⟨k, hk, r, hr, rfl⟩ := ht + obtain ⟨p, hp, q, hq, hpq⟩ := exists_add_eq_of_mem_support_mul hk + obtain ⟨e, he, heSmall⟩ := exists_small_square (sub_pos.mpr hr) + let a := x.trunc p + single p (x.coeff p - e) + let b := y.trunc q + single q (y.coeff q - e) + have ha : a ∈ truncLT x := by + apply trunc_add_single_truncLT hp + linarith + have hb : b ∈ truncLT y := by + apply trunc_add_single_truncLT hq + linarith + have hxaPos : 0 < x - a := sub_leftApprox_pos x p e he + have hybPos : 0 < y - b := sub_leftApprox_pos y q e he + have hxaBound : x - a < single p (2 * e) := by + apply sub_leftApprox_lt_single + linarith + have hybBound : y - b < single q (2 * e) := by + apply sub_leftApprox_lt_single + linarith + have hpMonoPos : 0 < single p (2 * e) := hxaPos.trans hxaBound + have hproductBound : + (x - a) * (y - b) < single (p + q) (4 * e ^ 2) := by + calc + (x - a) * (y - b) < single p (2 * e) * (y - b) := + mul_lt_mul_of_pos_right hxaBound hybPos + _ < single p (2 * e) * single q (2 * e) := + mul_lt_mul_of_pos_left hybBound hpMonoPos + _ = single (p + q) ((2 * e) * (2 * e)) := + single_mul_single p q (2 * e) (2 * e) + _ = single (p + q) (4 * e ^ 2) := by ring_nf + have hmonoGap : + single (p + q) (4 * e ^ 2) < + x * y - ((x * y).trunc k + single k r) := by + rw [hpq] + exact single_lt_sub_leftApprox (x * y) k r (4 * e ^ 2) heSmall + refine ⟨a, ha, b, hb, ?_, ?_⟩ + · dsimp [mulOptionValue] + have := hproductBound.trans hmonoGap + nlinarith + · exact mulOptionValue_lt_mul_of_lt_of_lt + (lt_of_truncLT ha) (lt_of_truncLT hb) + +/-- Every right coefficient truncation of a product strictly dominates an opposite-side +multiplication option, which is itself strictly above the product. -/ +theorem exists_mulOptionValue_between_of_mem_truncGT + {x y t : SurrealHahnSeries} (ht : t ∈ truncGT (x * y)) : + ∃ a ∈ truncLT x, ∃ b ∈ truncGT y, + x * y < mulOptionValue x y a b ∧ mulOptionValue x y a b < t := by + rw [truncGT_def] at ht + obtain ⟨k, hk, r, hr, rfl⟩ := ht + obtain ⟨p, hp, q, hq, hpq⟩ := exists_add_eq_of_mem_support_mul hk + obtain ⟨e, he, heSmall⟩ := exists_small_square (sub_pos.mpr hr) + let a := x.trunc p + single p (x.coeff p - e) + let b := y.trunc q + single q (y.coeff q + e) + have ha : a ∈ truncLT x := by + apply trunc_add_single_truncLT hp + linarith + have hb : b ∈ truncGT y := by + apply trunc_add_single_truncGT hq + linarith + have hxaPos : 0 < x - a := sub_leftApprox_pos x p e he + have hbyPos : 0 < b - y := rightApprox_sub_pos y q e he + have hxaBound : x - a < single p (2 * e) := by + apply sub_leftApprox_lt_single + linarith + have hbyBound : b - y < single q (2 * e) := by + apply rightApprox_sub_lt_single + linarith + have hpMonoPos : 0 < single p (2 * e) := hxaPos.trans hxaBound + have hproductBound : + (x - a) * (b - y) < single (p + q) (4 * e ^ 2) := by + calc + (x - a) * (b - y) < single p (2 * e) * (b - y) := + mul_lt_mul_of_pos_right hxaBound hbyPos + _ < single p (2 * e) * single q (2 * e) := + mul_lt_mul_of_pos_left hbyBound hpMonoPos + _ = single (p + q) ((2 * e) * (2 * e)) := + single_mul_single p q (2 * e) (2 * e) + _ = single (p + q) (4 * e ^ 2) := by ring_nf + have hmonoGap : + single (p + q) (4 * e ^ 2) < + ((x * y).trunc k + single k r) - x * y := by + rw [hpq] + exact single_lt_rightApprox_sub (x * y) k r (4 * e ^ 2) heSmall + refine ⟨a, ha, b, hb, ?_, ?_⟩ + · exact mul_lt_mulOptionValue_of_lt_of_gt + (lt_of_truncLT ha) (gt_of_truncGT hb) + · dsimp [mulOptionValue] + have := hproductBound.trans hmonoGap + nlinarith + +private theorem mulOption_equiv + {x y a b : SurrealHahnSeries.{u}} + (hay : (a * y).toSurreal = a.toSurreal * y.toSurreal) + (hxb : (x * b).toSurreal = x.toSurreal * b.toSurreal) + (hab : (a * b).toSurreal = a.toSurreal * b.toSurreal) : + IGame.mulOption x.toIGame y.toIGame a.toIGame b.toIGame ≈ + (mulOptionValue x y a b).toIGame := by + rw [← Surreal.mk_eq_mk] + simp only [IGame.mulOption, Surreal.mk_sub, Surreal.mk_add, Surreal.mk_mul, + mk_toIGame] + rw [mulOptionValue_eq] + simp only [sub_eq_add_neg, toSurreal_add, toSurreal_neg] + rw [hay, hxb, hab] + +private theorem cutMulOption_equiv + {x y a b : SurrealHahnSeries.{u}} + (hay : (a * y).toSurreal = a.toSurreal * y.toSurreal) + (hxb : (x * b).toSurreal = x.toSurreal * b.toSurreal) + (hab : (a * b).toSurreal = a.toSurreal * b.toSurreal) : + IGame.mulOption !{toIGame '' truncLT x | toIGame '' truncGT x} + !{toIGame '' truncLT y | toIGame '' truncGT y} a.toIGame b.toIGame ≈ + (mulOptionValue x y a b).toIGame := by + exact (Numeric.mulOption_congr₁ (toIGame_equiv x).symm).trans <| + (Numeric.mulOption_congr₂ (toIGame_equiv y).symm).trans <| + mulOption_equiv hay hxb hab + +/-- Truncation options of a series of limit length are strictly shorter. -/ +private theorem length_lt_of_mem_truncLT_or_mem_truncGT {y b : SurrealHahnSeries.{u}} + (hy : IsSuccPrelimit y.length) (hb : b ∈ truncLT y ∨ b ∈ truncGT y) : + b.length < y.length := + hb.elim (length_lt_of_truncLT hy) (length_lt_of_truncGT hy) + +/-- The constant series `single 0 r` represents the real number `r`. -/ +private theorem toIGame_single_zero_equiv (r : ℝ) : (single 0 r).toIGame ≈ (r : IGame) := by + rw [← Surreal.mk_eq_mk, mk_toIGame] + simp [toSurreal_single] + +/-- The constant series with dyadic coefficient `q` represents the dyadic `q`. -/ +private theorem toIGame_single_zero_dyadic_equiv (q : Dyadic) : + (single 0 (q.toRat : ℝ)).toIGame ≈ (q : IGame) := by + apply AntisymmRel.trans ?_ (Real.toIGame_dyadic_equiv q) + rw [← Surreal.mk_eq_mk, mk_toIGame] + simp [toSurreal_single] + +/-- Constant series are ordered by their coefficients. -/ +private theorem single_zero_lt_single_zero {q r : ℝ} (h : q < r) : + single 0 q < single 0 r := by + rw [← toSurreal_lt_toSurreal_iff, toSurreal_single, toSurreal_single, Surreal.wpow_zero, + mul_one, mul_one] + exact Real.toSurreal_lt_iff.mpr h + +/-- The Conway multiplication option of the real `r` against the cut of `y`, at the dyadic option +`q` of `r` and the truncation option `b` of `y`, is the Hahn-series multiplication option +`mulOptionValue (single 0 r) y (single 0 q) b`, provided multiplication by `single 0 r` is +already compatible on `b`. -/ +private theorem mulOption_real_equiv (r : ℝ) (y : SurrealHahnSeries.{u}) (q : Dyadic) + {b : SurrealHahnSeries.{u}} + (hb : (single 0 r * b).toSurreal = (r : Surreal) * b.toSurreal) : + IGame.mulOption (r : IGame) !{toIGame '' truncLT y | toIGame '' truncGT y} + (q : IGame) b.toIGame ≈ + (mulOptionValue (single 0 r) y (single 0 (q.toRat : ℝ)) b).toIGame := + (Numeric.mulOption_congr₁ (toIGame_single_zero_equiv r).symm).trans <| + (Numeric.mulOption_congr₂ (toIGame_equiv y).symm).trans <| + (Numeric.mulOption_congr₃ (toIGame_single_zero_dyadic_equiv q).symm).trans <| + mulOption_equiv + (by simpa [toSurreal_single] using toSurreal_single_zero_ratCast_mul q.toRat y) + (by simpa [toSurreal_single] using hb) + (by simpa [toSurreal_single] using toSurreal_single_zero_ratCast_mul q.toRat b) + +/-- The Conway multiplication option at the dyadic option `0` of `r` is the truncation option +`single 0 r * b` itself. -/ +private theorem mulOption_real_zero_equiv (r : ℝ) (y : SurrealHahnSeries.{u}) + {b : SurrealHahnSeries.{u}} + (hb : (single 0 r * b).toSurreal = (r : Surreal) * b.toSurreal) : + IGame.mulOption (r : IGame) !{toIGame '' truncLT y | toIGame '' truncGT y} + ((0 : Dyadic) : IGame) b.toIGame ≈ (single 0 r * b).toIGame := by + grw [mulOption_real_equiv r y 0 hb] + simp [mulOptionValue_eq] + +/-- The cut of `single 0 r * y`, for `y` of limit length, fits between the options of the Conway +product of `r` with the cut of `y`: every option is a multiplication option at a dyadic option of +`r` and a truncation option of `y`, and lies on the correct side of the product. -/ +private theorem fits_single_zero_mul (r : ℝ) {y : SurrealHahnSeries.{u}} + (hy : IsSuccPrelimit y.length) + (hmul : ∀ b : SurrealHahnSeries.{u}, b.length < y.length → + (single 0 r * b).toSurreal = (r : Surreal) * b.toSurreal) : + Fits !{toIGame '' truncLT (single 0 r * y) | toIGame '' truncGT (single 0 r * y)} + ((r : IGame) * !{toIGame '' truncLT y | toIGame '' truncGT y}) := by + have hoption (q : Dyadic) {b : SurrealHahnSeries.{u}} + (hb : b ∈ truncLT y ∨ b ∈ truncGT y) := + mulOption_real_equiv r y q (hmul b (length_lt_of_mem_truncLT_or_mem_truncGT hy hb)) + simp only [Fits, forall_moves_mul, moves_ofSets, Player.cases] + constructor + · intro p + cases p <;> simp only [Real.forall_leftMoves_toIGame, + Real.forall_rightMoves_toIGame, forall_mem_image] + · intro q hq b hb + rw [Numeric.not_le] + grw [hoption q (Or.inl hb), ← toIGame_equiv (single 0 r * y)] + exact_mod_cast mulOptionValue_lt_mul_of_lt_of_lt + (single_zero_lt_single_zero hq) (lt_of_truncLT hb) + · intro q hq b hb + rw [Numeric.not_le] + grw [hoption q (Or.inr hb), ← toIGame_equiv (single 0 r * y)] + exact_mod_cast mulOptionValue_lt_mul_of_gt_of_gt + (single_zero_lt_single_zero hq) (gt_of_truncGT hb) + · intro p + cases p <;> simp only [Real.forall_leftMoves_toIGame, + Real.forall_rightMoves_toIGame, forall_mem_image] + · intro q hq b hb + rw [Numeric.not_le] + grw [← toIGame_equiv (single 0 r * y), hoption q (Or.inr hb)] + exact_mod_cast mul_lt_mulOptionValue_of_lt_of_gt + (single_zero_lt_single_zero hq) (gt_of_truncGT hb) + · intro q hq b hb + rw [Numeric.not_le] + grw [← toIGame_equiv (single 0 r * y), hoption q (Or.inl hb)] + exact_mod_cast mul_lt_mulOptionValue_of_gt_of_lt + (single_zero_lt_single_zero hq) (lt_of_truncLT hb) + +/-- Every left truncation option of `single 0 r * y` is dominated by a left option of the Conway +product of `r` with the cut of `y`. The truncation option is `single 0 r * b` for a truncation +option `b` of `y` on the side determined by the sign of `r`, and the multiplication option at the +dyadic `0` and `b` represents it. -/ +private theorem exists_leftMove_ge_of_mem_truncLT_single_zero_mul (r : ℝ) + {y : SurrealHahnSeries.{u}} (hy : IsSuccPrelimit y.length) + (hmul : ∀ b : SurrealHahnSeries.{u}, b.length < y.length → + (single 0 r * b).toSurreal = (r : Surreal) * b.toSurreal) : + ∀ z ∈ !{toIGame '' truncLT (single 0 r * y) | toIGame '' truncGT (single 0 r * y)}ᴸ, + ∃ w ∈ ((r : IGame) * !{toIGame '' truncLT y | toIGame '' truncGT y})ᴸ, z ≤ w := by + rw [moves_ofSets] + rintro _ ⟨t, ht, rfl⟩ + obtain ⟨hrPos, b, hb, rfl⟩ | ⟨hrNeg, b, hb, rfl⟩ := + exists_eq_single_mul_of_mem_truncLT ht + · refine ⟨_, mulOption_mem_moves_mul (b := b.toIGame) (px := left) (py := left) + (Real.mem_leftMoves_toIGame_of_lt (q := 0) (by simpa using hrPos)) ?_, ?_⟩ + · rw [moves_ofSets] + exact mem_image_of_mem toIGame hb + · exact (mulOption_real_zero_equiv r y + (hmul b (length_lt_of_mem_truncLT_or_mem_truncGT hy (Or.inl hb)))).symm.le + · refine ⟨_, mulOption_mem_moves_mul (b := b.toIGame) (px := right) (py := right) + (Real.mem_rightMoves_toIGame_of_lt (q := 0) (by simpa using hrNeg)) ?_, ?_⟩ + · rw [moves_ofSets] + exact mem_image_of_mem toIGame hb + · exact (mulOption_real_zero_equiv r y + (hmul b (length_lt_of_mem_truncLT_or_mem_truncGT hy (Or.inr hb)))).symm.le + +/-- Every right truncation option of `single 0 r * y` dominates a right option of the Conway +product of `r` with the cut of `y`, namely the multiplication option at the dyadic `0` and the +truncation option `b` of `y` with `single 0 r * b` the given option. -/ +private theorem exists_rightMove_le_of_mem_truncGT_single_zero_mul (r : ℝ) + {y : SurrealHahnSeries.{u}} (hy : IsSuccPrelimit y.length) + (hmul : ∀ b : SurrealHahnSeries.{u}, b.length < y.length → + (single 0 r * b).toSurreal = (r : Surreal) * b.toSurreal) : + ∀ z ∈ !{toIGame '' truncLT (single 0 r * y) | toIGame '' truncGT (single 0 r * y)}ᴿ, + ∃ w ∈ ((r : IGame) * !{toIGame '' truncLT y | toIGame '' truncGT y})ᴿ, w ≤ z := by + rw [moves_ofSets] + rintro _ ⟨t, ht, rfl⟩ + obtain ⟨hrPos, b, hb, rfl⟩ | ⟨hrNeg, b, hb, rfl⟩ := + exists_eq_single_mul_of_mem_truncGT ht + · refine ⟨_, mulOption_mem_moves_mul (b := b.toIGame) (px := left) (py := right) + (Real.mem_leftMoves_toIGame_of_lt (q := 0) (by simpa using hrPos)) ?_, ?_⟩ + · rw [moves_ofSets] + exact mem_image_of_mem toIGame hb + · exact (mulOption_real_zero_equiv r y + (hmul b (length_lt_of_mem_truncLT_or_mem_truncGT hy (Or.inr hb)))).le + · refine ⟨_, mulOption_mem_moves_mul (b := b.toIGame) (px := right) (py := left) + (Real.mem_rightMoves_toIGame_of_lt (q := 0) (by simpa using hrNeg)) ?_, ?_⟩ + · rw [moves_ofSets] + exact mem_image_of_mem toIGame hb + · exact (mulOption_real_zero_equiv r y + (hmul b (length_lt_of_mem_truncLT_or_mem_truncGT hy (Or.inl hb)))).le + +/-- The limit step for multiplication by a real constant. Rational options of the real constant +are handled by additive compatibility, while truncation options of the other factor are strictly +shorter recursive inputs. -/ +theorem toSurreal_single_zero_mul_of_isSuccPrelimit (r : ℝ) + {y : SurrealHahnSeries.{u}} (hy : IsSuccPrelimit y.length) + (hmul : ∀ b : SurrealHahnSeries.{u}, b.length < y.length → + (single 0 r * b).toSurreal = (r : Surreal) * b.toSurreal) : + (single 0 r * y).toSurreal = (r : Surreal) * y.toSurreal := by + rw [← mk_toIGame (single 0 r * y), ← mk_toIGame y, ← Surreal.mk_real_toIGame, + ← Surreal.mk_mul] + apply Surreal.mk_eq + rw [toIGame_limit hy] + exact (toIGame_equiv (single 0 r * y)).trans + (Fits.equiv_of_forall_moves (fits_single_zero_mul r hy hmul) + (exists_leftMove_ge_of_mem_truncLT_single_zero_mul r hy hmul) + (exists_rightMove_le_of_mem_truncGT_single_zero_mul r hy hmul)) + +/-- Conway normal forms preserve multiplication by every real constant on the left. -/ +theorem toSurreal_single_zero_mul (r : ℝ) (y : SurrealHahnSeries.{u}) : + (single 0 r * y).toSurreal = (r : Surreal) * y.toSurreal := by + induction y using lengthRecOn with + | succ y i s hi hs IH => + rw [mul_add, toSurreal_add, IH, single_mul_single, toSurreal_single, + toSurreal_succ hi, Real.toSurreal_mul] + ring_nf + | limit y hy IH => exact toSurreal_single_zero_mul_of_isSuccPrelimit r hy IH + +private theorem toSurreal_single_mul_of_one (p : Surreal.{u}) (r : ℝ) + (y : SurrealHahnSeries.{u}) + (hone : (single p 1 * y).toSurreal = ω^ p * y.toSurreal) : + (single p r * y).toSurreal = (r : Surreal) * ω^ p * y.toSurreal := by + have hfactor : single p r = single 0 r * single p 1 := by + rw [single_mul_single] + simp + rw [hfactor, mul_assoc, toSurreal_single_zero_mul, hone] + ring + +private theorem toSurreal_single_one_mul_succ (g : IGame.{u}) [Numeric g] + {y : SurrealHahnSeries.{u}} {i : Surreal} {s : ℝ} + (hi : ∀ j ∈ y.support, i < j) + (IH : (single (Surreal.mk g) 1 * y).toSurreal = + ω^ (Surreal.mk g) * y.toSurreal) : + (single (Surreal.mk g) 1 * (y + single i s)).toSurreal = + ω^ (Surreal.mk g) * (y + single i s).toSurreal := by + rw [mul_add, toSurreal_add, IH, single_mul_single, toSurreal_single, + toSurreal_succ hi, Surreal.wpow_add] + ring_nf + +/-- The monomial `single (mk g) 1` represents `ω^ g`. -/ +private theorem toIGame_single_one_equiv (g : IGame.{u}) [Numeric g] : + (single (Surreal.mk g) 1).toIGame ≈ ω^ g := by + rw [← Surreal.mk_eq_mk, mk_toIGame, Surreal.mk_wpow] + simp [toSurreal_single] + +/-- The monomial `single (mk z) q` with dyadic coefficient `q` represents `q * ω^ z`. -/ +private theorem toIGame_single_dyadic_equiv (q : Dyadic) (z : IGame.{u}) [Numeric z] : + (single (Surreal.mk z) (q.toRat : ℝ)).toIGame ≈ (q : IGame) * ω^ z := by + rw [← Surreal.mk_eq_mk, mk_toIGame, Surreal.mk_mul, Surreal.mk_wpow, Surreal.mk_dyadic] + simp [toSurreal_single] + +/-- A dyadic multiple of the monomial at a left option `z` of `g` is below the monomial at `g`, +since `q * ω^ z < ω^ g` for `z < g`. -/ +private theorem single_dyadic_lt_single_one_of_mem_leftMoves (g : IGame.{u}) [Numeric g] + (q : Dyadic) {z : IGame.{u}} [Numeric z] (hz : z ∈ gᴸ) : + single (Surreal.mk z) (q.toRat : ℝ) < single (Surreal.mk g) 1 := by + rw [← toSurreal_lt_toSurreal_iff] + simp only [toSurreal_single] + simpa using + Surreal.mul_wpow_lt_wpow q.toRat (Surreal.mk_lt_mk.mpr (Numeric.left_lt hz)) + +/-- The monomial at `g` is below every positive dyadic multiple of the monomial at a right option +`z` of `g`, since `ω^ g < q * ω^ z` for `g < z` and `0 < q`. -/ +private theorem single_one_lt_single_dyadic_of_mem_rightMoves (g : IGame.{u}) [Numeric g] + {q : Dyadic} {z : IGame.{u}} [Numeric z] (hq : 0 < q) (hz : z ∈ gᴿ) : + single (Surreal.mk g) 1 < single (Surreal.mk z) (q.toRat : ℝ) := by + rw [← toSurreal_lt_toSurreal_iff] + simp only [toSurreal_single] + have hqReal : (0 : ℝ) < (q.toRat : ℝ) := by exact_mod_cast hq + simpa using Surreal.wpow_lt_mul_wpow hqReal + (Surreal.mk_lt_mk.mpr (Numeric.lt_right hz)) + +/-- The Conway multiplication option of `ω^ g` against the cut of `y`, at the option `q * ω^ z` +of `ω^ g` and the truncation option `b` of `y`, is the Hahn-series multiplication option +`mulOptionValue (single (mk g) 1) y (single (mk z) q) b`, provided multiplication by +`single (mk z) 1` is compatible everywhere and multiplication by `single (mk g) 1` is compatible +on `b`. -/ +private theorem mulOption_wpow_equiv (g : IGame.{u}) [Numeric g] (y : SurrealHahnSeries.{u}) + (q : Dyadic) {z : IGame.{u}} [Numeric z] + (hz : ∀ c : SurrealHahnSeries.{u}, + (single (Surreal.mk z) 1 * c).toSurreal = ω^ (Surreal.mk z) * c.toSurreal) + {b : SurrealHahnSeries.{u}} + (hb : (single (Surreal.mk g) 1 * b).toSurreal = ω^ (Surreal.mk g) * b.toSurreal) : + IGame.mulOption (ω^ g) !{toIGame '' truncLT y | toIGame '' truncGT y} + ((q : IGame) * ω^ z) b.toIGame ≈ + (mulOptionValue (single (Surreal.mk g) 1) y + (single (Surreal.mk z) (q.toRat : ℝ)) b).toIGame := by + have hAcompat (c : SurrealHahnSeries.{u}) : + (single (Surreal.mk z) (q.toRat : ℝ) * c).toSurreal = + (single (Surreal.mk z) (q.toRat : ℝ)).toSurreal * c.toSurreal := by + simpa [toSurreal_single, mul_assoc] using + toSurreal_single_mul_of_one (Surreal.mk z) (q.toRat : ℝ) c (hz c) + exact (Numeric.mulOption_congr₁ (toIGame_single_one_equiv g).symm).trans <| + (Numeric.mulOption_congr₂ (toIGame_equiv y).symm).trans <| + (Numeric.mulOption_congr₃ (toIGame_single_dyadic_equiv q z).symm).trans <| + mulOption_equiv (hAcompat y) (by simpa [toSurreal_single] using hb) (hAcompat b) + +/-- The Conway multiplication option at the option `0` of `ω^ g` is the truncation option +`single (mk g) 1 * b` itself. -/ +private theorem mulOption_wpow_zero_equiv (g : IGame.{u}) [Numeric g] + (y : SurrealHahnSeries.{u}) {b : SurrealHahnSeries.{u}} + (hb : (single (Surreal.mk g) 1 * b).toSurreal = ω^ (Surreal.mk g) * b.toSurreal) : + IGame.mulOption (ω^ g) !{toIGame '' truncLT y | toIGame '' truncGT y} 0 b.toIGame ≈ + (single (Surreal.mk g) 1 * b).toIGame := + (Numeric.mulOption_congr₁ (toIGame_single_one_equiv g).symm).trans <| + (Numeric.mulOption_congr₂ (toIGame_equiv y).symm).trans <| + (Numeric.mulOption_congr₃ toIGame_zero.symm.antisymmRel).trans <| by + grw [mulOption_equiv (x := single (Surreal.mk g) 1) (y := y) (a := 0) (b := b) + (by simp) (by simpa [toSurreal_single] using hb) (by simp)] + simp [mulOptionValue_eq] + +/-- The cut of `single (mk g) 1 * y`, for `y` of limit length, fits between the options of the +Conway product of `ω^ g` with the cut of `y`: every option is a multiplication option at an +option `0` or `q * ω^ z` of `ω^ g` and a truncation option of `y`, and lies on the correct side +of the product. -/ +private theorem fits_single_one_mul (g : IGame.{u}) [Numeric g] {y : SurrealHahnSeries.{u}} + (hy : IsSuccPrelimit y.length) + (hmove : ∀ p z [Numeric z], z ∈ g.moves p → ∀ b : SurrealHahnSeries.{u}, + (single (Surreal.mk z) 1 * b).toSurreal = ω^ (Surreal.mk z) * b.toSurreal) + (hlenRec : ∀ b : SurrealHahnSeries.{u}, b.length < y.length → + (single (Surreal.mk g) 1 * b).toSurreal = ω^ (Surreal.mk g) * b.toSurreal) : + Fits !{toIGame '' truncLT (single (Surreal.mk g) 1 * y) | + toIGame '' truncGT (single (Surreal.mk g) 1 * y)} + (ω^ g * !{toIGame '' truncLT y | toIGame '' truncGT y}) := by + have hoption (q : Dyadic) {p : Player} {z : IGame.{u}} [Numeric z] (hz : z ∈ g.moves p) + {b : SurrealHahnSeries.{u}} (hb : b ∈ truncLT y ∨ b ∈ truncGT y) := + mulOption_wpow_equiv g y q (hmove p z hz) + (hlenRec b (length_lt_of_mem_truncLT_or_mem_truncGT hy hb)) + have hzeroOption {b : SurrealHahnSeries.{u}} (hb : b ∈ truncLT y ∨ b ∈ truncGT y) := + mulOption_wpow_zero_equiv g y (hlenRec b (length_lt_of_mem_truncLT_or_mem_truncGT hy hb)) + have hxpos : 0 < single (Surreal.mk g) 1 := by + rw [← toSurreal_lt_toSurreal_iff] + simp [toSurreal_single] + simp only [Fits, forall_moves_mul, moves_ofSets, Player.cases] + constructor + · intro p + cases p <;> simp only [forall_leftMoves_wpow, forall_rightMoves_wpow, + forall_mem_image] + · constructor + · intro b hb + rw [Numeric.not_le] + grw [hzeroOption (Or.inl hb), ← toIGame_equiv (single (Surreal.mk g) 1 * y)] + exact_mod_cast mul_lt_mul_of_pos_left (lt_of_truncLT hb) hxpos + · intro q _ z hz b hb + letI := Numeric.of_mem_moves hz + rw [Numeric.not_le] + grw [hoption q hz (Or.inl hb), ← toIGame_equiv (single (Surreal.mk g) 1 * y)] + exact_mod_cast mulOptionValue_lt_mul_of_lt_of_lt + (single_dyadic_lt_single_one_of_mem_leftMoves g q hz) (lt_of_truncLT hb) + · intro q hq z hz b hb + letI := Numeric.of_mem_moves hz + rw [Numeric.not_le] + grw [hoption q hz (Or.inr hb), ← toIGame_equiv (single (Surreal.mk g) 1 * y)] + exact_mod_cast mulOptionValue_lt_mul_of_gt_of_gt + (single_one_lt_single_dyadic_of_mem_rightMoves g hq hz) (gt_of_truncGT hb) + · intro p + cases p <;> simp only [forall_leftMoves_wpow, forall_rightMoves_wpow, + forall_mem_image] + · constructor + · intro b hb + rw [Numeric.not_le] + grw [← toIGame_equiv (single (Surreal.mk g) 1 * y), hzeroOption (Or.inr hb)] + exact_mod_cast mul_lt_mul_of_pos_left (gt_of_truncGT hb) hxpos + · intro q _ z hz b hb + letI := Numeric.of_mem_moves hz + rw [Numeric.not_le] + grw [← toIGame_equiv (single (Surreal.mk g) 1 * y), hoption q hz (Or.inr hb)] + exact_mod_cast mul_lt_mulOptionValue_of_lt_of_gt + (single_dyadic_lt_single_one_of_mem_leftMoves g q hz) (gt_of_truncGT hb) + · intro q hq z hz b hb + letI := Numeric.of_mem_moves hz + rw [Numeric.not_le] + grw [← toIGame_equiv (single (Surreal.mk g) 1 * y), hoption q hz (Or.inl hb)] + exact_mod_cast mul_lt_mulOptionValue_of_gt_of_lt + (single_one_lt_single_dyadic_of_mem_rightMoves g hq hz) (lt_of_truncLT hb) + +/-- Every left truncation option of `single (mk g) 1 * y` is dominated by a left option of the +Conway product of `ω^ g` with the cut of `y`: it is `single (mk g) 1 * b` for a left truncation +option `b` of `y`, represented by the multiplication option at `0` and `b`. -/ +private theorem exists_leftMove_ge_of_mem_truncLT_single_one_mul (g : IGame.{u}) [Numeric g] + {y : SurrealHahnSeries.{u}} (hy : IsSuccPrelimit y.length) + (hlenRec : ∀ b : SurrealHahnSeries.{u}, b.length < y.length → + (single (Surreal.mk g) 1 * b).toSurreal = ω^ (Surreal.mk g) * b.toSurreal) : + ∀ z ∈ !{toIGame '' truncLT (single (Surreal.mk g) 1 * y) | + toIGame '' truncGT (single (Surreal.mk g) 1 * y)}ᴸ, + ∃ w ∈ (ω^ g * !{toIGame '' truncLT y | toIGame '' truncGT y})ᴸ, z ≤ w := by + rw [moves_ofSets] + rintro _ ⟨t, ht, rfl⟩ + obtain ⟨-, b, hb, rfl⟩ | ⟨hfalse, -⟩ := exists_eq_single_mul_of_mem_truncLT ht + · refine ⟨_, mulOption_mem_moves_mul (b := b.toIGame) (px := left) (py := left) + (zero_mem_leftMoves_wpow g) ?_, ?_⟩ + · rw [moves_ofSets] + exact mem_image_of_mem toIGame hb + · exact (mulOption_wpow_zero_equiv g y + (hlenRec b (length_lt_of_mem_truncLT_or_mem_truncGT hy (Or.inl hb)))).symm.le + · norm_num at hfalse + +/-- Every right truncation option of `single (mk g) 1 * y` dominates a right option of the +Conway product of `ω^ g` with the cut of `y`: it is `single (mk g) 1 * b` for a right truncation +option `b` of `y`, represented by the multiplication option at `0` and `b`. -/ +private theorem exists_rightMove_le_of_mem_truncGT_single_one_mul (g : IGame.{u}) [Numeric g] + {y : SurrealHahnSeries.{u}} (hy : IsSuccPrelimit y.length) + (hlenRec : ∀ b : SurrealHahnSeries.{u}, b.length < y.length → + (single (Surreal.mk g) 1 * b).toSurreal = ω^ (Surreal.mk g) * b.toSurreal) : + ∀ z ∈ !{toIGame '' truncLT (single (Surreal.mk g) 1 * y) | + toIGame '' truncGT (single (Surreal.mk g) 1 * y)}ᴿ, + ∃ w ∈ (ω^ g * !{toIGame '' truncLT y | toIGame '' truncGT y})ᴿ, w ≤ z := by + rw [moves_ofSets] + rintro _ ⟨t, ht, rfl⟩ + obtain ⟨-, b, hb, rfl⟩ | ⟨hfalse, -⟩ := exists_eq_single_mul_of_mem_truncGT ht + · refine ⟨_, mulOption_mem_moves_mul (b := b.toIGame) (px := left) (py := right) + (zero_mem_leftMoves_wpow g) ?_, ?_⟩ + · rw [moves_ofSets] + exact mem_image_of_mem toIGame hb + · exact (mulOption_wpow_zero_equiv g y + (hlenRec b (length_lt_of_mem_truncLT_or_mem_truncGT hy (Or.inr hb)))).le + · norm_num at hfalse + +/-- The limit step for multiplication by the monomial `single (mk g) 1`, given compatibility of +the monomials at the options of `g` on every input and of this monomial on strictly shorter +inputs. -/ +private theorem toSurreal_single_one_mul_limit (g : IGame.{u}) [Numeric g] + {y : SurrealHahnSeries.{u}} (hy : IsSuccPrelimit y.length) + (hmove : ∀ p z [Numeric z], z ∈ g.moves p → ∀ b : SurrealHahnSeries.{u}, + (single (Surreal.mk z) 1 * b).toSurreal = ω^ (Surreal.mk z) * b.toSurreal) + (hlenRec : ∀ b : SurrealHahnSeries.{u}, b.length < y.length → + (single (Surreal.mk g) 1 * b).toSurreal = ω^ (Surreal.mk g) * b.toSurreal) : + (single (Surreal.mk g) 1 * y).toSurreal = ω^ (Surreal.mk g) * y.toSurreal := by + rw [← mk_toIGame (single (Surreal.mk g) 1 * y), ← mk_toIGame y, ← Surreal.mk_wpow, + ← Surreal.mk_mul] + apply Surreal.mk_eq + rw [toIGame_limit hy] + exact (toIGame_equiv (single (Surreal.mk g) 1 * y)).trans + (Fits.equiv_of_forall_moves (fits_single_one_mul g hy hmove hlenRec) + (exists_leftMove_ge_of_mem_truncLT_single_one_mul g hy hlenRec) + (exists_rightMove_le_of_mem_truncGT_single_one_mul g hy hlenRec)) + +private theorem toSurreal_single_one_mul (g : IGame.{u}) [Numeric g] + (y : SurrealHahnSeries.{u}) : + (single (Surreal.mk g) 1 * y).toSurreal = ω^ (Surreal.mk g) * y.toSurreal := by + let motive := fun g : IGame.{u} ↦ ∀ (_hg : Numeric g) (y : SurrealHahnSeries.{u}), + (single (Surreal.mk g) 1 * y).toSurreal = ω^ (Surreal.mk g) * y.toSurreal + apply IGame.moveRecOn (motive := motive) g + intro g IH hg y + induction y using lengthRecOn with + | succ y i s hi hs IHlen => exact toSurreal_single_one_mul_succ g hi IHlen + | limit y hy IHlen => + apply toSurreal_single_one_mul_limit g hy + · intro p z hzNumeric hz b + exact IH p z hz hzNumeric b + · exact IHlen + +/-- Conway normal forms preserve multiplication by an arbitrary singleton on the left. -/ +theorem toSurreal_single_mul (p : Surreal.{u}) (r : ℝ) (y : SurrealHahnSeries.{u}) : + (single p r * y).toSurreal = (single p r).toSurreal * y.toSurreal := by + calc + (single p r * y).toSurreal = (r : Surreal) * ω^ p * y.toSurreal := + toSurreal_single_mul_of_one p r y (by simpa using toSurreal_single_one_mul p.out y) + _ = (single p r).toSurreal * y.toSurreal := by rw [toSurreal_single] + +/-- The limit-by-limit induction step for Conway normal-form multiplication, stated with the two +recursive axes it uses. Compatibility for shorter left inputs is needed only against right inputs +no longer than the fixed right input; compatibility for shorter right inputs is needed only against +the fixed left input. -/ +theorem toSurreal_mul_of_isSuccPrelimit_of_axes + {x y : SurrealHahnSeries.{u}} + (hx : IsSuccPrelimit x.length) (hy : IsSuccPrelimit y.length) + (hmulLeft : ∀ a b : SurrealHahnSeries.{u}, + a.length < x.length → b.length ≤ y.length → + (a * b).toSurreal = a.toSurreal * b.toSurreal) + (hmulRight : ∀ b : SurrealHahnSeries.{u}, b.length < y.length → + (x * b).toSurreal = x.toSurreal * b.toSurreal) : + (x * y).toSurreal = x.toSurreal * y.toSurreal := by + have hlenX {a : SurrealHahnSeries.{u}} + (ha : a ∈ truncLT x ∨ a ∈ truncGT x) : a.length < x.length := + ha.elim (length_lt_of_truncLT hx) (length_lt_of_truncGT hx) + have hlenY {b : SurrealHahnSeries.{u}} + (hb : b ∈ truncLT y ∨ b ∈ truncGT y) : b.length < y.length := + hb.elim (length_lt_of_truncLT hy) (length_lt_of_truncGT hy) + have hmulAY {a : SurrealHahnSeries.{u}} (ha : a ∈ truncLT x ∨ a ∈ truncGT x) : + (a * y).toSurreal = a.toSurreal * y.toSurreal := + hmulLeft a y (hlenX ha) le_rfl + have hmulXB {b : SurrealHahnSeries.{u}} (hb : b ∈ truncLT y ∨ b ∈ truncGT y) : + (x * b).toSurreal = x.toSurreal * b.toSurreal := + hmulRight b (hlenY hb) + have hmulAB {a b : SurrealHahnSeries.{u}} + (ha : a ∈ truncLT x ∨ a ∈ truncGT x) + (hb : b ∈ truncLT y ∨ b ∈ truncGT y) : + (a * b).toSurreal = a.toSurreal * b.toSurreal := + hmulLeft a b (hlenX ha) (hlenY hb).le + rw [← mk_toIGame (x * y), ← mk_toIGame x, ← mk_toIGame y, + ← Surreal.mk_mul] + apply Surreal.mk_eq + rw [toIGame_limit hx, toIGame_limit hy] + apply (toIGame_equiv (x * y)).trans + apply Fits.equiv_of_forall_moves + · simp only [Fits, forall_moves_mul, moves_ofSets, Player.cases] + constructor + · intro p + cases p <;> simp only [forall_mem_image] + · intro a ha b hb + rw [Numeric.not_le] + grw [cutMulOption_equiv (hmulAY (Or.inl ha)) (hmulXB (Or.inl hb)) + (hmulAB (Or.inl ha) (Or.inl hb)), ← toIGame_equiv (x * y)] + exact_mod_cast mulOptionValue_lt_mul_of_lt_of_lt + (lt_of_truncLT ha) (lt_of_truncLT hb) + · intro a ha b hb + rw [Numeric.not_le] + grw [cutMulOption_equiv (hmulAY (Or.inr ha)) (hmulXB (Or.inr hb)) + (hmulAB (Or.inr ha) (Or.inr hb)), ← toIGame_equiv (x * y)] + exact_mod_cast mulOptionValue_lt_mul_of_gt_of_gt + (gt_of_truncGT ha) (gt_of_truncGT hb) + · intro p + cases p <;> simp only [forall_mem_image] + · intro a ha b hb + rw [Numeric.not_le] + grw [← toIGame_equiv (x * y), + cutMulOption_equiv (hmulAY (Or.inl ha)) (hmulXB (Or.inr hb)) + (hmulAB (Or.inl ha) (Or.inr hb))] + exact_mod_cast mul_lt_mulOptionValue_of_lt_of_gt + (lt_of_truncLT ha) (gt_of_truncGT hb) + · intro a ha b hb + rw [Numeric.not_le] + grw [← toIGame_equiv (x * y), + cutMulOption_equiv (hmulAY (Or.inr ha)) (hmulXB (Or.inl hb)) + (hmulAB (Or.inr ha) (Or.inl hb))] + exact_mod_cast mul_lt_mulOptionValue_of_gt_of_lt + (gt_of_truncGT ha) (lt_of_truncLT hb) + · rw [moves_ofSets] + rintro _ ⟨t, ht, rfl⟩ + obtain ⟨a, ha, b, hb, htb, -⟩ := + exists_mulOptionValue_between_of_mem_truncLT ht + let w := IGame.mulOption + !{toIGame '' truncLT x | toIGame '' truncGT x} + !{toIGame '' truncLT y | toIGame '' truncGT y} + a.toIGame b.toIGame + refine ⟨w, ?_, ?_⟩ + · dsimp only [w] + apply mulOption_mem_moves_mul (px := left) (py := left) + · rw [moves_ofSets] + exact mem_image_of_mem toIGame ha + · rw [moves_ofSets] + exact mem_image_of_mem toIGame hb + · dsimp only [w] + grw [cutMulOption_equiv (hmulAY (Or.inl ha)) (hmulXB (Or.inl hb)) + (hmulAB (Or.inl ha) (Or.inl hb))] + exact (toIGame_lt_toIGame_iff.mpr htb).le + · rw [moves_ofSets] + rintro _ ⟨t, ht, rfl⟩ + obtain ⟨a, ha, b, hb, -, hbt⟩ := + exists_mulOptionValue_between_of_mem_truncGT ht + let w := IGame.mulOption + !{toIGame '' truncLT x | toIGame '' truncGT x} + !{toIGame '' truncLT y | toIGame '' truncGT y} + a.toIGame b.toIGame + refine ⟨w, ?_, ?_⟩ + · dsimp only [w] + apply mulOption_mem_moves_mul (px := left) (py := right) + · rw [moves_ofSets] + exact mem_image_of_mem toIGame ha + · rw [moves_ofSets] + exact mem_image_of_mem toIGame hb + · dsimp only [w] + grw [cutMulOption_equiv (hmulAY (Or.inl ha)) (hmulXB (Or.inr hb)) + (hmulAB (Or.inl ha) (Or.inr hb))] + exact (toIGame_lt_toIGame_iff.mpr hbt).le + +/-- The limit-by-limit induction step for Conway normal-form multiplication. If multiplication is +already compatible whenever at least one input has strictly shorter support, it is compatible for +two inputs whose support lengths are successor prelimits. -/ +theorem toSurreal_mul_of_isSuccPrelimit + {x y : SurrealHahnSeries.{u}} + (hx : IsSuccPrelimit x.length) (hy : IsSuccPrelimit y.length) + (hmul : ∀ a b : SurrealHahnSeries.{u}, + a.length ≤ x.length → b.length ≤ y.length → + (a.length < x.length ∨ b.length < y.length) → + (a * b).toSurreal = a.toSurreal * b.toSurreal) : + (x * y).toSurreal = x.toSurreal * y.toSurreal := + toSurreal_mul_of_isSuccPrelimit_of_axes hx hy + (fun a b ha hb ↦ hmul a b ha.le hb (Or.inl ha)) + (fun b hb ↦ hmul x b le_rfl hb.le (Or.inr hb)) + +/-- The Conway normal-form equivalence from surreal Hahn series to surreal numbers preserves +multiplication. -/ +theorem toSurreal_mul (x y : SurrealHahnSeries.{u}) : + (x * y).toSurreal = x.toSurreal * y.toSurreal := by + apply lengthRecOn (motive := fun x ↦ ∀ y, + (x * y).toSurreal = x.toSurreal * y.toSurreal) x + · intro x i r hi _ IH y + rw [add_mul, toSurreal_add, IH, toSurreal_single_mul, toSurreal_succ hi, + toSurreal_single] + ring + · intro x hx IHx y + apply lengthRecOn (motive := fun y ↦ + (x * y).toSurreal = x.toSurreal * y.toSurreal) y + · intro y i r hi _ IHy + have hsingle : + (x * single i r).toSurreal = x.toSurreal * (single i r).toSurreal := by + rw [mul_comm, toSurreal_single_mul, mul_comm] + rw [mul_add, toSurreal_add, IHy, hsingle, toSurreal_succ hi, toSurreal_single] + ring + · intro y hy IHy + exact toSurreal_mul_of_isSuccPrelimit_of_axes hx hy + (fun a b ha _ ↦ IHx a ha b) IHy + +/-- Conway normal forms preserve arbitrary surreal products. -/ +@[simp] +theorem _root_.Surreal.toHahnSeries_mul (x y : Surreal.{u}) : + (x * y).toHahnSeries = x.toHahnSeries * y.toHahnSeries := by + apply toSurreal_strictMono.injective + rw [toSurreal_mul, Surreal.toSurreal_toHahnSeries, + Surreal.toSurreal_toHahnSeries, Surreal.toSurreal_toHahnSeries] + +/-- Conway normal form as a ring equivalence between surreals and small surreal Hahn series. -/ +def _root_.Surreal.toHahnSeriesRingEquiv : + Surreal.{u} ≃+* SurrealHahnSeries.{u} where + toEquiv := Surreal.toHahnSeriesOrderIso.toEquiv + map_add' := Surreal.toHahnSeries_add + map_mul' := Surreal.toHahnSeries_mul + +@[simp] +theorem _root_.Surreal.toHahnSeriesRingEquiv_apply (x : Surreal.{u}) : + Surreal.toHahnSeriesRingEquiv x = x.toHahnSeries := + (rfl) + +@[simp] +theorem _root_.Surreal.toHahnSeriesRingEquiv_symm_apply (x : SurrealHahnSeries.{u}) : + Surreal.toHahnSeriesRingEquiv.symm x = x.toSurreal := + (rfl) + +end SurrealHahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormRecursion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormRecursion.lean new file mode 100644 index 0000000000..b0383150d8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormRecursion.lean @@ -0,0 +1,504 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov, Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormBasic +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Leading + +/-! +# Recursion on the length of a surreal Hahn series + +This module supplies successor decomposition and transfinite length recursion for the Conway +normal-form construction. It follows the corresponding axiom-free infrastructure from +CombinatorialGames PR #263, adapted to the pinned public API. +-/ + +universe u + +public noncomputable section + +attribute [grind =] Subtype.mk_le_mk Subtype.mk_lt_mk Order.lt_add_one_iff + +open Order Set + +namespace SurrealHahnSeries + +open Ordinal + +@[simp] +theorem truncIdx_eq_self {x : SurrealHahnSeries} {i : Ordinal} : + x.truncIdx i = x ↔ x.length ≤ i where + mp h := by + contrapose! h + exact truncIdx_ne h + mpr := truncIdx_of_le + +@[simp] +theorem truncIdx_length (x : SurrealHahnSeries) : x.truncIdx x.length = x := by + simp + +theorem self_mem_range_truncIdx (x : SurrealHahnSeries) : x ∈ range x.truncIdx := + ⟨_, x.truncIdx_length⟩ + +theorem self_mem_range_trunc (x : SurrealHahnSeries) : x ∈ range x.trunc := by + refine ⟨!{∅ | x.support}, trunc_eq_self ?_⟩ + aesop + +theorem range_truncIdx_eq_range_trunc (x : SurrealHahnSeries) : + range x.truncIdx = range x.trunc := by + ext y + constructor + · rintro ⟨i, rfl⟩ + obtain h | h := lt_or_ge i x.length + · rw [truncIdx_of_lt h] + exact mem_range_self _ + · rw [truncIdx_of_le h] + exact self_mem_range_trunc x + · rintro ⟨i, rfl⟩ + by_cases! hx : ∀ j ∈ x.support, i < j + · rw [trunc_eq_self_iff.2 hx] + use x.length + simp + · have H : {j : x.support | j.1 ≤ i}.Nonempty := by + obtain ⟨j, hj, hj'⟩ := hx + exact ⟨⟨j, hj⟩, hj'⟩ + obtain ⟨j, hj, hj'⟩ := wellFounded_gt.has_min _ H + use x.exp.symm j + rw [truncIdx_symm_exp] + refine trunc_eq_trunc hj fun k hk hk' ↦ ?_ + by_contra hk'' + exact hj' ⟨k, hk''⟩ hk' hk + +theorem truncIdx_mem_range_trunc (x : SurrealHahnSeries) (i : Ordinal) : + x.truncIdx i ∈ range x.trunc := by + simp [← range_truncIdx_eq_range_trunc] + +theorem trunc_mem_range_truncIdx (x : SurrealHahnSeries) (i : Surreal) : + x.trunc i ∈ range x.truncIdx := by + simp [range_truncIdx_eq_range_trunc] +@[simp] +theorem leadingTerm_term (x : SurrealHahnSeries) (i : Ordinal) : + (x.term i).leadingTerm = x.term i := by + by_cases hi : i < x.length + · rw [term_of_lt hi] + simp + · rw [term_of_le (le_of_not_gt hi)] + simp + +@[simp] +theorem leadingCoeff_term (x : SurrealHahnSeries) (i : Ordinal) : + (x.term i).leadingCoeff = x.coeffIdx i := by + by_cases hi : i < x.length + · rw [term_of_lt hi, coeffIdx_of_lt hi] + simp + · rw [term_of_le (le_of_not_gt hi), coeffIdx_of_le (le_of_not_gt hi)] + simp + +theorem wlog_term {x : SurrealHahnSeries} {i : Ordinal} (hi : i < x.length) : + (x.term i).wlog = x.exp ⟨i, hi⟩ := by + have hc : x.coeffIdx i ≠ 0 := by + rw [ne_eq, coeffIdx_eq_zero_iff] + exact not_le_of_gt hi + have hc' : (x.coeffIdx i : Surreal) ≠ 0 := by exact_mod_cast hc + rw [term_of_lt hi, Surreal.wlog_mul hc' (by simp)] + simp + +theorem mk_term {x : SurrealHahnSeries} {i : Ordinal} (hi : i < x.length) : + ArchimedeanClass.mk (x.term i) = .mk (ω^ (x.exp ⟨i, hi⟩)) := by + have hc : x.coeffIdx i ≠ 0 := by + rw [ne_eq, coeffIdx_eq_zero_iff] + exact not_le_of_gt hi + rw [term_of_lt hi, ArchimedeanClass.mk_mul, Surreal.mk_realCast hc] + simp + +namespace TermSeq + +/-- A `TermSeq` with a single term. -/ +@[simps (attr := grind =), expose] +def single (r : ℝ) (e : Surreal) (hr : r ≠ 0) : TermSeq where + length := 1 + exp _ := e + coeff _ := r + exp_strictAnti _ := by simp + coeff_ne_zero _ := hr + +/-- Appends a single term at the end of a `TermSeq`. -/ +@[simps (attr := grind =) -isSimp, expose] +def appendSingle (s : TermSeq) (r : ℝ) (e : Surreal) (hr : r ≠ 0) (he : ∀ i, e < s.exp i) : + TermSeq where + length := s.length + 1 + exp i := if h : i = s.length then e else s.exp ⟨i, by grind⟩ + coeff i := if h : i = s.length then r else s.coeff ⟨i, by grind⟩ + exp_strictAnti := by grind [StrictAnti] + coeff_ne_zero := by grind + +attribute [simp] appendSingle_length + +theorem exp_eq_exp_appendSingle (s : TermSeq) (i r e hr he) : + s.exp i = (s.appendSingle r e hr he).exp ⟨i.1, by grind⟩ := by + rw [appendSingle_exp, dif_neg (ne_of_lt i.2)] + +theorem coeff_eq_coeff_appendSingle (s : TermSeq) (i r e hr he) : + s.coeff i = (s.appendSingle r e hr he).coeff ⟨i.1, by grind⟩ := by + rw [appendSingle_coeff, dif_neg (ne_of_lt i.2)] + +@[simp, grind =] +theorem exp_appendSingle_same (s : TermSeq) (r e hr he) : + (s.appendSingle r e hr he).exp ⟨s.length, by grind⟩ = e := by + rw [appendSingle_exp, dif_pos rfl] + +@[simp, grind =] +theorem coeff_appendSingle_same (s : TermSeq) (r e hr he) : + (s.appendSingle r e hr he).coeff ⟨s.length, by grind⟩ = r := by + rw [appendSingle_coeff, dif_pos rfl] + +@[simp] +theorem coe_appendSingle {s : TermSeq} {r : ℝ} {e : Surreal} (hr : r ≠ 0) (he : ∀ i, e < s.exp i) : + appendSingle s r e hr he = s + SurrealHahnSeries.single e r := by + ext j + by_cases hj : j ∈ range s.exp + · obtain ⟨j, rfl⟩ := hj + rw [coeff_add_apply] + conv_lhs => rw [exp_eq_exp_appendSingle s j r e hr he] + rw [coeff_coe, appendSingle_coeff, dif_neg (ne_of_lt j.2), coeff_coe, + coeff_single_of_ne (ne_of_lt (he j)), add_zero] + · rw [coeff_add_apply, coeff_coe_of_notMem hj, zero_add] + obtain rfl | he := eq_or_ne e j + · conv_lhs => right; rw [← exp_appendSingle_same s r e hr he] + rw [coeff_coe] + simp + · rw [coeff_single_of_ne he, coeff_coe_of_notMem] + rintro ⟨k, hk⟩ + rw [appendSingle_exp] at hk + split at hk + · exact he hk + · apply hj + refine ⟨⟨k, ?_⟩, hk⟩ + have hk' : ↑k ≤ s.length := by + rw [← Order.lt_add_one_iff, ← appendSingle_length] + exact k.2 + exact lt_of_le_of_ne hk' ‹↑k ≠ s.length› + +/-- Truncate a `TermSeq` at the i-th term. -/ +@[simps (attr := grind =), expose] +def trunc (s : TermSeq) (i : Ordinal) : TermSeq where + length := min i s.length + exp i := s.exp ⟨i, by grind⟩ + coeff i := s.coeff ⟨i, by grind⟩ + exp_strictAnti _ := by grind + coeff_ne_zero := by grind + +@[simp] +theorem trunc_of_le {s : TermSeq} {i : Ordinal} (h : s.length ≤ i) : s.trunc i = s := by + ext + · simpa + · rfl + · rfl + +@[simp] +theorem trunc_trunc (s : TermSeq) (i j : Ordinal) : (s.trunc i).trunc j = s.trunc (min i j) := by + ext + · simp only [trunc_length] + ac_rfl + · simp + · simp + +@[simp← ] +theorem coe_trunc (s : TermSeq) (i : Ordinal) : s.trunc i = truncIdx s i := by + obtain hi | hi := lt_or_ge i s.length + · rw [truncIdx_of_lt (by simpa), exp_coe] + ext j + by_cases hj : j ∈ range s.exp + · obtain ⟨⟨j, hj⟩, _, rfl⟩ := hj + obtain hj' | hj' := lt_or_ge j i + · rw [coeff_trunc_of_lt] + · have hj'' : j < (s.trunc i).length := by + simpa only [trunc_length, mem_Iio, lt_inf_iff] using And.intro hj' hj + change + coeff (s.trunc i : SurrealHahnSeries) + ((s.trunc i).exp ⟨j, hj''⟩) = + coeff (s : SurrealHahnSeries) (s.exp ⟨j, hj⟩) + rw [coeff_coe, coeff_coe] + rw [trunc_coeff] + · simpa + · rw [coeff_trunc_of_le, coeff_coe_of_notMem] + · grind + · simpa + · rw [coeff_trunc_eq_zero, coeff_coe_of_notMem] + · grind + · rwa [← support_coe, mem_support_iff, not_ne_iff] at hj + · rw [trunc_of_le hi, truncIdx_of_le (by simpa)] + +theorem trunc_appendSingle {s : TermSeq} {r e hr he} {i} (hi : i ≤ s.length) : + trunc (s.appendSingle r e hr he) i = trunc s i := by + apply TermSeq.ext + · have hi' : i ≤ s.length + 1 := hi.trans (by simp) + rw [trunc_length, trunc_length, appendSingle_length, min_eq_left hi, min_eq_left hi'] + · intro k hs ht + have hk : k < s.length := by + apply lt_of_lt_of_le ht + rw [trunc_length] + exact min_le_right .. + rw [trunc_exp, trunc_exp, appendSingle_exp, dif_neg (ne_of_lt hk)] + · intro k hs ht + have hk : k < s.length := by + apply lt_of_lt_of_le ht + rw [trunc_length] + exact min_le_right .. + rw [trunc_coeff, trunc_coeff, appendSingle_coeff, dif_neg (ne_of_lt hk)] + +@[simp] +theorem trunc_appendSingle_self (s : TermSeq) {r e} (hr he) : + trunc (s.appendSingle r e hr he) s.length = s := by + rw [trunc_appendSingle le_rfl , trunc_of_le le_rfl] + +theorem trunc_add_one {s : TermSeq} {i} (hi : i < s.length) : + s.trunc (i + 1) = + (s.trunc i).appendSingle (s.coeff ⟨i, hi⟩) (s.exp ⟨i, hi⟩) (by simp) (by grind) := by + have hi' : i + 1 ≤ s.length := Order.add_one_le_iff.mpr hi + have hlength : (s.trunc i).length = i := by + rw [trunc_length, min_eq_left hi.le] + apply TermSeq.ext + · rw [trunc_length, appendSingle_length, hlength, min_eq_left hi'] + · intro k hs ht + have hk : k < i + 1 := by + apply lt_of_lt_of_le hs + rw [trunc_length] + exact min_le_left .. + rw [appendSingle_exp] + by_cases hki : k = i + · rw [dif_pos (hki.trans hlength.symm), trunc_exp] + subst k + rfl + · rw [dif_neg (by + intro h + exact hki (h.trans hlength)), trunc_exp, trunc_exp] + · intro k hs ht + have hk : k < i + 1 := by + apply lt_of_lt_of_le hs + rw [trunc_length] + exact min_le_left .. + rw [appendSingle_coeff] + by_cases hki : k = i + · rw [dif_pos (hki.trans hlength.symm), trunc_coeff] + subst k + rfl + · rw [dif_neg (by + intro h + exact hki (h.trans hlength)), trunc_coeff, trunc_coeff] + + +end TermSeq + +/-! ### Recursion principles -/ + +/-- Build data for a `SurrealHahnSeries` by building it for a `TermSeq`. -/ +def termSeqRecOn {motive : SurrealHahnSeries → Sort*} (x : SurrealHahnSeries) + (mk : ∀ s : TermSeq, motive s) : motive x := + cast (congrArg _ (by simp)) (mk (.ofSurrealHahnSeries x)) + +@[simp] +theorem termSeqRecOn_coe {motive : SurrealHahnSeries → Sort*} {mk} (s : TermSeq) : + termSeqRecOn (motive := motive) s mk = mk s := by + rw [termSeqRecOn, cast_eq_iff_heq] + congr + simp + +theorem length_add_single {x : SurrealHahnSeries} {i : Surreal} {r : ℝ} + (h : ∀ j ∈ x.support, i < j) (hr : r ≠ 0) : (x + single i r).length = x.length + 1 := by + induction x using termSeqRecOn with | mk s + rw [← TermSeq.coe_appendSingle hr fun _ ↦ h _ (by simp)] + rw [TermSeq.length_coe] + simp + +theorem length_add_single_le {x : SurrealHahnSeries} {i : Surreal} {r : ℝ} + (h : ∀ j ∈ x.support, i < j) : (x + single i r).length ≤ x.length + 1 := by + obtain rfl | hr := eq_or_ne r 0 + · simp + · rw [length_add_single h hr] + +@[simp] +theorem length_single (i : Surreal) {r : ℝ} (hr : r ≠ 0) : length (.single i r) = 1 := by + rw [← zero_add (single i r), length_add_single _ hr] <;> simp + +theorem length_single_le (i : Surreal) (r : ℝ) : length (.single i r) ≤ 1 := by + obtain rfl | hr := eq_or_ne r 0 <;> simp_all + +private theorem isLeast_support_succ {x : SurrealHahnSeries} {o : Ordinal} (h : x.length = o + 1) : + (x.exp ⟨o, by simp_all⟩).1 ∈ lowerBounds x.support := by + refine fun j hj ↦ ?_ + change _ ≤ ↑(⟨j, hj⟩ : x.support) + rw [← symm_exp_le_symm_exp_iff, x.exp.symm_apply_apply, ← Subtype.coe_le_coe, ← lt_add_one_iff] + exact h ▸ symm_exp_lt _ + +-- Auxiliary construction for `lengthRecOn`. +private def lengthRecOnAux {motive : SurrealHahnSeries → Sort*} (o : Ordinal) + (succ : ∀ y i r, (∀ j ∈ y.support, i < j) → r ≠ 0 → motive y → motive (y + single i r)) + (limit : ∀ y, IsSuccPrelimit y.length → (∀ z, length z < length y → motive z) → motive y) : + ∀ x, x.length = o → motive x := + SuccOrder.prelimitRecOn o + (by + refine fun a _ IH x hx ↦ cast (congrArg _ <| trunc_add_single (isLeast_support_succ hx)) + (succ (x.trunc <| x.exp ⟨a, ?_⟩) _ _ ?_ ?_ (IH _ ?_)) + all_goals aesop + ) + (fun a ha IH x hx ↦ limit _ (hx ▸ ha) fun y hy ↦ IH _ (hx ▸ hy) _ rfl) + +private theorem lengthRecOnAux_succ {motive : SurrealHahnSeries → Sort*} + {o a : Ordinal} (ha : a = o + 1) {succ limit} : + lengthRecOnAux (motive := motive) a succ limit = fun x _ ↦ + cast (congrArg _ <| trunc_add_single (isLeast_support_succ <| by simp_all)) + (succ (x.trunc <| x.exp ⟨o, _⟩) _ _ (by grind) (by simp_all) + (lengthRecOnAux o succ limit _ (by grind))) := by + subst ha; exact SuccOrder.prelimitRecOn_succ .. + +private theorem lengthRecOnAux_limit {motive : SurrealHahnSeries → Sort*} + {o : Ordinal} (ho : IsSuccPrelimit o) {succ limit} : + lengthRecOnAux (motive := motive) o succ limit = fun y hy ↦ + limit y (by simp_all) fun z _ ↦ lengthRecOnAux _ succ limit z rfl := + SuccOrder.prelimitRecOn_of_isSuccPrelimit _ _ ho + +/-- Recursion on the length of a Hahn series, separating out the case where it's a +succesor ordinal. -/ +def lengthRecOn {motive : SurrealHahnSeries → Sort*} (x : SurrealHahnSeries) + (succ : ∀ y i r, (∀ j ∈ y.support, i < j) → r ≠ 0 → motive y → motive (y + single i r)) + (limit : ∀ y, IsSuccPrelimit y.length → (∀ z, length z < length y → motive z) → motive y) : + motive x := + lengthRecOnAux _ succ limit _ rfl + +theorem lengthRecOn_succ {motive : SurrealHahnSeries → Sort*} {succ limit} + {x : SurrealHahnSeries} {i : Surreal} {r : ℝ} (hi : ∀ j ∈ x.support, i < j) (hr : r ≠ 0) : + lengthRecOn (motive := motive) (x + single i r) succ limit = + succ _ _ _ hi hr (lengthRecOn x succ limit) := by + rw [lengthRecOn, lengthRecOnAux_succ (o := x.length), cast_eq_iff_heq, lengthRecOn] + · have H : ∀ {hx}, ↑((x + single i r).exp ⟨x.length, hx⟩) = i := by + induction x using termSeqRecOn with | mk s + rw [← TermSeq.coe_appendSingle hr fun _ ↦ hi _ (by simp)] + simp + congr! + · rw [H, trunc_add, trunc_single_of_le le_rfl, add_zero, trunc_eq_self hi] + · exact H + · rw [H] + simpa using mt (hi i) (lt_irrefl i) + · exact length_add_single hi hr + +theorem lengthRecOn_limit {motive : SurrealHahnSeries → Sort*} + {x : SurrealHahnSeries} (hx : IsSuccPrelimit x.length) {succ limit} : + lengthRecOn (motive := motive) x succ limit = + limit x hx fun y _ ↦ lengthRecOn y succ limit := by + rw [lengthRecOn, lengthRecOnAux_limit hx] + rfl + +/-! ### Extra lemmas -/ + +theorem length_truncIdx_add_single {x : SurrealHahnSeries} (i : Iio x.length) {r : ℝ} (hr : r ≠ 0) : + (x.truncIdx i + single (x.exp i) r).length = i + 1 := by + rw [length_add_single _ hr, length_truncIdx] + · grind + · rw [truncIdx_of_lt i.2, support_trunc] + aesop + +theorem length_truncIdx_add_single_le {x : SurrealHahnSeries} (i : Iio x.length) (r : ℝ) : + (x.truncIdx i + single (x.exp i) r).length ≤ i + 1 := by + obtain rfl | hr := eq_or_ne r 0 + · simp + · rw [length_truncIdx_add_single _ hr] + +@[simp] +theorem truncIdx_truncIdx (x : SurrealHahnSeries) (i j : Ordinal) : + (x.truncIdx i).truncIdx j = x.truncIdx (min i j) := by + induction x using termSeqRecOn with | mk s + simp + +@[aesop simp] +theorem coeffIdx_truncIdx (x : SurrealHahnSeries) (i : Ordinal) : + (x.truncIdx i).coeffIdx = fun j ↦ if j < i then x.coeffIdx j else 0 := by + ext j + induction x using termSeqRecOn with | mk s + aesop + +theorem coeffIdx_truncIdx_of_lt {x : SurrealHahnSeries} {i j : Ordinal} (h : j < i) : + (x.truncIdx i).coeffIdx j = x.coeffIdx j := by + rw [coeffIdx_truncIdx] + exact if_pos h + +theorem coeffIdx_truncIdx_of_le {x : SurrealHahnSeries} {i j : Ordinal} (h : i ≤ j) : + (x.truncIdx i).coeffIdx j = 0 := by + rw [coeffIdx_truncIdx] + exact if_neg h.not_gt + +theorem truncIdx_add_one {x : SurrealHahnSeries} {i : Ordinal} (hi : i < x.length) : + x.truncIdx (i + 1) = x.truncIdx i + single (x.exp ⟨i, hi⟩) (x.coeffIdx i) := by + induction x using termSeqRecOn with | mk s + rw [← TermSeq.coe_trunc, ← TermSeq.coe_trunc, TermSeq.exp_coe, + ← TermSeq.coe_appendSingle, TermSeq.trunc_add_one] + · congr + rw [TermSeq.coeffIdx_coe_of_lt (by simpa using hi)] + · simpa using hi + · simp_rw [TermSeq.trunc_exp] + grind + +theorem eq_of_length_eq_add_one {x : SurrealHahnSeries} {i : Ordinal} (hi : x.length = i + 1) : + x = x.truncIdx i + single (x.exp ⟨i, by simp [hi]⟩) (x.coeffIdx i) := by + rw [← truncIdx_add_one, truncIdx_of_le hi.le] + +theorem support_truncIdx_strictMonoOn {x : SurrealHahnSeries} : + StrictMonoOn (fun i ↦ (truncIdx x i).support) (Iio x.length) := by + intro i hi j hj h + dsimp + rw [← min_eq_right h.le, ← truncIdx_truncIdx] + apply support_truncIdx_ssubset + simp_all + +theorem support_truncIdx_mono {x : SurrealHahnSeries} : + Monotone fun i ↦ (truncIdx x i).support := by + intro i j h + dsimp + rw [← min_eq_right h, ← truncIdx_truncIdx] + exact support_truncIdx_subset .. + +@[simp] +theorem exp_truncIdx {x : SurrealHahnSeries} {i : Ordinal} (j : Iio (x.truncIdx i).length) : + (x.truncIdx i).exp j = ⟨x.exp ⟨j, by aesop⟩, by aesop⟩ := by + induction x using termSeqRecOn with | mk s + apply Subtype.val_injective + rw [exp_congr (TermSeq.coe_trunc s i).symm] + simp + +theorem term_truncIdx_of_lt {x : SurrealHahnSeries} {i j : Ordinal} (h : j < i) : + (x.truncIdx i).term j = x.term j := by + obtain h' | h' := le_or_gt x.length j + · rw [truncIdx_of_le (h'.trans h.le)] + · rw [term_of_lt, term_of_lt h', coeffIdx_truncIdx_of_lt h] + · simp + · simpa [h] + +theorem term_truncIdx_of_le {x : SurrealHahnSeries} {i j : Ordinal} (h : i ≤ j) : + (x.truncIdx i).term j = 0 := by + rw [term_of_le] + simp [h] + +theorem term_injective : term.Injective := by + intro x y h + induction x using termSeqRecOn with | mk s + induction y using termSeqRecOn with | mk t + congr + ext i + · refine eq_of_forall_ge_iff fun _ ↦ ?_ + simp_rw [← TermSeq.length_coe, ← term_eq_zero, h] + · have := congrFun h i + convert congrArg Surreal.wlog this <;> + · rw [wlog_term, TermSeq.exp_coe] + simpa + · have := congrFun h i + convert congrArg Surreal.leadingCoeff this <;> + · rw [leadingCoeff_term, TermSeq.coeffIdx_coe_of_lt] + +@[simp] +theorem term_inj {x y : SurrealHahnSeries} : x.term = y.term ↔ x = y := + term_injective.eq_iff + +end SurrealHahnSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormSupport.lean new file mode 100644 index 0000000000..6ee38be01c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormSupport.lean @@ -0,0 +1,158 @@ +/- +Copyright (c) 2026 Dan Abramov, Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov, Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Birthday.Basic +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Pow + +/-! +# Support lemmas for the Conway normal-form construction + +These inequalities and equivalences are used in the axiom-free Conway normal-form construction +of CombinatorialGames PR #263. Their names, statements, and namespaces agree with the +corresponding upstream declarations. +-/ + +public noncomputable section + +universe u + +namespace IGame + +namespace Numeric + +theorem mul_wpow_lt_mul_wpow_of_pos {x y : IGame} [Numeric x] [Numeric y] + (r : ℝ) {s : ℝ} (hs : 0 < s) (h : x < y) : r * ω^ x < s * ω^ y := + mul_wpow_lt_mul_wpow r hs h + +theorem mul_wpow_lt_mul_wpow_of_neg {x y : IGame} [Numeric x] [Numeric y] + {r : ℝ} (s : ℝ) (hr : r < 0) (h : y < x) : r * ω^ x < s * ω^ y := by + rw [← Surreal.mk_lt_mk] + change (r : Surreal) * ω^ (Surreal.mk x) < (s : Surreal) * ω^ (Surreal.mk y) + rw [← neg_lt_neg_iff] + simpa [neg_mul] using + Surreal.mul_wpow_lt_mul_wpow (-s) (Left.neg_pos_iff.mpr hr) + (Surreal.mk_lt_mk.mpr h) + +theorem realCast_mul_wpow_equiv (r : ℝ) (x : IGame.{u}) [Numeric x] : + r * ω^ x ≈ !{(fun s : ℝ ↦ s * ω^ x) '' Set.Iio r | (fun s : ℝ ↦ s * ω^ x) '' Set.Ioi r} := by + apply Fits.equiv_of_forall_moves + · simp [Fits] + all_goals + simp only [forall_moves_mul, Player.mul_left, Player.mul_right, + moves_ofSets, Player.cases, Set.mem_image] + rintro (_ | _) a ha b hb + · rw [Real.leftMoves_toIGame] at ha + rw [leftMoves_wpow] at hb + obtain ⟨s, hs, rfl⟩ := ha + obtain (rfl | ⟨a, -, y, hy, rfl⟩) := hb + · aesop + numeric + obtain ⟨t, ht, ht'⟩ := exists_between (α := ℝ) hs + refine ⟨(t : IGame) * ω^ x, ⟨t, ht', rfl⟩, ?_⟩ + rw [← Surreal.mk_le_mk] + dsimp [mulOption] + simp_rw [Surreal.mk_dyadic] + rw [add_sub_assoc, ← sub_mul, ← le_sub_iff_add_le, sub_eq_add_neg, add_comm, + ← sub_le_iff_le_add, le_neg, neg_sub, ← sub_mul, ← mul_assoc] + convert Surreal.mk_le_mk.mpr + (mul_wpow_lt_mul_wpow_of_pos ((r - s) * a) (s := t - s) _ (left_lt hy)).le <;> + simp_all + · rw [Real.rightMoves_toIGame] at ha + rw [rightMoves_wpow] at hb + obtain ⟨s, hs, rfl⟩ := ha + obtain ⟨a, ha, y, hy, rfl⟩ := hb + numeric + obtain ⟨t, ht⟩ := exists_lt r + refine ⟨(t : IGame) * ω^ x, ⟨t, ht, rfl⟩, ?_⟩ + rw [← Surreal.mk_le_mk] + dsimp [mulOption] + simp_rw [Surreal.mk_dyadic] + rw [add_sub_assoc, ← sub_mul, ← le_sub_iff_add_le, sub_eq_add_neg, add_comm, + ← sub_le_iff_le_add, ← neg_mul, ← sub_mul, neg_sub, ← mul_assoc] + convert Surreal.mk_le_mk.mpr + (mul_wpow_lt_mul_wpow_of_pos (s - t) (s := (s - r) * a) _ (lt_right hy)).le <;> + simp_all + · rw [Real.leftMoves_toIGame] at ha + rw [Player.neg_left, rightMoves_wpow] at hb + obtain ⟨s, hs, rfl⟩ := ha + obtain ⟨a, ha, y, hy, rfl⟩ := hb + numeric + obtain ⟨t, ht⟩ := exists_gt r + refine ⟨(t : IGame) * ω^ x, ⟨t, ht, rfl⟩, ?_⟩ + rw [← Surreal.mk_le_mk] + dsimp [mulOption] + simp_rw [Surreal.mk_dyadic] + rw [add_sub_assoc, ← sub_mul, ← sub_le_iff_le_add', ← sub_mul, ← mul_assoc] + convert Surreal.mk_le_mk.mpr + (mul_wpow_lt_mul_wpow_of_pos (t - s) (s := (r - s) * a) _ (lt_right hy)).le <;> + simp_all + · rw [Real.rightMoves_toIGame] at ha + rw [Player.neg_right, leftMoves_wpow] at hb + obtain ⟨s, hs, rfl⟩ := ha + obtain (rfl | ⟨a, -, y, hy, rfl⟩) := hb + · aesop + numeric + obtain ⟨t, ht, ht'⟩ := exists_between (α := ℝ) hs + refine ⟨(t : IGame) * ω^ x, ⟨t, ht, rfl⟩, ?_⟩ + rw [← Surreal.mk_le_mk] + dsimp [mulOption] + simp_rw [Surreal.mk_dyadic] + rw [add_sub_assoc, ← sub_mul, ← sub_le_iff_le_add', ← sub_mul, ← neg_le_neg_iff, + ← neg_mul, neg_sub, ← neg_mul, neg_sub, ← mul_assoc] + convert Surreal.mk_le_mk.mpr + (mul_wpow_lt_mul_wpow_of_pos ((s - r) * a) (s := s - t) _ (left_lt hy)).le <;> + simp_all + +end Numeric + +/-- A simplicity-theorem variant using an equivalent game whose moves are easier to enumerate. -/ +theorem Fits.equiv_of_forall_moves_of_equiv {x y : IGame} (a : IGame) (h : x ≈ a) + (hx : x.Fits y) (hl : ∀ z ∈ aᴸ, ∃ w ∈ yᴸ, z ≤ w) + (hr : ∀ z ∈ aᴿ, ∃ w ∈ yᴿ, w ≤ z) : x ≈ y := + h.trans <| Fits.equiv_of_forall_moves (hx.congr h) hl hr + +end IGame + +namespace Surreal + +theorem birthday_eq_iInf_fits (x : IGame) [hx : IGame.Numeric x] : + birthday (.mk x) = + ⨅ y : {y : Subtype IGame.Numeric // IGame.Fits y x}, birthday (.mk y.1.1) := by + let f (y : {y : Subtype IGame.Numeric // IGame.Fits y x}) := birthday (.mk y.1) + let : Inhabited {y : Subtype IGame.Numeric // IGame.Fits y x} := + ⟨⟨x, hx⟩, IGame.Fits.refl _⟩ + apply (ciInf_le' f default).antisymm' + obtain ⟨⟨⟨y, _⟩, hy⟩, hy'⟩ := ciInf_mem f + obtain ⟨z, _, hz, hz'⟩ := birthday_eq_iGameBirthday (.mk y) + rw [← hz'.trans hy'] + apply (birthday_mk_le z).trans' + congr! 1 + rw [eq_comm, mk_eq_mk] at hz ⊢ + refine (hy.congr hz).equiv_of_forall_birthday_le fun w hw hw' ↦ hz' ▸ ?_ + exact hy'.trans_le <| (ciInf_le' f ⟨⟨w, hw⟩, hw'⟩).trans (birthday_mk_le _) + +end Surreal + +namespace IGame + +theorem Fits.birthday_le {x y : IGame} [hx : Numeric x] [Numeric y] (h : Fits x y) : + Surreal.birthday (.mk y) ≤ Surreal.birthday (.mk x) := by + let f (x : {x : Subtype Numeric // Fits x y}) := Surreal.birthday (.mk x.1) + rw [Surreal.birthday_eq_iInf_fits y] + exact ciInf_le' f ⟨⟨x, hx⟩, h⟩ + +theorem Fits.birthday_lt {x y : IGame} [Numeric x] [Numeric y] + (h : Fits x y) (he : ¬ x ≈ y) : Surreal.birthday (.mk y) < Surreal.birthday (.mk x) := by + apply h.birthday_le.lt_of_not_ge + contrapose he + obtain ⟨z, _, hz, hz'⟩ := Surreal.birthday_eq_iGameBirthday (.mk x) + rw [← hz'] at he + rw [eq_comm, Surreal.mk_eq_mk] at hz + exact hz.trans <| (h.congr hz).equiv_of_forall_birthday_le fun w _ hw ↦ + he.trans (hw.birthday_le.trans <| Surreal.birthday_mk_le _) + +end IGame diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/RealLeadingSplit.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/RealLeadingSplit.lean new file mode 100644 index 0000000000..49a75d1583 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/RealLeadingSplit.lean @@ -0,0 +1,531 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IrreducibilityTransfer +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduced +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ArchimedeanAssumptions +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.CardinalIntegerPart +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.IntegerPart +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveCoefficientMap +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveDomainEquiv +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.SignedFull +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Transfer +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealArchimedeanStratum + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEmbedding +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEquiv +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedCharacterization +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.DegreeTransfer + +/-! +# Real leading splits of surreal Hahn series + +Embed a nonpositive real-exponent Hahn series into the surreal exponent group. Its leading +Archimedean class is the real class, its open truncation retains only the constant coefficient, +and splitting at that class simply extends each coefficient by a constant infinitesimal Hahn +series. + +The irreducibility theorem combines this description with the residue-one case of LM24, +Proposition 8.3.6(5): irreducibility after coefficient extension implies irreducibility in the +surreal truncation integer part. The same description shows that a constant-coefficient-one series +is reduced in the sense of LM24, Definition 8.2.1, after the embedding. + +The last section passes to Conway's omnific integers. A real-exponent series with integer +constant coefficient determines the omnific integer `ofRealSeries` whose signed Conway normal form +is the embedded series; its Conway coefficients, support, normal form, and length are read off +from the series, and irreducibility and reducedness transfer. This is the natural route to +omnific integers whose Conway normal forms have real exponents. + +## References + +* S. L'Innocente, V. Mantova, *A factorisation theory for generalised power series and omnific + integers*, Adv. Math. 442 (2024) 109513, cited as [LM24]. +-/ + +universe u v + +open scoped HahnSeries + +public noncomputable section + +namespace HahnSeries.Nonpositive + +open FiniteArchimedeanClass + +variable {R : Type v} [Field R] + +private def realToSurrealAddMonoidHom : ℝ →+ Surreal.{u} := + Real.toSurrealRingHom.toRingHom.toAddMonoidHom + +/-- Map a real-exponent nonpositive Hahn series into the surreal exponent group. -/ +def mapRealDomainToSurreal : Nonpositive ℝ R →+* Nonpositive Surreal.{u} R := + mapDomain realToSurrealAddMonoidHom + (by + intro r s h + change (r : Surreal.{u}) = (s : Surreal.{u}) at h + exact_mod_cast h) + (fun r s ↦ Real.toSurreal_le_iff) + +/-- Mapping the real exponent domain into the surreal numbers is injective. -/ +theorem mapRealDomainToSurreal_injective : + Function.Injective (mapRealDomainToSurreal : + Nonpositive ℝ R → Nonpositive Surreal.{u} R) := by + intro a b hab + apply mapDomain_injective realToSurrealAddMonoidHom + (by + intro x y h + change (x : Surreal.{u}) = (y : Surreal.{u}) at h + exact_mod_cast h) + (fun x y ↦ Real.toSurreal_le_iff) + change mapRealDomainToSurreal a = mapRealDomainToSurreal b + exact hab + +@[simp] +theorem mapRealDomainToSurreal_coeff_real (a : Nonpositive ℝ R) (r : ℝ) : + (mapRealDomainToSurreal a : R⟦Surreal.{u}⟧).coeff (r : Surreal.{u}) = + (a : R⟦ℝ⟧).coeff r := by + exact mapDomain_coeff_image realToSurrealAddMonoidHom + (by + intro x y h + change (x : Surreal.{u}) = (y : Surreal.{u}) at h + exact_mod_cast h) + (fun x y ↦ Real.toSurreal_le_iff) a r + +/-- Mapping the real exponent domain preserves the constant coefficient. -/ +theorem constantCoeff_mapRealDomainToSurreal (a : Nonpositive ℝ R) : + constantCoeff (mapRealDomainToSurreal a : Nonpositive Surreal.{u} R) = + constantCoeff a := by + rw [mapRealDomainToSurreal] + exact constantCoeff_mapDomain realToSurrealAddMonoidHom + (by + intro x y h + change (x : Surreal.{u}) = (y : Surreal.{u}) at h + exact_mod_cast h) + (fun x y ↦ Real.toSurreal_le_iff) a + +/-- Mapping the real exponent domain sends the support pointwise into the surreal real line. -/ +theorem mapRealDomainToSurreal_support (a : Nonpositive ℝ R) : + (mapRealDomainToSurreal a : R⟦Surreal.{u}⟧).support = + (fun r : ℝ ↦ (r : Surreal.{u})) '' (a : R⟦ℝ⟧).support := by + exact support_mapDomain realToSurrealAddMonoidHom + (by + intro x y h + change (x : Surreal.{u}) = (y : Surreal.{u}) at h + exact_mod_cast h) + (fun x y ↦ Real.toSurreal_le_iff) a + +/-- Mapping the real exponent domain preserves support order type, up to universe lift. -/ +theorem lift_supportOrderType_mapRealDomainToSurreal (a : Nonpositive ℝ R) : + Ordinal.lift.{0, u + 1} + (mapRealDomainToSurreal a : R⟦Surreal.{u}⟧).supportOrderType = + Ordinal.lift.{u + 1, 0} (a : R⟦ℝ⟧).supportOrderType := by + rw [mapRealDomainToSurreal] + exact lift_supportOrderType_mapDomain realToSurrealAddMonoidHom + (by + intro x y h + change (x : Surreal.{u}) = (y : Surreal.{u}) at h + exact_mod_cast h) + (fun x y ↦ Real.toSurreal_le_iff) a + +/-- The leading Archimedean class of a nonconstant series supported on the embedded real line is +the real Archimedean class. -/ +theorem leadingClass_mapRealDomainToSurreal_eq_realFiniteClass + {a : Nonpositive ℝ R} (ha : a ≠ 0) + (horder : ((mapRealDomainToSurreal a : Nonpositive Surreal.{u} R) : + R⟦Surreal.{u}⟧).order ≠ 0) : + leadingClass (mapRealDomainToSurreal a) horder = + Surreal.realFiniteClass := by + apply Subtype.ext + rw [leadingClass_val, Surreal.realFiniteClass_val] + have hmappedNe : (mapRealDomainToSurreal a : Nonpositive Surreal.{u} R) ≠ 0 := + fun hzero ↦ ha (mapRealDomainToSurreal_injective (by simpa using hzero)) + have horderMem : ((mapRealDomainToSurreal a : Nonpositive Surreal.{u} R) : + R⟦Surreal.{u}⟧).order ∈ + (mapRealDomainToSurreal a : R⟦Surreal.{u}⟧).support := by + rw [HahnSeries.mem_support] + exact HahnSeries.coeff_order_eq_zero.not.mpr + (fun h ↦ hmappedNe (Subtype.ext h)) + rw [mapRealDomainToSurreal_support] at horderMem + obtain ⟨r, _hr, hrorder⟩ := horderMem + rw [← hrorder] + apply Surreal.mk_realCast + intro hr0 + subst r + apply horder + simpa using hrorder.symm + +/-- The open truncation at the real Archimedean class retains only the constant coefficient of a +series whose exponents are embedded reals. -/ +theorem tau_mapRealDomainToSurreal + (a : Nonpositive ℝ R) : + tau (K := ℝ) + (Surreal.realFiniteClass : FiniteArchimedeanClass Surreal.{u}) + (mapRealDomainToSurreal a) = + C (constantCoeff a) := by + apply Subtype.ext + apply HahnSeries.coeff_injective + funext g + by_cases hgBall : g ∈ ball ℝ + (Surreal.realFiniteClass : FiniteArchimedeanClass Surreal.{u}) + · rw [coeff_tau_of_mem _ _ hgBall] + by_cases hg0 : g = 0 + · subst g + rw [coe_C, HahnSeries.C_apply] + simp only [HahnSeries.coeff_single_same] + have hcoeff := mapRealDomainToSurreal_coeff_real a 0 + have hzero : ((0 : ℝ) : Surreal.{u}) = 0 := + Real.toSurrealRingHom.map_zero + rw [constantCoeff_apply] + rw [← hzero] + exact hcoeff + · have hgNotSupport : g ∉ + (mapRealDomainToSurreal a : R⟦Surreal.{u}⟧).support := by + rw [mapRealDomainToSurreal_support] + rintro ⟨r, _hr, hrg⟩ + have hrealG : g ∈ + (Surreal.realStratum : Submodule ℝ Surreal.{u}) := by + rw [Surreal.mem_realStratum_iff] + exact ⟨r, hrg⟩ + have hzero := Submodule.disjoint_def.mp + Surreal.disjoint_ball_realStratum + g hgBall hrealG + exact hg0 hzero + have hcoeff : (mapRealDomainToSurreal a : R⟦Surreal.{u}⟧).coeff g = 0 := by + rw [← not_ne_iff, ← HahnSeries.mem_support] + exact hgNotSupport + rw [hcoeff, coe_C, HahnSeries.C_apply, + HahnSeries.coeff_single_of_ne hg0] + · rw [coeff_tau_of_not_mem _ _ hgBall] + have hg0 : g ≠ 0 := by + intro hzero + subst g + exact hgBall (zero_mem _) + rw [coe_C, HahnSeries.C_apply, HahnSeries.coeff_single_of_ne hg0] + +/-- The real-supported series belongs to a truncation integer part whenever its constant +coefficient belongs to the chosen coefficient subring. -/ +def mapRealDomainToSurrealIntegerPart (Z : Subring R) (a : Nonpositive ℝ R) + (haConstant : constantCoeff a ∈ Z) : + HahnSeries.truncationIntegerPart Surreal.{u} Z := + ⟨mapRealDomainToSurreal a, by + rw [mem_truncationIntegerPart, ← constantCoeff_apply] + exact (constantCoeff_mapDomain realToSurrealAddMonoidHom + (by + intro x y h + change (x : Surreal.{u}) = (y : Surreal.{u}) at h + exact_mod_cast h) + (fun x y ↦ Real.toSurreal_le_iff) a).symm ▸ haConstant⟩ + +@[simp] +theorem coe_mapRealDomainToSurrealIntegerPart + (Z : Subring R) (a : Nonpositive ℝ R) + (haConstant : constantCoeff a ∈ Z) : + (mapRealDomainToSurrealIntegerPart Z a haConstant : Nonpositive Surreal.{u} R) = + mapRealDomainToSurreal a := + (rfl) + +/-- Splitting a real-supported surreal Hahn series at the real Archimedean class extends its +coefficients by constant infinitesimal Hahn series and leaves its real exponents unchanged. -/ +theorem splitTruncation_mapRealDomainToSurreal + (u : HahnEmbedding.ArchimedeanStrata ℝ Surreal.{u}) (a : Nonpositive ℝ R) : + splitTruncation (Surreal.archimedeanStrataWithReal u) + Surreal.realFiniteClass (mapRealDomainToSurreal a) = + embDomainRingEquiv + (Surreal.archimedeanStrataWithRealOrderAddMonoidIso u) + (nonpositiveCoefficientMap + (HahnSeries.C : R →+* R⟦ball ℝ Surreal.realFiniteClass⟧) a) := by + apply Subtype.ext + apply HahnSeries.ext + funext s + apply HahnSeries.ext + funext b + let e := Surreal.archimedeanStrataWithRealOrderAddMonoidIso u + let r := e.symm s + have hs : e r = s := e.apply_symm_apply s + rw [← hs] + rw [coe_splitTruncation, coe_embDomainRingEquiv, + HahnSeries.archimedeanSplitRingEquiv_coeff, + TClosed_coeff, coeff_T_of_mem] + · rw [HahnSeries.embDomainRingEquiv_coeff, + coe_nonpositiveCoefficientMap] + rw [HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall_apply] + by_cases hb0 : (b : Surreal.{u}) = 0 + · have hb : b = 0 := Subtype.ext hb0 + subst b + simp only [ofLex_toLex] + rw [Surreal.coe_archimedeanStrataWithRealOrderAddMonoidIso] + rw [show ((0 : ball ℝ Surreal.realFiniteClass) : Surreal.{u}) = 0 from rfl, add_zero] + rw [mapRealDomainToSurreal_coeff_real] + simp [HahnSeries.C_apply] + · have hb : b ≠ 0 := fun h ↦ hb0 (congrArg Subtype.val h) + have hleft : (mapRealDomainToSurreal a : R⟦Surreal.{u}⟧).coeff + ((e r : (Surreal.archimedeanStrataWithReal u).stratum + Surreal.realFiniteClass) + (b : Surreal.{u})) = 0 := by + rw [← not_ne_iff, ← HahnSeries.mem_support, + mapRealDomainToSurreal_support] + rintro ⟨q, _hq, hqeq⟩ + have hrealB : (b : Surreal.{u}) ∈ Surreal.realStratum := by + rw [Surreal.mem_realStratum_iff] + refine ⟨q - r, ?_⟩ + have hscoe : (e r : Surreal.{u}) = (r : Surreal.{u}) := by + exact Surreal.coe_archimedeanStrataWithRealOrderAddMonoidIso _ _ + change (q : Surreal.{u}) = (e r : Surreal.{u}) + (b : Surreal.{u}) at hqeq + rw [hscoe] at hqeq + rw [show ((q - r : ℝ) : Surreal.{u}) = (q : Surreal.{u}) - (r : Surreal.{u}) by + exact Real.toSurrealRingHom.map_sub q r] + apply sub_eq_iff_eq_add.mpr + simpa [add_comm] using hqeq + have hzero := Submodule.disjoint_def.mp Surreal.disjoint_ball_realStratum + (b : Surreal.{u}) b.2 hrealB + exact hb (Subtype.ext hzero) + simp only [ofLex_toLex] + rw [hleft] + change 0 = (HahnSeries.C ((a : R⟦ℝ⟧).coeff r)).coeff b + exact (HahnSeries.coeff_single_of_ne hb).symm + · exact (HahnEmbedding.ArchimedeanStrata.stratumLexBallEquivClosedBall + (Surreal.archimedeanStrataWithReal u) Surreal.realFiniteClass (toLex (e r, b))).2 + +/-- A real-supported constant-one series gives an irreducible surreal truncation-integer-part +element when its coefficient extension to the infinitesimal Hahn field is irreducible. -/ +theorem irreducible_mapRealDomainToSurrealIntegerPart + (u : HahnEmbedding.ArchimedeanStrata ℝ Surreal.{u}) (Z : Subring R) + (a : Nonpositive ℝ R) (ha : a ≠ 0) + (haOrder : (mapRealDomainToSurreal a : R⟦Surreal.{u}⟧).order ≠ 0) + (haConstant : constantCoeff a = 1) + (hirr : Irreducible + (nonpositiveCoefficientMap + (HahnSeries.C : R →+* R⟦ball ℝ + (Surreal.realFiniteClass : FiniteArchimedeanClass Surreal.{u})⟧) a)) : + Irreducible + (mapRealDomainToSurrealIntegerPart Z a + (haConstant.symm ▸ Z.one_mem) : + HahnSeries.truncationIntegerPart Surreal.{u} Z) := by + let b : HahnSeries.truncationIntegerPart Surreal.{u} Z := + mapRealDomainToSurrealIntegerPart Z a + (haConstant.symm ▸ Z.one_mem) + have hbCoe : (b : Nonpositive Surreal.{u} R) = mapRealDomainToSurreal a := + (rfl) + have hbOrder : ((b : Nonpositive Surreal.{u} R) : R⟦Surreal.{u}⟧).order ≠ 0 := by + rw [hbCoe] + exact haOrder + have hb0 : (b : Nonpositive Surreal.{u} R) ≠ 0 := by + rw [hbCoe] + intro hzero + exact ha (mapRealDomainToSurreal_injective (by simpa using hzero)) + have hleading : leadingClass (b : Nonpositive Surreal.{u} R) hbOrder = + Surreal.realFiniteClass := by + apply Subtype.ext + rw [leadingClass_val] + have hval := congrArg Subtype.val + (leadingClass_mapRealDomainToSurreal_eq_realFiniteClass ha haOrder) + rw [leadingClass_val] at hval + simpa only [hbCoe] using hval + apply irreducible_of_irreducible_splitTruncation_of_tau_eq_one + (Surreal.archimedeanStrataWithReal u) Z b hb0 hbOrder + · rw [hleading] + apply tauBall_eq_one_of_tau_eq_one + rw [hbCoe, tau_mapRealDomainToSurreal, haConstant] + apply Subtype.ext + simpa only [coe_C, Subring.coe_one] using + (HahnSeries.C_one (Γ := Surreal.{u}) (R := R)) + · rw [hleading, hbCoe, + splitTruncation_mapRealDomainToSurreal] + exact hirr.map + (embDomainRingEquiv + (Surreal.archimedeanStrataWithRealOrderAddMonoidIso u)) + +/-- A real-supported series with constant coefficient one is reduced after embedding its exponents +into the surreal numbers: its open truncation at the leading class is the constant one. -/ +theorem isReduced_mapRealDomainToSurreal {a : Nonpositive ℝ R} + (haOrder : (mapRealDomainToSurreal a : R⟦Surreal.{u}⟧).order ≠ 0) + (haConstant : constantCoeff a = 1) : + IsReduced (mapRealDomainToSurreal a : Nonpositive Surreal.{u} R) := by + have ha : a ≠ 0 := fun h ↦ haOrder (by + rw [h, map_zero, ZeroMemClass.coe_zero, HahnSeries.order_zero]) + have hmappedNe : (mapRealDomainToSurreal a : Nonpositive Surreal.{u} R) ≠ 0 := + fun hzero ↦ ha (mapRealDomainToSurreal_injective (by simpa using hzero)) + apply (isReduced_iff_tau_leadingClass_eq_zero_or_one (K := ℝ) _ hmappedNe haOrder).mpr + right + rw [leadingClass_mapRealDomainToSurreal_eq_realFiniteClass ha haOrder, + tau_mapRealDomainToSurreal, haConstant] + apply Subtype.ext + simpa only [coe_C, Subring.coe_one] using (HahnSeries.C_one (Γ := Surreal.{u}) (R := R)) + +end HahnSeries.Nonpositive + +/-! ### Surreal numbers whose signed Conway normal form has real exponents -/ + +namespace Surreal + +open HahnSeries.Nonpositive + +variable {x : Surreal.{u}} {a : HahnSeries.Nonpositive ℝ ℝ} + +/-- The Conway coefficient at `-r` of a surreal whose signed Conway normal form is a +real-exponent series is the series coefficient at `r`. -/ +theorem coeff_neg_realCast_of_toSignedFullHahnSeries_eq + (hx : x.toSignedFullHahnSeries = mapRealDomainToSurreal a) (r : ℝ) : + x.coeff (-(r : Surreal.{u})) = (a : ℝ⟦ℝ⟧).coeff r := by + rw [← coeff_toSignedFullHahnSeries, hx, mapRealDomainToSurreal_coeff_real] + +/-- The Conway support of a surreal whose signed Conway normal form is a real-exponent series is +the negated image of the series support. -/ +theorem support_of_toSignedFullHahnSeries_eq + (hx : x.toSignedFullHahnSeries = mapRealDomainToSurreal a) : + x.support = (fun r : ℝ ↦ -(r : Surreal.{u})) '' (a : ℝ⟦ℝ⟧).support := by + ext i + constructor + · intro hi + have hsigned : -i ∈ x.toSignedFullHahnSeries.support := + mem_support_toSignedFullHahnSeries.mpr (by rwa [neg_neg]) + rw [hx, mapRealDomainToSurreal_support] at hsigned + obtain ⟨r, hr, hri⟩ := hsigned + have hri' : (r : Surreal.{u}) = -i := hri + refine ⟨r, hr, ?_⟩ + change -(r : Surreal.{u}) = i + rw [hri', neg_neg] + · rintro ⟨r, hr, rfl⟩ + apply mem_support_toSignedFullHahnSeries.mp + rw [hx, mapRealDomainToSurreal_support] + exact ⟨r, hr, rfl⟩ + +/-- The Conway normal form of a surreal whose signed Conway normal form is a real-exponent series +is the surreal Hahn series supported on negated reals whose coefficient at `-r` is the series +coefficient at `r`. -/ +theorem toHahnSeries_eq_of_toSignedFullHahnSeries_eq + (hx : x.toSignedFullHahnSeries = mapRealDomainToSurreal a) (N : SurrealHahnSeries.{u}) + (hN : ∀ r : ℝ, N.coeff (-(r : Surreal.{u})) = (a : ℝ⟦ℝ⟧).coeff r) + (hNsupport : N.support ⊆ Set.range (fun r : ℝ ↦ -(r : Surreal.{u}))) : + x.toHahnSeries = N := by + apply SurrealHahnSeries.ext + funext i + rw [coeff_toHahnSeries] + by_cases hi : i ∈ Set.range (fun r : ℝ ↦ -(r : Surreal.{u})) + · obtain ⟨r, rfl⟩ := hi + change x.coeff (-(r : Surreal.{u})) = N.coeff (-(r : Surreal.{u})) + rw [hN, coeff_neg_realCast_of_toSignedFullHahnSeries_eq hx] + · have hxi : x.coeff i = 0 := by + rw [← notMem_support_iff, support_of_toSignedFullHahnSeries_eq hx] + rintro ⟨r, -, hri⟩ + exact hi ⟨r, hri⟩ + have hNi : N.coeff i = 0 := by + by_contra hne + exact hi (hNsupport (SurrealHahnSeries.mem_support_iff.mpr hne)) + rw [hxi, hNi] + +/-- The lifted Conway length of a surreal whose signed Conway normal form is a real-exponent +series is the lifted support order type of the series. -/ +theorem lift_length_of_toSignedFullHahnSeries_eq + (hx : x.toSignedFullHahnSeries = mapRealDomainToSurreal a) : + Ordinal.lift.{u + 1, u} x.length = + Ordinal.lift.{u + 1, 0} (a : ℝ⟦ℝ⟧).supportOrderType := by + have h : Ordinal.lift.{0, u + 1} + (mapRealDomainToSurreal a : ℝ⟦Surreal.{u}⟧).supportOrderType = + Ordinal.lift.{u + 1, 0} (a : ℝ⟦ℝ⟧).supportOrderType := + lift_supportOrderType_mapRealDomainToSurreal a + rw [← hx, toSignedFullHahnSeries_eq, HahnSeries.supportOrderType_embDomainRingEquiv, + supportOrderType_toFullHahnSeries, Ordinal.lift_id'] at h + exact h + +end Surreal + +/-! ### Omnific integers with real Conway exponents -/ + +namespace Surreal.OmnificInteger + +open HahnSeries.Nonpositive + +variable (a : HahnSeries.Nonpositive ℝ ℝ) + +private theorem cardSupp_mapRealDomainToSurreal_lt : + (mapRealDomainToSurreal a : ℝ⟦Surreal.{u}⟧).cardSupp < Surreal.smallSupportCardinal.{u} := by + have hsmall : Small.{u, u + 1} (mapRealDomainToSurreal a : ℝ⟦Surreal.{u}⟧).support := by + rw [mapRealDomainToSurreal_support] + infer_instance + rw [HahnSeries.cardSupp, Surreal.smallSupportCardinal_eq_univ] + simpa only [Cardinal.lift_id] using (Cardinal.small_iff_lift_mk_lt_univ + (α := (mapRealDomainToSurreal a : ℝ⟦Surreal.{u}⟧).support)).mp hsmall + +private def boundedOfRealSeries (ha : constantCoeff a ∈ Surreal.realIntegerSubring) : + SignedSmallSupportIntegerPart.{u} := + ⟨⟨mapRealDomainToSurreal a, cardSupp_mapRealDomainToSurreal_lt a⟩, by + rw [HahnSeries.mem_cardSuppLTTruncationIntegerPart] + refine ⟨support_subset _, ?_⟩ + rw [← constantCoeff_apply, constantCoeff_mapRealDomainToSurreal] + exact ha⟩ + +private theorem toTruncationIntegerPartRingHom_boundedOfRealSeries + (ha : constantCoeff a ∈ Surreal.realIntegerSubring) : + HahnSeries.CardSuppLTTruncationIntegerPart.toTruncationIntegerPartRingHom + Surreal.realIntegerSubring (boundedOfRealSeries a ha) = + mapRealDomainToSurrealIntegerPart Surreal.realIntegerSubring a ha := by + apply Subtype.ext + apply Subtype.ext + rw [HahnSeries.CardSuppLTTruncationIntegerPart.coe_toTruncationIntegerPartRingHom, + HahnSeries.CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom, + coe_mapRealDomainToSurrealIntegerPart] + rfl + +/-- The omnific integer whose signed Conway normal form is the real-exponent series `a`: the +Conway normal form `∑ a_r ω ^ (-r)` over the support of `a`. -/ +def ofRealSeries (ha : constantCoeff a ∈ Surreal.realIntegerSubring) : + Surreal.OmnificInteger.{u} := + signedSmallSupportIntegerPartRingEquiv.symm (boundedOfRealSeries a ha) + +variable (ha : constantCoeff a ∈ Surreal.realIntegerSubring) + +/-- The signed Conway normal form of `ofRealSeries a ha` is `a` with surreal exponents. -/ +theorem toSignedFullHahnSeries_ofRealSeries : + (ofRealSeries.{u} a ha).1.toSignedFullHahnSeries = mapRealDomainToSurreal a := by + have h := signedSmallSupportIntegerPartRingEquiv.apply_symm_apply (boundedOfRealSeries a ha) + rw [signedSmallSupportIntegerPartRingEquiv_apply] at h + have hraw := congrArg (fun q : SignedSmallSupportIntegerPart.{u} ↦ + ((q : HahnSeries.CardSuppLTField (G := Surreal) (R := ℝ) + (κ := Surreal.smallSupportCardinal.{u})) : HahnSeries Surreal ℝ)) h + rw [coe_toSignedSmallSupportIntegerPart] at hraw + exact hraw + +/-- The signed nonpositive Hahn series of `ofRealSeries a ha` is `a` with surreal exponents. -/ +theorem toSignedNonpositiveHahn_ofRealSeries : + (ofRealSeries.{u} a ha).toSignedNonpositiveHahn = mapRealDomainToSurreal a := by + apply Subtype.ext + rw [coe_toSignedNonpositiveHahn, toSignedFullHahnSeries_ofRealSeries] + +/-- The Conway normal form of `ofRealSeries a ha` has the support order type of `a`, lifted to +the universe of the surreal model. -/ +theorem length_ofRealSeries : + (ofRealSeries.{u} a ha).1.length = Ordinal.lift.{u, 0} (a : ℝ⟦ℝ⟧).supportOrderType := by + apply Ordinal.lift_inj.{u + 1, u}.mp + rw [Ordinal.lift_lift] + exact Surreal.lift_length_of_toSignedFullHahnSeries_eq (toSignedFullHahnSeries_ofRealSeries a ha) + +/-- `ofRealSeries a ha` is irreducible when `a` is irreducible in the surreal truncation integer +part. -/ +theorem irreducible_ofRealSeries + (hirr : Irreducible (mapRealDomainToSurrealIntegerPart Surreal.realIntegerSubring a ha : + HahnSeries.truncationIntegerPart Surreal.{u} Surreal.realIntegerSubring)) : + Irreducible (ofRealSeries.{u} a ha) := by + have h : Irreducible (boundedOfRealSeries a ha) := by + apply + HahnSeries.CardSuppLTTruncationIntegerPart.irreducible_of_irreducible_toTruncationIntegerPart + Surreal.realIntegerSubring + rw [toTruncationIntegerPartRingHom_boundedOfRealSeries] + exact hirr + exact h.map signedSmallSupportIntegerPartRingEquiv.symm + +/-- `ofRealSeries a ha` is reduced when `a` is nonzero and nonconstant with constant coefficient +one. -/ +theorem isReduced_ofRealSeries + (haOrder : (mapRealDomainToSurreal a : ℝ⟦Surreal.{u}⟧).order ≠ 0) + (haConstant : constantCoeff a = 1) : + IsReduced (ofRealSeries.{u} a ha).toSignedNonpositiveHahn := by + rw [toSignedNonpositiveHahn_ofRealSeries] + exact isReduced_mapRealDomainToSurreal haOrder haConstant + +end Surreal.OmnificInteger diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/SignedFull.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/SignedFull.lean new file mode 100644 index 0000000000..b7bb2b1af9 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/SignedFull.lean @@ -0,0 +1,167 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainOrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Full + +/-! +# Conway normal forms with signed surreal exponents + +The order dual in `Surreal.toFullHahnSeries` records the reversal from Conway's `ω` to +LM24's `t = ω⁻¹`. Sending a dual exponent `i` to the ordinary surreal exponent `-i` makes +that reversal explicit and places the normal form in a Hahn field whose exponent group is +`Surreal` itself. This is the orientation in which the surreal Archimedean-stratum assumptions +apply directly. +-/ + +universe u + +public noncomputable section + +namespace Surreal + +/-- Negation identifies dual Conway exponents with signed ordinary surreal exponents. -/ +def dualExponentOrderAddMonoidIso : Surrealᵒᵈ ≃+o Surreal := + { toFun := fun x ↦ -x.ofDual + invFun := fun x ↦ OrderDual.toDual (-x) + left_inv := by intro x; simp + right_inv := by intro x; simp + map_add' := by intro x y; simp [add_comm] + map_le_map_iff' := by + intro x y + change -x.ofDual ≤ -y.ofDual ↔ y.ofDual ≤ x.ofDual + exact neg_le_neg_iff } + +/-- The signed-exponent map sends a dual exponent to the negative underlying surreal. -/ +@[simp] +theorem dualExponentOrderAddMonoidIso_apply (x : Surrealᵒᵈ) : + dualExponentOrderAddMonoidIso x = -x.ofDual := + (rfl) + +/-- The inverse signed-exponent map sends `x` to the dual of `-x`. -/ +@[simp] +theorem dualExponentOrderAddMonoidIso_symm_apply (x : Surreal.{u}) : + dualExponentOrderAddMonoidIso.symm x = OrderDual.toDual (-x) := + (rfl) + +/-- The full Conway normal form with the exponent of `t = ω⁻¹` written as an ordinary +surreal number. -/ +def toSignedFullHahnSeries (x : Surreal.{u}) : HahnSeries Surreal ℝ := + HahnSeries.embDomainRingEquiv dualExponentOrderAddMonoidIso x.toFullHahnSeries + +/-- The signed full series is exponent reindexing of the dual-exponent full series. -/ +theorem toSignedFullHahnSeries_eq (x : Surreal.{u}) : + toSignedFullHahnSeries x = + HahnSeries.embDomainRingEquiv dualExponentOrderAddMonoidIso x.toFullHahnSeries := + (rfl) + +/-- Evaluation of the signed Conway normal form at exponent `g`. -/ +@[simp] +theorem coeff_toSignedFullHahnSeries (x g : Surreal.{u}) : + x.toSignedFullHahnSeries.coeff g = x.coeff (-g) := by + rw [toSignedFullHahnSeries_eq, + ← dualExponentOrderAddMonoidIso.apply_symm_apply g, + HahnSeries.embDomainRingEquiv_coeff, + dualExponentOrderAddMonoidIso_symm_apply, + coeff_toFullHahnSeries] + simp + +/-- Signed exponent reindexing preserves the zero Conway normal form. -/ +@[simp] +theorem toSignedFullHahnSeries_zero : + toSignedFullHahnSeries (0 : Surreal.{u}) = 0 := by + rw [toSignedFullHahnSeries, toFullHahnSeries_zero, map_zero] + +/-- Signed exponent reindexing preserves addition of Conway normal forms. -/ +theorem toSignedFullHahnSeries_add (x y : Surreal.{u}) : + toSignedFullHahnSeries (x + y) = + toSignedFullHahnSeries x + toSignedFullHahnSeries y := by + rw [toSignedFullHahnSeries_eq, toSignedFullHahnSeries_eq, + toSignedFullHahnSeries_eq, toFullHahnSeries_add, map_add] + +/-- Signed exponent reindexing preserves negation of Conway normal forms. -/ +@[simp] +theorem toSignedFullHahnSeries_neg (x : Surreal.{u}) : + toSignedFullHahnSeries (-x) = -toSignedFullHahnSeries x := by + rw [toSignedFullHahnSeries_eq, toSignedFullHahnSeries_eq, + toFullHahnSeries_neg, map_neg] + +/-- Signed exponent reindexing preserves subtraction of Conway normal forms. -/ +@[simp] +theorem toSignedFullHahnSeries_sub (x y : Surreal.{u}) : + toSignedFullHahnSeries (x - y) = + toSignedFullHahnSeries x - toSignedFullHahnSeries y := by + rw [sub_eq_add_neg, toSignedFullHahnSeries_add, toSignedFullHahnSeries_neg] + rfl + +/-- The signed full Conway normal-form map is injective. -/ +theorem toSignedFullHahnSeries_injective : + Function.Injective (toSignedFullHahnSeries : + Surreal.{u} → HahnSeries Surreal ℝ) := + (HahnSeries.embDomainRingEquiv dualExponentOrderAddMonoidIso).injective.comp + toFullHahnSeries_injective + +/-- A signed Hahn exponent occurs exactly when its negation occurs in the unsigned Conway +support. -/ +theorem mem_support_toSignedFullHahnSeries {x g : Surreal.{u}} : + g ∈ x.toSignedFullHahnSeries.support ↔ -g ∈ x.support := by + rw [toSignedFullHahnSeries_eq, HahnSeries.support_embDomainRingEquiv] + constructor + · rintro ⟨i, hi, rfl⟩ + simpa using (mem_support_toFullHahnSeries.mp hi) + · intro hg + refine ⟨OrderDual.toDual (-g), mem_support_toFullHahnSeries.mpr ?_, ?_⟩ + · simpa using hg + · simp + +/-- Signed exponent reindexing preserves the LM24 degree of the Conway normal form. -/ +@[simp] +theorem degree_toSignedFullHahnSeries (x : Surreal.{u}) : + x.toSignedFullHahnSeries.degree = x.toFullHahnSeries.degree := by + rw [HahnSeries.degree_eq_cantorDegree, HahnSeries.degree_eq_cantorDegree, + toSignedFullHahnSeries_eq, HahnSeries.supportOrderType_embDomainRingEquiv] + +/-- The signed full Conway normal form of a real is concentrated at exponent zero. -/ +@[simp] +theorem toSignedFullHahnSeries_realCast (r : ℝ) : + toSignedFullHahnSeries (r : Surreal.{u}) = HahnSeries.single 0 r := by + rw [toSignedFullHahnSeries_eq, toFullHahnSeries_realCast] + ext g + rw [← dualExponentOrderAddMonoidIso.apply_symm_apply g, + HahnSeries.embDomainRingEquiv_coeff] + rw [dualExponentOrderAddMonoidIso_symm_apply] + simp [HahnSeries.coeff_single] + +/-- The signed full Conway normal form of `ω ^ x` is the monomial at exponent `-x`. -/ +@[simp] +theorem toSignedFullHahnSeries_wpow (x : Surreal.{u}) : + toSignedFullHahnSeries (ω^ x) = HahnSeries.single (-x) 1 := by + rw [toSignedFullHahnSeries_eq, toFullHahnSeries_wpow, + HahnSeries.embDomainRingEquiv_single] + rfl + +/-- The signed full Conway Hahn-series map preserves arbitrary surreal products. -/ +@[simp] +theorem toSignedFullHahnSeries_mul (x y : Surreal.{u}) : + toSignedFullHahnSeries (x * y) = + toSignedFullHahnSeries x * toSignedFullHahnSeries y := by + rw [toSignedFullHahnSeries_eq, toSignedFullHahnSeries_eq, + toSignedFullHahnSeries_eq, toFullHahnSeries_mul, map_mul] + +/-- Full Hahn multiplication compatibility is equivalent to its signed-exponent form. -/ +theorem toSignedFullHahnSeries_mul_iff (x y : Surreal.{u}) : + toSignedFullHahnSeries (x * y) = + toSignedFullHahnSeries x * toSignedFullHahnSeries y ↔ + toFullHahnSeries (x * y) = toFullHahnSeries x * toFullHahnSeries y := by + change HahnSeries.embDomainRingEquiv dualExponentOrderAddMonoidIso + (x * y).toFullHahnSeries = + HahnSeries.embDomainRingEquiv dualExponentOrderAddMonoidIso x.toFullHahnSeries * + HahnSeries.embDomainRingEquiv dualExponentOrderAddMonoidIso y.toFullHahnSeries ↔ _ + rw [← map_mul] + exact (HahnSeries.embDomainRingEquiv dualExponentOrderAddMonoidIso).injective.eq_iff + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests.lean new file mode 100644 index 0000000000..06bedd9efd --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests.lean @@ -0,0 +1,15 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.CardinalIntegerPart +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.DegreeTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.Full +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.Multiplication +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalFormAdd +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalFormMul + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/CardinalIntegerPart.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/CardinalIntegerPart.lean new file mode 100644 index 0000000000..a95908f4ca --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/CardinalIntegerPart.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.CardinalIntegerPart + +/-! +# Checks for the bounded omnific-integer correspondence + +This separately compiled client checks both directions of the public additive equivalence and +the conditional ring-equivalence constructor. The generic raw-series equality exercises the +normal-form content; the two-term example excludes the zero and single-monomial degeneracies. +-/ + +universe u + +public noncomputable section + +namespace Tests + +open Surreal + +/-- The monomial `ω` as an omnific integer. -/ +def omegaOmnific : Surreal.OmnificInteger.{u} := + ⟨ω^ (1 : Surreal.{u}), mem_omnificIntegers.mpr + (isOmnificInteger_iff_normalForm.mpr ⟨by + intro i hi + rw [support_wpow, Set.mem_singleton_iff] at hi + subst i + simp, by + rw [coeff_wpow] + refine ⟨0, ?_⟩ + simp⟩)⟩ + +/-- The omnific integer `ω + 3`, with two distinct Conway exponents. -/ +def omegaAddThree : Surreal.OmnificInteger.{u} := + omegaOmnific + 3 + +/-- The bounded image retains exactly the full Conway normal form. -/ +theorem smallSupportIntegerPart_rawSeries + (x : Surreal.OmnificInteger.{u}) : + ((x.toSmallSupportIntegerPart : + HahnSeries.CardSuppLTField (G := Surrealᵒᵈ) (R := ℝ) + (κ := Surreal.smallSupportCardinal.{u})) : HahnSeries Surrealᵒᵈ ℝ) = + x.1.toFullHahnSeries := + Surreal.OmnificInteger.coe_toSmallSupportIntegerPart x + +/-- The nondegenerate two-term example survives the public round trip. -/ +theorem omegaAddThree_smallSupport_roundTrip : + Surreal.OmnificInteger.ofSmallSupportIntegerPart + omegaAddThree.toSmallSupportIntegerPart = omegaAddThree := + Surreal.OmnificInteger.ofSmallSupportIntegerPart_toSmallSupportIntegerPart _ + +/-- The bounded Conway/Hahn correspondence preserves multiplication without an extra premise. -/ +theorem smallSupportIntegerPart_map_mul + (x y : Surreal.OmnificInteger.{u}) : + Surreal.OmnificInteger.smallSupportIntegerPartRingEquiv (x * y) = + Surreal.OmnificInteger.smallSupportIntegerPartRingEquiv x * + Surreal.OmnificInteger.smallSupportIntegerPartRingEquiv y := + map_mul _ x y + +/-- Signed exponent reindexing retains exactly the signed Conway normal form. -/ +theorem signedSmallSupportIntegerPart_rawSeries + (x : Surreal.OmnificInteger.{u}) : + ((x.toSignedSmallSupportIntegerPart : + HahnSeries.CardSuppLTField (G := Surreal) (R := ℝ) + (κ := Surreal.smallSupportCardinal.{u})) : HahnSeries Surreal ℝ) = + x.1.toSignedFullHahnSeries := + Surreal.OmnificInteger.coe_toSignedSmallSupportIntegerPart x + +/-- The signed Conway/Hahn correspondence preserves multiplication without an extra premise. -/ +theorem signedSmallSupportIntegerPart_map_mul + (x y : Surreal.OmnificInteger.{u}) : + Surreal.OmnificInteger.signedSmallSupportIntegerPartRingEquiv (x * y) = + Surreal.OmnificInteger.signedSmallSupportIntegerPartRingEquiv x * + Surreal.OmnificInteger.signedSmallSupportIntegerPartRingEquiv y := + map_mul _ x y + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/DegreeTransfer.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/DegreeTransfer.lean new file mode 100644 index 0000000000..0a6c5dbb8b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/DegreeTransfer.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.DegreeTransfer + +/-! +# Checks for Conway-to-Hahn degree transfer + +The two-term example `ω + 1` has distinct nonzero exponents, so it excludes the zero and +single-monomial degeneracies. Its finite support gives degree zero on both sides of the full Hahn +embedding, while the generic equality gives degree preservation for every surreal number. +-/ + +universe u + +public noncomputable section + +namespace Tests + +open Surreal + +/-- The nondegenerate two-term surreal used by the degree-transfer check. -/ +def twoTermDegreeSurreal : Surreal.{u} := + ω^ (1 : Surreal.{u}) + ((1 : ℝ) : Surreal.{u}) + +private theorem twoTermDegreeSurreal_support_finite : + ((twoTermDegreeSurreal : Surreal.{u}).support).Finite := by + rw [twoTermDegreeSurreal] + have hwpow : (support (ω^ (1 : Surreal.{u}))).Finite := by + rw [support_wpow] + exact Set.finite_singleton _ + exact (hwpow.union (support_realCast_finite (1 : ℝ))).subset support_add_subset + +private theorem twoTermDegreeSurreal_ne_zero : + (twoTermDegreeSurreal : Surreal.{u}) ≠ 0 := by + rw [twoTermDegreeSurreal] + exact (add_pos (Surreal.wpow_pos _) (by norm_num)).ne' + +/-- The public full Hahn embedding preserves degree for an arbitrary surreal. -/ +theorem surrealFullHahn_supportDegree (x : Surreal.{u}) : + x.toFullHahnSeries.degree = x.supportDegree := + supportDegree_toFullHahnSeries x + +/-- The nondegenerate two-term Conway normal form has degree zero. -/ +theorem twoTermDegreeSurreal_supportDegree : + (twoTermDegreeSurreal : Surreal.{u}).supportDegree = 0 := by + rw [← supportDegree_toFullHahnSeries, HahnSeries.degree_eq_zero] + constructor + · intro hzero + apply twoTermDegreeSurreal_ne_zero + apply toFullHahnSeries_injective + rw [hzero, toFullHahnSeries_zero] + · have himage : + (twoTermDegreeSurreal : Surreal.{u}).toFullHahnSeries.support ⊆ + OrderDual.toDual '' (twoTermDegreeSurreal : Surreal.{u}).support := by + intro i hi + exact ⟨i.ofDual, mem_support_toFullHahnSeries.mp hi, by simp⟩ + exact (twoTermDegreeSurreal_support_finite.image OrderDual.toDual).subset himage + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/Full.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/Full.lean new file mode 100644 index 0000000000..29a2f98da3 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/Full.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Full + +/-! +# Checks for full Conway Hahn series + +The square of `ω + 1` exercises two distinct nonzero exponents and the mixed convolution term. +Its coefficient at exponent one is two, separating genuine multiplication from a plausible wrong +operation that keeps only products of matching or leading exponents. +-/ + +universe u + +public noncomputable section + +namespace Tests + +open Surreal + +/-- The nondegenerate two-term surreal `ω + 1`. -/ +def twoTermSurreal : Surreal.{u} := + ω^ (1 : Surreal.{u}) + ((1 : ℝ) : Surreal.{u}) + + +/-- The full Hahn embedding preserves arbitrary surreal products. -/ +example (x y : Surreal.{u}) : + toFullHahnSeries (x * y) = toFullHahnSeries x * toFullHahnSeries y := + toFullHahnSeries_mul x y + +/-- The full Conway map preserves the square of the nondegenerate two-term example. -/ +theorem toFullHahnSeries_twoTerm_square : + toFullHahnSeries + ((twoTermSurreal : Surreal.{u}) * twoTermSurreal) = + toFullHahnSeries (twoTermSurreal : Surreal.{u}) * + toFullHahnSeries twoTermSurreal := + toFullHahnSeries_mul _ _ + +/-- The mixed coefficient in the nondegenerate square is two. -/ +theorem toFullHahnSeries_twoTerm_square_coeff_one : + (toFullHahnSeries + ((twoTermSurreal : Surreal.{u}) * twoTermSurreal)).coeff + (OrderDual.toDual (1 : Surreal.{u})) = 2 := by + rw [toFullHahnSeries_twoTerm_square] + simp only [twoTermSurreal, toFullHahnSeries_add, + toFullHahnSeries_wpow, toFullHahnSeries_realCast] + rw [add_mul, mul_add, mul_add] + simp only [HahnSeries.single_mul_single] + rw [HahnSeries.coeff_add, HahnSeries.coeff_add, HahnSeries.coeff_add] + simp only [HahnSeries.coeff_single] + simp + norm_num + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/Multiplication.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/Multiplication.lean new file mode 100644 index 0000000000..5787890f8e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/Multiplication.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Multiplication + +/-! +# Checks for omnific-integer normal-form multiplication + +These checks exercise closure and the public characteristic theorem for the transported +normal-form product without unfolding its definition. +-/ + +public noncomputable section + +namespace Tests + +open Surreal + +/-- Formal Hahn multiplication of omnific-integer normal forms again represents an omnific +integer. -/ +example {x y : Surreal} (hx : x.IsOmnificInteger) (hy : y.IsOmnificInteger) : + ((x.toHahnSeries * y.toHahnSeries).toSurreal).IsOmnificInteger := + hx.toHahnSeries_mul_toSurreal hy + +/-- Compatibility on positive truncations is sufficient for arbitrary omnific integers. -/ +example {x y : Surreal} (hx : x.IsOmnificInteger) (hy : y.IsOmnificInteger) + (hpositive : (x.trunc 0 * y.trunc 0).toHahnSeries = + x.toHahnSeries.trunc 0 * y.toHahnSeries.trunc 0) : + (x * y).toHahnSeries = x.toHahnSeries * y.toHahnSeries := + hx.toHahnSeries_mul_of_trunc_zero hy hpositive + +/-- The public normal form of the transported product computes to the Hahn product. -/ +example (x y : Surreal.OmnificInteger) : + (x.normalFormProduct y : Surreal).toHahnSeries = + x.1.toHahnSeries * y.1.toHahnSeries := + Surreal.OmnificInteger.toHahnSeries_normalFormProduct x y + +/-- Transported normal-form multiplication is the ordinary omnific-integer multiplication. -/ +example (x y : Surreal.OmnificInteger) : + x.normalFormProduct y = x * y := + Surreal.OmnificInteger.normalFormProduct_eq_mul x y + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/NormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/NormalForm.lean new file mode 100644 index 0000000000..54824122cf --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/NormalForm.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalForm + +/-! +# API checks for the Conway normal form of surreal numbers + +The two-term example has distinct exponents and nonzero coefficients, so it separates the Conway +normal form from the false conversion that retains only the leading term. Both directions of the +normal-form equivalence are evaluated on this example. +-/ + +public noncomputable section + +namespace Tests + +open Set SurrealHahnSeries + +theorem surrealNormalForm_zero : + SurrealHahnSeries.toSurreal (Surreal.toHahnSeries 0) = 0 := by + simp + +theorem surrealNormalForm_single_real (r : ℝ) : + SurrealHahnSeries.toSurreal (.single 0 r) = r := by + simp + +private theorem zero_lt_support_single_one {j : Surreal} + (hj : j ∈ (SurrealHahnSeries.single 1 1).support) : 0 < j := by + have : j = 1 := mem_singleton_iff.mp (support_single_subset hj) + simp [this] + +theorem surrealNormalForm_twoTerm : + SurrealHahnSeries.toSurreal + (SurrealHahnSeries.single 1 1 + SurrealHahnSeries.single 0 1) = + ω^ (1 : Surreal) + 1 := by + rw [SurrealHahnSeries.toSurreal_succ] + · simp + · exact fun j hj ↦ zero_lt_support_single_one hj + +theorem surrealNormalForm_twoTerm_roundTrip : + Surreal.toHahnSeries + (SurrealHahnSeries.toSurreal + (SurrealHahnSeries.single 1 1 + SurrealHahnSeries.single 0 1)) = + SurrealHahnSeries.single 1 1 + SurrealHahnSeries.single 0 1 := by + simp + +theorem surrealNormalForm_twoTerm_ne_leadingTerm : + SurrealHahnSeries.toSurreal + (SurrealHahnSeries.single 1 1 + SurrealHahnSeries.single 0 1) ≠ + SurrealHahnSeries.toSurreal (SurrealHahnSeries.single 1 1) := by + rw [surrealNormalForm_twoTerm] + simp + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/NormalFormAdd.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/NormalFormAdd.lean new file mode 100644 index 0000000000..6d0a41777d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/NormalFormAdd.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Dan Abramov, Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov, Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormAdd + +/-! +# API checks for additive Conway normal forms + +These checks exercise additive compatibility through the public module boundary. The two-term +example is nondegenerate: its exponents are distinct and both coefficients are nonzero. Its +coefficient at exponent zero separates the result from the plausible but incorrect operation that +retains only the leading term. +-/ + +public noncomputable section + +namespace Tests + +open SurrealHahnSeries + +theorem surrealNormalForm_add (x y : Surreal) : + Surreal.toHahnSeries (x + y) = x.toHahnSeries + y.toHahnSeries := + Surreal.toHahnSeries_add x y + +theorem surrealValue_add (x y : SurrealHahnSeries) : + (x + y).toSurreal = x.toSurreal + y.toSurreal := + SurrealHahnSeries.toSurreal_add x y + +theorem surrealNormalForm_neg (x : Surreal) : + Surreal.toHahnSeries (-x) = -x.toHahnSeries := + Surreal.toHahnSeries_neg x + +theorem surrealNormalForm_twoTerm_add : + Surreal.toHahnSeries (ω^ (1 : Surreal) + 1) = + single 1 1 + single 0 1 := by + simp + +theorem surrealNormalForm_twoTerm_add_constantCoeff : + (Surreal.toHahnSeries (ω^ (1 : Surreal) + 1)).coeff 0 = 1 := by + simp only [Surreal.toHahnSeries_add, Surreal.toHahnSeries_wpow, + Surreal.toHahnSeries_one, coeff_add, Pi.add_apply, coeff_single_self, add_eq_right] + exact coeff_single_of_ne one_ne_zero 1 + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/NormalFormMul.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/NormalFormMul.lean new file mode 100644 index 0000000000..e02242d56e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests/NormalFormMul.lean @@ -0,0 +1,137 @@ +/- +Copyright (c) 2026 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormMul + +/-! +# Checks for Conway normal-form multiplication options + +These checks exercise the public multiplication-option and truncation-cofinality interface without +unfolding the Conway normal-form or surreal Hahn-series definitions. +-/ + +open Order Set + +public noncomputable section + +namespace Tests + +open SurrealHahnSeries + +/-- Integer casts use the public constant-singleton representation. -/ +example (n : ℤ) : + (n : SurrealHahnSeries) = single 0 (n : ℝ) := + intCast_eq_single_zero n + +/-- Arbitrary Conway normal forms preserve multiplication by integer constants. -/ +example (n : ℤ) (x : Surreal) : + ((n : Surreal) * x).toHahnSeries = + single 0 (n : ℝ) * x.toHahnSeries := + Surreal.toHahnSeries_intCast_mul n x + +/-- Arbitrary normal forms preserve multiplication by rational constants. -/ +example (q : ℚ) (x : SurrealHahnSeries) : + (single 0 (q : ℝ) * x).toSurreal = (q : Surreal) * x.toSurreal := + toSurreal_single_zero_ratCast_mul q x + +/-- Arbitrary normal forms preserve multiplication by every real constant. -/ +example (r : ℝ) (x : SurrealHahnSeries) : + (single 0 r * x).toSurreal = (r : Surreal) * x.toSurreal := + toSurreal_single_zero_mul r x + +/-- Arbitrary normal forms preserve multiplication by every singleton normal form. -/ +example (p : Surreal) (r : ℝ) (x : SurrealHahnSeries) : + (single p r * x).toSurreal = (single p r).toSurreal * x.toSurreal := + toSurreal_single_mul p r x + +/-- Singleton multiplication is available without exposing the underlying Hahn-series subtype. -/ +example (p q : Surreal) (r s : ℝ) : + single p r * single q s = single (p + q) (r * s) := + single_mul_single p q r s + +/-- Singleton multiplication translates arbitrary coefficients and truncation cutoffs. -/ +example (p q k : Surreal) (r : ℝ) (y : SurrealHahnSeries) : + (single p r * y).coeff k = r * y.coeff (k - p) ∧ + (single p r * y).trunc (p + q) = single p r * y.trunc q := + ⟨coeff_single_mul p r y k, trunc_single_mul p q r y⟩ + +/-- Product truncations expose exact source truncation options with the expected sign reversal. -/ +example {p : Surreal} {r : ℝ} {y t : SurrealHahnSeries} : + (t ∈ truncLT (single p r * y) → + (0 < r ∧ ∃ b ∈ truncLT y, single p r * b = t) ∨ + (r < 0 ∧ ∃ b ∈ truncGT y, single p r * b = t)) ∧ + (t ∈ truncGT (single p r * y) → + (0 < r ∧ ∃ b ∈ truncGT y, single p r * b = t) ∨ + (r < 0 ∧ ∃ b ∈ truncLT y, single p r * b = t)) := + ⟨exists_eq_single_mul_of_mem_truncLT, exists_eq_single_mul_of_mem_truncGT⟩ + +/-- The public option value evaluates to its defining ring expression without unfolding. -/ +example (x y a b : SurrealHahnSeries) : + mulOptionValue x y a b = a * y + x * b - a * b := + mulOptionValue_eq x y a b + +/-- Formal and Conway multiplication agree on the leading normal-form term. -/ +example (x y : SurrealHahnSeries) : + (x * y).toSurreal.leadingTerm = (x.toSurreal * y.toSurreal).leadingTerm := + leadingTerm_toSurreal_mul x y + +/-- A nonzero product coefficient publicly yields a contributing pair of source exponents. -/ +example {x y : SurrealHahnSeries} {k : Surreal} (hk : k ∈ (x * y).support) : + ∃ p ∈ x.support, ∃ q ∈ y.support, p + q = k := + exists_add_eq_of_mem_support_mul hk + +/-- Nonnegative support and integer-part constant coefficients are stable under multiplication. -/ +example {x y : SurrealHahnSeries} + (hx : x.support ⊆ Set.Ici 0) (hy : y.support ⊆ Set.Ici 0) : + (x * y).support ⊆ Set.Ici 0 ∧ + (x * y).coeff 0 = x.coeff 0 * y.coeff 0 := + ⟨support_mul_subset_Ici hx hy, coeff_zero_mul_of_support_subset_Ici hx hy⟩ + +/-- Every left truncation of a product is dominated by a genuine left product option. -/ +example {x y t : SurrealHahnSeries} (ht : t ∈ truncLT (x * y)) : + ∃ a ∈ truncLT x, ∃ b ∈ truncLT y, + t < mulOptionValue x y a b ∧ mulOptionValue x y a b < x * y := + exists_mulOptionValue_between_of_mem_truncLT ht + +/-- Every right truncation of a product dominates a genuine right product option. -/ +example {x y t : SurrealHahnSeries} (ht : t ∈ truncGT (x * y)) : + ∃ a ∈ truncLT x, ∃ b ∈ truncGT y, + x * y < mulOptionValue x y a b ∧ mulOptionValue x y a b < t := + exists_mulOptionValue_between_of_mem_truncGT ht + +/-- The limit-by-limit step consumes multiplication only for strictly shorter recursive inputs. -/ +example {x y : SurrealHahnSeries} + (hx : IsSuccPrelimit x.length) (hy : IsSuccPrelimit y.length) + (hmul : ∀ a b : SurrealHahnSeries, + a.length ≤ x.length → b.length ≤ y.length → + (a.length < x.length ∨ b.length < y.length) → + (a * b).toSurreal = a.toSurreal * b.toSurreal) : + (x * y).toSurreal = x.toSurreal * y.toSurreal := + toSurreal_mul_of_isSuccPrelimit hx hy hmul + +/-- The exact recursive limit step accepts the left and right length axes independently. -/ +example {x y : SurrealHahnSeries} + (hx : IsSuccPrelimit x.length) (hy : IsSuccPrelimit y.length) + (hmulLeft : ∀ a b : SurrealHahnSeries, + a.length < x.length → b.length ≤ y.length → + (a * b).toSurreal = a.toSurreal * b.toSurreal) + (hmulRight : ∀ b : SurrealHahnSeries, b.length < y.length → + (x * b).toSurreal = x.toSurreal * b.toSurreal) : + (x * y).toSurreal = x.toSurreal * y.toSurreal := + toSurreal_mul_of_isSuccPrelimit_of_axes hx hy hmulLeft hmulRight + +/-- The Conway normal-form map preserves arbitrary Hahn-series products. -/ +example (x y : SurrealHahnSeries) : + (x * y).toSurreal = x.toSurreal * y.toSurreal := + toSurreal_mul x y + +/-- The inverse Conway normal-form map preserves arbitrary surreal products. -/ +example (x y : Surreal) : + (x * y).toHahnSeries = x.toHahnSeries * y.toHahnSeries := + Surreal.toHahnSeries_mul x y + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Transfer.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Transfer.lean new file mode 100644 index 0000000000..5ead9db581 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Transfer.lean @@ -0,0 +1,217 @@ +/- +Copyright (c) 2026 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalForm + +/-! +# Transfer surreal Hahn-series definitions to surreal numbers + +This module transfers coefficients, support, length, and truncation along the Conway normal-form +order equivalence. It follows CombinatorialGames PR #263, adapted to the pinned module-safe API. +Arithmetic compatibility is proved in later modules. +-/ + +universe u + +public noncomputable section + +namespace Surreal + +open Set + +/-! ### Coefficients -/ + +/-- The coefficient of `ω ^ i` in the Conway normal form of a surreal number. -/ +def coeff (x : Surreal) : Surreal → ℝ := + x.toHahnSeries.coeff + +@[simp] +theorem coeff_zero : coeff 0 = 0 := by + simp [coeff] + +@[simp] +theorem coeff_wpow (x : Surreal) : coeff (ω^ x) = Pi.single x 1 := by + rw [coeff, toHahnSeries_wpow, SurrealHahnSeries.coeff_single] + +/-- A real surreal has only its constant Conway coefficient. -/ +@[simp] +theorem coeff_realCast (r : ℝ) : + coeff (r : Surreal.{u}) = Pi.single 0 r := by + rw [coeff, toHahnSeries_realCast, SurrealHahnSeries.coeff_single] + +@[simp] +theorem coeff_toHahnSeries (x : Surreal) : x.toHahnSeries.coeff = x.coeff := + (rfl) + +@[simp] +theorem _root_.SurrealHahnSeries.coeff_toSurreal (x : SurrealHahnSeries) : + x.toSurreal.coeff = x.coeff := by + simp [coeff] + +/-! ### Support -/ + +/-- The support of the Conway normal form of a surreal number. -/ +def support (x : Surreal) : Set Surreal := + x.toHahnSeries.support + +@[simp] +theorem support_coeff (x : Surreal) : x.coeff.support = x.support := + (rfl) + +@[simp] +theorem support_zero : support 0 = ∅ := by + simp [support] + +@[simp] +theorem support_wpow (x : Surreal) : support (ω^ x) = {x} := by + aesop (add simp [support]) + +/-- The Conway support of a real surreal is finite. -/ +theorem support_realCast_finite (r : ℝ) : + (support (r : Surreal.{u})).Finite := by + rw [← support_coeff, coeff_realCast] + exact Set.Finite.subset (Set.finite_singleton 0) Pi.support_single_subset + +@[simp] +theorem support_eq_empty {x : Surreal} : x.support = ∅ ↔ x = 0 := by + simp [support] + +@[simp] +theorem support_toHahnSeries (x : Surreal) : x.toHahnSeries.support = x.support := + (rfl) + +@[simp] +theorem _root_.SurrealHahnSeries.support_toSurreal (x : SurrealHahnSeries) : + x.toSurreal.support = x.support := by + simp [support] + +theorem wellFoundedOn_support (x : Surreal) : x.support.WellFoundedOn (fun a b ↦ a > b) := + x.toHahnSeries.wellFoundedOn_support + +instance (x : Surreal.{u}) : Small.{u} x.support := + inferInstanceAs (Small (SurrealHahnSeries.support _)) + +instance (x : Surreal) : WellFoundedGT x.support := + inferInstanceAs (WellFoundedGT (SurrealHahnSeries.support _)) + +/-! ### Length -/ + +/-- The ordinal length of the Conway normal form of a surreal number. -/ +def length (x : Surreal) : Ordinal := + x.toHahnSeries.length + +@[simp] +theorem length_zero : length 0 = 0 := by + simp [length] + +@[simp] +theorem length_wpow (x : Surreal) : length (ω^ x) = 1 := by + simp [length] + +@[simp, grind =] +theorem mem_support_iff {x i : Surreal} : i ∈ x.support ↔ x.coeff i ≠ 0 := + (Iff.rfl) + +theorem notMem_support_iff {x i : Surreal} : i ∉ x.support ↔ x.coeff i = 0 := + mem_support_iff.not_left + +@[simp] +theorem length_toHahnSeries (x : Surreal) : x.toHahnSeries.length = x.length := + (rfl) + +theorem PartialSum.length_top (x : Surreal) : (⊤ : PartialSum x).length = x.length := by + rw [PartialSum.length_eq_carrier_length, PartialSum.carrier_top, length_toHahnSeries] + +@[simp] +theorem type_support (x : Surreal.{u}) : + @Ordinal.type x.support (fun a b ↦ a > b) _ = Ordinal.lift.{u + 1} x.length := + SurrealHahnSeries.type_support _ + +@[simp] +theorem _root_.SurrealHahnSeries.length_toSurreal (x : SurrealHahnSeries) : + x.toSurreal.length = x.length := by + simp [length] + +/-! ### Truncation -/ + +/-- Remove the terms of the Conway normal form whose exponents are at most `i`. -/ +def trunc (x i : Surreal) : Surreal := + x.toHahnSeries.trunc i + +@[simp] +theorem trunc_zero (i : Surreal) : trunc 0 i = 0 := by + rw [trunc] + have h : (0 : SurrealHahnSeries).trunc i = 0 := + SurrealHahnSeries.trunc_eq_self fun j hj ↦ by simp at hj + rw [toHahnSeries_zero, h, SurrealHahnSeries.toSurreal_zero] + +@[simp] +theorem toHahnSeries_trunc (x i : Surreal) : + (x.trunc i).toHahnSeries = x.toHahnSeries.trunc i := by + simp [trunc] + +@[simp] +theorem _root_.SurrealHahnSeries.toSurreal_trunc (x : SurrealHahnSeries) (i : Surreal) : + x.trunc i = x.toSurreal.trunc i := by + simp [trunc] + +@[aesop simp] +theorem coeff_trunc (x i : Surreal) : + (x.trunc i).coeff = fun j ↦ if i < j then x.coeff j else 0 := by + unfold coeff + aesop + +@[simp] +theorem coeff_trunc_of_lt {x i j : Surreal} (h : i < j) : + (x.trunc i).coeff j = x.coeff j := by + rw [coeff_trunc] + exact if_pos h + +@[simp] +theorem coeff_trunc_of_le {x i j : Surreal} (h : j ≤ i) : + (x.trunc i).coeff j = 0 := by + rw [coeff_trunc] + exact if_neg h.not_gt + +@[simp, grind =] +theorem support_trunc (x i : Surreal) : (x.trunc i).support = x.support ∩ Ioi i := by + aesop + +theorem support_trunc_subset (x i : Surreal) : (x.trunc i).support ⊆ x.support := by + simp + +theorem support_trunc_anti {x : Surreal} : Antitone fun i ↦ (trunc x i).support := + fun _ _ _ _ ↦ by aesop (add safe tactic (by order)) + +theorem coeff_trunc_eq_zero {x i j : Surreal} (h : x.coeff i = 0) : + (x.trunc j).coeff i = 0 := by + aesop + +theorem coeff_trunc_of_mem {x i j : Surreal} (h : j ∈ (x.trunc i).support) : + (x.trunc i).coeff j = x.coeff j := by + aesop + +theorem trunc_eq_self_iff {x i : Surreal} : x.trunc i = x ↔ ∀ j ∈ x.support, i < j := by + nth_rw 2 [← toSurreal_toHahnSeries x] + rw [trunc, SurrealHahnSeries.toSurreal_inj] + exact SurrealHahnSeries.trunc_eq_self_iff + +alias ⟨_, trunc_eq_self⟩ := trunc_eq_self_iff + +theorem trunc_eq_trunc {x i j : Surreal} (h : i ≤ j) + (H : ∀ k, i < k → k ≤ j → x.coeff k = 0) : x.trunc i = x.trunc j := by + simpa [← toHahnSeries_trunc] using x.toHahnSeries.trunc_eq_trunc h H + +open SurrealHahnSeries in +theorem PartialSum.mem_range_trunc {x : Surreal} (y : PartialSum x) : + y.carrier.toSurreal ∈ range x.trunc := by + rw [← truncIdx_length_of_le (y := y) le_top, carrier_truncIdx, carrier_top] + obtain ⟨z, hz⟩ := truncIdx_mem_range_trunc x.toHahnSeries y.length + rw [← hz] + simp + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger.lean new file mode 100644 index 0000000000..e7f9766aa9 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger.lean @@ -0,0 +1,15 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Basic +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Ordinal +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Refinement +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.RefinementConjecture +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Basic.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Basic.lean new file mode 100644 index 0000000000..6c24723bed --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Basic.lean @@ -0,0 +1,325 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Division +public import Mathlib.Algebra.Ring.Subring.Defs +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Round + +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.GameCmp +import Mathlib.Tactic.Abel +import Mathlib.Tactic.Ring + +/-! +# Omnific integers + +Conway defines a surreal number `x` to be an omnific integer when +`x = {x - 1 | x + 1}`. This file uses that fixed-point equation as the direct definition and +proves Conway's closure statements, so the resulting carrier is a subring of the surreal numbers. +The proofs use the exact option formulae for addition and multiplication of numeric pregames. + +Conway's normal-form criterion, and the equivalent criterion recalled in LM24, Section 1.1, is a +theorem about this carrier rather than its definition. The pinned CombinatorialGames revision does +not yet construct the full surreal-to-Hahn normal-form map, so this file does not assume such a map +or use an unrelated Hahn-series presentation as the definition. + +The source is *On Numbers and Games*, pages 45--46: the definition preceding Theorem 30, Theorem 30 +for ring closure, and Theorem 31 for the later normal-form characterization. +-/ + +universe u + +public noncomputable section + +namespace Surreal + +namespace OmnificInteger + +private def cutGame (x : IGame.{u}) : IGame.{u} := + !{{x - 1} | {x + 1}} + +private instance cutGameNumeric (x : IGame.{u}) [IGame.Numeric x] : + IGame.Numeric (cutGame x) := by + rw [IGame.numeric_def] + constructor + · simp only [cutGame, IGame.leftMoves_ofSets, IGame.rightMoves_ofSets, + Set.mem_singleton_iff, forall_eq] + rw [← Surreal.mk_lt_mk] + simp only [Surreal.mk_sub, Surreal.mk_add, Surreal.mk_one] + simp [sub_eq_add_neg, add_comm] + · intro p y hy + cases p with + | left => + simp only [cutGame, IGame.leftMoves_ofSets, Set.mem_singleton_iff] at hy + subst y + infer_instance + | right => + simp only [cutGame, IGame.rightMoves_ofSets, Set.mem_singleton_iff] at hy + subst y + infer_instance + +private def IsOmnificGame (x : IGame.{u}) : Prop := + x ≈ cutGame x + +private theorem isOmnificGame_zero : IsOmnificGame (0 : IGame.{u}) := by + apply AntisymmRel.symm + rw [← IGame.fits_zero_iff_equiv] + simp [IGame.Fits, cutGame] + +private theorem isOmnificGame_one : IsOmnificGame (1 : IGame.{u}) := by + apply AntisymmRel.symm + apply IGame.equiv_one_of_fits + · rw [IGame.Fits] + constructor + · intro z hz + simp only [cutGame, IGame.leftMoves_ofSets, Set.mem_singleton_iff] at hz + subst z + game_cmp + · intro z hz + simp only [cutGame, IGame.rightMoves_ofSets, Set.mem_singleton_iff] at hz + subst z + game_cmp + · intro h + have hz : ((1 : IGame.{u}) - 1) ⧏ cutGame 1 := + IGame.left_lf (by simp [cutGame]) + exact hz (h.1.trans (IGame.sub_self_equiv 1).2) + +private theorem neg_cutGame (x : IGame.{u}) : -cutGame x = cutGame (-x) := by + simp only [cutGame, IGame.neg_ofSets] + congr! 2 + · simp [sub_eq_add_neg, add_comm] + · simp [sub_eq_add_neg, add_comm] + +private theorem IsOmnificGame.neg {x : IGame.{u}} (hx : IsOmnificGame x) : + IsOmnificGame (-x) := by + rw [IsOmnificGame, ← neg_cutGame] + exact IGame.neg_congr hx + +private theorem cutGame_add_cutGame_equiv {x y : IGame.{u}} + [IGame.Numeric x] [IGame.Numeric y] + (hx : IsOmnificGame x) (hy : IsOmnificGame y) : + cutGame x + cutGame y ≈ cutGame (x + y) := by + have hx' : Game.mk !{{x - 1} | {x + 1}} = Game.mk x := (Game.mk_eq hx).symm + have hy' : Game.mk !{{y - 1} | {y + 1}} = Game.mk y := (Game.mk_eq hy).symm + apply Game.mk_eq_mk.mp + simp only [cutGame, IGame.ofSets_add_ofSets, Game.mk_ofSets, Set.image_union, + Set.image_singleton] + simp only [Game.mk_add, Game.mk_sub, Game.mk_one, hx', hy'] + abel_nf + congr <;> simp + +private theorem IsOmnificGame.add {x y : IGame.{u}} [IGame.Numeric x] [IGame.Numeric y] + (hx : IsOmnificGame x) (hy : IsOmnificGame y) : IsOmnificGame (x + y) := by + exact (IGame.add_congr hx hy).trans (cutGame_add_cutGame_equiv hx hy) + +private theorem mulOption_cutGame_equiv {x y s t : IGame.{u}} + [IGame.Numeric x] [IGame.Numeric y] [IGame.Numeric s] [IGame.Numeric t] + (hx : IsOmnificGame x) (hy : IsOmnificGame y) : + IGame.mulOption !{{x - 1} | {x + 1}} !{{y - 1} | {y + 1}} + (x + s) (y + t) ≈ x * y - s * t := by + letI : IGame.Numeric !{{x - 1} | {x + 1}} := cutGameNumeric x + letI : IGame.Numeric !{{y - 1} | {y + 1}} := cutGameNumeric y + have hx' : Surreal.mk !{{x - 1} | {x + 1}} = Surreal.mk x := (Surreal.mk_eq hx).symm + have hy' : Surreal.mk !{{y - 1} | {y + 1}} = Surreal.mk y := (Surreal.mk_eq hy).symm + apply Surreal.mk_eq_mk.mp + simp only [IGame.mulOption, Surreal.mk_sub, Surreal.mk_add, Surreal.mk_mul] + rw [hx', hy'] + ring + +private theorem cutGame_mul_cutGame_equiv {x y : IGame.{u}} + [IGame.Numeric x] [IGame.Numeric y] + (hx : IsOmnificGame x) (hy : IsOmnificGame y) : + cutGame x * cutGame y ≈ cutGame (x * y) := by + rw [cutGame, cutGame, IGame.ofSets_mul_ofSets] + apply IGame.equiv_of_exists + · intro a ha + simp only [IGame.leftMoves_ofSets, Set.mem_image, Set.mem_union, Set.mem_prod, + Set.mem_singleton_iff, Prod.exists] at ha + obtain ⟨a₁, b₁, (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩), rfl⟩ := ha + · refine ⟨x * y - 1, by simp [cutGame], ?_⟩ + simpa [sub_eq_add_neg] using + mulOption_cutGame_equiv (x := x) (y := y) (s := (-1)) (t := (-1)) hx hy + · refine ⟨x * y - 1, by simp [cutGame], ?_⟩ + simpa using mulOption_cutGame_equiv (x := x) (y := y) (s := 1) (t := 1) hx hy + · intro a ha + simp only [IGame.rightMoves_ofSets, Set.mem_image, Set.mem_union, Set.mem_prod, + Set.mem_singleton_iff, Prod.exists] at ha + obtain ⟨a₁, b₁, (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩), rfl⟩ := ha + · refine ⟨x * y + 1, by simp [cutGame], ?_⟩ + simpa [sub_eq_add_neg] using + mulOption_cutGame_equiv (x := x) (y := y) (s := (-1)) (t := 1) hx hy + · refine ⟨x * y + 1, by simp [cutGame], ?_⟩ + simpa [sub_eq_add_neg] using + mulOption_cutGame_equiv (x := x) (y := y) (s := 1) (t := (-1)) hx hy + · intro b hb + simp only [cutGame, IGame.leftMoves_ofSets, Set.mem_singleton_iff] at hb + subst b + refine ⟨IGame.mulOption !{{x - 1} | {x + 1}} !{{y - 1} | {y + 1}} + (x - 1) (y - 1), ?_, ?_⟩ + · simp + · simpa [cutGame, sub_eq_add_neg] using + mulOption_cutGame_equiv (x := x) (y := y) (s := (-1)) (t := (-1)) hx hy + · intro b hb + simp only [cutGame, IGame.rightMoves_ofSets, Set.mem_singleton_iff] at hb + subst b + refine ⟨IGame.mulOption !{{x - 1} | {x + 1}} !{{y - 1} | {y + 1}} + (x - 1) (y + 1), ?_, ?_⟩ + · simp + · simpa [cutGame, sub_eq_add_neg] using + mulOption_cutGame_equiv (x := x) (y := y) (s := (-1)) (t := 1) hx hy + +private theorem IsOmnificGame.mul {x y : IGame.{u}} [IGame.Numeric x] [IGame.Numeric y] + (hx : IsOmnificGame x) (hy : IsOmnificGame y) : IsOmnificGame (x * y) := by + exact (IGame.Numeric.mul_congr hx hy).trans (cutGame_mul_cutGame_equiv hx hy) + +private theorem not_isOmnificGame_half : ¬IsOmnificGame (IGame.half : IGame.{u}) := by + intro hhalf + have hcut : cutGame (IGame.half : IGame.{u}) ≈ 0 := + IGame.fits_zero_iff_equiv.mp (by + rw [IGame.Fits] + constructor <;> intro z hz <;> + simp only [cutGame, IGame.leftMoves_ofSets, IGame.rightMoves_ofSets, + Set.mem_singleton_iff] at hz <;> + subst z <;> game_cmp) + exact IGame.zero_lt_half.not_ge (hhalf.trans hcut).1 + +end OmnificInteger + +/-- The singleton cut `{x - 1 | x + 1}` associated with a surreal number `x`. -/ +def omnificIntegerCut (x : Surreal.{u}) : Surreal.{u} := + !{{x - 1} | {x + 1}}' (by + simp only [Set.mem_singleton_iff] + intro a ha b hb + subst a + subst b + simp [sub_eq_add_neg]) + +/-- Conway's omnific-integer cut is definitionally the singleton cut at distance one. -/ +theorem omnificIntegerCut_eq (x : Surreal.{u}) : + omnificIntegerCut x = + !{{x - 1} | {x + 1}}' (by + simp only [Set.mem_singleton_iff] + rintro _ rfl _ rfl + simp [sub_eq_add_neg]) := + (rfl) + +/-- A surreal number is an omnific integer when it equals `{x - 1 | x + 1}`. -/ +def IsOmnificInteger (x : Surreal.{u}) : Prop := + x = omnificIntegerCut x + +/-- The defining fixed-point equation for an omnific integer. -/ +theorem isOmnificInteger_iff {x : Surreal.{u}} : + IsOmnificInteger x ↔ x = omnificIntegerCut x := + Iff.rfl + +/-- Conway's singleton-cut definition of an omnific integer is equivalently fixedness under +rounding with radius one. -/ +theorem isOmnificInteger_iff_round_one {x : Surreal.{u}} : + IsOmnificInteger x ↔ x.round 1 = x := by + rw [IsOmnificInteger, omnificIntegerCut, round_of_pos zero_lt_one] + exact eq_comm + +open OmnificInteger + +private theorem omnificIntegerCut_mk (x : IGame.{u}) [IGame.Numeric x] : + omnificIntegerCut (Surreal.mk x) = Surreal.mk (cutGame x) := by + rw [omnificIntegerCut] + symm + letI : IGame.Numeric !{{x - 1} | {x + 1}} := cutGameNumeric x + change Surreal.mk !{{x - 1} | {x + 1}} = _ + rw [Surreal.mk_ofSets] + congr! 2 <;> simp + +/-- The omnific-integer predicate expressed on a numeric pregame representative. -/ +theorem isOmnificInteger_mk_iff (x : IGame.{u}) [IGame.Numeric x] : + IsOmnificInteger (Surreal.mk x) ↔ + x ≈ !{{x - 1} | {x + 1}} := by + rw [IsOmnificInteger, omnificIntegerCut_mk, Surreal.mk_eq_mk] + rfl + +/-- Zero is an omnific integer. -/ +theorem isOmnificInteger_zero : IsOmnificInteger (0 : Surreal.{u}) := by + rw [← Surreal.mk_zero, isOmnificInteger_mk_iff] + exact OmnificInteger.isOmnificGame_zero + +/-- One is an omnific integer. -/ +theorem isOmnificInteger_one : IsOmnificInteger (1 : Surreal.{u}) := by + rw [← Surreal.mk_one, isOmnificInteger_mk_iff] + exact OmnificInteger.isOmnificGame_one + +/-- The negative of an omnific integer is an omnific integer. -/ +theorem IsOmnificInteger.neg {x : Surreal.{u}} (hx : IsOmnificInteger x) : + IsOmnificInteger (-x) := by + induction x using Surreal.ind with + | mk x => + rw [← Surreal.mk_neg, isOmnificInteger_mk_iff] + exact OmnificInteger.IsOmnificGame.neg ((isOmnificInteger_mk_iff x).mp hx) + +/-- The sum of two omnific integers is an omnific integer. -/ +theorem IsOmnificInteger.add {x y : Surreal.{u}} + (hx : IsOmnificInteger x) (hy : IsOmnificInteger y) : IsOmnificInteger (x + y) := by + induction x using Surreal.ind with + | mk x => + induction y using Surreal.ind with + | mk y => + rw [← Surreal.mk_add, isOmnificInteger_mk_iff] + exact OmnificInteger.IsOmnificGame.add + ((isOmnificInteger_mk_iff x).mp hx) ((isOmnificInteger_mk_iff y).mp hy) + +/-- The product of two omnific integers is an omnific integer. -/ +theorem IsOmnificInteger.mul {x y : Surreal.{u}} + (hx : IsOmnificInteger x) (hy : IsOmnificInteger y) : IsOmnificInteger (x * y) := by + induction x using Surreal.ind with + | mk x => + induction y using Surreal.ind with + | mk y => + rw [← Surreal.mk_mul, isOmnificInteger_mk_iff] + exact OmnificInteger.IsOmnificGame.mul + ((isOmnificInteger_mk_iff x).mp hx) ((isOmnificInteger_mk_iff y).mp hy) + +/-- Omnific integers are closed under subtraction. -/ +theorem IsOmnificInteger.sub {x y : Surreal.{u}} + (hx : IsOmnificInteger x) (hy : IsOmnificInteger y) : + IsOmnificInteger (x - y) := + hx.add hy.neg + +/-- The subring of surreal numbers satisfying Conway's omnific-integer equation. -/ +def omnificIntegers : Subring Surreal.{u} where + carrier := {x | IsOmnificInteger x} + zero_mem' := isOmnificInteger_zero + one_mem' := isOmnificInteger_one + add_mem' := IsOmnificInteger.add + neg_mem' := IsOmnificInteger.neg + mul_mem' := IsOmnificInteger.mul + +/-- Membership in `omnificIntegers` is Conway's omnific-integer predicate. -/ +@[simp] +theorem mem_omnificIntegers {x : Surreal.{u}} : + x ∈ omnificIntegers ↔ IsOmnificInteger x := + Iff.rfl + +/-- Omnific integers, with the ring structure inherited from the surreal numbers. -/ +abbrev OmnificInteger := ↥(omnificIntegers : Subring Surreal.{u}) + +/-- Every natural number is an omnific integer. -/ +@[simp] +theorem IsOmnificInteger.natCast (n : ℕ) : + IsOmnificInteger (n : Surreal.{u}) := + mem_omnificIntegers.mp (n : OmnificInteger.{u}).2 + +/-- Every integer is an omnific integer. -/ +@[simp] +theorem IsOmnificInteger.intCast (n : ℤ) : + IsOmnificInteger (n : Surreal.{u}) := + mem_omnificIntegers.mp (n : OmnificInteger.{u}).2 + +/-- The surreal number `2⁻¹` is not an omnific integer. -/ +theorem two_inv_not_mem_omnificIntegers : + (2 : Surreal.{u})⁻¹ ∉ omnificIntegers := by + rw [← IGame.mk_half, mem_omnificIntegers, isOmnificInteger_mk_iff] + exact OmnificInteger.not_isOmnificGame_half + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/NormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/NormalForm.lean new file mode 100644 index 0000000000..ebf63f40b6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/NormalForm.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Copyright (c) 2026 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov, Violeta Hernández Palacios +-/ +/- +Partly adapted and modified from the Apache-2.0-licensed CombinatorialGames PR #317: +https://github.com/vihdzp/combinatorial-games/pull/317 +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormAdd +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Basic + +/-! +# Conway normal forms of omnific integers + +This module proves Conway's normal-form characterization of the omnific integers: a surreal is an +omnific integer exactly when its Conway support consists of nonnegative exponents and its constant +coefficient is an integer. The proof uses the fixed-point definition from +`ConwayRefinement.Surreal.OmnificInteger.Basic` and the Conway normal-form rounding +criterion. + +The characterization is Theorem 31 of *On Numbers and Games* and is the presentation of `Oz` +recalled in LM24, Section 1.1. +-/ + +universe u + +public noncomputable section + +namespace Surreal + +open Set + +/-- A positive omnific integer is at least one. -/ +theorem IsOmnificInteger.one_le_iff_pos {x : Surreal.{u}} + (h : IsOmnificInteger x) : 1 ≤ x ↔ 0 < x where + mp := zero_lt_one.trans_le + mpr hx := by + rw [isOmnificInteger_iff_round_one] at h + by_contra hnot + have hxle : x ≤ 1 := le_of_not_ge hnot + have hzero : 0 ∈ Ioo (x - 1) (x + 1) := by + constructor <;> linarith + rw [round_of_zero_mem hzero] at h + exact hx.ne h + +/-- An omnific integer below one is nonpositive. -/ +theorem IsOmnificInteger.lt_one_iff_nonpos {x : Surreal.{u}} + (h : IsOmnificInteger x) : x < 1 ↔ x ≤ 0 := by + rw [← not_iff_not] + simpa only [not_le, not_lt] using h.one_le_iff_pos + +/-- An omnific integer strictly between negative one and one is zero. -/ +theorem IsOmnificInteger.eq_zero_of_mem_Ioo_neg_one_one {x : Surreal.{u}} + (hx : IsOmnificInteger x) (hbound : x ∈ Ioo (-1) 1) : x = 0 := by + have hxNonpos : x ≤ 0 := hx.lt_one_iff_nonpos.mp hbound.2 + have hnegNonpos : -x ≤ 0 := hx.neg.lt_one_iff_nonpos.mp (by linarith [hbound.1]) + linarith + +/-- Two omnific integers whose difference is strictly between negative one and one are equal. -/ +theorem IsOmnificInteger.eq_of_sub_mem_Ioo_neg_one_one {x y : Surreal.{u}} + (hx : IsOmnificInteger x) (hy : IsOmnificInteger y) + (hbound : x - y ∈ Ioo (-1) 1) : x = y := by + have hzero := (hx.sub hy).eq_zero_of_mem_Ioo_neg_one_one hbound + linarith + +/-- A real number is an omnific integer exactly when it is the image of an integer. -/ +@[simp] +theorem isOmnificInteger_realCast_iff {r : ℝ} : + IsOmnificInteger (r : Surreal.{u}) ↔ r ∈ range ((↑) : ℤ → ℝ) where + mpr := by + rintro ⟨n, rfl⟩ + simpa only [Real.toSurreal_intCast] using IsOmnificInteger.intCast n + mp h := by + rw [← Int.fract_eq_zero_iff] + apply (Int.fract_nonneg r).antisymm' + rw [← Real.toSurreal_le_iff, Real.toSurreal_zero, + ← IsOmnificInteger.lt_one_iff_nonpos] + · exact_mod_cast Int.fract_lt_one r + · rw [Int.fract, Real.toSurreal_sub] + apply h.sub + simpa only [Real.toSurreal_intCast] using IsOmnificInteger.intCast ⌊r⌋ + +/-- If a Conway support is nonnegative, removing its positive truncation leaves its real constant +coefficient. -/ +theorem sub_trunc_zero_eq_realCast_of_support_subset_Ici {x : Surreal.{u}} + (hx : x.support ⊆ Ici 0) : + x - x.trunc 0 = (x.coeff 0 : Surreal) := by + rw [← toHahnSeries_inj] + ext i + simp only [sub_eq_add_neg, toHahnSeries_add, toHahnSeries_neg, + SurrealHahnSeries.coeff_add_apply, SurrealHahnSeries.coeff_neg, + Pi.neg_apply, coeff_toHahnSeries, toHahnSeries_trunc, + SurrealHahnSeries.coeff_trunc, toHahnSeries_realCast, + SurrealHahnSeries.coeff_single] + rcases lt_trichotomy i 0 with hi | rfl | hi + · have hcoeff : x.coeff i = 0 := by + rw [← notMem_support_iff] + exact fun hmem ↦ (not_le_of_gt hi) (hx hmem) + simp [hcoeff, hi.ne] + · simp + · simp [hi, hi.ne'] + +/-- Conway's normal-form characterization: `x` is an omnific integer exactly when all exponents +in its support are nonnegative and its coefficient at exponent zero is an integer. -/ +theorem isOmnificInteger_iff_normalForm {x : Surreal.{u}} : + IsOmnificInteger x ↔ + x.support ⊆ Ici 0 ∧ x.coeff 0 ∈ range ((↑) : ℤ → ℝ) := by + constructor + · intro hx + have hround : x.round 1 = x := isOmnificInteger_iff_round_one.mp hx + have hsupp : x.support ⊆ Ici 0 := by + simpa only [wlog_one] using support_subset_of_round_eq hround zero_lt_one + refine ⟨hsupp, ?_⟩ + rw [← isOmnificInteger_realCast_iff] + rw [← sub_trunc_zero_eq_realCast_of_support_subset_Ici hsupp] + apply hx.sub + rw [isOmnificInteger_iff_round_one] + apply eq_round_of_support_subset + · simpa only [wlog_one, support_trunc] using + (inter_subset_right : x.support ∩ Ioi 0 ⊆ Ioi 0) + · exact zero_lt_one + · rintro ⟨hsupp, hcoeff⟩ + have htrunc : IsOmnificInteger (x.trunc 0) := by + rw [isOmnificInteger_iff_round_one] + apply eq_round_of_support_subset + · simpa only [wlog_one, support_trunc] using + (inter_subset_right : x.support ∩ Ioi 0 ⊆ Ioi 0) + · exact zero_lt_one + have hconstant : IsOmnificInteger (x.coeff 0 : Surreal) := + isOmnificInteger_realCast_iff.mpr hcoeff + rw [← sub_add_cancel x (x.trunc 0), + sub_trunc_zero_eq_realCast_of_support_subset_Ici hsupp] + exact hconstant.add htrunc + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Ordinal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Ordinal.lean new file mode 100644 index 0000000000..30064dca53 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Ordinal.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Basic +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Ordinal + +import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.GameCmp + +/-! +# Ordinals as omnific integers + +This file proves the final assertion of Conway's Theorem 31: every ordinal, embedded in the +surreal numbers, is an omnific integer. The proof uses the canonical ordinal pregame and Conway's +fixed-point definition directly; it does not presuppose a surreal normal-form map. +-/ + +universe u + +public noncomputable section + +open IGame Order + +namespace NatOrdinal + +private theorem toIGame_le_sub_one_of_lt {a o : NatOrdinal.{u}} (hao : a < o) : + a.toIGame ≤ o.toIGame - 1 := by + rw [← Game.mk_le_mk] + simp only [Game.mk_sub, Game.mk_one, Game.mk_natOrdinal_toIGame] + rw [le_sub_iff_add_le, ← NatOrdinal.toGame_one, ← NatOrdinal.toGame_add] + apply NatOrdinal.toGame.monotone + simpa only [Order.succ_eq_add_one] using succ_le_of_lt hao + +private theorem toIGame_equiv_omnificIntegerCut (o : NatOrdinal.{u}) : + o.toIGame ≈ !{{o.toIGame - 1} | {o.toIGame + 1}} := by + apply IGame.Fits.equiv_of_forall_moves + · rw [IGame.Fits] + constructor + · intro z hz + simp only [IGame.leftMoves_ofSets, Set.mem_singleton_iff] at hz + subst z + exact IGame.Numeric.not_le.mpr (by + rw [← Surreal.mk_lt_mk] + simp) + · intro z hz + simp only [IGame.rightMoves_ofSets, Set.mem_singleton_iff] at hz + subst z + exact IGame.Numeric.not_le.mpr (by + rw [← Surreal.mk_lt_mk] + simp) + · intro z hz + rw [NatOrdinal.leftMoves_toIGame] at hz + obtain ⟨a, ha, rfl⟩ := hz + exact ⟨o.toIGame - 1, by simp, toIGame_le_sub_one_of_lt ha⟩ + · simp + +/-- Every ordinal, under its canonical embedding in the surreal numbers, is an omnific integer. -/ +theorem isOmnificInteger_toSurreal (o : NatOrdinal.{u}) : + Surreal.IsOmnificInteger o.toSurreal := by + rw [← Surreal.mk_natOrdinal_toIGame, Surreal.isOmnificInteger_mk_iff] + exact toIGame_equiv_omnificIntegerCut o + +/-- Every ordinal belongs to the omnific-integer subring of the surreal numbers. -/ +theorem toSurreal_mem_omnificIntegers (o : NatOrdinal.{u}) : + o.toSurreal ∈ Surreal.omnificIntegers := + Surreal.mem_omnificIntegers.mpr (isOmnificInteger_toSurreal o) + +end NatOrdinal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality.lean new file mode 100644 index 0000000000..aa4c63f0ea --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.FiniteClasses +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.IrreducibleOmnificIntegers +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OmnificIntegers +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OrdinaryIntegers +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.ZFC + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/FiniteClasses.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/FiniteClasses.lean new file mode 100644 index 0000000000..8ec0142c70 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/FiniteClasses.lean @@ -0,0 +1,186 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.IrreducibleOmnificIntegers +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassPrimality + +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationResidue + +/-! +# Primality for finitely many support classes + +Integer constants are primal in the bounded Hahn integer part. The generic finite-class theorem +then gives primality for omnific integers whose support meets finitely many Archimedean classes. +-/ + +public noncomputable section + +open Cardinal FiniteArchimedeanClass +open scoped HahnSeries + +namespace HahnSeries.Nonpositive + +variable {K G R : Type*} {κ : Cardinal} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] [Fact (ℵ₀ < κ)] +variable (Z : Subring R) (hZ : ∀ r : R, r ∈ Z ↔ ∃ z : ℤ, (z : R) = r) +include hZ + +/-- Every integer constant is primal in the bounded integer part over the integers. -/ +theorem isPrimal_intCast [CharZero R] (z : ℤ) : + IsPrimal (z : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) := by + refine UniqueFactorizationMonoid.induction_on_prime + (P := fun z : ℤ ↦ IsPrimal + (z : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z)) z ?_ ?_ ?_ + · simpa using (isPrimal_zero : IsPrimal + (0 : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z)) + · intro a ha + exact (ha.map (Int.castRingHom _)).isPrimal + · intro a p _ hp ha + rw [Int.cast_mul] + exact (prime_intCast Z hZ hp).isPrimal.mul ha + +/-- A bounded integer-part series of order zero is an integer constant and hence primal. -/ +theorem isPrimal_of_order_eq_zero [CharZero R] + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) + (horder : ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x : + Nonpositive G R) : R⟦G⟧).order = 0) : IsPrimal x := by + let xN := CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x + have hconstant : (xN : R⟦G⟧) = HahnSeries.C ((xN : R⟦G⟧).coeff 0) := by + ext g + by_cases hg : g = 0 + · subst g + simp + · rw [HahnSeries.C_apply, HahnSeries.coeff_single_of_ne hg] + by_contra hcoeff + have hgNonpos : g ≤ 0 := support_subset xN ((HahnSeries.mem_support _ _).mpr hcoeff) + have hzeroLe : 0 ≤ g := horder ▸ HahnSeries.order_le_of_coeff_ne_zero hcoeff + exact hg (le_antisymm hgNonpos hzeroLe) + have hcoeffMem : (xN : R⟦G⟧).coeff 0 ∈ Z := by + simpa only [xN, CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] using + ((mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp x.2).2 + obtain ⟨z, hz⟩ := (hZ _).mp hcoeffMem + have hxz : x = (z : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) := by + apply CardSuppLTTruncationIntegerPart.toNonpositiveRingHom_injective Z + rw [map_intCast] + apply Subtype.ext + change (xN : R⟦G⟧) = HahnSeries.C (z : R) + rw [hconstant, hz] + rw [hxz] + exact isPrimal_intCast Z hZ z + +end HahnSeries.Nonpositive + +namespace Surreal + +universe u + +/-- A bounded signed surreal integer-part series whose support meets only finitely many +Archimedean classes is primal. -/ +theorem isPrimal_cardSuppLTTruncationIntegerPart_of_supportArchimedeanClasses_finite + (a : HahnSeries.cardSuppLTTruncationIntegerPart + (G := Surreal.{u}) (R := ℝ) (κ := smallSupportCardinal.{u}) realIntegerSubring) + (hfinite : (HahnSeries.Nonpositive.supportArchimedeanClasses + (HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom + realIntegerSubring a)).Finite) : IsPrimal a := by + apply HahnSeries.Nonpositive.isPrimal_of_supportArchimedeanClasses_finite_of_reduced + realIntegerSubring archimedeanStrata + · exact HahnSeries.Nonpositive.isPrimal_of_order_eq_zero realIntegerSubring + OmnificInteger.realIntegerSubring_mem_iff + · intro y hyOrder hyReduced + have hy0 : HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom + realIntegerSubring y ≠ 0 := by + intro hyzero + apply hyOrder + rw [hyzero, Subring.coe_zero, HahnSeries.order_zero] + let c := HahnSeries.Nonpositive.leadingClass + (HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom + realIntegerSubring y) hyOrder + exact HahnSeries.Nonpositive.isPrimal_of_isReduced_of_leadingClass_orderIso_real + archimedeanStrata realIntegerSubring y hy0 hyOrder hyReduced + (assumptionA2AtFiniteClass realIntegerSubring c) + (stratumOrderAddMonoidIsoReal archimedeanStrata c) + · exact hfinite + +/-- The finite-class endpoint stated directly using the underlying support image. -/ +theorem isPrimal_cardSuppLTTruncationIntegerPart_of_image_mk_support_finite + (a : HahnSeries.cardSuppLTTruncationIntegerPart + (G := Surreal.{u}) (R := ℝ) (κ := smallSupportCardinal.{u}) realIntegerSubring) + (hfinite : (ArchimedeanClass.mk '' (a : ℝ⟦Surreal.{u}⟧).support).Finite) : + IsPrimal a := by + apply isPrimal_cardSuppLTTruncationIntegerPart_of_supportArchimedeanClasses_finite + rw [HahnSeries.CardSuppLTTruncationIntegerPart.supportArchimedeanClasses_toNonpositiveRingHom] + exact hfinite + +end Surreal + +namespace Surreal.OmnificInteger + +universe u + +open HahnSeries.Nonpositive + +/-- Changing from Conway normal-form exponents to signed Hahn exponents preserves the set of +support classes, including the zero class. -/ +theorem supportArchimedeanClasses_toSignedNonpositiveHahn (x : Surreal.OmnificInteger.{u}) : + supportArchimedeanClasses x.toSignedNonpositiveHahn = + ArchimedeanClass.mk '' (x : Surreal.{u}).support := by + ext c + rw [mem_supportArchimedeanClasses] + constructor + · rintro ⟨g, hg, rfl⟩ + refine ⟨-g, ?_, by simp⟩ + rw [coe_toSignedNonpositiveHahn] at hg + exact Surreal.mem_support_toSignedFullHahnSeries.mp hg + · rintro ⟨g, hg, rfl⟩ + refine ⟨-g, ?_, by simp⟩ + rw [coe_toSignedNonpositiveHahn, Surreal.mem_support_toSignedFullHahnSeries] + simpa only [neg_neg] using hg + +/-- An omnific integer whose support meets only finitely many Archimedean classes is primal. +The signed support includes exponent zero, whose class is `⊤`; sign reversal does not change +Archimedean classes. The conclusion also holds for zero. -/ +@[blueprint "cor:omnific-finite-classes" + (phase := "Surreal numbers and omnific integers") + (title := "Primality for finitely many Archimedean classes") + (statement := /-- + Every omnific integer whose normal-form exponents meet only finitely many + Archimedean classes is primal in $\Oz$. + -/) + (proof := /-- + Pass to the signed Hahn presentation and induct on the finite set of + occupied Archimedean classes. A series of order zero is an integer + constant. Otherwise, split off its leading class. The reduced factor is + primal by \ref{cor:reduced-hahn-integer-part-primal}, using + \ref{fact:surreal-archimedean-strata} for $(A1)_\sigma$ and + \ref{fact:surreal-archimedean-ball-cofinality} for $(A2)_\sigma$; the lower truncation + has fewer occupied classes and is primal by induction. Their product is + primal. By \ref{thm:signed-normal-form-omnific-integer-equivalence}, + signed normal form transfers primality back to the original omnific integer. + -/)] +theorem isPrimal_of_supportArchimedeanClasses_finite (x : Surreal.OmnificInteger.{u}) + (hfinite : (supportArchimedeanClasses x.toSignedNonpositiveHahn).Finite) : IsPrimal x := by + let b : SignedSmallSupportIntegerPart.{u} := toSignedSmallSupportIntegerPart x + have himage : HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom + Surreal.realIntegerSubring b = x.toSignedNonpositiveHahn := by + apply Subtype.ext + rw [HahnSeries.CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom, + coe_toSignedNonpositiveHahn] + exact coe_toSignedSmallSupportIntegerPart x + have hbPrimal : IsPrimal b := by + apply Surreal.isPrimal_cardSuppLTTruncationIntegerPart_of_supportArchimedeanClasses_finite + rwa [himage] + let E : Surreal.OmnificInteger.{u} ≃+* SignedSmallSupportIntegerPart.{u} := + signedSmallSupportIntegerPartRingEquiv + apply (RingEquiv.isPrimal_iff E x).mp + simpa only [E, signedSmallSupportIntegerPartRingEquiv_apply, b] using hbPrimal + +end Surreal.OmnificInteger diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/IrreducibleOmnificIntegers.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/IrreducibleOmnificIntegers.lean new file mode 100644 index 0000000000..bf489a824f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/IrreducibleOmnificIntegers.lean @@ -0,0 +1,427 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OmnificIntegers +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalFiniteClassReduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedCharacterization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Monomial +public import Mathlib.RingTheory.UniqueFactorizationDomain.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ArchimedeanAssumptions + +/-! +# Every irreducible omnific integer is prime + +Let `b` be an omnific integer, read as a bounded integer-part element of the signed Hahn series +`ℝ⟦Surreal⟧` with nonpositive exponents. If `b` is not an ordinary integer, its lowest exponent is +nonzero, and at the Archimedean class `σ` of that exponent LM24's reduction `ρ_σ(b)` divides `b` +with cofactor the open truncation `τ_σ(b)` (LM24, Definition 8.2.4): `b = ρ_σ(b) · τ_σ(b)`. Both +factors lie in the integer part, the units of the integer part are `±1`, and `ρ_σ(b)` is not a +unit. So an irreducible `b` has `τ_σ(b) ∈ {0, 1, -1}`: `b` or `-b` is reduced (LM24, +Proposition 8.2.5), hence primal (`Surreal.OmnificInteger.isPrimal_of_isReduced`, resting on the +primality of every series), hence prime. An irreducible ordinary integer is a prime number, and +a prime number `p` is prime in the omnific integers: `p` divides an omnific integer exactly when +it divides its integer constant coefficient, since a series without constant term is divisible +by every nonzero integer. + +Hence every irreducible omnific integer is prime, and factorisations into irreducibles are unique +up to order and units (`Surreal.OmnificInteger.factorization_unique`). +-/ + +universe u + +public noncomputable section + +open Cardinal FiniteArchimedeanClass +open scoped HahnSeries + +namespace HahnSeries.Nonpositive + +variable {K G R : Type*} {κ : Cardinal} +variable [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] +variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] +variable [Module K G] [IsOrderedModule K G] +variable [Field R] [Fact (ℵ₀ < κ)] + +/-! ### Units of the integer part over the integers -/ + +variable (Z : Subring R) (hZ : ∀ r : R, r ∈ Z ↔ ∃ z : ℤ, (z : R) = r) +include hZ + +/-- When `Z` is the image of `ℤ`, the units of the integer part are `1` and `-1`. -/ +theorem eq_one_or_eq_neg_one_of_isUnit [CharZero R] + {x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z} (hx : IsUnit x) : + x = 1 ∨ x = -1 := by + obtain ⟨v, rfl⟩ := hx + set x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z := ↑v with hxdef + let y : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z := ↑v⁻¹ + have hxy : x * y = 1 := by rw [hxdef]; exact v.mul_inv + have hxN := eq_C_constantCoeff_of_isUnit + ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z).isUnit_map v.isUnit) + have hyN := eq_C_constantCoeff_of_isUnit + ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z).isUnit_map (v⁻¹).isUnit) + obtain ⟨m, hm⟩ := (hZ _).mp ((mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp x.2).2 + obtain ⟨n, hn⟩ := (hZ _).mp ((mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp y.2).2 + have hxC : CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x = C (m : R) := by + rw [hxN, constantCoeff_apply, CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom, hm] + have hyC : CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z y = C (n : R) := by + rw [hyN, constantCoeff_apply, CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom, hn] + have hmn : ((m * n : ℤ) : R) = 1 := by + have h := congrArg (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z) hxy + rw [map_mul, map_one, hxC, hyC, ← map_mul] at h + have h' := congrArg (fun q : Nonpositive G R ↦ (q : R⟦G⟧)) h + simp only [coe_C, Subring.coe_one] at h' + rw [← HahnSeries.C_one] at h' + rw [Int.cast_mul] + exact HahnSeries.C_injective h' + have hm1 : m * n = 1 := by exact_mod_cast hmn + rcases Int.eq_one_or_neg_one_of_mul_eq_one hm1 with h1 | h1 + · left + apply CardSuppLTTruncationIntegerPart.toNonpositiveRingHom_injective Z + rw [hxC, h1, map_one, Int.cast_one, map_one] + · right + apply CardSuppLTTruncationIntegerPart.toNonpositiveRingHom_injective Z + rw [hxC, h1, map_neg, map_one, Int.cast_neg, Int.cast_one, map_neg, map_one] + +/-! ### Irreducible elements of the integer part are reduced up to sign -/ + +/-- An irreducible bounded integer-part element with nonzero lowest exponent is reduced up to +sign: at the class of its lowest exponent, `x = ρ_σ(x) τ_σ(x)` with `ρ_σ(x)` not a unit, so +`τ_σ(x) ∈ {0, 1, -1}` (LM24, Proposition 8.2.5). -/ +theorem isReduced_or_isReduced_neg_of_irreducible [CharZero R] + (u : HahnEmbedding.ArchimedeanStrata K G) + {x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z} (hirr : Irreducible x) + (horder : ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x : + Nonpositive G R) : R⟦G⟧).order ≠ 0) : + IsReduced (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) ∨ + IsReduced (-CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) := by + set xN := CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x with hxN + have hx0 : xN ≠ 0 := by + intro h + apply horder + rw [h, Subring.coe_zero, HahnSeries.order_zero] + set c := leadingClass xN horder with hc + have hT : T (K := K) c xN = xN := T_leadingClass xN horder + by_cases htau : tau (K := K) c xN = 0 + · left + exact (isReduced_iff_tau_leadingClass_eq_zero_or_one xN hx0 horder).mpr (Or.inl htau) + have hfac := rhoIntegerPart_mul_tauIntegerPart u c Z x hT htau + rcases hirr.isUnit_or_isUnit hfac.symm with hρ | hτ + · -- the reduction is not a unit: it would be `1`, forcing `x = τ_σ(x)` + exfalso + have hρN : CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z + (rhoIntegerPart u c Z x hT htau) = 1 := by + rcases eq_one_or_eq_neg_one_of_isUnit Z hZ hρ with h1 | h1 + · rw [h1, map_one] + · exfalso + have hcoeff := coeff_zero_rho_of_tau_ne_zero u c xN htau + rw [← toNonpositive_rhoIntegerPart u c Z x hT htau, h1, map_neg, map_one] at hcoeff + have : ((-1 : Nonpositive G R) : R⟦G⟧).coeff 0 = -1 := by + rw [Subring.coe_neg, Subring.coe_one, HahnSeries.coeff_neg, HahnSeries.coeff_one, + if_pos rfl] + rw [this] at hcoeff + have h2 : (1 : R) + 1 = 0 := by + calc (1 : R) + 1 = -1 + 1 := by rw [hcoeff] + _ = 0 := neg_add_cancel 1 + exact two_ne_zero (one_add_one_eq_two.symm.trans h2) + have hxτ : xN = tau (K := K) c xN := by + have h := congrArg (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z) hfac + rw [map_mul, hρN, one_mul, toNonpositive_tauIntegerPart] at h + exact h.symm + have hcmk : c = FiniteArchimedeanClass.mk (xN : R⟦G⟧).order horder := by + apply Subtype.ext + rw [hc, leadingClass_val, FiniteArchimedeanClass.val_mk] + have hnot : (xN : R⟦G⟧).order ∉ ball K c := by + intro hmem + have hlt := (FiniteArchimedeanClass.mem_ball_iff (K := K)).mp hmem horder + rw [← hcmk] at hlt + exact lt_irrefl _ hlt + have h0 : ((tau (K := K) c xN : Nonpositive G R) : R⟦G⟧).coeff (xN : R⟦G⟧).order = 0 := + coeff_tau_of_not_mem c xN hnot + rw [← hxτ] at h0 + exact hx0 (Subtype.ext (HahnSeries.coeff_order_eq_zero.mp h0)) + · rcases eq_one_or_eq_neg_one_of_isUnit Z hZ hτ with h1 | h1 + · left + refine (isReduced_iff_tau_leadingClass_eq_zero_or_one (K := K) xN hx0 horder).mpr (Or.inr ?_) + have h := congrArg (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z) h1 + rw [toNonpositive_tauIntegerPart, map_one] at h + exact h + · right + have hx0' : -xN ≠ 0 := neg_ne_zero.mpr hx0 + have horder' : ((-xN : Nonpositive G R) : R⟦G⟧).order ≠ 0 := by + rw [Subring.coe_neg, HahnSeries.order_neg]; exact horder + refine (isReduced_iff_tau_leadingClass_eq_zero_or_one (K := K) (-xN) hx0' horder').mpr + (Or.inr ?_) + have hclass : leadingClass (-xN) horder' = c := by + apply Subtype.ext + rw [leadingClass_val, leadingClass_val, Subring.coe_neg, HahnSeries.order_neg] + rw [hclass, map_neg] + have h := congrArg (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z) h1 + rw [toNonpositive_tauIntegerPart, map_neg, map_one] at h + rw [h, neg_neg] + +/-! ### Prime numbers are prime in the integer part over the integers -/ + +/-- The integer constant coefficient of a bounded integer-part element over the integers. -/ +def intCoeff (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : ℤ := + Classical.choose ((hZ _).mp ((mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp x.2).2) + +theorem intCoeff_spec (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + ((intCoeff Z hZ x : ℤ) : R) = + ((x : CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧).coeff 0 := + Classical.choose_spec ((hZ _).mp ((mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp x.2).2) + +/-- The integer constant coefficient is a ring homomorphism to `ℤ`. -/ +@[expose] def intCoeffRingHom [CharZero R] : + cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z →+* ℤ where + toFun := intCoeff Z hZ + map_one' := by + apply Int.cast_injective (α := R) + rw [intCoeff_spec, Int.cast_one, Subring.coe_one, Subfield.coe_one, HahnSeries.coeff_one, + if_pos rfl] + map_mul' x y := by + apply Int.cast_injective (α := R) + rw [Int.cast_mul, intCoeff_spec, intCoeff_spec, intCoeff_spec] + have h := coeff_zero_mul (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z x) + (CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z y) + rw [Subring.coe_mul, Subfield.coe_mul] + simpa only [CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] using h + map_zero' := by + apply Int.cast_injective (α := R) + rw [intCoeff_spec, Int.cast_zero, Subring.coe_zero, Subfield.coe_zero, HahnSeries.coeff_zero] + map_add' x y := by + apply Int.cast_injective (α := R) + rw [Int.cast_add, intCoeff_spec, intCoeff_spec, intCoeff_spec, Subring.coe_add, + Subfield.coe_add, HahnSeries.coeff_add] + +theorem intCoeffRingHom_apply [CharZero R] + (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + intCoeffRingHom Z hZ x = intCoeff Z hZ x := + rfl + +omit hZ in +/-- A constant series, in the `κ`-bounded field. -/ +@[expose] def constField (r : R) : CardSuppLTField (G := G) (R := R) (κ := κ) := + ⟨HahnSeries.C r, by + rw [mem_cardSuppLTSubfield, HahnSeries.C_apply] + exact (HahnSeries.cardSupp_single_le _ _).trans_lt (one_lt_aleph0.trans Fact.out)⟩ + +omit hZ in +theorem coe_constField (r : R) : + ((constField (G := G) (κ := κ) r : CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧) = + HahnSeries.C r := + rfl + +/-- An integer `z ≠ 0` divides a bounded integer-part element exactly when it divides its integer +constant coefficient: a series without constant term is divisible by every nonzero integer. -/ +theorem intCast_dvd_iff [CharZero R] {z : ℤ} (hz : z ≠ 0) + (a : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) : + (z : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) ∣ a ↔ + z ∣ intCoeffRingHom Z hZ a := by + constructor + · intro h + have := map_dvd (intCoeffRingHom Z hZ) h + rwa [map_intCast, Int.cast_id] at this + · rintro ⟨k, hk⟩ + have hzR : (z : R) ≠ 0 := Int.cast_ne_zero.mpr hz + have ha0 : ((a : CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧).coeff 0 = + ((z * k : ℤ) : R) := by + rw [← hk, intCoeffRingHom_apply, intCoeff_spec] + -- the quotient `(a - a₀) / z + k` + let w : CardSuppLTField (G := G) (R := R) (κ := κ) := + constField ((z : R)⁻¹) * ((a : CardSuppLTField (G := G) (R := R) (κ := κ)) - + constField ((z * k : ℤ) : R)) + constField (k : R) + have hw : (w : R⟦G⟧) = HahnSeries.C ((z : R)⁻¹) * + (((a : CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧) - + HahnSeries.C ((z * k : ℤ) : R)) + + HahnSeries.C (k : R) := by + simp only [w, Subfield.coe_add, Subfield.coe_mul, Subfield.coe_sub, coe_constField] + have hwmem : w ∈ cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z := by + rw [mem_cardSuppLTTruncationIntegerPart, hw] + constructor + · intro g hg + rcases HahnSeries.support_add_subset _ _ hg with hg | hg + · obtain ⟨i, hi, j, hj, rfl⟩ := HahnSeries.support_mul_subset hg + rw [HahnSeries.C_apply] at hi + have hi0 : i = 0 := HahnSeries.support_single_subset hi + change i + j ∈ Set.Iic 0 + rw [hi0, zero_add] + rw [sub_eq_add_neg] at hj + rcases HahnSeries.support_add_subset _ _ hj with hj | hj + · exact ((mem_cardSuppLTTruncationIntegerPart (Z := Z)).mp a.2).1 hj + · have hj' := HahnSeries.support_neg_subset _ hj + rw [HahnSeries.C_apply] at hj' + exact (HahnSeries.support_single_subset hj').le + · rw [HahnSeries.C_apply] at hg + exact (HahnSeries.support_single_subset hg).le + · rw [HahnSeries.coeff_add, HahnSeries.C_mul_eq_smul, HahnSeries.coeff_smul, + HahnSeries.coeff_sub, ha0, HahnSeries.C_apply, HahnSeries.coeff_single_same, sub_self, + smul_zero, zero_add, HahnSeries.C_apply, HahnSeries.coeff_single_same] + exact (hZ _).mpr ⟨k, rfl⟩ + refine ⟨⟨w, hwmem⟩, ?_⟩ + apply Subtype.ext + apply Subtype.ext + rw [Subring.coe_mul, Subfield.coe_mul, SubringClass.coe_intCast, SubringClass.coe_intCast] + change ((a : CardSuppLTField (G := G) (R := R) (κ := κ)) : R⟦G⟧) = (z : R⟦G⟧) * (w : R⟦G⟧) + rw [hw, ← map_intCast (HahnSeries.C : R →+* R⟦G⟧), mul_add, ← mul_assoc, ← map_mul, + mul_inv_cancel₀ hzR, map_one, one_mul, ← map_mul, ← Int.cast_mul, sub_add_cancel] + +/-- A prime number is prime in the integer part over the integers. -/ +theorem prime_intCast [CharZero R] {z : ℤ} (hz : Prime z) : + Prime (z : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) := by + refine ⟨?_, ?_, fun a b hab ↦ ?_⟩ + · intro h + apply hz.ne_zero + have := congrArg (intCoeffRingHom Z hZ) h + rwa [map_intCast, Int.cast_id, map_zero] at this + · intro h + apply hz.not_unit + rcases eq_one_or_eq_neg_one_of_isUnit Z hZ h with h1 | h1 + · have := congrArg (intCoeffRingHom Z hZ) h1 + rw [map_intCast, Int.cast_id, map_one] at this + rw [this]; exact isUnit_one + · have := congrArg (intCoeffRingHom Z hZ) h1 + rw [map_intCast, Int.cast_id, map_neg, map_one] at this + rw [this]; exact isUnit_one.neg + · rw [intCast_dvd_iff Z hZ hz.ne_zero, map_mul] at hab + rcases hz.dvd_or_dvd hab with h | h + · exact Or.inl ((intCast_dvd_iff Z hZ hz.ne_zero a).mpr h) + · exact Or.inr ((intCast_dvd_iff Z hZ hz.ne_zero b).mpr h) + +/-- An integer irreducible in the integer part over the integers is irreducible in `ℤ`. -/ +theorem irreducible_int_of_irreducible_intCast [CharZero R] {z : ℤ} + (hz : Irreducible (z : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z)) : + Irreducible z := by + refine ⟨fun h ↦ hz.not_isUnit (h.map (Int.castRingHom _)), fun a b hab ↦ ?_⟩ + have hab' : (z : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) = a * b := by + rw [hab, Int.cast_mul] + rcases hz.isUnit_or_isUnit hab' with h | h + · left + rcases eq_one_or_eq_neg_one_of_isUnit Z hZ h with h1 | h1 + · have := congrArg (intCoeffRingHom Z hZ) h1 + rw [map_intCast, Int.cast_id, map_one] at this + rw [this]; exact isUnit_one + · have := congrArg (intCoeffRingHom Z hZ) h1 + rw [map_intCast, Int.cast_id, map_neg, map_one] at this + rw [this]; exact isUnit_one.neg + · right + rcases eq_one_or_eq_neg_one_of_isUnit Z hZ h with h1 | h1 + · have := congrArg (intCoeffRingHom Z hZ) h1 + rw [map_intCast, Int.cast_id, map_one] at this + rw [this]; exact isUnit_one + · have := congrArg (intCoeffRingHom Z hZ) h1 + rw [map_intCast, Int.cast_id, map_neg, map_one] at this + rw [this]; exact isUnit_one.neg + +end HahnSeries.Nonpositive + +namespace Surreal.OmnificInteger + +open HahnSeries.Nonpositive + +theorem not_isOrdinaryInteger_neg {x : Surreal.OmnificInteger.{u}} (hx : ¬ IsOrdinaryInteger x) : + ¬ IsOrdinaryInteger (-x) := by + intro h + obtain ⟨z, hz⟩ := (isOrdinaryInteger_iff _).mp h + apply hx + rw [isOrdinaryInteger_iff] + refine ⟨-z, ?_⟩ + rw [Int.cast_neg, ← hz, Subring.coe_neg, neg_neg] + +theorem toSignedNonpositiveHahn_neg (x : Surreal.OmnificInteger.{u}) : + (-x).toSignedNonpositiveHahn = -x.toSignedNonpositiveHahn := by + apply Subtype.ext + rw [coe_toSignedNonpositiveHahn, Subring.coe_neg, Surreal.toSignedFullHahnSeries_neg, + ← coe_toSignedNonpositiveHahn] + exact (Subring.coe_neg _ _).symm + +theorem realIntegerSubring_mem_iff (r : ℝ) : + r ∈ Surreal.realIntegerSubring ↔ ∃ z : ℤ, (z : ℝ) = r := by + rw [Surreal.mem_realIntegerSubring] + exact Iff.rfl + +/-- An irreducible omnific integer that is not an ordinary integer is primal: it or its negative +is reduced (LM24, Proposition 8.2.5), and reduced nonordinary omnific integers are primal. -/ +theorem isPrimal_of_irreducible_of_not_isOrdinaryInteger (x : Surreal.OmnificInteger.{u}) + (hirr : Irreducible x) (hx : ¬ IsOrdinaryInteger x) : IsPrimal x := by + have hb : Irreducible (toSignedSmallSupportIntegerPart x) := by + rw [← signedSmallSupportIntegerPartRingEquiv_apply] + exact (MulEquiv.irreducible_iff (f := signedSmallSupportIntegerPartRingEquiv.{u})).mpr hirr + have horder := boundedSignedHahn_order_ne_zero_of_not_isOrdinaryInteger x hx + have himage : HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom + Surreal.realIntegerSubring (toSignedSmallSupportIntegerPart x) = + x.toSignedNonpositiveHahn := by + apply Subtype.ext + rw [HahnSeries.CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom, + coe_toSignedNonpositiveHahn] + exact coe_toSignedSmallSupportIntegerPart x + rcases isReduced_or_isReduced_neg_of_irreducible Surreal.realIntegerSubring + realIntegerSubring_mem_iff Surreal.archimedeanStrata hb horder with hred | hred + · rw [himage] at hred + exact isPrimal_of_isReduced x hx hred + · rw [himage, ← toSignedNonpositiveHahn_neg] at hred + have hneg := isPrimal_of_isReduced (-x) (not_isOrdinaryInteger_neg hx) hred + have hx' : x = (-1) * (-x) := by rw [neg_one_mul, neg_neg] + rw [hx'] + exact isUnit_neg_one.isPrimal.mul hneg + +/-- An irreducible omnific integer that is not an ordinary integer is prime. -/ +theorem prime_of_irreducible_of_not_isOrdinaryInteger (x : Surreal.OmnificInteger.{u}) + (hirr : Irreducible x) (hx : ¬ IsOrdinaryInteger x) : Prime x := + hirr.prime_of_isPrimal (isPrimal_of_irreducible_of_not_isOrdinaryInteger x hirr hx) + +/-- An irreducible ordinary integer is prime in the omnific integers. -/ +theorem prime_of_irreducible_of_isOrdinaryInteger (x : Surreal.OmnificInteger.{u}) + (hirr : Irreducible x) (hx : IsOrdinaryInteger x) : Prime x := by + obtain ⟨z, hz⟩ := (isOrdinaryInteger_iff x).mp hx + have hxz : x = (z : Surreal.OmnificInteger.{u}) := Subtype.ext (by rw [hz]; simp) + rw [hxz] at hirr ⊢ + rw [← MulEquiv.prime_iff signedSmallSupportIntegerPartRingEquiv.{u}, map_intCast] + have hirr' : Irreducible (z : SignedSmallSupportIntegerPart.{u}) := by + rw [← map_intCast signedSmallSupportIntegerPartRingEquiv.{u}] + exact (MulEquiv.irreducible_iff (f := signedSmallSupportIntegerPartRingEquiv.{u})).mpr hirr + exact prime_intCast Surreal.realIntegerSubring realIntegerSubring_mem_iff + (irreducible_iff_prime.mp + (irreducible_int_of_irreducible_intCast Surreal.realIntegerSubring + realIntegerSubring_mem_iff hirr')) + +/-- **Every irreducible omnific integer is prime.** -/ +@[blueprint "thm:omnific-factorisation" + (phase := "Surreal numbers and omnific integers") + (title := "Irreducible omnific integers are prime") + (statement := /-- + Every irreducible element of $\mathbf{Oz}$ is prime in $\mathbf{Oz}$. + -/) + (proof := /-- + Let $x\in\mathbf{Oz}$ be irreducible. If $x$ is not an ordinary integer, the + factorisation at its leading Archimedean class shows that either $x$ or $-x$ + is reduced. The reduced element is primal by + \ref{thm:reduced-omnific-primal}; multiplication by $-1$ preserves primality, + so $x$ is primal and hence prime. If $x$ is an ordinary integer, its + irreducibility in $\mathbf{Oz}$ makes the corresponding integer irreducible in + $\mathbb Z$, hence a prime integer. Divisibility of integer constants in + $\mathbf{Oz}$ is detected by the ordinary integer constant coefficient, so + $x$ is prime in $\mathbf{Oz}$ in this case as well. + -/)] +theorem prime_of_irreducible (x : Surreal.OmnificInteger.{u}) (hirr : Irreducible x) : Prime x := by + by_cases hx : IsOrdinaryInteger x + · exact prime_of_irreducible_of_isOrdinaryInteger x hirr hx + · exact prime_of_irreducible_of_not_isOrdinaryInteger x hirr hx + +/-- Unique factorisation in the omnific integers: two factorisations of an omnific integer into +irreducibles agree up to order and units. -/ +theorem factorization_unique {f g : Multiset Surreal.OmnificInteger.{u}} + (hf : ∀ x ∈ f, Irreducible x) (hg : ∀ x ∈ g, Irreducible x) + (hfg : Associated f.prod g.prod) : + Multiset.Rel Associated f g := + prime_factors_unique (fun x hx ↦ prime_of_irreducible x (hf x hx)) + (fun x hx ↦ prime_of_irreducible x (hg x hx)) hfg + +end Surreal.OmnificInteger diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/OmnificIntegers.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/OmnificIntegers.lean new file mode 100644 index 0000000000..971c2a0e71 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/OmnificIntegers.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OrdinaryIntegers + +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ArchimedeanAssumptions + +/-! +# Every nonordinary reduced omnific integer is primal + +The leading-class transfer of [LM24, Prop. 9.2.2] reduces a nonordinary reduced omnific integer +to a reduced generalised power series with real exponents. Every such series is primal, and every +Archimedean stratum of the surreal exponent group is order-isomorphic to `ℝ` [LM24, +Prop. 2.4.3]. Hence every nonordinary reduced omnific integer is primal, and every irreducible one +is prime. +-/ + +public noncomputable section + +open Cardinal FiniteArchimedeanClass +open scoped HahnSeries NatOrdinal + +namespace Surreal.OmnificInteger + +universe u + +/-- Every nonordinary reduced omnific integer is primal. -/ +@[blueprint "thm:reduced-omnific-primal" + (phase := "Surreal numbers and omnific integers") + (title := "Primality of reduced omnific integers outside $\\mathbb Z$") + (statement := /-- + Let $x\in\mathbf{Oz}$ be an omnific integer whose underlying surreal + number is not equal to any integer. Write $s$ for its signed nonpositive + series representation. Suppose that $s$ is reduced: $s\ne0$ and, for + some Archimedean class $\sigma$, + \[ + \operatorname{supp}(s)\cap\operatorname{supp}(s-1) + \subseteq\{y:[y]=\sigma\}. + \] + Then $x$ is primal in $\mathbf{Oz}$. + -/) + (proof := /-- + By \ref{thm:signed-normal-form-omnific-integer-equivalence}, $x$ + corresponds to a bounded integer-part series $b$. Since $x$ is not an ordinary integer, the + underlying series of $b$ is nonzero and has nonzero order; reducedness + transfers from $s$ to $b$. At the leading Archimedean class of $b$, the + surreal exponent group satisfies $(A2)_\sigma$ by + \ref{fact:surreal-archimedean-ball-cofinality}, and its stratum is + order-isomorphic to $\mathbb R$ by + \ref{fact:surreal-archimedean-strata}. Hence + \ref{cor:reduced-hahn-integer-part-primal} makes $b$ primal. Transport + primality back through the ring equivalence. + -/)] +theorem isPrimal_of_isReduced + (x : Surreal.OmnificInteger.{u}) (hxInteger : ¬ IsOrdinaryInteger x) + (hxReduced : HahnSeries.Nonpositive.IsReduced x.toSignedNonpositiveHahn) : + IsPrimal x := by + let b : SignedSmallSupportIntegerPart.{u} := toSignedSmallSupportIntegerPart x + let hbOrder := boundedSignedHahn_order_ne_zero_of_not_isOrdinaryInteger x hxInteger + have himage : + HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom + Surreal.realIntegerSubring b = x.toSignedNonpositiveHahn := by + apply Subtype.ext + rw [HahnSeries.CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom, + coe_toSignedNonpositiveHahn] + exact coe_toSignedSmallSupportIntegerPart x + have hx0 : x ≠ 0 := by + intro hxzero + subst x + apply hxInteger + rw [isOrdinaryInteger_iff] + exact ⟨0, rfl⟩ + have hb0 : + HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom + Surreal.realIntegerSubring b ≠ 0 := by + rw [himage] + intro hxHahn + apply hx0 + apply Subtype.ext + apply Surreal.toSignedFullHahnSeries_injective + have hraw := congrArg (fun q : HahnSeries.Nonpositive Surreal ℝ ↦ + (q : HahnSeries Surreal ℝ)) hxHahn + rw [coe_toSignedNonpositiveHahn] at hraw + exact hraw.trans Surreal.toSignedFullHahnSeries_zero.symm + have hbReduced : HahnSeries.Nonpositive.IsReduced + (HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom + Surreal.realIntegerSubring b) := by + rw [himage] + exact hxReduced + let c := HahnSeries.Nonpositive.leadingClass + (HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom + Surreal.realIntegerSubring b) hbOrder + have hbPrimal : IsPrimal b := + HahnSeries.Nonpositive.isPrimal_of_isReduced_of_leadingClass_orderIso_real + Surreal.archimedeanStrata Surreal.realIntegerSubring b hb0 hbOrder hbReduced + (Surreal.assumptionA2AtFiniteClass Surreal.realIntegerSubring c) + (Surreal.stratumOrderAddMonoidIsoReal Surreal.archimedeanStrata c) + let E : Surreal.OmnificInteger.{u} ≃+* SignedSmallSupportIntegerPart.{u} := + signedSmallSupportIntegerPartRingEquiv + have hmap : IsPrimal (E x) := by + simpa only [E, signedSmallSupportIntegerPartRingEquiv_apply, b] using hbPrimal + exact (RingEquiv.isPrimal_iff E x).mp hmap + +/-- Every irreducible nonordinary reduced omnific integer is prime. -/ +theorem prime_of_irreducible_of_isReduced + (x : Surreal.OmnificInteger.{u}) (hirr : Irreducible x) + (hxInteger : ¬ IsOrdinaryInteger x) + (hxReduced : HahnSeries.Nonpositive.IsReduced x.toSignedNonpositiveHahn) : + Prime x := + hirr.prime_of_isPrimal (isPrimal_of_isReduced x hxInteger hxReduced) + +end Surreal.OmnificInteger diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/OrdinaryIntegers.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/OrdinaryIntegers.lean new file mode 100644 index 0000000000..d7c14828c7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/OrdinaryIntegers.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.CardinalIntegerPart +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.DegreeTransfer + +/-! +# Ordinary omnific integers + +An omnific integer is ordinary when it is an integer. A non-ordinary omnific integer has nonzero +lowest exponent in the signed Hahn orientation, and conversely; these are the hypotheses under +which the LM24 leading-class transfer applies. +-/ + +public noncomputable section + +open Cardinal FiniteArchimedeanClass +open scoped HahnSeries NatOrdinal + +namespace Surreal.OmnificInteger + +universe u + +/-- An omnific integer is ordinary when its underlying surreal is an integer. -/ +def IsOrdinaryInteger (x : Surreal.OmnificInteger.{u}) : Prop := + ∃ z : ℤ, x.1 = (z : Surreal) + +/-- Characterization of ordinary omnific integers by an integer witness. -/ +theorem isOrdinaryInteger_iff (x : Surreal.OmnificInteger.{u}) : + IsOrdinaryInteger x ↔ ∃ z : ℤ, x.1 = (z : Surreal) := + (Iff.rfl) + +/-- A non-ordinary omnific integer has nonzero order in the signed Hahn orientation. -/ +theorem signedFullHahnSeries_order_ne_zero_of_not_isOrdinaryInteger + (x : Surreal.OmnificInteger.{u}) (hx : ¬ IsOrdinaryInteger x) : + x.1.toSignedFullHahnSeries.order ≠ 0 := by + intro horder + have hsupport : x.1.toSignedFullHahnSeries.support ⊆ Set.Iic 0 := by + intro g hg + exact x.toSignedNonpositiveHahn.2 (by + simpa only [coe_toSignedNonpositiveHahn] using hg) + have hconstant : x.1.toSignedFullHahnSeries = + HahnSeries.C (x.1.toSignedFullHahnSeries.coeff 0) := by + ext g + rcases eq_or_ne g 0 with rfl | hg + · simp + · rw [HahnSeries.C_apply, HahnSeries.coeff_single_of_ne hg] + by_contra hcoeff + exact hg (le_antisymm (hsupport hcoeff) + (horder ▸ HahnSeries.order_le_of_coeff_ne_zero hcoeff)) + have hb := (HahnSeries.mem_cardSuppLTTruncationIntegerPart + (Z := Surreal.realIntegerSubring)).mp (toSignedSmallSupportIntegerPart x).2 + have hcoeff : x.1.toSignedFullHahnSeries.coeff 0 ∈ + Surreal.realIntegerSubring := by + rw [← coe_toSignedSmallSupportIntegerPart x] + exact hb.2 + rw [Surreal.mem_realIntegerSubring] at hcoeff + obtain ⟨z, hz⟩ := hcoeff + apply hx + rw [isOrdinaryInteger_iff] + refine ⟨z, ?_⟩ + apply Surreal.toSignedFullHahnSeries_injective + calc + x.1.toSignedFullHahnSeries = + HahnSeries.C (x.1.toSignedFullHahnSeries.coeff 0) := hconstant + _ = HahnSeries.single 0 (x.1.toSignedFullHahnSeries.coeff 0) := by + ext g + rw [HahnSeries.C_apply] + _ = HahnSeries.single 0 (z : ℝ) := by rw [hz] + _ = ((z : Surreal).toSignedFullHahnSeries) := by + simpa using (Surreal.toSignedFullHahnSeries_realCast (z : ℝ)).symm + +/-- An omnific integer whose signed Conway normal form has nonzero order is not an ordinary +integer. -/ +theorem not_isOrdinaryInteger_of_signedFullHahnSeries_order_ne_zero + (x : Surreal.OmnificInteger.{u}) (horder : x.1.toSignedFullHahnSeries.order ≠ 0) : + ¬ IsOrdinaryInteger x := by + rintro ⟨z, hz⟩ + apply horder + have hcast : x.1.toSignedFullHahnSeries = HahnSeries.single 0 (z : ℝ) := by + rw [hz] + simpa using Surreal.toSignedFullHahnSeries_realCast (z : ℝ) + rw [hcast] + rcases eq_or_ne (z : ℝ) 0 with hz0 | hz0 + · rw [hz0, HahnSeries.single_eq_zero, HahnSeries.order_zero] + · exact HahnSeries.order_single hz0 + +/-- The bounded signed Hahn image of a non-ordinary omnific integer has nonzero order. -/ +theorem boundedSignedHahn_order_ne_zero_of_not_isOrdinaryInteger + (x : Surreal.OmnificInteger.{u}) (hx : ¬ IsOrdinaryInteger x) : + ((HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom + Surreal.realIntegerSubring (toSignedSmallSupportIntegerPart x) : + HahnSeries.Nonpositive Surreal ℝ) : HahnSeries Surreal ℝ).order ≠ 0 := by + rw [HahnSeries.CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom, + coe_toSignedSmallSupportIntegerPart] + exact signedFullHahnSeries_order_ne_zero_of_not_isOrdinaryInteger x hx + +end Surreal.OmnificInteger diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/ZFC.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/ZFC.lean new file mode 100644 index 0000000000..68f8ade7ae --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/ZFC.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificInteger +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificCodes +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Reduced +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.IrreducibleOmnificIntegers +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.FiniteClasses + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage + +/-! +# Factorisation in the class presentation of the omnific integers + +The cut-preserving ring equivalence carries factors and divisibility witnesses in both directions. +Consequently the factorisation conclusions hold for the proper-class presentation as well. +-/ + +universe u + +public noncomputable section + +namespace ZFSet.Surreal.OmnificInteger + +/-- An ordinary omnific class value is an integer cast. -/ +def IsOrdinaryInteger (x : OmnificInteger.{u}) : Prop := ∃ z : ℤ, x = z + +/-- Ordinary integers agree in the class and library presentations. -/ +theorem isOrdinaryInteger_iff (x : OmnificInteger.{u}) : + x.IsOrdinaryInteger ↔ _root_.Surreal.OmnificInteger.IsOrdinaryInteger (ringEquiv x) := by + rw [IsOrdinaryInteger, _root_.Surreal.OmnificInteger.isOrdinaryInteger_iff] + constructor + · rintro ⟨z, rfl⟩ + exact ⟨z, by simp⟩ + · rintro ⟨z, hz⟩ + refine ⟨z, ringEquiv.injective ?_⟩ + rw [map_intCast] + exact Subtype.ext hz + +/-- Every irreducible omnific class value is prime. -/ +theorem prime_of_irreducible (x : OmnificInteger.{u}) (hx : Irreducible x) : Prime x := + (MulEquiv.prime_iff ringEquiv).1 + (_root_.Surreal.OmnificInteger.prime_of_irreducible (ringEquiv x) + ((MulEquiv.irreducible_iff ringEquiv).2 hx)) + +/-- Two finite factorisations into irreducible class values agree up to order and units. -/ +theorem factorization_unique {f g : Multiset OmnificInteger.{u}} + (hf : ∀ x ∈ f, Irreducible x) (hg : ∀ x ∈ g, Irreducible x) + (hfg : Associated f.prod g.prod) : + Multiset.Rel Associated f g := + prime_factors_unique (fun x hx ↦ prime_of_irreducible x (hf x hx)) + (fun x hx ↦ prime_of_irreducible x (hg x hx)) hfg + +/-- Every reduced, nonordinary omnific class value is primal. -/ +theorem isPrimal_of_isReduced (x : OmnificInteger.{u}) (hx : ¬x.IsOrdinaryInteger) + (hred : ZFSet.Surreal.IsReduced (x : ZFSet.Surreal.{u})) : IsPrimal x := + (RingEquiv.isPrimal_iff ringEquiv x).1 + (_root_.Surreal.OmnificInteger.isPrimal_of_isReduced (ringEquiv x) + (fun h ↦ hx ((isOrdinaryInteger_iff x).2 h)) + ((isReduced_iff_toSignedNonpositiveHahn x).1 hred)) + +/-- A nonzero omnific class value meeting finitely many support classes is primal. -/ +theorem isPrimal_of_hasFiniteSupportClasses (x : OmnificInteger.{u}) (_hx : x ≠ 0) + (hfinite : ZFSet.Surreal.HasFiniteSupportClasses (x : ZFSet.Surreal.{u})) : IsPrimal x := by + apply (RingEquiv.isPrimal_iff ringEquiv x).1 + apply _root_.Surreal.OmnificInteger.isPrimal_of_supportArchimedeanClasses_finite + rw [_root_.Surreal.OmnificInteger.supportArchimedeanClasses_toSignedNonpositiveHahn, + ringEquiv_apply, coe_toOmnificInteger] + exact (ZFSet.Surreal.hasFiniteSupportClasses_iff_toSurreal _).1 hfinite + + +end ZFSet.Surreal.OmnificInteger + +namespace ZFSet.OmnificCode + +/-- Every irreducible omnific set code is prime, with no restriction on factor codes. -/ +theorem isPrime_of_isIrreducible (x : OmnificCode.{u}) (hx : x.IsIrreducible) : x.IsPrime := + (isPrime_iff x).2 (_root_.Surreal.OmnificInteger.prime_of_irreducible x.value + ((isIrreducible_iff x).1 hx)) + +end ZFSet.OmnificCode diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Refinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Refinement.lean new file mode 100644 index 0000000000..4980b34c0e --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Refinement.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Refinement.ConwayRefinement + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Refinement/ConwayRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Refinement/ConwayRefinement.lean new file mode 100644 index 0000000000..ea3f57cbce --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Refinement/ConwayRefinement.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.LimitTailPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.CardinalIntegerPart +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.RefinementConjecture +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RationalTailQuotient + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Conway's refinement conjecture for omnific integers + +The signed Conway normal form identifies the omnific integers with the cardinal-bounded +generalised-power-series integer part over the integer subring of the reals. Finite support-class +primality and the common-tail theorem prove that this integer part is pre-Schreier. Transporting +through signed normal form gives Conway's four-factor refinement theorem. +-/ + +open Cardinal FiniteArchimedeanClass +open HahnSeries.CardSuppLTTruncationIntegerPart + +universe u + +public noncomputable section + +namespace Surreal.OmnificInteger + +private theorem small_of_card_lt_smallSupportCardinal + {S : Set (FiniteArchimedeanClass Surreal.{u})} + (hS : #S < Surreal.smallSupportCardinal.{u}) : Small.{u} S := by + rw [Cardinal.small_iff_lift_mk_lt_univ, Cardinal.lift_id] + rw [Surreal.smallSupportCardinal_eq_univ] at hS + exact hS + +/-- Every element of the signed bounded Hahn integer part corresponding to the omnific integers +is primal. -/ +@[blueprint "thm:surreal-hahn-integer-part-primality" + (phase := "Surreal numbers and omnific integers") + (title := "Primality of the surreal Hahn integer part") + (statement := /-- + Every element of + \[ + \mathbb Z+\mathbb R((\mathbf{No}_u^{<0}))_{\kappa_u} + \] + is primal, where $\kappa_u$ is the universe cardinal. + -/) + (proof := /-- + The two Archimedean hypotheses follow from + \ref{fact:surreal-archimedean-strata} and + \ref{fact:surreal-archimedean-ball-cofinality}. Therefore + \ref{thm:finite-support-classes-primality} handles series whose support + meets finitely many Archimedean classes. For a small limit family, the + quotient by its common tail is Cauchy complete by + \ref{lem:surreal-common-tail-quotient-complete}. The common tail has + the required fraction-field property by + \ref{thm:surreal-common-tail-integer-part-fraction-field}. Finally, + \ref{thm:limit-tail-primality} proves primality for arbitrary support-class + order type. + -/)] +theorem signedSmallSupportIntegerPart_isPrimal + (a : SignedSmallSupportIntegerPart.{u}) : IsPrimal a := by + apply isPrimal_of_finite_classes_and_limit_tail_conditions Surreal.realIntegerSubring + · intro y hy + apply HahnSeries.Nonpositive.isPrimal_of_supportArchimedeanClasses_finite + Surreal.realIntegerSubring Surreal.archimedeanStrata + (fun c ↦ ⟨Surreal.stratumOrderAddMonoidIsoReal Surreal.archimedeanStrata c⟩) + (Surreal.assumptionA2AtFiniteClass Surreal.realIntegerSubring) y + rw [supportArchimedeanClasses_toNonpositiveRingHom] + exact hy + · intro T hTne hTlimit hTcard + letI : Small.{u} T := small_of_card_lt_smallSupportCardinal hTcard + letI : Nonempty T := Set.nonempty_coe_sort.mpr hTne + exact ⟨Surreal.completeSpace_rationalTailQuotient T hTlimit⟩ + · intro T _hTne hTlimit hTcard + letI : Small.{u} T := small_of_card_lt_smallSupportCardinal hTcard + exact Surreal.fracSubring_cardSuppLTTruncationIntegerPart_tailSubmodule_eq_top + Surreal.realIntegerSubring T hTlimit + +/-- The signed bounded Hahn integer part corresponding to the omnific integers is pre-Schreier. -/ +theorem signedSmallSupportIntegerPart_decompositionMonoid : + DecompositionMonoid SignedSmallSupportIntegerPart.{u} := + ⟨signedSmallSupportIntegerPart_isPrimal⟩ + +/-- The omnific-integer subring has the four-factor refinement property. -/ +@[blueprint "thm:omnific-integer-refinement-property" + (phase := "Surreal numbers and omnific integers") + (title := "Refinement property of $\\mathbf{Oz}_u$") + (statement := /-- + If $a,b,c,d\in\mathbf{Oz}$ and $ab=cd$, then there are + $e,f,g,h\in\mathbf{Oz}$ such that + \[ + a=ef,\qquad b=gh,\qquad c=eg,\qquad d=fh. + \] + -/) + (proof := /-- + By \ref{thm:signed-normal-form-omnific-integer-equivalence}, + $\mathbf{Oz}_u$ is isomorphic to its bounded generalised-power-series + integer part. + By \ref{thm:surreal-hahn-integer-part-primality}, that integer part is + pre-Schreier and therefore has four-factor refinement. Transport the + refinement back through signed normal form. + -/)] +theorem conwayRefinement : ConwayRefinementConjecture.{u} := by + rw [conwayRefinementConjecture_def, ← hasFourFactorRefinement_def] + letI : DecompositionMonoid SignedSmallSupportIntegerPart.{u} := + signedSmallSupportIntegerPart_decompositionMonoid + exact signedSmallSupportIntegerPartRingEquiv.toMulEquiv.hasFourFactorRefinement_iff.mpr + hasFourFactorRefinement_of_decompositionMonoid + +end Surreal.OmnificInteger diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/RefinementConjecture.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/RefinementConjecture.lean new file mode 100644 index 0000000000..5ceb8a0482 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/RefinementConjecture.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement + +/-! +# Conway's four-factor refinement conjecture + +This file states the second conjecture on omnific integers from *On Numbers and Games*, page 46, +and LM24, Conjecture 1.1.1(2). There are no nonzero hypotheses: every equality `a * b = c * d` +must have factors `e`, `f`, `g`, and `h` satisfying the four displayed equations. + +The four inputs and four witnesses range over `Surreal.OmnificInteger.{u}`. The class presentation +by set-coded Conway cuts, modulo Conway equivalence, gives an equivalent formula in Mathlib's +ZFC model; the comparison is proved in +`ConwayRefinement.Surreal.ZFC.Refinement`. Its universe parameter is the universe +of sets in that model, not a bound on the allowed option sets within it. + +-/ + +universe u + +public section + +/-- The fixed-universe four-factor refinement conjecture for omnific integers. -/ +def ConwayRefinementConjecture : Prop := + HasFourFactorRefinement Surreal.OmnificInteger.{u} + +/-- The four equations in the fixed-universe refinement conjecture. -/ +theorem conwayRefinementConjecture_def : + ConwayRefinementConjecture.{u} ↔ + ∀ a b c d : Surreal.OmnificInteger.{u}, a * b = c * d → + ∃ e f g h : Surreal.OmnificInteger.{u}, + a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h := + hasFourFactorRefinement_def diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests.lean new file mode 100644 index 0000000000..eafd52f005 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests.lean @@ -0,0 +1,14 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.Basic +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.ConwayRefinement +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.DegreeTwoOzPrime +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.FiniteClasses +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.ZFC + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/Basic.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/Basic.lean new file mode 100644 index 0000000000..c08a5d5317 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/Basic.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.RefinementConjecture +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Ordinal + +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Ordinal +import Mathlib.Algebra.Order.Ring.Cast + +/-! +# API checks for omnific integers + +This file checks the public fixed-point and subring interfaces from a separate module. The ordinary +integer `2` is only an interface smoke test. The semantic checks prove that `ω - 1` belongs to the +carrier but is not the image of an ordinary integer, and that `2⁻¹` does not belong to the +carrier. Together, the latter checks distinguish Conway's carrier from both the ordinary integers +and all surreal numbers. +-/ + +universe u + +public noncomputable section + +namespace Tests + +open Surreal + +/-- Interface smoke test: addition in the predicate proves that `2` is an omnific integer. -/ +theorem two_mem_omnificIntegers : + (2 : Surreal.{u}) ∈ omnificIntegers := by + apply mem_omnificIntegers.mpr + rw [← one_add_one_eq_two] + exact isOmnificInteger_one.add isOmnificInteger_one + +/-- For `2`, subring membership reduces to Conway's fixed-point equation. -/ +theorem two_mem_omnificIntegers_iff_cut : + (2 : Surreal.{u}) ∈ omnificIntegers ↔ + (2 : Surreal.{u}) = omnificIntegerCut 2 := + mem_omnificIntegers.trans isOmnificInteger_iff + +/-- The ordinal `ω`, embedded in the surreal numbers, is an omnific integer. -/ +theorem omega_mem_omnificIntegers : + (NatOrdinal.of Ordinal.omega0).toSurreal ∈ omnificIntegers := + NatOrdinal.toSurreal_mem_omnificIntegers _ + +/-- The omnific integer `ω - 1` is larger than every embedded natural number. -/ +theorem natCast_lt_omega_sub_one (n : ℕ) : + (n : Surreal.{u}) < (NatOrdinal.of Ordinal.omega0).toSurreal - 1 := by + rw [lt_sub_iff_add_lt] + rw [← NatOrdinal.toSurreal_natCast n, ← NatOrdinal.toSurreal_one, + ← NatOrdinal.toSurreal_add] + apply NatOrdinal.toSurreal.strictMono + simpa using NatOrdinal.natCast_lt_omega0 (n + 1) + +/-- The omnific integer `ω - 1` is larger than every embedded ordinary integer. -/ +theorem intCast_lt_omega_sub_one (z : ℤ) : + (z : Surreal.{u}) < (NatOrdinal.of Ordinal.omega0).toSurreal - 1 := by + apply lt_of_le_of_lt (b := (z.natAbs : Surreal.{u})) + · simpa using + (Int.cast_mono (R := Surreal.{u}) (Int.le_natAbs : z ≤ z.natAbs)) + · exact natCast_lt_omega_sub_one z.natAbs + +/-- The surreal number `ω - 1` belongs to the omnific-integer subring. -/ +theorem omega_sub_one_mem_omnificIntegers : + (NatOrdinal.of Ordinal.omega0).toSurreal - 1 ∈ omnificIntegers := by + apply mem_omnificIntegers.mpr + exact (NatOrdinal.isOmnificInteger_toSurreal _).add isOmnificInteger_one.neg + +/-- The omnific integer `ω - 1` is not the image of an ordinary integer. -/ +theorem omega_sub_one_ne_intCast (z : ℤ) : + (NatOrdinal.of Ordinal.omega0).toSurreal - 1 ≠ (z : Surreal.{u}) := + (intCast_lt_omega_sub_one z).ne' + +/-- The surreal number `2⁻¹` does not belong to the omnific-integer subring. -/ +theorem two_inv_not_mem_omnificIntegers : + (2 : Surreal.{u})⁻¹ ∉ omnificIntegers := + Surreal.two_inv_not_mem_omnificIntegers + +/-- The refinement conjecture includes product equalities involving zero. -/ +theorem conwayRefinementConjecture_zero_product + (hC : ConwayRefinementConjecture.{u}) {a b : OmnificInteger.{u}} (hab : a * b = 0) : + ∃ e f g h : OmnificInteger.{u}, + a = e * f ∧ b = g * h ∧ (0 : OmnificInteger.{u}) = e * g ∧ 0 = f * h := by + apply conwayRefinementConjecture_def.mp hC a b 0 0 + simpa using hab + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/ConwayRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/ConwayRefinement.lean new file mode 100644 index 0000000000..b5e25ffdfd --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/ConwayRefinement.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinementProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayNormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Ordinal + +/-! +# Checks for the native Conway target + +The cut-defined carrier excludes one half, separating it from the entire surreal field. +The public equivalence exposes native subring divisibility. The zero-input certificate ensures +that the standalone statement does not silently exclude the cancellation boundary. +-/ + +public noncomputable section + +universe u + +namespace Tests.Conway + +open ConwayRefinement.Standalone.Oz + +/-- The target's carrier is not the whole field of surreal numbers. -/ +theorem half_not_in_carrier : ¬ IsConwayOmnificInteger ((2 : Surreal.{u})⁻¹) := by + rw [isConwayOmnificInteger_iff_mem] + exact Surreal.two_inv_not_mem_omnificIntegers + +/-- The carrier includes an actual infinite omnific integer, so it is not just the integers. -/ +theorem omega_in_carrier : + IsConwayOmnificInteger (NatOrdinal.of Ordinal.omega0).toSurreal ∧ + ∀ n : ℕ, (n : Surreal.{u}) < (NatOrdinal.of Ordinal.omega0).toSurreal := by + refine ⟨isConwayOmnificInteger_iff_mem.mpr (NatOrdinal.toSurreal_mem_omnificIntegers _), ?_⟩ + intro n + rw [← NatOrdinal.toSurreal_natCast n] + exact NatOrdinal.toSurreal.strictMono (NatOrdinal.natCast_lt_omega0 n) + +/-- The endpoint uses divisibility in the actual omnific subring. -/ +theorem native_endpoint (h : ConwayConjecture.{u}) (b : Surreal.OmnificInteger.{u}) : + IsPrimal b := conwayConjecture_iff_forall_isPrimal.mp h b + +/-- A zero top row remains within the standalone conjecture's quantifiers. -/ +theorem zero_row (h : ConwayConjecture.{u}) : + ∃ e f g h : Surreal.{u}, + IsConwayOmnificInteger e ∧ IsConwayOmnificInteger f ∧ + IsConwayOmnificInteger g ∧ IsConwayOmnificInteger h ∧ + 0 = e * f ∧ 3 = g * h ∧ 0 = e * g ∧ 2 = f * h := by + have hz : IsConwayOmnificInteger (0 : Surreal.{u}) := + isConwayOmnificInteger_iff_mem.mpr (Subring.zero_mem _) + exact h 0 3 0 2 hz + (isConwayOmnificInteger_iff_mem.mpr ((3 : Surreal.OmnificInteger).2)) hz + (isConwayOmnificInteger_iff_mem.mpr ((2 : Surreal.OmnificInteger).2)) (by simp) + +end Tests.Conway diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/DegreeTwoOzPrime.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/DegreeTwoOzPrime.lean new file mode 100644 index 0000000000..8d02780882 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/DegreeTwoOzPrime.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrimeProof + +/-! +# API checks for the explicit degree-two prime + +This separately compiled client consumes only the public standalone statement/proof boundary. It +checks the literal prime, the coefficient-doubled reducible foil, their exact common support order +type, and the support equality that makes the comparison mathematically sharp, in the surreal +numbers of an arbitrary universe. +-/ + +universe u + +public noncomputable section + +namespace Tests.DegreeTwoOz + +open ConwayRefinement.Standalone.Oz.DegreeTwoExample + +/-- The literal coefficient-one normal form is certified prime. -/ +example : Prime degreeTwoOz.{u} := + IsPrime.proof + +/-- Its Conway support has exact order type `ω² + 1`. -/ +example : HasExactSupportOrderType.{u} := + HasExactSupportOrderType.proof + +/-- The coefficient-doubled comparison has the same exact order type. -/ +example : FoilHasExactSupportOrderType.{u} := + FoilHasExactSupportOrderType.proof + +/-- The comparison element has an explicit factorisation into two nonunits. -/ +example : FoilHasNontrivialFactorization.{u} := + FoilHasNontrivialFactorization.proof + +/-- The prime and reducible foil have literally equal Conway supports. -/ +example : degreeTwoFoil.{u}.1.support = degreeTwoOz.1.support := + degreeTwoFoil_support + +/-- The two normal forms differ; their constant coefficients are two and one. -/ +theorem degreeTwoFoil_ne_degreeTwoOz : degreeTwoFoil.{u} ≠ degreeTwoOz := by + intro h + have hcoeff := congrArg + (fun q : ConwayRefinement.Standalone.Oz.OmnificInteger.{u} ↦ q.1.coeff 0) h + rw [degreeTwoFoil_val, degreeTwoOz_val, two_mul] at hcoeff + rw [SurrealHahnSeries.coeff_add_apply, normalForm_coeff_zero] at hcoeff + norm_num at hcoeff + +end Tests.DegreeTwoOz diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/FiniteClasses.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/FiniteClasses.lean new file mode 100644 index 0000000000..e9456d78f6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/FiniteClasses.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.FiniteClasses +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowPrime + +/-! +# A downstream client of finite-class omnific primality + +Conway's one-row omnific integer has support order type `ω + 1`, so this client uses a genuinely +infinite support. Its reducedness supplies the finite support-class hypothesis. The stronger +prime theorem for this example is not used to obtain the primality conclusion here. +-/ + +public noncomputable section + +namespace Tests + +open Surreal.OmnificInteger.OneRowExample + +/-- The infinite Conway normal form meets finitely many classes, in the same orientation as +the paper's hypothesis. -/ +theorem oneRow_normalForm_classes_finite : + (ArchimedeanClass.mk '' (oneRowOz : Surreal).support).Finite := by + rw [← Surreal.OmnificInteger.supportArchimedeanClasses_toSignedNonpositiveHahn] + exact oneRowOz_isReduced.supportArchimedeanClasses_finite + +/-- The one-row omnific integer is primal by the finite-class theorem. -/ +theorem oneRow_primal_of_finite_classes : IsPrimal oneRowOz := + Surreal.OmnificInteger.isPrimal_of_supportArchimedeanClasses_finite oneRowOz + oneRowOz_isReduced.supportArchimedeanClasses_finite + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/NormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/NormalForm.lean new file mode 100644 index 0000000000..e1da3eece8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/NormalForm.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.NormalForm + +/-! +# Checks for Conway normal forms of omnific integers + +The positive example `ω + 3` has both a genuinely positive exponent and a nonzero integral +constant coefficient, so it excludes the degenerate pure-constant and zero cases. The negative +monomial `ω⁻¹` separates the intended nonnegative-support criterion from the nearby wrong +definition that permits arbitrary exponents with an integral constant coefficient. +-/ + +universe u + +noncomputable section + +public section + +namespace Tests + +open Set Surreal + +/-- The monomial `ω` satisfies the normal-form criterion for omnific integers. -/ +theorem omega_isOmnificInteger : + IsOmnificInteger (ω^ (1 : Surreal.{u})) := by + rw [isOmnificInteger_iff_normalForm] + constructor + · simp + · simp + +/-- The nonconstant surreal `ω + 3` is an omnific integer. -/ +theorem omega_add_three_isOmnificInteger : + IsOmnificInteger (ω^ (1 : Surreal.{u}) + 3) := + omega_isOmnificInteger.add (IsOmnificInteger.natCast 3) + +/-- The nonconstant check has the expected integral coefficient at exponent zero. -/ +theorem omega_add_three_coeff_zero : + (ω^ (1 : Surreal.{u}) + 3).coeff 0 = 3 := by + have homega : + (ω^ (1 : Surreal.{u})).toHahnSeries.coeff 0 = 0 := by + rw [toHahnSeries_wpow, + SurrealHahnSeries.coeff_single_of_ne (by norm_num)] + have hthree : (3 : Surreal.{u}).toHahnSeries.coeff 0 = 3 := by + calc + (3 : Surreal.{u}).toHahnSeries.coeff 0 = + (SurrealHahnSeries.single 0 3).coeff 0 := + congrArg (fun q : SurrealHahnSeries ↦ q.coeff 0) + (toHahnSeries_natCast 3) + _ = 3 := SurrealHahnSeries.coeff_single_self 0 3 + calc + (ω^ (1 : Surreal.{u}) + 3).coeff 0 = + (ω^ (1 : Surreal.{u}) + 3).toHahnSeries.coeff 0 := + congrFun (coeff_toHahnSeries _).symm 0 + _ = ((ω^ (1 : Surreal.{u})).toHahnSeries + + (3 : Surreal.{u}).toHahnSeries).coeff 0 := by + rw [toHahnSeries_add] + _ = (ω^ (1 : Surreal.{u})).toHahnSeries.coeff 0 + + (3 : Surreal.{u}).toHahnSeries.coeff 0 := + SurrealHahnSeries.coeff_add_apply _ _ _ + _ = 3 := by rw [homega, hthree, zero_add] + +/-- A negative monomial is not an omnific integer. -/ +theorem wpow_neg_one_not_isOmnificInteger : + ¬IsOmnificInteger (ω^ (-1 : Surreal.{u})) := by + rw [isOmnificInteger_iff_normalForm] + rintro ⟨hsupport, _⟩ + have hnonnegative : (0 : Surreal.{u}) ≤ -1 := hsupport (by + rw [support_wpow] + exact mem_singleton _) + norm_num at hnonnegative + +/-- The unit gap makes two sufficiently close omnific integers equal. -/ +example {x y : Surreal.{u}} (hx : IsOmnificInteger x) (hy : IsOmnificInteger y) + (hbound : x - y ∈ Ioo (-1) 1) : x = y := + hx.eq_of_sub_mem_Ioo_neg_one_one hy hbound + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/ZFC.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/ZFC.lean new file mode 100644 index 0000000000..19eb808a10 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests/ZFC.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.ZFC +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.ZFCDegreeTwoPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Properness +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Refinement + +/-! +# Certificates for factorisation over the class of omnific codes + +The explicit degree-two example supplies an irreducible code with infinite support, so the +irreducible-to-prime implication is not vacuous and does not describe only ordinary integers. +The zero and unit cases check the public factorisation predicates. The remaining certificates +check the exported conclusions for native class values and their normal forms. +-/ + +universe u + +public noncomputable section + +namespace Tests.ZFC + +open ZFSet + +/-- A nonordinary, infinite-support irreducible code exercises the class-wide prime theorem. -/ +theorem exists_degreeTwo_prime_code : + ∃ c : OmnificCode.{u}, + c.value = _root_.Surreal.OmnificInteger.DegreeTwoExample.degreeTwoOz ∧ + c.IsIrreducible ∧ c.IsPrime := by + obtain ⟨c, hc⟩ := OmnificCode.value_surjective + _root_.Surreal.OmnificInteger.DegreeTwoExample.degreeTwoOz.{u} + have hp : Prime c.value := by + rw [hc] + exact _root_.Surreal.OmnificInteger.DegreeTwoExample.degreeTwoOz_prime + have hi := (OmnificCode.isIrreducible_iff c).2 hp.irreducible + exact ⟨c, hc, hi, OmnificCode.isPrime_of_isIrreducible c hi⟩ + +example : ¬(0 : OmnificCode.{u}).IsPrime := by + simp [OmnificCode.isPrime_iff] + +example : ¬(1 : OmnificCode.{u}).IsIrreducible := by + simp [OmnificCode.isIrreducible_iff] + +example : (1 : OmnificCode.{u}).IsUnit := by + simp [OmnificCode.isUnit_iff] + +example : OmnificCode.Divides (0 : OmnificCode.{u}) 0 := by + simp [OmnificCode.divides_iff] + +example : ¬OmnificCode.Divides (0 : OmnificCode.{u}) 1 := by + simp [OmnificCode.divides_iff] + +example (z : ZFSet.{u}) (h : IsGameCode z) + (hz : (GameCode.mk z h).IsOmnificInteger) + (hi : (⟨GameCode.mk z h, hz⟩ : OmnificCode.{u}).IsIrreducible) : + (⟨GameCode.mk z h, hz⟩ : OmnificCode.{u}).IsPrime := + OmnificCode.isPrime_of_isIrreducible _ hi + +example : ∀ s : ZFSet.{u}, omnificGameCodes ≠ Class.ofSet s := + omnificGameCodes_ne_ofSet + +example (x : ZFSet.Surreal.OmnificInteger.{u}) (hx : Irreducible x) : Prime x := + ZFSet.Surreal.OmnificInteger.prime_of_irreducible x hx + +example (x : ZFSet.Surreal.OmnificInteger.{u}) (hx : x ≠ 0) + (hf : ZFSet.Surreal.HasFiniteSupportClasses (x : ZFSet.Surreal.{u})) : IsPrimal x := + ZFSet.Surreal.OmnificInteger.isPrimal_of_hasFiniteSupportClasses x hx hf + +example (x : ZFSet.Surreal.OmnificInteger.{u}) + (hx : ¬x.IsOrdinaryInteger) (hr : ZFSet.Surreal.IsReduced (x : ZFSet.Surreal.{u})) : + IsPrimal x := + ZFSet.Surreal.OmnificInteger.isPrimal_of_isReduced x hx hr + +open ZFSet.Surreal.OmnificInteger.DegreeTwoExample + +example : + ZFSet.Surreal.toHahnSeries (degreeTwoOz.{u} : ZFSet.Surreal.{u}) = + _root_.Surreal.OmnificInteger.DegreeTwoExample.normalForm := + degreeTwoOz_toHahnSeries + +example (x : ZFSet.Surreal.OmnificInteger.{u}) : + ZFSet.Surreal.toHahnSeries (x : ZFSet.Surreal.{u}) = + _root_.Surreal.OmnificInteger.DegreeTwoExample.normalForm ↔ x = degreeTwoOz := + toHahnSeries_eq_normalForm_iff x + +example : + (ZFSet.Surreal.toHahnSeries (degreeTwoOz.{u} : ZFSet.Surreal.{u})).length = + Ordinal.omega0 ^ (2 : Ordinal) + 1 := + degreeTwoOz_length + +example : ZFSet.Surreal.IsReduced (degreeTwoOz.{u} : ZFSet.Surreal.{u}) := + degreeTwoOz_isReduced + +example : Prime degreeTwoOz.{u} := degreeTwoOz_prime + +example : ZFSet.Surreal.OmnificInteger.RefinementConjecture.{u} ↔ + ConwayRefinementConjecture.{u} := + ZFSet.Surreal.OmnificInteger.refinementConjecture_iff + +end Tests.ZFC diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/RationalTailQuotient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/RationalTailQuotient.lean new file mode 100644 index 0000000000..e12c0ccfd0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/RationalTailQuotient.lean @@ -0,0 +1,322 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ConvexQuotientSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.CutFilling +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealModule +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportArchimedeanClasses +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedAddGroup +public import Mathlib.Algebra.Algebra.Rat +public import Mathlib.Algebra.Order.Module.Rat +public import Mathlib.Topology.Algebra.IsUniformGroup.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Rational tail quotients of the surreals + +For a family of finite Archimedean classes, its common tail is a rational subspace of the +surreals. Quotienting by that subspace gives the usual ordered tail quotient together with its +native rational-vector-space structure. At a nonempty limit family, the quotient is Cauchy +complete for its additive uniformity: the canonical representatives of the family are a small +positive coinitial family, and surreal simplicity fills every cut indexed by that family. + +This presentation is used when a small closed rational subspace of the tail quotient must be +formed. Its additive subgroup is exactly the tail kernel used by the older additive presentation. +-/ + +open Set + +universe u + +public noncomputable section + +namespace Surreal + +/-- The quotient by the rational subspace underlying a family of Archimedean tails. -/ +abbrev RationalTailQuotient (T : Set (FiniteArchimedeanClass Surreal.{u})) := + Surreal.{u} ⧸ FiniteArchimedeanClass.tailSubmodule ℚ T + +noncomputable instance rationalTailQuotientLinearOrder + (T : Set (FiniteArchimedeanClass Surreal.{u})) : LinearOrder (RationalTailQuotient T) := + ConvexQuotient.instLinearOrder (H := + (FiniteArchimedeanClass.tailSubmodule ℚ T).toAddSubgroup) + +instance rationalTailQuotientIsOrderedAddMonoid + (T : Set (FiniteArchimedeanClass Surreal.{u})) : + IsOrderedAddMonoid (RationalTailQuotient T) := + ConvexQuotient.instIsOrderedAddMonoid (H := + (FiniteArchimedeanClass.tailSubmodule ℚ T).toAddSubgroup) + +instance rationalTailQuotientPosSMulMono + (T : Set (FiniteArchimedeanClass Surreal.{u})) : + PosSMulMono ℚ (RationalTailQuotient T) where + smul_le_smul_of_nonneg_left q hq x y hxy := by + change ∃ a b : Surreal.{u}, Submodule.Quotient.mk a = x ∧ + Submodule.Quotient.mk b = y ∧ a ≤ b at hxy + obtain ⟨a, b, ha, hb, hab⟩ := hxy + change ∃ a b : Surreal.{u}, Submodule.Quotient.mk a = q • x ∧ + Submodule.Quotient.mk b = q • y ∧ a ≤ b + refine ⟨q • a, q • b, ?_, ?_, smul_le_smul_of_nonneg_left hab hq⟩ + · simpa only [Submodule.Quotient.mk_smul] using congrArg (q • ·) ha + · simpa only [Submodule.Quotient.mk_smul] using congrArg (q • ·) hb + +instance rationalTailQuotientPosSMulStrictMono + (T : Set (FiniteArchimedeanClass Surreal.{u})) : + PosSMulStrictMono ℚ (RationalTailQuotient T) := + PosSMulMono.toPosSMulStrictMono + +/-- Absolute value commutes with projection to a rational tail quotient. -/ +theorem rationalTailQuotient_abs + (T : Set (FiniteArchimedeanClass Surreal.{u})) (x : Surreal.{u}) : + |(Submodule.Quotient.mk x : RationalTailQuotient T)| = Submodule.Quotient.mk |x| := by + rcases le_total 0 x with hx | hx + · have hxq : (0 : RationalTailQuotient T) ≤ Submodule.Quotient.mk x := by + rw [← Submodule.Quotient.mk_zero] + exact ConvexQuotient.mk_le_mk hx + rw [abs_of_nonneg hx, abs_of_nonneg hxq] + · have hxq : (Submodule.Quotient.mk x : RationalTailQuotient T) ≤ 0 := by + rw [← Submodule.Quotient.mk_zero] + exact ConvexQuotient.mk_le_mk hx + rw [abs_of_nonpos hx, abs_of_nonpos hxq, ← Submodule.Quotient.mk_neg] + +/-- A strict comparison of quotient Archimedean classes reflects to the chosen surreal +representatives. -/ +theorem archimedeanClass_mk_lt_of_rationalTailQuotient_mk_lt + (T : Set (FiniteArchimedeanClass Surreal.{u})) {x y : Surreal.{u}} + (h : ArchimedeanClass.mk (Submodule.Quotient.mk x : RationalTailQuotient T) < + ArchimedeanClass.mk (Submodule.Quotient.mk y : RationalTailQuotient T)) : + ArchimedeanClass.mk x < ArchimedeanClass.mk y := by + rw [ArchimedeanClass.mk_lt_mk] at h ⊢ + intro n + have hn := h n + have hn' : (Submodule.Quotient.mk (n • |y|) : RationalTailQuotient T) < + Submodule.Quotient.mk |x| := by + have heq : (Submodule.Quotient.mk (n • |y|) : RationalTailQuotient T) = + n • Submodule.Quotient.mk |y| := by + change QuotientAddGroup.mk' _ (n • |y|) = n • QuotientAddGroup.mk' _ |y| + exact map_nsmul (QuotientAddGroup.mk' _) n |y| + rw [heq] + simpa only [rationalTailQuotient_abs] using hn + exact ConvexQuotient.lt_of_mk_lt_mk hn' + +/-- Suppose a chosen quotient class is met by `S`, and every nonzero member of `W` lies outside +its quotient closed ball while retaining a class met by `S`. Then the nonzero support classes of +`W` form a strict initial segment of the support classes of `S`. -/ +theorem exists_nonzeroSupportClass_bound + (T : Set (FiniteArchimedeanClass Surreal.{u})) + (q : FiniteArchimedeanClass (RationalTailQuotient T)) + (S W : Set Surreal.{u}) + (hqocc : q.1 ∈ ArchimedeanClass.mk '' + (Submodule.Quotient.mk (p := FiniteArchimedeanClass.tailSubmodule ℚ T) '' S)) + (hW : ∀ g ∈ W, g ≠ 0 → + Submodule.Quotient.mk g ∉ FiniteArchimedeanClass.closedBallAddSubgroup q) + (hWocc : ∀ g ∈ W, g ≠ 0 → ArchimedeanClass.mk g ∈ ArchimedeanClass.mk '' S) : + ∃ c ∈ ArchimedeanClass.mk '' (S \ {0}), + ArchimedeanClass.mk '' (W \ {0}) ⊆ + (ArchimedeanClass.mk '' (S \ {0})) ∩ Set.Iio c := by + obtain ⟨yq, ⟨y, hyS, rfl⟩, hyq⟩ := hqocc + have hy0 : y ≠ 0 := by + intro hy + subst y + have hqtop : q.1 = ⊤ := by + rw [← hyq] + exact ArchimedeanClass.mk_eq_top_iff.mpr (Submodule.Quotient.mk_zero _) + exact q.2 hqtop + refine ⟨ArchimedeanClass.mk y, ⟨y, ⟨hyS, by simpa using hy0⟩, rfl⟩, ?_⟩ + rintro c ⟨g, ⟨hgW, hg0⟩, rfl⟩ + rw [Set.mem_singleton_iff] at hg0 + obtain ⟨z, hzS, hzg⟩ := hWocc g hgW hg0 + have hz0 : z ≠ 0 := by + intro hz + subst z + rw [ArchimedeanClass.mk_zero] at hzg + have hgtop : ArchimedeanClass.mk g = ⊤ := hzg.symm + exact hg0 (ArchimedeanClass.mk_eq_top_iff.mp hgtop) + refine ⟨⟨z, ⟨hzS, by simpa using hz0⟩, hzg⟩, ?_⟩ + have hgq : ArchimedeanClass.mk (Submodule.Quotient.mk g : RationalTailQuotient T) < + ArchimedeanClass.mk (Submodule.Quotient.mk y : RationalTailQuotient T) := by + apply ArchimedeanClass.mk_lt_of_not_mem_closedBallAddSubgroup + intro hmem + apply hW g hgW hg0 + apply FiniteArchimedeanClass.mem_closedBallAddSubgroup_iff.mpr + intro hgq0 + change q.1 ≤ ArchimedeanClass.mk (Submodule.Quotient.mk g : RationalTailQuotient T) + rw [← hyq] + exact ArchimedeanClass.mem_closedBallAddSubgroup_iff.mp hmem + exact archimedeanClass_mk_lt_of_rationalTailQuotient_mk_lt T hgq + +noncomputable instance rationalTailQuotientTopologicalSpace + (T : Set (FiniteArchimedeanClass Surreal.{u})) : + TopologicalSpace (RationalTailQuotient T) := + Preorder.topology (RationalTailQuotient T) + +instance rationalTailQuotientOrderTopology + (T : Set (FiniteArchimedeanClass Surreal.{u})) : + OrderTopology (RationalTailQuotient T) := + ⟨rfl⟩ + +instance rationalTailQuotientDenselyOrdered + (T : Set (FiniteArchimedeanClass Surreal.{u})) : + DenselyOrdered (RationalTailQuotient T) := by + constructor + intro a b hab + refine ⟨(2 : ℚ)⁻¹ • (a + b), ?_, ?_⟩ + · calc + a = (2 : ℚ)⁻¹ • (a + a) := by rw [smul_add, ← add_smul]; norm_num + _ < (2 : ℚ)⁻¹ • (a + b) := + smul_lt_smul_of_pos_left + (add_lt_add_left hab a |>.trans_eq (add_comm _ _)) (by norm_num) + · calc + (2 : ℚ)⁻¹ • (a + b) < (2 : ℚ)⁻¹ • (b + b) := + smul_lt_smul_of_pos_left + (by simpa [add_comm] using (add_lt_add_left hab b)) (by norm_num) + _ = b := by rw [smul_add, ← add_smul]; norm_num + +instance rationalTailQuotientIsTopologicalAddGroup + (T : Set (FiniteArchimedeanClass Surreal.{u})) : + IsTopologicalAddGroup (RationalTailQuotient T) where + toContinuousAdd := continuousAdd_of_orderTopology (RationalTailQuotient T) + toContinuousNeg := continuousNeg_of_orderTopology (RationalTailQuotient T) + +noncomputable instance rationalTailQuotientUniformSpace + (T : Set (FiniteArchimedeanClass Surreal.{u})) : + UniformSpace (RationalTailQuotient T) := + IsTopologicalAddGroup.rightUniformSpace (RationalTailQuotient T) + +instance rationalTailQuotientIsUniformAddGroup + (T : Set (FiniteArchimedeanClass Surreal.{u})) : + IsUniformAddGroup (RationalTailQuotient T) := + isUniformAddGroup_of_addCommGroup + +/-- Canonical positive scales in a rational tail quotient, indexed by a small copy of the +class family. -/ +def rationalTailQuotientScale + (T : Set (FiniteArchimedeanClass Surreal.{u})) [Small.{u} T] + (i : Shrink.{u} T) : + RationalTailQuotient T := + Submodule.Quotient.mk + (FiniteArchimedeanClass.positiveRepresentative ((equivShrink T).symm i).1) + +/-- The canonical quotient scale is represented by the positive representative of its class. -/ +@[simp] +theorem rationalTailQuotientScale_apply + (T : Set (FiniteArchimedeanClass Surreal.{u})) [Small.{u} T] + (i : Shrink.{u} T) : + rationalTailQuotientScale T i = Submodule.Quotient.mk + (FiniteArchimedeanClass.positiveRepresentative ((equivShrink T).symm i).1) := + (rfl) + +/-- At a limit family, every canonical tail-quotient scale is positive. -/ +theorem rationalTailQuotientScale_pos + (T : Set (FiniteArchimedeanClass Surreal.{u})) [Small.{u} T] + (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) (i : Shrink.{u} T) : + 0 < rationalTailQuotientScale T i := by + rw [← Submodule.Quotient.mk_zero] + apply ConvexQuotient.mk_lt_mk_iff.mpr + constructor + · exact FiniteArchimedeanClass.positiveRepresentative_pos _ + · intro hmem + have htail : FiniteArchimedeanClass.positiveRepresentative ((equivShrink T).symm i).1 ∈ + FiniteArchimedeanClass.tailKernel T := by + rw [← FiniteArchimedeanClass.tailSubmodule_toAddSubgroup ℚ T] + simpa using hmem + exact FiniteArchimedeanClass.positiveRepresentative_not_mem_tailKernel hT _ htail + +/-- The canonical scales are coinitial among the positive elements of the tail quotient. -/ +theorem exists_rationalTailQuotientScale_le + (T : Set (FiniteArchimedeanClass Surreal.{u})) [Small.{u} T] + {x : RationalTailQuotient T} (hx : 0 < x) : + ∃ i : Shrink.{u} T, rationalTailQuotientScale T i ≤ x := by + induction x using Submodule.Quotient.induction_on with + | H x => + have hxq : (Submodule.Quotient.mk (0 : Surreal.{u}) : RationalTailQuotient T) < + (Submodule.Quotient.mk x : RationalTailQuotient T) := by + simpa using hx + have hx0 : 0 < x := ConvexQuotient.lt_of_mk_lt_mk hxq + have hxH : x ∉ FiniteArchimedeanClass.tailKernel T := by + intro hmem + apply (ConvexQuotient.mk_lt_mk_iff.mp hxq).2 + have : x ∈ (FiniteArchimedeanClass.tailSubmodule ℚ T).toAddSubgroup := by + simpa only [FiniteArchimedeanClass.tailSubmodule_toAddSubgroup ℚ T] using hmem + simpa using this + rw [FiniteArchimedeanClass.mem_tailKernel_iff] at hxH + push Not at hxH + obtain ⟨c, hxc⟩ := hxH + refine ⟨equivShrink T c, ConvexQuotient.mk_le_mk ?_⟩ + apply (ArchimedeanClass.lt_of_mk_lt_mk_of_nonneg ?_ hx0.le).le + rw [FiniteArchimedeanClass.mk_positiveRepresentative] + simpa using hxc + +/-- The positive representatives of a limit family give a small coinitial family in its rational +tail quotient. -/ +@[blueprint "lem:surreal-common-tail-quotient-coinitial-scales" + (phase := "Surreal numbers and omnific integers") + (title := "A coinitial family of positive elements in surreal common-tail quotients") + (statement := /-- + Let $T$ be a $u$-small family of nonzero Archimedean classes of + $\mathbf{No}_u$ with no least member in the magnitude order. Index $T$ by + a $u$-small type $I$, and let $\varepsilon_i$ be the image in + $\mathbf{No}_u/H_T$ of the positive representative of the class indexed + by $i$. Then every $\varepsilon_i$ is positive, and for every $x>0$ in + the quotient there is $i\in I$ such that $\varepsilon_i\le x$. + -/) + (proof := /-- + A positive representative cannot lie in $H_T$: a later class in $T$ + excludes it from the common tail. Conversely, lift $x>0$ to a positive + surreal representative. Since that representative is not in $H_T$, its + Archimedean class lies above some member of $T$; the corresponding positive + representative therefore maps below $x$ in the quotient. + -/)] +theorem rationalTailQuotientScale_pos_and_coinitial + (T : Set (FiniteArchimedeanClass Surreal.{u})) [Small.{u} T] + (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) : + (∀ i : Shrink.{u} T, 0 < rationalTailQuotientScale T i) ∧ + ∀ x : RationalTailQuotient T, 0 < x → + ∃ i : Shrink.{u} T, rationalTailQuotientScale T i ≤ x := + ⟨rationalTailQuotientScale_pos T hT, fun _ hx ↦ exists_rationalTailQuotientScale_le T hx⟩ + +/-- A rational tail quotient at a nonempty limit family is Cauchy complete for its additive +uniformity. -/ +@[blueprint "lem:surreal-common-tail-quotient-complete" + (phase := "Surreal numbers and omnific integers") + (title := "Cauchy completeness of surreal common-tail quotients") + (statement := /-- + Let $T$ be a $u$-small nonempty family of nonzero Archimedean classes of + $\mathbf{No}_u$ with no least member in the magnitude order. The ordered + rational vector space obtained by quotienting $\mathbf{No}_u$ by the + common tail below $T$ is Cauchy complete in its additive uniformity. + -/) + (proof := /-- + By \ref{lem:surreal-common-tail-quotient-coinitial-scales}, a small copy + of $T$ indexes positive scales coinitial in the quotient, and rational + halving supplies the doubled-scale hypothesis of + \ref{lem:complete-of-coinitial-scales-and-cut-filling}. To fill a cut in + the quotient, \ref{lem:cut-filling-order-reflecting-surjection} lifts its + two small indexed families to surreal representatives. Strict order in a + convex quotient reflects to those representatives, so + \ref{thm:surreal-simplicity-small-cuts} fills the lifted cut inside + $\mathbf{No}_u$; the monotone quotient map sends the filler back between + the original families. The Cauchy-completeness criterion now applies. + -/)] +theorem completeSpace_rationalTailQuotient + (T : Set (FiniteArchimedeanClass Surreal.{u})) [Small.{u} T] [Nonempty T] + (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) : CompleteSpace (RationalTailQuotient T) := by + letI : Nonempty (Shrink.{u} T) := ⟨equivShrink T (Classical.arbitrary T)⟩ + obtain ⟨hpos, hcoinitial⟩ := rationalTailQuotientScale_pos_and_coinitial T hT + apply completeSpace_of_coinitial_of_exists_half (rationalTailQuotientScale T) + · exact hpos + · exact hcoinitial + · intro x hx + exact ⟨(2 : ℚ)⁻¹ • x, smul_pos (by norm_num) hx, by + rw [← add_smul] + norm_num⟩ + · exact FillsCuts.of_surjective (Submodule.Quotient.mk_surjective _) + (fun _ _ h ↦ ConvexQuotient.mk_le_mk h) + (fun _ _ h ↦ ConvexQuotient.lt_of_mk_lt_mk h) Surreal.fillsCuts + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/RealArchimedeanStratum.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/RealArchimedeanStratum.lean new file mode 100644 index 0000000000..8a19ea2ac1 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/RealArchimedeanStratum.lean @@ -0,0 +1,183 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealModule +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Leading +public import Mathlib.Algebra.Order.Module.HahnEmbedding +public import Mathlib.Algebra.Order.Ring.StandardPart + +/-! +# The real Archimedean stratum of the surreal numbers + +The embedded real line complements the infinitesimal surreal numbers inside the finite surreal +numbers. This module packages that familiar standard-part decomposition as a distinguished +Archimedean stratum. All other strata may still be chosen arbitrarily. + +This choice makes splitting a surreal Hahn series supported on real exponents transparent: the +outer exponents remain real and every inner exponent is zero. +-/ + +public noncomputable section + +open FiniteArchimedeanClass + +namespace Surreal + +/-- The standard embedding of the reals into the surreal numbers as a linear map. -/ +def realLinearMap : ℝ →ₗ[ℝ] Surreal where + toFun r := (r : Surreal) + map_add' r s := by simp + map_smul' r s := by + change ((r * s : ℝ) : Surreal) = (r : Surreal) * (s : Surreal) + exact Real.toSurrealRingHom.map_mul r s + +/-- The embedded real line as a real subspace of the surreal numbers. -/ +def realStratum : Submodule ℝ Surreal := LinearMap.range realLinearMap + +/-- A surreal number belongs to the real stratum exactly when it is an embedded real number. -/ +theorem mem_realStratum_iff {x : Surreal} : + x ∈ realStratum ↔ ∃ r : ℝ, (r : Surreal) = x := + Iff.rfl + +/-- The ordered additive identification of the real line with the real surreal stratum. -/ +def realOrderAddMonoidIso : ℝ ≃+o realStratum := + { LinearEquiv.ofInjective realLinearMap (by + intro r s h + change (r : Surreal) = (s : Surreal) at h + exact_mod_cast h) with + map_le_map_iff' := by + intro r s + change (r : Surreal) ≤ (s : Surreal) ↔ r ≤ s + exact Real.toSurreal_le_iff } + +@[simp] +theorem coe_realOrderAddMonoidIso (r : ℝ) : + (realOrderAddMonoidIso r : Surreal) = r := + (rfl) + +/-- The finite Archimedean class of every nonzero real surreal number. -/ +def realFiniteClass : FiniteArchimedeanClass Surreal := + FiniteArchimedeanClass.mk (1 : Surreal) one_ne_zero + +@[simp] +theorem realFiniteClass_val : realFiniteClass.val = 0 := by + rw [realFiniteClass] + exact ArchimedeanClass.mk_one + +/-- The infinitesimal ball and the embedded real line meet only at zero. -/ +theorem disjoint_ball_realStratum : + Disjoint (ball ℝ realFiniteClass) realStratum := by + rw [Submodule.disjoint_def] + intro x hxBall hxReal + obtain ⟨r, rfl⟩ := hxReal + by_cases hr : r = 0 + · simp [hr] + have hrSurreal : (r : Surreal) ≠ 0 := by simp [hr] + have hlt := (mem_ball_iff ℝ).mp hxBall hrSurreal + exfalso + change (realFiniteClass : ArchimedeanClass Surreal) < + ArchimedeanClass.mk (r : Surreal) at hlt + rw [realFiniteClass_val, Surreal.mk_realCast hr] at hlt + exact (lt_irrefl _ hlt).elim + +/-- Every finite surreal number is uniquely a real number plus an infinitesimal. -/ +theorem ball_sup_realStratum_eq : + ball ℝ realFiniteClass ⊔ realStratum = closedBall ℝ realFiniteClass := by + apply le_antisymm + · rw [sup_le_iff] + refine ⟨(ball_lt_closedBall (K := ℝ)).le, ?_⟩ + rintro _ ⟨r, rfl⟩ + rw [mem_closedBall_iff] + intro hr + apply le_of_eq + apply Subtype.ext + rw [realFiniteClass_val] + change 0 = ArchimedeanClass.mk (r : Surreal) + exact (Surreal.mk_realCast (by simpa [realLinearMap] using hr)).symm + · intro x hx + by_cases hx0 : x = 0 + · simp [hx0] + have hxmk : 0 ≤ ArchimedeanClass.mk x := by + have h := (mem_closedBall_iff ℝ).mp hx hx0 + change (realFiniteClass : ArchimedeanClass Surreal) ≤ ArchimedeanClass.mk x at h + simpa only [realFiniteClass_val] using h + let r := ArchimedeanClass.stdPart x + have hresidual : x - (r : Surreal) ∈ ball ℝ realFiniteClass := by + rw [mem_ball_iff] + intro _hne + rw [← Subtype.coe_lt_coe, realFiniteClass_val] + exact ArchimedeanClass.mk_sub_stdPart_pos Real.toSurrealRingHom hxmk + have hreal : (r : Surreal) ∈ realStratum := ⟨r, rfl⟩ + rw [← sub_add_cancel x (r : Surreal)] + have hresidual' : x - (r : Surreal) ∈ ball ℝ realFiniteClass ⊔ realStratum := + (show ball ℝ realFiniteClass ≤ ball ℝ realFiniteClass ⊔ realStratum from le_sup_left) + hresidual + have hreal' : (r : Surreal) ∈ ball ℝ realFiniteClass ⊔ realStratum := + (show realStratum ≤ ball ℝ realFiniteClass ⊔ realStratum from le_sup_right) hreal + exact (ball ℝ realFiniteClass ⊔ realStratum).add_mem hresidual' hreal' + +/-- Replace the stratum at the real Archimedean class by the embedded real line. -/ +def archimedeanStrataWithReal + (u : HahnEmbedding.ArchimedeanStrata ℝ Surreal) : + HahnEmbedding.ArchimedeanStrata ℝ Surreal where + stratum c := if c = realFiniteClass then realStratum else u.stratum c + disjoint_ball_stratum c := by + classical + by_cases hc : c = realFiniteClass + · subst c + simpa using disjoint_ball_realStratum + · simp only [hc, ↓reduceIte] + exact u.disjoint_ball_stratum c + ball_sup_stratum_eq c := by + classical + by_cases hc : c = realFiniteClass + · subst c + simpa using ball_sup_realStratum_eq + · simp only [hc, ↓reduceIte] + exact u.ball_sup_stratum_eq c + +@[simp] +theorem archimedeanStrataWithReal_stratum_real + (u : HahnEmbedding.ArchimedeanStrata ℝ Surreal) : + (archimedeanStrataWithReal u).stratum realFiniteClass = realStratum := by + simp [archimedeanStrataWithReal] + +/-- The real coordinate on the distinguished stratum of `archimedeanStrataWithReal`. -/ +def archimedeanStrataWithRealOrderAddMonoidIso + (u : HahnEmbedding.ArchimedeanStrata ℝ Surreal) : + ℝ ≃+o (archimedeanStrataWithReal u).stratum realFiniteClass where + toFun r := ⟨(r : Surreal), by + rw [archimedeanStrataWithReal_stratum_real] + exact ⟨r, rfl⟩⟩ + invFun x := ArchimedeanClass.stdPart (x : Surreal) + left_inv r := ArchimedeanClass.stdPart_map_real Real.toSurrealRingHom r + right_inv x := by + apply Subtype.ext + have hx : (x : Surreal) ∈ realStratum := by + rw [← archimedeanStrataWithReal_stratum_real u] + exact x.2 + obtain ⟨r, hr⟩ := hx + change ((ArchimedeanClass.stdPart (x : Surreal) : ℝ) : Surreal) = x + rw [← hr] + change ((ArchimedeanClass.stdPart (r : Surreal) : ℝ) : Surreal) = (r : Surreal) + exact congrArg (fun s : ℝ ↦ (s : Surreal)) + (ArchimedeanClass.stdPart_map_real Real.toSurrealRingHom r) + map_add' r s := by + apply Subtype.ext + simp + map_le_map_iff' := by + intro r s + change (r : Surreal) ≤ (s : Surreal) ↔ r ≤ s + exact Real.toSurreal_le_iff + +@[simp] +theorem coe_archimedeanStrataWithRealOrderAddMonoidIso + (u : HahnEmbedding.ArchimedeanStrata ℝ Surreal) (r : ℝ) : + (archimedeanStrataWithRealOrderAddMonoidIso u r : Surreal) = r := + (rfl) + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/RealModule.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/RealModule.lean new file mode 100644 index 0000000000..940779aa6f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/RealModule.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Real +public import Mathlib.Algebra.Algebra.Defs +public import Mathlib.Algebra.Order.Module.Defs + +/-! +# Surreal numbers as an ordered real vector space + +The standard ordered embedding of `ℝ` into the surreal field makes `Surreal` an algebra over +`ℝ`. Its scalar multiplication is ordinary multiplication by the embedded real, so it respects +the orders in both arguments. + +These instances are natural candidates for CombinatorialGames. They live here rather than in the +pinned dependency so later surreal constructions can use real-linear Archimedean strata without +modifying the dependency revision. +-/ + +public noncomputable section + +namespace Surreal + +/-- The surreal field as an algebra over its standard embedded copy of `ℝ`. -/ +noncomputable instance instAlgebraReal : Algebra ℝ Surreal := + Real.toSurrealRingHom.toRingHom.toAlgebra + +/-- Real scalar multiplication on surreal numbers is ordered in both arguments. -/ +instance instIsOrderedModuleReal : IsOrderedModule ℝ Surreal where + smul_le_smul_of_nonneg_left r hr x y hxy := by + rw [Algebra.smul_def, Algebra.smul_def] + exact mul_le_mul_of_nonneg_left hxy (Real.toSurreal_nonneg_iff.mpr hr) + smul_le_smul_of_nonneg_right x hx r s hrs := by + rw [Algebra.smul_def, Algebra.smul_def] + exact mul_le_mul_of_nonneg_right (Real.toSurreal_le_iff.mpr hrs) hx + +/-- Real scalar multiplication is multiplication by the standard surreal embedding. -/ +theorem real_smul_def (r : ℝ) (x : Surreal) : + r • x = (r : Surreal) * x := + Algebra.smul_def r x + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Round.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Round.lean new file mode 100644 index 0000000000..6144650c47 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Round.lean @@ -0,0 +1,241 @@ +/- +Copyright (c) 2026 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Real +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormSupport + +/-! +# Rounding surreal numbers by a positive radius + +For positive `r`, `x.round r` is the simplest surreal strictly between `x - r` and `x + r`. +For nonpositive `r` it is defined to be `x`. The addition and multiplication fixed-point lemmas +follow the option formulas for surreal arithmetic. This downstream module follows the rounding +infrastructure from CombinatorialGames PR #317. +-/ + +universe u + +public noncomputable section + +namespace Surreal + +open IGame Set + +/-- A surreal cut is represented by the game cut on chosen representatives of its options. -/ +theorem ofSets_eq_mk {s t : Set Surreal.{u}} [Small.{u} s] [Small.{u} t] + {H : ∀ x ∈ s, ∀ y ∈ t, x < y} : + !{s | t} = @mk !{out '' s | out '' t} (.mk (by + rw [moves_ofSets, moves_ofSets] + rintro _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ + rw [← Surreal.mk_lt_mk, out_eq, out_eq] + exact H x hx y hy) (by simp)) := by + rw [← toGame_inj, toGame_ofSets, toGame_mk, Game.mk_ofSets] + simp_rw [image_image, gameMk_out] + +/-- A surreal cut is no more complex than any surreal strictly between all its options. -/ +theorem birthday_ofSets_le_of_mem {s t : Set Surreal.{u}} {z : Surreal} + [Small.{u} s] [Small.{u} t] {H : ∀ x ∈ s, ∀ y ∈ t, x < y} + (hL : ∀ x ∈ s, x < z) (hR : ∀ y ∈ t, z < y) : + !{s | t}.birthday ≤ z.birthday := by + rw [ofSets_eq_mk, ← out_eq z] + generalize_proofs + apply IGame.Fits.birthday_le + constructor + · intro x hx + letI := IGame.Numeric.of_mem_moves hx + rw [IGame.Numeric.not_le] + simp only [moves_ofSets, Player.cases] at hx + obtain ⟨a, ha, rfl⟩ := hx + rw [← Surreal.mk_lt_mk, out_eq, out_eq] + exact hL a ha + · intro y hy + letI := IGame.Numeric.of_mem_moves hy + rw [IGame.Numeric.not_le] + simp only [moves_ofSets, Player.cases] at hy + obtain ⟨a, ha, rfl⟩ := hy + rw [← Surreal.mk_lt_mk, out_eq, out_eq] + exact hR a ha + +/-- A distinct surreal strictly between all options of a cut has strictly larger birthday. -/ +theorem birthday_ofSets_lt_of_mem {s t : Set Surreal.{u}} {z : Surreal} + [Small.{u} s] [Small.{u} t] {H : ∀ x ∈ s, ∀ y ∈ t, x < y} + (hL : ∀ x ∈ s, x < z) (hR : ∀ y ∈ t, z < y) (h : !{s | t} ≠ z) : + !{s | t}.birthday < z.birthday := by + rw [ofSets_eq_mk, ← out_eq z] + generalize_proofs + apply IGame.Fits.birthday_lt + · constructor + · intro x hx + letI := IGame.Numeric.of_mem_moves hx + rw [IGame.Numeric.not_le] + simp only [moves_ofSets, Player.cases] at hx + obtain ⟨a, ha, rfl⟩ := hx + rw [← Surreal.mk_lt_mk, out_eq, out_eq] + exact hL a ha + · intro y hy + letI := IGame.Numeric.of_mem_moves hy + rw [IGame.Numeric.not_le] + simp only [moves_ofSets, Player.cases] at hy + obtain ⟨a, ha, rfl⟩ := hy + rw [← Surreal.mk_lt_mk, out_eq, out_eq] + exact hR a ha + · rwa [← mk_eq_mk, ← ofSets_eq_mk, out_eq, eq_comm] + +/-- The least-birthday surreal lying strictly between all options is the surreal cut. -/ +theorem ofSets_eq_of_forall_birthday_le {s t : Set Surreal.{u}} {z : Surreal} + [Small.{u} s] [Small.{u} t] {H : ∀ x ∈ s, ∀ y ∈ t, x < y} + (hL : ∀ x ∈ s, x < z) (hR : ∀ y ∈ t, z < y) + (h : ∀ w, (∀ x ∈ s, x < w) → (∀ y ∈ t, w < y) → + z.birthday ≤ w.birthday) : + !{s | t} = z := by + by_contra hz + exact (birthday_ofSets_lt_of_mem hL hR hz).not_ge <| + h _ (fun _ ↦ lt_ofSets_of_mem_left) (fun _ ↦ ofSets_lt_of_mem_right) + +private theorem sub_lt_add_of_pos (x : Surreal) {r : Surreal} (hr : 0 < r) : + x - r < x + r := by + simpa only [sub_eq_add_neg, add_comm] using add_lt_add_left (neg_lt_self hr) x + +/-- For positive `r`, the simplest surreal strictly between `x - r` and `x + r`; for nonpositive +`r`, the junk value `x`. -/ +def round (x r : Surreal) : Surreal := + if hr : 0 < r then !{{x - r} | {x + r}}' (by + rintro _ rfl _ rfl + exact sub_lt_add_of_pos x hr) else x + +theorem round_of_pos {x r : Surreal} (hr : 0 < r) : + x.round r = !{{x - r} | {x + r}}' (by + rintro _ rfl _ rfl + exact sub_lt_add_of_pos x hr) := + dif_pos hr + +theorem round_of_nonpos {x r : Surreal} (hr : r ≤ 0) : x.round r = x := + dif_neg hr.not_gt + +/-- The singleton rounding cut of a positive numeric game is numeric. -/ +@[implicit_reducible] +def roundGameNumeric {x r : IGame} [x.Numeric] [r.Numeric] (hr : 0 < r) : + IGame.Numeric !{{x - r} | {x + r}} := + .mk (by + intro y hy z hz + simp only [IGame.leftMoves_ofSets, IGame.rightMoves_ofSets, + mem_singleton_iff] at hy hz + subst y + subst z + rw [← Surreal.mk_lt_mk] + simpa only [Surreal.mk_sub, Surreal.mk_add] using + sub_lt_add_of_pos (Surreal.mk x) (by + simpa only [Surreal.mk_zero] using + (Surreal.mk_lt_mk (x := (0 : IGame)) (y := r)).mpr hr)) (by + intro p y hy + cases p with + | left => + simp only [IGame.leftMoves_ofSets, mem_singleton_iff] at hy + subst y + infer_instance + | right => + simp only [IGame.rightMoves_ofSets, mem_singleton_iff] at hy + subst y + infer_instance) + +theorem round_mk_of_pos {x r : IGame} (hr : 0 < r) [x.Numeric] [r.Numeric] : + (mk x).round (mk r) = @mk !{{x - r} | {x + r}} + (roundGameNumeric hr) := by + rw [round_of_pos hr, mk_ofSets] + congr + · rw [range_singleton] + congr 1 + · rw [range_singleton] + congr 1 + +/-- The rounding cut is no more complex than any surreal strictly inside its defining interval. -/ +theorem birthday_round_le {x y r : Surreal} (h : y ∈ Ioo (x - r) (x + r)) : + (x.round r).birthday ≤ y.birthday := by + have hr : 0 < r := by + rw [← neg_lt_self_iff] + apply (add_lt_add_iff_left x).mp + simpa only [sub_eq_add_neg] using h.1.trans h.2 + cases h + rw [round_of_pos hr] + apply birthday_ofSets_le_of_mem <;> simpa + +/-- The simplest surreal in the open rounding interval is the rounding cut. -/ +theorem round_eq_of_forall_birthday_le {x y r : Surreal} + (h : y ∈ Ioo (x - r) (x + r)) + (hy : ∀ z, z ∈ Ioo (x - r) (x + r) → y.birthday ≤ z.birthday) : + x.round r = y := by + have hr : 0 < r := by + rw [← neg_lt_self_iff] + apply (add_lt_add_iff_left x).mp + simpa only [sub_eq_add_neg] using h.1.trans h.2 + cases h + rw [round_of_pos hr, ofSets_eq_of_forall_birthday_le] + · simpa + · simpa + · simpa using hy + +theorem round_of_zero_mem {x r : Surreal} (h : 0 ∈ Ioo (x - r) (x + r)) : x.round r = 0 := by + have hr : 0 < r := by + rw [← neg_lt_self_iff] + apply (add_lt_add_iff_left x).mp + simpa only [sub_eq_add_neg] using h.1.trans h.2 + cases x with | mk x + cases r with | mk r + have hr' : (0 : IGame) < r := by + rw [← Surreal.mk_lt_mk] + simpa only [Surreal.mk_zero] using hr + letI : IGame.Numeric !{{x - r} | {x + r}} := + roundGameNumeric (x := x) (r := r) hr' + rw [← mk_zero, round_mk_of_pos hr, mk_eq_mk, ← fits_zero_iff_equiv] + simpa [Fits] + +@[simp] +theorem round_zero (r : Surreal) : round 0 r = 0 := by + obtain h | h := le_or_gt r 0 + · rw [round_of_nonpos h] + · apply round_of_zero_mem + simpa + +@[simp] +theorem round_neg {x r : Surreal} : (-x).round r = -x.round r := by + obtain h | h := le_or_gt r 0 + · simp_rw [round_of_nonpos h] + cases x with | mk x + cases r with | mk r + simp only [← mk_neg, round_mk_of_pos h, neg_ofSets, neg_singleton, + sub_eq_add_neg, neg_add, neg_neg] + +theorem round_add_of_eq {x y r : Surreal} (hx : x.round r = x) (hy : y.round r = y) : + (x + y).round r = x + y := by + obtain h | h := le_or_gt r 0 + · rw [round_of_nonpos h] + cases x with | mk x + cases y with | mk y + cases r with | mk r + conv_rhs => rw [← hx, ← hy] + simp only [← mk_add, round_mk_of_pos h] at * + generalize_proofs at hx hy + simp only [ofSets_add_ofSets, mk_ofSets, image_singleton, union_singleton, + range_singleton, range_insert] + dsimp + congr <;> rw [hx, hy] <;> grind + +theorem round_mul_of_eq {x y r : Surreal} (h : 0 < r) + (hx : x.round r = x) (hy : y.round r = y) : + (x * y).round (r * r) = x * y := by + have h' : 0 < r * r := mul_self_pos.2 h.ne' + cases x with | mk x + cases y with | mk y + cases r with | mk r + conv_rhs => rw [← hx, ← hy] + simp only [← mk_mul, round_mk_of_pos h, round_mk_of_pos h'] at * + generalize_proofs at hx hy + simp only [ofSets_mul_ofSets, mk_ofSets, mulOption, singleton_prod_singleton, + union_singleton, image_insert_eq, image_singleton, range_singleton, range_insert] + congr <;> dsimp <;> rw [hx, hy] <;> grind + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/SmallDiscrete.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/SmallDiscrete.lean new file mode 100644 index 0000000000..18555472ac --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/SmallDiscrete.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Basic +public import Mathlib.Logic.Small.Set + +/-! +# Small sets of surreals are discrete + +No small family of positive surreals reaches down to zero: the surreal born between zero and the +family is positive and below all of it (`exists_pos_lt_of_small`). Every small set of surreals is +therefore discrete — around any point sits an interval meeting the set only there +(`exists_Ioo_inter_subset_singleton_of_small`). + +This is why an analysis by limit points of a support has to be carried out over a small group of +exponents rather than over the surreals themselves. A surreal has a small support, so its support +has no limit points at all inside the surreals, and every rank computed there collapses. Over a +small exponent group the positive elements do have a small coinitial family, limit points exist, +and the analysis has content; the factorisations it produces are equations, and equations transfer +back along the embedding of exponents whatever the ranks do. +-/ + +universe u + +public noncomputable section + +namespace Surreal + +/-- **No small family of positive surreals is coinitial.** The surreal born from zero on the left +and the family on the right is positive and lies below every member. -/ +theorem exists_pos_lt_of_small {P : Set Surreal.{u}} [Small.{u} P] (hP : ∀ p ∈ P, 0 < p) : + ∃ q : Surreal.{u}, 0 < q ∧ ∀ p ∈ P, q < p := by + have hsep : ∀ x ∈ ({0} : Set Surreal.{u}), ∀ y ∈ P, x < y := by + rintro _ rfl y hy + exact hP y hy + refine ⟨!{({0} : Set Surreal.{u}) | P}, ?_, fun p hp ↦ ?_⟩ + · exact lt_ofSets_of_mem_left (H := hsep) rfl + · exact ofSets_lt_of_mem_right (H := hsep) hp + +/-- **A small set of surreals is discrete.** Around any surreal there is an interval meeting a +given small set only at that surreal, obtained from a positive surreal below all the distances +from it to the other members. -/ +theorem exists_Ioo_inter_subset_singleton_of_small {S : Set Surreal.{u}} [Small.{u} S] + (p : Surreal.{u}) : + ∃ a b : Surreal.{u}, a < p ∧ p < b ∧ Set.Ioo a b ∩ S ⊆ {p} := by + classical + set d : Surreal.{u} → Surreal.{u} := fun s ↦ max (s - p) (p - s) with hd + have hsub : (S \ {p} : Set Surreal.{u}) ⊆ S := Set.sdiff_subset + haveI : Small.{u} (S \ {p} : Set Surreal.{u}) := small_subset hsub + obtain ⟨q, hq, hlt⟩ := exists_pos_lt_of_small (P := d '' (S \ {p})) (by + rintro _ ⟨s, hs, rfl⟩ + rw [hd, lt_max_iff] + rcases lt_trichotomy s p with h | h | h + · exact Or.inr (sub_pos.mpr h) + · exact absurd h fun h' ↦ hs.2 (by simp [h']) + · exact Or.inl (sub_pos.mpr h)) + refine ⟨p - q, p + q, sub_lt_self p hq, lt_add_of_pos_right p hq, fun s hs ↦ ?_⟩ + by_contra hne + obtain ⟨h₁, h₂⟩ := hs.1 + have hclose : d s < q := by + rw [hd, max_lt_iff] + refine ⟨?_, ?_⟩ + · rw [sub_lt_iff_lt_add, add_comm] + exact h₂ + · rw [sub_lt_iff_lt_add, add_comm, ← sub_lt_iff_lt_add] + exact h₁ + exact absurd hclose (not_lt.mpr (hlt _ ⟨s, ⟨hs.2, hne⟩, rfl⟩).le) + +end Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Tests.lean new file mode 100644 index 0000000000..275432063d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Tests.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.ArchimedeanAssumptions +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.RealModule + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Tests/ArchimedeanAssumptions.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Tests/ArchimedeanAssumptions.lean new file mode 100644 index 0000000000..3bf88d9149 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Tests/ArchimedeanAssumptions.lean @@ -0,0 +1,89 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ArchimedeanAssumptions + +/-! +# API checks for LM24 assumptions `(A1)_σ` and `(A2)_σ` on surreal strata + +This separately compiled client consumes the arbitrary-stratum and fixed-strata forms without +unfolding the standard-part or cofinality constructions. It exercises both assumptions at a +nonzero class and at the zero class. +-/ + +public noncomputable section + +namespace Tests + +theorem surreal_stratum_orderAddMonoidIso_real + (u : HahnEmbedding.ArchimedeanStrata ℝ Surreal) + (c : FiniteArchimedeanClass Surreal) : + Nonempty (u.stratum c ≃+o ℝ) := + (LM24.assumptionA1AtFiniteClass_iff u c).mp + (Surreal.assumptionA1AtFiniteClass u c) + +theorem surreal_fixed_strata_assumptionA1_finite + (c : FiniteArchimedeanClass Surreal) : + LM24.AssumptionA1AtFiniteClass Surreal.archimedeanStrata c := + Surreal.assumptionA1AtFiniteClass Surreal.archimedeanStrata c + +theorem surreal_fixed_strata_assumptionA1_zero : + LM24.AssumptionA1 Surreal.archimedeanStrata (⊤ : ArchimedeanClass Surreal) := + Surreal.archimedeanStrata_assumptionA1 ⊤ + +universe u v + +theorem surreal_smallSupportCardinal_uncountable : + Cardinal.aleph0 < Surreal.smallSupportCardinal.{u} := + Surreal.aleph0_lt_smallSupportCardinal + +theorem surreal_smallSupportCardinal_regular : + Surreal.smallSupportCardinal.{u}.IsRegular := + Surreal.smallSupportCardinal_isRegular + +theorem surreal_assumptionA2_finite + {R : Type v} [Field R] (Z : Subring R) + (c : FiniteArchimedeanClass Surreal.{u}) : + LM24.AssumptionA2AtFiniteClass (K := ℝ) Surreal.smallSupportCardinal Z c := + Surreal.assumptionA2AtFiniteClass Z c + +theorem surreal_assumptionA2_zero + {R : Type v} [Field R] (Z : Subring R) : + LM24.AssumptionA2 Surreal.smallSupportCardinal Z + (⊤ : ArchimedeanClass Surreal.{u}) := + Surreal.assumptionA2 Z ⊤ + +/-- The Archimedean class of the surreal number `1`. -/ +def surrealUnitClass : FiniteArchimedeanClass Surreal := + FiniteArchimedeanClass.mk 1 one_ne_zero + +theorem surrealUnitClass_eq : + surrealUnitClass = FiniteArchimedeanClass.mk 1 one_ne_zero := (rfl) + +/-- The monomial `ω⁻¹` lies in the open ball below the class of `1`. -/ +def surrealPositiveInfinitesimal : + ↥(FiniteArchimedeanClass.ball ℝ surrealUnitClass) := + ⟨ω^ (-1 : Surreal), by + rw [FiniteArchimedeanClass.mem_ball_iff] + intro hzero + rw [surrealUnitClass_eq, FiniteArchimedeanClass.mk_lt_mk one_ne_zero hzero] + simpa using Surreal.archimedeanClassMk_wpow_strictAnti + (show (-1 : Surreal) < 0 by norm_num)⟩ + +theorem surrealPositiveInfinitesimal_pos : + 0 < surrealPositiveInfinitesimal := + Surreal.wpow_pos _ + +/-- The open surreal ball below the class of `1` is nondegenerate. This separates the cofinality +branch of `(A2)_σ` from its zero-inner-group branch. -/ +theorem surrealUnitClass_ball_nontrivial : + ¬Subsingleton ↥(FiniteArchimedeanClass.ball ℝ surrealUnitClass) := by + intro h + exact surrealPositiveInfinitesimal_pos.ne' + (Subsingleton.elim surrealPositiveInfinitesimal 0) + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Tests/RealModule.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Tests/RealModule.lean new file mode 100644 index 0000000000..c773ae426d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Tests/RealModule.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealModule +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Pow + +/-! +# API checks for the ordered real module structure on surreal numbers + +The first check identifies scalar multiplication with the standard real embedding. The second +uses the genuinely non-real surreal `ω` and confirms that multiplication by a positive real is +strictly monotone on it. +-/ + +public noncomputable section + +namespace Tests + +theorem surreal_real_smul (r : ℝ) (x : Surreal) : + r • x = (r : Surreal) * x := + Surreal.real_smul_def r x + +theorem surreal_real_smul_omega_strictMono : + StrictMono (fun r : ℝ ↦ r • (ω^ (0 : Surreal))) := by + intro r s hrs + change r • (ω^ (0 : Surreal)) < s • (ω^ (0 : Surreal)) + rw [Surreal.real_smul_def, Surreal.real_smul_def] + exact mul_lt_mul_of_pos_right (Real.toSurreal_lt_iff.mpr hrs) (Surreal.wpow_pos 0) + +end Tests diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC.lean new file mode 100644 index 0000000000..d260dd2eaf --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC.lean @@ -0,0 +1,18 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Basic +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Cuts +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Identification +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificCodes +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificInteger +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Properness +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Reduced +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Refinement +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Basic.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Basic.lean new file mode 100644 index 0000000000..a5aa59a3cc --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Basic.lean @@ -0,0 +1,215 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.GameOperations +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Division +public import Mathlib.Algebra.Field.TransferInstance +public import Mathlib.Algebra.Order.Hom.Ring +public import Mathlib.Order.Lattice + +import Mathlib.Algebra.Order.Ring.InjSurj + +/-! +# Surreal values of ZFC game codes + +Numeric ZFC game codes are quotiented by Conway equivalence. The resulting ordered field is +identified with the surreal numbers, preserving the value of each set-coded Conway cut. +-/ + +universe u + +public noncomputable section + +namespace ZFSet + +/-- A set-coded game satisfying Conway's numeric condition. -/ +structure NumericGameCode where + code : GameCode.{u} + numeric : code.IsNumeric + +namespace NumericGameCode + +/-- The numeric game obtained by decoding a numeric ZFC game code. -/ +def toIGame (x : NumericGameCode.{u}) : IGame.{u} := x.code.toIGame + +instance (x : NumericGameCode.{u}) : IGame.Numeric x.toIGame := by + exact (GameCode.isNumeric_iff x.code).1 x.numeric + +/-- The surreal value of a numeric ZFC game code. -/ +def toSurreal (x : NumericGameCode.{u}) : _root_.Surreal.{u} := _root_.Surreal.mk x.toIGame + +/-- Numerical equality of codes is Conway equivalence, not literal equality of ZFC sets. -/ +def setoid : Setoid NumericGameCode.{u} where + r x y := AntisymmRel (· ≤ ·) x.code y.code + iseqv := ⟨fun _ ↦ .rfl, fun h ↦ h.symm, fun h₁ h₂ ↦ h₁.trans h₂⟩ + +/-- Two numeric codes have the same surreal value exactly when they are Conway equivalent. -/ +theorem toSurreal_eq_iff (x y : NumericGameCode.{u}) : + x.toSurreal = y.toSurreal ↔ AntisymmRel (· ≤ ·) x.code y.code := by + rw [toSurreal, toSurreal, _root_.Surreal.mk_eq_mk] + rfl + +/-- Every surreal value has a numeric ZFC game code. -/ +theorem toSurreal_surjective : Function.Surjective (toSurreal.{u}) := by + intro x + let c : NumericGameCode.{u} := ⟨GameCode.ofIGame x.out, by + rw [GameCode.isNumeric_iff, GameCode.toIGame_ofIGame] + infer_instance⟩ + refine ⟨c, ?_⟩ + letI : IGame.Numeric (GameCode.ofIGame x.out).toIGame := + (GameCode.isNumeric_iff _).1 c.numeric + change _root_.Surreal.mk (GameCode.ofIGame x.out).toIGame = x + simp only [GameCode.toIGame_ofIGame, _root_.Surreal.out_eq] + +end NumericGameCode + +/-- The class presentation of surreal values: numeric ZFC game codes modulo Conway equality. -/ +def Surreal : Type (u + 1) := Quotient NumericGameCode.setoid.{u} + +namespace Surreal + +/-- The value represented by a numeric ZFC game code. -/ +def mk (x : GameCode.{u}) (hx : x.IsNumeric) : Surreal.{u} := + Quotient.mk _ (NumericGameCode.mk x hx) + +/-- Evaluate a Conway-equivalence class of numeric ZFC codes in the surreal field. -/ +def toSurreal : Surreal.{u} → _root_.Surreal.{u} := + Quotient.lift NumericGameCode.toSurreal fun x y h ↦ + (NumericGameCode.toSurreal_eq_iff x y).2 h + +@[simp] +theorem toSurreal_mk (x : GameCode.{u}) (hx : x.IsNumeric) : + toSurreal (mk x hx) = @ _root_.Surreal.mk x.toIGame + ((GameCode.isNumeric_iff x).1 hx) := (rfl) + +/-- Equality of class values is precisely Conway equivalence of their numeric codes. -/ +theorem mk_eq_mk (x y : GameCode.{u}) (hx : x.IsNumeric) (hy : y.IsNumeric) : + mk x hx = mk y hy ↔ AntisymmRel (· ≤ ·) x y := Quotient.eq + +/-- Every class value is represented by a numeric ZFC game code. -/ +theorem exists_mk (x : Surreal.{u}) : ∃ (c : GameCode.{u}) (hc : c.IsNumeric), mk c hc = x := by + induction x using Quotient.inductionOn with + | h c => exact ⟨c.code, c.numeric, rfl⟩ + +/-- Evaluation distinguishes all surreal values represented by the code class. -/ +theorem toSurreal_injective : Function.Injective (toSurreal.{u}) := by + intro x y + induction x, y using Quotient.inductionOn₂ with + | h x y => + intro h + exact Quotient.sound ((NumericGameCode.toSurreal_eq_iff x y).1 h) + +/-- The class presentation includes every surreal number. -/ +theorem toSurreal_surjective : Function.Surjective (toSurreal.{u}) := by + intro x + obtain ⟨c, hc⟩ := NumericGameCode.toSurreal_surjective x + exact ⟨mk c.code c.numeric, hc⟩ + +/-- The exact correspondence between class-coded surreal values and the surreal field. -/ +def equiv : Surreal.{u} ≃ _root_.Surreal.{u} := + Equiv.ofBijective toSurreal ⟨toSurreal_injective, toSurreal_surjective⟩ + +@[simp] +theorem equiv_apply (x : Surreal.{u}) : equiv x = toSurreal x := (rfl) + +instance : Field Surreal.{u} := equiv.field + +instance : LinearOrder Surreal.{u} := by + classical + exact equiv.linearOrder + +/-- Evaluation preserves the field operations on class values. -/ +def ringEquiv : Surreal.{u} ≃+* _root_.Surreal.{u} := equiv.ringEquiv + +@[simp] +theorem ringEquiv_apply (x : Surreal.{u}) : ringEquiv x = toSurreal x := (rfl) + +@[simp] +theorem toSurreal_zero : toSurreal (0 : Surreal.{u}) = 0 := map_zero ringEquiv + +@[simp] +theorem toSurreal_one : toSurreal (1 : Surreal.{u}) = 1 := map_one ringEquiv + +@[simp] +theorem toSurreal_add (x y : Surreal.{u}) : + toSurreal (x + y) = toSurreal x + toSurreal y := map_add ringEquiv x y + +@[simp] +theorem toSurreal_mul (x y : Surreal.{u}) : + toSurreal (x * y) = toSurreal x * toSurreal y := map_mul ringEquiv x y + +@[simp] +theorem toSurreal_le_toSurreal (x y : Surreal.{u}) : + toSurreal x ≤ toSurreal y ↔ x ≤ y := (Iff.rfl) + +@[simp] +theorem toSurreal_lt_toSurreal (x y : Surreal.{u}) : + toSurreal x < toSurreal y ↔ x < y := (Iff.rfl) + +instance : IsStrictOrderedRing Surreal.{u} := + Function.Injective.isStrictOrderedRing toSurreal toSurreal_zero toSurreal_one + toSurreal_add toSurreal_mul (toSurreal_le_toSurreal _ _) (toSurreal_lt_toSurreal _ _) + +/-- Evaluation is an ordered ring equivalence between the two presentations of surreals. -/ +def orderRingEquiv : Surreal.{u} ≃+*o _root_.Surreal.{u} where + __ := ringEquiv + map_le_map_iff' := toSurreal_le_toSurreal _ _ + +@[simp] +theorem orderRingEquiv_apply (x : Surreal.{u}) : orderRingEquiv x = toSurreal x := (rfl) + +@[simp] +theorem toSurreal_neg (x : Surreal.{u}) : toSurreal (-x) = -toSurreal x := + map_neg ringEquiv x + +@[simp] +theorem toSurreal_sub (x y : Surreal.{u}) : + toSurreal (x - y) = toSurreal x - toSurreal y := map_sub ringEquiv x y + +@[simp] +theorem mk_zero : mk (0 : GameCode.{u}) GameCode.isNumeric_zero = 0 := by + apply toSurreal_injective + simp only [toSurreal_mk, GameCode.toIGame_zero, _root_.Surreal.mk_zero, toSurreal_zero] + +@[simp] +theorem mk_one : mk (1 : GameCode.{u}) GameCode.isNumeric_one = 1 := by + apply toSurreal_injective + simp only [toSurreal_mk, GameCode.toIGame_one, _root_.Surreal.mk_one, toSurreal_one] + +@[simp] +theorem mk_neg (x : GameCode.{u}) (hx : x.IsNumeric) : + mk (-x) hx.neg = -mk x hx := by + letI : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff _).1 hx + apply toSurreal_injective + simp only [toSurreal_mk, GameCode.toIGame_neg, _root_.Surreal.mk_neg, toSurreal_neg] + +@[simp] +theorem mk_add (x y : GameCode.{u}) (hx : x.IsNumeric) (hy : y.IsNumeric) : + mk (x + y) (hx.add hy) = mk x hx + mk y hy := by + letI : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff _).1 hx + letI : IGame.Numeric y.toIGame := (GameCode.isNumeric_iff _).1 hy + apply toSurreal_injective + simp only [toSurreal_mk, GameCode.toIGame_add, _root_.Surreal.mk_add, toSurreal_add] + +@[simp] +theorem mk_sub (x y : GameCode.{u}) (hx : x.IsNumeric) (hy : y.IsNumeric) : + mk (x - y) (hx.sub hy) = mk x hx - mk y hy := by + letI : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff _).1 hx + letI : IGame.Numeric y.toIGame := (GameCode.isNumeric_iff _).1 hy + apply toSurreal_injective + simp only [toSurreal_mk, GameCode.toIGame_sub, _root_.Surreal.mk_sub, toSurreal_sub] + +@[simp] +theorem mk_mul (x y : GameCode.{u}) (hx : x.IsNumeric) (hy : y.IsNumeric) : + mk (x * y) (hx.mul hy) = mk x hx * mk y hy := by + letI : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff _).1 hx + letI : IGame.Numeric y.toIGame := (GameCode.isNumeric_iff _).1 hy + apply toSurreal_injective + simp only [toSurreal_mk, GameCode.toIGame_mul, _root_.Surreal.mk_mul, toSurreal_mul] + +end Surreal +end ZFSet diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Cuts.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Cuts.lean new file mode 100644 index 0000000000..1ae276480c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Cuts.lean @@ -0,0 +1,214 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Basic +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Basic +public import Mathlib.Logic.Small.Set + +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Basic +import Mathlib.Data.Set.Image + +/-! +# Small Conway cuts of class-coded surreal values + +A small left set and a small right set of numeric ZFC game codes form a numeric code when every +left value is strictly below every right value. Its quotient value is the Conway cut of the option +values. Choosing numeric representatives therefore constructs cuts on arbitrary small sets of +class-coded surreal values, independently of the representative choices at the level of values. +-/ + +universe u + +public noncomputable section + +open Set + +namespace ZFSet.GameCode + +/-- Small separated sets of numeric codes form a numeric Conway cut. -/ +theorem isNumeric_ofSets (s t : Set GameCode.{u}) [Small.{u} s] [Small.{u} t] + (hs : ∀ x ∈ s, IsNumeric x) (ht : ∀ x ∈ t, IsNumeric x) + (h : ∀ x ∈ s, ∀ y ∈ t, x < y) : IsNumeric (ofSets s t) := by + rw [isNumeric_iff_options] + constructor + · simpa only [moves_ofSets_left, moves_ofSets_right] using h + · intro p x hx + cases p with + | left => exact hs x (by simpa only [moves_ofSets_left] using hx) + | right => exact ht x (by simpa only [moves_ofSets_right] using hx) + +end ZFSet.GameCode + +namespace ZFSet.Surreal + +/-- Quotienting numeric codes preserves their strict Conway comparison. -/ +@[simp] +theorem mk_lt_mk (x y : GameCode.{u}) (hx : x.IsNumeric) (hy : y.IsNumeric) : + mk x hx < mk y hy ↔ x < y := by + letI : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff x).1 hx + letI : IGame.Numeric y.toIGame := (GameCode.isNumeric_iff y).1 hy + rw [← toSurreal_lt_toSurreal, toSurreal_mk, toSurreal_mk, + _root_.Surreal.mk_lt_mk, GameCode.toIGame_lt_toIGame] + +/-- Quotienting numeric codes preserves their non-strict Conway comparison. -/ +@[simp] +theorem mk_le_mk (x y : GameCode.{u}) (hx : x.IsNumeric) (hy : y.IsNumeric) : + mk x hx ≤ mk y hy ↔ x ≤ y := by + letI : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff x).1 hx + letI : IGame.Numeric y.toIGame := (GameCode.isNumeric_iff y).1 hy + rw [← toSurreal_le_toSurreal, toSurreal_mk, toSurreal_mk, + _root_.Surreal.mk_le_mk, GameCode.toIGame_le_toIGame] + +/-- The class values represented by a set of numeric game codes. -/ +def codeValues (s : Set GameCode.{u}) (hs : ∀ x ∈ s, x.IsNumeric) : Set Surreal.{u} := + Set.range fun x : s ↦ mk x.1 (hs x.1 x.2) + +instance (s : Set GameCode.{u}) (hs : ∀ x ∈ s, x.IsNumeric) [Small.{u} s] : + Small.{u} (codeValues s hs) := + inferInstanceAs (Small.{u} (Set.range fun x : s ↦ mk x.1 (hs x.1 x.2))) + +@[simp] +theorem mem_codeValues {s : Set GameCode.{u}} {hs : ∀ x ∈ s, x.IsNumeric} + {x : Surreal.{u}} : x ∈ codeValues s hs ↔ ∃ y, ∃ hy : y ∈ s, mk y (hs y hy) = x := by + simp [codeValues] + +/-- Strict separation of numeric code sets descends to their class values. -/ +theorem codeValues_separated (s t : Set GameCode.{u}) + (hs : ∀ x ∈ s, x.IsNumeric) (ht : ∀ x ∈ t, x.IsNumeric) + (h : ∀ x ∈ s, ∀ y ∈ t, x < y) : + ∀ x ∈ codeValues s hs, ∀ y ∈ codeValues t ht, x < y := by + rintro _ ⟨⟨x, hx⟩, rfl⟩ _ ⟨⟨y, hy⟩, rfl⟩ + exact (mk_lt_mk x y (hs x hx) (ht y hy)).2 (h x hx y hy) + +/-- Evaluation preserves separation of left and right sets of class values. -/ +theorem toSurreal_separated (s t : Set Surreal.{u}) + (h : ∀ x ∈ s, ∀ y ∈ t, x < y) : + ∀ x ∈ toSurreal '' s, ∀ y ∈ toSurreal '' t, x < y := by + rintro _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ + exact (toSurreal_lt_toSurreal x y).2 (h x hx y hy) + +/-- The quotient value of the raw Conway cut on separated numeric option codes. -/ +def ofCodeSets (s t : Set GameCode.{u}) [Small.{u} s] [Small.{u} t] + (hs : ∀ x ∈ s, x.IsNumeric) (ht : ∀ x ∈ t, x.IsNumeric) + (h : ∀ x ∈ s, ∀ y ∈ t, x < y) : Surreal.{u} := + mk (GameCode.ofSets s t) (GameCode.isNumeric_ofSets s t hs ht h) + +/-- The class code cut is represented by the literal ZFC cut on its option codes. -/ +theorem ofCodeSets_eq_mk (s t : Set GameCode.{u}) [Small.{u} s] [Small.{u} t] + (hs : ∀ x ∈ s, x.IsNumeric) (ht : ∀ x ∈ t, x.IsNumeric) + (h : ∀ x ∈ s, ∀ y ∈ t, x < y) : + ofCodeSets s t hs ht h = + mk (GameCode.ofSets s t) (GameCode.isNumeric_ofSets s t hs ht h) := (rfl) + +/-- Evaluating a raw numeric code cut gives the Conway cut of its evaluated option values. -/ +theorem toSurreal_ofCodeSets (s t : Set GameCode.{u}) [Small.{u} s] [Small.{u} t] + (hs : ∀ x ∈ s, x.IsNumeric) (ht : ∀ x ∈ t, x.IsNumeric) + (h : ∀ x ∈ s, ∀ y ∈ t, x < y) : + toSurreal (ofCodeSets s t hs ht h) = + !{toSurreal '' codeValues s hs | toSurreal '' codeValues t ht}' + (toSurreal_separated _ _ (codeValues_separated s t hs ht h)) := by + apply _root_.Surreal.toGame_inj.1 + rw [ofCodeSets_eq_mk, toSurreal_mk, _root_.Surreal.toGame_mk, + GameCode.toIGame_ofSets, Game.mk_ofSets, _root_.Surreal.toGame_ofSets] + congr 1 + simp only [codeValues, Set.image_image, ← Set.range_comp, Function.comp_def, + toSurreal_mk, _root_.Surreal.toGame_mk] + simp only [Set.image_eq_range] + +/-- Choose a numeric ZFC game code representing a class value. -/ +def out (x : Surreal.{u}) : GameCode.{u} := Classical.choose (exists_mk x) + +/-- The chosen representative of a class value is numeric. -/ +theorem isNumeric_out (x : Surreal.{u}) : x.out.IsNumeric := + Classical.choose (Classical.choose_spec (exists_mk x)) + +@[simp] +theorem out_eq (x : Surreal.{u}) : mk x.out (isNumeric_out x) = x := + Classical.choose_spec (Classical.choose_spec (exists_mk x)) + +@[simp] +theorem out_lt_out (x y : Surreal.{u}) : x.out < y.out ↔ x < y := by + rw [← mk_lt_mk x.out y.out (isNumeric_out x) (isNumeric_out y), out_eq, out_eq] + +/-- Every code in the image of a set under the representative selection is numeric. -/ +theorem out_image_numeric (s : Set Surreal.{u}) : ∀ x ∈ out '' s, x.IsNumeric := by + rintro _ ⟨x, _, rfl⟩ + exact isNumeric_out x + +/-- Selecting representatives preserves strict separation of two sets. -/ +theorem out_image_separated (s t : Set Surreal.{u}) + (h : ∀ x ∈ s, ∀ y ∈ t, x < y) : + ∀ x ∈ out '' s, ∀ y ∈ out '' t, x < y := by + rintro _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ + exact (out_lt_out x y).2 (h x hx y hy) + +@[simp] +theorem codeValues_out_image (s : Set Surreal.{u}) : + codeValues (out '' s) (out_image_numeric s) = s := by + ext x + constructor + · intro hx + obtain ⟨c, hc, hcx⟩ := mem_codeValues.1 hx + obtain ⟨y, hy, rfl⟩ := hc + exact ((out_eq y).symm.trans hcx) ▸ hy + · intro hx + exact mem_codeValues.2 ⟨x.out, Set.mem_image_of_mem out hx, out_eq x⟩ + +/-- Construct a class-coded Conway cut using the raw cuts of chosen numeric representatives. -/ +instance : OfSets Surreal.{u} (fun st ↦ ∀ x ∈ st Player.left, + ∀ y ∈ st Player.right, x < y) where + ofSets st h _ _ := ofCodeSets (out '' st Player.left) (out '' st Player.right) + (out_image_numeric _) (out_image_numeric _) + (out_image_separated _ _ h) + +/-- The class cut is the quotient of the raw cut on chosen representative codes. -/ +theorem ofSets_eq_ofCodeSets (s t : Set Surreal.{u}) [Small.{u} s] [Small.{u} t] + (h : ∀ x ∈ s, ∀ y ∈ t, x < y) : + (!{s | t}'h : Surreal.{u}) = ofCodeSets (out '' s) (out '' t) + (out_image_numeric s) (out_image_numeric t) (out_image_separated s t h) := (rfl) + +/-- Evaluating an arbitrary small class cut gives the Conway cut of the evaluation images. -/ +@[simp] +theorem toSurreal_ofSets (s t : Set Surreal.{u}) [Small.{u} s] [Small.{u} t] + (h : ∀ x ∈ s, ∀ y ∈ t, x < y) : + toSurreal (!{s | t}'h) = + !{toSurreal '' s | toSurreal '' t}'(toSurreal_separated s t h) := by + rw [ofSets_eq_ofCodeSets, toSurreal_ofCodeSets] + simp only [codeValues_out_image] + +/-- A raw numeric code cut agrees with the class cut of its option values. -/ +theorem ofCodeSets_eq_ofSets (s t : Set GameCode.{u}) [Small.{u} s] [Small.{u} t] + (hs : ∀ x ∈ s, x.IsNumeric) (ht : ∀ x ∈ t, x.IsNumeric) + (h : ∀ x ∈ s, ∀ y ∈ t, x < y) : + ofCodeSets s t hs ht h = + !{codeValues s hs | codeValues t ht}'(codeValues_separated s t hs ht h) := by + apply toSurreal_injective + rw [toSurreal_ofCodeSets, toSurreal_ofSets] + +/-- Quotienting the literal ZFC cut is the same as cutting its quotient option values. -/ +theorem mk_ofSets (s t : Set GameCode.{u}) [Small.{u} s] [Small.{u} t] + (hs : ∀ x ∈ s, x.IsNumeric) (ht : ∀ x ∈ t, x.IsNumeric) + (h : ∀ x ∈ s, ∀ y ∈ t, x < y) : + mk (GameCode.ofSets s t) (GameCode.isNumeric_ofSets s t hs ht h) = + !{codeValues s hs | codeValues t ht}'(codeValues_separated s t hs ht h) := by + exact (ofCodeSets_eq_mk s t hs ht h).symm.trans (ofCodeSets_eq_ofSets s t hs ht h) + +/-- Every left option value is strictly below the class cut. -/ +theorem lt_ofSets_of_mem_left {s t : Set Surreal.{u}} [Small.{u} s] [Small.{u} t] + {h : ∀ x ∈ s, ∀ y ∈ t, x < y} {x : Surreal.{u}} (hx : x ∈ s) : + x < !{s | t}'h := by + rw [← toSurreal_lt_toSurreal, toSurreal_ofSets] + exact _root_.Surreal.lt_ofSets_of_mem_left (Set.mem_image_of_mem _ hx) + +/-- The class cut is strictly below every right option value. -/ +theorem ofSets_lt_of_mem_right {s t : Set Surreal.{u}} [Small.{u} s] [Small.{u} t] + {h : ∀ x ∈ s, ∀ y ∈ t, x < y} {x : Surreal.{u}} (hx : x ∈ t) : + !{s | t}'h < x := by + rw [← toSurreal_lt_toSurreal, toSurreal_ofSets] + exact _root_.Surreal.ofSets_lt_of_mem_right (Set.mem_image_of_mem _ hx) + +end ZFSet.Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Identification.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Identification.lean new file mode 100644 index 0000000000..9f76d45045 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Identification.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificInteger +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Cuts +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.NormalForm + +/-! +# Native cut and normal-form criteria for the omnific-integer class + +The class predicate defined using raw ZFC game codes is exactly fixedness under the class-valued +singleton Conway cut. Equivalently, its canonical Conway normal form has nonnegative support and +an integral constant coefficient. These are the cut and normal-form presentations of Conway's +omnific integers recalled in LM24, Section 1.1; the exponent orientation here is unsigned. +-/ + +universe u + +public noncomputable section + +namespace ZFSet.Surreal + +/-- A class value is omnific exactly when it equals its singleton cut at distance one. -/ +theorem isOmnificInteger_iff_cut (x : Surreal.{u}) : + x.IsOmnificInteger ↔ x = !{{x - 1} | {x + 1}}'(by + simp only [Set.mem_singleton_iff] + rintro _ rfl _ rfl + simp [sub_eq_add_neg]) := by + rw [isOmnificInteger_iff, _root_.Surreal.isOmnificInteger_iff, + ← toSurreal_injective.eq_iff, toSurreal_ofSets, _root_.Surreal.omnificIntegerCut_eq] + simp only [Set.image_singleton, toSurreal_sub, toSurreal_add, toSurreal_one] + +/-- Nonnegativity of every Conway support exponent is unchanged by evaluation. -/ +theorem support_subset_Ici_zero_iff_toSurreal (x : Surreal.{u}) : + support x ⊆ Set.Ici 0 ↔ (toSurreal x).support ⊆ Set.Ici 0 := by + rw [← image_support, Set.image_subset_iff] + simp only [Set.subset_def, Set.mem_preimage, Set.mem_Ici, + ← toSurreal_zero, toSurreal_le_toSurreal] + +/-- A class value is omnific exactly when its Conway support is nonnegative and its constant +coefficient is an integer, with the coefficient on the left of the equality. -/ +theorem isOmnificInteger_iff_normalForm (x : Surreal.{u}) : + x.IsOmnificInteger ↔ + support x ⊆ Set.Ici 0 ∧ ∃ z : ℤ, coeff x 0 = (z : ℝ) := by + rw [isOmnificInteger_iff, _root_.Surreal.isOmnificInteger_iff_normalForm, + ← support_subset_Ici_zero_iff_toSurreal, coeff_eq_toSurreal, toSurreal_zero] + constructor + · rintro ⟨hs, z, hz⟩ + exact ⟨hs, z, hz.symm⟩ + · rintro ⟨hs, z, hz⟩ + exact ⟨hs, z, hz.symm⟩ + +end ZFSet.Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/NormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/NormalForm.lean new file mode 100644 index 0000000000..7035836a42 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/NormalForm.lean @@ -0,0 +1,186 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Basic +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Transfer +public import Mathlib.Algebra.Order.Archimedean.Class +public import Mathlib.Data.Set.Finite.Basic +public import Mathlib.Logic.Small.Basic + +/-! +# Conway normal forms of class-coded surreal values + +The Conway-equivalence classes of numeric ZFC game codes use the existing Conway normal-form +order equivalence. Coefficients and support are indexed by class-coded surreal exponents; support +is set-sized. The finite-support-class and reducedness predicates are stated directly on these +exponents, with exact equivalences to the corresponding formulas in the surreal field. + +Reducedness uses the unsigned Conway-exponent orientation of LM24, Definition 8.2.6. It retains +the zero Archimedean class, which is relevant to constant coefficients other than zero and one. +-/ + +universe u + +public noncomputable section + +namespace ZFSet.Surreal + +/-- The canonical Conway normal-form chart of the class-coded surreal field. -/ +def toHahnSeriesOrderIso : Surreal.{u} ≃o SurrealHahnSeries.{u} := + orderRingEquiv.toOrderIso.trans _root_.Surreal.toHahnSeriesOrderIso + +@[simp] +theorem toHahnSeriesOrderIso_apply (x : Surreal.{u}) : + toHahnSeriesOrderIso x = (toSurreal x).toHahnSeries := by + simp [toHahnSeriesOrderIso] + +/-- The Conway normal form of a class-coded surreal value. -/ +def toHahnSeries (x : Surreal.{u}) : SurrealHahnSeries.{u} := toHahnSeriesOrderIso x + +@[simp] +theorem toHahnSeries_eq_toSurreal (x : Surreal.{u}) : + toHahnSeries x = (toSurreal x).toHahnSeries := toHahnSeriesOrderIso_apply x + +/-- A class value has a given normal form exactly when that series evaluates to its value. -/ +theorem toHahnSeries_eq_iff (x : Surreal.{u}) (s : SurrealHahnSeries.{u}) : + toHahnSeries x = s ↔ toSurreal x = s.toSurreal := by + constructor + · intro h + have hvalue := congrArg SurrealHahnSeries.toSurreal h + simpa only [toHahnSeries_eq_toSurreal, _root_.Surreal.toSurreal_toHahnSeries] using hvalue + · intro h + rw [toHahnSeries_eq_toSurreal, h, SurrealHahnSeries.toHahnSeries_toSurreal] + +/-- The coefficient at a class-coded Conway exponent. -/ +def coeff (x i : Surreal.{u}) : ℝ := (toHahnSeries x).coeff (toSurreal i) + +@[simp] +theorem coeff_eq_toSurreal (x i : Surreal.{u}) : + coeff x i = (toSurreal x).coeff (toSurreal i) := by + rw [coeff, toHahnSeries_eq_toSurreal, _root_.Surreal.coeff_toHahnSeries] + +/-- The Conway support, indexed by the class-coded surreal exponents. -/ +def support (x : Surreal.{u}) : Set Surreal.{u} := toSurreal ⁻¹' (toSurreal x).support + +/-- Membership in the class-coded support is detected by evaluating the exponent. -/ +theorem mem_support_iff_toSurreal (x i : Surreal.{u}) : + i ∈ support x ↔ toSurreal i ∈ (toSurreal x).support := (Iff.rfl) + +@[simp] +theorem mem_support_iff (x i : Surreal.{u}) : i ∈ support x ↔ coeff x i ≠ 0 := by + rw [mem_support_iff_toSurreal, _root_.Surreal.mem_support_iff, coeff_eq_toSurreal] + +/-- Evaluation maps the class-coded support onto exactly the Conway support. -/ +theorem image_support (x : Surreal.{u}) : + toSurreal '' support x = (toSurreal x).support := + Set.image_preimage_eq _ toSurreal_surjective + +/-- A normal form has only a set-sized collection of class-coded exponents. -/ +instance (x : Surreal.{u}) : Small.{u} (support x) := by + refine small_of_injective (f := fun i : support x ↦ + (⟨toSurreal i, (mem_support_iff_toSurreal x i).1 i.property⟩ : + (toSurreal x).support)) ?_ + intro i j h + apply Subtype.ext + exact toSurreal_injective (congrArg Subtype.val h) + +/-- Evaluation preserves the support intersection used by reducedness. -/ +theorem image_support_inter_support_sub_one (x : Surreal.{u}) : + toSurreal '' (support x ∩ support (x - 1)) = + (toSurreal x).support ∩ (toSurreal x - 1).support := by + rw [Set.image_inter toSurreal_injective, image_support, image_support, + toSurreal_sub, toSurreal_one] + +/-- Evaluation induces an order-preserving map on additive Archimedean classes. -/ +def archimedeanClassMap : + ArchimedeanClass Surreal.{u} →o ArchimedeanClass _root_.Surreal.{u} := + ArchimedeanClass.orderHom orderRingEquiv.toOrderRingHom.toOrderAddMonoidHom + +@[simp] +theorem archimedeanClassMap_mk (i : Surreal.{u}) : + archimedeanClassMap (ArchimedeanClass.mk i) = ArchimedeanClass.mk (toSurreal i) := by + simp [archimedeanClassMap] + +/-- Distinct class-coded Archimedean classes remain distinct after evaluation. -/ +theorem archimedeanClassMap_injective : Function.Injective (archimedeanClassMap.{u}) := + ArchimedeanClass.orderHom_injective orderRingEquiv.injective + +/-- Every surreal Archimedean class is represented by class-coded exponents. -/ +theorem archimedeanClassMap_surjective : Function.Surjective (archimedeanClassMap.{u}) := by + intro c + induction c using ArchimedeanClass.ind with + | mk i => + obtain ⟨j, rfl⟩ := toSurreal_surjective i + exact ⟨ArchimedeanClass.mk j, archimedeanClassMap_mk j⟩ + +/-- Evaluation identifies exactly the Archimedean classes met by the two supports. -/ +theorem image_supportArchimedeanClasses (x : Surreal.{u}) : + archimedeanClassMap '' (ArchimedeanClass.mk '' support x) = + ArchimedeanClass.mk '' (toSurreal x).support := by + calc + _ = (fun i ↦ ArchimedeanClass.mk (toSurreal i)) '' support x := by + simp only [Set.image_image, archimedeanClassMap_mk] + _ = ArchimedeanClass.mk '' (toSurreal '' support x) := by rw [Set.image_image] + _ = _ := by rw [image_support] + +/-- The Conway support meets only finitely many additive Archimedean classes. -/ +def HasFiniteSupportClasses (x : Surreal.{u}) : Prop := + (ArchimedeanClass.mk '' support x).Finite + +/-- The defining set formula for finite support-class number. -/ +theorem hasFiniteSupportClasses_iff (x : Surreal.{u}) : + HasFiniteSupportClasses x ↔ (ArchimedeanClass.mk '' support x).Finite := (Iff.rfl) + +/-- Finite support-class number is unchanged by evaluation in the surreal field. -/ +theorem hasFiniteSupportClasses_iff_toSurreal (x : Surreal.{u}) : + HasFiniteSupportClasses x ↔ (ArchimedeanClass.mk '' (toSurreal x).support).Finite := by + rw [hasFiniteSupportClasses_iff, ← image_supportArchimedeanClasses] + exact (Set.finite_image_iff archimedeanClassMap_injective.injOn).symm + +/-- LM24 reducedness: a nonzero class value whose support and support after subtracting one +intersect in a single Archimedean class, including the possible zero class. -/ +def IsReduced (x : Surreal.{u}) : Prop := + x ≠ 0 ∧ ∃ c : ArchimedeanClass Surreal.{u}, + support x ∩ support (x - 1) ⊆ {i | ArchimedeanClass.mk i = c} + +/-- The defining nonzero and support-intersection conditions for class-coded reducedness. -/ +theorem isReduced_iff (x : Surreal.{u}) : + IsReduced x ↔ x ≠ 0 ∧ ∃ c : ArchimedeanClass Surreal.{u}, + support x ∩ support (x - 1) ⊆ {i | ArchimedeanClass.mk i = c} := (Iff.rfl) + +/-- Class-coded reducedness is exactly the unsigned Conway-support formula after evaluation. -/ +theorem isReduced_iff_toSurreal (x : Surreal.{u}) : + IsReduced x ↔ toSurreal x ≠ 0 ∧ ∃ c : ArchimedeanClass _root_.Surreal.{u}, + (toSurreal x).support ∩ (toSurreal x - 1).support ⊆ + {i | ArchimedeanClass.mk i = c} := by + rw [isReduced_iff] + have hzero : x ≠ 0 ↔ toSurreal x ≠ 0 := by + constructor + · intro hx h + exact hx (toSurreal_injective (h.trans toSurreal_zero.symm)) + · intro hx h + exact hx (h ▸ toSurreal_zero) + constructor + · rintro ⟨hx, c, hc⟩ + refine ⟨hzero.mp hx, archimedeanClassMap c, ?_⟩ + intro i hi + rw [← image_support_inter_support_sub_one] at hi + obtain ⟨j, hj, rfl⟩ := hi + change ArchimedeanClass.mk (toSurreal j) = archimedeanClassMap c + rw [← archimedeanClassMap_mk] + exact congrArg archimedeanClassMap (hc hj) + · rintro ⟨hx, c, hc⟩ + obtain ⟨c, rfl⟩ := archimedeanClassMap_surjective c + refine ⟨hzero.mpr hx, c, ?_⟩ + intro i hi + apply archimedeanClassMap_injective + rw [archimedeanClassMap_mk] + apply hc + rw [← image_support_inter_support_sub_one] + exact ⟨i, hi, rfl⟩ + +end ZFSet.Surreal diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/OmnificCodes.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/OmnificCodes.lean new file mode 100644 index 0000000000..2e483862d3 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/OmnificCodes.lean @@ -0,0 +1,181 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificInteger +public import Mathlib.Algebra.Group.Irreducible.Defs +public import Mathlib.Algebra.Prime.Defs + +import Mathlib.Algebra.Divisibility.Units + +/-! +# Factorisation predicates quantified over omnific ZFC codes + +All factors and divisibility witnesses below range over the full class of omnific game codes. +Products use Conway's recursive multiplication and equality is Conway equivalence. The +surjectivity of evaluation identifies these formulas with the usual ring predicates. +-/ + +universe u + +public noncomputable section + +namespace ZFSet + +/-- A ZFC game code satisfying Conway's omnific-integer equation. -/ +structure OmnificCode where + code : GameCode.{u} + omnific : code.IsOmnificInteger + +namespace OmnificCode + +/-- The actual omnific integer represented by a set code. -/ +def value (x : OmnificCode.{u}) : _root_.Surreal.OmnificInteger.{u} := + ⟨Surreal.toSurreal (Surreal.mk x.code x.omnific.isNumeric), + _root_.Surreal.mem_omnificIntegers.2 + ((GameCode.isOmnificInteger_iff_toSurreal _ _).1 x.omnific)⟩ + +@[simp] +theorem coe_value (x : OmnificCode.{u}) : (x.value : _root_.Surreal.{u}) = + Surreal.toSurreal (Surreal.mk x.code x.omnific.isNumeric) := (rfl) + +/-- Every omnific integer, including every possible factor or divisor, has a set code. -/ +theorem value_surjective : Function.Surjective (value.{u}) := by + intro b + let c := GameCode.ofIGame (b : _root_.Surreal.{u}).out + have hc : c.IsNumeric := (GameCode.isNumeric_ofIGame _).2 inferInstance + have hval : Surreal.toSurreal (Surreal.mk c hc) = (b : _root_.Surreal.{u}) := by + rw [Surreal.toSurreal_mk] + simp only [c, GameCode.toIGame_ofIGame, _root_.Surreal.out_eq] + have hb : c.IsOmnificInteger := (GameCode.isOmnificInteger_iff_toSurreal c hc).2 (by + rw [hval] + exact _root_.Surreal.mem_omnificIntegers.1 b.2) + exact ⟨⟨c, hb⟩, Subtype.ext hval⟩ + +/-- Equality of omnific codes means Conway equivalence, not literal code equality. -/ +def Equivalent (x y : OmnificCode.{u}) : Prop := AntisymmRel (· ≤ ·) x.code y.code + +/-- The equality relation on codes agrees exactly with equality of their values. -/ +theorem equivalent_iff (x y : OmnificCode.{u}) : Equivalent x y ↔ x.value = y.value := by + rw [Subtype.ext_iff, coe_value, coe_value] + rw [Surreal.toSurreal_injective.eq_iff, Surreal.mk_eq_mk] + rfl + +instance : Zero OmnificCode.{u} := ⟨⟨0, + (GameCode.isOmnificInteger_iff_toSurreal 0 GameCode.isNumeric_zero).2 (by + rw [Surreal.mk_zero, Surreal.toSurreal_zero] + exact _root_.Surreal.isOmnificInteger_zero)⟩⟩ + +instance : One OmnificCode.{u} := ⟨⟨1, + (GameCode.isOmnificInteger_iff_toSurreal 1 GameCode.isNumeric_one).2 (by + rw [Surreal.mk_one, Surreal.toSurreal_one] + exact _root_.Surreal.isOmnificInteger_one)⟩⟩ + +instance : Mul OmnificCode.{u} := ⟨fun x y ↦ ⟨x.code * y.code, + (GameCode.isOmnificInteger_iff_toSurreal _ + (x.omnific.isNumeric.mul y.omnific.isNumeric)).2 (by + rw [Surreal.mk_mul _ _ x.omnific.isNumeric y.omnific.isNumeric, Surreal.toSurreal_mul] + exact ((GameCode.isOmnificInteger_iff_toSurreal _ _).1 x.omnific).mul + ((GameCode.isOmnificInteger_iff_toSurreal _ _).1 y.omnific))⟩⟩ + +@[simp] +theorem code_zero : (0 : OmnificCode.{u}).code = 0 := (rfl) + +@[simp] +theorem code_one : (1 : OmnificCode.{u}).code = 1 := (rfl) + +@[simp] +theorem code_mul (x y : OmnificCode.{u}) : (x * y).code = x.code * y.code := (rfl) + +@[simp] +theorem value_zero : (0 : OmnificCode.{u}).value = 0 := by + apply Subtype.ext + simp only [coe_value, code_zero, Surreal.mk_zero, Surreal.toSurreal_zero] + rfl + +@[simp] +theorem value_one : (1 : OmnificCode.{u}).value = 1 := by + apply Subtype.ext + simp only [coe_value, code_one, Surreal.mk_one, Surreal.toSurreal_one] + rfl + +@[simp] +theorem value_mul (x y : OmnificCode.{u}) : (x * y).value = x.value * y.value := by + apply Subtype.ext + change Surreal.toSurreal (Surreal.mk (x.code * y.code) + (x.omnific.isNumeric.mul y.omnific.isNumeric)) = + Surreal.toSurreal (Surreal.mk x.code x.omnific.isNumeric) * + Surreal.toSurreal (Surreal.mk y.code y.omnific.isNumeric) + rw [Surreal.mk_mul _ _ x.omnific.isNumeric y.omnific.isNumeric, Surreal.toSurreal_mul] + +/-- Divisibility with an omnific set-code witness and Conway equality. -/ +def Divides (x y : OmnificCode.{u}) : Prop := ∃ z, Equivalent y (x * z) + +/-- Units are codes with an omnific multiplicative inverse. -/ +def IsUnit (x : OmnificCode.{u}) : Prop := Divides x 1 + +/-- Irreducibility tested against every pair of omnific codes. -/ +def IsIrreducible (x : OmnificCode.{u}) : Prop := + ¬x.IsUnit ∧ ∀ a b, Equivalent x (a * b) → a.IsUnit ∨ b.IsUnit + +/-- Primality tested against every pair of omnific codes and every divisibility witness. -/ +def IsPrime (x : OmnificCode.{u}) : Prop := + ¬Equivalent x 0 ∧ ¬x.IsUnit ∧ + ∀ a b, Divides x (a * b) → Divides x a ∨ Divides x b + +/-- Code divisibility is exactly divisibility in the omnific-integer ring. -/ +theorem divides_iff (x y : OmnificCode.{u}) : Divides x y ↔ x.value ∣ y.value := by + constructor + · rintro ⟨z, hz⟩ + exact ⟨z.value, by simpa only [value_mul] using (equivalent_iff _ _).1 hz⟩ + · rintro ⟨z, hz⟩ + obtain ⟨c, rfl⟩ := value_surjective z + exact ⟨c, (equivalent_iff _ _).2 (by simpa only [value_mul] using hz)⟩ + +/-- Code units are exactly units in the omnific-integer ring. -/ +theorem isUnit_iff (x : OmnificCode.{u}) : x.IsUnit ↔ _root_.IsUnit x.value := by + rw [IsUnit, divides_iff, value_one, isUnit_iff_dvd_one] + +/-- Code irreducibility is the unrestricted ring-theoretic predicate. -/ +theorem isIrreducible_iff (x : OmnificCode.{u}) : + x.IsIrreducible ↔ Irreducible x.value := by + constructor + · rintro ⟨hu, h⟩ + refine ⟨fun hv ↦ hu ((isUnit_iff x).2 hv), ?_⟩ + intro a b hab + obtain ⟨ca, rfl⟩ := value_surjective a + obtain ⟨cb, rfl⟩ := value_surjective b + have hc := h ca cb ((equivalent_iff _ _).2 (by simpa only [value_mul] using hab)) + exact hc.imp (isUnit_iff _).1 (isUnit_iff _).1 + · intro h + refine ⟨fun hu ↦ h.not_isUnit ((isUnit_iff _).1 hu), ?_⟩ + intro a b hab + have hv : x.value = a.value * b.value := by + simpa only [value_mul] using (equivalent_iff _ _).1 hab + exact (h.isUnit_or_isUnit hv).imp (isUnit_iff _).2 (isUnit_iff _).2 + +/-- Code primality is the unrestricted ring-theoretic predicate. -/ +theorem isPrime_iff (x : OmnificCode.{u}) : x.IsPrime ↔ Prime x.value := by + constructor + · rintro ⟨hz, hu, h⟩ + refine ⟨fun hv ↦ hz ((equivalent_iff _ _).2 (by simpa only [value_zero] using hv)), + fun hv ↦ hu ((isUnit_iff _).2 hv), ?_⟩ + intro a b hab + obtain ⟨ca, rfl⟩ := value_surjective a + obtain ⟨cb, rfl⟩ := value_surjective b + have hc := h ca cb ((divides_iff _ _).2 (by simpa only [value_mul] using hab)) + exact hc.imp (divides_iff _ _).1 (divides_iff _ _).1 + · intro h + refine ⟨fun hz ↦ h.ne_zero (by + simpa only [value_zero] using (equivalent_iff _ _).1 hz), + fun hu ↦ h.not_unit ((isUnit_iff _).1 hu), ?_⟩ + intro a b hab + have hv : x.value ∣ a.value * b.value := by + simpa only [value_mul] using (divides_iff _ _).1 hab + exact (h.dvd_or_dvd hv).imp (divides_iff _ _).2 (divides_iff _ _).2 + +end OmnificCode +end ZFSet diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/OmnificInteger.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/OmnificInteger.lean new file mode 100644 index 0000000000..58d69ddbce --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/OmnificInteger.lean @@ -0,0 +1,140 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Basic +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Basic + +/-! +# The omnific-integer class + +An omnific code is numeric and Conway equivalent to the singleton cut `{x - 1 | x + 1}`. +The corresponding class values form a subring, identified exactly with the cut-defined omnific +integers. Equality here is equality of numeric values, not equality of their codes. +-/ + +universe u + +public noncomputable section + +namespace ZFSet +namespace GameCode + +/-- Conway's omnific-integer condition on a numeric set-coded game. -/ +def IsOmnificInteger (x : GameCode.{u}) : Prop := + x.IsNumeric ∧ AntisymmRel (· ≤ ·) x (ofSets {x - 1} {x + 1}) + +/-- An omnific game code is numeric. -/ +theorem IsOmnificInteger.isNumeric {x : GameCode.{u}} (h : x.IsOmnificInteger) : x.IsNumeric := + h.1 + +/-- The code condition is precisely fixedness under Conway's defining singleton cut. -/ +theorem isOmnificInteger_iff (x : GameCode.{u}) : x.IsOmnificInteger ↔ + x.IsNumeric ∧ AntisymmRel (· ≤ ·) x (ofSets {x - 1} {x + 1}) := (Iff.rfl) + +/-- The set-code condition agrees with the actual omnific-integer predicate. -/ +theorem isOmnificInteger_iff_toSurreal (x : GameCode.{u}) (hx : x.IsNumeric) : + x.IsOmnificInteger ↔ _root_.Surreal.IsOmnificInteger (Surreal.toSurreal (Surreal.mk x hx)) := by + letI : IGame.Numeric x.toIGame := (isNumeric_iff _).1 hx + rw [isOmnificInteger_iff, and_iff_right hx, Surreal.toSurreal_mk, + _root_.Surreal.isOmnificInteger_mk_iff] + rw [← toIGame_equiv_toIGame] + simp only [toIGame_ofSets, Set.image_singleton, toIGame_sub, toIGame_add, toIGame_one] + +end GameCode + +namespace Surreal + +/-- A class value is omnific when a numeric code satisfies Conway's singleton-cut equation. -/ +def IsOmnificInteger (x : Surreal.{u}) : Prop := + ∃ (c : GameCode.{u}) (hc : c.IsNumeric), mk c hc = x ∧ c.IsOmnificInteger + +/-- The class and library predicates select exactly the same omnific integers. -/ +theorem isOmnificInteger_iff (x : Surreal.{u}) : + x.IsOmnificInteger ↔ _root_.Surreal.IsOmnificInteger x.toSurreal := by + constructor + · rintro ⟨c, hc, rfl, h⟩ + exact (GameCode.isOmnificInteger_iff_toSurreal c hc).1 h + · intro h + obtain ⟨c, hc, rfl⟩ := exists_mk x + exact ⟨c, hc, rfl, (GameCode.isOmnificInteger_iff_toSurreal c hc).2 h⟩ + +/-- The subring of class values satisfying Conway's omnific-integer equation. -/ +def omnificIntegers : Subring Surreal.{u} where + carrier := {x | x.IsOmnificInteger} + zero_mem' := (isOmnificInteger_iff _).2 (by + rw [toSurreal_zero] + exact _root_.Surreal.isOmnificInteger_zero) + one_mem' := (isOmnificInteger_iff _).2 (by + rw [toSurreal_one] + exact _root_.Surreal.isOmnificInteger_one) + add_mem' hx hy := (isOmnificInteger_iff _).2 (by + rw [toSurreal_add] + exact ((isOmnificInteger_iff _).1 hx).add ((isOmnificInteger_iff _).1 hy)) + neg_mem' hx := (isOmnificInteger_iff _).2 (by + rw [toSurreal_neg] + exact ((isOmnificInteger_iff _).1 hx).neg) + mul_mem' hx hy := (isOmnificInteger_iff _).2 (by + rw [toSurreal_mul] + exact ((isOmnificInteger_iff _).1 hx).mul ((isOmnificInteger_iff _).1 hy)) + +@[simp] +theorem mem_omnificIntegers (x : Surreal.{u}) : + x ∈ omnificIntegers ↔ x.IsOmnificInteger := (Iff.rfl) + +/-- The class presentation of Conway's omnific-integer ring. -/ +abbrev OmnificInteger := ↥(omnificIntegers : Subring Surreal.{u}) + +namespace OmnificInteger + +/-- Evaluate an omnific class value in the library's omnific-integer ring. -/ +def toOmnificInteger (x : OmnificInteger.{u}) : _root_.Surreal.OmnificInteger.{u} := + ⟨toSurreal x, _root_.Surreal.mem_omnificIntegers.2 + ((isOmnificInteger_iff _).1 ((mem_omnificIntegers _).1 x.2))⟩ + +@[simp] +theorem coe_toOmnificInteger (x : OmnificInteger.{u}) : + (toOmnificInteger x : _root_.Surreal.{u}) = toSurreal (x : Surreal.{u}) := (rfl) + +/-- An exact equivalence of omnific-integer rings, covering all elements and witnesses. -/ +def ringEquiv : OmnificInteger.{u} ≃+* _root_.Surreal.OmnificInteger.{u} where + toFun := toOmnificInteger + invFun x := ⟨equiv.symm x, (mem_omnificIntegers _).2 ((isOmnificInteger_iff _).2 (by + simpa only [← equiv_apply, equiv.apply_symm_apply] using + (_root_.Surreal.mem_omnificIntegers.1 x.2)))⟩ + left_inv x := by + apply Subtype.ext + change equiv.symm (toSurreal (x : Surreal.{u})) = (x : Surreal.{u}) + rw [← equiv_apply, equiv.symm_apply_apply] + right_inv x := by + apply Subtype.ext + change toSurreal (equiv.symm (x : _root_.Surreal.{u})) = (x : _root_.Surreal.{u}) + rw [← equiv_apply, equiv.apply_symm_apply] + map_add' x y := Subtype.ext (toSurreal_add x y) + map_mul' x y := Subtype.ext (toSurreal_mul x y) + +@[simp] +theorem ringEquiv_apply (x : OmnificInteger.{u}) : ringEquiv x = toOmnificInteger x := (rfl) + +@[simp] +theorem toSurreal_coe_ringEquiv_symm (x : _root_.Surreal.OmnificInteger.{u}) : + toSurreal (ringEquiv.symm x : Surreal.{u}) = (x : _root_.Surreal.{u}) := by + simpa only [ringEquiv_apply, coe_toOmnificInteger] using + congrArg (fun y : _root_.Surreal.OmnificInteger.{u} ↦ (y : _root_.Surreal.{u})) + (ringEquiv.apply_symm_apply x) + +/-- The omnific-ring comparison also preserves order. -/ +def orderRingEquiv : OmnificInteger.{u} ≃+*o _root_.Surreal.OmnificInteger.{u} where + __ := ringEquiv + map_le_map_iff' := toSurreal_le_toSurreal _ _ + +@[simp] +theorem orderRingEquiv_apply (x : OmnificInteger.{u}) : + orderRingEquiv x = toOmnificInteger x := (rfl) + +end OmnificInteger +end Surreal +end ZFSet diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Properness.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Properness.lean new file mode 100644 index 0000000000..375dfbc451 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Properness.lean @@ -0,0 +1,216 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificCodes +public import Mathlib.SetTheory.ZFC.Class +public import Mathlib.Logic.Small.Defs + +import Mathlib.Logic.Small.Basic +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Cardinal +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Ordinal + +/-! +# Proper ZFC classes of numeric and omnific game codes + +The intrinsic predicates on ZFC sets select numeric game codes and omnific-integer game codes. +Neither class is represented by a ZFC set. This is witnessed by the size of the distinct values: +evaluation covers every surreal number or omnific integer, and neither value type is small in +the universe of option sets. The quotient presentations of those values are likewise not small. +-/ + +universe u + +public noncomputable section + +namespace Surreal.OmnificInteger + +/-- Omnific integers with option sets in universe `u` are not `u`-small. -/ +theorem not_small : ¬Small.{u} OmnificInteger.{u} := by + intro h + letI : Small.{u} OmnificInteger.{u} := h + let f : Ordinal.{u} → OmnificInteger.{u} := fun o ↦ + ⟨(NatOrdinal.of o).toSurreal, NatOrdinal.toSurreal_mem_omnificIntegers (NatOrdinal.of o)⟩ + apply not_injective_of_ordinal f + intro a b hab + exact NatOrdinal.of.injective (NatOrdinal.toSurreal.injective (congrArg Subtype.val hab)) + +end Surreal.OmnificInteger + +namespace ZFSet + +/-- The ZFC class of sets satisfying the game-code grammar and Conway's numeric condition. -/ +def numericGameCodes : Class.{u} := + fun z ↦ ∃ h : IsGameCode z, (GameCode.mk z h).IsNumeric + +/-- Membership in the numeric-code class is the intrinsic numeric predicate on a game code. -/ +theorem numericGameCodes_iff (z : ZFSet.{u}) : + numericGameCodes z ↔ ∃ h : IsGameCode z, (GameCode.mk z h).IsNumeric := (Iff.rfl) + +/-- The ZFC class of game codes satisfying Conway's omnific-integer condition. -/ +def omnificGameCodes : Class.{u} := + fun z ↦ ∃ h : IsGameCode z, (GameCode.mk z h).IsOmnificInteger + +/-- Membership in the omnific-code class is Conway's omnific-integer predicate on a game code. -/ +theorem omnificGameCodes_iff (z : ZFSet.{u}) : + omnificGameCodes z ↔ ∃ h : IsGameCode z, (GameCode.mk z h).IsOmnificInteger := (Iff.rfl) + +/-- Every omnific code is numeric. -/ +theorem omnificGameCodes_subset_numericGameCodes : + omnificGameCodes.{u} ⊆ numericGameCodes.{u} := by + intro z hz + obtain ⟨h, hm⟩ := (omnificGameCodes_iff z).1 hz + exact (numericGameCodes_iff z).2 ⟨h, hm.isNumeric⟩ + +namespace GameCode + +/-- A game code belongs to the numeric class exactly when it is numeric. -/ +theorem mem_numericGameCodes (x : GameCode.{u}) : numericGameCodes (x : ZFSet.{u}) ↔ + x.IsNumeric := by + rw [numericGameCodes_iff] + constructor + · rintro ⟨h, hx⟩ + simpa only [mk_coe] using hx + · intro hx + exact ⟨x.isGameCode, by simpa only [mk_coe] using hx⟩ + +/-- A game code belongs to the omnific class exactly when it is an omnific code. -/ +theorem mem_omnificGameCodes (x : GameCode.{u}) : omnificGameCodes (x : ZFSet.{u}) ↔ + x.IsOmnificInteger := by + rw [omnificGameCodes_iff] + constructor + · rintro ⟨h, hx⟩ + simpa only [mk_coe] using hx + · intro hx + exact ⟨x.isGameCode, by simpa only [mk_coe] using hx⟩ + +end GameCode + +namespace NumericGameCode + +/-- Numeric codes with the same underlying game code are equal. -/ +@[ext] +theorem ext {x y : NumericGameCode.{u}} (h : x.code = y.code) : x = y := by + cases x + cases y + cases h + rfl + +/-- The underlying ZFC set distinguishes literal numeric codes. -/ +theorem coe_code_injective : + Function.Injective (fun x : NumericGameCode.{u} ↦ (x.code : ZFSet.{u})) := + fun _ _ h ↦ ext (GameCode.ext h) + +/-- Every typed numeric code belongs to the intrinsic ZFC class. -/ +theorem mem_numericGameCodes (x : NumericGameCode.{u}) : + numericGameCodes (x.code : ZFSet.{u}) := (GameCode.mem_numericGameCodes _).2 x.numeric + +/-- Numeric game codes are not small, because their values cover all surreal numbers. -/ +theorem not_small : ¬Small.{u} NumericGameCode.{u} := by + intro h + letI : Small.{u} NumericGameCode.{u} := h + exact _root_.Surreal.not_small (small_of_surjective toSurreal_surjective) + +end NumericGameCode + +/-- The intrinsic numeric-code class consists exactly of the underlying sets of numeric codes. -/ +theorem numericGameCodes_iff_exists (z : ZFSet.{u}) : + numericGameCodes z ↔ ∃ c : NumericGameCode.{u}, (c.code : ZFSet.{u}) = z := by + constructor + · intro hz + obtain ⟨h, hn⟩ := (numericGameCodes_iff z).1 hz + exact ⟨⟨GameCode.mk z h, hn⟩, GameCode.coe_mk z h⟩ + · rintro ⟨c, rfl⟩ + exact c.mem_numericGameCodes + +namespace OmnificCode + +/-- Omnific codes with the same underlying game code are equal. -/ +@[ext] +theorem ext {x y : OmnificCode.{u}} (h : x.code = y.code) : x = y := by + cases x + cases y + cases h + rfl + +/-- The underlying ZFC set distinguishes literal omnific codes. -/ +theorem coe_code_injective : + Function.Injective (fun x : OmnificCode.{u} ↦ (x.code : ZFSet.{u})) := + fun _ _ h ↦ ext (GameCode.ext h) + +/-- Every typed omnific code belongs to the intrinsic ZFC class. -/ +theorem mem_omnificGameCodes (x : OmnificCode.{u}) : + omnificGameCodes (x.code : ZFSet.{u}) := (GameCode.mem_omnificGameCodes _).2 x.omnific + +/-- Omnific game codes are not small, because their values cover all omnific integers. -/ +theorem not_small : ¬Small.{u} OmnificCode.{u} := by + intro h + letI : Small.{u} OmnificCode.{u} := h + exact _root_.Surreal.OmnificInteger.not_small (small_of_surjective value_surjective) + +end OmnificCode + +/-- The intrinsic omnific-code class consists exactly of the underlying sets of omnific codes. -/ +theorem omnificGameCodes_iff_exists (z : ZFSet.{u}) : + omnificGameCodes z ↔ ∃ c : OmnificCode.{u}, (c.code : ZFSet.{u}) = z := by + constructor + · intro hz + obtain ⟨h, hn⟩ := (omnificGameCodes_iff z).1 hz + exact ⟨⟨GameCode.mk z h, hn⟩, GameCode.coe_mk z h⟩ + · rintro ⟨c, rfl⟩ + exact c.mem_omnificGameCodes + +private theorem class_ne_ofSet_of_not_small {α : Type (u + 1)} (f : α → ZFSet.{u}) + (hf : Function.Injective f) (C : Class.{u}) (hC : ∀ x, C (f x)) + (hα : ¬Small.{u} α) (s : ZFSet.{u}) : C ≠ Class.ofSet s := by + intro h + let g : α → s := fun x ↦ ⟨f x, by + apply Class.coe_apply.1 + rw [← h] + exact hC x⟩ + exact hα (small_of_injective (f := g) (fun _ _ hab ↦ hf (congrArg Subtype.val hab))) + +/-- No ZFC set has exactly the numeric game codes as its elements. -/ +theorem numericGameCodes_ne_ofSet (s : ZFSet.{u}) : numericGameCodes ≠ Class.ofSet s := + class_ne_ofSet_of_not_small _ NumericGameCode.coe_code_injective _ + NumericGameCode.mem_numericGameCodes NumericGameCode.not_small s + +/-- Numeric game codes form a proper ZFC class, with a proper class of distinct surreal values. -/ +theorem numericGameCodes_notMem_univ : numericGameCodes ∉ Class.univ.{u} := by + intro h + obtain ⟨s, hs⟩ := Class.mem_univ.1 h + exact numericGameCodes_ne_ofSet s hs.symm + +/-- No ZFC set has exactly the omnific game codes as its elements. -/ +theorem omnificGameCodes_ne_ofSet (s : ZFSet.{u}) : omnificGameCodes ≠ Class.ofSet s := + class_ne_ofSet_of_not_small _ OmnificCode.coe_code_injective _ + OmnificCode.mem_omnificGameCodes OmnificCode.not_small s + +/-- Omnific codes form a proper ZFC class, with a proper class of distinct omnific values. -/ +theorem omnificGameCodes_notMem_univ : omnificGameCodes ∉ Class.univ.{u} := by + intro h + obtain ⟨s, hs⟩ := Class.mem_univ.1 h + exact omnificGameCodes_ne_ofSet s hs.symm + +namespace Surreal + +/-- Distinct Conway-equivalence classes of numeric ZFC game codes do not form a small type. -/ +theorem not_small : ¬Small.{u} Surreal.{u} := by + intro h + letI : Small.{u} Surreal.{u} := h + exact _root_.Surreal.not_small (small_of_surjective toSurreal_surjective) + +namespace OmnificInteger + +/-- Distinct omnific values in the class presentation do not form a small type. -/ +theorem not_small : ¬Small.{u} OmnificInteger.{u} := by + intro h + letI : Small.{u} OmnificInteger.{u} := h + exact _root_.Surreal.OmnificInteger.not_small (small_of_surjective ringEquiv.surjective) + +end OmnificInteger +end Surreal +end ZFSet diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Reduced.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Reduced.lean new file mode 100644 index 0000000000..262c43a0bd --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Reduced.lean @@ -0,0 +1,99 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificInteger +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduced +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.CardinalIntegerPart +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.SignedFull + +/-! +# Class-coded reducedness and the signed Hahn orientation + +The unsigned Conway support formula is equivalent to LM24 reducedness of the signed nonpositive +Hahn series. Negating an exponent preserves its additive Archimedean class, including the zero +class. Consequently the native reducedness predicate on class-coded omnific integers is exactly +the reducedness hypothesis used by the signed Hahn-series theorems. +-/ + +universe u + +public noncomputable section + +namespace Surreal.OmnificInteger + +/-- LM24 reducedness in the signed orientation is exactly the unsigned Conway-support formula. -/ +theorem isReduced_toSignedNonpositiveHahn_iff_support (x : OmnificInteger.{u}) : + HahnSeries.Nonpositive.IsReduced x.toSignedNonpositiveHahn ↔ + (x : Surreal.{u}) ≠ 0 ∧ ∃ c : ArchimedeanClass Surreal.{u}, + (x : Surreal.{u}).support ∩ ((x : Surreal.{u}) - 1).support ⊆ + {i | ArchimedeanClass.mk i = c} := by + have hsub : ((x.toSignedNonpositiveHahn - 1 : HahnSeries.Nonpositive Surreal ℝ) : + HahnSeries Surreal ℝ) = ((x : Surreal) - 1).toSignedFullHahnSeries := by + calc + _ = (x.toSignedNonpositiveHahn : HahnSeries Surreal ℝ) - 1 := rfl + _ = (x : Surreal).toSignedFullHahnSeries - 1 := by + rw [coe_toSignedNonpositiveHahn] + _ = ((x : Surreal) - 1).toSignedFullHahnSeries := by + rw [Surreal.toSignedFullHahnSeries_sub] + congr 1 + simpa using (Surreal.toSignedFullHahnSeries_realCast (1 : ℝ)).symm + have hmem (i : Surreal.{u}) : + i ∈ (x.toSignedNonpositiveHahn : HahnSeries Surreal ℝ).support ↔ + -i ∈ (x : Surreal).support := by + rw [coe_toSignedNonpositiveHahn, Surreal.mem_support_toSignedFullHahnSeries] + have hmemSub (i : Surreal.{u}) : + i ∈ ((x.toSignedNonpositiveHahn - 1 : HahnSeries.Nonpositive Surreal ℝ) : + HahnSeries Surreal ℝ).support ↔ -i ∈ ((x : Surreal) - 1).support := by + rw [hsub, Surreal.mem_support_toSignedFullHahnSeries] + have hzero : x.toSignedNonpositiveHahn ≠ 0 ↔ (x : Surreal) ≠ 0 := by + constructor + · intro hx h + apply hx + apply Subtype.ext + rw [coe_toSignedNonpositiveHahn, h, Surreal.toSignedFullHahnSeries_zero] + rfl + · intro hx h + apply hx + apply Surreal.toSignedFullHahnSeries_injective + have hraw := congrArg (fun q : HahnSeries.Nonpositive Surreal ℝ ↦ + (q : HahnSeries Surreal ℝ)) h + rw [coe_toSignedNonpositiveHahn] at hraw + exact hraw.trans Surreal.toSignedFullHahnSeries_zero.symm + constructor + · intro hx + obtain ⟨hx0, c, hc⟩ := hx.elim + refine ⟨hzero.mp hx0, c, ?_⟩ + intro i hi + have hsigned : -i ∈ (x.toSignedNonpositiveHahn : HahnSeries Surreal ℝ).support ∩ + ((x.toSignedNonpositiveHahn - 1 : HahnSeries.Nonpositive Surreal ℝ) : + HahnSeries Surreal ℝ).support := by + constructor + · exact (hmem (-i)).2 (by simpa only [neg_neg] using hi.1) + · exact (hmemSub (-i)).2 (by simpa only [neg_neg] using hi.2) + simpa only [Set.mem_setOf_eq, ArchimedeanClass.mk_neg] using hc hsigned + · rintro ⟨hx0, c, hc⟩ + refine HahnSeries.Nonpositive.isReduced_of_support_inter_support_sub_one_subset + (hzero.mpr hx0) c ?_ + intro i hi + have hunsigned : -i ∈ (x : Surreal).support ∩ ((x : Surreal) - 1).support := + ⟨(hmem i).1 hi.1, (hmemSub i).1 hi.2⟩ + simpa only [Set.mem_setOf_eq, ArchimedeanClass.mk_neg] using hc hunsigned + +end Surreal.OmnificInteger + +namespace ZFSet.Surreal.OmnificInteger + +/-- Native class-coded reducedness is equivalent to the signed Hahn reducedness hypothesis. -/ +theorem isReduced_iff_toSignedNonpositiveHahn (x : OmnificInteger.{u}) : + ZFSet.Surreal.IsReduced (x : ZFSet.Surreal.{u}) ↔ + HahnSeries.Nonpositive.IsReduced (ringEquiv x).toSignedNonpositiveHahn := by + rw [ZFSet.Surreal.isReduced_iff_toSurreal, + _root_.Surreal.OmnificInteger.isReduced_toSignedNonpositiveHahn_iff_support] + simp only [ringEquiv_apply, coe_toOmnificInteger] + +end ZFSet.Surreal.OmnificInteger diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Refinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Refinement.lean new file mode 100644 index 0000000000..310ad89958 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Refinement.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificInteger +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.RefinementConjecture +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage + +/-! +# Conway's refinement conjecture for class-coded omnific integers + +The cut-preserving ring equivalence identifies the four-factor formula on class-coded omnific +values with the formula on the surreal omnific-integer ring. All four inputs and all four factors +are unrestricted, including zero. This states the class presentation of LM24, +Conjecture 1.1.1(2); it does not assert the conjecture. +-/ + +universe u + +public noncomputable section + +namespace ZFSet.Surreal.OmnificInteger + +/-- Conway's four-factor conjecture in the class presentation; no nonzero hypotheses are imposed. -/ +def RefinementConjecture : Prop := HasFourFactorRefinement OmnificInteger.{u} + +/-- The class formulation is equivalent to the existing refinement conjecture, not a weakening. -/ +theorem refinementConjecture_iff : RefinementConjecture.{u} ↔ ConwayRefinementConjecture.{u} := by + rw [RefinementConjecture, hasFourFactorRefinement_iff_forall_isPrimal] + have htarget : ConwayRefinementConjecture.{u} ↔ + ∀ b : _root_.Surreal.OmnificInteger.{u}, IsPrimal b := by + rw [conwayRefinementConjecture_def, ← hasFourFactorRefinement_def, + hasFourFactorRefinement_iff_forall_isPrimal] + rw [htarget, ringEquiv.surjective.forall] + exact forall_congr' fun x ↦ (RingEquiv.isPrimal_iff ringEquiv x).symm + +end ZFSet.Surreal.OmnificInteger diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests.lean new file mode 100644 index 0000000000..3e6834e77f --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests.lean @@ -0,0 +1,12 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Cuts +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Identification +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Properness + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/Cuts.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/Cuts.lean new file mode 100644 index 0000000000..4bce81cde8 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/Cuts.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Cuts + +/-! +# Imported checks for class-coded Conway cuts + +The infinite left set of all natural numbers excludes a construction restricted to finite cuts +or collapsing a cut to one of its options. A nonempty right-option code representing zero separates +literal ZFC code equality from numerical Conway equivalence. The ordinary empty and singleton cuts +are interface smoke tests, not substitutes for these semantic separators. +-/ + +universe u + +public noncomputable section + +open Set + +namespace Tests.ClassSurrealCuts + +example (s t : Set ZFSet.Surreal.{u}) [Small.{u} s] [Small.{u} t] + (h : ∀ x ∈ s, ∀ y ∈ t, x < y) : + ZFSet.Surreal.toSurreal (!{s | t}'h) = + !{ZFSet.Surreal.toSurreal '' s | ZFSet.Surreal.toSurreal '' t}' + (ZFSet.Surreal.toSurreal_separated s t h) := + ZFSet.Surreal.toSurreal_ofSets s t h + +example (s t : Set ZFSet.GameCode.{u}) [Small.{u} s] [Small.{u} t] + (hs : ∀ x ∈ s, x.IsNumeric) (ht : ∀ x ∈ t, x.IsNumeric) + (h : ∀ x ∈ s, ∀ y ∈ t, x < y) : + ZFSet.Surreal.mk (ZFSet.GameCode.ofSets s t) + (ZFSet.GameCode.isNumeric_ofSets s t hs ht h) = + !{ZFSet.Surreal.codeValues s hs | ZFSet.Surreal.codeValues t ht}' + (ZFSet.Surreal.codeValues_separated s t hs ht h) := + ZFSet.Surreal.mk_ofSets s t hs ht h + +example (s t : Set ZFSet.GameCode.{u}) [Small.{u} s] [Small.{u} t] : + (ZFSet.GameCode.ofSets s t : ZFSet.{u}) = ZFSet.pair + (ZFSet.range fun x : s ↦ (x.1 : ZFSet.{u})) + (ZFSet.range fun x : t ↦ (x.1 : ZFSet.{u})) := + ZFSet.GameCode.coe_ofSets s t + +example : (!{∅ | ∅} : ZFSet.Surreal.{u}) = 0 := by + apply ZFSet.Surreal.toSurreal_injective + simp only [ZFSet.Surreal.toSurreal_ofSets, Set.image_empty, ZFSet.Surreal.toSurreal_zero] + rw [Surreal.zero_def] + congr 1 + funext p + cases p <;> rfl + +example : (!{{0} | ∅} : ZFSet.Surreal.{u}) = 1 := by + apply ZFSet.Surreal.toSurreal_injective + simpa only [ZFSet.Surreal.toSurreal_ofSets, Set.image_singleton, Set.image_empty, + ZFSet.Surreal.toSurreal_zero, ZFSet.Surreal.toSurreal_one] using Surreal.one_def.symm + +example : (0 : ZFSet.Surreal.{u}) < !{{0} | {1}} ∧ + (!{{0} | {1}} : ZFSet.Surreal.{u}) < 1 := by + exact ⟨ZFSet.Surreal.lt_ofSets_of_mem_left (Set.mem_singleton _), + ZFSet.Surreal.ofSets_lt_of_mem_right (Set.mem_singleton _)⟩ + +/-- A class cut whose left set is infinite, with every natural number as a left option. -/ +def aboveNaturals : ZFSet.Surreal.{u} := !{Set.range (fun n : ℕ ↦ (n : ZFSet.Surreal.{u})) | ∅} + +/-- The infinite cut is strictly above every natural number, not merely a finite option bound. -/ +theorem nat_lt_aboveNaturals (n : ℕ) : (n : ZFSet.Surreal.{u}) < aboveNaturals := + ZFSet.Surreal.lt_ofSets_of_mem_left (Set.mem_range_self n) + +/-- The infinite cut is not any finite natural number. -/ +theorem aboveNaturals_ne_nat (n : ℕ) : aboveNaturals.{u} ≠ (n : ZFSet.Surreal.{u}) := + (nat_lt_aboveNaturals n).ne' + +/-- The raw code with no left options and the single right option one. -/ +def noncanonicalZero : ZFSet.GameCode.{u} := ZFSet.GameCode.ofSets ∅ {1} + +/-- The noncanonical zero code is numeric because all its options are numeric and separated. -/ +theorem noncanonicalZero_numeric : noncanonicalZero.{u}.IsNumeric := + ZFSet.GameCode.isNumeric_ofSets ∅ {1} (by simp) (by simp) (by simp) + +/-- The noncanonical zero code is not literally the empty-option zero code. -/ +theorem noncanonicalZero_ne_zero : noncanonicalZero.{u} ≠ 0 := by + intro h + have hm := congrArg (fun x : ZFSet.GameCode.{u} ↦ x.toIGame.moves Player.right) h + simp [noncanonicalZero] at hm + +/-- The noncanonical zero code nevertheless represents precisely the zero class value. -/ +theorem mk_noncanonicalZero : + ZFSet.Surreal.mk noncanonicalZero.{u} noncanonicalZero_numeric = 0 := by + apply ZFSet.Surreal.toSurreal_injective + apply Surreal.toGame_inj.1 + rw [ZFSet.Surreal.toSurreal_mk, Surreal.toGame_mk, + ZFSet.Surreal.toSurreal_zero, Surreal.toGame_zero] + apply Game.mk_eq + rw [noncanonicalZero, ZFSet.GameCode.toIGame_ofSets] + apply IGame.fits_zero_iff_equiv.1 + simp [IGame.Fits] + +end Tests.ClassSurrealCuts diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/Identification.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/Identification.lean new file mode 100644 index 0000000000..fc61cf9aee --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/Identification.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Identification + +/-! +# Imported checks of native class omnific criteria + +The positive monomial `ω` excludes a definition restricted to ordinary integers. The reciprocal +of two excludes unrestricted constant coefficients, while a negative support exponent violates +the unsigned Conway-support criterion. The native singleton-cut and coefficient formulas below +exercise their exported interfaces without unfolding project definitions. +-/ + +universe u + +public noncomputable section + +namespace Tests.ClassOmnificIdentification + +example (x : ZFSet.Surreal.{u}) : + x.IsOmnificInteger ↔ x = !{{x - 1} | {x + 1}}'(by + simp only [Set.mem_singleton_iff] + rintro _ rfl _ rfl + simp [sub_eq_add_neg]) := + ZFSet.Surreal.isOmnificInteger_iff_cut x + +example (x : ZFSet.Surreal.{u}) : + x.IsOmnificInteger ↔ + ZFSet.Surreal.support x ⊆ Set.Ici 0 ∧ + ∃ z : ℤ, ZFSet.Surreal.coeff x 0 = (z : ℝ) := + ZFSet.Surreal.isOmnificInteger_iff_normalForm x + +/-- A negative Conway support exponent rules out the class omnific predicate. -/ +theorem not_isOmnificInteger_of_negative_support (x i : ZFSet.Surreal.{u}) + (hi : i ∈ ZFSet.Surreal.support x) (hneg : i < 0) : ¬ x.IsOmnificInteger := by + intro hx + exact (not_le_of_gt hneg) (((ZFSet.Surreal.isOmnificInteger_iff_normalForm x).1 hx).1 hi) + +/-- The class value with normal form `ω` is an omnific integer. -/ +theorem omega_isOmnificInteger : + (ZFSet.Surreal.equiv.symm (ω^ (1 : Surreal.{u}))).IsOmnificInteger := by + rw [ZFSet.Surreal.isOmnificInteger_iff_normalForm] + constructor + · rw [ZFSet.Surreal.support_subset_Ici_zero_iff_toSurreal, + ← ZFSet.Surreal.equiv_apply, ZFSet.Surreal.equiv.apply_symm_apply] + simp + · refine ⟨0, ?_⟩ + rw [ZFSet.Surreal.coeff_eq_toSurreal, ZFSet.Surreal.toSurreal_zero, + ← ZFSet.Surreal.equiv_apply, ZFSet.Surreal.equiv.apply_symm_apply] + simp + +/-- The class reciprocal of two is not an omnific integer. -/ +theorem two_inv_not_isOmnificInteger : + ¬ ((2 : ZFSet.Surreal.{u})⁻¹).IsOmnificInteger := by + rw [ZFSet.Surreal.isOmnificInteger_iff] + have h := Surreal.two_inv_not_mem_omnificIntegers.{u} + rw [Surreal.mem_omnificIntegers] at h + simpa only [← ZFSet.Surreal.ringEquiv_apply, map_inv₀, map_ofNat] using h + +end Tests.ClassOmnificIdentification diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/NormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/NormalForm.lean new file mode 100644 index 0000000000..3795a39003 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/NormalForm.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Reduced +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormAdd + +/-! +# A separate client of class-coded Conway normal forms + +The chart and support-class predicates are used only through their public interfaces. The +normal form `ω + 2` separates reducedness from the incorrect variant that deletes exponent zero: +both its constant and its nonconstant term survive subtraction of one, in distinct Archimedean +classes. Zero is also tested separately, since nonzeroness is part of reducedness. +-/ + +universe u + +public noncomputable section + +namespace ZFSet.Surreal.Tests.NormalForm + +/-- An arbitrary small Conway series is recovered from its class-coded value. -/ +theorem chart_inverse (s : SurrealHahnSeries.{u}) : + toHahnSeries (toHahnSeriesOrderIso.symm s) = s := by + rw [toHahnSeries_eq_toSurreal, ← toHahnSeriesOrderIso_apply, OrderIso.apply_symm_apply] + +/-- The native support remains set-sized after separately compiling the producer. -/ +theorem support_small (x : Surreal.{u}) : Small.{u} (support x) := inferInstance + +/-- Zero has finite support-class number. -/ +theorem zero_hasFiniteSupportClasses : HasFiniteSupportClasses (0 : Surreal.{u}) := by + rw [hasFiniteSupportClasses_iff_toSurreal, toSurreal_zero, _root_.Surreal.support_zero, + Set.image_empty] + exact Set.finite_empty + +/-- Zero is not reduced, even though its support intersection is empty. -/ +theorem zero_not_isReduced : ¬ IsReduced (0 : Surreal.{u}) := by + simp only [isReduced_iff, ne_eq, not_true_eq_false, false_and, not_false_eq_true] + +/-- The class-coded value with Conway normal form `ω + 2`. -/ +def twoTerm : Surreal.{u} := + toHahnSeriesOrderIso.symm (SurrealHahnSeries.single 1 1 + SurrealHahnSeries.single 0 2) + +/-- The two displayed terms are exactly the normal form of the class-coded example. -/ +theorem toHahnSeries_twoTerm : + toHahnSeries twoTerm.{u} = SurrealHahnSeries.single 1 1 + SurrealHahnSeries.single 0 2 := + chart_inverse _ + +private theorem coeff_eq_normalForm (x i : Surreal.{u}) : + coeff x i = (toHahnSeries x).coeff (toSurreal i) := by + rw [coeff_eq_toSurreal, toHahnSeries_eq_toSurreal, _root_.Surreal.coeff_toHahnSeries] + +/-- The example has a nonzero constant coefficient distinct from one. -/ +theorem twoTerm_coeff_zero : coeff twoTerm.{u} 0 = 2 := by + rw [coeff_eq_normalForm, toHahnSeries_twoTerm, toSurreal_zero] + simp [SurrealHahnSeries.coeff_add_apply, SurrealHahnSeries.coeff_single_of_ne] + +/-- The example also has a nonzero coefficient at the nonzero exponent one. -/ +theorem twoTerm_coeff_one : coeff twoTerm.{u} 1 = 1 := by + rw [coeff_eq_normalForm, toHahnSeries_twoTerm, toSurreal_one] + simp [SurrealHahnSeries.coeff_add_apply, SurrealHahnSeries.coeff_single_of_ne] + +/-- The example is nonzero, as witnessed by its coefficient at exponent one. -/ +theorem twoTerm_ne_zero : twoTerm.{u} ≠ 0 := by + intro h + have hcoeff := twoTerm_coeff_one.{u} + rw [h, coeff_eq_toSurreal, toSurreal_zero, _root_.Surreal.coeff_zero] at hcoeff + exact zero_ne_one hcoeff + +private theorem coeff_sub_one (x i : Surreal.{u}) : + coeff (x - 1) i = coeff x i - (Pi.single 0 1 : _root_.Surreal.{u} → ℝ) (toSurreal i) := by + rw [coeff_eq_toSurreal, toSurreal_sub, toSurreal_one, coeff_eq_toSurreal] + simp only [sub_eq_add_neg, + _root_.Surreal.coeff_add, _root_.Surreal.coeff_neg, _root_.Surreal.coeff_one, + Pi.add_apply, Pi.neg_apply] + +/-- Both relevant coefficients remain nonzero after subtraction of one. -/ +theorem twoTerm_sub_one_coeffs : + coeff (twoTerm.{u} - 1) 0 = 1 ∧ coeff (twoTerm.{u} - 1) 1 = 1 := by + rw [coeff_sub_one, coeff_sub_one, twoTerm_coeff_zero, twoTerm_coeff_one, + toSurreal_zero, toSurreal_one] + norm_num [Pi.single_apply] + +/-- Exactly the exponents zero and one occur in the example. -/ +theorem twoTerm_support : support twoTerm.{u} = {0, 1} := by + ext i + constructor + · intro hi + have h := (mem_support_iff_toSurreal twoTerm i).1 hi + rw [← _root_.Surreal.support_toHahnSeries, ← toHahnSeries_eq_toSurreal, + toHahnSeries_twoTerm] at h + rcases SurrealHahnSeries.support_add_subset h with h | h + · have he : toSurreal i = 1 := SurrealHahnSeries.support_single_subset h + have hi1 : i = 1 := toSurreal_injective (he.trans toSurreal_one.symm) + simp only [Set.mem_insert_iff, Set.mem_singleton_iff, hi1, or_true] + · have he : toSurreal i = 0 := SurrealHahnSeries.support_single_subset h + have hi0 : i = 0 := toSurreal_injective (he.trans toSurreal_zero.symm) + simp only [Set.mem_insert_iff, Set.mem_singleton_iff, hi0, true_or] + · simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + rintro (rfl | rfl) + · rw [mem_support_iff, twoTerm_coeff_zero] + norm_num + · rw [mem_support_iff, twoTerm_coeff_one] + exact one_ne_zero + +/-- The nonconstant example meets finitely many support classes. -/ +theorem twoTerm_hasFiniteSupportClasses : HasFiniteSupportClasses twoTerm.{u} := by + rw [hasFiniteSupportClasses_iff, twoTerm_support] + exact ((Set.finite_singleton 1).insert 0).image _ + +/-- The zero exponent and nonzero exponent make the example genuinely non-reduced. -/ +theorem twoTerm_not_isReduced : ¬ IsReduced twoTerm.{u} := by + intro h + obtain ⟨_, c, hc⟩ := (isReduced_iff twoTerm).1 h + have hzero : ArchimedeanClass.mk (0 : Surreal.{u}) = c := hc ⟨by + rw [mem_support_iff, twoTerm_coeff_zero] + norm_num, by + rw [mem_support_iff, twoTerm_sub_one_coeffs.1] + exact one_ne_zero⟩ + have hone : ArchimedeanClass.mk (1 : Surreal.{u}) = c := hc ⟨by + rw [mem_support_iff, twoTerm_coeff_one] + exact one_ne_zero, by + rw [mem_support_iff, twoTerm_sub_one_coeffs.2] + exact one_ne_zero⟩ + have htop : ArchimedeanClass.mk (1 : Surreal.{u}) = ⊤ := + hone.trans (hzero.symm.trans ArchimedeanClass.mk_zero) + exact one_ne_zero (ArchimedeanClass.mk_eq_top_iff.mp htop) + +/-- Deleting zero would incorrectly satisfy a nonzero-only version of reducedness. -/ +theorem twoTerm_nonzero_intersection_one_class : + twoTerm.{u} ≠ 0 ∧ ∃ c : ArchimedeanClass Surreal.{u}, + (support twoTerm ∩ support (twoTerm - 1)) \ {0} ⊆ + {i | ArchimedeanClass.mk i = c} := by + refine ⟨twoTerm_ne_zero, ArchimedeanClass.mk 1, ?_⟩ + intro i hi + have hiSupport := hi.1.1 + rw [twoTerm_support, Set.mem_insert_iff, Set.mem_singleton_iff] at hiSupport + rcases hiSupport with rfl | rfl + · exact False.elim (hi.2 (Set.mem_singleton 0)) + · rfl + +/-- The signed bridge can be used after separately compiling its producer. -/ +theorem signed_reduced_iff (x : OmnificInteger.{u}) : + IsReduced (x : Surreal.{u}) ↔ + HahnSeries.Nonpositive.IsReduced (OmnificInteger.ringEquiv x).toSignedNonpositiveHahn := + OmnificInteger.isReduced_iff_toSignedNonpositiveHahn x + +end ZFSet.Surreal.Tests.NormalForm diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/Properness.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/Properness.lean new file mode 100644 index 0000000000..1e1b8b9b3a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/Properness.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Properness +import LeanPool.ConwayRefinement.CombinatorialGames.Game.Special + +/-! +# Public checks for the intrinsic proper classes + +The empty ZFC set is not a game code, the star game is not numeric, and one half is numeric but +not omnific. These distinguish the intrinsic classes from all ZFC sets, all game codes, and the +incorrect identification of omnific and numeric codes. The remaining examples check coverage of +arbitrary values and properness through the exported interface. +-/ + +universe u + +noncomputable section + +open ZFSet + +example : numericGameCodes ((0 : GameCode.{u}) : ZFSet.{u}) := + (GameCode.mem_numericGameCodes _).2 GameCode.isNumeric_zero + +example : numericGameCodes ((1 : GameCode.{u}) : ZFSet.{u}) := + (GameCode.mem_numericGameCodes _).2 GameCode.isNumeric_one + +example : omnificGameCodes ((0 : GameCode.{u}) : ZFSet.{u}) := by + simpa only [OmnificCode.code_zero] using (0 : OmnificCode.{u}).mem_omnificGameCodes + +example : omnificGameCodes ((1 : GameCode.{u}) : ZFSet.{u}) := by + simpa only [OmnificCode.code_one] using (1 : OmnificCode.{u}).mem_omnificGameCodes + +example : ¬numericGameCodes (∅ : ZFSet.{u}) := by + intro h + obtain ⟨hg, _⟩ := (numericGameCodes_iff _).1 h + obtain ⟨L, R, heq, _, _⟩ := hg.exists_eq_pair + have hm : ({L} : ZFSet.{u}) ∈ (∅ : ZFSet.{u}) := by rw [heq]; simp [ZFSet.pair] + exact ZFSet.notMem_empty _ hm + +example : ¬numericGameCodes + ((GameCode.ofSets ({0} : Set GameCode.{u}) {0}) : ZFSet.{u}) := by + rw [GameCode.mem_numericGameCodes, GameCode.isNumeric_iff_options] + simp + +example : numericGameCodes ((GameCode.ofIGame (IGame.half : IGame.{u})) : ZFSet.{u}) := + (GameCode.mem_numericGameCodes _).2 ((GameCode.isNumeric_ofIGame _).2 inferInstance) + +example : ¬omnificGameCodes ((GameCode.ofIGame (IGame.half : IGame.{u})) : ZFSet.{u}) := by + intro h + have hn : (GameCode.ofIGame (IGame.half : IGame.{u})).IsNumeric := + (GameCode.isNumeric_ofIGame _).2 inferInstance + have ho := (GameCode.isOmnificInteger_iff_toSurreal _ hn).1 + ((GameCode.mem_omnificGameCodes _).1 h) + apply _root_.Surreal.two_inv_not_mem_omnificIntegers + apply _root_.Surreal.mem_omnificIntegers.2 + simpa only [ZFSet.Surreal.toSurreal_mk, GameCode.toIGame_ofIGame, IGame.mk_half] using ho + +example (x : _root_.Surreal.{u}) : + ∃ c : NumericGameCode.{u}, numericGameCodes (c.code : ZFSet.{u}) ∧ c.toSurreal = x := by + obtain ⟨c, hc⟩ := NumericGameCode.toSurreal_surjective x + exact ⟨c, c.mem_numericGameCodes, hc⟩ + +example (x : _root_.Surreal.OmnificInteger.{u}) : + ∃ c : OmnificCode.{u}, omnificGameCodes (c.code : ZFSet.{u}) ∧ c.value = x := by + obtain ⟨c, hc⟩ := OmnificCode.value_surjective x + exact ⟨c, c.mem_omnificGameCodes, hc⟩ + +example (z : ZFSet.{u}) (hz : numericGameCodes z) : + ∃ c : NumericGameCode.{u}, (c.code : ZFSet.{u}) = z := + (numericGameCodes_iff_exists z).1 hz + +example (z : ZFSet.{u}) (hz : omnificGameCodes z) : + ∃ c : OmnificCode.{u}, (c.code : ZFSet.{u}) = z := + (omnificGameCodes_iff_exists z).1 hz + +example (s : ZFSet.{u}) : numericGameCodes ≠ Class.ofSet s := numericGameCodes_ne_ofSet s + +example (s : ZFSet.{u}) : omnificGameCodes ≠ Class.ofSet s := omnificGameCodes_ne_ofSet s + +example : numericGameCodes ∉ Class.univ.{u} := numericGameCodes_notMem_univ + +example : omnificGameCodes ∉ Class.univ.{u} := omnificGameCodes_notMem_univ + +example : ¬Small.{u} ZFSet.Surreal.{u} := ZFSet.Surreal.not_small + +example : ¬Small.{u} ZFSet.Surreal.OmnificInteger.{u} := ZFSet.Surreal.OmnificInteger.not_small diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Tests.lean new file mode 100644 index 0000000000..e140da0468 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Tests.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Tests.SourceIndex +import LeanPool.ConwayRefinement.ConwayRefinement.Tests.UpstreamReuse + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Tests/SourceIndex.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Tests/SourceIndex.lean new file mode 100644 index 0000000000..1c700dad47 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Tests/SourceIndex.lean @@ -0,0 +1,1214 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedValuation +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.ResidueMathlib +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducible +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducibleFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GermLikeFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportGCD +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.InfiniteSupportFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Multiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPart +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPartMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalProposition922 +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.FiniteClassReduction +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduced +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.ArchimedeanAssumptions +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.CardinalIntegerPart +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueSubmultiplicative +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.CriticalPoint +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Irreducibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OneRow +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedTruncationSpan +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.Factorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.FactorizationClassification +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedSpanFactorization +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwoExample +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SectionSixFour +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SeriesMaximalFiniteSupportDivisor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Tests.SupportSupremumMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrderTypeMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GradedDivisibility +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartSeries +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.PrincipalMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IrreducibilityTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.SupportSupremumMultiplicativity +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SourceStatements +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.RefinementConjecture +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.DegreeTransfer +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.NormalForm +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Identification +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Properness +import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Refinement + +/-! +# Compiled signatures of the source results + +Exact type ascriptions for the published results used in the proof and for the structures on which +they rest. A change in hypotheses, quantifier order, endpoints, or ordinal operations fails +elaboration here. Semantic boundary examples distinguish the intended definitions from nearby +incorrect ones. + +The refinement theorem has two isolated statements. `ConwayRefinement/Standalone/Mathlib/` fixes +its Hahn-series form against Mathlib alone, while +`ConwayRefinement/Standalone/CombinatorialGames/` fixes its concrete omnific-integer form against +Mathlib and CombinatorialGames alone. + +The hash-command linter is disabled because checked signatures are this module's purpose. +-/ +universe u v + +open scoped DirectSum HahnSeries NatOrdinal Topology + +public section + +section ExactSignatures + +/- LM24's unsigned normal-form criterion on the class presentation of Conway cuts. -/ + ∀ x : ZFSet.Surreal.{u}, x.IsOmnificInteger ↔ + ZFSet.Surreal.support x ⊆ Set.Ici 0 ∧ + ∃ z : ℤ, ZFSet.Surreal.coeff x 0 = (z : ℝ)) + +/- Every possible omnific factor or divisibility witness has a code. -/ + Function.Surjective (ZFSet.OmnificCode.value.{u})) + +/- Properness of the code class and of its distinct numerical values. -/ + ∀ s : ZFSet.{u}, ZFSet.omnificGameCodes ≠ Class.ofSet s) + ¬Small.{u} ZFSet.Surreal.OmnificInteger.{u}) + +/- The class comparison preserves the complete refinement conjecture, not a restricted case. -/ + ZFSet.Surreal.OmnificInteger.RefinementConjecture.{u} ↔ ConwayRefinementConjecture.{u}) + +/- LM17, Definition 4.1: the two support-order alternatives in the germ-like predicate. -/ + ∀ {K : Type u} [Field K] {a : Berarducci.Series K}, LM17.IsGermLike a → + (a : K⟦ℝ⟧).supportOrderType = (Berarducci.ordinalValue a).val ∨ + (1 < Berarducci.ordinalValue a ∧ + (a : K⟦ℝ⟧).supportOrderType = (Berarducci.ordinalValue a).val + 1)) + +/- LM17, Theorem 4.8: every nonzero germ-like series factors into irreducibles. -/ + ∀ {K : Type u} [Field K] [CharZero K] {a : Berarducci.Series K}, + LM17.IsGermLike a → a ≠ 0 → + ∃ f : Multiset (Berarducci.Series K), + (∀ b ∈ f, Irreducible b) ∧ Associated f.prod a) + +/- The degree-two-plus-one example exercises the second, nondegenerate germ-like branch. -/ + LM17.IsGermLike (PommersheimShahriari.DegreeTwoExample.degreeTwoWithConstant (K := ℚ))) + +section ResidueStructures + +variable {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + (ν : MaxAddDegree R M) (m : M) + +#synth CommRing ν.ResidueRing + +#synth Module ν.ResidueRing (ν.Component m) + +end ResidueStructures + +/- LM24, Fact 2.5.2: units and pairwise gcds in the nonpositive finite-support ring. -/ + ∀ {G : Type u} {K : Type v} [LinearOrder G] [AddCommGroup G] + [IsOrderedAddMonoid G] [Field K] + (p : (HahnSeries.Nonpositive.finiteSupportSubring : + Subring (HahnSeries.Nonpositive G K))), + IsUnit p ↔ + ∃ k : K, k ≠ 0 ∧ + p = HahnSeries.Nonpositive.finiteSupportScalarHom (G := G) k) + ∀ {G : Type u} {K : Type v} [LinearOrder G] [AddCommGroup G] + [IsOrderedAddMonoid G] [Field K] + (p q : (HahnSeries.Nonpositive.finiteSupportSubring : + Subring (HahnSeries.Nonpositive G K))), + ∃ d : (HahnSeries.Nonpositive.finiteSupportSubring : + Subring (HahnSeries.Nonpositive G K)), + ∀ e : (HahnSeries.Nonpositive.finiteSupportSubring : + Subring (HahnSeries.Nonpositive G K)), + e ∣ p ∧ e ∣ q ↔ e ∣ d) + +/- The same underlying `t⁻¹` distinguishes the nonpositive ring from the full group ring. -/ + ¬ IsUnit Tests.nonpositiveNegativeMonomial) + IsUnit Tests.fullNegativeMonomial) + +/- The zero-boundary gcd certificate retains both association and the defining orientation. -/ + ∃ d : Tests.IntegerNonpositiveFiniteSupportRing, + (d ∣ Tests.nonpositiveNegativeMonomial ∧ + Tests.nonpositiveNegativeMonomial ∣ d) ∧ + ∀ e : Tests.IntegerNonpositiveFiniteSupportRing, + e ∣ 0 ∧ e ∣ Tests.nonpositiveNegativeMonomial ↔ e ∣ d) + ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] [LinearOrder M] + (ν : MaxAddDegree R M) (x y : R), + ν.RVRel x y ↔ + (ν x = ⊥ ∧ ν y = ⊥) ∨ + (ν x ≠ ⊥ ∧ ν (x - y) < ν x)) + ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + (ν : MaxAddDegree R M) [ν.IsMultiplicative], ν.RV ≃* ν.HomogeneousClasses) + ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + (ν : MaxAddDegree R M), MaxAddDegree ν.AssociatedGraded M) + ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] [LinearOrder M] + (ν : MaxAddDegree R M) (x : ν.AssociatedGraded) (m : M), + ν.associatedGradedValue x = (m : WithBot M) ↔ + x m ≠ 0 ∧ ∀ i, x i ≠ 0 → i ≤ m) + ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + (ν : MaxAddDegree R M), ν.associatedGradedValuation.IsSeparated) + ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + (ν : MaxAddDegree R M) (x : R), + ν.associatedGradedValuation (ν.initialForm x) = ν x) + ∀ {K : Type v} [Field K] (b c : Berarducci.Series K), + Berarducci.ordinalValue (b + c) ≤ + max (Berarducci.ordinalValue b) (Berarducci.ordinalValue c)) + +/- Berarducci, Theorem 9.7 and Corollary 9.8. -/ + ∀ {K : Type v} [Field K] [CharZero K] (b c : Berarducci.Series K), + Berarducci.ordinalValue (b * c) = + Berarducci.ordinalValue b * Berarducci.ordinalValue c) + +/- Berarducci, Lemma 10.1 and Definition 10.2. -/ + ∀ {K : Type v} [Field K] [CharZero K] {b : Berarducci.Series K}, b ≠ 0 → + ∃ x : ℝ, Berarducci.IsCriticalPoint b x) + +/- Berarducci, Lemma 10.4. -/ + ∀ {K : Type v} [Field K] [CharZero K] + {b c : Berarducci.Series K} {x y : ℝ}, + Berarducci.IsCriticalPoint b x → Berarducci.IsCriticalPoint c y → + Berarducci.ordinalValue + (Berarducci.translatedTruncation + (((b * c : Berarducci.Series K) : K⟦ℝ⟧)) (x + y)) = + Berarducci.ordinalValue + (Berarducci.translatedTruncation (b : K⟦ℝ⟧) x) * + Berarducci.ordinalValue + (Berarducci.translatedTruncation (c : K⟦ℝ⟧) y)) + +/- Berarducci, Theorem 10.5: both alternatives for the support order type, the prohibition on +strictly negative monomial divisors, and both irreducibility conclusions. -/ + ∀ {K : Type v} [Field K] [CharZero K] {a : Berarducci.Series K}, + (∀ (gamma : ℝ) (hgamma : gamma < 0), + ¬ HahnSeries.Nonpositive.single gamma (1 : K) hgamma.le ∣ a) → + ((a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ∨ + ∃ beta : Ordinal, (a : K⟦ℝ⟧).supportOrderType = + Ordinal.omega0 ^ Ordinal.omega0 ^ beta) → + Irreducible a ∧ Irreducible (a + 1)) + +/- Berarducci, Theorem 10.5, specialized to the coefficient-one row underlying LM24, +Example 9.2.8. -/ + ∀ {K : Type v} [Field K], + (Berarducci.OneRow.withConstant (K := K) : K⟦ℝ⟧).supportOrderType = + Ordinal.omega0 + 1) + ∀ {K : Type v} [Field K] [CharZero K], + Irreducible (Berarducci.OneRow.withoutConstant (K := K)) ∧ + Irreducible (Berarducci.OneRow.withConstant (K := K))) + +/- PS06's quotient is by `J + K`, not Berarducci's ideal `J`. -/ + ∀ {K : Type v} [Field K] {b : Berarducci.Series K}, + b ∈ PommersheimShahriari.nearConstantSubmodule K ↔ + b ∈ Berarducci.nearConstantSubgroup K) + PommersheimShahriari.toSeriesQuotientByJAddConstants + (HahnSeries.Nonpositive.C (1 : ℚ)) = 0) + Berarducci.toGerm (HahnSeries.Nonpositive.C (1 : ℚ)) ≠ 0) + +/- PS06, Lemma 3.1: ordinal factorisation and the critical-point obstruction. -/ + ∀ {K : Type v} [Field K] {b c : Berarducci.Series K}, + Berarducci.ordinalValue b * Berarducci.ordinalValue c = + ω^ (2 : NatOrdinal) → + Berarducci.ordinalValue b ≤ Berarducci.ordinalValue c → + (Berarducci.ordinalValue b = 1 ∧ + Berarducci.ordinalValue c = ω^ (2 : NatOrdinal)) ∨ + (Berarducci.ordinalValue b = ω^ (1 : NatOrdinal) ∧ + Berarducci.ordinalValue c = ω^ (1 : NatOrdinal))) + ∀ {K : Type v} [Field K] [CharZero K] + {a b c : Berarducci.Series K} {x y : ℝ}, + a = b * c → Berarducci.ordinalValue a = ω^ (2 : NatOrdinal) → + (∀ u : ℝ, u < 0 → + Berarducci.ordinalValue (Berarducci.translatedTruncation (a : K⟦ℝ⟧) u) < + ω^ (2 : NatOrdinal)) → + Berarducci.IsCriticalPoint b x → Berarducci.IsCriticalPoint c y → + x = 0 ∧ y = 0) + +/- PS06, Lemma 3.1, complete support-order classification. -/ + ∀ {K : Type v} [Field K] [CharZero K] + {a b c : Berarducci.Series K}, + a ∉ Berarducci.nearConstantSubgroup K → + ((a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) ∨ + (a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) + 1) → + a = b * c → Berarducci.ordinalValue b ≤ Berarducci.ordinalValue c → + (∃ k : K, k ≠ 0 ∧ b = HahnSeries.Nonpositive.C k ∧ + c = HahnSeries.Nonpositive.C k⁻¹ * a ∧ + (c : K⟦ℝ⟧).supportOrderType = (a : K⟦ℝ⟧).supportOrderType) ∨ + (((b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ∨ + (b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 + 1) ∧ + ((c : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ∨ + (c : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 + 1) ∧ + Berarducci.ordinalValue b = ω^ (1 : NatOrdinal) ∧ + Berarducci.ordinalValue c = ω^ (1 : NatOrdinal))) + ∀ {K : Type v} [Field K] [CharZero K] + {a b c : Berarducci.Series K}, + a ∉ Berarducci.nearConstantSubgroup K → + ((a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) ∨ + (a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) + 1) → + a = b * c → Berarducci.ordinalValue b ≤ Berarducci.ordinalValue c → + (∃ k : K, k ≠ 0 ∧ b = HahnSeries.Nonpositive.C k ∧ + c = HahnSeries.Nonpositive.C k⁻¹ * a ∧ + (c : K⟦ℝ⟧).supportOrderType = (a : K⟦ℝ⟧).supportOrderType) ∨ + (((b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ∨ + (b : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 + 1) ∧ + ((c : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ∨ + (c : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 + 1) ∧ + Berarducci.ordinalValue b = ω^ (1 : NatOrdinal) ∧ + Berarducci.ordinalValue c = ω^ (1 : NatOrdinal))) + +/- PS06, Proposition 3.2(2) and (5), upper-bound direction. -/ + ∀ {K : Type v} [Field K] {b c : Berarducci.Series K}, + Berarducci.ordinalValue b = ω^ (1 : NatOrdinal) → + Berarducci.ordinalValue c = ω^ (1 : NatOrdinal) → + Berarducci.IsCriticalPoint b 0 → Berarducci.IsCriticalPoint c 0 → + Module.finrank K (PommersheimShahriari.translatedTruncationSpan (b * c)) ≤ 2) + +/- PS06, Proposition 3.2(5), without a finite-dimensionality assumption. -/ + ∀ {K : Type v} [Field K] {b c : Berarducci.Series K}, + Berarducci.ordinalValue b = ω^ (1 : NatOrdinal) → + Berarducci.ordinalValue c = ω^ (1 : NatOrdinal) → + Berarducci.IsCriticalPoint b 0 → Berarducci.IsCriticalPoint c 0 → + Module.rank K (PommersheimShahriari.translatedTruncationSpan (b * c)) ≤ 2) + +/- PS06, Corollary 3.3. -/ + ∀ {K : Type v} [Field K] [CharZero K] {a : Berarducci.Series K}, + a ∉ Berarducci.nearConstantSubgroup K → + ((a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) ∨ + (a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) + 1) → + 2 < Module.finrank K (PommersheimShahriari.translatedTruncationSpan a) → Irreducible a) + +/- PS06, Corollary 3.3, in cardinal-rank form. -/ + ∀ {K : Type v} [Field K] [CharZero K] {a : Berarducci.Series K}, + a ∉ Berarducci.nearConstantSubgroup K → + ((a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) ∨ + (a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) + 1) → + (2 : Cardinal) < + Module.rank K (PommersheimShahriari.translatedTruncationSpan a) → Irreducible a) + +/- The explicit coefficient-one `ω² + 1` series supplied by the PS06 criterion. -/ + ∀ {K : Type v} [Field K], + ((PommersheimShahriari.DegreeTwoExample.degreeTwoWithConstant (K := K) : + Berarducci.Series K) : K⟦ℝ⟧).supportOrderType = + Ordinal.omega0 ^ (2 : Ordinal) + 1) + ∀ {K : Type v} [Field K] [CharZero K], + Irreducible + (PommersheimShahriari.DegreeTwoExample.degreeTwoWithConstant (K := K))) + ∀ {K : Type v} [Field K] [CharZero K] {a : Berarducci.Series K}, + a ∉ Berarducci.nearConstantSubgroup K → + ((a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) ∨ + (a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) + 1) → + 2 < Module.finrank K (PommersheimShahriari.translatedTruncationSpan a) → Irreducible a) + ∀ {K : Type v} [Field K] [CharZero K], + (HahnSeries.Nonpositive.negativeMonomialIdeal K).IsPrime) + +/- Berarducci, Corollary 9.9, imported by LM24 as Fact 3.4.1. -/ + ∀ {K : Type v} [Field K] [CharZero K], + HahnSeries.Nonpositive.OrderTypeMultiplicativeOnWeaklyPrincipal K) + +/- LM24, Propositions 3.5.1(2) and 3.6.1. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (b c : HahnSeries.Nonpositive ℝ K), + HahnSeries.Nonpositive.supportSup (b * c) = + HahnSeries.Nonpositive.supportSup b + HahnSeries.Nonpositive.supportSup c) + ∀ {K : Type v} [Field K] [CharZero K] + {b c : HahnSeries.Nonpositive ℝ K}, + HahnSeries.Nonpositive.IsPrincipal b → + HahnSeries.Nonpositive.IsPrincipal c → + HahnSeries.Nonpositive.IsPrincipal (b * c)) + +/- Boundary certificates exercise the proved characteristic-zero theorems on nonconstant +inputs. -/ + Berarducci.ordinalValue + (Tests.approachZeroNonpositive * + Tests.approachZeroNonpositive) = + Berarducci.ordinalValue Tests.approachZeroNonpositive * + Berarducci.ordinalValue Tests.approachZeroNonpositive) + ((Tests.twoTermNonprincipal * Tests.twoTermNonprincipal : + HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).degree = + (Tests.twoTermNonprincipal : ℚ⟦ℝ⟧).degree + + (Tests.twoTermNonprincipal : ℚ⟦ℝ⟧).degree) + ∃ b : HahnSeries.Nonpositive ℝ ℚ, + HahnSeries.Nonpositive.supportSup b = 0 ∧ + 0 ∉ (b : ℚ⟦ℝ⟧).support ∧ + HahnSeries.Nonpositive.supportSup (b * b) = 0) + ∀ {K : Type v} [Field K] {b : Berarducci.Series K}, + Berarducci.ordinalValueDegree b = ⊥ ↔ + b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K) + ∀ {K : Type v} [Field K] (b : Berarducci.Series K), + Berarducci.ordinalValueDegreeValuation K b = ⊥ ↔ + b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K) + ∀ {K : Type v} [Field K] + (α : NatOrdinal) (b c : Berarducci.Series K) + (hb : Berarducci.ordinalValue b < ω^ (α + 1)) + (hc : Berarducci.ordinalValue c < ω^ (α + 1)), + Berarducci.principalComponentMk α b hb = + Berarducci.principalComponentMk α c hc ↔ + Berarducci.ordinalValue (b - c) < ω^ α) + ∀ {K : Type v} [Field K] (α : NatOrdinal) + (x : Berarducci.PrincipalComponent K α), x ≠ 0 → + ∃ (p : Berarducci.Series K) + (hpBound : Berarducci.ordinalValue p < ω^ (α + 1)), + HahnSeries.Nonpositive.IsPrincipal p ∧ + (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal) ∧ + Berarducci.principalComponentMk α p hpBound = x) + +/- The equal-degree specialization of LM24, Proposition 3.6.2 used in Lemma 7.2.3. The +unrestricted printed proposition is false. -/ + ∀ {K : Type v} [Field K] {b c : HahnSeries.Nonpositive ℝ K}, + HahnSeries.Nonpositive.IsPrincipal b → + HahnSeries.Nonpositive.IsPrincipal c → + (c : K⟦ℝ⟧).degree = (b : K⟦ℝ⟧).degree → + ((b + c : HahnSeries.Nonpositive ℝ K) : K⟦ℝ⟧).degree = + (b : K⟦ℝ⟧).degree → + HahnSeries.Nonpositive.IsPrincipal (b + c)) + ∀ {K : Type v} [Field K] {p : Berarducci.Series K} + (_hp : HahnSeries.Nonpositive.IsPrincipal p) {α : NatOrdinal}, + (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal) → + Berarducci.ordinalValue p = ω^ α) + ∀ {K : Type v} [Field K] + (α : NatOrdinal) {b c : Berarducci.Series K} + (_hb : HahnSeries.Nonpositive.IsPrincipal b) + (_hc : HahnSeries.Nonpositive.IsPrincipal c) + (hbDegree : (b : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) + (hcDegree : (c : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)), + Berarducci.degreeLayerMk α b hbDegree.le = + Berarducci.degreeLayerMk α c hcDegree.le ↔ + Berarducci.ordinalValue (b - c) < ω^ α) + ∀ (K : Type v) [Field K] + (α : NatOrdinal), + Berarducci.principalDegreeClasses K α ≃ₗ[K] + Berarducci.PrincipalComponent K α) + +/- LM24, Proposition 5.3.1. -/ + ∀ (K : Type v) [Field K] [CharZero K] + (α : NatOrdinal), + TensorProduct K (Berarducci.PrincipalComponent K α) + Berarducci.FiniteSupportRing ≃ₗ[K] + (HahnSeries.Nonpositive.degreeValuation K).Component α) + +/- LM24, Proposition 6.1.2, under the paper's blanket characteristic-zero hypothesis. -/ + (Berarducci.principalSubringTensorEquiv K : + TensorProduct K (Berarducci.PrincipalSubring K) + Berarducci.FiniteSupportRing ≃ₐ[K] + Berarducci.DegreeGraded K)) + ∀ {K : Type v} [Field K] [CharZero K] + (x : Berarducci.PrincipalSubring K) + (p : Berarducci.FiniteSupportRing) (α : NatOrdinal), + Berarducci.principalSubringTensorEquiv K (x ⊗ₜ p) α = + Berarducci.principalComponentTensorEquiv K α (x α ⊗ₜ p)) + ∀ {K : Type v} [Field K] [CharZero K] + (z : TensorProduct K (Berarducci.PrincipalSubring K) + Berarducci.FiniteSupportRing) (α : NatOrdinal), + Berarducci.principalSubringTensorEquiv K z α = + Berarducci.principalComponentTensorEquiv K α + (Berarducci.principalSubringTensorComponent K α z)) + +/- LM24, Proposition 5.4.3. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (B : Berarducci.HahnDegreeRV K), + ∃ p : Berarducci.FiniteSupportRing, + (∀ q : Berarducci.FiniteSupportRing, + Berarducci.finiteSupportRVEmbedding K q ∣ B ↔ q ∣ p) ∧ + (∀ p' : Berarducci.FiniteSupportRing, + (∀ q : Berarducci.FiniteSupportRing, + Berarducci.finiteSupportRVEmbedding K q ∣ B ↔ q ∣ p') → + ∃ k : K, k ≠ 0 ∧ + p' = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k * p) ∧ + (Berarducci.IsPrincipalRV B → + ∃ k : K, + p = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k)) + +/- LM24, Corollary 5.4.4. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (B : Berarducci.DegreeGraded K), + ∃ p : Berarducci.FiniteSupportRing, + (∀ q : Berarducci.FiniteSupportRing, + Berarducci.finiteSupportGradedEmbedding K q ∣ B ↔ q ∣ p) ∧ + ∀ p' : Berarducci.FiniteSupportRing, + (∀ q : Berarducci.FiniteSupportRing, + Berarducci.finiteSupportGradedEmbedding K q ∣ B ↔ q ∣ p') → + ∃ k : K, k ≠ 0 ∧ + p' = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k * p) + +/- LM24, Notation 5.4.5. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (B : Berarducci.DegreeGraded K), + ∃! p : Berarducci.FiniteSupportRing, + Berarducci.IsNormalizedGradedMaximalFiniteSupportDivisor B p) + +/- LM24, Remark 5.4.6. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (B : Berarducci.DegreeGraded K), + Berarducci.finiteSupportGradedEmbedding K + (Berarducci.gradedNormalizedMaximalFiniteSupportDivisor B) ∣ B) + +/- LM24, Proposition 5.4.8. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (B C : Berarducci.DegreeGraded K), + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor B * + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor C ∣ + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor (B * C)) + +/- LM24, Proposition 5.5.1. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (b : Berarducci.Series K), + ∃ p : Berarducci.FiniteSupportRing, + (∀ q : Berarducci.FiniteSupportRing, + (q : Berarducci.Series K) ∣ b ↔ q ∣ p) ∧ + ∀ p' : Berarducci.FiniteSupportRing, + (∀ q : Berarducci.FiniteSupportRing, + (q : Berarducci.Series K) ∣ b ↔ q ∣ p') → + ∃ k : K, k ≠ 0 ∧ + p' = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k * p) + +/- LM24, Notation 5.5.2. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (b : Berarducci.Series K), + ∃! p : Berarducci.FiniteSupportRing, + Berarducci.IsNormalizedSeriesMaximalFiniteSupportDivisor b p) + ∀ {K : Type v} [Field K] [CharZero K] + (b : Berarducci.Series K), + Berarducci.IsNormalizedSeriesMaximalFiniteSupportDivisor b + (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b)) + +/- LM24, Remark 5.5.3. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (b : Berarducci.Series K), + (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b : + Berarducci.Series K) ∣ b) + ∀ (K : Type v) [Field K] [CharZero K], + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor + (0 : Berarducci.Series K) = 0) + ∀ {K : Type v} [Field K] [CharZero K] + (p : Berarducci.FiniteSupportRing), + ∃ k : K, k ≠ 0 ∧ + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor + (p : Berarducci.Series K) = + HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k * p) + ∀ {K : Type v} [Field K] [CharZero K] + (p : Berarducci.FiniteSupportRing), + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor + (p : Berarducci.Series K) = + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor + (Berarducci.finiteSupportGradedEmbedding K p)) + ∀ {K : Type v} [Field K] [CharZero K] + {b : Berarducci.Series K}, + HahnSeries.Nonpositive.IsPrincipal b → + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b = 1) + +/- LM24, Proposition 5.5.5. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (b c : Berarducci.Series K), + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b * + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor c ∣ + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor (b * c)) + +/- LM24, Example 5.5.4. -/ + Berarducci.IsRVMaximalFiniteSupportDivisor + ((HahnSeries.Nonpositive.degreeValuation ℚ).rv Tests.seriesMaximalExample) + (Associates.mk Tests.seriesMaximalExampleRVDivisor)) + ∀ (_hgcd : ∀ p q : Berarducci.FiniteSupportRing, + ∃ d : Berarducci.FiniteSupportRing, + ∀ e : Berarducci.FiniteSupportRing, e ∣ p ∧ e ∣ q ↔ e ∣ d) + (_hunits : ∀ u : Berarducci.FiniteSupportRing, + IsUnit u ↔ ∃ k : ℚ, k ≠ 0 ∧ + u = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k), + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor + Tests.seriesMaximalExample = + Tests.seriesMaximalExampleDivisor) + ∀ (_hgcd : ∀ p q : Berarducci.FiniteSupportRing, + ∃ d : Berarducci.FiniteSupportRing, + ∀ e : Berarducci.FiniteSupportRing, e ∣ p ∧ e ∣ q ↔ e ∣ d) + (_hunits : ∀ u : Berarducci.FiniteSupportRing, + IsUnit u ↔ ∃ k : ℚ, k ≠ 0 ∧ + u = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k), + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor + Tests.seriesMaximalExampleLeadingGraded = + Tests.seriesMaximalExampleRVDivisor) + Tests.seriesMaximalExampleRVDivisor ≠ + Tests.seriesMaximalExampleDivisor) + +/- LM24, Proposition 5.6.1. The list is the finite sequence `c₁, …, cₙ`, and its length +is `n`. -/ + ∀ {K : Type v} [Field K] [CharZero K] + {b : Berarducci.Series K}, b ≠ 0 → + ∃ (factors : List (Berarducci.Series K)) (k : K), + b = HahnSeries.Nonpositive.C k * + (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b : + Berarducci.Series K) * factors.prod ∧ + (∀ c ∈ factors, + Irreducible c ∧ (c : K⟦ℝ⟧).support.Infinite) ∧ + factors.length ≤ + HahnSeries.degreeCantorTermCount (b : K⟦ℝ⟧)) + ∀ {K : Type v} [Field K] [CharZero K] + {b : Berarducci.Series K}, b ≠ 0 → + ∃ (factors : List (Berarducci.Series K)) (k : K), + k ≠ 0 ∧ + b = HahnSeries.Nonpositive.C k * + (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b : + Berarducci.Series K) * factors.prod ∧ + (∀ c ∈ factors, + Irreducible c ∧ (c : K⟦ℝ⟧).support.Infinite) ∧ + factors.length ≤ + HahnSeries.degreeCantorTermCount (b : K⟦ℝ⟧)) + ¬Berarducci.HasOnlyUnitFiniteSupportDivisors + (0 : Berarducci.Series ℚ)) + +/- LM24, Proposition 6.2.1. -/ + ∀ {K : Type v} [Field K] + [CharZero K] + {B C : Berarducci.DegreeGraded K}, + B ≠ 0 → C ≠ 0 → + B * C ∈ + (HahnSeries.Nonpositive.degreeValuation K).homogeneousClasses → + B ∈ + (HahnSeries.Nonpositive.degreeValuation K).homogeneousClasses ∧ + C ∈ + (HahnSeries.Nonpositive.degreeValuation K).homogeneousClasses) + +/- The exact graded-image model of `P` used in LM24, Corollary 6.2.2. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (x : Berarducci.DegreeGraded K), + Berarducci.IsPrincipalRVImage x ↔ + ∃ B : Berarducci.HahnDegreeRV K, + Berarducci.IsPrincipalRV B ∧ + (HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom B = x) + +/- The intrinsic characterization of the exact graded-image model of `P`. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (x : Berarducci.DegreeGraded K), + Berarducci.IsPrincipalRVImage x ↔ + x ≠ 0 ∧ + x ∈ + (HahnSeries.Nonpositive.degreeValuation K).homogeneousClasses ∧ + Berarducci.IsPrincipalGraded x) + +/- LM24, Corollary 6.2.2, `P̂` clause. -/ + ∀ {K : Type v} [Field K] + [CharZero K] + {B C : Berarducci.DegreeGraded K}, + B ≠ 0 → C ≠ 0 → Berarducci.IsPrincipalGraded (B * C) → + Berarducci.IsPrincipalGraded B ∧ + Berarducci.IsPrincipalGraded C) + +/- LM24, Corollary 6.2.2, `P` clause. -/ + ∀ {K : Type v} [Field K] + [CharZero K] + {B C : Berarducci.DegreeGraded K}, + B ≠ 0 → C ≠ 0 → Berarducci.IsPrincipalRVImage (B * C) → + Berarducci.IsPrincipalRVImage B ∧ + Berarducci.IsPrincipalRVImage C) + +/- LM24, Corollary 6.2.3, RV clause. -/ + ∀ {K : Type v} [Field K] + [CharZero K] + (B C : Berarducci.HahnDegreeRV K), + B ∣ C ↔ + (HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom B ∣ + (HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom C) + +/- LM24, Corollary 6.2.3, finite-support clause. -/ + ∀ {K : Type v} [Field K] + [CharZero K] + (p q : Berarducci.FiniteSupportRing), + Berarducci.finiteSupportGradedEmbedding K p ∣ + Berarducci.finiteSupportGradedEmbedding K q ↔ + p ∣ q) + +/- LM24, Proposition 6.2.4. -/ + ∀ {K : Type v} [Field K] + [CharZero K] + (B : Berarducci.HahnDegreeRV K) + (C : Berarducci.DegreeGraded K), + (HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom B ∣ C ↔ + ∀ α, + (HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom B ∣ + DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component + α (C α)) + +/- LM24, Lemma 6.3.1. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (B C : Berarducci.HahnDegreeRV K), + Berarducci.IsPrincipalRV C → C ≠ 0 → + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor + ((HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom (B * C)) = + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor + ((HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom B)) + +/- LM24, Lemma 6.3.2. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (B C : Berarducci.DegreeGraded K), + Berarducci.IsPrincipalGraded C → C ≠ 0 → + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor (B * C) = + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor B) + +/- LM24, Lemma 6.3.3. -/ + ∀ (K : Type v) [Field K] [CharZero K], + @Algebra.IsRelativelyAlgebraicallyClosed K + (Berarducci.PrincipalSubringFractionField K) _ _ + (Berarducci.principalSubringFractionAlgebra K)) + +/- LM24, Lemma 6.3.4. The nonzeroness of the inverted coefficient is made explicit because +Lean's inverse is total. -/ + ∀ {K : Type v} [Field K] [CharZero K] + {p₁ p₂ : Berarducci.PrincipalSubringFractionFiniteSupportRing K}, + p₁ ≠ 0 → p₂ ≠ 0 → + p₁ * p₂ ∈ Berarducci.principalSubringFractionCoefficientSubring K → + ∃ B : Berarducci.PrincipalSubringFractionField K, + B ≠ 0 ∧ + p₁ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B ∈ + Berarducci.principalSubringFractionCoefficientSubring K ∧ + p₂ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B⁻¹ ∈ + Berarducci.principalSubringFractionCoefficientSubring K) + +/- Guardrail: omitting the preceding `B ≠ 0` lets `B = 0` satisfy both membership clauses for +arbitrary factors under Lean's total inverse. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (p₁ p₂ : Berarducci.PrincipalSubringFractionFiniteSupportRing K), + ∃ B : Berarducci.PrincipalSubringFractionField K, + p₁ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B ∈ + Berarducci.principalSubringFractionCoefficientSubring K ∧ + p₂ * HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) B⁻¹ ∈ + Berarducci.principalSubringFractionCoefficientSubring K) + +/- LM24, Remark 6.3.5. Under the identification of Remark 6.1.3, coefficient extension +reflects divisibility. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (p q : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)), + Berarducci.principalSubringFractionScalarExtension K p ∣ + Berarducci.principalSubringFractionScalarExtension K q ↔ + p ∣ q) + +/- LM24, Corollary 6.3.6, in the stronger factor-witness form used in its proof. The +finite-support factors remain elements of `K(ℝ^{≤ 0})`. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (p : Berarducci.FiniteSupportRing) + (B C : Berarducci.DegreeGraded K), + Berarducci.finiteSupportGradedEmbedding K p ∣ B * C → + ∃ p₁ p₂ : Berarducci.FiniteSupportRing, + p = p₁ * p₂ ∧ + Berarducci.finiteSupportGradedEmbedding K p₁ ∣ B ∧ + Berarducci.finiteSupportGradedEmbedding K p₂ ∣ C) + +/- LM24, Corollary 6.3.6. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (p : Berarducci.FiniteSupportRing), + IsPrimal (Berarducci.finiteSupportGradedEmbedding K p)) + +/- LM24, Corollary 6.3.7. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (B C : Berarducci.DegreeGraded K), + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor (B * C) = + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor B * + Berarducci.gradedNormalizedMaximalFiniteSupportDivisor C) + +/- LM24, Proposition 6.3.8. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (b c : Berarducci.Series K), + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor (b * c) = + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b * + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor c) + +/- LM24, Corollary 6.3.9, in the stronger factor-witness form used in its proof. The factors +remain in the finite-support subring, and their equality is asserted in the ambient series ring. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (p : Berarducci.FiniteSupportRing (K := K)) (b c : Berarducci.Series K), + (p : Berarducci.Series K) ∣ b * c → + ∃ p₁ p₂ : Berarducci.FiniteSupportRing (K := K), + (p : Berarducci.Series K) = + (p₁ : Berarducci.Series K) * (p₂ : Berarducci.Series K) ∧ + (p₁ : Berarducci.Series K) ∣ b ∧ + (p₂ : Berarducci.Series K) ∣ c) + +/- LM24, Theorem 6.4.1. The list is the sequence `c₁, …, cₙ`, its length is `n`, and +only the finite-support factor is asserted to be unique. -/ + ∀ {K : Type v} [Field K] [CharZero K] + {b : Berarducci.Series K}, b ≠ 0 → + ∃ (p : Berarducci.FiniteSupportRing (K := K)) + (factors : List (Berarducci.Series K)), + Berarducci.IsInfiniteSupportIrreducibleFactorization b p factors ∧ + factors.length ≤ + HahnSeries.degreeCantorTermCount (b : K⟦ℝ⟧) ∧ + Berarducci.IsUniqueFiniteSupportFactorUpToScalar b p) + +/- Pending exact target for LM24, Corollary 6.4.2. `DecompositionMonoid` is the +pre-Schreier condition, while `GCDMonoid` contains data and is therefore asserted through +`Nonempty`. This anonymous fixture freezes the proposition without introducing a theorem stub. -/ + ((DecompositionMonoid (Berarducci.Series K) ↔ + Nonempty (GCDMonoid (Berarducci.Series K))) ∧ + (Nonempty (GCDMonoid (Berarducci.Series K)) ↔ + ∀ c : Berarducci.Series K, + Irreducible c → (c : K⟦ℝ⟧).support.Infinite → Prime c))) + +/- Boundary guardrail for Theorem 6.4.1: the source permits `n = 0`. -/ + Berarducci.IsInfiniteSupportIrreducibleFactorization + (1 : Berarducci.Series ℚ) + (1 : Berarducci.FiniteSupportRing (K := ℚ)) []) + +/- Scalar-uniqueness guardrail: literal equality of finite-support factors is false. -/ + (-1 : Berarducci.FiniteSupportRing (K := ℚ)) ≠ 1) + +/- LM24, Section 6.5, definition of almost irreducibility. The factorisation form makes the +quotient in the printed wording explicit without choosing a division operation. -/ + ∀ {H : AddSubgroup ℝ} {K : Type v} [Field K] + {b : HahnSeries.Nonpositive H K}, + HahnSeries.Nonpositive.IsAlmostIrreducible b ↔ + ∀ c d : HahnSeries.Nonpositive H K, b = c * d → + ¬HahnSeries.Nonpositive.IsMonomial c → + HahnSeries.Nonpositive.IsMonomial d) + +/- LM24, Remark 6.5.1, first assertion. -/ + ∀ {H : AddSubgroup ℝ} {K : Type v} [Field K] + {b : HahnSeries.Nonpositive H K}, Irreducible b → + HahnSeries.Nonpositive.IsAlmostIrreducible b) + +/- Corrected second assertion of LM24, Remark 6.5.1. The printed statement omits the +necessary hypothesis that `b` is not a unit. -/ +open HahnSeries.Nonpositive in + ∀ {H : AddSubgroup ℝ} {K : Type v} [Field K] + {b : HahnSeries.Nonpositive H K}, + HahnSeries.Nonpositive.IsAlmostIrreducible b → ¬IsUnit b → + HahnSeries.Nonpositive.realSupportSup H b = 0 → Irreducible b) + +/- Counterexample to the printed second assertion of LM24, Remark 6.5.1. -/ + HahnSeries.Nonpositive.IsAlmostIrreducible + (1 : Tests.RealExponentSeries) ∧ + HahnSeries.Nonpositive.realSupportSup Tests.RealExponentSubgroup + (1 : Tests.RealExponentSeries) = 0 ∧ + ¬Irreducible (1 : Tests.RealExponentSeries)) + +/- LM24, Remark 6.5.1, final assertion. -/ + ∀ {H : AddSubgroup ℝ} {K : Type v} [Field K] [DivisibleBy H ℤ] + {b : HahnSeries.Nonpositive H K}, + HahnSeries.Nonpositive.realSupportSup H b < 0 → ¬Irreducible b) + +/- Corrected exact target for LM24, Lemma 6.5.2. The printed universal quantifier includes +`p = 0`, although the proof and the notation `p_H` require `p ≠ 0`. This proposition remains +uninhabited until the Ritt-factorisation prerequisites are available. -/ + [DivisibleBy H ℤ] + (p : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)) ↦ + p ≠ 0 → + ∃! q : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport + (G := H) (K := K), + HahnSeries.Nonpositive.IsNormalizedHPart H p q) + +/- Semantic boundary for the normalized `H`-part predicate: the identity has the identity as +its unique normalized part. -/ + ∀ (H : AddSubgroup ℝ) {K : Type v} [Field K], + ∃! q : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport + (G := H) (K := K), + HahnSeries.Nonpositive.IsNormalizedHPart H + (1 : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)) q) + +/- The uniqueness part of LM24, Lemma 6.5.2 is proved without the Ritt existence input. -/ + ∀ {H : AddSubgroup ℝ} {K : Type v} [Field K] + {p : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)} + {q q' : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport + (G := H) (K := K)}, + HahnSeries.Nonpositive.IsNormalizedHPart H p q → + HahnSeries.Nonpositive.IsNormalizedHPart H p q' → q = q') + +/- Corrected exact target for LM24, Corollary 6.5.3. The nonzero hypothesis ensures that the +normalized `H`-part of `p(b)` is defined. This relational statement avoids choosing it before +Lemma 6.5.2 is proved. -/ + [DivisibleBy H ℤ] (b : HahnSeries.Nonpositive ℝ K) ↦ + b ≠ 0 → + ∀ pH : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport (G := H) (K := K), + HahnSeries.Nonpositive.IsNormalizedHPart H + (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b) pH → + ∀ q : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport (G := H) (K := K), + HahnSeries.Nonpositive.mapDomainToReal H + ((q : HahnSeries.Nonpositive.FiniteSupportRing (G := H) (K := K)) : + HahnSeries.Nonpositive H K) ∣ b ↔ + (q : HahnSeries.Nonpositive.FiniteSupportRing (G := H) (K := K)) ∣ + (pH : HahnSeries.Nonpositive.FiniteSupportRing (G := H) (K := K))) + +/- The proved, prerequisite-explicit reduction underlying Corollary 6.5.3. -/ + ∀ (H : AddSubgroup ℝ) {K : Type v} [Field K] + {b : HahnSeries.Nonpositive ℝ K} + {p : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)} + {pH : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport (G := H) (K := K)}, + Berarducci.IsNormalizedSeriesMaximalFiniteSupportDivisor b p → + HahnSeries.Nonpositive.IsNormalizedHPart H p pH → + ∀ q : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport (G := H) (K := K), + HahnSeries.Nonpositive.mapDomainToReal H + ((q : HahnSeries.Nonpositive.FiniteSupportRing (G := H) (K := K)) : + HahnSeries.Nonpositive H K) ∣ b ↔ + (q : HahnSeries.Nonpositive.FiniteSupportRing (G := H) (K := K)) ∣ + (pH : HahnSeries.Nonpositive.FiniteSupportRing (G := H) (K := K))) + +/- Corrected relational target for LM24, Corollary 6.5.4. Both inputs are nonzero because the +normalized `H`-part is a partial operation with codomain `1 + K(H^{<0})`. -/ + [DivisibleBy H ℤ] + (p q : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)) ↦ + p ≠ 0 → q ≠ 0 → + ∀ pH qH pqH : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport + (G := H) (K := K), + HahnSeries.Nonpositive.IsNormalizedHPart H p pH → + HahnSeries.Nonpositive.IsNormalizedHPart H q qH → + HahnSeries.Nonpositive.IsNormalizedHPart H (p * q) pqH → + pqH = pH * qH) + +/- The proved reduction underlying Corollary 6.5.4 isolates exactly the factor-refinement input +used in the printed proof. -/ + ∀ (H : AddSubgroup ℝ) {K : Type v} [Field K], + HahnSeries.Nonpositive.HasNormalizedHDivisorRefinement H (K := K) → + ∀ {p q : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)} + {pH qH pqH : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport + (G := H) (K := K)}, + HahnSeries.Nonpositive.IsNormalizedHPart H p pH → + HahnSeries.Nonpositive.IsNormalizedHPart H q qH → + HahnSeries.Nonpositive.IsNormalizedHPart H (p * q) pqH → + pqH = pH * qH) + +/- Nonconstant semantic certificate for the multiplication reduction: for the trivial exponent +subgroup, the normalized part of `(1 + t⁻¹)²` is `1`, although `1 + t⁻¹` is not its embedded +normalized part. -/ + Tests.normalizedPartNonconstantSeries ≠ + HahnSeries.Nonpositive.finiteSupportToReal Tests.TrivialExponentSubgroup + (1 : HahnSeries.Nonpositive.FiniteSupportRing + (G := Tests.TrivialExponentSubgroup) (K := ℚ))) + HahnSeries.Nonpositive.IsNormalizedHPart Tests.TrivialExponentSubgroup + (Tests.normalizedPartNonconstantSeries * + Tests.normalizedPartNonconstantSeries) 1) + +/- Corrected relational target for LM24, Corollary 6.5.5. -/ + [DivisibleBy H ℤ] (b c : HahnSeries.Nonpositive ℝ K) ↦ + b ≠ 0 → c ≠ 0 → + ∀ bH cH bcH : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport + (G := H) (K := K), + HahnSeries.Nonpositive.IsNormalizedHPart H + (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b) bH → + HahnSeries.Nonpositive.IsNormalizedHPart H + (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor c) cH → + HahnSeries.Nonpositive.IsNormalizedHPart H + (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor (b * c)) bcH → + bcH = bH * cH) + +/- The proved reduction underlying Corollary 6.5.5 keeps both mathematical prerequisites +explicit: normalized-divisor refinement and multiplicativity of the real maximal finite-support +divisor. -/ + ∀ (H : AddSubgroup ℝ) {K : Type v} [Field K], + HahnSeries.Nonpositive.HasNormalizedHDivisorRefinement H (K := K) → + ∀ {b c : HahnSeries.Nonpositive ℝ K} + {bH cH bcH : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport + (G := H) (K := K)}, + HahnSeries.Nonpositive.IsNormalizedHPart H + (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b) bH → + HahnSeries.Nonpositive.IsNormalizedHPart H + (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor c) cH → + HahnSeries.Nonpositive.IsNormalizedHPart H + (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor (b * c)) bcH → + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor (b * c) = + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b * + Berarducci.seriesNormalizedMaximalFiniteSupportDivisor c → + bcH = bH * cH) + +/- Exact target for LM24, Corollary 6.5.6. -/ + [DivisibleBy H ℤ] ↦ + ∀ p : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport (G := H) (K := K), + IsPrimal + (((p : HahnSeries.Nonpositive.FiniteSupportRing (G := H) (K := K)) : + HahnSeries.Nonpositive H K))) + +/- Corrected exact target for LM24, Theorem 6.5.7. The coefficient unit is indispensable. The +first clause gives existence and global uniqueness of the normalized finite-support factor. When +the real support supremum lies in `H`, the second clause gives an irreducible factorisation whose +monomial exponent equals that supremum and is globally unique among such factorisations. -/ + [DivisibleBy H ℤ] (b : HahnSeries.Nonpositive H K) ↦ + b ≠ 0 → + ∃ (k : Kˣ) + (p : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport (G := H) (K := K)) + (x : HahnSeries.Nonpositive.exponentMonoid H) + (factors : List (HahnSeries.Nonpositive H K)), + HahnSeries.Nonpositive.IsAlmostIrreducibleFactorization b k p x factors ∧ + HahnSeries.Nonpositive.IsUniqueNormalizedHFactor b p ∧ + ((∃ s : H, HahnSeries.Nonpositive.realSupportSup H b = ((s : ℝ) : WithBot ℝ)) → + ∃ (k' : Kˣ) (x' : HahnSeries.Nonpositive.exponentMonoid H) + (factors' : List (HahnSeries.Nonpositive H K)), + HahnSeries.Nonpositive.IsIrreducibleSubgroupFactorization + b k' p x' factors' ∧ + HahnSeries.Nonpositive.realSupportSup H b = + ((((x' : H) : ℝ) : WithBot ℝ)) ∧ + HahnSeries.Nonpositive.IsUniqueIrreducibleFactorizationExponent b x')) + +/- Scalar boundary for Theorem 6.5.7: the corrected factorisation represents `2`, whereas the +same normalized factor, zero exponent, and empty residual list without a scalar do not. -/ + HahnSeries.Nonpositive.IsAlmostIrreducibleFactorization + (HahnSeries.Nonpositive.C 2 : Tests.FactorizationSeries) + (Units.mk0 2 (by norm_num)) + (1 : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport + (G := Tests.FactorizationExponentSubgroup) (K := ℚ)) + Tests.factorizationZeroExponent []) + (HahnSeries.Nonpositive.C 2 : Tests.FactorizationSeries) ≠ + (((1 : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport + (G := Tests.FactorizationExponentSubgroup) (K := ℚ)) : + HahnSeries.Nonpositive.FiniteSupportRing + (G := Tests.FactorizationExponentSubgroup) (K := ℚ)) : + Tests.FactorizationSeries) * + (HahnSeries.Nonpositive.finiteSupportMonomial (K := ℚ) + Tests.factorizationZeroExponent : + Tests.FactorizationSeries) * + ([] : List Tests.FactorizationSeries).prod) + ∀ {K : Type v} [Field K] + (α : NatOrdinal) (k : K) + (x : Berarducci.principalDegreeClasses K α), + Berarducci.principalDegreeClassesToPrincipalComponent K α (k • x) = + k • Berarducci.principalDegreeClassesToPrincipalComponent K α x) + ∀ {K : Type v} [Field K] [CharZero K] + {α β : NatOrdinal} + (x : Berarducci.principalDegreeClasses K α) + (y : Berarducci.principalDegreeClasses K β), + Berarducci.principalDegreeClassesEquivPrincipalComponent K (α + β) + (Berarducci.principalDegreeClassesMul x y) = + Berarducci.principalComponentMul + (Berarducci.principalDegreeClassesEquivPrincipalComponent K α x) + (Berarducci.principalDegreeClassesEquivPrincipalComponent K β y)) + ∀ (K : Type v) [Field K], + Type (max v 1)) + ∀ (K : Type v) [Field K] [CharZero K], + Berarducci.PrincipalSubring K →ₐ[K] + Berarducci.DegreeGraded K) + ∀ {K : Type v} [Field K] [CharZero K] + (x : Berarducci.PrincipalSubring K) (α : NatOrdinal), + Berarducci.principalSubringEmbedding K x α = + Berarducci.principalComponentToHahnDegreeLayer K α (x α)) + ∀ {K : Type v} [Field K] [CharZero K] + (x : Berarducci.DegreeGraded K), + x ∈ Berarducci.principalSubringSubalgebra K ↔ + Berarducci.IsPrincipalGraded x) + ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + (ν : MaxAddDegree R M), ν.nonpositiveSubring →+* ν.ResidueRing) + ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + (ν : MaxAddDegree R M), Function.Surjective ν.residueMap) + ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + (ν : MaxAddDegree R M), + RingHom.ker ν.residueMap = ν.negativeIdeal) + ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] + [LinearOrder M] [IsOrderedCancelAddMonoid M] + (ν : MaxAddDegree R M), + ν.nonpositiveSubring ⧸ ν.negativeIdeal ≃+* ν.ResidueRing) + ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommGroup M] + [LinearOrder M] [IsOrderedAddMonoid M] + (w : Valuation R (WithZero (Multiplicative M))), + (MaxAddDegree.ofValuation w).nonpositiveSubring = w.integer) + ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommGroup M] + [LinearOrder M] [IsOrderedAddMonoid M] + (w : Valuation R (WithZero (Multiplicative M))), + (MaxAddDegree.ofValuation w).negativeIdeal = + (w.ltIdeal 1).comap (MaxAddDegree.nonpositiveEquivInteger w).toRingHom) + ∀ {K : Type v} [Field K] [CharZero K], + ∃ w : MaxAddDegree (HahnSeries.Nonpositive ℝ K) NatOrdinal, w.IsMultiplicative ∧ + (∀ b, w b = (b : K⟦ℝ⟧).degree) ∧ + w.nonpositiveSubring = HahnSeries.Nonpositive.finiteSupportSubring ∧ + w.negativeIdeal = ⊥ ∧ Function.Bijective w.residueMap) + ∀ {K : Type v} [Field K] [CharZero K] + (b c : HahnSeries.Nonpositive ℝ K), b ≠ 0 → c ≠ 0 → + ((b + c : HahnSeries.Nonpositive ℝ K) : K⟦ℝ⟧).degree ≤ + max (b : K⟦ℝ⟧).degree (c : K⟦ℝ⟧).degree ∧ + ((b * c : HahnSeries.Nonpositive ℝ K) : K⟦ℝ⟧).degree = + (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree ∧ + ((b : K⟦ℝ⟧).degree = ⊥ ↔ b = 0)) + ∀ {K : Type v} [Field K] [CharZero K] + {p b c : HahnSeries.Nonpositive ℝ K}, + p ∈ HahnSeries.Nonpositive.finiteSupportSubring → p ∣ b * c → + ∃ p₁ p₂ : HahnSeries.Nonpositive ℝ K, + p₁ ∈ HahnSeries.Nonpositive.finiteSupportSubring ∧ + p₂ ∈ HahnSeries.Nonpositive.finiteSupportSubring ∧ + p = p₁ * p₂ ∧ p₁ ∣ b ∧ p₂ ∣ c) + +/- LM24, Corollary 6.3.9. -/ + ∀ {K : Type v} [Field K] [CharZero K] + {p : HahnSeries.Nonpositive ℝ K}, + p ∈ HahnSeries.Nonpositive.finiteSupportSubring → IsPrimal p) + +/- Berarducci, Definition 6.6. The residual point is strictly negative, and the translated closed +truncation has exactly the residual value. -/ + ∀ {K : Type v} [Field K] + {b : Berarducci.SeriesWithOrdinalValueAboveOne K} {γ : ℝ}, + γ ∈ Berarducci.residualPointSet b ↔ + γ < 0 ∧ + Berarducci.ordinalValue + (Berarducci.translatedTruncation (b.1 : K⟦ℝ⟧) γ) = b.residualValue) + ∀ {K : Type v} [Field K] + (b : Berarducci.SeriesWithOrdinalValueAboveOne K) (η : ℝ), + Berarducci.residualPointTail b η = + Berarducci.residualPointSet b ∩ Set.Ioo η 0) + +/- Berarducci, Lemma 6.8. The statement is unchanged; the proof treats residual value one by +isolated support points rather than by the failing limit-index construction in the printed proof. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (b : Berarducci.SeriesWithOrdinalValueAboveOne K), + ∀ᶠ η in nhdsWithin (0 : ℝ) (Set.Iio 0), + (Berarducci.residualPointTail b η).Nonempty ∧ + ∃ htail : (Berarducci.residualPointTail b η).IsPWO, + htail.orderType = b.principalValue.val ∧ + IsLUB (Berarducci.residualPointTail b η) 0) + +/- Berarducci, Lemma 6.9, with the domain of `X(b)` and `v_J^p(b)` made explicit. -/ + ∀ {K : Type v} [Field K] [CharZero K] + (b : Berarducci.SeriesWithOrdinalValueAboveOne K) (c : Berarducci.Series K) + {ρ : Ordinal}, Ordinal.IsPrincipal (fun α β ↦ α + β) ρ → + (∀ᶠ γ in nhdsWithin (0 : ℝ) (Set.Iio 0), + γ ∈ Berarducci.residualPointSet b → + NatOrdinal.of ρ ≤ + Berarducci.ordinalValue (Berarducci.translatedTruncation (c : K⟦ℝ⟧) γ)) → + NatOrdinal.of (ρ * b.principalValue.val) ≤ Berarducci.ordinalValue c) + ConwayRefinementConjecture.{u} ↔ + ∀ a b c d : Surreal.OmnificInteger.{u}, a * b = c * d → + ∃ e f g h : Surreal.OmnificInteger.{u}, + a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h) + +/- *On Numbers and Games*, Theorem 31, as recalled in LM24, Section 1.1. -/ + ∀ {x : Surreal.{u}}, + Surreal.IsOmnificInteger x ↔ + x.support ⊆ Set.Ici 0 ∧ + x.coeff 0 ∈ Set.range ((↑) : ℤ → ℝ)) + +/- LM24, Sections 1.1 and 1.5, after the change of variable `t = ω⁻¹`. -/ + ∀ (x : Surreal.{u}), + x.toFullHahnSeries.supportOrderType = Ordinal.lift.{u + 1, u} x.length) + ∀ (x : Surreal.{u}), x.toFullHahnSeries.degree = x.supportDegree) + +/- LM24, Proposition 2.4.3: every nonzero surreal Archimedean stratum is order-additively +isomorphic to the reals. -/ + ∀ (s : HahnEmbedding.ArchimedeanStrata ℝ Surreal.{u}) + (c : FiniteArchimedeanClass Surreal.{u}), s.stratum c ≃+o ℝ) + +/- Universe-bounded LM24, Proposition 2.4.4: every nonzero surreal Archimedean ball has +cofinality at least the cardinal bounding small Conway normal forms. -/ + ∀ (c : FiniteArchimedeanClass Surreal.{u}), + Surreal.smallSupportCardinal.{u} ≤ + Order.cof ↥(FiniteArchimedeanClass.ball ℝ c)) + +/- LM24, Definition 8.2.6. Reducedness is defined only for a nonzero series, and the witnessing +Archimedean class may be the zero class. -/ + ∀ {G : Type u} {R : Type v} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Ring R] + {b : HahnSeries.Nonpositive G R}, HahnSeries.Nonpositive.IsReduced b → + b ≠ 0 ∧ ∃ c : ArchimedeanClass G, + (b : R⟦G⟧).support ∩ + ((b - 1 : HahnSeries.Nonpositive G R) : R⟦G⟧).support ⊆ + {x | ArchimedeanClass.mk x = c}) + +/- The zero Archimedean class is a genuine witness, while mixing zero with a nonzero class is +not reduced. -/ + HahnSeries.Nonpositive.IsReduced Tests.reducedConstant) + ¬HahnSeries.Nonpositive.IsReduced Tests.nonreducedTwoClass) + +/- The finite calculation before LM24, Definition 8.4.2 uses the classes met by the support, +including the zero class. These are not the individual support exponents. -/ + ∀ {G : Type u} {R : Type v} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Ring R] + (b : HahnSeries.Nonpositive G R) (c : ArchimedeanClass G), + c ∈ HahnSeries.Nonpositive.supportArchimedeanClasses b ↔ + ∃ g ∈ (b : R⟦G⟧).support, ArchimedeanClass.mk g = c) + +/- LM24's finite calculation removes the leading class at each open truncation. The Mathlib +order on classes is opposite to LM24's. This signature checks strict support-class descent. -/ + ∀ {K : Type u} {G : Type u} {R : Type v} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Ring R] + (b : HahnSeries.Nonpositive G R) (_hb0 : b ≠ 0) + (horder : (b : R⟦G⟧).order ≠ 0), + HahnSeries.Nonpositive.supportArchimedeanClasses + (HahnSeries.Nonpositive.tau (K := K) + (HahnSeries.Nonpositive.leadingClass b horder) b) ⊂ + HahnSeries.Nonpositive.supportArchimedeanClasses b) + +/- The leading reduction in LM24, Proposition 8.2.5 is reduced. This one-step certificate, +together with strict descent, does not assert the closed finite-product formula in Section 8.4. -/ + ∀ {K : Type u} {G : Type u} {R : Type v} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (s : HahnEmbedding.ArchimedeanStrata K G) + (b : HahnSeries.Nonpositive G R) (_hb0 : b ≠ 0) + (horder : (b : R⟦G⟧).order ≠ 0) + (_htau : HahnSeries.Nonpositive.tau (K := K) + (HahnSeries.Nonpositive.leadingClass b horder) b ≠ 0), + HahnSeries.Nonpositive.IsReduced + (HahnSeries.Nonpositive.rho s (HahnSeries.Nonpositive.leadingClass b horder) b)) + +/- Nondegenerate separators: the first support contains both zero and a nonzero exponent; +the second support is infinite but meets only one class. -/ + HahnSeries.Nonpositive.supportArchimedeanClasses + Tests.FiniteClassReduction.twoClassSeries = + {ArchimedeanClass.mk (-1 : ℝ), ⊤}) + (Berarducci.OneRow.withoutConstant (K := ℝ) : ℝ⟦ℝ⟧).support.Infinite) + HahnSeries.Nonpositive.supportArchimedeanClasses + (Berarducci.OneRow.withoutConstant (K := ℝ)) = + {ArchimedeanClass.mk (-1 : ℝ)}) + +/- LM24, Proposition 8.3.6(5), residue-one irreducibility transfer. -/ + ∀ {K : Type u} {G : Type u} {R : Type v} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + (s : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : HahnSeries.truncationIntegerPart G Z) + (_hb0 : (b : HahnSeries.Nonpositive G R) ≠ 0) + (horder : ((b : HahnSeries.Nonpositive G R) : R⟦G⟧).order ≠ 0) + (_htau : HahnSeries.Nonpositive.tauBall (K := K) + (HahnSeries.Nonpositive.leadingClass + (b : HahnSeries.Nonpositive G R) horder) + (b : HahnSeries.Nonpositive G R) = 1) + (_hirr : Irreducible + (HahnSeries.Nonpositive.splitTruncation s + (HahnSeries.Nonpositive.leadingClass + (b : HahnSeries.Nonpositive G R) horder) + (b : HahnSeries.Nonpositive G R))), + Irreducible b) + +/- LM24, Proposition 9.2.2 in the cardinal-bounded model used for surreal normal forms. Its +underlying preimage lemma is used with a domain ambient ring and clears scalar denominators before +applying primality in the residue subring. -/ + ∀ {L : Type u} {A : Type v} [Field L] [CommRing A] [Algebra L A] + {π : A →ₐ[L] L} {S : Subring L} [IsDomain A] {b : A} (hb : π b ∈ S), + IsPrimal (⟨b, hb⟩ : Subring.residueSubring π S) ↔ + (π b ≠ 0 ∧ IsPrimal (⟨π b, hb⟩ : S) ∧ IsPrimal b) ∨ + (π b = 0 ∧ + IsPrimal + (⟨b, Subring.le_fracSubring hb⟩ : + Subring.residueSubring π (Subring.fracSubring S)))) + ∀ {K : Type u} {G : Type u} {R : Type v} {κ : Cardinal.{u}} + [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [Module K G] [IsOrderedModule K G] [Field R] + [Fact (Cardinal.aleph0 < κ)] [Fact κ.IsRegular] + (s : HahnEmbedding.ArchimedeanStrata K G) (Z : Subring R) + (b : HahnSeries.cardSuppLTTruncationIntegerPart + (G := G) (R := R) (κ := κ) Z) + (_hb0 : HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b ≠ 0) + (horder : ((HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b : + HahnSeries.Nonpositive G R) : R⟦G⟧).order ≠ 0) + (_hbReduced : HahnSeries.Nonpositive.IsReduced + (HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b)) + (_hA2 : LM24.AssumptionA2AtFiniteClass (K := K) κ Z + (HahnSeries.Nonpositive.leadingClass + (HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder)), + IsPrimal b ↔ + IsPrimal (HahnSeries.Nonpositive.splitTruncationCardSuppLT s + (HahnSeries.Nonpositive.leadingClass + (HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) horder) + (HahnSeries.CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z b) + (HahnSeries.CardSuppLTTruncationIntegerPart.cardSupp_toNonpositiveRingHom_lt Z b))) + +end ExactSignatures diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Tests/UpstreamReuse.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Tests/UpstreamReuse.lean new file mode 100644 index 0000000000..39243c71e0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Tests/UpstreamReuse.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +import Mathlib.Algebra.Divisibility.Basic +import Mathlib.Algebra.DirectSum.Ring +import Mathlib.Algebra.Group.Subgroup.Lattice +import Mathlib.Algebra.MonoidAlgebra.ToDirectSum +import Mathlib.Algebra.MvPolynomial.Eval +import Mathlib.Algebra.Order.Archimedean.Real.Basic +import Mathlib.FieldTheory.AlgebraicClosure +import Mathlib.LinearAlgebra.Basis.VectorSpace +import Mathlib.LinearAlgebra.DirectSum.TensorProduct +import Mathlib.LinearAlgebra.Dual.Lemmas +import Mathlib.LinearAlgebra.Projection +import Mathlib.RingTheory.Derivation.Basic +import Mathlib.RingTheory.HahnSeries.Cardinal +import Mathlib.RingTheory.Ideal.Prime +import Mathlib.RingTheory.Ideal.Quotient.Operations +import Mathlib.RingTheory.Ideal.Span +import Mathlib.RingTheory.Localization.Basic +import Mathlib.RingTheory.Localization.BaseChange +import Mathlib.RingTheory.Localization.FractionRing +import Mathlib.RingTheory.Valuation.Basic +import Mathlib.RingTheory.Valuation.ExtendToLocalization +import Mathlib.RingTheory.Valuation.Integers +import Mathlib.RingTheory.TensorProduct.Maps +import Mathlib.RingTheory.TensorProduct.MonoidAlgebra +import Mathlib.Order.Bounds.OrderIso +import Mathlib.Order.Filter.Germ.Basic +import Mathlib.Order.Hom.Set +import Mathlib.SetTheory.Ordinal.Arithmetic +import Mathlib.SetTheory.Ordinal.Principal +import Mathlib.SetTheory.Cardinal.Cofinality.Basic +import Mathlib.SetTheory.ZFC.Class +import Mathlib.SetTheory.Ordinal.Family +import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic +import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Ordinal + +/-! +# Upstream reuse checks + +This module pins the availability and compiler-visible signatures of selected upstream interfaces. +It intentionally declares no mathematical API. The hash-command linter is disabled here because +the module consists precisely of checked signature fixtures. +-/ +universe u v w + (@Ordinal.isPrincipal_add_iff_zero_or_omega0_opow : + {o : Ordinal.{u}} → + Ordinal.IsPrincipal (· + ·) o ↔ + o = 0 ∨ o ∈ Set.range fun e : Ordinal.{u} ↦ Ordinal.omega0 ^ e) + (@Ordinal.sub_omega0_opow_log_lt : + {o : Ordinal.{u}} → + o ≠ 0 → o - Ordinal.omega0 ^ Ordinal.log Ordinal.omega0 o < o) + (@HahnSeries.cardSuppLTSubring : + (Γ : Type u) → + (R : Type v) → + (κ : Cardinal.{u}) → + [PartialOrder Γ] → + [AddCommMonoid Γ] → + [IsOrderedCancelAddMonoid Γ] → + [Ring R] → [Fact (Cardinal.aleph0 ≤ κ)] → Subring (HahnSeries Γ R)) + (@HahnSeries.cardSuppLTSubfield : + (Γ : Type u) → + (R : Type v) → + (κ : Cardinal.{u}) → + [LinearOrder Γ] → + [AddCommGroup Γ] → + [IsOrderedAddMonoid Γ] → + [Field R] → [Fact (Cardinal.aleph0 < κ)] → Subfield (HahnSeries Γ R)) + (@Order.le_cof_iff : + ∀ {α : Type u} [Preorder α] {c : Cardinal.{u}}, + c ≤ Order.cof α ↔ ∀ s : Set α, IsCofinal s → c ≤ Cardinal.mk ↥s) + (@not_isCofinal_iff : + ∀ {α : Type u} [LinearOrder α] {s : Set α}, + ¬ IsCofinal s ↔ ∃ x, ∀ y ∈ s, y < x) + (@HahnSeries.cardSupp_single_mul_le : + ∀ {Γ : Type u} {R : Type v} [PartialOrder Γ] [AddCommMonoid Γ] + [IsOrderedCancelAddMonoid Γ] [NonUnitalNonAssocSemiring R] + (x : HahnSeries Γ R) (a : Γ) (r : R), + (HahnSeries.single a r * x).cardSupp ≤ x.cardSupp) + (@HahnSeries.iterateEquiv : + {Γ : Type u} → + {Γ' : Type v} → + {R : Type w} → + [PartialOrder Γ] → + [Zero R] → + [PartialOrder Γ'] → + HahnSeries Γ (HahnSeries Γ' R) ≃ HahnSeries (Lex (Γ × Γ')) R) + (@HahnSeries.truncLT : + {Γ : Type u} → + {R : Type v} → + [Zero R] → + [PartialOrder Γ] → + [DecidableLT Γ] → Γ → ZeroHom (HahnSeries Γ R) (HahnSeries Γ R)) + (@HahnSeries.embDomain : + {Γ : Type u} → + {Γ' : Type v} → + {R : Type w} → + [PartialOrder Γ] → + [Zero R] → + [PartialOrder Γ'] → + (Γ ↪o Γ') → HahnSeries Γ R → HahnSeries Γ' R) + (@HahnSeries.support_embDomain_subset : + {Γ : Type u} → + {Γ' : Type v} → + {R : Type w} → + [PartialOrder Γ] → + [Zero R] → + [PartialOrder Γ'] → + {f : Γ ↪o Γ'} → + {x : HahnSeries Γ R} → + (HahnSeries.embDomain f x).support ⊆ f '' x.support) + (@WithBot.coe_sSup' : + {α : Type u} → + [Preorder α] → + [SupSet α] → + {s : Set α} → + s.Nonempty → + BddAbove s → + ((sSup s : α) : WithBot α) = + sSup ((fun a : α ↦ (a : WithBot α)) '' s)) + (@SurrealHahnSeries.type_support : + ∀ x : SurrealHahnSeries.{u}, + Ordinal.type (α := x.support) (· > ·) = Ordinal.lift.{u + 1} x.length) + (@not_injective_of_ordinal : + ∀ {α : Type v} [Small.{u} α] (f : Ordinal.{u} → α), ¬Function.Injective f) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology.lean new file mode 100644 index 0000000000..919611f888 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology.lean @@ -0,0 +1,14 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixson +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonProduct +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonRank +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonReconstruction +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Tests + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixson.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixson.lean new file mode 100644 index 0000000000..eedaf5564a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixson.lean @@ -0,0 +1,190 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Topology.DerivedSet +public import Mathlib.Topology.Sets.Closeds +public import Mathlib.SetTheory.Ordinal.Arithmetic +import Mathlib.Order.TransfiniteIteration +public import Mathlib.Topology.Maps.Basic +import Mathlib.Topology.Compactness.Compact + +/-! +# Transfinite Cantor–Bendixson derivatives + +The derivative is taken in the given ambient topology. Its transfinite iteration on a closed +set takes intersections at limit ordinals. Closed maps with finite fibers lift membership in +every derivative of the image. No countability or scatteredness assumption is imposed. +-/ + +public noncomputable section + +open Set Topology Order + +universe u v w + +namespace TopologicalSpace.Closeds + +variable {X : Type u} [TopologicalSpace X] [T1Space X] + +/-- The set of accumulation points of a closed set, in the ambient topology. -/ +def derived (s : Closeds X) : Closeds X := ⟨derivedSet (s : Set X), isClosed_derivedSet _⟩ + +@[simp] +theorem coe_derived (s : Closeds X) : (s.derived : Set X) = derivedSet (s : Set X) := (rfl) + +theorem derived_le (s : Closeds X) : s.derived ≤ s := + (isClosed_iff_derivedSet_subset _).mp s.isClosed + +/-- The transfinite Cantor–Bendixson derivative, with the original closed set at stage zero. -/ +def cantorBendixson (s : Closeds X) (o : Ordinal.{w}) : Closeds X := + transfiniteIterate (I := (Closeds X)ᵒᵈ) derived o s + +@[simp] +theorem cantorBendixson_zero (s : Closeds X) : s.cantorBendixson (0 : Ordinal.{w}) = s := by + exact transfiniteIterate_bot (I := (Closeds X)ᵒᵈ) derived s + +@[simp] +theorem cantorBendixson_add_one (s : Closeds X) (o : Ordinal.{w}) : + s.cantorBendixson (o + 1) = (s.cantorBendixson o).derived := by + exact transfiniteIterate_succ (I := (Closeds X)ᵒᵈ) derived s o (not_isMax o) + +theorem cantorBendixson_limit (s : Closeds X) (o : Ordinal.{w}) (ho : IsSuccLimit o) : + s.cantorBendixson o = ⨅ i : Iio o, s.cantorBendixson i.1 := by + exact transfiniteIterate_limit (I := (Closeds X)ᵒᵈ) derived s o ho + +theorem cantorBendixson_mono {s t : Closeds X} (hst : s ≤ t) (o : Ordinal.{w}) : + s.cantorBendixson o ≤ t.cantorBendixson o := by + induction o using Ordinal.limitRecOn with + | zero => simpa using hst + | add_one o ih => + rw [cantorBendixson_add_one, cantorBendixson_add_one] + exact derivedSet_mono _ _ ih + | limit o ho ih => + rw [cantorBendixson_limit _ _ ho, cantorBendixson_limit _ _ ho] + exact iInf_mono fun i ↦ ih i.1 i.2 + +theorem cantorBendixson_antitone (s : Closeds X) : + Antitone (s.cantorBendixson : Ordinal.{w} → Closeds X) := + monotone_transfiniteIterate (I := (Closeds X)ᵒᵈ) derived s derived_le + +theorem cantorBendixson_le (s : Closeds X) (o : Ordinal.{w}) : s.cantorBendixson o ≤ s := by + simpa using s.cantorBendixson_antitone (show 0 ≤ o from zero_le) + +end TopologicalSpace.Closeds + +variable {X : Type u} {Y : Type v} [TopologicalSpace X] [TopologicalSpace Y] + +/-- Every accumulation point of the image under a closed map lifts to an accumulation point. +Continuity and finiteness of the fibers are not required for this single derivative. -/ +theorem IsClosedMap.derivedSet_image_subset {f : X → Y} (hf : IsClosedMap f) (s : Set X) : + derivedSet (f '' s) ⊆ f '' derivedSet s := by + intro y hy + have hfreq := accPt_iff_frequently.mp (mem_derivedSet.mp hy) + obtain ⟨x, hx, h⟩ := hf.frequently_nhds_fiber (p := fun x ↦ f x ≠ y ∧ x ∈ s) y + (hfreq.mono fun z hz ↦ by + obtain ⟨a, ha, rfl⟩ := hz.2 + exact ⟨a, rfl, hz.1, ha⟩) + refine ⟨x, mem_derivedSet.mpr (accPt_iff_frequently.mpr ?_), hx⟩ + exact h.mono fun z hz ↦ ⟨fun hzx ↦ hz.1 (hzx ▸ hx), hz.2⟩ + +/-- A closed map with finite fibers lifts every transfinite derivative of the image. +The statement holds for arbitrary ordinals, including limits of uncountable cofinality. -/ +theorem IsClosedMap.cantorBendixson_image_subset [T1Space X] [T1Space Y] + {f : X → Y} (hf : IsClosedMap f) (hfin : ∀ y, (f ⁻¹' {y}).Finite) + (s : TopologicalSpace.Closeds X) (o : Ordinal.{w}) : + ((⟨f '' (s : Set X), hf _ s.isClosed⟩ : TopologicalSpace.Closeds Y).cantorBendixson o : + Set Y) ⊆ f '' (s.cantorBendixson o : Set X) := by + induction o using Ordinal.limitRecOn with + | zero => simp + | add_one o ih => + simp only [TopologicalSpace.Closeds.cantorBendixson_add_one, + TopologicalSpace.Closeds.coe_derived] + exact (derivedSet_mono _ _ ih).trans (hf.derivedSet_image_subset _) + | limit o ho ih => + intro y hy + rw [TopologicalSpace.Closeds.cantorBendixson_limit _ _ ho] at hy ⊢ + have hymem : ∀ i : Iio o, y ∈ f '' (s.cantorBendixson i.1 : Set X) := + fun i ↦ ih i.1 i.2 ((TopologicalSpace.Closeds.mem_iInf.mp hy) i) + let t (i : Iio o) : Set X := (f ⁻¹' {y}) ∩ (s.cantorBendixson i.1 : Set X) + have htn (i : Iio o) : (t i).Nonempty := by + obtain ⟨x, hx, hxy⟩ := hymem i + exact ⟨x, hxy, hx⟩ + have htd : Directed (· ⊇ ·) t := by + intro i j + refine ⟨max i j, ?_, ?_⟩ + · exact inter_subset_inter_right _ (s.cantorBendixson_antitone (le_max_left i j)) + · exact inter_subset_inter_right _ (s.cantorBendixson_antitone (le_max_right i j)) + have htf (i : Iio o) : (t i).Finite := (hfin y).subset inter_subset_left + letI : Nonempty (Iio o) := ⟨⟨0, ho.bot_lt⟩⟩ + obtain ⟨x, hx⟩ := IsCompact.nonempty_iInter_of_directed_nonempty_isCompact_isClosed + t htd htn (fun i ↦ (htf i).isCompact) (fun i ↦ (htf i).isClosed) + have hxi := mem_iInter.mp hx + exact ⟨x, TopologicalSpace.Closeds.mem_iInf.mpr (fun i ↦ (hxi i).2), + (hxi ⟨0, ho.bot_lt⟩).1⟩ + +namespace TopologicalSpace.Closeds + +variable [T1Space X] + +/-- A locally strictly decreasing ordinal label bounds every Cantor–Bendixson stage. +Only other points of the original closed set are required to have smaller nearby labels. -/ +theorem cantorBendixson_subset_of_locally_lt (s : Closeds X) (r : X → Ordinal.{w}) + (hr : ∀ x ∈ s, ∀ᶠ y in 𝓝 x, y ∈ s → y ≠ x → r y < r x) (o : Ordinal.{w}) : + (s.cantorBendixson o : Set X) ⊆ {x | o ≤ r x} := by + induction o using Ordinal.limitRecOn with + | zero => exact fun _ _ ↦ (show (0 : Ordinal) ≤ _ from zero_le) + | add_one o ih => + intro x hx + rw [cantorBendixson_add_one] at hx + have hacc := accPt_iff_frequently.mp (mem_derivedSet.mp hx) + have hxs : x ∈ s := s.cantorBendixson_le (o + 1) (by + rw [cantorBendixson_add_one]; exact hx) + change o + 1 ≤ r x + apply Order.succ_le_iff.mpr + by_contra! hle + obtain ⟨y, hy, hnear⟩ := (hacc.and_eventually (hr x hxs)).exists + exact (not_lt_of_ge (ih hy.2)) + ((hnear (s.cantorBendixson_le o hy.2) hy.1).trans_le hle) + | limit o ho ih => + intro x hx + rw [cantorBendixson_limit _ _ ho] at hx + exact ho.le_iff_forall_le.mpr fun a ha ↦ ih a ha (mem_iInf.mp hx ⟨a, ha⟩) + +/-- Transfinite derivatives commute with binary unions of closed sets. -/ +theorem cantorBendixson_sup (s t : Closeds X) (o : Ordinal.{w}) : + (s ⊔ t).cantorBendixson o = s.cantorBendixson o ⊔ t.cantorBendixson o := by + apply le_antisymm + · induction o using Ordinal.limitRecOn with + | zero => simp + | add_one o ih => + rw [cantorBendixson_add_one, cantorBendixson_add_one, cantorBendixson_add_one] + change (((s ⊔ t).cantorBendixson o).derived : Set X) ⊆ + ((s.cantorBendixson o).derived : Set X) ∪ ((t.cantorBendixson o).derived : Set X) + simp only [coe_derived] + rw [← derivedSet_union] + exact derivedSet_mono _ _ ih + | limit o ho ih => + intro x hx + change x ∈ (s.cantorBendixson o : Set X) ∪ (t.cantorBendixson o : Set X) + by_contra hnot + have hs : x ∉ s.cantorBendixson o := fun hh ↦ hnot (Or.inl hh) + have ht : x ∉ t.cantorBendixson o := fun hh ↦ hnot (Or.inr hh) + rw [cantorBendixson_limit _ _ ho] at hs ht + obtain ⟨i, hi⟩ : ∃ i : Iio o, x ∉ s.cantorBendixson i.1 := by + by_contra! hn + exact hs (mem_iInf.mpr hn) + obtain ⟨j, hj⟩ : ∃ j : Iio o, x ∉ t.cantorBendixson j.1 := by + by_contra! hn + exact ht (mem_iInf.mpr hn) + have hm := ih (max i.1 j.1) (max_lt i.2 j.2) + ((s ⊔ t).cantorBendixson_antitone (max_lt i.2 j.2).le hx) + rcases hm with hm | hm + · exact hi (s.cantorBendixson_antitone (le_max_left _ _) hm) + · exact hj (t.cantorBendixson_antitone (le_max_right _ _) hm) + · exact sup_le (cantorBendixson_mono le_sup_left o) (cantorBendixson_mono le_sup_right o) + +end TopologicalSpace.Closeds diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonProduct.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonProduct.lean new file mode 100644 index 0000000000..4a06fd60d0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonProduct.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixson +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Basic +public import Mathlib.Topology.Constructions.SumProd + +/-! +# Natural-sum bounds for Cantor–Bendixson derivatives of products + +Locally strictly decreasing ordinal labels on two closed sets give their natural sum as a +bound on the Cantor–Bendixson stages of the product. The addition is Hessenberg addition on +`NatOrdinal`, not ordinary ordinal addition. No countability or compactness is required. +-/ + +public noncomputable section + +open Set Filter Topology TopologicalSpace + +universe u v w + +namespace TopologicalSpace.Closeds + +variable {X : Type u} {Y : Type v} [TopologicalSpace X] [TopologicalSpace Y] + [T1Space X] [T1Space Y] + +/-- Natural addition of locally strictly decreasing ordinal labels bounds product derivatives. -/ +theorem cantorBendixson_prod_subset_of_locally_lt (s : Closeds X) (t : Closeds Y) + (r : X → NatOrdinal.{w}) (q : Y → NatOrdinal.{w}) + (hr : ∀ x ∈ s, ∀ᶠ z in 𝓝 x, z ∈ s → z ≠ x → r z < r x) + (hq : ∀ y ∈ t, ∀ᶠ z in 𝓝 y, z ∈ t → z ≠ y → q z < q y) (o : Ordinal.{w}) : + ((s ×ˢ t).cantorBendixson o : Set (X × Y)) ⊆ {p | o ≤ (r p.1 + q p.2).val} := by + apply cantorBendixson_subset_of_locally_lt + rintro ⟨x, y⟩ hxy + obtain ⟨hx, hy⟩ := mem_prod.mp hxy + rw [nhds_prod_eq] + apply eventually_prod_iff.mpr + refine ⟨_, hr x hx, _, hq y hy, ?_⟩ + intro z hz w hw hzw hne + obtain ⟨hzs, hwt⟩ := mem_prod.mp hzw + apply NatOrdinal.val.lt_iff_lt.mpr + by_cases hzx : z = x + · subst z + have hwy : w ≠ y := fun heq ↦ hne (Prod.ext rfl heq) + exact add_lt_add_right (hw hwt hwy) _ + · have hwle : q w ≤ q y := by + by_cases hwy : w = y + · exact hwy ▸ le_rfl + · exact (hw hwt hwy).le + exact add_lt_add_of_lt_of_le (hz hzs hzx) hwle + +end TopologicalSpace.Closeds diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonRank.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonRank.lean new file mode 100644 index 0000000000..2ee572b206 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonRank.lean @@ -0,0 +1,144 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixson +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAddition +public import Mathlib.SetTheory.Ordinal.Basic +import Mathlib.Topology.DiscreteSubset + +/-! +# Cantor–Bendixson point ranks of well-ordered supports + +For a closed well-ordered subset of a linearly ordered space, each point disappears at a +successor derivative stage. The ordinal index of the point in the well-ordered support gives +a bound, because a sufficiently small neighborhood contains no larger support point. + +The point rank is the least ordinal whose successor derivative omits the point. On the support, +membership in stage `o` is equivalent to `o` being at most the point rank. Points outside the +support have rank zero. All derivatives use the given ambient topology. +-/ + +public noncomputable section + +open Set Filter Topology TopologicalSpace + +universe u + +variable {X : Type u} [LinearOrder X] [TopologicalSpace X] [OrderTopology X] + +/-- A well-ordered support has no points immediately to the right of any given ambient point. -/ +theorem Set.IsPWO.eventually_le {s : Set X} (hs : s.IsPWO) (x : X) : + ∀ᶠ y in 𝓝 x, y ∈ s → y ≤ x := by + let v := s ∩ Ioi x + by_cases hn : v.Nonempty + · have hv : v.IsWF := hs.isWF.mono inter_subset_left + let m := hv.min hn + have hm : m ∈ v := hv.min_mem hn + filter_upwards [Iio_mem_nhds hm.2] with y hy hys + exact le_of_not_gt fun hxy ↦ (not_lt_of_ge (hv.min_le hn ⟨hys, hxy⟩)) hy + · apply Filter.Eventually.of_forall + intro y hy + exact le_of_not_gt fun hxy ↦ hn ⟨y, hy, hxy⟩ + +namespace TopologicalSpace.Closeds + +/-- Every ambient point is absent from some successor derivative of a closed well-ordered set. -/ +theorem exists_notMem_cantorBendixson_succ (s : Closeds X) (hs : (s : Set X).IsPWO) (x : X) : + ∃ o : Ordinal.{u}, x ∉ (s.cantorBendixson (o + 1) : Set X) := by + classical + letI : WellFoundedLT (s : Set X) := ⟨hs.isWF⟩ + let r (y : X) : Ordinal.{u} := + if h : y ∈ s then Ordinal.typein (α := (s : Set X)) (· < ·) ⟨y, h⟩ else 0 + have hr : ∀ y ∈ s, ∀ᶠ z in 𝓝 y, z ∈ s → z ≠ y → r z < r y := by + intro y hy + filter_upwards [hs.eventually_le y] with z hz hzs hzy + simp only [r, dif_pos hzs, dif_pos hy, Ordinal.typein_lt_typein] + exact (lt_of_le_of_ne (hz hzs) hzy : z < y) + refine ⟨r x, fun hx ↦ ?_⟩ + exact (not_le_of_gt (Order.lt_succ (r x))) + (s.cantorBendixson_subset_of_locally_lt r hr (r x + 1) hx) + +/-- The least ordinal whose successor derivative omits the point; zero outside the set. -/ +def cantorBendixsonRank (s : Closeds X) (hs : (s : Set X).IsPWO) (x : X) : Ordinal.{u} := + wellFounded_lt.min {o : Ordinal.{u} | x ∉ (s.cantorBendixson (o + 1) : Set X)} + (s.exists_notMem_cantorBendixson_succ hs x) + +/-- The successor of the point rank removes that point. -/ +theorem notMem_cantorBendixson_rank_add_one (s : Closeds X) + (hs : (s : Set X).IsPWO) (x : X) : + x ∉ (s.cantorBendixson (s.cantorBendixsonRank hs x + 1) : Set X) := by + exact wellFounded_lt.min_mem + {o : Ordinal.{u} | x ∉ (s.cantorBendixson (o + 1) : Set X)} + (s.exists_notMem_cantorBendixson_succ hs x) + +/-- Any successor stage omitting a point gives an upper bound on its rank. -/ +theorem cantorBendixsonRank_le_of_notMem (s : Closeds X) (hs : (s : Set X).IsPWO) + (x : X) {o : Ordinal.{u}} (ho : x ∉ (s.cantorBendixson (o + 1) : Set X)) : + s.cantorBendixsonRank hs x ≤ o := by + exact wellFounded_lt.min_le ho + +/-- A point belongs to a derivative exactly when it lies in the set and its rank is high enough. -/ +theorem mem_cantorBendixson_iff (s : Closeds X) (hs : (s : Set X).IsPWO) + (x : X) (o : Ordinal.{u}) : + x ∈ (s.cantorBendixson o : Set X) ↔ x ∈ s ∧ o ≤ s.cantorBendixsonRank hs x := by + constructor + · intro hx + refine ⟨s.cantorBendixson_le o hx, ?_⟩ + by_contra! ho + exact s.notMem_cantorBendixson_rank_add_one hs x + (s.cantorBendixson_antitone (Order.succ_le_of_lt ho) hx) + · rintro ⟨hx, ho⟩ + induction o using Ordinal.limitRecOn with + | zero => simpa using hx + | add_one o ih => + by_contra hn + exact (not_le_of_gt ((Order.lt_succ o).trans_le ho)) + (s.cantorBendixsonRank_le_of_notMem hs x hn) + | limit o hlo ih => + rw [cantorBendixson_limit _ _ hlo] + exact mem_iInf.mpr fun i ↦ ih i.1 i.2 (i.2.le.trans ho) + +/-- A support point has rank `o` exactly when it survives stage `o` but not its successor. -/ +theorem cantorBendixsonRank_eq_iff (s : Closeds X) (hs : (s : Set X).IsPWO) + {x : X} (hx : x ∈ s) (o : Ordinal.{u}) : + s.cantorBendixsonRank hs x = o ↔ + x ∈ (s.cantorBendixson o : Set X) ∧ x ∉ (s.cantorBendixson (o + 1) : Set X) := by + constructor + · intro he + exact ⟨(s.mem_cantorBendixson_iff hs x o).mpr ⟨hx, he.ge⟩, + he ▸ s.notMem_cantorBendixson_rank_add_one hs x⟩ + · rintro ⟨hm, hn⟩ + exact le_antisymm (s.cantorBendixsonRank_le_of_notMem hs x hn) + ((s.mem_cantorBendixson_iff hs x o).mp hm).2 + +/-- The rank convention assigns zero to points outside the original closed set. -/ +theorem cantorBendixsonRank_of_notMem (s : Closeds X) (hs : (s : Set X).IsPWO) + {x : X} (hx : x ∉ s) : s.cantorBendixsonRank hs x = 0 := by + apply le_antisymm _ zero_le + apply s.cantorBendixsonRank_le_of_notMem hs x + exact fun h ↦ hx (s.cantorBendixson_le _ h) + +/-- Every point has rank zero relative to a finite closed set. -/ +theorem cantorBendixsonRank_of_finite (s : Closeds X) (hs : (s : Set X).IsPWO) + (hfin : (s : Set X).Finite) (x : X) : s.cantorBendixsonRank hs x = 0 := by + apply le_antisymm _ zero_le + apply s.cantorBendixsonRank_le_of_notMem hs x + rw [cantorBendixson_add_one, cantorBendixson_zero, coe_derived, mem_derivedSet] + exact fun h ↦ hfin.not_infinite (Set.Infinite.of_accPt h) + +/-- All other sufficiently nearby support points have strictly smaller rank. -/ +theorem cantorBendixsonRank_locally_lt (s : Closeds X) (hs : (s : Set X).IsPWO) + (x : X) : ∀ᶠ y in 𝓝 x, y ∈ s → y ≠ x → + s.cantorBendixsonRank hs y < s.cantorBendixsonRank hs x := by + have hn := s.notMem_cantorBendixson_rank_add_one hs x + rw [cantorBendixson_add_one, coe_derived, mem_derivedSet, accPt_iff_frequently, + Filter.not_frequently] at hn + filter_upwards [hn] with y hy hys hyx + by_contra! hle + exact hy ⟨hyx, (s.mem_cantorBendixson_iff hs y _).mpr ⟨hys, hle⟩⟩ + +end TopologicalSpace.Closeds diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonReconstruction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonReconstruction.lean new file mode 100644 index 0000000000..6054770e0a --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonReconstruction.lean @@ -0,0 +1,507 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonRank +public import Mathlib.Topology.Homeomorph.Defs +public import Mathlib.Topology.DiscreteSubset + +import Mathlib.Topology.Maps.Basic + +/-! +# Local reconstruction of Cantor–Bendixson stages + +Transfinite derivatives compose by ordinary ordinal addition and agree locally whenever the +original closed sets agree on an open set. For a closed well-ordered support, the points of +exact rank `a` are dense in its `a`-th derivative. These facts give the reconstruction inequality: +if its rank-`a` points locally belong to another set's `b`-th derivative, then its `(a + c)`-th +stage locally belongs to that set's `(b + c)`-th stage, for every ordinal `c`. + +The statements use the given ambient topology and hold at arbitrary ordinal cofinalities. +-/ + +public noncomputable section + +open Set Filter Topology TopologicalSpace + +universe u v w + +/-- Homeomorphisms preserve every transfinite derivative stage of a closed set. -/ +theorem Homeomorph.mem_cantorBendixson_iff {X Y : Type*} + [TopologicalSpace X] [TopologicalSpace Y] [T1Space X] [T1Space Y] + (e : X ≃ₜ Y) (s : Closeds X) (t : Closeds Y) (he : e '' (s : Set X) = (t : Set Y)) + (x : X) (o : Ordinal.{v}) : + e x ∈ (t.cantorBendixson o : Set Y) ↔ x ∈ (s.cantorBendixson o : Set X) := by + have hf (y : Y) : (e ⁻¹' {y}).Finite := (finite_singleton y).preimage e.injective.injOn + have hg (x : X) : (e.symm ⁻¹' {x}).Finite := + (finite_singleton x).preimage e.symm.injective.injOn + have ht' : (⟨e '' (s : Set X), e.isClosedMap _ s.isClosed⟩ : Closeds Y) = t := + SetLike.coe_injective he + have he' : e.symm '' (t : Set Y) = (s : Set X) := by + rw [← he, ← Set.image_comp] + simp + have hs' : (⟨e.symm '' (t : Set Y), e.symm.isClosedMap _ t.isClosed⟩ : Closeds X) = s := + SetLike.coe_injective he' + have hst := e.isClosedMap.cantorBendixson_image_subset hf s o + have hts := e.symm.isClosedMap.cantorBendixson_image_subset hg t o + rw [ht'] at hst + rw [hs'] at hts + constructor + · intro hx + obtain ⟨y, hy, hyx⟩ := hst hx + exact e.injective hyx ▸ hy + · intro hx + obtain ⟨y, hy, hyx⟩ := hts hx + have hxy : y = e x := by simpa using congrArg e hyx + exact hxy ▸ hy + +namespace TopologicalSpace.Closeds + +variable {X : Type u} [TopologicalSpace X] [T1Space X] + +/-- Iteration of derivative stages corresponds to ordinary ordinal addition. -/ +theorem cantorBendixson_add (s : Closeds X) (a b : Ordinal.{v}) : + s.cantorBendixson (a + b) = (s.cantorBendixson a).cantorBendixson b := by + induction b using Ordinal.limitRecOn with + | zero => simp + | add_one b ih => + rw [← add_assoc, cantorBendixson_add_one, cantorBendixson_add_one, ih] + | limit b hb ih => + rw [cantorBendixson_limit _ _ (Ordinal.isSuccLimit_add a hb), + cantorBendixson_limit _ _ hb] + apply le_antisymm + · apply le_iInf + intro i + rw [← ih i.1 i.2] + exact iInf_le (fun j : Iio (a + b) ↦ s.cantorBendixson j.1) + ⟨a + i.1, (add_lt_add_iff_left a).mpr i.2⟩ + · apply le_iInf + intro i + obtain ⟨j, hj, hij⟩ := (Ordinal.lt_add_iff hb.ne_bot).mp i.2 + exact (iInf_le (fun k : Iio b ↦ (s.cantorBendixson a).cantorBendixson k.1) + ⟨j, hj⟩).trans + ((ih j hj) ▸ s.cantorBendixson_antitone hij) + +end TopologicalSpace.Closeds + +/-- Restricting a set to an open set preserves its derived set inside that open set. -/ +theorem IsOpen.derivedSet_inter_eq {X : Type*} [TopologicalSpace X] {U s : Set X} + (hU : IsOpen U) : derivedSet (s ∩ U) ∩ U = derivedSet s ∩ U := by + ext x + constructor + · rintro ⟨hx, hxU⟩ + exact ⟨derivedSet_mono _ _ inter_subset_left hx, hxU⟩ + · rintro ⟨hx, hxU⟩ + refine ⟨mem_derivedSet.mpr (accPt_iff_frequently.mpr ?_), hxU⟩ + exact ((accPt_iff_frequently.mp (mem_derivedSet.mp hx)).and_eventually + (hU.mem_nhds hxU)).mono fun y hy ↦ ⟨hy.1.1, hy.1.2, hy.2⟩ + +/-- Sets agreeing on an open set have closures agreeing there. -/ +theorem IsOpen.closure_congr {X : Type*} [TopologicalSpace X] {U s t : Set X} + (hU : IsOpen U) (hst : s ∩ U = t ∩ U) : closure s ∩ U = closure t ∩ U := by + ext x + constructor + · intro hx + have hm := hU.closure_inter hx + rw [hst] at hm + exact ⟨closure_mono inter_subset_left hm, hx.2⟩ + · intro hx + have hm := hU.closure_inter hx + rw [← hst] at hm + exact ⟨closure_mono inter_subset_left hm, hx.2⟩ + +/-- Sets agreeing on an open set have derived sets agreeing there. -/ +theorem IsOpen.derivedSet_congr {X : Type*} [TopologicalSpace X] {U s t : Set X} + (hU : IsOpen U) (hst : s ∩ U = t ∩ U) : derivedSet s ∩ U = derivedSet t ∩ U := by + rw [← hU.derivedSet_inter_eq (s := s), hst, hU.derivedSet_inter_eq] + +namespace TopologicalSpace.Closeds + +variable {X : Type u} [TopologicalSpace X] [T1Space X] + +/-- Closed sets agreeing on an open set have every derivative stage agreeing there. -/ +theorem cantorBendixson_congr_on_open (s t : Closeds X) {U : Set X} (hU : IsOpen U) + (hst : (s : Set X) ∩ U = (t : Set X) ∩ U) (o : Ordinal.{v}) : + (s.cantorBendixson o : Set X) ∩ U = (t.cantorBendixson o : Set X) ∩ U := by + induction o using Ordinal.limitRecOn with + | zero => simpa using hst + | add_one o ih => + simpa only [cantorBendixson_add_one, coe_derived] using hU.derivedSet_congr ih + | limit o ho ih => + rw [cantorBendixson_limit _ _ ho, cantorBendixson_limit _ _ ho] + ext x + constructor + · rintro ⟨hx, hxU⟩ + refine ⟨Closeds.mem_iInf.mpr (fun i ↦ ?_), hxU⟩ + exact ((Set.ext_iff.mp (ih i.1 i.2) x).mp + ⟨Closeds.mem_iInf.mp hx i, hxU⟩).1 + · rintro ⟨hx, hxU⟩ + refine ⟨Closeds.mem_iInf.mpr (fun i ↦ ?_), hxU⟩ + exact ((Set.ext_iff.mp (ih i.1 i.2) x).mpr + ⟨Closeds.mem_iInf.mp hx i, hxU⟩).1 + +/-- Local inclusion of closed sets implies local inclusion at every derivative stage. -/ +theorem cantorBendixson_mono_on_open (s t : Closeds X) {U : Set X} (hU : IsOpen U) + (hst : (s : Set X) ∩ U ⊆ (t : Set X)) (o : Ordinal.{v}) : + (s.cantorBendixson o : Set X) ∩ U ⊆ (t.cantorBendixson o : Set X) := by + have he : (s : Set X) ∩ U = ((s ⊓ t : Closeds X) : Set X) ∩ U := by + ext x + constructor + · intro hx + exact ⟨⟨hx.1, hst hx⟩, hx.2⟩ + · rintro ⟨⟨hx, _⟩, hxU⟩ + exact ⟨hx, hxU⟩ + intro x hx + have hx' := (Set.ext_iff.mp (s.cantorBendixson_congr_on_open (s ⊓ t) hU he o) x).mp hx + exact cantorBendixson_mono inf_le_right o hx'.1 + +variable [LinearOrder X] [OrderTopology X] + +/-- Point rank depends only on the closed set in a neighborhood of the point. -/ +theorem cantorBendixsonRank_congr_on_open (s t : Closeds X) + (hs : (s : Set X).IsPWO) (ht : (t : Set X).IsPWO) + {U : Set X} (hU : IsOpen U) (hst : (s : Set X) ∩ U = (t : Set X) ∩ U) + {x : X} (hx : x ∈ U) : s.cantorBendixsonRank hs x = t.cantorBendixsonRank ht x := by + apply le_antisymm + · apply s.cantorBendixsonRank_le_of_notMem hs x + intro hm + have he := s.cantorBendixson_congr_on_open t hU hst (t.cantorBendixsonRank ht x + 1) + exact t.notMem_cantorBendixson_rank_add_one ht x ((Set.ext_iff.mp he x).mp ⟨hm, hx⟩).1 + · apply t.cantorBendixsonRank_le_of_notMem ht x + intro hm + have he := s.cantorBendixson_congr_on_open t hU hst (s.cantorBendixsonRank hs x + 1) + exact s.notMem_cantorBendixson_rank_add_one hs x ((Set.ext_iff.mp he x).mpr ⟨hm, hx⟩).1 + +omit [T1Space X] in +/-- The isolated points of a closed well-ordered support are dense in that support. -/ +theorem closure_isolated_eq (s : Closeds X) (hs : (s : Set X).IsPWO) : + closure {x | x ∈ s ∧ x ∉ derivedSet (s : Set X)} = (s : Set X) := by + apply Subset.antisymm (closure_minimal (fun _ h ↦ h.1) s.isClosed) + intro x hx + apply mem_closure_iff.mpr + intro U hU hxU + let v : Set X := (s : Set X) ∩ U + have hv : v.IsWF := hs.isWF.mono inter_subset_left + have hn : v.Nonempty := ⟨x, hx, hxU⟩ + let m := hv.min hn + have hm : m ∈ v := hv.min_mem hn + refine ⟨m, hm.2, hm.1, ?_⟩ + rw [mem_derivedSet, accPt_iff_frequently, Filter.not_frequently] + filter_upwards [hs.eventually_le m, hU.mem_nhds hm.2] with y hy hyU hn + exact hn.1 ((hy hn.2).antisymm (hv.min_le ‹v.Nonempty› ⟨hn.2, hyU⟩)) + +/-- The exact rank-`o` points are dense in the `o`-th derivative of a well-ordered support. -/ +theorem closure_rank_level_eq (s : Closeds X) (hs : (s : Set X).IsPWO) (o : Ordinal.{u}) : + closure {x | x ∈ s ∧ s.cantorBendixsonRank hs x = o} = + (s.cantorBendixson o : Set X) := by + have hd := (s.cantorBendixson o).closure_isolated_eq (hs.mono (s.cantorBendixson_le o)) + have he : {x | x ∈ s ∧ s.cantorBendixsonRank hs x = o} = + {x | x ∈ (s.cantorBendixson o : Set X) ∧ + x ∉ derivedSet (s.cantorBendixson o : Set X)} := by + ext x + constructor + · rintro ⟨hx, hr⟩ + have hh := (s.cantorBendixsonRank_eq_iff hs hx o).mp hr + simpa only [cantorBendixson_add_one, coe_derived, mem_setOf_eq] using hh + · intro hh + have hx := s.cantorBendixson_le o hh.1 + refine ⟨hx, (s.cantorBendixsonRank_eq_iff hs hx o).mpr ?_⟩ + simpa only [cantorBendixson_add_one, coe_derived, mem_setOf_eq] using hh + rw [he] + exact hd + +/-- Local inclusion of exact-rank points lifts to all further derivative stages. -/ +theorem cantorBendixson_reconstruction (s t : Closeds X) (hs : (s : Set X).IsPWO) + {U : Set X} (hU : IsOpen U) (a b c : Ordinal.{u}) + (hlevel : ∀ y ∈ U, y ∈ s → s.cantorBendixsonRank hs y = a → + y ∈ (t.cantorBendixson b : Set X)) : + (s.cantorBendixson (a + c) : Set X) ∩ U ⊆ + (t.cantorBendixson (b + c) : Set X) := by + have hlocal : (s.cantorBendixson a : Set X) ∩ U ⊆ (t.cantorBendixson b : Set X) := by + intro x hx + have hl : x ∈ closure {y | y ∈ s ∧ s.cantorBendixsonRank hs y = a} := by + rw [s.closure_rank_level_eq hs a] + exact hx.1 + have hf := (mem_closure_iff_frequently.mp hl).and_eventually (hU.mem_nhds hx.2) + exact (t.cantorBendixson b).isClosed.closure_subset + (mem_closure_iff_frequently.mpr (hf.mono fun y hy ↦ hlevel y hy.2 hy.1.1 hy.1.2)) + simpa only [cantorBendixson_add] using + (s.cantorBendixson a).cantorBendixson_mono_on_open (t.cantorBendixson b) hU hlocal c + +/-- If every local exact-rank point of `s` survives to the same stage of `t`, then absence from +the next two stages of `t` bounds the rank in `s` by one successor. -/ +theorem cantorBendixsonRank_le_add_one_of_rankLevel_mapsTo_stage + (s t : Closeds X) (hs : (s : Set X).IsPWO) {U : Set X} (hU : IsOpen U) + {x : X} (hxU : x ∈ U) (a b : Ordinal.{u}) + (hlevel : ∀ y ∈ U, y ∈ s → s.cantorBendixsonRank hs y = a → + y ∈ (t.cantorBendixson b : Set X)) + (ht : x ∉ (t.cantorBendixson ((b + 1) + 1) : Set X)) : + s.cantorBendixsonRank hs x ≤ a + 1 := by + apply s.cantorBendixsonRank_le_of_notMem hs x + intro hx + have hrec := s.cantorBendixson_reconstruction t hs hU a b (1 + 1) hlevel + apply ht + have hm := hrec ⟨by simpa only [add_assoc] using hx, hxU⟩ + simpa only [add_assoc] using hm + +/-- If every local exact-rank point of `s` survives to the same stage of `t`, then absence from +the next two stages of `t` bounds the rank in `s` by one successor. -/ +theorem cantorBendixsonRank_le_add_one_of_rankLevel_mapsTo + (s t : Closeds X) (hs : (s : Set X).IsPWO) {U : Set X} (hU : IsOpen U) + {x : X} (hxU : x ∈ U) (a : Ordinal.{u}) + (hlevel : ∀ y ∈ U, y ∈ s → s.cantorBendixsonRank hs y = a → + y ∈ (t.cantorBendixson a : Set X)) + (ht : x ∉ (t.cantorBendixson ((a + 1) + 1) : Set X)) : + s.cantorBendixsonRank hs x ≤ a + 1 := by + exact s.cantorBendixsonRank_le_add_one_of_rankLevel_mapsTo_stage + t hs hU hxU a a hlevel ht + +/-- The points of one exact Cantor--Bendixson rank in a closed partially well-ordered set form a +discrete subset. -/ +theorem rankLevel_isDiscrete (s : Closeds X) (hs : (s : Set X).IsPWO) (o : Ordinal.{u}) : + IsDiscrete {x | x ∈ s ∧ s.cantorBendixsonRank hs x = o} := by + rw [isDiscrete_iff_nhdsNE] + intro x hx + have hr := (s.cantorBendixsonRank_eq_iff hs hx.1 o).mp hx.2 + have hn : ¬AccPt x (𝓟 (s.cantorBendixson o : Set X)) := by + simpa only [cantorBendixson_add_one, coe_derived, mem_derivedSet] using hr.2 + rw [AccPt, not_neBot] at hn + apply le_antisymm + · calc + 𝓝[≠] x ⊓ 𝓟 {y | y ∈ s ∧ s.cantorBendixsonRank hs y = o} ≤ + 𝓝[≠] x ⊓ 𝓟 (s.cantorBendixson o : Set X) := + inf_le_inf_left _ (Filter.principal_mono.mpr fun y hy ↦ + (s.mem_cantorBendixson_iff hs y o).mpr ⟨hy.1, hy.2.ge⟩) + _ = ⊥ := hn + · exact bot_le + +omit [T1Space X] in +/-- The subtype of one exact rank level inherits partial well-ordering from the closed support. -/ +theorem rankLevel_univ_isPWO (s : Closeds X) (hs : (s : Set X).IsPWO) + (o : Ordinal.{u}) : + (Set.univ : Set {x // x ∈ s ∧ s.cantorBendixsonRank hs x = o}).IsPWO := by + rw [Set.isPWO_iff_exists_monotone_subseq] + intro f _ + obtain ⟨g, hg⟩ := hs.exists_monotone_subseq fun n ↦ (f n).property.1 + refine ⟨g, fun a b hab ↦ ?_⟩ + exact Subtype.coe_le_coe.mp (hg hab) + +variable [NoMinOrder X] + +omit [LinearOrder X] [OrderTopology X] [NoMinOrder X] [T1Space X] in +/-- **A union of two discrete sets is discrete when neither accumulates at the other.** At a point +of one of them, that set's own witness handles it; the other either contains the point, and +supplies its own witness, or stays away from it, leaving room to shrink into. + +Staying away is the hypothesis, in the form each application actually has: it holds when the sets +are closed, and equally when they are only relatively closed on an open set containing both. -/ +theorem isDiscrete_union {L M : Set X} (hL : IsDiscrete L) (hM : IsDiscrete M) + (hLM : ∀ x ∈ M, x ∉ L → Lᶜ ∈ 𝓝 x) (hML : ∀ x ∈ L, x ∉ M → Mᶜ ∈ 𝓝 x) : + IsDiscrete (L ∪ M) := by + rw [isDiscrete_iff_nhdsNE] at hL hM ⊢ + have haway : ∀ {S : Set X} {y : X}, Sᶜ ∈ 𝓝 y → 𝓝[≠] y ⊓ 𝓟 S = ⊥ := by + intro S y hy + refine le_bot_iff.mp (le_trans (inf_le_inf_right _ nhdsWithin_le_nhds) ?_) + rw [le_bot_iff, Filter.inf_principal_eq_bot] + exact hy + intro x hx + rw [← Filter.sup_principal, inf_sup_left] + rcases hx with hx | hx + · rw [hL x hx, bot_sup_eq] + by_cases hxM : x ∈ M + · exact hM x hxM + · exact haway (hML x hx hxM) + · rw [hM x hx, sup_bot_eq] + by_cases hxL : x ∈ L + · exact hL x hxL + · exact haway (hLM x hx hxL) + +omit [LinearOrder X] [OrderTopology X] [NoMinOrder X] [T1Space X] in +/-- **A finite union of discrete sets is discrete when none accumulates at another's points.** -/ +theorem isDiscrete_biUnion {ι' : Type*} (s : Finset ι') (L : ι' → Set X) + (hL : ∀ i ∈ s, IsDiscrete (L i)) + (haway : ∀ i ∈ s, ∀ j ∈ s, ∀ x ∈ L j, x ∉ L i → (L i)ᶜ ∈ 𝓝 x) : + IsDiscrete (⋃ i ∈ s, L i) := by + classical + induction s using Finset.induction_on with + | empty => + simp only [Finset.notMem_empty, Set.iUnion_of_empty, Set.iUnion_empty] + rw [isDiscrete_iff_nhdsNE] + simp + | insert c s hc ih => + have hLs : ∀ i ∈ s, IsDiscrete (L i) := fun i hi ↦ hL i (Finset.mem_insert_of_mem hi) + have hawayS : ∀ i ∈ s, ∀ j ∈ s, ∀ x ∈ L j, x ∉ L i → (L i)ᶜ ∈ 𝓝 x := + fun i hi j hj ↦ haway i (Finset.mem_insert_of_mem hi) j (Finset.mem_insert_of_mem hj) + have hrest := ih hLs hawayS + rw [Finset.set_biUnion_insert] + refine isDiscrete_union (hL c (Finset.mem_insert_self c s)) hrest ?_ ?_ + · intro x hx hxc + rw [Set.mem_iUnion₂] at hx + obtain ⟨j, hj, hxj⟩ := hx + exact haway c (Finset.mem_insert_self c s) j (Finset.mem_insert_of_mem hj) x hxj hxc + · intro x hx hxrest + have hcompl : (⋃ i ∈ s, L i)ᶜ = ⋂ i ∈ s, (L i)ᶜ := by + simp only [Set.compl_iUnion] + rw [hcompl] + refine (Filter.biInter_finset_mem s).mpr fun i hi ↦ ?_ + refine haway i (Finset.mem_insert_of_mem hi) c (Finset.mem_insert_self c s) x hx ?_ + intro hxi + exact hxrest (Set.mem_iUnion₂.mpr ⟨i, hi, hxi⟩) + +omit [T1Space X] in +/-- **Ordered disjoint left cuts for a discrete set.** Each point of a discrete set in a linear +order has an interval below it meeting the set only at that point, and those intervals may be taken +so that a smaller point never reaches into a larger point's interval. -/ +theorem exists_leftCuts_of_isDiscrete (L : Set X) (hL : IsDiscrete L) : + ∃ z : ↥L → X, (∀ x : ↥L, z x < (x : X)) ∧ + (∀ x : ↥L, Ioc (z x) (x : X) ∩ L = {(x : X)}) ∧ + ∀ x y : ↥L, (x : X) < (y : X) → (x : X) ≤ z y := by + have hcuts : ∀ x : ↥L, ∃ z < (x : X), Ioc z (x : X) ∩ L = {(x : X)} := by + intro x + obtain ⟨U, hUn, hUint⟩ := nhds_inter_eq_singleton_of_mem_discrete hL x.property + obtain ⟨z, hzx, hzU⟩ := exists_Ioc_subset_of_mem_nhds hUn (exists_lt (x : X)) + refine ⟨z, hzx, Set.Subset.antisymm ?_ ?_⟩ + · intro y hy + rw [← hUint] + exact ⟨hzU hy.1, hy.2⟩ + · intro y hy + rw [mem_singleton_iff] at hy + subst y + exact ⟨⟨hzx, le_rfl⟩, x.property⟩ + choose z hzlt hzlevel using hcuts + refine ⟨z, hzlt, hzlevel, fun x y hxy ↦ ?_⟩ + by_contra hle + have hxmem : (x : X) ∈ Ioc (z y) (y : X) ∩ L := ⟨⟨lt_of_not_ge hle, hxy.le⟩, x.property⟩ + rw [hzlevel y, mem_singleton_iff] at hxmem + exact hxy.ne hxmem + +/-- Exact-rank points admit left neighborhoods that are ordered by their centers. This is the +arbitrary-cofinality replacement for choosing successive disjoint intervals along a sequence. -/ +theorem exists_rankLevel_leftCuts (s : Closeds X) (hs : (s : Set X).IsPWO) + (o : Ordinal.{u}) : + ∃ z : {x // x ∈ s ∧ s.cantorBendixsonRank hs x = o} → X, + (∀ x, z x < x) ∧ + (∀ x, Ioc (z x) x ∩ {y | y ∈ s ∧ s.cantorBendixsonRank hs y = o} = + {(x : X)}) ∧ + ∀ x y : {x // x ∈ s ∧ s.cantorBendixsonRank hs x = o}, + (x : X) < y → (x : X) ≤ z y := by + let level : Set X := {x | x ∈ s ∧ s.cantorBendixsonRank hs x = o} + have hdisc : IsDiscrete level := s.rankLevel_isDiscrete hs o + have hcuts : ∀ x : level, ∃ z < (x : X), Ioc z x ∩ level = {(x : X)} := by + intro x + obtain ⟨U, hUn, hUint⟩ := nhds_inter_eq_singleton_of_mem_discrete hdisc x.property + obtain ⟨z, hzx, hzU⟩ := exists_Ioc_subset_of_mem_nhds hUn (exists_lt (x : X)) + refine ⟨z, hzx, Set.Subset.antisymm ?_ ?_⟩ + · intro y hy + rw [← hUint] + exact ⟨hzU hy.1, hy.2⟩ + · intro y hy + rw [mem_singleton_iff] at hy + subst y + exact ⟨⟨hzx, le_rfl⟩, x.property⟩ + choose z hzlt hzlevel using hcuts + refine ⟨z, hzlt, hzlevel, fun x y hxy ↦ ?_⟩ + by_contra hle + have hxmem : (x : X) ∈ Ioc (z y) y ∩ level := + ⟨⟨lt_of_not_ge hle, hxy.le⟩, x.property⟩ + rw [hzlevel y, mem_singleton_iff] at hxmem + exact hxy.ne hxmem + +end TopologicalSpace.Closeds + +/-- Homeomorphisms carrying one closed well-ordered support onto another preserve point ranks. -/ +theorem Homeomorph.cantorBendixsonRank_eq {X Y : Type u} + [LinearOrder X] [LinearOrder Y] [TopologicalSpace X] [TopologicalSpace Y] + [OrderTopology X] [OrderTopology Y] (e : X ≃ₜ Y) + (s : Closeds X) (t : Closeds Y) (hs : (s : Set X).IsPWO) (ht : (t : Set Y).IsPWO) + (he : e '' (s : Set X) = (t : Set Y)) (x : X) : + t.cantorBendixsonRank ht (e x) = s.cantorBendixsonRank hs x := by + apply le_antisymm + · apply t.cantorBendixsonRank_le_of_notMem ht (e x) + intro hx + exact s.notMem_cantorBendixson_rank_add_one hs x + ((e.mem_cantorBendixson_iff s t he x _).mp hx) + · apply s.cantorBendixsonRank_le_of_notMem hs x + intro hx + exact t.notMem_cantorBendixson_rank_add_one ht (e x) + ((e.mem_cantorBendixson_iff s t he x _).mpr hx) + +namespace Topology.IsClosedEmbedding + +variable {X : Type u} {Y : Type v} [TopologicalSpace X] [TopologicalSpace Y] + [T1Space X] [T1Space Y] {f : X → Y} + +/-- A closed embedding carries every Cantor–Bendixson derivative onto the corresponding +derivative of its closed image. -/ +theorem image_cantorBendixson_eq (hf : IsClosedEmbedding f) (s : Closeds X) + (o : Ordinal.{w}) : + f '' (s.cantorBendixson o : Set X) = + ((⟨f '' (s : Set X), hf.isClosedMap _ s.isClosed⟩ : Closeds Y).cantorBendixson o : + Set Y) := by + apply Set.Subset.antisymm + · induction o using Ordinal.limitRecOn with + | zero => simp + | add_one o ih => + simp only [Closeds.cantorBendixson_add_one, Closeds.coe_derived] + exact (hf.continuous.image_derivedSet hf.injective).trans + (derivedSet_mono _ _ ih) + | limit o ho ih => + rw [Closeds.cantorBendixson_limit _ _ ho, + Closeds.cantorBendixson_limit _ _ ho] + rintro _ ⟨x, hx, rfl⟩ + apply Closeds.mem_iInf.mpr + intro i + exact ih i.1 i.2 ⟨x, Closeds.mem_iInf.mp hx i, rfl⟩ + · exact hf.isClosedMap.cantorBendixson_image_subset + (fun y ↦ (Set.finite_singleton y).preimage hf.injective.injOn) s o + +end Topology.IsClosedEmbedding + +namespace Topology.IsOpenEmbedding + +variable {X : Type u} {Y : Type v} [TopologicalSpace X] [TopologicalSpace Y] + [T1Space X] [T1Space Y] {f : X → Y} + +omit [T1Space X] [T1Space Y] in +private theorem image_derivedSet_eq_inter_range (hf : IsOpenEmbedding f) (s : Set X) : + f '' derivedSet s = derivedSet (f '' s) ∩ range f := by + apply Set.Subset.antisymm + · rintro _ ⟨x, hx, rfl⟩ + exact ⟨hf.continuous.image_derivedSet hf.injective ⟨x, hx, rfl⟩, + mem_range_self x⟩ + · rintro y ⟨hy, x, rfl⟩ + refine ⟨x, mem_derivedSet.mpr ?_, rfl⟩ + have hy' : AccPt (f x) (Filter.principal (f '' s)) := mem_derivedSet.mp hy + rw [← hf.accPt_comap_iff] at hy' + simpa only [comap_principal, preimage_image_eq _ hf.injective] using hy' + +/-- Derivatives in an open subspace are the ambient derivatives restricted to that subspace. -/ +theorem image_cantorBendixson_top_eq (hf : IsOpenEmbedding f) (o : Ordinal.{w}) : + f '' (((⊤ : Closeds X).cantorBendixson o : Set X)) = + ((⊤ : Closeds Y).cantorBendixson o : Set Y) ∩ range f := by + induction o using Ordinal.limitRecOn with + | zero => simp + | add_one o ih => + simp only [Closeds.cantorBendixson_add_one, Closeds.coe_derived] + rw [hf.image_derivedSet_eq_inter_range, ih] + exact hf.isOpen_range.derivedSet_inter_eq + | limit o ho ih => + rw [Closeds.cantorBendixson_limit _ _ ho, + Closeds.cantorBendixson_limit _ _ ho] + ext y + constructor + · rintro ⟨x, hx, rfl⟩ + refine ⟨Closeds.mem_iInf.mpr fun i ↦ ?_, mem_range_self x⟩ + exact (Set.ext_iff.mp (ih i.1 i.2) (f x)).mp + ⟨x, Closeds.mem_iInf.mp hx i, rfl⟩ |>.1 + · rintro ⟨hy, x, rfl⟩ + refine ⟨x, Closeds.mem_iInf.mpr fun i ↦ ?_, rfl⟩ + have hi := (Set.ext_iff.mp (ih i.1 i.2) (f x)).mpr + ⟨Closeds.mem_iInf.mp hy i, mem_range_self x⟩ + obtain ⟨z, hz, hzx⟩ := hi + exact hf.injective hzx ▸ hz + +end Topology.IsOpenEmbedding diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order.lean new file mode 100644 index 0000000000..a6e0e00e5c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order.lean @@ -0,0 +1,22 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ArchimedeanBallBase +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonAddition +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonConvexCover +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ClosedPWO +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CoinitialComplete +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedAddGroup +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedIntervalFamily +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAddition +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAdditionFiber +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOSumset +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SeparatedPieceFamily +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SmallClosedSubspace +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ArchimedeanBallBase.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ArchimedeanBallBase.lean new file mode 100644 index 0000000000..6522446785 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ArchimedeanBallBase.lean @@ -0,0 +1,218 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.Order.Archimedean.Class +public import Mathlib.Topology.Algebra.OpenSubgroup +public import Mathlib.SetTheory.Cardinal.Order +public import Mathlib.Order.Cofinal +public import Mathlib.Topology.Order.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# A well-founded base of open Archimedean balls + +In an ordered abelian group whose nonzero Archimedean classes have no smallest magnitude, the +open Archimedean balls form a neighborhood base at zero. Mathlib orders Archimedean classes in +the reverse of magnitude, so the hypothesis is that `FiniteArchimedeanClass G` has no maximum. + +The full class order need not be well-founded. To obtain a well-founded nested base, fix an +arbitrary well-order of the finite classes and retain its record elements: a class belongs to +`CofinalIndex G` when it is larger in the ambient class order than every earlier class in the +well-order. Record elements are cofinal, while their ambient order is a subrelation of the fixed +well-order. Their open balls therefore give the required base without any countability +assumption or separately chosen cofinal chain. +-/ + +open Set + +universe u + +public noncomputable section + +namespace ArchimedeanClass + +variable {G : Type u} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + +/-- The record finite Archimedean classes for an arbitrary fixed well-order. Their inherited +Archimedean-class order is well-founded and their values are cofinal among finite classes. -/ +def CofinalIndex (G : Type u) [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] := + {c : FiniteArchimedeanClass G // ∀ d, WellOrderingRel d c → d < c} + +namespace CofinalIndex + +noncomputable instance : LinearOrder (CofinalIndex G) := inferInstanceAs (LinearOrder + {c : FiniteArchimedeanClass G // ∀ d, WellOrderingRel d c → d < c}) + +/-- The finite Archimedean class represented by an index in the cofinal family. -/ +def archimedeanClass (i : CofinalIndex G) : FiniteArchimedeanClass G := i.1 + +/-- A representative of the Archimedean class indexed by `i`. -/ +def representative (i : CofinalIndex G) : G := + ArchimedeanClass.out (archimedeanClass i).1 + +/-- The representative of a cofinal index is nonzero. -/ +theorem representative_ne_zero (i : CofinalIndex G) : representative i ≠ 0 := by + change ArchimedeanClass.out (archimedeanClass i).1 ≠ 0 + intro h + have hout := ArchimedeanClass.mk_out (archimedeanClass i).1 + rw [h, ArchimedeanClass.mk_eq_top_iff.mpr rfl] at hout + exact (archimedeanClass i).2 hout.symm + +/-- The class of the chosen representative is the indexed Archimedean class. -/ +theorem mk_representative (i : CofinalIndex G) : + ArchimedeanClass.mk (representative i) = (archimedeanClass i).1 := + ArchimedeanClass.mk_out (archimedeanClass i).1 + +/-- The map from the cofinal index set to finite Archimedean classes is strictly monotone. -/ +theorem archimedeanClass_lt_of_lt {i j : CofinalIndex G} (hij : i < j) : + archimedeanClass i < archimedeanClass j := + hij + +/-- The index order is the order induced from finite Archimedean classes. -/ +theorem lt_iff_archimedeanClass_lt {i j : CofinalIndex G} : + i < j ↔ archimedeanClass i < archimedeanClass j := + Iff.rfl + +/-- Increasing cofinal indices give increasing underlying Archimedean classes. -/ +theorem underlyingClass_lt_of_lt {i j : CofinalIndex G} (hij : i < j) : + (archimedeanClass i).1 < (archimedeanClass j).1 := + hij + +private theorem wellOrderingRel_of_lt {a b : CofinalIndex G} (hab : a < b) : + WellOrderingRel a.1 b.1 := by + rcases trichotomous_of WellOrderingRel a.1 b.1 with h | h | h + · exact h + · exact False.elim (hab.ne (Subtype.ext h)) + · exact False.elim ((a.property b.1 h).asymm hab) + +noncomputable instance : WellFoundedLT (CofinalIndex G) := ⟨ + (InvImage.wf (fun c : CofinalIndex G ↦ c.1) WellOrderingRel.isWellOrder.wf).mono + (fun _ _ h ↦ wellOrderingRel_of_lt h)⟩ + +/-- The indexed Archimedean classes are cofinal in the finite class order. -/ +theorem isCofinal_range_archimedeanClass : IsCofinal + (Set.range (archimedeanClass (G := G))) := by + change IsCofinal (Set.range (fun c : + {c : FiniteArchimedeanClass G // ∀ d, WellOrderingRel d c → d < c} => c.1)) + simpa using + (isCofinal_setOf_imp_lt + (WellOrderingRel : FiniteArchimedeanClass G → FiniteArchimedeanClass G → Prop)) + +end CofinalIndex + +/-- Every open Archimedean ball is order-convex. -/ +theorem ballAddSubgroup_ordConnected (c : ArchimedeanClass G) : + ((ballAddSubgroup c : AddSubgroup G) : Set G).OrdConnected := by + by_cases hc : c = ⊤ + · rw [hc, ballAddSubgroup_top] + exact ordConnected_singleton + constructor + intro a ha b hb x hx + apply (mem_ballAddSubgroup_iff hc).mpr + have ha' := (mem_ballAddSubgroup_iff hc).mp ha + have hb' := (mem_ballAddSubgroup_iff hc).mp hb + exact (lt_min ha' hb').trans_le (min_le_mk_of_le_of_le hx.1 hx.2) + +variable [TopologicalSpace G] [OrderTopology G] [IsTopologicalAddGroup G] + +/-- An Archimedean ball is open when there is a strictly smaller nonzero magnitude. -/ +theorem ballAddSubgroup_isOpen_of_exists_gt + {c : ArchimedeanClass G} (hc : ∃ d ≠ ⊤, c < d) : + IsOpen ((ballAddSubgroup c : AddSubgroup G) : Set G) := by + obtain ⟨d, hdtop, hcd⟩ := hc + induction d using ArchimedeanClass.ind with + | mk a => + have ha0 : a ≠ 0 := mk_eq_top_iff.not.mp hdtop + have habs : 0 < |a| := abs_pos.mpr ha0 + apply AddSubgroup.isOpen_of_mem_nhds + apply Filter.mem_of_superset (Ioo_mem_nhds (neg_lt_zero.mpr habs) habs) + intro x hx + apply (mem_ballAddSubgroup_iff hcd.ne_top).mpr + exact hcd.trans_le ((mk_le_mk).mpr ⟨1, by simpa using (abs_lt.mpr hx).le⟩) + +/-- The canonical open Archimedean ball at a record class. -/ +def cofinalBallBase (i : CofinalIndex G) : AddSubgroup G := + ballAddSubgroup (CofinalIndex.archimedeanClass i).1 + +omit [TopologicalSpace G] [OrderTopology G] [IsTopologicalAddGroup G] in +/-- Membership in a canonical Archimedean ball. -/ +theorem mem_cofinalBallBase_iff (i : CofinalIndex G) (x : G) : + x ∈ cofinalBallBase i ↔ + (CofinalIndex.archimedeanClass i).1 < ArchimedeanClass.mk x := + mem_ballAddSubgroup_iff (CofinalIndex.archimedeanClass i).2 + +omit [TopologicalSpace G] [OrderTopology G] [IsTopologicalAddGroup G] in +/-- The canonical Archimedean balls decrease along their index order. -/ +theorem cofinalBallBase_antitone : Antitone (cofinalBallBase (G := G)) := by + intro i j hij + exact ballAddSubgroup_antitone (show i.1.1 ≤ j.1.1 from hij) + +/-- If finite Archimedean classes have no maximum, every canonical ball is open. -/ +theorem cofinalBallBase_isOpen [NoMaxOrder (FiniteArchimedeanClass G)] (i : CofinalIndex G) : + IsOpen ((cofinalBallBase i : AddSubgroup G) : Set G) := by + obtain ⟨d, hid⟩ := exists_gt (CofinalIndex.archimedeanClass i) + exact ballAddSubgroup_isOpen_of_exists_gt ⟨d.1, d.2, hid⟩ + +omit [TopologicalSpace G] [OrderTopology G] [IsTopologicalAddGroup G] in +/-- Every canonical Archimedean ball is order-convex. -/ +theorem cofinalBallBase_ordConnected (i : CofinalIndex G) : + ((cofinalBallBase i : AddSubgroup G) : Set G).OrdConnected := + ballAddSubgroup_ordConnected (CofinalIndex.archimedeanClass i).1 + +omit [TopologicalSpace G] [OrderTopology G] [IsTopologicalAddGroup G] in +/-- The canonical Archimedean balls are coinitial among symmetric neighborhoods of zero. -/ +theorem exists_cofinalBallBase_subset_Ioo (ε : G) (hε : 0 < ε) : + ∃ i : CofinalIndex G, ((cofinalBallBase i : AddSubgroup G) : Set G) ⊆ Ioo (-ε) ε := by + obtain ⟨d, ⟨i, rfl⟩, hi⟩ := + CofinalIndex.isCofinal_range_archimedeanClass (G := G) + ⟨ArchimedeanClass.mk ε, ArchimedeanClass.mk_eq_top_iff.not.mpr hε.ne'⟩ + refine ⟨i, fun x hx ↦ ?_⟩ + have hix : (CofinalIndex.archimedeanClass i).1 < mk x := + (mem_cofinalBallBase_iff i x).mp hx + have hi' : mk ε ≤ (CofinalIndex.archimedeanClass i).1 := hi + have hxabs : |x| < ε := by + simpa [abs_of_pos hε] using (mk_lt_mk.mp (hi'.trans_lt hix) 1) + exact abs_lt.mp hxabs + +/-- Open Archimedean balls admit a well-founded decreasing neighbourhood basis when the nonzero +Archimedean classes have no smallest magnitude. -/ +@[blueprint "lem:well-founded-archimedean-ball-basis" + (phase := "Algebraic independence in graded rings") + (title := "Well-founded Archimedean-ball bases") + (statement := /-- + Let $G$ be an ordered topological abelian group. Suppose that the nonzero + Archimedean classes of $G$ have no least element in the magnitude order. + Then there are a well-founded linear order $I$ and a decreasing family + $(U_i)_{i\in I}$ of open order-convex additive subgroups of $G$ such that + every symmetric open interval about $0$ contains some $U_i$. + -/) + (proof := /-- + Well-order the finite Archimedean classes arbitrarily and retain each + class that is larger in the Archimedean-class order than every earlier + class. These record classes are cofinal, while their inherited order is + a subrelation of the chosen well-order and is therefore well-founded. + Associate to each record class its Archimedean ball. The balls decrease + with the record classes and are order-convex. The absence of a least + nonzero magnitude makes every ball open, and cofinality of the record + classes puts one inside every symmetric interval about $0$. + -/)] +theorem exists_wellFounded_archimedeanBall_basis + [NoMaxOrder (FiniteArchimedeanClass G)] : + ∃ (ι : Type u) (_ : LinearOrder ι) (_ : WellFoundedLT ι) + (U : ι → AddSubgroup G), + Antitone U ∧ + (∀ i, IsOpen ((U i : AddSubgroup G) : Set G)) ∧ + (∀ i, ((U i : AddSubgroup G) : Set G).OrdConnected) ∧ + ∀ ε : G, 0 < ε → ∃ i, ((U i : AddSubgroup G) : Set G) ⊆ Ioo (-ε) ε := by + exact ⟨CofinalIndex G, inferInstance, inferInstance, cofinalBallBase, + cofinalBallBase_antitone, cofinalBallBase_isOpen, cofinalBallBase_ordConnected, + exists_cofinalBallBase_subset_Ioo⟩ + +end ArchimedeanClass + +end diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CantorBendixsonAddition.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CantorBendixsonAddition.lean new file mode 100644 index 0000000000..6d1cb6dd1d --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CantorBendixsonAddition.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonProduct +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonRank + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Cantor–Bendixson bounds for addition of supports + +Addition on two closed well-ordered supports is a closed map with finite fibers in an ordered +uniform group that is Cauchy complete. A point in any derivative of their sum therefore comes +from a pair whose natural sum of point ranks bounds that stage. This applies at arbitrary +ordinals and does not require addition on the supports to be injective. +-/ + +public noncomputable section + +open Set Filter Topology TopologicalSpace +open scoped Pointwise + +universe u + +namespace TopologicalSpace.Closeds + +variable {G : Type u} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + +/-- A point in a derivative of a sum lifts to summands with a sufficient natural sum of ranks. -/ +@[blueprint "lem:cantor-bendixson-derivative-of-sum" + (phase := "Cantor–Bendixson ranks of supports") + (title := "Cantor--Bendixson derivatives of sums of well-ordered sets") + (statement := /-- + Let $S,T$ be closed well-ordered subsets of a nontrivial ordered abelian + group $G$, equipped with a compatible additive uniformity and its order + topology, and assume that $G$ is Cauchy complete. For every ordinal $\alpha$, + \[ + (S+T)^{(\alpha)}\subseteq + \left\{z:\begin{array}{l} + z=x+y\text{ for some }x\in S, y\in T,\\ + \alpha\le + \operatorname{rk}_S(x)\oplus\operatorname{rk}_T(y) + \end{array}\right\}. + \] + -/) + (proof := /-- + On $S\times T$, the natural sum of the two point ranks strictly decreases + in a punctured neighbourhood of each point. Transfinite + Cantor--Bendixson induction therefore bounds the derivative rank on the + product. Addition $S\times T\to S+T$ is closed and has finite fibers; + lifting derivatives through this map gives the stated summands and rank + bound. + -/)] +theorem cantorBendixson_add_subset (s t : Closeds G) + (hs : (s : Set G).IsPWO) (ht : (t : Set G).IsPWO) (o : Ordinal.{u}) : + ((⟨(s : Set G) + (t : Set G), + hs.isClosed_add ht s.isClosed t.isClosed⟩ : Closeds G).cantorBendixson o : Set G) ⊆ + {z | ∃ x ∈ s, ∃ y ∈ t, x + y = z ∧ + o ≤ (NatOrdinal.of (s.cantorBendixsonRank hs x) + + NatOrdinal.of (t.cantorBendixsonRank ht y)).val} := by + let f : (s : Set G) ×ˢ t → G := fun p ↦ p.1.1 + p.1.2 + have hf : IsClosedMap f := hs.isClosedMap_add ht s.isClosed t.isClosed + have himage : f '' (univ : Set ((s : Set G) ×ˢ t)) = (s : Set G) + (t : Set G) := by + ext z + constructor + · rintro ⟨p, _, rfl⟩ + exact add_mem_add p.2.1 p.2.2 + · rintro ⟨x, hx, y, hy, rfl⟩ + exact ⟨⟨(x, y), hx, hy⟩, mem_univ _, rfl⟩ + have he : (⟨f '' (univ : Set ((s : Set G) ×ˢ t)), hf _ isClosed_univ⟩ : Closeds G) = + ⟨(s : Set G) + (t : Set G), hs.isClosed_add ht s.isClosed t.isClosed⟩ := + Closeds.ext himage + let r (p : (s : Set G) ×ˢ t) : NatOrdinal := + NatOrdinal.of (s.cantorBendixsonRank hs p.1.1) + + NatOrdinal.of (t.cantorBendixsonRank ht p.1.2) + have hr (p : (s : Set G) ×ˢ t) (_hp : p ∈ (⊤ : Closeds ((s : Set G) ×ˢ t))) : + ∀ᶠ q in 𝓝 p, q ∈ (⊤ : Closeds ((s : Set G) ×ˢ t)) → q ≠ p → r q < r p := by + have hfst : Continuous (fun q : (s : Set G) ×ˢ t ↦ q.1.1) := by fun_prop + have hsnd : Continuous (fun q : (s : Set G) ×ˢ t ↦ q.1.2) := by fun_prop + filter_upwards + [hfst.continuousAt.tendsto.eventually (s.cantorBendixsonRank_locally_lt hs p.1.1), + hsnd.continuousAt.tendsto.eventually (t.cantorBendixsonRank_locally_lt ht p.1.2)] + with q hq1 hq2 _ hne + change NatOrdinal.of _ + NatOrdinal.of _ < NatOrdinal.of _ + NatOrdinal.of _ + by_cases h1 : q.1.1 = p.1.1 + · have h2 : q.1.2 ≠ p.1.2 := fun h2 ↦ hne (Subtype.ext (Prod.ext h1 h2)) + rw [h1] + apply add_lt_add_right + exact hq2 q.2.2 h2 + · have h2 : NatOrdinal.of (t.cantorBendixsonRank ht q.1.2) ≤ + NatOrdinal.of (t.cantorBendixsonRank ht p.1.2) := by + by_cases he2 : q.1.2 = p.1.2 + · rw [he2] + · exact (hq2 q.2.2 he2).le + exact add_lt_add_of_lt_of_le (hq1 q.2.1 h1) h2 + have hb := (⊤ : Closeds ((s : Set G) ×ˢ t)).cantorBendixson_subset_of_locally_lt + (fun p ↦ (r p).val) (fun p hp ↦ (hr p hp).mono fun q hq hqt hne ↦ hq hqt hne) o + have hlift := hf.cantorBendixson_image_subset (hs.finite_subtype_add_fiber ht) ⊤ o + rw [show (⊤ : Closeds ((s : Set G) ×ˢ t)) = + ⟨univ, isClosed_univ⟩ from rfl] at hlift + change ((⟨f '' univ, hf _ isClosed_univ⟩ : Closeds G).cantorBendixson o : Set G) ⊆ _ + at hlift + rw [he] at hlift + intro z hz + obtain ⟨p, hp, hpz⟩ := hlift hz + exact ⟨p.1.1, p.2.1, p.1.2, p.2.2, hpz, hb hp⟩ + +end TopologicalSpace.Closeds diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CantorBendixsonConvexCover.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CantorBendixsonConvexCover.lean new file mode 100644 index 0000000000..e9c5ab5fbb --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CantorBendixsonConvexCover.lean @@ -0,0 +1,271 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonRank +import Mathlib.Order.WellFounded +import Mathlib.Topology.Order.MonotoneContinuity + +/-! +# A disjoint convex cover controlled by Cantor–Bendixson rank + +Fix a nested well-ordered family of open order-convex additive subgroups forming a neighborhood +base at zero. Every point of a closed partially well-ordered set has cosets in which it is the +largest point of the set and its unique point of maximal Cantor--Bendixson rank; along the nested +base each point has a least such level. The cosets of least level through each point are maximal +in the whole chosen family, so the maximal members cover the set, are pairwise disjoint and order +separated, and carry one center each. The centers accumulate nowhere, including at zero, because +every center owns an open coset meeting no other center. + +The output forgets the subgroups: it consists of open order-convex pairwise disjoint ordered +pieces, each containing its center as the largest point of the set inside it, with every other +point of the set inside of strictly smaller rank. This is the localization used by the +well-founded cofactor construction, at arbitrary cofinality and with no countability hypothesis. +-/ + +open Set Filter Topology TopologicalSpace + +universe u v + +public noncomputable section + +variable {G : Type u} {κ : Type v} + [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [TopologicalSpace G] [OrderTopology G] [NoMinOrder G] [NoMaxOrder G] + [LinearOrder κ] [WellFoundedLT κ] + +omit [AddCommGroup G] [IsOrderedAddMonoid G] [TopologicalSpace G] [OrderTopology G] + [NoMinOrder G] [NoMaxOrder G] [LinearOrder κ] [WellFoundedLT κ] in +/-- Two disjoint order-convex sets crossed by one ordered pair are fully order separated. -/ +theorem Set.OrdConnected.forall_lt_of_disjoint {D E : Set G} + (hD : D.OrdConnected) (hE : E.OrdConnected) (hDE : Disjoint D E) + {d e : G} (hd : d ∈ D) (he : e ∈ E) (hde : d < e) : + ∀ a ∈ D, ∀ b ∈ E, a < b := by + intro a ha b hb + by_contra hba + have hba' : b ≤ a := not_lt.mp hba + rcases lt_or_ge a e with hae | hea + · exact Set.disjoint_left.mp hDE ha (hE.out hb he ⟨hba', hae.le⟩) + · exact Set.disjoint_left.mp hDE (hD.out hd ha ⟨hde.le, hea⟩) he + +namespace TopologicalSpace.Closeds + +/-- A closed partially well-ordered set in a group with a nested well-ordered convex open subgroup +base has a pairwise disjoint ordered open convex cover. Each piece contains its center as the +largest member of the set inside it and as its unique member of maximal Cantor--Bendixson rank; +the centers accumulate nowhere. -/ +theorem exists_disjoint_convex_cover_with_rank_lt_center_within + (s : Closeds G) (hs : (s : Set G).IsPWO) + (W : Set G) (hWopen : IsOpen W) + (U : κ → AddSubgroup G) + (hUmono : ∀ {i j : κ}, i ≤ j → (U j : Set G) ⊆ (U i : Set G)) + (hUopen : ∀ i, IsOpen (U i : Set G)) + (hUconv : ∀ i, (U i : Set G).OrdConnected) + (hUbase : ∀ ε : G, 0 < ε → ∃ i, (U i : Set G) ⊆ Ioo (-ε) ε) : + ∃ (X : Set G) (C : X → Set G), + X ⊆ (s : Set G) ∩ W ∧ + (∀ x : X, (x : G) ∈ C x) ∧ + (∀ x : X, IsOpen (C x)) ∧ + (∀ x : X, (C x).OrdConnected) ∧ + (∀ x : X, C x ⊆ W) ∧ + (∀ x y : X, x ≠ y → Disjoint (C x) (C y)) ∧ + (∀ x y : X, (x : G) < (y : G) → ∀ a ∈ C x, ∀ b ∈ C y, a < b) ∧ + ((s : Set G) ∩ W ⊆ ⋃ x : X, C x) ∧ + (∀ x : X, ∀ z ∈ (s : Set G) ∩ C x, z ≤ (x : G)) ∧ + (∀ x : X, ∀ z ∈ (s : Set G) ∩ C x, z ≠ (x : G) → + s.cantorBendixsonRank hs z < s.cantorBendixsonRank hs (x : G)) ∧ + (∀ z ∈ W, ¬ AccPt z (𝓟 X)) := by + classical + let T := {z : G // z ∈ (s : Set G) ∩ W} + let coset : G → κ → Set G := fun z i ↦ (fun g ↦ z + g) '' (U i : Set G) + have hcoset_mem : ∀ (z : G) (i : κ), z ∈ coset z i := fun z i ↦ + ⟨0, (U i).zero_mem, add_zero z⟩ + have hcoset_open : ∀ (z : G) (i : κ), IsOpen (coset z i) := by + intro z i + have hset : coset z i = (fun y ↦ y + -z) ⁻¹' (U i : Set G) := by + ext y + constructor + · rintro ⟨u, hu, rfl⟩ + have he : (fun g ↦ z + g) u + -z = u := by + change z + u + -z = u + abel + simpa only [Set.mem_preimage, he] using hu + · intro hy + exact ⟨y + -z, hy, by change z + (y + -z) = y; abel⟩ + rw [hset] + exact (OrderIso.continuous (OrderIso.addRight (-z))).isOpen_preimage _ (hUopen i) + have hcoset_conv : ∀ (z : G) (i : κ), (coset z i).OrdConnected := by + intro z i + constructor + rintro a ⟨u, hu, rfl⟩ b ⟨v, hv, rfl⟩ w ⟨hwl, hwr⟩ + have hwl' : z + u ≤ w := hwl + have hwr' : w ≤ z + v := hwr + refine ⟨w - z, (hUconv i).out hu hv ⟨?_, ?_⟩, by change z + (w - z) = w; abel⟩ + · rwa [le_sub_iff_add_le, add_comm] + · rwa [sub_le_iff_le_add, add_comm] + -- Step 1: every point of the set has a valid level. + have hlevel : ∀ z : T, ∃ i : κ, coset (z : G) i ⊆ W ∧ + (∀ w ∈ (s : Set G), w ∈ coset (z : G) i → w ≤ (z : G)) ∧ + (∀ w ∈ (s : Set G), w ∈ coset (z : G) i → w ≠ (z : G) → + s.cantorBendixsonRank hs w < s.cantorBendixsonRank hs (z : G)) := by + rintro ⟨z, hz⟩ + have hnearW := (hs.eventually_le z).and (s.cantorBendixsonRank_locally_lt hs z) + have hnear : {y : G | (y ∈ (s : Set G) → y ≤ z) ∧ + (y ∈ s → y ≠ z → s.cantorBendixsonRank hs y < s.cantorBendixsonRank hs z)} ∩ W ∈ + 𝓝 z := Filter.inter_mem hnearW (hWopen.mem_nhds hz.2) + obtain ⟨a, b, ⟨haz, hzb⟩, hab⟩ := mem_nhds_iff_exists_Ioo_subset.mp hnear + obtain ⟨i, hi⟩ := hUbase (min (z - a) (b - z)) + (lt_min (sub_pos.mpr haz) (sub_pos.mpr hzb)) + have hmem : ∀ w ∈ coset z i, w ∈ Ioo a b := by + rintro w ⟨u, hu, rfl⟩ + have hu' := hi hu + constructor + · have h1 : -(z - a) < u := (neg_le_neg (min_le_left _ _)).trans_lt hu'.1 + have h2 := add_lt_add_left h1 z + have e1 : -(z - a) + z = a := by abel + rw [e1, add_comm u z] at h2 + exact h2 + · have h1 : u < b - z := hu'.2.trans_le (min_le_right _ _) + have h2 := add_lt_add_left h1 z + have e1 : b - z + z = b := by abel + rw [e1, add_comm u z] at h2 + exact h2 + exact ⟨i, fun w hwm ↦ (hab (hmem w hwm)).2, + fun w hw hwm ↦ (hab (hmem w hwm)).1.1 hw, + fun w hw hwm ↦ (hab (hmem w hwm)).1.2 hw⟩ + -- Step 2: the least valid level and its coset. + let good : T → Set κ := fun z ↦ {i : κ | coset (z : G) i ⊆ W ∧ + (∀ w ∈ (s : Set G), w ∈ coset (z : G) i → w ≤ (z : G)) ∧ + (∀ w ∈ (s : Set G), w ∈ coset (z : G) i → w ≠ (z : G) → + s.cantorBendixsonRank hs w < s.cantorBendixsonRank hs (z : G))} + have hne : ∀ z : T, (good z).Nonempty := fun z ↦ hlevel z + let idx : T → κ := fun z ↦ wellFounded_lt.min (good z) (hne z) + have hidx : ∀ z : T, idx z ∈ good z := fun z ↦ wellFounded_lt.min_mem (good z) (hne z) + let B : T → Set G := fun z ↦ coset (z : G) (idx z) + have hBmem : ∀ z : T, (z : G) ∈ B z := fun z ↦ hcoset_mem (z : G) (idx z) + -- Cosets of comparable levels through a common point are nested. + have hnest : ∀ z w : T, idx w ≤ idx z → ∀ y, y ∈ B z → y ∈ B w → B z ⊆ B w := by + rintro z w hij y ⟨u, hu, hyu⟩ ⟨v, hv, hyv⟩ p ⟨q, hq, hpq⟩ + have hyu' : (z : G) + u = y := hyu + have hyv' : (w : G) + v = y := hyv + have hpq' : (z : G) + q = p := hpq + refine ⟨v - u + q, (U (idx w)).add_mem ((U (idx w)).sub_mem hv (hUmono hij hu)) + (hUmono hij hq), ?_⟩ + change (w : G) + (v - u + q) = p + have hzw : (z : G) = (w : G) + v - u := by + rw [eq_sub_iff_add_eq, hyu', hyv'] + rw [← hpq', hzw] + abel + -- Equal cosets share their largest set point. + have hcenter_eq : ∀ z w : T, B z = B w → (z : G) = (w : G) := by + intro z w he + have h1 : (z : G) ∈ B w := by rw [← he]; exact hBmem z + have h2 : (w : G) ∈ B z := by rw [he]; exact hBmem w + exact le_antisymm ((hidx w).2.1 z z.2.1 h1) ((hidx z).2.1 w w.2.1 h2) + -- Step 3: the maximal cosets. + let X : Set G := {p : G | ∃ hp : p ∈ (s : Set G) ∩ W, + ∀ v : T, B ⟨p, hp⟩ ⊆ B v → B v = B ⟨p, hp⟩} + have hXs : X ⊆ (s : Set G) ∩ W := fun p hp ↦ hp.choose + let C : X → Set G := fun x ↦ B ⟨(x : G), hXs x.2⟩ + have hCmax : ∀ x : X, ∀ v : T, C x ⊆ B v → B v = C x := fun x ↦ x.2.choose_spec + have hCmem : ∀ x : X, (x : G) ∈ C x := fun x ↦ hBmem _ + -- Disjointness of distinct maximal cosets. + have hdisj : ∀ x y : X, x ≠ y → Disjoint (C x) (C y) := by + intro x y hxy + rw [Set.disjoint_left] + intro q hqx hqy + have hxyG : (x : G) ≠ (y : G) := fun h ↦ hxy (Subtype.ext h) + rcases le_total (idx ⟨(x : G), hXs x.2⟩) (idx ⟨(y : G), hXs y.2⟩) with h | h + · have hsub := hnest ⟨(y : G), hXs y.2⟩ ⟨(x : G), hXs x.2⟩ h q hqy hqx + have heq := hCmax y ⟨(x : G), hXs x.2⟩ hsub + exact hxyG (hcenter_eq ⟨(x : G), hXs x.2⟩ ⟨(y : G), hXs y.2⟩ heq) + · have hsub := hnest ⟨(x : G), hXs x.2⟩ ⟨(y : G), hXs y.2⟩ h q hqx hqy + have heq := hCmax x ⟨(y : G), hXs y.2⟩ hsub + exact hxyG (hcenter_eq ⟨(y : G), hXs y.2⟩ ⟨(x : G), hXs x.2⟩ heq).symm + -- Coverage: the least-level coset through a point is maximal. + have hcov : (s : Set G) ∩ W ⊆ ⋃ x : X, C x := by + intro p hp + let covIdx : Set κ := {j : κ | ∃ w : T, idx w = j ∧ p ∈ B w} + have hcovne : covIdx.Nonempty := ⟨idx ⟨p, hp⟩, ⟨p, hp⟩, rfl, hBmem ⟨p, hp⟩⟩ + obtain ⟨w, hwidx, hpw⟩ := wellFounded_lt.min_mem covIdx hcovne + have hwmax : ∀ v : T, B w ⊆ B v → B v = B w := by + intro v hsub + have hpv : p ∈ B v := hsub hpw + have hmv : idx w ≤ idx v := by + rw [hwidx] + exact wellFounded_lt.min_le (s := covIdx) (x := idx v) ⟨v, rfl, hpv⟩ + exact le_antisymm (hnest v w hmv p hpv hpw) hsub + have hwX : (w : G) ∈ X := ⟨w.2, hwmax⟩ + exact Set.mem_iUnion.mpr ⟨⟨(w : G), hwX⟩, hpw⟩ + -- Order separation from disjointness and convexity. + have hconv : ∀ x : X, (C x).OrdConnected := fun x ↦ hcoset_conv _ _ + have hord : ∀ x y : X, (x : G) < (y : G) → ∀ a ∈ C x, ∀ b ∈ C y, a < b := by + intro x y hxy + exact Set.OrdConnected.forall_lt_of_disjoint (hconv x) (hconv y) + (hdisj x y fun h ↦ absurd (congrArg Subtype.val h) hxy.ne) + (hCmem x) (hCmem y) hxy + -- The centers accumulate nowhere. + have hdiscrete : ∀ z ∈ W, ¬ AccPt z (𝓟 X) := by + intro z hzW hacc + rw [accPt_iff_nhds] at hacc + by_cases hzs : z ∈ (s : Set G) ∩ W + · obtain ⟨x₀, hx₀⟩ := Set.mem_iUnion.mp (hcov hzs) + have hXC : ∀ y ∈ X, y ∈ C x₀ → y = (x₀ : G) := by + intro y hy hyC + by_contra hne + exact Set.disjoint_left.mp + (hdisj ⟨y, hy⟩ x₀ fun h ↦ hne (congrArg Subtype.val h)) + (hCmem ⟨y, hy⟩) hyC + rcases eq_or_ne (x₀ : G) z with hx0z | hx0z + · obtain ⟨y, ⟨hyC, hyX⟩, hyz⟩ := hacc (C x₀) ((hcoset_open _ _).mem_nhds hx₀) + exact hyz (by rw [hXC y hyX hyC, hx0z]) + · rcases lt_or_gt_of_ne hx0z with hlt | hgt + · obtain ⟨b, hzb⟩ := exists_gt z + obtain ⟨y, ⟨⟨hyC, hy1, _⟩, hyX⟩, hyz⟩ := hacc (C x₀ ∩ Ioo (x₀ : G) b) + ((((hcoset_open _ _).inter isOpen_Ioo)).mem_nhds ⟨hx₀, hlt, hzb⟩) + exact absurd (hXC y hyX hyC) (ne_of_gt hy1) + · obtain ⟨a, haz⟩ := exists_lt z + obtain ⟨y, ⟨⟨hyC, _, hy2⟩, hyX⟩, hyz⟩ := hacc (C x₀ ∩ Ioo a (x₀ : G)) + ((((hcoset_open _ _).inter isOpen_Ioo)).mem_nhds ⟨hx₀, haz, hgt⟩) + exact absurd (hXC y hyX hyC) (ne_of_lt hy2) + · have hzsc : z ∉ (s : Set G) := fun h ↦ hzs ⟨h, hzW⟩ + obtain ⟨y, ⟨hyc, hyX⟩, -⟩ := hacc ((s : Set G)ᶜ) + (s.isClosed.isOpen_compl.mem_nhds hzsc) + exact hyc (hXs hyX).1 + exact ⟨X, C, hXs, hCmem, fun x ↦ hcoset_open _ _, hconv, + fun x ↦ (hidx ⟨(x : G), hXs x.2⟩).1, hdisj, hord, hcov, + fun x z hz ↦ (hidx ⟨(x : G), hXs x.2⟩).2.1 z hz.1 hz.2, + fun x z hz hne ↦ (hidx ⟨(x : G), hXs x.2⟩).2.2 z hz.1 hz.2 hne, hdiscrete⟩ + +/-- The disjoint convex cover of the whole closed set, obtained by taking the open region to be +`univ`. -/ +theorem exists_disjoint_convex_cover_with_rank_lt_center (s : Closeds G) (hs : (s : Set G).IsPWO) + (U : κ → AddSubgroup G) + (hUmono : ∀ {i j : κ}, i ≤ j → (U j : Set G) ⊆ (U i : Set G)) + (hUopen : ∀ i, IsOpen (U i : Set G)) + (hUconv : ∀ i, (U i : Set G).OrdConnected) + (hUbase : ∀ ε : G, 0 < ε → ∃ i, (U i : Set G) ⊆ Ioo (-ε) ε) : + ∃ (X : Set G) (C : X → Set G), + X ⊆ (s : Set G) ∧ + (∀ x : X, (x : G) ∈ C x) ∧ + (∀ x : X, IsOpen (C x)) ∧ + (∀ x : X, (C x).OrdConnected) ∧ + (∀ x y : X, x ≠ y → Disjoint (C x) (C y)) ∧ + (∀ x y : X, (x : G) < (y : G) → ∀ a ∈ C x, ∀ b ∈ C y, a < b) ∧ + ((s : Set G) ⊆ ⋃ x : X, C x) ∧ + (∀ x : X, ∀ z ∈ (s : Set G) ∩ C x, z ≤ (x : G)) ∧ + (∀ x : X, ∀ z ∈ (s : Set G) ∩ C x, z ≠ (x : G) → + s.cantorBendixsonRank hs z < s.cantorBendixsonRank hs (x : G)) ∧ + (∀ z : G, ¬ AccPt z (𝓟 X)) := by + obtain ⟨X, C, hXs, hCmem, hCopen, hCconv, -, hCdisj, hCord, hCcov, hCmax, hCrank, hXdisc⟩ := + exists_disjoint_convex_cover_with_rank_lt_center_within s hs Set.univ isOpen_univ U + hUmono hUopen hUconv hUbase + refine ⟨X, C, fun p hp ↦ (hXs hp).1, hCmem, hCopen, hCconv, hCdisj, hCord, ?_, hCmax, hCrank, + fun z ↦ hXdisc z (Set.mem_univ z)⟩ + intro p hp + exact hCcov ⟨hp, Set.mem_univ p⟩ + +end TopologicalSpace.Closeds diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ClosedPWO.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ClosedPWO.lean new file mode 100644 index 0000000000..a3a47622c7 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ClosedPWO.lean @@ -0,0 +1,466 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorBendixson +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonReconstruction +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAddition +public import Mathlib.Topology.Instances.Real.Lemmas + +import Mathlib.SetTheory.Ordinal.FixedPoint +import Mathlib.Topology.Order.Monotone +import Mathlib.Topology.Order.MonotoneContinuity +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Closed real well-orders + +A closed well-ordered subset of the reals is canonically homeomorphic to its ordinal index +space. Closing a well-order below a strict supremum inserts at most one limit point before each +original point; in particular it preserves a nonzero additively principal order type. +-/ + +open Filter Order Set Topology +open Ordinal + +public noncomputable section + +namespace Set.IsPWO + +variable {s : Set ℝ} (hs : s.IsPWO) + +private def enumReal (s : Set ℝ) [WellFoundedLT s] : + Iio (Ordinal.type (· < · : s → s → Prop)) → ℝ := + fun i ↦ (Ordinal.enum (· < · : s → s → Prop) i).1 + +private theorem enumReal_strictMono (s : Set ℝ) [WellFoundedLT s] : StrictMono (enumReal s) := by + intro i j hij + exact (Ordinal.enum_lt_enum (r := (· < · : s → s → Prop))).mpr hij + +private theorem exists_enumReal_ge_of_isSuccLimit [WellFoundedLT s] (hc : IsClosed s) + {i : Iio (Ordinal.type (· < · : s → s → Prop))} (hi : IsSuccLimit i.1) + {b : ℝ} (hb : b < enumReal s i) : + ∃ j < i, b ≤ enumReal s j := by + let A : Set ℝ := enumReal s '' Iio i + have hAne : A.Nonempty := by + let j : Iio (Ordinal.type (· < · : s → s → Prop)) := + ⟨0, hi.bot_lt.trans i.2⟩ + exact ⟨enumReal s j, ⟨j, hi.bot_lt, rfl⟩⟩ + have hAbdd : BddAbove A := by + refine ⟨enumReal s i, ?_⟩ + rintro _ ⟨j, hji, rfl⟩ + exact (enumReal_strictMono s hji).le + have hAs : A ⊆ s := by + rintro _ ⟨j, _, rfl⟩ + exact (Ordinal.enum (· < · : s → s → Prop) j).2 + have hsupmem : sSup A ∈ s := hc.closure_subset + (closure_mono hAs (csSup_mem_closure hAne hAbdd)) + have hsup_le : sSup A ≤ enumReal s i := csSup_le hAne fun _ hx ↦ by + obtain ⟨j, hji, rfl⟩ := hx + exact (enumReal_strictMono s hji).le + have hsup_eq : sSup A = enumReal s i := by + apply le_antisymm hsup_le + by_contra hnot + have hlt : sSup A < enumReal s i := lt_of_not_ge hnot + let k : Iio (Ordinal.type (· < · : s → s → Prop)) := + ⟨Ordinal.typein (· < · : s → s → Prop) ⟨sSup A, hsupmem⟩, + Ordinal.typein_lt_type _ _⟩ + have hki : k < i := by + apply (Ordinal.enum_lt_enum (r := (· < · : s → s → Prop))).mp + have hk : Ordinal.enum (· < · : s → s → Prop) k = ⟨sSup A, hsupmem⟩ := by + simp [k] + rw [hk] + exact hlt + have hsucc : k.1 + 1 < i.1 := hi.succ_lt hki + let j : Iio (Ordinal.type (· < · : s → s → Prop)) := + ⟨k.1 + 1, hsucc.trans i.2⟩ + have hjA : enumReal s j ∈ A := ⟨j, hsucc, rfl⟩ + have hkj : k < j := Order.lt_succ k.1 + have hsup_lt : sSup A < enumReal s j := by + have := enumReal_strictMono s hkj + simpa [k, enumReal] using this + exact (not_lt_of_ge (le_csSup hAbdd hjA)) hsup_lt + by_contra! hnone + have hub : b ∈ upperBounds A := by + rintro _ ⟨j, hji, rfl⟩ + exact (hnone j hji).le + have hle : enumReal s i ≤ b := by + rw [← hsup_eq] + exact (isLUB_csSup hAne hAbdd).2 hub + exact (not_lt_of_ge hle) hb + +private theorem nhdsWithin_Ici_eq_pure + {T : Ordinal} (i : Iio T) : 𝓝[Set.Ici i] i = pure i := by + apply le_antisymm + · rw [le_pure_iff] + have hopen : IsOpen {j : Iio T | j.1 < i.1 + 1} := + isOpen_Iio.preimage continuous_subtype_val + have hmem : {j : Iio T | j.1 < i.1 + 1} ∈ 𝓝 i := + hopen.mem_nhds (Order.lt_succ i.1) + rw [mem_nhdsWithin_iff_exists_mem_nhds_inter] + refine ⟨_, hmem, ?_⟩ + intro j hj + apply mem_singleton_iff.mpr + apply Subtype.ext + exact le_antisymm (Order.lt_succ_iff.mp hj.1) hj.2 + · exact pure_le_nhdsWithin (mem_Ici.mpr le_rfl) + +private theorem continuousAt_enumReal_of_not_isSuccLimit [WellFoundedLT s] + {i : Iio (Ordinal.type (· < · : s → s → Prop))} (hi : ¬IsSuccLimit i.1) : + ContinuousAt (enumReal s) i := by + have hopenOrdinal : IsOpen ({i.1} : Set Ordinal) := + SuccOrder.isOpen_singleton_iff.mpr hi + have hopen : IsOpen ({i} : Set (Iio (Ordinal.type (· < · : s → s → Prop)))) := by + rw [show ({i} : Set (Iio (Ordinal.type (· < · : s → s → Prop)))) = + (fun j : Iio (Ordinal.type (· < · : s → s → Prop)) ↦ j.1) ⁻¹' {i.1} by + ext j + exact Subtype.ext_iff] + exact hopenOrdinal.preimage continuous_subtype_val + change Tendsto (enumReal s) (𝓝 i) (𝓝 (enumReal s i)) + rw [(isOpen_singleton_iff_nhds_eq_pure i).mp hopen] + exact pure_le_nhds _ + +private theorem continuous_enumReal [WellFoundedLT s] (hc : IsClosed s) : + Continuous (enumReal s) := by + rw [continuous_iff_continuousAt] + intro i + by_cases hi : IsSuccLimit i.1 + · apply continuousAt_iff_continuous_left_right.mpr + constructor + · apply StrictMonoOn.continuousWithinAt_left_of_exists_between + (s := Set.univ) ((enumReal_strictMono s).strictMonoOn Set.univ) univ_mem + intro b hb + obtain ⟨j, hji, hbj⟩ := exists_enumReal_ge_of_isSuccLimit hc hi hb + exact ⟨j, mem_univ _, hbj, enumReal_strictMono s hji⟩ + · change Tendsto (enumReal s) (𝓝[Set.Ici i] i) (𝓝 (enumReal s i)) + rw [nhdsWithin_Ici_eq_pure] + exact pure_le_nhds _ + · exact continuousAt_enumReal_of_not_isSuccLimit hi + +private def enumRealOrderIso (s : Set ℝ) [WellFoundedLT s] : + Iio (Ordinal.type (· < · : s → s → Prop)) ≃o s := + OrderIso.ofRelIsoLT (Ordinal.enum (· < · : s → s → Prop)) + +private theorem continuous_typeinReal [WellFoundedLT s] : + Continuous (enumRealOrderIso s).symm := by + let t : TopologicalSpace (Iio (Ordinal.type (· < · : s → s → Prop))) := inferInstance + have ht : t = Preorder.topology (Iio (Ordinal.type (· < · : s → s → Prop))) := + OrderTopology.topology_eq_generate_intervals + change @Continuous s (Iio (Ordinal.type (· < · : s → s → Prop))) _ t + (enumRealOrderIso s).symm + rw [ht, continuous_generateFrom_iff] + rintro u ⟨a, rfl | rfl⟩ + · rw [show (enumRealOrderIso s).symm ⁻¹' Ioi a = + Subtype.val ⁻¹' Ioi ((enumRealOrderIso s) a).1 by + ext x + change a < (enumRealOrderIso s).symm x ↔ (enumRealOrderIso s) a < x + constructor + · intro h + have h' := (enumRealOrderIso s).strictMono h + rw [(enumRealOrderIso s).apply_symm_apply] at h' + exact h' + · intro h + have h' := (enumRealOrderIso s).symm.strictMono h + rw [(enumRealOrderIso s).symm_apply_apply] at h' + exact h'] + exact isOpen_Ioi.preimage continuous_subtype_val + · rw [show (enumRealOrderIso s).symm ⁻¹' Iio a = + Subtype.val ⁻¹' Iio ((enumRealOrderIso s) a).1 by + ext x + change (enumRealOrderIso s).symm x < a ↔ x < (enumRealOrderIso s) a + constructor + · intro h + have h' := (enumRealOrderIso s).strictMono h + rw [(enumRealOrderIso s).apply_symm_apply] at h' + exact h' + · intro h + have h' := (enumRealOrderIso s).symm.strictMono h + rw [(enumRealOrderIso s).symm_apply_apply] at h' + exact h'] + exact isOpen_Iio.preimage continuous_subtype_val + +/-- The canonical enumeration of a closed real well-order is a homeomorphism from its ordinal +index space. -/ +def homeomorphIioType [WellFoundedLT s] (hc : IsClosed s) : + Iio (Ordinal.type (· < · : s → s → Prop)) ≃ₜ s := + Homeomorph.mk (enumRealOrderIso s).toEquiv + (Continuous.subtype_mk (continuous_enumReal hc) _) + continuous_typeinReal + +end Set.IsPWO +universe u + +namespace Set + +variable {s : Set ℝ} + +private theorem exists_mem_Ioc_of_mem_closure' (hs : s.IsPWO) {x y : ℝ} + (hx : x ∈ closure s) (hy : y < x) : + ∃ b ∈ s, y < b ∧ b ≤ x := by + by_contra! hn + have habove : ∀ b ∈ s, y < b → x < b := fun b hb hyb ↦ hn b hb hyb + let v := s ∩ Ioi x + have hv : v.IsWF := hs.isWF.mono inter_subset_left + have hne : v.Nonempty := by + obtain ⟨b, hby, hbs⟩ := mem_closure_iff_nhds.mp hx (Ioi y) (Ioi_mem_nhds hy) + exact ⟨b, hbs, habove b hbs hby⟩ + let m := hv.min hne + have hm : m ∈ v := hv.min_mem hne + obtain ⟨b, hb, hbs⟩ := mem_closure_iff_nhds.mp hx (Ioo y m) (Ioo_mem_nhds hy hm.2) + exact (not_lt_of_ge (hv.min_le hne ⟨hbs, habove b hbs hb.1⟩)) hb.2 + +variable {z : ℝ} + +private def strictClosure : Set ℝ := closure s ∩ Iio z + +private theorem exists_support_above (hz : IsLUB s z) + (x : strictClosure (s := s) (z := z)) : + ∃ y ∈ s, x.1 < y := by + obtain ⟨y, hy, hxy, -⟩ := hz.exists_between x.2.2 + exact ⟨y, hy, hxy⟩ + +private def upperSupport (x : strictClosure (s := s) (z := z)) : Set ℝ := s ∩ Ici x.1 + +private theorem upperSupport_nonempty (hz : IsLUB s z) + (x : strictClosure (s := s) (z := z)) : + (upperSupport (s := s) (z := z) x).Nonempty := by + obtain ⟨y, hy, hxy⟩ := exists_support_above hz x + exact ⟨y, hy, hxy.le⟩ + +private noncomputable def ceiling (hs : s.IsPWO) (hz : IsLUB s z) + (x : strictClosure (s := s) (z := z)) : ℝ := + (hs.isWF.mono (s := upperSupport (s := s) (z := z) x) inter_subset_left).min + (upperSupport_nonempty hz x) + +private theorem ceiling_mem (hs : s.IsPWO) (hz : IsLUB s z) + (x : strictClosure (s := s) (z := z)) : + ceiling hs hz x ∈ s ∩ Ici x.1 := + (hs.isWF.mono (s := upperSupport (s := s) (z := z) x) inter_subset_left).min_mem + (upperSupport_nonempty hz x) + +private theorem ceiling_le_of_mem (hs : s.IsPWO) (hz : IsLUB s z) + (x : strictClosure (s := s) (z := z)) {y : ℝ} + (hy : y ∈ s) (hxy : x.1 ≤ y) : + ceiling hs hz x ≤ y := + (hs.isWF.mono (s := upperSupport (s := s) (z := z) x) inter_subset_left).min_le + (upperSupport_nonempty hz x) ⟨hy, hxy⟩ + +private theorem ceiling_eq_self_of_mem (hs : s.IsPWO) (hz : IsLUB s z) + (x : strictClosure (s := s) (z := z)) + (hx : x.1 ∈ s) : + ceiling hs hz x = x.1 := + le_antisymm (ceiling_le_of_mem hs hz x hx le_rfl) (ceiling_mem hs hz x).2 + +private noncomputable def closureEmbedding (hs : s.IsPWO) (hz : IsLUB s z) : + strictClosure (s := s) (z := z) → s ×ₗ Fin 2 := by + classical + exact fun x ↦ + ⟨⟨ceiling hs hz x, (ceiling_mem hs hz x).1⟩, + if x.1 ∈ s then (1 : Fin 2) else 0⟩ + +private theorem closureEmbedding_strictMono (hs : s.IsPWO) (hz : IsLUB s z) : + StrictMono (closureEmbedding hs hz) := by + intro x y hxy + have hceil : ceiling hs hz x ≤ ceiling hs hz y := + ceiling_le_of_mem hs hz x (ceiling_mem hs hz y).1 + ((show x.1 ≤ y.1 from hxy.le).trans (ceiling_mem hs hz y).2) + by_cases hlt : ceiling hs hz x < ceiling hs hz y + · rw [Prod.Lex.lt_iff] + exact Or.inl hlt + · have heq : ceiling hs hz x = ceiling hs hz y := le_antisymm hceil (not_lt.mp hlt) + have hxnot : x.1 ∉ s := by + intro hxs + have hxceil := ceiling_eq_self_of_mem hs hz x hxs + have hy_le : y.1 ≤ ceiling hs hz y := (ceiling_mem hs hz y).2 + have hyx : y.1 ≤ x.1 := by + rw [← hxceil, heq] + exact hy_le + exact (not_le_of_gt hxy) hyx + have hys : y.1 ∈ s := by + by_contra hynot + obtain ⟨b, hbs, hxb, hby⟩ := + exists_mem_Ioc_of_mem_closure' hs y.2.1 hxy + have hb_lt : b < y.1 := lt_of_le_of_ne hby fun h ↦ hynot (h ▸ hbs) + have hceilb : ceiling hs hz x ≤ b := ceiling_le_of_mem hs hz x hbs hxb.le + have hyceil : y.1 ≤ ceiling hs hz y := (ceiling_mem hs hz y).2 + have : ceiling hs hz y < ceiling hs hz y := + heq.symm.le.trans_lt (hceilb.trans_lt (hb_lt.trans_le hyceil)) + exact (lt_irrefl _ this) + rw [Prod.Lex.lt_iff] + refine Or.inr ⟨Subtype.ext heq, ?_⟩ + simp only [closureEmbedding, hxnot, hys, ↓reduceIte] + change (0 : Fin 2) < 1 + simp + +private theorem strictClosure_orderType_le_two_mul (hs : s.IsPWO) (hz : IsLUB s z) : + ((hs.closure.mono (s := strictClosure (s := s) (z := z)) + inter_subset_left).orderType) ≤ + 2 * hs.orderType := by + let ht := hs.closure.mono (s := strictClosure (s := s) (z := z)) inter_subset_left + letI : WellFoundedLT (strictClosure (s := s) (z := z)) := ⟨ht.isWF⟩ + letI : WellFoundedLT s := ⟨hs.isWF⟩ + let e : strictClosure (s := s) (z := z) ↪o s ×ₗ Fin 2 := + OrderEmbedding.ofStrictMono (closureEmbedding hs hz) + (closureEmbedding_strictMono hs hz) + calc + ht.orderType = typeLT (strictClosure (s := s) (z := z)) := + ht.orderType_eq_typeLT_of_orderIso (OrderIso.refl _) + _ ≤ typeLT (s ×ₗ Fin 2) := e.ltEmbedding.ordinal_type_le + _ = 2 * hs.orderType := by + change Ordinal.type (Prod.Lex (fun a b : s ↦ a < b) + (fun a b : Fin 2 ↦ a < b)) = _ + rw [Ordinal.type_prod_lex, Ordinal.type_fin] + exact congrArg (2 * ·) (hs.orderType_eq_typeLT_of_orderIso (OrderIso.refl s)).symm + +private theorem strictClosure_orderType_eq_of_two_mul (hs : s.IsPWO) (hz : IsLUB s z) + (hzn : z ∉ s) (habsorb : 2 * hs.orderType = hs.orderType) : + (hs.closure.mono (s := strictClosure (s := s) (z := z)) + inter_subset_left).orderType = hs.orderType := by + let ht := hs.closure.mono (s := strictClosure (s := s) (z := z)) inter_subset_left + apply le_antisymm + · simpa only [habsorb] using strictClosure_orderType_le_two_mul hs hz + · apply hs.orderType_mono ht + intro x hx + refine ⟨subset_closure hx, ?_⟩ + exact lt_of_le_of_ne (hz.1 hx) fun h ↦ hzn (h ▸ hx) + +private theorem strictClosure_orderType_eq_opow (hs : s.IsPWO) (hz : IsLUB s z) + (hzn : z ∉ s) {a : Ordinal} (ha : a ≠ 0) + (htype : hs.orderType = omega0 ^ a) : + (hs.closure.mono (s := strictClosure (s := s) (z := z)) + inter_subset_left).orderType = omega0 ^ a := by + have habsorb : 2 * hs.orderType = hs.orderType := by + rw [htype, mul_eq_right_iff_opow_omega0_dvd] + have h2 : (2 : Ordinal) ^ omega0 = omega0 := natCast_opow_omega0 (by norm_num) + rw [h2] + have hle : (1 : Ordinal) ≤ a := by + simpa using Order.succ_le_of_lt (pos_iff_ne_zero.mpr ha) + simpa only [opow_one] using opow_dvd_opow omega0 hle + exact (strictClosure_orderType_eq_of_two_mul hs hz hzn habsorb).trans htype + +private theorem mem_cantorBendixson_top_Iio_iff {T : Ordinal.{0}} (i : Iio T) + (a : Ordinal.{0}) : + i ∈ ((⊤ : TopologicalSpace.Closeds (Iio T)).cantorBendixson a : Set (Iio T)) ↔ + i.1 ∈ ((⊤ : TopologicalSpace.Closeds Ordinal).cantorBendixson a : Set Ordinal) := by + let f : Iio T → Ordinal := Subtype.val + have hf : Topology.IsOpenEmbedding f := isOpen_Iio.isOpenEmbedding_subtypeVal + have himage := hf.image_cantorBendixson_top_eq a + constructor + · intro hi + have hm : f i ∈ f '' + ((⊤ : TopologicalSpace.Closeds (Iio T)).cantorBendixson a : Set (Iio T)) := + ⟨i, hi, rfl⟩ + exact ((Set.ext_iff.mp himage (f i)).mp hm).1 + · intro hi + have hm : f i ∈ + ((⊤ : TopologicalSpace.Closeds Ordinal).cantorBendixson a : Set Ordinal) ∩ + range f := ⟨hi, mem_range_self i⟩ + obtain ⟨j, hj, hji⟩ := (Set.ext_iff.mp himage (f i)).mpr hm + exact hf.injective hji ▸ hj + +/-- If a real well-order has order type `ω ^ a` and a strict supremum, that supremum has +Cantor–Bendixson rank `a` in the closure. -/ +@[blueprint "lem:cantor-bendixson-rank-of-strict-supremum" + (phase := "Cantor–Bendixson ranks of supports") + (title := "Cantor--Bendixson rank at a strict supremum") + (statement := /-- + Let $S\subseteq\mathbb R$ be well ordered and let $z$ be its least upper + bound, with $z\notin S$. If $\alpha\ne0$ and + $\operatorname{ot}(S)=\omega^\alpha$, then + \[ + \operatorname{rk}_{\mathrm{CB},\mathrm{cl}(S)}(z)=\alpha. + \] + -/) + (proof := /-- + The closure of $S$ is again well ordered. Its increasing enumeration is a + homeomorphism from an ordinal interval, and the strict initial segment below + $z$ still has order type $\omega^\alpha$. In an ordinal interval, the + $\alpha$-th Cantor--Bendixson derivative contains the point indexed by + $\omega^\alpha$, while the $(\alpha+1)$-st derivative does not. Transport + these two statements through the homeomorphism to the closure of $S$. + -/)] +theorem IsPWO.cantorBendixsonRank_closure_eq_of_orderType_eq_opow + (hs : s.IsPWO) (hz : IsLUB s z) (hzn : z ∉ s) {a : Ordinal} (ha : a ≠ 0) + (htype : hs.orderType = omega0 ^ a) : + TopologicalSpace.Closeds.cantorBendixsonRank + (⟨(_root_.closure s), isClosed_closure⟩ : TopologicalSpace.Closeds ℝ) + (Set.IsPWO.closure hs) z = a := by + obtain ⟨y, hy, -, -⟩ := hz.exists_between (sub_lt_self z one_pos) + have hzc : z ∈ _root_.closure s := hz.mem_closure ⟨y, hy⟩ + let S : TopologicalSpace.Closeds ℝ := ⟨(_root_.closure s), isClosed_closure⟩ + let C : Set ℝ := _root_.closure s + let hc : C.IsPWO := hs.closure + letI : WellFoundedLT C := ⟨hc.isWF⟩ + let T : Ordinal := Ordinal.type (· < · : C → C → Prop) + let i : Iio T := + ⟨Ordinal.typein (· < · : C → C → Prop) ⟨z, hzc⟩, + Ordinal.typein_lt_type _ _⟩ + have hi : i.1 = omega0 ^ a := by + rw [← strictClosure_orderType_eq_opow hs hz hzn ha htype] + exact (hc.orderType_inter_Iio_eq_typein hzc).symm + let e := Set.IsPWO.homeomorphIioType (s := C) isClosed_closure + have hei : e i = ⟨z, hzc⟩ := by + apply Subtype.ext + simp [e, Set.IsPWO.homeomorphIioType, Set.IsPWO.enumRealOrderIso, + i] + have hsource : + i ∈ ((⊤ : TopologicalSpace.Closeds (Iio T)).cantorBendixson a : Set (Iio T)) := by + rw [mem_cantorBendixson_top_Iio_iff, Ordinal.cantorBendixson_top_eq, + if_neg ha, hi, Ordinal.mem_positivePrincipalMultiples] + exact ⟨1, zero_lt_one, by simp⟩ + have hsourceSucc : + i ∉ ((⊤ : TopologicalSpace.Closeds (Iio T)).cantorBendixson (a + 1) : + Set (Iio T)) := by + have hsucc : a + 1 ≠ 0 := (add_pos_of_right zero_lt_one a).ne' + rw [mem_cantorBendixson_top_Iio_iff, Ordinal.cantorBendixson_top_eq, + if_neg hsucc, hi, Ordinal.mem_positivePrincipalMultiples] + rintro ⟨q, hq, heq⟩ + have hle : omega0 ^ (a + 1) ≤ omega0 ^ (a + 1) * q := + by simpa using mul_le_mul_right (one_le_iff_pos.mpr hq) (omega0 ^ (a + 1)) + have hlt : omega0 ^ a < omega0 ^ (a + 1) := + (opow_lt_opow_iff_right one_lt_omega0).mpr (Order.lt_succ a) + exact (not_le_of_gt hlt) (hle.trans_eq heq) + have heTop : e '' (Set.univ : Set (Iio T)) = (Set.univ : Set C) := by + ext x + simp + have hsub : ⟨z, hzc⟩ ∈ + ((⊤ : TopologicalSpace.Closeds C).cantorBendixson a : Set C) := by + rw [← hei] + exact (e.mem_cantorBendixson_iff ⊤ ⊤ heTop i a).mpr hsource + have hsubSucc : ⟨z, hzc⟩ ∉ + ((⊤ : TopologicalSpace.Closeds C).cantorBendixson (a + 1) : Set C) := by + rw [← hei] + exact fun h ↦ hsourceSucc ((e.mem_cantorBendixson_iff ⊤ ⊤ heTop i (a + 1)).mp h) + let j : C → ℝ := Subtype.val + have hj : Topology.IsClosedEmbedding j := isClosed_closure.isClosedEmbedding_subtypeVal + let J : TopologicalSpace.Closeds ℝ := + ⟨j '' ((⊤ : TopologicalSpace.Closeds C) : Set C), + hj.isClosedMap _ (TopologicalSpace.Closeds.isClosed ⊤)⟩ + have hJS : J = S := by + apply SetLike.coe_injective + ext x + simp [J, S, j, C] + have hambient : z ∈ (S.cantorBendixson a : Set ℝ) := by + have hstage := hj.image_cantorBendixson_eq ⊤ a + have hzJ : z ∈ (J.cantorBendixson a : Set ℝ) := by + rw [← hstage] + exact ⟨⟨z, hzc⟩, hsub, rfl⟩ + rwa [hJS] at hzJ + have hambientSucc : z ∉ (S.cantorBendixson (a + 1) : Set ℝ) := by + have hstage := hj.image_cantorBendixson_eq ⊤ (a + 1) + intro hzS + have hzJ : z ∈ (J.cantorBendixson (a + 1) : Set ℝ) := by + rwa [hJS] + rw [← hstage] at hzJ + obtain ⟨x, hx, hxz⟩ := hzJ + change x.1 = z at hxz + have hxeq : x = ⟨z, hzc⟩ := Subtype.ext hxz + exact hsubSucc (hxeq ▸ hx) + exact (S.cantorBendixsonRank_eq_iff (Set.IsPWO.closure hs) hzc a).mpr + ⟨hambient, hambientSucc⟩ + +end Set diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CoinitialComplete.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CoinitialComplete.lean new file mode 100644 index 0000000000..a4908f3e81 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CoinitialComplete.lean @@ -0,0 +1,238 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Topology.Algebra.IsUniformGroup.Defs +public import Mathlib.Topology.Order.Basic +public import Mathlib.Topology.UniformSpace.Cauchy + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Completeness from a coinitial family and fillable cuts + +An ordered abelian group need not be Cauchy complete, and the group of exponents of a Conway +normal form is a case in point: the partial sums of `∑_a ω^(-a)` over all ordinals `a` form a +Cauchy family with no limit, because a limit would need a support that is not a set. What rescues +the situation is passing to a quotient by a convex subgroup, where the positive elements acquire a +*set-indexed* coinitial family. This file records what that buys. + +Suppose the positive elements of `G` admit a family `ε : ι → G` that is coinitial with room to +spare — below every positive element sits some `ε i` together with a second copy of itself — and +suppose every cut cut out by two `ι`-indexed families can be filled. Then `G` is Cauchy complete +(`completeSpace_of_coinitial_of_forall_exists_mem_cut`). + +The proof is the usual centre-and-radius argument, carried out at the fixed index type `ι` so that +only cuts between two `ι`-indexed families are ever needed. Pick for each `i` a set `A i` in the +Cauchy filter of diameter below `ε i` and a point `a i` of it. Any two of these sets meet, so +`a i - ε i < a j + ε j` for all `i` and `j`; filling that cut gives a point `z` within `ε i` of +every `a i`, and then `A i` sits inside any interval around `z` of radius at least `ε i + ε i`. + +For the intended application `ι` indexes a coinitial family of the quotient, the cuts are filled by +choosing representatives and taking a single surreal cut between the two resulting sets, and the +second copy of `ε i` is available because the quotient is divisible. +-/ + +universe u w + +open Filter Set Topology Uniformity + +public section + +/-- Filling cuts between two `ι`-indexed families. Stated as a predicate so that the hypothesis +can be transported along a quotient before being fed to the completeness criterion. -/ +def FillsCuts (ι : Type w) (G : Type u) [Preorder G] : Prop := + ∀ L R : ι → G, (∀ i j, L i < R j) → ∃ z, (∀ i, L i ≤ z) ∧ ∀ j, z ≤ R j + +theorem fillsCuts_iff (ι : Type w) (G : Type u) [Preorder G] : + FillsCuts ι G ↔ + ∀ L R : ι → G, (∀ i j, L i < R j) → ∃ z, (∀ i, L i ≤ z) ∧ ∀ j, z ≤ R j := + Iff.rfl + +/-- A conditionally complete order fills every cut between nonempty families: the supremum of the +lower family is bounded above by the upper one, and lies below all of it. -/ +theorem fillsCuts_of_conditionallyCompleteLinearOrder {ι : Type w} [Nonempty ι] + {G : Type u} [ConditionallyCompleteLinearOrder G] : FillsCuts ι G := by + intro L R hLR + have hbdd : BddAbove (Set.range L) := + ⟨R (Classical.arbitrary ι), by rintro _ ⟨i, rfl⟩; exact (hLR i _).le⟩ + refine ⟨sSup (Set.range L), fun i ↦ le_csSup hbdd ⟨i, rfl⟩, fun j ↦ ?_⟩ + exact csSup_le (Set.range_nonempty L) (by rintro _ ⟨i, rfl⟩; exact (hLR i j).le) + +/-- **Cut filling passes to a quotient.** A surjection that preserves `≤` and reflects `<` carries +the property of filling `ι`-indexed cuts along with it: lift the two families to representatives, +which the reflected order still separates, fill the cut upstairs, and push the filler down. + +For a quotient of an ordered group by a convex subgroup the hypotheses hold, so the quotient fills +cuts as soon as the group does — which for the surreals is the simplicity theorem at sets. -/ +@[blueprint "lem:cut-filling-order-reflecting-surjection" + (phase := "A cut criterion for Cauchy completeness") + (title := "Cut filling under monotone order-reflecting surjections") + (statement := /-- + Let $f\colon G\twoheadrightarrow C$ be a monotone surjection of preordered + sets that reflects strict inequalities. If every cut between two + $I$-indexed families in $G$ can be filled, then the same is true in $C$. + -/) + (proof := /-- + Choose preimages in $G$ of the two families in $C$. Reflection of strict + inequalities keeps the lifted families separated. Fill their cut in + $G$, then apply $f$; monotonicity places the image between the two original + families. + -/)] +theorem FillsCuts.of_surjective {ι : Type w} {G : Type u} {C : Type*} [Preorder G] [Preorder C] + {f : G → C} (hsurj : Function.Surjective f) (hmono : Monotone f) + (hreflect : ∀ a b : G, f a < f b → a < b) (hG : FillsCuts ι G) : FillsCuts ι C := by + intro L R hLR + choose l hl using fun i ↦ hsurj (L i) + choose r hr using fun j ↦ hsurj (R j) + obtain ⟨z, hzl, hzr⟩ := hG l r fun i j ↦ hreflect _ _ (by rw [hl, hr]; exact hLR i j) + exact ⟨f z, fun i ↦ hl i ▸ hmono (hzl i), fun j ↦ hr j ▸ hmono (hzr j)⟩ + +variable {G : Type u} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] + +/-- The symmetric interval of a positive radius is an entourage. -/ +theorem mem_uniformity_Ioo_of_pos {c : G} (hc : 0 < c) : + {p : G × G | p.2 - p.1 ∈ Ioo (-c) c} ∈ 𝓤 G := by + rw [uniformity_eq_comap_nhds_zero G] + exact ⟨Ioo (-c) c, Ioo_mem_nhds (neg_neg_iff_pos.mpr hc) hc, subset_rfl⟩ + +/-- Conversely every entourage contains a symmetric interval of positive radius. -/ +theorem exists_pos_Ioo_subset_of_mem_uniformity [Nontrivial G] {s : Set (G × G)} + (hs : s ∈ 𝓤 G) : ∃ c : G, 0 < c ∧ {p : G × G | p.2 - p.1 ∈ Ioo (-c) c} ⊆ s := by + rw [uniformity_eq_comap_nhds_zero G] at hs + obtain ⟨W, hW, hWs⟩ := hs + obtain ⟨x, hx⟩ := exists_ne (0 : G) + have hpos : (0 : G) < |x| := abs_pos.mpr hx + obtain ⟨l, u, hlu, hsub⟩ := + (mem_nhds_iff_exists_Ioo_subset' ⟨-|x|, neg_neg_iff_pos.mpr hpos⟩ ⟨|x|, hpos⟩).mp hW + refine ⟨min (-l) u, lt_min (neg_pos.mpr hlu.1) hlu.2, fun p hp ↦ hWs ?_⟩ + refine hsub ⟨?_, ?_⟩ + · refine lt_of_le_of_lt ?_ hp.1 + rw [le_neg] + exact min_le_left (-l) u + · exact hp.2.trans_le (min_le_right (-l) u) + +/-- **Completeness from a coinitial family and fillable cuts.** If the positive elements of `G` +admit a coinitial family `ε : ι → G` whose members each fit twice below any prescribed positive +element, and every cut between two `ι`-indexed families of `G` is filled, then `G` is Cauchy +complete. + +Only cuts indexed by the same `ι` as the coinitial family are used, so for a quotient of the +surreals by a convex subgroup this asks for the simplicity theorem at sets, not at classes. -/ +@[blueprint "lem:complete-of-coinitial-scales-and-cut-filling" + (phase := "A cut criterion for Cauchy completeness") + (title := "A cut criterion for Cauchy completeness") + (statement := /-- + Let $G$ be an ordered abelian group whose order topology is induced by a + compatible additive uniformity, and let $I$ be nonempty. Suppose there + are elements $\varepsilon_i>0$ such that, for every $c>0$, some $i\in I$ + satisfies + \[ + \varepsilon_i+\varepsilon_i\le c. + \] + Suppose also that whenever $L_i.trans hqb⟩ + exact (hab hc) (subset_closure ⟨i, rfl⟩) + · obtain ⟨p, ⟨hcutp, _⟩, ⟨_, hpb⟩⟩ := hi + obtain ⟨q, ⟨_, hqcenter⟩, ⟨haq, _⟩⟩ := hj + have hc : center j ∈ Ioo a b := + ⟨haq.trans_le hqcenter, (hord j i hji).trans_lt hcutp |>.trans hpb⟩ + exact (hab hc) (subset_closure ⟨j, rfl⟩) + +/-- Away from the closure of the interval centers, the closure of an ordered union agrees locally +with the closure of one member. -/ +theorem exists_local_closure_eq_ordered_iUnion + (f : ι → Set X) (cut center : ι → X) + (hsupp : ∀ i, f i ⊆ Ioc (cut i) (center i)) + (hord : ∀ i j, i < j → center i ≤ cut j) + {x : X} (hxcenter : x ∉ closure (Set.range center)) + (hx : x ∈ closure (⋃ i, f i)) : + ∃ i t, IsOpen t ∧ x ∈ t ∧ + closure (⋃ i, f i) ∩ t = closure (f i) ∩ t := by + obtain ⟨t, htx, hsub⟩ := exists_nhds_subsingleton_ordered_Ioc cut center hord hxcenter + let u := interior t + have hxu : x ∈ u := mem_interior_iff_mem_nhds.mpr htx + have huopen : IsOpen u := isOpen_interior + obtain ⟨p, hpu, hp⟩ := mem_closure_iff.mp hx u huopen hxu + rw [Set.mem_iUnion] at hp + obtain ⟨i, hpi⟩ := hp + have hi : i ∈ {j | (Ioc (cut j) (center j) ∩ t).Nonempty} := + ⟨p, hsupp i hpi, interior_subset hpu⟩ + refine ⟨i, u, huopen, hxu, huopen.closure_congr ?_⟩ + ext y + constructor + · rintro ⟨hy, hyu⟩ + rw [Set.mem_iUnion] at hy + obtain ⟨j, hyj⟩ := hy + have hj : j ∈ {k | (Ioc (cut k) (center k) ∩ t).Nonempty} := + ⟨y, hsupp j hyj, interior_subset hyu⟩ + exact ⟨hsub hj hi ▸ hyj, hyu⟩ + · rintro ⟨hyi, hyu⟩ + exact ⟨Set.mem_iUnion_of_mem i hyi, hyu⟩ + +/-- If a derivative stage of every component is supported at its interval center, the +corresponding stage of the ordered union is supported on the closure of those centers. -/ +theorem cantorBendixson_ordered_iUnion_subset_closure_range + (f : ι → Set X) (cut center : ι → X) + (hsupp : ∀ i, f i ⊆ Ioc (cut i) (center i)) + (hord : ∀ i j, i < j → center i ≤ cut j) (o : Ordinal.{u}) + (hstage : ∀ i, ((⟨closure (f i), isClosed_closure⟩ : Closeds X).cantorBendixson o : + Set X) ⊆ {center i}) : + ((⟨closure (⋃ i, f i), isClosed_closure⟩ : Closeds X).cantorBendixson o : Set X) ⊆ + closure (Set.range center) := by + intro x hx + by_contra hxcenter + have hxunion : x ∈ closure (⋃ i, f i) := + (⟨closure (⋃ i, f i), isClosed_closure⟩ : Closeds X).cantorBendixson_le o hx + obtain ⟨i, t, htopen, hxt, heq⟩ := + exists_local_closure_eq_ordered_iUnion f cut center hsupp hord hxcenter hxunion + let s : Closeds X := ⟨closure (⋃ i, f i), isClosed_closure⟩ + let q : Closeds X := ⟨closure (f i), isClosed_closure⟩ + have hcongr := TopologicalSpace.Closeds.cantorBendixson_congr_on_open + s q htopen heq o + have hm := (Set.ext_iff.mp hcongr x).mp ⟨hx, hxt⟩ + have hxc : x = center i := Set.mem_singleton_iff.mp (hstage i hm.1) + exact hxcenter (subset_closure ⟨i, hxc.symm⟩) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOAddition.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOAddition.lean new file mode 100644 index 0000000000..88054e2765 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOAddition.lean @@ -0,0 +1,211 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Order.WellFoundedSet +public import Mathlib.Topology.Algebra.IsUniformGroup.Basic +public import Mathlib.Topology.Order.LeftRightNhds +public import Mathlib.Topology.Maps.Proper.Basic +public import Mathlib.Topology.UniformSpace.UniformEmbedding +public import Mathlib.Topology.Algebra.Group.Pointwise + +/-! +# Addition on well-ordered supports + +In a complete linearly ordered uniform additive group, addition restricted to two closed +well-ordered subsets is proper and has finite fibers. Closure therefore commutes with their +pointwise sum. Well-ordering here refers to the increasing order on the exponent group. + +The proof uses the finite set of minimal elements in a partially well-ordered set: an ultrafilter +containing that set concentrates above one of its minimal elements. If the sums are Cauchy, +nonnegative increments in either coordinate are bounded by increments of the sum. Completeness +then supplies a limit in the closed product. No Archimedean or countable cofinality hypothesis +is used, and no order completion is substituted for the given ambient group. +-/ + +public section + +open Set Filter Topology +open scoped Pointwise + +/-- An ultrafilter containing a partially well-ordered set concentrates above one of its points. -/ +theorem Set.IsPWO.exists_eventually_le {α : Type*} [PartialOrder α] + {s : Set α} (hs : s.IsPWO) (𝒰 : Ultrafilter α) (hmem : s ∈ 𝒰) : + ∃ a ∈ s, ∀ᶠ b in 𝒰, a ≤ b := by + have hfin : {a | Minimal (· ∈ s) a}.Finite := + (setOf_minimal_antichain _).finite_of_partiallyWellOrderedOn + (hs.mono (setOf_minimal_subset _)) + have he : ∀ᶠ b in 𝒰, ∃ a ∈ {a | Minimal (· ∈ s) a}, a ≤ b := by + filter_upwards [hmem] with b hb + obtain ⟨a, hab, ha⟩ := hs.exists_le_minimal hb + exact ⟨a, ha, hab⟩ + obtain ⟨a, ha, hab⟩ := (Ultrafilter.eventually_exists_mem_iff hfin).mp he + exact ⟨a, ha.1, hab⟩ + +private theorem Set.IsPWO.exists_mem_Ioc_of_mem_closure {α : Type*} + [LinearOrder α] [TopologicalSpace α] [OrderTopology α] + {s : Set α} (hs : s.IsPWO) {x y : α} (hx : x ∈ closure s) (hy : y < x) : + ∃ b ∈ s, y < b ∧ b ≤ x := by + by_contra! hn + have habove : ∀ b ∈ s, y < b → x < b := fun b hb hyb ↦ hn b hb hyb + let v := s ∩ Ioi x + have hv : v.IsWF := hs.isWF.mono inter_subset_left + have hne : v.Nonempty := by + obtain ⟨b, hby, hbs⟩ := mem_closure_iff_nhds.mp hx (Ioi y) (Ioi_mem_nhds hy) + exact ⟨b, hbs, habove b hbs hby⟩ + let m := hv.min hne + have hm : m ∈ v := hv.min_mem hne + obtain ⟨b, hb, hbs⟩ := mem_closure_iff_nhds.mp hx (Ioo y m) (Ioo_mem_nhds hy hm.2) + exact (not_lt_of_ge (hv.min_le hne ⟨hbs, habove b hbs hb.1⟩)) hb.2 + +/-- The ambient closure of a well-ordered subset of a linearly ordered space is well ordered. -/ +theorem Set.IsPWO.closure {α : Type*} [LinearOrder α] [TopologicalSpace α] + [OrderTopology α] {s : Set α} (hs : s.IsPWO) : (closure s).IsPWO := by + rw [Set.isPWO_iff_isWF, Set.isWF_iff_no_descending_seq] + intro f hf hmem + choose b hbs hb using fun n ↦ + hs.exists_mem_Ioc_of_mem_closure (hmem n) (hf (Nat.lt_succ_self n)) + have hAnti : StrictAnti b := strictAnti_nat_of_succ_lt fun n ↦ + lt_of_le_of_lt (hb (n + 1)).2 (hb n).1 + exact (Set.isWF_iff_no_descending_seq.mp hs.isWF) b hAnti hbs + +section OrderedGroup + +variable {G : Type*} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] in +/-- A line of fixed sum meets a product of well-ordered sets in finitely many points. -/ +theorem Set.IsPWO.finite_add_fiber {s t : Set G} (hs : s.IsPWO) (ht : t.IsPWO) (z : G) : + {p : G × G | p ∈ s ×ˢ t ∧ p.1 + p.2 = z}.Finite := by + apply IsAntichain.finite_of_partiallyWellOrderedOn _ + ((hs.prod ht).mono fun _ h ↦ h.1) + intro p hp q hq hne hpq + apply hne + have hfst : p.1 = q.1 := le_antisymm hpq.1 <| + (add_le_add_iff_right p.2).mp <| calc + q.1 + p.2 ≤ q.1 + q.2 := add_le_add_right hpq.2 _ + _ = p.1 + p.2 := hq.2.trans hp.2.symm + exact Prod.ext hfst (add_left_cancel (hfst ▸ hp.2.trans hq.2.symm)) + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] in +private theorem abs_sub_lt_of_lower_bound {a x y : G × G} {ε : G} + (hx : a ≤ x) (hy : a ≤ y) + (hxs : |(x.1 + x.2) - (a.1 + a.2)| < ε) + (hys : |(y.1 + y.2) - (a.1 + a.2)| < ε) : |x.1 - y.1| < ε := by + have hb (z : G × G) (hz : a ≤ z) : + z.1 - a.1 ≤ (z.1 + z.2) - (a.1 + a.2) := by + rw [← sub_add_sub_comm] + exact le_add_of_nonneg_right (sub_nonneg.mpr hz.2) + apply abs_lt.mpr + constructor + · have h : y.1 - x.1 < ε := + (sub_le_sub_left hx.1 _).trans_lt ((hb y hy).trans_lt (abs_lt.mp hys).2) + simpa only [neg_sub] using neg_lt_neg h + · exact (sub_le_sub_left hy.1 _).trans_lt ((hb x hx).trans_lt (abs_lt.mp hxs).2) + +private theorem Ultrafilter.exists_mem_small_coordinates {s t : Set G} + (hs : s.IsPWO) (ht : t.IsPWO) (𝒰 : Ultrafilter (G × G)) + (hmem : s ×ˢ t ∈ 𝒰) + (hc : Cauchy (Filter.map (fun p : G × G ↦ p.1 + p.2) (𝒰 : Filter (G × G)))) + {ε : G} (hε : 0 < ε) : + ∃ v ∈ 𝒰, ∀ x ∈ v, ∀ y ∈ v, |x.1 - y.1| < ε ∧ |x.2 - y.2| < ε := by + obtain ⟨v, hv, hdiam⟩ := + ((nhds_basis_zero_abs_lt G).uniformity_of_nhds_zero_swapped.cauchy_iff.mp hc).2 ε hε + let w : Set (G × G) := (s ×ˢ t) ∩ {p | p.1 + p.2 ∈ v} + have hw : w ∈ 𝒰 := inter_mem hmem hv + obtain ⟨a, ha, hle⟩ := ((hs.prod ht).mono inter_subset_left).exists_eventually_le 𝒰 hw + refine ⟨w ∩ Ici a, inter_mem hw hle, ?_⟩ + intro x hx y hy + have hxa : |(x.1 + x.2) - (a.1 + a.2)| < ε := hdiam _ hx.1.2 _ ha.2 + have hya : |(y.1 + y.2) - (a.1 + a.2)| < ε := hdiam _ hy.1.2 _ ha.2 + refine ⟨abs_sub_lt_of_lower_bound hx.2 hy.2 hxa hya, ?_⟩ + exact abs_sub_lt_of_lower_bound (a := a.swap) (x := x.swap) (y := y.swap) + ⟨hx.2.2, hx.2.1⟩ ⟨hy.2.2, hy.2.1⟩ + (by simpa only [Prod.swap, add_comm] using hxa) + (by simpa only [Prod.swap, add_comm] using hya) + +/-- A Cauchy sum makes an ultrafilter on two well-ordered supports itself Cauchy. -/ +theorem Ultrafilter.cauchy_of_add {s t : Set G} + (hs : s.IsPWO) (ht : t.IsPWO) (𝒰 : Ultrafilter (G × G)) + (hmem : s ×ˢ t ∈ 𝒰) + (hc : Cauchy (Filter.map (fun p : G × G ↦ p.1 + p.2) (𝒰 : Filter (G × G)))) : + Cauchy (𝒰 : Filter (G × G)) := by + rw [cauchy_prod_iff] + constructor + · rw [IsUniformAddGroup.cauchy_map_iff_tendsto] + refine ⟨inferInstance, (nhds_basis_zero_abs_lt G).tendsto_right_iff.mpr ?_⟩ + intro ε hε + obtain ⟨v, hv, hd⟩ := 𝒰.exists_mem_small_coordinates hs ht hmem hc hε + exact mem_of_superset (prod_mem_prod hv hv) fun p hp ↦ (hd _ hp.1 _ hp.2).1 + · rw [IsUniformAddGroup.cauchy_map_iff_tendsto] + refine ⟨inferInstance, (nhds_basis_zero_abs_lt G).tendsto_right_iff.mpr ?_⟩ + intro ε hε + obtain ⟨v, hv, hd⟩ := 𝒰.exists_mem_small_coordinates hs ht hmem hc hε + exact mem_of_superset (prod_mem_prod hv hv) fun p hp ↦ (hd _ hp.1 _ hp.2).2 + +/-- Addition on two closed well-ordered supports is proper in an ordered uniform group that is +Cauchy complete. -/ +theorem Set.IsPWO.isProperMap_add [CompleteSpace G] {s t : Set G} + (hs : s.IsPWO) (ht : t.IsPWO) (hsc : IsClosed s) (htc : IsClosed t) : + IsProperMap (fun p : s ×ˢ t ↦ p.1.1 + p.1.2) := by + letI : CompleteSpace (s ×ˢ t) := (hsc.prod htc).isComplete.completeSpace_coe + refine isProperMap_iff_ultrafilter_of_t2.mpr ⟨by fun_prop, ?_⟩ + intro 𝒰 y hy + have hc : Cauchy (Filter.map (fun p : G × G ↦ p.1 + p.2) + (𝒰.map Subtype.val : Filter (G × G))) := by + simpa only [Ultrafilter.coe_map, Filter.map_map, Function.comp_def] using hy.cauchy_map + have hm : s ×ˢ t ∈ 𝒰.map Subtype.val := by + change {p : s ×ˢ t | p.1 ∈ s ×ˢ t} ∈ (𝒰 : Filter (s ×ˢ t)) + exact Filter.Eventually.of_forall fun p ↦ p.2 + have hu := (𝒰.map Subtype.val).cauchy_of_add hs ht hm hc + have hcU : Cauchy (𝒰 : Filter (s ×ˢ t)) := + isUniformEmbedding_subtype_val.isUniformInducing.cauchy_map_iff.mp hu + exact cauchy_iff_exists_le_nhds.mp hcU + +/-- Addition on two closed well-ordered supports is a closed map. -/ +theorem Set.IsPWO.isClosedMap_add [CompleteSpace G] {s t : Set G} + (hs : s.IsPWO) (ht : t.IsPWO) (hsc : IsClosed s) (htc : IsClosed t) : + IsClosedMap (fun p : s ×ˢ t ↦ p.1.1 + p.1.2) := + (hs.isProperMap_add ht hsc htc).isClosedMap + +omit [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] in +/-- Every fiber of addition on the subtype of two well-ordered supports is finite. -/ +theorem Set.IsPWO.finite_subtype_add_fiber {s t : Set G} + (hs : s.IsPWO) (ht : t.IsPWO) (z : G) : + ((fun p : s ×ˢ t ↦ p.1.1 + p.1.2) ⁻¹' {z}).Finite := by + have hf := (hs.finite_add_fiber ht z).preimage + (f := (Subtype.val : s ×ˢ t → G × G)) Subtype.val_injective.injOn + change {p : s ×ˢ t | p.1.1 + p.1.2 = z}.Finite + simpa only [preimage_setOf_eq, Subtype.coe_prop, true_and] using hf + +/-- The sum of two closed well-ordered supports is closed. -/ +theorem Set.IsPWO.isClosed_add [CompleteSpace G] {s t : Set G} + (hs : s.IsPWO) (ht : t.IsPWO) (hsc : IsClosed s) (htc : IsClosed t) : + IsClosed (s + t) := by + have he : Set.range (fun p : s ×ˢ t ↦ p.1.1 + p.1.2) = s + t := by + ext z + constructor + · rintro ⟨p, rfl⟩ + exact Set.add_mem_add p.2.1 p.2.2 + · rintro ⟨x, hx, y, hy, rfl⟩ + exact ⟨⟨(x, y), hx, hy⟩, rfl⟩ + rw [← he] + exact (hs.isClosedMap_add ht hsc htc).isClosed_range + +/-- Closure commutes with addition of well-ordered supports when the ambient ordered uniform group +is Cauchy complete. -/ +theorem Set.IsPWO.closure_add_eq [CompleteSpace G] {s t : Set G} + (hs : s.IsPWO) (ht : t.IsPWO) : + _root_.closure (s + t) = _root_.closure s + _root_.closure t := by + apply Subset.antisymm + · exact closure_minimal (Set.add_subset_add subset_closure subset_closure) + (hs.closure.isClosed_add ht.closure isClosed_closure isClosed_closure) + · rw [← Set.image2_add, ← Set.image2_add, ← Set.image_prod, ← Set.image_prod, + ← closure_prod_eq] + exact image_closure_subset_closure_image (by fun_prop) + +end OrderedGroup diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOAdditionFiber.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOAdditionFiber.lean new file mode 100644 index 0000000000..94cf99d8a0 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOAdditionFiber.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonRank + +/-! +# Local domination by a finite addition fiber + +Near a fixed sum, each pair from two closed well-ordered supports is coordinatewise bounded +by exactly one pair in the fiber at that sum. Closedness of addition propagates the local +right gaps of the supports to a whole nearby fiber; finite fibers supply uniqueness. +The ambient ordered uniform group is Cauchy complete. No countability or density is assumed. +-/ + +public noncomputable section + +open Set Filter Topology + +universe u + +variable {G : Type u} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] + [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] + +/-- Every nearby addition pair lies below a pair in the fixed fiber. -/ +theorem Set.IsPWO.eventually_exists_add_dominator {B C : Set G} + (hB : B.IsPWO) (hC : C.IsPWO) (hBc : IsClosed B) (hCc : IsClosed C) (γ : G) : + ∀ᶠ δ in 𝓝 γ, ∀ q : B ×ˢ C, q.1.1 + q.1.2 = δ → + ∃ p : B ×ˢ C, p.1.1 + p.1.2 = γ ∧ q.1 ≤ p.1 := by + apply (hB.isClosedMap_add hC hBc hCc).eventually_nhds_fiber γ + intro p hp + have hfst : Continuous (fun q : B ×ˢ C ↦ q.1.1) := by fun_prop + have hsnd : Continuous (fun q : B ×ˢ C ↦ q.1.2) := by fun_prop + filter_upwards [hfst.continuousAt.tendsto.eventually (hB.eventually_le p.1.1), + hsnd.continuousAt.tendsto.eventually (hC.eventually_le p.1.2)] with q hq1 hq2 + exact ⟨p, hp, hq1 q.2.1, hq2 q.2.2⟩ + +/-- Every nearby addition pair lies below exactly one pair in the fixed fiber. -/ +theorem Set.IsPWO.eventually_existsUnique_add_dominator {B C : Set G} + (hB : B.IsPWO) (hC : C.IsPWO) (hBc : IsClosed B) (hCc : IsClosed C) (γ : G) : + ∀ᶠ δ in 𝓝 γ, ∀ q : B ×ˢ C, q.1.1 + q.1.2 = δ → + ∃! p : B ×ˢ C, p.1.1 + p.1.2 = γ ∧ q.1 ≤ p.1 := by + let f : B ×ˢ C → G := fun p ↦ p.1.1 + p.1.2 + let F := f ⁻¹' {γ} + have hF : F.Finite := hB.finite_subtype_add_fiber hC γ + have hu : ∀ᶠ δ in 𝓝 γ, ∀ p ∈ F, ∀ r ∈ F, ∀ q : B ×ˢ C, + f q = δ → q.1 ≤ p.1 → q.1 ≤ r.1 → p = r := by + apply hF.eventually_all.mpr + intro p hp + apply hF.eventually_all.mpr + intro r hr + by_cases he : p = r + · exact Filter.Eventually.of_forall fun _ _ _ _ _ ↦ he + have hne : p.1.1 ≠ r.1.1 := by + intro he1 + apply he + apply Subtype.ext + apply Prod.ext he1 + have hh : p.1.1 + p.1.2 = r.1.1 + r.1.2 := hp.trans hr.symm + rw [he1] at hh + exact add_left_cancel hh + rcases lt_or_gt_of_ne hne with hlt | hlt + · have hgap : p.1.1 + r.1.2 < γ := + (add_lt_add_left hlt r.1.2).trans_eq hr + filter_upwards [eventually_gt_nhds hgap] with δ hδ q hq hqp hqr + exact False.elim ((not_le_of_gt hδ) (hq ▸ add_le_add hqp.1 hqr.2)) + · have hgap : r.1.1 + p.1.2 < γ := + (add_lt_add_left hlt p.1.2).trans_eq hp + filter_upwards [eventually_gt_nhds hgap] with δ hδ q hq hqp hqr + exact False.elim ((not_le_of_gt hδ) (hq ▸ add_le_add hqr.1 hqp.2)) + filter_upwards [hB.eventually_exists_add_dominator hC hBc hCc γ, hu] + with δ hex huniq q hq + obtain ⟨p, hp, hqp⟩ := hex q hq + exact ⟨p, ⟨hp, hqp⟩, fun r hr ↦ huniq r hr.1 p hp q hq hr.2 hqp⟩ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOSumset.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOSumset.lean new file mode 100644 index 0000000000..41a5f58182 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOSumset.lean @@ -0,0 +1,246 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Algebra.Group.Pointwise.Set.Basic +public import Mathlib.Order.WellFoundedSet +public import Mathlib.Topology.MetricSpace.Pseudo.Defs + +import Mathlib.Topology.Instances.Real.Lemmas +import Mathlib.Topology.Order.MonotoneConvergence +import Mathlib.Topology.Sequences + +/-! +# Sumsets of well-ordered sets of reals + +The two geometric inputs to Berarducci's convolution formula in Section 7. + +Berarducci, Lemma 7.1: the closure of the pointwise sum of two partially well-ordered subsets of +`ℝ` is the sum of their closures. Berarducci, Lemma 7.4: for `δ ≤ γ` sufficiently close to +`γ`, +every point of `B × C` on the line of sum `δ` is dominated coordinatewise by exactly one point of +`B × C` on the line of sum `γ`. + +Both rest on one construction: a sequence in `B + C` converging to `x` can be replaced by a +subsequence whose two factor sequences are monotone, hence convergent, with limits in the two +closures summing to `x`. Well-ordering supplies the monotone subsequences and completeness of `ℝ` +supplies their limits; Berarducci, Remark 7.3 records that Lemma 7.1 fails over `ℚ`. + +Uniqueness in Lemma 7.4 is separate and uses only well-ordering: the line of sum `γ` meets +`B × C` in finitely many points, so the first coordinates of those points are separated by some +`d > 0`, and two distinct dominating points would force `γ - δ ≥ d`. + +The inclusion `closure B + closure C ⊆ closure (B + C)` holds for arbitrary sets and is stated +separately. Lemma 7.4 is applied to the closed supports of two series, so the module also proves +that the closure of a partially well-ordered set of reals is partially well ordered: a strictly +decreasing sequence in the closure can be pushed down to one in the set itself. +-/ + +public noncomputable section + +open Pointwise Filter Topology + +namespace Set + +private theorem exists_mem_Ioc_of_mem_closure {B : Set ℝ} (hB : B.IsPWO) {x y : ℝ} + (hx : x ∈ closure B) (hy : y < x) : ∃ b ∈ B, y < b ∧ b ≤ x := by + by_contra hcon + push Not at hcon + have habove : ∀ b ∈ B, y < b → x < b := by + intro b hbB hyb + exact lt_of_not_ge fun hbx ↦ absurd hbx (not_le.mpr (hcon b hbB hyb)) + set U := B ∩ Set.Ioi x with hU + have hUwf : U.IsWF := hB.isWF.mono Set.inter_subset_left + have hUne : U.Nonempty := by + obtain ⟨b, hbB, hb⟩ := Metric.mem_closure_iff.mp hx (x - y) (by linarith) + rw [Real.dist_eq, abs_lt] at hb + exact ⟨b, hbB, habove b hbB (by linarith [hb.1])⟩ + set m := hUwf.min hUne with hm + have hmU : m ∈ U := hUwf.min_mem hUne + have hmx : x < m := hmU.2 + obtain ⟨b', hb'B, hb'⟩ := + Metric.mem_closure_iff.mp hx (min (m - x) (x - y)) (lt_min (by linarith) (by linarith)) + rw [Real.dist_eq, abs_lt] at hb' + have hb'y : y < b' := by + have := hb'.1 + have hle : min (m - x) (x - y) ≤ x - y := min_le_right _ _ + linarith + have hb'x : x < b' := habove b' hb'B hb'y + have hb'm : b' < m := by + have := hb'.2 + have hle : min (m - x) (x - y) ≤ m - x := min_le_left _ _ + linarith + exact absurd hb'm (not_lt.mpr (hUwf.min_le hUne ⟨hb'B, hb'x⟩)) + +/-- The closure of a partially well-ordered set of reals is partially well ordered. -/ +theorem isPWO_closure {B : Set ℝ} (hB : B.IsPWO) : (closure B).IsPWO := by + rw [Set.isPWO_iff_isWF, Set.isWF_iff_no_descending_seq] + intro f hf hmem + choose b hbB hb using fun n ↦ + exists_mem_Ioc_of_mem_closure hB (hmem n) (hf (Nat.lt_succ_self n)) + have hAnti : StrictAnti b := by + refine strictAnti_nat_of_succ_lt fun n ↦ ?_ + exact lt_of_le_of_lt (hb (n + 1)).2 (hb n).1 + exact (Set.isWF_iff_no_descending_seq.mp hB.isWF) b hAnti hbB + +private theorem exists_monotone_limits_of_add_tendsto + {B C : Set ℝ} (hB : B.IsPWO) (hC : C.IsPWO) {x : ℝ} + {b c : ℕ → ℝ} (hb : ∀ n, b n ∈ B) (hc : ∀ n, c n ∈ C) + (hlim : Tendsto (fun n ↦ b n + c n) atTop (𝓝 x)) : + ∃ (g : ℕ → ℕ) (β ξ : ℝ), StrictMono g ∧ β ∈ closure B ∧ ξ ∈ closure C ∧ + β + ξ = x ∧ (∀ n, b (g n) ≤ β) ∧ ∀ n, c (g n) ≤ ξ := by + obtain ⟨g₁, hg₁⟩ := hB.exists_monotone_subseq hb + obtain ⟨g₂, hg₂⟩ := + hC.exists_monotone_subseq (f := fun n ↦ c (g₁ n)) fun n ↦ hc (g₁ n) + set g : ℕ → ℕ := fun n ↦ g₁ (g₂ n) with hgDef + have hgMono : StrictMono g := g₁.strictMono.comp g₂.strictMono + set B' : ℕ → ℝ := fun n ↦ b (g n) with hB'Def + set C' : ℕ → ℝ := fun n ↦ c (g n) with hC'Def + have hB'mono : Monotone B' := fun _ _ hmn ↦ hg₁ (g₂.strictMono.monotone hmn) + have hC'mono : Monotone C' := fun _ _ hmn ↦ hg₂ hmn + have hsumLim : Tendsto (fun n ↦ B' n + C' n) atTop (𝓝 x) := + hlim.comp hgMono.tendsto_atTop + have hbound : ∀ n, B' n + C' n ≤ x := (hB'mono.add hC'mono).ge_of_tendsto hsumLim + have hB'bdd : BddAbove (Set.range B') := by + refine ⟨x - C' 0, ?_⟩ + rintro _ ⟨n, rfl⟩ + have h0 := hC'mono (Nat.zero_le n) + have hn := hbound n + linarith + have hC'bdd : BddAbove (Set.range C') := by + refine ⟨x - B' 0, ?_⟩ + rintro _ ⟨n, rfl⟩ + have h0 := hB'mono (Nat.zero_le n) + have hn := hbound n + linarith + have hB'lim : Tendsto B' atTop (𝓝 (⨆ n, B' n)) := tendsto_atTop_ciSup hB'mono hB'bdd + have hC'lim : Tendsto C' atTop (𝓝 (⨆ n, C' n)) := tendsto_atTop_ciSup hC'mono hC'bdd + refine ⟨g, ⨆ n, B' n, ⨆ n, C' n, hgMono, + mem_closure_of_tendsto hB'lim (by filter_upwards with n using hb (g n)), + mem_closure_of_tendsto hC'lim (by filter_upwards with n using hc (g n)), ?_, + fun n ↦ le_ciSup hB'bdd n, fun n ↦ le_ciSup hC'bdd n⟩ + exact tendsto_nhds_unique (hB'lim.add hC'lim) hsumLim + +theorem closure_add_closure_subset (B C : Set ℝ) : + closure B + closure C ⊆ closure (B + C) := by + rw [← Set.image2_add, ← Set.image2_add, ← Set.image_prod, ← Set.image_prod, + ← closure_prod_eq] + exact image_closure_subset_closure_image (by fun_prop) + +theorem IsPWO.closure_add {B C : Set ℝ} (hB : B.IsPWO) (hC : C.IsPWO) : + closure (B + C) = closure B + closure C := by + refine Set.Subset.antisymm ?_ (closure_add_closure_subset B C) + intro x hx + obtain ⟨y, hy, hyx⟩ := mem_closure_iff_seq_limit.mp hx + choose b hb c hc hbc using fun n ↦ Set.mem_add.mp (hy n) + have hlim : Tendsto (fun n ↦ b n + c n) atTop (𝓝 x) := by + simpa only [hbc] using hyx + obtain ⟨_, β, ξ, _, hβ, hξ, hsum, -, -⟩ := + exists_monotone_limits_of_add_tendsto hB hC hb hc hlim + exact hsum ▸ Set.add_mem_add hβ hξ + +/-- Berarducci, Section 7: a line `β + ξ = γ` meets `B × C` in finitely many points. -/ +theorem IsPWO.finite_sub_mem {B C : Set ℝ} (hB : B.IsPWO) (hC : C.IsPWO) (γ : ℝ) : + {β | β ∈ B ∧ γ - β ∈ C}.Finite := by + by_contra hinf + rw [Set.not_finite] at hinf + set e := hinf.natEmbedding with he + set u : ℕ → ℝ := fun n ↦ (e n : ℝ) with hu + have huInj : Function.Injective u := fun m n hmn ↦ e.injective (Subtype.ext hmn) + have huB : ∀ n, u n ∈ B := fun n ↦ (e n).2.1 + have huC : ∀ n, γ - u n ∈ C := fun n ↦ (e n).2.2 + obtain ⟨g, hg⟩ := hB.exists_monotone_subseq huB + set v : ℕ → ℝ := fun n ↦ u (g n) with hv + have hvMono : Monotone v := fun _ _ hmn ↦ hg hmn + have hvInj : Function.Injective v := huInj.comp g.injective + have hvStrict : StrictMono v := hvMono.strictMono_of_injective hvInj + have hwAnti : StrictAnti (fun n ↦ γ - v n) := fun _ _ hmn ↦ + sub_lt_sub_left (hvStrict hmn) γ + exact (Set.isWF_iff_no_descending_seq.mp hC.isWF) _ hwAnti fun n ↦ huC (g n) + +private theorem exists_pos_forall_le_abs_sub {S : Set ℝ} (hS : S.Finite) : + ∃ d > (0 : ℝ), ∀ β₁ ∈ S, ∀ β₂ ∈ S, + β₁ ≠ β₂ → d ≤ |β₁ - β₂| := by + classical + set T := hS.toFinset with hT + set P := (T ×ˢ T).filter fun p ↦ p.1 ≠ p.2 with hP + by_cases hPne : P.Nonempty + · refine ⟨P.inf' hPne fun p ↦ |p.1 - p.2|, ?_, ?_⟩ + · rw [gt_iff_lt, Finset.lt_inf'_iff] + intro p hp + have hne : p.1 ≠ p.2 := (Finset.mem_filter.mp hp).2 + exact abs_pos.mpr (sub_ne_zero.mpr hne) + · intro β₁ h₁ β₂ h₂ hne + have hmem : (β₁, β₂) ∈ P := by + simp only [hP, Finset.mem_filter, Finset.mem_product, hT, + Set.Finite.mem_toFinset] + exact ⟨⟨h₁, h₂⟩, hne⟩ + exact Finset.inf'_le (fun p ↦ |p.1 - p.2|) hmem + · refine ⟨1, one_pos, fun β₁ h₁ β₂ h₂ hne ↦ absurd ⟨(β₁, β₂), ?_⟩ hPne⟩ + simp only [hP, Finset.mem_filter, Finset.mem_product, hT, + Set.Finite.mem_toFinset] + exact ⟨⟨h₁, h₂⟩, hne⟩ + +private theorem eventually_unique_dominating {B C : Set ℝ} + (hB : B.IsPWO) (hC : C.IsPWO) (γ : ℝ) : + ∀ᶠ δ in 𝓝[≤] γ, ∀ β' ξ' : ℝ, β' + ξ' = δ → ∀ β₁ β₂ : ℝ, + (β₁ ∈ B ∧ γ - β₁ ∈ C ∧ β' ≤ β₁ ∧ ξ' ≤ γ - β₁) → + (β₂ ∈ B ∧ γ - β₂ ∈ C ∧ β' ≤ β₂ ∧ + ξ' ≤ γ - β₂) → + β₁ = β₂ := by + obtain ⟨d, hd, hgap⟩ := exists_pos_forall_le_abs_sub (hB.finite_sub_mem hC γ) + have hnear : ∀ᶠ δ in 𝓝[≤] γ, γ - d < δ := + eventually_nhdsWithin_of_eventually_nhds (eventually_gt_nhds (by linarith)) + filter_upwards [hnear] with δ hδ β' ξ' hsum β₁ β₂ h₁ h₂ + by_contra hne + have hd₁₂ : d ≤ |β₁ - β₂| := + hgap β₁ ⟨h₁.1, h₁.2.1⟩ β₂ ⟨h₂.1, h₂.2.1⟩ hne + rcases abs_cases (β₁ - β₂) with ⟨habs, _⟩ | ⟨habs, _⟩ + · have : δ ≤ γ - d := by + have h := h₂.2.2.1 + have h' := h₁.2.2.2 + rw [habs] at hd₁₂ + linarith + linarith + · have : δ ≤ γ - d := by + have h := h₁.2.2.1 + have h' := h₂.2.2.2 + rw [habs] at hd₁₂ + linarith + linarith + +private theorem eventually_exists_dominating {B C : Set ℝ} + (hB : B.IsPWO) (hC : C.IsPWO) (hBc : IsClosed B) (hCc : IsClosed C) (γ : ℝ) : + ∀ᶠ δ in 𝓝[≤] γ, ∀ β' ∈ B, ∀ ξ' ∈ C, β' + ξ' = δ → + ∃ β, β ∈ B ∧ γ - β ∈ C ∧ β' ≤ β ∧ ξ' ≤ γ - β := by + by_contra hcon + rw [not_eventually] at hcon + obtain ⟨δ, hδ, hδp⟩ := Filter.exists_seq_forall_of_frequently hcon + simp only [not_forall, not_exists] at hδp + choose b hb c hc hbc hno using hδp + have hlim : Tendsto (fun n ↦ b n + c n) atTop (𝓝 γ) := by + have hδγ : Tendsto δ atTop (𝓝 γ) := hδ.mono_right nhdsWithin_le_nhds + simpa only [hbc] using hδγ + obtain ⟨g, β, ξ, _, hβ, hξ, hsum, hble, hcle⟩ := + exists_monotone_limits_of_add_tendsto hB hC hb hc hlim + have hβB : β ∈ B := hBc.closure_eq ▸ hβ + have hξC : ξ ∈ C := hCc.closure_eq ▸ hξ + have hγβ : γ - β = ξ := by linarith + exact hno (g 0) β ⟨hβB, by rw [hγβ]; exact hξC, hble 0, by rw [hγβ]; exact hcle 0⟩ + +/-- Berarducci, Lemma 7.4: for `δ ≤ γ` sufficiently close to `γ`, every point of +`B × C` on the line of sum `δ` is dominated by exactly one point of `B × C` on the line of +sum `γ`. -/ +theorem IsPWO.eventually_existsUnique_dominating {B C : Set ℝ} + (hB : B.IsPWO) (hC : C.IsPWO) (hBc : IsClosed B) (hCc : IsClosed C) (γ : ℝ) : + ∀ᶠ δ in 𝓝[≤] γ, ∀ β' ∈ B, ∀ ξ' ∈ C, β' + ξ' = δ → + ∃! β, β ∈ B ∧ γ - β ∈ C ∧ β' ≤ β ∧ ξ' ≤ γ - β := by + filter_upwards [eventually_exists_dominating hB hC hBc hCc γ, + eventually_unique_dominating hB hC γ] with δ hex huniq β' hβ' ξ' hξ' hsum + obtain ⟨β, hβ⟩ := hex β' hβ' ξ' hξ' hsum + exact ⟨β, hβ, fun β₂ h₂ ↦ huniq β' ξ' hsum β₂ β h₂ hβ⟩ + +end Set diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SeparatedPieceFamily.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SeparatedPieceFamily.lean new file mode 100644 index 0000000000..fc9ad99e27 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SeparatedPieceFamily.lean @@ -0,0 +1,193 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonReconstruction + +/-! +# Local geometry of separated piece families + +A family of pieces, each carried by an open member of a pairwise ordered disjoint family of open +sets and bounded above by a center inside its own open carrier, is locally a single piece: at a +point of some carrier, that carrier isolates its piece; away from all carriers and from the +closure of the centers, an order interval avoiding the centers meets at most one piece, because a +piece meeting it forces its center inside. This replaces the half-open interval bookkeeping of +ordered interval families and applies to cosets of convex open subgroups at arbitrary +cofinality. +-/ + +open Set Filter Topology TopologicalSpace + +universe u v + +public noncomputable section + +variable {X : Type u} {ι : Type v} + [LinearOrder X] [TopologicalSpace X] [OrderTopology X] [NoMinOrder X] [NoMaxOrder X] + [LinearOrder ι] + +omit [TopologicalSpace X] [OrderTopology X] [NoMinOrder X] [NoMaxOrder X] in +/-- An order interval avoiding the centers meets at most one piece of a separated family. -/ +theorem subsingleton_pieces_of_Ioo_of_notMem_centers + (P : ι → Set X) (C : ι → Set X) (x : ι → X) + (hPC : ∀ i, P i ⊆ C i) (hPx : ∀ i, ∀ p ∈ P i, p ≤ x i) (hxC : ∀ i, x i ∈ C i) + (hord : ∀ i j, i < j → ∀ a ∈ C i, ∀ b ∈ C j, a < b) + {a b : X} (hab : ∀ y ∈ Ioo a b, y ∉ Set.range x) : + {i | (P i ∩ Ioo a b).Nonempty}.Subsingleton := by + intro i hi j hj + by_contra hne + rcases lt_or_gt_of_ne hne with hij | hji + · obtain ⟨p, hpP, hpa, hpb⟩ := hi + obtain ⟨q, hqP, hqa, hqb⟩ := hj + have hpx : p ≤ x i := hPx i p hpP + have hxq : x i < q := hord i j hij (x i) (hxC i) q (hPC j hqP) + exact hab (x i) ⟨hpa.trans_le hpx, hxq.trans hqb⟩ ⟨i, rfl⟩ + · obtain ⟨p, hpP, hpa, hpb⟩ := hi + obtain ⟨q, hqP, hqa, hqb⟩ := hj + have hqx : q ≤ x j := hPx j q hqP + have hxp : x j < p := hord j i hji (x j) (hxC j) p (hPC i hpP) + exact hab (x j) ⟨hqa.trans_le hqx, hxp.trans hpb⟩ ⟨j, rfl⟩ + +/-- Away from the closure of the centers, the closure of a separated piece union agrees locally +with the closure of a single piece. -/ +theorem exists_local_closure_eq_separated_pieces + (P : ι → Set X) (C : ι → Set X) (x : ι → X) + (hPC : ∀ i, P i ⊆ C i) (hPx : ∀ i, ∀ p ∈ P i, p ≤ x i) (hxC : ∀ i, x i ∈ C i) + (hCopen : ∀ i, IsOpen (C i)) + (hdisj : ∀ i j, i ≠ j → Disjoint (C i) (C j)) + (hord : ∀ i j, i < j → ∀ a ∈ C i, ∀ b ∈ C j, a < b) + {z : X} (hzcenter : z ∉ closure (Set.range x)) + (hz : z ∈ closure (⋃ i, P i)) : + ∃ i t, IsOpen t ∧ z ∈ t ∧ + closure (⋃ i, P i) ∩ t = closure (P i) ∩ t := by + classical + by_cases hzC : ∃ i, z ∈ C i + · obtain ⟨i, hzi⟩ := hzC + refine ⟨i, C i, hCopen i, hzi, (hCopen i).closure_congr ?_⟩ + ext y + constructor + · rintro ⟨hy, hyC⟩ + rw [Set.mem_iUnion] at hy + obtain ⟨j, hyj⟩ := hy + rcases eq_or_ne j i with rfl | hji + · exact ⟨hyj, hyC⟩ + · exact absurd hyC (Set.disjoint_left.mp (hdisj j i hji) (hPC j hyj)) + · rintro ⟨hyi, hyC⟩ + exact ⟨Set.mem_iUnion_of_mem i hyi, hyC⟩ + · rw [not_exists] at hzC + have hcompl : (closure (Set.range x))ᶜ ∈ 𝓝 z := + isClosed_closure.isOpen_compl.mem_nhds hzcenter + obtain ⟨a, b, ⟨haz, hzb⟩, hab⟩ := mem_nhds_iff_exists_Ioo_subset.mp hcompl + have habx : ∀ y ∈ Ioo a b, y ∉ Set.range x := fun y hy hyx ↦ + hab hy (subset_closure hyx) + have hsub := subsingleton_pieces_of_Ioo_of_notMem_centers P C x hPC hPx hxC hord habx + obtain ⟨p, hpu, hp⟩ := mem_closure_iff.mp hz (Ioo a b) isOpen_Ioo ⟨haz, hzb⟩ + rw [Set.mem_iUnion] at hp + obtain ⟨i, hpi⟩ := hp + have hi : i ∈ {j | (P j ∩ Ioo a b).Nonempty} := ⟨p, hpi, hpu⟩ + refine ⟨i, Ioo a b, isOpen_Ioo, ⟨haz, hzb⟩, isOpen_Ioo.closure_congr ?_⟩ + ext y + constructor + · rintro ⟨hy, hyu⟩ + rw [Set.mem_iUnion] at hy + obtain ⟨j, hyj⟩ := hy + have hj : j ∈ {k | (P k ∩ Ioo a b).Nonempty} := ⟨y, hyj, hyu⟩ + exact ⟨hsub hj hi ▸ hyj, hyu⟩ + · rintro ⟨hyi, hyu⟩ + exact ⟨Set.mem_iUnion_of_mem i hyi, hyu⟩ + +/-- When every piece closure stays inside its open carrier, the closure of the union is carried +by the carriers together with the closure of the centers. -/ +theorem closure_iUnion_subset_of_closure_piece_subset + (P : ι → Set X) (C : ι → Set X) (x : ι → X) + (hPC : ∀ i, P i ⊆ C i) (hPx : ∀ i, ∀ p ∈ P i, p ≤ x i) (hxC : ∀ i, x i ∈ C i) + (hCopen : ∀ i, IsOpen (C i)) + (hdisj : ∀ i j, i ≠ j → Disjoint (C i) (C j)) + (hord : ∀ i j, i < j → ∀ a ∈ C i, ∀ b ∈ C j, a < b) + (hclP : ∀ i, closure (P i) ⊆ C i) : + closure (⋃ i, P i) ⊆ (⋃ i, C i) ∪ closure (Set.range x) := by + intro z hz + by_cases hzc : z ∈ closure (Set.range x) + · exact Or.inr hzc + · obtain ⟨i, t, -, hzt, heq⟩ := + exists_local_closure_eq_separated_pieces P C x hPC hPx hxC hCopen hdisj hord hzc hz + have hzi : z ∈ closure (P i) := ((Set.ext_iff.mp heq z).mp ⟨hz, hzt⟩).1 + exact Or.inl (Set.mem_iUnion_of_mem i (hclP i hzi)) + +/-- If a derivative stage of every piece is supported at its center, the same stage of the +separated union is supported on the closure of the centers. -/ +theorem cantorBendixson_separated_iUnion_subset_closure_range + (P : ι → Set X) (C : ι → Set X) (x : ι → X) + (hPC : ∀ i, P i ⊆ C i) (hPx : ∀ i, ∀ p ∈ P i, p ≤ x i) (hxC : ∀ i, x i ∈ C i) + (hCopen : ∀ i, IsOpen (C i)) + (hdisj : ∀ i j, i ≠ j → Disjoint (C i) (C j)) + (hord : ∀ i j, i < j → ∀ a ∈ C i, ∀ b ∈ C j, a < b) + (o : Ordinal.{u}) + (hstage : ∀ i, ((⟨closure (P i), isClosed_closure⟩ : Closeds X).cantorBendixson o : + Set X) ⊆ {x i}) : + ((⟨closure (⋃ i, P i), isClosed_closure⟩ : Closeds X).cantorBendixson o : Set X) ⊆ + closure (Set.range x) := by + intro z hz + by_contra hzcenter + have hzunion : z ∈ closure (⋃ i, P i) := + (⟨closure (⋃ i, P i), isClosed_closure⟩ : Closeds X).cantorBendixson_le o hz + obtain ⟨i, t, htopen, hzt, heq⟩ := + exists_local_closure_eq_separated_pieces P C x hPC hPx hxC hCopen hdisj hord hzcenter hzunion + let s : Closeds X := ⟨closure (⋃ i, P i), isClosed_closure⟩ + let q : Closeds X := ⟨closure (P i), isClosed_closure⟩ + have hcongr := TopologicalSpace.Closeds.cantorBendixson_congr_on_open s q htopen heq o + have hm := (Set.ext_iff.mp hcongr z).mp ⟨hz, hzt⟩ + have hzc : z = x i := Set.mem_singleton_iff.mp (hstage i hm.1) + exact hzcenter (subset_closure ⟨i, hzc.symm⟩) + +omit [NoMinOrder X] [NoMaxOrder X] [LinearOrder ι] in +/-- On its own open carrier, a derivative stage of the separated union agrees with that stage of +the single piece carried there. -/ +theorem cantorBendixson_inter_piece_eq + (P : ι → Set X) (C : ι → Set X) + (hPC : ∀ i, P i ⊆ C i) + (hCopen : ∀ i, IsOpen (C i)) + (hdisj : ∀ i j, i ≠ j → Disjoint (C i) (C j)) + (i : ι) (o : Ordinal.{u}) : + ((⟨closure (⋃ j, P j), isClosed_closure⟩ : Closeds X).cantorBendixson o : Set X) ∩ C i = + ((⟨closure (P i), isClosed_closure⟩ : Closeds X).cantorBendixson o : Set X) ∩ C i := by + have hinter : (⋃ j, P j) ∩ C i = P i ∩ C i := by + ext y + constructor + · rintro ⟨hy, hyC⟩ + rw [Set.mem_iUnion] at hy + obtain ⟨j, hyj⟩ := hy + rcases eq_or_ne j i with rfl | hji + · exact ⟨hyj, hyC⟩ + · exact absurd hyC (Set.disjoint_left.mp (hdisj j i hji) (hPC j hyj)) + · rintro ⟨hyi, hyC⟩ + exact ⟨Set.mem_iUnion_of_mem i hyi, hyC⟩ + exact TopologicalSpace.Closeds.cantorBendixson_congr_on_open _ _ (hCopen i) + ((hCopen i).closure_congr hinter) o + +/-- If every piece of a separated family has an empty stage, that stage of the union is carried +by the closure of the centers with the centers themselves removed. -/ +theorem cantorBendixson_separated_iUnion_subset_of_stage_empty + (P : ι → Set X) (C : ι → Set X) (x : ι → X) + (hPC : ∀ i, P i ⊆ C i) (hPx : ∀ i, ∀ p ∈ P i, p ≤ x i) (hxC : ∀ i, x i ∈ C i) + (hCopen : ∀ i, IsOpen (C i)) + (hdisj : ∀ i j, i ≠ j → Disjoint (C i) (C j)) + (hord : ∀ i j, i < j → ∀ a ∈ C i, ∀ b ∈ C j, a < b) + (o : Ordinal.{u}) + (hstage : ∀ i, ((⟨closure (P i), isClosed_closure⟩ : Closeds X).cantorBendixson o : + Set X) = ∅) : + ((⟨closure (⋃ i, P i), isClosed_closure⟩ : Closeds X).cantorBendixson o : Set X) ⊆ + closure (Set.range x) \ Set.range x := by + intro z hz + refine ⟨cantorBendixson_separated_iUnion_subset_closure_range P C x hPC hPx hxC hCopen hdisj + hord o (fun i ↦ by rw [hstage i]; exact Set.empty_subset _) hz, ?_⟩ + rintro ⟨i, rfl⟩ + have hmem : x i ∈ ((⟨closure (P i), isClosed_closure⟩ : Closeds X).cantorBendixson o : + Set X) ∩ C i := by + rw [← cantorBendixson_inter_piece_eq P C hPC hCopen hdisj i o] + exact ⟨hz, hxC i⟩ + rw [hstage i] at hmem + exact absurd hmem.1 (Set.notMem_empty _) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SmallClosedSubspace.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SmallClosedSubspace.lean new file mode 100644 index 0000000000..f8fbdeb942 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SmallClosedSubspace.lean @@ -0,0 +1,227 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedAddGroup +public import Mathlib.Algebra.Order.Module.Rat +public import Mathlib.Algebra.Module.Torsion.Field +public import Mathlib.LinearAlgebra.Finsupp.LinearCombination +public import Mathlib.SetTheory.Cardinal.Finsupp +public import Mathlib.SetTheory.Cardinal.Rat +public import Mathlib.Topology.Algebra.Module.Basic + +import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint + +/-! +# Supports in closed rational subspaces + +Density of a rational span in its closure bounds every well-ordered subset of the closure by the +cardinality of the original span. This keeps supports produced by Cantor–Bendixson germ refinement +below a prescribed cardinal without bounding the whole closed subspace. +-/ + +open Set +open Cardinal + +universe u + +public noncomputable section + +namespace Submodule + +variable {C : Type u} [AddCommGroup C] [LinearOrder C] [IsOrderedAddMonoid C] + [Module ℚ C] [PosSMulMono ℚ C] + [TopologicalSpace C] [OrderTopology C] [IsTopologicalAddGroup C] + [DenselyOrdered C] + +local instance : PosSMulStrictMono ℚ C := PosSMulMono.toPosSMulStrictMono + +omit [IsOrderedAddMonoid C] in +/-- Rational scalar multiplication is continuous in the order topology of an ordered rational +vector space. -/ +theorem continuous_rat_smul (q : ℚ) : Continuous fun x : C ↦ q • x := by + rcases lt_trichotomy q 0 with hq | hq | hq + · have hpos : 0 < -q := neg_pos.mpr hq + have hcont : Continuous fun x : C ↦ (-q) • x := by + apply Monotone.continuous_of_surjective + · intro x y hxy + exact smul_le_smul_of_nonneg_left hxy hpos.le + · intro y + refine ⟨(-q)⁻¹ • y, ?_⟩ + change (-q) • ((-q)⁻¹ • y) = y + rw [smul_smul, mul_inv_cancel₀ hpos.ne', one_smul] + convert continuous_neg.comp hcont using 1 + funext x + simp + · subst q + simpa using (continuous_const : Continuous fun _ : C ↦ (0 : C)) + · apply Monotone.continuous_of_surjective + · intro x y hxy + exact smul_le_smul_of_nonneg_left hxy hq.le + · intro y + refine ⟨q⁻¹ • y, ?_⟩ + change q • (q⁻¹ • y) = y + rw [smul_smul, mul_inv_cancel₀ hq.ne', one_smul] + +instance instContinuousConstSMulRat : ContinuousConstSMul ℚ C := + ⟨continuous_rat_smul⟩ + +/-- Distinct points in the closed rational span are separated by a point of the original span. -/ +theorem exists_span_between_of_ne (S : Set C) + (x y : (span ℚ S).topologicalClosure) (hxy : x ≠ y) : + ∃ z : span ℚ S, (x : C) < z ∧ (z : C) < y ∨ + (y : C) < z ∧ (z : C) < x := by + let P := span ℚ S + rcases lt_or_gt_of_ne (Subtype.coe_ne_coe.mpr hxy) with hxy' | hyx' + · let m : C := (2 : ℚ)⁻¹ • ((x : C) + (y : C)) + have hm : m ∈ closure (P : Set C) := by + have hm' : m ∈ P.topologicalClosure := by + simpa [m] using P.topologicalClosure.smul_mem ((2 : ℚ)⁻¹) + (P.topologicalClosure.add_mem x.2 y.2) + rw [← topologicalClosure_coe] + exact hm' + have hxm : (x : C) < m := by + dsimp [m] + calc + (x : C) = (2 : ℚ)⁻¹ • ((x : C) + (x : C)) := by + rw [smul_add, ← add_smul] + norm_num + _ < (2 : ℚ)⁻¹ • ((x : C) + (y : C)) := + smul_lt_smul_of_pos_left + (add_lt_add_left hxy' (x : C) |>.trans_eq (add_comm _ _)) (by norm_num) + have hmy : m < (y : C) := by + dsimp [m] + calc + (2 : ℚ)⁻¹ • ((x : C) + (y : C)) < + (2 : ℚ)⁻¹ • ((y : C) + (y : C)) := + smul_lt_smul_of_pos_left + (by simpa [add_comm] using (add_lt_add_left hxy' (y : C))) (by norm_num) + _ = (y : C) := by + rw [smul_add, ← add_smul] + norm_num + obtain ⟨z, hzI, hzP⟩ := + mem_closure_iff.mp hm (Ioo (x : C) (y : C)) isOpen_Ioo ⟨hxm, hmy⟩ + exact ⟨⟨z, hzP⟩, Or.inl hzI⟩ + · let m : C := (2 : ℚ)⁻¹ • ((y : C) + (x : C)) + have hm : m ∈ closure (P : Set C) := by + have hm' : m ∈ P.topologicalClosure := by + simpa [m] using P.topologicalClosure.smul_mem ((2 : ℚ)⁻¹) + (P.topologicalClosure.add_mem y.2 x.2) + rw [← topologicalClosure_coe] + exact hm' + have hym : (y : C) < m := by + dsimp [m] + calc + (y : C) = (2 : ℚ)⁻¹ • ((y : C) + (y : C)) := by + rw [smul_add, ← add_smul] + norm_num + _ < (2 : ℚ)⁻¹ • ((y : C) + (x : C)) := + smul_lt_smul_of_pos_left + (add_lt_add_left hyx' (y : C) |>.trans_eq (add_comm _ _)) (by norm_num) + have hmx : m < (x : C) := by + dsimp [m] + calc + (2 : ℚ)⁻¹ • ((y : C) + (x : C)) < + (2 : ℚ)⁻¹ • ((x : C) + (x : C)) := + smul_lt_smul_of_pos_left + (by simpa [add_comm] using (add_lt_add_left hyx' (x : C))) (by norm_num) + _ = (x : C) := by + rw [smul_add, ← add_smul] + norm_num + obtain ⟨z, hzI, hzP⟩ := + mem_closure_iff.mp hm (Ioo (y : C) (x : C)) isOpen_Ioo ⟨hym, hmx⟩ + exact ⟨⟨z, hzP⟩, Or.inr hzI⟩ + +/-- Every well-ordered subset of the closed rational span of a small nonempty set is small. -/ +@[blueprint "lem:well-ordered-subset-closed-rational-span-cardinality" + (phase := "Refinement over Archimedean classes") + (title := "Well-ordered subsets of closed rational spans") + (statement := /-- + Let $C$ be a densely ordered rational vector space with its order topology, + let $\kappa>\aleph_0$, and let $S\subseteq C$ be nonempty with + $\#S<\kappa$. Every well-ordered subset of the topological closure of + $\operatorname{span}_{\mathbb Q}(S)$ has cardinality less than $\kappa$. + -/) + (proof := /-- + For each nonmaximal point $x$ of the well-ordered subset, let $x^+$ be its + successor and choose a point of $\operatorname{span}_{\mathbb Q}(S)$ + strictly between $x$ and $x^+$. The resulting intervals are disjoint, so + this choice is injective; the possible maximum accounts for one additional + point. Hence the subset has cardinality at most + $\#\operatorname{span}_{\mathbb Q}(S)+1$. Finite rational linear + combinations identify the latter span with a subset of + $S\to_0\mathbb Q$, whose cardinality is + $\max\{\#S,\aleph_0\}<\kappa$. + -/)] +theorem mk_lt_of_isPWO_topologicalClosure_span + {κ : Cardinal.{u}} [Fact (ℵ₀ < κ)] + (S : Set C) (hS : #S < κ) (hSne : S.Nonempty) + (W : Set (span ℚ S).topologicalClosure) (hW : W.IsPWO) : + #W < κ := by + let upper (x : W) : Set (span ℚ S).topologicalClosure := W ∩ Set.Ioi x + have upperWF (x : W) : (upper x).IsWF := hW.isWF.mono Set.inter_subset_left + let next (x : W) (h : (upper x).Nonempty) : W := + ⟨(upperWF x).min h, ((upperWF x).min_mem h).1⟩ + have lt_next (x : W) (h : (upper x).Nonempty) : x < next x h := + ((upperWF x).min_mem h).2 + have exists_between_span (x : W) (h : (upper x).Nonempty) : + ∃ z : span ℚ S, (x : C) < z ∧ (z : C) < next x h := by + have hne : + (x : (span ℚ S).topologicalClosure) ≠ + (next x h : (span ℚ S).topologicalClosure) := by + intro hxy + exact (lt_next x h).ne (Subtype.ext hxy) + obtain ⟨z, hz | hz⟩ := exists_span_between_of_ne S x (next x h) hne + · exact ⟨z, hz⟩ + · exact ((show (x : C) < next x h by exact lt_next x h).asymm + (hz.1.trans hz.2)).elim + let between (x : W) (h : (upper x).Nonempty) : span ℚ S := + Classical.choose (exists_between_span x h) + have between_spec (x : W) (h : (upper x).Nonempty) : + (x : C) < between x h ∧ (between x h : C) < next x h := by + exact Classical.choose_spec (exists_between_span x h) + classical + let f : W → (span ℚ S) ⊕ Unit := fun x ↦ + if h : (upper x).Nonempty then Sum.inl (between x h) else Sum.inr () + have hf : Function.Injective f := by + have f_ne_of_lt {x y : W} (hxy : x < y) : f x ≠ f y := by + have hx : (upper x).Nonempty := ⟨y, y.2, hxy⟩ + by_cases hy : (upper y).Nonempty + · intro heq + have heq' : between x hx = between y hy := by + simpa only [f, dif_pos hx, dif_pos hy, Sum.inl.injEq] using heq + have hnle : next x hx ≤ y := (upperWF x).min_le hx ⟨y.2, hxy⟩ + have hlt : (between x hx : C) < between y hy := by + calc + (between x hx : C) < next x hx := (between_spec x hx).2 + _ ≤ y := hnle + _ < between y hy := (between_spec y hy).1 + exact hlt.ne (congrArg Subtype.val heq') + · simp [f, hx, hy] + intro x y hxy + by_contra hne + rcases lt_or_gt_of_ne hne with hlt | hgt + · exact f_ne_of_lt hlt hxy + · exact f_ne_of_lt hgt hxy.symm + have hspan : #(span ℚ S) < κ := by + letI : Nonempty S := hSne.to_subtype + have hinj : Function.Injective (Span.repr ℚ S) := by + intro x y hxy + apply Subtype.ext + have := congrArg (Finsupp.linearCombination ℚ ((↑) : S → C)) hxy + simpa using this + calc + #(span ℚ S) ≤ #(S →₀ ℚ) := Cardinal.mk_le_of_injective hinj + _ = max #S ℵ₀ := by + simp + _ < κ := max_lt hS Fact.out + calc + #W ≤ #(span ℚ S) + 1 := by + simpa using Cardinal.mk_le_of_injective hf + _ < κ := Cardinal.add_lt_of_lt (Fact.out : ℵ₀ < κ).le hspan + (Cardinal.one_lt_aleph0.trans Fact.out) + +end Submodule diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests.lean new file mode 100644 index 0000000000..0c101d6e4b --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests.CantorBendixsonConvexCover +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests.PWOAddition + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/CantorBendixsonConvexCover.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/CantorBendixsonConvexCover.lean new file mode 100644 index 0000000000..8eab3b4078 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/CantorBendixsonConvexCover.lean @@ -0,0 +1,235 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonConvexCover +public import Mathlib.Algebra.Order.Group.PiLex +public import Mathlib.Data.Real.Basic +public import Mathlib.Topology.Instances.Real.Lemmas +import Mathlib.Order.Interval.Set.OrdConnected + +/-! +# The Cantor–Bendixson convex cover has a nondegenerate model + +The partition hypotheses require a nested well-ordered neighborhood base at zero consisting of +open convex subgroups. The real line does not satisfy them: its only convex subgroups are zero +and the whole line, and zero is not open. Any witness is therefore non-Archimedean, and this file +supplies one: real sequences indexed by the naturals under the lexicographic order, with the +subgroups of sequences vanishing below a given index. + +Those subgroups are nested, convex, open, and coinitial, so the hypotheses are consistent and the +geometric part of the cofactor construction is not vacuous. The check also separates the openness +requirement from the trivial family: the zero subgroup alone satisfies every other condition. +-/ + +public noncomputable section + +open Set + +namespace Tests.CantorBendixsonConvexCover + +/-- Real sequences under the lexicographic order: a non-Archimedean ordered abelian group. -/ +abbrev LexSeq := Lex (ℕ → ℝ) + +/-- The entries of a lexicographic sequence. -/ +abbrev entry (x : LexSeq) (k : ℕ) : ℝ := ofLex x k + +theorem entry_add (x y : LexSeq) (k : ℕ) : + entry (x + y) k = entry x k + entry y k := (rfl) + +theorem entry_neg (x : LexSeq) (k : ℕ) : entry (-x) k = -entry x k := (rfl) + +theorem entry_zero (k : ℕ) : entry (0 : LexSeq) k = 0 := (rfl) + +theorem entry_sub (x y : LexSeq) (k : ℕ) : + entry (x - y) k = entry x k - entry y k := (rfl) + +theorem lt_of_forall_eq_of_lt {x y : LexSeq} {m : ℕ} + (h : ∀ j < m, entry x j = entry y j) (hm : entry x m < entry y m) : x < y := + ⟨m, h, hm⟩ + +instance : TopologicalSpace LexSeq := Preorder.topology LexSeq + +instance : OrderTopology LexSeq := ⟨rfl⟩ + +/-- The subgroup of sequences vanishing below a given index. -/ +def vanishingBelow (n : ℕ) : AddSubgroup LexSeq where + carrier := {x : LexSeq | ∀ k < n, entry x k = 0} + zero_mem' := fun _ _ ↦ rfl + add_mem' hx hy := fun k hk ↦ by + rw [entry_add, hx k hk, hy k hk, add_zero] + neg_mem' hx := fun k hk ↦ by + rw [entry_neg, hx k hk, neg_zero] + +@[simp] +theorem mem_vanishingBelow {n : ℕ} {x : LexSeq} : + x ∈ vanishingBelow n ↔ ∀ k < n, entry x k = 0 := (Iff.rfl) + +/-- The witnessing family is nested and decreasing. -/ +theorem vanishingBelow_mono {i j : ℕ} (hij : i ≤ j) : + (vanishingBelow j : Set LexSeq) ⊆ (vanishingBelow i : Set LexSeq) := + fun _ hx k hk ↦ hx k (hk.trans_le hij) + +/-- The least index at which a nonzero sequence does not vanish. -/ +theorem exists_least_ne_zero {c : LexSeq} {k : ℕ} (hne : entry c k ≠ 0) : + ∃ m, entry c m ≠ 0 ∧ ∀ j < m, entry c j = 0 := by + classical + have hex : ∃ m, entry c m ≠ 0 := ⟨k, hne⟩ + exact ⟨Nat.find hex, Nat.find_spec hex, fun j hj ↦ not_not.mp (Nat.find_min hex hj)⟩ + +/-- Each subgroup of the family is convex: a sequence between two vanishing ones has no earlier +nonzero entry, since a positive one would exceed the upper bound and a negative one would fall +below the lower bound. -/ +theorem vanishingBelow_ordConnected (n : ℕ) : + ((vanishingBelow n : AddSubgroup LexSeq) : Set LexSeq).OrdConnected := by + constructor + intro a ha b hb c hc k hk + by_contra hne + obtain ⟨m, hm, hmin⟩ := exists_least_ne_zero hne + have hmn : m < n := by + by_contra hmn + exact hne (hmin k (lt_of_lt_of_le hk (not_lt.mp hmn))) + rcases lt_trichotomy (entry c m) 0 with hneg | hzero | hpos + · have hca : c < a := + lt_of_forall_eq_of_lt (fun j hj ↦ by + rw [hmin j hj, ha j (hj.trans hmn)]) (by rw [ha m hmn]; exact hneg) + exact absurd hc.1 (not_le.mpr hca) + · exact hm hzero + · have hbc : b < c := + lt_of_forall_eq_of_lt (fun j hj ↦ by + rw [hb j (hj.trans hmn), hmin j hj]) (by rw [hb m hmn]; exact hpos) + exact absurd hc.2 (not_le.mpr hbc) + +/-- The indicator sequence with a single unit entry. -/ +def unitAt (n : ℕ) : LexSeq := toLex (fun k ↦ if k = n then (1 : ℝ) else 0) + +theorem entry_unitAt (n k : ℕ) : entry (unitAt n) k = if k = n then (1 : ℝ) else 0 := (rfl) + +theorem unitAt_pos (n : ℕ) : 0 < unitAt n := by + refine lt_of_forall_eq_of_lt (m := n) (fun j hj ↦ ?_) ?_ + · rw [entry_unitAt, if_neg hj.ne] + rfl + · rw [entry_unitAt, if_pos rfl] + exact zero_lt_one + +/-- Every sequence vanishing below an index lies strictly between the negative and positive unit +sequences at that index, so each subgroup of the family contains a neighborhood of zero and is +therefore open. -/ +theorem vanishingBelow_subset_Ioo (n : ℕ) : + ((vanishingBelow (n + 1) : AddSubgroup LexSeq) : Set LexSeq) ⊆ + Ioo (-unitAt n) (unitAt n) := by + intro x hx + constructor + · refine lt_of_forall_eq_of_lt (m := n) (fun j hj ↦ ?_) ?_ + · rw [entry_neg, entry_unitAt, if_neg hj.ne, neg_zero, + hx j (hj.trans (Nat.lt_succ_self n))] + · rw [entry_neg, entry_unitAt, if_pos rfl, hx n (Nat.lt_succ_self n)] + norm_num + · refine lt_of_forall_eq_of_lt (m := n) (fun j hj ↦ ?_) ?_ + · rw [entry_unitAt, if_neg hj.ne, hx j (hj.trans (Nat.lt_succ_self n))] + · rw [entry_unitAt, if_pos rfl, hx n (Nat.lt_succ_self n)] + exact zero_lt_one + +theorem vanishingBelow_isOpen (n : ℕ) : + IsOpen ((vanishingBelow n : AddSubgroup LexSeq) : Set LexSeq) := by + rw [isOpen_iff_mem_nhds] + intro x hx + have hsub : Ioo (x - unitAt n) (x + unitAt n) ⊆ + ((vanishingBelow n : AddSubgroup LexSeq) : Set LexSeq) := by + intro y hy + have hmem : y - x ∈ Ioo (-unitAt n) (unitAt n) := by + constructor + · rw [lt_sub_iff_add_lt] + have h1 := hy.1 + rw [sub_eq_neg_add] at h1 + exact h1 + · rw [sub_lt_iff_lt_add] + have h2 := hy.2 + rw [add_comm] at h2 + exact h2 + -- Convexity of the subgroup transfers membership from `x` to `y`. + have hyx : y = x + (y - x) := by abel + rw [hyx] + refine AddSubgroup.add_mem _ hx ?_ + intro k hk + by_contra hne + obtain ⟨m, hm, hmin⟩ := exists_least_ne_zero hne + have hmn : m < n := by + by_contra hmn + exact hne (hmin k (lt_of_lt_of_le hk (not_lt.mp hmn))) + rcases lt_trichotomy (entry (y - x) m) 0 with hneg | hzero | hpos + · refine absurd hmem.1 (not_lt.mpr (le_of_lt (lt_of_forall_eq_of_lt (m := m) + (fun j hj ↦ ?_) ?_))) + · rw [hmin j hj, entry_neg, entry_unitAt, if_neg (by omega), neg_zero] + · rw [entry_neg, entry_unitAt, if_neg (by omega), neg_zero] + exact hneg + · exact hm hzero + · refine absurd hmem.2 (not_lt.mpr (le_of_lt (lt_of_forall_eq_of_lt (m := m) + (fun j hj ↦ ?_) ?_))) + · rw [entry_unitAt, if_neg (by omega), hmin j hj] + · rw [entry_unitAt, if_neg (by omega)] + exact hpos + exact Filter.mem_of_superset + (Ioo_mem_nhds (sub_lt_self x (unitAt_pos n)) (lt_add_of_pos_right x (unitAt_pos n))) hsub + +/-- The family is coinitial: every strictly positive sequence dominates one of its members. -/ +theorem exists_vanishingBelow_subset_Ioo {ε : LexSeq} (hε : 0 < ε) : + ∃ n : ℕ, ((vanishingBelow n : AddSubgroup LexSeq) : Set LexSeq) ⊆ Ioo (-ε) ε := by + obtain ⟨p, hpz, hpos⟩ := hε + have hpz' : ∀ j < p, entry ε j = 0 := fun j hj ↦ (hpz j hj).symm + have hpos' : (0 : ℝ) < entry ε p := hpos + refine ⟨p + 1, fun x hx ↦ ⟨?_, ?_⟩⟩ + · refine lt_of_forall_eq_of_lt (m := p) (fun j hj ↦ ?_) ?_ + · rw [entry_neg, hpz' j hj, neg_zero, hx j (hj.trans (Nat.lt_succ_self p))] + · rw [entry_neg, hx p (Nat.lt_succ_self p)] + linarith + · refine lt_of_forall_eq_of_lt (m := p) (fun j hj ↦ ?_) ?_ + · rw [hx j (hj.trans (Nat.lt_succ_self p)), hpz' j hj] + · rw [hx p (Nat.lt_succ_self p)] + exact hpos' + +instance : NoMinOrder LexSeq := + ⟨fun x ↦ ⟨x - unitAt 0, sub_lt_self x (unitAt_pos 0)⟩⟩ + +instance : NoMaxOrder LexSeq := + ⟨fun x ↦ ⟨x + unitAt 0, lt_add_of_pos_right x (unitAt_pos 0)⟩⟩ + +/-- **The cover hypotheses are consistent.** Every hypothesis of the disjoint convex cover theorem +holds for the lexicographic sequence group with the vanishing-below family, so the result is not +vacuous. -/ +theorem exists_disjoint_convex_cover_with_rank_lt_center_lexSeq + (s : TopologicalSpace.Closeds LexSeq) (hs : (s : Set LexSeq).IsPWO) : + ∃ (X : Set LexSeq) (C : X → Set LexSeq), + X ⊆ (s : Set LexSeq) ∧ + (∀ x : X, (x : LexSeq) ∈ C x) ∧ + (∀ x : X, IsOpen (C x)) ∧ + (∀ x : X, (C x).OrdConnected) ∧ + (∀ x y : X, x ≠ y → Disjoint (C x) (C y)) ∧ + (∀ x y : X, (x : LexSeq) < (y : LexSeq) → ∀ a ∈ C x, ∀ b ∈ C y, a < b) ∧ + ((s : Set LexSeq) ⊆ ⋃ x : X, C x) ∧ + (∀ x : X, ∀ z ∈ (s : Set LexSeq) ∩ C x, z ≤ (x : LexSeq)) ∧ + (∀ x : X, ∀ z ∈ (s : Set LexSeq) ∩ C x, z ≠ (x : LexSeq) → + s.cantorBendixsonRank hs z < s.cantorBendixsonRank hs (x : LexSeq)) ∧ + (∀ z : LexSeq, ¬ AccPt z (Filter.principal X)) := + TopologicalSpace.Closeds.exists_disjoint_convex_cover_with_rank_lt_center s hs vanishingBelow + (fun hij ↦ vanishingBelow_mono hij) vanishingBelow_isOpen vanishingBelow_ordConnected + (fun _ hε ↦ exists_vanishingBelow_subset_Ioo hε) + +/-- The real line is not a witness: its only convex subgroups are zero and the whole line, and +zero is not open, so no family of open convex subgroups is a neighborhood base at zero. The +openness requirement is therefore doing real work. -/ +theorem not_isOpen_bot_real : ¬ IsOpen ((⊥ : AddSubgroup ℝ) : Set ℝ) := by + intro h + have hmem : (0 : ℝ) ∈ ((⊥ : AddSubgroup ℝ) : Set ℝ) := (⊥ : AddSubgroup ℝ).zero_mem + obtain ⟨ε, hε, hsub⟩ := Metric.isOpen_iff.mp h 0 hmem + have hlt : ε / 2 ∈ Metric.ball (0 : ℝ) ε := by + rw [Metric.mem_ball, Real.dist_eq, sub_zero, abs_of_pos (by linarith)] + linarith + have hb : ε / 2 ∈ (⊥ : AddSubgroup ℝ) := hsub hlt + rw [AddSubgroup.mem_bot] at hb + linarith + +end Tests.CantorBendixsonConvexCover diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/PWOAddition.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/PWOAddition.lean new file mode 100644 index 0000000000..32b0851e08 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/PWOAddition.lean @@ -0,0 +1,1035 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAddition +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Additive +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Truncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Convolution +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Multiplication +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Leibniz +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Power +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Cancellation +public import + LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValueMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Germ +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Graded +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Scalar +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.GlobalCofactors +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Lifts +import Mathlib.Algebra.MvPolynomial.CommRing +import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import Mathlib.Topology.DerivedSet +public import Mathlib.Topology.Instances.Real.Lemmas +import Mathlib.Analysis.SpecificLimits.Basic + +/-! +# Addition on a support with an accumulation point + +The closed support generated by the negative reciprocal sequence has an accumulation point at +zero. Addition on its square is proper and has a finite noninjective fiber. This excludes both +a finite-support substitute for well-ordering and an injectivity substitute for finite fibers. +The empty-support case separately exercises the degenerate domain. +-/ + +public noncomputable section + +open Set Filter Topology HahnSeries + +namespace Tests.PWOAddition + +/-- The increasing negative reciprocal sequence converging to zero. -/ +def negRecip (n : ℕ) : ℝ := -(1 / ((n : ℝ) + 1)) + +@[simp] +theorem negRecip_apply (n : ℕ) : + negRecip n = -(1 / ((n : ℝ) + 1)) := (rfl) + +private theorem negRecip_strictMono : StrictMono negRecip := by + intro m n hmn + simp only [negRecip_apply] + apply neg_lt_neg + exact one_div_lt_one_div_of_lt (by positivity) (by exact_mod_cast Nat.add_lt_add_right hmn 1) + +private theorem negRecip_pwo : (range negRecip).IsPWO := by + simpa only [image_univ] using + (Set.isPWO_of_wellQuasiOrderedLE (univ : Set ℕ)).image_of_monotoneOn + (negRecip_strictMono.monotone.monotoneOn _) + +private theorem negRecip_tendsto : Tendsto negRecip atTop (𝓝 (0 : ℝ)) := by + simpa only [← funext negRecip_apply, neg_zero] using + (tendsto_one_div_add_atTop_nhds_zero_nat (𝕜 := ℝ)).neg + +/-- The test support is not discrete: zero is an accumulation point. -/ +theorem accumulation : (0 : ℝ) ∈ derivedSet (closure (range negRecip)) := by + apply mem_derivedSet.mpr + apply accPt_iff_nhds.mpr + intro U hU + have he : ∀ᶠ n in atTop, negRecip n ∈ U := negRecip_tendsto hU + obtain ⟨n, hn⟩ := he.exists + refine ⟨negRecip n, ⟨hn, subset_closure (mem_range_self n)⟩, ?_⟩ + simp only [negRecip_apply] + exact neg_ne_zero.mpr (one_div_ne_zero (by positivity)) + +/-- The proper-map theorem applies to a support with a genuine accumulation point. -/ +theorem proper_add : + IsProperMap (fun p : closure (range negRecip) ×ˢ closure (range negRecip) ↦ p.1.1 + p.1.2) := + negRecip_pwo.closure.isProperMap_add negRecip_pwo.closure isClosed_closure isClosed_closure + +/-- The addition fiber is finite although addition is not injective on the support square. -/ +theorem finite_noninjective_fiber : + let s := closure (range negRecip) + let f := fun p : s ×ˢ s ↦ p.1.1 + p.1.2 + (f ⁻¹' {negRecip 0 + negRecip 1}).Finite ∧ ¬Function.Injective f := by + dsimp only + refine ⟨negRecip_pwo.closure.finite_subtype_add_fiber negRecip_pwo.closure _, ?_⟩ + intro hinj + let p : closure (range negRecip) ×ˢ closure (range negRecip) := + ⟨(negRecip 0, negRecip 1), subset_closure (mem_range_self 0), subset_closure (mem_range_self 1)⟩ + let q : closure (range negRecip) ×ˢ closure (range negRecip) := + ⟨(negRecip 1, negRecip 0), subset_closure (mem_range_self 1), subset_closure (mem_range_self 0)⟩ + have he : p = q := hinj (by exact add_comm _ _) + have hfst : negRecip 0 = negRecip 1 := congrArg (fun p ↦ p.1.1) he + exact (negRecip_strictMono (by decide : 0 < 1)).ne hfst + +/-- Empty supports are permitted by the proper-map statement. -/ +theorem empty_left : IsProperMap (fun p : (∅ : Set ℝ) ×ˢ closure (range negRecip) ↦ + p.1.1 + p.1.2) := + Set.isPWO_empty.isProperMap_add negRecip_pwo.closure isClosed_empty isClosed_closure + +/-- A Hahn series with coefficient one on the negative reciprocal sequence and zero elsewhere. -/ +def accumulatingSeries : HahnSeries ℝ ℚ := by + classical + exact ⟨fun x ↦ if x ∈ range negRecip then 1 else 0, by + simpa only [Function.support, ne_eq, ite_eq_right_iff, one_ne_zero, imp_false, not_not, + Set.setOf_mem_eq] + using negRecip_pwo⟩ + +open Classical in +@[simp] +theorem accumulatingSeries_coeff (x : ℝ) : + accumulatingSeries.coeff x = if x ∈ range negRecip then 1 else 0 := by + classical + rfl + +@[simp] +theorem accumulatingSeries_support : accumulatingSeries.support = range negRecip := by + classical + ext x + simp only [HahnSeries.mem_support, accumulatingSeries_coeff, ne_eq, ite_eq_right_iff, + one_ne_zero, imp_false, not_not] + +/-- A genuine infinite Hahn support has positive rank at zero and value at least `omega`. -/ +theorem accumulatingSeries_positive_rank : + 1 ≤ accumulatingSeries.cantorBendixsonRank 0 ∧ + Ordinal.omega0 ≤ accumulatingSeries.cantorBendixsonValue := by + have hm : (0 : ℝ) ∈ + (accumulatingSeries.closedSupport.cantorBendixson (1 : Ordinal) : Set ℝ) := by + rw [show (1 : Ordinal) = 0 + 1 by simp, TopologicalSpace.Closeds.cantorBendixson_add_one, + TopologicalSpace.Closeds.cantorBendixson_zero, TopologicalSpace.Closeds.coe_derived, + HahnSeries.coe_closedSupport, accumulatingSeries_support] + exact accumulation + obtain ⟨hmem, hr⟩ := (accumulatingSeries.mem_support_derivative_iff 0 1).mp hm + refine ⟨hr, ?_⟩ + rw [accumulatingSeries.cantorBendixsonValue_of_mem hmem] + simpa only [Ordinal.opow_one] using + Ordinal.opow_le_opow_right Ordinal.omega0_pos hr + +/-- Zero and strictly negative monomials vanish, but a nonzero constant has value one. -/ +theorem value_boundary_cases : + (0 : HahnSeries ℝ ℚ).cantorBendixsonValue = 0 ∧ + (HahnSeries.single (-1 : ℝ) (1 : ℚ)).cantorBendixsonValue = 0 ∧ + (HahnSeries.single (0 : ℝ) (1 : ℚ)).cantorBendixsonValue = 1 := by + refine ⟨HahnSeries.cantorBendixsonValue_zero, ?_, ?_⟩ + · apply HahnSeries.cantorBendixsonValue_of_finite_of_coeff_eq_zero + · exact (Set.finite_singleton _).subset HahnSeries.support_single_subset + · simp + · apply HahnSeries.cantorBendixsonValue_of_finite_of_coeff_ne_zero + · exact (Set.finite_singleton _).subset HahnSeries.support_single_subset + · simp + +/-- Weak truncation retains the cutoff monomial; strict truncation deletes it. -/ +theorem cutoff_endpoint : + (HahnSeries.translate (1 : ℝ) + (HahnSeries.truncLE (-1) (HahnSeries.single (-1) (1 : ℚ)))).cantorBendixsonValue = 1 ∧ + (HahnSeries.translate (1 : ℝ) + (HahnSeries.truncLT (-1) (HahnSeries.single (-1) (1 : ℚ)))).cantorBendixsonValue = 0 := by + have hle : HahnSeries.translate (1 : ℝ) + (HahnSeries.truncLE (-1) (HahnSeries.single (-1) (1 : ℚ))) = + HahnSeries.single 0 1 := by + ext x + by_cases hx : x = 0 + · subst x + simp [HahnSeries.coeff_truncLE] + · have hn : x - 1 ≠ -1 := by simpa using hx + simp [HahnSeries.coeff_truncLE, hx, hn] + have hlt : HahnSeries.truncLT (-1 : ℝ) (HahnSeries.single (-1) (1 : ℚ)) = 0 := by + ext x + by_cases hx : x = -1 + · subst x + simp [HahnSeries.coeff_truncLT] + · simp [HahnSeries.coeff_truncLT, hx] + rw [hle, hlt, map_zero] + exact ⟨value_boundary_cases.2.2, HahnSeries.cantorBendixsonValue_zero⟩ + +/-- A cutoff at an actual accumulation point preserves its positive rank. -/ +theorem accumulated_cutoff_rank : + (HahnSeries.translate (0 : ℝ) + (HahnSeries.truncLE 0 accumulatingSeries)).cantorBendixsonRank 0 ≥ 1 := by + rw [HahnSeries.translate_zero_apply, HahnSeries.cantorBendixsonRank_truncLE] + exact accumulatingSeries_positive_rank.1 + +/-- The finite convolution fiber contains a limit pair absent from both raw supports. -/ +theorem convolution_limit_index : + ((0, 0) : ℝ × ℝ) ∈ accumulatingSeries.closedSupportAddFiber accumulatingSeries 0 ∧ + (0 : ℝ) ∉ accumulatingSeries.support := by + have hc : (0 : ℝ) ∈ accumulatingSeries.closedSupport := by + rw [mem_closedSupport, accumulatingSeries_support] + exact isClosed_closure.closure_subset (derivedSet_subset_closure _ accumulation) + refine ⟨(mem_closedSupportAddFiber _ _ _ _).mpr ⟨hc, hc, add_zero _⟩, ?_⟩ + rw [accumulatingSeries_support] + rintro ⟨n, hn⟩ + have hne : negRecip n ≠ 0 := by + simp only [negRecip_apply, ne_eq, neg_eq_zero, one_div, inv_eq_zero] + positivity + exact hne hn + +/-- Omitting that limit pair would falsely give value zero for this actual square. -/ +theorem convolution_square_nonzero_value : + (accumulatingSeries * accumulatingSeries).cantorBendixsonValue ≠ 0 := by + apply mt (cantorBendixsonValue_eq_zero_iff _).mp + apply not_not.mpr + have hcoeff (n : ℕ) : + 0 < (accumulatingSeries * accumulatingSeries).coeff (negRecip n + negRecip n) := by + rw [coeff_mul] + apply Finset.sum_pos' + · intro p _ + apply mul_nonneg <;> simp only [accumulatingSeries_coeff] <;> split <;> norm_num + · refine ⟨(negRecip n, negRecip n), ?_, ?_⟩ + · rw [Finset.mem_addAntidiagonal, accumulatingSeries_support] + exact ⟨mem_range_self n, mem_range_self n, rfl⟩ + · simp only [accumulatingSeries_coeff, mem_range_self, if_true, one_mul, zero_lt_one] + have ht := negRecip_tendsto + apply mem_closure_of_tendsto (by simpa only [add_zero] using ht.add ht) + exact Filter.Eventually.of_forall fun n ↦ (hcoeff n).ne' + +/-- The finite convolution error has value zero on the accumulating support fixture. -/ +theorem convolution_error_value : + (translate (0 : ℝ) (truncLE 0 (accumulatingSeries * accumulatingSeries)) - + ∑ p ∈ accumulatingSeries.closedSupportAddFiber accumulatingSeries 0, + translate (-p.1) (truncLE p.1 accumulatingSeries) * + translate (-p.2) (truncLE p.2 accumulatingSeries)).cantorBendixsonValue = 0 := by + simpa only [neg_zero] using + accumulatingSeries.cantorBendixsonValue_convolution_error accumulatingSeries 0 + +/-- The natural-product upper bound applies to the nonzero infinite-support square. -/ +theorem square_value_upper_bound : + NatOrdinal.of (accumulatingSeries * accumulatingSeries).cantorBendixsonValue ≤ + NatOrdinal.of accumulatingSeries.cantorBendixsonValue * + NatOrdinal.of accumulatingSeries.cantorBendixsonValue := by + have hs : accumulatingSeries.support ⊆ Iic 0 := by + rw [accumulatingSeries_support] + rintro _ ⟨n, rfl⟩ + simp only [mem_Iic, negRecip_apply] + exact neg_nonpos.mpr (by positivity) + exact accumulatingSeries.cantorBendixsonValue_mul_le accumulatingSeries hs hs + +/-- Equal nonzero values can cancel completely; the unequal-values hypothesis is necessary. -/ +theorem equal_value_cancellation : + (-accumulatingSeries).cantorBendixsonValue = accumulatingSeries.cantorBendixsonValue ∧ + 0 < accumulatingSeries.cantorBendixsonValue ∧ + (accumulatingSeries + -accumulatingSeries).cantorBendixsonValue = 0 := by + refine ⟨cantorBendixsonValue_neg _, + Ordinal.omega0_pos.trans_le accumulatingSeries_positive_rank.2, ?_⟩ + rw [add_neg_cancel, cantorBendixsonValue_zero] + +/-- An ordinary constant cannot cancel the accumulating part of the test series. -/ +theorem constant_does_not_cancel_accumulation : + (accumulatingSeries + single (0 : ℝ) (1 : ℚ)).cantorBendixsonValue = + accumulatingSeries.cantorBendixsonValue := by + have hlt : (single (0 : ℝ) (1 : ℚ)).cantorBendixsonValue < + accumulatingSeries.cantorBendixsonValue := by + rw [value_boundary_cases.2.2] + exact Ordinal.one_lt_omega0.trans_le accumulatingSeries_positive_rank.2 + rw [cantorBendixsonValue_add_eq_max_of_ne _ _ hlt.ne', max_eq_left hlt.le] + +private theorem accumulating_support_nonpositive : accumulatingSeries.support ⊆ Iic 0 := by + rw [accumulatingSeries_support] + rintro _ ⟨n, rfl⟩ + simp only [mem_Iic, negRecip_apply] + exact neg_nonpos.mpr (by positivity) + +/-- Value one permits an actual infinite tail bounded away from zero. -/ +theorem infinite_tail_value_one : + (translate (-1 : ℝ) accumulatingSeries).support.Infinite ∧ + (translate (-1 : ℝ) accumulatingSeries + single 0 (1 : ℚ)).cantorBendixsonValue = 1 := by + have hbound : (translate (-1 : ℝ) accumulatingSeries).support ⊆ Iic (-1 : ℝ) := by + rw [support_translate] + rintro _ ⟨x, hx, rfl⟩ + simpa only [mem_Iic, add_zero] using + add_le_add_right (accumulating_support_nonpositive hx) (-1 : ℝ) + have hnonpos : (translate (-1 : ℝ) accumulatingSeries).support ⊆ Iic 0 := + hbound.trans (Iic_subset_Iic.mpr (by norm_num)) + have hz : (translate (-1 : ℝ) accumulatingSeries).cantorBendixsonValue = 0 := + (cantorBendixsonValue_eq_zero_iff_support_bounded_lt _ hnonpos).mpr + ⟨-1, by norm_num, hbound⟩ + constructor + · intro hf + have hr := accumulatingSeries.cantorBendixsonRank_translate (-1) 0 + rw [cantorBendixsonRank_of_finite _ hf, eq_comm] at hr + have hge := accumulatingSeries_positive_rank.1 + rw [hr] at hge + exact (not_le_of_gt (show (0 : Ordinal) < 1 from zero_lt_one)) hge + · rw [cantorBendixsonValue_add_eq_max_of_ne _ _ (by + rw [hz, value_boundary_cases.2.2]; exact zero_ne_one), hz, value_boundary_cases.2.2] + exact max_eq_right zero_le + +/-- A value-one factor with infinite support preserves the accumulating-series value. -/ +theorem value_one_factor_preserves_infinite_value : + ((translate (-1 : ℝ) accumulatingSeries + single 0 (1 : ℚ)) * + accumulatingSeries).cantorBendixsonValue = accumulatingSeries.cantorBendixsonValue := by + apply cantorBendixsonValue_mul_of_left_eq_one _ _ _ accumulating_support_nonpositive + infinite_tail_value_one.2 + intro x hx + change x ≤ 0 + rcases support_add_subset _ _ hx with hx | hx + · rw [support_translate] at hx + obtain ⟨y, hy, rfl⟩ := hx + exact add_nonpos (by norm_num) (accumulating_support_nonpositive hy) + · exact (support_single_subset hx : x = 0) ▸ le_rfl + +/-- The Leibniz bound is strictly smaller than the predicted square value on an actual +infinite support; this excludes a finite-support or constant-factor substitute. -/ +theorem leibniz_infinite_square : + ∃ ρ : NatOrdinal, 0 < ρ ∧ + ρ < NatOrdinal.of accumulatingSeries.cantorBendixsonValue * + NatOrdinal.of accumulatingSeries.cantorBendixsonValue ∧ + ∀ᶠ γ in 𝓝[<] (0 : ℝ), + NatOrdinal.of (translate (-γ) (truncLE γ (accumulatingSeries * accumulatingSeries)) - + translate (-γ) (truncLE γ accumulatingSeries) * accumulatingSeries - + accumulatingSeries * translate (-γ) (truncLE γ accumulatingSeries)).cantorBendixsonValue < + ρ := by + have hc : 0 ∈ closure accumulatingSeries.support := by + rw [accumulatingSeries_support] + exact isClosed_closure.closure_subset (derivedSet_subset_closure _ accumulation) + let B : Ordinal.AdditivePrincipalAboveOne := + ⟨accumulatingSeries.cantorBendixsonValue, by + rw [accumulatingSeries.cantorBendixsonValue_of_mem hc] + exact Ordinal.isAdditivelyPrincipal_omega0_opow _, + Ordinal.one_lt_omega0.trans_le accumulatingSeries_positive_rank.2⟩ + have hρ : 0 < NatOrdinal.of B.residualFactor := + pos_iff_ne_zero.mpr B.residualFactor_isAdditivelyPrincipal.ne_zero + have hV : 0 < NatOrdinal.of B.val := pos_iff_ne_zero.mpr B.2.1.ne_zero + refine ⟨NatOrdinal.of B.residualFactor * NatOrdinal.of B.val, mul_pos hρ hV, ?_, ?_⟩ + · apply mul_lt_mul_of_pos_right _ hV + change NatOrdinal.of B.residualFactor < NatOrdinal.of B.val + rw [← B.naturalResidual_mul_naturalPrincipal] + simpa only [mul_one] using + mul_lt_mul_of_pos_left + (show (1 : NatOrdinal) < NatOrdinal.of B.principalFactor from B.one_lt_principalFactor) hρ + · exact accumulatingSeries.eventually_cantorBendixsonValue_leibnizRemainder_lt + accumulatingSeries accumulating_support_nonpositive accumulating_support_nonpositive + B B rfl rfl le_rfl + +/-- The eventual qualifier is essential: negative monomials produce a value-one remainder +at an earlier negative cutoff, although both original values are zero. -/ +theorem leibniz_not_all_negative_cutoffs : + let b : HahnSeries ℝ ℚ := single (-1) 1 + (translate (2 : ℝ) (truncLE (-2) (b * b)) - translate 2 (truncLE (-2) b) * b - + b * translate 2 (truncLE (-2) b)).cantorBendixsonValue = 1 := by + dsimp only + have hz : truncLE (-2 : ℝ) (single (-1) (1 : ℚ)) = 0 := by + ext x + by_cases hx : x = -1 + · subst x + norm_num [HahnSeries.coeff_truncLE] + · simp [HahnSeries.coeff_truncLE, hx] + have hprod : (single (-1 : ℝ) (1 : ℚ) * single (-1) 1) = single (-2) 1 := by + rw [single_mul_single] + norm_num + have htr : translate (2 : ℝ) (truncLE (-2) (single (-2) (1 : ℚ))) = single 0 1 := by + ext x + by_cases hx : x = 0 + · subst x + norm_num [HahnSeries.coeff_truncLE] + · have hx' : x - 2 ≠ -2 := by simpa using hx + simp [HahnSeries.coeff_truncLE, hx, hx'] + rw [hz, hprod, htr, map_zero, zero_mul, mul_zero, sub_zero, sub_zero] + exact value_boundary_cases.2.2 + +/-- Zero-input API smoke test; this does not distinguish the multiplicities. -/ +theorem power_remainder_zero_inputs (b : HahnSeries ℝ ℚ) (m : ℕ) (γ : ℝ) : + leibnizPowerRemainder 0 b m γ = 0 ∧ leibnizPowerRemainder b 0 m γ = 0 := by + simp [leibnizPowerRemainder_eq] + +/-- The ordinary coefficient distinguishes the square rule from the wrong coefficient-one rule. -/ +theorem power_remainder_multiplicity : + let b : HahnSeries ℝ ℚ := 1 + single (-1) 1 + (leibnizPowerRemainder b 1 1 (-1)).coeff 0 = 0 ∧ + (translate 1 (truncLE (-1) (b ^ 2)) - + translate 1 (truncLE (-1) b) * b).coeff 0 = 1 := by + let b : HahnSeries ℝ ℚ := 1 + single (-1) 1 + change (leibnizPowerRemainder b 1 1 (-1)).coeff 0 = 0 ∧ _ + have hs : (single (-1 : ℝ) (1 : ℚ)) ^ 2 = single (-2) 1 := by + rw [pow_two, single_mul_single] + norm_num + have hp : b ^ 2 = 1 + 2 * single (-1) 1 + single (-2) 1 := by + dsimp only [b] + rw [add_sq, one_pow, mul_one, hs] + have ht : translate (1 : ℝ) (truncLE (-1) b) = 1 := by + ext x + by_cases hx : x = 0 + · subst x + norm_num [HahnSeries.coeff_truncLE, b] + · have hn : x - 1 ≠ -1 := by simpa using hx + suffices x ≤ 0 → x - 1 ≠ 0 by + simpa [HahnSeries.coeff_truncLE, b, hx, hn] using this + intro hle he + linarith + have h1 : truncLE (-1 : ℝ) (1 : HahnSeries ℝ ℚ) = 0 := by + ext x + by_cases hx : x = 0 + · subst x + norm_num [HahnSeries.coeff_truncLE] + · simp [HahnSeries.coeff_truncLE, hx] + constructor + · rw [leibnizPowerRemainder_eq] + norm_num only [neg_neg, one_add_one_eq_two, pow_one, mul_one, h1, map_zero, + mul_zero, sub_zero, ht, one_mul] + rw [hp] + norm_num [HahnSeries.coeff_truncLE, b, coeff_nsmul, two_mul, + show (2 : HahnSeries ℝ ℚ) = 1 + 1 by norm_num] + have htwo : (2 : HahnSeries ℝ ℚ) = 1 + 1 := by norm_num + rw [htwo, coeff_add] + norm_num + · change (translate (1 : ℝ) (truncLE (-1) (b ^ 2)) - + translate 1 (truncLE (-1) b) * b).coeff 0 = 1 + rw [ht, one_mul, hp] + norm_num [HahnSeries.coeff_truncLE, b, two_mul] + +/-- The power estimate on an actual accumulating support, for every exponent including zero. +The positive Cantor–Bendixson rank excludes a finite-support or ordinary-constant substitute. -/ +theorem power_remainder_infinite_support (m : ℕ) : + ∃ ρ : NatOrdinal, 0 < ρ ∧ + ρ < NatOrdinal.of accumulatingSeries.cantorBendixsonValue ^ (m + 1) ∧ + ∀ᶠ γ in 𝓝[<] (0 : ℝ), + NatOrdinal.of (translate (-γ) (truncLE γ (accumulatingSeries ^ (m + 1))) - + (m + 1) • (translate (-γ) (truncLE γ accumulatingSeries) * + accumulatingSeries ^ m)).cantorBendixsonValue < ρ := by + have hc : 0 ∈ closure accumulatingSeries.support := by + rw [accumulatingSeries_support] + exact isClosed_closure.closure_subset (derivedSet_subset_closure _ accumulation) + let B : Ordinal.AdditivePrincipalAboveOne := + ⟨accumulatingSeries.cantorBendixsonValue, by + rw [accumulatingSeries.cantorBendixsonValue_of_mem hc] + exact Ordinal.isAdditivelyPrincipal_omega0_opow _, + Ordinal.one_lt_omega0.trans_le accumulatingSeries_positive_rank.2⟩ + have hρ : 0 < NatOrdinal.of B.residualFactor := + pos_iff_ne_zero.mpr B.residualFactor_isAdditivelyPrincipal.ne_zero + have hV : 0 < NatOrdinal.of B.val := pos_iff_ne_zero.mpr B.2.1.ne_zero + have hlt : NatOrdinal.of B.residualFactor < NatOrdinal.of B.val := by + rw [← B.naturalResidual_mul_naturalPrincipal] + simpa only [mul_one] using mul_lt_mul_of_pos_left + (show (1 : NatOrdinal) < NatOrdinal.of B.principalFactor from B.one_lt_principalFactor) hρ + refine ⟨NatOrdinal.of B.val ^ m * NatOrdinal.of B.residualFactor, + mul_pos (pow_pos hV m) hρ, ?_, ?_⟩ + · change NatOrdinal.of B.val ^ m * NatOrdinal.of B.residualFactor < + NatOrdinal.of B.val ^ (m + 1) + rw [pow_succ] + exact mul_lt_mul_of_pos_left hlt (pow_pos hV m) + · exact accumulatingSeries.eventually_cantorBendixsonValue_powerRemainder_lt + accumulating_support_nonpositive B rfl m + +private theorem finite_strict_cut {y : ℝ} (hy : y < 0) : + (truncLE y accumulatingSeries).support.Finite := by + obtain ⟨N, hN⟩ := eventually_atTop.mp (negRecip_tendsto (Ioi_mem_nhds hy)) + apply ((Finset.range N).finite_toSet.image negRecip).subset + intro x hx + rw [support_truncLE, accumulatingSeries_support] at hx + obtain ⟨⟨n, rfl⟩, hn⟩ := hx + refine ⟨n, ?_, rfl⟩ + simp only [Finset.mem_coe, Finset.mem_range] + exact lt_of_not_ge fun hge ↦ (not_lt_of_ge hn) (hN n hge) + +/-- The accumulating fixture has rank exactly one in value, not merely a positive lower bound. -/ +theorem accumulatingSeries_value : + accumulatingSeries.cantorBendixsonValue = Ordinal.omega0 := by + have hstage : (accumulatingSeries.closedSupport.cantorBendixson (1 : Ordinal) : Set ℝ) ⊆ {0} := by + intro y hy + obtain ⟨hys, hyr⟩ := (accumulatingSeries.mem_support_derivative_iff y 1).mp hy + have hy0 : y ≤ 0 := closure_minimal accumulating_support_nonpositive isClosed_Iic hys + by_contra hne + have hylt : y < 0 := lt_of_le_of_ne hy0 hne + have hz : accumulatingSeries.cantorBendixsonRank y = 0 := by + rw [← cantorBendixsonRank_truncLE _ y] + exact cantorBendixsonRank_of_finite _ (finite_strict_cut hylt) y + rw [hz] at hyr + exact not_le_of_gt zero_lt_one hyr + have hnot : (0 : ℝ) ∉ (accumulatingSeries.closedSupport.cantorBendixson + ((1 : Ordinal) + 1) : Set ℝ) := by + rw [TopologicalSpace.Closeds.cantorBendixson_add_one, TopologicalSpace.Closeds.coe_derived] + intro h + exact (finite_singleton (0 : ℝ)).not_infinite + (Set.Infinite.of_accPt (mem_derivedSet.mp (derivedSet_mono _ _ hstage h))) + have hr : accumulatingSeries.cantorBendixsonRank 0 ≤ 1 := by + rw [cantorBendixsonRank_eq] + exact accumulatingSeries.closedSupport.cantorBendixsonRank_le_of_notMem + accumulatingSeries.closedSupport_isPWO 0 hnot + have he := hr.antisymm accumulatingSeries_positive_rank.1 + have hm : (0 : ℝ) ∈ closure accumulatingSeries.support := by + rw [accumulatingSeries_support] + exact isClosed_closure.closure_subset (derivedSet_subset_closure _ accumulation) + rw [cantorBendixsonValue_of_mem _ hm, he, Ordinal.opow_one] + +private def omegaValue : Ordinal.AdditivePrincipalAboveOne := + ⟨Ordinal.omega0, Ordinal.isAdditivelyPrincipal_iff.mpr ⟨1, by simp⟩, Ordinal.one_lt_omega0⟩ + +private theorem omegaValue_residual : omegaValue.residualFactor = 1 := by + apply omegaValue.residualFactor_eq_one_of_isInfiniteMultiplicativelyPrincipal + apply Ordinal.isInfiniteMultiplicativelyPrincipal_iff.mpr + exact ⟨0, by simp [omegaValue]⟩ + +/-- The pure-power cancellation theorem proves every power value on an actual infinite support. +Residual cutoffs have value one, so value-one multiplication closes the smaller-product +hypothesis. -/ +theorem accumulatingSeries_pow_value (n : ℕ) : + NatOrdinal.of (accumulatingSeries ^ n).cantorBendixsonValue = + NatOrdinal.of Ordinal.omega0 ^ n := by + induction n with + | zero => + simp only [pow_zero] + apply congrArg NatOrdinal.of + exact cantorBendixsonValue_of_finite_of_coeff_ne_zero _ + (by rw [support_one]; exact finite_singleton _) (by simp) + | succ n ih => + apply cantorBendixsonValue_pow_eq_of_eventually accumulatingSeries + accumulating_support_nonpositive omegaValue accumulatingSeries_value n + apply Filter.Eventually.of_forall + intro γ hγ + have hv : (translate (-γ) (truncLE γ accumulatingSeries)).cantorBendixsonValue = 1 := by + rw [omegaValue_residual] at hγ + exact NatOrdinal.of.injective hγ + rw [cantorBendixsonValue_mul_of_left_eq_one _ _ (support_translated_truncLE _ _) + ((nonpositiveSubring ℝ ℚ).pow_mem accumulating_support_nonpositive _) hv] + rw [omegaValue_residual] + simpa only [NatOrdinal.of_one, mul_one, omegaValue] using ih + + + +/-- The two-factor cancellation theorem also closes on the opposite-sign infinite factors. +Its residual-point hypothesis uses the independently proved pure-square value. -/ +theorem accumulatingSeries_negative_product_value : + NatOrdinal.of (accumulatingSeries * -accumulatingSeries).cantorBendixsonValue = + NatOrdinal.of Ordinal.omega0 ^ 2 := by + have hc : (-accumulatingSeries).support ⊆ Iic 0 := by + simpa only [support_neg] using accumulating_support_nonpositive + have hv : (-accumulatingSeries).cantorBendixsonValue = omegaValue.val := by + rw [cantorBendixsonValue_neg, accumulatingSeries_value] + rfl + have h := cantorBendixsonValue_pow_mul_eq_of_eventually accumulatingSeries + (-accumulatingSeries) accumulating_support_nonpositive hc omegaValue omegaValue + accumulatingSeries_value hv le_rfl 0 (by + apply Filter.Eventually.of_forall + intro γ hγ + have ht : (translate (-γ) (truncLE γ accumulatingSeries)).cantorBendixsonValue = 1 := by + rw [omegaValue_residual] at hγ + exact NatOrdinal.of.injective hγ + rw [pow_zero, one_mul, cantorBendixsonValue_mul_of_left_eq_one _ _ + (support_translated_truncLE _ _) ((nonpositiveSubring ℝ ℚ).pow_mem hc 2) ht, + neg_sq, omegaValue_residual] + simpa only [NatOrdinal.of_one, mul_one, one_mul, omegaValue, pow_two, pow_zero] using + accumulatingSeries_pow_value 2) + simpa only [zero_add, pow_one, omegaValue, pow_two] using h + + +/-- Unequal positive ranks, mixed signs, and a nonzero constant term are all retained. -/ +theorem accumulatingSeries_mixed_rank_product : + NatOrdinal.of (accumulatingSeries ^ 2 * (1 - accumulatingSeries)).cantorBendixsonValue = + NatOrdinal.of Ordinal.omega0 ^ 3 := by + have hb : accumulatingSeries.support ⊆ Iic 0 := by + rw [accumulatingSeries_support] + rintro x ⟨n, rfl⟩ + change negRecip n ≤ 0 + rw [negRecip_apply] + exact neg_nonpos.mpr (by positivity) + have hc : (1 - accumulatingSeries).support ⊆ Iic 0 := + (nonpositiveSubring ℝ ℚ).sub_mem (nonpositiveSubring ℝ ℚ).one_mem hb + have h1 : (1 : HahnSeries ℝ ℚ).cantorBendixsonValue = 1 := + cantorBendixsonValue_of_finite_of_coeff_ne_zero _ + (by rw [support_one]; exact finite_singleton _) (by simp) + have hv : (1 - accumulatingSeries).cantorBendixsonValue = Ordinal.omega0 := by + rw [sub_eq_add_neg, cantorBendixsonValue_add_eq_max_of_ne, cantorBendixsonValue_neg, + accumulatingSeries_value, h1, max_eq_right Ordinal.one_lt_omega0.le] + rw [cantorBendixsonValue_neg, accumulatingSeries_value, h1] + exact Ordinal.one_lt_omega0.ne + rw [cantorBendixsonValue_mul _ _ ((nonpositiveSubring ℝ ℚ).pow_mem hb 2) hc, + accumulatingSeries_pow_value, hv] + rfl + +open HahnSeries.Nonpositive in +/-- The germ quotient is not the ordinary-coefficient quotient: this series has coefficient +zero at zero and still gives a nonzero germ. -/ +theorem accumulatingSeries_survives_germ : + ∃ b : Nonpositive ℝ ℚ, (b : HahnSeries ℝ ℚ) = accumulatingSeries ∧ + (b : HahnSeries ℝ ℚ).coeff 0 = 0 ∧ + Ideal.Quotient.mk (cantorBendixsonValuation (G := ℝ) (R := ℚ)).supp b ≠ 0 := by + have hb : accumulatingSeries.support ⊆ Iic 0 := by + rw [accumulatingSeries_support] + rintro x ⟨n, rfl⟩ + change negRecip n ≤ 0 + rw [negRecip_apply] + exact neg_nonpos.mpr (by positivity) + refine ⟨⟨accumulatingSeries, hb⟩, rfl, ?_, ?_⟩ + · rw [accumulatingSeries_coeff, if_neg] + rintro ⟨n, hn⟩ + rw [negRecip_apply] at hn + exact (neg_ne_zero.mpr (one_div_ne_zero (by positivity))) hn + · rw [ne_eq, Ideal.Quotient.eq_zero_iff_mem, Valuation.mem_supp_iff, + cantorBendixsonValuation_apply] + change NatOrdinal.of accumulatingSeries.cantorBendixsonValue ≠ 0 + rw [accumulatingSeries_value] + exact Ordinal.omega0_ne_zero + + +open HahnSeries.Nonpositive in +/-- A nonzero negative monomial vanishes in the germ quotient, excluding the zero ideal. -/ +theorem negative_monomial_vanishes_germ : + ∃ b : Nonpositive ℝ ℚ, b ≠ 0 ∧ + Ideal.Quotient.mk (cantorBendixsonValuation (G := ℝ) (R := ℚ)).supp b = 0 := by + have hb : (HahnSeries.single (-1 : ℝ) (1 : ℚ)).support ⊆ Iic 0 := by + intro x hx + have hx' : x = -1 := support_single_subset hx + simpa only [mem_Iic, hx'] using (show (-1 : ℝ) ≤ 0 by norm_num) + refine ⟨⟨HahnSeries.single (-1) 1, hb⟩, ?_, ?_⟩ + · intro h + have h' := congrArg (fun x : Nonpositive ℝ ℚ ↦ (x : HahnSeries ℝ ℚ).coeff (-1)) h + simp at h' + · rw [Ideal.Quotient.eq_zero_iff_mem, Valuation.mem_supp_iff, + cantorBendixsonValuation_apply] + exact congrArg NatOrdinal.of value_boundary_cases.2.1 + + +open HahnSeries.Nonpositive in +/-- The accumulating series gives a genuine degree-one class whose square is nonzero. -/ +theorem accumulatingSeries_graded_class : + ∃ b : Nonpositive ℝ ℚ, (b : HahnSeries ℝ ℚ) = accumulatingSeries ∧ + cantorBendixsonDegreeValuation b = (1 : WithBot NatOrdinal) ∧ + (cantorBendixsonDegreeValuation (G := ℝ) (R := ℚ)).initialForm b ^ 2 ≠ 0 := by + obtain ⟨b, hb, -, -⟩ := accumulatingSeries_survives_germ + have hd : cantorBendixsonDegreeValuation b = (1 : WithBot NatOrdinal) := by + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, hb, + accumulatingSeries_value] + simp + refine ⟨b, hb, hd, ?_⟩ + letI := cantorBendixson_associatedGraded_isDomain (G := ℝ) (R := ℚ) + exact pow_ne_zero 2 + ((cantorBendixsonDegreeValuation (G := ℝ) (R := ℚ)).initialForm_ne_zero_of_ne_bot + (by rw [hd]; exact WithBot.coe_ne_bot)) + +section Derivative + +open HahnSeries.Nonpositive + +local notation "ν" => (cantorBendixsonDegreeValuation (G := ℝ) (R := ℚ)) + +/-- The accumulating degree-one class has nonzero derivative, excluding the zero-map substitute. -/ +theorem accumulatingSeries_derivative_nonzero : + ∃ b : (ν).filtrationLE 1, ((b : Nonpositive ℝ ℚ) : HahnSeries ℝ ℚ) = + accumulatingSeries ∧ + cantorBendixsonGradedDerivation ((ν).homogeneousMk 1 b) ≠ 0 := by + obtain ⟨b, hb, hd, -⟩ := accumulatingSeries_graded_class + let a : (ν).filtrationLE 1 := ⟨b, ((ν).mem_filtrationLE_iff _ _).mpr hd.le⟩ + refine ⟨a, hb, ?_⟩ + have ha : (ν).componentMk 1 a ≠ 0 := by + rw [ne_eq, (ν).componentMk_eq_zero_iff] + change ¬ ν b < (1 : NatOrdinal) + rw [hd] + exact lt_irrefl _ + intro hzero + apply ha + have hi := cantorBendixsonGradedDerivation_injective_on_successor + (G := ℝ) (R := ℚ) 0 + rw [zero_add] at hi + apply hi + simpa only [(ν).homogeneousMk_apply, map_zero] using hzero + +/-- The additive derivative sends zero to zero. -/ +theorem graded_derivative_zero : cantorBendixsonGradedDerivation + (0 : (ν).AssociatedGraded) = 0 := map_zero _ + +/-- Every grade-zero class has zero derivative. -/ +theorem graded_derivative_constant_grade (a : (ν).Component 0) : + cantorBendixsonGradedDerivation (DirectSum.of (ν).Component 0 a) = 0 := by + rw [cantorBendixsonGradedDerivation_of, + cantorBendixsonHomogeneousDerivation_limit 0 NatOrdinal.constantCoeff_zero, + AddMonoidHom.zero_apply] + +/-- The grade-zero scalar map is an actual coefficient-field equivalence. -/ +theorem graded_zero_component_coefficients : + Function.Bijective (cantorBendixsonLayerScalarHom (G := ℝ) (K := ℚ)) := + ⟨cantorBendixsonLayerScalarHom_injective, cantorBendixsonLayerScalarHom_surjective⟩ + +/-- The standard derivation and additive truncation map agree. -/ +theorem graded_derivation_apply + (x : (ν).AssociatedGraded) : + cantorBendixsonDerivation x = cantorBendixsonGradedDerivation x := + cantorBendixsonDerivation_apply x + +/-- The accumulating series exercises both terms of the graded product rule. -/ +theorem accumulatingSeries_graded_square_rule : + ∃ b : (ν).filtrationLE 1, ((b : Nonpositive ℝ ℚ) : HahnSeries ℝ ℚ) = + accumulatingSeries ∧ + cantorBendixsonGradedDerivation ((ν).homogeneousMk 1 b ^ 2) = + 2 • (cantorBendixsonGradedDerivation ((ν).homogeneousMk 1 b) * + ((ν).homogeneousMk 1 b : Filter.Germ (𝓝[<] (0 : ℝ)) (ν).AssociatedGraded)) := by + obtain ⟨b, hb, -⟩ := accumulatingSeries_derivative_nonzero + refine ⟨b, hb, ?_⟩ + rw [pow_two, cantorBendixsonGradedDerivation_mul, two_smul] + congr 1 + exact mul_comm _ _ + +/-- Dropping one of the two square-rule terms is false for the actual accumulating series. -/ +theorem accumulatingSeries_graded_square_not_single_copy : + ∃ b : (ν).filtrationLE 1, ((b : Nonpositive ℝ ℚ) : HahnSeries ℝ ℚ) = + accumulatingSeries ∧ + cantorBendixsonGradedDerivation ((ν).homogeneousMk 1 b ^ 2) ≠ + cantorBendixsonGradedDerivation ((ν).homogeneousMk 1 b) * + ((ν).homogeneousMk 1 b : Filter.Germ (𝓝[<] (0 : ℝ)) (ν).AssociatedGraded) := by + obtain ⟨b, hb, hD⟩ := accumulatingSeries_derivative_nonzero + refine ⟨b, hb, ?_⟩ + let x := (ν).homogeneousMk 1 b + have hx : x ≠ 0 := by + intro hx + exact hD (by change cantorBendixsonGradedDerivation x = 0; rw [hx, map_zero]) + letI := cantorBendixson_associatedGraded_isDomain (G := ℝ) (R := ℚ) + have hp : cantorBendixsonGradedDerivation x * + (x : Filter.Germ (𝓝[<] (0 : ℝ)) (ν).AssociatedGraded) ≠ 0 := by + intro he + apply hD + generalize cantorBendixsonGradedDerivation x = f at he ⊢ + induction f using Filter.Germ.inductionOn with + | h f => + change ((fun γ ↦ f γ * x) : Filter.Germ (𝓝[<] (0 : ℝ)) (ν).AssociatedGraded) = 0 at he + rw [← Filter.Germ.coe_zero, Filter.Germ.coe_eq] at he ⊢ + filter_upwards [he] with γ hγ + exact (mul_eq_zero.mp hγ).resolve_right hx + intro he + have hs := cantorBendixsonGradedDerivation_mul x x + rw [← pow_two, he] at hs + have hc := mul_comm + (x : Filter.Germ (𝓝[<] (0 : ℝ)) (ν).AssociatedGraded) (cantorBendixsonGradedDerivation x) + rw [hc] at hs + exact hp (add_left_cancel (hs.symm.trans (add_zero _).symm)) + +end Derivative + +section GlobalCofactors + +open HahnSeries.Nonpositive + +local notation "ν" => (cantorBendixsonDegreeValuation (G := ℝ) (R := ℚ)) + +private theorem accumulating_neg_rank {y : ℝ} (hy : y < 0) : + accumulatingSeries.cantorBendixsonRank y = 0 := by + rw [← cantorBendixsonRank_truncLE _ y] + exact cantorBendixsonRank_of_finite _ (finite_strict_cut hy) y + +/-- The literal pointwise assembly conclusion is unsatisfiable at an accumulating rank level: +prescribing the constant one at every rank-zero point of the accumulating support forces a +coefficient one at cutoffs arbitrarily close to zero, while the required bound at the +nonpositive noncenter zero forces the support strictly below zero. The pointwise degree +hypothesis of the top-rank assembly therefore cannot be dropped. -/ +theorem no_literal_assembly_at_accumulating_level : + ∃ u : Nonpositive ℝ ℚ, (u : HahnSeries ℝ ℚ) = accumulatingSeries ∧ + ¬ ∃ c : Nonpositive ℝ ℚ, + (∀ i : {x // x ∈ (u : HahnSeries ℝ ℚ).closedSupport ∧ + (u : HahnSeries ℝ ℚ).closedSupport.cantorBendixsonRank + (u : HahnSeries ℝ ℚ).closedSupport_isPWO x = (0 : Ordinal)}, + ν (translatedTruncLE (i : ℝ) c - 1) = ⊥) ∧ + ∀ y : ℝ, y ≤ 0 → + ¬(y ∈ (u : HahnSeries ℝ ℚ).closedSupport ∧ + (u : HahnSeries ℝ ℚ).closedSupport.cantorBendixsonRank + (u : HahnSeries ℝ ℚ).closedSupport_isPWO y = (0 : Ordinal)) → + ν (translatedTruncLE y c) < ((0 : NatOrdinal) : WithBot NatOrdinal) := by + refine ⟨⟨accumulatingSeries, accumulating_support_nonpositive⟩, rfl, ?_⟩ + set u : Nonpositive ℝ ℚ := ⟨accumulatingSeries, accumulating_support_nonpositive⟩ + rintro ⟨c, hc1, hc2⟩ + have hm0 : (0 : ℝ) ∈ closure accumulatingSeries.support := by + rw [accumulatingSeries_support] + exact isClosed_closure.closure_subset (derivedSet_subset_closure _ accumulation) + have h0rank : (u : HahnSeries ℝ ℚ).cantorBendixsonRank 0 ≠ 0 := + Order.one_le_iff_ne_zero.mp accumulatingSeries_positive_rank.1 + have hnc : ¬((0 : ℝ) ∈ (u : HahnSeries ℝ ℚ).closedSupport ∧ + (u : HahnSeries ℝ ℚ).closedSupport.cantorBendixsonRank + (u : HahnSeries ℝ ℚ).closedSupport_isPWO 0 = (0 : Ordinal)) := by + rintro ⟨-, hr⟩ + exact h0rank (((u : HahnSeries ℝ ℚ).cantorBendixsonRank_eq 0).trans hr) + have hcbot : ν c = ⊥ := by + have hbot := hc2 0 le_rfl hnc + rw [translatedTruncLE_zero] at hbot + cases hν : ν c with + | bot => rfl + | coe a => + rw [hν, WithBot.coe_lt_coe] at hbot + exact absurd hbot (not_lt_of_ge (zero_le (a := a))) + obtain ⟨e, he0, hsupp⟩ := (cantorBendixsonDegreeValuation_eq_bot_iff c).mp hcbot + obtain ⟨n, hn⟩ := eventually_atTop.mp (negRecip_tendsto (Ioi_mem_nhds he0)) + have hen : e < negRecip n := hn n le_rfl + have hneg : negRecip n < 0 := by + rw [negRecip_apply] + simp only [one_div, Left.neg_neg_iff, inv_pos] + positivity + have hxsupp : negRecip n ∈ accumulatingSeries.support := by + rw [accumulatingSeries_support] + exact ⟨n, rfl⟩ + have hxmem : negRecip n ∈ (u : HahnSeries ℝ ℚ).closedSupport := + (HahnSeries.mem_closedSupport _ _).mpr (subset_closure hxsupp) + have hxrank : (u : HahnSeries ℝ ℚ).closedSupport.cantorBendixsonRank + (u : HahnSeries ℝ ℚ).closedSupport_isPWO (negRecip n) = (0 : Ordinal) := by + rw [← (u : HahnSeries ℝ ℚ).cantorBendixsonRank_eq] + exact accumulating_neg_rank hneg + have hcen := hc1 ⟨negRecip n, hxmem, hxrank⟩ + obtain ⟨e', he'0, hsupp'⟩ := (cantorBendixsonDegreeValuation_eq_bot_iff _).mp hcen + have h0diff : (0 : ℝ) ∉ + ((translatedTruncLE (negRecip n) c - 1 : Nonpositive ℝ ℚ) : HahnSeries ℝ ℚ).support := by + intro h + exact absurd (hsupp' h) (not_le.mpr he'0) + have hcoeff : (c : HahnSeries ℝ ℚ).coeff (negRecip n) = 1 := by + have hzero : ((translatedTruncLE (negRecip n) c - 1 : Nonpositive ℝ ℚ) : + HahnSeries ℝ ℚ).coeff 0 = 0 := by + by_contra hne + exact h0diff ((HahnSeries.mem_support _ _).mpr hne) + rw [AddSubgroupClass.coe_sub, HahnSeries.coeff_sub, coe_translatedTruncLE, + coeff_translate, zero_sub, neg_neg, HahnSeries.coeff_truncLE, if_pos le_rfl, + OneMemClass.coe_one, HahnSeries.coeff_one, if_pos rfl, sub_eq_zero] at hzero + exact hzero + have hxin : negRecip n ∈ (c : HahnSeries ℝ ℚ).support := + (HahnSeries.mem_support _ _).mpr (by rw [hcoeff]; exact one_ne_zero) + exact absurd (hsupp hxin) (not_le.mpr hen) + +/-- On the accumulating fixture, a degree-zero cofactor of the series itself makes every +translated truncation have degree strictly below one. The zero cofactor is not a substitute, +because the original series keeps degree one at cutoff zero. -/ +theorem accumulating_global_cofactor : + ∃ u c : Nonpositive ℝ ℚ, (u : HahnSeries ℝ ℚ) = accumulatingSeries ∧ + (∀ x : ℝ, x ≤ 0 → ν (translatedTruncLE x c) ≤ (0 : NatOrdinal)) ∧ + (∀ x : ℝ, x ≤ 0 → + ν (translatedTruncLE x (u - c * u)) < ((1 : NatOrdinal) : WithBot NatOrdinal)) ∧ + c ≠ 0 := by + classical + set u : Nonpositive ℝ ℚ := ⟨accumulatingSeries, accumulating_support_nonpositive⟩ with hu_def + have hν1 : ν u = ((1 : NatOrdinal) : WithBot NatOrdinal) := by + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply] + have hval : (u : HahnSeries ℝ ℚ).cantorBendixsonValue = Ordinal.omega0 := + accumulatingSeries_value + rw [hval] + simp + have huneg : ∀ {y : ℝ}, y < 0 → (u : HahnSeries ℝ ℚ).cantorBendixsonRank y = 0 := + fun hy ↦ accumulating_neg_rank hy + have hcut0 : ∀ x : ℝ, x < 0 → + ν (translatedTruncLE x u) < ((1 : NatOrdinal) : WithBot NatOrdinal) := by + intro x hx + rw [degree_translatedTruncLE_eq] + by_cases hxm : x ∈ (u : HahnSeries ℝ ℚ).closedSupport + · rw [if_pos hxm, huneg hx, NatOrdinal.of_zero, WithBot.coe_lt_coe] + exact zero_lt_one + · rw [if_neg hxm] + exact WithBot.bot_lt_coe 1 + have hu : ∀ x : ℝ, x ≤ 0 → + ν (translatedTruncLE x u) ≤ ((1 : NatOrdinal) : WithBot NatOrdinal) := by + intro x hx + rcases eq_or_lt_of_le hx with hx0 | hxneg + · subst hx0 + rw [translatedTruncLE_zero] + exact hν1.le + · exact (hcut0 x hxneg).le + have hlevel0 : ∀ i : {x // x ∈ (u : HahnSeries ℝ ℚ).closedSupport ∧ + (u : HahnSeries ℝ ℚ).closedSupport.cantorBendixsonRank + (u : HahnSeries ℝ ℚ).closedSupport_isPWO x = (1 : NatOrdinal).val}, + (i : ℝ) = 0 := by + rintro ⟨x, hxm, hxr⟩ + by_contra hne + have hx0 : x ≤ 0 := closure_minimal u.property isClosed_Iic + ((HahnSeries.mem_closedSupport _ _).mp hxm) + have hxneg : x < 0 := lt_of_le_of_ne hx0 hne + have h0 : (u : HahnSeries ℝ ℚ).closedSupport.cantorBendixsonRank + (u : HahnSeries ℝ ℚ).closedSupport_isPWO x = 0 := by + rw [← (u : HahnSeries ℝ ℚ).cantorBendixsonRank_eq] + exact huneg hxneg + rw [h0] at hxr + have : (1 : NatOrdinal).val = (1 : Ordinal) := NatOrdinal.val_one + rw [this] at hxr + exact zero_ne_one hxr + obtain ⟨c, hcb, hres⟩ := exists_forall_degree_translatedTruncLE_sub_sum_mul_lt + (G := ℝ) (R := ℚ) 1 (ι := Unit) (fun _ ↦ u) (fun _ ↦ 0) (fun _ ↦ 1) + (fun _ ↦ (zero_add 1).le) (fun _ ↦ hν1.le) (fun _ ↦ hcut0) u hu (fun _ _ ↦ 1) + (fun _ _ ↦ (ν).map_one_le_zero) (fun i ↦ by + rw [hlevel0 i, translatedTruncLE_zero] + have hsum : (∑ _j : Unit, (1 : Nonpositive ℝ ℚ) * u) = u := by + rw [Fintype.sum_unique, one_mul] + rw [hsum, sub_self, (ν).map_zero] + exact WithBot.bot_lt_coe 1) + have hsum : (∑ j : Unit, c j * u) = c () * u := by + rw [Fintype.sum_unique] + refine ⟨u, c (), rfl, fun x hx ↦ ?_, fun x hx ↦ ?_, ?_⟩ + · exact hcb () x hx + · have := hres x hx + rwa [hsum] at this + · intro hzero + have := hres 0 le_rfl + rw [hsum, hzero, zero_mul, sub_zero, translatedTruncLE_zero, hν1] at this + exact lt_irrefl _ this + +end GlobalCofactors + +section Lifts + +open HahnSeries.Nonpositive MvPolynomial + +local notation "ν" => (cantorBendixsonDegreeValuation (G := ℝ) (R := ℚ)) + +/-- Two distinct series lift one nonzero degree-one class; their difference has bottom degree. +Lifting detects the class, not the series. -/ +theorem distinct_lifts_of_one_class : + ∃ u u' : Nonpositive ℝ ℚ, u ≠ u' ∧ + ∃ e : (ν).AssociatedGraded, e ≠ 0 ∧ + Represents u 1 e ∧ Represents u' 1 e ∧ ν (u - u') = ⊥ := by + classical + obtain ⟨u, hu, hd, -⟩ := accumulatingSeries_graded_class + have hle : ν u ≤ (1 : NatOrdinal) := hd.le + have hs : (HahnSeries.single (-1 : ℝ) (1 : ℚ)).support ⊆ Iic 0 := by + intro x hx + have hx' : x = -1 := support_single_subset hx + simp only [mem_Iic, hx'] + norm_num + set s : Nonpositive ℝ ℚ := ⟨HahnSeries.single (-1) 1, hs⟩ with hs_def + have hsbot : ν s = ⊥ := by + apply (cantorBendixsonDegreeValuation_eq_bot_iff s).mpr + refine ⟨-1, by norm_num, ?_⟩ + intro x hx + have hx' : x = -1 := support_single_subset hx + simp only [mem_Iic, hx', le_refl] + set e : (ν).AssociatedGraded := + (ν).homogeneousMk 1 ⟨u, ((ν).mem_filtrationLE_iff 1 u).mpr hle⟩ with he_def + have hrepu : Represents u 1 e := represents_iff.mpr ⟨hle, rfl⟩ + have hrepu' : Represents (u + s) 1 e := by + have h := hrepu.add (represents_of_degree_lt (m := 1) + (by rw [hsbot]; exact WithBot.bot_lt_coe 1)) + rwa [add_zero] at h + refine ⟨u, u + s, ?_, e, ?_, hrepu, hrepu', ?_⟩ + · intro huu + have hc := congrArg (fun z : Nonpositive ℝ ℚ ↦ (z : HahnSeries ℝ ℚ).coeff (-1)) huu + have hadd : ((u + s : Nonpositive ℝ ℚ) : HahnSeries ℝ ℚ).coeff (-1) = + (u : HahnSeries ℝ ℚ).coeff (-1) + 1 := by + have hcoe : ((u + s : Nonpositive ℝ ℚ) : HahnSeries ℝ ℚ) = + (u : HahnSeries ℝ ℚ) + HahnSeries.single (-1) 1 := rfl + rw [hcoe, HahnSeries.coeff_add, HahnSeries.coeff_single_same] + change (u : HahnSeries ℝ ℚ).coeff (-1) = + ((u + s : Nonpositive ℝ ℚ) : HahnSeries ℝ ℚ).coeff (-1) at hc + rw [hadd] at hc + nth_rewrite 1 [← add_zero ((u : HahnSeries ℝ ℚ).coeff (-1))] at hc + exact zero_ne_one (add_left_cancel hc) + · rw [he_def, ne_eq, (ν).homogeneousMk_eq_zero_iff] + rw [hd] + exact lt_irrefl _ + · rw [show u - (u + s) = -s by ring, (ν).map_neg, hsbot] + +/-- Without independence of the lifted classes, a nonzero polynomial with small weights can +evaluate to bottom degree: the injectivity hypothesis of the uniqueness clause is not +removable. -/ +theorem pol_uniqueness_needs_independence : + ¬ ∀ (wt : Bool → NatOrdinal.{0}) (V : Bool → Nonpositive ℝ ℚ) (F : MvPolynomial Bool ℚ), + (∀ d ∈ F.support, (Finsupp.weight wt) d < 2) → ν (aeval V F) = ⊥ → F = 0 := by + classical + intro h + obtain ⟨u, u', hne, -, -, -, -, hbot⟩ := distinct_lifts_of_one_class + have hF : (MvPolynomial.X true - MvPolynomial.X false : MvPolynomial Bool ℚ) = 0 := by + apply h (fun _ ↦ 1) (fun b ↦ bif b then u else u') + · intro d hd + have hd' := MvPolynomial.support_sub Bool (MvPolynomial.X true) (MvPolynomial.X false) hd + have hw : (Finsupp.weight (fun _ : Bool ↦ (1 : NatOrdinal.{0}))) d = 1 := by + rcases Finset.mem_union.mp hd' with hd'' | hd'' <;> + · rw [MvPolynomial.support_X] at hd'' + rw [Finset.mem_singleton.mp hd'', Finsupp.weight_single, one_nsmul] + rw [hw] + exact one_lt_two + · rw [map_sub, aeval_X, aeval_X] + simpa only [Bool.cond_true, Bool.cond_false] using hbot + have hXX := sub_eq_zero.mp hF + exact absurd (MvPolynomial.X_injective hXX) (by decide) + +/-- The polynomial of a series modulo bounded series, run below degree one with no generators: +the machinery extracts the constant term, and only the correct constant works. -/ +theorem degree_lt_one_constant_extraction : + ∃ u : Nonpositive ℝ ℚ, + (u : HahnSeries ℝ ℚ) = 1 + HahnSeries.single (-1 : ℝ) (1 : ℚ) ∧ + (∃ c : ℚ, ν (u - algebraMap ℚ (Nonpositive ℝ ℚ) c) = ⊥) ∧ + ∀ c : ℚ, ν (u - algebraMap ℚ (Nonpositive ℝ ℚ) c) = ⊥ → c = 1 := by + classical + have hs : (1 + HahnSeries.single (-1 : ℝ) (1 : ℚ)).support ⊆ Iic 0 := by + intro x hx + rcases HahnSeries.support_add_subset _ _ hx with hx' | hx' + · rw [HahnSeries.support_one] at hx' + simp only [mem_singleton_iff] at hx' + simp [hx'] + · have hx'' : x = -1 := support_single_subset hx' + simp only [mem_Iic, hx''] + norm_num + set u : Nonpositive ℝ ℚ := ⟨1 + HahnSeries.single (-1) 1, hs⟩ with hu_def + have hcoeff0 : (u : HahnSeries ℝ ℚ).coeff 0 = 1 := by + change (1 + HahnSeries.single (-1 : ℝ) (1 : ℚ)).coeff 0 = 1 + rw [HahnSeries.coeff_add, HahnSeries.coeff_one, if_pos rfl, + HahnSeries.coeff_single_of_ne (by norm_num : (0 : ℝ) ≠ -1), add_zero] + have hufin : (u : HahnSeries ℝ ℚ).support.Finite := by + apply Set.Finite.subset ((Set.finite_singleton (-1 : ℝ)).insert 0) + intro x hx + rcases HahnSeries.support_add_subset _ _ hx with hx' | hx' + · rw [HahnSeries.support_one] at hx' + exact Set.mem_insert_iff.mpr (Or.inl (mem_singleton_iff.mp hx')) + · exact Set.mem_insert_iff.mpr (Or.inr (support_single_subset hx')) + have hu0 : ν u ≤ (0 : NatOrdinal) := by + rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, + cantorBendixsonValue_of_finite_of_coeff_ne_zero _ hufin + (by rw [hcoeff0]; exact one_ne_zero), + NatOrdinal.of_one, NatOrdinal.cantorDegree_eq_ordinalCantorDegree, + NatOrdinal.val_one, Ordinal.cantorDegree_one, WithBot.coe_zero] + have hgen : ∀ β : NatOrdinal.{0}, β < 1 → + ∀ y ∈ DirectSum.rangeLof ℚ (ν).Component β, + ∃ F : MvPolynomial Empty ℚ, IsWeightedHomogeneous (fun _ ↦ 1) F β ∧ + aeval (fun _ ↦ (0 : (ν).AssociatedGraded)) F = y := by + intro β hβ y hy + have hβ0 : β = 0 := by + have h01 : β < 0 + 1 := by rwa [zero_add] + exact le_antisymm (Order.lt_add_one_iff.mp h01) (zero_le (a := β)) + subst hβ0 + obtain ⟨a, rfl⟩ := (DirectSum.mem_rangeLof_iff ℚ (ν).Component 0 y).mp hy + obtain ⟨k, hk⟩ := cantorBendixsonLayerScalarHom_surjective (G := ℝ) (K := ℚ) a + refine ⟨C k, isWeightedHomogeneous_C _ k, ?_⟩ + rw [aeval_C, cantorBendixson_algebraMap_apply, hk, DirectSum.lof_eq_of] + obtain ⟨F, -, -, hFbot⟩ := exists_forall_weight_lt_and_degree_sub_aeval_eq_bot + (V := fun _ ↦ 0) (fun _ ↦ (0 : (ν).AssociatedGraded)) + (fun i ↦ i.elim) 1 hgen u (hu0.trans_lt (WithBot.coe_lt_coe.mpr zero_lt_one)) + obtain ⟨c, hc⟩ := MvPolynomial.C_surjective Empty F + refine ⟨u, rfl, ⟨c, ?_⟩, ?_⟩ + · rw [← hc, aeval_C] at hFbot + exact hFbot + · intro c hc' + obtain ⟨e, he0, hesupp⟩ := (cantorBendixsonDegreeValuation_eq_bot_iff _).mp hc' + have h0notin : (0 : ℝ) ∉ + ((u - algebraMap ℚ (Nonpositive ℝ ℚ) c : Nonpositive ℝ ℚ) : HahnSeries ℝ ℚ).support := + fun h ↦ absurd (hesupp h) (not_le.mpr he0) + have hz : ((u - algebraMap ℚ (Nonpositive ℝ ℚ) c : Nonpositive ℝ ℚ) : + HahnSeries ℝ ℚ).coeff 0 = 0 := by + by_contra hnz + exact h0notin ((HahnSeries.mem_support _ _).mpr hnz) + rw [AddSubgroupClass.coe_sub, HahnSeries.coeff_sub, hcoeff0, + HahnSeries.Nonpositive.algebraMap_apply, coe_C, HahnSeries.C_apply, + HahnSeries.coeff_single_same, sub_eq_zero] at hz + exact hz.symm + +end Lifts + +end Tests.PWOAddition diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Tests.lean new file mode 100644 index 0000000000..61669bdf66 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Tests.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ + +import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Tests.CantorBendixson + +/-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Tests/CantorBendixson.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Tests/CantorBendixson.lean new file mode 100644 index 0000000000..b3b609015c --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Tests/CantorBendixson.lean @@ -0,0 +1,183 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonProduct +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonReconstruction +public import Mathlib.Topology.Instances.ENat +import Mathlib.Topology.DiscreteSubset +public import Mathlib.Topology.Maps.Proper.Basic + +/-! +# Semantic checks for transfinite Cantor–Bendixson derivatives + +In the order topology on extended naturals, stage one of the whole space is exactly infinity, +and stage two is empty. This separates derived set from closure and from a falsely discrete +ambient topology. The same calculation exercises a genuine limit stage. A two-to-one projection +also exercises the closed-map theorem without substituting injectivity for finite fibers. +-/ + +public noncomputable section + +open Set Filter Topology TopologicalSpace Order + +namespace Tests.CantorBendixson + +private theorem derivedSet_finite {X : Type*} [TopologicalSpace X] [T1Space X] + {s : Set X} (hs : s.Finite) : derivedSet s = ∅ := by + apply eq_empty_iff_forall_notMem.mpr + intro x hx + exact hs.not_infinite (Set.Infinite.of_accPt (mem_derivedSet.mp hx)) + +private theorem enat_derivedSet_univ : derivedSet (univ : Set ℕ∞) = {⊤} := by + ext x + constructor + · intro hx + by_contra hx0 + have hxne : x ≠ ⊤ := hx0 + have h := accPt_iff_frequently.mp (mem_derivedSet.mp hx) + simp [ENat.nhds_eq_pure hxne] at h + · intro hx + have hx' : x = ⊤ := hx + subst x + apply mem_derivedSet.mpr + apply accPt_iff_nhds.mpr + intro U hU + have he : ∀ᶠ n : ℕ in atTop, (n : ℕ∞) ∈ U := ENat.tendsto_natCast_nhds_top hU + obtain ⟨n, hn⟩ := he.exists + exact ⟨(n : ℕ∞), ⟨hn, mem_univ _⟩, ENat.coe_ne_top n⟩ + +/-- The convergent-sequence limit survives stage one; isolated finite points do not. -/ +theorem enat_stage_one : + ((⊤ : Closeds ℕ∞).cantorBendixson (1 : Ordinal) : Set ℕ∞) = {⊤} := by + rw [show (1 : Ordinal) = 0 + 1 by simp, Closeds.cantorBendixson_add_one, + Closeds.cantorBendixson_zero, Closeds.coe_derived, Closeds.coe_top] + exact enat_derivedSet_univ + +/-- The surviving limit point is isolated in the first derivative and disappears at stage two. -/ +theorem enat_stage_two : (⊤ : Closeds ℕ∞).cantorBendixson (2 : Ordinal) = ⊥ := by + apply Closeds.ext + rw [show (2 : Ordinal) = 1 + 1 from one_add_one_eq_two.symm, Closeds.cantorBendixson_add_one, + Closeds.coe_derived, enat_stage_one, Closeds.coe_bot] + exact derivedSet_finite (finite_singleton _) + +/-- A genuine limit stage is computed by intersections, not by restarting the derivative. -/ +theorem enat_stage_omega : + (⊤ : Closeds ℕ∞).cantorBendixson Ordinal.omega0 = ⊥ := by + apply le_antisymm _ bot_le + have h := (⊤ : Closeds ℕ∞).cantorBendixson_antitone + (show (2 : Ordinal) ≤ Ordinal.omega0 from (Ordinal.natCast_lt_omega0 2).le) + simpa only [enat_stage_two] using h + +/-- The same finite points, in their own discrete ambient space, have no accumulation point. -/ +theorem nat_stage_one : (⊤ : Closeds ℕ).cantorBendixson (1 : Ordinal) = ⊥ := by + apply Closeds.ext + rw [show (1 : Ordinal) = 0 + 1 by simp, Closeds.cantorBendixson_add_one, + Closeds.cantorBendixson_zero, Closeds.coe_derived, Closeds.coe_top, Closeds.coe_bot] + apply eq_empty_iff_forall_notMem.mpr + intro n hn + have h := accPt_iff_frequently.mp (mem_derivedSet.mp hn) + simp at h + +/-- A closed projection with two-point fibers lifts every derivative, for arbitrary ordinals. -/ +theorem two_point_projection (o : Ordinal) : + ((⊤ : Closeds ℕ∞).cantorBendixson o : Set ℕ∞) ⊆ + Prod.fst '' ((⊤ : Closeds (ℕ∞ × Fin 2)).cantorBendixson o : Set (ℕ∞ × Fin 2)) := by + have hf : IsClosedMap (Prod.fst : ℕ∞ × Fin 2 → ℕ∞) := isClosedMap_fst_of_compactSpace + have hfin (y : ℕ∞) : (Prod.fst ⁻¹' {y} : Set (ℕ∞ × Fin 2)).Finite := by + have heq : (Prod.fst ⁻¹' {y} : Set (ℕ∞ × Fin 2)) = {y} ×ˢ univ := by + ext x + simp + rw [heq] + exact (finite_singleton _).prod (finite_univ) + have himage : (⟨Prod.fst '' (univ : Set (ℕ∞ × Fin 2)), hf _ isClosed_univ⟩ : + Closeds ℕ∞) = ⊤ := by + apply Closeds.ext + simp only [Closeds.coe_mk, Closeds.coe_top, image_univ] + exact Set.range_eq_univ.mpr Prod.fst_surjective + simpa only [Closeds.coe_top, himage] using hf.cantorBendixson_image_subset hfin ⊤ o + +/-- The product of two convergent sequences has no point at stage three. This exercises the +natural-sum bound with two nonzero coordinate ranks. -/ +theorem enat_product_stage_three : + (⊤ : Closeds (ℕ∞ × ℕ∞)).cantorBendixson (3 : Ordinal) = ⊥ := by + let r (n : ℕ∞) : NatOrdinal := if n = ⊤ then 1 else 0 + have hr (x : ℕ∞) (_hx : x ∈ (⊤ : Closeds ℕ∞)) : + ∀ᶠ z in 𝓝 x, z ∈ (⊤ : Closeds ℕ∞) → z ≠ x → r z < r x := by + by_cases hx : x = ⊤ + · subst x + exact Filter.Eventually.of_forall fun z _ hz ↦ by simp [r, hz] + · simp [ENat.nhds_eq_pure hx] + have hbound := (⊤ : Closeds ℕ∞).cantorBendixson_prod_subset_of_locally_lt + ⊤ r r hr hr (3 : Ordinal) + have hprod : (⊤ : Closeds ℕ∞) ×ˢ (⊤ : Closeds ℕ∞) = ⊤ := by + ext x + simp + rw [hprod] at hbound + apply Closeds.ext + apply eq_empty_iff_forall_notMem.mpr + intro p hp + have h := hbound hp + change (3 : Ordinal) ≤ (r p.1 + r p.2).val at h + have hle (n : ℕ∞) : r n ≤ 1 := by simp [r]; split <;> simp + have hsum : (r p.1 + r p.2).val ≤ 2 := by + have hs : r p.1 + r p.2 ≤ (2 : NatOrdinal) := by + calc + _ ≤ 1 + 1 := add_le_add (hle p.1) (hle p.2) + _ = 2 := one_add_one_eq_two + exact NatOrdinal.val.monotone hs + have hnot : ¬ (3 : Ordinal) ≤ 2 := by + exact_mod_cast (show ¬ (3 : ℕ) ≤ 2 by decide) + exact hnot (h.trans hsum) + +/-- The product bound is nondegenerate: the pair of limit points survives stage two. -/ +theorem enat_product_top_mem_stage_two : + (⊤, ⊤) ∈ (⊤ : Closeds (ℕ∞ × ℕ∞)).cantorBendixson (2 : Ordinal) := by + have htop : (⊤ : ℕ∞) ∈ derivedSet (univ : Set ℕ∞) := by rw [enat_derivedSet_univ]; simp + have hrow (y : ℕ∞) : (⊤, y) ∈ derivedSet (univ : Set (ℕ∞ × ℕ∞)) := by + have h := (Continuous.prodMk_left y).image_derivedSet + (fun _ _ heq ↦ congrArg Prod.fst heq) ⟨⊤, htop, rfl⟩ + exact derivedSet_mono _ _ (subset_univ _) h + have hcol : (⊤, ⊤) ∈ derivedSet (derivedSet (univ : Set (ℕ∞ × ℕ∞))) := by + have h := ((continuous_const : Continuous fun _ : ℕ∞ ↦ (⊤ : ℕ∞)).prodMk + continuous_id).image_derivedSet (fun _ _ heq ↦ congrArg Prod.snd heq) ⟨⊤, htop, rfl⟩ + exact derivedSet_mono _ _ (by rintro _ ⟨y, _, rfl⟩; exact hrow y) h + rw [show (2 : Ordinal) = (0 + 1) + 1 by simp only [zero_add, one_add_one_eq_two], + Closeds.cantorBendixson_add_one, Closeds.cantorBendixson_add_one, + Closeds.cantorBendixson_zero] + change (⊤, ⊤) ∈ ((⊤ : Closeds (ℕ∞ × ℕ∞)).derived.derived : Set (ℕ∞ × ℕ∞)) + simpa only [Closeds.coe_derived, Closeds.coe_top] using hcol + +/-- The sequence limit has point rank exactly one, rather than its order index `omega`. -/ +theorem enat_top_rank : + (⊤ : Closeds ℕ∞).cantorBendixsonRank (Set.isPWO_of_wellQuasiOrderedLE _) ⊤ = 1 := by + apply ((⊤ : Closeds ℕ∞).cantorBendixsonRank_eq_iff (Set.isPWO_of_wellQuasiOrderedLE _) + (by trivial) 1).mpr + constructor + · rw [enat_stage_one] + exact mem_singleton _ + · rw [one_add_one_eq_two, enat_stage_two] + exact notMem_empty _ + +/-- Every finite point is isolated, so its point rank is zero. -/ +theorem enat_nat_rank (n : ℕ) : + (⊤ : Closeds ℕ∞).cantorBendixsonRank (Set.isPWO_of_wellQuasiOrderedLE _) n = 0 := by + apply ((⊤ : Closeds ℕ∞).cantorBendixsonRank_eq_iff (Set.isPWO_of_wellQuasiOrderedLE _) + (by trivial) 0).mpr + constructor + · simp + · rw [zero_add, enat_stage_one] + exact ENat.coe_ne_top n + +/-- The isolated rank-zero points are dense even though the limit point has rank one. -/ +theorem enat_rank_zero_dense : + closure {x : ℕ∞ | (⊤ : Closeds ℕ∞).cantorBendixsonRank + (Set.isPWO_of_wellQuasiOrderedLE _) x = 0} = univ := by + have hm (x : ℕ∞) : x ∈ (⊤ : Closeds ℕ∞) := by trivial + simpa only [hm, true_and, Closeds.cantorBendixson_zero, Closeds.coe_top] using + (⊤ : Closeds ℕ∞).closure_rank_level_eq (Set.isPWO_of_wellQuasiOrderedLE _) 0 + +end Tests.CantorBendixson diff --git a/LeanPool/ConwayRefinement/Solution.lean b/LeanPool/ConwayRefinement/Solution.lean new file mode 100644 index 0000000000..d2dd504195 --- /dev/null +++ b/LeanPool/ConwayRefinement/Solution.lean @@ -0,0 +1,27 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinementProof + +/-! +# Conway's refinement theorem + +This module connects Palomar's advertised declaration to the proof. +-/ + +public noncomputable section + +universe u + +namespace ConwayRefinement.Palomar + +/-- Conway's refinement theorem for omnific integers, stated from first principles. -/ +theorem conwayRefinement : + ConwayRefinement.Standalone.InlineConwayRefinement.Surreal.ConwayConjecture.{u} := + ConwayRefinement.Standalone.InlineConwayRefinement.Surreal.ConwayConjecture.proof + +end ConwayRefinement.Palomar diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index 95e0c8ad83..89cce05d9f 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -9966,3 +9966,32 @@ projects: msc: - '90C35' - '05C21' + - title: Conway refinement for omnific integers + summary: 'Proves multiplicative refinement for omnific integers: every equality ab = cd admits a + two-by-two factor refinement. Develops factorization and refinement of generalized power-series + integer parts and connects these to surreal-number and standalone Mathlib formulations.' + branch: ordered algebra + main_declarations: + - ConwayRefinement.Palomar.conwayRefinement + main_results: + - declaration: ConwayRefinement.Palomar.conwayRefinement + informal: If four omnific integers satisfy ab = cd, there are omnific integers e, f, g, h with + a = ef, b = gh, c = eg, and d = fh, including degenerate cases. + tags: + - surreal-numbers + - ordered-algebra + - factorization + msc: + - 06A05 + - 13F25 + provenance: AI + slug: conway-refinement + entry_module: LeanPool.ConwayRefinement + authors: + - Dan Abramov + source: + url: https://github.com/gaearon/conway-refinement + github_repo: gaearon/conway-refinement + commit: 264445c93b78554c408e99e4e7f663693b4e91ab + license: Apache-2.0 + status: verified From 330d9215a34fb854203df54f1320be0ccaae987f Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 18:42:51 +0000 Subject: [PATCH 02/18] Port complete upstream content to current Mathlib and improve lint compliance --- .../CombinatorialGames/Game/Basic.lean | 3 +- .../CombinatorialGames/Game/Birthday.lean | 2 +- .../CombinatorialGames/Game/Classes.lean | 2 +- .../CombinatorialGames/Game/IGame.lean | 13 +++-- .../CombinatorialGames/Game/Player.lean | 9 +++- .../CombinatorialGames/Mathlib/Small.lean | 4 +- .../CombinatorialGames/Surreal/Basic.lean | 4 +- .../CombinatorialGames/Surreal/Dyadic.lean | 4 +- .../Surreal/HahnSeries/Basic.lean | 14 +++--- .../Surreal/Multiplication.lean | 2 +- .../CombinatorialGames/Surreal/Pow.lean | 6 +-- .../DirectSum/GermFinitePartIdeal.lean | 6 +-- .../Algebra/DirectSum/GermPolynomial.lean | 4 +- .../Algebra/DirectSum/GermSuccessorStep.lean | 26 +++++----- .../Algebra/DirectSum/GermSyzygy.lean | 12 ++--- .../Algebra/DirectSum/HomogeneousPrime.lean | 2 +- .../Algebra/DirectSum/LeadingGrade.lean | 1 - .../Algebra/GradedRing/Extension.lean | 6 +-- .../Algebra/GradedRing/HomogeneousSpan.lean | 4 +- .../Algebra/GradedRing/OrdinalGenerators.lean | 4 +- .../LoweringDerivation/Correction.lean | 4 +- .../Algebra/LoweringDerivation/Grading.lean | 6 +-- .../LoweringDerivation/IdealGEGraded.lean | 4 +- .../Algebra/LoweringDerivation/Mu.lean | 8 ++-- .../Algebra/MvPolynomial/BaseChange.lean | 4 +- .../Algebra/MvPolynomial/Components.lean | 18 +++---- .../Algebra/MvPolynomial/ComponentsSpan.lean | 6 +-- .../Algebra/MvPolynomial/Expansion.lean | 2 +- .../MvPolynomial/FinitePartDecomposition.lean | 4 +- .../MvPolynomial/FinitePartErasure.lean | 6 +-- .../Algebra/MvPolynomial/FinitePartVars.lean | 2 +- .../LimitOrdinalContradiction.lean | 2 +- .../MvPolynomial/OrdinalDerivation.lean | 10 ++-- .../Algebra/MvPolynomial/Syzygy.lean | 6 +-- .../MvPolynomial/WeightedTotalDegree.lean | 22 ++++----- .../Algebra/Valuation/BasisOver.lean | 4 +- .../Algebra/Valuation/DegreeInitialForm.lean | 14 +++--- .../Algebra/Valuation/DegreeOver.lean | 2 +- .../Valuation/DegreeRepresentatives.lean | 10 ++-- .../Algebra/Valuation/DegreeSum.lean | 8 ++-- .../Algebra/Valuation/FiltrationDegree.lean | 4 +- .../Valuation/Tests/AssociatedGraded.lean | 2 +- .../ConwayRefinement/Blueprint.lean | 48 ++++++++++--------- .../Data/Multiset/SelectionComplexity.lean | 6 +-- .../OmnificInteger/DegreeTwoNormalForm.lean | 4 +- .../OmnificInteger/OneRowNormalForm.lean | 4 +- .../CardinalTruncationDomainEmbedding.lean | 6 +-- .../HahnSeries/ConvexQuotientSplitting.lean | 4 +- .../HahnSeries/EPrimitive.lean | 6 +-- .../HahnSeries/FactorCoefficients.lean | 8 ++-- .../DegreeTwo/DegreeTwoExample.lean | 8 ++-- .../FactorizationClassification.lean | 2 +- .../TranslatedSpanFactorization.lean | 12 ++--- .../Factorization/MaximalFinite.lean | 4 +- .../Factorization/RVMaximalFinite.lean | 2 +- .../Random/CoefficientRandom.lean | 14 +++--- .../Random/GradedIrreducible.lean | 6 +-- .../Random/PrincipalIrreducible.lean | 2 +- .../Factorization/Random/ReducibleSpan.lean | 4 +- .../Factorization/Random/SupportRandom.lean | 2 +- .../Factorization/SeriesMaximalFinite.lean | 2 +- .../Tests/GradedDivisibility.lean | 4 +- .../HahnSeries/FiniteSupport.lean | 2 +- .../FiniteSupportNormalization.lean | 4 +- .../CofactorInduction.lean | 42 ++++++++-------- .../AlgebraicIndependence/Convolution.lean | 18 +++---- .../AlgebraicIndependence/Derivation.lean | 4 +- .../DerivationIdeal.lean | 22 ++++----- .../AlgebraicIndependence/DerivationSet.lean | 4 +- .../AlgebraicIndependence/Derivative.lean | 18 +++---- .../Germ/AlgebraicIndependence/Germ.lean | 2 +- .../GlobalCofactors.lean | 4 +- .../LeadingCoefficient.lean | 2 +- .../Germ/AlgebraicIndependence/Leibniz.lean | 14 +++--- .../AlgebraicIndependence/LiftFamily.lean | 2 +- .../Germ/AlgebraicIndependence/Lifts.lean | 16 +++---- .../LimitOrdinalEvaluation.lean | 2 +- .../LimitOrdinalRelationAtCutoff.lean | 4 +- .../AlgebraicIndependence/LinearMaximal.lean | 2 +- .../LowerTruncationDegree.lean | 16 +++---- .../OrderedIntervalCantorBendixson.lean | 4 +- .../PartialDerivativeIndices.lean | 2 +- .../PartialDerivativesAtLimitOrdinal.lean | 4 +- ...calarLeadingCoefficientAtLimitOrdinal.lean | 4 +- .../SeparatedPieceCantorBendixson.lean | 12 ++--- .../SyzygyIntegration.lean | 16 +++---- .../TranslatedTruncationInterpolation.lean | 10 ++-- ...anslatedTruncationInterpolationOnSets.lean | 4 +- .../AlgebraicIndependence/Truncation.lean | 14 +++--- .../TruncationExpansion.lean | 4 +- .../TruncationPolynomial.lean | 26 +++++----- .../IntegerPart/ClassTruncation.lean | 18 +++---- .../IntegerPart/FiniteClassReduction.lean | 4 +- .../IntegerPart/IntegerPartSplitting.lean | 2 +- .../IntegerPart/LimitTailPrimality.lean | 2 +- .../IntegerPart/ReducedCharacterization.lean | 8 ++-- .../HahnSeries/IntegerPart/Reduction.lean | 2 +- .../CardinalTruncationClosedClass.lean | 4 +- .../ClosedClassRefinementTransport.lean | 8 ++-- .../ConvexRestrictionFactorization.lean | 6 +-- .../Refinement/FiniteGermError.lean | 20 ++++---- .../TruncationIntegerPartFractionField.lean | 2 +- .../IntegerPart/Tests/ClassTruncation.lean | 1 + .../ConwayRefinement/HahnSeries/Iterate.lean | 10 ++-- .../HahnSeries/LimitTailQuotient.lean | 1 + .../HahnSeries/Nonpositive.lean | 6 +-- .../AlgebraicIndependence/BaseChange.lean | 2 +- .../AlgebraicIndependence/DerivAt.lean | 2 +- .../LeadingCoefficient.lean | 14 +++--- .../AlgebraicIndependence/Lifts.lean | 4 +- .../LimitOrdinalRelationAtCutoff.lean | 2 +- .../AlgebraicIndependence/LowDegreeParts.lean | 2 +- .../LoweringDerivation.lean | 4 +- .../AlgebraicIndependence/OmegaSupport.lean | 8 ++-- .../PartialDerivativeIndices.lean | 2 +- .../AlgebraicIndependence/Partials.lean | 4 +- .../AlgebraicIndependence/Pieces.lean | 10 ++-- .../AlgebraicIndependence/Shift.lean | 4 +- .../SumAlongCutoffs.lean | 12 ++--- .../SupportLoweringPieces.lean | 2 +- .../TruncationExpansion.lean | 2 +- .../TruncationPolynomial.lean | 2 +- .../TruncationsIdeal.lean | 6 +-- .../OrdinalValue/ComplexityDecrease.lean | 2 +- .../HahnSeries/OrdinalValue/Convolution.lean | 24 +++++----- .../OrdinalValue/ConvolutionList.lean | 12 ++--- .../OrdinalValue/CriticalPointExistence.lean | 4 +- .../HahnSeries/OrdinalValue/GermValueCut.lean | 2 +- .../OrdinalValue/Irreducibility.lean | 4 +- .../HahnSeries/OrdinalValue/OneRow.lean | 4 +- .../OrdinalValueFinalSegment.lean | 4 +- .../PrincipalComponentTensor.lean | 4 +- .../PrincipalSubringMonoidAlgebra.lean | 2 +- .../OrdinalValue/ResidualPointCofinality.lean | 2 +- .../OrdinalValue/ResidualPointOrderType.lean | 4 +- .../OrdinalValue/Statements/ProductValue.lean | 4 +- .../OrdinalValue/Tests/ConvolutionList.lean | 2 +- .../OrdinalValue/Tests/CriticalPoint.lean | 2 +- .../OrdinalValue/Tests/ResidualPoint.lean | 4 +- .../HahnSeries/OrdinalValue/Truncation.lean | 10 ++-- .../PolynomialAlgebra/CompleteGerm.lean | 2 +- .../HahnSeries/SeparatedPieceSum.lean | 12 ++--- .../HahnSeries/SubgroupAlgebra.lean | 20 ++++---- .../HahnSeries/SubgroupGCD.lean | 4 +- .../HahnSeries/SubgroupSupport.lean | 20 ++++---- .../AlgebraicIndependentDet.lean | 8 ++-- .../LinearAlgebra/IndicatorFinsupp.lean | 18 +++---- .../Order/Filter/Germ/LinearMap.lean | 2 +- .../Order/Filter/Tests/FunAtZeroMinus.lean | 4 +- .../Ordinal/AdditivelyPrincipal.lean | 2 +- .../SetTheory/Ordinal/CantorBendixson.lean | 12 ++--- .../SetTheory/Ordinal/SetOrderType.lean | 24 +++++----- .../SetTheory/Ordinal/Sumset.lean | 4 +- .../Examples/DegreeTwoPrimeProof.lean | 4 +- .../Examples/OneRowPrimeProof.lean | 4 +- .../Support/DegreeTwoExample.lean | 4 +- .../Support/FinitePowerFamily.lean | 4 +- .../Support/OmegaOmegaBoundary.lean | 4 +- .../Support/OneRowExample.lean | 4 +- ...PrincipalRVAlgebraicIndependenceProof.lean | 8 ++-- .../Examples/NegativeMonomialRootsProof.lean | 6 +-- .../Support/HahnLimitTailQuotient.lean | 1 + .../Support/InlineConwayRefinementProof.lean | 2 +- .../Mathlib/Support/InlineSurreal.lean | 18 ++++--- .../Surreal/HahnSeries/NormalFormAdd.lean | 2 +- .../Surreal/HahnSeries/NormalFormBasic.lean | 2 +- .../HahnSeries/NormalFormRecursion.lean | 26 +++++----- .../Surreal/HahnSeries/Transfer.lean | 4 +- .../Primality/IrreducibleOmnificIntegers.lean | 4 +- .../ConwayRefinement/Surreal/Round.lean | 4 +- .../Topology/CantorBendixsonRank.lean | 4 +- .../Topology/Order/ArchimedeanBallBase.lean | 6 +-- .../Topology/Order/ClosedPWO.lean | 6 +-- .../Topology/Order/PWOAddition.lean | 4 +- .../Topology/Order/SmallClosedSubspace.lean | 2 +- .../Tests/CantorBendixsonConvexCover.lean | 20 ++++---- .../Topology/Order/Tests/PWOAddition.lean | 14 +++--- 177 files changed, 636 insertions(+), 621 deletions(-) diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Basic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Basic.lean index c63448407c..fe98076598 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Basic.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Basic.lean @@ -1,8 +1,7 @@ /- Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Violeta Hernández Palacios, Reid Barton, Mario Carneiro, Isabel Longbottom, Kim Morrison, -Apurva Nakade, Yuyang Zhao +Authors: Violeta Hernández Palacios, Reid Barton, Mario Carneiro, Isabel Longbottom, Kim Morrison, Apurva Nakade, Yuyang Zhao -/ module diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean index a9045da147..ec95eca130 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean @@ -63,7 +63,7 @@ theorem birthday_eq_max (x : IGame) : birthday x = apply eq_of_forall_lt_iff simp [lt_birthday_iff, NatOrdinal.lt_iSup_iff] -@[aesop apply unsafe] +@[aesop apply safe] theorem birthday_lt_of_mem_moves {p : Player} {x y : IGame} (hy : y ∈ x.moves p) : y.birthday < x.birthday := lt_birthday_iff.2 ⟨p, y, hy, le_rfl⟩ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean index 92b5145539..1cd1610cc3 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean @@ -128,7 +128,7 @@ variable (x y : IGame) [hx : Impartial x] [hy : Impartial y] omit hx in theorem sub_equiv : x - y ≈ x + y := add_congr_right (neg_equiv y) -@[aesop unsafe 50% apply] +@[aesop safe apply] protected theorem of_mem_moves {p} {x y : IGame} [h : Impartial x] : y ∈ x.moves p → Impartial y := (impartial_def.1 h).2 p y diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean index 242f7a9fe5..5d36eccbb0 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean @@ -1,8 +1,7 @@ /- Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Violeta Hernández Palacios, Reid Barton, Mario Carneiro, Isabel Longbottom, Kim Morrison, -Yuyang Zhao +Authors: Violeta Hernández Palacios, Reid Barton, Mario Carneiro, Isabel Longbottom, Kim Morrison, Yuyang Zhao -/ module @@ -182,7 +181,7 @@ theorem ofSets_inj {s₁ s₂ t₁ t₂ : Set IGame} [Small s₁] [Small s₂] [ def Subposition : IGame → IGame → Prop := Relation.TransGen fun x y => x ∈ ⋃ p, y.moves p -@[aesop unsafe apply 50%] +@[aesop safe apply] theorem Subposition.of_mem_moves {p} {x y : IGame} (h : x ∈ y.moves p) : Subposition x y := Relation.TransGen.single (Set.mem_iUnion_of_mem p h) @@ -214,7 +213,7 @@ theorem subposition_wf : WellFounded Subposition := by -- We make no use of `IGame`'s definition from a `QPF` after this point. attribute [irreducible] IGame -instance : IsWellFounded _ Subposition := ⟨subposition_wf⟩ +instance : WellFounded _ Subposition := ⟨subposition_wf⟩ instance : WellFoundedRelation IGame := ⟨Subposition, instIsWellFoundedSubposition.wf⟩ theorem Subposition.irrefl (x : IGame) : ¬Subposition x x := _root_.irrefl x @@ -1017,7 +1016,7 @@ theorem eq_intCast_of_mem_rightMoves_intCast {n : ℤ} {x : IGame} (hx : x ∈ n /-! ### Multiplication -/ -- TODO: upstream -attribute [aesop apply unsafe 50%] Prod.Lex.left Prod.Lex.right +attribute [aesop apply safe] Prod.Lex.left Prod.Lex.right private def mul' (x y : IGame) : IGame := !{(range fun a : (xᴸ ×ˢ yᴸ ∪ xᴿ ×ˢ yᴿ :) ↦ @@ -1211,7 +1210,7 @@ private theorem inv_eq'' {x : IGame} : private theorem inv_eq {x : IGame.{u}} (hx : 0 < x) : x⁻¹ = !{.range (InvTy.val x left) | .range (InvTy.val x right)} := by - rw [inv_eq'', if_pos hx, inv'] + rw [inv_eq'', ite_eq_left hx, inv'] rfl private theorem inv_eq' {x : IGame.{u}} (hx : 0 < x) : @@ -1243,7 +1242,7 @@ def invOption (x y a : IGame) : IGame := private theorem invOption_eq {x y a : IGame} (hy : 0 < y) : invOption x y a = (1 + (y - x) * a) * inv' y := by - rw [invOption, IGame.div_eq_mul_inv, inv_eq'', if_pos hy] + rw [invOption, IGame.div_eq_mul_inv, inv_eq'', ite_eq_left hy] theorem zero_mem_leftMoves_inv {x : IGame} (hx : 0 < x) : 0 ∈ x⁻¹ᴸ := by rw [inv_eq hx, leftMoves_ofSets] diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Player.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Player.lean index 108cfa3a69..0115a77e49 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Player.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Player.lean @@ -6,6 +6,9 @@ Authors: Yuyang Zhao module public import Mathlib.Algebra.Ring.Defs +public import Mathlib.Algebra.Group.Defs +public import Mathlib.Data.Finset.Insert +import Mathlib.Algebra.Ring.Defs public import Mathlib.Data.Fintype.Defs public import Mathlib.Logic.Small.Defs @@ -31,7 +34,11 @@ inductive Player where | left : Player /-- The Right player. -/ | right : Player -deriving DecidableEq, Fintype, Inhabited +deriving DecidableEq, Inhabited + +instance : Fintype Player where + elems := {Player.left, Player.right} + complete := by intro p; cases p <;> simp namespace Player diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib/Small.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib/Small.lean index 851817ef32..c1429e0707 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib/Small.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib/Small.lean @@ -33,7 +33,9 @@ private theorem small_level (x : α) : ∀ n, Small.{u} (level r x n) refine @small_sUnion _ _ ?_ ?_ · have := small_level x n exact small_image .. - · simp_all + · intro ⟨a, ha⟩ + obtain ⟨b, _, rfl⟩ := ha + exact H b private theorem small_sUnion_level (x : α) : Small.{u} (⋃₀ range (level r x)) := by refine @small_sUnion _ _ ?_ ?_ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Basic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Basic.lean index 395ee522a2..10c8264fc4 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Basic.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Basic.lean @@ -295,14 +295,14 @@ theorem mk_ofSets {s t : Set IGame.{u}} [Small.{u} s] [Small.{u} t] {H : Numeric rw [mk_ofSets'] congr!; aesop -@[aesop apply unsafe] +@[aesop apply safe] theorem lt_ofSets_of_mem_left {s t : Set Surreal.{u}} [Small.{u} s] [Small.{u} t] {H : ∀ x ∈ s, ∀ y ∈ t, x < y} {x : Surreal} (hx : x ∈ s) : x < !{s | t} := by rw [lt_iff_not_ge, ← toGame_le_iff, toGame_ofSets] exact Game.lf_ofSets_of_mem_left (Set.mem_image_of_mem _ hx) -@[aesop apply unsafe] +@[aesop apply safe] theorem ofSets_lt_of_mem_right {s t : Set Surreal.{u}} [Small.{u} s] [Small.{u} t] {H : ∀ x ∈ s, ∀ y ∈ t, x < y} {x : Surreal} (hx : x ∈ t) : !{s | t} < x := by diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Dyadic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Dyadic.lean index 28f466679e..6e8d347279 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Dyadic.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Dyadic.lean @@ -145,7 +145,7 @@ decreasing_by dyadic_wf noncomputable instance : Coe Dyadic IGame := ⟨toIGame⟩ theorem toIGame_of_den_eq_one {x : Dyadic} (hx : x.den = 1) : (x : IGame) = x.num := by - rw [toIGame, dif_pos hx] + rw [toIGame, dite_eq_left hx] @[simp] theorem toIGame_intCast (n : ℤ) : ((n : Dyadic) : IGame) = n := by simpa using toIGame_of_den_eq_one (Dyadic.den_intCast n) @@ -156,7 +156,7 @@ theorem toIGame_of_den_eq_one {x : Dyadic} (hx : x.den = 1) : (x : IGame) = x.nu theorem toIGame_of_den_ne_one {x : Dyadic} (hx : x.den ≠ 1) : x = !{{(lower x : IGame)} | {(upper x : IGame)}} := - by rw [toIGame, dif_neg hx] + by rw [toIGame, dite_eq_right hx] @[simp] theorem toIGame_half : half = ½ := by diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries/Basic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries/Basic.lean index 2333ff6215..20f6cbb362 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries/Basic.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries/Basic.lean @@ -219,12 +219,12 @@ theorem support_trunc_anti {x : SurrealHahnSeries} : Antitone fun i ↦ (trunc x @[simp] theorem coeff_trunc_of_lt {x : SurrealHahnSeries} {i j : Surreal} (h : i < j) : (x.trunc i).coeff j = x.coeff j := - if_pos h + ite_eq_left h @[simp] theorem coeff_trunc_of_le {x : SurrealHahnSeries} {i j : Surreal} (h : j ≤ i) : (x.trunc i).coeff j = 0 := - if_neg h.not_gt + ite_eq_right h.not_gt theorem coeff_trunc_eq_zero {x : SurrealHahnSeries} {i j : Surreal} (h : x.coeff i = 0) : (x.trunc j).coeff i = 0 := by @@ -393,11 +393,11 @@ def coeffIdx (x : SurrealHahnSeries) (i : Ordinal) : ℝ := theorem coeffIdx_of_lt {x : SurrealHahnSeries} {i : Ordinal} (h : i < x.length) : x.coeffIdx i = x.coeff (x.exp ⟨i, h⟩) := by - rw [coeffIdx, dif_pos] + rw [coeffIdx, dite_eq_left] theorem coeffIdx_of_le {x : SurrealHahnSeries} {i : Ordinal} (h : x.length ≤ i) : x.coeffIdx i = 0 := by - rw [coeffIdx, dif_neg h.not_gt] + rw [coeffIdx, dite_eq_right h.not_gt] @[simp] theorem coeffIdx_zero : coeffIdx 0 = 0 := by @@ -437,11 +437,11 @@ theorem support_truncIdx (x : SurrealHahnSeries) (i : Ordinal) : theorem truncIdx_of_lt {x : SurrealHahnSeries} {i : Ordinal} (h : i < x.length) : x.truncIdx i = x.trunc (x.exp ⟨i, h⟩) := by - rw [truncIdx, dif_pos] + rw [truncIdx, dite_eq_left] theorem truncIdx_of_le {x : SurrealHahnSeries} {i : Ordinal} (h : x.length ≤ i) : x.truncIdx i = x := by - rw [truncIdx, dif_neg h.not_gt] + rw [truncIdx, dite_eq_right h.not_gt] @[simp] theorem truncIdx_zero : truncIdx 0 = 0 := by @@ -523,7 +523,7 @@ def term (x : SurrealHahnSeries) (i : Ordinal) : Surreal := theorem term_of_lt {x : SurrealHahnSeries} {i : Ordinal} (hi : i < x.length) : x.term i = x.coeffIdx i * ω^ (x.exp ⟨i, hi⟩).1 := - dif_pos hi + dite_eq_left hi @[simp] theorem term_eq_zero {x : SurrealHahnSeries} {i : Ordinal} : x.term i = 0 ↔ x.length ≤ i := by diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean index 4f4425500e..b8fe4b95f3 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean @@ -164,7 +164,7 @@ def ArgsRel := InvImage (TransGen <| CutExpand fun x y => ∃ p, x ∈ y.moves p lemma argsRel_wf : WellFounded ArgsRel := InvImage.wf _ (Subrelation.wf (fun h => h.elim fun _ => Subposition.of_mem_moves) subposition_wf).cutExpand.transGen -instance : IsWellFounded _ ArgsRel := ⟨argsRel_wf⟩ +instance : WellFounded _ ArgsRel := ⟨argsRel_wf⟩ /-- The property that all arguments are numeric is leftward-closed under `ArgsRel`. -/ lemma ArgsRel.numeric_closed {a' a} : ArgsRel a' a → a.Numeric → a'.Numeric := diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Pow.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Pow.lean index 7cc01df2a1..338dc134ad 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Pow.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Pow.lean @@ -667,14 +667,14 @@ instance _root_.IGame.Numeric.wlog (x : IGame) : Numeric x.wlog := by @[simp] theorem mk_wlog (x : IGame) [h : Numeric x] : mk x.wlog = (mk x).wlog := by - simp_rw [IGame.wlog, dif_pos h, Surreal.out_eq] + simp_rw [IGame.wlog, dite_eq_left h, Surreal.out_eq] @[simp] theorem wlog_zero : wlog 0 = 0 := - dif_pos rfl + dite_eq_left rfl theorem wpow_wlog_veq (h : x ≠ 0) : ω^ wlog x =ᵥ x := by - rw [wlog, dif_neg h] + rw [wlog, dite_eq_right h] exact Classical.choose_spec (exists_wpow_veq h) @[simp] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermFinitePartIdeal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermFinitePartIdeal.lean index 3e5e713c87..23e0c60c49 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermFinitePartIdeal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermFinitePartIdeal.lean @@ -162,12 +162,12 @@ theorem pderiv_mem_span_varsOfFinitePart_of_forall_lt ∀ t ∈ s, f t = aeval x (mkDerivation K (fun i ↦ g i t) (pderiv j F)) := by refine ⟨fun t ↦ if ht : t ∈ s then aeval x (mkDerivation K (fun i ↦ g i t) (pderiv j F)) else 0, fun t ↦ ?_, - fun t ht ↦ dif_pos ht⟩ + fun t ht ↦ dite_eq_left ht⟩ beta_reduce by_cases ht : t ∈ s - · rw [dif_pos ht] + · rw [dite_eq_left ht] exact mem_span_of_mkDerivation hg hqdef ih (hsdef t ht) - · rw [dif_neg ht] + · rw [dite_eq_right ht] exact Ideal.zero_mem _ have hΔf : Δ (aeval x (pderiv j F)) = (f : Germ l R) := by rw [hg.map_aeval hΔ] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermPolynomial.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermPolynomial.lean index fc3027adc1..fcdcafda94 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermPolynomial.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermPolynomial.lean @@ -442,7 +442,7 @@ theorem eq_zero_of_eventually_mkDerivation_eq_zero [CharZero K] (hwt : ∀ i, 1 have hcoeff : ∀ γ, mkDerivation K (fun i ↦ g i γ) F = 0 → ∀ d ≤ D, q γ d = 0 := by intro γ hγ d hd have := xCoeff_sum_mul_X_pow x₀ (Finset.range (D + 1)) (q := q γ) (fun d _ ↦ hqsupp γ d) d - rwa [← hDexp γ, hγ, map_zero, if_pos (Finset.mem_range.mpr (by omega)), eq_comm] at this + rwa [← hDexp γ, hγ, map_zero, ite_eq_left (Finset.mem_range.mpr (by omega)), eq_comm] at this -- the coefficient of `(X x₀)^D`: `∂_γ c_D = 0`, so `c_D` is a non-zero scalar `a` have hcD0 : ∀ᶠ γ in l, mkDerivation K (fun i ↦ g i γ) (c D) = 0 := hD.mono fun γ hγ ↦ by simpa [hq, hcD1] using hcoeff γ hγ D le_rfl @@ -494,7 +494,7 @@ theorem eq_zero_of_eventually_mkDerivation_eq_zero [CharZero K] (hwt : ∀ i, 1 rw [haeval, zero_sub, neg_mem_iff] at hcf have hcx := hcfcoeff x₀ rw [hind (wt x₀) cf hcfw hcf, Finsupp.coe_zero, Pi.zero_apply, hh, coeff_add, hc, coeff_xCoeff, - if_neg (by simp), zero_add, C_mul_X_eq_monomial, coeff_monomial, if_pos rfl] at hcx + ite_eq_right (by simp), zero_add, C_mul_X_eq_monomial, coeff_monomial, ite_eq_left rfl] at hcx exact ha0 ((mul_eq_zero.mp hcx.symm).resolve_left (Nat.cast_ne_zero.mpr (by omega))) /-! ### Algebraic independence -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean index a0573239f9..b8c2e5b616 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean @@ -172,13 +172,13 @@ theorem injectiveAt_of_forall_lt [CharZero K] (hgz : GradeZeroScalars A) intro t ht by_cases htB : t ∈ B · rw [Finset.sum_eq_single ⟨t, htB⟩] - · rw [ha', if_pos htB, if_pos rfl, mul_one] + · rw [ha', ite_eq_left htB, ite_eq_left rfl, mul_one] · intro b _ hb - rw [ha', if_pos htB, if_neg fun h ↦ hb (Subtype.ext h), mul_zero] + rw [ha', ite_eq_left htB, ite_eq_right fun h ↦ hb (Subtype.ext h), mul_zero] · intro h exact absurd (Finset.mem_univ _) h · rw [hsum t ht] - exact Finset.sum_congr rfl fun b _ ↦ by rw [ha', if_neg htB] + exact Finset.sum_congr rfl fun b _ ↦ by rw [ha', ite_eq_right htB] -- `F = ∑_b c_b W_b` obtain ⟨W, hW⟩ : ∃ W : ↥B → MvPolynomial ι K, ∀ b, W b = ∑ t ∈ T, a' t b * (X t + V t) := ⟨_, fun _ ↦ rfl⟩ @@ -247,9 +247,9 @@ theorem injectiveAt_of_forall_lt [CharZero K] (hgz : GradeZeroScalars A) · have h : ∃ β, β + lam b = e := ⟨β, hβ⟩ have hch : ∀ h' : ∃ β, β + lam b = e, Classical.choose h' = β := fun h' ↦ add_right_cancel ((Classical.choose_spec h').trans hβ.symm) - rw [hcomp, dif_pos h, hch] + rw [hcomp, dite_eq_left h, hch] exact (decompose (A) (w b) β).2 - · rw [hcomp, dif_neg h] + · rw [hcomp, dite_eq_right h] have hcomp_syz : ∀ σ ∈ L, ∀ e, ∑ b : ↥B, aeval x (c b) * comp (ev σ) e b = 0 := by intro σ hσ e have h1 : ∀ b : ↥B, aeval x (c b) * comp (ev σ) e b = @@ -258,8 +258,8 @@ theorem injectiveAt_of_forall_lt [CharZero K] (hgz : GradeZeroScalars A) rw [GradedRing.proj_apply, coe_decompose_mul_of_left_mem (𝒜 := A) (aeval_mem_of_forall_mem hx.mem (hchom b (hBT b.2))) (aeval x (σ b)) e, hcomp, hev] by_cases h : ∃ β, β + lam b = e - · rw [dif_pos h, dif_pos h] - · rw [dif_neg h, dif_neg h, mul_zero] + · rw [dite_eq_left h, dite_eq_left h] + · rw [dite_eq_right h, dite_eq_right h, mul_zero] have h2 : ∑ b : ↥B, aeval x (c b) * aeval x (σ b) = 0 := by have := congrArg (aeval x) (hL σ hσ).2 rw [map_sum, map_zero] at this @@ -271,7 +271,7 @@ theorem injectiveAt_of_forall_lt [CharZero K] (hgz : GradeZeroScalars A) by_contra hβ apply hne by_cases h : ∃ β', β' + lam b = e - · rw [hcomp, hev, dif_pos h] at hmem hne ⊢ + · rw [hcomp, hev, dite_eq_left h] at hmem hne ⊢ -- a nonzero element of `P_β` and of `P_{β'}` forces `β = β'` have hβ' : β = Classical.choose h := by by_contra hne' @@ -282,7 +282,7 @@ theorem injectiveAt_of_forall_lt [CharZero K] (hgz : GradeZeroScalars A) rw [hβ'] at hβ rw [decompose_aeval hx.mem, weightedHomogeneousComponent_eq_zero_of_forall_vars (fun i hi ↦ hΛ i (mem_supported.mp ((hL σ hσ).1 b) hi)) hβ, map_zero] - · rw [hcomp, dif_neg h] at hne + · rw [hcomp, dite_eq_right h] at hne exact absurd rfl hne -- the degrees occurring, and the sum of the components set E : Finset NatOrdinal := L.biUnion fun σ ↦ Finset.univ.biUnion fun b : ↥B ↦ @@ -301,7 +301,7 @@ theorem injectiveAt_of_forall_lt [CharZero K] (hgz : GradeZeroScalars A) have h : ∃ β', β' + lam b = β + lam b := ⟨β, rfl⟩ have hch : ∀ h' : ∃ β', β' + lam b = β + lam b, Classical.choose h' = β := fun h' ↦ add_right_cancel (Classical.choose_spec h') - rw [hcomp, dif_pos h, hch] + rw [hcomp, dite_eq_left h, hch] · intro e _ he rw [hcomp] split_ifs with h @@ -326,7 +326,7 @@ theorem injectiveAt_of_forall_lt [CharZero K] (hgz : GradeZeroScalars A) ⟨e, hcomp_hom _ _⟩ have heT : eT (comp (ev σ) e) = Classical.choose h := by simp only [heTdef] - rw [dif_pos h] + rw [dite_eq_left h] rw [heT] exact Classical.choose_spec h have hTPlim : ∀ w ∈ TP, ∀ (b : ↥B) β, w b ∈ A β → w b ≠ 0 → @@ -585,9 +585,9 @@ theorem injectiveAt_of_forall_lt [CharZero K] (hgz : GradeZeroScalars A) have hf0 := hx.independent (wt b) f hfsupp hfmem have hfb := congrArg (fun g : ι →₀ K ↦ g b₀) hf0 simp only [Finsupp.coe_zero, Pi.zero_apply] at hfb - rw [hfapply, if_pos (hBT hb₀)] at hfb + rw [hfapply, ite_eq_left (hBT hb₀)] at hfb have hκ1 : κ' b₀ = 1 := by - rw [hκ', ha' b₀ b, if_pos hb₀, if_pos hb, coeff_zero_one] + rw [hκ', ha' b₀ b, ite_eq_left hb₀, ite_eq_left hb, coeff_zero_one] rw [hκ1] at hfb exact one_ne_zero hfb diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSyzygy.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSyzygy.lean index 1e1fb972d4..104a4265cd 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSyzygy.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSyzygy.lean @@ -83,12 +83,12 @@ theorem exists_eq_sum_smul_of_mem_span {lam : B → NatOrdinal.{z}} {T : Finset obtain ⟨r, _, hr⟩ := Submodule.mem_span_finset.mp hwN refine ⟨fun τ ↦ if h : ∃ ρ, ρ + eT τ = d then (decompose A (r τ) (Classical.choose h) : R) else 0, - fun τ _ ↦ ⟨fun ρ hρ ↦ ?_, fun h ↦ dif_neg h⟩, ?_⟩ + fun τ _ ↦ ⟨fun ρ hρ ↦ ?_, fun h ↦ dite_eq_right h⟩, ?_⟩ · have h : ∃ ρ, ρ + eT τ = d := ⟨ρ, hρ⟩ have hρ' : ∀ h' : ∃ ρ, ρ + eT τ = d, Classical.choose h' = ρ := fun h' ↦ add_right_cancel ((Classical.choose_spec h').trans hρ.symm) beta_reduce - rw [dif_pos h, hρ'] + rw [dite_eq_left h, hρ'] exact (decompose A (r τ) ρ).2 · funext b rw [Finset.sum_apply] @@ -121,9 +121,9 @@ theorem exists_eq_sum_smul_of_mem_span {lam : B → NatOrdinal.{z}} {T : Finset rw [Classical.choose_spec h1] refine add_right_cancel (b := lam b) ?_ rw [add_assoc, hβ', Classical.choose_spec h2, hβ] - rw [dif_pos h1, dif_pos h2, hch, mul_comm] + rw [dite_eq_left h1, dite_eq_left h2, hch, mul_comm] · have h2 : ¬ ∃ ρ, ρ + eT τ = d := fun h ↦ h1 (hiff.mpr h) - rw [dif_neg h1, dif_neg h2, zero_mul] + rw [dite_eq_right h1, dite_eq_right h2, zero_mul] · rw [(hT τ hτ).eq_zero hτb, mul_zero, ← GradedRing.proj_apply, map_zero, mul_zero] · -- no degree is forced: both sides vanish rw [hw.eq_zero hb] @@ -134,7 +134,7 @@ theorem exists_eq_sum_smul_of_mem_span {lam : B → NatOrdinal.{z}} {T : Finset have h2 : ¬ ∃ ρ, ρ + eT τ = d := fun ⟨ρ, hρ⟩ ↦ hb ⟨ρ + β', by rw [add_assoc, hβ', hρ]⟩ beta_reduce - rw [dif_neg h2, zero_mul] + rw [dite_eq_right h2, zero_mul] · rw [(hT τ hτ).eq_zero hτb, mul_zero] section Induction @@ -266,7 +266,7 @@ theorem mem_span_of_isHomogeneousTuple_of_sum_eq_zero obtain ⟨W, hWon, hWoff⟩ : ∃ W : T → B → R, (∀ t ∈ V, W t = fun b ↦ D b t) ∧ ∀ t ∉ V, W t = 0 := ⟨fun t ↦ if t ∈ V then (fun b ↦ D b t) else 0, - fun t ht ↦ if_pos ht, fun t ht ↦ if_neg ht⟩ + fun t ht ↦ ite_eq_left ht, fun t ht ↦ ite_eq_right ht⟩ have hWhom : ∀ t, IsHomogeneousTuple A lam (W t) d' := fun t ↦ by by_cases ht : t ∈ V · rw [hWon t ht, hd'def] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/HomogeneousPrime.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/HomogeneousPrime.lean index 9dd2b1b5e1..8e6b6befc9 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/HomogeneousPrime.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/HomogeneousPrime.lean @@ -155,7 +155,7 @@ theorem irreducible_of_homogeneous_of_grade_not_split {i : ι} (a : A i) have hle := grade_le_leadingGrade A hjne rw [hlz, WithBot.coe_le_coe] at hle exact hj (le_antisymm hle (hbot j)) - rw [hzj, DirectSum.of_apply, dif_neg (Ne.symm hj)] + rw [hzj, DirectSum.of_apply, dite_eq_right (Ne.symm hj)] have hz0 : z 0 ≠ 0 := by intro h apply hz diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/LeadingGrade.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/LeadingGrade.lean index 24be417e8c..9136e24de1 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/LeadingGrade.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/LeadingGrade.lean @@ -53,7 +53,6 @@ theorem leadingGrade_eq_bot_iff (x : DirectSum ι A) : leadingGrade A x = ⊥ ↔ x = 0 := by classical simp only [leadingGrade, Finset.max_eq_bot, DFinsupp.support_eq_empty] - rfl theorem grade_le_leadingGrade {x : DirectSum ι A} {i : ι} (hi : x i ≠ 0) : (i : WithBot ι) ≤ leadingGrade A x := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/Extension.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/Extension.lean index 87cf30d15b..8f5ab9c52d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/Extension.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/Extension.lean @@ -93,7 +93,7 @@ theorem exists_isMinimalSystem_extension (hwt : ∀ i, wt i ≠ 0) (hmem : ∀ i rw [hcdef, Finsupp.finsetSum_apply, Finset.sum_eq_single j] · rw [Finsupp.single_eq_same] · intro j' _ hj' - rw [Finsupp.single_apply, if_neg] + rw [Finsupp.single_apply, ite_eq_right] exact fun h ↦ hj' (Subtype.ext h) · intro h; exact absurd hj h have hcsupp : ∀ j ∈ c.support, wt j = β := by @@ -229,11 +229,11 @@ theorem exists_isMinimalSystem_extension (hwt : ∀ i, wt i ≠ 0) (hmem : ∀ i intro q by_cases h : (q : (𝒜 β) ⧸ D β) ∈ S β · have hspec := Classical.choose_spec (Set.mem_range.mp h) - have hq : g q = Sum.inl (Classical.choose (Set.mem_range.mp h)).1 := dif_pos h + have hq : g q = Sum.inl (Classical.choose (Set.mem_range.mp h)).1 := dite_eq_left h refine ⟨by rw [hq]; exact (Classical.choose (Set.mem_range.mp h)).2, fun hq' ↦ ?_⟩ rw [← hspec] exact congrArg (mkV β) (Subtype.ext (by change x' (g q) = _; rw [hq]; rfl)) - · have hq : g q = Sum.inr ⟨⟨β, hβ⟩, ⟨q, h⟩⟩ := dif_neg h + · have hq : g q = Sum.inr ⟨⟨β, hβ⟩, ⟨q, h⟩⟩ := dite_eq_right h refine ⟨by rw [hq]; rfl, fun hq' ↦ ?_⟩ rw [← hlift β ⟨q, h⟩] exact congrArg (mkV β) (Subtype.ext (by change x' (g q) = _; rw [hq]; rfl)) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/HomogeneousSpan.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/HomogeneousSpan.lean index 613337ae6f..db51b235d1 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/HomogeneousSpan.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/HomogeneousSpan.lean @@ -83,12 +83,12 @@ theorem exists_decompose_eq_sum_mul_of_mem_span {ι : Type w} [Fintype ι] {q : rw [← hr] exact Finset.sum_congr rfl fun j _ ↦ by rw [smul_eq_mul, mul_comm] refine ⟨fun j ↦ if h : ∃ β, β + c j = α then (decompose 𝒜 (r j) (Classical.choose h) : R) else 0, - fun j β hβ ↦ ?_, fun j h ↦ dif_neg h, ?_⟩ + fun j β hβ ↦ ?_, fun j h ↦ dite_eq_right h, ?_⟩ · have h : ∃ β, β + c j = α := ⟨β, hβ⟩ have hβ' : ∀ h' : ∃ β, β + c j = α, Classical.choose h' = β := fun h' ↦ add_right_cancel ((Classical.choose_spec h').trans hβ.symm) beta_reduce - rw [dif_pos h, hβ'] + rw [dite_eq_left h, hβ'] exact (decompose 𝒜 (r j) β).2 · calc (decompose 𝒜 x α : R) = GradedRing.proj 𝒜 α (∑ j, q j * r j) := by rw [GradedRing.proj_apply, hr'] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/OrdinalGenerators.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/OrdinalGenerators.lean index b0f8da8ee5..72bfb46933 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/OrdinalGenerators.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/OrdinalGenerators.lean @@ -449,12 +449,12 @@ theorem exists_linear_part (hwt : ∀ i, wt i ≠ 0) (hmem : ∀ i, x i ∈ 𝒜 · rw [Finsupp.single_apply, coeff_monomial] by_cases h : i = j · subst h; simp - · rw [if_neg h, if_neg] + · rw [ite_eq_right h, ite_eq_right] intro h' exact h (Finsupp.single_left_injective one_ne_zero h') · push Not at hd refine ⟨0, by simp, ?_, fun j ↦ by rw [Finsupp.coe_zero, Pi.zero_apply, coeff_monomial, - if_neg (hd j)]⟩ + ite_eq_right (hd j)]⟩ rw [map_zero, sub_zero] -- `d` has at least two factors: split off one variable have hd0 : d ≠ 0 := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Correction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Correction.lean index c434d27f1f..e1a0471508 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Correction.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Correction.lean @@ -69,11 +69,11 @@ def endpointSpace (j : ℕ) (α : NatOrdinal) : Submodule E (Fibre 𝒜) := omit [GradedAlgebra 𝒜] in theorem endpointSpace_of_pos {j : ℕ} {α : NatOrdinal} (hα : 0 < α.constantCoeff) : - endpointSpace 𝒜 j α = fibreGrade 𝒜 (α.removeNat (j + 1)) := if_pos hα + endpointSpace 𝒜 j α = fibreGrade 𝒜 (α.removeNat (j + 1)) := ite_eq_left hα omit [GradedAlgebra 𝒜] in theorem endpointSpace_of_eq_zero {j : ℕ} {α : NatOrdinal} (hα : α.constantCoeff = 0) : - endpointSpace 𝒜 j α = ⊥ := if_neg (by omega) + endpointSpace 𝒜 j α = ⊥ := ite_eq_right (by omega) omit [GradedAlgebra 𝒜] in theorem endpointSpace_le (j : ℕ) (α : NatOrdinal) : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Grading.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Grading.lean index 90656fbe07..43abcdd1b2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Grading.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Grading.lean @@ -121,7 +121,7 @@ theorem decompose_mul_of_right_mem_eq_zero {r g : R} {e δ : NatOrdinal} (hg : g classical rw [DirectSum.decompose_mul, DirectSum.decompose_of_mem 𝒜 hg, DirectSum.coe_mul_apply_eq_dfinsuppSum, DFinsupp.sum_comm] - refine (DFinsupp.sum_single_index ?_).trans (DFinsupp.sum_eq_zero fun β ↦ if_neg (h β)) + refine (DFinsupp.sum_single_index ?_).trans (DFinsupp.sum_eq_zero fun β ↦ ite_eq_right (h β)) simp /-- The degree-`δ` component of an element of the span of homogeneous generators is a finite sum @@ -145,14 +145,14 @@ theorem exists_decompose_eq_sum_of_mem_span {S : Set R} (e : S → NatOrdinal) intro i rw [smul_eq_mul] split_ifs with hP - · rw [show β' i = β ⟨i, hP⟩ from dif_pos hP] + · rw [show β' i = β ⟨i, hP⟩ from dite_eq_left hP] exact decompose_mul_of_right_mem_eq 𝒜 (hS (g i)) (hβ ⟨i, hP⟩) · exact decompose_mul_of_right_mem_eq_zero 𝒜 (hS (g i)) fun β hβ ↦ hP ⟨β, hβ⟩ rw [← hsum, DirectSum.decompose_sum, DirectSum.sum_apply, Submodule.coe_sum, Finset.sum_congr rfl fun i _ ↦ hterm i, ← Finset.sum_filter, Finset.sum_subtype (Finset.univ.filter fun i : Fin n ↦ ∃ β, β + e (g i) = δ) (p := fun i : Fin n ↦ ∃ β, β + e (g i) = δ) (fun i ↦ by simp)] - exact Finset.sum_congr rfl fun k _ ↦ by rw [show β' k.1 = β k from dif_pos k.2] + exact Finset.sum_congr rfl fun k _ ↦ by rw [show β' k.1 = β k from dite_eq_left k.2] /-- A homogeneous element of `I_{≥j} ∩ A_δ` is a finite sum of products `a * b` with `a ∈ A_e`, `e ≥ j` finite, and `b` homogeneous of a degree `β` with `e ⊕ β = δ`. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/IdealGEGraded.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/IdealGEGraded.lean index a9e7698dd8..a3cbb02c26 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/IdealGEGraded.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/IdealGEGraded.lean @@ -217,12 +217,12 @@ theorem gradeInitial_natCast (n : ℕ) (a : 𝒜 (n : NatOrdinal)) : gradeInitial 𝒜 (n : NatOrdinal) a = idealGEMk 𝒜 n (mem_idealGE_of_mem 𝒜 le_rfl a.2) := by have h : (n : NatOrdinal) = ((n : NatOrdinal).constantCoeff : NatOrdinal) := by rw [NatOrdinal.constantCoeff_natCast] - rw [gradeInitial, dif_pos h] + rw [gradeInitial, dite_eq_left h] exact idealGEMk_congr_index 𝒜 (NatOrdinal.constantCoeff_natCast n) _ theorem gradeInitial_of_not_natCast {α : NatOrdinal} (hα : ¬ ∃ n : ℕ, α = n) (a : 𝒜 α) : gradeInitial 𝒜 α a = 0 := by - rw [gradeInitial, dif_neg fun h ↦ hα ⟨_, h⟩] + rw [gradeInitial, dite_eq_right fun h ↦ hα ⟨_, h⟩] rfl /-- The sum of the classes in `gr_{I_•} A` of the homogeneous components of finite degree. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Mu.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Mu.lean index a3e1b3f7f5..5cc8bb53a9 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Mu.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Mu.lean @@ -290,10 +290,10 @@ theorem exists_mu_eq {j : ℕ} {H : R} (hH : H ∈ idealGE 𝒜 j) : refine Finset.sum_congr rfl fun i _ ↦ ?_ rw [Submodule.mkQ_apply, smul_eq_mul] by_cases h : e i = j - · rw [if_pos h, mu_tmul] + · rw [ite_eq_left h, mu_tmul] have ha : (a i : R) = g i := by simp [a, h] rw [ha, mul_comm] - · rw [if_neg h, eq_comm, Submodule.Quotient.mk_eq_zero] + · rw [ite_eq_right h, eq_comm, Submodule.Quotient.mk_eq_zero] exact Ideal.mul_mem_left _ _ (mem_idealGE_of_mem 𝒜 (by have := hje i; omega) (hge i)) /-- The class of a homogeneous element of `I_{≥j} ∩ A_δ` is in the image of `μ_j` restricted to @@ -319,12 +319,12 @@ theorem exists_mu_lTensor_eq {j : ℕ} {δ : NatOrdinal} {H : R} (hHδ : H ∈ refine Finset.sum_congr rfl fun k _ ↦ ?_ rw [Submodule.mkQ_apply] by_cases h : e k = j - · rw [if_pos h, LinearMap.lTensor_tmul] + · rw [ite_eq_left h, LinearMap.lTensor_tmul] have ha' : (a' k : R) = a k := by simp [a', h] have hb' : ((fibreGrade 𝒜 (δ.removeNat j)).subtype (b' k)) = fibreMap 𝒜 (b k) := by simp [b', h] rw [hb', mu_tmul, ha'] - · rw [if_neg h, eq_comm, Submodule.Quotient.mk_eq_zero] + · rw [ite_eq_right h, eq_comm, Submodule.Quotient.mk_eq_zero] exact Ideal.mul_mem_right _ _ (mem_idealGE_of_mem 𝒜 (by have := hje k; omega) (ha k)) /-- Homogeneous lifting: a tensor in `A_j ⊗ (A/I)_β`, `j ⊕ β = α`, is the class modulo `I_{≥j+1}` diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/BaseChange.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/BaseChange.lean index bb66eca979..4424a51de2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/BaseChange.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/BaseChange.lean @@ -69,12 +69,12 @@ theorem aevalTmulOne_comp_scalarRTensorAlgEquiv [DecidableEq σ] (y : σ → A) Algebra.TensorProduct.map (aeval y : MvPolynomial σ K →ₐ[K] A) (AlgHom.id K L) := by refine Algebra.TensorProduct.ext ?_ ?_ · refine MvPolynomial.algHom_ext fun i ↦ ?_ - simp only [AlgHom.comp_apply, Algebra.TensorProduct.includeLeft_apply, AlgEquiv.coe_algHom, + simp only [AlgHom.comp_apply, Algebra.TensorProduct.includeLeft_apply, AlgEquiv.coe_toAlgHom, scalarRTensorAlgEquiv_X_tmul_one, aevalTmulOne_X, Algebra.TensorProduct.map_tmul, aeval_X, AlgHom.coe_id, id_eq] · refine AlgHom.ext fun l ↦ ?_ simp only [AlgHom.coe_restrictScalars', AlgHom.comp_apply, - Algebra.TensorProduct.includeRight_apply, AlgEquiv.coe_algHom, + Algebra.TensorProduct.includeRight_apply, AlgEquiv.coe_toAlgHom, scalarRTensorAlgEquiv_one_tmul, aevalTmulOne_C, Algebra.TensorProduct.map_tmul, map_one, AlgHom.coe_id, id_eq] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Components.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Components.lean index 14d89f5020..936e819117 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Components.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Components.lean @@ -32,25 +32,25 @@ variable {σ : Type u} {R : Type v} [CommRing R] (wt : σ → NatOrdinal) at least `τ`. -/ noncomputable def componentsGE (τ : NatOrdinal) (P : MvPolynomial σ R) : MvPolynomial σ R := by classical - exact ∑ d ∈ P.support.filter fun d ↦ τ ≤ Finsupp.weight wt d, monomial d (coeff d P) + exact ∑ d ∈ P.support.filter fun d ↦ τ ≤ Finsupp.weight wt d, monomial d (AddMonoidAlgebra.coeff P d) open Classical in theorem coeff_componentsGE (τ : NatOrdinal) (P : MvPolynomial σ R) (d : σ →₀ ℕ) : - coeff d (componentsGE wt τ P) = if τ ≤ Finsupp.weight wt d then coeff d P else 0 := by + AddMonoidAlgebra.coeff (componentsGE wt τ P) d = if τ ≤ Finsupp.weight wt d then AddMonoidAlgebra.coeff P d else 0 := by classical rw [componentsGE] simp only [coeff_sum, coeff_monomial] split_ifs with hτ · rw [Finset.sum_eq_single d] - · rw [if_pos rfl] + · rw [ite_eq_left rfl] · intro d' _ hd' - rw [if_neg hd'] + rw [ite_eq_right hd'] · intro hd - rw [if_pos rfl] + rw [ite_eq_left rfl] by_contra h exact hd (Finset.mem_filter.mpr ⟨mem_support_iff.mpr h, hτ⟩) · refine Finset.sum_eq_zero fun d' hd' ↦ ?_ - rw [if_neg] + rw [ite_eq_right] rintro rfl exact hτ (Finset.mem_filter.mp hd').2 @@ -58,14 +58,14 @@ theorem componentsGE_add (τ : NatOrdinal) (P Q : MvPolynomial σ R) : componentsGE wt τ (P + Q) = componentsGE wt τ P + componentsGE wt τ Q := by classical ext d - simp only [coeff_componentsGE, coeff_add] + simp only [AddMonoidAlgebra.coeff_add, Finsupp.add_apply, coeff_componentsGE] split_ifs <;> simp theorem componentsGE_neg (τ : NatOrdinal) (P : MvPolynomial σ R) : componentsGE wt τ (-P) = -componentsGE wt τ P := by classical ext d - have hneg : ∀ Q : MvPolynomial σ R, coeff d (-Q) = -coeff d Q := fun Q ↦ by + have hneg : ∀ Q : MvPolynomial σ R, AddMonoidAlgebra.coeff (-Q) d = -AddMonoidAlgebra.coeff Q d := fun Q ↦ by change (coeffAddMonoidHom d) (-Q) = -(coeffAddMonoidHom d) Q exact map_neg _ _ rw [hneg, coeff_componentsGE, coeff_componentsGE, hneg] @@ -93,7 +93,7 @@ theorem componentsGE_eq_zero_of_forall_lt {τ : NatOrdinal} {P : MvPolynomial σ (hP : ∀ d ∈ P.support, Finsupp.weight wt d < τ) : componentsGE wt τ P = 0 := by classical ext d - rw [coeff_componentsGE, coeff_zero] + rw [coeff_componentsGE, AddMonoidAlgebra.coeff_zero] split_ifs with hτ · by_contra h exact absurd (hP d (mem_support_iff.mpr h)) (not_lt.mpr hτ) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/ComponentsSpan.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/ComponentsSpan.lean index 2c242b7f98..c96fb56195 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/ComponentsSpan.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/ComponentsSpan.lean @@ -40,15 +40,15 @@ theorem componentsGE_eq_sum_weightedHomogeneousComponent (τ : NatOrdinal) (P : split_ifs with hτ · by_cases hd : d ∈ P.support · rw [Finset.sum_eq_single (Finsupp.weight wt d)] - · rw [if_pos rfl] + · rw [ite_eq_left rfl] · intro e _ he - rw [if_neg (Ne.symm he)] + rw [ite_eq_right (Ne.symm he)] · intro h exact absurd (Finset.mem_filter.mpr ⟨Finset.mem_image_of_mem _ hd, hτ⟩) h · rw [notMem_support_iff.mp hd] exact (Finset.sum_eq_zero fun e _ ↦ by split_ifs <;> rfl).symm · refine (Finset.sum_eq_zero fun e he ↦ ?_).symm - rw [if_neg] + rw [ite_eq_right] rintro rfl exact hτ (Finset.mem_filter.mp he).2 diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Expansion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Expansion.lean index f56999b7d7..2f9798b3bf 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Expansion.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Expansion.lean @@ -167,7 +167,7 @@ theorem xCoeff_mem_supported (k : ℕ) (p : MvPolynomial σ R) : xCoeff x k p rename_val_mem_supported x _ theorem coeff_xCoeff (k : ℕ) (p : MvPolynomial σ R) (m : σ →₀ ℕ) : - coeff m (xCoeff x k p) = if m x = 0 then coeff (m + Finsupp.single x k) p else 0 := by + AddMonoidAlgebra.coeff (xCoeff x k p) m = if m x = 0 then AddMonoidAlgebra.coeff p (m + Finsupp.single x k) else 0 := by rw [xCoeff_apply] split_ifs with hm · have hsub : (m.support : Set σ) ⊆ Set.range (Subtype.val : {y // y ≠ x} → σ) := fun y hy ↦ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartDecomposition.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartDecomposition.lean index 66171769f1..0dcdea77a2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartDecomposition.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartDecomposition.lean @@ -109,7 +109,7 @@ theorem exists_eq_sum_pderiv_mul_X_add_of_mem_span {δ : NatOrdinal} refine ⟨fun t ↦ if h : t ∈ T then eraseFinitePart wt δ.constantCoeff (U ⟨t, h⟩) else 0, fun t ht ↦ ?_, ?_⟩ · beta_reduce - rw [dif_pos ht] + rw [dite_eq_left ht] exact ⟨isWeightedHomogeneous_eraseFinitePart wt _ (hUt ⟨t, ht⟩), eraseFinitePart_mem_supported wt _ _⟩ · have hshape := eraseFinitePart_add_sum_X_mul_pderiv hδ hF @@ -119,7 +119,7 @@ theorem exists_eq_sum_pderiv_mul_X_add_of_mem_span {δ : NatOrdinal} rw [← Finset.sum_add_distrib] refine Finset.sum_congr rfl fun t _ ↦ ?_ beta_reduce - rw [dif_pos t.2, mul_add, mul_comm (X (t : σ)), add_comm] + rw [dite_eq_left t.2, mul_add, mul_comm (X (t : σ)), add_comm] end MvPolynomial diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartErasure.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartErasure.lean index 15a4b500fc..b08c88097e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartErasure.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartErasure.lean @@ -92,12 +92,12 @@ theorem eraseFinitePart_monomial (d : σ →₀ ℕ) (r : R) : split_ifs with h · obtain ⟨i, hi, hik⟩ := h rw [Finsupp.prod, Finset.prod_eq_zero hi (by - rw [if_pos hik, zero_pow (Finsupp.mem_support_iff.mp hi)]), mul_zero] + rw [ite_eq_left hik, zero_pow (Finsupp.mem_support_iff.mp hi)]), mul_zero] · rw [monomial_eq, algebraMap_eq] congr 1 refine Finset.prod_congr rfl fun i hi ↦ ?_ beta_reduce - rw [if_neg fun hik ↦ h ⟨i, hi, hik⟩] + rw [ite_eq_right fun hik ↦ h ⟨i, hi, hik⟩] /-- The substitution fixes a polynomial none of whose variable weights has constant Cantor coefficient `k`. -/ @@ -108,7 +108,7 @@ theorem eraseFinitePart_eq_self {G : MvPolynomial σ R} conv_rhs => rw [G.as_sum] conv_lhs => rw [G.as_sum, map_sum] refine Finset.sum_congr rfl fun d hd ↦ ?_ - rw [eraseFinitePart_monomial, if_neg] + rw [eraseFinitePart_monomial, ite_eq_right] rintro ⟨i, hi, hik⟩ exact hG i ((mem_vars_iff_mem_support i).mpr ⟨d, hd, hi⟩) hik diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartVars.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartVars.lean index e67c09d820..9d3ae1f104 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartVars.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartVars.lean @@ -83,7 +83,7 @@ theorem isWeightedHomogeneous_pderiv_of_add_wt_eq {F : MvPolynomial σ R} {δ : /-- A homogeneous polynomial of nonzero degree has zero constant coefficient. -/ theorem coeff_zero_eq_zero_of_isWeightedHomogeneous {p : MvPolynomial σ R} {β : NatOrdinal} - (hp : IsWeightedHomogeneous wt p β) (hβ : β ≠ 0) : coeff 0 p = 0 := by + (hp : IsWeightedHomogeneous wt p β) (hβ : β ≠ 0) : AddMonoidAlgebra.coeff p 0 = 0 := by by_contra h exact hβ ((hp h).symm.trans (map_zero _)) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/LimitOrdinalContradiction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/LimitOrdinalContradiction.lean index a862f3fe9d..b36c54bad0 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/LimitOrdinalContradiction.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/LimitOrdinalContradiction.lean @@ -66,7 +66,7 @@ theorem partLT_eq_zero_of_mem_vars_pderiv {β α : NatOrdinal} {F : MvPolynomial exact hid' rfl have hid : i ∈ d.support := by rw [Finsupp.mem_support_iff] at hid' ⊢ - rw [Finsupp.tsub_apply, Finsupp.single_apply, if_neg hi0.symm, Nat.sub_zero] at hid' + rw [Finsupp.tsub_apply, Finsupp.single_apply, ite_eq_right hi0.symm, Nat.sub_zero] at hid' exact hid' -- the parts below `ω^β` of the monomial add up to `α_{<β}` have hsum : ∑ j ∈ d.support, d j • NatOrdinal.partLT β (wt j) = NatOrdinal.partLT β α := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/OrdinalDerivation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/OrdinalDerivation.lean index 6e00ce5970..077028ddf5 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/OrdinalDerivation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/OrdinalDerivation.lean @@ -152,7 +152,7 @@ theorem vars_pderiv_subset (i : σ) (p : MvPolynomial σ R) : (pderiv i p).vars -- `d'` is `d - single i 1` for a monomial `d` of `p` with `d i ≠ 0` have : d' ∈ (p.support.image fun d ↦ d - Finsupp.single i 1) := by have hsum : pderiv i p = - ∑ d ∈ p.support, monomial (d - Finsupp.single i 1) (coeff d p * d i) := by + ∑ d ∈ p.support, monomial (d - Finsupp.single i 1) (AddMonoidAlgebra.coeff p d * d i) := by conv_lhs => rw [p.as_sum, map_sum] exact Finset.sum_congr rfl fun d _ ↦ pderiv_monomial rw [hsum] at hd' @@ -173,7 +173,7 @@ theorem exists_mem_support_of_mem_support_pderiv {i : σ} ∃ d ∈ p.support, d i ≠ 0 ∧ d' = d - Finsupp.single i 1 := by classical have hsum : pderiv i p = - ∑ d ∈ p.support, monomial (d - Finsupp.single i 1) (coeff d p * d i) := by + ∑ d ∈ p.support, monomial (d - Finsupp.single i 1) (AddMonoidAlgebra.coeff p d * d i) := by conv_lhs => rw [p.as_sum, map_sum] exact Finset.sum_congr rfl fun d _ ↦ pderiv_monomial rw [hsum] at hd' @@ -196,16 +196,16 @@ theorem exists_add_eq_weight_of_mem_support_pderiv (wt : σ → NatOrdinal) {i : /-- The coefficient of `d - X_v` in `∂_v p`, for a monomial `d` containing `X_v`. -/ theorem coeff_sub_single_pderiv {v : σ} {p : MvPolynomial σ R} {d : σ →₀ ℕ} (hd : d v ≠ 0) : - coeff (d - Finsupp.single v 1) (pderiv v p) = coeff d p * (d v : R) := by + AddMonoidAlgebra.coeff (pderiv v p) (d - Finsupp.single v 1) = AddMonoidAlgebra.coeff p d * (d v : R) := by classical have hsum : pderiv v p = - ∑ d' ∈ p.support, monomial (d' - Finsupp.single v 1) (coeff d' p * d' v) := by + ∑ d' ∈ p.support, monomial (d' - Finsupp.single v 1) (AddMonoidAlgebra.coeff p d' * d' v) := by conv_lhs => rw [p.as_sum, map_sum] exact Finset.sum_congr rfl fun d' _ ↦ pderiv_monomial rw [hsum, MvPolynomial.coeff_sum] by_cases hdp : d ∈ p.support · rw [Finset.sum_eq_single d] - · rw [coeff_monomial, if_pos rfl] + · rw [coeff_monomial, ite_eq_left rfl] · intro d' _ hne rw [coeff_monomial] split_ifs with h diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Syzygy.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Syzygy.lean index 57304e0654..01e3521ad4 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Syzygy.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Syzygy.lean @@ -71,10 +71,10 @@ theorem exists_eq_sum_monomial_mul_C_of_sum_C_mul_eq_zero (c : B → R₀) ∃ (m : Finset (σ →₀ ℕ)) (v : (σ →₀ ℕ) → B → R₀), (∀ d ∈ m, ∑ b, c b * v d b = 0) ∧ ∀ b, u b = ∑ d ∈ m, monomial d 1 * C (v d b) := by classical - refine ⟨Finset.univ.biUnion fun b ↦ (u b).support, fun d b ↦ coeff d (u b), fun d _ ↦ ?_, + refine ⟨Finset.univ.biUnion fun b ↦ (u b).support, fun d b ↦ AddMonoidAlgebra.coeff (u b) d, fun d _ ↦ ?_, fun b ↦ ?_⟩ - · have := congrArg (coeff d) hu - rw [coeff_sum, coeff_zero] at this + · have := congrArg ((fun p => AddMonoidAlgebra.coeff p d)) hu + rw [coeff_sum, AddMonoidAlgebra.coeff_zero] at this simpa only [coeff_C_mul] using this · conv_lhs => rw [(u b).as_sum] rw [Finset.sum_subset (Finset.subset_biUnion_of_mem (fun b ↦ (u b).support) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/WeightedTotalDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/WeightedTotalDegree.lean index 6f5669627e..a0aaff9316 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/WeightedTotalDegree.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/WeightedTotalDegree.lean @@ -45,7 +45,7 @@ theorem weightedHomogeneousComponent_weightedTotalDegree_ne_zero {F : MvPolynomi fun s ↦ Finsupp.weight w s intro h0 have := coeff_weightedHomogeneousComponent (w := w) (n := weightedTotalDegree w F) (φ := F) d - rw [h0, coeff_zero, weightedTotalDegree, hsup, if_pos rfl] at this + rw [h0, AddMonoidAlgebra.coeff_zero, weightedTotalDegree, hsup, ite_eq_left rfl] at this exact mem_support_iff.mp hd this.symm omit [OrderBot M] in @@ -60,9 +60,9 @@ theorem eq_sum_weightedHomogeneousComponent (F : MvPolynomial σ R) : simp only [coeff_weightedHomogeneousComponent] by_cases hd : d ∈ F.support · rw [Finset.sum_eq_single (Finsupp.weight w d)] - · rw [if_pos rfl] + · rw [ite_eq_left rfl] · intro m _ hm - rw [if_neg (Ne.symm hm)] + rw [ite_eq_right (Ne.symm hm)] · intro hnot exact absurd (Finset.mem_image_of_mem _ hd) hnot · rw [notMem_support_iff.mp hd] @@ -86,25 +86,25 @@ theorem weightedTotalDegree_sub_weightedHomogeneousComponent_lt (F : MvPolynomia by_cases hFG : F - G = 0 · exact Or.inl hFG refine Or.inr (lt_of_le_of_ne (Finset.sup_le fun s hs ↦ ?_) fun heq ↦ ?_) - · have hs' : coeff s (F - G) ≠ 0 := mem_support_iff.mp hs - have hsub : coeff s (F - G) = - if Finsupp.weight w s = d then 0 else coeff s F := by + · have hs' : AddMonoidAlgebra.coeff (F - G) s ≠ 0 := mem_support_iff.mp hs + have hsub : AddMonoidAlgebra.coeff (F - G) s = + if Finsupp.weight w s = d then 0 else AddMonoidAlgebra.coeff F s := by rw [coeff_sub, hG, coeff_weightedHomogeneousComponent] split_ifs <;> simp have hne : Finsupp.weight w s ≠ d := by intro heq - rw [hsub, if_pos heq] at hs' + rw [hsub, ite_eq_left heq] at hs' exact hs' rfl - have hFne : coeff s F ≠ 0 := by - rw [hsub, if_neg hne] at hs' + have hFne : AddMonoidAlgebra.coeff F s ≠ 0 := by + rw [hsub, ite_eq_right hne] at hs' exact hs' exact le_weightedTotalDegree _ (mem_support_iff.mpr hFne) · obtain ⟨s, hs, hsup⟩ := Finset.exists_mem_eq_sup (F - G).support (support_nonempty.mpr hFG) fun s ↦ Finsupp.weight w s - have hs' : coeff s (F - G) ≠ 0 := mem_support_iff.mp hs + have hs' : AddMonoidAlgebra.coeff (F - G) s ≠ 0 := mem_support_iff.mp hs have hweight : Finsupp.weight w s = d := by rw [← heq, weightedTotalDegree, hsup] - rw [coeff_sub, hG, coeff_weightedHomogeneousComponent, if_pos hweight, sub_self] at hs' + rw [coeff_sub, hG, coeff_weightedHomogeneousComponent, ite_eq_left hweight, sub_self] at hs' exact hs' rfl end CommRing diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/BasisOver.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/BasisOver.lean index f172be5571..39bb36d976 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/BasisOver.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/BasisOver.lean @@ -503,10 +503,10 @@ theorem homogeneousMk_eq_sum (t : R) (d : M) degreeOverSubalgebraHom ν P (f i) * H.layerClass i else 0] refine Finset.sum_congr rfl fun i _ ↦ ?_ by_cases h : γ i = d - · rw [if_pos h] + · rw [ite_eq_left h] subst h rw [H.degreeOverSubalgebraHom_mul_layerClass] - · rw [if_neg h] + · rw [ite_eq_right h] refine (ν.degreeOver P).homogeneousMk_eq_zero_of_degree_lt (hmem i i.2) ?_ exact lt_of_le_of_lt (H.degreeOver_coe_mul_beta_le (f i) i) (WithBot.coe_lt_coe.mpr (lt_of_le_of_ne (hγ i i.2) h)) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeInitialForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeInitialForm.lean index c5d4aa4274..a4945900d1 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeInitialForm.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeInitialForm.lean @@ -51,12 +51,12 @@ def initialForm (ν : MaxAddDegree R M) (x : R) : ν.AssociatedGraded := theorem initialForm_eq_zero_of_eq_bot (ν : MaxAddDegree R M) {x : R} (hx : ν x = ⊥) : ν.initialForm x = 0 := by - rw [initialForm, dif_pos hx] + rw [initialForm, dite_eq_left hx] theorem initialForm_eq_homogeneousMk_of_ne_bot (ν : MaxAddDegree R M) {x : R} (hx : ν x ≠ ⊥) : ν.initialForm x = ν.homogeneousMk ((ν x).unbot hx) (ν.initialRepresentative x hx) := by - rw [initialForm, dif_neg hx] + rw [initialForm, dite_eq_right hx] omit [IsOrderedCancelAddMonoid M] in /-- The homogeneous class of an element of nonbottom degree in its exact degree is nonzero. -/ @@ -68,7 +68,7 @@ theorem componentMk_initialRepresentative_ne_zero (ν : MaxAddDegree R M) (x : R theorem initialForm_ne_zero_of_ne_bot (ν : MaxAddDegree R M) {x : R} (hx : ν x ≠ ⊥) : ν.initialForm x ≠ 0 := by - rw [initialForm, dif_neg hx, ne_eq, ν.homogeneousMk_eq_zero_iff, + rw [initialForm, dite_eq_right hx, ne_eq, ν.homogeneousMk_eq_zero_iff, ν.coe_initialRepresentative, WithBot.coe_unbot] exact lt_irrefl _ @@ -92,7 +92,7 @@ theorem initialForm_eq_homogeneousMk_of_componentMk_ne_zero have hxbot : ν x ≠ ⊥ := by simp [hdegree] have hm : (ν x).unbot hxbot = m := (WithBot.unbot_eq_iff hxbot).mpr hdegree - rw [initialForm, dif_neg hxbot, ν.homogeneousMk_apply, ν.homogeneousMk_apply] + rw [initialForm, dite_eq_right hxbot, ν.homogeneousMk_apply, ν.homogeneousMk_apply] apply DirectSum.of_eq_of_gradedMonoid_eq apply Sigma.ext hm apply ν.componentMk_heq_of_grade_eq_of_coe_eq hm @@ -120,7 +120,7 @@ theorem initialForm_eq_of_sub_lt (ν : MaxAddDegree R M) {x y : R} have hy : ν y ≠ ⊥ := hdegree ▸ hx have hm : (ν x).unbot hx = (ν y).unbot hy := (WithBot.unbot_inj hx hy).mpr hdegree - rw [initialForm, dif_neg hx, initialForm, dif_neg hy, + rw [initialForm, dite_eq_right hx, initialForm, dite_eq_right hy, ν.homogeneousMk_apply, ν.homogeneousMk_apply] apply DirectSum.of_eq_of_gradedMonoid_eq apply Sigma.ext hm @@ -141,7 +141,7 @@ theorem initialForm_one : ν.initialForm 1 = 1 := by rw [hcomponentOne, (DirectSum.of ν.Component 0).map_zero] · have hne : ν 1 ≠ ⊥ := by simp [hone] have hm : (ν 1).unbot hne = 0 := (WithBot.unbot_eq_iff hne).mpr hone - rw [initialForm, dif_neg hne, ν.homogeneousMk_apply, DirectSum.one_def] + rw [initialForm, dite_eq_right hne, ν.homogeneousMk_apply, DirectSum.one_def] change DirectSum.of ν.Component _ _ = DirectSum.of ν.Component 0 ν.componentOne rw [ν.componentOne_eq_componentMk] apply DirectSum.of_eq_of_gradedMonoid_eq @@ -169,7 +169,7 @@ theorem initialForm_mul (x y : R) : have hm : (ν (x * y)).unbot hxy = (ν x).unbot hx + (ν y).unbot hy := by apply WithBot.coe_injective rw [WithBot.coe_unbot, WithBot.coe_add, ν.map_mul, WithBot.coe_unbot, WithBot.coe_unbot] - rw [initialForm, dif_neg hxy, initialForm, dif_neg hx, initialForm, dif_neg hy, + rw [initialForm, dite_eq_right hxy, initialForm, dite_eq_right hx, initialForm, dite_eq_right hy, ν.homogeneousMk_mul, ν.homogeneousMk_apply, ν.homogeneousMk_apply] apply DirectSum.of_eq_of_gradedMonoid_eq apply Sigma.ext hm diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeOver.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeOver.lean index ff56ae42d0..c698bc87c7 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeOver.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeOver.lean @@ -146,7 +146,7 @@ private theorem withBot_eq_of_forall_le_iff {a b : WithBot M} (hbot : a = ⊥ `ν = deg` and `P = S` this is the paper's `deg_S`. -/ def degreeOver : MaxAddDegree R M where toFun := degreeOverFun ν P - map_zero' := by rw [degreeOverFun, if_pos rfl] + map_zero' := by rw [degreeOverFun, ite_eq_left rfl] map_one_le_zero' := by rw [WithBot.coe_zero.symm, degreeOverFun_le_iff] exact ν.one_mem_degreeOverStage_zero P diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeRepresentatives.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeRepresentatives.lean index 39d85fe326..a1e286db84 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeRepresentatives.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeRepresentatives.lean @@ -204,14 +204,14 @@ theorem degree_aeval_lt_of_forall_weight_lt {ν : MaxAddDegree R M} {ι : Type w ν (aeval x F) < (m : WithBot M) := by classical rw [show aeval x F = - ∑ d ∈ F.support, aeval x (monomial d (MvPolynomial.coeff d F)) by + ∑ d ∈ F.support, aeval x (monomial d (AddMonoidAlgebra.coeff F d)) by conv_lhs => rw [F.as_sum] rw [map_sum]] apply ν.map_sum_lt_of_forall_lt _ _ (WithBot.bot_lt_coe m) intro d hd - have hhom : IsWeightedHomogeneous wt (monomial d (MvPolynomial.coeff d F)) + have hhom : IsWeightedHomogeneous wt (monomial d (AddMonoidAlgebra.coeff F d)) (Finsupp.weight wt d) := - isWeightedHomogeneous_monomial wt d (MvPolynomial.coeff d F) rfl + isWeightedHomogeneous_monomial wt d (AddMonoidAlgebra.coeff F d) rfl exact (ν.represents_aeval hscalar hx hhom).degree_le.trans_lt (WithBot.coe_lt_coe.mpr (hF d hd)) @@ -234,9 +234,9 @@ theorem represents_aeval_weightedHomogeneousComponent {ν : MaxAddDegree R M} { have hne := MvPolynomial.mem_support_iff.mp hd rw [MvPolynomial.coeff_sub, coeff_weightedHomogeneousComponent] at hne by_cases hdw : Finsupp.weight wt d = m - · rw [if_pos hdw, sub_self] at hne + · rw [ite_eq_left hdw, sub_self] at hne exact absurd rfl hne - · rw [if_neg hdw, sub_zero] at hne + · rw [ite_eq_right hdw, sub_zero] at hne exact lt_of_le_of_ne (hF d (MvPolynomial.mem_support_iff.mpr hne)) hdw have htop := ν.represents_aeval hscalar hx hhom have hlow : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeSum.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeSum.lean index 65a1ac2538..a41337b31f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeSum.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeSum.lean @@ -89,8 +89,8 @@ theorem homogeneousMk_finsetSum_apply {ι : Type x} (s : Finset ι) (m : ι → have hterm : ∀ i ∈ s, (ν.homogeneousMk (m i) ⟨y i, hy i⟩) d = if h : m i = d then ν.componentMk d ⟨y i, h ▸ hy i⟩ else 0 := fun i _ ↦ by by_cases h : m i = d - · rw [dif_pos h, ν.homogeneousMk_apply_of_eq (hy i) h] - · rw [dif_neg h, ν.homogeneousMk_apply_of_ne (hy i) h] + · rw [dite_eq_left h, ν.homogeneousMk_apply_of_eq (hy i) h] + · rw [dite_eq_right h, ν.homogeneousMk_apply_of_ne (hy i) h] rw [Finset.sum_congr rfl hterm, Finset.sum_dite, Finset.sum_const_zero, add_zero, ← map_sum] congr 1 apply Subtype.ext @@ -113,8 +113,8 @@ theorem initialForm_apply (y : R) (d : M) : have hmem : y ∈ ν.filtrationLE m := (ν.mem_filtrationLE_iff m y).mpr hm.symm.le rw [← ν.homogeneousMk_eq_initialForm_of_degree_eq hmem hm.symm] by_cases h : m = d - · rw [ν.homogeneousMk_apply_of_eq hmem h, dif_pos (by rw [← hm, h])] - · rw [ν.homogeneousMk_apply_of_ne hmem h, dif_neg] + · rw [ν.homogeneousMk_apply_of_eq hmem h, dite_eq_left (by rw [← hm, h])] + · rw [ν.homogeneousMk_apply_of_ne hmem h, dite_eq_right] intro h' rw [← hm, WithBot.coe_inj] at h' exact h h' diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/FiltrationDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/FiltrationDegree.lean index d5170c1d30..54e2b57269 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/FiltrationDegree.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/FiltrationDegree.lean @@ -100,12 +100,12 @@ def value (x : R) : WithBot (OrderDual ℕ) := by @[simp] theorem value_zero : hF.value 0 = ⊥ := by - rw [value, dif_pos rfl] + rw [value, dite_eq_left rfl] theorem value_of_ne_zero {x : R} (hx : x ≠ 0) : hF.value x = ((OrderDual.toDual (hF.index hx) : OrderDual ℕ) : WithBot (OrderDual ℕ)) := by - rw [value, dif_neg hx] + rw [value, dite_eq_right hx] theorem value_eq_bot_iff (x : R) : hF.value x = ⊥ ↔ x = 0 := by constructor diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGraded.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGraded.lean index 99ba0acb5a..1b0ba44fe4 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGraded.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGraded.lean @@ -160,7 +160,7 @@ theorem printedRepresentativeAdd_not_commutative : ((oneRepresentative : ℚ) + ((0 : trivialValuation.filtrationLE 0) : ℚ)) = trivialValuation oneRepresentative := by simp - rw [printedRepresentativeAdd, if_neg hzeroOne, printedRepresentativeAdd, if_pos honeZero] + rw [printedRepresentativeAdd, ite_eq_right hzeroOne, printedRepresentativeAdd, ite_eq_left honeZero] simp only [add_zero] exact oneRepresentative_componentMk_ne_zero.symm diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Blueprint.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Blueprint.lean index 04f2402f65..db69a2db5e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Blueprint.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Blueprint.lean @@ -115,27 +115,29 @@ private structure CollectState where private abbrev CollectM := ReaderT CollectContext (StateM CollectState) -private partial def collectSelected (name : Name) : CollectM Unit := do - let state ← get - unless state.visited.contains name do - modify fun state => { state with visited := state.visited.insert name } - let { environment, root } ← read - if name != root && (nodeExt.find? environment name).isSome then - modify fun state => { state with selected := state.selected.insert name } - else - let collectExpression (expression : Expr) : CollectM Unit := - expression.getUsedConstants.forM collectSelected - match environment.find? name with - | some (.axiomInfo _) => pure () - | some (.defnInfo value) => collectExpression value.type *> collectExpression value.value - | some (.thmInfo value) => collectExpression value.type *> collectExpression value.value - | some (.opaqueInfo value) => collectExpression value.type *> collectExpression value.value - | some (.quotInfo _) => pure () - | some (.ctorInfo value) => collectExpression value.type - | some (.recInfo value) => collectExpression value.type - | some (.inductInfo value) => - collectExpression value.type *> value.ctors.forM collectSelected - | none => pure () +private def collectSelected : Nat → Name → CollectM Unit + | 0, _ => pure () + | fuel + 1, name => do + let state ← get + unless state.visited.contains name do + modify fun state => { state with visited := state.visited.insert name } + let { environment, root } ← read + if name != root && (nodeExt.find? environment name).isSome then + modify fun state => { state with selected := state.selected.insert name } + else + let collectExpression (expression : Expr) : CollectM Unit := + expression.getUsedConstants.forM (collectSelected fuel) + match environment.find? name with + | some (.axiomInfo _) => pure () + | some (.defnInfo value) => collectExpression value.type *> collectExpression value.value + | some (.thmInfo value) => collectExpression value.type *> collectExpression value.value + | some (.opaqueInfo value) => collectExpression value.type *> collectExpression value.value + | some (.quotInfo _) => pure () + | some (.ctorInfo value) => collectExpression value.type + | some (.recInfo value) => collectExpression value.type + | some (.inductInfo value) => + collectExpression value.type *> value.ctors.forM (collectSelected fuel) + | none => pure () private def declarationType : ConstantInfo → Expr | .axiomInfo value | .defnInfo value | .thmInfo value | .opaqueInfo value | @@ -153,11 +155,11 @@ private def collectDependencies (environment : Environment) (root : Name) : let some info := environment.find? root | return ({}, {}) let mut statementState : CollectState := {} for name in (declarationType info).getUsedConstants do - (_, statementState) := ((collectSelected name).run { environment, root }).run statementState + (_, statementState) := ((collectSelected (environment.constants.toList.length + 1) name).run { environment, root }).run statementState let mut proofState := statementState if let some value := declarationValue? info then for name in value.getUsedConstants do - (_, proofState) := ((collectSelected name).run { environment, root }).run proofState + (_, proofState) := ((collectSelected (environment.constants.toList.length + 1) name).run { environment, root }).run proofState return (statementState.selected, proofState.selected \ statementState.selected) private def namesJson (names : NameSet) : Json := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/SelectionComplexity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/SelectionComplexity.lean index 32afd8f32f..f09c273150 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/SelectionComplexity.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/SelectionComplexity.lean @@ -262,7 +262,7 @@ theorem count_reduced_of_ne {w : Multiset α} {hw : w ≠ 0} {t : Multiset α} Multiset.count y (s.reduced w hw t) = 2 * Multiset.count y w := by rw [reduced, unselected] simp only [Multiset.count_add, Multiset.count_replicate, Multiset.count_filter, - if_neg (Ne.symm hy), if_pos hy, Multiset.count_eq_zero.mpr hyt] + ite_eq_right (Ne.symm hy), ite_eq_left hy, Multiset.count_eq_zero.mpr hyt] omega theorem selected_mem_reduced {w : Multiset α} {hw : w ≠ 0} {t : Multiset α} @@ -394,8 +394,8 @@ theorem replicate_selectedExponent_add_unselected (w : Multiset α) (hw : w ≠ rw [Multiset.count_add, s.unselected_eq, Multiset.count_replicate, Multiset.count_filter] by_cases hy : y = s.selected w hw · subst hy - rw [if_pos rfl, if_neg (fun h ↦ h rfl), add_zero, s.selectedExponent_eq_count] - · rw [if_neg (Ne.symm hy), if_pos hy, zero_add] + rw [ite_eq_left rfl, ite_eq_right (fun h ↦ h rfl), add_zero, s.selectedExponent_eq_count] + · rw [ite_eq_right (Ne.symm hy), ite_eq_left hy, zero_add] /-- The complexity consists of the relevant distinct-factor weights and selected multiplicity. -/ theorem complexity_eq (w : Multiset α) (hw : w ≠ 0) : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/DegreeTwoNormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/DegreeTwoNormalForm.lean index da83183e4e..68489036f2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/DegreeTwoNormalForm.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/DegreeTwoNormalForm.lean @@ -164,12 +164,12 @@ theorem normalForm_support : normalForm.{u}.support = range exponentAtIndex := b theorem normalForm_coeff_exponent (m n : ℕ) : normalForm.{u}.coeff (exponent m n : ℝ) = 1 := by classical - rw [normalForm_coeff, coefficient, if_pos] + rw [normalForm_coeff, coefficient, ite_eq_left] exact ⟨(↑(toLex (m, n)) : Index), rfl⟩ theorem normalForm_coeff_zero : normalForm.{u}.coeff 0 = 1 := by classical - rw [normalForm_coeff, coefficient, if_pos] + rw [normalForm_coeff, coefficient, ite_eq_left] exact ⟨⊤, rfl⟩ end Surreal.OmnificInteger.DegreeTwoExample diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowNormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowNormalForm.lean index 6ba43c46dd..236dcfd539 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowNormalForm.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowNormalForm.lean @@ -110,12 +110,12 @@ theorem normalForm_support : normalForm.support = range exponentAtIndex := by theorem normalForm_coeff_exponent (n : ℕ) : normalForm.coeff (exponent n : ℝ) = 1 := by classical - rw [normalForm_coeff, coefficient, if_pos] + rw [normalForm_coeff, coefficient, ite_eq_left] exact ⟨(n : Index), rfl⟩ theorem normalForm_coeff_zero : normalForm.coeff 0 = 1 := by classical - rw [normalForm_coeff, coefficient, if_pos] + rw [normalForm_coeff, coefficient, ite_eq_left] exact ⟨⊤, rfl⟩ end Surreal.OmnificInteger.OneRowExample diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEmbedding.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEmbedding.lean index 19143f4aad..3c2b0acf57 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEmbedding.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEmbedding.lean @@ -228,11 +228,11 @@ theorem CardSuppLTTruncationIntegerPart.coe_mapDomain_restrictDomain change (HahnSeries.embDomain e (HahnSeries.restrictDomain e (x : R⟦H⟧))).coeff (e g) = _ rw [HahnSeries.embDomain_coeff, HahnSeries.restrictDomain_coeff, - HahnSeries.coeff_filter, if_pos] + HahnSeries.coeff_filter, ite_eq_left] · rfl · exact Set.mem_range_self g - · rw [HahnSeries.embDomain_notin_range] - · rw [HahnSeries.coeff_filter, if_neg hh] + · rw [HahnSeries.embDomain_of_notMem_range] + · rw [HahnSeries.coeff_filter, ite_eq_right hh] · exact hh namespace CardSuppLTTruncationIntegerPart diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ConvexQuotientSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ConvexQuotientSplitting.lean index 13cec69bea..21fce1bce8 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ConvexQuotientSplitting.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ConvexQuotientSplitting.lean @@ -89,9 +89,9 @@ theorem convexQuotientSplitRingEquiv_filter_comap rw [hmk] split · rename_i hmem - rw [if_pos (hiff.mp hmem), convexQuotientSplitRingEquiv_coeff] + rw [ite_eq_left (hiff.mp hmem), convexQuotientSplitRingEquiv_coeff] · rename_i hmem - rw [if_neg (fun hq ↦ hmem (hiff.mpr hq))] + rw [ite_eq_right (fun hq ↦ hmem (hiff.mpr hq))] rfl open Classical in diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/EPrimitive.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/EPrimitive.lean index 4c348825a7..dc7c1440eb 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/EPrimitive.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/EPrimitive.lean @@ -52,10 +52,10 @@ theorem coeff_add_of_forall_le {x y : K⟦G⟧} {a b : G} (ha : ∀ g ∈ x.support, g ≤ a) (hb : ∀ g ∈ y.support, g ≤ b) : (x * y).coeff (a + b) = x.coeff a * y.coeff b := by classical - have hsplit : ∀ c ∈ Finset.addAntidiagonal x.isPWO_support y.isPWO_support (a + b), + have hsplit : ∀ c ∈ Finset.antidiagonal x.isPWO_support y.isPWO_support (a + b), c = (a, b) := by intro c hc - rw [Finset.mem_addAntidiagonal] at hc + rw [Finset.mem_antidiagonal] at hc obtain ⟨hc1, hc2, hc0⟩ := hc have h1 : c.1 = a := by refine le_antisymm (ha _ hc1) ?_ @@ -76,7 +76,7 @@ theorem coeff_add_of_forall_le {x y : K⟦G⟧} {a b : G} refine Finset.sum_eq_zero fun c hc ↦ ?_ rw [hsplit c hc, hy0, mul_zero] refine Finset.sum_eq_single_of_mem (a, b) ?_ (fun c hc hne ↦ absurd (hsplit c hc) hne) - refine Finset.mem_addAntidiagonal.mpr ⟨?_, ?_, rfl⟩ + refine Finset.mem_antidiagonal.mpr ⟨?_, ?_, rfl⟩ · exact (HahnSeries.mem_support x a).mpr hx0 · exact (HahnSeries.mem_support y b).mpr hy0 diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FactorCoefficients.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FactorCoefficients.lean index ec56a74488..e68bce6e20 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FactorCoefficients.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FactorCoefficients.lean @@ -37,9 +37,9 @@ theorem subgroupAlgebraHom_mapRingHom (H : AddSubgroup G) (P : AddMonoidAlgebra rw [HahnSeries.coeff_subgroupAlgebraHom, HahnSeries.map_coeff, HahnSeries.coeff_subgroupAlgebraHom] by_cases hg : g ∈ H - · rw [dif_pos hg, dif_pos hg, AddMonoidAlgebra.mapRingHom_apply', + · rw [dite_eq_left hg, dite_eq_left hg, AddMonoidAlgebra.mapRingHom_apply', Finsupp.mapRange_apply] - · rw [dif_neg hg, dif_neg hg, map_zero] + · rw [dite_eq_right hg, dite_eq_right hg, map_zero] /-- Hahn-series form of scalar clearing for finite-support factors. -/ theorem exists_scalar_of_hahn_mul_eq_map @@ -86,11 +86,11 @@ theorem exists_scalar_of_hahn_mul_eq_map refine ⟨c, hc, fun x ↦ ?_⟩ by_cases hx : x ∈ H · have : p.coeff x = p₁ ⟨x, hx⟩ := by - rw [← hp₁, HahnSeries.coeff_subgroupAlgebraHom, dif_pos hx] + rw [← hp₁, HahnSeries.coeff_subgroupAlgebraHom, dite_eq_left hx] rw [this] exact hcoeff _ · have : p.coeff x = 0 := by - rw [← hp₁, HahnSeries.coeff_subgroupAlgebraHom, dif_neg hx] + rw [← hp₁, HahnSeries.coeff_subgroupAlgebraHom, dite_eq_right hx] rw [this, mul_zero] exact ⟨0, map_zero _⟩ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwoExample.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwoExample.lean index 50859f317a..95ee8e6ea7 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwoExample.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwoExample.lean @@ -319,7 +319,7 @@ private theorem degreeTwo_germ_coeff_eq_block (m : ℕ) {delta : ℝ} ((Berarducci.translatedTruncation (degreeTwoSeries (K := K) : K⟦ℝ⟧) (degreeTwoCutoff m) : Berarducci.Series K) : K⟦ℝ⟧).coeff delta = ((degreeTwoBlock (K := K) m : Berarducci.Series K) : K⟦ℝ⟧).coeff delta := by - rw [Berarducci.coeff_translatedTruncation, if_pos hdelta0] + rw [Berarducci.coeff_translatedTruncation, ite_eq_left hdelta0] by_cases hblock : delta ∈ Set.range (degreeTwoBlockEmbedding m) · obtain ⟨n, rfl⟩ := hblock rw [degreeTwoBlock_coeff_embedding (K := K)] @@ -613,7 +613,7 @@ theorem degreeTwoWithConstant_coeff_eq_zero {x : ℝ} (hrange : x ∉ Set.range degreeTwoExponentEmbedding) (hx0 : x ≠ 0) : ((degreeTwoWithConstant (K := K) : Berarducci.Series K) : K⟦ℝ⟧).coeff x = 0 := by rw [degreeTwoWithConstant_coe (K := K), HahnSeries.coeff_add] - simp only [HahnSeries.C_apply, HahnSeries.coeff_single, if_neg hx0, add_zero] + simp only [HahnSeries.C_apply, HahnSeries.coeff_single, ite_eq_right hx0, add_zero] rw [← not_ne_iff, ← HahnSeries.mem_support, degreeTwoSeries_support (K := K)] exact hrange @@ -691,10 +691,10 @@ private theorem translatedTruncation_C_one_eq_zero {x : ℝ} (hx : x < 0) : funext delta rw [Berarducci.coeff_translatedTruncation] by_cases hdelta : delta ≤ 0 - · rw [if_pos hdelta, HahnSeries.C_apply] + · rw [ite_eq_left hdelta, HahnSeries.C_apply] have hsum : x + delta ≠ 0 := ne_of_lt (add_neg_of_neg_of_nonpos hx hdelta) simp [hsum] - · rw [if_neg hdelta] + · rw [ite_eq_right hdelta] rfl theorem degreeTwoWithConstant_translatedTruncationClass_eq_block (m : ℕ) : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/FactorizationClassification.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/FactorizationClassification.lean index af806c0e62..8b130370e8 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/FactorizationClassification.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/FactorizationClassification.lean @@ -76,7 +76,7 @@ private theorem not_accPt_support_of_translatedTruncation_mem_nearConstantSubgro have hη0 : η < δ := by dsimp [δ]; linarith have hδ0 : δ < 0 := by dsimp [δ]; linarith have hzero := hcoeff δ hη0 hδ0 - rw [coeff_translatedTruncation, if_pos hδ0.le] at hzero + rw [coeff_translatedTruncation, ite_eq_left hδ0.le] at hzero have hcoeffZero : (b : K⟦ℝ⟧).coeff w = 0 := by simpa [δ] using hzero exact (HahnSeries.mem_support _ _).mp hwSupport hcoeffZero diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/TranslatedSpanFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/TranslatedSpanFactorization.lean index 53eb5b27be..47431f804b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/TranslatedSpanFactorization.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/TranslatedSpanFactorization.lean @@ -150,14 +150,14 @@ theorem translatedTruncationClass_mul_eq have hxβle : x - β ≤ 0 := hcClosure hβClosure.2 by_cases hβ0 : β = 0 · subst β - rw [if_pos rfl, _root_.sub_zero, translatedTruncation_zero] + rw [ite_eq_left rfl, _root_.sub_zero, translatedTruncation_zero] exact toSeriesQuotientByJAddConstants_mul_translatedTruncation_eq_coeff_smul (hcNear hx) - · rw [if_neg hβ0] + · rw [ite_eq_right hβ0] by_cases hβx : β = x · subst β - rw [if_pos rfl, _root_.sub_self, translatedTruncation_zero] + rw [ite_eq_left rfl, _root_.sub_self, translatedTruncation_zero] exact toSeriesQuotientByJAddConstants_translatedTruncation_mul_eq_coeff_smul (hbNear hx) - · rw [if_neg hβx] + · rw [ite_eq_right hβx] have hβneg : β < 0 := lt_of_le_of_ne hβle hβ0 have hxβneg : x - β < 0 := by apply lt_of_le_of_ne hxβle @@ -178,7 +178,7 @@ theorem translatedTruncationClass_mul_eq · simp [hβ0] have hzero : (if 0 ∈ T then B else 0) = B := by by_cases hxClosure : x ∈ closure (c : K⟦ℝ⟧).support - · rw [if_pos] + · rw [ite_eq_left] exact mem_convolutionIndex.mpr ⟨hbCritical.mem_closure_support, by simpa using hxClosure⟩ · have hxSupport : x ∉ (c : K⟦ℝ⟧).support := @@ -190,7 +190,7 @@ theorem translatedTruncationClass_mul_eq simp [hnot, B, hxSupport] have hxIndex : (if x ∈ T then C else 0) = C := by by_cases hxClosure : x ∈ closure (b : K⟦ℝ⟧).support - · rw [if_pos] + · rw [ite_eq_left] exact mem_convolutionIndex.mpr ⟨hxClosure, by simpa using hcCritical.mem_closure_support⟩ · have hxSupport : x ∉ (b : K⟦ℝ⟧).support := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFinite.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFinite.lean index f9c4f111cf..ee8e166a63 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFinite.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFinite.lean @@ -518,7 +518,7 @@ theorem layerMaximalFiniteSupportDivisor_eq_of_is {α : NatOrdinal} classical let hex : ∃ b : Associates (FiniteSupportRing (K := K)), IsLayerMaximalFiniteSupportDivisor α B b := ⟨a, ha⟩ - rw [layerMaximalFiniteSupportDivisor, dif_pos hex] + rw [layerMaximalFiniteSupportDivisor, dite_eq_left hex] exact (Classical.choose_spec hex).eq ha /-- Under pairwise gcd existence, the canonical homogeneous class satisfies its defining @@ -558,7 +558,7 @@ theorem gradedMaximalFiniteSupportDivisor_eq_of_is {B : DegreeGraded K} classical let hex : ∃ b : Associates (FiniteSupportRing (K := K)), IsGradedMaximalFiniteSupportDivisor B b := ⟨a, ha⟩ - rw [gradedMaximalFiniteSupportDivisor, dif_pos hex] + rw [gradedMaximalFiniteSupportDivisor, dite_eq_left hex] exact (Classical.choose_spec hex).eq ha /-- Under pairwise gcd existence, the canonical graded class satisfies its defining diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/RVMaximalFinite.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/RVMaximalFinite.lean index 576d436b13..7894755aac 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/RVMaximalFinite.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/RVMaximalFinite.lean @@ -543,7 +543,7 @@ theorem rvMaximalFiniteSupportDivisor_eq_of_is {B : HahnDegreeRV K} classical let hex : ∃ b : Associates (FiniteSupportRing (K := K)), IsRVMaximalFiniteSupportDivisor B b := ⟨a, ha⟩ - rw [rvMaximalFiniteSupportDivisor, dif_pos hex] + rw [rvMaximalFiniteSupportDivisor, dite_eq_left hex] exact (Classical.choose_spec hex).eq ha /-- Under pairwise gcd existence, the canonical RV class satisfies its defining diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/CoefficientRandom.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/CoefficientRandom.lean index 3efac0a9eb..aa66fd1a44 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/CoefficientRandom.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/CoefficientRandom.lean @@ -111,7 +111,7 @@ theorem IsMutuallyCoefficientRandom.truncationsIndependent {ι : Type} {b : ι -- The matrix of coefficients. have hcoeff : ∀ (q k : P), ((c k : Series K) : K⟦ℝ⟧).coeff (x q) = ((b (j k) : Series K) : K⟦ℝ⟧).coeff (γ k + x q) := fun q k ↦ by - rw [hc, coeff_translatedTruncation, if_pos (hxneg q).le] + rw [hc, coeff_translatedTruncation, ite_eq_left (hxneg q).le] let M : Matrix P P K := Matrix.of fun q k ↦ ((c k : Series K) : K⟦ℝ⟧).coeff (x q) have hMg : M.mulVec (fun k : P ↦ g k) = 0 := by funext q @@ -131,9 +131,9 @@ theorem IsMutuallyCoefficientRandom.truncationsIndependent {ι : Type} {b : ι simp only [M, Matrix.of_apply, v] rw [hcoeff q k] by_cases h : (j k, γ k + x q) ∈ coefficientIndex b - · rw [dif_pos h] + · rw [dite_eq_left h] rfl - · rw [dif_neg h, Option.elim] + · rw [dite_eq_right h, Option.elim] rw [mem_coefficientIndex_iff, not_ne_iff] at h exact h have hdiag : ∀ q, (v q q).isSome := by @@ -142,16 +142,16 @@ theorem IsMutuallyCoefficientRandom.truncationsIndependent {ι : Type} {b : ι rw [mem_coefficientIndex_iff] rw [← hcoeff q q] exact hxc q - simp only [v, dif_pos h, Option.isSome_some] + simp only [v, dite_eq_left h, Option.isSome_some] have hdistinct : ∀ q k q' k' w, v q k = some w → v q' k' = some w → q = q' ∧ k = k' := by intro q k q' k' w h1 h2 have hpair : (j k, γ k + x q) = (j k', γ k' + x q') := by by_cases hk : (j k, γ k + x q) ∈ coefficientIndex b · by_cases hk' : (j k', γ k' + x q') ∈ coefficientIndex b - · simp only [v, dif_pos hk, dif_pos hk', Option.some.injEq] at h1 h2 + · simp only [v, dite_eq_left hk, dite_eq_left hk', Option.some.injEq] at h1 h2 exact congrArg Subtype.val (h1.trans h2.symm) - · simp [v, dif_neg hk'] at h2 - · simp [v, dif_neg hk] at h1 + · simp [v, dite_eq_right hk'] at h2 + · simp [v, dite_eq_right hk] at h1 have hj : j k = j k' := congrArg Prod.fst hpair have hγ' : γ k + x q = γ k' + x q' := congrArg Prod.snd hpair by_cases hqq : q = q' diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/GradedIrreducible.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/GradedIrreducible.lean index 2a75fa0c0e..022034c1f7 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/GradedIrreducible.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/GradedIrreducible.lean @@ -310,9 +310,9 @@ theorem coordinate_blockForm [CharZero K] {ι : Type*} [Fintype ι] [DecidableEq classical rw [blockForm_def, map_sum] rw [Finset.sum_eq_single m] - · rw [coordinate_tmul, hφ, if_pos rfl, one_smul] + · rw [coordinate_tmul, hφ, ite_eq_left rfl, one_smul] · intro i _ hi - rw [coordinate_tmul, hφ, if_neg hi, zero_smul] + rw [coordinate_tmul, hφ, ite_eq_right hi, zero_smul] · intro h exact absurd (Finset.mem_univ m) h @@ -486,7 +486,7 @@ theorem eq_of_initialForm_eq_finiteSupportGradedEmbedding [CharZero K] {a : Seri by_contra hd0 have hcomp := congrArg (fun z : DegreeGraded K ↦ z d) h rw [finiteSupportGradedEmbedding_eq_initialForm, MaxAddDegree.initialForm_apply, - MaxAddDegree.initialForm_apply, dif_pos hd.symm, dif_neg (by + MaxAddDegree.initialForm_apply, dite_eq_left hd.symm, dite_eq_right (by rw [hdeg0] intro h0 exact hd0 (by rw [← hd, ← h0]))] at hcomp diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/PrincipalIrreducible.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/PrincipalIrreducible.lean index ac8a886286..ea1101f060 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/PrincipalIrreducible.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/PrincipalIrreducible.lean @@ -53,7 +53,7 @@ theorem not_isUnit_of_grade_ne_zero {alpha : NatOrdinal} (halpha : alpha ≠ 0) rw [hy] at hzero apply (one_ne_zero : (1 : PrincipalSubring K) ≠ 0) rw [DirectSum.one_def] at hzero ⊢ - simp only [DirectSum.of_apply, dif_pos] at hzero + simp only [DirectSum.of_apply, dite_eq_left] at hzero rw [show (GradedMonoid.GOne.one : PrincipalComponent K 0) = 0 by simpa using hzero, map_zero] /-- A nonzero class of grade zero is a unit: grade zero is the scalar field. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/ReducibleSpan.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/ReducibleSpan.lean index 403cbb21c1..1e3e7f6aa5 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/ReducibleSpan.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/ReducibleSpan.lean @@ -64,7 +64,7 @@ def gradeClass (α : NatOrdinal) (c : Series K) : PrincipalSubring K := theorem gradeClass_of_lt {α : NatOrdinal} {c : Series K} (h : ordinalValue c < ω^ (α + 1)) : gradeClass α c = DirectSum.of (PrincipalComponent K) α (principalComponentMk α c h) := by - rw [gradeClass, dif_pos h] + rw [gradeClass, dite_eq_left h] theorem gradeClass_eq_homogeneousMk {α : NatOrdinal} {c : Series K} (h : ordinalValue c < ω^ (α + 1)) : @@ -200,7 +200,7 @@ theorem gradeClass_eq_of_apply (α : NatOrdinal) (c : Series K) : gradeClass α c = DirectSum.of (PrincipalComponent K) α (gradeClass α c α) := by by_cases h : ordinalValue c < ω^ (α + 1) · rw [gradeClass_of_lt h, DirectSum.of_eq_same] - · rw [gradeClass, dif_neg h, DirectSum.zero_apply, map_zero] + · rw [gradeClass, dite_eq_right h, DirectSum.zero_apply, map_zero] /-! ### The reducible span -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/SupportRandom.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/SupportRandom.lean index a2131401c9..6ddfe75851 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/SupportRandom.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/SupportRandom.lean @@ -85,7 +85,7 @@ theorem IsMutuallySupportRandom.truncationsIndependent {ι : Type} {b : ι → S -- The coefficient of `R` at `x` vanishes, so another `c k₁` contributes at `x`. have hcoeff : ∀ k : κ, ((c k : Series K) : K⟦ℝ⟧).coeff x = ((b (j k) : Series K) : K⟦ℝ⟧).coeff (γ k + x) := fun k ↦ by - rw [hc, coeff_translatedTruncation, if_pos hx0.le] + rw [hc, coeff_translatedTruncation, ite_eq_left hx0.le] obtain ⟨k₁, hk₁P, hk₁ne, hk₁c⟩ : ∃ k₁ ∈ P, k₁ ≠ k₀ ∧ ((c k₁ : Series K) : K⟦ℝ⟧).coeff x ≠ 0 := by by_contra hnone push Not at hnone diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesMaximalFinite.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesMaximalFinite.lean index bc004fca80..fd590c4d97 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesMaximalFinite.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesMaximalFinite.lean @@ -295,7 +295,7 @@ theorem seriesMaximalFiniteSupportDivisor_eq_of_is classical let hex : ∃ c : Associates (FiniteSupportRing (K := K)), IsSeriesMaximalFiniteSupportDivisor b c := ⟨a, ha⟩ - rw [seriesMaximalFiniteSupportDivisor, dif_pos hex] + rw [seriesMaximalFiniteSupportDivisor, dite_eq_left hex] exact (Classical.choose_spec hex).eq ha /-- Under pairwise greatest-common-divisor existence, the canonical class satisfies its defining diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/GradedDivisibility.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/GradedDivisibility.lean index af6d7bca96..ef2980faf3 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/GradedDivisibility.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/GradedDivisibility.lean @@ -280,8 +280,8 @@ theorem gradedDivisibilityNonprincipalElement_not_mem : intro h have := congrArg Subtype.val h norm_num [gradedDivisibilityNonprincipalExponent] at this - rw [AddMonoidAlgebra.single_apply, if_neg (Ne.symm hne), - AddMonoidAlgebra.single_apply, if_pos rfl] at hcoeff + rw [AddMonoidAlgebra.single_apply, ite_eq_right (Ne.symm hne), + AddMonoidAlgebra.single_apply, ite_eq_left rfl] at hcoeff have hgraded : (0 : Berarducci.DegreeGraded K) = 1 := by simpa using congrArg diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupport.lean index df16624e79..48c71bfab4 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupport.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupport.lean @@ -223,7 +223,7 @@ private theorem finiteSupportCoefficients_surjective : simpa [bHahn, HahnSeries.mem_support] using hg have hgrange : g ∈ Set.range e := by contrapose! hgf' - exact Finsupp.embDomain_notin_range e f g hgf' + exact Finsupp.embDomain_of_notMem_range e f g hgf' obtain ⟨x, rfl⟩ := hgrange exact x.2 let b : Nonpositive G K := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalization.lean index fbd26af105..765512a372 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalization.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalization.lean @@ -78,9 +78,9 @@ theorem IsMonicFiniteSupport.mul let P : K⟦G⟧ := ((p : Nonpositive G K) : K⟦G⟧) let Q : K⟦G⟧ := ((q : Nonpositive G K) : K⟦G⟧) have hantidiagonal : - Finset.addAntidiagonal P.isPWO_support Q.isPWO_support (x + y) = {(x, y)} := by + Finset.antidiagonal P.isPWO_support Q.isPWO_support (x + y) = {(x, y)} := by ext ⟨i, j⟩ - simp only [Finset.mem_addAntidiagonal, Finset.mem_singleton, Prod.mk.injEq] + simp only [Finset.mem_antidiagonal, Finset.mem_singleton, Prod.mk.injEq] constructor · rintro ⟨hi, hj, hij⟩ have hix := hxGreatest.2 hi diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CofactorInduction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CofactorInduction.lean index 343d0e019a..adc0f1526c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CofactorInduction.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CofactorInduction.lean @@ -100,7 +100,7 @@ theorem degree_sub_strictTail_eq_bot {c : G} (hc : c < 0) (b : Nonpositive G K) (mem_support _ _).mp hg rw [HahnSeries.coeff_truncGT] at hg' by_contra hcg - rw [if_pos (not_le.mp hcg), sub_self] at hg' + rw [ite_eq_left (not_le.mp hcg), sub_self] at hg' exact hg' rfl /-- Above the cut, translated truncations of a series and its strict tail differ only by a series @@ -124,7 +124,7 @@ theorem degree_translatedTruncLE_sub_strictTail_eq_bot {c y : G} (hcy : c < y) rw [HahnSeries.coeff_truncGT] at hcoeff have hle : g + y ≤ c := by by_contra hn - rw [if_pos (not_le.mp hn), sub_self] at hcoeff + rw [ite_eq_left (not_le.mp hn), sub_self] at hcoeff exact hcoeff rfl simpa using sub_le_sub_right hle y @@ -201,10 +201,10 @@ theorem truncLE_eq_zero_of_forall_lt (f : K⟦G⟧) (y : G) ext g rw [HahnSeries.coeff_truncLE] by_cases hgy : g ≤ y - · rw [if_pos hgy] + · rw [ite_eq_left hgy] by_contra hne exact absurd hgy (not_le.mpr (h g ((mem_support _ _).mpr hne))) - · rw [if_neg hgy, HahnSeries.coeff_zero] + · rw [ite_eq_right hgy, HahnSeries.coeff_zero] omit [AddCommGroup G] [IsOrderedAddMonoid G] [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] [CompleteSpace G] in @@ -309,7 +309,7 @@ theorem degree_translatedTruncLE_separatedHsum_eq_bot_of_notMem (c : Nonpositive G K) (hc : (c : HahnSeries G K) = separatedHsum hX f hsep) {y : G} (hyC : ∀ x, y ∉ C x) (hyz : y ∉ closure (Set.range z)) : ν (translatedTruncLE y c) = ⊥ := by - rw [degree_translatedTruncLE_eq, if_neg ?_] + rw [degree_translatedTruncLE_eq, ite_eq_right ?_] intro hy exact (by have hcl : ((c : HahnSeries G K).closedSupport : Set G) ⊆ @@ -377,7 +377,7 @@ theorem degree_translatedTruncLE_of_pos {s : G} (hs : 0 < s) (b : Nonpositive G theorem degree_translatedTruncLE_eq_bot_of_notMem_closedSupport {s : G} {b : Nonpositive G K} (hs : s ∉ (b : HahnSeries G K).closedSupport) : ν (translatedTruncLE s b) = ⊥ := by - rw [degree_translatedTruncLE_eq, if_neg hs] + rw [degree_translatedTruncLE_eq, ite_eq_right hs] /-- A uniform degree bound at nonpositive cutoffs extends to every cutoff. -/ theorem degree_translatedTruncLE_le_of_nonpositive {b : Nonpositive G K} @@ -580,7 +580,7 @@ theorem exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal ((mem_closedSupport _ _).mp hzs) obtain ⟨F, hFw, hFbot, hFGE⟩ := hp z hz0 have hνT : ν (translatedTruncLE z u) = (β : WithBot NatOrdinal) := by - rw [degree_translatedTruncLE_eq, if_pos hzs, cantorBendixsonRank_eq, hzr, NatOrdinal.of_val] + rw [degree_translatedTruncLE_eq, ite_eq_left hzs, cantorBendixsonRank_eq, hzr, NatOrdinal.of_val] have hνF : ν (aeval V F) = (β : WithBot NatOrdinal) := by rw [← degree_eq_of_degree_sub_eq_bot hFbot, hνT] have hwle : ∀ d ∈ F.support, (Finsupp.weight wt) d ≤ β := by @@ -611,9 +611,9 @@ theorem exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal have hne := MvPolynomial.mem_support_iff.mp hd rw [MvPolynomial.coeff_sub, hFβ_def, coeff_weightedHomogeneousComponent] at hne by_cases hdw : (Finsupp.weight wt) d = β - · rw [if_pos hdw, sub_self] at hne + · rw [ite_eq_left hdw, sub_self] at hne exact absurd rfl hne - · rw [if_neg hdw, sub_zero] at hne + · rw [ite_eq_right hdw, sub_zero] at hne exact lt_of_le_of_ne (hwle d (MvPolynomial.mem_support_iff.mpr hne)) hdw have hkey : translatedTruncLE z u - aeval V Fβ = (translatedTruncLE z u - aeval V F) + aeval V (F - Fβ) := by @@ -845,7 +845,7 @@ theorem exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal rw [degree_eq_of_degree_sub_eq_bot h1] rw [degree_translatedTruncLE_eq] by_cases hm : (x : G) + s ∈ (R : HahnSeries G K).closedSupport - · rw [if_pos hm] + · rw [ite_eq_left hm] rcases eq_or_ne ((x : G) + s) (x : G) with heq | hne · rw [heq] · have hlt := hCrank x ((x : G) + s) ⟨hm, hy'C⟩ hne @@ -854,7 +854,7 @@ theorem exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal rw [cantorBendixsonRank_eq, cantorBendixsonRank_eq] exact hlt exact (WithBot.coe_le_coe.mpr (NatOrdinal.of.monotone hlt'.le)) - · rw [if_neg hm] + · rw [ite_eq_right hm] exact bot_le · have hbelow := lt_of_notMem_ordConnected (hCconv x) (hCmem x) hy'x hy'C have hzero : truncLE ((x : G) + s) (fx x) = 0 := @@ -869,7 +869,7 @@ theorem exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal intro x have h1 := hRdrop (x : G) (hX0 x) have hm : (x : G) ∈ (R : HahnSeries G K).closedSupport := hXs x.2 - rw [degree_translatedTruncLE_eq, if_pos hm] at h1 + rw [degree_translatedTruncLE_eq, ite_eq_left hm] at h1 exact WithBot.coe_lt_coe.mp h1 -- The local ideal condition for each piece. have hpux : ∀ x : ↥Xset, ∀ s : G, s ≤ 0 → ∃ F : MvPolynomial ι K, @@ -1005,7 +1005,7 @@ theorem exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal · have hz0 : z - (x : G) ≤ 0 := closure_minimal (cp x j).property isClosed_Iic ((mem_closedSupport _ _).mp hm) have hprof := hcpb x j (z - (x : G)) hz0 - rw [degree_translatedTruncLE_eq, if_pos hm, WithBot.coe_le_coe] at hprof + rw [degree_translatedTruncLE_eq, ite_eq_left hm, WithBot.coe_le_coe] at hprof have hval := NatOrdinal.of.symm.monotone hprof change NatOrdinal.val (NatOrdinal.of _) ≤ NatOrdinal.val _ at hval rwa [NatOrdinal.val_of] at hval @@ -1024,7 +1024,7 @@ theorem exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal (hplC j) (hplle j) hCmem hCopen hCdisj hCord (hsepP j) hdiscP (P j β).val (hstageP j) rw [degree_translatedTruncLE_eq] by_cases hm : y ∈ ((cP j : Nonpositive G K) : HahnSeries G K).closedSupport - · rw [if_pos hm] + · rw [ite_eq_left hm] have hrank : ((cP j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank y ≤ (P j β).val := by have hr := hbounds.1 y @@ -1037,7 +1037,7 @@ theorem exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal WithBot NatOrdinal) ≤ (NatOrdinal.of ((P j β).val) : WithBot NatOrdinal) := WithBot.coe_le_coe.mpr (NatOrdinal.of.monotone hrank) _ = (P j β : WithBot NatOrdinal) := by rw [NatOrdinal.of_val] - · rw [if_neg hm] + · rw [ite_eq_right hm] exact bot_le -- Step E: the final cofactors correct every truncation to the floor. refine ⟨fun j ↦ ctop j + cP j, ?_, ?_, ?_⟩ @@ -1334,7 +1334,7 @@ theorem exists_cofactors_degree_le_add_one_of_properly_locallyIdeal intro x have h1 := htruncationBounds.degree_translatedTruncLE_lt (hXneg x) have hm : (x : G) ∈ ((u : Nonpositive G K) : HahnSeries G K).closedSupport := (hXs x.2).1 - rw [degree_translatedTruncLE_eq, if_pos hm] at h1 + rw [degree_translatedTruncLE_eq, ite_eq_left hm] at h1 rw [hbx x] exact WithBot.coe_lt_coe.mp h1 have hRsum : ((u : Nonpositive G K) : HahnSeries G K) = 0 ∨ True := Or.inr trivial @@ -1403,7 +1403,7 @@ theorem exists_cofactors_degree_le_add_one_of_properly_locallyIdeal rw [h2] at h1 rw [degree_eq_of_degree_sub_eq_bot h1, degree_translatedTruncLE_eq] by_cases hm : (x : G) + s ∈ ((u : Nonpositive G K) : HahnSeries G K).closedSupport - · rw [if_pos hm] + · rw [ite_eq_left hm] rcases eq_or_ne ((x : G) + s) (x : G) with heq | hne · rw [heq, hbx x] · have hlt := hCrank x ((x : G) + s) ⟨hm, hy'C⟩ hne @@ -1413,7 +1413,7 @@ theorem exists_cofactors_degree_le_add_one_of_properly_locallyIdeal exact hlt rw [hbx x] exact WithBot.coe_le_coe.mpr (NatOrdinal.of.monotone hlt'.le) - · rw [if_neg hm] + · rw [ite_eq_right hm] exact bot_le · have hbelow := lt_of_notMem_ordConnected (hCconv x) (hCmem x) hy'x hy'C have hzero : truncLE ((x : G) + s) (fx x) = 0 := @@ -1553,7 +1553,7 @@ theorem exists_cofactors_degree_le_add_one_of_properly_locallyIdeal · have hz0 : z - (x : G) ≤ 0 := closure_minimal (cp x j).property isClosed_Iic ((mem_closedSupport _ _).mp hm) have hprof := hcpb x j (z - (x : G)) hz0 - rw [degree_translatedTruncLE_eq, if_pos hm, WithBot.coe_le_coe] at hprof + rw [degree_translatedTruncLE_eq, ite_eq_left hm, WithBot.coe_le_coe] at hprof have hval := NatOrdinal.of.symm.monotone hprof change NatOrdinal.val (NatOrdinal.of _) ≤ NatOrdinal.val _ at hval rwa [NatOrdinal.val_of] at hval @@ -1589,7 +1589,7 @@ theorem exists_cofactors_degree_le_add_one_of_properly_locallyIdeal (P j μ).val (hstageP j) 0 hclcen rw [degree_translatedTruncLE_eq] by_cases hm : z ∈ ((cP j : Nonpositive G K) : HahnSeries G K).closedSupport - · rw [if_pos hm] + · rw [ite_eq_left hm] have hrank : ((cP j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank z ≤ (P j μ).val := by have hr := hbounds z @@ -1602,7 +1602,7 @@ theorem exists_cofactors_degree_le_add_one_of_properly_locallyIdeal WithBot NatOrdinal) ≤ (NatOrdinal.of ((P j μ).val) : WithBot NatOrdinal) := WithBot.coe_le_coe.mpr (NatOrdinal.of.monotone hrank) _ = (P j μ : WithBot NatOrdinal) := by rw [NatOrdinal.of_val] - · rw [if_neg hm] + · rw [ite_eq_right hm] exact bot_le have hcPb : ∀ j, ν (cP j) ≤ P j μ := fun j ↦ by simpa only [translatedTruncLE_zero] using hcPbt j 0 diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Convolution.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Convolution.lean index 458387b647..f0ef3a57dc 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Convolution.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Convolution.lean @@ -41,16 +41,16 @@ variable [NonUnitalNonAssocSemiring R] /-- The coefficient of two weak truncations is a restricted finite antidiagonal sum. -/ theorem coeff_truncLE_mul_truncLE (b d : HahnSeries G R) (a c z : G) : (truncLE a b * truncLE c d).coeff z = - ∑ p ∈ (Finset.addAntidiagonal b.isPWO_support d.isPWO_support z).filter + ∑ p ∈ (Finset.antidiagonal b.isPWO_support d.isPWO_support z).filter (fun p ↦ p.1 ≤ a ∧ p.2 ≤ c), b.coeff p.1 * d.coeff p.2 := by classical rw [coeff_mul] - have he : Finset.addAntidiagonal (truncLE a b).isPWO_support + have he : Finset.antidiagonal (truncLE a b).isPWO_support (truncLE c d).isPWO_support z = - (Finset.addAntidiagonal b.isPWO_support d.isPWO_support z).filter + (Finset.antidiagonal b.isPWO_support d.isPWO_support z).filter (fun p ↦ p.1 ≤ a ∧ p.2 ≤ c) := by ext p - simp only [Finset.mem_addAntidiagonal, support_truncLE, mem_setOf_eq, Finset.mem_filter] + simp only [Finset.mem_antidiagonal, support_truncLE, mem_setOf_eq, Finset.mem_filter] tauto rw [he] apply Finset.sum_congr rfl @@ -98,15 +98,15 @@ theorem eventually_coeff_mul_eq_sum_truncLE (b d : HahnSeries G R) (γ : G) : rw [Finset.sum_comm] apply Finset.sum_congr rfl intro q hq - obtain ⟨hqb, hqd, hqz⟩ := Finset.mem_addAntidiagonal.mp hq + obtain ⟨hqb, hqd, hqz⟩ := Finset.mem_antidiagonal.mp hq let q' : (b.closedSupport : Set G) ×ˢ (d.closedSupport : Set G) := ⟨q, (b.mem_closedSupport q.1).mpr (subset_closure hqb), (d.mem_closedSupport q.2).mpr (subset_closure hqd)⟩ obtain ⟨p, hp, huniq⟩ := hz q' hqz symm - refine (Finset.sum_eq_single p.1 ?_ ?_).trans (if_pos hp.2) + refine (Finset.sum_eq_single p.1 ?_ ?_).trans (ite_eq_left hp.2) · intro r hr hne - apply if_neg + apply ite_eq_right intro hdom have hr' := (b.mem_closedSupportAddFiber d γ r).mp hr let r' : (b.closedSupport : Set G) ×ˢ (d.closedSupport : Set G) := @@ -164,12 +164,12 @@ theorem cantorBendixsonValue_convolution_error (b d : HahnSeries G R) (γ : G) : have he : z - -γ = γ + z := by simp only [sub_neg_eq_add, add_comm] rw [he] by_cases hzγ : γ + z ≤ γ - · rw [if_pos hzγ, hz] + · rw [ite_eq_left hzγ, hz] have hcoef : S.coeff (γ + z) = ∑ p ∈ b.closedSupportAddFiber d γ, (truncLE p.1 b * truncLE p.2 d).coeff (γ + z) := coeff_sum _ rw [hcoef, sub_self] - · rw [if_neg hzγ, hS _ (lt_of_not_ge hzγ), sub_self] + · rw [ite_eq_right hzγ, hS _ (lt_of_not_ge hzγ), sub_self] /-- The translated product truncation and its finite convolution sum have the same value. -/ @[blueprint "lem:cantor-bendixson-convolution" diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Derivation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Derivation.lean index 622574720c..1635df58d9 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Derivation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Derivation.lean @@ -66,7 +66,7 @@ def cantorBendixsonHomogeneousDerivation (α : NatOrdinal.{u}) : theorem cantorBendixsonHomogeneousDerivation_limit (α : NatOrdinal.{u}) (hα : α.constantCoeff = 0) : cantorBendixsonHomogeneousDerivation (G := G) (R := R) α = 0 := by - rw [cantorBendixsonHomogeneousDerivation, dif_neg (by simp [hα])] + rw [cantorBendixsonHomogeneousDerivation, dite_eq_right (by simp [hα])] private theorem successorDerivation_cast {α β : NatOrdinal.{u}} (h : α = β) (e : β + 1 = α + 1) : @@ -83,7 +83,7 @@ private theorem cantorBendixsonHomogeneousDerivation_succ (α : NatOrdinal.{u}) simp only [Nat.cast_one] at he rw [he] exact Nat.zero_lt_succ _ - rw [cantorBendixsonHomogeneousDerivation, dif_pos hc] + rw [cantorBendixsonHomogeneousDerivation, dite_eq_left hc] have he : (α + 1).removeNat 1 = α := by apply add_right_cancel (b := (1 : NatOrdinal)) simpa only [Nat.cast_one] using NatOrdinal.removeNat_add_natCast hc diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationIdeal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationIdeal.lean index 1b822ea7ab..3b1dbbe2e0 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationIdeal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationIdeal.lean @@ -155,10 +155,10 @@ theorem exists_grading_mul_and_derivation_eq_rankLevel by_cases hγ : γ ∈ (p : HahnSeries G K).closedSupport ∧ (p : HahnSeries G K).closedSupport.cantorBendixsonRank (p : HahnSeries G K).closedSupport_isPWO γ = δ.val - · simp only [dif_pos hγ, Function.comp_apply] + · simp only [dite_eq_left hγ, Function.comp_apply] change DirectSum.of (ν).Component β (b ⟨γ, hγ⟩) = a ⟨γ, hγ⟩ exact hb ⟨γ, hγ⟩ - · simp only [dif_neg hγ, Function.comp_apply, map_zero] + · simp only [dite_eq_right hγ, Function.comp_apply, map_zero] · refine ⟨0, ?_, ?_⟩ · rw [mul_zero] exact zero_mem _ @@ -167,8 +167,8 @@ theorem exists_grading_mul_and_derivation_eq_rankLevel by_cases hγ : γ ∈ (p : HahnSeries G K).closedSupport ∧ (p : HahnSeries G K).closedSupport.cantorBendixsonRank (p : HahnSeries G K).closedSupport_isPWO γ = δ.val - · simp only [Pi.zero_apply, dif_pos hγ, ha0 ⟨γ, hγ⟩ hβ] - · simp only [Pi.zero_apply, dif_neg hγ] + · simp only [Pi.zero_apply, dite_eq_left hγ, ha0 ⟨γ, hγ⟩ hβ] + · simp only [Pi.zero_apply, dite_eq_right hγ] open Classical in /-- Ideal membership of a successor homogeneous class follows from pointwise ideal membership @@ -250,20 +250,20 @@ theorem mem_span_of_cantorBendixsonGradedDerivation_eq_coe by_cases hi : (i : G) ∈ good · change (if (i : G) ∈ good then f i else 0) ∈ DirectSum.rangeLof K (ν).Component δ - rw [if_pos hi, ← hi] + rw [ite_eq_left hi, ← hi] exact DirectSum.of_mem_rangeLof K (ν).Component δ _ · change (if (i : G) ∈ good then f i else 0) ∈ DirectSum.rangeLof K (ν).Component δ - rw [if_neg hi] + rw [ite_eq_right hi] exact zero_mem _ have haIdeal : ∀ i, a i ∈ Ideal.span (Set.range q) := by intro i by_cases hi : (i : G) ∈ good · change (if (i : G) ∈ good then f i else 0) ∈ Ideal.span (Set.range q) - rw [if_pos hi] + rw [ite_eq_left hi] exact hf i · change (if (i : G) ∈ good then f i else 0) ∈ Ideal.span (Set.range q) - rw [if_neg hi] + rw [ite_eq_right hi] exact Ideal.zero_mem _ have hdec := fun i ↦ OrdinalGraded.exists_eq_sum_mul_of_mem_span (𝒜 := DirectSum.rangeLof K (ν).Component) hq (haGrade i) (haIdeal i) @@ -298,16 +298,16 @@ theorem mem_span_of_cantorBendixsonGradedDerivation_eq_coe by_cases hγ : γ ∈ (p : HahnSeries G K).closedSupport ∧ (p : HahnSeries G K).closedSupport.cantorBendixsonRank (p : HahnSeries G K).closedSupport_isPWO γ = δ.val - · simp only [dif_pos hγ] + · simp only [dite_eq_left hγ] calc DirectSum.of (ν).Component δ (cantorBendixsonDerivAt δ (p : Nonpositive G K) γ) = f γ := hγgood _ = a ⟨γ, hγ⟩ := by change f γ = if γ ∈ good then f γ else 0 - rw [if_pos hγgood] + rw [ite_eq_left hγgood] _ = ∑ j, q j * u ⟨γ, hγ⟩ j := hsum ⟨γ, hγ⟩ - · simp only [dif_neg hγ, mul_zero, Finset.sum_const_zero] + · simp only [dite_eq_right hγ, mul_zero, Finset.sum_const_zero] have hzero : cantorBendixsonDerivAt δ (p : Nonpositive G K) γ = 0 := by by_contra hne have hs := (cantorBendixsonDerivAt_ne_zero_iff δ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationSet.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationSet.lean index 51aca68be1..04ffa6627e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationSet.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationSet.lean @@ -113,9 +113,9 @@ theorem exists_derivation_eq_of_isDiscrete (ρ : NatOrdinal.{u}) (S : Set G) rw [Filter.Germ.mapLinear_coe, Filter.Germ.coe_eq] refine Filter.Eventually.of_forall fun γ ↦ ?_ by_cases hγ : γ ∈ S - · simp only [dif_pos hγ, if_pos hγ, Function.comp_apply] + · simp only [dite_eq_left hγ, ite_eq_left hγ, Function.comp_apply] exact hy ⟨γ, hγ⟩ - · simp only [dif_neg hγ, if_neg hγ, Function.comp_apply, map_zero] + · simp only [dite_eq_right hγ, ite_eq_right hγ, Function.comp_apply, map_zero] end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Derivative.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Derivative.lean index 3067d86243..ca2c3c6ddd 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Derivative.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Derivative.lean @@ -77,8 +77,8 @@ theorem degree_translatedTruncLE_eq (b : Nonpositive G R) (γ : G) : rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, coe_translatedTruncLE, HahnSeries.cantorBendixsonValue_translated_truncLE] by_cases hm : γ ∈ (b : HahnSeries G R).closedSupport - · simp only [if_pos hm, NatOrdinal.of_omega0_opow, NatOrdinal.cantorDegree_wpow] - · simp only [if_neg hm, NatOrdinal.of_zero, NatOrdinal.cantorDegree_zero] + · simp only [ite_eq_left hm, NatOrdinal.of_omega0_opow, NatOrdinal.cantorDegree_wpow] + · simp only [ite_eq_right hm, NatOrdinal.of_zero, NatOrdinal.cantorDegree_zero] /-- Translated truncations have degree strictly below any bound for the original degree, at all sufficiently close negative cutoffs. -/ @@ -106,7 +106,7 @@ theorem eventually_degree_translatedTruncLE_lt (b : Nonpositive G R) (α : NatOr filter_upwards [nhdsWithin_le_nhds hnh] with γ hγ change γ ∉ (b : HahnSeries G R).closedSupport at hγ rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, - coe_translatedTruncLE, cantorBendixsonValue_translated_truncLE, if_neg hγ, + coe_translatedTruncLE, cantorBendixsonValue_translated_truncLE, ite_eq_right hγ, NatOrdinal.of_zero, NatOrdinal.cantorDegree_zero] exact WithBot.bot_lt_coe α @@ -165,7 +165,7 @@ theorem cantorBendixsonDerivAt_eq (α : NatOrdinal.{u}) (b : Nonpositive G R) ( (h : ν (translatedTruncLE γ b) ≤ α) : cantorBendixsonDerivAt α b γ = (ν).componentMk α ⟨translatedTruncLE γ b, ((ν).mem_filtrationLE_iff _ _).mpr h⟩ := by - rw [cantorBendixsonDerivAt, dif_pos h] + rw [cantorBendixsonDerivAt, dite_eq_left h] /-- Under the successor-filtration bound, the pointwise derivative is nonzero exactly at the points of the representative's closed support having the prescribed Cantor–Bendixson rank. -/ @@ -180,17 +180,17 @@ theorem cantorBendixsonDerivAt_ne_zero_iff (α : NatOrdinal.{u}) have hdegree := degree_translatedTruncLE_eq b γ rw [hdegree] by_cases hm : γ ∈ (b : HahnSeries G R).closedSupport - · rw [if_pos hm, WithBot.coe_le_coe] + · rw [ite_eq_left hm, WithBot.coe_le_coe] constructor · intro hle refine ⟨hm, ?_⟩ have heq : NatOrdinal.of ((b : HahnSeries G R).cantorBendixsonRank γ) = α := - le_antisymm (by simpa only [hdegree, if_pos hm, WithBot.coe_le_coe] using h) hle + le_antisymm (by simpa only [hdegree, ite_eq_left hm, WithBot.coe_le_coe] using h) hle have := congrArg NatOrdinal.val heq simpa only [NatOrdinal.val_of] using this · rintro ⟨_, hr⟩ rw [hr, NatOrdinal.of_val] - · rw [if_neg hm] + · rw [ite_eq_right hm] exact ⟨fun hbot ↦ ((not_le_of_gt (WithBot.bot_lt_coe α)) hbot).elim, fun hmem ↦ (hm hmem.1).elim⟩ @@ -356,7 +356,7 @@ theorem exists_lt_and_degree_translatedTruncLE_eq (b : Nonpositive G R) (α ρ : rw [h0] at hγlevel exact absurd (hrank0.symm.trans hγlevel.2) (ne_of_gt hρval) refine ⟨γ, hγmem.1, lt_of_le_of_ne hγ0 hγne, ?_⟩ - rw [degree_translatedTruncLE_eq, if_pos hγlevel.1, cantorBendixsonRank_eq, hγlevel.2, + rw [degree_translatedTruncLE_eq, ite_eq_left hγlevel.1, cantorBendixsonRank_eq, hγlevel.2, NatOrdinal.of_val] /-- Below a degree that is a limit ordinal, no eventual bound on the truncation degrees holds: @@ -389,7 +389,7 @@ theorem degree_le_add_one_of_forall_neg_le (b : Nonpositive G R) (τ : NatOrdina · exfalso have hmem : z ∈ (b : HahnSeries G R).closedSupport := (mem_closedSupport _ _).mpr hzs have hd := h z hzneg - rw [degree_translatedTruncLE_eq, if_pos hmem, WithBot.coe_le_coe] at hd + rw [degree_translatedTruncLE_eq, ite_eq_left hmem, WithBot.coe_le_coe] at hd have hval := NatOrdinal.of.symm.monotone hd change NatOrdinal.val (NatOrdinal.of ((b : HahnSeries G R).cantorBendixsonRank z)) ≤ NatOrdinal.val τ at hval diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Germ.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Germ.lean index a87a19a85e..90d03c8446 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Germ.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Germ.lean @@ -97,7 +97,7 @@ theorem constantCoeff_ne_zero_of_isUnit_cantorBendixson_germ rw [show ((b * c : Nonpositive G R) : HahnSeries G R).coeff 0 = (b : HahnSeries G R).coeff 0 * (c : HahnSeries G R).coeff 0 from coeff_zero_mul b c] at hbc' - simpa only [constantCoeff_apply, Subring.coe_one, HahnSeries.coeff_one, if_pos] using hbc' + simpa only [constantCoeff_apply, Subring.coe_one, HahnSeries.coeff_one, ite_eq_left] using hbc' intro hb0 rw [hb0, zero_mul] at hbc exact zero_ne_one hbc diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/GlobalCofactors.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/GlobalCofactors.lean index 1cda31db2d..1df32a5813 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/GlobalCofactors.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/GlobalCofactors.lean @@ -133,14 +133,14 @@ theorem exists_forall_degree_translatedTruncLE_sub_sum_mul_lt (β : NatOrdinal.{ · have hu' : ν (translatedTruncLE x u) < β := by by_cases hxm : x ∈ (u : HahnSeries G R).closedSupport · refine lt_of_le_of_ne (hu x hx) ?_ - rw [degree_translatedTruncLE_eq, if_pos hxm] + rw [degree_translatedTruncLE_eq, ite_eq_left hxm] intro he apply hxl refine ⟨hxm, ?_⟩ have hval := congrArg NatOrdinal.val (WithBot.coe_injective he) rw [NatOrdinal.val_of, cantorBendixsonRank_eq] at hval exact hval - · rw [degree_translatedTruncLE_eq, if_neg hxm] + · rw [degree_translatedTruncLE_eq, ite_eq_right hxm] exact hbot rw [map_sub, map_sum] refine ((ν).map_sub_le_max _ _).trans_lt (max_lt hu' ?_) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LeadingCoefficient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LeadingCoefficient.lean index 4ac9be0420..6bebf97580 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LeadingCoefficient.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LeadingCoefficient.lean @@ -138,7 +138,7 @@ theorem false_of_aeval_eq_zero_of_leastTerm_le_of_ne_zero rw [pow_zero, one_mul, xCoeff_of_mem_supported B₀ (LiftFamily.FreeOfVariable.pol_translatedTruncLE_aeval_mem_supported (σ := σ) (hx := hx) hσ hinj hg hF0hom (hFkmem 0) (hFkvars 0) hγ) D, - if_neg (Nat.ne_of_gt hD)] + ite_eq_right (Nat.ne_of_gt hD)] · have hfreeK := LiftFamily.FreeOfVariable.aeval (σ := σ) (hx := hx) hσ hinj hg (hFkhom k hkD') (hαklt k hk1 hkD') (hFkmem k) (hFkvars k) exact (LiftFamily.FreeOfVariable.xCoeff_pol_translatedTruncLE_lift_pow_mul diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Leibniz.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Leibniz.lean index 3ae428cac7..6b05e8cb0d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Leibniz.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Leibniz.lean @@ -62,10 +62,10 @@ theorem cantorBendixsonValue_leibnizRemainder_lt_of_forall (b d : HahnSeries G R (d.support_translated_truncLE p.2) apply le_antisymm _ zero_le rcases hnot with hp | hp - · rw [cantorBendixsonValue_translated_truncLE, if_neg hp, + · rw [cantorBendixsonValue_translated_truncLE, ite_eq_right hp, NatOrdinal.of_zero, zero_mul] at hmul exact hmul - · rw [d.cantorBendixsonValue_translated_truncLE, if_neg hp, + · rw [d.cantorBendixsonValue_translated_truncLE, ite_eq_right hp, NatOrdinal.of_zero, mul_zero] at hmul exact hmul have hsub : I ⊆ I' := fun _ hp ↦ @@ -147,7 +147,7 @@ private theorem eventually_truncation_value_lt_wpow (b : HahnSeries G R) (α : N have hev := isClosed_closure.isOpen_compl.mem_nhds hn filter_upwards [hev] with c hc _ rw [b.cantorBendixsonValue_translated_truncLE, - if_neg (by simpa only [mem_closedSupport, mem_compl_iff] using hc), NatOrdinal.of_zero] + ite_eq_right (by simpa only [mem_closedSupport, mem_compl_iff] using hc), NatOrdinal.of_zero] exact NatOrdinal.wpow_pos _ · filter_upwards [b.eventually_value_translated_truncLE_lt hz] with c hc hne exact lt_of_lt_of_le (hc hne) hb @@ -174,11 +174,11 @@ theorem eventually_cantorBendixsonValue_leibnizRemainder_lt_of_le_wpow (b d : Ha have hyv := (hηv ⟨hγ.1.trans hγy, hy.le⟩).2 hy.ne have hxle : NatOrdinal.of (translate (-x) (truncLE x b)).cantorBendixsonValue ≤ ω^ α := by by_cases hm : x ∈ b.closedSupport - · rw [b.cantorBendixsonValue_translated_truncLE, if_pos hm, + · rw [b.cantorBendixsonValue_translated_truncLE, ite_eq_left hm, NatOrdinal.of_omega0_opow] at hxv ⊢ exact NatOrdinal.wpow_le_wpow.mpr (Order.lt_add_one_iff.mp (NatOrdinal.wpow_lt_wpow.mp hxv)) - · rw [b.cantorBendixsonValue_translated_truncLE, if_neg hm, NatOrdinal.of_zero] + · rw [b.cantorBendixsonValue_translated_truncLE, ite_eq_right hm, NatOrdinal.of_zero] exact zero_le have hprod := (translate (-x) (truncLE x b)).cantorBendixsonValue_mul_le (translate (-y) (truncLE y d)) (b.support_translated_truncLE x) @@ -186,12 +186,12 @@ theorem eventually_cantorBendixsonValue_leibnizRemainder_lt_of_le_wpow (b d : Ha apply hprod.trans_lt apply (mul_le_mul_left hxle _).trans_lt by_cases hm : y ∈ d.closedSupport - · rw [d.cantorBendixsonValue_translated_truncLE, if_pos hm, + · rw [d.cantorBendixsonValue_translated_truncLE, ite_eq_left hm, NatOrdinal.of_omega0_opow] at hyv ⊢ rw [← NatOrdinal.wpow_add] apply NatOrdinal.wpow_lt_wpow.mpr exact add_lt_add_right (NatOrdinal.wpow_lt_wpow.mp hyv) α - · rw [d.cantorBendixsonValue_translated_truncLE, if_neg hm, + · rw [d.cantorBendixsonValue_translated_truncLE, ite_eq_right hm, NatOrdinal.of_zero, mul_zero] exact NatOrdinal.wpow_pos _ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LiftFamily.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LiftFamily.lean index 72205bc112..4f5cec208c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LiftFamily.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LiftFamily.lean @@ -99,7 +99,7 @@ theorem exists_representative_hasLowerTruncationDegree rw [HahnSeries.coeff_sub, hbdef, HahnSeries.coeff_truncGT] at hcoeff have hle : g + γ ≤ c := by by_contra hn - rw [if_pos (not_le.mp hn), sub_self] at hcoeff + rw [ite_eq_left (not_le.mp hn), sub_self] at hcoeff exact hcoeff rfl simpa using sub_le_sub_right hle γ have hsub : ν ((w : Nonpositive G K) - b) = ⊥ := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Lifts.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Lifts.lean index 9929db9b20..e0ca791ea0 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Lifts.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Lifts.lean @@ -195,7 +195,7 @@ theorem eq_zero_of_forall_weight_lt_of_degree_aeval_eq_bot · obtain ⟨d, hd⟩ := MvPolynomial.ne_zero_iff.mp hzero rw [coeff_weightedHomogeneousComponent] at hd by_cases hdw : (Finsupp.weight wt) d = β - · rw [if_pos hdw] at hd + · rw [ite_eq_left hdw] at hd have hβα : β < α := hdw ▸ hw d (MvPolynomial.mem_support_iff.mpr hd) have hrep := represents_aeval_weightedHomogeneousComponent x hV hβ have hrep0 : Represents (aeval V F) β 0 := @@ -203,13 +203,13 @@ theorem eq_zero_of_forall_weight_lt_of_degree_aeval_eq_bot exact absurd (hinj β _ hβα (weightedHomogeneousComponent_isWeightedHomogeneous (w := wt) (n := β) (φ := F)) (hrep.unique hrep0)) hzero - · rw [if_neg hdw] at hd + · rw [ite_eq_right hdw] at hd exact absurd rfl hd have hlt : ∀ d ∈ F.support, (Finsupp.weight wt) d < β := by intro d hd refine lt_of_le_of_ne (hβ d hd) fun he ↦ ?_ have := congrArg (MvPolynomial.coeff d) hcomp0 - rw [coeff_weightedHomogeneousComponent, if_pos he, MvPolynomial.coeff_zero] at this + rw [coeff_weightedHomogeneousComponent, ite_eq_left he, MvPolynomial.coeff_zero] at this exact MvPolynomial.mem_support_iff.mp hd this rcases eq_or_ne β 0 with rfl | hβ0 · rw [MvPolynomial.eq_zero_iff] @@ -247,7 +247,7 @@ theorem forall_weight_le_degree_aeval_of_injective intro e he refine lt_of_le_of_ne (hβ e he) fun heq ↦ ?_ have hcz := congrArg (MvPolynomial.coeff e) hzero - rw [coeff_weightedHomogeneousComponent, if_pos heq, MvPolynomial.coeff_zero] at hcz + rw [coeff_weightedHomogeneousComponent, ite_eq_left heq, MvPolynomial.coeff_zero] at hcz exact MvPolynomial.mem_support_iff.mp he hcz rcases eq_or_ne β 0 with rfl | hβ0 · exact absurd (hlt d hd) (not_lt_of_ge (zero_le (a := (Finsupp.weight wt) d))) @@ -258,13 +258,13 @@ theorem forall_weight_le_degree_aeval_of_injective rw [coeff_weightedHomogeneousComponent] at he by_cases hew : (Finsupp.weight wt) e = β · have hβα : β < α := hew ▸ hw e (MvPolynomial.mem_support_iff.mpr (by - rwa [if_pos hew] at he)) + rwa [ite_eq_left hew] at he)) have haev : aeval x (weightedHomogeneousComponent wt β F) ≠ 0 := fun h ↦ hzero (hinj β _ hβα (weightedHomogeneousComponent_isWeightedHomogeneous (w := wt) (n := β) (φ := F)) h) rw [(represents_aeval_weightedHomogeneousComponent x hV hβ).degree_eq haev] exact WithBot.coe_le_coe.mpr (hβ d hd) - · rw [if_neg hew] at he + · rw [ite_eq_right hew] at he exact absurd rfl he open Classical in @@ -339,8 +339,8 @@ theorem translatedTruncLE_smul (γ : G) (k : K) (b : Nonpositive G K) : rw [HahnSeries.coeff_smul, coeff_translate, coeff_translate, HahnSeries.coeff_truncLE, HahnSeries.coeff_truncLE, HahnSeries.coeff_smul] by_cases h : g - -γ ≤ γ - · rw [if_pos h, if_pos h] - · rw [if_neg h, if_neg h, smul_zero] + · rw [ite_eq_left h, ite_eq_left h] + · rw [ite_eq_right h, ite_eq_right h, smul_zero] /-- A lift of the zero class has degree strictly below the class degree. -/ theorem Represents.degree_lt_of_eq_zero {b : Nonpositive G K} {m : NatOrdinal.{u}} diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalEvaluation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalEvaluation.lean index 80e37a67a1..138fb564b7 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalEvaluation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalEvaluation.lean @@ -255,7 +255,7 @@ theorem injectiveAt_of_limit have hlam₀ : lam₀ < NatOrdinal.partLT β α := max_lt hlamE1 hl₁ have hα₁le : α₁ ≤ NatOrdinal.partGE β α + lam₀ := by by_cases h : NatOrdinal.partGE β α₁ = NatOrdinal.partGE β α - · have hl : l₁ = NatOrdinal.partLT β α₁ := by rw [hl₁def, if_pos h] + · have hl : l₁ = NatOrdinal.partLT β α₁ := by rw [hl₁def, ite_eq_left h] calc α₁ = NatOrdinal.partGE β α₁ + NatOrdinal.partLT β α₁ := (NatOrdinal.partGE_add_partLT β α₁).symm _ = NatOrdinal.partGE β α + l₁ := by rw [h, hl] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean index 24e7a08edf..99889ef22e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean @@ -251,7 +251,7 @@ theorem degLT_eq_zero_of_mem_vars_H {i : ι} (hD : degreeOf S.B₀ S.F = 1) (hi exact hid' rfl have hid : i ∈ d.support := by rw [Finsupp.mem_support_iff] at hid' ⊢ - rw [Finsupp.tsub_apply, Finsupp.single_apply, if_neg hi0.symm, Nat.sub_zero] at hid' + rw [Finsupp.tsub_apply, Finsupp.single_apply, ite_eq_right hi0.symm, Nat.sub_zero] at hid' exact hid' -- the parts below `β` of `d` add up to `α_{<β} = (deg B₀)_{<β}`, and `B₀` contributes all of it have hsum := S.sum_degLT_eq_αLT hd @@ -328,7 +328,7 @@ theorem exists_eq_add_single_add_single {d : ι →₀ ℕ} {i u : ι} (hi : i have hdi : 1 ≤ d i := Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hi) have hdu : 1 ≤ d u := Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hu) have h1 : Finsupp.single u 1 ≤ d - Finsupp.single i 1 := by - rw [Finsupp.single_le_iff, Finsupp.tsub_apply, Finsupp.single_apply, if_neg (Ne.symm hui)] + rw [Finsupp.single_le_iff, Finsupp.tsub_apply, Finsupp.single_apply, ite_eq_right (Ne.symm hui)] omega have h2 : Finsupp.single i 1 ≤ d := Finsupp.single_le_iff.mpr hdi rw [add_right_comm, tsub_add_cancel_of_le h1, tsub_add_cancel_of_le h2] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LinearMaximal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LinearMaximal.lean index d98e58b155..8da8805a5e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LinearMaximal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LinearMaximal.lean @@ -206,7 +206,7 @@ theorem degreeOf_eq_one by_contra hnot have hle : τ ≤ Finsupp.weight wt d := not_lt.mp hnot have hcoeff := congrArg (MvPolynomial.coeff d) (hzero γ hγ hγ0) - rw [coeff_componentsGE, if_pos hle, MvPolynomial.coeff_zero] at hcoeff + rw [coeff_componentsGE, ite_eq_left hle, MvPolynomial.coeff_zero] at hcoeff exact mem_support_iff.mp hd hcoeff simpa only [add_zero] using hdeglt · exact hhα diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LowerTruncationDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LowerTruncationDegree.lean index 00c7a47a38..415e451e6d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LowerTruncationDegree.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LowerTruncationDegree.lean @@ -88,7 +88,7 @@ theorem hasLowerTruncationDegree_algebraMap (k : K) : · rw [algebraMap_apply] exact degree_C_le k · intro y hy - rw [degree_translatedTruncLE_eq, if_neg ?_] + rw [degree_translatedTruncLE_eq, ite_eq_right ?_] · exact WithBot.bot_lt_coe 0 · intro hmem have hclos := (mem_closedSupport _ _).mp hmem @@ -523,9 +523,9 @@ theorem exists_lt_forall_degree_monomial_leibniz_le rw [MvPolynomial.pderiv_pow, MvPolynomial.pderiv_X] by_cases hji : j = i · subst hji - rw [Pi.single_eq_same, if_pos rfl, mul_one, map_mul, map_pow, MvPolynomial.aeval_X, + rw [Pi.single_eq_same, ite_eq_left rfl, mul_one, map_mul, map_pow, MvPolynomial.aeval_X, map_natCast, Nat.add_sub_cancel, nsmul_eq_mul] - · rw [Pi.single_eq_of_ne (Ne.symm hji), if_neg hji, mul_zero, map_zero] + · rw [Pi.single_eq_of_ne (Ne.symm hji), ite_eq_right hji, mul_zero, map_zero] have hA : aeval V (MvPolynomial.monomial (Finsupp.single i (n + 1) + d') (1 : K)) = V i ^ (n + 1) * aeval V (MvPolynomial.monomial d' (1 : K)) := by rw [hsplit, map_mul, map_pow, MvPolynomial.aeval_X] @@ -561,13 +561,13 @@ theorem exists_lt_forall_degree_monomial_leibniz_le rw [hsplit, MvPolynomial.pderiv_mul, map_add, e1, e2, add_mul] congr 1 · by_cases hji : j = i - · rw [if_pos hji, if_pos hji, hji] - · rw [if_neg hji, if_neg hji, zero_mul, zero_mul] + · rw [ite_eq_left hji, ite_eq_left hji, hji] + · rw [ite_eq_right hji, ite_eq_right hji, zero_mul, zero_mul] · ring rw [Finset.sum_congr rfl hterm, Finset.sum_add_distrib, ← Finset.mul_sum, Finset.sum_ite_eq' t i (fun _ ↦ ((n + 1 : ℕ) • (V i ^ n) * aeval V (MvPolynomial.monomial d' (1 : K))) * translatedTruncLE γ (V i)), - if_pos hit] + ite_eq_left hit] obtain ⟨lamA, hlamA, hboundA⟩ := exists_lt_forall_degree_pow_leibniz_le (hV i) (hwt i) n by_cases hd0 : d' = 0 @@ -836,13 +836,13 @@ theorem exists_lt_forall_degree_polynomialDifferentiatedRelation_le exact ⟨Q, hQw, hQ⟩ choose Q hQw hQ using hrep refine ⟨fun i ↦ if hi : i ∈ t then Q i hi else 0, fun i hi ↦ by - simpa only [dif_pos hi] using hQw i hi, ?_⟩ + simpa only [dite_eq_left hi] using hQw i hi, ?_⟩ -- substituting is exact modulo series bounded strictly below zero have hsub : ν ((∑ i ∈ t, aeval V (MvPolynomial.pderiv i F) * translatedTruncLE γ (V i)) - ∑ i ∈ t, aeval V (MvPolynomial.pderiv i F) * aeval V (if hi : i ∈ t then Q i hi else 0)) = ⊥ := by refine degree_sub_eq_bot_sum t _ _ fun i hi ↦ ?_ - rw [dif_pos hi] + rw [dite_eq_left hi] exact degree_sub_eq_bot_mul (by simp) (hQ i hi) have hval : aeval V (∑ i ∈ t, MvPolynomial.pderiv i F * (if hi : i ∈ t then Q i hi else 0)) = diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/OrderedIntervalCantorBendixson.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/OrderedIntervalCantorBendixson.lean index edf8387287..c282ce6e0b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/OrderedIntervalCantorBendixson.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/OrderedIntervalCantorBendixson.lean @@ -97,7 +97,7 @@ theorem support_translatedTruncLE_orderedIntervalHsum_sub_component_subset · exact (not_lt_of_ge (hxle.trans (hord i j hij))) (hsupp j hxj).1 _ = (f i).coeff x := congrArg (fun q : R⟦Γ⟧ ↦ q.coeff x) (orderedIntervalSummableFamily_apply hι f cut center hsupp hord i) - rw [HahnSeries.coeff_truncLE, if_pos hxle, hcoeff, sub_self] + rw [HahnSeries.coeff_truncLE, ite_eq_left hxle, hcoeff, sub_self] · have hnot : ¬x ≤ center i := by change ¬center i + g ≤ center i exact not_le_of_gt (by @@ -105,7 +105,7 @@ theorem support_translatedTruncLE_orderedIntervalHsum_sub_component_subset have hfi : (f i).coeff x = 0 := by by_contra h exact hnot (hsupp i ((mem_support _ _).mpr h)).2 - rw [HahnSeries.coeff_truncLE, if_neg hnot, hfi, sub_zero] + rw [HahnSeries.coeff_truncLE, ite_eq_right hnot, hfi, sub_zero] end AddCommGroup diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativeIndices.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativeIndices.lean index 0c87b85110..9bb3f2aa83 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativeIndices.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativeIndices.lean @@ -67,7 +67,7 @@ theorem componentsGE_mem_span_subtype {ι : Type w} [Finite ι] (weightedHomogeneousComponent wt (Finsupp.weight wt d) P) = weightedHomogeneousComponent wt (Finsupp.weight wt d) P := by rw [weightedHomogeneousComponent_of_mem - (weightedHomogeneousComponent_mem wt P _), if_pos rfl] + (weightedHomogeneousComponent_mem wt P _), ite_eq_left rfl] rw [← hcomp, hsum] rw [← Finset.sum_filter_add_sum_filter_not Finset.univ A] have hzero : ∑ j ∈ Finset.univ.filter (fun j ↦ ¬ A j), q j * a j = 0 := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativesAtLimitOrdinal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativesAtLimitOrdinal.lean index af0c17fcfc..52a01246d4 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativesAtLimitOrdinal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativesAtLimitOrdinal.lean @@ -343,13 +343,13 @@ theorem exists_finset_pderiv_eq_sum_of_lowDegreePartAlgebraicLE {v' : ι} (hv' : · intro i hi obtain ⟨v, -, rfl⟩ := Finset.mem_image.mp hi beta_reduce - rw [dif_pos (⟨v, rfl⟩ : + rw [dite_eq_left (⟨v, rfl⟩ : ∃ w : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, w.1.1 = v.1.1)] exact hCB₀ _ · rw [hΘeq, Finset.sum_image fun v _ w _ h ↦ hindex h] refine Finset.sum_congr rfl fun v _ ↦ ?_ beta_reduce - rw [dif_pos (⟨v, rfl⟩ : + rw [dite_eq_left (⟨v, rfl⟩ : ∃ w : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, w.1.1 = v.1.1)] have hchoice : Classical.choose (⟨v, rfl⟩ : ∃ w : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/ScalarLeadingCoefficientAtLimitOrdinal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/ScalarLeadingCoefficientAtLimitOrdinal.lean index d00aecef4f..2a909ef73c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/ScalarLeadingCoefficientAtLimitOrdinal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/ScalarLeadingCoefficientAtLimitOrdinal.lean @@ -110,7 +110,7 @@ theorem false_of_aeval_eq_zero_of_leadingCoefficientDegree_eq_zero intro h have hc := congrArg (MvPolynomial.coeff (Finsupp.single B₀ 1)) h rw [MvPolynomial.coeff_add, MvPolynomial.coeff_C_mul, MvPolynomial.coeff_X, - if_pos rfl, mul_one, MvPolynomial.coeff_zero] at hc + ite_eq_left rfl, mul_one, MvPolynomial.coeff_zero] at hc have hleft : MvPolynomial.coeff (Finsupp.single B₀ 1) (xCoeff B₀ D' F) = 0 := by by_contra hne exact (mem_supported.mp (hFkmem D')) @@ -206,7 +206,7 @@ theorem false_of_aeval_eq_zero_of_leadingCoefficientDegree_eq_zero rw [pow_zero, one_mul, xCoeff_of_mem_supported B₀ (LiftFamily.FreeOfVariable.pol_translatedTruncLE_aeval_mem_supported (σ := σ) (hx := hx) hσ hinj hg hF0hom (hFkmem 0) (hFkvars 0) hγ) D', - if_neg (Nat.ne_of_gt hD'1)] + ite_eq_right (Nat.ne_of_gt hD'1)] · have hmk : (D' + 1 - k) • wt B₀ < α := by rw [← hαk k hkD] exact lt_add_of_pos_right _ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SeparatedPieceCantorBendixson.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SeparatedPieceCantorBendixson.lean index 8ce7700117..c8c4a97dfc 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SeparatedPieceCantorBendixson.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SeparatedPieceCantorBendixson.lean @@ -54,13 +54,13 @@ theorem support_truncLE_separatedHsum_sub_piece_subset apply hg rw [HahnSeries.coeff_sub, HahnSeries.coeff_truncLE, HahnSeries.coeff_truncLE] by_cases hgy : g ≤ y - · rw [if_pos hgy, if_pos hgy, coeff_separatedHsum_eq hX f hsep x g ?_, sub_self] + · rw [ite_eq_left hgy, ite_eq_left hgy, coeff_separatedHsum_eq hX f hsep x g ?_, sub_self] intro j hji hgj have hgCj : g ∈ C j := hfC j hgj rcases lt_or_gt_of_ne hji with hj | hj · exact hgc ((hord j x hj g hgCj c hc).le) · exact absurd (hord x j hj y hy g hgCj) (not_lt.mpr hgy) - · rw [if_neg hgy, if_neg hgy, sub_self] + · rw [ite_eq_right hgy, ite_eq_right hgy, sub_self] omit [AddCommGroup G] [IsOrderedAddMonoid G] in /-- Removing the part of a series outside a convex piece changes its weak truncations only at or @@ -76,13 +76,13 @@ theorem support_truncLE_sub_truncLE_setRestrict_subset rw [HahnSeries.coeff_sub, HahnSeries.coeff_truncLE, HahnSeries.coeff_truncLE, coeff_setRestrict] by_cases hgy : g ≤ y - · rw [if_pos hgy, if_pos hgy] + · rw [ite_eq_left hgy, ite_eq_left hgy] by_cases hgC : g ∈ C - · rw [if_pos hgC, sub_self] - · rw [if_neg hgC] + · rw [ite_eq_left hgC, sub_self] + · rw [ite_eq_right hgC] have hgb : g ∉ b.support := fun hgb ↦ hgc (hb g hgb hgC hgy) rw [not_not.mp fun h ↦ hgb ((mem_support _ _).mpr h), sub_zero] - · rw [if_neg hgy, if_neg hgy, sub_self] + · rw [ite_eq_right hgy, ite_eq_right hgy, sub_self] open Classical in /-- Inside a piece, translating the difference between the truncated sum and the truncated diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SyzygyIntegration.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SyzygyIntegration.lean index 874dbce57d..9c1abe9324 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SyzygyIntegration.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/SyzygyIntegration.lean @@ -113,9 +113,9 @@ theorem hasSyzygyIntegration {B : Type w} [Finite B] (lam : B → NatOrdinal.{u} eventually_degree_translatedTruncLE_le (p b') (ρ b') (by rw [hρsucc] exact hpdeg)] with γ hγI hγdeg - simp only [D, dif_pos hb] + simp only [D, dite_eq_left hb] by_cases hne : cantorBendixsonDerivAt (ρ b') (p b') γ ≠ 0 - · rw [if_pos] + · rw [ite_eq_left] refine mem_iUnion_of_mem b' ⟨?_, hγI⟩ rw [mem_rankLevelSet_iff, ← cantorBendixsonRank_eq] exact (cantorBendixsonDerivAt_ne_zero_iff _ _ _ hγdeg).mp hne @@ -124,7 +124,7 @@ theorem hasSyzygyIntegration {B : Type w} [Finite B] (lam : B → NatOrdinal.{u} split <;> rfl · have hDzero : D b = 0 := by funext γ - simp only [D, dif_neg hb, Pi.zero_apply] + simp only [D, dite_eq_right hb, Pi.zero_apply] rw [hDzero, Filter.Germ.coe_zero] by_cases hex : ∃ β, β + lam b = d · obtain ⟨β', hβ'⟩ := hex @@ -146,17 +146,17 @@ theorem hasSyzygyIntegration {B : Type w} [Finite B] (lam : B → NatOrdinal.{u} have hleft : ρ b' + lam b = d.removeNat 1 := by rw [← NatOrdinal.removeNat_add_right (β b') (lam b) (hβpos b'), hβ] exact hleft.trans hκ.symm - simp only [D, dif_pos hb] + simp only [D, dite_eq_left hb] split · rw [← hρ] exact DirectSum.of_mem_rangeLof K (ν).Component (ρ b') _ · exact zero_mem _ - · simp only [D, dif_neg hb] + · simp only [D, dite_eq_right hb] exact zero_mem _ · by_cases hb : b ∈ active · exact (hn ⟨ρ ⟨b, hb⟩, by rw [← NatOrdinal.removeNat_add_right (β ⟨b, hb⟩) (lam b) (hβpos ⟨b, hb⟩), hβ]⟩).elim - · simp only [D, dif_neg hb] + · simp only [D, dite_eq_right hb] · intro b γ hγ simp only [D] split <;> rfl @@ -201,9 +201,9 @@ theorem hasSyzygyIntegration {B : Type w} [Finite B] (lam : B → NatOrdinal.{u} · rw [cantorBendixsonDerivation_apply] exact hderiv · intro γ hγ - simp only [if_pos hγ] + simp only [ite_eq_left hγ] · intro γ hγ - simp only [if_neg hγ] + simp only [ite_eq_right hγ] end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolation.lean index b643d66939..1f6dcb0b19 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolation.lean @@ -372,9 +372,9 @@ theorem exists_prescribed_components_on_rankLevel (α β : NatOrdinal.{u}) by_cases hs : γ ∈ (p : HahnSeries G R).closedSupport ∧ (p : HahnSeries G R).closedSupport.cantorBendixsonRank (p : HahnSeries G R).closedSupport_isPWO γ = α.val - · rw [dif_pos hs, cantorBendixsonDerivAt_eq β b γ hbγ] + · rw [dite_eq_left hs, cantorBendixsonDerivAt_eq β b γ hbγ] exact (hpoint ⟨γ, hs⟩).choose_spec - · rw [dif_neg hs] + · rw [dite_eq_right hs] by_contra hne have hbexact := (cantorBendixsonDerivAt_ne_zero_iff β b γ hbγ).mp hne have hbB : (b : HahnSeries G R) = B := rfl @@ -498,7 +498,7 @@ theorem exists_prescribed_truncations_on_topRankLevel (β ρ : NatOrdinal.{u}) have hx0 : x ≤ 0 := closure_minimal p.property isClosed_Iic ((mem_closedSupport _ _).mp hxs) have hd := hp x hx0 - rw [degree_translatedTruncLE_eq, if_pos hxs, WithBot.coe_le_coe] at hd + rw [degree_translatedTruncLE_eq, ite_eq_left hxs, WithBot.coe_le_coe] at hd have hval := NatOrdinal.of.symm.monotone hd change NatOrdinal.val (NatOrdinal.of ((p : HahnSeries G R).cantorBendixsonRank x)) ≤ NatOrdinal.val β at hval @@ -517,14 +517,14 @@ theorem exists_prescribed_truncations_on_topRankLevel (β ρ : NatOrdinal.{u}) exact fun hyd ↦ hyn (hclosure (hderiv hyd)) rw [degree_translatedTruncLE_eq] by_cases hym : y ∈ (c : HahnSeries G R).closedSupport - · rw [if_pos hym] + · rw [ite_eq_left hym] have hrlt : (c : HahnSeries G R).cantorBendixsonRank y < ρ.val := by by_contra hge exact hyd (((c : HahnSeries G R).mem_support_derivative_iff y ρ.val).mpr ⟨(mem_closedSupport _ _).mp hym, not_lt.mp hge⟩) rw [WithBot.coe_lt_coe, ← NatOrdinal.of_val ρ] exact NatOrdinal.of.lt_iff_lt.mpr hrlt - · rw [if_neg hym] + · rw [ite_eq_right hym] exact WithBot.bot_lt_coe ρ end HahnSeries.Nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolationOnSets.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolationOnSets.lean index 0b205c0418..545fb9e7bf 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolationOnSets.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolationOnSets.lean @@ -133,9 +133,9 @@ theorem exists_prescribed_components_on_set (β : NatOrdinal.{u}) (S : Set G) rw [cantorBendixsonLayerDeriv_componentMk, Filter.Germ.coe_eq] filter_upwards [eventually_degree_translatedTruncLE_le b β hb, hnear] with γ hbγ hnearγ by_cases hs : γ ∈ S - · rw [dif_pos hs, cantorBendixsonDerivAt_eq β b γ hbγ] + · rw [dite_eq_left hs, cantorBendixsonDerivAt_eq β b γ hbγ] exact (hpoint ⟨γ, hs⟩).choose_spec - · rw [dif_neg hs] + · rw [dite_eq_right hs] by_contra hne have hbexact := (cantorBendixsonDerivAt_ne_zero_iff β b γ hbγ).mp hne have hbB : (b : HahnSeries G R) = B := rfl diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Truncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Truncation.lean index 1182ca82f5..7befb115cf 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Truncation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Truncation.lean @@ -167,9 +167,9 @@ theorem cantorBendixsonValue_translated_truncLE (b : HahnSeries G R) (c : G) : simpa only [neg_add_cancel] using ((truncLE c b).mem_closedSupport_translate (-c) c).trans (b.mem_closedSupport_truncLE c) by_cases hc : c ∈ b.closedSupport - · rw [if_pos hc, cantorBendixsonValue_of_mem _ ((mem_closedSupport _ _).mp (hm.mpr hc)), + · rw [ite_eq_left hc, cantorBendixsonValue_of_mem _ ((mem_closedSupport _ _).mp (hm.mpr hc)), cantorBendixsonRank_translated_truncLE] - · rw [if_neg hc] + · rw [ite_eq_right hc] apply cantorBendixsonValue_of_notMem intro hh exact hc (hm.mp ((mem_closedSupport _ _).mpr hh)) @@ -186,10 +186,10 @@ theorem eventually_value_translated_truncLE_lt (b : HahnSeries G R) with c hc hne rw [b.cantorBendixsonValue_translated_truncLE, b.cantorBendixsonValue_of_mem hb0] by_cases hmem : c ∈ b.closedSupport - · rw [if_pos hmem] + · rw [ite_eq_left hmem] apply (Ordinal.opow_lt_opow_iff_right Ordinal.one_lt_omega0).mpr simpa only [cantorBendixsonRank_eq] using hc hmem hne - · rw [if_neg hmem] + · rw [ite_eq_right hmem] exact Ordinal.opow_pos _ Ordinal.omega0_pos variable [Nontrivial G] @@ -256,15 +256,15 @@ theorem cantorBendixsonValue_reconstruction (b d : HahnSeries G R) (hb : b.suppo have hylt : y < 0 := lt_of_le_of_ne hy0 hyne have hval : (translate (-y) (truncLE y b)).cantorBendixsonValue = Ordinal.omega0 ^ a := by - rw [b.cantorBendixsonValue_translated_truncLE, if_pos ((b.mem_closedSupport y).mpr hys), + rw [b.cantorBendixsonValue_translated_truncLE, ite_eq_left ((b.mem_closedSupport y).mpr hys), hyr] have h := hlevel y hy hylt hval rw [d.cantorBendixsonValue_translated_truncLE] at h by_cases hym : y ∈ d.closedSupport - · rw [if_pos hym] at h + · rw [ite_eq_left hym] at h exact ⟨(d.mem_closedSupport y).mp hym, (Ordinal.opow_le_opow_iff_right Ordinal.one_lt_omega0).mp h⟩ - · rw [if_neg hym] at h + · rw [ite_eq_right hym] at h exact ((Ordinal.opow_pos _ Ordinal.omega0_pos).not_ge h).elim) rw [d.cantorBendixsonValue_of_mem hd0] exact Ordinal.opow_le_opow_right Ordinal.omega0_pos hdr diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationExpansion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationExpansion.lean index 5589dc25b5..101dfc6152 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationExpansion.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationExpansion.lean @@ -102,7 +102,7 @@ theorem IsRemainder.mul_X {d : ι →₀ ℕ} {E : MvPolynomial ι K} intro d' hd' obtain ⟨d₁, hd₁, d₂, hd₂, hw⟩ := exists_add_eq_weight_of_mem_support_mul (wt := wt) hd' obtain ⟨k, hk, hT⟩ := hE d₁ hd₁ - rw [X, support_monomial, if_neg one_ne_zero, Finset.mem_singleton] at hd₂ + rw [X, support_monomial, ite_eq_right one_ne_zero, Finset.mem_singleton] at hd₂ subst d₂ rw [Finsupp.weight_single, one_smul] at hw exact ⟨k, hk, hw ▸ TermDegree.untrunc i hT⟩ @@ -272,7 +272,7 @@ theorem exists_pol_translatedTruncLE_aeval_monomial σ.pol hx α (translatedTruncLE γ (σ.lift i)) = _ rw [translatedTruncLE_zero, hadef, σ.pol_aeval hx hinj (fun e he ↦ by - rw [support_monomial, if_neg one_ne_zero, Finset.mem_singleton] at he + rw [support_monomial, ite_eq_right one_ne_zero, Finset.mem_singleton] at he rwa [he])] have hfγ : f (γ, 0) = σ.pol hx α (translatedTruncLE γ a) * X i := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationPolynomial.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationPolynomial.lean index 3d38f91def..1094f8aaed 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationPolynomial.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationPolynomial.lean @@ -84,7 +84,7 @@ theorem pol_weight_le_degree {α : NatOrdinal.{u}} {u : Nonpositive G K} (((Finsupp.weight wt) d : NatOrdinal) : WithBot NatOrdinal) ≤ ν u := by classical unfold pol - rw [dif_pos hu] + rw [dite_eq_left hu] exact (Classical.choose_spec (σ.exists_polynomial hx u hu)).1 include hx in @@ -94,7 +94,7 @@ theorem degree_sub_aeval_pol_eq_bot {α : NatOrdinal.{u}} {u : Nonpositive G K} ν (u - aeval σ.lift (σ.pol hx α u)) = ⊥ := by classical unfold pol - rw [dif_pos hu] + rw [dite_eq_left hu] exact (Classical.choose_spec (σ.exists_polynomial hx u hu)).2.2 include hx in @@ -230,7 +230,7 @@ theorem weightedTotalDegree_xCoeff_add_nsmul_lt obtain ⟨d, hd, hsup⟩ := Finset.exists_mem_eq_sup _ (support_nonempty.mpr h) (Finsupp.weight wt) have hmem : d + Finsupp.single B₀ k ∈ (xCoeff B₀ k Q * X B₀ ^ k).support := by - rw [mem_support_iff, X_pow_eq_monomial, coeff_mul_monomial', if_pos le_add_self, + rw [mem_support_iff, X_pow_eq_monomial, coeff_mul_monomial', ite_eq_left le_add_self, add_tsub_cancel_right, mul_one] exact mem_support_iff.mp hd have hlt := hQ _ (support_xCoeff_mul_X_pow_subset B₀ k Q hmem) @@ -252,7 +252,7 @@ theorem pol_eq_zero_of_degree_eq_bot {α : NatOrdinal.{u}} {u : Nonpositive G K} (hu : ν u = ⊥) : σ.pol hx α u = 0 := by classical unfold pol - rw [dif_pos (by rw [hu]; exact WithBot.bot_lt_coe α)] + rw [dite_eq_left (by rw [hu]; exact WithBot.bot_lt_coe α)] have hspec := Classical.choose_spec (σ.exists_polynomial hx u (by rw [hu]; exact WithBot.bot_lt_coe α)) apply MvPolynomial.eq_zero_iff.mpr @@ -445,7 +445,7 @@ theorem pol_translatedTruncLE_mul_boundary {α m n : NatOrdinal.{u}} by_cases h0a : 0 ∈ (a : HahnSeries G K).closedSupport · have hγb : γ ∉ (b : HahnSeries G K).closedSupport := fun h ↦ hnot ⟨h0a, h⟩ have hbot : ν (translatedTruncLE γ b) = ⊥ := by - rw [degree_translatedTruncLE_eq, if_neg hγb] + rw [degree_translatedTruncLE_eq, ite_eq_right hγb] rw [σ.pol_eq_zero_of_degree_eq_bot hx hbot, mul_zero] · have hbot : ν a = ⊥ := by rw [cantorBendixsonDegreeValuation_apply, cantorBendixsonValuation_apply, @@ -469,7 +469,7 @@ theorem pol_translatedTruncLE_mul_boundary {α m n : NatOrdinal.{u}} NatOrdinal.cantorDegree_zero] rw [translatedTruncLE_zero, σ.pol_eq_zero_of_degree_eq_bot hx hbot, mul_zero] · have hbot : ν (translatedTruncLE γ a) = ⊥ := by - rw [degree_translatedTruncLE_eq, if_neg hγa] + rw [degree_translatedTruncLE_eq, ite_eq_right hγa] rw [σ.pol_eq_zero_of_degree_eq_bot hx hbot, zero_mul] · exact absurd hq hqnot @@ -497,7 +497,7 @@ theorem pol_lift_pow {α : NatOrdinal.{u}} rw [hpow] apply σ.pol_aeval hx hinj intro d hd - rw [X_pow_eq_monomial, support_monomial, if_neg one_ne_zero, + rw [X_pow_eq_monomial, support_monomial, ite_eq_right one_ne_zero, Finset.mem_singleton] at hd rw [hd, Finsupp.weight_single] exact he @@ -915,8 +915,8 @@ theorem xCoeff_pol_translatedTruncLE_lift_pow_mul | zero => rw [pow_zero, one_mul] exact ⟨fun k hk ↦ by - rw [xCoeff_of_mem_supported B₀ (hu.trunc_mem hγ) k, if_neg (Nat.ne_of_gt hk)], - by rw [xCoeff_of_mem_supported B₀ (hu.trunc_mem hγ) 0, if_pos rfl]⟩ + rw [xCoeff_of_mem_supported B₀ (hu.trunc_mem hγ) k, ite_eq_right (Nat.ne_of_gt hk)], + by rw [xCoeff_of_mem_supported B₀ (hu.trunc_mem hγ) 0, ite_eq_left rfl]⟩ | succ e ih => have hg0 : wt B₀ ≠ 0 := hx.ne_zero B₀ have hstep : e • wt B₀ + m < (e + 1) • wt B₀ + m := by @@ -1009,7 +1009,7 @@ theorem xCoeff_pol_translatedTruncLE_lift_pow_mul X B₀ ^ e by ring, xCoeff_mul_X_pow B₀ (Subalgebra.mul_mem _ (σ.pol_translatedTruncLE_lift_mem_supported hx hσ hB₀ le_rfl hγ) - hu.pol_mem) (k' + 1) e, if_neg (by omega), add_zero, add_zero] + hu.pol_mem) (k' + 1) e, ite_eq_right (by omega), add_zero, add_zero] · rw [map_add, map_add, map_sum, Finset.sum_eq_zero fun q hq ↦ hfhigh q hq (e + 1) (Nat.lt_succ_self e), xCoeff_succ_X_mul, ih'.2, ← mul_assoc, @@ -1019,7 +1019,7 @@ theorem xCoeff_pol_translatedTruncLE_lift_pow_mul X B₀ ^ e by ring, xCoeff_mul_X_pow B₀ (Subalgebra.mul_mem _ (σ.pol_translatedTruncLE_lift_mem_supported hx hσ hB₀ le_rfl hγ) - hu.pol_mem) (e + 1) e, if_neg (Nat.succ_ne_self e), add_zero, add_zero] + hu.pol_mem) (e + 1) e, ite_eq_right (Nat.succ_ne_self e), add_zero, add_zero] /-- A proper truncation of the evaluation of a top-degree homogeneous polynomial which omits `B₀` and uses no heavier variable still has a representing polynomial which omits `B₀`. -/ @@ -1129,7 +1129,7 @@ theorem xCoeff_pol_translatedTruncLE_lift_pow | zero => rw [zero_add, pow_one, xCoeff_of_mem_supported B₀ (σ.pol_translatedTruncLE_lift_mem_supported hx hσ hB₀ le_rfl hγ) 0, - if_pos rfl, one_smul] + ite_eq_left rfl, one_smul] | succ e ih => have hg0 : wt B₀ ≠ 0 := hx.ne_zero B₀ have hstep : (e + 1) • wt B₀ < (e + 1 + 1) • wt B₀ := by @@ -1218,7 +1218,7 @@ theorem xCoeff_pol_translatedTruncLE_lift_pow Finset.sum_eq_zero hfzero, add_zero, xCoeff_succ_X_mul, ih he'.le hγ, xCoeff_mul_X_pow B₀ (σ.pol_translatedTruncLE_lift_mem_supported hx hσ hB₀ le_rfl hγ) - (e + 1) (e + 1), if_pos rfl] + (e + 1) (e + 1), ite_eq_left rfl] exact (succ_nsmul _ (e + 1)).symm end FreeOfVariable diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ClassTruncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ClassTruncation.lean index 05c70f2013..9fe91eb47d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ClassTruncation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ClassTruncation.lean @@ -98,10 +98,10 @@ private theorem filter_mul (p : G → Prop) [DecidablePred p] ext g rw [HahnSeries.coeff_filter, HahnSeries.coeff_mul, HahnSeries.coeff_mul] by_cases hg : p g - · rw [if_pos hg] + · rw [ite_eq_left hg] apply Finset.sum_congr · ext ij - simp only [Finset.mem_addAntidiagonal, HahnSeries.support_filter] + simp only [Finset.mem_antidiagonal, HahnSeries.support_filter] constructor · rintro ⟨hi, hj, hij⟩ have hp := (hpadd (support_subset x hi) (support_subset y hj)).mp (hij ▸ hg) @@ -110,12 +110,12 @@ private theorem filter_mul (p : G → Prop) [DecidablePred p] exact ⟨hi, hj, hij⟩ · intro ij hij rw [HahnSeries.coeff_filter, HahnSeries.coeff_filter] - rw [Finset.mem_addAntidiagonal] at hij + rw [Finset.mem_antidiagonal] at hij rw [HahnSeries.support_filter, HahnSeries.support_filter] at hij simp [hij.1.2, hij.2.1.2] - · rw [if_neg hg] + · rw [ite_eq_right hg] apply (Finset.sum_eq_zero fun ij hij ↦ ?_).symm - rw [Finset.mem_addAntidiagonal] at hij + rw [Finset.mem_antidiagonal] at hij rw [HahnSeries.support_filter] at hij rw [HahnSeries.support_filter] at hij have hpij := (hpadd (support_subset x hij.1.1) (support_subset y hij.2.1.1)).mpr @@ -168,14 +168,14 @@ theorem coeff_T_of_mem (c : FiniteArchimedeanClass G) (x : Nonpositive G R) {g : ((T (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff g = (x : R⟦G⟧).coeff g := by classical change (HahnSeries.filter (fun g ↦ g ∈ closedBall K c) (x : R⟦G⟧)).coeff g = _ - rw [HahnSeries.coeff_filter, if_pos hg] + rw [HahnSeries.coeff_filter, ite_eq_left hg] theorem coeff_T_of_not_mem (c : FiniteArchimedeanClass G) (x : Nonpositive G R) {g : G} (hg : g ∉ closedBall K c) : ((T (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff g = 0 := by classical change (HahnSeries.filter (fun g ↦ g ∈ closedBall K c) (x : R⟦G⟧)).coeff g = 0 - rw [HahnSeries.coeff_filter, if_neg hg] + rw [HahnSeries.coeff_filter, ite_eq_right hg] /-- Closed-class truncation cannot introduce a new support exponent. -/ theorem support_T_subset (c : FiniteArchimedeanClass G) (x : Nonpositive G R) : @@ -189,14 +189,14 @@ theorem coeff_tau_of_mem (c : FiniteArchimedeanClass G) (x : Nonpositive G R) {g ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff g = (x : R⟦G⟧).coeff g := by classical change (HahnSeries.filter (fun g ↦ g ∈ ball K c) (x : R⟦G⟧)).coeff g = _ - rw [HahnSeries.coeff_filter, if_pos hg] + rw [HahnSeries.coeff_filter, ite_eq_left hg] theorem coeff_tau_of_not_mem (c : FiniteArchimedeanClass G) (x : Nonpositive G R) {g : G} (hg : g ∉ ball K c) : ((tau (K := K) c x : Nonpositive G R) : R⟦G⟧).coeff g = 0 := by classical change (HahnSeries.filter (fun g ↦ g ∈ ball K c) (x : R⟦G⟧)).coeff g = 0 - rw [HahnSeries.coeff_filter, if_neg hg] + rw [HahnSeries.coeff_filter, ite_eq_right hg] /-- Closed truncation at the class of the lowest nonzero exponent retains the whole series. -/ theorem T_leadingClass (x : Nonpositive G R) (horder : (x : R⟦G⟧).order ≠ 0) : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassReduction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassReduction.lean index bfef13ed2c..8d91792e73 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassReduction.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassReduction.lean @@ -130,7 +130,7 @@ theorem isReduced_of_T_eq_self_of_tau_eq_one (c : FiniteArchimedeanClass G) have hcoeff := congrArg (fun y : Nonpositive G R ↦ (y : R⟦G⟧).coeff g) htau rw [coeff_tau_of_mem (K := K) c x hball] at hcoeff change (x : R⟦G⟧).coeff g = (1 : R⟦G⟧).coeff g at hcoeff - rw [HahnSeries.coeff_one, if_neg hg0] at hcoeff + rw [HahnSeries.coeff_one, ite_eq_right hg0] at hcoeff exact (HahnSeries.mem_support _ _).mp hg hcoeff have hle := (FiniteArchimedeanClass.mem_closedBall_iff K).mp hgClosed hg0 have hnlt : ¬ c < FiniteArchimedeanClass.mk g hg0 := fun hlt ↦ @@ -153,7 +153,7 @@ theorem IsReduced.supportArchimedeanClasses_finite {x : Nonpositive G R} (hx : I refine ⟨hg, ?_⟩ rw [HahnSeries.mem_support] change ((x : R⟦G⟧) - 1).coeff g ≠ 0 - rw [HahnSeries.coeff_sub, HahnSeries.coeff_one, if_neg hg0, sub_zero] + rw [HahnSeries.coeff_sub, HahnSeries.coeff_one, ite_eq_right hg0, sub_zero] exact (HahnSeries.mem_support _ _).mp hg end Ring diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/IntegerPartSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/IntegerPartSplitting.lean index 368b2dfa7f..8d33031da2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/IntegerPartSplitting.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/IntegerPartSplitting.lean @@ -228,7 +228,7 @@ def unsplitIntegerPart · rw [coeff_T_of_mem c z hg] · rw [coeff_T_of_not_mem c z hg] symm - apply HahnSeries.embDomain_notin_range + apply HahnSeries.embDomain_of_notMem_range exact fun ⟨h, hh⟩ ↦ hg (by rw [closedBallOrderEmbedding_apply] at hh exact hh ▸ h.2) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/LimitTailPrimality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/LimitTailPrimality.lean index c91965d920..ab75a727fb 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/LimitTailPrimality.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/LimitTailPrimality.lean @@ -163,7 +163,7 @@ theorem isPrimal_of_finite_classes_and_limit_tail_conditions obtain ⟨z, ⟨r, hr, hqr⟩, hzq⟩ := hqocc' intro hzero have hcoeff := congrArg (fun y : HahnSeries G R ↦ y.coeff r) hzero - rw [HahnSeries.coeff_filter, if_pos] at hcoeff + rw [HahnSeries.coeff_filter, ite_eq_left] at hcoeff · exact (HahnSeries.mem_support _ _).mp hr hcoeff · change P.mkQ r ∈ FiniteArchimedeanClass.closedBallAddSubgroup q apply FiniteArchimedeanClass.mem_closedBallAddSubgroup_iff.mpr diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ReducedCharacterization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ReducedCharacterization.lean index b22af6dda5..a14108aa7f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ReducedCharacterization.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/ReducedCharacterization.lean @@ -33,7 +33,7 @@ variable [Field R] private theorem coeff_sub_one_of_ne_zero (x : Nonpositive G R) {g : G} (hg : g ≠ 0) : ((x - 1 : Nonpositive G R) : R⟦G⟧).coeff g = (x : R⟦G⟧).coeff g := by change ((x : R⟦G⟧) - 1).coeff g = _ - rw [HahnSeries.coeff_sub, HahnSeries.coeff_one, if_neg hg, sub_zero] + rw [HahnSeries.coeff_sub, HahnSeries.coeff_one, ite_eq_right hg, sub_zero] private theorem leadingClass_le_mk_of_mem_support (x : Nonpositive G R) (horder : (x : R⟦G⟧).order ≠ 0) {g : G} (hg : g ∈ (x : R⟦G⟧).support) @@ -88,7 +88,7 @@ private theorem tau_eq_C_constantCoeff_of_support_nonzero_class · rw [coe_C] change ((tau (K := K) (leadingClass x horder) x : Nonpositive G R) : R⟦G⟧).coeff g = (HahnSeries.single 0 ((x : R⟦G⟧).coeff 0)).coeff g - rw [HahnSeries.coeff_single, if_neg hg0] + rw [HahnSeries.coeff_single, ite_eq_right hg0] by_cases hg : g ∈ (x : R⟦G⟧).support · rw [coeff_tau_of_not_mem] intro hball @@ -136,7 +136,7 @@ theorem isReduced_iff_tau_leadingClass_eq_zero_or_one 0 ∈ ((x - 1 : Nonpositive G R) : R⟦G⟧).support := by rw [HahnSeries.mem_support] change (((x : R⟦G⟧) - 1).coeff 0) ≠ 0 - rw [HahnSeries.coeff_sub, HahnSeries.coeff_one, if_pos rfl] + rw [HahnSeries.coeff_sub, HahnSeries.coeff_one, ite_eq_left rfl] exact sub_ne_zero.mpr hnot.2 have htop : (⊤ : ArchimedeanClass G) = d := hd ⟨hzeroSupport, hzeroSubSupport⟩ exact (FiniteArchimedeanClass.mk (x : R⟦G⟧).order horder).prop @@ -182,7 +182,7 @@ theorem isReduced_iff_tau_leadingClass_eq_zero_or_one (fun y : Nonpositive G R ↦ (y : R⟦G⟧).coeff g) htau rw [coeff_tau_of_mem _ _ hball] at hcoeff change (x : R⟦G⟧).coeff g = (1 : R⟦G⟧).coeff g at hcoeff - simp only [HahnSeries.coeff_one, if_neg hg0] at hcoeff + simp only [HahnSeries.coeff_one, ite_eq_right hg0] at hcoeff exact ((HahnSeries.mem_support _ _).mp hgSupport) hcoeff have heq : leadingClass x horder = FiniteArchimedeanClass.mk g hg0 := le_antisymm hle (not_lt.mp hnlt) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Reduction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Reduction.lean index 6031ebceda..ac059e954d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Reduction.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Reduction.lean @@ -346,7 +346,7 @@ theorem coeff_zero_reductionQuotient (u : HahnEmbedding.ArchimedeanStrata K G) change ((HahnSeries.archimedeanSplitRingEquiv u c (TClosed c x) / HahnSeries.C (tauBall c x)).coeff 0).coeff 0 = 1 rw [coeff_zero_archimedeanSplitRingEquiv_TClosed_div_C u c x htau] - rw [HahnSeries.coeff_one, if_pos rfl] + rw [HahnSeries.coeff_one, ite_eq_left rfl] /-- LM24's `ρ_σ`: divide the closed-class truncation by the open-class truncation when the latter is nonzero, and otherwise retain the closed-class truncation. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CardinalTruncationClosedClass.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CardinalTruncationClosedClass.lean index a6fab39ae8..4a70f2fd21 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CardinalTruncationClosedClass.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CardinalTruncationClosedClass.lean @@ -160,7 +160,7 @@ def closedClassRestrict (S : Subring L) (q : FiniteArchimedeanClass G) hxNcard)⟩, by rw [mem_cardSuppLTTruncationIntegerPart] refine ⟨xr.2, ?_⟩ - rw [Nonpositive.closedClassRestrict_coeff, if_pos] + rw [Nonpositive.closedClassRestrict_coeff, ite_eq_left] · simpa only [xN, coe_toNonpositiveRingHom] using hxmem.2 · exact (FiniteArchimedeanClass.closedBallAddSubgroup q).zero_mem⟩ @@ -335,7 +335,7 @@ theorem exists_refinement_closedClassRestrict_of_ambient ((closedClassRestrict S q a : cardSuppLTTruncationIntegerPart (G := G) (R := L) (κ := κ) S) : L⟦G⟧).coeff 0 = (a : L⟦G⟧).coeff 0 := by - rw [coe_closedClassRestrict, Nonpositive.closedClassRestrict_coeff, if_pos] + rw [coe_closedClassRestrict, Nonpositive.closedClassRestrict_coeff, ite_eq_left] · exact congrArg (fun z : L⟦G⟧ ↦ z.coeff 0) (coe_toNonpositiveRingHom S a) · exact (FiniteArchimedeanClass.closedBallAddSubgroup q).zero_mem convert haS using 1 diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/ClosedClassRefinementTransport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/ClosedClassRefinementTransport.lean index a91f4dfe1b..9d21d7aaf5 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/ClosedClassRefinementTransport.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/ClosedClassRefinementTransport.lean @@ -91,7 +91,7 @@ theorem convexQuotientSplit_filter_eq_closed_class_restrict rw [CardSuppLTTruncationIntegerPart.coe_closedClassRestrict, Nonpositive.closedClassRestrict_coeff] by_cases hzD : z ∈ D - · rw [if_pos hzD] + · rw [ite_eq_left hzD] change ((convexQuotientSplitRingEquiv P (t : R⟦G⟧)).coeff z).coeff p = _ have hxcoeff := congrArg (fun y : (R⟦P⟧)⟦G ⧸ P⟧ ↦ (y.coeff z).coeff p) @@ -100,10 +100,10 @@ theorem convexQuotientSplit_filter_eq_closed_class_restrict rw [CardSuppLTTruncationIntegerPart.coe_toNonpositiveRingHom] rw [coe_cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv] rw [hxcoeff] - simpa only [D, if_pos hzD] using hz - · rw [if_neg hzD] + simpa only [D, ite_eq_left hzD] using hz + · rw [ite_eq_right hzD] change ((convexQuotientSplitRingEquiv P (t : R⟦G⟧)).coeff z).coeff p = 0 - simpa only [D, if_neg hzD, HahnSeries.coeff_zero] using hz + simpa only [D, ite_eq_right hzD, HahnSeries.coeff_zero] using hz private theorem ambient_factorization_of_closed_class_factorization (P : Submodule K G) [P.toAddSubgroup.IsConvex] (Z : Subring R) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/ConvexRestrictionFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/ConvexRestrictionFactorization.lean index 6102778947..34fb70cee0 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/ConvexRestrictionFactorization.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/ConvexRestrictionFactorization.lean @@ -158,7 +158,7 @@ private theorem exists_complementary_factor {C : AddSubgroup G} simpa only [HahnSeries.support_one, Set.mem_singleton_iff] using h exact hg0 ▸ Set.mem_Iic.mpr le_rfl · exact Set.mem_Iic.mpr (hprod g h).1 - · rw [HahnSeries.coeff_add, HahnSeries.coeff_one, if_pos rfl, hzero, add_zero] + · rw [HahnSeries.coeff_add, HahnSeries.coeff_one, ite_eq_left rfl, hzero, add_zero] · intro g hg hg0 rcases HahnSeries.support_add_subset _ _ hg with h | h · exact absurd (by @@ -204,7 +204,7 @@ def restrictToAddSubgroup (Z : Subring K) (C : AddSubgroup G) rw [HahnSeries.mem_cardSuppLTTruncationIntegerPart] refine ⟨(HahnSeries.support_filter_subset _ _).trans hxmem.1, ?_⟩ change (HahnSeries.filter (· ∈ C) (x : K⟦G⟧)).coeff 0 ∈ Z - rw [HahnSeries.coeff_filter, if_pos C.zero_mem] + rw [HahnSeries.coeff_filter, ite_eq_left C.zero_mem] exact hxmem.2⟩ open Classical in @@ -313,7 +313,7 @@ theorem exists_factorization_by_restriction (HahnSeries.mem_cardSuppLTSubfield (Γ := G) (R := K) (κ := κ)).mpr ((HahnSeries.cardSupp_mono (HahnSeries.support_filter_subset _ _)).trans_lt b.1.2)⟩ have ht0 : (tf : K⟦G⟧).coeff 0 = (b : K⟦G⟧).coeff 0 := by - rw [HahnSeries.coeff_filter, if_pos C.zero_mem] + rw [HahnSeries.coeff_filter, ite_eq_left C.zero_mem] let t : HahnSeries.cardSuppLTTruncationIntegerPart (G := G) (R := K) (κ := κ) Z := ⟨tf, by rw [HahnSeries.mem_cardSuppLTTruncationIntegerPart] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/FiniteGermError.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/FiniteGermError.lean index 39159ee370..34300d154e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/FiniteGermError.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/FiniteGermError.lean @@ -100,7 +100,7 @@ theorem closedClassRestrict_ne_zero_of_mem_image_mk_support obtain ⟨g, hg, hgc⟩ := hc intro hzero have hcoeff := congrArg (fun x : Nonpositive G R ↦ (x : HahnSeries G R).coeff g) hzero - rw [closedClassRestrict_coeff, if_pos] at hcoeff + rw [closedClassRestrict_coeff, ite_eq_left] at hcoeff · exact (HahnSeries.mem_support _ _).mp hg hcoeff · apply (FiniteArchimedeanClass.mem_closedBallAddSubgroup_iff).mpr intro hg0 @@ -163,21 +163,21 @@ theorem closedClassRestrict_mul (c : FiniteArchimedeanClass G) (a b : Nonpositiv · exact hy hy0 exact (le_min hx' hy').trans (ArchimedeanClass.min_le_mk_of_le_of_le hz.1 hz.2) - have hsub : Finset.addAntidiagonal + have hsub : Finset.antidiagonal (HahnSeries.filter (· ∈ C) (a : HahnSeries G R)).isPWO_support (HahnSeries.filter (· ∈ C) (b : HahnSeries G R)).isPWO_support g ⊆ - Finset.addAntidiagonal (a : HahnSeries G R).isPWO_support + Finset.antidiagonal (a : HahnSeries G R).isPWO_support (b : HahnSeries G R).isPWO_support g := by intro p hp - rw [Finset.mem_addAntidiagonal] at hp ⊢ + rw [Finset.mem_antidiagonal] at hp ⊢ exact ⟨HahnSeries.support_filter_subset _ _ hp.1, HahnSeries.support_filter_subset _ _ hp.2.1, hp.2.2⟩ by_cases hg : g ∈ C - · rw [if_pos hg] + · rw [ite_eq_left hg] refine Finset.sum_congr ?_ ?_ · apply Finset.Subset.antisymm _ hsub intro p hp - rw [Finset.mem_addAntidiagonal] at hp ⊢ + rw [Finset.mem_antidiagonal] at hp ⊢ have hp1le : p.1 ≤ 0 := a.property hp.1 have hp2le : p.2 ≤ 0 := b.property hp.2.1 have hgp1 : g ≤ p.1 := by @@ -190,12 +190,12 @@ theorem closedClassRestrict_mul (c : FiniteArchimedeanClass G) (a b : Nonpositiv by simpa only [HahnSeries.support_filter, Set.mem_setOf_eq] using And.intro hp.2.1 hp2C, hp.2.2⟩ · intro p hp - rw [Finset.mem_addAntidiagonal, HahnSeries.support_filter, + rw [Finset.mem_antidiagonal, HahnSeries.support_filter, HahnSeries.support_filter] at hp - simp only [HahnSeries.coeff_filter, if_pos hp.1.2, if_pos hp.2.1.2] - · rw [if_neg hg] + simp only [HahnSeries.coeff_filter, ite_eq_left hp.1.2, ite_eq_left hp.2.1.2] + · rw [ite_eq_right hg] refine (Finset.sum_eq_zero fun p hp ↦ ?_).symm - rw [Finset.mem_addAntidiagonal, HahnSeries.support_filter, + rw [Finset.mem_antidiagonal, HahnSeries.support_filter, HahnSeries.support_filter] at hp exact (hg (hp.2.2 ▸ C.add_mem hp.1.2 hp.2.1.2)).elim diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/TruncationIntegerPartFractionField.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/TruncationIntegerPartFractionField.lean index e802dcf8d7..a80007bc70 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/TruncationIntegerPartFractionField.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/TruncationIntegerPartFractionField.lean @@ -119,7 +119,7 @@ private theorem constantCoeff_cofinalGermNonpositive : change (cofinalGermSeries (G := G) (K := K)).coeff 0 = 0 rw [cofinalGermSeries] change (if 0 ∈ Set.range (cofinalNegativeExponent (G := G)) then 1 else 0) = 0 - rw [if_neg] + rw [ite_eq_right] rintro ⟨i, hi⟩ exact (cofinalNegativeExponent_lt_zero i).ne hi diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ClassTruncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ClassTruncation.lean index 4e7fbf6cec..63d5946bcf 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ClassTruncation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ClassTruncation.lean @@ -5,6 +5,7 @@ Authors: Dan Abramov -/ module +public import Mathlib.Algebra.Order.Archimedean.Basic public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ClassTruncation /-! diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Iterate.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Iterate.lean index 4038db4366..807c0ccf5b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Iterate.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Iterate.lean @@ -54,9 +54,9 @@ private theorem ofIterate_mul (x y : R⟦Γ'⟧⟦Γ⟧) : (fun z _ ↦ (toLex (z.1.1, z.2.1), toLex (z.1.2, z.2.2))) · intro z hz rw [Finset.mem_sigma] at hz - rw [Finset.mem_addAntidiagonal] at hz - rw [Finset.mem_addAntidiagonal] at hz - rw [Finset.mem_addAntidiagonal] + rw [Finset.mem_antidiagonal] at hz + rw [Finset.mem_antidiagonal] at hz + rw [Finset.mem_antidiagonal] exact ⟨hz.2.1, hz.2.2.1, Prod.ext hz.1.2.2 hz.2.2.2⟩ · intro z₁ hz₁ z₂ hz₂ heq have hbase : z₁.1 = z₂.1 := @@ -67,9 +67,9 @@ private theorem ofIterate_mul (x y : R⟦Γ'⟧⟦Γ⟧) : (congrArg (fun z ↦ (ofLex z.2).2) heq) exact Sigma.ext hbase (heq_of_eq hfiber) · intro z hz - rw [Finset.mem_addAntidiagonal] at hz + rw [Finset.mem_antidiagonal] at hz refine ⟨⟨((ofLex z.1).1, (ofLex z.2).1), ((ofLex z.1).2, (ofLex z.2).2)⟩, ?_, ?_⟩ - · rw [Finset.mem_sigma, Finset.mem_addAntidiagonal, Finset.mem_addAntidiagonal] + · rw [Finset.mem_sigma, Finset.mem_antidiagonal, Finset.mem_antidiagonal] exact ⟨⟨ne_zero_of_coeff_ne_zero hz.1, ne_zero_of_coeff_ne_zero hz.2.1, congrArg Prod.fst hz.2.2⟩, hz.1, hz.2.1, congrArg Prod.snd hz.2.2⟩ · rfl diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/LimitTailQuotient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/LimitTailQuotient.lean index 7accd10c7b..2d4b0a0252 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/LimitTailQuotient.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/LimitTailQuotient.lean @@ -5,6 +5,7 @@ Authors: Dan Abramov -/ module +public import Mathlib.Algebra.Order.Archimedean.Basic public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ConvexQuotientSplitting public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedAddGroup public import Mathlib.Algebra.Algebra.Rat diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Nonpositive.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Nonpositive.lean index f3ff43a6eb..a1fb309c40 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Nonpositive.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Nonpositive.lean @@ -90,10 +90,10 @@ theorem coe_single (g : Γ) (r : R) (hg : g ≤ 0) : (rfl) private theorem eq_zero_of_mem_addAntidiagonal_zero {x y : Nonpositive Γ R} {ij : Γ × Γ} - (hij : ij ∈ Finset.addAntidiagonal (x : R⟦Γ⟧).isPWO_support + (hij : ij ∈ Finset.antidiagonal (x : R⟦Γ⟧).isPWO_support (y : R⟦Γ⟧).isPWO_support 0) : ij = (0, 0) := by - rcases Finset.mem_addAntidiagonal.mp hij with ⟨hi, hj, hij⟩ + rcases Finset.mem_antidiagonal.mp hij with ⟨hi, hj, hij⟩ have hi_zero := eq_zero_of_add_nonneg_left (support_subset x hi) (support_subset y hj) hij.ge have hj_zero := eq_zero_of_add_nonneg_right (support_subset x hi) (support_subset y hj) hij.ge exact Prod.ext hi_zero hj_zero @@ -120,7 +120,7 @@ theorem coeff_zero_mul (x y : Nonpositive Γ R) : · apply Finset.sum_eq_single (0, 0) · intro ij hij hne exact (hne (eq_zero_of_mem_addAntidiagonal_zero hij)).elim - · simp [Finset.mem_addAntidiagonal, HahnSeries.mem_support, hx, hy] + · simp [Finset.mem_antidiagonal, HahnSeries.mem_support, hx, hy] /-- Evaluation at exponent zero as a ring homomorphism on nonpositive Hahn series. -/ def constantCoeff : Nonpositive Γ R →+* R where diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/BaseChange.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/BaseChange.lean index ba68e08d33..a50195fdc2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/BaseChange.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/BaseChange.lean @@ -303,7 +303,7 @@ theorem principalComponentBaseChange_injective [Algebra K E] rw [map_sum] rw [Finset.sum_congr rfl fun i (_ : i ∈ c.support) ↦ nonpositiveLinearCoeffMap_C_mul bE i j (b i)] - rw [Finset.sum_ite_eq' c.support j b, if_pos hj] + rw [Finset.sum_ite_eq' c.support j b, ite_eq_left hj] · exact Finsupp.notMem_support_iff.mp hj have hc : c = 0 := Finsupp.ext hzero rw [hc, Finsupp.sum_zero_index] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivAt.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivAt.lean index a9ac2afc4a..a3582e0473 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivAt.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivAt.lean @@ -72,7 +72,7 @@ theorem derivAt_eq (alpha : NatOrdinal) derivAt alpha b gamma = principalComponentMk (alpha.removeNat 1) (translatedTruncation (b : K⟦ℝ⟧) gamma) h := by - simp only [derivAt, dif_pos h] + simp only [derivAt, dite_eq_left h] /-- A series in `J_{ω^(α+1)}` has translated truncations in `J_{ω^α} = J_{ω^(α⁻+1)}` near zero (truncation drop with `β = α`). -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LeadingCoefficient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LeadingCoefficient.lean index 1668bb4554..6c3ee0233e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LeadingCoefficient.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LeadingCoefficient.lean @@ -321,7 +321,7 @@ theorem pol_lift_pow (e : ℕ) (he : e • wt B₀ < α) : rw [map_pow, aeval_X] have hX : DegreeLT wt (X B₀ ^ e : MvPolynomial ι K) α := degreeLT_iff.mpr fun d hd ↦ by classical - rw [X_pow_eq_monomial, support_monomial, if_neg one_ne_zero, Finset.mem_singleton] at hd + rw [X_pow_eq_monomial, support_monomial, ite_eq_right one_ne_zero, Finset.mem_singleton] at hd rw [hd, Finsupp.weight_single] exact he rw [h1, σ.pol_aeval hx hinj hX] @@ -439,8 +439,8 @@ theorem exists_forall_xCoeff_pol_translatedTruncation_pow_mul (hg : wt B₀ < α refine ⟨ε, hε, fun γ hγε hγ0 ↦ ?_⟩ rw [pow_zero, one_mul] refine ⟨fun k hk ↦ ?_, ?_⟩ - · rw [xCoeff_of_mem_supported B₀ (h γ hγε hγ0), if_neg (Nat.pos_iff_ne_zero.mp hk)] - · rw [xCoeff_of_mem_supported B₀ (h γ hγε hγ0), if_pos rfl] + · rw [xCoeff_of_mem_supported B₀ (h γ hγε hγ0), ite_eq_right (Nat.pos_iff_ne_zero.mp hk)] + · rw [xCoeff_of_mem_supported B₀ (h γ hγε hγ0), ite_eq_left rfl] | succ e ih => -- degrees have hstep : e • wt B₀ + β < (e + 1) • wt B₀ + β := by @@ -532,14 +532,14 @@ theorem exists_forall_xCoeff_pol_translatedTruncation_pow_mul (hg : wt B₀ < α Finset.sum_eq_zero fun β hβ ↦ hfβ β hβ k (by omega)] obtain ⟨k', rfl⟩ : ∃ k', k = k' + 1 := ⟨k - 1, by omega⟩ rw [xCoeff_succ_X_mul, (h₁ γ hγ₁ hγ0).1 k' (by omega), ← mul_assoc, - xCoeff_mul_X_pow B₀ (Subalgebra.mul_mem _ (h₃ γ hγ₃ hγ0) hu.pol_mem), if_neg (by omega), + xCoeff_mul_X_pow B₀ (Subalgebra.mul_mem _ (h₃ γ hγ₃ hγ0) hu.pol_mem), ite_eq_right (by omega), add_zero, add_zero] · -- the coefficient of `X_{B₀}^(e+1)` rw [hconv, map_add, map_add, hf0, hfγ, map_sum, Finset.sum_eq_zero fun β hβ ↦ hfβ β hβ (e + 1) (Nat.lt_succ_self e), xCoeff_succ_X_mul, (h₁ γ hγ₁ hγ0).2, ← mul_assoc, xCoeff_mul_X_pow B₀ (Subalgebra.mul_mem _ (h₃ γ hγ₃ hγ0) hu.pol_mem), - if_neg (Nat.succ_ne_self e), add_zero, add_zero] + ite_eq_right (Nat.succ_ne_self e), add_zero, add_zero] /-- **The coefficient of `X_{B₀}^e` for the pure power `b_{B₀}^{e+1}`.** For `(e + 1) • wt B₀ ≤ α` and all `γ < 0` sufficiently close to `0`, the coefficient of `X_{B₀}^e` in the polynomial of @@ -555,7 +555,7 @@ theorem exists_forall_xCoeff_pol_translatedTruncation_pow (hg : wt B₀ < α) (e | zero => obtain ⟨ε, hε, h⟩ := σ.exists_forall_pol_translatedTruncation_lift_mem hx hinj B₀ hg refine ⟨ε, hε, fun γ hγε hγ0 ↦ ?_⟩ - rw [zero_add, pow_one, xCoeff_of_mem_supported B₀ (h γ hγε hγ0), if_pos rfl, one_smul] + rw [zero_add, pow_one, xCoeff_of_mem_supported B₀ (h γ hγε hγ0), ite_eq_left rfl, one_smul] | succ e ih => have hstep : (e + 1) • wt B₀ < (e + 1 + 1) • wt B₀ := by rw [succ_nsmul (wt B₀) (e + 1)] @@ -637,7 +637,7 @@ theorem exists_forall_xCoeff_pol_translatedTruncation_pow (hg : wt B₀ < α) (e simp only rw [xCoeff_mul_of_mem_supported B₀ (h₃ β (by linarith) hβneg), h0', hC, mul_zero] rw [hconv, map_add, map_add, hf0, hfγ, map_sum, Finset.sum_eq_zero hfβ, add_zero, - xCoeff_succ_X_mul, h₁ γ hγ₁ hγ0, xCoeff_mul_X_pow B₀ (h₃ γ hγ₃ hγ0), if_pos rfl] + xCoeff_succ_X_mul, h₁ γ hγ₁ hγ0, xCoeff_mul_X_pow B₀ (h₃ γ hγ₃ hγ0), ite_eq_left rfl] exact (succ_nsmul _ (e + 1)).symm end Lifts diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Lifts.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Lifts.lean index 78d92f5172..7d2fe2bc58 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Lifts.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Lifts.lean @@ -273,7 +273,7 @@ theorem weightedHomogeneousComponent_weightedTotalDegree_ne_zero {F : MvPolynomi (Finsupp.weight wt) intro h have := congrArg (coeff d) h - rw [coeff_weightedHomogeneousComponent, if_pos (by rw [weightedTotalDegree, hsup]), + rw [coeff_weightedHomogeneousComponent, ite_eq_left (by rw [weightedTotalDegree, hsup]), coeff_zero] at this exact mem_support_iff.mp hd this @@ -530,7 +530,7 @@ theorem toGerm_aeval_pol {α : NatOrdinal} {u : Series K} (hu : ordinalValue u < toGerm (aeval σ.lift (σ.pol hx α u)) = toGerm u := by classical unfold pol - rw [dif_pos hu] + rw [dite_eq_left hu] exact (Classical.choose_spec (σ.exists_degreeLT_toGerm_aeval_eq hx α u hu)).2 /-- When evaluation is injective below `α`, the polynomial of `u` modulo `J` is the unique diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean index ad825d2a46..097415550a 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean @@ -350,7 +350,7 @@ theorem degLT_eq_zero_of_mem_vars_H {i : ι} (hi : i ∈ S.H.vars) : S.degLT i = exact hid' rfl have hid : i ∈ d.support := by rw [Finsupp.mem_support_iff] at hid' ⊢ - rw [Finsupp.tsub_apply, Finsupp.single_apply, if_neg hi0.symm, Nat.sub_zero] at hid' + rw [Finsupp.tsub_apply, Finsupp.single_apply, ite_eq_right hi0.symm, Nat.sub_zero] at hid' exact hid' -- The parts below `β` add up to `α_{<β} = (deg B₀)_{<β}`; `B₀` contributes all of it. have hsum := S.sum_degLT_eq_αLT hd diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LowDegreeParts.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LowDegreeParts.lean index 4bc0f00638..e1daf63c2a 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LowDegreeParts.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LowDegreeParts.lean @@ -80,7 +80,7 @@ theorem exists_eq_add_single_add_single {d : ι →₀ ℕ} {i u : ι} (hi : i have hdi : 1 ≤ d i := Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hi) have hdu : 1 ≤ d u := Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hu) have h1 : Finsupp.single u 1 ≤ d - Finsupp.single i 1 := by - rw [Finsupp.single_le_iff, Finsupp.tsub_apply, Finsupp.single_apply, if_neg (Ne.symm hui)] + rw [Finsupp.single_le_iff, Finsupp.tsub_apply, Finsupp.single_apply, ite_eq_right (Ne.symm hui)] omega have h2 : Finsupp.single i 1 ≤ d := Finsupp.single_le_iff.mpr hdi rw [add_right_comm, tsub_add_cancel_of_le h1, tsub_add_cancel_of_le h2] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LoweringDerivation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LoweringDerivation.lean index 98140ed79a..e7fde81e86 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LoweringDerivation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LoweringDerivation.lean @@ -69,11 +69,11 @@ theorem principalComponentDerivation_of_pos {α : NatOrdinal} (hα : 0 < α.cons principalComponentDerivation K α a = Filter.Germ.mapLinear (DirectSum.lof K NatOrdinal (PrincipalComponent K) (α.removeNat 1)) (principalComponentDerivAt K α hα a) := by - rw [principalComponentDerivation, dif_pos hα, LinearMap.comp_apply] + rw [principalComponentDerivation, dite_eq_left hα, LinearMap.comp_apply] theorem principalComponentDerivation_of_eq_zero {α : NatOrdinal} (hα : α.constantCoeff = 0) (a : PrincipalComponent K α) : principalComponentDerivation K α a = 0 := by - rw [principalComponentDerivation, dif_neg (by omega), LinearMap.zero_apply] + rw [principalComponentDerivation, dite_eq_right (by omega), LinearMap.zero_apply] /-- For `α` a successor, `∂` of the class of `u` is the function at `0⁻` `γ ↦ ∂(u)(γ)`, the class of the translated truncation `u^{|γ}` in `P_{α⁻}` included into `P̂`. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/OmegaSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/OmegaSupport.lean index 3ecf647ac3..e1d3ed19c9 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/OmegaSupport.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/OmegaSupport.lean @@ -66,10 +66,10 @@ theorem wpow_le_supportOrderType_truncGT_truncLE {δ : NatOrdinal} (p : Series K have hgerm : toGerm (translatedTruncation (p : K⟦ℝ⟧) γ) = toGerm r := by rw [toGerm_eq_toGerm_iff_exists_coeff_eq] refine ⟨θ - γ, by linarith, fun η hη1 hη2 ↦ ?_⟩ - rw [coeff_translatedTruncation, if_pos hη2] + rw [coeff_translatedTruncation, ite_eq_left hη2] change _ = (translate (-γ) (truncGT θ (truncLE γ (p : K⟦ℝ⟧)))).coeff η rw [coeff_translate, sub_neg_eq_add, coeff_truncGT_of_lt (by linarith), - HahnSeries.coeff_truncLE, if_pos (by linarith), add_comm] + HahnSeries.coeff_truncLE, ite_eq_left (by linarith), add_comm] calc ω^ δ ≤ ordinalValue (translatedTruncation (p : K⟦ℝ⟧) γ) := hγ _ = ordinalValue r := ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (toGerm_eq_toGerm_iff.mp hgerm) @@ -280,11 +280,11 @@ theorem exists_strictMono_range_eq {Z : Set ℝ} (hZ : Z.IsPWO) let next : ℝ → ℝ := fun x ↦ if h : (Z ∩ Set.Ioi x).Nonempty then (hZ.isWF.mono Set.inter_subset_left).min h else x have hnext_mem : ∀ x, (Z ∩ Set.Ioi x).Nonempty → next x ∈ Z ∧ x < next x := fun x h ↦ by - simp only [next, dif_pos h] + simp only [next, dite_eq_left h] exact Set.IsWF.min_mem _ h have hnext_le : ∀ x, ∀ z ∈ Z, x < z → next x ≤ z := fun x z hz hxz ↦ by have h : (Z ∩ Set.Ioi x).Nonempty := ⟨z, hz, hxz⟩ - simp only [next, dif_pos h] + simp only [next, dite_eq_left h] exact Set.IsWF.min_le _ h ⟨hz, hxz⟩ -- every point of `Z` has a point of `Z` above it have hZne : ∀ x ∈ Z, (Z ∩ Set.Ioi x).Nonempty := fun x hx ↦ by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PartialDerivativeIndices.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PartialDerivativeIndices.lean index 9c23f912f3..7a3b58d675 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PartialDerivativeIndices.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PartialDerivativeIndices.lean @@ -75,7 +75,7 @@ theorem componentsGE_mem_span_subtype {ι : Type w} [Finite ι] {q : ι → MvPo have hcomp : weightedHomogeneousComponent wt (Finsupp.weight wt d) (weightedHomogeneousComponent wt (Finsupp.weight wt d) P) = weightedHomogeneousComponent wt (Finsupp.weight wt d) P := by - rw [weightedHomogeneousComponent_of_mem (weightedHomogeneousComponent_mem wt P _), if_pos rfl] + rw [weightedHomogeneousComponent_of_mem (weightedHomogeneousComponent_mem wt P _), ite_eq_left rfl] rw [← hcomp, hsum] rw [← Finset.sum_filter_add_sum_filter_not Finset.univ A] have hzero : ∑ j ∈ Finset.univ.filter (fun j ↦ ¬ A j), q j * u j = 0 := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Partials.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Partials.lean index 229e821adf..529748e306 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Partials.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Partials.lean @@ -397,13 +397,13 @@ theorem exists_finset_pderiv_eq_sum_of_lowDegreePartAlgebraicLE {v' : ι} (hv' : · intro i hi obtain ⟨v, -, rfl⟩ := Finset.mem_image.mp hi beta_reduce - rw [dif_pos (⟨v, rfl⟩ : + rw [dite_eq_left (⟨v, rfl⟩ : ∃ w : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, w.1.1 = v.1.1)] exact hUB₀ _ · rw [hΘeq, Finset.sum_image fun v _ w _ h ↦ hinjv h] refine Finset.sum_congr rfl fun v _ ↦ ?_ beta_reduce - rw [dif_pos (⟨v, rfl⟩ : + rw [dite_eq_left (⟨v, rfl⟩ : ∃ w : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, w.1.1 = v.1.1)] congr 2 exact (hinjv (Classical.choose_spec diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Pieces.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Pieces.lean index 67a793f234..fc5c2e8a3f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Pieces.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Pieces.lean @@ -112,9 +112,9 @@ theorem translatedTruncation_window_sub_mem (a b : ℝ) (E : K⟦ℝ⟧) {ξ : rw [not_le] at hlt apply hδ by_cases h0 : δ ≤ 0 - · rw [if_pos h0, if_pos h0, if_pos ⟨by linarith, by linarith⟩, show ξ + δ + b = b + ξ + δ by ring, + · rw [ite_eq_left h0, ite_eq_left h0, ite_eq_left ⟨by linarith, by linarith⟩, show ξ + δ + b = b + ξ + δ by ring, sub_self] - · rw [if_neg h0, if_neg h0, sub_zero] + · rw [ite_eq_right h0, ite_eq_right h0, sub_zero] /-! ### Sums along a sequence of cutoffs -/ @@ -173,11 +173,11 @@ theorem translatedTruncation_sumAlongCutoffsSeries_sub_mem (k : ℕ) {ξ : ℝ} rw [not_le] at hlt apply hδ by_cases h0 : δ ≤ 0 - · rw [if_pos h0, if_pos h0, + · rw [ite_eq_left h0, ite_eq_left h0, coeff_sumAlongCutoffs_of_mem w c γ hγ hdisj (k := k) ⟨by linarith, by linarith⟩, coeff_placedTerm, - if_pos (by linarith), show γ k + ξ + δ - γ k = ξ + δ by ring, sub_self] - · rw [if_neg h0, if_neg h0, sub_zero] + ite_eq_left (by linarith), show γ k + ξ + δ - γ k = ξ + δ by ring, sub_self] + · rw [ite_eq_right h0, ite_eq_right h0, sub_zero] /-- At cutoffs `ζ ≤ γ_0 + c_0`, below the first interval, the translated truncations of the sum (m) vanish. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Shift.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Shift.lean index 01f96db49f..f050f53687 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Shift.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Shift.lean @@ -43,11 +43,11 @@ def shift (ξ : ℝ) (u : Series K) : Series K := theorem coe_shift_of_le {ξ : ℝ} (hξ : ξ ≤ 0) (u : Series K) : ((shift ξ u : Series K) : K⟦ℝ⟧) = translate ξ (u : K⟦ℝ⟧) := by - rw [shift, dif_pos hξ, Subring.coe_mul, Nonpositive.coe_single, single_one_mul_eq_translate] + rw [shift, dite_eq_left hξ, Subring.coe_mul, Nonpositive.coe_single, single_one_mul_eq_translate] theorem shift_mul {ξ : ℝ} (hξ : ξ ≤ 0) (u v : Series K) : shift ξ u * v = shift ξ (u * v) := by - rw [shift, shift, dif_pos hξ, dif_pos hξ, mul_assoc] + rw [shift, shift, dite_eq_left hξ, dite_eq_left hξ, mul_assoc] /-- The translated truncation of a shift: `(t^ξ u)^{|ζ} = u^{|ζ - ξ}`. -/ theorem translatedTruncation_shift {ξ : ℝ} (hξ : ξ ≤ 0) (u : Series K) (ζ : ℝ) : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SumAlongCutoffs.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SumAlongCutoffs.lean index c9e2300579..f2de1886b7 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SumAlongCutoffs.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SumAlongCutoffs.lean @@ -279,7 +279,7 @@ theorem exists_sumAlongCutoffs (δ : NatOrdinal) (γ : ℕ → ℝ) (hγ : Stric · exact le_max_right _ _ have hdisj : ∀ k, γ k ≤ γ (k + 1) + c (k + 1) := by intro k - simp only [hcdef, if_neg (Nat.succ_ne_zero k), Nat.add_sub_cancel] + simp only [hcdef, ite_eq_right (Nat.succ_ne_zero k), Nat.add_sub_cancel] linarith [le_max_left (γ k - γ (k + 1)) (-ε (k + 1))] -- the sum along cutoffs set s' := sumAlongCutoffs w c γ hγ hdisj with hs'def @@ -314,10 +314,10 @@ theorem exists_sumAlongCutoffs (δ : NatOrdinal) (γ : ℕ → ℝ) (hγ : Stric have hgerm : toGerm (translatedTruncation (s : K⟦ℝ⟧) (γ k)) = toGerm (w k) := by rw [toGerm_eq_toGerm_iff_exists_coeff_eq] refine ⟨c k, hc k, fun η hη1 hη2 ↦ ?_⟩ - rw [coeff_translatedTruncation, if_pos hη2, hscoe, + rw [coeff_translatedTruncation, ite_eq_left hη2, hscoe, coeff_sumAlongCutoffs_of_mem w c γ hγ hdisj (k := k) ⟨by linarith, by linarith⟩, coeff_placedTerm, - add_sub_cancel_left, if_pos hη1] + add_sub_cancel_left, ite_eq_left hη1] have hval : ordinalValue (translatedTruncation (s : K⟦ℝ⟧) (γ k)) = ordinalValue (w k) := ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (toGerm_eq_toGerm_iff.mp hgerm) refine ⟨hval ▸ hw k, ?_⟩ @@ -342,7 +342,7 @@ theorem exists_sumAlongCutoffs (δ : NatOrdinal) (γ : ℕ → ℝ) (hγ : Stric have hgerm : toGerm (translatedTruncation (s : K⟦ℝ⟧) ξ) = toGerm 0 := by rw [toGerm_eq_toGerm_iff_exists_coeff_eq] refine ⟨γ (k - 1) - ξ, by linarith, fun η hη1 hη2 ↦ ?_⟩ - rw [coeff_translatedTruncation, if_pos hη2, hscoe, Subring.coe_zero, + rw [coeff_translatedTruncation, ite_eq_left hη2, hscoe, Subring.coe_zero, HahnSeries.coeff_zero] refine coeff_sumAlongCutoffs_eq_zero w c γ hγ hdisj fun j hj ↦ ?_ rcases lt_trichotomy j k with hjk | rfl | hjk @@ -365,10 +365,10 @@ theorem exists_sumAlongCutoffs (δ : NatOrdinal) (γ : ℕ → ℝ) (hγ : Stric toGerm (translatedTruncation ((w k : Series K) : K⟦ℝ⟧) (ξ - γ k)) := by rw [toGerm_eq_toGerm_iff_exists_coeff_eq] refine ⟨γ k + c k - ξ, by linarith, fun η hη1 hη2 ↦ ?_⟩ - rw [coeff_translatedTruncation, coeff_translatedTruncation, if_pos hη2, if_pos hη2, hscoe, + rw [coeff_translatedTruncation, coeff_translatedTruncation, ite_eq_left hη2, ite_eq_left hη2, hscoe, coeff_sumAlongCutoffs_of_mem w c γ hγ hdisj (k := k) ⟨by linarith, by linarith⟩, coeff_placedTerm, - if_pos (by linarith)] + ite_eq_left (by linarith)] congr 1 ring rw [ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (toGerm_eq_toGerm_iff.mp hgerm)] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SupportLoweringPieces.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SupportLoweringPieces.lean index 6217a40a0a..3d60023864 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SupportLoweringPieces.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SupportLoweringPieces.lean @@ -56,7 +56,7 @@ theorem lt_of_mem_support_piece {a b : ℝ} {E : K⟦ℝ⟧} {y : ℝ} rw [HahnSeries.mem_support, coeff_piece] at hy by_contra h rw [not_lt] at h - exact hy (if_neg fun h' ↦ absurd h'.1 (not_lt.mpr (by linarith))) + exact hy (ite_eq_right fun h' ↦ absurd h'.1 (not_lt.mpr (by linarith))) /-- The sequence `γ_k := -ε/(k+1)`: strictly increasing, negative, with supremum `0`. -/ theorem strictMono_neg_div_succ {ε : ℝ} (hε : 0 < ε) : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationExpansion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationExpansion.lean index ce4fa26441..a12117fb02 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationExpansion.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationExpansion.lean @@ -100,7 +100,7 @@ theorem IsRemainder.mul_X {d : ι →₀ ℕ} {E : MvPolynomial ι K} (hE : IsRe classical obtain ⟨d₁, hd₁, d₂, hd₂, hw⟩ := exists_add_eq_weight_of_mem_support_mul (wt := wt) hd' obtain ⟨k, hk, hT⟩ := hE d₁ hd₁ - rw [X, support_monomial, if_neg one_ne_zero, Finset.mem_singleton] at hd₂ + rw [X, support_monomial, ite_eq_right one_ne_zero, Finset.mem_singleton] at hd₂ subst hd₂ rw [Finsupp.weight_single, one_smul] at hw exact ⟨k, hk, hw ▸ TermDegree.untrunc i hT⟩ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationPolynomial.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationPolynomial.lean index 3370a360d1..b5189a306b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationPolynomial.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationPolynomial.lean @@ -71,7 +71,7 @@ theorem translatedTruncation_C_of_neg (k : K) {γ : ℝ} (hγ : γ < 0) : ext δ rw [coeff_translatedTruncation, Subring.coe_zero, HahnSeries.coeff_zero] split_ifs with hδ - · rw [HahnSeries.C_apply, HahnSeries.coeff_single, if_neg (by linarith)] + · rw [HahnSeries.C_apply, HahnSeries.coeff_single, ite_eq_right (by linarith)] · rfl /-! ### Degree at most `β` -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationsIdeal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationsIdeal.lean index dc4b714319..6fbd0ecd33 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationsIdeal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationsIdeal.lean @@ -138,11 +138,11 @@ theorem of_principalComponentMk_mem_span_of_forall_componentsGE_mem {ι' : Type* (f : FunAtZeroMinus (PrincipalSubring K)) := by rw [principalSubringDerivation_of, principalComponentDerivation_principalComponentMk hα1] exact (funAtZeroMinus_coe_eq_iff_exists _ _).mpr ⟨ε, hε, fun δ h1 h2 ↦ by - simp only [f, if_pos (And.intro h1 h2)]⟩ + simp only [f, ite_eq_left (And.intro h1 h2)]⟩ have hf : ∀ δ, f δ ∈ Ideal.span (Set.range fun j ↦ aeval x (q j)) := by intro δ by_cases h : -ε < δ ∧ δ < 0 - · simp only [f, if_pos h] + · simp only [f, ite_eq_left h] have hδ : ordinalValue (translatedTruncation (u : K⟦ℝ⟧) δ) < ω^ ((τ + 1).removeNat 1 + 1) := by rw [hrem]; exact hdrop δ h.1 h.2 @@ -153,7 +153,7 @@ theorem of_principalComponentMk_mem_span_of_forall_componentsGE_mem {ι' : Type* rw [hrep.of_principalComponentMk] exact aeval_mem_span_range_of_mem_span (weightedHomogeneousComponent_mem_span_of_componentsGE_mem wt hq (htrunc δ h.1 h.2) le_rfl) - · simp only [f, if_neg h] + · simp only [f, ite_eq_right h] exact Ideal.zero_mem _ exact mem_span_of_principalSubringDerivation_eq_coe hq' hc hα1 (of_mem_principalGrading _ _) hf hΔ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ComplexityDecrease.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ComplexityDecrease.lean index f209340a76..6cc8abb28c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ComplexityDecrease.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ComplexityDecrease.lean @@ -96,7 +96,7 @@ theorem count_reduced_of_ne {w : FormalExpression K} {hw : w ≠ 0} {t : FormalE Multiset.count y (reduced w hw t) = 2 * Multiset.count y w := by rw [reduced, unselected] simp only [Multiset.count_add, Multiset.count_replicate, Multiset.count_filter, - if_neg (Ne.symm hy), if_pos hy, Multiset.count_eq_zero.mpr hyt] + ite_eq_right (Ne.symm hy), ite_eq_left hy, Multiset.count_eq_zero.mpr hyt] omega /-- The selected factor survives the reduction exactly when its exponent exceeds one. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Convolution.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Convolution.lean index 37c79a2f0e..e2763945f6 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Convolution.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Convolution.lean @@ -54,22 +54,22 @@ private theorem mem_support_translatedTruncation {b : K⟦ℝ⟧} {β u : ℝ} : theorem coeff_translatedTruncation_mul (b c : K⟦ℝ⟧) (β ξ δ : ℝ) : ((translatedTruncation b β * translatedTruncation c ξ : Series K) : K⟦ℝ⟧).coeff δ = - ∑ pq ∈ (Finset.addAntidiagonal b.isPWO_support c.isPWO_support (β + ξ + δ)).filter + ∑ pq ∈ (Finset.antidiagonal b.isPWO_support c.isPWO_support (β + ξ + δ)).filter (fun pq ↦ pq.1 ≤ β ∧ pq.2 ≤ ξ), b.coeff pq.1 * c.coeff pq.2 := by rw [Subring.coe_mul, HahnSeries.coeff_mul] refine Finset.sum_nbij' (i := fun uv ↦ (β + uv.1, ξ + uv.2)) (j := fun pq ↦ (pq.1 - β, pq.2 - ξ)) ?_ ?_ ?_ ?_ ?_ · rintro ⟨u, v⟩ huv - rw [Finset.mem_addAntidiagonal] at huv + rw [Finset.mem_antidiagonal] at huv obtain ⟨hu, hv, huv⟩ := huv rw [mem_support_translatedTruncation] at hu rw [mem_support_translatedTruncation] at hv - simp only [Finset.mem_filter, Finset.mem_addAntidiagonal] + simp only [Finset.mem_filter, Finset.mem_antidiagonal] refine ⟨⟨hu.2, hv.2, by linarith⟩, by linarith [hu.1], by linarith [hv.1]⟩ · rintro ⟨p, q⟩ hpq - simp only [Finset.mem_filter, Finset.mem_addAntidiagonal] at hpq + simp only [Finset.mem_filter, Finset.mem_antidiagonal] at hpq obtain ⟨⟨hp, hq, hsum⟩, hpβ, hqξ⟩ := hpq - rw [Finset.mem_addAntidiagonal] + rw [Finset.mem_antidiagonal] refine ⟨?_, ?_, by linarith⟩ · rw [mem_support_translatedTruncation] exact ⟨by linarith, by simpa using hp⟩ @@ -80,11 +80,11 @@ theorem coeff_translatedTruncation_mul (b c : K⟦ℝ⟧) (β ξ δ : ℝ) : · rintro ⟨p, q⟩ _ simp · rintro ⟨u, v⟩ huv - rw [Finset.mem_addAntidiagonal] at huv + rw [Finset.mem_antidiagonal] at huv obtain ⟨hu, hv, -⟩ := huv rw [mem_support_translatedTruncation] at hu rw [mem_support_translatedTruncation] at hv - rw [coeff_translatedTruncation, coeff_translatedTruncation, if_pos hu.1, if_pos hv.1] + rw [coeff_translatedTruncation, coeff_translatedTruncation, ite_eq_left hu.1, ite_eq_left hv.1] /-- The finite index set of Berarducci's convolution formula: the first coordinates of the points of the closed supports lying on the line of sum `γ`. -/ @@ -137,8 +137,8 @@ theorem germAt_mul (b c : K⟦ℝ⟧) (γ : ℝ) : refine ⟨η₀ - γ, by linarith, fun δ hδlow hδ0 ↦ ?_⟩ have hγδ : γ + δ ∈ Set.Ioc η₀ γ := ⟨by linarith, by linarith⟩ have hunique := hsub hγδ - rw [coeff_translatedTruncation, if_pos hδ0] - set A := Finset.addAntidiagonal b.isPWO_support c.isPWO_support (γ + δ) with hA + rw [coeff_translatedTruncation, ite_eq_left hδ0] + set A := Finset.antidiagonal b.isPWO_support c.isPWO_support (γ + δ) with hA rw [HahnSeries.coeff_mul] have hcoeSum : ((∑ β ∈ convolutionIndex b c γ, translatedTruncation b β * translatedTruncation c (γ - β) : Series K) : K⟦ℝ⟧).coeff δ = @@ -158,18 +158,18 @@ theorem germAt_mul (b c : K⟦ℝ⟧) (γ : ℝ) : simp only [Finset.sum_filter] rw [Finset.sum_comm] refine (Finset.sum_congr rfl fun pq hpq ↦ ?_).symm - rw [Finset.mem_addAntidiagonal] at hpq + rw [Finset.mem_antidiagonal] at hpq obtain ⟨hp, hq, hsum⟩ := hpq obtain ⟨β₀, hβ₀, hβ₀uniq⟩ := hunique pq.1 (subset_closure hp) pq.2 (subset_closure hq) hsum refine (Finset.sum_eq_single β₀ ?_ ?_).trans ?_ · intro β hβ hne - refine if_neg fun hdom ↦ hne ?_ + refine ite_eq_right fun hdom ↦ hne ?_ exact hβ₀uniq β ⟨(mem_convolutionIndex.mp hβ).1, (mem_convolutionIndex.mp hβ).2, hdom.1, hdom.2⟩ · intro hnot exact absurd (mem_convolutionIndex.mpr ⟨hβ₀.1, hβ₀.2.1⟩) hnot - · exact if_pos ⟨hβ₀.2.2.1, hβ₀.2.2.2⟩ + · exact ite_eq_left ⟨hβ₀.2.2.1, hβ₀.2.2.2⟩ /-- Berarducci, Lemma 7.5(2), the convolution formula at a nonpositive cutoff. -/ theorem germAt_mul_of_nonpos (b c : K⟦ℝ⟧) (γ : ℝ) (_hγ : γ ≤ 0) : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ConvolutionList.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ConvolutionList.lean index 614e2bdb95..8d58b1b608 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ConvolutionList.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ConvolutionList.lean @@ -76,10 +76,10 @@ theorem length_of_mem_convolutionIndexList : | [], γ, f, hf => by rw [convolutionIndexList_nil] at hf by_cases hγ : γ = 0 - · rw [if_pos hγ, Finset.mem_singleton] at hf + · rw [ite_eq_left hγ, Finset.mem_singleton] at hf rw [hf] rfl - · rw [if_neg hγ] at hf + · rw [ite_eq_right hγ] at hf exact absurd hf (Finset.notMem_empty f) | b :: t, γ, f, hf => by rw [convolutionIndexList_cons, Finset.mem_biUnion] at hf @@ -94,9 +94,9 @@ theorem sum_of_mem_convolutionIndexList : | [], γ, f, hf => by rw [convolutionIndexList_nil] at hf by_cases hγ : γ = 0 - · rw [if_pos hγ, Finset.mem_singleton] at hf + · rw [ite_eq_left hγ, Finset.mem_singleton] at hf rw [hf, List.sum_nil, hγ] - · rw [if_neg hγ] at hf + · rw [ite_eq_right hγ] at hf exact absurd hf (Finset.notMem_empty f) | b :: t, γ, f, hf => by rw [convolutionIndexList_cons, Finset.mem_biUnion] at hf @@ -124,11 +124,11 @@ theorem germAt_listProd (l : List K⟦ℝ⟧) (γ : ℝ) : rw [List.prod_nil, convolutionIndexList_nil] by_cases hγ : γ = 0 · subst hγ - rw [if_pos rfl, Finset.sum_singleton, germListProd_nil] + rw [ite_eq_left rfl, Finset.sum_singleton, germListProd_nil] change germAt ((1 : Series K) : K⟦ℝ⟧) 0 = 1 rw [germAt_apply, translatedTruncation_zero] exact map_one toGerm - · rw [if_neg hγ, Finset.sum_empty] + · rw [ite_eq_right hγ, Finset.sum_empty] exact germAt_one_of_ne_zero hγ | cons b t ih => rw [List.prod_cons, germAt_mul, convolutionIndexList_cons] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPointExistence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPointExistence.lean index c62ca5b286..619aeaadf3 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPointExistence.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPointExistence.lean @@ -66,14 +66,14 @@ private theorem translatedTruncation_eq_C_of_support_subset_Ici ext δ rw [coeff_translatedTruncation, HahnSeries.Nonpositive.coe_C] rcases lt_trichotomy δ 0 with hδ | rfl | hδ - · rw [if_pos hδ.le, HahnSeries.C_apply, + · rw [ite_eq_left hδ.le, HahnSeries.C_apply, HahnSeries.coeff_single_of_ne hδ.ne] apply not_ne_iff.mp rw [← HahnSeries.mem_support] intro hmem exact (not_le_of_gt (by linarith : x + δ < x)) (hb hmem) · simp - · rw [if_neg (not_le_of_gt hδ), HahnSeries.C_apply, + · rw [ite_eq_right (not_le_of_gt hδ), HahnSeries.C_apply, HahnSeries.coeff_single_of_ne hδ.ne'] private theorem principalHeadExponent_nonpositive diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/GermValueCut.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/GermValueCut.lean index 7687cf2260..fcfbd55e5f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/GermValueCut.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/GermValueCut.lean @@ -95,7 +95,7 @@ theorem exists_ordinalValue_translatedTruncation_le (b : SeriesWithOrdinalValueA ⟨(b.1 : K⟦ℝ⟧).coeff γ, ?_⟩ refine toGerm_eq_toGerm_iff_exists_coeff_eq.mpr ⟨η' - γ, by linarith, fun δ hδlow hδ0 ↦ ?_⟩ - rw [coeff_translatedTruncation, if_pos hδ0, HahnSeries.Nonpositive.coe_C] + rw [coeff_translatedTruncation, ite_eq_left hδ0, HahnSeries.Nonpositive.coe_C] rcases hδ0.eq_or_lt with rfl | hδneg · simp · rw [HahnSeries.C_apply, HahnSeries.coeff_single_of_ne (by linarith : δ ≠ (0 : ℝ))] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Irreducibility.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Irreducibility.lean index 4d4f5bc0c0..88cd47337a 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Irreducibility.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Irreducibility.lean @@ -242,10 +242,10 @@ private theorem translatedTruncation_one_eq_zero_of_neg {u : ℝ} (hu : u < 0) : funext delta rw [coeff_translatedTruncation] by_cases hdelta : delta ≤ 0 - · rw [if_pos hdelta] + · rw [ite_eq_left hdelta] have hsum : u + delta ≠ 0 := ne_of_lt (add_neg_of_neg_of_nonpos hu hdelta) simp [hsum] - · rw [if_neg hdelta] + · rw [ite_eq_right hdelta] rfl private theorem ordinalValue_add_one_eq_of_one_lt [CharZero K] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OneRow.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OneRow.lean index 5df67406f1..8842b5e16c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OneRow.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OneRow.lean @@ -200,7 +200,7 @@ theorem withConstant_coeff_exponent (n : ℕ) : have hne : exponent n ≠ 0 := by rw [exponent_apply] exact (neg_lt_zero.mpr (by positivity)).ne - rw [HahnSeries.coeff_one, if_neg hne, add_zero] + rw [HahnSeries.coeff_one, ite_eq_right hne, add_zero] @[simp] theorem withConstant_coeff_zero : @@ -222,7 +222,7 @@ theorem withConstant_support : · subst x simp [withConstant_coeff_zero] · have hone : (1 : K⟦ℝ⟧).coeff x = 0 := by - rw [HahnSeries.coeff_one, if_neg hx] + rw [HahnSeries.coeff_one, ite_eq_right hx] rw [HahnSeries.mem_support, withConstant, Subring.coe_add, HahnSeries.coeff_add, show ((1 : Series K) : K⟦ℝ⟧) = 1 from rfl, hone, add_zero, ← HahnSeries.mem_support, withoutConstant_support] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueFinalSegment.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueFinalSegment.lean index 02915d4faf..fd02a8832f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueFinalSegment.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueFinalSegment.lean @@ -258,7 +258,7 @@ theorem le_ordinalValue_translatedTruncation_of_forall_le_orderType have hδθ : θ < -γ + x := by linarith have hδneg : -γ + x < 0 := by linarith have hgerm : ((translatedTruncation b γ : Series K) : K⟦ℝ⟧).coeff (-γ + x) = b.coeff x := by - rw [coeff_translatedTruncation, if_pos hδ0] + rw [coeff_translatedTruncation, ite_eq_left hδ0] congr 1 ring rw [HahnSeries.mem_support, ← hcoeff (-γ + x) hδθ hδneg, hgerm] @@ -289,7 +289,7 @@ theorem exists_ordinalValue_translatedTruncation_eq_of_sub_mem_nearConstantSubgr rw [← toGerm_eq_toGerm_iff] apply toGerm_eq_toGerm_iff_exists_coeff_eq.mpr refine ⟨η - γ, sub_neg.mpr hηγ, fun δ hδ hδ0 ↦ ?_⟩ - rw [coeff_translatedTruncation, coeff_translatedTruncation, if_pos hδ0, if_pos hδ0] + rw [coeff_translatedTruncation, coeff_translatedTruncation, ite_eq_left hδ0, ite_eq_left hδ0] have hnear : η < γ + δ := by linarith have hnegative : γ + δ < 0 := by linarith have hjZero : (j : K⟦ℝ⟧).coeff (γ + δ) = 0 := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentTensor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentTensor.lean index 2102bdca2a..1592a84127 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentTensor.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentTensor.lean @@ -622,7 +622,7 @@ private theorem degreeLayerTruncationAt_principalComponentTensorMap_tmul_monomia simp only [coe_shiftedSeries] by_cases hhg : h = g · subst g - rw [if_pos rfl] + rw [ite_eq_left rfl] have hgerm : translatedTruncation (HahnSeries.translate (h : ℝ) (p : K⟦ℝ⟧)) h = p := by apply Subtype.ext @@ -633,7 +633,7 @@ private theorem degreeLayerTruncationAt_principalComponentTensorMap_tmul_monomia apply (principalComponentMk_eq_iff alpha _ p _ hpBound).mpr rw [hgerm, sub_self, ordinalValue_zero] exact NatOrdinal.wpow_pos alpha - · rw [if_neg hhg] + · rw [ite_eq_right hhg] rw [principalComponentMk_eq_zero_iff] rcases lt_or_gt_of_ne (Subtype.coe_ne_coe.mpr hhg) with hhgLT | hghLT · have htrunc : HahnSeries.truncLE ((g : ℝ) - (h : ℝ)) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringMonoidAlgebra.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringMonoidAlgebra.lean index 12af0e5fe7..3fd09ce905 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringMonoidAlgebra.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringMonoidAlgebra.lean @@ -92,7 +92,7 @@ theorem degreeGradedEquivPrincipalMonoidAlgebra_finiteSupportMonomial rw [degreeGradedEquivPrincipalMonoidAlgebra, AlgEquiv.trans_apply, AlgEquiv.trans_apply, htensor] simp only [Algebra.TensorProduct.congr_apply, AlgEquiv.refl_toAlgHom, - Algebra.TensorProduct.map_tmul, AlgEquiv.coe_algHom, + Algebra.TensorProduct.map_tmul, AlgEquiv.coe_toAlgHom, HahnSeries.Nonpositive.finiteSupportAddMonoidAlgebraEquiv_monomial, AlgEquiv.coe_restrictScalars', AddMonoidAlgebra.scalarTensorEquiv_tmul, AddMonoidAlgebra.mapAlgHom_single, map_one, one_smul] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointCofinality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointCofinality.lean index 742735faac..bdc799e76e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointCofinality.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointCofinality.lean @@ -109,7 +109,7 @@ private theorem isLUB_negativeSupport_translatedTruncation_of_cofinal_support have hdelta0 : -gamma + x < 0 := by linarith [hBlt x hxB] constructor - · rw [HahnSeries.mem_support, coeff_translatedTruncation, if_pos hdelta0.le] + · rw [HahnSeries.mem_support, coeff_translatedTruncation, ite_eq_left hdelta0.le] simpa using hxCoeff · exact hdelta0 constructor diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointOrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointOrderType.lean index a52494a5b8..974ab236dd 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointOrderType.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointOrderType.lean @@ -587,7 +587,7 @@ theorem exists_residualPoint_orderType_eq_of_residualValue_eq_one ⟨(b.1 : K⟦ℝ⟧).coeff y, ?_⟩ refine toGerm_eq_toGerm_iff_exists_coeff_eq.mpr ⟨z - y, by linarith, fun δ hδlow hδ0 ↦ ?_⟩ - rw [coeff_translatedTruncation, if_pos hδ0, HahnSeries.Nonpositive.coe_C] + rw [coeff_translatedTruncation, ite_eq_left hδ0, HahnSeries.Nonpositive.coe_C] rcases hδ0.eq_or_lt with rfl | hδneg · simp · rw [HahnSeries.C_apply, HahnSeries.coeff_single_of_ne (by linarith : δ ≠ (0 : ℝ))] @@ -599,7 +599,7 @@ theorem exists_residualPoint_orderType_eq_of_residualValue_eq_one intro hmem have hzero := constantCoeff_eq_zero_of_mem_negativeMonomialIdeal hmem rw [HahnSeries.Nonpositive.constantCoeff_apply, coeff_translatedTruncation, - if_pos le_rfl] at hzero + ite_eq_left le_rfl] at hzero exact hycoeff (by simpa using hzero) have hveq : ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) y) = b.residualValue := by rw [hρ] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ProductValue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ProductValue.lean index 3585d5bdeb..8f8e64acfc 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ProductValue.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ProductValue.lean @@ -90,8 +90,8 @@ theorem replicate_selectedExponent_add_unselected (w : FormalExpression K) (hw : rw [Multiset.count_add, unselected_eq, Multiset.count_replicate, Multiset.count_filter] by_cases hy : y = selected w hw · subst hy - rw [if_pos rfl, if_neg (fun h ↦ h rfl), add_zero, selectedExponent_eq_count] - · rw [if_neg (Ne.symm hy), if_pos hy, zero_add] + rw [ite_eq_left rfl, ite_eq_right (fun h ↦ h rfl), add_zero, selectedExponent_eq_count] + · rw [ite_eq_right (Ne.symm hy), ite_eq_left hy, zero_add] end FormalExpression diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ConvolutionList.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ConvolutionList.lean index 9546f06906..057f2ed2d6 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ConvolutionList.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ConvolutionList.lean @@ -25,7 +25,7 @@ open scoped HahnSeries /-- The empty product contributes only at cutoff zero. -/ theorem convolutionIndexList_nil_one : Berarducci.convolutionIndexList ([] : List ℚ⟦ℝ⟧) 1 = ∅ := by - rw [Berarducci.convolutionIndexList_nil, if_neg one_ne_zero] + rw [Berarducci.convolutionIndexList_nil, ite_eq_right one_ne_zero] /-- Reading the formula at the empty list computes the germ of one away from zero. -/ theorem germAt_one_at_one : Berarducci.germAt (1 : ℚ⟦ℝ⟧) 1 = 0 := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/CriticalPoint.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/CriticalPoint.lean index da9e806390..96708e5b29 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/CriticalPoint.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/CriticalPoint.lean @@ -52,7 +52,7 @@ private theorem criticalNegativeMonomial_germ_zero_of_lt ext d rw [Berarducci.coeff_translatedTruncation] by_cases hd : d ≤ 0 - · rw [if_pos hd, coe_criticalNegativeMonomial] + · rw [ite_eq_left hd, coe_criticalNegativeMonomial] have hne : y + d ≠ -1 := by linarith rw [HahnSeries.coeff_single_of_ne hne] simp diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ResidualPoint.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ResidualPoint.lean index 0e9a4622ad..ac09cdf283 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ResidualPoint.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/ResidualPoint.lean @@ -125,10 +125,10 @@ theorem translatedTruncation_approachZero_neg_one : · by_cases hδNonpositive : δ ≤ 0 · have hδNeg : δ < 0 := lt_of_le_of_ne hδNonpositive hδ have hlt : -1 + δ < -1 := by linarith - rw [if_pos hδNonpositive, + rw [ite_eq_left hδNonpositive, approachZero_coeff_eq_zero_of_lt_neg_one hlt] simp [hδ] - · rw [if_neg hδNonpositive] + · rw [ite_eq_right hδNonpositive] simp [hδ] /-- The least exponent is a residual point, whereas zero fails the value equation and is diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Truncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Truncation.lean index 8fffe264a6..5e97cf344b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Truncation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Truncation.lean @@ -130,7 +130,7 @@ theorem translatedTruncation_zero (b : Series K) : rw [coeff_translatedTruncation] by_cases hδ : δ ≤ 0 · simp [hδ] - · rw [if_neg hδ] + · rw [ite_eq_right hδ] apply Eq.symm apply not_ne_iff.mp rw [← HahnSeries.mem_support] @@ -188,14 +188,14 @@ theorem germAt_eq_germAt_iff_exists_coeff_eq {b c : K⟦ℝ⟧} {γ : ℝ} : have hshiftLower : ε < δ - γ := by linarith have hshiftUpper : δ - γ ≤ 0 := by linarith have h := heq (δ - γ) hshiftLower hshiftUpper - rw [coeff_translatedTruncation, coeff_translatedTruncation, if_pos hshiftUpper, - if_pos hshiftUpper] at h + rw [coeff_translatedTruncation, coeff_translatedTruncation, ite_eq_left hshiftUpper, + ite_eq_left hshiftUpper] at h simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using h · rintro ⟨η, hη, heq⟩ refine ⟨η - γ, by linarith, fun δ hεδ hδ0 ↦ ?_⟩ have hLower : η < γ + δ := by linarith have hUpper : γ + δ ≤ γ := by linarith - rw [coeff_translatedTruncation, coeff_translatedTruncation, if_pos hδ0, if_pos hδ0] + rw [coeff_translatedTruncation, coeff_translatedTruncation, ite_eq_left hδ0, ite_eq_left hδ0] exact heq (γ + δ) hLower hUpper /-- A germ taken at a point outside the closure of the support vanishes. -/ @@ -207,7 +207,7 @@ theorem germAt_eq_zero_of_not_mem_closure_support {b : K⟦ℝ⟧} {γ : ℝ} have hzero : (0 : Germ K) = toGerm 0 := by simp rw [germAt_apply, hzero, toGerm_eq_toGerm_iff_exists_coeff_eq] refine ⟨-ε, by linarith, fun δ hδlow hδ0 ↦ ?_⟩ - rw [coeff_translatedTruncation, if_pos hδ0] + rw [coeff_translatedTruncation, ite_eq_left hδ0] simp only [Subring.coe_zero, HahnSeries.coeff_zero] by_contra hcoeff have hmem : γ + δ ∈ b.support := (HahnSeries.mem_support _ _).mpr hcoeff diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/CompleteGerm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/CompleteGerm.lean index 1e3abe3a50..59898e25cb 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/CompleteGerm.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/CompleteGerm.lean @@ -98,7 +98,7 @@ theorem germAlgHom_injective have hcomponent : weightedHomogeneousComponent wt β F ≠ 0 := by rw [MvPolynomial.ne_zero_iff] refine ⟨d, ?_⟩ - rw [coeff_weightedHomogeneousComponent, if_pos hβ.symm] + rw [coeff_weightedHomogeneousComponent, ite_eq_left hβ.symm] exact MvPolynomial.mem_support_iff.mp hd have hgraded : aeval xg (weightedHomogeneousComponent wt β F) ≠ 0 := by intro h diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SeparatedPieceSum.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SeparatedPieceSum.lean index d4d2b47003..91afba40e1 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SeparatedPieceSum.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SeparatedPieceSum.lean @@ -117,9 +117,9 @@ def setRestrict (s : Set Γ) [DecidablePred (· ∈ s)] (b : R⟦Γ⟧) : R⟦Γ apply hg change (if g ∈ s then b.coeff g else 0) = 0 rcases Classical.em (g ∈ s) with hgs | hgs - · rw [if_pos hgs] + · rw [ite_eq_left hgs] exact of_not_not fun h ↦ hgb ((mem_support _ _).mpr h) - · rw [if_neg hgs] + · rw [ite_eq_right hgs] @[simp] theorem coeff_setRestrict (s : Set Γ) [DecidablePred (· ∈ s)] (b : R⟦Γ⟧) (g : Γ) : @@ -132,12 +132,12 @@ theorem support_setRestrict (s : Set Γ) [DecidablePred (· ∈ s)] (b : R⟦Γ constructor · intro h rcases Classical.em (g ∈ s) with hgs | hgs - · rw [if_pos hgs] at h + · rw [ite_eq_left hgs] at h exact ⟨(mem_support _ _).mpr h, hgs⟩ - · rw [if_neg hgs] at h + · rw [ite_eq_right hgs] at h exact absurd rfl h · rintro ⟨hb, hgs⟩ - rw [if_pos hgs] + rw [ite_eq_left hgs] exact (mem_support _ _).mp hb open Classical in @@ -155,7 +155,7 @@ theorem separatedHsum_setRestrict_eq (hι : (Set.univ : Set ι).IsPWO) ext g by_cases hgb : g ∈ b.support · obtain ⟨i, hgi⟩ := Set.mem_iUnion.mp (hcov hgb) - rw [coeff_separatedHsum_eq _ _ _ i g ?_, coeff_setRestrict, if_pos hgi] + rw [coeff_separatedHsum_eq _ _ _ i g ?_, coeff_setRestrict, ite_eq_left hgi] intro j hji rw [support_setRestrict] rintro ⟨-, hgj⟩ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupAlgebra.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupAlgebra.lean index e6721e59a4..a4a6d7d45d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupAlgebra.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupAlgebra.lean @@ -59,11 +59,11 @@ private theorem coeff_subgroupAlgebraHom_single (H : AddSubgroup G) (a : H) (b : = if hg : g ∈ H then (Finsupp.single a b : H →₀ K) ⟨g, hg⟩ else 0 := by rw [subgroupAlgebraHom_single, HahnSeries.coeff_single] by_cases hg : g ∈ H - · rw [dif_pos hg, Finsupp.single_apply] + · rw [dite_eq_left hg, Finsupp.single_apply] by_cases hga : g = (a : G) - · rw [if_pos hga, if_pos (Subtype.ext hga.symm : a = ⟨g, hg⟩)] - · rw [if_neg hga, if_neg (fun h : a = ⟨g, hg⟩ ↦ hga (congrArg Subtype.val h).symm)] - · rw [dif_neg hg, if_neg] + · rw [ite_eq_left hga, ite_eq_left (Subtype.ext hga.symm : a = ⟨g, hg⟩)] + · rw [ite_eq_right hga, ite_eq_right (fun h : a = ⟨g, hg⟩ ↦ hga (congrArg Subtype.val h).symm)] + · rw [dite_eq_right hg, ite_eq_right] rintro rfl exact hg a.2 @@ -90,7 +90,7 @@ theorem subgroupAlgebraHom_injective (H : AddSubgroup G) : intro f₁ f₂ h ext a have hc := congrArg (fun x : K⟦G⟧ ↦ x.coeff (a : G)) h - simp only [coeff_subgroupAlgebraHom, dif_pos a.2] at hc + simp only [coeff_subgroupAlgebraHom, dite_eq_left a.2] at hc simpa using hc open Classical in @@ -100,7 +100,7 @@ theorem support_subgroupAlgebraHom_subset (H : AddSubgroup G) (f : AddMonoidAlge rw [HahnSeries.mem_support, coeff_subgroupAlgebraHom] at hg by_cases hgH : g ∈ H · exact hgH - · rw [dif_neg hgH] at hg + · rw [dite_eq_right hgH] at hg exact absurd rfl hg open Classical in @@ -110,9 +110,9 @@ theorem support_subgroupAlgebraHom_finite (H : AddSubgroup G) (f : AddMonoidAlge intro g hg rw [HahnSeries.mem_support, coeff_subgroupAlgebraHom] at hg by_cases hgH : g ∈ H - · rw [dif_pos hgH] at hg + · rw [dite_eq_left hgH] at hg exact ⟨⟨g, hgH⟩, Finsupp.mem_support_iff.mpr hg, rfl⟩ - · rw [dif_neg hgH] at hg + · rw [dite_eq_right hgH] at hg exact absurd rfl hg open Classical in @@ -129,8 +129,8 @@ theorem exists_subgroupAlgebraHom_eq ext g rw [coeff_subgroupAlgebraHom] by_cases hgH : g ∈ H - · rw [dif_pos hgH, Finsupp.comapDomain_apply, hxf, Finsupp.onFinset_apply] - · rw [dif_neg hgH] + · rw [dite_eq_left hgH, Finsupp.comapDomain_apply, hxf, Finsupp.onFinset_apply] + · rw [dite_eq_right hgH] by_contra hne exact hgH (hsub ((HahnSeries.mem_support _ _).mpr (Ne.symm hne))) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupGCD.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupGCD.lean index 103adfec48..7b313c53e8 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupGCD.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupGCD.lean @@ -126,8 +126,8 @@ theorem dvdFS_of_forall_subgroup {H : AddSubgroup G} {f g h : K⟦G⟧} · intro x hx rw [HahnSeries.mem_support, hcoeff x] at hx by_cases hxp : x - s ∈ H - · exact absurd (if_pos hxp) hx - · rw [if_neg hxp] at hx + · exact absurd (ite_eq_left hxp) hx + · rw [ite_eq_right hxp] at hx refine Finset.mem_coe.mpr (Finset.mem_erase.mpr ⟨?_, ?_⟩) · rintro rfl exact hxp (by simp) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupSupport.lean index f92f252e14..14b49e87a9 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupSupport.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupSupport.lean @@ -110,30 +110,30 @@ theorem filter_mul_of_invariant {H : AddSubgroup G} {f u : K⟦G⟧} filter p (f * u) = f * filter p u := by ext c rw [HahnSeries.coeff_filter, HahnSeries.coeff_mul, HahnSeries.coeff_mul] - have hsub : Finset.addAntidiagonal f.isPWO_support (filter p u).isPWO_support c - ⊆ Finset.addAntidiagonal f.isPWO_support u.isPWO_support c := by + have hsub : Finset.antidiagonal f.isPWO_support (filter p u).isPWO_support c + ⊆ Finset.antidiagonal f.isPWO_support u.isPWO_support c := by intro b hb - rw [Finset.mem_addAntidiagonal] at hb ⊢ + rw [Finset.mem_antidiagonal] at hb ⊢ exact ⟨hb.1, HahnSeries.support_filter_subset _ u hb.2.1, hb.2.2⟩ - have hrestrict : ∀ b ∈ Finset.addAntidiagonal f.isPWO_support (filter p u).isPWO_support c, + have hrestrict : ∀ b ∈ Finset.antidiagonal f.isPWO_support (filter p u).isPWO_support c, f.coeff b.1 * (filter p u).coeff b.2 = f.coeff b.1 * u.coeff b.2 := by intro b hb - rw [Finset.mem_addAntidiagonal] at hb + rw [Finset.mem_antidiagonal] at hb rw [HahnSeries.support_filter] at hb - rw [HahnSeries.coeff_filter, if_pos hb.2.1.2] + rw [HahnSeries.coeff_filter, ite_eq_left hb.2.1.2] by_cases hc : p c - · rw [if_pos hc] + · rw [ite_eq_left hc] refine Finset.sum_congr ?_ (fun b hb ↦ (hrestrict b hb).symm) refine Finset.Subset.antisymm (fun b hb ↦ ?_) hsub - rw [Finset.mem_addAntidiagonal] at hb ⊢ + rw [Finset.mem_antidiagonal] at hb ⊢ obtain ⟨hb1, hb2, hb0⟩ := hb refine ⟨hb1, ?_, hb0⟩ rw [HahnSeries.support_filter] refine ⟨hb2, ?_⟩ exact (hp b.1 (hf hb1) b.2).mp (by rw [hb0]; exact hc) - · rw [if_neg hc] + · rw [ite_eq_right hc] refine (Finset.sum_eq_zero fun b hb ↦ ?_).symm - rw [Finset.mem_addAntidiagonal] at hb + rw [Finset.mem_antidiagonal] at hb rw [HahnSeries.support_filter] at hb refine absurd ?_ hc have hb0 := hb.2.2 diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/AlgebraicIndependentDet.lean b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/AlgebraicIndependentDet.lean index b222c400e8..1605e1e2c5 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/AlgebraicIndependentDet.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/AlgebraicIndependentDet.lean @@ -58,15 +58,15 @@ theorem det_ne_zero_of_algebraicIndependent {V : Type w} {f : V → A} by_cases hij : i = j · subst hij obtain ⟨w, hw⟩ := Option.isSome_iff_exists.mp (hdiag i) - rw [hw, if_pos rfl] + rw [hw, ite_eq_left rfl] simp only [Option.elim, MvPolynomial.eval_X, e] - rw [if_pos ⟨i, hw⟩] - · rw [if_neg hij] + rw [ite_eq_left ⟨i, hw⟩] + · rw [ite_eq_right hij] cases hv : v i j with | none => simp | some w => simp only [Option.elim, MvPolynomial.eval_X, e] - rw [if_neg] + rw [ite_eq_right] rintro ⟨i', hi'⟩ obtain ⟨h1, h2⟩ := hdistinct i j i' i' w hv hi' exact hij (h1.trans h2.symm) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/IndicatorFinsupp.lean b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/IndicatorFinsupp.lean index cdda28fa25..958ca965b3 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/IndicatorFinsupp.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/IndicatorFinsupp.lean @@ -35,27 +35,27 @@ noncomputable def indicatorFinsupp (L : Set M) (R : Type u) [Semiring R] (y : M) open scoped Classical in theorem indicatorFinsupp_apply_of_mem (L : Set M) {y : M} (h : y ∈ L) (z : L) : L.indicatorFinsupp R y z = if (z : M) = y then 1 else 0 := by - rw [indicatorFinsupp, dif_pos h, Finsupp.single_apply] + rw [indicatorFinsupp, dite_eq_left h, Finsupp.single_apply] by_cases hz : (z : M) = y - · rw [if_pos hz, if_pos (Subtype.ext hz).symm] - · rw [if_neg hz, if_neg fun h' ↦ hz (congrArg Subtype.val h').symm] + · rw [ite_eq_left hz, ite_eq_left (Subtype.ext hz).symm] + · rw [ite_eq_right hz, ite_eq_right fun h' ↦ hz (congrArg Subtype.val h').symm] theorem indicatorFinsupp_apply_of_notMem (L : Set M) {y : M} (h : y ∉ L) (z : L) : L.indicatorFinsupp R y z = 0 := by - rw [indicatorFinsupp, dif_neg h, Finsupp.zero_apply] + rw [indicatorFinsupp, dite_eq_right h, Finsupp.zero_apply] /-- The indicator of `y` evaluated at the basis vector of `y` itself is `1`. -/ theorem indicatorFinsupp_apply_self (L : Set M) {y : M} (h : y ∈ L) : L.indicatorFinsupp R y ⟨y, h⟩ = 1 := by classical - rw [indicatorFinsupp_apply_of_mem L h, if_pos rfl] + rw [indicatorFinsupp_apply_of_mem L h, ite_eq_left rfl] /-- The indicator of `y` vanishes at a basis vector other than `y`. -/ theorem indicatorFinsupp_apply_of_ne (L : Set M) (y : M) (z : L) (hz : (z : M) ≠ y) : L.indicatorFinsupp R y z = 0 := by classical by_cases h : y ∈ L - · rw [indicatorFinsupp_apply_of_mem L h, if_neg hz] + · rw [indicatorFinsupp_apply_of_mem L h, ite_eq_right hz] · exact indicatorFinsupp_apply_of_notMem L h z theorem indicatorFinsupp_apply_nonneg [PartialOrder R] [IsOrderedRing R] (L : Set M) (y : M) @@ -76,14 +76,14 @@ theorem linearCombination_indicatorFinsupp (L : Set M) (y : M) : Finsupp.linearCombination R (fun z : L ↦ (z : M)) (L.indicatorFinsupp R y) = if y ∈ L then y else 0 := by by_cases h : y ∈ L - · rw [indicatorFinsupp, dif_pos h, Finsupp.linearCombination_single, one_smul, if_pos h] - · rw [indicatorFinsupp, dif_neg h, map_zero, if_neg h] + · rw [indicatorFinsupp, dite_eq_left h, Finsupp.linearCombination_single, one_smul, ite_eq_left h] + · rw [indicatorFinsupp, dite_eq_right h, map_zero, ite_eq_right h] variable (R) in /-- The linear combination of the indicator of a member of `L` is that member. -/ theorem linearCombination_indicatorFinsupp_of_mem (L : Set M) {y : M} (h : y ∈ L) : Finsupp.linearCombination R (fun z : L ↦ (z : M)) (L.indicatorFinsupp R y) = y := by - rw [linearCombination_indicatorFinsupp, if_pos h] + rw [linearCombination_indicatorFinsupp, ite_eq_left h] variable (R) in /-- The linear combination of the indicator of `0` is `0`, whether or not `0 ∈ L`. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ/LinearMap.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ/LinearMap.lean index da4147b319..99a602f825 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ/LinearMap.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ/LinearMap.lean @@ -151,7 +151,7 @@ private theorem mapLinear_tensorRightContraction_tensorProduct (lambda : E → (T : Germ l V ⊗[K] E) : mapLinear (tensorRightContraction lambda) (tensorProduct (l := l) T) = tensorRightContraction lambda T := by - induction T with + induction T using TensorProduct.induction_on with | zero => simp | tmul g e => rw [tensorProduct_tmul, tensorRightContraction_tmul] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Tests/FunAtZeroMinus.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Tests/FunAtZeroMinus.lean index 7f48c6aeca..53a6c9baef 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Tests/FunAtZeroMinus.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Tests/FunAtZeroMinus.lean @@ -43,7 +43,7 @@ theorem tailZero_funAtZeroMinus_eq_zero : change (tailZero : FunAtZeroMinus ℚ) = ((fun _ : ℝ ↦ (0 : ℚ)) : FunAtZeroMinus ℚ) rw [funAtZeroMinus_coe_eq_iff_exists] refine ⟨1, by norm_num, fun γ hγ _ ↦ ?_⟩ - rw [tailZero, if_neg] + rw [tailZero, ite_eq_right] linarith /-- Constant functions remain distinct in `Fun_{0⁻}(ℚ)`. -/ @@ -89,7 +89,7 @@ theorem eventuallyFirstAxis_funAtZeroMinus_mem : (eventuallyFirstAxis : FunAtZeroMinus (ℚ × ℚ)) ∈ funAtZeroMinusSubmodule firstAxis := by rw [coe_mem_funAtZeroMinusSubmodule_iff_exists] refine ⟨1, by norm_num, fun γ hγ _ ↦ ?_⟩ - rw [eventuallyFirstAxis, if_neg] + rw [eventuallyFirstAxis, ite_eq_right] · simp · linarith diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/AdditivelyPrincipal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/AdditivelyPrincipal.lean index 86842c2691..fa8045570b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/AdditivelyPrincipal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/AdditivelyPrincipal.lean @@ -130,7 +130,7 @@ theorem additivePrincipalTerms_of_ne_zero {o : Ordinal} (ho : o ≠ 0) : additivePrincipalTerms o = omega0 ^ log omega0 o :: additivePrincipalTerms (o - omega0 ^ log omega0 o) := by rw [additivePrincipalTerms] - simp only [if_neg ho] + simp only [ite_eq_right ho] /-- A finite ordinary sum of ordinals below a positive additive-principal ordinal remains below that ordinal. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorBendixson.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorBendixson.lean index 61d2b7466e..5f4ec98d1c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorBendixson.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorBendixson.lean @@ -215,12 +215,12 @@ theorem cantorBendixson_top_eq (a : Ordinal.{u}) : rw [ih] by_cases ha : a = 0 · subst a - simp only [zero_add, if_true, if_neg one_ne_zero] + simp only [zero_add, if_true, ite_eq_right one_ne_zero] rw [derivedSet_univ_eq, ← derivedSet_Ioi_zero_eq, ← positivePrincipalMultiples_zero, derivedSet_positivePrincipalMultiples] simp - · simp only [if_neg ha] + · simp only [ite_eq_right ha] rw [derivedSet_positivePrincipalMultiples] simp [ha] | limit a ha ih => @@ -228,7 +228,7 @@ theorem cantorBendixson_top_eq (a : Ordinal.{u}) : simp only [TopologicalSpace.Closeds.coe_iInf] ext x simp only [mem_iInter] - simp only [if_neg (show a ≠ 0 from ha.ne_bot)] + simp only [ite_eq_right (show a ≠ 0 from ha.ne_bot)] constructor · intro hx apply (Set.ext_iff.mp (iInter_positivePrincipalMultiples ha) x).mp @@ -239,18 +239,18 @@ theorem cantorBendixson_top_eq (a : Ordinal.{u}) : have h1a : (1 : Ordinal.{u}) < a := by simpa using ha.succ_lt ha.bot_lt have hstage := hx ⟨(1 : Ordinal.{u}), h1a⟩ - rw [ih (1 : Ordinal.{u}) h1a, if_neg one_ne_zero] at hstage + rw [ih (1 : Ordinal.{u}) h1a, ite_eq_right one_ne_zero] at hstage obtain ⟨y, hy, hxy⟩ := hstage change 0 < x exact pos_iff_ne_zero.mpr fun hx0 ↦ by rw [hx0] at hxy exact (mul_ne_zero (opow_ne_zero _ omega0_ne_zero) hy.ne') hxy - · simpa only [ih i.1 i.2, if_neg hi] using hx i + · simpa only [ih i.1 i.2, ite_eq_right hi] using hx i · intro hx i rw [ih i.1 i.2] by_cases hi : i.1 = 0 · simp [hi] - · rw [if_neg hi] + · rw [ite_eq_right hi] have hall := (Set.ext_iff.mp (iInter_positivePrincipalMultiples ha) x).mpr hx exact mem_iInter.mp hall i diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/SetOrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/SetOrderType.lean index 48c1f5476a..cf568ac8e6 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/SetOrderType.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/SetOrderType.lean @@ -84,7 +84,7 @@ theorem orderType_eq_typeLT_of_orderIso {A : Type u} [LinearOrder A] [WellFounde /-- A partially well-ordered set is order-isomorphic to the canonical well order of its ordinary order type. -/ theorem nonempty_orderIso_toType (hs : s.IsPWO) : Nonempty (hs.orderType.ToType ≃o s) := by - letI : WellFoundedLT s := ⟨hs.isWF⟩ + letI : WellFoundedLT s := hs.isWF have htypes : typeLT hs.orderType.ToType = typeLT s := by rw [type_toType] exact hs.orderType_eq_typeLT_of_orderIso (OrderIso.refl s) @@ -117,7 +117,7 @@ well-ordered set. -/ theorem orderType_image_of_strictMonoOn {B : Type u} [LinearOrder B] (hs : s.IsPWO) {f : α → B} (hf : StrictMonoOn f s) : (hs.image_of_monotoneOn hf.monotoneOn).orderType = hs.orderType := by - letI : WellFoundedLT s := ⟨hs.isWF⟩ + letI : WellFoundedLT s := hs.isWF let e : s ≃o f '' s := StrictMonoOn.orderIso f s hf exact @@ -137,9 +137,9 @@ theorem orderType_eq_add_iff (hs : s.IsPWO) (a b : Ordinal.{u}) : s = s₀ ∪ s₁ := by constructor · intro htype - letI : WellFoundedLT s := ⟨hs.isWF⟩ + letI : WellFoundedLT s := hs.isWF letI : WellFoundedLT (a.ToType ⊕ₗ b.ToType) := - ⟨Sum.lex_wf wellFounded_lt wellFounded_lt⟩ + Sum.lex_wf wellFounded_lt wellFounded_lt have htypes : typeLT s = typeLT (a.ToType ⊕ₗ b.ToType) := by calc typeLT s = hs.orderType := @@ -224,10 +224,10 @@ theorem orderType_eq_add_iff (hs : s.IsPWO) (a b : Ordinal.{u}) : · exact ⟨Sum.inlₗ ⟨x, hx⟩, rfl⟩ · exact ⟨Sum.inrₗ ⟨x, hx⟩, rfl⟩ let e : s₀ ⊕ₗ s₁ ≃o s := hf.orderIsoOfSurjective f hsurj - letI : WellFoundedLT s₀ := ⟨hs₀.isWF⟩ - letI : WellFoundedLT s₁ := ⟨hs₁.isWF⟩ + letI : WellFoundedLT s₀ := hs₀.isWF + letI : WellFoundedLT s₁ := hs₁.isWF letI : WellFoundedLT (s₀ ⊕ₗ s₁) := - ⟨Sum.lex_wf wellFounded_lt wellFounded_lt⟩ + Sum.lex_wf wellFounded_lt wellFounded_lt calc hs.orderType = typeLT (s₀ ⊕ₗ s₁) := hs.orderType_eq_typeLT_of_orderIso e.symm @@ -313,7 +313,7 @@ theorem orderType_inter_Iio_eq_typein [WellFoundedLT s] (hs : s.IsPWO) {x : α} (hx : x ∈ s) : (hs.mono (s := s ∩ Set.Iio x) Set.inter_subset_left).orderType = Ordinal.typein (· < · : s → s → Prop) ⟨x, hx⟩ := by - letI : WellFoundedLT s := ⟨hs.isWF⟩ + letI : WellFoundedLT s := hs.isWF rw [orderType_eq_typeLT_of_orderIso _ (interIioOrderIso hx), ← Ordinal.type_Iio_lt] /-- Splitting a partially well-ordered set at one of its elements splits its order type. -/ @@ -323,7 +323,7 @@ theorem orderType_inter_Iio_add_inter_Ici [WellFoundedLT s] (hs.mono (s := s ∩ Set.Ici x) Set.inter_subset_left).orderType = hs.orderType := by letI : WellFoundedLT (Set.Iio (⟨x, hx⟩ : s) ⊕ₗ Set.Ici (⟨x, hx⟩ : s)) := - ⟨Sum.lex_wf wellFounded_lt wellFounded_lt⟩ + Sum.lex_wf wellFounded_lt wellFounded_lt rw [orderType_eq_typeLT_of_orderIso _ (interIioOrderIso hx), orderType_eq_typeLT_of_orderIso _ (interIciOrderIso hx), ← Ordinal.type_sum_lex] @@ -339,7 +339,7 @@ theorem exists_orderType_inter_Iio_eq (hs : s.IsPWO) {k : Ordinal.{u}} (hk : k < hs.orderType) : ∃ x, ∃ _ : x ∈ s, (hs.mono (s := s ∩ Set.Iio x) Set.inter_subset_left).orderType = k := by - letI : WellFoundedLT s := ⟨hs.isWF⟩ + letI : WellFoundedLT s := hs.isWF have htype : k < Ordinal.type (· < · : s → s → Prop) := by rwa [← hs.orderType_eq_typeLT_of_orderIso (OrderIso.refl s)] obtain ⟨y, hy⟩ := Ordinal.typein_surj (· < · : s → s → Prop) htype @@ -397,7 +397,7 @@ theorem exists_gt_of_isSuccLimit_orderType (hs : s.IsPWO) (hlimit : Order.IsSuccLimit hs.orderType) {x : α} (hx : x ∈ s) : ∃ y ∈ s, x < y := by - letI : WellFoundedLT s := ⟨hs.isWF⟩ + letI : WellFoundedLT s := hs.isWF have hprelimit : Order.IsSuccPrelimit (Ordinal.type (fun x y : s ↦ x < y)) := by rw [← hs.orderType_eq_typeLT_of_orderIso (OrderIso.refl s)] @@ -413,7 +413,7 @@ the converse of `Set.IsPWO.exists_gt_of_isSuccLimit_orderType`. -/ theorem isSuccLimit_orderType_of_forall_exists_gt (hs : s.IsPWO) (hne : s.Nonempty) (hgt : ∀ x ∈ s, ∃ y ∈ s, x < y) : Order.IsSuccLimit hs.orderType := by - letI : WellFoundedLT s := ⟨hs.isWF⟩ + letI : WellFoundedLT s := hs.isWF have hnomax : NoMaxOrder s := by constructor rintro ⟨x, hx⟩ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Sumset.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Sumset.lean index 59060a92df..50ea005fb5 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Sumset.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Sumset.lean @@ -45,7 +45,7 @@ private theorem orderType_le_of_forall_inter_Iio_lt (hs : s.IsPWO) {o : Ordinal} hs.orderType ≤ o := by apply le_of_forall_lt intro c hc - letI : WellFoundedLT s := ⟨hs.isWF⟩ + letI : WellFoundedLT s := hs.isWF have hType : typeLT s = hs.orderType := (orderType_eq_typeLT_of_orderIso hs (OrderIso.refl s)).symm have hc' : c < typeLT s := hc.trans_eq hType.symm @@ -70,7 +70,7 @@ private theorem exists_naturalAdd_split (hs : s.IsPWO) (hzero : hs.orderType ≠ rw [hp.symm] exact Ordinal.isPrincipal_add_omega0_opow d have hp_lt : p < hs.orderType := hp_le.lt_of_ne hp_ne - letI : WellFoundedLT s := ⟨hs.isWF⟩ + letI : WellFoundedLT s := hs.isWF have hType : typeLT s = hs.orderType := (orderType_eq_typeLT_of_orderIso hs (OrderIso.refl s)).symm have hp_type : p < typeLT s := hp_lt.trans_eq hType.symm diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/DegreeTwoPrimeProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/DegreeTwoPrimeProof.lean index dfc64e2c50..c4b7fffda2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/DegreeTwoPrimeProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/DegreeTwoPrimeProof.lean @@ -134,9 +134,9 @@ theorem proof : HasDisplayedCoefficients.{u} := by by simp [exponentAtIndex, exponent_apply]⟩ constructor · intro i hi - rw [hcoeff, if_pos hi] + rw [hcoeff, ite_eq_left hi] · intro i hi - rw [hcoeff, if_neg hi] + rw [hcoeff, ite_eq_right hi] end HasDisplayedCoefficients diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OneRowPrimeProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OneRowPrimeProof.lean index 3a3df29971..87bf6af0ef 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OneRowPrimeProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/OneRowPrimeProof.lean @@ -48,9 +48,9 @@ theorem proof : HasDisplayedCoefficients := by · exact ⟨(n : Index), by simp [exponentAtIndex, exponent_apply]⟩ constructor · intro i hi - rw [hcoeff, if_pos hi] + rw [hcoeff, ite_eq_left hi] · intro i hi - rw [hcoeff, if_neg hi] + rw [hcoeff, ite_eq_right hi] end HasDisplayedCoefficients diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/DegreeTwoExample.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/DegreeTwoExample.lean index a0561bd766..1277773952 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/DegreeTwoExample.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/DegreeTwoExample.lean @@ -166,12 +166,12 @@ theorem normalForm_support : normalForm.{u}.support = range exponentAtIndex := b theorem normalForm_coeff_exponent (m n : ℕ) : normalForm.{u}.coeff (exponent m n : ℝ) = 1 := by classical - rw [normalForm_coeff, coefficient, if_pos] + rw [normalForm_coeff, coefficient, ite_eq_left] exact ⟨(↑(toLex (m, n)) : Index), rfl⟩ theorem normalForm_coeff_zero : normalForm.{u}.coeff 0 = 1 := by classical - rw [normalForm_coeff, coefficient, if_pos] + rw [normalForm_coeff, coefficient, ite_eq_left] exact ⟨⊤, rfl⟩ private theorem normalForm_support_nonnegative : normalForm.{u}.support ⊆ Ici 0 := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamily.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamily.lean index 2955cd76b1..1cd633c826 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamily.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamily.lean @@ -383,13 +383,13 @@ theorem finitePowerNormalForm_length (n : ℕ) : theorem finitePowerNormalForm_coeff_exponent (n : ℕ) (p : FiniteLex n) : (finitePowerNormalForm n).coeff (finitePowerConwayExponent n p : ℝ) = 1 := by classical - rw [finitePowerNormalForm_coeff, finitePowerCoefficient, if_pos] + rw [finitePowerNormalForm_coeff, finitePowerCoefficient, ite_eq_left] exact ⟨(↑p : ConwayIndex n), rfl⟩ theorem finitePowerNormalForm_coeff_zero (n : ℕ) : (finitePowerNormalForm n).coeff 0 = 1 := by classical - rw [finitePowerNormalForm_coeff, finitePowerCoefficient, if_pos] + rw [finitePowerNormalForm_coeff, finitePowerCoefficient, ite_eq_left] exact ⟨⊤, rfl⟩ private theorem finitePowerNormalForm_support_nonnegative (n : ℕ) : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmegaOmegaBoundary.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmegaOmegaBoundary.lean index b9fe11c740..b7094c5e16 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmegaOmegaBoundary.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmegaOmegaBoundary.lean @@ -407,12 +407,12 @@ theorem boundaryNormalForm_length : theorem boundaryNormalForm_coeff_exponent (x : BoundaryIndex) : boundaryNormalForm.coeff (boundaryExponentAtIndex x) = 1 := by classical - rw [boundaryNormalForm_coeff, boundaryCoefficient, if_pos] + rw [boundaryNormalForm_coeff, boundaryCoefficient, ite_eq_left] exact ⟨x, rfl⟩ theorem boundaryNormalForm_coeff_zero : boundaryNormalForm.coeff 0 = 0 := by classical - rw [boundaryNormalForm_coeff, boundaryCoefficient, if_neg] + rw [boundaryNormalForm_coeff, boundaryCoefficient, ite_eq_right] rintro ⟨x, hx⟩ have hxpos := boundaryExponentAtIndex_pos x rw [hx] at hxpos diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OneRowExample.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OneRowExample.lean index 601835fb53..76502bb1a3 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OneRowExample.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OneRowExample.lean @@ -110,12 +110,12 @@ theorem normalForm_support : normalForm.support = range exponentAtIndex := by theorem normalForm_coeff_exponent (n : ℕ) : normalForm.coeff (exponent n : ℝ) = 1 := by classical - rw [normalForm_coeff, coefficient, if_pos] + rw [normalForm_coeff, coefficient, ite_eq_left] exact ⟨(n : Index), rfl⟩ theorem normalForm_coeff_zero : normalForm.coeff 0 = 1 := by classical - rw [normalForm_coeff, coefficient, if_pos] + rw [normalForm_coeff, coefficient, ite_eq_left] exact ⟨⊤, rfl⟩ private theorem normalForm_support_nonnegative : normalForm.support ⊆ Ici 0 := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/PrincipalRVAlgebraicIndependenceProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/PrincipalRVAlgebraicIndependenceProof.lean index 09ac0a322d..6beac2f7a1 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/PrincipalRVAlgebraicIndependenceProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/PrincipalRVAlgebraicIndependenceProof.lean @@ -130,13 +130,13 @@ theorem ordinalValue_eq (a : nonpos K) : ordinalValue a = Berarducci.ordinalValu classical unfold ordinalValue by_cases hJ : MemJ a - · rw [if_pos hJ, Berarducci.ordinalValue_of_mem_negativeMonomialIdeal ((memJ_iff a).mp hJ)] - rw [if_neg hJ] + · rw [ite_eq_left hJ, Berarducci.ordinalValue_of_mem_negativeMonomialIdeal ((memJ_iff a).mp hJ)] + rw [ite_eq_right hJ] by_cases hN : IsNearConstant a - · rw [if_pos hN, + · rw [ite_eq_left hN, Berarducci.ordinalValue_of_mem_nearConstantSubgroup_of_not_mem_negativeMonomialIdeal ((isNearConstant_iff a).mp hN) (fun h ↦ hJ ((memJ_iff a).mpr h))] - rw [if_neg hN, + rw [ite_eq_right hN, Berarducci.ordinalValue_of_not_mem_nearConstantSubgroup (fun h ↦ hN ((isNearConstant_iff a).mpr h))] congr 1 diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/NegativeMonomialRootsProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/NegativeMonomialRootsProof.lean index cd56678c46..3266406c9e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/NegativeMonomialRootsProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/NegativeMonomialRootsProof.lean @@ -17,9 +17,9 @@ public noncomputable section namespace ConwayRefinement.Standalone.Hahn.NegativeMonomialExample private theorem eq_zero_of_mem_addAntidiagonal_zero {x y : Ring} {ij : ℝ × ℝ} - (hij : ij ∈ Finset.addAntidiagonal x.1.isPWO_support y.1.isPWO_support 0) : + (hij : ij ∈ Finset.antidiagonal x.1.isPWO_support y.1.isPWO_support 0) : ij = (0, 0) := by - rcases Finset.mem_addAntidiagonal.mp hij with ⟨hi, hj, hij⟩ + rcases Finset.mem_antidiagonal.mp hij with ⟨hi, hj, hij⟩ have hi_zero := eq_zero_of_add_nonneg_left (x.2 hi) (y.2 hj) hij.ge have hj_zero := eq_zero_of_add_nonneg_right (x.2 hi) (y.2 hj) hij.ge exact Prod.ext hi_zero hj_zero @@ -47,7 +47,7 @@ private def constantCoeff : Ring →+* ℚ where · apply Finset.sum_eq_single (0, 0) · intro ij hij hne exact (hne (eq_zero_of_mem_addAntidiagonal_zero hij)).elim - · simp [Finset.mem_addAntidiagonal, HahnSeries.mem_support, hx, hy] + · simp [Finset.mem_antidiagonal, HahnSeries.mem_support, hx, hy] private theorem nthRoot_not_unit (n : ℕ) (hn : 0 < n) : ¬ IsUnit (nthRoot n) := by intro h diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnLimitTailQuotient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnLimitTailQuotient.lean index adcaddc0c4..3f194eaf85 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnLimitTailQuotient.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnLimitTailQuotient.lean @@ -5,6 +5,7 @@ Authors: Dan Abramov -/ module +public import Mathlib.Algebra.Order.Archimedean.Basic public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotientSplitting public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.OrderedAddGroup public import Mathlib.Algebra.Algebra.Rat diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean index bb05f73205..2250186e66 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean @@ -626,7 +626,7 @@ theorem toCG_mul (x y : SupportGame.{u}) : toCG (x * y) = toCG x * toCG y := by termination_by (x, y) decreasing_by all_goals - aesop (add unsafe + aesop (add safe [ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves, Prod.Lex.left, Prod.Lex.right]) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean index a5430c0bc4..80e74801f1 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean @@ -74,7 +74,11 @@ inductive Player where | left : Player /-- The Right player. -/ | right : Player -deriving DecidableEq, Fintype, Inhabited +deriving DecidableEq, Inhabited + +instance : Fintype Player where + elems := {Player.left, Player.right} + complete := by intro p; cases p <;> simp namespace Player @@ -534,7 +538,7 @@ theorem ofSets_inj {s₁ s₂ t₁ t₂ : Set IGame} [Small s₁] [Small s₂] [ def Subposition : IGame → IGame → Prop := Relation.TransGen fun x y => x ∈ ⋃ p, y.moves p -@[aesop unsafe apply 50%] +@[aesop safe apply] theorem Subposition.of_mem_moves {p} {x y : IGame} (h : x ∈ y.moves p) : Subposition x y := Relation.TransGen.single (Set.mem_iUnion_of_mem p h) @@ -568,7 +572,7 @@ theorem subposition_wf : WellFounded Subposition := by -- We make no use of `IGame`'s definition from a `QPF` after this point. attribute [irreducible] IGame -instance : IsWellFounded _ Subposition := ⟨subposition_wf⟩ +instance : WellFounded _ Subposition := ⟨subposition_wf⟩ instance : WellFoundedRelation IGame := ⟨Subposition, instIsWellFoundedSubposition.wf⟩ theorem Subposition.irrefl (x : IGame) : ¬Subposition x x := _root_.irrefl x @@ -1372,7 +1376,7 @@ theorem eq_intCast_of_mem_rightMoves_intCast {n : ℤ} {x : IGame} (hx : x ∈ n /-! ### Multiplication -/ -attribute [aesop apply unsafe 50%] Prod.Lex.left Prod.Lex.right +attribute [aesop apply safe] Prod.Lex.left Prod.Lex.right private def mul' (x y : IGame) : IGame := !{(range fun a : (xᴸ ×ˢ yᴸ ∪ xᴿ ×ˢ yᴿ :) ↦ @@ -2339,7 +2343,7 @@ theorem mk_ofSets {s t : Set IGame.{u_inline_8}} [Small.{u_inline_8} s] rw [mk_ofSets'] congr!; aesop -@[aesop apply unsafe] +@[aesop apply safe] theorem lt_ofSets_of_mem_left {s t : Set Surreal.{u_inline_8}} [Small.{u_inline_8} s] [Small.{u_inline_8} t] {H : ∀ x ∈ s, ∀ y ∈ t, x < y} {x : Surreal} (hx : x ∈ s) : @@ -2347,7 +2351,7 @@ theorem lt_ofSets_of_mem_left {s t : Set Surreal.{u_inline_8}} [Small.{u_inline_ rw [lt_iff_not_ge, ← toGame_le_iff, toGame_ofSets] exact Game.lf_ofSets_of_mem_left (Set.mem_image_of_mem _ hx) -@[aesop apply unsafe] +@[aesop apply safe] theorem ofSets_lt_of_mem_right {s t : Set Surreal.{u_inline_8}} [Small.{u_inline_8} s] [Small.{u_inline_8} t] {H : ∀ x ∈ s, ∀ y ∈ t, x < y} {x : Surreal} (hx : x ∈ t) : @@ -2522,7 +2526,7 @@ def ArgsRel := lemma argsRel_wf : WellFounded ArgsRel := InvImage.wf _ (Subrelation.wf (fun h => h.elim fun _ => Subposition.of_mem_moves) subposition_wf).cutExpand.transGen -instance : IsWellFounded _ ArgsRel := ⟨argsRel_wf⟩ +instance : WellFounded _ ArgsRel := ⟨argsRel_wf⟩ /-- The property that all arguments are numeric is leftward-closed under `ArgsRel`. -/ lemma ArgsRel.numeric_closed {a' a} : ArgsRel a' a → a.Numeric → a'.Numeric := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormAdd.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormAdd.lean index f8a783b603..c0110d622f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormAdd.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormAdd.lean @@ -208,7 +208,7 @@ private theorem sub_trunc_vle_wpow (x i : Surreal) : x - x.trunc i ≤ᵥ ω^ i have hmem : ↑(s.exp ⟨j, hjlen⟩) ∈ (s.trunc i).support := by rw [SurrealHahnSeries.support_trunc] exact ⟨(s.exp ⟨j, hjlen⟩).2, hiExp⟩ - rw [← hj, SurrealHahnSeries.support_truncIdx, dif_pos hjlen] at hmem + rw [← hj, SurrealHahnSeries.support_truncIdx, dite_eq_left hjlen] at hmem have hfalse : ↑(s.exp ⟨j, hjlen⟩) < ↑(s.exp ⟨j, hjlen⟩) := by simpa using hmem.2 exact (lt_irrefl _) hfalse diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormBasic.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormBasic.lean index f773d6ca6e..76c3b1b6f4 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormBasic.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormBasic.lean @@ -126,7 +126,7 @@ def ofSurrealHahnSeries (x : SurrealHahnSeries) : TermSeq where @[simp, grind =] theorem coeff_coe {s : TermSeq} (i : Iio s.length) : coeff s (s.exp i) = s.coeff i := by - rw [toSurrealHahnSeries, coeff_mk, dif_pos ⟨i, rfl⟩] + rw [toSurrealHahnSeries, coeff_mk, dite_eq_left ⟨i, rfl⟩] generalize_proofs H rw [s.exp_strictAnti.injective <| Classical.choose_spec H] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormRecursion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormRecursion.lean index b0383150d8..40187888e0 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormRecursion.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormRecursion.lean @@ -139,21 +139,21 @@ attribute [simp] appendSingle_length theorem exp_eq_exp_appendSingle (s : TermSeq) (i r e hr he) : s.exp i = (s.appendSingle r e hr he).exp ⟨i.1, by grind⟩ := by - rw [appendSingle_exp, dif_neg (ne_of_lt i.2)] + rw [appendSingle_exp, dite_eq_right (ne_of_lt i.2)] theorem coeff_eq_coeff_appendSingle (s : TermSeq) (i r e hr he) : s.coeff i = (s.appendSingle r e hr he).coeff ⟨i.1, by grind⟩ := by - rw [appendSingle_coeff, dif_neg (ne_of_lt i.2)] + rw [appendSingle_coeff, dite_eq_right (ne_of_lt i.2)] @[simp, grind =] theorem exp_appendSingle_same (s : TermSeq) (r e hr he) : (s.appendSingle r e hr he).exp ⟨s.length, by grind⟩ = e := by - rw [appendSingle_exp, dif_pos rfl] + rw [appendSingle_exp, dite_eq_left rfl] @[simp, grind =] theorem coeff_appendSingle_same (s : TermSeq) (r e hr he) : (s.appendSingle r e hr he).coeff ⟨s.length, by grind⟩ = r := by - rw [appendSingle_coeff, dif_pos rfl] + rw [appendSingle_coeff, dite_eq_left rfl] @[simp] theorem coe_appendSingle {s : TermSeq} {r : ℝ} {e : Surreal} (hr : r ≠ 0) (he : ∀ i, e < s.exp i) : @@ -163,7 +163,7 @@ theorem coe_appendSingle {s : TermSeq} {r : ℝ} {e : Surreal} (hr : r ≠ 0) (h · obtain ⟨j, rfl⟩ := hj rw [coeff_add_apply] conv_lhs => rw [exp_eq_exp_appendSingle s j r e hr he] - rw [coeff_coe, appendSingle_coeff, dif_neg (ne_of_lt j.2), coeff_coe, + rw [coeff_coe, appendSingle_coeff, dite_eq_right (ne_of_lt j.2), coeff_coe, coeff_single_of_ne (ne_of_lt (he j)), add_zero] · rw [coeff_add_apply, coeff_coe_of_notMem hj, zero_add] obtain rfl | he := eq_or_ne e j @@ -242,13 +242,13 @@ theorem trunc_appendSingle {s : TermSeq} {r e hr he} {i} (hi : i ≤ s.length) : apply lt_of_lt_of_le ht rw [trunc_length] exact min_le_right .. - rw [trunc_exp, trunc_exp, appendSingle_exp, dif_neg (ne_of_lt hk)] + rw [trunc_exp, trunc_exp, appendSingle_exp, dite_eq_right (ne_of_lt hk)] · intro k hs ht have hk : k < s.length := by apply lt_of_lt_of_le ht rw [trunc_length] exact min_le_right .. - rw [trunc_coeff, trunc_coeff, appendSingle_coeff, dif_neg (ne_of_lt hk)] + rw [trunc_coeff, trunc_coeff, appendSingle_coeff, dite_eq_right (ne_of_lt hk)] @[simp] theorem trunc_appendSingle_self (s : TermSeq) {r e} (hr he) : @@ -270,10 +270,10 @@ theorem trunc_add_one {s : TermSeq} {i} (hi : i < s.length) : exact min_le_left .. rw [appendSingle_exp] by_cases hki : k = i - · rw [dif_pos (hki.trans hlength.symm), trunc_exp] + · rw [dite_eq_left (hki.trans hlength.symm), trunc_exp] subst k rfl - · rw [dif_neg (by + · rw [dite_eq_right (by intro h exact hki (h.trans hlength)), trunc_exp, trunc_exp] · intro k hs ht @@ -283,10 +283,10 @@ theorem trunc_add_one {s : TermSeq} {i} (hi : i < s.length) : exact min_le_left .. rw [appendSingle_coeff] by_cases hki : k = i - · rw [dif_pos (hki.trans hlength.symm), trunc_coeff] + · rw [dite_eq_left (hki.trans hlength.symm), trunc_coeff] subst k rfl - · rw [dif_neg (by + · rw [dite_eq_right (by intro h exact hki (h.trans hlength)), trunc_coeff, trunc_coeff] @@ -423,12 +423,12 @@ theorem coeffIdx_truncIdx (x : SurrealHahnSeries) (i : Ordinal) : theorem coeffIdx_truncIdx_of_lt {x : SurrealHahnSeries} {i j : Ordinal} (h : j < i) : (x.truncIdx i).coeffIdx j = x.coeffIdx j := by rw [coeffIdx_truncIdx] - exact if_pos h + exact ite_eq_left h theorem coeffIdx_truncIdx_of_le {x : SurrealHahnSeries} {i j : Ordinal} (h : i ≤ j) : (x.truncIdx i).coeffIdx j = 0 := by rw [coeffIdx_truncIdx] - exact if_neg h.not_gt + exact ite_eq_right h.not_gt theorem truncIdx_add_one {x : SurrealHahnSeries} {i : Ordinal} (hi : i < x.length) : x.truncIdx (i + 1) = x.truncIdx i + single (x.exp ⟨i, hi⟩) (x.coeffIdx i) := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Transfer.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Transfer.lean index 5ead9db581..20703aca75 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Transfer.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Transfer.lean @@ -169,13 +169,13 @@ theorem coeff_trunc (x i : Surreal) : theorem coeff_trunc_of_lt {x i j : Surreal} (h : i < j) : (x.trunc i).coeff j = x.coeff j := by rw [coeff_trunc] - exact if_pos h + exact ite_eq_left h @[simp] theorem coeff_trunc_of_le {x i j : Surreal} (h : j ≤ i) : (x.trunc i).coeff j = 0 := by rw [coeff_trunc] - exact if_neg h.not_gt + exact ite_eq_right h.not_gt @[simp, grind =] theorem support_trunc (x i : Surreal) : (x.trunc i).support = x.support ∩ Ioi i := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/IrreducibleOmnificIntegers.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/IrreducibleOmnificIntegers.lean index bf489a824f..a0e834e886 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/IrreducibleOmnificIntegers.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/IrreducibleOmnificIntegers.lean @@ -125,7 +125,7 @@ theorem isReduced_or_isReduced_neg_of_irreducible [CharZero R] rw [← toNonpositive_rhoIntegerPart u c Z x hT htau, h1, map_neg, map_one] at hcoeff have : ((-1 : Nonpositive G R) : R⟦G⟧).coeff 0 = -1 := by rw [Subring.coe_neg, Subring.coe_one, HahnSeries.coeff_neg, HahnSeries.coeff_one, - if_pos rfl] + ite_eq_left rfl] rw [this] at hcoeff have h2 : (1 : R) + 1 = 0 := by calc (1 : R) + 1 = -1 + 1 := by rw [hcoeff] @@ -185,7 +185,7 @@ theorem intCoeff_spec (x : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ map_one' := by apply Int.cast_injective (α := R) rw [intCoeff_spec, Int.cast_one, Subring.coe_one, Subfield.coe_one, HahnSeries.coeff_one, - if_pos rfl] + ite_eq_left rfl] map_mul' x y := by apply Int.cast_injective (α := R) rw [Int.cast_mul, intCoeff_spec, intCoeff_spec, intCoeff_spec] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Round.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Round.lean index 6144650c47..e37a4e8e24 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Round.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Round.lean @@ -111,10 +111,10 @@ theorem round_of_pos {x r : Surreal} (hr : 0 < r) : x.round r = !{{x - r} | {x + r}}' (by rintro _ rfl _ rfl exact sub_lt_add_of_pos x hr) := - dif_pos hr + dite_eq_left hr theorem round_of_nonpos {x r : Surreal} (hr : r ≤ 0) : x.round r = x := - dif_neg hr.not_gt + dite_eq_right hr.not_gt /-- The singleton rounding cut of a positive numeric game is numeric. -/ @[implicit_reducible] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonRank.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonRank.lean index 2ee572b206..93ad917228 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonRank.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonRank.lean @@ -50,13 +50,13 @@ namespace TopologicalSpace.Closeds theorem exists_notMem_cantorBendixson_succ (s : Closeds X) (hs : (s : Set X).IsPWO) (x : X) : ∃ o : Ordinal.{u}, x ∉ (s.cantorBendixson (o + 1) : Set X) := by classical - letI : WellFoundedLT (s : Set X) := ⟨hs.isWF⟩ + letI : WellFoundedLT (s : Set X) := hs.isWF let r (y : X) : Ordinal.{u} := if h : y ∈ s then Ordinal.typein (α := (s : Set X)) (· < ·) ⟨y, h⟩ else 0 have hr : ∀ y ∈ s, ∀ᶠ z in 𝓝 y, z ∈ s → z ≠ y → r z < r y := by intro y hy filter_upwards [hs.eventually_le y] with z hz hzs hzy - simp only [r, dif_pos hzs, dif_pos hy, Ordinal.typein_lt_typein] + simp only [r, dite_eq_left hzs, dite_eq_left hy, Ordinal.typein_lt_typein] exact (lt_of_le_of_ne (hz hzs) hzy : z < y) refine ⟨r x, fun hx ↦ ?_⟩ exact (not_le_of_gt (Order.lt_succ (r x))) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ArchimedeanBallBase.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ArchimedeanBallBase.lean index 6522446785..f2bbec4b3c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ArchimedeanBallBase.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ArchimedeanBallBase.lean @@ -90,9 +90,9 @@ private theorem wellOrderingRel_of_lt {a b : CofinalIndex G} (hab : a < b) : · exact False.elim (hab.ne (Subtype.ext h)) · exact False.elim ((a.property b.1 h).asymm hab) -noncomputable instance : WellFoundedLT (CofinalIndex G) := ⟨ +noncomputable instance : WellFoundedLT (CofinalIndex G) := (InvImage.wf (fun c : CofinalIndex G ↦ c.1) WellOrderingRel.isWellOrder.wf).mono - (fun _ _ h ↦ wellOrderingRel_of_lt h)⟩ + (fun _ _ h ↦ wellOrderingRel_of_lt h) /-- The indexed Archimedean classes are cofinal in the finite class order. -/ theorem isCofinal_range_archimedeanClass : IsCofinal @@ -100,7 +100,7 @@ theorem isCofinal_range_archimedeanClass : IsCofinal change IsCofinal (Set.range (fun c : {c : FiniteArchimedeanClass G // ∀ d, WellOrderingRel d c → d < c} => c.1)) simpa using - (isCofinal_setOf_imp_lt + (isCofinal_setOfPred_imp_lt (WellOrderingRel : FiniteArchimedeanClass G → FiniteArchimedeanClass G → Prop)) end CofinalIndex diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ClosedPWO.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ClosedPWO.lean index a3a47622c7..ae570f8415 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ClosedPWO.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ClosedPWO.lean @@ -302,7 +302,7 @@ private theorem strictClosure_orderType_le_two_mul (hs : s.IsPWO) (hz : IsLUB s 2 * hs.orderType := by let ht := hs.closure.mono (s := strictClosure (s := s) (z := z)) inter_subset_left letI : WellFoundedLT (strictClosure (s := s) (z := z)) := ⟨ht.isWF⟩ - letI : WellFoundedLT s := ⟨hs.isWF⟩ + letI : WellFoundedLT s := hs.isWF let e : strictClosure (s := s) (z := z) ↪o s ×ₗ Fin 2 := OrderEmbedding.ofStrictMono (closureEmbedding hs hz) (closureEmbedding_strictMono hs hz) @@ -410,14 +410,14 @@ theorem IsPWO.cantorBendixsonRank_closure_eq_of_orderType_eq_opow have hsource : i ∈ ((⊤ : TopologicalSpace.Closeds (Iio T)).cantorBendixson a : Set (Iio T)) := by rw [mem_cantorBendixson_top_Iio_iff, Ordinal.cantorBendixson_top_eq, - if_neg ha, hi, Ordinal.mem_positivePrincipalMultiples] + ite_eq_right ha, hi, Ordinal.mem_positivePrincipalMultiples] exact ⟨1, zero_lt_one, by simp⟩ have hsourceSucc : i ∉ ((⊤ : TopologicalSpace.Closeds (Iio T)).cantorBendixson (a + 1) : Set (Iio T)) := by have hsucc : a + 1 ≠ 0 := (add_pos_of_right zero_lt_one a).ne' rw [mem_cantorBendixson_top_Iio_iff, Ordinal.cantorBendixson_top_eq, - if_neg hsucc, hi, Ordinal.mem_positivePrincipalMultiples] + ite_eq_right hsucc, hi, Ordinal.mem_positivePrincipalMultiples] rintro ⟨q, hq, heq⟩ have hle : omega0 ^ (a + 1) ≤ omega0 ^ (a + 1) * q := by simpa using mul_le_mul_right (one_le_iff_pos.mpr hq) (omega0 ^ (a + 1)) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOAddition.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOAddition.lean index 88054e2765..69da609f27 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOAddition.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOAddition.lean @@ -36,8 +36,8 @@ theorem Set.IsPWO.exists_eventually_le {α : Type*} [PartialOrder α] {s : Set α} (hs : s.IsPWO) (𝒰 : Ultrafilter α) (hmem : s ∈ 𝒰) : ∃ a ∈ s, ∀ᶠ b in 𝒰, a ≤ b := by have hfin : {a | Minimal (· ∈ s) a}.Finite := - (setOf_minimal_antichain _).finite_of_partiallyWellOrderedOn - (hs.mono (setOf_minimal_subset _)) + (setOfPred_minimal_antichain _).finite_of_partiallyWellOrderedOn + (hs.mono (setOfPred_minimal_subset _)) have he : ∀ᶠ b in 𝒰, ∃ a ∈ {a | Minimal (· ∈ s) a}, a ≤ b := by filter_upwards [hmem] with b hb obtain ⟨a, hab, ha⟩ := hs.exists_le_minimal hb diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SmallClosedSubspace.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SmallClosedSubspace.lean index f8fbdeb942..5688f4729f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SmallClosedSubspace.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SmallClosedSubspace.lean @@ -192,7 +192,7 @@ theorem mk_lt_of_isPWO_topologicalClosure_span by_cases hy : (upper y).Nonempty · intro heq have heq' : between x hx = between y hy := by - simpa only [f, dif_pos hx, dif_pos hy, Sum.inl.injEq] using heq + simpa only [f, dite_eq_left hx, dite_eq_left hy, Sum.inl.injEq] using heq have hnle : next x hx ≤ y := (upperWF x).min_le hx ⟨y.2, hxy⟩ have hlt : (between x hx : C) < between y hy := by calc diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/CantorBendixsonConvexCover.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/CantorBendixsonConvexCover.lean index 8eab3b4078..d33051a522 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/CantorBendixsonConvexCover.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/CantorBendixsonConvexCover.lean @@ -110,9 +110,9 @@ theorem entry_unitAt (n k : ℕ) : entry (unitAt n) k = if k = n then (1 : ℝ) theorem unitAt_pos (n : ℕ) : 0 < unitAt n := by refine lt_of_forall_eq_of_lt (m := n) (fun j hj ↦ ?_) ?_ - · rw [entry_unitAt, if_neg hj.ne] + · rw [entry_unitAt, ite_eq_right hj.ne] rfl - · rw [entry_unitAt, if_pos rfl] + · rw [entry_unitAt, ite_eq_left rfl] exact zero_lt_one /-- Every sequence vanishing below an index lies strictly between the negative and positive unit @@ -124,13 +124,13 @@ theorem vanishingBelow_subset_Ioo (n : ℕ) : intro x hx constructor · refine lt_of_forall_eq_of_lt (m := n) (fun j hj ↦ ?_) ?_ - · rw [entry_neg, entry_unitAt, if_neg hj.ne, neg_zero, + · rw [entry_neg, entry_unitAt, ite_eq_right hj.ne, neg_zero, hx j (hj.trans (Nat.lt_succ_self n))] - · rw [entry_neg, entry_unitAt, if_pos rfl, hx n (Nat.lt_succ_self n)] + · rw [entry_neg, entry_unitAt, ite_eq_left rfl, hx n (Nat.lt_succ_self n)] norm_num · refine lt_of_forall_eq_of_lt (m := n) (fun j hj ↦ ?_) ?_ - · rw [entry_unitAt, if_neg hj.ne, hx j (hj.trans (Nat.lt_succ_self n))] - · rw [entry_unitAt, if_pos rfl, hx n (Nat.lt_succ_self n)] + · rw [entry_unitAt, ite_eq_right hj.ne, hx j (hj.trans (Nat.lt_succ_self n))] + · rw [entry_unitAt, ite_eq_left rfl, hx n (Nat.lt_succ_self n)] exact zero_lt_one theorem vanishingBelow_isOpen (n : ℕ) : @@ -163,14 +163,14 @@ theorem vanishingBelow_isOpen (n : ℕ) : rcases lt_trichotomy (entry (y - x) m) 0 with hneg | hzero | hpos · refine absurd hmem.1 (not_lt.mpr (le_of_lt (lt_of_forall_eq_of_lt (m := m) (fun j hj ↦ ?_) ?_))) - · rw [hmin j hj, entry_neg, entry_unitAt, if_neg (by omega), neg_zero] - · rw [entry_neg, entry_unitAt, if_neg (by omega), neg_zero] + · rw [hmin j hj, entry_neg, entry_unitAt, ite_eq_right (by omega), neg_zero] + · rw [entry_neg, entry_unitAt, ite_eq_right (by omega), neg_zero] exact hneg · exact hm hzero · refine absurd hmem.2 (not_lt.mpr (le_of_lt (lt_of_forall_eq_of_lt (m := m) (fun j hj ↦ ?_) ?_))) - · rw [entry_unitAt, if_neg (by omega), hmin j hj] - · rw [entry_unitAt, if_neg (by omega)] + · rw [entry_unitAt, ite_eq_right (by omega), hmin j hj] + · rw [entry_unitAt, ite_eq_right (by omega)] exact hpos exact Filter.mem_of_superset (Ioo_mem_nhds (sub_lt_self x (unitAt_pos n)) (lt_add_of_pos_right x (unitAt_pos n))) hsub diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/PWOAddition.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/PWOAddition.lean index 32b0851e08..33129c595c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/PWOAddition.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/PWOAddition.lean @@ -209,7 +209,7 @@ theorem convolution_square_nonzero_value : · intro p _ apply mul_nonneg <;> simp only [accumulatingSeries_coeff] <;> split <;> norm_num · refine ⟨(negRecip n, negRecip n), ?_, ?_⟩ - · rw [Finset.mem_addAntidiagonal, accumulatingSeries_support] + · rw [Finset.mem_antidiagonal, accumulatingSeries_support] exact ⟨mem_range_self n, mem_range_self n, rfl⟩ · simp only [accumulatingSeries_coeff, mem_range_self, if_true, one_mul, zero_lt_one] have ht := negRecip_tendsto @@ -583,7 +583,7 @@ theorem accumulatingSeries_survives_germ : rw [negRecip_apply] exact neg_nonpos.mpr (by positivity) refine ⟨⟨accumulatingSeries, hb⟩, rfl, ?_, ?_⟩ - · rw [accumulatingSeries_coeff, if_neg] + · rw [accumulatingSeries_coeff, ite_eq_right] rintro ⟨n, hn⟩ rw [negRecip_apply] at hn exact (neg_ne_zero.mpr (one_div_ne_zero (by positivity))) hn @@ -803,8 +803,8 @@ theorem no_literal_assembly_at_accumulating_level : by_contra hne exact h0diff ((HahnSeries.mem_support _ _).mpr hne) rw [AddSubgroupClass.coe_sub, HahnSeries.coeff_sub, coe_translatedTruncLE, - coeff_translate, zero_sub, neg_neg, HahnSeries.coeff_truncLE, if_pos le_rfl, - OneMemClass.coe_one, HahnSeries.coeff_one, if_pos rfl, sub_eq_zero] at hzero + coeff_translate, zero_sub, neg_neg, HahnSeries.coeff_truncLE, ite_eq_left le_rfl, + OneMemClass.coe_one, HahnSeries.coeff_one, ite_eq_left rfl, sub_eq_zero] at hzero exact hzero have hxin : negRecip n ∈ (c : HahnSeries ℝ ℚ).support := (HahnSeries.mem_support _ _).mpr (by rw [hcoeff]; exact one_ne_zero) @@ -834,9 +834,9 @@ theorem accumulating_global_cofactor : intro x hx rw [degree_translatedTruncLE_eq] by_cases hxm : x ∈ (u : HahnSeries ℝ ℚ).closedSupport - · rw [if_pos hxm, huneg hx, NatOrdinal.of_zero, WithBot.coe_lt_coe] + · rw [ite_eq_left hxm, huneg hx, NatOrdinal.of_zero, WithBot.coe_lt_coe] exact zero_lt_one - · rw [if_neg hxm] + · rw [ite_eq_right hxm] exact WithBot.bot_lt_coe 1 have hu : ∀ x : ℝ, x ≤ 0 → ν (translatedTruncLE x u) ≤ ((1 : NatOrdinal) : WithBot NatOrdinal) := by @@ -981,7 +981,7 @@ theorem degree_lt_one_constant_extraction : set u : Nonpositive ℝ ℚ := ⟨1 + HahnSeries.single (-1) 1, hs⟩ with hu_def have hcoeff0 : (u : HahnSeries ℝ ℚ).coeff 0 = 1 := by change (1 + HahnSeries.single (-1 : ℝ) (1 : ℚ)).coeff 0 = 1 - rw [HahnSeries.coeff_add, HahnSeries.coeff_one, if_pos rfl, + rw [HahnSeries.coeff_add, HahnSeries.coeff_one, ite_eq_left rfl, HahnSeries.coeff_single_of_ne (by norm_num : (0 : ℝ) ≠ -1), add_zero] have hufin : (u : HahnSeries ℝ ℚ).support.Finite := by apply Set.Finite.subset ((Set.finite_singleton (-1 : ℝ)).insert 0) From 8f3738ed99f112468d89251ad2098558de3b6d87 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 23:16:03 +0000 Subject: [PATCH 03/18] Port Conway tensor recursors and algebraic structure interfaces --- .../CombinatorialGames/Game/Functor.lean | 8 +++++++- .../Algebra/DirectSum/TrailingGrade.lean | 1 - .../Algebra/MvPolynomial/GCDMonoid.lean | 15 ++++++++------- .../Algebra/MvPolynomial/Syzygy.lean | 2 +- .../Valuation/DegreeAssociatedGradedDomain.lean | 2 +- .../TensorProduct/SubalgebraBasis.lean | 3 +-- .../Order/Filter/FunAtZeroMinus.lean | 3 +-- .../Order/Filter/Germ/LinearMap.lean | 3 +-- 8 files changed, 20 insertions(+), 17 deletions(-) diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Functor.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Functor.lean index 80d09b34f4..e956fe5535 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Functor.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Functor.lean @@ -81,6 +81,12 @@ noncomputable instance : QPF GameFunctor where abs x := ⟨fun p ↦ Set.range (x.2 ∘ .mk p ∘ PLift.up), fun _ ↦ by infer_instance⟩ repr x := ⟨fun p ↦ Shrink (x.1 p), Sigma.rec (fun _ y ↦ ((equivShrink _).symm y.1).1)⟩ abs_repr x := by ext; simp [← (equivShrink _).exists_congr_right] - abs_map f := by intro ⟨x, f⟩; ext; simp [PFunctor.map, map_def] + abs_map f := by + intro ⟨x, g⟩ + apply Subtype.ext + funext p + change Set.range (f ∘ g ∘ Sigma.mk p ∘ PLift.up) = + f '' Set.range (g ∘ Sigma.mk p ∘ PLift.up) + exact Set.range_comp f _ end GameFunctor diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/TrailingGrade.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/TrailingGrade.lean index 9317bdcb45..4f32ab4b79 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/TrailingGrade.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/TrailingGrade.lean @@ -55,7 +55,6 @@ theorem trailingGrade_eq_top_iff (x : DirectSum ι A) : trailingGrade A x = ⊤ ↔ x = 0 := by classical simp only [trailingGrade, Finset.min_eq_top, DFinsupp.support_eq_empty] - rfl theorem trailingGrade_le_grade {x : DirectSum ι A} {i : ι} (hi : x i ≠ 0) : trailingGrade A x ≤ (i : WithTop ι) := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/GCDMonoid.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/GCDMonoid.lean index 0768db534d..91996fe098 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/GCDMonoid.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/GCDMonoid.lean @@ -58,13 +58,14 @@ private noncomputable def pullbackNormalizationMonoid (e : A ≃* B) [NormalizationMonoid B] : NormalizationMonoid A where normUnit a := Units.map e.symm.toMonoidHom (normUnit (e a)) normUnit_zero := by simp - normUnit_mul ha hb := by - ext - simp [ha, hb] - normUnit_coe_units u := by - ext - change e.symm ↑(normUnit (↑(Units.map e.toMonoidHom u) : B) : Bˣ) = ↑u⁻¹ - rw [normUnit_coe_units] + normUnit_one := by simp + normUnit_mul_units {a} u ha := by + apply Units.ext + have he : e a ≠ 0 := by simpa using ha + change e.symm ↑(normUnit (e (a * ↑u))) = + ↑(u⁻¹ * Units.map e.symm.toMonoidHom (normUnit (e a))) + rw [map_mul, show e ↑u = ↑(Units.map e.toMonoidHom u) from rfl, + normUnit_mul_units _ he] simp @[implicit_reducible] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Syzygy.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Syzygy.lean index 01e3521ad4..930ae3db7d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Syzygy.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Syzygy.lean @@ -75,7 +75,7 @@ theorem exists_eq_sum_monomial_mul_C_of_sum_C_mul_eq_zero (c : B → R₀) fun b ↦ ?_⟩ · have := congrArg ((fun p => AddMonoidAlgebra.coeff p d)) hu rw [coeff_sum, AddMonoidAlgebra.coeff_zero] at this - simpa only [coeff_C_mul] using this + simpa only [coeff_C_mul, Finsupp.zero_apply] using this · conv_lhs => rw [(u b).as_sum] rw [Finset.sum_subset (Finset.subset_biUnion_of_mem (fun b ↦ (u b).support) (Finset.mem_univ b))] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedDomain.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedDomain.lean index 8acb69ed3d..fbba331850 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedDomain.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedDomain.lean @@ -179,7 +179,7 @@ theorem nontrivial_of_associatedGraded_isDomain exact congrArg (fun z : ν.filtrationLE m ↦ (z : ν.Component m)) (Subtype.ext (Subsingleton.elim (x : R) (y : R))) have hgraded : (1 : ν.AssociatedGraded) = 0 := - DirectSum.ext ν.Component (fun m ↦ hcomponent m _ _) + DFinsupp.ext (fun m ↦ hcomponent m _ _) exact one_ne_zero hgraded variable [WellFoundedLT M] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/SubalgebraBasis.lean b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/SubalgebraBasis.lean index 10aeb4168c..229ba00394 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/SubalgebraBasis.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/SubalgebraBasis.lean @@ -66,8 +66,7 @@ theorem tensorBasisRepr_tmul (g : G) (l : L) : /-- The key formula: the coordinates of `j(x) · (B i ⊗ 1)` are `single i x`. -/ theorem tensorBasisRepr_tensorInclusion_mul (x : S ⊗[K] L) (i : ι) : S.tensorBasisRepr B (S.tensorInclusion x * (B i ⊗ₜ[K] 1)) = Finsupp.single i x := by - induction x using TensorProduct.induction_on with - | zero => rw [map_zero, zero_mul, map_zero, Finsupp.single_zero] + induction x using TensorProduct.inductionOn with | tmul s l => rw [tensorInclusion_tmul, Algebra.TensorProduct.tmul_mul_tmul, mul_one, tensorBasisRepr_tmul] have hsmul : (s : G) * B i = s • B i := rfl diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/FunAtZeroMinus.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/FunAtZeroMinus.lean index 07468ffc8d..5724abe19e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/FunAtZeroMinus.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/FunAtZeroMinus.lean @@ -341,8 +341,7 @@ theorem mapLinear_lTensor_funAtZeroMinusTensorId (u : U →ₗ[K] FunAtZeroMinus V) (f : E →ₗ[K] E') (T : U ⊗[K] E) : Filter.Germ.mapLinear (f.lTensor V) (funAtZeroMinusTensorId u T) = funAtZeroMinusTensorId u (f.lTensor U T) := by - induction T with - | zero => simp + induction T using TensorProduct.inductionOn with | tmul x e => rw [LinearMap.lTensor_tmul, funAtZeroMinusTensorId_tmul, funAtZeroMinusTensorId_tmul] induction u x using Filter.Germ.inductionOn with diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ/LinearMap.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ/LinearMap.lean index 99a602f825..7d34f5d7f3 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ/LinearMap.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ/LinearMap.lean @@ -151,8 +151,7 @@ private theorem mapLinear_tensorRightContraction_tensorProduct (lambda : E → (T : Germ l V ⊗[K] E) : mapLinear (tensorRightContraction lambda) (tensorProduct (l := l) T) = tensorRightContraction lambda T := by - induction T using TensorProduct.induction_on with - | zero => simp + induction T using TensorProduct.inductionOn with | tmul g e => rw [tensorProduct_tmul, tensorRightContraction_tmul] induction g using inductionOn with From 935fefdf29438b5a51488c02f21802cfd644f914 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 23:36:47 +0000 Subject: [PATCH 04/18] Port Conway tensor, Hahn-series and game APIs to Lean 4.34 --- .../CombinatorialGames/Game/Birthday.lean | 5 +- .../CombinatorialGames/Game/IGame.lean | 26 ++++++--- .../Surreal/Multiplication.lean | 2 +- .../CombinatorialGames/Tactic/GameCmp.lean | 2 +- .../Algebra/LoweringDerivation/Mu.lean | 7 +-- .../Algebra/MvPolynomial/BaseChange.lean | 36 ++++++------ .../Valuation/DegreeWeightedPolynomial.lean | 10 ++-- .../LatticeFactorCoefficients.lean | 47 ++++++++-------- .../LaurentFactorCoefficients.lean | 36 ++++++------ .../HahnSeries/DomainEmbedding.lean | 4 +- .../HahnSeries/DomainOrderType.lean | 6 +- .../HahnSeries/FiniteSupport.lean | 2 +- .../FiniteSupportMonoidAlgebra.lean | 6 +- .../HahnSeries/FiniteSupportResidue.lean | 2 +- .../Tests/ReducedCharacterization.lean | 2 + .../ConwayRefinement/HahnSeries/Iterate.lean | 5 +- .../HahnSeries/IterateOrderType.lean | 4 +- .../HahnSeries/NonpositiveDomainEquiv.lean | 4 +- .../HahnSeries/OrdinalValue/OrdinalValue.lean | 2 +- .../OrdinalValueFinalSegment.lean | 4 +- .../OrdinalValue/ResidualPointOrderType.lean | 4 +- .../OrdinalValue/ResidualPointSupport.lean | 2 +- .../Tests/OrdinalValueFinalSegment.lean | 2 +- .../HahnSeries/SubgroupAlgebra.lean | 21 +++---- .../HahnSeries/Tests/Truncation.lean | 56 ++++++++++--------- .../HahnSeries/Tests/WeakNormalForm.lean | 56 ++++++++++--------- .../HahnSeries/Translation.lean | 2 +- .../SetTheory/Ordinal/CantorBendixson.lean | 1 + .../SetTheory/Ordinal/OrderedUnion.lean | 4 +- .../Mathlib/InlineConwayRefinement.lean | 5 ++ .../Mathlib/Support/InlineSurreal.lean | 45 +++++++++++---- .../Surreal/OmnificInteger/NormalForm.lean | 5 ++ .../Topology/Order/ClosedPWO.lean | 4 +- .../Topology/Order/SmallClosedSubspace.lean | 2 + 34 files changed, 240 insertions(+), 181 deletions(-) diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean index ec95eca130..d7a52bf624 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean @@ -212,7 +212,7 @@ instance small_setOf_birthday_lt (o : NatOrdinal.{u}) : Small.{u} {x | birthday | isSuccPrelimit o ho ih => convert @small_biUnion _ _ (Iio o) _ (fun i _ => {x : IGame.{u} | x.birthday < i}) ih ext x - simpa using ho.lt_iff_exists_lt + simpa [Set.nonempty_def, and_comm] using ho.lt_iff_exists_lt /-- Games with a bounded birthday form a small set. -/ instance small_setOf_birthday_le (o : NatOrdinal.{u}) : Small.{u} {x | birthday x ≤ o} := by @@ -238,6 +238,7 @@ noncomputable def birthdayFinset : ℕ → Finset IGame.{u} theorem mem_birthdayFinset_succ {x : IGame} {n : ℕ} : x ∈ birthdayFinset (n + 1) ↔ ∃ l r, (l ⊆ birthdayFinset n ∧ r ⊆ birthdayFinset n) ∧ !{l | r} = x := by simp [birthdayFinset] + rfl @[simp] theorem birthdayFinset_zero : birthdayFinset 0 = {0} := (rfl) @@ -275,7 +276,7 @@ theorem mem_birthdayFinset {x : IGame} {n : ℕ} : x ∈ birthdayFinset n ↔ x. theorem strictMono_birthdayFinset : StrictMono birthdayFinset := by refine strictMono_nat_of_lt_succ fun n ↦ ⟨fun y hy ↦ ?_, fun h ↦ ?_⟩ - · rw [SetLike.mem_coe, mem_birthdayFinset] at * + · rw [mem_birthdayFinset] at * apply hy.trans simp · have := Finset.card_le_card h diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean index 5d36eccbb0..b5aef5fc55 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean @@ -138,7 +138,8 @@ instance (p : Player) (x : IGame.{u}) : Small.{u} (x.moves p) := x.dest.2 p @[simp, game_cmp] theorem moves_ofSets (p) (st : Player → Set IGame) [Small.{u} (st left)] [Small.{u} (st right)] : !{st}.moves p = st p := by - dsimp [ofSets]; ext; rw [moves, QPF.Fix.dest_mk] + exact congrArg (fun s : GameFunctor IGame => s.val p) + (QPF.Fix.dest_mk ⟨st, by rintro (_ | _) <;> assumption⟩) @[simp] theorem ofSets_moves (x : IGame) : !{x.moves} = x := x.mk_dest @@ -200,21 +201,24 @@ instance small_subtype_subposition (x : IGame.{u}) : Small.{u} {y // Subposition small_transGen' _ x theorem subposition_wf : WellFounded Subposition := by + change WellFounded (Relation.TransGen fun (x y : QPF.Fix GameFunctor) => + x ∈ ⋃ p, (QPF.Fix.dest y).val p) refine ⟨fun x => Acc.transGen ?_⟩ apply QPF.Fix.ind - unfold moves rintro _ ⟨⟨st, hst⟩, rfl⟩ constructor rintro y hy - rw [QPF.Fix.dest_mk, mem_iUnion] at hy - obtain ⟨_, ⟨_, h⟩, _, rfl⟩ := hy - exact h + rw [QPF.Fix.dest_mk] at hy + change y ∈ ⋃ p, Subtype.val '' st p at hy + obtain ⟨p, hp⟩ := Set.mem_iUnion.mp hy + obtain ⟨z, _, rfl⟩ := hp + exact z.property -- We make no use of `IGame`'s definition from a `QPF` after this point. attribute [irreducible] IGame -instance : WellFounded _ Subposition := ⟨subposition_wf⟩ -instance : WellFoundedRelation IGame := ⟨Subposition, instIsWellFoundedSubposition.wf⟩ +instance : WellFounded Subposition := subposition_wf +instance : WellFoundedRelation IGame := ⟨Subposition, subposition_wf⟩ theorem Subposition.irrefl (x : IGame) : ¬Subposition x x := _root_.irrefl x @@ -1024,7 +1028,13 @@ private def mul' (x y : IGame) : IGame := (range fun a : (xᴸ ×ˢ yᴿ ∪ xᴿ ×ˢ yᴸ :) ↦ mul' a.1.1 y + mul' x a.1.2 - mul' a.1.1 a.1.2)} termination_by (x, y) -decreasing_by all_goals aesop +decreasing_by + all_goals + rcases a.property with h | h + all_goals + first + | exact Prod.Lex.left _ _ (Subposition.of_mem_moves h.1) + | exact Prod.Lex.right _ (Subposition.of_mem_moves h.2) #adaptation_note /-- noncomputable is now needed -/ in /-- The product of `x = !{s₁ | t₁}` and `y = !{s₂ | t₂}` is diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean index b8fe4b95f3..d8dfc1aa91 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean @@ -164,7 +164,7 @@ def ArgsRel := InvImage (TransGen <| CutExpand fun x y => ∃ p, x ∈ y.moves p lemma argsRel_wf : WellFounded ArgsRel := InvImage.wf _ (Subrelation.wf (fun h => h.elim fun _ => Subposition.of_mem_moves) subposition_wf).cutExpand.transGen -instance : WellFounded _ ArgsRel := ⟨argsRel_wf⟩ +instance : WellFounded ArgsRel := argsRel_wf /-- The property that all arguments are numeric is leftward-closed under `ArgsRel`. -/ lemma ArgsRel.numeric_closed {a' a} : ArgsRel a' a → a.Numeric → a'.Numeric := diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/GameCmp.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/GameCmp.lean index 19df73a7e6..40cfc0be62 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/GameCmp.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/GameCmp.lean @@ -53,7 +53,7 @@ public section variable {α : Type*} {P : α → Prop} attribute [game_cmp] Set.forall_mem_empty -@[game_cmp] theorem Set.exists_mem_empty : (∃ x ∈ (∅ : Set α), P x) ↔ False := by simp +@[game_cmp] theorem Set.gameCmp_exists_mem_empty : (∃ x ∈ (∅ : Set α), P x) ↔ False := by simp @[game_cmp] theorem Set.forall_singleton {x : α} : (∀ y ∈ ({x} : Set α), P y) ↔ P x := by simp @[game_cmp] theorem Set.exists_singleton {x : α} : (∃ y ∈ ({x} : Set α), P y) ↔ P x := by simp diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Mu.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Mu.lean index 5cc8bb53a9..f85ff1be6c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Mu.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Mu.lean @@ -205,7 +205,6 @@ theorem fibreMap_eq_mk (b : R) : fibreMap 𝒜 b = Submodule.Quotient.mk b := rf theorem muMulLeft_mk (j : ℕ) (a : 𝒜 (j : NatOrdinal)) (b : R) : muMulLeft 𝒜 j a (fibreMap 𝒜 b) = Submodule.Quotient.mk ((a : R) * b) := by - rw [fibreMap_eq_mk, muMulLeft, LinearMap.restrictScalars_apply, Submodule.mapQ_apply] rfl /-- The bilinear map `A_j × A/I → A/I_{≥j+1}`, `(B, π(C)) ↦ BC + I_{≥j+1}`. -/ @@ -263,8 +262,7 @@ theorem mapLinear_idealGEQuot_eq_zero_iff (j : ℕ) (g : FunAtZeroMinus R) : theorem mu_lTensor_mulLeft (j : ℕ) (B : R) (T : 𝒜 (j : NatOrdinal) ⊗[E] Fibre 𝒜) : mu 𝒜 j ((LinearMap.mulLeft E (fibreMap 𝒜 B)).lTensor _ T) = mu 𝒜 j T * (Ideal.Quotient.mk (idealGE 𝒜 (j + 1)) B) := by - induction T with - | zero => simp + induction T using TensorProduct.inductionOn with | tmul a c => obtain ⟨b, rfl⟩ := fibreMap_surjective 𝒜 c rw [LinearMap.lTensor_tmul, LinearMap.mulLeft_apply, ← map_mul, mu_tmul, mu_tmul] @@ -335,8 +333,7 @@ theorem exists_homogeneous_mu_eq {j : ℕ} {α : NatOrdinal} (hj : j ≤ α.cons mu 𝒜 j ((fibreGrade 𝒜 (α.removeNat j)).subtype.lTensor _ T) = (Submodule.Quotient.mk G : R ⧸ idealGE 𝒜 (j + 1)) := by classical - induction T with - | zero => exact ⟨0, zero_mem _, zero_mem _, by simp⟩ + induction T using TensorProduct.inductionOn with | tmul a c => obtain ⟨b, hb, hbc⟩ := exists_mem_of_mem_fibreGrade 𝒜 c.2 refine ⟨(a : R) * b, ?_, Ideal.mul_mem_right _ _ (mem_idealGE_of_mem 𝒜 le_rfl a.2), ?_⟩ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/BaseChange.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/BaseChange.lean index 4424a51de2..90bcb26fc9 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/BaseChange.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/BaseChange.lean @@ -32,22 +32,23 @@ namespace MvPolynomial variable {K : Type u} {A : Type v} {L : Type w} {σ : Type x} variable [CommRing K] [CommRing A] [Algebra K A] [CommRing L] [Algebra K L] +/-- Extending polynomial coefficients by a tensor factor on the right, as a `K`-algebra + equivalence. -/ +noncomputable def polynomialScalarTensorAlgEquiv : + MvPolynomial σ K ⊗[K] L ≃ₐ[K] MvPolynomial σ L := + (Algebra.TensorProduct.comm K _ _).trans + ((algebraTensorAlgEquiv (σ := σ) K L).restrictScalars K) + /-- The identification `K[X_i] ⊗_K L ≅ L[X_i]` on a variable tensor. -/ -theorem scalarRTensorAlgEquiv_X_tmul_one [DecidableEq σ] (i : σ) : - scalarRTensorAlgEquiv (σ := σ) (R := K) (N := L) (X i ⊗ₜ[K] 1) = X i := by - classical - refine MvPolynomial.ext _ _ fun d ↦ ?_ - simp [scalarRTensorAlgEquiv, rTensorAlgEquiv_apply, coeff_rTensorAlgHom_tmul, coeff_map, - coeff_X, Algebra.smul_def, mul_one, apply_ite (algebraMap K L)] +theorem scalarRTensorAlgEquiv_X_tmul_one (i : σ) : + polynomialScalarTensorAlgEquiv (σ := σ) (K := K) (L := L) (X i ⊗ₜ[K] 1) = X i := by + simp [polynomialScalarTensorAlgEquiv, algebraTensorAlgEquiv_tmul] /-- The identification `K[X_i] ⊗_K L ≅ L[X_i]` on a scalar tensor. -/ -theorem scalarRTensorAlgEquiv_one_tmul [DecidableEq σ] (l : L) : - scalarRTensorAlgEquiv (σ := σ) (R := K) (N := L) (1 ⊗ₜ[K] l) = C l := by - classical - refine MvPolynomial.ext _ _ fun d ↦ ?_ - simp [scalarRTensorAlgEquiv, rTensorAlgEquiv_apply, coeff_rTensorAlgHom_tmul, coeff_map, - coeff_C, coeff_one, apply_ite] - split_ifs with hd <;> simp [hd] +theorem scalarRTensorAlgEquiv_one_tmul (l : L) : + polynomialScalarTensorAlgEquiv (σ := σ) (K := K) (L := L) (1 ⊗ₜ[K] l) = C l := by + simp [polynomialScalarTensorAlgEquiv, algebraTensorAlgEquiv_tmul, + MvPolynomial.smul_eq_C_mul] variable (K L) in /-- Evaluation `L[X_i] → A ⊗_K L`, `X_i ↦ y i ⊗ 1`, `l ↦ 1 ⊗ l`, as a `K`-algebra @@ -63,9 +64,9 @@ theorem aevalTmulOne_C (y : σ → A) (l : L) : aevalTmulOne K L y (C l) = (1 : /-- Through `K[X_i] ⊗_K L ≅ L[X_i]`, evaluation at the `y i ⊗ 1` is the base change to `L` of evaluation at the `y i`. -/ -theorem aevalTmulOne_comp_scalarRTensorAlgEquiv [DecidableEq σ] (y : σ → A) : +theorem aevalTmulOne_comp_scalarRTensorAlgEquiv (y : σ → A) : (aevalTmulOne K L y).comp - (scalarRTensorAlgEquiv (σ := σ) (R := K) (N := L)).toAlgHom = + (polynomialScalarTensorAlgEquiv (σ := σ) (K := K) (L := L)).toAlgHom = Algebra.TensorProduct.map (aeval y : MvPolynomial σ K →ₐ[K] A) (AlgHom.id K L) := by refine Algebra.TensorProduct.ext ?_ ?_ · refine MvPolynomial.algHom_ext fun i ↦ ?_ @@ -96,8 +97,7 @@ theorem aevalTmulOne_surjective {y : σ → A} (hy : Function.Surjective (aeval y : MvPolynomial σ K →ₐ[K] A)) : Function.Surjective (aevalTmulOne K L y) := by intro z - induction z using TensorProduct.induction_on with - | zero => exact ⟨0, map_zero _⟩ + induction z using TensorProduct.inductionOn with | tmul a l => obtain ⟨G, rfl⟩ := hy a refine ⟨C l * map (algebraMap K L) G, ?_⟩ @@ -118,7 +118,7 @@ theorem aevalTmulOne_injective [Module.Flat K L] {y : σ → A} (Algebra.TensorProduct.map (aeval y : MvPolynomial σ K →ₐ[K] A) (AlgHom.id K L)) := Module.Flat.rTensor_preserves_injective_linearMap (R := K) (M := L) (aeval y : MvPolynomial σ K →ₐ[K] A).toLinearMap hy - set e := scalarRTensorAlgEquiv (σ := σ) (R := K) (N := L) + set e := polynomialScalarTensorAlgEquiv (σ := σ) (K := K) (L := L) have key : ∀ u, aevalTmulOne K L y (e u) = Algebra.TensorProduct.map (aeval y : MvPolynomial σ K →ₐ[K] A) (AlgHom.id K L) u := fun u ↦ congrFun (congrArg (fun f : _ →ₐ[K] _ ↦ (f : _ → _)) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeWeightedPolynomial.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeWeightedPolynomial.lean index c1452abbfe..10f3287dfc 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeWeightedPolynomial.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeWeightedPolynomial.lean @@ -128,22 +128,22 @@ theorem homogeneousMk_aeval_of_isWeightedHomogeneous {G : MvPolynomial σ L} {d ν.homogeneousMk d ⟨aeval x G, hle⟩ = Φ G := by classical have hdeg : ∀ e ∈ G.support, - ν (aeval x (monomial e (coeff e G))) = (d : WithBot M) := fun e he ↦ by + ν (aeval x (monomial e (G.coeff e))) = (d : WithBot M) := fun e he ↦ by rw [H.degree_aeval_monomial e (mem_support_iff.mp he), hG (mem_support_iff.mp he)] - have hmem : ∀ e ∈ G.support, aeval x (monomial e (coeff e G)) ∈ ν.filtrationLE d := + have hmem : ∀ e ∈ G.support, aeval x (monomial e (G.coeff e)) ∈ ν.filtrationLE d := fun e he ↦ (ν.mem_filtrationLE_iff _ _).mpr (hdeg e he).le have hsplit : (⟨aeval x G, hle⟩ : ν.filtrationLE d) = - ⟨∑ e ∈ G.support, aeval x (monomial e (coeff e G)), (ν.filtrationLE _).sum_mem hmem⟩ := by + ⟨∑ e ∈ G.support, aeval x (monomial e (G.coeff e)), (ν.filtrationLE _).sum_mem hmem⟩ := by apply Subtype.ext change aeval x G = _ conv_lhs => rw [as_sum G] rw [_root_.map_sum] rw [hsplit, ν.homogeneousMk_finsetSum _ _ hmem] conv_rhs => rw [as_sum G] - rw [_root_.map_sum, ← Finset.sum_attach G.support fun e ↦ Φ (monomial e (coeff e G))] + rw [_root_.map_sum, ← Finset.sum_attach G.support fun e ↦ Φ (monomial e (G.coeff e))] refine Finset.sum_congr rfl fun e _ ↦ ?_ rw [ν.homogeneousMk_eq_initialForm_of_degree_eq _ (hdeg e.1 e.2)] - exact H.initialForm_aeval_monomial e.1 (coeff e.1 G) + exact H.initialForm_aeval_monomial e.1 (G.coeff e.1) variable [OrderBot M] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LatticeFactorCoefficients.lean b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LatticeFactorCoefficients.lean index 157378a531..3ae949abff 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LatticeFactorCoefficients.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LatticeFactorCoefficients.lean @@ -30,7 +30,7 @@ variable {K : Type u} {L : Type v} [Field K] [Field L] [Algebra K L] omit [Algebra K L] in /-- Coefficient extension is `Finsupp.mapRange` on the underlying finitely supported function. -/ theorem mapRingHom_apply' {M : Type*} [AddMonoid M] (f : K →+* L) (x : AddMonoidAlgebra K M) : - AddMonoidAlgebra.mapRingHom M f x = Finsupp.mapRange f (map_zero f) x := rfl + AddMonoidAlgebra.mapRingHom M f x = ofCoeff (Finsupp.mapRange f (map_zero f) x.coeff) := rfl omit [Algebra K L] in /-- Relabelling exponents commutes with extending coefficients. -/ @@ -38,8 +38,7 @@ theorem mapDomain_mapRingHom {M N : Type*} [AddMonoid M] [AddMonoid N] (psi : M (f : K →+* L) (x : AddMonoidAlgebra K M) : AddMonoidAlgebra.mapDomainRingHom L psi (AddMonoidAlgebra.mapRingHom M f x) = AddMonoidAlgebra.mapRingHom N f (AddMonoidAlgebra.mapDomainRingHom K psi x) := by - rw [mapDomainRingHom_apply, mapRingHom_apply', mapRingHom_apply', mapDomainRingHom_apply] - exact Finsupp.mapDomain_mapRange psi x f (map_zero f) (map_add f) + exact (DFunLike.congr_fun (mapRingHom_comp_mapDomainRingHom f psi) x).symm /-- Lattice form of scalar clearing: collapse the lattice to one variable along a functional that separates the exponents in play. -/ @@ -48,28 +47,30 @@ theorem exists_scalar_of_mul_eq_map_lattice {k : ℕ} {q r : AddMonoidAlgebra L (Fin k → ℤ)} {P : AddMonoidAlgebra K (Fin k → ℤ)} (hq : q ≠ 0) (hr : r ≠ 0) (hqr : q * r = AddMonoidAlgebra.mapRingHom (Fin k → ℤ) (algebraMap K L) P) : - ∃ c : L, c ≠ 0 ∧ ∀ g, c * q g ∈ (algebraMap K L).range := by + ∃ c : L, c ≠ 0 ∧ ∀ g, c * q.coeff g ∈ (algebraMap K L).range := by classical - obtain ⟨psi, hpsi⟩ := AddMonoidHom.exists_injOn_finInt (q.support ∪ r.support) - have hsub : (q.support : Set (Fin k → ℤ)) ⊆ ((q.support ∪ r.support : Finset _) : Set _) := + obtain ⟨psi, hpsi⟩ := AddMonoidHom.exists_injOn_finInt (q.coeff.support ∪ r.coeff.support) + have hsub : (q.coeff.support : Set (Fin k → ℤ)) ⊆ ((q.coeff.support ∪ r.coeff.support : Finset _) : Set _) := fun x hx ↦ Finset.mem_coe.mpr (Finset.mem_union_left _ (Finset.mem_coe.mp hx)) - have hinjq : Set.InjOn psi (q.support : Set (Fin k → ℤ)) := hpsi.mono hsub - have htransfer : ∀ g ∈ q.support, - (AddMonoidAlgebra.mapDomainRingHom L psi q) (psi g) = q g := fun g hg ↦ - Finsupp.mapDomain_apply' _ q hsub hpsi (Finset.mem_union_left _ hg) + have hinjq : Set.InjOn psi (q.coeff.support : Set (Fin k → ℤ)) := hpsi.mono hsub + have htransfer : ∀ g ∈ q.coeff.support, + (AddMonoidAlgebra.mapDomainRingHom L psi q).coeff (psi g) = q.coeff g := fun g hg ↦ + Finsupp.mapDomain_apply' _ q.coeff hsub hpsi (Finset.mem_union_left _ hg) have hq0 : AddMonoidAlgebra.mapDomainRingHom L psi q ≠ 0 := by - obtain ⟨g, hg⟩ := Finsupp.support_nonempty_iff.mpr hq + obtain ⟨g, hg⟩ := Finsupp.support_nonempty_iff.mpr (coeff_eq_zero.not.mpr hq) intro h0 rw [h0] at htransfer exact (Finsupp.mem_support_iff.mp hg) (htransfer g hg).symm have hr0 : AddMonoidAlgebra.mapDomainRingHom L psi r ≠ 0 := by - obtain ⟨g, hg⟩ := Finsupp.support_nonempty_iff.mpr hr - have hsubr : (r.support : Set (Fin k → ℤ)) ⊆ ((q.support ∪ r.support : Finset _) : Set _) := + obtain ⟨g, hg⟩ := Finsupp.support_nonempty_iff.mpr (coeff_eq_zero.not.mpr hr) + have hsubr : (r.coeff.support : Set (Fin k → ℤ)) ⊆ ((q.coeff.support ∪ r.coeff.support : Finset _) : Set _) := fun x hx ↦ Finset.mem_coe.mpr (Finset.mem_union_right _ (Finset.mem_coe.mp hx)) intro h0 - have := Finsupp.mapDomain_apply' ((q.support ∪ r.support : Finset _) : Set _) r hsubr hpsi + have := Finsupp.mapDomain_apply' ((q.coeff.support ∪ r.coeff.support : Finset _) : Set _) r.coeff hsubr hpsi (Finset.mem_union_right _ hg) - have h0' : Finsupp.mapDomain psi r = 0 := (mapDomainRingHom_apply L psi r).symm.trans h0 + have h0' : Finsupp.mapDomain psi r.coeff = 0 := by + simpa only [mapDomainRingHom_apply, mapDomain, coeff_ofCoeff, coeff_zero] + using congrArg AddMonoidAlgebra.coeff h0 rw [h0'] at this exact (Finsupp.mem_support_iff.mp hg) this.symm have hrel : (AddMonoidAlgebra.mapDomainRingHom L psi q) * @@ -80,7 +81,7 @@ theorem exists_scalar_of_mul_eq_map_lattice {k : ℕ} obtain ⟨c, hc, hcoeff⟩ := LaurentPolynomial.exists_scalar_of_mul_eq_map hclosed hq0 hr0 hrel refine ⟨c, hc, fun g ↦ ?_⟩ - by_cases hg : g ∈ q.support + by_cases hg : g ∈ q.coeff.support · rw [← htransfer g hg] exact hcoeff _ · rw [Finsupp.notMem_support_iff.mp hg, mul_zero] @@ -92,26 +93,26 @@ theorem exists_scalar_of_mul_eq_map_free {H : Type w} [AddCommGroup H] (hclosed : Algebra.IsRelativelyAlgebraicallyClosed K L) {q r : AddMonoidAlgebra L H} {P : AddMonoidAlgebra K H} (hq : q ≠ 0) (hr : r ≠ 0) (hqr : q * r = AddMonoidAlgebra.mapRingHom H (algebraMap K L) P) : - ∃ c : L, c ≠ 0 ∧ ∀ g, c * q g ∈ (algebraMap K L).range := by + ∃ c : L, c ≠ 0 ∧ ∀ g, c * q.coeff g ∈ (algebraMap K L).range := by obtain ⟨k, ⟨e⟩⟩ := hfree have hinj : Function.Injective (e : H → (Fin k → ℤ)) := e.injective have htrans : ∀ (x : AddMonoidAlgebra L H) (g : H), - (AddMonoidAlgebra.mapDomainRingHom L e.toAddMonoidHom x) (e g) = x g := by + (AddMonoidAlgebra.mapDomainRingHom L e.toAddMonoidHom x).coeff (e g) = x.coeff g := by intro x g rw [mapDomainRingHom_apply] - exact Finsupp.mapDomain_apply hinj x g + exact Finsupp.mapDomain_apply_of_injective hinj x.coeff g have hq0 : AddMonoidAlgebra.mapDomainRingHom L e.toAddMonoidHom q ≠ 0 := by - obtain ⟨g, hg⟩ := Finsupp.support_nonempty_iff.mpr hq + obtain ⟨g, hg⟩ := Finsupp.support_nonempty_iff.mpr (coeff_eq_zero.not.mpr hq) intro h0 apply Finsupp.mem_support_iff.mp hg rw [← htrans q g, h0] - exact Finsupp.zero_apply + rfl have hr0 : AddMonoidAlgebra.mapDomainRingHom L e.toAddMonoidHom r ≠ 0 := by - obtain ⟨g, hg⟩ := Finsupp.support_nonempty_iff.mpr hr + obtain ⟨g, hg⟩ := Finsupp.support_nonempty_iff.mpr (coeff_eq_zero.not.mpr hr) intro h0 apply Finsupp.mem_support_iff.mp hg rw [← htrans r g, h0] - exact Finsupp.zero_apply + rfl have hrel : (AddMonoidAlgebra.mapDomainRingHom L e.toAddMonoidHom q) * (AddMonoidAlgebra.mapDomainRingHom L e.toAddMonoidHom r) = AddMonoidAlgebra.mapRingHom (Fin k → ℤ) (algebraMap K L) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LaurentFactorCoefficients.lean b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LaurentFactorCoefficients.lean index 173899c231..7fa5af04ed 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LaurentFactorCoefficients.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LaurentFactorCoefficients.lean @@ -32,37 +32,37 @@ variable {R : Type u} [Semiring R] /-- The Laurent image of a polynomial has the same coefficients at natural exponents. -/ theorem toLaurent_apply_natCast (p : Polynomial R) (n : ℕ) : - (Polynomial.toLaurent p) (n : ℤ) = p.coeff n := by - rw [Polynomial.toLaurent_apply, Finsupp.mapDomain_apply Nat.cast_injective] + (Polynomial.toLaurent p).coeff (n : ℤ) = p.coeff n := by + rw [coeff_toLaurent] + change (p.toFinsupp.coeff.mapDomain Nat.castEmbedding) (Nat.castEmbedding n) = p.coeff n + rw [Finsupp.mapDomain_apply_of_injective Nat.castEmbedding.injective] rfl /-- The Laurent image of a polynomial vanishes at negative exponents. -/ theorem toLaurent_apply_of_neg (p : Polynomial R) {z : ℤ} (hz : z < 0) : - (Polynomial.toLaurent p) z = 0 := by - rw [Polynomial.toLaurent_apply] - refine Finsupp.mapDomain_notin_range _ _ ?_ + (Polynomial.toLaurent p).coeff z = 0 := by + rw [coeff_toLaurent] + refine Finsupp.mapDomain_of_notMem_range _ _ ?_ rintro ⟨n, rfl⟩ + change (n : ℤ) < 0 at hz omega /-- Coefficient extension commutes with the Laurent inclusion. -/ theorem toLaurent_map {S : Type*} [Semiring S] (f : R →+* S) (p : Polynomial R) : Polynomial.toLaurent (p.map f) = AddMonoidAlgebra.mapRingHom ℤ f (Polynomial.toLaurent p) := by - refine Finsupp.ext fun z ↦ ?_ + ext z rcases lt_or_ge z 0 with hz | hz · rw [toLaurent_apply_of_neg _ hz] - change (0 : S) = f ((Polynomial.toLaurent p) z) + change (0 : S) = f ((Polynomial.toLaurent p).coeff z) rw [toLaurent_apply_of_neg _ hz, map_zero] · obtain ⟨n, rfl⟩ := Int.eq_ofNat_of_zero_le hz rw [toLaurent_apply_natCast, Polynomial.coeff_map] - change f (p.coeff n) = f ((Polynomial.toLaurent p) (n : ℤ)) + change f (p.coeff n) = f ((Polynomial.toLaurent p).coeff (n : ℤ)) rw [toLaurent_apply_natCast] /-- Coefficient extension fixes the Laurent monomials. -/ theorem mapRingHom_T {S : Type*} [Semiring S] (f : R →+* S) (z : ℤ) : AddMonoidAlgebra.mapRingHom ℤ f (LaurentPolynomial.T z) = LaurentPolynomial.T z := by - refine Finsupp.ext fun w ↦ ?_ - change f ((LaurentPolynomial.T z : AddMonoidAlgebra R ℤ) w) = _ - simp only [LaurentPolynomial.T, Finsupp.single_apply] - split_ifs <;> simp + simp only [LaurentPolynomial.T, AddMonoidAlgebra.mapRingHom_single, map_one] section Core @@ -93,14 +93,14 @@ section Shift variable {R : Type u} [CommRing R] private theorem mul_T_apply (f : AddMonoidAlgebra R ℤ) (n : ℤ) (z : ℤ) : - ((f * LaurentPolynomial.T n : AddMonoidAlgebra R ℤ)) z = f (z - n) := by - rw [show (LaurentPolynomial.T n : AddMonoidAlgebra R ℤ) = Finsupp.single n (1 : R) from rfl, - AddMonoidAlgebra.mul_single_apply, mul_one, sub_eq_add_neg] + (f * LaurentPolynomial.T n : AddMonoidAlgebra R ℤ).coeff z = f.coeff (z - n) := by + simp only [LaurentPolynomial.T, AddMonoidAlgebra.coeff_mul_single_apply, + mul_one, sub_eq_add_neg] /-- Coefficients of a Laurent polynomial read off a polynomial shift, at natural indices. -/ theorem apply_sub_of_toLaurent_eq_mul_T {f : AddMonoidAlgebra R ℤ} {p : Polynomial R} {n : ℕ} (h : Polynomial.toLaurent p = f * LaurentPolynomial.T (n : ℤ)) (j : ℕ) : - f ((j : ℤ) - n) = p.coeff j := by + f.coeff ((j : ℤ) - n) = p.coeff j := by have hj := mul_T_apply f (n : ℤ) (j : ℤ) rw [← h, toLaurent_apply_natCast] at hj exact hj.symm @@ -108,7 +108,7 @@ theorem apply_sub_of_toLaurent_eq_mul_T {f : AddMonoidAlgebra R ℤ} {p : Polyno /-- Below the shift the Laurent polynomial vanishes. -/ theorem apply_eq_zero_of_toLaurent_eq_mul_T {f : AddMonoidAlgebra R ℤ} {p : Polynomial R} {n : ℕ} (h : Polynomial.toLaurent p = f * LaurentPolynomial.T (n : ℤ)) {z : ℤ} (hz : z + n < 0) : - f z = 0 := by + f.coeff z = 0 := by have hz' := mul_T_apply f (n : ℤ) (z + n) simp only [add_sub_cancel_right] at hz' rw [← h, toLaurent_apply_of_neg _ hz] at hz' @@ -123,7 +123,7 @@ theorem exists_scalar_of_mul_eq_map (hclosed : Algebra.IsRelativelyAlgebraicallyClosed K L) {q r : AddMonoidAlgebra L ℤ} {P : AddMonoidAlgebra K ℤ} (hq : q ≠ 0) (hr : r ≠ 0) (hqr : q * r = AddMonoidAlgebra.mapRingHom ℤ (algebraMap K L) P) : - ∃ c : L, c ≠ 0 ∧ ∀ z, c * q z ∈ (algebraMap K L).range := by + ∃ c : L, c ≠ 0 ∧ ∀ z, c * q.coeff z ∈ (algebraMap K L).range := by obtain ⟨n₀, q₀, hq₀⟩ := LaurentPolynomial.exists_T_pow q obtain ⟨m₀, r₀, hr₀⟩ := LaurentPolynomial.exists_T_pow r obtain ⟨l, P₀, hP₀⟩ := LaurentPolynomial.exists_T_pow P diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainEmbedding.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainEmbedding.lean index 5f70a73bc4..6de0b73c98 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainEmbedding.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainEmbedding.lean @@ -82,9 +82,9 @@ theorem lift_supportOrderType_mapDomain (f : G →+ H) (hfi : Function.Injective (HahnSeries.supportOrderType (mapDomain f hfi hf b : K⟦H⟧)) = Ordinal.lift.{v, u} (HahnSeries.supportOrderType (b : K⟦G⟧)) := by let e : G ↪o H := ⟨⟨f, hfi⟩, hf _ _⟩ - letI : WellFoundedLT (b : K⟦G⟧).support := ⟨(b : K⟦G⟧).isWF_support⟩ + letI : WellFoundedLT (b : K⟦G⟧).support := (b : K⟦G⟧).isWF_support letI : WellFoundedLT (mapDomain f hfi hf b : K⟦H⟧).support := - ⟨(mapDomain f hfi hf b : K⟦H⟧).isWF_support⟩ + (mapDomain f hfi hf b : K⟦H⟧).isWF_support let supportEquiv : (mapDomain f hfi hf b : K⟦H⟧).support ≃o (b : K⟦G⟧).support := (OrderIso.setCongr _ (f '' (b : K⟦G⟧).support) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainOrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainOrderType.lean index cee53cc971..7185ba7739 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainOrderType.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainOrderType.lean @@ -45,8 +45,8 @@ theorem supportOrderType_restrictDomain_le (f : G ↪o H) (x : R⟦H⟧) : intro a b hab exact f.strictMono hab letI : WellFoundedLT ↑(restrictDomain f x).support := - ⟨(restrictDomain f x).isPWO_support.isWF⟩ - letI : WellFoundedLT ↑x.support := ⟨x.isPWO_support.isWF⟩ + (restrictDomain f x).isPWO_support.isWF + letI : WellFoundedLT ↑x.support := x.isPWO_support.isWF rw [supportOrderType_eq_setOrderType, supportOrderType_eq_setOrderType] calc (restrictDomain f x).isPWO_support.orderType = @@ -72,7 +72,7 @@ variable [AddCommMonoid H] [IsOrderedCancelAddMonoid H] theorem supportOrderType_embDomainRingEquiv (e : G ≃+o H) (x : R⟦G⟧) : (embDomainRingEquiv e x).supportOrderType = x.supportOrderType := by rw [supportOrderType_eq_setOrderType, supportOrderType_eq_setOrderType] - letI : WellFoundedLT x.support := ⟨x.isWF_support⟩ + letI : WellFoundedLT x.support := x.isWF_support let supportEquiv : (embDomainRingEquiv e x).support ≃o x.support := (OrderIso.setCongr _ (e '' x.support) (support_embDomainRingEquiv e x)).trans (StrictMonoOn.orderIso e x.support diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupport.lean index 48c71bfab4..95afcf7c45 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupport.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupport.lean @@ -258,7 +258,7 @@ theorem finiteSupportFinsuppEquiv_apply /-- The finite-support monomial `t^g`, for a nonpositive exponent `g`. -/ def finiteSupportMonomial (g : exponentMonoid G) : (finiteSupportSubring : Subring (Nonpositive G K)) := - ⟨single (g : G) (1 : K) g.2, by + ⟨single (g : G) (1 : K) (show (g : G) ≤ 0 from g.2), by rw [mem_finiteSupportSubring_iff, coe_single] exact Set.Finite.subset (Set.finite_singleton (g : G)) (HahnSeries.support_single_subset (a := (g : G)) (r := (1 : K)))⟩ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportMonoidAlgebra.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportMonoidAlgebra.lean index 4f84091e50..df5536cc91 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportMonoidAlgebra.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportMonoidAlgebra.lean @@ -58,7 +58,7 @@ theorem finiteSupportCoefficients_toSeries finiteSupportCoefficients (finiteSupportAddMonoidAlgebraToSeries f) = AddMonoidAlgebra.coeff f := by induction f using AddMonoidAlgebra.induction_on with - | hM g => + | of g => rw [AddMonoidAlgebra.of_apply] rw [finiteSupportAddMonoidAlgebraToSeries, AddMonoidAlgebra.lift_single] rw [one_smul] @@ -69,10 +69,10 @@ theorem finiteSupportCoefficients_toSeries finiteSupportMonomial (K := K) g from rfl] rw [finiteSupportCoefficients_monomial] rfl - | hadd f g hf hg => + | add f g hf hg => rw [map_add, map_add, hf, hg] exact (AddMonoidAlgebra.coeff_add f g).symm - | hsmul k f hf => + | smul k f hf => rw [map_smul, map_smul, hf] exact (AddMonoidAlgebra.coeff_smul k f).symm diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportResidue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportResidue.lean index 256f4fdc16..6798356085 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportResidue.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportResidue.lean @@ -73,7 +73,7 @@ theorem finiteSupportResidueEquiv_apply w.residueMap (RingEquiv.subringCongr (nonpositiveSubring_eq_finiteSupportSubring_of_value_eq_degree w hvalue).symm b) := by - simp [finiteSupportResidueEquiv] + rfl /-- Under the RV/homogeneous equivalence, the residue isomorphism is the restriction of `rv`. -/ theorem coe_rvEquivHomogeneous_rv_eq_residueRingHom_finiteSupportResidueEquiv diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ReducedCharacterization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ReducedCharacterization.lean index b24b784b43..3f7cd597fa 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ReducedCharacterization.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ReducedCharacterization.lean @@ -5,6 +5,8 @@ Authors: Dan Abramov -/ module +public import Mathlib.Algebra.Order.Archimedean.Basic + public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedCharacterization /-! diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Iterate.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Iterate.lean index 807c0ccf5b..dd422b328d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Iterate.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Iterate.lean @@ -46,8 +46,9 @@ private theorem ofIterate_mul (x y : R⟦Γ'⟧⟦Γ⟧) : ofIterate (x * y) = ofIterate x * ofIterate y := by ext g rcases g with ⟨g, g'⟩ - simp only [ofIterate, coeff_mul] - rw [coeff_sum] + change ((x * y).coeff g).coeff g' = + (ofIterate x * ofIterate y).coeff (toLex (g, g')) + rw [coeff_mul, coeff_sum] simp only [coeff_mul] rw [Finset.sum_sigma'] apply Finset.sum_bij diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IterateOrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IterateOrderType.lean index 920d338263..24920b412b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IterateOrderType.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IterateOrderType.lean @@ -48,9 +48,9 @@ theorem supportOrderType_outer_le_iterateRingEquiv (x : R⟦Γ'⟧⟦Γ⟧) : change toLex (a.1, inner a) < toLex (b.1, inner b) rw [Prod.Lex.toLex_lt_toLex] exact Or.inl hab - letI : WellFoundedLT ↑x.support := ⟨x.isPWO_support.isWF⟩ + letI : WellFoundedLT ↑x.support := x.isPWO_support.isWF letI : WellFoundedLT ↑(iterateRingEquiv x).support := - ⟨(iterateRingEquiv x).isPWO_support.isWF⟩ + (iterateRingEquiv x).isPWO_support.isWF rw [supportOrderType_eq_setOrderType, supportOrderType_eq_setOrderType] calc x.isPWO_support.orderType = typeLT ↑x.support := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NonpositiveDomainEquiv.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NonpositiveDomainEquiv.lean index cf0149c34d..666afd781e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NonpositiveDomainEquiv.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NonpositiveDomainEquiv.lean @@ -80,9 +80,9 @@ theorem lift_supportOrderType_embDomainRingEquiv (e : G ≃+o H) Ordinal.lift.{u, v} (HahnSeries.supportOrderType (embDomainRingEquiv e x : K⟦H⟧)) = Ordinal.lift.{v, u} (HahnSeries.supportOrderType (x : K⟦G⟧)) := by - letI : WellFoundedLT (x : K⟦G⟧).support := ⟨(x : K⟦G⟧).isWF_support⟩ + letI : WellFoundedLT (x : K⟦G⟧).support := (x : K⟦G⟧).isWF_support letI : WellFoundedLT (embDomainRingEquiv e x : K⟦H⟧).support := - ⟨(embDomainRingEquiv e x : K⟦H⟧).isWF_support⟩ + (embDomainRingEquiv e x : K⟦H⟧).isWF_support let supportEquiv : (embDomainRingEquiv e x : K⟦H⟧).support ≃o (x : K⟦G⟧).support := (OrderIso.setCongr _ (e '' (x : K⟦G⟧).support) (by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValue.lean index 63b75d3bd7..623a616eac 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValue.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValue.lean @@ -163,7 +163,7 @@ private theorem mem_nearConstantSubgroup_of_supportOrderType_le_one · have hbTypeOne : (b : K⟦ℝ⟧).supportOrderType = 1 := by simpa using hbOne letI : WellFoundedLT (b : K⟦ℝ⟧).support := - ⟨(b : K⟦ℝ⟧).isWF_support⟩ + (b : K⟦ℝ⟧).isWF_support have htype : Ordinal.type (fun x y : (b : K⟦ℝ⟧).support ↦ x < y) = 1 := by rw [← HahnSeries.supportOrderType_eq_typeLT (x := (b : K⟦ℝ⟧)) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueFinalSegment.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueFinalSegment.lean index fd02a8832f..b973274445 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueFinalSegment.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueFinalSegment.lean @@ -203,8 +203,8 @@ theorem ordinalValue_translatedTruncation_le_orderType_of_isRelUpperSet_supportB let hshiftedPWO : shifted.IsPWO := ((translatedTruncation b γ : Series K) : K⟦ℝ⟧).isPWO_support.mono fun _ hx ↦ (hshifted hx).1.1 - letI : WellFoundedLT C := ⟨hCPWO.isWF⟩ - letI : WellFoundedLT shifted := ⟨hshiftedPWO.isWF⟩ + letI : WellFoundedLT C := hCPWO.isWF + letI : WellFoundedLT shifted := hshiftedPWO.isWF let f : C → shifted := fun x ↦ ⟨-γ + x.1, x.1, x.2, rfl⟩ have hf : StrictMono f := by intro x y hxy diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointOrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointOrderType.lean index 974ab236dd..a535214571 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointOrderType.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointOrderType.lean @@ -351,7 +351,7 @@ private theorem ordinalValue_translatedTruncation_val_le_of_orderType_inter_Iio_ have hIiow : I ∩ Set.Iio w = S ∩ Set.Iio w := by ext y exact ⟨fun hy ↦ ⟨hy.1.1, hy.2⟩, fun hy ↦ ⟨⟨hy.1, lt_trans hy.2 hwγ⟩, hy.2⟩⟩ - letI : WellFoundedLT I := ⟨hI.isWF⟩ + letI : WellFoundedLT I := hI.isWF have hsplit := hI.orderType_inter_Iio_add_inter_Ici hwI have hIiowot : (hI.mono (s := I ∩ Set.Iio w) Set.inter_subset_left).orderType = ρ * α := by rw [Set.IsPWO.orderType_congr _ (hS.mono (s := S ∩ Set.Iio w) Set.inter_subset_left) hIiow] @@ -407,7 +407,7 @@ private theorem le_ordinalValue_translatedTruncation_of_isLUB_of_orderType_inter (negativeSupportTail_subset_support b.1 η)) with hSpwo set I := S ∩ Set.Iio γ with hIdef set hI := hS.mono (s := I) Set.inter_subset_left with hIpwo - letI : WellFoundedLT I := ⟨hI.isWF⟩ + letI : WellFoundedLT I := hI.isWF apply le_ordinalValue_translatedTruncation_of_forall_le_orderType intro θ hθ obtain ⟨z, hzI, hθz, _⟩ := hLUB.exists_between hθ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointSupport.lean index f52fa040f0..07ba8cf17f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointSupport.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointSupport.lean @@ -71,7 +71,7 @@ theorem exists_strictMono_cutoff_of_residualPointTail b.principalValue_isInfiniteMultiplicativelyPrincipal.isAdditivelyPrincipal).2 · exact ⟨x, hxTail, hθx⟩ _ = b.principalValue.val := htailType - letI : WellFoundedLT finalTail := ⟨hfinalTail.isWF⟩ + letI : WellFoundedLT finalTail := hfinalTail.isWF have htypes : typeLT b.principalValue.val.ToType = typeLT finalTail := by calc typeLT b.principalValue.val.ToType = b.principalValue.val := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/OrdinalValueFinalSegment.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/OrdinalValueFinalSegment.lean index fe129aaf73..408ab39152 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/OrdinalValueFinalSegment.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/OrdinalValueFinalSegment.lean @@ -110,7 +110,7 @@ theorem approachZeroPlusOne_fullSupport_singleton_counterexample : refine ⟨singletonZero_isRelUpperSet_approachZeroPlusOne_support, Set.singleton_nonempty 0, ?_, ?_⟩ · let hsingleton : ({0} : Set ℝ).IsPWO := Set.isPWO_singleton 0 - letI : WellFoundedLT ({0} : Set ℝ) := ⟨hsingleton.isWF⟩ + letI : WellFoundedLT ({0} : Set ℝ) := hsingleton.isWF calc hsingleton.orderType = typeLT ({0} : Set ℝ) := hsingleton.orderType_eq_typeLT_of_orderIso (OrderIso.refl _) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupAlgebra.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupAlgebra.lean index a4a6d7d45d..b02e3096b1 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupAlgebra.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SubgroupAlgebra.lean @@ -47,7 +47,7 @@ def subgroupAlgebraHom (H : AddSubgroup G) : AddMonoidAlgebra K H →ₐ[K] K⟦ @[simp] theorem subgroupAlgebraHom_single (H : AddSubgroup G) (a : H) (b : K) : - subgroupAlgebraHom H (Finsupp.single a b) = single (a : G) b := by + subgroupAlgebraHom H (AddMonoidAlgebra.single a b) = single (a : G) b := by rw [subgroupAlgebraHom, AddMonoidAlgebra.lift_single] ext g simp [subgroupMonomialHom, HahnSeries.coeff_single] @@ -55,7 +55,7 @@ theorem subgroupAlgebraHom_single (H : AddSubgroup G) (a : H) (b : K) : open Classical in /-- The coefficients of a monomial image. -/ private theorem coeff_subgroupAlgebraHom_single (H : AddSubgroup G) (a : H) (b : K) (g : G) : - (subgroupAlgebraHom H (Finsupp.single a b)).coeff g + (subgroupAlgebraHom H (AddMonoidAlgebra.single a b)).coeff g = if hg : g ∈ H then (Finsupp.single a b : H →₀ K) ⟨g, hg⟩ else 0 := by rw [subgroupAlgebraHom_single, HahnSeries.coeff_single] by_cases hg : g ∈ H @@ -70,17 +70,17 @@ private theorem coeff_subgroupAlgebraHom_single (H : AddSubgroup G) (a : H) (b : open Classical in /-- The coefficients of the image are the coefficients of the group-ring element. -/ theorem coeff_subgroupAlgebraHom (H : AddSubgroup G) (f : AddMonoidAlgebra K H) (g : G) : - (subgroupAlgebraHom H f).coeff g = if hg : g ∈ H then f ⟨g, hg⟩ else 0 := by + (subgroupAlgebraHom H f).coeff g = if hg : g ∈ H then f.coeff ⟨g, hg⟩ else 0 := by induction f using AddMonoidAlgebra.induction_on with - | hM m => + | of m => have hof : (AddMonoidAlgebra.of K H (Multiplicative.ofAdd m) : AddMonoidAlgebra K H) - = Finsupp.single m 1 := rfl + = AddMonoidAlgebra.single m 1 := rfl rw [hof] exact coeff_subgroupAlgebraHom_single H m 1 g - | hadd x y hx hy => + | add x y hx hy => rw [map_add, HahnSeries.coeff_add, hx, hy] by_cases hg : g ∈ H <;> simp [hg] - | hsmul r x hx => + | smul r x hx => rw [map_smul, HahnSeries.coeff_smul, hx] by_cases hg : g ∈ H <;> simp [hg] @@ -106,7 +106,7 @@ theorem support_subgroupAlgebraHom_subset (H : AddSubgroup G) (f : AddMonoidAlge open Classical in theorem support_subgroupAlgebraHom_finite (H : AddSubgroup G) (f : AddMonoidAlgebra K H) : (subgroupAlgebraHom H f).support.Finite := by - refine Set.Finite.subset ((f.support : Finset H).finite_toSet.image ((↑) : H → G)) ?_ + refine Set.Finite.subset ((f.coeff.support : Finset H).finite_toSet.image ((↑) : H → G)) ?_ intro g hg rw [HahnSeries.mem_support, coeff_subgroupAlgebraHom] at hg by_cases hgH : g ∈ H @@ -125,11 +125,12 @@ theorem exists_subgroupAlgebraHom_eq (fun a ha ↦ hfin.mem_toFinset.mpr ha) with hxf have hinj : Set.InjOn ((↑) : H → G) (((↑) : H → G) ⁻¹' xf.support) := fun a _ b _ hab ↦ Subtype.ext hab - refine ⟨Finsupp.comapDomain ((↑) : H → G) xf hinj, ?_⟩ + refine ⟨AddMonoidAlgebra.ofCoeff (Finsupp.comapDomain ((↑) : H → G) xf hinj), ?_⟩ ext g rw [coeff_subgroupAlgebraHom] by_cases hgH : g ∈ H - · rw [dite_eq_left hgH, Finsupp.comapDomain_apply, hxf, Finsupp.onFinset_apply] + · rw [dite_eq_left hgH, AddMonoidAlgebra.coeff_ofCoeff, Finsupp.comapDomain_apply, + hxf, Finsupp.onFinset_apply] · rw [dite_eq_right hgH] by_contra hne exact hgH (hsub ((HahnSeries.mem_support _ _).mpr (Ne.symm hne))) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Truncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Truncation.lean index d03e063269..c9e1c8d2ad 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Truncation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Truncation.lean @@ -181,43 +181,47 @@ def oneAddOmegaSplitSeries : ℚ⟦Unit ⊕ₗ ℕ⟧ where /-- The singleton first part of `oneAddOmegaSplitSeries`. -/ def oneAddOmegaLower : ℚ⟦Unit ⊕ₗ ℕ⟧ := - HahnSeries.filter (fun x ↦ x.isLeft) oneAddOmegaSplitSeries + HahnSeries.filter (fun x ↦ (ofLex x).isLeft) oneAddOmegaSplitSeries /-- The `ℕ`-indexed second part of `oneAddOmegaSplitSeries`. -/ def oneAddOmegaUpper : ℚ⟦Unit ⊕ₗ ℕ⟧ := - HahnSeries.filter (fun x ↦ x.isRight) oneAddOmegaSplitSeries + HahnSeries.filter (fun x ↦ (ofLex x).isRight) oneAddOmegaSplitSeries private theorem oneAddOmegaLower_support : oneAddOmegaLower.support = Set.range Sum.inlₗ := by rw [oneAddOmegaLower, HahnSeries.support_filter] ext x - rcases x with x | x - · constructor - · intro _ - exact ⟨x, rfl⟩ - · intro _ - simp [oneAddOmegaSplitSeries] - · constructor - · intro h - simp at h - · rintro ⟨y, h⟩ - have hlt : Sum.inlₗ y < Sum.inrₗ x := Sum.Lex.inl_lt_inr y x - exact (hlt.ne h).elim + induction x using Lex.rec with + | h x => + rcases x with x | x + · constructor + · intro _ + exact ⟨x, rfl⟩ + · intro _ + simp [oneAddOmegaSplitSeries] + · constructor + · intro h + simp at h + · rintro ⟨y, h⟩ + have hlt : Sum.inlₗ y < Sum.inrₗ x := Sum.Lex.inl_lt_inr y x + exact (hlt.ne h).elim private theorem oneAddOmegaUpper_support : oneAddOmegaUpper.support = Set.range Sum.inrₗ := by rw [oneAddOmegaUpper, HahnSeries.support_filter] ext x - rcases x with x | x - · constructor - · intro h - simp at h - · rintro ⟨y, h⟩ - have hlt : Sum.inlₗ x < Sum.inrₗ y := Sum.Lex.inl_lt_inr x y - exact (hlt.ne h.symm).elim - · constructor - · intro _ - exact ⟨x, rfl⟩ - · intro _ - simp [oneAddOmegaSplitSeries] + induction x using Lex.rec with + | h x => + rcases x with x | x + · constructor + · intro h + simp at h + · rintro ⟨y, h⟩ + have hlt : Sum.inlₗ x < Sum.inrₗ y := Sum.Lex.inl_lt_inr x y + exact (hlt.ne h.symm).elim + · constructor + · intro _ + exact ⟨x, rfl⟩ + · intro _ + simp [oneAddOmegaSplitSeries] private theorem oneAddOmegaLower_supportOrderType : oneAddOmegaLower.supportOrderType = 1 := by rw [HahnSeries.supportOrderType_eq_setOrderType] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/WeakNormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/WeakNormalForm.lean index a202ba5d97..d758bb865a 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/WeakNormalForm.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/WeakNormalForm.lean @@ -69,41 +69,45 @@ def twoOmegaSeries : ℚ⟦ℕ ⊕ₗ ℕ⟧ where /-- The first `ℕ`-indexed component of `twoOmegaSeries`. -/ def twoOmegaLower : ℚ⟦ℕ ⊕ₗ ℕ⟧ := - HahnSeries.filter (fun x ↦ x.isLeft) twoOmegaSeries + HahnSeries.filter (fun x ↦ (ofLex x).isLeft) twoOmegaSeries /-- The second `ℕ`-indexed component of `twoOmegaSeries`. -/ def twoOmegaUpper : ℚ⟦ℕ ⊕ₗ ℕ⟧ := - HahnSeries.filter (fun x ↦ x.isRight) twoOmegaSeries + HahnSeries.filter (fun x ↦ (ofLex x).isRight) twoOmegaSeries private theorem twoOmegaLower_support : twoOmegaLower.support = Set.range Sum.inlₗ := by rw [twoOmegaLower, HahnSeries.support_filter] ext x - rcases x with x | x - · constructor - · intro _ - exact ⟨x, rfl⟩ - · intro _ - simp [twoOmegaSeries] - · constructor - · intro h - simp at h - · rintro ⟨y, h⟩ - exact ((Sum.Lex.inl_lt_inr y x).ne h).elim + induction x using Lex.rec with + | h x => + rcases x with x | x + · constructor + · intro _ + exact ⟨x, rfl⟩ + · intro _ + simp [twoOmegaSeries] + · constructor + · intro h + simp at h + · rintro ⟨y, h⟩ + exact ((Sum.Lex.inl_lt_inr y x).ne h).elim private theorem twoOmegaUpper_support : twoOmegaUpper.support = Set.range Sum.inrₗ := by rw [twoOmegaUpper, HahnSeries.support_filter] ext x - rcases x with x | x - · constructor - · intro h - simp at h - · rintro ⟨y, h⟩ - exact ((Sum.Lex.inl_lt_inr x y).ne h.symm).elim - · constructor - · intro _ - exact ⟨x, rfl⟩ - · intro _ - simp [twoOmegaSeries] + induction x using Lex.rec with + | h x => + rcases x with x | x + · constructor + · intro h + simp at h + · rintro ⟨y, h⟩ + exact ((Sum.Lex.inl_lt_inr x y).ne h.symm).elim + · constructor + · intro _ + exact ⟨x, rfl⟩ + · intro _ + simp [twoOmegaSeries] private theorem twoOmegaLower_supportOrderType : twoOmegaLower.supportOrderType = Ordinal.omega0 := by @@ -134,7 +138,9 @@ private theorem twoOmega_supportBelow : private theorem twoOmegaLower_add_upper : twoOmegaLower + twoOmegaUpper = twoOmegaSeries := by ext x - rcases x with x | x <;> simp [twoOmegaLower, twoOmegaUpper, twoOmegaSeries] + induction x using Lex.rec with + | h x => + cases x <;> simp [twoOmegaLower, twoOmegaUpper, twoOmegaSeries] private theorem twoOmegaLower_isWeaklyPrincipal : HahnSeries.IsWeaklyPrincipal twoOmegaLower := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Translation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Translation.lean index a0beace824..873ae8b4f5 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Translation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Translation.lean @@ -72,7 +72,7 @@ variable [LinearOrder G] [LinearOrder H] [AddMonoid R] theorem supportOrderType_embDomainAddEquiv (e : G ≃o H) (x : R⟦G⟧) : (embDomainAddEquiv e x).supportOrderType = x.supportOrderType := by rw [supportOrderType_eq_setOrderType, supportOrderType_eq_setOrderType] - letI : WellFoundedLT x.support := ⟨x.isWF_support⟩ + letI : WellFoundedLT x.support := x.isWF_support let supportEquiv : (embDomainAddEquiv e x).support ≃o x.support := (OrderIso.setCongr _ (e '' x.support) (support_embDomain e.toOrderEmbedding x)).trans (StrictMonoOn.orderIso e x.support (e.strictMono.strictMonoOn x.support)).symm diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorBendixson.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorBendixson.lean index 5f4ec98d1c..38e17da50b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorBendixson.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorBendixson.lean @@ -11,6 +11,7 @@ public import Mathlib.SetTheory.Ordinal.Exponential public import Mathlib.SetTheory.Ordinal.Topology import Mathlib.Topology.Maps.Basic +import Mathlib.Topology.Order.IsNormal /-! # Cantor–Bendixson derivatives of ordinals diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/OrderedUnion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/OrderedUnion.lean index 4b5927f088..3bd7351604 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/OrderedUnion.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/OrderedUnion.lean @@ -118,7 +118,7 @@ theorem mul_le_orderType_iUnion_of_isSuccLimit have block_embedding_exists (i : successorRange l) : Nonempty (ρ.ToType ↪o separatedBlock B i.1) := by let hblock := block_isPWO i - letI : WellFoundedLT (separatedBlock B i.1) := ⟨hblock.isWF⟩ + letI : WellFoundedLT (separatedBlock B i.1) := hblock.isWF have hle : typeLT ρ.ToType ≤ typeLT (separatedBlock B i.1) := by calc typeLT ρ.ToType = ρ := type_toType ρ @@ -154,7 +154,7 @@ theorem mul_le_orderType_iUnion_of_isSuccLimit change type (Prod.Lex (· < · : successorRange l → successorRange l → Prop) (· < · : ρ.ToType → ρ.ToType → Prop)) = ρ * l rw [type_prod_lex, type_toType, successorRange_orderType l hl] - letI : WellFoundedLT (⋃ i, B i) := ⟨hUnion.isWF⟩ + letI : WellFoundedLT (⋃ i, B i) := hUnion.isWF calc ρ * l = typeLT (successorRange l ×ₗ ρ.ToType) := hdomain.symm _ ≤ typeLT (⋃ i, B i) := unionEmbedding.ltEmbedding.ordinal_type_le diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/InlineConwayRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/InlineConwayRefinement.lean index 5c87a50049..df0bf24745 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/InlineConwayRefinement.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/InlineConwayRefinement.lean @@ -1,5 +1,10 @@ /- Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. Copyright (c) 2025 Aaron Liu. All rights reserved. Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. Copyright (c) 2025 Yuyang Zhao. All rights reserved. diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean index 80e74801f1..eac8a11e39 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean @@ -1,5 +1,10 @@ /- Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. Copyright (c) 2025 Aaron Liu. All rights reserved. Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. Copyright (c) 2025 Yuyang Zhao. All rights reserved. @@ -304,7 +309,13 @@ noncomputable instance : QPF GameFunctor where abs x := ⟨fun p ↦ Set.range (x.2 ∘ .mk p ∘ PLift.up), fun _ ↦ by infer_instance⟩ repr x := ⟨fun p ↦ Shrink (x.1 p), Sigma.rec (fun _ y ↦ ((equivShrink _).symm y.1).1)⟩ abs_repr x := by ext; simp [← (equivShrink _).exists_congr_right] - abs_map f := by intro ⟨x, f⟩; ext; simp [PFunctor.map, map_def] + abs_map f := by + intro ⟨x, g⟩ + apply Subtype.ext + funext p + change Set.range (f ∘ g ∘ Sigma.mk p ∘ PLift.up) = + f '' Set.range (g ∘ Sigma.mk p ∘ PLift.up) + exact Set.range_comp f _ end GameFunctor @@ -332,7 +343,9 @@ private theorem small_level (x : α) : ∀ n, Small.{u_inline_2} (level r x n) refine @small_sUnion _ _ ?_ ?_ · have := small_level x n exact small_image .. - · simp_all + · intro ⟨a, ha⟩ + obtain ⟨b, _, rfl⟩ := ha + exact H b private theorem small_sUnion_level (x : α) : Small.{u_inline_2} (⋃₀ range (level r x)) := by refine @small_sUnion _ _ ?_ ?_ @@ -493,7 +506,8 @@ instance (p : Player) (x : IGame.{u_inline_4}) : Small.{u_inline_4} (x.moves p) theorem moves_ofSets (p) (st : Player → Set IGame) [Small.{u_inline_4} (st left)] [Small.{u_inline_4} (st right)] : !{st}.moves p = st p := by - dsimp [ofSets]; ext; rw [moves, QPF.Fix.dest_mk] + exact congrArg (fun s : GameFunctor IGame => s.val p) + (QPF.Fix.dest_mk ⟨st, by rintro (_ | _) <;> assumption⟩) @[simp] theorem ofSets_moves (x : IGame) : !{x.moves} = x := x.mk_dest @@ -559,21 +573,24 @@ instance small_subtype_subposition (x : IGame.{u_inline_4}) : small_transGen' _ x theorem subposition_wf : WellFounded Subposition := by + change WellFounded (Relation.TransGen fun (x y : QPF.Fix GameFunctor) => + x ∈ ⋃ p, (QPF.Fix.dest y).val p) refine ⟨fun x => Acc.transGen ?_⟩ apply QPF.Fix.ind - unfold moves rintro _ ⟨⟨st, hst⟩, rfl⟩ constructor rintro y hy - rw [QPF.Fix.dest_mk, mem_iUnion] at hy - obtain ⟨_, ⟨_, h⟩, _, rfl⟩ := hy - exact h + rw [QPF.Fix.dest_mk] at hy + change y ∈ ⋃ p, Subtype.val '' st p at hy + obtain ⟨p, hp⟩ := Set.mem_iUnion.mp hy + obtain ⟨z, _, rfl⟩ := hp + exact z.property -- We make no use of `IGame`'s definition from a `QPF` after this point. attribute [irreducible] IGame -instance : WellFounded _ Subposition := ⟨subposition_wf⟩ -instance : WellFoundedRelation IGame := ⟨Subposition, instIsWellFoundedSubposition.wf⟩ +instance : WellFounded Subposition := subposition_wf +instance : WellFoundedRelation IGame := ⟨Subposition, subposition_wf⟩ theorem Subposition.irrefl (x : IGame) : ¬Subposition x x := _root_.irrefl x @@ -1384,7 +1401,13 @@ private def mul' (x y : IGame) : IGame := (range fun a : (xᴸ ×ˢ yᴿ ∪ xᴿ ×ˢ yᴸ :) ↦ mul' a.1.1 y + mul' x a.1.2 - mul' a.1.1 a.1.2)} termination_by (x, y) -decreasing_by all_goals aesop +decreasing_by + all_goals + rcases a.property with h | h + all_goals + first + | exact Prod.Lex.left _ _ (Subposition.of_mem_moves h.1) + | exact Prod.Lex.right _ (Subposition.of_mem_moves h.2) #adaptation_note /-- noncomputable is now needed -/ in /-- The product of `x = !{s₁ | t₁}` and `y = !{s₂ | t₂}` is @@ -2526,7 +2549,7 @@ def ArgsRel := lemma argsRel_wf : WellFounded ArgsRel := InvImage.wf _ (Subrelation.wf (fun h => h.elim fun _ => Subposition.of_mem_moves) subposition_wf).cutExpand.transGen -instance : WellFounded _ ArgsRel := ⟨argsRel_wf⟩ +instance : WellFounded ArgsRel := argsRel_wf /-- The property that all arguments are numeric is leftward-closed under `ArgsRel`. -/ lemma ArgsRel.numeric_closed {a' a} : ArgsRel a' a → a.Numeric → a'.Numeric := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/NormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/NormalForm.lean index ebf63f40b6..d451f0cbb9 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/NormalForm.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/NormalForm.lean @@ -1,5 +1,10 @@ /- Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. Copyright (c) 2026 Violeta Hernández Palacios. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov, Violeta Hernández Palacios diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ClosedPWO.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ClosedPWO.lean index ae570f8415..2374d59fbd 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ClosedPWO.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ClosedPWO.lean @@ -301,7 +301,7 @@ private theorem strictClosure_orderType_le_two_mul (hs : s.IsPWO) (hz : IsLUB s inter_subset_left).orderType) ≤ 2 * hs.orderType := by let ht := hs.closure.mono (s := strictClosure (s := s) (z := z)) inter_subset_left - letI : WellFoundedLT (strictClosure (s := s) (z := z)) := ⟨ht.isWF⟩ + letI : WellFoundedLT (strictClosure (s := s) (z := z)) := ht.isWF letI : WellFoundedLT s := hs.isWF let e : strictClosure (s := s) (z := z) ↪o s ×ₗ Fin 2 := OrderEmbedding.ofStrictMono (closureEmbedding hs hz) @@ -394,7 +394,7 @@ theorem IsPWO.cantorBendixsonRank_closure_eq_of_orderType_eq_opow let S : TopologicalSpace.Closeds ℝ := ⟨(_root_.closure s), isClosed_closure⟩ let C : Set ℝ := _root_.closure s let hc : C.IsPWO := hs.closure - letI : WellFoundedLT C := ⟨hc.isWF⟩ + letI : WellFoundedLT C := hc.isWF let T : Ordinal := Ordinal.type (· < · : C → C → Prop) let i : Iio T := ⟨Ordinal.typein (· < · : C → C → Prop) ⟨z, hzc⟩, diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SmallClosedSubspace.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SmallClosedSubspace.lean index 5688f4729f..11586063ea 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SmallClosedSubspace.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SmallClosedSubspace.lean @@ -14,6 +14,8 @@ public import Mathlib.SetTheory.Cardinal.Rat public import Mathlib.Topology.Algebra.Module.Basic import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +import Mathlib.Tactic.NormNum.Inv +import Mathlib.Tactic.NormNum.Ineq /-! # Supports in closed rational subspaces From 701bd501b314bffd740646723a88ed7d878a53b9 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 23:46:54 +0000 Subject: [PATCH 05/18] Repair Conway graded coefficients and principal tensor representations --- .../CombinatorialGames/Surreal/Real.lean | 12 ++++- .../Algebra/GradedRing/OrdinalGenerators.lean | 15 +++--- .../LoweringDerivation/FilteredModule.lean | 12 ++--- .../CardinalTruncationDomainEmbedding.lean | 2 +- .../HahnSeries/FactorCoefficients.lean | 2 +- .../Factorization/DegreeTwo/DegreeTwo.lean | 1 - .../FiniteSupportNormalizedGCD.lean | 5 +- .../FiniteSupportScalarExtension.lean | 6 +-- .../PrincipalComponentTensor.lean | 48 ++++++------------- .../HahnSeries/RealSupportSupremum.lean | 16 +++---- .../HahnSeries/Tests/FiniteSupportGCD.lean | 2 +- 11 files changed, 54 insertions(+), 67 deletions(-) diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Real.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Real.lean index 95f0a872b8..a237adcbe7 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Real.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Real.lean @@ -32,8 +32,16 @@ theorem exists_dyadic_btwn {K : Type*} [Field K] [LinearOrder K] [IsStrictOrdere obtain ⟨n, nh⟩ := exists_nat_gt (y - x)⁻¹ have := nh.trans (Nat.cast_lt.2 Nat.lt_two_pow_self) obtain ⟨z, hz, hz'⟩ := exists_div_btwn h (nh.trans (Nat.cast_lt.2 Nat.lt_two_pow_self)) - use .mkRat z ⟨n, rfl⟩ - simp_all [Rat.mkRat_eq_div] + have hnPower : 2 ^ n ∈ Submonoid.powers (2 : ℕ) := + Submonoid.pow_mem _ (Submonoid.mem_powers _) _ + have hcast : ((Dyadic.mkRat z (n := 2 ^ n) hnPower).toRat : K) = + (z : K) / (2 ^ n : ℕ) := by + rw [Dyadic.coe_mkRat] + simp only [Rat.mkRat_eq_div, Rat.cast_div, Rat.cast_intCast, + Rat.cast_pow, Rat.cast_ofNat, Nat.cast_pow, Nat.cast_ofNat] + refine ⟨.mkRat z (n := 2 ^ n) hnPower, ?_⟩ + rw [hcast] + exact ⟨hz, hz'⟩ namespace Real diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/OrdinalGenerators.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/OrdinalGenerators.lean index 72bfb46933..c65e3d0ba2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/OrdinalGenerators.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/OrdinalGenerators.lean @@ -119,8 +119,11 @@ theorem decompose_aeval (hmem : ∀ i, x i ∈ 𝒜 (wt i)) (F : MvPolynomial ι DirectSum.sum_apply, Submodule.coe_sum] rw [Finset.sum_eq_single β (fun m _ hne ↦ DirectSum.decompose_of_mem_ne 𝒜 (hmem' m) hne) fun hn ↦ ?_, DirectSum.decompose_of_mem_same 𝒜 (hmem' β)] - rw [Set.Finite.mem_toFinset, Function.mem_support, not_not] at hn - rw [hn, map_zero, DirectSum.decompose_zero, DirectSum.zero_apply, Submodule.coe_zero] + have hz : weightedHomogeneousComponent wt β F = 0 := by + apply not_not.mp + intro hz + exact hn ((weightedHomogeneousComponent_finsupp F).mem_toFinset.mpr hz) + rw [hz, map_zero, DirectSum.decompose_zero, DirectSum.zero_apply, Submodule.coe_zero] /-- A linear combination of the generators is the evaluation of the same combination of the variables. -/ @@ -313,7 +316,7 @@ end IsMinimalSystem omit [GradedAlgebra 𝒜] in /-- For degrees `wt i ≠ 0`, a polynomial homogeneous of degree zero is a constant. -/ theorem eq_C_of_isWeightedHomogeneous_zero (hwt : ∀ i, wt i ≠ 0) {p : MvPolynomial ι E} - (hp : IsWeightedHomogeneous wt p 0) : p = C (coeff 0 p) := by + (hp : IsWeightedHomogeneous wt p 0) : p = C (p.coeff 0) := by classical ext m rw [coeff_C] @@ -416,7 +419,7 @@ theorem exists_linear_part (hwt : ∀ i, wt i ≠ 0) (hmem : ∀ i, x i ∈ 𝒜 {F : MvPolynomial ι E} {β : NatOrdinal.{o}} (hβ : β ≠ 0) (hF : IsWeightedHomogeneous wt F β) : ∃ c : ι →₀ E, (∀ i ∈ c.support, wt i = β) ∧ aeval x F - Finsupp.linearCombination E x c ∈ decomposableAt 𝒜 β ∧ - ∀ i, c i = coeff (Finsupp.single i 1) F := by + ∀ i, c i = F.coeff (Finsupp.single i 1) := by classical induction hF using IsWeightedHomogeneous.induction_on with | zero => exact ⟨0, by simp, by simp, fun i ↦ by simp⟩ @@ -424,7 +427,7 @@ theorem exists_linear_part (hwt : ∀ i, wt i ≠ 0) (hmem : ∀ i, x i ∈ 𝒜 obtain ⟨c, hcw, hc, hcoeff⟩ := ihp obtain ⟨c', hcw', hc', hcoeff'⟩ := ihq refine ⟨c + c', fun i hi ↦ ?_, ?_, fun i ↦ by - rw [Finsupp.add_apply, hcoeff, hcoeff', coeff_add]⟩ + rw [Finsupp.add_apply, hcoeff, hcoeff', AddMonoidAlgebra.coeff_add, Finsupp.add_apply]⟩ · rcases Finset.mem_union.mp (Finsupp.support_add hi) with h | h · exact hcw i h · exact hcw' i h @@ -535,7 +538,7 @@ a combination of the generators of degree `β` lying in `(A_+)² ∩ A_β`. -/ theorem coeff_single_eq_zero_of_aeval_eq_zero {F : MvPolynomial ι E} {β : NatOrdinal.{o}} (hβ : β ≠ 0) (hF : IsWeightedHomogeneous wt F β) (h0 : aeval x F = 0) (i : ι) : - coeff (Finsupp.single i 1) F = 0 := by + F.coeff (Finsupp.single i 1) = 0 := by obtain ⟨c, hcw, hc, hcoeff⟩ := exists_linear_part hx.ne_zero hx.mem hβ hF rw [h0, zero_sub, neg_mem_iff] at hc have := hx.independent β c hcw hc diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/FilteredModule.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/FilteredModule.lean index 2f587444be..43ca54becd 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/FilteredModule.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/FilteredModule.lean @@ -316,8 +316,7 @@ theorem gradeSectionMul_tmul (s : Fibre 𝒜 →ₗ[E] R) (j : ℕ) (a : 𝒜 (j theorem muOfSection_rTensor_natInclusion (s : Fibre 𝒜 →ₗ[E] R) (j : ℕ) (T : 𝒜 (j : NatOrdinal) ⊗[E] Fibre 𝒜) : muOfSection 𝒜 s ((natInclusion 𝒜 j).rTensor _ T) = gradeSectionMul 𝒜 s j T := by - induction T with - | zero => rw [map_zero, map_zero, map_zero] + induction T using TensorProduct.inductionOn with | tmul a c => rw [LinearMap.rTensor_tmul, muOfSection_tmul, gradeSectionMul_tmul, coe_natInclusion] | add x y hx hy => rw [map_add, map_add, hx, hy, map_add] @@ -325,8 +324,7 @@ theorem muOfSection_rTensor_natInclusion (s : Fibre 𝒜 →ₗ[E] R) (j : ℕ) omit [GradedAlgebra 𝒜] in theorem gradeSectionMul_mem_idealGE (s : Fibre 𝒜 →ₗ[E] R) (j : ℕ) (T : 𝒜 (j : NatOrdinal) ⊗[E] Fibre 𝒜) : gradeSectionMul 𝒜 s j T ∈ idealGE 𝒜 j := by - induction T with - | zero => rw [map_zero]; exact zero_mem _ + induction T using TensorProduct.inductionOn with | tmul a c => rw [gradeSectionMul_tmul] exact Ideal.mul_mem_right _ _ (mem_idealGE_of_mem 𝒜 le_rfl a.2) @@ -338,8 +336,7 @@ theorem mk_gradeSectionMul {s : Fibre 𝒜 →ₗ[E] R} (hs : IsGradedFibreSecti (T : 𝒜 (j : NatOrdinal) ⊗[E] Fibre 𝒜) : (Submodule.Quotient.mk (gradeSectionMul 𝒜 s j T) : R ⧸ idealGE 𝒜 (j + 1)) = mu 𝒜 j T := by - induction T with - | zero => rw [map_zero, map_zero, Submodule.Quotient.mk_zero] + induction T using TensorProduct.inductionOn with | tmul a c => rw [gradeSectionMul_tmul, ← hs.fibreMap_apply c, mu_tmul, hs.fibreMap_apply] | add x y hx hy => rw [map_add, map_add, Submodule.Quotient.mk_add, hx, hy] @@ -348,8 +345,7 @@ theorem mk_gradeSectionMul {s : Fibre 𝒜 →ₗ[E] R} (hs : IsGradedFibreSecti theorem gradeSectionMul_lTensor_mem {s : Fibre 𝒜 →ₗ[E] R} (hs : IsGradedFibreSection 𝒜 s) (j : ℕ) (β : NatOrdinal) (T : 𝒜 (j : NatOrdinal) ⊗[E] fibreGrade 𝒜 β) : gradeSectionMul 𝒜 s j ((fibreGrade 𝒜 β).subtype.lTensor _ T) ∈ 𝒜 ((j : NatOrdinal) + β) := by - induction T with - | zero => rw [map_zero, map_zero]; exact zero_mem _ + induction T using TensorProduct.inductionOn with | tmul a c => rw [LinearMap.lTensor_tmul, gradeSectionMul_tmul, Submodule.subtype_apply] exact SetLike.mul_mem_graded a.2 (hs.mem c.2) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEmbedding.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEmbedding.lean index 3c2b0acf57..e658d3aca3 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEmbedding.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEmbedding.lean @@ -163,7 +163,7 @@ theorem CardSuppLTTruncationIntegerPart.coeff_zero_convexQuotientSplitRingEquiv (cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z x).2).2⟩ : cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) = CardSuppLTTruncationIntegerPart.restrictDomain - P.toAddSubgroup.subtype Subtype.val_injective (fun _ _ ↦ Iff.rfl) Z x := by + P.toAddSubgroup.subtype P.toAddSubgroup.subtype_injective (fun _ _ ↦ ⟨fun h ↦ h, fun h ↦ h⟩) Z x := by apply Subtype.ext apply Subtype.ext rw [coe_restrictDomain] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FactorCoefficients.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FactorCoefficients.lean index e68bce6e20..57ad0e6174 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FactorCoefficients.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FactorCoefficients.lean @@ -85,7 +85,7 @@ theorem exists_scalar_of_hahn_mul_eq_map (HahnSeries.exists_addEquiv_fin S) hclosed hp₁0 hq₁0 hrel₁ refine ⟨c, hc, fun x ↦ ?_⟩ by_cases hx : x ∈ H - · have : p.coeff x = p₁ ⟨x, hx⟩ := by + · have : p.coeff x = p₁.coeff ⟨x, hx⟩ := by rw [← hp₁, HahnSeries.coeff_subgroupAlgebraHom, dite_eq_left hx] rw [this] exact hcoeff _ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwo.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwo.lean index 0bbc39720a..ce4dd821c6 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwo.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwo.lean @@ -252,7 +252,6 @@ theorem ordinalValue_eq_wpow_two rw [translatedTruncation_zero] at hordinary rw [NatOrdinal.of_omega0_opow] at hordinary convert hordinary using 1 - congr 1 have hdegree : (a : K⟦ℝ⟧).degree = (2 : WithBot NatOrdinal) := degree_eq_two haNear haType have hvalueDegreeGe : (2 : WithBot NatOrdinal) ≤ ordinalValueDegree a := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalizedGCD.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalizedGCD.lean index 6a68953f4a..7f7862344d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalizedGCD.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalizedGCD.lean @@ -70,8 +70,9 @@ private noncomputable def normalizedAssociateRepresentativeMonoidHom : private noncomputable def finiteSupportNormalizationMonoid : NormalizationMonoid (finiteSupportSubring (G := G) (K := K)) := by classical - exact normalizationMonoidOfMonoidHomRightInverse normalizedAssociateRepresentativeMonoidHom - normalizedAssociateRepresentative_mk + exact (strongNormalizationMonoidOfMonoidHomRightInverse + (α := finiteSupportSubring (G := G) (K := K)) + normalizedAssociateRepresentativeMonoidHom normalizedAssociateRepresentative_mk).toNormalizationMonoid /-- The nonpositive finite-support Hahn-series ring over a field is a normalized GCD domain. -/ theorem nonemptyNormalizedGCDMonoid_finiteSupport : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportScalarExtension.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportScalarExtension.lean index 8466ef34a6..ca4715c1ea 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportScalarExtension.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportScalarExtension.lean @@ -71,9 +71,9 @@ theorem finiteSupportMap_coeff (f : K →+* L) _ = f (finiteSupportCoefficients b g) := by rw [finiteSupportAddMonoidAlgebraEquiv_map] change - AddMonoidAlgebra.mapRingHom (exponentMonoid G) f - (finiteSupportAddMonoidAlgebraEquiv b) g = _ - rw [AddMonoidAlgebra.mapRingHom_apply] + (AddMonoidAlgebra.mapRingHom (exponentMonoid G) f + (finiteSupportAddMonoidAlgebraEquiv b)).coeff g = _ + rw [AddMonoidAlgebra.coeff_mapRingHom] exact congrArg f (congrArg (fun q : exponentMonoid G →₀ K ↦ q g) (coeff_finiteSupportAddMonoidAlgebraEquiv (G := G) (K := K) b)) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentTensor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentTensor.lean index 1592a84127..18c512636d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentTensor.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentTensor.lean @@ -40,12 +40,11 @@ namespace Berarducci public noncomputable section -variable {K : Type v} [Field K] [CharZero K] +variable {K : Type v} [Field K] abbrev FiniteSupportRing := HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K) -omit [CharZero K] in private theorem coe_translatedTruncation_translate (p : Series K) (h g : ℝ) : ((translatedTruncation (HahnSeries.translate h (p : K⟦ℝ⟧)) g : Series K) : K⟦ℝ⟧) = @@ -90,7 +89,6 @@ private def degreeLayerTruncationAtRepresentative (alpha : NatOrdinal) (g : ℝ) exact translatedTruncation_add ((b : Series K) : K⟦ℝ⟧) ((c : Series K) : K⟦ℝ⟧) g -omit [CharZero K] in variable (K) in private theorem degreeLayerTruncationAt_lower_le_ker (alpha : NatOrdinal) (g : ℝ) : (HahnSeries.Nonpositive.degreeValuation K).lowerFiltration alpha ≤ @@ -118,7 +116,6 @@ private def degreeLayerTruncationAt (alpha : NatOrdinal) (g : ℝ) : (degreeLayerTruncationAtRepresentative K alpha g) (degreeLayerTruncationAt_lower_le_ker K alpha g) -omit [CharZero K] in /-- On the degree-`α` homogeneous class of `b`, the map is the class of `b^{|γ}` in `P_α`. -/ private theorem degreeLayerTruncationAt_mk (alpha : NatOrdinal) (g : ℝ) (b : Series K) (hb : (b : K⟦ℝ⟧).degree ≤ @@ -135,7 +132,6 @@ private theorem degreeLayerTruncationAt_mk (alpha : NatOrdinal) (g : ℝ) rw [principalComponentMk_eq_componentMk] rfl -omit [CharZero K] in /-- The finite-support residue equivalence sends a constant series to its canonical degree-zero homogeneous class. -/ theorem degreeFiniteSupportResidueEquiv_scalar (k : K) : @@ -154,7 +150,6 @@ theorem degreeFiniteSupportResidueEquiv_scalar (k : K) : exact (HahnSeries.Nonpositive.coe_finiteSupportScalarHom (G := ℝ) (K := K) k).trans (HahnSeries.Nonpositive.coe_C k).symm -omit [CharZero K] in /-- Successive scalar actions by degree-zero residue classes agree with multiplication in the residue ring. -/ theorem degreeResidue_smul_smul (alpha : NatOrdinal) @@ -167,7 +162,6 @@ theorem degreeResidue_smul_smul (alpha : NatOrdinal) DirectSum.of_zero_smul, DirectSum.of_zero_mul] rw [mul_assoc] -omit [CharZero K] in /-- The unit residue class acts identically on every degree component. -/ theorem degreeResidue_one_smul (alpha : NatOrdinal) (x : (HahnSeries.Nonpositive.degreeValuation K).Component alpha) : @@ -177,7 +171,6 @@ theorem degreeResidue_one_smul (alpha : NatOrdinal) apply DirectSum.of_injective (β := w.Component) alpha rw [DirectSum.of_zero_smul, DirectSum.of_zero_one, one_mul] -omit [CharZero K] in private theorem residue_smul_comm (alpha : NatOrdinal) (a b : (HahnSeries.Nonpositive.degreeValuation K).ResidueRing) (x : (HahnSeries.Nonpositive.degreeValuation K).Component alpha) : @@ -185,7 +178,6 @@ private theorem residue_smul_comm (alpha : NatOrdinal) rw [← degreeResidue_smul_smul alpha, ← degreeResidue_smul_smul alpha, mul_comm] -omit [CharZero K] in private theorem residueEquiv_eq_degreeLayerMk (p : FiniteSupportRing (K := K)) : HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K p = degreeLayerMk 0 (p : Series K) (by @@ -208,7 +200,7 @@ theorem degreeFiniteSupportResidueEquiv_smul_degreeLayerMk (alpha : NatOrdinal) HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K p • degreeLayerMk alpha b hb = degreeLayerMk alpha ((p : Series K) * b) (by - rw [HahnSeries.Nonpositive.degree_mul] + apply (HahnSeries.degree_mul_le _ _).trans exact (add_le_add (by simpa using (HahnSeries.degree_le_zero_iff.mpr ((HahnSeries.Nonpositive.mem_finiteSupportSubring_iff @@ -226,7 +218,6 @@ theorem degreeFiniteSupportResidueEquiv_smul_degreeLayerMk (alpha : NatOrdinal) rw [degreeLayerMk_eq_componentMk, degreeLayerMk_eq_componentMk] exact w.componentMk_heq_of_grade_eq_of_coe_eq (zero_add alpha) _ _ rfl -omit [CharZero K] in theorem principalComponentToHahnDegreeLayer_mk (alpha : NatOrdinal) (p : Series K) (hp : HahnSeries.Nonpositive.IsPrincipal p) (hpDegree : (p : K⟦ℝ⟧).degree = (alpha : WithBot NatOrdinal)) @@ -275,7 +266,6 @@ def principalComponentFiniteSupportMul (alpha : NatOrdinal) : rw [degreeLayer_smul_eq_residue_smul] exact degreeResidue_smul_smul alpha _ _ _) -omit [CharZero K] in @[simp] theorem principalComponentFiniteSupportMul_apply (alpha : NatOrdinal) (x : PrincipalComponent K alpha) (p : FiniteSupportRing (K := K)) : @@ -290,7 +280,6 @@ def principalComponentTensorMap (alpha : NatOrdinal) : (HahnSeries.Nonpositive.degreeValuation K).Component alpha := TensorProduct.lift (principalComponentFiniteSupportMul K alpha) -omit [CharZero K] in @[simp] theorem principalComponentTensorMap_tmul (alpha : NatOrdinal) (x : PrincipalComponent K alpha) (p : FiniteSupportRing (K := K)) : @@ -304,14 +293,14 @@ theorem principalComponentTensorMap_principal_monomial (alpha : NatOrdinal) (p : Series K) (hp : HahnSeries.Nonpositive.IsPrincipal p) (hpDegree : (p : K⟦ℝ⟧).degree = (alpha : WithBot NatOrdinal)) (hpBound : ordinalValue p < ω^ (alpha + 1)) - (g : {g : ℝ // g ≤ 0}) : + (g : HahnSeries.Nonpositive.exponentMonoid ℝ) : principalComponentTensorMap K alpha (principalComponentMk alpha p hpBound ⊗ₜ HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g) = degreeLayerMk alpha (((HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g : FiniteSupportRing (K := K)) : Series K) * p) (by - rw [HahnSeries.Nonpositive.degree_mul] + apply (HahnSeries.degree_mul_le _ _).trans exact (add_le_add (by exact HahnSeries.degree_le_zero_iff.mpr ((HahnSeries.Nonpositive.mem_finiteSupportSubring_iff @@ -323,8 +312,7 @@ theorem principalComponentTensorMap_principal_monomial (alpha : NatOrdinal) principalComponentToHahnDegreeLayer_mk alpha p hp hpDegree hpBound] rw [degreeFiniteSupportResidueEquiv_smul_degreeLayerMk] -omit [CharZero K] in -private theorem finiteSupportMonomial_degree (g : {g : ℝ // g ≤ 0}) : +private theorem finiteSupportMonomial_degree (g : HahnSeries.Nonpositive.exponentMonoid ℝ) : ((((HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g : FiniteSupportRing (K := K)) : Series K) : K⟦ℝ⟧).degree) = 0 := by apply HahnSeries.degree_eq_zero.mpr @@ -336,8 +324,7 @@ private theorem finiteSupportMonomial_degree (g : {g : ℝ // g ≤ 0}) : FiniteSupportRing (K := K)) : Series K)).mp (HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g).2 -omit [CharZero K] in -private theorem coe_finiteSupportMonomial_mul (g : {g : ℝ // g ≤ 0}) (p : Series K) : +private theorem coe_finiteSupportMonomial_mul (g : HahnSeries.Nonpositive.exponentMonoid ℝ) (p : Series K) : ((((HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g : FiniteSupportRing (K := K)) : Series K) * p : Series K) : K⟦ℝ⟧) = HahnSeries.translate (g : ℝ) (p : K⟦ℝ⟧) := by @@ -347,28 +334,26 @@ private theorem coe_finiteSupportMonomial_mul (g : {g : ℝ // g ≤ 0}) (p : Se rw [HahnSeries.Nonpositive.coe_finiteSupportMonomial, HahnSeries.single_one_mul_eq_translate] -private def shiftedSeries (g : {g : ℝ // g ≤ 0}) (p : Series K) : Series K := +private def shiftedSeries (g : HahnSeries.Nonpositive.exponentMonoid ℝ) (p : Series K) : Series K := ⟨HahnSeries.translate (g : ℝ) (p : K⟦ℝ⟧), by rw [HahnSeries.mem_nonpositiveSubring, HahnSeries.support_translate] rintro _ ⟨x, hx, rfl⟩ exact add_nonpos g.2 (HahnSeries.Nonpositive.support_subset p hx)⟩ -omit [CharZero K] in @[simp] -private theorem coe_shiftedSeries (g : {g : ℝ // g ≤ 0}) (p : Series K) : +private theorem coe_shiftedSeries (g : HahnSeries.Nonpositive.exponentMonoid ℝ) (p : Series K) : ((shiftedSeries g p : Series K) : K⟦ℝ⟧) = HahnSeries.translate (g : ℝ) (p : K⟦ℝ⟧) := (rfl) -omit [CharZero K] in -private theorem finiteSupportMonomial_mul_eq_shiftedSeries (g : {g : ℝ // g ≤ 0}) (p : Series K) : +private theorem finiteSupportMonomial_mul_eq_shiftedSeries (g : HahnSeries.Nonpositive.exponentMonoid ℝ) (p : Series K) : ((HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g : FiniteSupportRing (K := K)) : Series K) * p = shiftedSeries g p := by apply Subtype.ext exact coe_finiteSupportMonomial_mul g p private abbrev PrincipalMonomialTerm (K : Type v) [Field K] := - Series K × {g : ℝ // g ≤ 0} + Series K × HahnSeries.Nonpositive.exponentMonoid ℝ private def principalMonomialTermSeries (t : PrincipalMonomialTerm K) : Series K := (HahnSeries.Nonpositive.finiteSupportMonomial (K := K) t.2 : @@ -377,8 +362,7 @@ private def principalMonomialTermSeries (t : PrincipalMonomialTerm K) : Series K private theorem principalMonomialTermSeries_degree (t : PrincipalMonomialTerm K) : ((principalMonomialTermSeries t : Series K) : K⟦ℝ⟧).degree = (t.1 : K⟦ℝ⟧).degree := by - rw [principalMonomialTermSeries, HahnSeries.Nonpositive.degree_mul, - finiteSupportMonomial_degree, zero_add] + rw [principalMonomialTermSeries, coe_finiteSupportMonomial_mul, HahnSeries.degree_translate] private def normalTermSeries (t : HahnSeries.NormalForm.Term K) (ht : t.exponent ≤ 0) : Series K := @@ -388,7 +372,6 @@ private def normalTermSeries (t : HahnSeries.NormalForm.Term K) rintro _ ⟨g, hg, rfl⟩ exact add_nonpos ht (HahnSeries.Nonpositive.support_subset t.coefficient hg))⟩ -omit [CharZero K] in private theorem principalMonomialTerm_series_eq_normalTermSeries (t : HahnSeries.NormalForm.Term K) (ht : t.exponent ≤ 0) : principalMonomialTermSeries @@ -592,7 +575,7 @@ private theorem principalComponentTensorMap_surjective (alpha : NatOrdinal) : private theorem degreeLayerTruncationAt_principalComponentTensorMap_tmul_monomial (alpha : NatOrdinal) (x : PrincipalComponent K alpha) - (h g : {x : ℝ // x ≤ 0}) : + (h g : HahnSeries.Nonpositive.exponentMonoid ℝ) : degreeLayerTruncationAt K alpha g (principalComponentTensorMap K alpha (x ⊗ₜ HahnSeries.Nonpositive.finiteSupportMonomial (K := K) h)) = @@ -697,7 +680,7 @@ private theorem degreeLayerTruncationAt_principalComponentTensorMap_tmul_monomia private theorem degreeLayerTruncationAt_principalComponentTensorMap (alpha : NatOrdinal) (z : PrincipalComponent K alpha ⊗[K] FiniteSupportRing (K := K)) - (g : {x : ℝ // x ≤ 0}) : + (g : HahnSeries.Nonpositive.exponentMonoid ℝ) : degreeLayerTruncationAt K alpha g (principalComponentTensorMap K alpha z) = TensorProduct.equivFinsuppOfBasisRight @@ -715,9 +698,7 @@ private theorem degreeLayerTruncationAt_principalComponentTensorMap (alpha : Nat TensorProduct.equivFinsuppOfBasisRight_symm_apply basis f rw [hz] induction f using Finsupp.induction with - | zero => - simp - rfl + | zero => simp | single_add a b f ha hb ih => have hzero : ∀ i, (0 : PrincipalComponent K alpha) ⊗ₜ[K] basis i = 0 := @@ -732,7 +713,6 @@ private theorem degreeLayerTruncationAt_principalComponentTensorMap (alpha : Nat rw [HahnSeries.Nonpositive.finiteSupportBasis_apply] rw [degreeLayerTruncationAt_principalComponentTensorMap_tmul_monomial] rw [Finsupp.add_apply, Finsupp.single_apply] - rfl variable (K) in private theorem principalComponentTensorMap_injective (alpha : NatOrdinal) : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/RealSupportSupremum.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/RealSupportSupremum.lean index 219074fa30..3fd2c13171 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/RealSupportSupremum.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/RealSupportSupremum.lean @@ -31,39 +31,39 @@ variable (H : AddSubgroup ℝ) {K : Type v} [Field K] /-- Regard a nonpositive Hahn series over `H ⊆ ℝ` as a real-exponent Hahn series. -/ def mapDomainToReal : Nonpositive H K →+* Nonpositive ℝ K := - mapDomain H.subtype Subtype.val_injective fun _ _ ↦ Iff.rfl + mapDomain H.subtype H.subtype_injective fun _ _ ↦ ⟨fun h ↦ h, fun h ↦ h⟩ /-- The underlying series of `mapDomainToReal` is Mathlib's exponent-domain embedding. -/ @[simp] theorem coe_mapDomainToReal (b : Nonpositive H K) : (mapDomainToReal H b : K⟦ℝ⟧) = HahnSeries.embDomain - (⟨⟨H.subtype, Subtype.val_injective⟩, by + (⟨⟨H.subtype, H.subtype_injective⟩, by intro a b exact Subtype.coe_le_coe⟩ : H ↪o ℝ) (b : K⟦H⟧) := - coe_mapDomain H.subtype Subtype.val_injective (fun _ _ ↦ Iff.rfl) b + coe_mapDomain H.subtype H.subtype_injective (fun _ _ ↦ ⟨fun h ↦ h, fun h ↦ h⟩) b /-- The real-domain embedding maps support by the subgroup inclusion. -/ theorem support_mapDomainToReal (b : Nonpositive H K) : (mapDomainToReal H b : K⟦ℝ⟧).support = ((fun h : H ↦ (h : ℝ)) '' (b : K⟦H⟧).support) := - support_mapDomain H.subtype Subtype.val_injective (fun _ _ ↦ Iff.rfl) b + support_mapDomain H.subtype H.subtype_injective (fun _ _ ↦ ⟨fun h ↦ h, fun h ↦ h⟩) b /-- The real-domain embedding is injective. -/ theorem mapDomainToReal_injective : Function.Injective (mapDomainToReal (K := K) H) := - mapDomain_injective H.subtype Subtype.val_injective fun _ _ ↦ Iff.rfl + mapDomain_injective H.subtype H.subtype_injective fun _ _ ↦ ⟨fun h ↦ h, fun h ↦ h⟩ /-- The real-domain embedding preserves the constant coefficient. -/ theorem constantCoeff_mapDomainToReal (b : Nonpositive H K) : constantCoeff (mapDomainToReal H b) = constantCoeff b := by have hmap : mapDomainToReal H b = - mapDomain H.subtype Subtype.val_injective (fun _ _ ↦ Iff.rfl) b := by + mapDomain H.subtype H.subtype_injective (fun _ _ ↦ ⟨fun h ↦ h, fun h ↦ h⟩) b := by apply Subtype.ext rw [coe_mapDomainToReal, coe_mapDomain] rw [hmap] - exact constantCoeff_mapDomain H.subtype Subtype.val_injective - (fun _ _ ↦ Iff.rfl) b + exact constantCoeff_mapDomain H.subtype H.subtype_injective + (fun _ _ ↦ ⟨fun h ↦ h, fun h ↦ h⟩) b /-- The supremum in `ℝ` of the support of a nonpositive series with exponents in `H`. -/ def realSupportSup (b : Nonpositive H K) : WithBot ℝ := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportGCD.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportGCD.lean index d5b0e225f6..7bf0093e37 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportGCD.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportGCD.lean @@ -37,7 +37,7 @@ abbrev IntegerFiniteSupportRing := /-- The nonpositive exponent `-1`. -/ def negativeExponent : HahnSeries.Nonpositive.exponentMonoid ℤ := - ⟨-1, by norm_num⟩ + ⟨-1, show (-1 : ℤ) ≤ 0 by norm_num⟩ /-- The monomial `t⁻¹` in the nonpositive finite-support ring. -/ def nonpositiveNegativeMonomial : IntegerNonpositiveFiniteSupportRing := From cf0cffcd7e9e8fc60ba02fa1b7d623f0b60e738c Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 23:50:47 +0000 Subject: [PATCH 06/18] Update Conway germ coefficients and graded tensor assumptions --- .../Surreal/HahnSeries/Basic.lean | 13 ++++--- .../Algebra/DirectSum/GermPolynomial.lean | 8 ++-- .../GradedRing/FinitePartSubstitution.lean | 2 +- .../LoweringDerivation/IdealGEGraded.lean | 5 +-- .../Factorization/NormalizedHPart.lean | 2 +- .../OrdinalValue/PrincipalSubringTensor.lean | 39 +++++++------------ .../Tests/PrincipalComponentTensor.lean | 4 +- .../Tests/PrincipalSubringFiniteSupport.lean | 6 +-- .../Tests/FiniteSupportScalarExtension.lean | 8 ++-- 9 files changed, 38 insertions(+), 49 deletions(-) diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries/Basic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries/Basic.lean index 20f6cbb362..33754a9b04 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries/Basic.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries/Basic.lean @@ -41,7 +41,7 @@ public noncomputable section attribute [aesop simp] Pi.single_apply -theorem Set.IsWF.to_subtype {α : Type*} [LT α] {s : Set α} (h : IsWF s) : WellFoundedLT s := ⟨h⟩ +theorem Set.IsWF.to_subtype {α : Type*} [LT α] {s : Set α} (h : IsWF s) : WellFoundedLT s := h /-- This is like `RelIso.cast` with better def-eqs. -/ def RelIso.subrel {α : Type*} (r : α → α → Prop) {p q : α → Prop} (H : ∀ x, p x ↔ q x) : @@ -382,7 +382,8 @@ theorem typein_support {x : SurrealHahnSeries.{u}} (i : x.support) : rw [typein, RelEmbedding.ofMonotone_coe, ← lift_id'.{u, u + 1} (type _)] apply RelIso.ordinal_lift_type_eq use Equiv.subtypeEquiv (equivShrink _) (fun a ↦ (orderIsoShrink _).toRelIsoLT.map_rel_iff.symm) - simp + intro a b + exact (orderIsoShrink x.support).lt_iff_lt /-! #### `coeffIdx` -/ @@ -409,8 +410,8 @@ theorem coeff_exp (x : SurrealHahnSeries) (i) : x.coeff (x.exp i) = x.coeffIdx i @[simp] theorem coeffIdx_symm_exp (x : SurrealHahnSeries) (i) : x.coeffIdx (x.exp.symm i) = x.coeff i := by - rw [coeffIdx_of_lt (by simp)] - simp + rw [coeffIdx_of_lt (x.exp.symm i).property] + exact congrArg (fun a : x.support ↦ x.coeff a) (x.exp.apply_symm_apply i) @[simp] theorem coeffIdx_eq_zero_iff {x : SurrealHahnSeries} {i : Ordinal} : @@ -453,8 +454,8 @@ theorem trunc_exp (x : SurrealHahnSeries) (i) : x.trunc (x.exp i) = x.truncIdx i @[simp] theorem truncIdx_symm_exp (x : SurrealHahnSeries) (i) : x.truncIdx (x.exp.symm i) = x.trunc i := by - rw [truncIdx_of_lt (by simp)] - simp + rw [truncIdx_of_lt (x.exp.symm i).property] + exact congrArg (fun a : x.support ↦ x.trunc a) (x.exp.apply_symm_apply i) theorem support_truncIdx_ssubset {x : SurrealHahnSeries} {i : Ordinal} (h : i < x.length) : support (truncIdx x i) ⊂ support x := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermPolynomial.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermPolynomial.lean index fcdcafda94..b6d3bf30e1 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermPolynomial.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermPolynomial.lean @@ -291,7 +291,7 @@ theorem exists_linear_part (hwt : ∀ i, 1 ≤ wt i) (hmem : ∀ i, x i ∈ A (w {F : MvPolynomial ι K} {n : ℕ} (hn : 1 ≤ n) (hF : IsWeightedHomogeneous wt F n) : ∃ c : ι →₀ K, (∀ i ∈ c.support, wt i = n) ∧ aeval x F - Finsupp.linearCombination K x c ∈ decomposable A n ∧ - ∀ i, c i = coeff (Finsupp.single i 1) F := by + ∀ i, c i = F.coeff (Finsupp.single i 1) := by obtain ⟨c, hcwt, hc, hcoeff⟩ := OrdinalGraded.exists_linear_part (fun i ↦ Nat.cast_ne_zero.mpr (Nat.one_le_iff_ne_zero.mp (hwt i))) hmem (Nat.cast_ne_zero.mpr (Nat.one_le_iff_ne_zero.mp hn)) @@ -370,7 +370,7 @@ variable {Δ : Derivation K R (Germ l R)} omit [GradedAlgebra A] in /-- Polynomials homogeneous of degree zero (for `deg X_i = wt i ≥ 1`) are constants. -/ theorem eq_C_of_isWeightedHomogeneous_zero (hwt : ∀ i, 1 ≤ wt i) {p : MvPolynomial ι K} - (hp : IsWeightedHomogeneous wt p 0) : p = C (coeff 0 p) := + (hp : IsWeightedHomogeneous wt p 0) : p = C (p.coeff 0) := OrdinalGraded.eq_C_of_isWeightedHomogeneous_zero (wt := fun i ↦ (wt i : NatOrdinal.{0})) (fun i ↦ Nat.cast_ne_zero.mpr (Nat.one_le_iff_ne_zero.mp (hwt i))) ((isWeightedHomogeneous_natCast_comp_iff (M := NatOrdinal.{0}) wt).mpr hp) @@ -452,7 +452,7 @@ theorem eq_zero_of_eventually_mkDerivation_eq_zero [CharZero K] (hwt : ∀ i, 1 have hpos : 0 < D * wt x₀ := Nat.mul_pos hD1 hn1 exact hcD (ih _ (by omega) (c D) (by omega) (hchom D) hcD0) have hw0 : w - D * wt x₀ = 0 := by omega - set a := coeff 0 (c D) with ha + set a := (c D).coeff 0 with ha have hcDa : c D = C a := eq_C_of_isWeightedHomogeneous_zero hwt (hw0 ▸ hchom D) have ha0 : a ≠ 0 := fun h ↦ hcD (by rw [hcDa, h, map_zero]) -- the coefficient of `(X x₀)^(D-1)`: `h := c_(D-1) + D a X x₀` has degree `wt x₀`, `∂_γ h = 0` @@ -493,7 +493,7 @@ theorem eq_zero_of_eventually_mkDerivation_eq_zero [CharZero K] (hwt : ∀ i, 1 obtain ⟨cf, hcfw, hcf, hcfcoeff⟩ := exists_linear_part hwt hmem hn1 hhhom rw [haeval, zero_sub, neg_mem_iff] at hcf have hcx := hcfcoeff x₀ - rw [hind (wt x₀) cf hcfw hcf, Finsupp.coe_zero, Pi.zero_apply, hh, coeff_add, hc, coeff_xCoeff, + rw [hind (wt x₀) cf hcfw hcf, Finsupp.coe_zero, Pi.zero_apply, hh, AddMonoidAlgebra.coeff_add, Finsupp.add_apply, hc, coeff_xCoeff, ite_eq_right (by simp), zero_add, C_mul_X_eq_monomial, coeff_monomial, ite_eq_left rfl] at hcx exact ha0 ((mul_eq_zero.mp hcx.symm).resolve_left (Nat.cast_ne_zero.mpr (by omega))) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/FinitePartSubstitution.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/FinitePartSubstitution.lean index 0886d5e3ac..7bf2cc753b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/FinitePartSubstitution.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/FinitePartSubstitution.lean @@ -89,7 +89,7 @@ theorem aeval_mem_decomposableAt_of_mem_supported rw [h] at hle exact hne j (le_antisymm hle zero_le) -- `X^d = X^{d'} * X_i` - have hmono : monomial d (coeff d V) = C (coeff d V) * (monomial d' 1 * X i) := by + have hmono : monomial d (V.coeff d) = C (V.coeff d) * (monomial d' 1 * X i) := by rw [X, monomial_mul, mul_one, C_mul_monomial, mul_one, hd'def, Finsupp.sub_add_single_one_cancel (Finsupp.mem_support_iff.mp hi)] rw [hmono, map_mul, map_mul, ← algebraMap_eq, AlgHom.commutes, Algebra.algebraMap_eq_smul_one, diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/IdealGEGraded.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/IdealGEGraded.lean index a3cbb02c26..f1daed64ac 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/IdealGEGraded.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/IdealGEGraded.lean @@ -314,10 +314,7 @@ theorem exists_idealGETensorHom_rTensor_eq (j : ℕ) (T : 𝒜 (j : NatOrdinal) ∃ x, ∃ hx : x ∈ idealGE 𝒜 j, mu 𝒜 j T = (Submodule.Quotient.mk x : R ⧸ idealGE 𝒜 (j + 1)) ∧ idealGETensorHom 𝒜 ((natInclusion 𝒜 j).rTensor _ T) = idealGEMk 𝒜 j hx := by - induction T with - | zero => - exact ⟨0, zero_mem _, by rw [map_zero, Submodule.Quotient.mk_zero], - by rw [map_zero, map_zero, idealGEMk_zero]⟩ + induction T using TensorProduct.inductionOn with | tmul a c => obtain ⟨b, rfl⟩ := fibreMap_surjective 𝒜 c exact ⟨(a : R) * b, Ideal.mul_mem_right _ _ (mem_idealGE_of_mem 𝒜 le_rfl a.2), diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedHPart.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedHPart.lean index b8e04516dc..d3f73fb7ab 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedHPart.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/NormalizedHPart.lean @@ -39,7 +39,7 @@ variable (H : AddSubgroup ℝ) {K : Type v} [Field K] def finiteSupportToReal : FiniteSupportRing (G := H) (K := K) →+* FiniteSupportRing (G := ℝ) (K := K) := - mapDomainFiniteSupport H.subtype Subtype.val_injective fun _ _ ↦ Iff.rfl + mapDomainFiniteSupport H.subtype H.subtype_injective fun _ _ ↦ ⟨fun h ↦ h, fun h ↦ h⟩ /-- The underlying nonpositive series of `finiteSupportToReal` is `mapDomainToReal`. -/ @[simp] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringTensor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringTensor.lean index 13512f47a8..3f3527ec37 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringTensor.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringTensor.lean @@ -40,7 +40,7 @@ namespace Berarducci public noncomputable section -variable {K : Type v} [Field K] [CharZero K] +variable {K : Type v} [Field K] variable (K) in private def principalSubringTensorLinearEquiv : @@ -63,7 +63,6 @@ def principalSubringTensorComponent (α : NatOrdinal) : (TensorProduct.directSumLeft K K (PrincipalComponent K) (FiniteSupportRing (K := K))).toLinearMap -omit [CharZero K] in /-- The tensor component of a pure tensor is the tensor of the corresponding principal component. -/ @[simp] @@ -95,7 +94,6 @@ def finiteSupportGradedEmbedding : rw [degreeFiniteSupportResidueEquiv_scalar, degreeGraded_algebraMap_apply] -omit [CharZero K] in /-- The finite-support embedding places the degree residue class in grade zero. -/ @[simp] theorem finiteSupportGradedEmbedding_apply (p : FiniteSupportRing (K := K)) : @@ -104,7 +102,6 @@ theorem finiteSupportGradedEmbedding_apply (p : FiniteSupportRing (K := K)) : (HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K p) := (rfl) -omit [CharZero K] in /-- Multiplication by the grade-zero finite-support embedding is the residue-ring scalar action on each homogeneous component. -/ theorem finiteSupportGradedEmbedding_mul_of (p : FiniteSupportRing (K := K)) (α : NatOrdinal) @@ -117,7 +114,6 @@ theorem finiteSupportGradedEmbedding_mul_of (p : FiniteSupportRing (K := K)) (α (HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K p • x) := by rw [finiteSupportGradedEmbedding_apply, ← DirectSum.of_zero_smul] -omit [CharZero K] in variable (K) in /-- The grade-zero finite-support embedding is injective. -/ theorem finiteSupportGradedEmbedding_injective : @@ -128,7 +124,7 @@ theorem finiteSupportGradedEmbedding_injective : variable (K) in /-- Multiplication of the two canonical graded embeddings induces the global tensor map. -/ -def principalSubringTensorMap : +def principalSubringTensorMap [CharZero K] : PrincipalSubring K ⊗[K] FiniteSupportRing (K := K) →ₐ[K] DegreeGraded K := Algebra.TensorProduct.productMap @@ -136,13 +132,12 @@ def principalSubringTensorMap : (finiteSupportGradedEmbedding K) /-- On a pure tensor, the global tensor map is multiplication of the two embedded factors. -/ -theorem principalSubringTensorMap_tmul (x : PrincipalSubring K) (p : FiniteSupportRing (K := K)) : +theorem principalSubringTensorMap_tmul [CharZero K] (x : PrincipalSubring K) (p : FiniteSupportRing (K := K)) : principalSubringTensorMap K (x ⊗ₜ p) = principalSubringEmbedding K x * finiteSupportGradedEmbedding K p := (rfl) -omit [CharZero K] in private theorem degreeGraded_of_zero_mul (a : (HahnSeries.Nonpositive.degreeValuation K).Component 0) (x : DegreeGraded K) : @@ -158,7 +153,7 @@ private theorem degreeGraded_of_zero_mul α).map_smul a x | add x y hx hy => rw [mul_add, smul_add, hx, hy] -private theorem principalSubringTensorMap_eq_linearEquiv +private theorem principalSubringTensorMap_eq_linearEquiv [CharZero K] (z : PrincipalSubring K ⊗[K] FiniteSupportRing (K := K)) : principalSubringTensorMap K z = principalSubringTensorLinearEquiv K z := by @@ -187,7 +182,7 @@ private theorem principalSubringTensorMap_eq_linearEquiv variable (K) in /-- The multiplication-induced global tensor map is bijective. -/ -theorem principalSubringTensorMap_bijective : +theorem principalSubringTensorMap_bijective [CharZero K] : Function.Bijective (principalSubringTensorMap K) := by have hfunctions : (principalSubringTensorMap K : @@ -220,7 +215,7 @@ variable (K) in components, so their direct sum is an algebra homomorphism. Every element has finite degree support; applying the inverse component maps degree by degree proves bijectivity. -/)] -def principalSubringTensorEquiv : +def principalSubringTensorEquiv [CharZero K] : PrincipalSubring K ⊗[K] FiniteSupportRing (K := K) ≃ₐ[K] DegreeGraded K := AlgEquiv.ofBijective (principalSubringTensorMap K) @@ -228,14 +223,14 @@ def principalSubringTensorEquiv : /-- The graded tensor equivalence has the multiplication-induced tensor map as its forward map. -/ @[simp] -theorem principalSubringTensorEquiv_apply +theorem principalSubringTensorEquiv_apply [CharZero K] (z : PrincipalSubring K ⊗[K] FiniteSupportRing (K := K)) : principalSubringTensorEquiv K z = principalSubringTensorMap K z := (rfl) /-- The graded tensor equivalence multiplies the images of a pure tensor's two factors. -/ -theorem principalSubringTensorEquiv_tmul +theorem principalSubringTensorEquiv_tmul [CharZero K] (x : PrincipalSubring K) (p : FiniteSupportRing (K := K)) : principalSubringTensorEquiv K (x ⊗ₜ p) = principalSubringEmbedding K x * @@ -244,7 +239,7 @@ theorem principalSubringTensorEquiv_tmul /-- On a pure tensor, each homogeneous projection of the global equivalence is the corresponding homogeneous-component equivalence. -/ -theorem principalSubringTensorEquiv_tmul_apply +theorem principalSubringTensorEquiv_tmul_apply [CharZero K] (x : PrincipalSubring K) (p : FiniteSupportRing (K := K)) (α : NatOrdinal) : principalSubringTensorEquiv K (x ⊗ₜ p) α = @@ -255,7 +250,7 @@ theorem principalSubringTensorEquiv_tmul_apply /-- On an arbitrary tensor, every homogeneous projection of the global equivalence is the corresponding homogeneous-component equivalence applied to the canonical tensor component. -/ -theorem principalSubringTensorEquiv_component +theorem principalSubringTensorEquiv_component [CharZero K] (z : PrincipalSubring K ⊗[K] FiniteSupportRing (K := K)) (α : NatOrdinal) : principalSubringTensorEquiv K z α = @@ -273,7 +268,7 @@ theorem principalSubringTensorEquiv_component homogeneous-component equivalence of that homogeneous component. -/ @[simp] -theorem principalSubringTensorComponent_symm_apply +theorem principalSubringTensorComponent_symm_apply [CharZero K] (y : DegreeGraded K) (α : NatOrdinal) : principalSubringTensorComponent K α ((principalSubringTensorEquiv K).symm y) = @@ -284,21 +279,21 @@ theorem principalSubringTensorComponent_symm_apply /-- Restricting the global equivalence to the finite-support factor gives its grade-zero embedding. -/ -theorem principalSubringTensorEquiv_one_tmul (p : FiniteSupportRing (K := K)) : +theorem principalSubringTensorEquiv_one_tmul [CharZero K] (p : FiniteSupportRing (K := K)) : principalSubringTensorEquiv K (1 ⊗ₜ p) = finiteSupportGradedEmbedding K p := by rw [principalSubringTensorEquiv_tmul, map_one, one_mul] /-- Restricting the global equivalence to the principal graded factor gives its canonical embedding. -/ -theorem principalSubringTensorEquiv_tmul_one (x : PrincipalSubring K) : +theorem principalSubringTensorEquiv_tmul_one [CharZero K] (x : PrincipalSubring K) : principalSubringTensorEquiv K (x ⊗ₜ 1) = principalSubringEmbedding K x := by rw [principalSubringTensorEquiv_tmul, map_one, mul_one] /-- The inverse global tensor equivalence sends the finite-support embedding to the corresponding pure tensor. -/ -theorem principalSubringTensorEquiv_symm_finiteSupportGradedEmbedding +theorem principalSubringTensorEquiv_symm_finiteSupportGradedEmbedding [CharZero K] (p : FiniteSupportRing (K := K)) : (principalSubringTensorEquiv K).symm (finiteSupportGradedEmbedding K p) = 1 ⊗ₜ p := by @@ -308,13 +303,12 @@ theorem principalSubringTensorEquiv_symm_finiteSupportGradedEmbedding /-- The inverse global tensor equivalence sends the principal graded embedding to the corresponding pure tensor. -/ @[simp] -theorem principalSubringTensorEquiv_symm_principalGradedEmbedding (x : PrincipalSubring K) : +theorem principalSubringTensorEquiv_symm_principalGradedEmbedding [CharZero K] (x : PrincipalSubring K) : (principalSubringTensorEquiv K).symm (principalSubringEmbedding K x) = x ⊗ₜ 1 := by apply (principalSubringTensorEquiv K).injective rw [AlgEquiv.apply_symm_apply, principalSubringTensorEquiv_tmul_one] -omit [CharZero K] in /-- A nonzero finite-support series has degree zero. -/ theorem degreeValuation_finiteSupport_eq_zero (p : FiniteSupportRing (K := K)) (hp : p ≠ 0) : HahnSeries.Nonpositive.degreeValuation K (p : Series K) = 0 := by @@ -331,13 +325,11 @@ def finiteSupportFiltrationRepresentative (p : FiniteSupportRing (K := K)) : simp · rw [degreeValuation_finiteSupport_eq_zero p hp, WithBot.coe_zero])⟩ -omit [CharZero K] in @[simp] theorem coe_finiteSupportFiltrationRepresentative (p : FiniteSupportRing (K := K)) : (finiteSupportFiltrationRepresentative p : Series K) = (p : Series K) := (rfl) -omit [CharZero K] in /-- The finite-support embedding sends a series to its grade-zero homogeneous class. -/ theorem finiteSupportGradedEmbedding_eq_homogeneousMk (p : FiniteSupportRing (K := K)) : finiteSupportGradedEmbedding K p = @@ -353,7 +345,6 @@ theorem finiteSupportGradedEmbedding_eq_homogeneousMk (p : FiniteSupportRing (K rw [(HahnSeries.Nonpositive.degreeValuation K).coe_nonpositiveEquivFiltrationLEZero, RingEquiv.coe_subringCongr_apply, coe_finiteSupportFiltrationRepresentative] -omit [CharZero K] in /-- The finite-support embedding sends a series to its initial form. -/ theorem finiteSupportGradedEmbedding_eq_initialForm (p : FiniteSupportRing (K := K)) : finiteSupportGradedEmbedding K p = diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponentTensor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponentTensor.lean index fbaaa1a5ec..02a9d45849 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponentTensor.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponentTensor.lean @@ -45,10 +45,10 @@ private theorem approachZeroPrincipalComponent_ne_zero : exact lt_irrefl _ /-- The exponent zero in the nonpositive real cone. -/ -def tensorExponentZero : {g : ℝ // g ≤ 0} := ⟨0, le_rfl⟩ +def tensorExponentZero : HahnSeries.Nonpositive.exponentMonoid ℝ := ⟨0, le_rfl⟩ /-- The exponent negative one in the nonpositive real cone. -/ -def tensorExponentNegOne : {g : ℝ // g ≤ 0} := ⟨-1, by norm_num⟩ +def tensorExponentNegOne : HahnSeries.Nonpositive.exponentMonoid ℝ := ⟨-1, show (-1 : ℝ) ≤ 0 by norm_num⟩ /-- A tensor with nonzero coordinates at the two distinct exponents `0` and `-1`. -/ def approachZeroTwoExponentTensor : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFiniteSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFiniteSupport.lean index 2f82d157d8..35c9216992 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFiniteSupport.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFiniteSupport.lean @@ -52,7 +52,7 @@ theorem outsideCoefficient_not_mem_coefficientMap_range : /-- The nonpositive real exponent `-1`. -/ def negativeOne : HahnSeries.Nonpositive.exponentMonoid ℝ := - ⟨-1, by norm_num⟩ + ⟨-1, show (-1 : ℝ) ≤ 0 by norm_num⟩ /-- A nonconstant finite-support series over `ℚ`, with coefficients one at `0` and `-1`. -/ def sourceBinomial : @@ -69,7 +69,7 @@ theorem extendedBinomial_negativeOne_coeff : extendedBinomial negativeOne = 1 := by rw [extendedBinomial, Berarducci.principalSubringFractionScalarExtension_coeff] - simp [sourceBinomial, negativeOne, + simp [sourceBinomial, negativeOne, Finsupp.single_apply, Subtype.ext_iff, HahnSeries.Nonpositive.finiteSupportCoefficients_apply] /-- The constant term survives coefficient extension. -/ @@ -78,7 +78,7 @@ theorem extendedBinomial_zero_coeff : extendedBinomial 0 = 1 := by rw [extendedBinomial, Berarducci.principalSubringFractionScalarExtension_coeff] - simp [sourceBinomial, negativeOne, + simp [sourceBinomial, negativeOne, Finsupp.single_apply, Subtype.ext_iff, HahnSeries.Nonpositive.finiteSupportCoefficients_apply] /-- The extended binomial lies in the embedded coefficient-series subring. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportScalarExtension.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportScalarExtension.lean index f3fd68ec3d..17820441ea 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportScalarExtension.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportScalarExtension.lean @@ -31,7 +31,7 @@ public noncomputable section /-- The nonpositive exponent `-1` used by the coefficient-extension fixtures. -/ def negativeOne : HahnSeries.Nonpositive.exponentMonoid ℤ := - ⟨-1, by norm_num⟩ + ⟨-1, show (-1 : ℤ) ≤ 0 by norm_num⟩ /-- A finite-support integer series with coefficients `3` at `0` and `2` at `-1`. -/ def integerFixture : @@ -65,7 +65,7 @@ theorem rationalFixture_negativeOne_coeff : ← HahnSeries.Nonpositive.smul_finiteSupport_eq_scalar_mul, map_add, map_smul] simp [HahnSeries.Nonpositive.finiteSupportCoefficients_apply, - HahnSeries.Nonpositive.coe_finiteSupportScalarHom, negativeOne] + HahnSeries.Nonpositive.coe_finiteSupportScalarHom, negativeOne, Finsupp.single_apply, Subtype.ext_iff] /-- The constant coefficient survives scalar extension and is mapped to `3 : ℚ`. -/ theorem rationalFixture_zero_coeff : @@ -75,7 +75,7 @@ theorem rationalFixture_zero_coeff : ← HahnSeries.Nonpositive.smul_finiteSupport_eq_scalar_mul, map_add, map_smul] simp [HahnSeries.Nonpositive.finiteSupportCoefficients_apply, - HahnSeries.Nonpositive.coe_finiteSupportScalarHom, negativeOne] + HahnSeries.Nonpositive.coe_finiteSupportScalarHom, negativeOne, Finsupp.single_apply, Subtype.ext_iff] /-- The scalar-extended integer fixture belongs to the image by construction. -/ theorem rationalFixture_mem_range : @@ -98,7 +98,7 @@ theorem rationalOutside_negativeOne_coeff : ← HahnSeries.Nonpositive.smul_finiteSupport_eq_scalar_mul, map_add, map_smul] simp [HahnSeries.Nonpositive.finiteSupportCoefficients_apply, - HahnSeries.Nonpositive.coe_finiteSupportScalarHom, negativeOne] + HahnSeries.Nonpositive.coe_finiteSupportScalarHom, negativeOne, Finsupp.single_apply, Subtype.ext_iff] /-- A nonintegral coefficient prevents membership in the image of integer scalar extension. -/ theorem rationalOutside_not_mem_range : From b2ff9c169f5f2254f22e41d7876837be8c5b1270 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 00:01:47 +0000 Subject: [PATCH 07/18] Port Conway normal forms and downstream divisor interfaces --- .../Algebra/DirectSum/GermSuccessorStep.lean | 6 +- .../LoweringDerivation/Polynomial.lean | 4 +- .../Factorization/MaximalFinite.lean | 25 ++---- .../NormalizedHPartMultiplicativity.lean | 2 +- .../Germ/AlgebraicIndependence/Lifts.lean | 4 +- .../Tests/PrincipalSubringTensor.lean | 2 +- .../Support/FinitePowerFamily.lean | 4 +- .../Surreal/HahnSeries/NormalFormBasic.lean | 22 +++-- .../ConwayRefinement/Tests/UpstreamReuse.lean | 87 ++++++++++++------- 9 files changed, 91 insertions(+), 65 deletions(-) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean index b8c2e5b616..a14a40df1b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean @@ -493,7 +493,7 @@ theorem injectiveAt_of_forall_lt [CharZero K] (hgz : GradeZeroScalars A) -- independence of the generators modulo `(P̂_+)² ∩ P_{deg b}` obtain ⟨b₀, hb₀⟩ := hBne obtain ⟨b, hb⟩ : ∃ b : ↥B, (b : ι) = b₀ := ⟨⟨b₀, hb₀⟩, rfl⟩ - obtain ⟨κ', hκ'⟩ : ∃ κ' : ι → K, ∀ t, κ' t = coeff 0 (a' t b) := ⟨_, fun _ ↦ rfl⟩ + obtain ⟨κ', hκ'⟩ : ∃ κ' : ι → K, ∀ t, κ' t = (a' t b).coeff 0 := ⟨_, fun _ ↦ rfl⟩ obtain ⟨ℓ, hℓ⟩ : ∃ ℓ : MvPolynomial ι K, ℓ = ∑ t ∈ T, C (κ' t) * X t := ⟨_, rfl⟩ have hdiff : aeval x (W b) - aeval x ℓ ∈ decomposableAt (A) (wt b) := by rw [hW, hℓ, map_sum, map_sum, ← Finset.sum_sub_distrib] @@ -538,7 +538,7 @@ theorem injectiveAt_of_forall_lt [CharZero K] (hgz : GradeZeroScalars A) exact mul_mem_decomposableAt_of_mem_decomposableAt hVt (aeval_mem_of_forall_mem hx.mem hahom) · have hκ0 : κ' t = 0 := by - rw [hκ', ha'0 t ht b h, coeff_zero] + rw [hκ', ha'0 t ht b h, AddMonoidAlgebra.coeff_zero, Finsupp.zero_apply] rw [ha'0 t ht b h, hκ0] simp only [map_zero, zero_mul, sub_zero] exact zero_mem _ @@ -577,7 +577,7 @@ theorem injectiveAt_of_forall_lt [CharZero K] (hgz : GradeZeroScalars A) rw [hκ'] exact coeff_zero_eq_zero_of_isWeightedHomogeneous hahom hβ0 · refine absurd ?_ hi - rw [hκ', ha'0 i hiT b h, coeff_zero] + rw [hκ', ha'0 i hiT b h, AddMonoidAlgebra.coeff_zero, Finsupp.zero_apply] · exact absurd rfl hi have hfmem : Finsupp.linearCombination K x f ∈ decomposableAt (A) (wt b) := by rw [hℓeq] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Polynomial.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Polynomial.lean index af21115bcb..d79a2e967a 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Polynomial.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/Polynomial.lean @@ -94,7 +94,7 @@ theorem exists_linear_part (hwt : ∀ i, 1 ≤ wt i) {F : MvPolynomial ι E} {n : ℕ} (hn : 1 ≤ n) (hF : IsWeightedHomogeneous wt F n) : ∃ c : ι →₀ E, (∀ i ∈ c.support, wt i = n) ∧ aeval x F - Finsupp.linearCombination E x c ∈ decomposable A n ∧ - ∀ i, c i = coeff (Finsupp.single i 1) F := by + ∀ i, c i = F.coeff (Finsupp.single i 1) := by exact GermPolynomial.exists_linear_part hwt hmem hn hF /-! ### The real-line derivation as a filter-germ derivation -/ @@ -179,7 +179,7 @@ end IsHomogeneousCoordinates /-- A positive-weight homogeneous polynomial of degree zero is constant. -/ theorem eq_C_of_isWeightedHomogeneous_zero (hwt : ∀ i, 1 ≤ wt i) {p : MvPolynomial ι E} (hp : IsWeightedHomogeneous wt p 0) : - p = C (coeff 0 p) := + p = C (p.coeff 0) := GermPolynomial.eq_C_of_isWeightedHomogeneous_zero hwt hp /-- A positive-degree homogeneous polynomial in the joint kernel of the pointwise derivations is diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFinite.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFinite.lean index ee8e166a63..e77197faf1 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFinite.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFinite.lean @@ -36,7 +36,7 @@ namespace Berarducci public noncomputable section -variable {K : Type v} [Field K] [CharZero K] +variable {K : Type v} [Field K] /-- Multiplication on the finite-support tensor factor agrees with the residue-ring action on a fixed component of `RV̂`. -/ @@ -67,7 +67,7 @@ theorem principalComponentTensorEquiv_mulRightFactor /-- Multiplication on the finite-support tensor factor agrees with multiplication by the grade-zero finite-support embedding in the associated graded ring. -/ -theorem principalSubringTensorEquiv_mulRightFactor (q : FiniteSupportRing (K := K)) +theorem principalSubringTensorEquiv_mulRightFactor [CharZero K] (q : FiniteSupportRing (K := K)) (z : PrincipalSubring K ⊗[K] FiniteSupportRing (K := K)) : principalSubringTensorEquiv K (TensorProduct.mulRightFactor q z) = @@ -130,7 +130,6 @@ def IsLayerMaximalFiniteSupportDivisor (α : NatOrdinal) ∃ C : (HahnSeries.Nonpositive.degreeValuation K).Component α, HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K q • C = B -omit [CharZero K] in /-- The defining divisibility characterization for a fixed homogeneous component. -/ theorem isLayerMaximalFiniteSupportDivisor_iff (α : NatOrdinal) (B : (HahnSeries.Nonpositive.degreeValuation K).Component α) @@ -149,7 +148,6 @@ def IsGradedMaximalFiniteSupportDivisor (B : DegreeGraded K) IsMaximalDivisorAlong (finiteSupportGradedEmbedding K).toMonoidHom B a -omit [CharZero K] in /-- The defining divisibility characterization for an element of the associated graded ring. -/ theorem isGradedMaximalFiniteSupportDivisor_iff (B : DegreeGraded K) (a : Associates (FiniteSupportRing (K := K))) : @@ -159,7 +157,6 @@ theorem isGradedMaximalFiniteSupportDivisor_iff (B : DegreeGraded K) rw [IsGradedMaximalFiniteSupportDivisor, isMaximalDivisorAlong_iff] -omit [CharZero K] in /-- Representative form of the maximal-divisor characterization used in LM24, Corollary 5.4.4. -/ theorem isGradedMaximalFiniteSupportDivisor_mk_iff (B : DegreeGraded K) @@ -220,7 +217,7 @@ theorem isContent_principalComponentTensorEquiv_symm_iff (α : NatOrdinal) /-- Multiplying a nonzero principal fixed-degree class by a finite-support series gives a class whose maximal finite-support divisor is represented by that finite-support series. -/ -theorem isLayerMaximalFiniteSupportDivisor_finiteSupport_mul_principal +theorem isLayerMaximalFiniteSupportDivisor_finiteSupport_mul_principal [CharZero K] (α : NatOrdinal) (p : FiniteSupportRing (K := K)) (a : Series K) (ha : HahnSeries.Nonpositive.IsPrincipal a) (haDegree : (a : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) : @@ -263,7 +260,7 @@ theorem isLayerMaximalFiniteSupportDivisor_finiteSupport_mul_principal /-- The graded maximal-divisor predicate is intrinsic tensor content transported through the global tensor equivalence. -/ -theorem isContent_principalGradedTensorEquiv_symm_iff (B : DegreeGraded K) +theorem isContent_principalGradedTensorEquiv_symm_iff [CharZero K] (B : DegreeGraded K) (a : Associates (FiniteSupportRing (K := K))) : TensorProduct.IsContent ((principalSubringTensorEquiv K).symm B) a ↔ @@ -306,7 +303,7 @@ theorem isContent_principalGradedTensorEquiv_symm_iff (B : DegreeGraded K) /-- A finite-support series, embedded in grade zero, is its own maximal finite-support divisor. -/ -theorem isGradedMaximalFiniteSupportDivisor_finiteSupport (p : FiniteSupportRing (K := K)) : +theorem isGradedMaximalFiniteSupportDivisor_finiteSupport [CharZero K] (p : FiniteSupportRing (K := K)) : IsGradedMaximalFiniteSupportDivisor (finiteSupportGradedEmbedding K p) (Associates.mk p) := by apply (isContent_principalGradedTensorEquiv_symm_iff _ (Associates.mk p)).mp @@ -334,7 +331,7 @@ theorem isGradedMaximalFiniteSupportDivisor_finiteSupport (p : FiniteSupportRing /-- Multiplying a nonzero principal fixed-degree class by a finite-support series gives a homogeneous graded class whose maximal finite-support divisor is represented by that series. -/ -theorem isGradedMaximalFiniteSupportDivisor_finiteSupport_mul_principal +theorem isGradedMaximalFiniteSupportDivisor_finiteSupport_mul_principal [CharZero K] (α : NatOrdinal) (p : FiniteSupportRing (K := K)) (a : Series K) (ha : HahnSeries.Nonpositive.IsPrincipal a) (haDegree : (a : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal)) : @@ -394,7 +391,6 @@ theorem isGradedMaximalFiniteSupportDivisor_finiteSupport_mul_principal rw [← heq, AlgEquiv.symm_apply_apply] exact TensorProduct.isContent_tmul_of_ne_zero X hX p -omit [CharZero K] in /-- A fixed homogeneous component has at most one maximal finite-support divisor class. -/ theorem IsLayerMaximalFiniteSupportDivisor.eq {α : NatOrdinal} {B : (HahnSeries.Nonpositive.degreeValuation K).Component α} @@ -409,7 +405,6 @@ theorem IsLayerMaximalFiniteSupportDivisor.eq {α : NatOrdinal} · exact (hb p).2 ((ha p).1 le_rfl) · exact (ha q).2 ((hb q).1 le_rfl) -omit [CharZero K] in /-- A graded element has at most one maximal finite-support divisor class. -/ theorem IsGradedMaximalFiniteSupportDivisor.eq {B : DegreeGraded K} {a b : Associates (FiniteSupportRing (K := K))} @@ -477,7 +472,7 @@ theorem exists_scalar_isLayerMaximalFiniteSupportDivisor_of_isPrincipal (α : Na /-- Pairwise gcd existence gives a unique maximal finite-support divisor of every element of the degree-graded ring. -/ -theorem existsUnique_isGradedMaximalFiniteSupportDivisor_of_exists_gcd +theorem existsUnique_isGradedMaximalFiniteSupportDivisor_of_exists_gcd [CharZero K] (hgcd : ∀ p q : FiniteSupportRing (K := K), ∃ d : FiniteSupportRing (K := K), ∀ e : FiniteSupportRing (K := K), @@ -508,7 +503,6 @@ noncomputable def layerMaximalFiniteSupportDivisor (α : NatOrdinal) else 0 -omit [CharZero K] in /-- Any class satisfying the homogeneous-component characterization is the canonical class. -/ theorem layerMaximalFiniteSupportDivisor_eq_of_is {α : NatOrdinal} {B : (HahnSeries.Nonpositive.degreeValuation K).Component α} @@ -549,7 +543,6 @@ noncomputable def gradedMaximalFiniteSupportDivisor (B : DegreeGraded K) : else 0 -omit [CharZero K] in /-- Any class satisfying the graded characterization is the canonical class. -/ theorem gradedMaximalFiniteSupportDivisor_eq_of_is {B : DegreeGraded K} {a : Associates (FiniteSupportRing (K := K))} @@ -563,7 +556,7 @@ theorem gradedMaximalFiniteSupportDivisor_eq_of_is {B : DegreeGraded K} /-- Under pairwise gcd existence, the canonical graded class satisfies its defining characterization. -/ -theorem gradedMaximalFiniteSupportDivisor_is_of_exists_gcd +theorem gradedMaximalFiniteSupportDivisor_is_of_exists_gcd [CharZero K] (hgcd : ∀ p q : FiniteSupportRing (K := K), ∃ d : FiniteSupportRing (K := K), ∀ e : FiniteSupportRing (K := K), @@ -578,7 +571,7 @@ theorem gradedMaximalFiniteSupportDivisor_is_of_exists_gcd /-- Associate-class form of LM24, Proposition 5.4.8: maximal finite-support divisor classes are supermultiplicative. -/ -theorem gradedMaximalFiniteSupportDivisor_mul_le_of_exists_gcd +theorem gradedMaximalFiniteSupportDivisor_mul_le_of_exists_gcd [CharZero K] (hgcd : ∀ p q : FiniteSupportRing (K := K), ∃ d : FiniteSupportRing (K := K), ∀ e : FiniteSupportRing (K := K), diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPartMultiplicativity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPartMultiplicativity.lean index 58446d8ef6..9b26e2e99c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPartMultiplicativity.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPartMultiplicativity.lean @@ -59,7 +59,7 @@ theorem one_isNormalizedTrivialExponentSubgroupPart /-- The real exponent `-1` as a nonpositive exponent. -/ def normalizedPartMinusOneExponent : exponentMonoid ℝ := - ⟨-1, by norm_num⟩ + ⟨-1, show (-1 : ℝ) ≤ 0 by norm_num⟩ /-- The nonconstant finite-support real series `1 + t⁻¹`. -/ def normalizedPartNonconstantSeries : FiniteSupportRing (G := ℝ) (K := ℚ) := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Lifts.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Lifts.lean index e0ca791ea0..0171abfae7 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Lifts.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Lifts.lean @@ -208,7 +208,7 @@ theorem eq_zero_of_forall_weight_lt_of_degree_aeval_eq_bot have hlt : ∀ d ∈ F.support, (Finsupp.weight wt) d < β := by intro d hd refine lt_of_le_of_ne (hβ d hd) fun he ↦ ?_ - have := congrArg (MvPolynomial.coeff d) hcomp0 + have := congrArg (fun p : MvPolynomial ι K => p.coeff d) hcomp0 rw [coeff_weightedHomogeneousComponent, ite_eq_left he, MvPolynomial.coeff_zero] at this exact MvPolynomial.mem_support_iff.mp hd this rcases eq_or_ne β 0 with rfl | hβ0 @@ -246,7 +246,7 @@ theorem forall_weight_le_degree_aeval_of_injective · have hlt : ∀ e ∈ F.support, (Finsupp.weight wt) e < β := by intro e he refine lt_of_le_of_ne (hβ e he) fun heq ↦ ?_ - have hcz := congrArg (MvPolynomial.coeff e) hzero + have hcz := congrArg (fun p : MvPolynomial ι K => p.coeff e) hzero rw [coeff_weightedHomogeneousComponent, ite_eq_left heq, MvPolynomial.coeff_zero] at hcz exact MvPolynomial.mem_support_iff.mp he hcz rcases eq_or_ne β 0 with rfl | hβ0 diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringTensor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringTensor.lean index 4fe9f9bbb6..0013b24973 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringTensor.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringTensor.lean @@ -92,7 +92,7 @@ theorem gradedTensorTwoGrade_positive_component_ne_zero : simpa only [map_zero] using hzero /-- The nonpositive exponent `-1` used by the finite-support factor fixture. -/ -def gradedTensorExponentNegOne : {g : ℝ // g ≤ 0} := ⟨-1, by norm_num⟩ +def gradedTensorExponentNegOne : HahnSeries.Nonpositive.exponentMonoid ℝ := ⟨-1, show (-1 : ℝ) ≤ 0 by norm_num⟩ /-- The finite-support monomial at exponent `-1`. -/ def gradedTensorFiniteMonomial : Berarducci.FiniteSupportRing (K := ℚ) := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamily.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamily.lean index 1cd633c826..507034eb56 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamily.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamily.lean @@ -68,7 +68,7 @@ noncomputable instance finiteLexLinearOrder : (n : ℕ) → LinearOrder (FiniteL instance finiteLexWellFoundedLT : (n : ℕ) → WellFoundedLT (FiniteLex n) | .zero => by change WellFoundedLT Unit - exact ⟨Finite.wellFounded_of_trans_of_irrefl (· < ·)⟩ + exact Finite.wellFounded_of_trans_of_irrefl (· < ·) | .succ n => by letI : WellFoundedLT (FiniteLex n) := finiteLexWellFoundedLT n exact inferInstanceAs (WellFoundedLT (Lex (ℕ × FiniteLex n))) @@ -183,6 +183,8 @@ theorem finitePowerExponent_strictMono (n : ℕ) : StrictMono (finitePowerExpone exact (lt_irrefl p hpq).elim | succ n ih => intro p q hpq + induction p using Lex.rec with | h p => + induction q using Lex.rec with | h q => rcases p with ⟨m, p⟩ rcases q with ⟨m', q⟩ rw [Prod.Lex.lt_iff'] at hpq diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormBasic.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormBasic.lean index 76c3b1b6f4..723bb36cbc 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormBasic.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormBasic.lean @@ -59,8 +59,8 @@ attribute [simp, grind .] coeff_ne_zero @[ext] theorem ext {s t : TermSeq} (hl : s.length = t.length) - (he : ∀ i (hs : i < s.length) (ht : i < t.length), s.exp ⟨i, hs⟩ = t.exp ⟨i, ht⟩) - (hc : ∀ i (hs : i < s.length) (ht : i < t.length), s.coeff ⟨i, hs⟩ = t.coeff ⟨i, ht⟩) : + (he : ∀ i (hs : i ∈ Iio s.length) (ht : i ∈ Iio t.length), s.exp ⟨i, hs⟩ = t.exp ⟨i, ht⟩) + (hc : ∀ i (hs : i ∈ Iio s.length) (ht : i ∈ Iio t.length), s.coeff ⟨i, hs⟩ = t.coeff ⟨i, ht⟩) : s = t := by cases s cases t @@ -108,7 +108,6 @@ def toSurrealHahnSeries (s : TermSeq) : SurrealHahnSeries := .mk _ (small_subset H) (.subset (by rw [wellFoundedOn_range] convert wellFounded_lt (α := Iio s.length) - ext exact s.exp_strictAnti.lt_iff_gt ) H) @@ -143,8 +142,11 @@ theorem support_coe (s : TermSeq) : support s = range s.exp := by /-- Order isomorphism between `Iio x.length` and the range of `x.exp`. -/ private def relIso' (s : TermSeq) : (· < · : Iio s.length → _) ≃r (· > · : range s.exp → _) := by - refine .ofSurjective ⟨⟨fun i ↦ ⟨s.exp i, ⟨i, rfl⟩⟩, fun a b h ↦ s.exp_strictAnti.injective ?_⟩, - s.exp_lt_exp_iff⟩ fun _ ↦ ?_ <;> aesop + refine .ofSurjective ⟨⟨fun i ↦ ⟨s.exp i, ⟨i, rfl⟩⟩, ?_⟩, s.exp_lt_exp_iff⟩ ?_ + · intro a b h + exact s.exp_strictAnti.injective (congrArg Subtype.val h) + · rintro ⟨x, ⟨i, rfl⟩⟩ + exact ⟨i, rfl⟩ /-- Order isomorphism between `Iio s.length` and the support of `x`. -/ private def relIso (s : TermSeq) : (· < · : Iio s.length → _) ≃r (· > · : support s → _) := @@ -223,10 +225,12 @@ def surrealHahnSeriesEquiv : TermSeq ≃ SurrealHahnSeries where toFun := toSurrealHahnSeries invFun := ofSurrealHahnSeries left_inv s := by - ext x _ h - · simp - · simp - · simp [coeffIdx_coe_of_lt h] + apply TermSeq.ext + · exact length_coe s + · intro i hs ht + exact exp_coe s ⟨i, hs⟩ + · intro i hs ht + exact coeffIdx_coe_of_lt ht right_inv x := by ext i by_cases h : i ∈ x.support diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Tests/UpstreamReuse.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Tests/UpstreamReuse.lean index 39243c71e0..ae2d60e3ae 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Tests/UpstreamReuse.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Tests/UpstreamReuse.lean @@ -45,67 +45,87 @@ import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Ordinal # Upstream reuse checks This module pins the availability and compiler-visible signatures of selected upstream interfaces. -It intentionally declares no mathematical API. The hash-command linter is disabled here because -the module consists precisely of checked signature fixtures. +The anonymous examples retain these signature checks without adding a mathematical API. -/ universe u v w - (@Ordinal.isPrincipal_add_iff_zero_or_omega0_opow : + +example : {o : Ordinal.{u}} → Ordinal.IsPrincipal (· + ·) o ↔ - o = 0 ∨ o ∈ Set.range fun e : Ordinal.{u} ↦ Ordinal.omega0 ^ e) - (@Ordinal.sub_omega0_opow_log_lt : + o = 0 ∨ o ∈ Set.range fun e : Ordinal.{u} ↦ Ordinal.omega0 ^ e := + @Ordinal.isPrincipal_add_iff_zero_or_omega0_opow + +example : {o : Ordinal.{u}} → - o ≠ 0 → o - Ordinal.omega0 ^ Ordinal.log Ordinal.omega0 o < o) - (@HahnSeries.cardSuppLTSubring : + o ≠ 0 → o - Ordinal.omega0 ^ Ordinal.log Ordinal.omega0 o < o := + @Ordinal.sub_omega0_opow_log_lt + +example : (Γ : Type u) → (R : Type v) → (κ : Cardinal.{u}) → [PartialOrder Γ] → [AddCommMonoid Γ] → [IsOrderedCancelAddMonoid Γ] → - [Ring R] → [Fact (Cardinal.aleph0 ≤ κ)] → Subring (HahnSeries Γ R)) - (@HahnSeries.cardSuppLTSubfield : + [Ring R] → [Fact (Cardinal.aleph0 ≤ κ)] → Subring (HahnSeries Γ R) := + @HahnSeries.cardSuppLTSubring + +example : (Γ : Type u) → (R : Type v) → (κ : Cardinal.{u}) → [LinearOrder Γ] → [AddCommGroup Γ] → [IsOrderedAddMonoid Γ] → - [Field R] → [Fact (Cardinal.aleph0 < κ)] → Subfield (HahnSeries Γ R)) - (@Order.le_cof_iff : + [Field R] → [Fact (Cardinal.aleph0 < κ)] → Subfield (HahnSeries Γ R) := + @HahnSeries.cardSuppLTSubfield + +example : ∀ {α : Type u} [Preorder α] {c : Cardinal.{u}}, - c ≤ Order.cof α ↔ ∀ s : Set α, IsCofinal s → c ≤ Cardinal.mk ↥s) - (@not_isCofinal_iff : + c ≤ Order.cof α ↔ ∀ s : Set α, IsCofinal s → c ≤ Cardinal.mk ↥s := + @Order.le_cof_iff + +example : ∀ {α : Type u} [LinearOrder α] {s : Set α}, - ¬ IsCofinal s ↔ ∃ x, ∀ y ∈ s, y < x) - (@HahnSeries.cardSupp_single_mul_le : + ¬ IsCofinal s ↔ ∃ x, ∀ y ∈ s, y < x := + @not_isCofinal_iff + +example : ∀ {Γ : Type u} {R : Type v} [PartialOrder Γ] [AddCommMonoid Γ] [IsOrderedCancelAddMonoid Γ] [NonUnitalNonAssocSemiring R] (x : HahnSeries Γ R) (a : Γ) (r : R), - (HahnSeries.single a r * x).cardSupp ≤ x.cardSupp) - (@HahnSeries.iterateEquiv : + (HahnSeries.single a r * x).cardSupp ≤ x.cardSupp := + @HahnSeries.cardSupp_single_mul_le + +example : {Γ : Type u} → {Γ' : Type v} → {R : Type w} → [PartialOrder Γ] → [Zero R] → [PartialOrder Γ'] → - HahnSeries Γ (HahnSeries Γ' R) ≃ HahnSeries (Lex (Γ × Γ')) R) - (@HahnSeries.truncLT : + HahnSeries Γ (HahnSeries Γ' R) ≃ HahnSeries (Lex (Γ × Γ')) R := + @HahnSeries.iterateEquiv + +example : {Γ : Type u} → {R : Type v} → [Zero R] → [PartialOrder Γ] → - [DecidableLT Γ] → Γ → ZeroHom (HahnSeries Γ R) (HahnSeries Γ R)) - (@HahnSeries.embDomain : + [DecidableLT Γ] → Γ → ZeroHom (HahnSeries Γ R) (HahnSeries Γ R) := + @HahnSeries.truncLT + +example : {Γ : Type u} → {Γ' : Type v} → {R : Type w} → [PartialOrder Γ] → [Zero R] → [PartialOrder Γ'] → - (Γ ↪o Γ') → HahnSeries Γ R → HahnSeries Γ' R) - (@HahnSeries.support_embDomain_subset : + (Γ ↪o Γ') → HahnSeries Γ R → HahnSeries Γ' R := + @HahnSeries.embDomain + +example : {Γ : Type u} → {Γ' : Type v} → {R : Type w} → @@ -114,8 +134,10 @@ universe u v w [PartialOrder Γ'] → {f : Γ ↪o Γ'} → {x : HahnSeries Γ R} → - (HahnSeries.embDomain f x).support ⊆ f '' x.support) - (@WithBot.coe_sSup' : + (HahnSeries.embDomain f x).support ⊆ f '' x.support := + @HahnSeries.support_embDomain_subset + +example : {α : Type u} → [Preorder α] → [SupSet α] → @@ -123,9 +145,14 @@ universe u v w s.Nonempty → BddAbove s → ((sSup s : α) : WithBot α) = - sSup ((fun a : α ↦ (a : WithBot α)) '' s)) - (@SurrealHahnSeries.type_support : + sSup ((fun a : α ↦ (a : WithBot α)) '' s) := + @WithBot.coe_sSup' + +example : ∀ x : SurrealHahnSeries.{u}, - Ordinal.type (α := x.support) (· > ·) = Ordinal.lift.{u + 1} x.length) - (@not_injective_of_ordinal : - ∀ {α : Type v} [Small.{u} α] (f : Ordinal.{u} → α), ¬Function.Injective f) + Ordinal.type (α := x.support) (· > ·) = Ordinal.lift.{u + 1} x.length := + @SurrealHahnSeries.type_support + +example : + ∀ {α : Type v} [Small.{u} α] (f : Ordinal.{u} → α), ¬Function.Injective f := + @not_injective_of_ordinal From 2e8019a0d7de9e85f900083f07e070f152a94958 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 00:07:29 +0000 Subject: [PATCH 08/18] Restore transfinite normal-form recursion and boundary orders --- .../Factorization/RVMaximalFinite.lean | 43 +++++----- .../LowerTruncationDegree.lean | 16 ++-- .../PrincipalGraded.lean | 1 - .../Support/OmegaOmegaBoundary.lean | 31 ++++--- .../HahnSeries/NormalFormRecursion.lean | 85 ++++++++++++++----- .../ConwayRefinement/Tests/UpstreamReuse.lean | 2 + 6 files changed, 109 insertions(+), 69 deletions(-) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/RVMaximalFinite.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/RVMaximalFinite.lean index 7894755aac..9e636bba43 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/RVMaximalFinite.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/RVMaximalFinite.lean @@ -33,7 +33,28 @@ public noncomputable section open HahnSeries.Nonpositive -variable {K : Type v} [Field K] [CharZero K] +variable {K : Type v} [Field K] + +/-- A fixed component, regarded as an element of the monoid of homogeneous graded classes. -/ +def degreeHomogeneousClass (α : NatOrdinal) + (B : (HahnSeries.Nonpositive.degreeValuation K).Component α) : + (HahnSeries.Nonpositive.degreeValuation K).HomogeneousClasses := + ⟨DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component α B, + (MaxAddDegree.mem_homogeneousClasses_iff + (HahnSeries.Nonpositive.degreeValuation K) _).mpr + (Or.inr ⟨α, B, rfl⟩)⟩ + +/-- The underlying graded element of a fixed homogeneous class. -/ +@[simp] +theorem coe_degreeHomogeneousClass (α : NatOrdinal) + (B : (HahnSeries.Nonpositive.degreeValuation K).Component α) : + (degreeHomogeneousClass α B : DegreeGraded K) = + DirectSum.of + (HahnSeries.Nonpositive.degreeValuation K).Component α B := + (rfl) + +variable [CharZero K] private theorem directSum_index_eq_of_of_eq {ι : Type*} [DecidableEq ι] {A : ι → Type*} [∀ i, AddCommMonoid (A i)] @@ -122,26 +143,6 @@ theorem coe_finiteSupportHomogeneousClass (p : FiniteSupportRing (K := K)) : ← (HahnSeries.Nonpositive.degreeValuation K).rvEquivHomogeneous_apply] exact coe_rvEquivHomogeneous_finiteSupportRVEmbedding p -/-- A fixed component, regarded as an element of the monoid of homogeneous graded classes. -/ -def degreeHomogeneousClass (α : NatOrdinal) - (B : (HahnSeries.Nonpositive.degreeValuation K).Component α) : - (HahnSeries.Nonpositive.degreeValuation K).HomogeneousClasses := - ⟨DirectSum.of - (HahnSeries.Nonpositive.degreeValuation K).Component α B, - (MaxAddDegree.mem_homogeneousClasses_iff - (HahnSeries.Nonpositive.degreeValuation K) _).mpr - (Or.inr ⟨α, B, rfl⟩)⟩ - -omit [CharZero K] in -/-- The underlying graded element of a fixed homogeneous class. -/ -@[simp] -theorem coe_degreeHomogeneousClass (α : NatOrdinal) - (B : (HahnSeries.Nonpositive.degreeValuation K).Component α) : - (degreeHomogeneousClass α B : DegreeGraded K) = - DirectSum.of - (HahnSeries.Nonpositive.degreeValuation K).Component α B := - (rfl) - /-- Multiplication of a finite-support homogeneous class with a fixed homogeneous class is the degree-zero residue action on that component. -/ theorem finiteSupportHomogeneousClass_mul_degreeHomogeneousClass diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LowerTruncationDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LowerTruncationDegree.lean index 415e451e6d..233b23791b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LowerTruncationDegree.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LowerTruncationDegree.lean @@ -705,25 +705,25 @@ theorem exists_lt_forall_degree_homogeneous_leibniz_le intro d _ exact hlamOf d.1 d.2 · have hFsum : F = ∑ d ∈ F.support.attach, - MvPolynomial.C (MvPolynomial.coeff d.1 F) * MvPolynomial.monomial d.1 (1 : K) := by + MvPolynomial.C (F.coeff d.1) * MvPolynomial.monomial d.1 (1 : K) := by conv_lhs => rw [F.as_sum] rw [← Finset.sum_attach F.support - (fun d ↦ MvPolynomial.monomial d (MvPolynomial.coeff d F))] + (fun d ↦ MvPolynomial.monomial d (F.coeff d))] refine Finset.sum_congr rfl fun d _ ↦ ?_ rw [MvPolynomial.C_mul_monomial, mul_one] have hleft : translatedTruncLE γ (aeval V F) = - ∑ d ∈ F.support.attach, MvPolynomial.coeff d.1 F • + ∑ d ∈ F.support.attach, F.coeff d.1 • translatedTruncLE γ (aeval V (MvPolynomial.monomial d.1 (1 : K))) := by conv_lhs => rw [hFsum] rw [map_sum, map_sum] refine Finset.sum_congr rfl fun d _ ↦ ?_ rw [map_mul, MvPolynomial.aeval_C, ← Algebra.smul_def, translatedTruncLE_smul] have hright : ∑ i ∈ t, aeval V (MvPolynomial.pderiv i F) * translatedTruncLE γ (V i) = - ∑ d ∈ F.support.attach, MvPolynomial.coeff d.1 F • + ∑ d ∈ F.support.attach, F.coeff d.1 • ∑ i ∈ t, aeval V (MvPolynomial.pderiv i (MvPolynomial.monomial d.1 (1 : K))) * translatedTruncLE γ (V i) := by have hinner : ∀ i ∈ t, aeval V (MvPolynomial.pderiv i F) * translatedTruncLE γ (V i) = - ∑ d ∈ F.support.attach, MvPolynomial.coeff d.1 F • + ∑ d ∈ F.support.attach, F.coeff d.1 • (aeval V (MvPolynomial.pderiv i (MvPolynomial.monomial d.1 (1 : K))) * translatedTruncLE γ (V i)) := by intro i _ @@ -736,11 +736,11 @@ theorem exists_lt_forall_degree_homogeneous_leibniz_le exact Finset.sum_congr rfl fun d _ ↦ (Finset.smul_sum).symm rw [hleft, hright, ← Finset.sum_sub_distrib] have hcongr : ∀ d ∈ F.support.attach, - MvPolynomial.coeff d.1 F • translatedTruncLE γ + F.coeff d.1 • translatedTruncLE γ (aeval V (MvPolynomial.monomial d.1 (1 : K))) - - MvPolynomial.coeff d.1 F • ∑ i ∈ t, aeval V (MvPolynomial.pderiv i + F.coeff d.1 • ∑ i ∈ t, aeval V (MvPolynomial.pderiv i (MvPolynomial.monomial d.1 (1 : K))) * translatedTruncLE γ (V i) = - MvPolynomial.coeff d.1 F • + F.coeff d.1 • (translatedTruncLE γ (aeval V (MvPolynomial.monomial d.1 (1 : K))) - ∑ i ∈ t, aeval V (MvPolynomial.pderiv i (MvPolynomial.monomial d.1 (1 : K))) * translatedTruncLE γ (V i)) := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalGraded.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalGraded.lean index 182fd8aef0..147e995999 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalGraded.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalGraded.lean @@ -136,7 +136,6 @@ theorem finiteDegreeOf_zero_scalar (k : K) : finiteDegreeOf K 0 (principalComponentScalarHom K k) = algebraMap K (principalFiniteDegreePart K) k := by apply Subtype.ext - rw [coe_finiteDegreeOf] exact principalSubring_algebraMap_apply k variable (K) in diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmegaOmegaBoundary.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmegaOmegaBoundary.lean index b7094c5e16..3022e59e69 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmegaOmegaBoundary.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/OmegaOmegaBoundary.lean @@ -49,22 +49,21 @@ open ConwayRefinement.Standalone.Oz.FinitePowerFamily /-- The lexicographic sum of the finite-tuple orders of types `ω ^ n`. -/ abbrev BoundaryIndex := Σₗ n : ℕ, FiniteLex n -instance : WellFoundedLT BoundaryIndex where - wf := by - change WellFounded - (Sigma.Lex (· < ·) fun n => (· < · : FiniteLex n → FiniteLex n → Prop)) - let e := Equiv.psigmaEquivSigma (fun n : ℕ => FiniteLex n) - let f : - (Sigma.Lex (· < ·) fun n => (· < · : FiniteLex n → FiniteLex n → Prop)) ↪r - (PSigma.Lex (· < ·) fun n => (· < · : FiniteLex n → FiniteLex n → Prop)) := { - toFun := e.symm - inj' := e.symm.injective - map_rel_iff' := by - rintro ⟨i, a⟩ ⟨j, b⟩ - simp only [PSigma.lex_iff, Sigma.lex_iff] - rfl } - exact f.wellFounded - (WellFounded.psigma_lex wellFounded_lt fun n => (finiteLexWellFoundedLT n).wf) +instance : WellFoundedLT BoundaryIndex := by + change WellFounded + (Sigma.Lex (· < ·) fun n => (· < · : FiniteLex n → FiniteLex n → Prop)) + let e := Equiv.psigmaEquivSigma (fun n : ℕ => FiniteLex n) + let f : + (Sigma.Lex (· < ·) fun n => (· < · : FiniteLex n → FiniteLex n → Prop)) ↪r + (PSigma.Lex (· < ·) fun n => (· < · : FiniteLex n → FiniteLex n → Prop)) := { + toFun := e.symm + inj' := e.symm.injective + map_rel_iff' := by + rintro ⟨i, a⟩ ⟨j, b⟩ + simp only [PSigma.lex_iff, Sigma.lex_iff] + rfl } + exact f.wellFounded + (WellFounded.psigma_lex wellFounded_lt fun n => (finiteLexWellFoundedLT n)) private theorem fiber_type_le_boundary (n : ℕ) : (Ordinal.omega0 : Ordinal) ^ (n : Ordinal) ≤ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormRecursion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormRecursion.lean index 40187888e0..7e1708c3ab 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormRecursion.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormRecursion.lean @@ -97,7 +97,7 @@ theorem leadingCoeff_term (x : SurrealHahnSeries) (i : Ordinal) : · rw [term_of_le (le_of_not_gt hi), coeffIdx_of_le (le_of_not_gt hi)] simp -theorem wlog_term {x : SurrealHahnSeries} {i : Ordinal} (hi : i < x.length) : +theorem wlog_term {x : SurrealHahnSeries} {i : Ordinal} (hi : i ∈ Iio x.length) : (x.term i).wlog = x.exp ⟨i, hi⟩ := by have hc : x.coeffIdx i ≠ 0 := by rw [ne_eq, coeffIdx_eq_zero_iff] @@ -106,7 +106,7 @@ theorem wlog_term {x : SurrealHahnSeries} {i : Ordinal} (hi : i < x.length) : rw [term_of_lt hi, Surreal.wlog_mul hc' (by simp)] simp -theorem mk_term {x : SurrealHahnSeries} {i : Ordinal} (hi : i < x.length) : +theorem mk_term {x : SurrealHahnSeries} {i : Ordinal} (hi : i ∈ Iio x.length) : ArchimedeanClass.mk (x.term i) = .mk (ω^ (x.exp ⟨i, hi⟩)) := by have hc : x.coeffIdx i ≠ 0 := by rw [ne_eq, coeffIdx_eq_zero_iff] @@ -126,7 +126,7 @@ def single (r : ℝ) (e : Surreal) (hr : r ≠ 0) : TermSeq where coeff_ne_zero _ := hr /-- Appends a single term at the end of a `TermSeq`. -/ -@[simps (attr := grind =) -isSimp, expose] +@[simps (attr := grind =) -isSimp length, expose] def appendSingle (s : TermSeq) (r : ℝ) (e : Surreal) (hr : r ≠ 0) (he : ∀ i, e < s.exp i) : TermSeq where length := s.length + 1 @@ -137,6 +137,24 @@ def appendSingle (s : TermSeq) (r : ℝ) (e : Surreal) (hr : r ≠ 0) (he : ∀ attribute [simp] appendSingle_length +@[grind =] +theorem appendSingle_exp (s : TermSeq) (r : ℝ) (e : Surreal) (hr : r ≠ 0) + (he : ∀ i, e < s.exp i) (i : Iio (s.appendSingle r e hr he).length) : + (s.appendSingle r e hr he).exp i = + if h : (i : Ordinal) = s.length then e else s.exp ⟨i, by + have hi := i.property + change (i : Ordinal) < s.length + 1 at hi + exact lt_of_le_of_ne (Order.lt_add_one_iff.mp hi) h⟩ := rfl + +@[grind =] +theorem appendSingle_coeff (s : TermSeq) (r : ℝ) (e : Surreal) (hr : r ≠ 0) + (he : ∀ i, e < s.exp i) (i : Iio (s.appendSingle r e hr he).length) : + (s.appendSingle r e hr he).coeff i = + if h : (i : Ordinal) = s.length then r else s.coeff ⟨i, by + have hi := i.property + change (i : Ordinal) < s.length + 1 at hi + exact lt_of_le_of_ne (Order.lt_add_one_iff.mp hi) h⟩ := rfl + theorem exp_eq_exp_appendSingle (s : TermSeq) (i r e hr he) : s.exp i = (s.appendSingle r e hr he).exp ⟨i.1, by grind⟩ := by rw [appendSingle_exp, dite_eq_right (ne_of_lt i.2)] @@ -183,7 +201,7 @@ theorem coe_appendSingle {s : TermSeq} {r : ℝ} {e : Surreal} (hr : r ≠ 0) (h exact lt_of_le_of_ne hk' ‹↑k ≠ s.length› /-- Truncate a `TermSeq` at the i-th term. -/ -@[simps (attr := grind =), expose] +@[simps (attr := grind =) length, expose] def trunc (s : TermSeq) (i : Ordinal) : TermSeq where length := min i s.length exp i := s.exp ⟨i, by grind⟩ @@ -191,6 +209,20 @@ def trunc (s : TermSeq) (i : Ordinal) : TermSeq where exp_strictAnti _ := by grind coeff_ne_zero := by grind +@[simp, grind =] +theorem trunc_exp (s : TermSeq) (j : Ordinal) (i : Iio (s.trunc j).length) : + (s.trunc j).exp i = s.exp ⟨i, by + have hi := i.property + change (i : Ordinal) < min j s.length at hi + exact hi.trans_le (min_le_right ..)⟩ := rfl + +@[simp, grind =] +theorem trunc_coeff (s : TermSeq) (j : Ordinal) (i : Iio (s.trunc j).length) : + (s.trunc j).coeff i = s.coeff ⟨i, by + have hi := i.property + change (i : Ordinal) < min j s.length at hi + exact hi.trans_le (min_le_right ..)⟩ := rfl + @[simp] theorem trunc_of_le {s : TermSeq} {i : Ordinal} (h : s.length ≤ i) : s.trunc i = s := by ext @@ -215,7 +247,7 @@ theorem coe_trunc (s : TermSeq) (i : Ordinal) : s.trunc i = truncIdx s i := by · obtain ⟨⟨j, hj⟩, _, rfl⟩ := hj obtain hj' | hj' := lt_or_ge j i · rw [coeff_trunc_of_lt] - · have hj'' : j < (s.trunc i).length := by + · have hj'' : j ∈ Iio (s.trunc i).length := by simpa only [trunc_length, mem_Iio, lt_inf_iff] using And.intro hj' hj change coeff (s.trunc i : SurrealHahnSeries) @@ -255,7 +287,7 @@ theorem trunc_appendSingle_self (s : TermSeq) {r e} (hr he) : trunc (s.appendSingle r e hr he) s.length = s := by rw [trunc_appendSingle le_rfl , trunc_of_le le_rfl] -theorem trunc_add_one {s : TermSeq} {i} (hi : i < s.length) : +theorem trunc_add_one {s : TermSeq} {i} (hi : i ∈ Iio s.length) : s.trunc (i + 1) = (s.trunc i).appendSingle (s.coeff ⟨i, hi⟩) (s.exp ⟨i, hi⟩) (by simp) (by grind) := by have hi' : i + 1 ≤ s.length := Order.add_one_le_iff.mpr hi @@ -430,16 +462,13 @@ theorem coeffIdx_truncIdx_of_le {x : SurrealHahnSeries} {i j : Ordinal} (h : i rw [coeffIdx_truncIdx] exact ite_eq_right h.not_gt -theorem truncIdx_add_one {x : SurrealHahnSeries} {i : Ordinal} (hi : i < x.length) : +theorem truncIdx_add_one {x : SurrealHahnSeries} {i : Ordinal} (hi : i ∈ Iio x.length) : x.truncIdx (i + 1) = x.truncIdx i + single (x.exp ⟨i, hi⟩) (x.coeffIdx i) := by induction x using termSeqRecOn with | mk s - rw [← TermSeq.coe_trunc, ← TermSeq.coe_trunc, TermSeq.exp_coe, - ← TermSeq.coe_appendSingle, TermSeq.trunc_add_one] - · congr - rw [TermSeq.coeffIdx_coe_of_lt (by simpa using hi)] - · simpa using hi - · simp_rw [TermSeq.trunc_exp] - grind + have hs : i ∈ Iio s.length := by simpa using hi + have hseq := congrArg (fun t : TermSeq ↦ (t : SurrealHahnSeries)) (TermSeq.trunc_add_one hs) + rw [TermSeq.coe_appendSingle] at hseq + simpa only [TermSeq.coe_trunc, TermSeq.exp_coe, TermSeq.coeffIdx_coe_of_lt hs] using hseq theorem eq_of_length_eq_add_one {x : SurrealHahnSeries} {i : Ordinal} (hi : x.length = i + 1) : x = x.truncIdx i + single (x.exp ⟨i, by simp [hi]⟩) (x.coeffIdx i) := by @@ -462,7 +491,16 @@ theorem support_truncIdx_mono {x : SurrealHahnSeries} : @[simp] theorem exp_truncIdx {x : SurrealHahnSeries} {i : Ordinal} (j : Iio (x.truncIdx i).length) : - (x.truncIdx i).exp j = ⟨x.exp ⟨j, by aesop⟩, by aesop⟩ := by + (x.truncIdx i).exp j = ⟨x.exp ⟨j, by + exact j.property.trans_le ((length_truncIdx x i).le.trans (min_le_right ..))⟩, by + rw [support_truncIdx] + split_ifs with h + · refine ⟨(x.exp _).property, ?_⟩ + change x.exp _ > x.exp ⟨i, h⟩ + apply x.exp.map_rel_iff.mpr + change (j : Ordinal) < i + exact j.property.trans_le ((length_truncIdx x i).le.trans (min_le_left ..)) + · exact (x.exp _).property⟩ := by induction x using termSeqRecOn with | mk s apply Subtype.val_injective rw [exp_congr (TermSeq.coe_trunc s i).symm] @@ -486,16 +524,17 @@ theorem term_injective : term.Injective := by induction x using termSeqRecOn with | mk s induction y using termSeqRecOn with | mk t congr - ext i + ext i hs ht · refine eq_of_forall_ge_iff fun _ ↦ ?_ simp_rw [← TermSeq.length_coe, ← term_eq_zero, h] - · have := congrFun h i - convert congrArg Surreal.wlog this <;> - · rw [wlog_term, TermSeq.exp_coe] - simpa - · have := congrFun h i - convert congrArg Surreal.leadingCoeff this <;> - · rw [leadingCoeff_term, TermSeq.coeffIdx_coe_of_lt] + · have he := congrArg Surreal.wlog (congrFun h i) + rw [wlog_term (by simpa using hs), wlog_term (by simpa using ht), + TermSeq.exp_coe, TermSeq.exp_coe] at he + exact he + · have hc := congrArg Surreal.leadingCoeff (congrFun h i) + rw [leadingCoeff_term, leadingCoeff_term, + TermSeq.coeffIdx_coe_of_lt hs, TermSeq.coeffIdx_coe_of_lt ht] at hc + exact hc @[simp] theorem term_inj {x y : SurrealHahnSeries} : x.term = y.term ↔ x = y := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Tests/UpstreamReuse.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Tests/UpstreamReuse.lean index ae2d60e3ae..66a1684a13 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Tests/UpstreamReuse.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Tests/UpstreamReuse.lean @@ -47,6 +47,8 @@ import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Ordinal This module pins the availability and compiler-visible signatures of selected upstream interfaces. The anonymous examples retain these signature checks without adding a mathematical API. -/ +noncomputable section + universe u v w example : From 8f4227466d2ef13135a5fcfce4b122891d647ecc Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 00:27:19 +0000 Subject: [PATCH 09/18] Port Conway coefficient APIs and preserve signature fixtures --- .../Tests/GradedDivisibility.lean | 78 +++--- .../PrincipalMaximalFiniteSupportDivisor.lean | 2 +- .../SeriesMaximalFiniteSupportDivisor.lean | 2 +- .../AlgebraicIndependence/LinearMaximal.lean | 2 +- ...calarLeadingCoefficientAtLimitOrdinal.lean | 8 +- .../TruncationExpansion.lean | 18 +- .../TruncationPolynomial.lean | 28 +-- .../IntegerPart/FiniteClassPrimality.lean | 8 +- .../LeadingCoefficient.lean | 2 +- .../AlgebraicIndependence/Lifts.lean | 4 +- .../PrincipalRepresentatives.lean | 4 +- .../TruncationExpansion.lean | 18 +- .../OrdinalValue/Tests/SectionSixThree.lean | 2 +- .../PolynomialPresentation.lean | 6 +- .../PolynomialAlgebra/PolynomialRing.lean | 4 +- .../Primality/OrdinalValueQuotient.lean | 7 +- .../HahnSeries/Primality/Primality.lean | 2 +- ...PrincipalRVAlgebraicIndependenceProof.lean | 2 +- .../Support/GermPolynomialRingProof.lean | 6 +- .../Mathlib/Support/HahnSeriesGCDProof.lean | 4 +- .../Support/InlineConwayRefinementProof.lean | 14 +- .../Surreal/HahnSeries/NormalForm.lean | 5 +- .../ConwayRefinement/Tests/SourceIndex.lean | 237 +++++++++++++++++- 23 files changed, 350 insertions(+), 113 deletions(-) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/GradedDivisibility.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/GradedDivisibility.lean index ef2980faf3..b49c3a3163 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/GradedDivisibility.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/GradedDivisibility.lean @@ -43,7 +43,7 @@ public noncomputable section /-- The strictly negative exponent used in the finite-support divisibility separator. -/ def gradedDivisibilityNegativeExponent : HahnSeries.Nonpositive.exponentMonoid ℝ := - ⟨-1, by norm_num⟩ + ⟨-1, show (-1 : ℝ) ≤ 0 by norm_num⟩ /-- The finite-support Hahn monomial at exponent `-1`. -/ def gradedDivisibilityNegativeMonomial : @@ -104,7 +104,7 @@ theorem gradedDivisibilityNegativeMonomial_not_dvd_one : her hProduct have hcoeff := congrArg (fun f : AddMonoidAlgebra ℚ (HahnSeries.Nonpositive.exponentMonoid ℝ) ↦ - f gradedDivisibilityNegativeExponent) ha + f.coeff gradedDivisibilityNegativeExponent) ha simp [gradedDivisibilityNegativeExponent_ne_zero] at hcoeff /-- The graded image of the negative monomial does not divide the graded image of one. -/ @@ -117,36 +117,7 @@ theorem gradedDivisibilityNegativeMonomialGraded_not_dvd_one : ((Berarducci.finiteSupportGradedEmbedding_dvd_iff gradedDivisibilityNegativeMonomial 1).mp hDvd) -variable {K : Type v} [Field K] [CharZero K] - -variable (K) in -/-- The degree-RV class of one, used as a nonzero principal-image boundary case. -/ -def gradedDivisibilityPrincipalOneRV : Berarducci.HahnDegreeRV K := - (HahnSeries.Nonpositive.degreeValuation K).rv 1 - -variable (K) in -/-- The degree-RV class of one is principal in the exact sense of LM24, Definition 5.2.1. -/ -theorem gradedDivisibilityPrincipalOneRV_isPrincipal : - Berarducci.IsPrincipalRV (gradedDivisibilityPrincipalOneRV K) := by - rw [Berarducci.isPrincipalRV_iff] - exact ⟨1, HahnSeries.Nonpositive.isPrincipal_one, rfl⟩ - -variable (K) in -/-- The canonical graded image of the principal RV class of one belongs to `P`. -/ -theorem gradedDivisibilityPrincipalOneRV_image : - Berarducci.IsPrincipalRVImage - ((HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom - (gradedDivisibilityPrincipalOneRV K)) := - Berarducci.isPrincipalRVImage_initialForm - (gradedDivisibilityPrincipalOneRV K) - (gradedDivisibilityPrincipalOneRV_isPrincipal K) - -variable (K) in -/-- Zero is not in the image of principal RV classes because principal series are nonzero. -/ -theorem gradedDivisibilityPrincipalRVImage_zero_false : - ¬ Berarducci.IsPrincipalRVImage (0 : Berarducci.DegreeGraded K) := by - intro hzero - exact (Berarducci.isPrincipalRVImage_iff _).mp hzero |>.1 rfl +variable {K : Type v} [Field K] /-- A graded element supported in the two distinct grades zero and one. -/ def gradedDivisibilityTwoComponent (a₀ : (HahnSeries.Nonpositive.degreeValuation K).Component 0) @@ -154,7 +125,6 @@ def gradedDivisibilityTwoComponent (a₀ : (HahnSeries.Nonpositive.degreeValuati Berarducci.DegreeGraded K := DirectSum.of _ 0 a₀ + DirectSum.of _ 1 a₁ -omit [CharZero K] in /-- The two-component fixture retains its prescribed grade-zero and grade-one components. -/ theorem gradedDivisibilityTwoComponent_components (a₀ : (HahnSeries.Nonpositive.degreeValuation K).Component 0) @@ -163,7 +133,6 @@ theorem gradedDivisibilityTwoComponent_components gradedDivisibilityTwoComponent a₀ a₁ 1 = a₁ := by simp [gradedDivisibilityTwoComponent, DirectSum.of_apply] -omit [CharZero K] in /-- With a nonzero grade-zero component, the fixture's trailing grade is zero. -/ theorem gradedDivisibilityTwoComponent_trailingValue (a₀ : (HahnSeries.Nonpositive.degreeValuation K).Component 0) @@ -178,7 +147,6 @@ theorem gradedDivisibilityTwoComponent_trailingValue exact ⟨by simpa [gradedDivisibilityTwoComponent, DirectSum.of_apply] using ha₀, fun _ _ ↦ bot_le⟩ -omit [CharZero K] in /-- With a nonzero grade-one component, the fixture's leading grade is one. -/ theorem gradedDivisibilityTwoComponent_leadingValue (a₀ : (HahnSeries.Nonpositive.degreeValuation K).Component 0) @@ -202,7 +170,6 @@ theorem gradedDivisibilityTwoComponent_leadingValue simp [gradedDivisibilityTwoComponent, DirectSum.of_apply, Ne.symm hi₀, Ne.symm hi₁] exact (hi hzero).elim -omit [CharZero K] in /-- With both displayed components nonzero, the two-component fixture is not in degree RV. -/ theorem gradedDivisibilityTwoComponent_not_homogeneous (a₀ : (HahnSeries.Nonpositive.degreeValuation K).Component 0) @@ -226,10 +193,41 @@ theorem gradedDivisibilityTwoComponent_not_homogeneous WithBot.coe_injective (hleadOne.symm.trans hlead) exact zero_ne_one (hzeroM.trans honeM.symm) +variable [CharZero K] + +variable (K) in +/-- The degree-RV class of one, used as a nonzero principal-image boundary case. -/ +def gradedDivisibilityPrincipalOneRV : Berarducci.HahnDegreeRV K := + (HahnSeries.Nonpositive.degreeValuation K).rv 1 + +variable (K) in +/-- The degree-RV class of one is principal in the exact sense of LM24, Definition 5.2.1. -/ +theorem gradedDivisibilityPrincipalOneRV_isPrincipal : + Berarducci.IsPrincipalRV (gradedDivisibilityPrincipalOneRV K) := by + rw [Berarducci.isPrincipalRV_iff] + exact ⟨1, HahnSeries.Nonpositive.isPrincipal_one, rfl⟩ + +variable (K) in +/-- The canonical graded image of the principal RV class of one belongs to `P`. -/ +theorem gradedDivisibilityPrincipalOneRV_image : + Berarducci.IsPrincipalRVImage + ((HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom + (gradedDivisibilityPrincipalOneRV K)) := + Berarducci.isPrincipalRVImage_initialForm + (gradedDivisibilityPrincipalOneRV K) + (gradedDivisibilityPrincipalOneRV_isPrincipal K) + +variable (K) in +/-- Zero is not in the image of principal RV classes because principal series are nonzero. -/ +theorem gradedDivisibilityPrincipalRVImage_zero_false : + ¬ Berarducci.IsPrincipalRVImage (0 : Berarducci.DegreeGraded K) := by + intro hzero + exact (Berarducci.isPrincipalRVImage_iff _).mp hzero |>.1 rfl + /-- The strictly negative exponent used to separate `P̂` from `RV̂`. -/ def gradedDivisibilityNonprincipalExponent : HahnSeries.Nonpositive.exponentMonoid ℝ := - ⟨-1, by norm_num⟩ + ⟨-1, show (-1 : ℝ) ≤ 0 by norm_num⟩ variable (K) in /-- A principal coefficient multiplied by a strictly negative finite-support monomial. -/ @@ -275,13 +273,13 @@ theorem gradedDivisibilityNonprincipalElement_not_mem : have hcoeff := congrArg (fun f : AddMonoidAlgebra (Berarducci.PrincipalSubring K) (HahnSeries.Nonpositive.exponentMonoid ℝ) ↦ - f gradedDivisibilityNonprincipalExponent) hcoordinates + f.coeff gradedDivisibilityNonprincipalExponent) hcoordinates have hne : gradedDivisibilityNonprincipalExponent ≠ 0 := by intro h have := congrArg Subtype.val h norm_num [gradedDivisibilityNonprincipalExponent] at this - rw [AddMonoidAlgebra.single_apply, ite_eq_right (Ne.symm hne), - AddMonoidAlgebra.single_apply, ite_eq_left rfl] at hcoeff + rw [AddMonoidAlgebra.coeff_single, Finsupp.single_apply, ite_eq_right (Ne.symm hne), + AddMonoidAlgebra.coeff_single, Finsupp.single_apply, ite_eq_left rfl] at hcoeff have hgraded : (0 : Berarducci.DegreeGraded K) = 1 := by simpa using congrArg diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/PrincipalMaximalFiniteSupportDivisor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/PrincipalMaximalFiniteSupportDivisor.lean index 66e418c02a..b9a724f098 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/PrincipalMaximalFiniteSupportDivisor.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/PrincipalMaximalFiniteSupportDivisor.lean @@ -129,7 +129,7 @@ theorem principalInvariantGraded_components_ne_zero : /-- The strictly negative exponent used by the nonconstant finite-support fixture. -/ def principalInvariantNegativeExponent : HahnSeries.Nonpositive.exponentMonoid ℝ := - ⟨-1, by norm_num⟩ + ⟨-1, show (-1 : ℝ) ≤ 0 by norm_num⟩ /-- The nonconstant finite-support monomial `t⁻¹`. -/ def principalInvariantFiniteMonomial : Berarducci.FiniteSupportRing (K := ℚ) := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/SeriesMaximalFiniteSupportDivisor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/SeriesMaximalFiniteSupportDivisor.lean index bd87a4698c..a57e5cf67f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/SeriesMaximalFiniteSupportDivisor.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/SeriesMaximalFiniteSupportDivisor.lean @@ -32,7 +32,7 @@ public noncomputable section /-- The finite-support monomial `x = t⁻¹` used in LM24, Example 5.5.4. -/ def seriesMaximalExampleMonomial : Berarducci.FiniteSupportRing (K := ℚ) := - HahnSeries.Nonpositive.finiteSupportMonomial (K := ℚ) ⟨-1, by norm_num⟩ + HahnSeries.Nonpositive.finiteSupportMonomial (K := ℚ) ⟨-1, show (-1 : ℝ) ≤ 0 by norm_num⟩ /-- The leading-RV maximal divisor `p₀ = 1 - t⁻²` from LM24, Example 5.5.4. -/ def seriesMaximalExampleRVDivisor : Berarducci.FiniteSupportRing (K := ℚ) := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LinearMaximal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LinearMaximal.lean index 8da8805a5e..f8fae8df8d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LinearMaximal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LinearMaximal.lean @@ -205,7 +205,7 @@ theorem degreeOf_eq_one rw [weightedTotalDegree, hsup] by_contra hnot have hle : τ ≤ Finsupp.weight wt d := not_lt.mp hnot - have hcoeff := congrArg (MvPolynomial.coeff d) (hzero γ hγ hγ0) + have hcoeff := congrArg (fun p : MvPolynomial ι K ↦ p.coeff d) (hzero γ hγ hγ0) rw [coeff_componentsGE, ite_eq_left hle, MvPolynomial.coeff_zero] at hcoeff exact mem_support_iff.mp hd hcoeff simpa only [add_zero] using hdeglt diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/ScalarLeadingCoefficientAtLimitOrdinal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/ScalarLeadingCoefficientAtLimitOrdinal.lean index 2a909ef73c..2f7af77037 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/ScalarLeadingCoefficientAtLimitOrdinal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/ScalarLeadingCoefficientAtLimitOrdinal.lean @@ -87,9 +87,9 @@ theorem false_of_aeval_eq_zero_of_leadingCoefficientDegree_eq_zero have h := hFkhom (D' + 1) le_rfl rwa [Nat.sub_self, zero_smul] at h have hFDC : xCoeff B₀ (D' + 1) F = - MvPolynomial.C (MvPolynomial.coeff 0 (xCoeff B₀ (D' + 1) F)) := + MvPolynomial.C ((xCoeff B₀ (D' + 1) F).coeff 0) := OrdinalGraded.eq_C_of_isWeightedHomogeneous_zero hx.ne_zero hFDhom - let c := MvPolynomial.coeff 0 (xCoeff B₀ (D' + 1) F) + let c := (xCoeff B₀ (D' + 1) F).coeff 0 have hc0 : c ≠ 0 := fun hc ↦ hFD (by rw [hFDC] change MvPolynomial.C c = 0 @@ -108,10 +108,10 @@ theorem false_of_aeval_eq_zero_of_leadingCoefficientDegree_eq_zero rwa [zero_add] at h have hhne : hpoly ≠ 0 := by intro h - have hc := congrArg (MvPolynomial.coeff (Finsupp.single B₀ 1)) h + have hc := congrArg (fun p : MvPolynomial ι K ↦ p.coeff (Finsupp.single B₀ 1)) h rw [MvPolynomial.coeff_add, MvPolynomial.coeff_C_mul, MvPolynomial.coeff_X, ite_eq_left rfl, mul_one, MvPolynomial.coeff_zero] at hc - have hleft : MvPolynomial.coeff (Finsupp.single B₀ 1) (xCoeff B₀ D' F) = 0 := by + have hleft : (xCoeff B₀ D' F).coeff (Finsupp.single B₀ 1) = 0 := by by_contra hne exact (mem_supported.mp (hFkmem D')) ((mem_vars_iff_mem_support B₀).mpr diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationExpansion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationExpansion.lean index 101dfc6152..6585660e01 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationExpansion.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationExpansion.lean @@ -377,7 +377,7 @@ theorem exists_pol_translatedTruncLE_aeval (α : WithBot NatOrdinal) := fun d hd ↦ (hmonomialBounds d hd).degree_translatedTruncLE_lt hγ |>.trans_le (WithBot.coe_le_coe.mpr (hH d hd)) - refine ⟨∑ d ∈ H.support.attach, MvPolynomial.C (MvPolynomial.coeff d.1 H) * E d.1 d.2, + refine ⟨∑ d ∈ H.support.attach, MvPolynomial.C (H.coeff d.1) * E d.1 d.2, ?_, ?_⟩ · intro d' hd' obtain ⟨d, _, hd'd⟩ := Finset.mem_biUnion.mp (support_sum hd') @@ -386,19 +386,19 @@ theorem exists_pol_translatedTruncLE_aeval exact support_smul hd'd obtain ⟨k, hk, hterm⟩ := hE d.1 d.2 d' hd'E exact ⟨d.1, d.2, k, hk, hterm⟩ - have hmonomial : ∀ d, monomial d (MvPolynomial.coeff d H) = - MvPolynomial.C (MvPolynomial.coeff d H) * monomial d (1 : K) := fun d ↦ by + have hmonomial : ∀ d, monomial d (H.coeff d) = + MvPolynomial.C (H.coeff d) * monomial d (1 : K) := fun d ↦ by rw [C_mul_monomial, mul_one] have hleft : σ.pol hx α (translatedTruncLE γ (aeval σ.lift H)) = ∑ d ∈ H.support.attach, - MvPolynomial.C (MvPolynomial.coeff d.1 H) * + MvPolynomial.C (H.coeff d.1) * σ.pol hx α (translatedTruncLE γ (aeval σ.lift (monomial d.1 (1 : K)))) := by conv_lhs => rw [H.as_sum] rw [map_sum, map_sum, ← Finset.sum_attach H.support] have hterm : ∀ d ∈ H.support.attach, translatedTruncLE γ (aeval σ.lift - (monomial d.1 (MvPolynomial.coeff d.1 H))) = - MvPolynomial.coeff d.1 H • translatedTruncLE γ + (monomial d.1 (H.coeff d.1))) = + H.coeff d.1 • translatedTruncLE γ (aeval σ.lift (monomial d.1 (1 : K))) := by intro d _ rw [hmonomial, map_mul, aeval_C, ← Algebra.smul_def, translatedTruncLE_smul] @@ -415,12 +415,12 @@ theorem exists_pol_translatedTruncLE_aeval rw [pderiv_monomial, Finsupp.notMem_support_iff.mp hj, Nat.cast_zero, mul_zero, monomial_zero] have hpd : ∀ j, pderiv j H = - ∑ d ∈ H.support.attach, MvPolynomial.C (MvPolynomial.coeff d.1 H) * + ∑ d ∈ H.support.attach, MvPolynomial.C (H.coeff d.1) * pderiv j (monomial d.1 1) := fun j ↦ by conv_lhs => rw [H.as_sum, map_sum, ← Finset.sum_attach H.support] exact Finset.sum_congr rfl fun d _ ↦ by rw [hmonomial, pderiv_C_mul] rw [Finset.sum_congr rfl (fun d _ ↦ congrArg - (MvPolynomial.C (MvPolynomial.coeff d.1 H) * ·) (hEq d.1 d.2))] + (MvPolynomial.C (H.coeff d.1) * ·) (hEq d.1 d.2))] simp only [mul_add, Finset.sum_add_distrib] congr 1 simp only [hpd, Finset.mul_sum] @@ -437,7 +437,7 @@ theorem exists_pol_translatedTruncLE_aeval rw [Finset.mul_sum] exact Finset.sum_congr rfl fun j _ ↦ by exact mul_left_comm - (MvPolynomial.C (MvPolynomial.coeff d.1 H)) + (MvPolynomial.C (H.coeff d.1)) (σ.pol hx α (translatedTruncLE γ (σ.lift j))) _ include hx in diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationPolynomial.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationPolynomial.lean index 1094f8aaed..dc674ac5e3 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationPolynomial.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationPolynomial.lean @@ -113,7 +113,7 @@ theorem pol_eq_of_degree_sub_aeval_eq_bot {α : NatOrdinal.{u}} exact hinj β hβα apply eq_zero_of_forall_weight_lt_of_degree_aeval_eq_bot xg σ.represents (fun β P hβα hP hP0 ↦ hinj' β hβα P hP hP0) (fun d hd ↦ by - have hdne : MvPolynomial.coeff d (σ.pol hx α u - F) ≠ 0 := mem_support_iff.mp hd + have hdne : (σ.pol hx α u - F).coeff d ≠ 0 := mem_support_iff.mp hd rw [MvPolynomial.coeff_sub ι] at hdne by_cases hdpol : d ∈ (σ.pol hx α u).support · exact σ.pol_weight_lt hx α u d hdpol @@ -157,7 +157,7 @@ theorem pol_add {α : NatOrdinal.{u}} have huv : ν (u + v) < (α : WithBot NatOrdinal) := ((ν).map_add_le_max u v).trans_lt (max_lt hu hv) apply σ.pol_eq_of_degree_sub_aeval_eq_bot hx hinj huv (fun d hd ↦ by - have hdne : MvPolynomial.coeff d (σ.pol hx α u + σ.pol hx α v) ≠ 0 := + have hdne : (σ.pol hx α u + σ.pol hx α v).coeff d ≠ 0 := mem_support_iff.mp hd rw [MvPolynomial.coeff_add] at hdne by_cases hdu : d ∈ (σ.pol hx α u).support @@ -205,7 +205,7 @@ theorem pol_smul {α : NatOrdinal.{u}} (degree_smul_le k u).trans_lt hu apply σ.pol_eq_of_degree_sub_aeval_eq_bot hx hinj hku · intro d hd - have hdne : MvPolynomial.coeff d (k • σ.pol hx α u) ≠ 0 := + have hdne : (k • σ.pol hx α u).coeff d ≠ 0 := mem_support_iff.mp hd rw [MvPolynomial.coeff_smul] at hdne exact σ.pol_weight_lt hx α u d @@ -620,7 +620,7 @@ theorem one {α : NatOrdinal.{u}} {B₀ : ι} (hα : 0 < α) rw [← map_one (MvPolynomial.aeval (R := K) σ.lift)] exact σ.pol_aeval hx hinj (F := 1) (by intro d hd - have hdne : MvPolynomial.coeff d (1 : MvPolynomial ι K) ≠ 0 := + have hdne : (1 : MvPolynomial ι K).coeff d ≠ 0 := mem_support_iff.mp hd rw [MvPolynomial.coeff_one] at hdne split_ifs at hdne with hd0 @@ -731,7 +731,7 @@ theorem pow {α : NatOrdinal.{u}} {B₀ : ι} {a : Nonpositive G K} {m : NatOrdi rw [← map_one (aeval (R := K) σ.lift)] exact σ.pol_aeval hx hinj (F := 1) (by intro d hd - have hdne : MvPolynomial.coeff d (1 : MvPolynomial ι K) ≠ 0 := + have hdne : (1 : MvPolynomial ι K).coeff d ≠ 0 := mem_support_iff.mp hd rw [MvPolynomial.coeff_one] at hdne split_ifs at hdne with hd0 @@ -780,7 +780,7 @@ theorem prod {α : NatOrdinal.{u}} {B₀ : ι} {κ : Type*} (hα : 0 < α) rw [← map_one (aeval (R := K) σ.lift)] exact σ.pol_aeval hx hinj (F := 1) (by intro d hd - have hdne : MvPolynomial.coeff d (1 : MvPolynomial ι K) ≠ 0 := + have hdne : (1 : MvPolynomial ι K).coeff d ≠ 0 := mem_support_iff.mp hd rw [MvPolynomial.coeff_one] at hdne split_ifs at hdne with hd0 @@ -851,13 +851,13 @@ theorem aeval (hσ : HasLowerTruncationDegrees σ) {α : NatOrdinal.{u}} {B₀ : exact (mem_supported.mp hmem) hv rfl have hwt : ∀ i ∈ d.support, wt i ≤ wt B₀ := fun i hi ↦ hle i ((mem_vars_iff_mem_support i).mpr ⟨d, hd, hi⟩) - have hmono : (monomial d (MvPolynomial.coeff d F) : MvPolynomial ι K) = - MvPolynomial.C (MvPolynomial.coeff d F) * monomial d 1 := by + have hmono : (monomial d (F.coeff d) : MvPolynomial ι K) = + MvPolynomial.C (F.coeff d) * monomial d 1 := by rw [C_mul_monomial, mul_one] rw [hmono, map_mul, aeval_C, Algebra.algebraMap_eq_smul_one, smul_mul_assoc, one_mul] rw [← hdw] exact (aeval_monomial (σ := σ) (hx := hx) hσ hinj hB₀ d hd0 hwt - (hdw ▸ hm)).smul (MvPolynomial.coeff d F) hinj + (hdw ▸ hm)).smul (F.coeff d) hinj /-- Multiplying a free series by a power of the distinguished lift is represented by the corresponding variable power. -/ @@ -1035,7 +1035,7 @@ theorem pol_translatedTruncLE_aeval_mem_supported have hα0 : α ≠ 0 := ne_of_gt ((zero_le : (0 : NatOrdinal) ≤ wt B₀).trans_lt hB₀) have hterm : ∀ d ∈ F.support, σ.pol hx α (translatedTruncLE γ - (MvPolynomial.aeval σ.lift (monomial d (MvPolynomial.coeff d F)))) ∈ + (MvPolynomial.aeval σ.lift (monomial d (F.coeff d)))) ∈ supported K {B₀}ᶜ := by intro d hd have hdw : Finsupp.weight wt d = α := hF (mem_support_iff.mp hd) @@ -1096,8 +1096,8 @@ theorem pol_translatedTruncLE_aeval_mem_supported ((MvPolynomial.aeval σ.lift (monomial d' (1 : K)) : Nonpositive G K) : HahnSeries G K) γ q).mp hq).2.1)) - have hmono : (monomial d (MvPolynomial.coeff d F) : MvPolynomial ι K) = - MvPolynomial.C (MvPolynomial.coeff d F) * monomial d (1 : K) := by + have hmono : (monomial d (F.coeff d) : MvPolynomial ι K) = + MvPolynomial.C (F.coeff d) * monomial d (1 : K) := by rw [C_mul_monomial, mul_one] rw [hmono, map_mul, aeval_C, Algebra.algebraMap_eq_smul_one, smul_mul_assoc, one_mul, translatedTruncLE_smul, σ.pol_smul hx hinj] @@ -1105,12 +1105,12 @@ theorem pol_translatedTruncLE_aeval_mem_supported · exact (σ.hasLowerTruncationDegree_aeval hσ (isWeightedHomogeneous_monomial wt d (1 : K) hdw)).degree_translatedTruncLE_lt hγ have hexp : MvPolynomial.aeval σ.lift F = ∑ d ∈ F.support, - MvPolynomial.aeval σ.lift (monomial d (MvPolynomial.coeff d F)) := by + MvPolynomial.aeval σ.lift (monomial d (F.coeff d)) := by conv_lhs => rw [F.as_sum] rw [map_sum] rw [hexp, map_sum, σ.pol_sum hx hinj _ _ (fun d hd ↦ by have hp := σ.hasLowerTruncationDegree_aeval hσ (isWeightedHomogeneous_monomial wt d - (MvPolynomial.coeff d F) (hF (mem_support_iff.mp hd))) + (F.coeff d) (hF (mem_support_iff.mp hd))) exact hp.degree_translatedTruncLE_lt hγ)] exact Subalgebra.sum_mem _ fun d hd ↦ hterm d hd diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassPrimality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassPrimality.lean index 2c37dd6b5c..af16f48694 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassPrimality.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassPrimality.lean @@ -233,8 +233,8 @@ theorem isPrimal_restrictDomain_tailSubmodule_of_ambient_finiteClasses (hxclasses : ArchimedeanClass.mk '' (x : HahnSeries G R).support ⊆ T₀ ∪ T₁) : let P := FiniteArchimedeanClass.tailSubmodule ℚ {c : FiniteArchimedeanClass G | c.1 ∈ T₀} - IsPrimal (restrictDomain P.toAddSubgroup.subtype Subtype.val_injective - (fun _ _ ↦ Iff.rfl) Z x) := by + IsPrimal (restrictDomain P.toAddSubgroup.subtype P.toAddSubgroup.subtype_injective + (fun _ _ ↦ ⟨fun h ↦ h, fun h ↦ h⟩) Z x) := by let P := FiniteArchimedeanClass.tailSubmodule ℚ {c : FiniteArchimedeanClass G | c.1 ∈ T₀} apply isPrimal_addSubgroup_of_ambient_finiteClasses Z hfinite P.toAddSubgroup @@ -243,8 +243,8 @@ theorem isPrimal_restrictDomain_tailSubmodule_of_ambient_finiteClasses HahnSeries.supportArchimedeanClasses_coeff_zero_convexQuotientSplitRingEquiv_finite (K := ℚ) T₀ T₁ hT₀gt hT₁ (x : HahnSeries G R) hxclasses rw [HahnSeries.coeff_zero_convexQuotientSplitRingEquiv] at hfinite' - have hre : ((restrictDomain P.toAddSubgroup.subtype Subtype.val_injective - (fun _ _ ↦ Iff.rfl) Z x : + have hre : ((restrictDomain P.toAddSubgroup.subtype P.toAddSubgroup.subtype_injective + (fun _ _ ↦ ⟨fun h ↦ h, fun h ↦ h⟩) Z x : cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) : HahnSeries P R) = HahnSeries.restrictDomain (HahnSeries.submoduleOrderEmbedding P) (x : HahnSeries G R) := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LeadingCoefficient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LeadingCoefficient.lean index 6c3ee0233e..85377fcfcd 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LeadingCoefficient.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LeadingCoefficient.lean @@ -296,7 +296,7 @@ theorem freeOfVariable_aeval (hg : wt B₀ < α) {F : MvPolynomial ι K} {β : N rw [map_sum] refine σ.freeOfVariable_sum hx hinj B₀ hβ _ _ fun d hd ↦ ?_ have hdw : Finsupp.weight wt d = β := hF (mem_support_iff.mp hd) - have hmono : (monomial d (coeff d F) : MvPolynomial ι K) = C (coeff d F) * monomial d 1 := by + have hmono : (monomial d (F.coeff d) : MvPolynomial ι K) = C (F.coeff d) * monomial d 1 := by rw [C_mul_monomial, mul_one] rw [hmono, map_mul, aeval_C, HahnSeries.Nonpositive.algebraMap_apply, aeval_monomial, map_one, one_mul, Finsupp.prod] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Lifts.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Lifts.lean index 7d2fe2bc58..9acb007b24 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Lifts.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Lifts.lean @@ -272,9 +272,9 @@ theorem weightedHomogeneousComponent_weightedTotalDegree_ne_zero {F : MvPolynomi obtain ⟨d, hd, hsup⟩ := Finset.exists_mem_eq_sup _ (support_nonempty.mpr hF0) (Finsupp.weight wt) intro h - have := congrArg (coeff d) h + have := congrArg (fun p : MvPolynomial ι K ↦ p.coeff d) h rw [coeff_weightedHomogeneousComponent, ite_eq_left (by rw [weightedTotalDegree, hsup]), - coeff_zero] at this + AddMonoidAlgebra.coeff_zero, Finsupp.zero_apply] at this exact mem_support_iff.mp hd this /-- Removing the top homogeneous component leaves a polynomial of degree below the top degree. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalRepresentatives.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalRepresentatives.lean index 21f731bb23..c4329bf236 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalRepresentatives.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PrincipalRepresentatives.lean @@ -239,12 +239,12 @@ theorem IsPrincipal.ordinalValue_translatedTruncation_aeval_lt (hwt : ∀ i, wt ordinalValue (translatedTruncation ((aeval σ.lift q : Series K) : K⟦ℝ⟧) ζ) < ω^ c := by classical have hsplit : translatedTruncation ((aeval σ.lift q : Series K) : K⟦ℝ⟧) ζ = - ∑ d ∈ q.support, (HahnSeries.Nonpositive.C : K →+* Series K) (coeff d q) * + ∑ d ∈ q.support, (HahnSeries.Nonpositive.C : K →+* Series K) (q.coeff d) * translatedTruncation ((aeval σ.lift (monomial d (1 : K)) : Series K) : K⟦ℝ⟧) ζ := by conv_lhs => rw [q.as_sum, map_sum] rw [AddSubmonoidClass.coe_finsetSum, ← translatedTruncationAddMonoidHom_apply, map_sum] refine Finset.sum_congr rfl fun d _ ↦ ?_ - have hmon : monomial d (coeff d q) = C (coeff d q) * monomial d (1 : K) := by + have hmon : monomial d (q.coeff d) = C (q.coeff d) * monomial d (1 : K) := by rw [C_mul_monomial, mul_one] rw [translatedTruncationAddMonoidHom_apply, hmon, map_mul, aeval_C, HahnSeries.Nonpositive.algebraMap_apply, Subring.coe_mul, HahnSeries.Nonpositive.coe_C, diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationExpansion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationExpansion.lean index a12117fb02..7496d28c57 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationExpansion.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationExpansion.lean @@ -436,14 +436,14 @@ theorem exists_forall_pol_translatedTruncation_aeval (H : MvPolynomial ι K) fun i hi ↦ hvars i ((mem_vars_iff_mem_support i).mpr ⟨d, hd, hi⟩) refine ⟨ε, hε, fun γ hγε hγ0 ↦ ?_⟩ -- the translated truncation of `H(b_𝓑)` as a sum over the monomials of `H` - have hmon : ∀ d, monomial d (coeff d H) = C (coeff d H) * monomial d (1 : K) := fun d ↦ by + have hmon : ∀ d, monomial d (H.coeff d) = C (H.coeff d) * monomial d (1 : K) := fun d ↦ by rw [C_mul_monomial, mul_one] - have hcoe : ∀ d, aeval σ.lift (monomial d (coeff d H)) = - (HahnSeries.Nonpositive.C : K →+* Series K) (coeff d H) * + have hcoe : ∀ d, aeval σ.lift (monomial d (H.coeff d)) = + (HahnSeries.Nonpositive.C : K →+* Series K) (H.coeff d) * aeval σ.lift (monomial d (1 : K)) := fun d ↦ by rw [hmon, map_mul, aeval_C, HahnSeries.Nonpositive.algebraMap_apply] have hsplit : translatedTruncation ((aeval σ.lift H : Series K) : K⟦ℝ⟧) γ = - ∑ d ∈ H.support, (HahnSeries.Nonpositive.C : K →+* Series K) (coeff d H) * + ∑ d ∈ H.support, (HahnSeries.Nonpositive.C : K →+* Series K) (H.coeff d) * translatedTruncation ((aeval σ.lift (monomial d (1 : K)) : Series K) : K⟦ℝ⟧) γ := by conv_lhs => rw [H.as_sum, map_sum] rw [AddSubmonoidClass.coe_finsetSum, ← translatedTruncationAddMonoidHom_apply, map_sum] @@ -451,7 +451,7 @@ theorem exists_forall_pol_translatedTruncation_aeval (H : MvPolynomial ι K) rw [translatedTruncationAddMonoidHom_apply, hcoe, Subring.coe_mul, HahnSeries.Nonpositive.coe_C, translatedTruncation_C_mul] have hval : ∀ d ∈ H.support, - ordinalValue ((HahnSeries.Nonpositive.C : K →+* Series K) (coeff d H) * + ordinalValue ((HahnSeries.Nonpositive.C : K →+* Series K) (H.coeff d) * translatedTruncation ((aeval σ.lift (monomial d (1 : K)) : Series K) : K⟦ℝ⟧) γ) < ω^ α := fun d hd ↦ ordinalValue_C_mul_lt _ (hmono γ hγε hγ0 d hd).1 refine ⟨?_, ?_⟩ @@ -459,7 +459,7 @@ theorem exists_forall_pol_translatedTruncation_aeval (H : MvPolynomial ι K) exact ordinalValue_sum_lt _ _ (NatOrdinal.wpow_pos α) hval -- the expansions of the monomials choose E hE hexp using fun d (hd : d ∈ H.support) ↦ (hmono γ hγε hγ0 d hd).2 - refine ⟨∑ d ∈ H.support.attach, C (coeff d.1 H) * E d.1 d.2, fun d' hd' ↦ ?_, ?_⟩ + refine ⟨∑ d ∈ H.support.attach, C (H.coeff d.1) * E d.1 d.2, fun d' hd' ↦ ?_, ?_⟩ · obtain ⟨d, _, hd'd⟩ := Finset.mem_biUnion.mp (support_sum hd') have hd'E : d' ∈ (E d.1 d.2).support := by rw [C_mul'] at hd'd @@ -476,8 +476,8 @@ theorem exists_forall_pol_translatedTruncation_aeval (H : MvPolynomial ι K) (mem_vars_iff_mem_support j).mpr ⟨d, hd, hj⟩ -- the left-hand side have hlhs : σ.pol hx α (translatedTruncation ((aeval σ.lift H : Series K) : K⟦ℝ⟧) γ) = - ∑ d ∈ H.support.attach, (C (coeff d.1 H) * ∑ j ∈ H.vars, T j * pderiv j (monomial d.1 1) + - C (coeff d.1 H) * E d.1 d.2) := by + ∑ d ∈ H.support.attach, (C (H.coeff d.1) * ∑ j ∈ H.vars, T j * pderiv j (monomial d.1 1) + + C (H.coeff d.1) * E d.1 d.2) := by rw [hsplit, σ.pol_sum hx hinj _ _ hval, ← Finset.sum_attach H.support] refine Finset.sum_congr rfl fun d _ ↦ ?_ rw [σ.pol_C_mul hx hinj _ (hmono γ hγε hγ0 _ d.2).1, hexp d.1 d.2, mul_add] @@ -485,7 +485,7 @@ theorem exists_forall_pol_translatedTruncation_aeval (H : MvPolynomial ι K) exact Finset.sum_subset (hsub d.1 d.2) fun j _ hj ↦ by rw [hsupp d.1 j hj, mul_zero] -- the right-hand side have hpd : ∀ j, pderiv j H = - ∑ d ∈ H.support.attach, C (coeff d.1 H) * pderiv j (monomial d.1 1) := fun j ↦ by + ∑ d ∈ H.support.attach, C (H.coeff d.1) * pderiv j (monomial d.1 1) := fun j ↦ by conv_lhs => rw [H.as_sum, map_sum, ← Finset.sum_attach H.support] exact Finset.sum_congr rfl fun d _ ↦ by rw [hmon, pderiv_C_mul] rw [hlhs, Finset.sum_add_distrib] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/SectionSixThree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/SectionSixThree.lean index d79d3991bc..0d2646bdba 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/SectionSixThree.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/SectionSixThree.lean @@ -131,7 +131,7 @@ theorem sectionSixThree_zeroSeriesFactorWitness (b c : Berarducci.Series K) (hbc /-- The finite-support monomial `t⁻¹` used in the nonconstant multiplicativity fixture. -/ def sectionSixThreeNegativeMonomial : Berarducci.FiniteSupportRing (K := ℚ) := - finiteSupportMonomial (K := ℚ) ⟨-1, by norm_num⟩ + finiteSupportMonomial (K := ℚ) ⟨-1, show (-1 : ℝ) ≤ 0 by norm_num⟩ /-- The first nonconstant factor `t⁻¹ + 1`. -/ def sectionSixThreeLeftSeries : Berarducci.Series ℚ := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialPresentation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialPresentation.lean index 701065ca16..9e9abad8dd 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialPresentation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialPresentation.lean @@ -148,7 +148,7 @@ structure IsPolynomialPresentation (b : ι → Nonpositive ℝ K) : Prop where Nonpositive ℝ K) /-- A polynomial whose value has degree at most zero is a constant. -/ eq_C_of_degree_le_zero : ∀ G : MvPolynomial ι (Berarducci.FiniteSupportRing (K := K)), - degreeValuation K (MvPolynomial.aeval b G) ≤ 0 → G = MvPolynomial.C (MvPolynomial.coeff 0 G) + degreeValuation K (MvPolynomial.aeval b G) ≤ 0 → G = MvPolynomial.C (G.coeff 0) /-- `K_fin[b_i]` is saturated under the nonzero scalars of `K_fin`. -/ mem_range_of_mul_mem_range : ∀ (u : Berarducci.FiniteSupportRing (K := K)) (t : Nonpositive ℝ K), u ≠ 0 → (u : Nonpositive ℝ K) * t ∈ (MvPolynomial.aeval b : MvPolynomial ι @@ -176,13 +176,13 @@ theorem isUnit_of_C_mul_eq_coordinatePolynomialMap (FiniteSupportFractionField (K := K)) u) * G = coordinatePolynomialMap K ι G') (hdeg : degreeValuation K (MvPolynomial.aeval b G') ≤ 0) : IsUnit G := by rw [hb.eq_C_of_degree_le_zero G' hdeg, coordinatePolynomialMap, MvPolynomial.map_C] at hGG' - have hc : MvPolynomial.coeff 0 G' ≠ 0 := by + have hc : G'.coeff 0 ≠ 0 := by intro hc rw [hc, map_zero, MvPolynomial.C_0, mul_eq_zero, MvPolynomial.C_eq_zero, map_eq_zero_iff _ (IsFractionRing.injective _ _)] at hGG' exact hGG'.elim hu hG have hunit : IsUnit (MvPolynomial.C (algebraMap (Berarducci.FiniteSupportRing (K := K)) - (FiniteSupportFractionField (K := K)) (MvPolynomial.coeff 0 G')) : + (FiniteSupportFractionField (K := K)) (G'.coeff 0)) : MvPolynomial ι (FiniteSupportFractionField (K := K))) := (isUnit_iff_ne_zero.mpr ((map_ne_zero_iff _ (IsFractionRing.injective _ _)).mpr hc)).map MvPolynomial.C diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialRing.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialRing.lean index d7b1adb032..2dfad1252b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialRing.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialRing.lean @@ -287,10 +287,10 @@ theorem evalAtLifts_injective : Function.Injective (evalAtLifts σ) := /-- A polynomial `G` whose value `G(b)` has degree at most zero is constant: its weighted total degree is zero, and every generator has positive degree. -/ theorem eq_C_of_degree_evalAtLifts_le_zero {G : MvPolynomial ι (FiniteSupportRing (K := K))} - (hG : degreeValuation K (evalAtLifts σ G) ≤ 0) : G = C (coeff 0 G) := by + (hG : degreeValuation K (evalAtLifts σ G) ≤ 0) : G = C (G.coeff 0) := by classical by_cases hzero : G = 0 - · rw [hzero, MvPolynomial.coeff_zero, C_0] + · rw [hzero, AddMonoidAlgebra.coeff_zero, Finsupp.zero_apply, C_0] rw [degree_evalAtLifts_eq hx σ hzero, ← WithBot.coe_zero, WithBot.coe_le_coe] at hG refine MvPolynomial.ext _ _ fun d ↦ ?_ rw [coeff_C] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/OrdinalValueQuotient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/OrdinalValueQuotient.lean index 8a81dfbb52..1b2efde687 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/OrdinalValueQuotient.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/OrdinalValueQuotient.lean @@ -158,8 +158,11 @@ def ordinalValueQuotientAlgEquiv : Germ K ≃ₐ[K] MvPolynomial ι K := theorem ordinalValueQuotientAlgEquiv_symm_apply (F : MvPolynomial ι K) : (σ.ordinalValueQuotientAlgEquiv hx).symm F = toGerm (aeval σ.lift F) := by - simp only [ordinalValueQuotientAlgEquiv, AlgEquiv.symm_symm, AlgEquiv.ofBijective_apply, - ordinalValueQuotientAlgHom_apply] + have h := (AlgEquiv.ofBijective_apply σ.ordinalValueQuotientAlgHom + ⟨σ.ordinalValueQuotientAlgHom_injective hx, + σ.ordinalValueQuotientAlgHom_surjective hx⟩ F).trans + (σ.ordinalValueQuotientAlgHom_apply F) + simpa only [ordinalValueQuotientAlgEquiv, AlgEquiv.symm_symm] using h theorem ordinalValueQuotientAlgEquiv_toGerm_aeval (F : MvPolynomial ι K) : σ.ordinalValueQuotientAlgEquiv hx (toGerm (aeval σ.lift F)) = F := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Primality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Primality.lean index 5871cf94c7..758ab6adf5 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Primality.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Primality.lean @@ -39,7 +39,7 @@ variable {K : Type v} [Field K] [CharZero K] /-- `K((ℝ^{≤0}))` is pre-Schreier (Mathlib's `DecompositionMonoid`) because it is a GCD domain. -/ instance decompositionMonoid : DecompositionMonoid (Series K) := by - letI : Nonempty (GCDMonoid (Series K)) := nonemptyGCDMonoid + letI : GCDMonoid (Series K) := Classical.choice nonemptyGCDMonoid infer_instance /-- Every series is primal in `K((ℝ^{≤0}))`. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/PrincipalRVAlgebraicIndependenceProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/PrincipalRVAlgebraicIndependenceProof.lean index 6beac2f7a1..56861e2144 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/PrincipalRVAlgebraicIndependenceProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/PrincipalRVAlgebraicIndependenceProof.lean @@ -91,7 +91,7 @@ theorem toSeries_aeval {ι : Type*} (b : ι → nonpos K) (F : MvPolynomial ι K /-! ### The ordinal value -/ theorem ot_eq (x : HahnSeries ℝ K) : ot x = HahnSeries.supportOrderType x := by - haveI : WellFoundedLT x.support := ⟨(supportIsWellOrder x).wf⟩ + haveI : WellFoundedLT x.support := (supportIsWellOrder x).wf exact (HahnSeries.supportOrderType_eq_typeLT (OrderIso.refl _)).symm theorem memJ_iff (a : nonpos K) : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/GermPolynomialRingProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/GermPolynomialRingProof.lean index fab49f6bd1..372bcf3d48 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/GermPolynomialRingProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/GermPolynomialRingProof.lean @@ -47,8 +47,10 @@ theorem J_eq : J K = HahnSeries.Nonpositive.negativeMonomialIdeal K := by variable (K) in /-- The standalone ring of germs is ring-equivalent to Berarducci's germ ring. -/ -def germRingEquiv : Germ K ≃+* Berarducci.Germ K := - Ideal.quotEquivOfEq J_eq +def germRingEquiv : Germ K ≃+* Berarducci.Germ K := by + exact @Ideal.quotEquivOfEq (nonpos K) inferInstance (J K) + (HahnSeries.Nonpositive.negativeMonomialIdeal K) inferInstance + ⟨fun b ha ↦ mul_comm b _ ▸ Ideal.mul_mem_left _ b ha⟩ J_eq namespace GermIsPolynomialRing diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesGCDProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesGCDProof.lean index a94e3bb1bf..032c6d17cc 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesGCDProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesGCDProof.lean @@ -51,8 +51,8 @@ theorem of_gcds (K : Type u) [Field K] : SeriesIsPrimal K := by intro hK letI := hK letI : DecidableEq (nonpos K) := Classical.decEq _ - letI : Nonempty (GCDMonoid (nonpos K)) := - ⟨gcdMonoidOfExistsGCD (SeriesHasGCDs.of_polynomiality K inferInstance)⟩ + letI : GCDMonoid (nonpos K) := + gcdMonoidOfExistsGCD (SeriesHasGCDs.of_polynomiality K inferInstance) intro a exact DecompositionMonoid.primal a diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean index 2250186e66..9e30f35aeb 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean @@ -625,10 +625,16 @@ theorem toCG_mul (x y : SupportGame.{u}) : toCG (x * y) = toCG x * toCG y := by _ = z := hmul termination_by (x, y) decreasing_by - all_goals - aesop (add safe - [ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves, Prod.Lex.left, - Prod.Lex.right]) + · obtain ⟨q, hq⟩ := ha + exact Prod.Lex.left _ _ + (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hq) + · obtain ⟨q, hq⟩ := hb + exact Prod.Lex.right _ + (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hq) + · obtain ⟨q, hq⟩ := ha + exact Prod.Lex.left _ _ + (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hq) + theorem toCG_numeric {x : SupportGame.{u}} (h : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric x) : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalForm.lean index 14d107eac0..14059fa458 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalForm.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalForm.lean @@ -786,8 +786,7 @@ theorem length_bot : length (⊥ : PartialSum x) = 0 := by instance : Preorder (PartialSum x) := .lift length -instance : WellFoundedLT (PartialSum x) where - wf := InvImage.wf length wellFounded_lt +instance : WellFoundedLT (PartialSum x) := InvImage.wf length wellFounded_lt instance : WellFoundedRelation (PartialSum x) := ⟨_, wellFounded_lt⟩ @@ -910,7 +909,7 @@ theorem birthday_le (y : PartialSum x) : birthday y.carrier ≤ birthday x := by instance : Small.{u} (PartialSum x) := by refine small_of_injective (β := Iic x.birthday) (f := fun y ↦ ⟨_, birthday_le y⟩) fun y z h ↦ birthday_strictMono.injective ?_ - simpa using h + exact congrArg Subtype.val h /-- The term sequence obtained as the supremum of a set of partial Hahn-series expansions. -/ @[expose] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Tests/SourceIndex.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Tests/SourceIndex.lean index 1c700dad47..3bf6d65a49 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Tests/SourceIndex.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Tests/SourceIndex.lean @@ -5,6 +5,7 @@ Authors: Dan Abramov -/ module + import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedValuation import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.ResidueMathlib @@ -64,44 +65,55 @@ its Hahn-series form against Mathlib alone, while `ConwayRefinement/Standalone/CombinatorialGames/` fixes its concrete omnific-integer form against Mathlib and CombinatorialGames alone. -The hash-command linter is disabled because checked signatures are this module's purpose. +Anonymous examples retain every checked signature without adding a named mathematical API. -/ + +noncomputable section + universe u v open scoped DirectSum HahnSeries NatOrdinal Topology -public section +section section ExactSignatures /- LM24's unsigned normal-form criterion on the class presentation of Conway cuts. -/ +example := (@ZFSet.Surreal.isOmnificInteger_iff_normalForm : ∀ x : ZFSet.Surreal.{u}, x.IsOmnificInteger ↔ ZFSet.Surreal.support x ⊆ Set.Ici 0 ∧ ∃ z : ℤ, ZFSet.Surreal.coeff x 0 = (z : ℝ)) /- Every possible omnific factor or divisibility witness has a code. -/ +example := (@ZFSet.OmnificCode.value_surjective : Function.Surjective (ZFSet.OmnificCode.value.{u})) /- Properness of the code class and of its distinct numerical values. -/ +example := (@ZFSet.omnificGameCodes_ne_ofSet : ∀ s : ZFSet.{u}, ZFSet.omnificGameCodes ≠ Class.ofSet s) +example := (@ZFSet.Surreal.OmnificInteger.not_small : ¬Small.{u} ZFSet.Surreal.OmnificInteger.{u}) /- The class comparison preserves the complete refinement conjecture, not a restricted case. -/ +example := (@ZFSet.Surreal.OmnificInteger.refinementConjecture_iff : ZFSet.Surreal.OmnificInteger.RefinementConjecture.{u} ↔ ConwayRefinementConjecture.{u}) /- LM17, Definition 4.1: the two support-order alternatives in the germ-like predicate. -/ +example := (@LM17.IsGermLike.elim : ∀ {K : Type u} [Field K] {a : Berarducci.Series K}, LM17.IsGermLike a → (a : K⟦ℝ⟧).supportOrderType = (Berarducci.ordinalValue a).val ∨ (1 < Berarducci.ordinalValue a ∧ (a : K⟦ℝ⟧).supportOrderType = (Berarducci.ordinalValue a).val + 1)) /- LM17, Theorem 4.8: every nonzero germ-like series factors into irreducibles. -/ +example := (@LM17.IsGermLike.exists_factorization : ∀ {K : Type u} [Field K] [CharZero K] {a : Berarducci.Series K}, LM17.IsGermLike a → a ≠ 0 → ∃ f : Multiset (Berarducci.Series K), (∀ b ∈ f, Irreducible b) ∧ Associated f.prod a) /- The degree-two-plus-one example exercises the second, nondegenerate germ-like branch. -/ +example := (Tests.LM17.degreeTwoWithConstant_isGermLike (K := ℚ) : LM17.IsGermLike (PommersheimShahriari.DegreeTwoExample.degreeTwoWithConstant (K := ℚ))) section ResidueStructures @@ -110,13 +122,14 @@ variable {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] [LinearOrder M] [IsOrderedCancelAddMonoid M] (ν : MaxAddDegree R M) (m : M) -#synth CommRing ν.ResidueRing +example : CommRing ν.ResidueRing := inferInstance -#synth Module ν.ResidueRing (ν.Component m) +example : Module ν.ResidueRing (ν.Component m) := inferInstance end ResidueStructures /- LM24, Fact 2.5.2: units and pairwise gcds in the nonpositive finite-support ring. -/ +example := (@HahnSeries.Nonpositive.isUnit_finiteSupport_iff_exists_scalar : ∀ {G : Type u} {K : Type v} [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] [Field K] (p : (HahnSeries.Nonpositive.finiteSupportSubring : @@ -124,6 +137,8 @@ end ResidueStructures IsUnit p ↔ ∃ k : K, k ≠ 0 ∧ p = HahnSeries.Nonpositive.finiteSupportScalarHom (G := G) k) + +example := (@HahnSeries.Nonpositive.finiteSupport_pairwise_gcd_exists : ∀ {G : Type u} {K : Type v} [LinearOrder G] [AddCommGroup G] [IsOrderedAddMonoid G] [Field K] (p q : (HahnSeries.Nonpositive.finiteSupportSubring : @@ -135,51 +150,72 @@ end ResidueStructures e ∣ p ∧ e ∣ q ↔ e ∣ d) /- The same underlying `t⁻¹` distinguishes the nonpositive ring from the full group ring. -/ +example := (Tests.nonpositiveNegativeMonomial_not_isUnit : ¬ IsUnit Tests.nonpositiveNegativeMonomial) + +example := (Tests.fullNegativeMonomial_isUnit : IsUnit Tests.fullNegativeMonomial) /- The zero-boundary gcd certificate retains both association and the defining orientation. -/ +example := (Tests.finiteSupportGCD_zero_left : ∃ d : Tests.IntegerNonpositiveFiniteSupportRing, (d ∣ Tests.nonpositiveNegativeMonomial ∧ Tests.nonpositiveNegativeMonomial ∣ d) ∧ ∀ e : Tests.IntegerNonpositiveFiniteSupportRing, e ∣ 0 ∧ e ∣ Tests.nonpositiveNegativeMonomial ↔ e ∣ d) + +example := (@MaxAddDegree.rvRel_iff : ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] [LinearOrder M] (ν : MaxAddDegree R M) (x y : R), ν.RVRel x y ↔ (ν x = ⊥ ∧ ν y = ⊥) ∨ (ν x ≠ ⊥ ∧ ν (x - y) < ν x)) + +example := (@MaxAddDegree.rvEquivHomogeneous : ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] [LinearOrder M] [IsOrderedCancelAddMonoid M] (ν : MaxAddDegree R M) [ν.IsMultiplicative], ν.RV ≃* ν.HomogeneousClasses) + +example := (@MaxAddDegree.associatedGradedValuation : ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] [LinearOrder M] [IsOrderedCancelAddMonoid M] (ν : MaxAddDegree R M), MaxAddDegree ν.AssociatedGraded M) + +example := (@MaxAddDegree.associatedGradedValue_eq_coe_iff : ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] [LinearOrder M] (ν : MaxAddDegree R M) (x : ν.AssociatedGraded) (m : M), ν.associatedGradedValue x = (m : WithBot M) ↔ x m ≠ 0 ∧ ∀ i, x i ≠ 0 → i ≤ m) + +example := (@MaxAddDegree.associatedGradedValuation_isSeparated : ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] [LinearOrder M] [IsOrderedCancelAddMonoid M] (ν : MaxAddDegree R M), ν.associatedGradedValuation.IsSeparated) + +example := (@MaxAddDegree.associatedGradedValuation_initialForm : ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] [LinearOrder M] [IsOrderedCancelAddMonoid M] (ν : MaxAddDegree R M) (x : R), ν.associatedGradedValuation (ν.initialForm x) = ν x) + +example := (@Berarducci.ordinalValue_add_le_max : ∀ {K : Type v} [Field K] (b c : Berarducci.Series K), Berarducci.ordinalValue (b + c) ≤ max (Berarducci.ordinalValue b) (Berarducci.ordinalValue c)) /- Berarducci, Theorem 9.7 and Corollary 9.8. -/ +example := (@Berarducci.ordinalValue_mul : ∀ {K : Type v} [Field K] [CharZero K] (b c : Berarducci.Series K), Berarducci.ordinalValue (b * c) = Berarducci.ordinalValue b * Berarducci.ordinalValue c) /- Berarducci, Lemma 10.1 and Definition 10.2. -/ +example := (@Berarducci.exists_isCriticalPoint : ∀ {K : Type v} [Field K] [CharZero K] {b : Berarducci.Series K}, b ≠ 0 → ∃ x : ℝ, Berarducci.IsCriticalPoint b x) /- Berarducci, Lemma 10.4. -/ +example := (@Berarducci.criticalPoint_product_value : ∀ {K : Type v} [Field K] [CharZero K] {b c : Berarducci.Series K} {x y : ℝ}, Berarducci.IsCriticalPoint b x → Berarducci.IsCriticalPoint c y → @@ -193,6 +229,7 @@ end ResidueStructures /- Berarducci, Theorem 10.5: both alternatives for the support order type, the prohibition on strictly negative monomial divisors, and both irreducibility conclusions. -/ +example := (@Berarducci.irreducible_and_add_one_of_supportOrderType : ∀ {K : Type v} [Field K] [CharZero K] {a : Berarducci.Series K}, (∀ (gamma : ℝ) (hgamma : gamma < 0), ¬ HahnSeries.Nonpositive.single gamma (1 : K) hgamma.le ∣ a) → @@ -203,22 +240,31 @@ strictly negative monomial divisors, and both irreducibility conclusions. -/ /- Berarducci, Theorem 10.5, specialized to the coefficient-one row underlying LM24, Example 9.2.8. -/ +example := (@Berarducci.OneRow.withConstant_supportOrderType : ∀ {K : Type v} [Field K], (Berarducci.OneRow.withConstant (K := K) : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 + 1) + +example := (@Berarducci.OneRow.irreducible_withoutConstant_and_withConstant : ∀ {K : Type v} [Field K] [CharZero K], Irreducible (Berarducci.OneRow.withoutConstant (K := K)) ∧ Irreducible (Berarducci.OneRow.withConstant (K := K))) /- PS06's quotient is by `J + K`, not Berarducci's ideal `J`. -/ +example := (@PommersheimShahriari.mem_nearConstantSubmodule_iff : ∀ {K : Type v} [Field K] {b : Berarducci.Series K}, b ∈ PommersheimShahriari.nearConstantSubmodule K ↔ b ∈ Berarducci.nearConstantSubgroup K) + +example := (Tests.constant_one_eq_zero_modulo_constants : PommersheimShahriari.toSeriesQuotientByJAddConstants (HahnSeries.Nonpositive.C (1 : ℚ)) = 0) + +example := (Tests.constant_one_ne_zero_in_berarducci_germ : Berarducci.toGerm (HahnSeries.Nonpositive.C (1 : ℚ)) ≠ 0) /- PS06, Lemma 3.1: ordinal factorisation and the critical-point obstruction. -/ +example := (@PommersheimShahriari.ordinalValue_factors_of_mul_eq_wpow_two : ∀ {K : Type v} [Field K] {b c : Berarducci.Series K}, Berarducci.ordinalValue b * Berarducci.ordinalValue c = ω^ (2 : NatOrdinal) → @@ -227,6 +273,8 @@ Example 9.2.8. -/ Berarducci.ordinalValue c = ω^ (2 : NatOrdinal)) ∨ (Berarducci.ordinalValue b = ω^ (1 : NatOrdinal) ∧ Berarducci.ordinalValue c = ω^ (1 : NatOrdinal))) + +example := (@PommersheimShahriari.criticalPoints_eq_zero_of_product_wpow_two : ∀ {K : Type v} [Field K] [CharZero K] {a b c : Berarducci.Series K} {x y : ℝ}, a = b * c → Berarducci.ordinalValue a = ω^ (2 : NatOrdinal) → @@ -237,6 +285,7 @@ Example 9.2.8. -/ x = 0 ∧ y = 0) /- PS06, Lemma 3.1, complete support-order classification. -/ +example := (@PommersheimShahriari.factorization_cases_of_supportOrderType_wpow_two : ∀ {K : Type v} [Field K] [CharZero K] {a b c : Berarducci.Series K}, a ∉ Berarducci.nearConstantSubgroup K → @@ -252,6 +301,8 @@ Example 9.2.8. -/ (c : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 + 1) ∧ Berarducci.ordinalValue b = ω^ (1 : NatOrdinal) ∧ Berarducci.ordinalValue c = ω^ (1 : NatOrdinal))) + +example := (@Tests.ps06_degreeTwo_factorization_client : ∀ {K : Type v} [Field K] [CharZero K] {a b c : Berarducci.Series K}, a ∉ Berarducci.nearConstantSubgroup K → @@ -269,6 +320,7 @@ Example 9.2.8. -/ Berarducci.ordinalValue c = ω^ (1 : NatOrdinal))) /- PS06, Proposition 3.2(2) and (5), upper-bound direction. -/ +example := (@PommersheimShahriari.finrank_translatedTruncationSpan_mul_le_two : ∀ {K : Type v} [Field K] {b c : Berarducci.Series K}, Berarducci.ordinalValue b = ω^ (1 : NatOrdinal) → Berarducci.ordinalValue c = ω^ (1 : NatOrdinal) → @@ -276,6 +328,7 @@ Example 9.2.8. -/ Module.finrank K (PommersheimShahriari.translatedTruncationSpan (b * c)) ≤ 2) /- PS06, Proposition 3.2(5), without a finite-dimensionality assumption. -/ +example := (@PommersheimShahriari.rank_translatedTruncationSpan_mul_le_two : ∀ {K : Type v} [Field K] {b c : Berarducci.Series K}, Berarducci.ordinalValue b = ω^ (1 : NatOrdinal) → Berarducci.ordinalValue c = ω^ (1 : NatOrdinal) → @@ -283,6 +336,7 @@ Example 9.2.8. -/ Module.rank K (PommersheimShahriari.translatedTruncationSpan (b * c)) ≤ 2) /- PS06, Corollary 3.3. -/ +example := (@PommersheimShahriari.irreducible_of_two_lt_finrank_translatedTruncationSpan : ∀ {K : Type v} [Field K] [CharZero K] {a : Berarducci.Series K}, a ∉ Berarducci.nearConstantSubgroup K → ((a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) ∨ @@ -290,6 +344,7 @@ Example 9.2.8. -/ 2 < Module.finrank K (PommersheimShahriari.translatedTruncationSpan a) → Irreducible a) /- PS06, Corollary 3.3, in cardinal-rank form. -/ +example := (@PommersheimShahriari.irreducible_of_two_lt_rank_translatedTruncationSpan : ∀ {K : Type v} [Field K] [CharZero K] {a : Berarducci.Series K}, a ∉ Berarducci.nearConstantSubgroup K → ((a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) ∨ @@ -298,30 +353,41 @@ Example 9.2.8. -/ Module.rank K (PommersheimShahriari.translatedTruncationSpan a) → Irreducible a) /- The explicit coefficient-one `ω² + 1` series supplied by the PS06 criterion. -/ +example := (@PommersheimShahriari.DegreeTwoExample.degreeTwoWithConstant_supportOrderType : ∀ {K : Type v} [Field K], ((PommersheimShahriari.DegreeTwoExample.degreeTwoWithConstant (K := K) : Berarducci.Series K) : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) + 1) + +example := (@PommersheimShahriari.DegreeTwoExample.degreeTwoWithConstant_irreducible : ∀ {K : Type v} [Field K] [CharZero K], Irreducible (PommersheimShahriari.DegreeTwoExample.degreeTwoWithConstant (K := K))) + +example := (@Tests.ps06_degreeTwo_irreducibility_client : ∀ {K : Type v} [Field K] [CharZero K] {a : Berarducci.Series K}, a ∉ Berarducci.nearConstantSubgroup K → ((a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) ∨ (a : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 ^ (2 : Ordinal) + 1) → 2 < Module.finrank K (PommersheimShahriari.translatedTruncationSpan a) → Irreducible a) + +example := (@Berarducci.negativeMonomialIdeal_isPrime : ∀ {K : Type v} [Field K] [CharZero K], (HahnSeries.Nonpositive.negativeMonomialIdeal K).IsPrime) /- Berarducci, Corollary 9.9, imported by LM24 as Fact 3.4.1. -/ +example := (@HahnSeries.Nonpositive.orderTypeMultiplicativeOnWeaklyPrincipal : ∀ {K : Type v} [Field K] [CharZero K], HahnSeries.Nonpositive.OrderTypeMultiplicativeOnWeaklyPrincipal K) /- LM24, Propositions 3.5.1(2) and 3.6.1. -/ +example := (@HahnSeries.Nonpositive.supportSup_mul : ∀ {K : Type v} [Field K] [CharZero K] (b c : HahnSeries.Nonpositive ℝ K), HahnSeries.Nonpositive.supportSup (b * c) = HahnSeries.Nonpositive.supportSup b + HahnSeries.Nonpositive.supportSup c) + +example := (@HahnSeries.Nonpositive.IsPrincipal.mul : ∀ {K : Type v} [Field K] [CharZero K] {b c : HahnSeries.Nonpositive ℝ K}, HahnSeries.Nonpositive.IsPrincipal b → @@ -330,25 +396,36 @@ Example 9.2.8. -/ /- Boundary certificates exercise the proved characteristic-zero theorems on nonconstant inputs. -/ +example := (Tests.ordinalValue_mul_approachZero : Berarducci.ordinalValue (Tests.approachZeroNonpositive * Tests.approachZeroNonpositive) = Berarducci.ordinalValue Tests.approachZeroNonpositive * Berarducci.ordinalValue Tests.approachZeroNonpositive) + +example := (Tests.twoTermNonprincipal_square_degree : ((Tests.twoTermNonprincipal * Tests.twoTermNonprincipal : HahnSeries.Nonpositive ℝ ℚ) : ℚ⟦ℝ⟧).degree = (Tests.twoTermNonprincipal : ℚ⟦ℝ⟧).degree + (Tests.twoTermNonprincipal : ℚ⟦ℝ⟧).degree) + +example := (Tests.exists_unattained_zeroSup_square : ∃ b : HahnSeries.Nonpositive ℝ ℚ, HahnSeries.Nonpositive.supportSup b = 0 ∧ 0 ∉ (b : ℚ⟦ℝ⟧).support ∧ HahnSeries.Nonpositive.supportSup (b * b) = 0) + +example := (@Berarducci.ordinalValueDegree_eq_bot_iff : ∀ {K : Type v} [Field K] {b : Berarducci.Series K}, Berarducci.ordinalValueDegree b = ⊥ ↔ b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K) + +example := (@Berarducci.ordinalValueDegreeValuation_eq_bot_iff : ∀ {K : Type v} [Field K] (b : Berarducci.Series K), Berarducci.ordinalValueDegreeValuation K b = ⊥ ↔ b ∈ HahnSeries.Nonpositive.negativeMonomialIdeal K) + +example := (@Berarducci.principalComponentMk_eq_iff : ∀ {K : Type v} [Field K] (α : NatOrdinal) (b c : Berarducci.Series K) (hb : Berarducci.ordinalValue b < ω^ (α + 1)) @@ -356,6 +433,8 @@ inputs. -/ Berarducci.principalComponentMk α b hb = Berarducci.principalComponentMk α c hc ↔ Berarducci.ordinalValue (b - c) < ω^ α) + +example := (@Berarducci.exists_principal_representative_of_ne_zero : ∀ {K : Type v} [Field K] (α : NatOrdinal) (x : Berarducci.PrincipalComponent K α), x ≠ 0 → ∃ (p : Berarducci.Series K) @@ -366,6 +445,7 @@ inputs. -/ /- The equal-degree specialization of LM24, Proposition 3.6.2 used in Lemma 7.2.3. The unrestricted printed proposition is false. -/ +example := (@HahnSeries.Nonpositive.IsPrincipal.add_of_degree_eq : ∀ {K : Type v} [Field K] {b c : HahnSeries.Nonpositive ℝ K}, HahnSeries.Nonpositive.IsPrincipal b → HahnSeries.Nonpositive.IsPrincipal c → @@ -373,10 +453,14 @@ unrestricted printed proposition is false. -/ ((b + c : HahnSeries.Nonpositive ℝ K) : K⟦ℝ⟧).degree = (b : K⟦ℝ⟧).degree → HahnSeries.Nonpositive.IsPrincipal (b + c)) + +example := (@Berarducci.ordinalValue_eq_wpow_of_isPrincipal : ∀ {K : Type v} [Field K] {p : Berarducci.Series K} (_hp : HahnSeries.Nonpositive.IsPrincipal p) {α : NatOrdinal}, (p : K⟦ℝ⟧).degree = (α : WithBot NatOrdinal) → Berarducci.ordinalValue p = ω^ α) + +example := (@Berarducci.degreeLayerMk_eq_iff_ordinalValue_sub_lt : ∀ {K : Type v} [Field K] (α : NatOrdinal) {b c : Berarducci.Series K} (_hb : HahnSeries.Nonpositive.IsPrincipal b) @@ -386,12 +470,16 @@ unrestricted printed proposition is false. -/ Berarducci.degreeLayerMk α b hbDegree.le = Berarducci.degreeLayerMk α c hcDegree.le ↔ Berarducci.ordinalValue (b - c) < ω^ α) + +example := (@Berarducci.principalDegreeClassesEquivPrincipalComponent : ∀ (K : Type v) [Field K] (α : NatOrdinal), Berarducci.principalDegreeClasses K α ≃ₗ[K] Berarducci.PrincipalComponent K α) /- LM24, Proposition 5.3.1. -/ +example := ((fun (K : Type v) [Field K] [CharZero K] ↦ + Berarducci.principalComponentTensorEquiv K) : ∀ (K : Type v) [Field K] [CharZero K] (α : NatOrdinal), TensorProduct K (Berarducci.PrincipalComponent K α) @@ -399,15 +487,20 @@ unrestricted printed proposition is false. -/ (HahnSeries.Nonpositive.degreeValuation K).Component α) /- LM24, Proposition 6.1.2, under the paper's blanket characteristic-zero hypothesis. -/ +example := (fun {K : Type v} [Field K] [CharZero K] ↦ (Berarducci.principalSubringTensorEquiv K : TensorProduct K (Berarducci.PrincipalSubring K) Berarducci.FiniteSupportRing ≃ₐ[K] Berarducci.DegreeGraded K)) + +example := (@Berarducci.principalSubringTensorEquiv_tmul_apply : ∀ {K : Type v} [Field K] [CharZero K] (x : Berarducci.PrincipalSubring K) (p : Berarducci.FiniteSupportRing) (α : NatOrdinal), Berarducci.principalSubringTensorEquiv K (x ⊗ₜ p) α = Berarducci.principalComponentTensorEquiv K α (x α ⊗ₜ p)) + +example := (@Berarducci.principalSubringTensorEquiv_component : ∀ {K : Type v} [Field K] [CharZero K] (z : TensorProduct K (Berarducci.PrincipalSubring K) Berarducci.FiniteSupportRing) (α : NatOrdinal), @@ -416,6 +509,7 @@ unrestricted printed proposition is false. -/ (Berarducci.principalSubringTensorComponent K α z)) /- LM24, Proposition 5.4.3. -/ +example := (@Berarducci.rv_maximal_finite_support_divisor : ∀ {K : Type v} [Field K] [CharZero K] (B : Berarducci.HahnDegreeRV K), ∃ p : Berarducci.FiniteSupportRing, @@ -431,6 +525,7 @@ unrestricted printed proposition is false. -/ p = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k)) /- LM24, Corollary 5.4.4. -/ +example := (@Berarducci.graded_maximal_finite_support_divisor : ∀ {K : Type v} [Field K] [CharZero K] (B : Berarducci.DegreeGraded K), ∃ p : Berarducci.FiniteSupportRing, @@ -443,18 +538,21 @@ unrestricted printed proposition is false. -/ p' = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k * p) /- LM24, Notation 5.4.5. -/ +example := (@Berarducci.existsUnique_normalized_maximal_finite_support_divisor : ∀ {K : Type v} [Field K] [CharZero K] (B : Berarducci.DegreeGraded K), ∃! p : Berarducci.FiniteSupportRing, Berarducci.IsNormalizedGradedMaximalFiniteSupportDivisor B p) /- LM24, Remark 5.4.6. -/ +example := (@Berarducci.maximalFiniteSupportDivisor_dvd : ∀ {K : Type v} [Field K] [CharZero K] (B : Berarducci.DegreeGraded K), Berarducci.finiteSupportGradedEmbedding K (Berarducci.gradedNormalizedMaximalFiniteSupportDivisor B) ∣ B) /- LM24, Proposition 5.4.8. -/ +example := (@Berarducci.maximalFiniteSupportDivisor_mul_dvd : ∀ {K : Type v} [Field K] [CharZero K] (B C : Berarducci.DegreeGraded K), Berarducci.gradedNormalizedMaximalFiniteSupportDivisor B * @@ -462,6 +560,7 @@ unrestricted printed proposition is false. -/ Berarducci.gradedNormalizedMaximalFiniteSupportDivisor (B * C)) /- LM24, Proposition 5.5.1. -/ +example := (@Berarducci.series_maximal_finite_support_divisor : ∀ {K : Type v} [Field K] [CharZero K] (b : Berarducci.Series K), ∃ p : Berarducci.FiniteSupportRing, @@ -474,41 +573,54 @@ unrestricted printed proposition is false. -/ p' = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k * p) /- LM24, Notation 5.5.2. -/ +example := (@Berarducci.existsUnique_normalized_series_maximal_finite_support_divisor : ∀ {K : Type v} [Field K] [CharZero K] (b : Berarducci.Series K), ∃! p : Berarducci.FiniteSupportRing, Berarducci.IsNormalizedSeriesMaximalFiniteSupportDivisor b p) + +example := (@Berarducci.seriesNormalizedMaximalFiniteSupportDivisor_is : ∀ {K : Type v} [Field K] [CharZero K] (b : Berarducci.Series K), Berarducci.IsNormalizedSeriesMaximalFiniteSupportDivisor b (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b)) /- LM24, Remark 5.5.3. -/ +example := (@Berarducci.seriesMaximalFiniteSupportDivisor_dvd : ∀ {K : Type v} [Field K] [CharZero K] (b : Berarducci.Series K), (Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b : Berarducci.Series K) ∣ b) + +example := (@Berarducci.seriesMaximalFiniteSupportDivisor_zero : ∀ (K : Type v) [Field K] [CharZero K], Berarducci.seriesNormalizedMaximalFiniteSupportDivisor (0 : Berarducci.Series K) = 0) + +example := (@Berarducci.exists_scalar_seriesMaximalFiniteSupportDivisor_coe : ∀ {K : Type v} [Field K] [CharZero K] (p : Berarducci.FiniteSupportRing), ∃ k : K, k ≠ 0 ∧ Berarducci.seriesNormalizedMaximalFiniteSupportDivisor (p : Berarducci.Series K) = HahnSeries.Nonpositive.finiteSupportScalarHom (G := ℝ) k * p) + +example := (@Berarducci.seriesMaximalFiniteSupportDivisor_coe_eq_graded : ∀ {K : Type v} [Field K] [CharZero K] (p : Berarducci.FiniteSupportRing), Berarducci.seriesNormalizedMaximalFiniteSupportDivisor (p : Berarducci.Series K) = Berarducci.gradedNormalizedMaximalFiniteSupportDivisor (Berarducci.finiteSupportGradedEmbedding K p)) + +example := (@Berarducci.seriesMaximalFiniteSupportDivisor_principal_eq_one : ∀ {K : Type v} [Field K] [CharZero K] {b : Berarducci.Series K}, HahnSeries.Nonpositive.IsPrincipal b → Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b = 1) /- LM24, Proposition 5.5.5. -/ +example := (@Berarducci.seriesMaximalFiniteSupportDivisor_mul_dvd : ∀ {K : Type v} [Field K] [CharZero K] (b c : Berarducci.Series K), Berarducci.seriesNormalizedMaximalFiniteSupportDivisor b * @@ -516,9 +628,12 @@ unrestricted printed proposition is false. -/ Berarducci.seriesNormalizedMaximalFiniteSupportDivisor (b * c)) /- LM24, Example 5.5.4. -/ +example := (Tests.seriesMaximalExample_isRVMaximalFiniteSupportDivisor : Berarducci.IsRVMaximalFiniteSupportDivisor ((HahnSeries.Nonpositive.degreeValuation ℚ).rv Tests.seriesMaximalExample) (Associates.mk Tests.seriesMaximalExampleRVDivisor)) + +example := (@Tests.seriesMaximalExample_normalized_eq : ∀ (_hgcd : ∀ p q : Berarducci.FiniteSupportRing, ∃ d : Berarducci.FiniteSupportRing, ∀ e : Berarducci.FiniteSupportRing, e ∣ p ∧ e ∣ q ↔ e ∣ d) @@ -528,6 +643,8 @@ unrestricted printed proposition is false. -/ Berarducci.seriesNormalizedMaximalFiniteSupportDivisor Tests.seriesMaximalExample = Tests.seriesMaximalExampleDivisor) + +example := (@Tests.seriesMaximalExample_gradedNormalized_eq : ∀ (_hgcd : ∀ p q : Berarducci.FiniteSupportRing, ∃ d : Berarducci.FiniteSupportRing, ∀ e : Berarducci.FiniteSupportRing, e ∣ p ∧ e ∣ q ↔ e ∣ d) @@ -537,11 +654,14 @@ unrestricted printed proposition is false. -/ Berarducci.gradedNormalizedMaximalFiniteSupportDivisor Tests.seriesMaximalExampleLeadingGraded = Tests.seriesMaximalExampleRVDivisor) + +example := (Tests.seriesMaximalExample_divisors_ne : Tests.seriesMaximalExampleRVDivisor ≠ Tests.seriesMaximalExampleDivisor) /- LM24, Proposition 5.6.1. The list is the finite sequence `c₁, …, cₙ`, and its length is `n`. -/ +example := (@Berarducci.series_infinite_support_factorization : ∀ {K : Type v} [Field K] [CharZero K] {b : Berarducci.Series K}, b ≠ 0 → ∃ (factors : List (Berarducci.Series K)) (k : K), @@ -552,6 +672,8 @@ is `n`. -/ Irreducible c ∧ (c : K⟦ℝ⟧).support.Infinite) ∧ factors.length ≤ HahnSeries.degreeCantorTermCount (b : K⟦ℝ⟧)) + +example := (@Berarducci.series_infinite_support_factorization_with_nonzero_scalar : ∀ {K : Type v} [Field K] [CharZero K] {b : Berarducci.Series K}, b ≠ 0 → ∃ (factors : List (Berarducci.Series K)) (k : K), @@ -563,10 +685,13 @@ is `n`. -/ Irreducible c ∧ (c : K⟦ℝ⟧).support.Infinite) ∧ factors.length ≤ HahnSeries.degreeCantorTermCount (b : K⟦ℝ⟧)) + +example := (Tests.zero_not_hasOnlyUnitFiniteSupportDivisors : ¬Berarducci.HasOnlyUnitFiniteSupportDivisors (0 : Berarducci.Series ℚ)) /- LM24, Proposition 6.2.1. -/ +example := (@Berarducci.hahnDegreeRV_factors_of_mul_mem : ∀ {K : Type v} [Field K] [CharZero K] {B C : Berarducci.DegreeGraded K}, @@ -579,6 +704,7 @@ is `n`. -/ (HahnSeries.Nonpositive.degreeValuation K).homogeneousClasses) /- The exact graded-image model of `P` used in LM24, Corollary 6.2.2. -/ +example := (@Berarducci.isPrincipalRVImage_iff_exists : ∀ {K : Type v} [Field K] [CharZero K] (x : Berarducci.DegreeGraded K), Berarducci.IsPrincipalRVImage x ↔ @@ -587,6 +713,7 @@ is `n`. -/ (HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom B = x) /- The intrinsic characterization of the exact graded-image model of `P`. -/ +example := (@Berarducci.isPrincipalRVImage_iff : ∀ {K : Type v} [Field K] [CharZero K] (x : Berarducci.DegreeGraded K), Berarducci.IsPrincipalRVImage x ↔ @@ -596,6 +723,7 @@ is `n`. -/ Berarducci.IsPrincipalGraded x) /- LM24, Corollary 6.2.2, `P̂` clause. -/ +example := (@Berarducci.hahnDegreePrincipalGraded_factors_of_mul_mem : ∀ {K : Type v} [Field K] [CharZero K] {B C : Berarducci.DegreeGraded K}, @@ -604,6 +732,7 @@ is `n`. -/ Berarducci.IsPrincipalGraded C) /- LM24, Corollary 6.2.2, `P` clause. -/ +example := (@Berarducci.hahnDegreePrincipalRVImage_factors_of_mul_mem : ∀ {K : Type v} [Field K] [CharZero K] {B C : Berarducci.DegreeGraded K}, @@ -612,6 +741,7 @@ is `n`. -/ Berarducci.IsPrincipalRVImage C) /- LM24, Corollary 6.2.3, RV clause. -/ +example := (@Berarducci.hahnDegreeRV_dvd_iff_associatedGraded_dvd : ∀ {K : Type v} [Field K] [CharZero K] (B C : Berarducci.HahnDegreeRV K), @@ -620,6 +750,7 @@ is `n`. -/ (HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom C) /- LM24, Corollary 6.2.3, finite-support clause. -/ +example := (@Berarducci.finiteSupportGradedEmbedding_dvd_iff : ∀ {K : Type v} [Field K] [CharZero K] (p q : Berarducci.FiniteSupportRing), @@ -628,6 +759,7 @@ is `n`. -/ p ∣ q) /- LM24, Proposition 6.2.4. -/ +example := (@Berarducci.hahnDegreeRV_dvd_iff_dvd_components : ∀ {K : Type v} [Field K] [CharZero K] (B : Berarducci.HahnDegreeRV K) @@ -640,6 +772,7 @@ is `n`. -/ α (C α)) /- LM24, Lemma 6.3.1. -/ +example := (@Berarducci.maximalFiniteSupportDivisor_rv_mul_principal : ∀ {K : Type v} [Field K] [CharZero K] (B C : Berarducci.HahnDegreeRV K), Berarducci.IsPrincipalRV C → C ≠ 0 → @@ -649,6 +782,7 @@ is `n`. -/ ((HahnSeries.Nonpositive.degreeValuation K).rvInitialFormHom B)) /- LM24, Lemma 6.3.2. -/ +example := (@Berarducci.maximalFiniteSupportDivisor_mul_principal : ∀ {K : Type v} [Field K] [CharZero K] (B C : Berarducci.DegreeGraded K), Berarducci.IsPrincipalGraded C → C ≠ 0 → @@ -656,6 +790,7 @@ is `n`. -/ Berarducci.gradedNormalizedMaximalFiniteSupportDivisor B) /- LM24, Lemma 6.3.3. -/ +example := (@Berarducci.isRelativelyAlgebraicallyClosed_principalGradedFractionField : ∀ (K : Type v) [Field K] [CharZero K], @Algebra.IsRelativelyAlgebraicallyClosed K (Berarducci.PrincipalSubringFractionField K) _ _ @@ -663,6 +798,7 @@ is `n`. -/ /- LM24, Lemma 6.3.4. The nonzeroness of the inverted coefficient is made explicit because Lean's inverse is total. -/ +example := (@Berarducci.principalSubringFraction_exists_scalarRedistribution : ∀ {K : Type v} [Field K] [CharZero K] {p₁ p₂ : Berarducci.PrincipalSubringFractionFiniteSupportRing K}, p₁ ≠ 0 → p₂ ≠ 0 → @@ -676,6 +812,7 @@ Lean's inverse is total. -/ /- Guardrail: omitting the preceding `B ≠ 0` lets `B = 0` satisfy both membership clauses for arbitrary factors under Lean's total inverse. -/ +example := (@Berarducci.principalSubringFraction_exists_literalTotalInverseScalarRedistribution : ∀ {K : Type v} [Field K] [CharZero K] (p₁ p₂ : Berarducci.PrincipalSubringFractionFiniteSupportRing K), ∃ B : Berarducci.PrincipalSubringFractionField K, @@ -686,6 +823,7 @@ arbitrary factors under Lean's total inverse. -/ /- LM24, Remark 6.3.5. Under the identification of Remark 6.1.3, coefficient extension reflects divisibility. -/ +example := (@Berarducci.principalSubringFractionScalarExtension_dvd_iff : ∀ {K : Type v} [Field K] [CharZero K] (p q : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)), Berarducci.principalSubringFractionScalarExtension K p ∣ @@ -694,6 +832,7 @@ reflects divisibility. -/ /- LM24, Corollary 6.3.6, in the stronger factor-witness form used in its proof. The finite-support factors remain elements of `K(ℝ^{≤ 0})`. -/ +example := (@Berarducci.finiteSupportGradedEmbedding_exists_factor_dvd : ∀ {K : Type v} [Field K] [CharZero K] (p : Berarducci.FiniteSupportRing) (B C : Berarducci.DegreeGraded K), @@ -704,11 +843,13 @@ finite-support factors remain elements of `K(ℝ^{≤ 0})`. -/ Berarducci.finiteSupportGradedEmbedding K p₂ ∣ C) /- LM24, Corollary 6.3.6. -/ +example := (@Berarducci.finiteSupportGradedEmbedding_isPrimal : ∀ {K : Type v} [Field K] [CharZero K] (p : Berarducci.FiniteSupportRing), IsPrimal (Berarducci.finiteSupportGradedEmbedding K p)) /- LM24, Corollary 6.3.7. -/ +example := (@Berarducci.maximalFiniteSupportDivisor_mul : ∀ {K : Type v} [Field K] [CharZero K] (B C : Berarducci.DegreeGraded K), Berarducci.gradedNormalizedMaximalFiniteSupportDivisor (B * C) = @@ -716,6 +857,7 @@ finite-support factors remain elements of `K(ℝ^{≤ 0})`. -/ Berarducci.gradedNormalizedMaximalFiniteSupportDivisor C) /- LM24, Proposition 6.3.8. -/ +example := (@Berarducci.seriesMaximalFiniteSupportDivisor_mul : ∀ {K : Type v} [Field K] [CharZero K] (b c : Berarducci.Series K), Berarducci.seriesNormalizedMaximalFiniteSupportDivisor (b * c) = @@ -724,6 +866,7 @@ finite-support factors remain elements of `K(ℝ^{≤ 0})`. -/ /- LM24, Corollary 6.3.9, in the stronger factor-witness form used in its proof. The factors remain in the finite-support subring, and their equality is asserted in the ambient series ring. -/ +example := (@Berarducci.finiteSupportSeries_exists_factor_dvd : ∀ {K : Type v} [Field K] [CharZero K] (p : Berarducci.FiniteSupportRing (K := K)) (b c : Berarducci.Series K), (p : Berarducci.Series K) ∣ b * c → @@ -735,6 +878,7 @@ remain in the finite-support subring, and their equality is asserted in the ambi /- LM24, Theorem 6.4.1. The list is the sequence `c₁, …, cₙ`, its length is `n`, and only the finite-support factor is asserted to be unique. -/ +example := (@Berarducci.series_factorization_with_unique_finiteSupportFactor : ∀ {K : Type v} [Field K] [CharZero K] {b : Berarducci.Series K}, b ≠ 0 → ∃ (p : Berarducci.FiniteSupportRing (K := K)) @@ -747,6 +891,7 @@ only the finite-support factor is asserted to be unique. -/ /- Pending exact target for LM24, Corollary 6.4.2. `DecompositionMonoid` is the pre-Schreier condition, while `GCDMonoid` contains data and is therefore asserted through `Nonempty`. This anonymous fixture freezes the proposition without introducing a theorem stub. -/ +example := (fun {K : Type v} [Field K] [CharZero K] ↦ ((DecompositionMonoid (Berarducci.Series K) ↔ Nonempty (GCDMonoid (Berarducci.Series K))) ∧ (Nonempty (GCDMonoid (Berarducci.Series K)) ↔ @@ -754,15 +899,18 @@ pre-Schreier condition, while `GCDMonoid` contains data and is therefore asserte Irreducible c → (c : K⟦ℝ⟧).support.Infinite → Prime c))) /- Boundary guardrail for Theorem 6.4.1: the source permits `n = 0`. -/ +example := (Tests.one_empty_infiniteSupportIrreducibleFactorization : Berarducci.IsInfiniteSupportIrreducibleFactorization (1 : Berarducci.Series ℚ) (1 : Berarducci.FiniteSupportRing (K := ℚ)) []) /- Scalar-uniqueness guardrail: literal equality of finite-support factors is false. -/ +example := (Tests.neg_one_finiteSupportFactor_ne_one : (-1 : Berarducci.FiniteSupportRing (K := ℚ)) ≠ 1) /- LM24, Section 6.5, definition of almost irreducibility. The factorisation form makes the quotient in the printed wording explicit without choosing a division operation. -/ +example := (@HahnSeries.Nonpositive.isAlmostIrreducible_iff : ∀ {H : AddSubgroup ℝ} {K : Type v} [Field K] {b : HahnSeries.Nonpositive H K}, HahnSeries.Nonpositive.IsAlmostIrreducible b ↔ @@ -771,6 +919,7 @@ quotient in the printed wording explicit without choosing a division operation. HahnSeries.Nonpositive.IsMonomial d) /- LM24, Remark 6.5.1, first assertion. -/ +example := (@HahnSeries.Nonpositive.Irreducible.isAlmostIrreducible : ∀ {H : AddSubgroup ℝ} {K : Type v} [Field K] {b : HahnSeries.Nonpositive H K}, Irreducible b → HahnSeries.Nonpositive.IsAlmostIrreducible b) @@ -778,12 +927,14 @@ quotient in the printed wording explicit without choosing a division operation. /- Corrected second assertion of LM24, Remark 6.5.1. The printed statement omits the necessary hypothesis that `b` is not a unit. -/ open HahnSeries.Nonpositive in +example := (@IsAlmostIrreducible.irreducible_of_not_isUnit_of_realSupportSup_eq_zero : ∀ {H : AddSubgroup ℝ} {K : Type v} [Field K] {b : HahnSeries.Nonpositive H K}, HahnSeries.Nonpositive.IsAlmostIrreducible b → ¬IsUnit b → HahnSeries.Nonpositive.realSupportSup H b = 0 → Irreducible b) /- Counterexample to the printed second assertion of LM24, Remark 6.5.1. -/ +example := (Tests.one_almostIrreducible_counterexample : HahnSeries.Nonpositive.IsAlmostIrreducible (1 : Tests.RealExponentSeries) ∧ HahnSeries.Nonpositive.realSupportSup Tests.RealExponentSubgroup @@ -791,6 +942,7 @@ open HahnSeries.Nonpositive in ¬Irreducible (1 : Tests.RealExponentSeries)) /- LM24, Remark 6.5.1, final assertion. -/ +example := (@HahnSeries.Nonpositive.not_irreducible_of_realSupportSup_lt_zero : ∀ {H : AddSubgroup ℝ} {K : Type v} [Field K] [DivisibleBy H ℤ] {b : HahnSeries.Nonpositive H K}, HahnSeries.Nonpositive.realSupportSup H b < 0 → ¬Irreducible b) @@ -798,6 +950,7 @@ open HahnSeries.Nonpositive in /- Corrected exact target for LM24, Lemma 6.5.2. The printed universal quantifier includes `p = 0`, although the proof and the notation `p_H` require `p ≠ 0`. This proposition remains uninhabited until the Ritt-factorisation prerequisites are available. -/ +example := (fun {H : AddSubgroup ℝ} {K : Type v} [Field K] [CharZero K] [DivisibleBy H ℤ] (p : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)) ↦ p ≠ 0 → @@ -807,6 +960,7 @@ uninhabited until the Ritt-factorisation prerequisites are available. -/ /- Semantic boundary for the normalized `H`-part predicate: the identity has the identity as its unique normalized part. -/ +example := (@HahnSeries.Nonpositive.existsUnique_normalizedHPart_one : ∀ (H : AddSubgroup ℝ) {K : Type v} [Field K], ∃! q : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport (G := H) (K := K), @@ -814,6 +968,7 @@ its unique normalized part. -/ (1 : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)) q) /- The uniqueness part of LM24, Lemma 6.5.2 is proved without the Ritt existence input. -/ +example := (@HahnSeries.Nonpositive.IsNormalizedHPart.eq : ∀ {H : AddSubgroup ℝ} {K : Type v} [Field K] {p : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)} {q q' : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport @@ -824,6 +979,7 @@ its unique normalized part. -/ /- Corrected exact target for LM24, Corollary 6.5.3. The nonzero hypothesis ensures that the normalized `H`-part of `p(b)` is defined. This relational statement avoids choosing it before Lemma 6.5.2 is proved. -/ +example := (fun {H : AddSubgroup ℝ} {K : Type v} [Field K] [CharZero K] [DivisibleBy H ℤ] (b : HahnSeries.Nonpositive ℝ K) ↦ b ≠ 0 → ∀ pH : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport (G := H) (K := K), @@ -837,6 +993,7 @@ Lemma 6.5.2 is proved. -/ (pH : HahnSeries.Nonpositive.FiniteSupportRing (G := H) (K := K))) /- The proved, prerequisite-explicit reduction underlying Corollary 6.5.3. -/ +example := (@HahnSeries.Nonpositive.normalizedHPart_dvd_iff_dvd_series : ∀ (H : AddSubgroup ℝ) {K : Type v} [Field K] {b : HahnSeries.Nonpositive ℝ K} {p : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)} @@ -852,6 +1009,7 @@ Lemma 6.5.2 is proved. -/ /- Corrected relational target for LM24, Corollary 6.5.4. Both inputs are nonzero because the normalized `H`-part is a partial operation with codomain `1 + K(H^{<0})`. -/ +example := (fun {H : AddSubgroup ℝ} {K : Type v} [Field K] [CharZero K] [DivisibleBy H ℤ] (p q : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)) ↦ p ≠ 0 → q ≠ 0 → @@ -864,6 +1022,7 @@ normalized `H`-part is a partial operation with codomain `1 + K(H^{<0})`. -/ /- The proved reduction underlying Corollary 6.5.4 isolates exactly the factor-refinement input used in the printed proof. -/ +example := (@HahnSeries.Nonpositive.normalizedHPart_mul_eq : ∀ (H : AddSubgroup ℝ) {K : Type v} [Field K], HahnSeries.Nonpositive.HasNormalizedHDivisorRefinement H (K := K) → ∀ {p q : HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K)} @@ -877,15 +1036,19 @@ used in the printed proof. -/ /- Nonconstant semantic certificate for the multiplication reduction: for the trivial exponent subgroup, the normalized part of `(1 + t⁻¹)²` is `1`, although `1 + t⁻¹` is not its embedded normalized part. -/ +example := (Tests.normalizedPartNonconstantSeries_ne_embeddedPart : Tests.normalizedPartNonconstantSeries ≠ HahnSeries.Nonpositive.finiteSupportToReal Tests.TrivialExponentSubgroup (1 : HahnSeries.Nonpositive.FiniteSupportRing (G := Tests.TrivialExponentSubgroup) (K := ℚ))) + +example := (Tests.normalizedPartNonconstantSeries_mul_isNormalizedPart : HahnSeries.Nonpositive.IsNormalizedHPart Tests.TrivialExponentSubgroup (Tests.normalizedPartNonconstantSeries * Tests.normalizedPartNonconstantSeries) 1) /- Corrected relational target for LM24, Corollary 6.5.5. -/ +example := (fun {H : AddSubgroup ℝ} {K : Type v} [Field K] [CharZero K] [DivisibleBy H ℤ] (b c : HahnSeries.Nonpositive ℝ K) ↦ b ≠ 0 → c ≠ 0 → ∀ bH cH bcH : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport @@ -901,6 +1064,7 @@ normalized part. -/ /- The proved reduction underlying Corollary 6.5.5 keeps both mathematical prerequisites explicit: normalized-divisor refinement and multiplicativity of the real maximal finite-support divisor. -/ +example := (@HahnSeries.Nonpositive.normalizedHPart_seriesMaximal_mul_eq : ∀ (H : AddSubgroup ℝ) {K : Type v} [Field K], HahnSeries.Nonpositive.HasNormalizedHDivisorRefinement H (K := K) → ∀ {b c : HahnSeries.Nonpositive ℝ K} @@ -918,6 +1082,7 @@ divisor. -/ bcH = bH * cH) /- Exact target for LM24, Corollary 6.5.6. -/ +example := (fun {H : AddSubgroup ℝ} {K : Type v} [Field K] [CharZero K] [DivisibleBy H ℤ] ↦ ∀ p : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport (G := H) (K := K), IsPrimal @@ -928,6 +1093,7 @@ divisor. -/ first clause gives existence and global uniqueness of the normalized finite-support factor. When the real support supremum lies in `H`, the second clause gives an irreducible factorisation whose monomial exponent equals that supremum and is globally unique among such factorisations. -/ +example := (fun {H : AddSubgroup ℝ} {K : Type v} [Field K] [CharZero K] [DivisibleBy H ℤ] (b : HahnSeries.Nonpositive H K) ↦ b ≠ 0 → ∃ (k : Kˣ) @@ -947,12 +1113,15 @@ monomial exponent equals that supremum and is globally unique among such factori /- Scalar boundary for Theorem 6.5.7: the corrected factorisation represents `2`, whereas the same normalized factor, zero exponent, and empty residual list without a scalar do not. -/ +example := (Tests.scalarTwo_almostIrreducibleFactorization : HahnSeries.Nonpositive.IsAlmostIrreducibleFactorization (HahnSeries.Nonpositive.C 2 : Tests.FactorizationSeries) (Units.mk0 2 (by norm_num)) (1 : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport (G := Tests.FactorizationExponentSubgroup) (K := ℚ)) Tests.factorizationZeroExponent []) + +example := (Tests.scalarTwo_ne_unscaled_empty_factorization : (HahnSeries.Nonpositive.C 2 : Tests.FactorizationSeries) ≠ (((1 : HahnSeries.Nonpositive.ConstantTermOneFiniteSupport (G := Tests.FactorizationExponentSubgroup) (K := ℚ)) : @@ -963,11 +1132,15 @@ same normalized factor, zero exponent, and empty residual list without a scalar Tests.factorizationZeroExponent : Tests.FactorizationSeries) * ([] : List Tests.FactorizationSeries).prod) + +example := (@Berarducci.principalDegreeClassesToPrincipalComponent_smul : ∀ {K : Type v} [Field K] (α : NatOrdinal) (k : K) (x : Berarducci.principalDegreeClasses K α), Berarducci.principalDegreeClassesToPrincipalComponent K α (k • x) = k • Berarducci.principalDegreeClassesToPrincipalComponent K α x) + +example := (@Berarducci.principalDegreeClassesEquivPrincipalComponent_mul : ∀ {K : Type v} [Field K] [CharZero K] {α β : NatOrdinal} (x : Berarducci.principalDegreeClasses K α) @@ -977,47 +1150,71 @@ same normalized factor, zero exponent, and empty residual list without a scalar Berarducci.principalComponentMul (Berarducci.principalDegreeClassesEquivPrincipalComponent K α x) (Berarducci.principalDegreeClassesEquivPrincipalComponent K β y)) + +example := (@Berarducci.PrincipalSubring : ∀ (K : Type v) [Field K], Type (max v 1)) + +example := (@Berarducci.principalSubringEmbedding : ∀ (K : Type v) [Field K] [CharZero K], Berarducci.PrincipalSubring K →ₐ[K] Berarducci.DegreeGraded K) + +example := (@Berarducci.principalSubringEmbedding_apply : ∀ {K : Type v} [Field K] [CharZero K] (x : Berarducci.PrincipalSubring K) (α : NatOrdinal), Berarducci.principalSubringEmbedding K x α = Berarducci.principalComponentToHahnDegreeLayer K α (x α)) + +example := (@Berarducci.mem_principalGradedSubalgebra_iff : ∀ {K : Type v} [Field K] [CharZero K] (x : Berarducci.DegreeGraded K), x ∈ Berarducci.principalSubringSubalgebra K ↔ Berarducci.IsPrincipalGraded x) + +example := (@MaxAddDegree.residueMap : ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] [LinearOrder M] [IsOrderedCancelAddMonoid M] (ν : MaxAddDegree R M), ν.nonpositiveSubring →+* ν.ResidueRing) + +example := (@MaxAddDegree.residueMap_surjective : ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] [LinearOrder M] [IsOrderedCancelAddMonoid M] (ν : MaxAddDegree R M), Function.Surjective ν.residueMap) + +example := (@MaxAddDegree.residueMap_ker : ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] [LinearOrder M] [IsOrderedCancelAddMonoid M] (ν : MaxAddDegree R M), RingHom.ker ν.residueMap = ν.negativeIdeal) + +example := (@MaxAddDegree.residueQuotientEquiv : ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommMonoid M] [LinearOrder M] [IsOrderedCancelAddMonoid M] (ν : MaxAddDegree R M), ν.nonpositiveSubring ⧸ ν.negativeIdeal ≃+* ν.ResidueRing) + +example := (@MaxAddDegree.nonpositiveSubring_ofValuation_eq_integer : ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommGroup M] [LinearOrder M] [IsOrderedAddMonoid M] (w : Valuation R (WithZero (Multiplicative M))), (MaxAddDegree.ofValuation w).nonpositiveSubring = w.integer) + +example := (@MaxAddDegree.negativeIdeal_ofValuation_eq_comap_ltIdeal : ∀ {R : Type u} {M : Type v} [CommRing R] [AddCommGroup M] [LinearOrder M] [IsOrderedAddMonoid M] (w : Valuation R (WithZero (Multiplicative M))), (MaxAddDegree.ofValuation w).negativeIdeal = (w.ltIdeal 1).comap (MaxAddDegree.nonpositiveEquivInteger w).toRingHom) + +example := (@HahnSeries.Nonpositive.real_hahn_series_finite_support_residue : ∀ {K : Type v} [Field K] [CharZero K], ∃ w : MaxAddDegree (HahnSeries.Nonpositive ℝ K) NatOrdinal, w.IsMultiplicative ∧ (∀ b, w b = (b : K⟦ℝ⟧).degree) ∧ w.nonpositiveSubring = HahnSeries.Nonpositive.finiteSupportSubring ∧ w.negativeIdeal = ⊥ ∧ Function.Bijective w.residueMap) + +example := (@HahnSeries.Nonpositive.real_hahn_series_degree_valuation : ∀ {K : Type v} [Field K] [CharZero K] (b c : HahnSeries.Nonpositive ℝ K), b ≠ 0 → c ≠ 0 → ((b + c : HahnSeries.Nonpositive ℝ K) : K⟦ℝ⟧).degree ≤ @@ -1025,6 +1222,8 @@ same normalized factor, zero exponent, and empty residual list without a scalar ((b * c : HahnSeries.Nonpositive ℝ K) : K⟦ℝ⟧).degree = (b : K⟦ℝ⟧).degree + (c : K⟦ℝ⟧).degree ∧ ((b : K⟦ℝ⟧).degree = ⊥ ↔ b = 0)) + +example := (@HahnSeries.Nonpositive.exists_finiteSupport_split_of_dvd_mul : ∀ {K : Type v} [Field K] [CharZero K] {p b c : HahnSeries.Nonpositive ℝ K}, p ∈ HahnSeries.Nonpositive.finiteSupportSubring → p ∣ b * c → @@ -1034,18 +1233,22 @@ same normalized factor, zero exponent, and empty residual list without a scalar p = p₁ * p₂ ∧ p₁ ∣ b ∧ p₂ ∣ c) /- LM24, Corollary 6.3.9. -/ +example := (@HahnSeries.Nonpositive.isPrimal_of_mem_finiteSupportSubring : ∀ {K : Type v} [Field K] [CharZero K] {p : HahnSeries.Nonpositive ℝ K}, p ∈ HahnSeries.Nonpositive.finiteSupportSubring → IsPrimal p) /- Berarducci, Definition 6.6. The residual point is strictly negative, and the translated closed truncation has exactly the residual value. -/ +example := (@Berarducci.mem_residualPointSet_iff : ∀ {K : Type v} [Field K] {b : Berarducci.SeriesWithOrdinalValueAboveOne K} {γ : ℝ}, γ ∈ Berarducci.residualPointSet b ↔ γ < 0 ∧ Berarducci.ordinalValue (Berarducci.translatedTruncation (b.1 : K⟦ℝ⟧) γ) = b.residualValue) + +example := (@Berarducci.residualPointTail_eq_inter_Ioo : ∀ {K : Type v} [Field K] (b : Berarducci.SeriesWithOrdinalValueAboveOne K) (η : ℝ), Berarducci.residualPointTail b η = @@ -1053,6 +1256,7 @@ truncation has exactly the residual value. -/ /- Berarducci, Lemma 6.8. The statement is unchanged; the proof treats residual value one by isolated support points rather than by the failing limit-index construction in the printed proof. -/ +example := (@Berarducci.residualPointTail_eventually : ∀ {K : Type v} [Field K] [CharZero K] (b : Berarducci.SeriesWithOrdinalValueAboveOne K), ∀ᶠ η in nhdsWithin (0 : ℝ) (Set.Iio 0), @@ -1062,6 +1266,7 @@ isolated support points rather than by the failing limit-index construction in t IsLUB (Berarducci.residualPointTail b η) 0) /- Berarducci, Lemma 6.9, with the domain of `X(b)` and `v_J^p(b)` made explicit. -/ +example := (@Berarducci.ordinalValue_ge_of_eventually_ordinalValue_translatedTruncation_ge : ∀ {K : Type v} [Field K] [CharZero K] (b : Berarducci.SeriesWithOrdinalValueAboveOne K) (c : Berarducci.Series K) {ρ : Ordinal}, Ordinal.IsPrincipal (fun α β ↦ α + β) ρ → @@ -1070,35 +1275,44 @@ isolated support points rather than by the failing limit-index construction in t NatOrdinal.of ρ ≤ Berarducci.ordinalValue (Berarducci.translatedTruncation (c : K⟦ℝ⟧) γ)) → NatOrdinal.of (ρ * b.principalValue.val) ≤ Berarducci.ordinalValue c) + +example := (@conwayRefinementConjecture_def : ConwayRefinementConjecture.{u} ↔ ∀ a b c d : Surreal.OmnificInteger.{u}, a * b = c * d → ∃ e f g h : Surreal.OmnificInteger.{u}, a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h) /- *On Numbers and Games*, Theorem 31, as recalled in LM24, Section 1.1. -/ +example := (@Surreal.isOmnificInteger_iff_normalForm : ∀ {x : Surreal.{u}}, Surreal.IsOmnificInteger x ↔ x.support ⊆ Set.Ici 0 ∧ x.coeff 0 ∈ Set.range ((↑) : ℤ → ℝ)) /- LM24, Sections 1.1 and 1.5, after the change of variable `t = ω⁻¹`. -/ +example := (@Surreal.supportOrderType_toFullHahnSeries : ∀ (x : Surreal.{u}), x.toFullHahnSeries.supportOrderType = Ordinal.lift.{u + 1, u} x.length) + +example := (@Surreal.supportDegree_toFullHahnSeries : ∀ (x : Surreal.{u}), x.toFullHahnSeries.degree = x.supportDegree) /- LM24, Proposition 2.4.3: every nonzero surreal Archimedean stratum is order-additively isomorphic to the reals. -/ +example := (@Surreal.stratumOrderAddMonoidIsoReal : ∀ (s : HahnEmbedding.ArchimedeanStrata ℝ Surreal.{u}) (c : FiniteArchimedeanClass Surreal.{u}), s.stratum c ≃+o ℝ) /- Universe-bounded LM24, Proposition 2.4.4: every nonzero surreal Archimedean ball has cofinality at least the cardinal bounding small Conway normal forms. -/ +example := (@Surreal.smallSupportCardinal_le_ball_cof : ∀ (c : FiniteArchimedeanClass Surreal.{u}), Surreal.smallSupportCardinal.{u} ≤ Order.cof ↥(FiniteArchimedeanClass.ball ℝ c)) /- LM24, Definition 8.2.6. Reducedness is defined only for a nonzero series, and the witnessing Archimedean class may be the zero class. -/ +example := (@HahnSeries.Nonpositive.IsReduced.elim : ∀ {G : Type u} {R : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Ring R] {b : HahnSeries.Nonpositive G R}, HahnSeries.Nonpositive.IsReduced b → @@ -1109,11 +1323,15 @@ Archimedean class may be the zero class. -/ /- The zero Archimedean class is a genuine witness, while mixing zero with a nonzero class is not reduced. -/ +example := (Tests.reducedConstant_isReduced : HahnSeries.Nonpositive.IsReduced Tests.reducedConstant) + +example := (Tests.nonreducedTwoClass_not_isReduced : ¬HahnSeries.Nonpositive.IsReduced Tests.nonreducedTwoClass) /- The finite calculation before LM24, Definition 8.4.2 uses the classes met by the support, including the zero class. These are not the individual support exponents. -/ +example := (@HahnSeries.Nonpositive.mem_supportArchimedeanClasses : ∀ {G : Type u} {R : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Ring R] (b : HahnSeries.Nonpositive G R) (c : ArchimedeanClass G), @@ -1122,6 +1340,7 @@ including the zero class. These are not the individual support exponents. -/ /- LM24's finite calculation removes the leading class at each open truncation. The Mathlib order on classes is opposite to LM24's. This signature checks strict support-class descent. -/ +example := (@HahnSeries.Nonpositive.supportArchimedeanClasses_tau_ssubset : ∀ {K : Type u} {G : Type u} {R : Type v} [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] @@ -1135,6 +1354,7 @@ order on classes is opposite to LM24's. This signature checks strict support-cla /- The leading reduction in LM24, Proposition 8.2.5 is reduced. This one-step certificate, together with strict descent, does not assert the closed finite-product formula in Section 8.4. -/ +example := (@HahnSeries.Nonpositive.isReduced_rho_leadingClass_of_tau_ne_zero : ∀ {K : Type u} {G : Type u} {R : Type v} [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] @@ -1149,15 +1369,21 @@ together with strict descent, does not assert the closed finite-product formula /- Nondegenerate separators: the first support contains both zero and a nonzero exponent; the second support is infinite but meets only one class. -/ +example := (Tests.FiniteClassReduction.twoClass_support_classes : HahnSeries.Nonpositive.supportArchimedeanClasses Tests.FiniteClassReduction.twoClassSeries = {ArchimedeanClass.mk (-1 : ℝ), ⊤}) + +example := (Tests.FiniteClassReduction.oneRow_support_infinite : (Berarducci.OneRow.withoutConstant (K := ℝ) : ℝ⟦ℝ⟧).support.Infinite) + +example := (Tests.FiniteClassReduction.oneRow_support_classes : HahnSeries.Nonpositive.supportArchimedeanClasses (Berarducci.OneRow.withoutConstant (K := ℝ)) = {ArchimedeanClass.mk (-1 : ℝ)}) /- LM24, Proposition 8.3.6(5), residue-one irreducibility transfer. -/ +example := (@HahnSeries.Nonpositive.irreducible_of_irreducible_splitTruncation_of_tau_eq_one : ∀ {K : Type u} {G : Type u} {R : Type v} [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] @@ -1180,6 +1406,7 @@ the second support is infinite but meets only one class. -/ /- LM24, Proposition 9.2.2 in the cardinal-bounded model used for surreal normal forms. Its underlying preimage lemma is used with a domain ambient ring and clears scalar denominators before applying primality in the residue subring. -/ +example := (@Subring.isPrimal_residueSubring_iff : ∀ {L : Type u} {A : Type v} [Field L] [CommRing A] [Algebra L A] {π : A →ₐ[L] L} {S : Subring L} [IsDomain A] {b : A} (hb : π b ∈ S), IsPrimal (⟨b, hb⟩ : Subring.residueSubring π S) ↔ @@ -1188,6 +1415,8 @@ applying primality in the residue subring. -/ IsPrimal (⟨b, Subring.le_fracSubring hb⟩ : Subring.residueSubring π (Subring.fracSubring S)))) + +example := (@Tests.cardinalProposition922 : ∀ {K : Type u} {G : Type u} {R : Type v} {κ : Cardinal.{u}} [DivisionRing K] [LinearOrder K] [IsOrderedRing K] [Archimedean K] [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] From dd6732abf5a3078f8afe8447facf8de21344e3a3 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 01:05:17 +0000 Subject: [PATCH 10/18] Clean Conway import warnings and document the complete API --- LeanPool.lean | 1 + .../CombinatorialGames/Game/Basic.lean | 5 +- .../CombinatorialGames/Game/Birthday.lean | 4 +- .../CombinatorialGames/Game/Classes.lean | 4 +- .../CombinatorialGames/Game/IGame.lean | 5 +- .../CombinatorialGames/Game/Player.lean | 2 +- .../CombinatorialGames/Surreal/Dyadic.lean | 2 +- .../CombinatorialGames/Surreal/Pow.lean | 2 +- .../CombinatorialGames/Surreal/Real.lean | 2 +- .../CombinatorialGames/Tactic/GameCmp.lean | 2 +- .../Algebra/DirectSum/GermPolynomial.lean | 3 +- .../Algebra/DirectSum/GermSuccessorStep.lean | 232 ++++++----- .../Algebra/Divisibility/MaximalDivisor.lean | 3 +- .../Algebra/Divisibility/Refinement.lean | 2 +- .../Algebra/Finset/FilterCard.lean | 34 ++ .../Algebra/GeometricIntegrality.lean | 20 +- .../GradedRing/FinitePartSubstitution.lean | 2 +- .../Algebra/GradedRing/OrdinalGenerators.lean | 2 +- .../LoweringDerivation/BaseChange.lean | 19 +- .../Algebra/MvPolynomial/Components.lean | 9 +- .../Algebra/MvPolynomial/ComponentsSpan.lean | 2 +- .../Algebra/MvPolynomial/Expansion.lean | 5 +- .../MvPolynomial/FinitePartDecomposition.lean | 2 +- .../Algebra/MvPolynomial/GCDMonoid.lean | 6 +- .../LimitOrdinalContradiction.lean | 6 +- .../MvPolynomial/OrdinalDerivation.lean | 8 +- .../Algebra/MvPolynomial/Syzygy.lean | 3 +- .../Order/Module/ConvexQuotientSplitting.lean | 1 + .../Algebra/Valuation/BasisOver.lean | 10 +- .../Valuation/DegreeAssociatedGraded.lean | 2 + .../DegreeAssociatedGradedDomain.lean | 6 +- .../Algebra/Valuation/DegreeInitialForm.lean | 3 +- .../DegreePrincipalInitialIdeal.lean | 2 +- .../Algebra/Valuation/FiltrationDegree.lean | 4 +- .../Algebra/Valuation/MaxAddDegree.lean | 3 +- .../Algebra/Valuation/QuotientDegree.lean | 2 +- .../Valuation/Tests/AssociatedGraded.lean | 10 +- .../Tests/AssociatedGradedValuation.lean | 6 + .../Algebra/Valuation/Tests/RV.lean | 6 + .../Algebra/Valuation/Tests/Residue.lean | 10 + .../ConwayRefinement/Blueprint.lean | 16 + .../Data/Multiset/SelectionComplexity.lean | 2 + .../OmnificInteger/OneRowNormalForm.lean | 2 +- .../LatticeFactorCoefficients.lean | 9 +- .../CardinalTruncationDomainEmbedding.lean | 3 +- .../HahnSeries/ConvexQuotientSplitting.lean | 1 + .../HahnSeries/Degree/Statements/Degree.lean | 2 +- .../Degree/Statements/DegreeResidue.lean | 2 +- .../HahnSeries/DegreeValuation.lean | 2 +- .../ConwayRefinement/HahnSeries/Domain.lean | 2 +- .../HahnSeries/DomainEmbedding.lean | 6 +- .../HahnSeries/DomainOrderType.lean | 8 +- .../Factorization/AlmostIrreducible.lean | 2 +- .../DegreeTwo/DegreeTwoExample.lean | 6 +- .../TranslatedSpanFactorization.lean | 6 +- .../Factorization/MaximalFinite.lean | 24 +- .../Factorization/PrincipalMaximalFinite.lean | 3 +- .../Random/GradedIrreducible.lean | 7 +- .../Factorization/Random/MainTheorem.lean | 2 +- .../SeriesMaximalMultiplicativity.lean | 2 +- .../Factorization/SeriesPrimality.lean | 2 +- .../Statements/PrincipalSubringFraction.lean | 2 +- .../Tests/AlmostIrreducible.lean | 3 + .../Tests/AlmostIrreducibleFactorization.lean | 2 + .../Tests/MaximalFiniteSupportDivisor.lean | 2 +- .../Factorization/Tests/NormalizedHPart.lean | 4 + .../NormalizedHPartMultiplicativity.lean | 1 + .../HahnSeries/FiniteSupport.lean | 4 +- .../HahnSeries/FiniteSupportGCDProof.lean | 4 +- .../FiniteSupportNormalizedGCD.lean | 5 +- .../FiniteSupportScalarExtension.lean | 5 +- .../AlgebraicIndependence.lean | 11 +- .../CantorBendixsonRankLevels.lean | 3 +- .../CantorBendixsonValue.lean | 4 +- .../CofactorInduction.lean | 373 ++++++++++-------- .../AlgebraicIndependence/Convolution.lean | 4 +- .../DerivationIdeal.lean | 5 +- .../AlgebraicIndependence/DerivationSet.lean | 3 +- .../Germ/AlgebraicIndependence/Germ.lean | 3 +- .../Germ/AlgebraicIndependence/Graded.lean | 2 +- .../LeadingCoefficient.lean | 3 +- .../AlgebraicIndependence/LiftFamily.lean | 3 +- .../Germ/AlgebraicIndependence/Lifts.lean | 4 +- .../LimitOrdinalRelationAtCutoff.lean | 2 + .../AlgebraicIndependence/LinearMaximal.lean | 2 +- .../LowerTruncationDegree.lean | 2 +- .../AlgebraicIndependence/Multiplication.lean | 2 +- .../PartialDerivativeIndices.lean | 2 +- .../PartialDerivativesAtLimitOrdinal.lean | 41 +- .../Germ/AlgebraicIndependence/Scalar.lean | 4 +- ...calarLeadingCoefficientAtLimitOrdinal.lean | 5 +- ...anslatedTruncationInterpolationOnSets.lean | 3 +- .../AlgebraicIndependence/Truncation.lean | 5 +- .../TruncationExpansion.lean | 4 +- .../TruncationPolynomial.lean | 2 +- .../HahnSeries/IntegerPart/Assumptions.lean | 4 +- .../IntegerPart/FiniteClassPrimality.lean | 2 +- .../IntegerPart/IntegerPartSplitting.lean | 12 + .../IntegerPart/LimitTailPrimality.lean | 4 +- .../Refinement/CardinalGermRefinement.lean | 18 +- .../Refinement/CompleteGermRefinement.lean | 2 +- .../Refinement/FiniteGermError.lean | 8 +- .../Refinement/LimitTailRefinement.lean | 4 +- .../Refinement/SupportClassFactorization.lean | 2 +- .../Refinement/SupportClassRefinement.lean | 6 +- .../TruncationIntegerPartFractionField.lean | 2 +- .../IntegerPart/Tests/ClassTruncation.lean | 2 + .../Tests/ReducedCharacterization.lean | 2 + .../IntegerPart/Tests/Reduction.lean | 2 + .../HahnSeries/IterateOrderType.lean | 4 +- .../HahnSeries/Multiplicativity.lean | 2 +- .../HahnSeries/NonpositiveDomainEquiv.lean | 6 +- .../HahnSeries/NormalForm.lean | 2 + .../HahnSeries/OrderType.lean | 2 +- .../CantorBendixsonRepresentatives.lean | 3 +- .../DerivAtInjective.lean | 2 +- .../IdealFromTruncations.lean | 4 +- .../LeadingCoefficient.lean | 3 +- .../LimitOrdinalRelationAtCutoff.lean | 4 + .../AlgebraicIndependence/LowDegreeParts.lean | 3 +- .../LoweringDerivation.lean | 6 +- .../PartialDerivativeIndices.lean | 5 +- .../AlgebraicIndependence/Partials.lean | 49 +-- .../AlgebraicIndependence/Pieces.lean | 5 +- .../ProductCondition.lean | 3 +- .../AlgebraicIndependence/ProductValues.lean | 3 +- .../AlgebraicIndependence/RealPartials.lean | 3 +- .../SumAlongCutoffs.lean | 3 +- .../SupportLoweringPieces.lean | 208 ++++++---- .../AlgebraicIndependence/Syzygy.lean | 7 +- .../TruncationExpansion.lean | 2 +- .../OrdinalValue/CriticalPoint.lean | 2 +- .../OrdinalValue/CriticalPointExistence.lean | 2 +- .../OrdinalValue/Irreducibility.lean | 2 +- .../HahnSeries/OrdinalValue/OneRow.lean | 2 +- .../HahnSeries/OrdinalValue/OrdinalValue.lean | 4 +- .../OrdinalValueFinalSegment.lean | 4 +- .../PrincipalComponentTensor.lean | 11 +- .../PrincipalSubringFraction.lean | 3 + .../PrincipalSubringFractionAlgebraic.lean | 10 +- .../PrincipalSubringLocalization.lean | 2 + .../PrincipalSubringMonoidAlgebra.lean | 4 +- ...cipalSubringScalarRedistributionProof.lean | 2 + .../OrdinalValue/PrincipalSubringTensor.lean | 9 +- .../OrdinalValue/ResidualPoint.lean | 2 +- .../OrdinalValue/ResidualPointOrderType.lean | 4 +- .../OrdinalValue/ResidualPointSupport.lean | 2 +- .../Statements/ResidualPoint.lean | 2 +- .../PrincipalGraded.lean | 2 +- .../Tests/OrdinalValueFinalSegment.lean | 2 +- .../Tests/PrincipalComponent.lean | 1 + .../Tests/PrincipalComponentTensor.lean | 3 +- .../OrdinalValue/Tests/PrincipalSubring.lean | 2 + .../Tests/PrincipalSubringFiniteSupport.lean | 4 +- .../Tests/PrincipalSubringFraction.lean | 6 + .../Tests/PrincipalSubringTensor.lean | 4 +- .../PolynomialAlgebra/CompleteGerm.lean | 2 +- .../PolynomialPresentation.lean | 6 +- .../PolynomialAlgebra/Tests/GCDMonoid.lean | 2 +- .../HahnSeries/Primality/GCDMonoid.lean | 4 +- .../HahnSeries/Primality/Primality.lean | 2 +- .../HahnSeries/SeparatedSupport.lean | 4 +- .../HahnSeries/Tests/FiniteSupportGCD.lean | 2 + .../Tests/FiniteSupportScalarExtension.lean | 7 +- .../Tests/Fixtures/ApproachZero.lean | 2 +- .../Tests/NonpositiveDomainEquiv.lean | 2 + .../HahnSeries/Tests/NormalForm.lean | 2 +- .../HahnSeries/Tests/OrderTypeDegree.lean | 20 +- .../HahnSeries/Tests/Truncation.lean | 18 +- .../HahnSeries/Tests/WeakNormalForm.lean | 6 +- .../HahnSeries/Translation.lean | 4 +- .../HahnSeries/WeakNormalForm.lean | 2 +- .../LinearAlgebra/FiniteSpanRelation.lean | 2 +- .../LinearAlgebra/TensorProduct/Content.lean | 10 +- .../ConwayRefinement/Order/Archimedean.lean | 2 +- .../RingTheory/LocalizationUFM.lean | 2 +- .../SetTheory/Ordinal/CantorBendixson.lean | 9 +- .../SetTheory/Ordinal/Degree.lean | 2 +- .../SetTheory/Ordinal/LeastTerm.lean | 3 + .../SetTheory/Ordinal/OrderedUnion.lean | 8 +- .../SetTheory/Ordinal/SetOrderType.lean | 58 +-- .../SetTheory/Ordinal/Sumset.lean | 4 +- .../SetTheory/Ordinal/Tests/SetOrderType.lean | 4 +- .../SetTheory/Ordinal/Tests/Sumset.lean | 12 +- .../SetTheory/ZFC/GameOperations.lean | 14 +- .../Examples/DegreeTwoPrimeProof.lean | 2 +- .../PrincipalRVAlgebraicIndependence.lean | 2 +- .../Support/FinitePowerFamily.lean | 8 +- ...PrincipalRVAlgebraicIndependenceProof.lean | 6 +- .../Mathlib/Examples/DegreeTwoPrime.lean | 2 +- .../Mathlib/Examples/DegreeTwoPrimeProof.lean | 2 +- .../HahnIntegerPartRefinementCriterion.lean | 2 +- .../Mathlib/GermPolynomialRing.lean | 2 +- .../Mathlib/HahnIntegerPartRefinement.lean | 2 +- .../Standalone/Mathlib/HahnSeriesGCD.lean | 2 +- .../Mathlib/HahnSeriesPolynomialRing.lean | 6 +- .../Mathlib/InlineConwayRefinement.lean | 1 + .../Support/CompleteHahnGermProof.lean | 4 +- .../Support/ConvexQuotientSplitting.lean | 1 + .../Mathlib/Support/ConwayRefinement.lean | 6 +- .../Support/ConwayRefinementProof.lean | 6 +- .../Support/GermPolynomialRingProof.lean | 8 +- .../HahnIntegerPartRefinementProof.lean | 22 +- .../Mathlib/Support/HahnSeriesGCDProof.lean | 14 +- .../HahnSeriesPolynomialRingProof.lean | 2 +- .../Support/InlineConwayRefinementProof.lean | 88 +++-- .../Mathlib/Support/InlineSurreal.lean | 59 +-- .../Surreal/ArchimedeanAssumptions.lean | 6 +- .../ConwayRefinement/Surreal/Cardinal.lean | 2 +- .../ConwayRefinement/Surreal/CutFilling.lean | 2 +- .../Surreal/HahnSeries/NormalForm.lean | 4 + .../Surreal/HahnSeries/NormalFormMul.lean | 8 +- .../HahnSeries/NormalFormRecursion.lean | 2 +- .../Surreal/OmnificInteger/Basic.lean | 7 +- .../Primality/IrreducibleOmnificIntegers.lean | 2 +- .../Refinement/ConwayRefinement.lean | 8 +- .../Surreal/RationalTailQuotient.lean | 2 +- .../ConwayRefinement/Surreal/Round.lean | 13 +- .../Surreal/SmallDiscrete.lean | 2 +- .../ConwayRefinement/Surreal/ZFC/Basic.lean | 17 +- .../ConwayRefinement/Surreal/ZFC/Cuts.lean | 8 +- .../Surreal/ZFC/OmnificCodes.lean | 3 +- .../Surreal/ZFC/OmnificInteger.lean | 2 +- .../Surreal/ZFC/Properness.lean | 10 +- .../ConwayRefinement/Surreal/ZFC/Reduced.lean | 4 +- .../ConwayRefinement/Tests/SourceIndex.lean | 2 +- .../Topology/CantorBendixson.lean | 2 +- .../Topology/CantorBendixsonRank.lean | 4 +- .../CantorBendixsonReconstruction.lean | 4 +- .../Order/CantorBendixsonConvexCover.lean | 2 +- .../Topology/Order/ClosedPWO.lean | 6 +- .../Topology/Order/CoinitialComplete.lean | 4 +- .../Topology/Order/PWOAddition.lean | 4 +- .../Topology/Order/SmallClosedSubspace.lean | 2 +- .../Tests/CantorBendixsonConvexCover.lean | 2 +- .../Topology/Order/Tests/PWOAddition.lean | 11 +- .../Topology/Tests/CantorBendixson.lean | 4 +- 237 files changed, 1230 insertions(+), 956 deletions(-) create mode 100644 LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Finset/FilterCard.lean diff --git a/LeanPool.lean b/LeanPool.lean index 756afe4725..0ae47e8c75 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -922,6 +922,7 @@ import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPro import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Tests import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Tests.Refinement +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Finset.FilterCard import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GeometricIntegrality import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.Extension diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Basic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Basic.lean index fe98076598..e12ef51288 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Basic.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Basic.lean @@ -1,10 +1,13 @@ /- Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Violeta Hernández Palacios, Reid Barton, Mario Carneiro, Isabel Longbottom, Kim Morrison, Apurva Nakade, Yuyang Zhao +Authors: V.Hernández Palacios, R.Barton, M.Carneiro, I.Longbottom, K.Morrison, A.Nakade, Y.Zhao -/ module +/- Full upstream author names: Violeta Hernández Palacios, Reid Barton, Mario Carneiro, Isabel +Longbottom, Kim Morrison, Apurva Nakade, Yuyang Zhao. -/ + public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Classes public import Mathlib.Algebra.CharZero.Defs public import Mathlib.Algebra.Order.Monoid.Defs diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean index d7a52bf624..02eb37d6af 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean @@ -212,7 +212,7 @@ instance small_setOf_birthday_lt (o : NatOrdinal.{u}) : Small.{u} {x | birthday | isSuccPrelimit o ho ih => convert @small_biUnion _ _ (Iio o) _ (fun i _ => {x : IGame.{u} | x.birthday < i}) ih ext x - simpa [Set.nonempty_def, and_comm] using ho.lt_iff_exists_lt + simpa [Set.nonempty_def, and_comm] using ho.lt_iff_nonempty_Ioo /-- Games with a bounded birthday form a small set. -/ instance small_setOf_birthday_le (o : NatOrdinal.{u}) : Small.{u} {x | birthday x ≤ o} := by @@ -406,7 +406,7 @@ instance small_setOf_birthday_le (o : NatOrdinal.{u}) : Small.{u} {x | birthday /-- Games with a bounded birthday form a small set. -/ instance small_setOf_birthday_lt (o : NatOrdinal.{u}) : Small.{u} {x | birthday x < o} := - small_subset (s := {x | birthday x ≤ o}) <| setOf_subset_setOf.2 fun _ => le_of_lt + small_subset (s := {x | birthday x ≤ o}) <| Set.ofPred_subset_ofPred.2 fun _ => le_of_lt /-- A variant of `small_setOf_birthday_le` in simp-normal form -/ instance small_subtype_birthday_le (o : NatOrdinal.{u}) : Small.{u} {x // birthday x ≤ o} := diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean index 1cd1610cc3..fd1ba5dee7 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean @@ -8,7 +8,7 @@ module public import LeanPool.ConwayRefinement.CombinatorialGames.Game.IGame public meta import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.AddInstances -import Mathlib.Data.Finite.Prod +import Mathlib.Basic.Finite.Prod import Mathlib.Data.Set.Finite.Lattice /-! @@ -442,7 +442,7 @@ theorem finite_setOf_subposition (x : IGame) [Short x] : {y | Subposition y x}.F convert Set.finite_iUnion fun p => (finite_moves p x).biUnion fun y hy ↦ (@ih p y hy (.of_mem_moves hy)).insert y ext - rw [Set.mem_setOf, subposition_iff_exists] + rw [Set.mem_ofPred, subposition_iff_exists] simp [wsubposition_iff_eq_or_subposition] instance (x : IGame) [Short x] : Finite {y // Subposition y x} := diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean index b5aef5fc55..789a5fb546 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean @@ -1,10 +1,13 @@ /- Copyright (c) 2025 Violeta Hernández Palacios. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Violeta Hernández Palacios, Reid Barton, Mario Carneiro, Isabel Longbottom, Kim Morrison, Yuyang Zhao +Authors: V.Hernández Palacios, R.Barton, M.Carneiro, I.Longbottom, K.Morrison, Y.Zhao -/ module +/- Full upstream author names: Violeta Hernández Palacios, Reid Barton, Mario Carneiro, Isabel +Longbottom, Kim Morrison, Yuyang Zhao. -/ + public import Batteries.Classes.RatCast public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Player public meta import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.Register diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Player.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Player.lean index 0115a77e49..732af70c62 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Player.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Player.lean @@ -143,7 +143,7 @@ macro "!{" st:term "}'" h:term:max : term => `(OfSets.ofSets $st $h) macro "!{" s:term " | " t:term "}'" h:term:max : term => `(!{Player.cases $s $t}'$h) /-- A tactic which attempts to automatically solve goals which appear on `OfSets`. -/ -macro "of_sets_tactic" : tactic => +macro (name := ofSetsTactic) "of_sets_tactic" : tactic => `(tactic| first | done | trivial diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Dyadic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Dyadic.lean index 6e8d347279..2efe08972a 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Dyadic.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Dyadic.lean @@ -58,7 +58,7 @@ theorem den_upper_lt {x : Dyadic} (h : x.den ≠ 1) : (upper x).den < x.den := b exact den_mkRat_lt ((odd_num h).add_odd odd_one).two_dvd h /-- An auxiliary tactic for inducting on the denominator of a `Dyadic`. -/ -macro "dyadic_wf" : tactic => +macro (name := dyadicWf) "dyadic_wf" : tactic => `(tactic| all_goals first | solve_by_elim [Prod.Lex.left, Prod.Lex.right, den_lower_lt, den_upper_lt] | decreasing_tactic) diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Pow.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Pow.lean index 338dc134ad..59b899e38f 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Pow.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Pow.lean @@ -804,7 +804,7 @@ theorem mk_div_wpow_wlog_of_ne_zero {x : Surreal} (hx : x ≠ 0) : rw [archimedeanClassMk_div_wpow_wlog, LinearOrderedAddCommGroupWithTop.sub_self_eq_zero_of_ne_top] simpa -private theorem ofSets_wlog_eq {x : IGame} [Numeric x] : +private theorem ofSets_wlog_eq {x : IGame} : !{IGame.wlog '' {y ∈ xᴸ | 0 < y} | IGame.wlog '' xᴿ} = !{range (Subtype.val ∘ fun x : (xᴸ ∩ Ioi 0 :) ↦ ⟨_, Numeric.wlog x⟩) | range (Subtype.val ∘ fun x : xᴿ ↦ ⟨_, Numeric.wlog x⟩)} := by diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Real.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Real.lean index a237adcbe7..3fbf791196 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Real.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Real.lean @@ -57,7 +57,7 @@ instance : Coe ℝ IGame := ⟨toIGame⟩ instance Numeric.toIGame (x : ℝ) : Numeric x := by rw [Real.toIGame] apply Numeric.mk - · simp only [leftMoves_ofSets, rightMoves_ofSets, Set.forall_mem_image, Set.mem_setOf] + · simp only [leftMoves_ofSets, rightMoves_ofSets, Set.forall_mem_image, Set.mem_ofPred] intro x hx y hy simpa using hx.trans hy · aesop (add simp [Numeric.dyadic]) diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/GameCmp.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/GameCmp.lean index 40cfc0be62..21ed1b3eec 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/GameCmp.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Tactic/GameCmp.lean @@ -39,7 +39,7 @@ Lemmas which are safe to tag with `game_cmp` are the following: Tagging any other lemmas might lead to `simp` failing to eliminate all quantifiers, and getting stuck in a goal that it can't solve. -/ -macro "game_cmp" : tactic => +macro (name := gameCmp) "game_cmp" : tactic => `(tactic| { try simp only [lt_iff_le_not_ge, ge_iff_le, gt_iff_lt, AntisymmRel, Relation.SymmGen, IncompRel] repeat diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermPolynomial.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermPolynomial.lean index b6d3bf30e1..8a1855cf30 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermPolynomial.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermPolynomial.lean @@ -493,7 +493,8 @@ theorem eq_zero_of_eventually_mkDerivation_eq_zero [CharZero K] (hwt : ∀ i, 1 obtain ⟨cf, hcfw, hcf, hcfcoeff⟩ := exists_linear_part hwt hmem hn1 hhhom rw [haeval, zero_sub, neg_mem_iff] at hcf have hcx := hcfcoeff x₀ - rw [hind (wt x₀) cf hcfw hcf, Finsupp.coe_zero, Pi.zero_apply, hh, AddMonoidAlgebra.coeff_add, Finsupp.add_apply, hc, coeff_xCoeff, + rw [hind (wt x₀) cf hcfw hcf, Finsupp.coe_zero, Pi.zero_apply, hh, AddMonoidAlgebra.coeff_add, + Finsupp.add_apply, hc, coeff_xCoeff, ite_eq_right (by simp), zero_add, C_mul_X_eq_monomial, coeff_monomial, ite_eq_left rfl] at hcx exact ha0 ((mul_eq_zero.mp hcx.symm).resolve_left (Nat.cast_ne_zero.mpr (by omega))) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean index a14a40df1b..4e94a05261 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean @@ -44,7 +44,130 @@ variable {ι : Type w} {wt : ι → NatOrdinal.{z}} {x : ι → R} variable {Δ : Derivation K R (Germ l R)} variable (hx : OrdinalGraded.IsMinimalSystem A wt x) variable (hΔ : GermPolynomial.IsLoweringDerivation A Δ) -include hx hΔ +include hx + +open Classical in +/-- Normalized cofactors have a nonzero linear part modulo decomposable homogeneous elements. -/ +private theorem not_forall_aeval_cofactors_mem_decomposable + {δ : NatOrdinal.{z}} (hδ : 0 < δ.constantCoeff) + (T B : Finset ι) (hBT : B ⊆ T) (hBne : B.Nonempty) + (lam : ι → NatOrdinal.{z}) (hlam : ∀ t ∈ T, lam t + wt t = δ) + (hconst : ∀ t ∈ T, (wt t).constantCoeff = δ.constantCoeff) + (V : ι → MvPolynomial ι K) + (hV : ∀ t ∈ T, IsWeightedHomogeneous wt (V t) (wt t) ∧ + V t ∈ supported K {i | (wt i).constantCoeff ≠ δ.constantCoeff}) + (a' : ι → ↥B → MvPolynomial ι K) (ha'one : ∀ b : ↥B, a' b b = 1) + (ha'hom : ∀ t ∈ T, ∀ b : ↥B, ∀ β, β + lam b = lam t → + IsWeightedHomogeneous wt (a' t b) β) + (ha'0 : ∀ t ∈ T, ∀ b : ↥B, (¬ ∃ β, β + lam b = lam t) → a' t b = 0) + (W : ↥B → MvPolynomial ι K) + (hW : ∀ b, W b = ∑ t ∈ T, a' t b * (X t + V t)) : + ¬ ∀ b : ↥B, aeval x (W b) ∈ decomposableAt A (wt b) := by + classical + intro hWdec + -- the linear part `ℓ_b` of `W_b` then lies in `(P̂_+)² ∩ P_{deg b}`, contradicting the linear + -- independence of the generators modulo `(P̂_+)² ∩ P_{deg b}` + obtain ⟨b₀, hb₀⟩ := hBne + obtain ⟨b, hb⟩ : ∃ b : ↥B, (b : ι) = b₀ := ⟨⟨b₀, hb₀⟩, rfl⟩ + obtain ⟨κ', hκ'⟩ : ∃ κ' : ι → K, ∀ t, κ' t = (a' t b).coeff 0 := ⟨_, fun _ ↦ rfl⟩ + obtain ⟨ℓ, hℓ⟩ : ∃ ℓ : MvPolynomial ι K, ℓ = ∑ t ∈ T, C (κ' t) * X t := ⟨_, rfl⟩ + have hdiff : aeval x (W b) - aeval x ℓ ∈ decomposableAt (A) (wt b) := by + rw [hW, hℓ, map_sum, map_sum, ← Finset.sum_sub_distrib] + refine sum_mem fun t ht ↦ ?_ + rw [map_mul, map_mul, map_add, aeval_X, ← algebraMap_eq, AlgHom.commutes] + have hVt : aeval x (V t) ∈ decomposableAt (A) (wt t) := by + refine aeval_mem_decomposableAt_of_mem_supported hx.mem hx.ne_zero ?_ (hV t ht).1 ?_ + · rw [hconst t ht] + exact hδ + · rw [hconst t ht] + exact (hV t ht).2 + by_cases h : ∃ β, β + lam b = lam t + · obtain ⟨β, hβ⟩ := h + have hahom := ha'hom t ht b β hβ + have hdeg : β + wt t = wt b := by + apply add_right_cancel (b := lam b) + rw [add_right_comm, hβ, hlam t ht, add_comm, hlam b (hBT b.2)] + by_cases hβ0 : β = 0 + · -- a scalar coefficient: the difference is `κ' t • V_t(𝓑)` + subst hβ0 + have hC : a' t b = C (κ' t) := by + rw [hκ'] + exact eq_C_of_isWeightedHomogeneous_zero hx.ne_zero hahom + rw [zero_add] at hdeg + rw [hC] + rw [← algebraMap_eq] + rw [AlgHom.commutes] + rw [mul_add] + rw [add_sub_cancel_left] + rw [mul_comm] + rw [← hdeg] + have := mul_mem_decomposableAt_of_mem_decomposableAt hVt + (SetLike.algebraMap_mem_graded (A) (κ' t)) + rwa [add_zero] at this + · have hκ0 : κ' t = 0 := by + rw [hκ'] + exact coeff_zero_eq_zero_of_isWeightedHomogeneous hahom hβ0 + rw [hκ0, map_zero, zero_mul, sub_zero, mul_add, ← hdeg] + refine add_mem (mul_mem_decomposableAt (A) hβ0 (hx.ne_zero t) + (aeval_mem_of_forall_mem hx.mem hahom) (hx.mem t)) ?_ + rw [mul_comm, add_comm] + exact mul_mem_decomposableAt_of_mem_decomposableAt hVt + (aeval_mem_of_forall_mem hx.mem hahom) + · have hκ0 : κ' t = 0 := by + rw [hκ', ha'0 t ht b h, AddMonoidAlgebra.coeff_zero, Finsupp.zero_apply] + rw [ha'0 t ht b h, hκ0] + simp only [map_zero, zero_mul, sub_zero] + exact zero_mem _ + have hℓmem : aeval x ℓ ∈ decomposableAt (A) (wt b) := by + have hub := hWdec b + have := sub_mem hub hdiff + rwa [sub_sub_cancel] at this + -- `ℓ(𝓑)` is a linear combination of the generators of degree `wt b` with coefficient `1` on + -- `x_b` + obtain ⟨f, hf⟩ : ∃ f : ι →₀ K, f = ∑ t ∈ T, Finsupp.single t (κ' t) := ⟨_, rfl⟩ + have hfapply : ∀ i, f i = if i ∈ T then κ' i else 0 := by + intro i + rw [hf, Finsupp.finsetSum_apply] + simp only [Finsupp.single_apply] + exact Finset.sum_ite_eq' T i κ' + have hℓeq : Finsupp.linearCombination K x f = aeval x ℓ := by + rw [hf, map_sum, hℓ, map_sum] + exact Finset.sum_congr rfl fun t _ ↦ by + rw [Finsupp.linearCombination_single, map_mul, aeval_X, ← algebraMap_eq, AlgHom.commutes, + Algebra.smul_def] + have hfsupp : ∀ i ∈ f.support, wt i = wt b := by + intro i hi + rw [Finsupp.mem_support_iff, hfapply] at hi + split_ifs at hi with hiT + · by_cases h : ∃ β, β + lam b = lam i + · obtain ⟨β, hβ⟩ := h + have hahom := ha'hom i hiT b β hβ + by_cases hβ0 : β = 0 + · subst hβ0 + rw [zero_add] at hβ + have := (hlam i hiT).trans (hlam b (hBT b.2)).symm + rw [hβ] at this + exact add_left_cancel this + · refine absurd ?_ hi + rw [hκ'] + exact coeff_zero_eq_zero_of_isWeightedHomogeneous hahom hβ0 + · refine absurd ?_ hi + rw [hκ', ha'0 i hiT b h, AddMonoidAlgebra.coeff_zero, Finsupp.zero_apply] + · exact absurd rfl hi + have hfmem : Finsupp.linearCombination K x f ∈ decomposableAt (A) (wt b) := by + rw [hℓeq] + exact hℓmem + have hf0 := hx.independent (wt b) f hfsupp hfmem + have hfb := congrArg (fun g : ι →₀ K ↦ g b₀) hf0 + simp only [Finsupp.coe_zero, Pi.zero_apply] at hfb + rw [hfapply, ite_eq_left (hBT hb₀)] at hfb + have hκ1 : κ' b₀ = 1 := by + rw [hκ', ← hb, ha'one b, AddMonoidAlgebra.coeff_one_zero] + rw [hκ1] at hfb + exact one_ne_zero hfb + + +include hΔ open Classical in /-- **The successor step.** Evaluation is injective in a degree of positive finite part when it is @@ -138,7 +261,7 @@ theorem injectiveAt_of_forall_lt [CharZero K] (hgz : GradeZeroScalars A) (∀ b : ↥B, ∀ β, β + lam b = lam t → IsWeightedHomogeneous wt (a b) β) ∧ (∀ b : ↥B, (¬ ∃ β, β + lam b = lam t) → a b = 0) ∧ c t = ∑ b : ↥B, c b * a b := by intro t ht - letI := weightedGradedAlgebra K wt + let := weightedGradedAlgebra K wt obtain ⟨a, ha, ha0, hsum⟩ := exists_eq_sum_mul_of_mem_span (𝒜 := weightedHomogeneousSubmodule K wt) (q := fun b : ↥B ↦ c b) (c := fun b : ↥B ↦ lam b) (fun b ↦ (mem_weightedHomogeneousSubmodule _ _ _ _).mpr (hchom b (hBT b.2))) @@ -489,107 +612,10 @@ theorem injectiveAt_of_forall_lt [CharZero K] (hgz : GradeZeroScalars A) ⟨fun h ↦ (Finset.mem_erase.mp hb').1 (Subtype.ext h), b'.2⟩) rw [← hρβ] exact mul_mem_decomposableAt (A) hρ0 hβ0 haρ hwβ - -- the linear part `ℓ_b` of `W_b` then lies in `(P̂_+)² ∩ P_{deg b}`, contradicting the linear - -- independence of the generators modulo `(P̂_+)² ∩ P_{deg b}` - obtain ⟨b₀, hb₀⟩ := hBne - obtain ⟨b, hb⟩ : ∃ b : ↥B, (b : ι) = b₀ := ⟨⟨b₀, hb₀⟩, rfl⟩ - obtain ⟨κ', hκ'⟩ : ∃ κ' : ι → K, ∀ t, κ' t = (a' t b).coeff 0 := ⟨_, fun _ ↦ rfl⟩ - obtain ⟨ℓ, hℓ⟩ : ∃ ℓ : MvPolynomial ι K, ℓ = ∑ t ∈ T, C (κ' t) * X t := ⟨_, rfl⟩ - have hdiff : aeval x (W b) - aeval x ℓ ∈ decomposableAt (A) (wt b) := by - rw [hW, hℓ, map_sum, map_sum, ← Finset.sum_sub_distrib] - refine sum_mem fun t ht ↦ ?_ - rw [map_mul, map_mul, map_add, aeval_X, ← algebraMap_eq, AlgHom.commutes] - have hVt : aeval x (V t) ∈ decomposableAt (A) (wt t) := by - refine aeval_mem_decomposableAt_of_mem_supported hx.mem hx.ne_zero ?_ (hV t ht).1 ?_ - · rw [(hmemT t ht).2] - exact hδ - · rw [(hmemT t ht).2] - exact (hV t ht).2 - by_cases h : ∃ β, β + lam b = lam t - · obtain ⟨β, hβ⟩ := h - have hahom := ha'hom t ht b β hβ - have hdeg : β + wt t = wt b := by - apply add_right_cancel (b := lam b) - rw [add_right_comm, hβ, hlam t ht, add_comm, hlam b (hBT b.2)] - by_cases hβ0 : β = 0 - · -- a scalar coefficient: the difference is `κ' t • V_t(𝓑)` - subst hβ0 - have hC : a' t b = C (κ' t) := by - rw [hκ'] - exact eq_C_of_isWeightedHomogeneous_zero hx.ne_zero hahom - rw [zero_add] at hdeg - rw [hC] - rw [← algebraMap_eq] - rw [AlgHom.commutes] - rw [mul_add] - rw [add_sub_cancel_left] - rw [mul_comm] - rw [← hdeg] - have := mul_mem_decomposableAt_of_mem_decomposableAt hVt - (SetLike.algebraMap_mem_graded (A) (κ' t)) - rwa [add_zero] at this - · have hκ0 : κ' t = 0 := by - rw [hκ'] - exact coeff_zero_eq_zero_of_isWeightedHomogeneous hahom hβ0 - rw [hκ0, map_zero, zero_mul, sub_zero, mul_add, ← hdeg] - refine add_mem (mul_mem_decomposableAt (A) hβ0 (hx.ne_zero t) - (aeval_mem_of_forall_mem hx.mem hahom) (hx.mem t)) ?_ - rw [mul_comm, add_comm] - exact mul_mem_decomposableAt_of_mem_decomposableAt hVt - (aeval_mem_of_forall_mem hx.mem hahom) - · have hκ0 : κ' t = 0 := by - rw [hκ', ha'0 t ht b h, AddMonoidAlgebra.coeff_zero, Finsupp.zero_apply] - rw [ha'0 t ht b h, hκ0] - simp only [map_zero, zero_mul, sub_zero] - exact zero_mem _ - have hℓmem : aeval x ℓ ∈ decomposableAt (A) (wt b) := by - have hub : u b ∈ decomposableAt (A) (wt b) := hudec b - rw [hu'] at hub - have := sub_mem hub hdiff - rwa [sub_sub_cancel] at this - -- `ℓ(𝓑)` is a linear combination of the generators of degree `wt b` with coefficient `1` on - -- `x_b` - obtain ⟨f, hf⟩ : ∃ f : ι →₀ K, f = ∑ t ∈ T, Finsupp.single t (κ' t) := ⟨_, rfl⟩ - have hfapply : ∀ i, f i = if i ∈ T then κ' i else 0 := by - intro i - rw [hf, Finsupp.finsetSum_apply] - simp only [Finsupp.single_apply] - exact Finset.sum_ite_eq' T i κ' - have hℓeq : Finsupp.linearCombination K x f = aeval x ℓ := by - rw [hf, map_sum, hℓ, map_sum] - exact Finset.sum_congr rfl fun t _ ↦ by - rw [Finsupp.linearCombination_single, map_mul, aeval_X, ← algebraMap_eq, AlgHom.commutes, - Algebra.smul_def] - have hfsupp : ∀ i ∈ f.support, wt i = wt b := by - intro i hi - rw [Finsupp.mem_support_iff, hfapply] at hi - split_ifs at hi with hiT - · by_cases h : ∃ β, β + lam b = lam i - · obtain ⟨β, hβ⟩ := h - have hahom := ha'hom i hiT b β hβ - by_cases hβ0 : β = 0 - · subst hβ0 - rw [zero_add] at hβ - have := (hlam i hiT).trans (hlam b (hBT b.2)).symm - rw [hβ] at this - exact add_left_cancel this - · refine absurd ?_ hi - rw [hκ'] - exact coeff_zero_eq_zero_of_isWeightedHomogeneous hahom hβ0 - · refine absurd ?_ hi - rw [hκ', ha'0 i hiT b h, AddMonoidAlgebra.coeff_zero, Finsupp.zero_apply] - · exact absurd rfl hi - have hfmem : Finsupp.linearCombination K x f ∈ decomposableAt (A) (wt b) := by - rw [hℓeq] - exact hℓmem - have hf0 := hx.independent (wt b) f hfsupp hfmem - have hfb := congrArg (fun g : ι →₀ K ↦ g b₀) hf0 - simp only [Finsupp.coe_zero, Pi.zero_apply] at hfb - rw [hfapply, ite_eq_left (hBT hb₀)] at hfb - have hκ1 : κ' b₀ = 1 := by - rw [hκ', ha' b₀ b, ite_eq_left hb₀, ite_eq_left hb, coeff_zero_one] - rw [hκ1] at hfb - exact one_ne_zero hfb + exact not_forall_aeval_cofactors_mem_decomposable hx hδ T B hBT hBne lam hlam + (fun t ht ↦ (hmemT t ht).2) V hV a' + (fun b ↦ by rw [ha', ite_eq_left b.2, ite_eq_left rfl]) ha'hom ha'0 W hW + (fun b ↦ by simpa only [hu'] using hudec b) end OrdinalGraded diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/MaximalDivisor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/MaximalDivisor.lean index 7c11f79e88..35818e7771 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/MaximalDivisor.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/MaximalDivisor.lean @@ -34,7 +34,7 @@ def IsMaximalDivisorAlong /-- The defining divisibility characterization of a maximal divisor along a map. -/ theorem isMaximalDivisorAlong_iff {D : Type u} {R : Type v} - [CommMonoidWithZero D] [IsCancelMulZero D] + [CommMonoidWithZero D] [CommMonoidWithZero R] (f : D →* R) (x : R) (a : Associates D) : IsMaximalDivisorAlong f x a ↔ @@ -48,6 +48,7 @@ variable [CommMonoidWithZero D] [IsCancelMulZero D] variable [CommMonoidWithZero R] variable {f : D →* R} {x y : R} {a b c : Associates D} +omit [IsCancelMulZero D] in /-- Zero has zero as its maximal divisor class along every multiplicative map. -/ theorem zero (f : D →* R) : IsMaximalDivisorAlong f 0 0 := by rw [isMaximalDivisorAlong_iff] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Refinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Refinement.lean index f89e2331d0..d70f691146 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Refinement.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Refinement.lean @@ -170,7 +170,7 @@ theorem hasFourFactorRefinement_iff_forall_isPrimal : constructor · exact fun hR a ↦ hR.isPrimal a · intro h - letI : DecompositionMonoid R := ⟨h⟩ + let : DecompositionMonoid R := ⟨h⟩ exact hasFourFactorRefinement_of_decompositionMonoid /-- Four-factor refinement is equivalent to the decomposition-monoid property. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Finset/FilterCard.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Finset/FilterCard.lean new file mode 100644 index 0000000000..f1d29bd5c6 --- /dev/null +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Finset/FilterCard.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Dan Abramov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Dan Abramov +-/ +module + +public import Mathlib.Data.Finset.Card + +/-! +# Cardinalities of strict upper filters + +Raising a weight threshold past a member of a finite set strictly decreases the number of +members above the threshold. This supplies the induction measure for partial-derivative identities. +-/ + +public section + +namespace ConwayRefinement + +/-- Raising the weight threshold to a larger member strictly decreases the upper filter's size. -/ +theorem card_filter_above_lt {ι η : Type*} [LinearOrder η] + (wt : ι → η) (s : Finset ι) {i j : ι} (hj : j ∈ s) (hij : wt i < wt j) : + (s.filter fun v ↦ wt j < wt v).card < (s.filter fun v ↦ wt i < wt v).card := by + classical + refine Finset.card_lt_card + (Finset.ssubset_iff_subset_ne.mpr ⟨fun v hv ↦ ?_, fun heq ↦ ?_⟩) + · obtain ⟨hv, hlt⟩ := Finset.mem_filter.mp hv + exact Finset.mem_filter.mpr ⟨hv, hij.trans hlt⟩ + · have hjmem : j ∈ s.filter fun v ↦ wt i < wt v := Finset.mem_filter.mpr ⟨hj, hij⟩ + rw [← heq, Finset.mem_filter] at hjmem + exact lt_irrefl _ hjmem.2 + +end ConwayRefinement diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GeometricIntegrality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GeometricIntegrality.lean index 9c2e0b3f64..60998f4c91 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GeometricIntegrality.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GeometricIntegrality.lean @@ -61,11 +61,11 @@ def IsGeometricallyIntegral (k : Type u) (B : Type v) theorem IsGeometricallyIntegral.isDomain {k : Type u} [Field k] {B : Type v} [CommRing B] [Algebra k B] (hB : IsGeometricallyIntegral k B) : IsDomain B := by - haveI : IsDomain (B ⊗[k] ULift.{max u v} k) := + have : IsDomain (B ⊗[k] ULift.{max u v} k) := hB (ULift.{max u v} k) let e : (B ⊗[k] ULift.{max u v} k) ≃ₐ[k] (B ⊗[k] k) := Algebra.TensorProduct.congr AlgEquiv.refl ULift.algEquiv - haveI : IsDomain (B ⊗[k] k) := e.symm.toMulEquiv.isDomain _ + have : IsDomain (B ⊗[k] k) := e.symm.toMulEquiv.isDomain _ exact (Algebra.TensorProduct.rid k k B).symm.toMulEquiv.isDomain _ section BaseChange @@ -75,7 +75,7 @@ theorem IsGeometricallyIntegral.of_algEquiv {k : Type u} [Field k] {A B : Type v [CommRing A] [Algebra k A] [CommRing B] [Algebra k B] (hA : IsGeometricallyIntegral k A) (e : A ≃ₐ[k] B) : IsGeometricallyIntegral k B := fun M _ _ ↦ by - haveI : IsDomain (A ⊗[k] M) := hA M + have : IsDomain (A ⊗[k] M) := hA M exact (Algebra.TensorProduct.congr e (AlgEquiv.refl (R := k) (A₁ := M))).symm.toMulEquiv.isDomain _ @@ -98,11 +98,11 @@ theorem isDomain_tensor_of_isDomain_of_forall_field {k : Type u} [Field k] {B : (hB : ∀ (L : Type w) [Field L] [Algebra k L], IsDomain (B ⊗[k] L)) (D : Type w) [CommRing D] [IsDomain D] [Algebra k D] : IsDomain (B ⊗[k] D) := by let L := FractionRing D - letI : Algebra k L := Algebra.ofModule + let : Algebra k L := Algebra.ofModule (fun r x y ↦ smul_mul_assoc r x y) (fun r x y ↦ mul_smul_comm r x y) - letI : IsScalarTower k D L := inferInstance - letI : IsDomain (B ⊗[k] L) := hB L + let : IsScalarTower k D L := inferInstance + let : IsDomain (B ⊗[k] L) := hB L let ι : D →ₐ[k] L := (IsScalarTower.toAlgHom k D L).restrictScalars k let Φ : B ⊗[k] D →ₐ[k] B ⊗[k] L := Algebra.TensorProduct.map (AlgHom.id k B) ι @@ -139,9 +139,9 @@ theorem IsGeometricallyIntegral.isDomain_mvPolynomial_quotient_span_map UniqueFactorizationMonoid.irreducible_iff_prime.mp hF have hIPrime : I.IsPrime := by exact (Ideal.span_singleton_prime hFPrime.ne_zero).mpr hFPrime - letI : I.IsPrime := hIPrime + let : I.IsPrime := hIPrime let D := MvPolynomial σ k ⧸ I - letI : IsDomain (B ⊗[k] D) := hB.isDomain_tensor_of_isDomain D + let : IsDomain (B ⊗[k] D) := hB.isDomain_tensor_of_isDomain D let ePoly : B ⊗[k] MvPolynomial σ k ≃ₐ[B] MvPolynomial σ B := MvPolynomial.algebraTensorAlgEquiv k B let rightInclusion : MvPolynomial σ k →ₐ[k] B ⊗[k] MvPolynomial σ k := @@ -161,7 +161,7 @@ theorem IsGeometricallyIntegral.isDomain_mvPolynomial_quotient_span_map congr 2 change ePoly (rightInclusion F) = MvPolynomial.map (algebraMap k B) F simp [rightInclusion, ePoly] - letI : IsDomain + let : IsDomain ((B ⊗[k] MvPolynomial σ k) ⧸ J) := eQuot.symm.toMulEquiv.isDomain let eMap : @@ -191,7 +191,7 @@ theorem IsGeometricallyIntegral.isDomain_fin_mvPolynomial_quotient_span_map let F' : MvPolynomial τ k := MvPolynomial.renameEquiv k liftEquiv F have hF' : Irreducible F' := by exact hF.map (MvPolynomial.renameEquiv k liftEquiv).toMulEquiv - letI : IsDomain + let : IsDomain (MvPolynomial τ B ⧸ Ideal.span {MvPolynomial.map (algebraMap k B) F'}) := hB.isDomain_mvPolynomial_quotient_span_map hF' diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/FinitePartSubstitution.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/FinitePartSubstitution.lean index 7bf2cc753b..4629d030d0 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/FinitePartSubstitution.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/FinitePartSubstitution.lean @@ -90,7 +90,7 @@ theorem aeval_mem_decomposableAt_of_mem_supported exact hne j (le_antisymm hle zero_le) -- `X^d = X^{d'} * X_i` have hmono : monomial d (V.coeff d) = C (V.coeff d) * (monomial d' 1 * X i) := by - rw [X, monomial_mul, mul_one, C_mul_monomial, mul_one, hd'def, + rw [X, MvPolynomial.monomial_mul_monomial, mul_one, C_mul_monomial, mul_one, hd'def, Finsupp.sub_add_single_one_cancel (Finsupp.mem_support_iff.mp hi)] rw [hmono, map_mul, map_mul, ← algebraMap_eq, AlgHom.commutes, Algebra.algebraMap_eq_smul_one, smul_mul_assoc, one_mul] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/OrdinalGenerators.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/OrdinalGenerators.lean index c65e3d0ba2..b30a12e082 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/OrdinalGenerators.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing/OrdinalGenerators.lean @@ -188,7 +188,7 @@ omit [GradedAlgebra 𝒜] in minimal systems. -/ theorem map_algEquiv {S : Type*} [CommRing S] [Algebra E S] - {ℬ : NatOrdinal.{o} → Submodule E S} [GradedAlgebra ℬ] + {ℬ : NatOrdinal.{o} → Submodule E S} (e : R ≃ₐ[E] S) (hgrade : ∀ (n : NatOrdinal.{o}) (r : R), r ∈ 𝒜 n ↔ e r ∈ ℬ n) : IsMinimalSystem ℬ wt (fun i ↦ e (x i)) where ne_zero := hx.ne_zero diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/BaseChange.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/BaseChange.lean index cce4ceee99..d92f5d1c25 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/BaseChange.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation/BaseChange.lean @@ -145,8 +145,7 @@ theorem gradeZeroScalars_baseChange (h0 : GradeZeroScalars 𝒜) : rw [gradeZeroScalars_iff] at h0 ⊢ intro x hx obtain ⟨x', rfl⟩ := hx - induction x' using TensorProduct.induction_on with - | zero => exact ⟨0, by rw [map_zero, map_zero]⟩ + induction x' using TensorProduct.inductionOn with | tmul e a => obtain ⟨k, hk⟩ := h0 a a.2 refine ⟨k • e, ?_⟩ @@ -170,12 +169,9 @@ theorem baseChangeDerivation_mul (x y : E ⊗[K] R) : (x : FunAtZeroMinus _) * baseChangeDerivation E Δ y := by have hconst_add : ∀ u v : E ⊗[K] R, ((u + v : E ⊗[K] R) : FunAtZeroMinus (E ⊗[K] R)) = (u : FunAtZeroMinus (E ⊗[K] R)) + (v : FunAtZeroMinus (E ⊗[K] R)) := fun _ _ ↦ rfl - have hconst_zero : ((0 : E ⊗[K] R) : FunAtZeroMinus (E ⊗[K] R)) = 0 := rfl - induction x using TensorProduct.induction_on with - | zero => rw [zero_mul, map_zero, zero_mul, hconst_zero, zero_mul, add_zero] + induction x using TensorProduct.inductionOn with | tmul e a => - induction y using TensorProduct.induction_on with - | zero => rw [mul_zero, map_zero, mul_zero, hconst_zero, mul_zero, add_zero] + induction y using TensorProduct.inductionOn with | tmul e' b => rw [Algebra.TensorProduct.tmul_mul_tmul, baseChangeDerivation_tmul, baseChangeDerivation_tmul, baseChangeDerivation_tmul, hΔ.map_mul, map_add, tensorFunAtZeroMinusLeft_mul_const, @@ -193,8 +189,7 @@ theorem baseChange_induction {α : NatOrdinal} (P : Submodule E (FunAtZeroMinus (h : ∀ (e : E) (a : R), a ∈ 𝒜 α → baseChangeDerivation E Δ (e ⊗ₜ[K] a) ∈ P) {x : E ⊗[K] R} (hx : x ∈ (𝒜 α).baseChange E) : baseChangeDerivation E Δ x ∈ P := by obtain ⟨x', rfl⟩ := hx - induction x' using TensorProduct.induction_on with - | zero => rw [map_zero, map_zero]; exact P.zero_mem + induction x' using TensorProduct.inductionOn with | tmul e a => rw [LinearMap.baseChange_tmul, Submodule.subtype_apply] exact h e a a.2 @@ -264,8 +259,7 @@ theorem baseChangeDerivation_baseChange {α : NatOrdinal} (hα : 0 < α.constant baseChangeDerivation E Δ ((𝒜 α).subtype.baseChange E (TensorProduct.comm K _ _ x)) = Filter.Germ.mapLinear (lowerGradeTensorEmbedding α) (funAtZeroMinusTensorId (hΔ.derivLinearAt hα) x) := by - induction x using TensorProduct.induction_on with - | zero => rw [map_zero, map_zero, map_zero, map_zero, map_zero] + induction x using TensorProduct.inductionOn with | tmul a e => obtain ⟨f, hf⟩ : ∃ f : ℝ → 𝒜 (α.removeNat 1), hΔ.derivLinearAt hα a = (f : FunAtZeroMinus _) := ⟨Quotient.out _, (Quotient.out_eq _).symm⟩ @@ -316,8 +310,7 @@ theorem fibreIdeal_baseChange : · intro x hx obtain ⟨e, hje, x', rfl⟩ := (mem_idealGEGenerators_iff _ 1 x).mp hx clear hx - induction x' using TensorProduct.induction_on with - | zero => rw [map_zero]; exact zero_mem _ + induction x' using TensorProduct.inductionOn with | tmul c a => rw [LinearMap.baseChange_tmul, Submodule.subtype_apply, show c ⊗ₜ[K] (a : R) = (c ⊗ₜ[K] (1 : R)) * diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Components.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Components.lean index 936e819117..89d8480028 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Components.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Components.lean @@ -32,11 +32,13 @@ variable {σ : Type u} {R : Type v} [CommRing R] (wt : σ → NatOrdinal) at least `τ`. -/ noncomputable def componentsGE (τ : NatOrdinal) (P : MvPolynomial σ R) : MvPolynomial σ R := by classical - exact ∑ d ∈ P.support.filter fun d ↦ τ ≤ Finsupp.weight wt d, monomial d (AddMonoidAlgebra.coeff P d) + exact ∑ d ∈ P.support.filter fun d ↦ τ ≤ Finsupp.weight wt d, monomial d + (AddMonoidAlgebra.coeff P d) open Classical in theorem coeff_componentsGE (τ : NatOrdinal) (P : MvPolynomial σ R) (d : σ →₀ ℕ) : - AddMonoidAlgebra.coeff (componentsGE wt τ P) d = if τ ≤ Finsupp.weight wt d then AddMonoidAlgebra.coeff P d else 0 := by + AddMonoidAlgebra.coeff (componentsGE wt τ P) d = if τ ≤ Finsupp.weight wt d then + AddMonoidAlgebra.coeff P d else 0 := by classical rw [componentsGE] simp only [coeff_sum, coeff_monomial] @@ -65,7 +67,8 @@ theorem componentsGE_neg (τ : NatOrdinal) (P : MvPolynomial σ R) : componentsGE wt τ (-P) = -componentsGE wt τ P := by classical ext d - have hneg : ∀ Q : MvPolynomial σ R, AddMonoidAlgebra.coeff (-Q) d = -AddMonoidAlgebra.coeff Q d := fun Q ↦ by + have hneg : ∀ Q : MvPolynomial σ R, AddMonoidAlgebra.coeff (-Q) d = -AddMonoidAlgebra.coeff Q + d := fun Q ↦ by change (coeffAddMonoidHom d) (-Q) = -(coeffAddMonoidHom d) Q exact map_neg _ _ rw [hneg, coeff_componentsGE, coeff_componentsGE, hneg] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/ComponentsSpan.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/ComponentsSpan.lean index c96fb56195..494fafb5fe 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/ComponentsSpan.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/ComponentsSpan.lean @@ -60,7 +60,7 @@ theorem weightedHomogeneousComponent_mem_span {ι : Type w} [Finite ι] {q : ι weightedHomogeneousComponent wt e P ∈ Ideal.span (Set.range q) := by classical cases nonempty_fintype ι - letI := weightedGradedAlgebra K wt + let := weightedGradedAlgebra K wt obtain ⟨u, -, -, hsum⟩ := OrdinalGraded.exists_decompose_eq_sum_mul_of_mem_span (𝒜 := weightedHomogeneousSubmodule K wt) (fun j ↦ (mem_weightedHomogeneousSubmodule _ _ _ _).mpr (hq j)) hP e diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Expansion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Expansion.lean index 2f9798b3bf..53d446a2c8 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Expansion.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Expansion.lean @@ -167,7 +167,8 @@ theorem xCoeff_mem_supported (k : ℕ) (p : MvPolynomial σ R) : xCoeff x k p rename_val_mem_supported x _ theorem coeff_xCoeff (k : ℕ) (p : MvPolynomial σ R) (m : σ →₀ ℕ) : - AddMonoidAlgebra.coeff (xCoeff x k p) m = if m x = 0 then AddMonoidAlgebra.coeff p (m + Finsupp.single x k) else 0 := by + AddMonoidAlgebra.coeff (xCoeff x k p) m = if m x = 0 then AddMonoidAlgebra.coeff p (m + + Finsupp.single x k) else 0 := by rw [xCoeff_apply] split_ifs with hm · have hsub : (m.support : Set σ) ⊆ Set.range (Subtype.val : {y // y ≠ x} → σ) := fun y hy ↦ @@ -184,7 +185,7 @@ theorem coeff_xCoeff (k : ℕ) (p : MvPolynomial σ R) (m : σ →₀ ℕ) : Finsupp.optionElim_apply_some, Finsupp.add_apply, Finsupp.single_eq_of_ne y.2, add_zero, Finsupp.comapDomain_apply] · refine coeff_rename_eq_zero _ _ _ fun u hu ↦ (hm ?_).elim - rw [← hu, Finsupp.mapDomain_notin_range] + rw [← hu, Finsupp.mapDomain_of_notMem_range] rintro ⟨y, hy⟩ exact y.2 hy diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartDecomposition.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartDecomposition.lean index 0dcdea77a2..ea395e5059 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartDecomposition.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/FinitePartDecomposition.lean @@ -76,7 +76,7 @@ theorem exists_eq_sum_pderiv_mul_X_add_of_mem_span {δ : NatOrdinal} V t ∈ supported K {i | (wt i).constantCoeff ≠ δ.constantCoeff}) ∧ F = ∑ t ∈ varsOfFinitePart wt F δ, pderiv t F * (X t + V t) := by classical - letI := weightedGradedAlgebra K wt + let := weightedGradedAlgebra K wt -- naming the index set keeps later rewrites from reaching inside it set T := varsOfFinitePart wt F δ with hT have hmemT : ∀ t : ↥T, (t : σ) ∈ F.vars ∧ (wt t).constantCoeff = δ.constantCoeff := fun t ↦ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/GCDMonoid.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/GCDMonoid.lean index 91996fe098..612e5c719e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/GCDMonoid.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/GCDMonoid.lean @@ -49,7 +49,7 @@ private theorem existsGCD_pullback (e : A ≃* B) theorem MulEquiv.nonemptyGCDMonoid (e : A ≃* B) [IsCancelMulZero A] [Nonempty (GCDMonoid B)] : Nonempty (GCDMonoid A) := by classical - letI : GCDMonoid B := Classical.choice inferInstance + let : GCDMonoid B := Classical.choice inferInstance exact ⟨gcdMonoidOfExistsGCD (existsGCD_pullback e fun a b ↦ ⟨gcd a b, fun d ↦ (dvd_gcd_iff d a b).symm⟩)⟩ @@ -122,7 +122,7 @@ private theorem existsGCD [NormalizedGCDMonoid R] (a b : MvPolynomial σ R) : ∃ c : MvPolynomial σ R, ∀ d : MvPolynomial σ R, d ∣ a ∧ d ∣ b ↔ d ∣ c := by classical obtain ⟨s, p, q, rfl, rfl⟩ := exists_finset_rename₂ a b - letI : NormalizedGCDMonoid (MvPolynomial s R) := normalizedGCDMonoidOfFinite s + let : NormalizedGCDMonoid (MvPolynomial s R) := normalizedGCDMonoidOfFinite s let S : Set σ := s let E := adjoiningVariablesEquiv (R := R) S have hrename (f : MvPolynomial s R) : E (C f) = rename ((↑) : s → σ) f := @@ -184,7 +184,7 @@ greatest common divisors. -/ theorem nonemptyGCDMonoid [Nonempty (NormalizedGCDMonoid R)] : Nonempty (GCDMonoid (MvPolynomial σ R)) := by classical - letI : NormalizedGCDMonoid R := Classical.choice inferInstance + let : NormalizedGCDMonoid R := Classical.choice inferInstance exact ⟨gcdMonoidOfExistsGCD existsGCD⟩ end MvPolynomial diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/LimitOrdinalContradiction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/LimitOrdinalContradiction.lean index b36c54bad0..174f1449e2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/LimitOrdinalContradiction.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/LimitOrdinalContradiction.lean @@ -417,11 +417,11 @@ def freeOf (B₀ : σ) : Subring (MvPolynomial σ R) where zero_mem' := map_zero _ one_mem' := pderiv_one add_mem' hp hq := by - rw [Set.mem_setOf_eq, map_add, hp, hq, add_zero] + rw [Set.mem_ofPred_eq, map_add, hp, hq, add_zero] neg_mem' hp := by - rw [Set.mem_setOf_eq, map_neg, hp, neg_zero] + rw [Set.mem_ofPred_eq, map_neg, hp, neg_zero] mul_mem' hp hq := by - rw [Set.mem_setOf_eq, pderiv_mul, hp, hq, zero_mul, mul_zero, add_zero] + rw [Set.mem_ofPred_eq, pderiv_mul, hp, hq, zero_mul, mul_zero, add_zero] omit [NoZeroDivisors R] [CharZero R] in @[simp] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/OrdinalDerivation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/OrdinalDerivation.lean index 077028ddf5..1b9a4eae26 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/OrdinalDerivation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/OrdinalDerivation.lean @@ -196,10 +196,12 @@ theorem exists_add_eq_weight_of_mem_support_pderiv (wt : σ → NatOrdinal) {i : /-- The coefficient of `d - X_v` in `∂_v p`, for a monomial `d` containing `X_v`. -/ theorem coeff_sub_single_pderiv {v : σ} {p : MvPolynomial σ R} {d : σ →₀ ℕ} (hd : d v ≠ 0) : - AddMonoidAlgebra.coeff (pderiv v p) (d - Finsupp.single v 1) = AddMonoidAlgebra.coeff p d * (d v : R) := by + AddMonoidAlgebra.coeff (pderiv v p) (d - Finsupp.single v 1) = AddMonoidAlgebra.coeff p d * + (d v : R) := by classical have hsum : pderiv v p = - ∑ d' ∈ p.support, monomial (d' - Finsupp.single v 1) (AddMonoidAlgebra.coeff p d' * d' v) := by + ∑ d' ∈ p.support, monomial (d' - Finsupp.single v 1) (AddMonoidAlgebra.coeff p d' * d' v) + := by conv_lhs => rw [p.as_sum, map_sum] exact Finset.sum_congr rfl fun d' _ ↦ pderiv_monomial rw [hsum, MvPolynomial.coeff_sum] @@ -242,7 +244,7 @@ theorem pderiv_ne_zero_of_mem_vars [NoZeroDivisors R] [CharZero R] {v : σ} have hdv' : d v ≠ 0 := Finsupp.mem_support_iff.mp hdv intro h have := coeff_sub_single_pderiv (p := p) hdv' - rw [h, MvPolynomial.coeff_zero] at this + rw [h, AddMonoidAlgebra.coeff_zero] at this exact mul_ne_zero (mem_support_iff.mp hd) (Nat.cast_ne_zero.mpr hdv') this.symm /-! ### Homogeneity -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Syzygy.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Syzygy.lean index 930ae3db7d..4d6b82a14e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Syzygy.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial/Syzygy.lean @@ -71,7 +71,8 @@ theorem exists_eq_sum_monomial_mul_C_of_sum_C_mul_eq_zero (c : B → R₀) ∃ (m : Finset (σ →₀ ℕ)) (v : (σ →₀ ℕ) → B → R₀), (∀ d ∈ m, ∑ b, c b * v d b = 0) ∧ ∀ b, u b = ∑ d ∈ m, monomial d 1 * C (v d b) := by classical - refine ⟨Finset.univ.biUnion fun b ↦ (u b).support, fun d b ↦ AddMonoidAlgebra.coeff (u b) d, fun d _ ↦ ?_, + refine ⟨Finset.univ.biUnion fun b ↦ (u b).support, fun d b ↦ AddMonoidAlgebra.coeff (u b) d, + fun d _ ↦ ?_, fun b ↦ ?_⟩ · have := congrArg ((fun p => AddMonoidAlgebra.coeff p d)) hu rw [coeff_sum, AddMonoidAlgebra.coeff_zero] at this diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/ConvexQuotientSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/ConvexQuotientSplitting.lean index 2bb7c24eea..d5f71ced6c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/ConvexQuotientSplitting.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/ConvexQuotientSplitting.lean @@ -114,6 +114,7 @@ theorem quotientProdLinearEquiv_zero_left (p : P) : Submodule.coe_prodEquivOfIsCompl'] simp [quotientLinearEquivComplement] +/-- The linear order on the quotient induced by convexity of the subspace. -/ noncomputable local instance quotientLinearOrder [P.toAddSubgroup.IsConvex] : LinearOrder (G ⧸ P) := ConvexQuotient.instLinearOrder (H := P.toAddSubgroup) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/BasisOver.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/BasisOver.lean index 39bb36d976..b0a7f6fdeb 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/BasisOver.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/BasisOver.lean @@ -641,7 +641,7 @@ theorem prime_coe_of_degreeOverGradedRingEquiv Prime (a : R) := by classical have hψsep : (ν.degreeOver P).IsSeparated := ν.degreeOver_isSeparated P - haveI : IsDomain (ν.degreeOver P).AssociatedGraded := Θ.symm.toMulEquiv.isDomain _ + have : IsDomain (ν.degreeOver P).AssociatedGraded := Θ.symm.toMulEquiv.isDomain _ -- the quotient by the initial form is a domain have hmap : Ideal.span {(ν.degreeOver P).initialForm (a : R)} = (Ideal.span ({1 ⊗ₜ[L'] a} : Set (C ⊗[L'] P))).map @@ -653,11 +653,11 @@ theorem prime_coe_of_degreeOverGradedRingEquiv Ideal.span ({1 ⊗ₜ[L'] a} : Set (C ⊗[L'] P)) := by rw [Ideal.map_span, Set.image_singleton] rfl - haveI : IsDomain ((C ⊗[L'] P) ⧸ Ideal.span ({1 ⊗ₜ[L'] a} : Set (C ⊗[L'] P))) := by + have : IsDomain ((C ⊗[L'] P) ⧸ Ideal.span ({1 ⊗ₜ[L'] a} : Set (C ⊗[L'] P))) := by have e := Algebra.TensorProduct.tensorQuotientEquiv (R := L') L' P C (Ideal.span {a}) rw [hmap'] at e exact e.symm.toMulEquiv.isDomain _ - haveI : IsDomain ((ν.degreeOver P).AssociatedGraded ⧸ + have : IsDomain ((ν.degreeOver P).AssociatedGraded ⧸ Ideal.span {(ν.degreeOver P).initialForm (a : R)}) := (Ideal.quotientEquiv _ _ Θ hmap).symm.toMulEquiv.isDomain _ exact (ν.degreeOver P).prime_of_quotient_span_initialForm_isDomain hψsep @@ -672,13 +672,13 @@ theorem prime_coe_of_degreeOverGradedRingEquiv_of_algEquiv {a₀ : P₀} (ha₀ : a₀ ≠ 0) [IsDomain (C ⊗[L'] P₀)] [IsDomain (C ⊗[L'] (P₀ ⧸ Ideal.span {a₀}))] : Prime ((e a₀ : P) : R) := by have ha : e a₀ ≠ 0 := (map_ne_zero_iff e e.injective).mpr ha₀ - haveI : IsDomain (C ⊗[L'] P) := + have : IsDomain (C ⊗[L'] P) := (Algebra.TensorProduct.congr (AlgEquiv.refl (R := L') (A₁ := C)) e).symm.toMulEquiv.isDomain _ have hmap : Ideal.span {e a₀} = (Ideal.span {a₀}).map (e : P₀ →+* P) := by rw [Ideal.map_span, Set.image_singleton] rfl let eQ := Ideal.quotientEquivAlg (Ideal.span {a₀}) (Ideal.span {e a₀}) e hmap - haveI : IsDomain (C ⊗[L'] (P ⧸ Ideal.span {e a₀})) := + have : IsDomain (C ⊗[L'] (P ⧸ Ideal.span {e a₀})) := (Algebra.TensorProduct.congr (AlgEquiv.refl (R := L') (A₁ := C)) eQ).symm.toMulEquiv.isDomain _ exact ν.prime_coe_of_degreeOverGradedRingEquiv P Θ hΘ ha diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGraded.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGraded.lean index 8c0fc94472..2b4283a035 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGraded.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGraded.lean @@ -331,9 +331,11 @@ theorem componentOne_eq_componentMk (ν : MaxAddDegree R M) : ν.componentMk 0 ⟨1, (ν.mem_filtrationLE_iff 0 1).mpr ν.map_one_le_zero⟩ := (rfl) +/-- The multiplicative identity in the degree-zero component. -/ scoped instance (ν : MaxAddDegree R M) : GradedMonoid.GOne ν.Component where one := ν.componentOne +/-- Multiplication of homogeneous components, with their degrees added. -/ scoped instance (ν : MaxAddDegree R M) : GradedMonoid.GMul ν.Component where mul := ν.componentMul diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedDomain.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedDomain.lean index fbba331850..fd3b8f4982 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedDomain.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedDomain.lean @@ -170,7 +170,7 @@ theorem nontrivial_of_associatedGraded_isDomain Nontrivial R := by apply not_subsingleton_iff_nontrivial.mp intro hsub - letI : Subsingleton R := hsub + let : Subsingleton R := hsub have hcomponent (m : M) (x y : ν.Component m) : x = y := by induction x using QuotientAddGroup.induction_on with | H x => @@ -190,9 +190,9 @@ theorem quotient_isDomain_of_associatedGraded_isDomain (ν : MaxAddDegree R M) (I : Ideal R) (hν : ν.IsSeparated) [IsDomain (ν.quotient I hν).AssociatedGraded] : IsDomain (R ⧸ I) := by - letI : Nontrivial (R ⧸ I) := + let : Nontrivial (R ⧸ I) := (ν.quotient I hν).nontrivial_of_associatedGraded_isDomain - haveI : (ν.quotient I hν).IsMultiplicative := + have : (ν.quotient I hν).IsMultiplicative := (ν.quotient I hν).isMultiplicative_of_associatedGraded_isDomain (ν.quotient_isSeparated I hν) exact ν.quotient_isDomain I hν diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeInitialForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeInitialForm.lean index a4945900d1..6a915633d2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeInitialForm.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeInitialForm.lean @@ -169,7 +169,8 @@ theorem initialForm_mul (x y : R) : have hm : (ν (x * y)).unbot hxy = (ν x).unbot hx + (ν y).unbot hy := by apply WithBot.coe_injective rw [WithBot.coe_unbot, WithBot.coe_add, ν.map_mul, WithBot.coe_unbot, WithBot.coe_unbot] - rw [initialForm, dite_eq_right hxy, initialForm, dite_eq_right hx, initialForm, dite_eq_right hy, + rw [initialForm, dite_eq_right hxy, initialForm, dite_eq_right hx, initialForm, + dite_eq_right hy, ν.homogeneousMk_mul, ν.homogeneousMk_apply, ν.homogeneousMk_apply] apply DirectSum.of_eq_of_gradedMonoid_eq apply Sigma.ext hm diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreePrincipalInitialIdeal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreePrincipalInitialIdeal.lean index 1704eaa312..f62ef31b06 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreePrincipalInitialIdeal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreePrincipalInitialIdeal.lean @@ -111,7 +111,7 @@ omit [WellFoundedLT M] in /-- For a separated multiplicative degree, an element `b ∉ (a)` of least degree in its coset modulo `(a)` has initial form outside `(in_ν a)`: otherwise `in_ν b = in_ν a · g` with `g` homogeneous, and a lift `g̃` of `g` gives `ν (b - a g̃) < ν b` in the same coset. -/ -theorem initialForm_notMem_span_initialForm (ν : MaxAddDegree R M) [ν.IsMultiplicative] +theorem initialForm_notMem_span_initialForm (ν : MaxAddDegree R M) (hν : ν.IsSeparated) {a b : R} (ha : a ≠ 0) (hb : b ∉ Ideal.span {a}) (hmin : ∀ b', b' - b ∈ Ideal.span {a} → ν b ≤ ν b') : ν.initialForm b ∉ Ideal.span {ν.initialForm a} := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/FiltrationDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/FiltrationDegree.lean index 54e2b57269..916d649fc5 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/FiltrationDegree.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/FiltrationDegree.lean @@ -234,8 +234,8 @@ The proof does not use `MaxAddDegree.quotient_isDomain_of_associatedGraded_isDom attached degree directly from the domain associated graded ring. -/ theorem isDomain_of_associatedGraded_isDomain [IsDomain (hF.degree).AssociatedGraded] : IsDomain R := by - haveI : Nontrivial R := (hF.degree).nontrivial_of_associatedGraded_isDomain - haveI : (hF.degree).IsMultiplicative := + have : Nontrivial R := (hF.degree).nontrivial_of_associatedGraded_isDomain + have : (hF.degree).IsMultiplicative := (hF.degree).isMultiplicative_of_associatedGraded_isDomain hF.degree_isSeparated exact (hF.degree).isDomain hF.degree_isSeparated diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/MaxAddDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/MaxAddDegree.lean index c7b4411156..50f50425f1 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/MaxAddDegree.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/MaxAddDegree.lean @@ -36,6 +36,7 @@ open scoped BigOperators multiplication. -/ structure MaxAddDegree (R : Type u) (M : Type v) [CommRing R] [AddCommMonoid M] [LinearOrder M] where + /-- The underlying degree function, with bottom as the value of zero. -/ toFun : R → WithBot M map_zero' : toFun 0 = ⊥ map_one_le_zero' : toFun 1 ≤ 0 @@ -202,7 +203,7 @@ domain. -/ theorem isDomain (ν : MaxAddDegree R M) [Nontrivial R] [ν.IsMultiplicative] (hν : ν.IsSeparated) : IsDomain R := by - letI : NoZeroDivisors R := + let : NoZeroDivisors R := ⟨fun hxy ↦ ν.eq_zero_or_eq_zero_of_mul_eq_zero hν hxy⟩ exact NoZeroDivisors.to_isDomain R diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/QuotientDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/QuotientDegree.lean index 5497d49cfa..a31b6cf899 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/QuotientDegree.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/QuotientDegree.lean @@ -116,7 +116,7 @@ theorem quotientValue_mk_le (ν : MaxAddDegree R M) (I : Ideal R) exact (WithBot.coe_unbot (ν x) hνx).symm rw [ν.quotientValue_eq_coe_min I hν hq, ← WithBot.coe_unbot (ν x) hνx, WithBot.coe_le_coe] - exact wellFounded_lt.min_le hmem + exact WellFoundedLT.min_le hmem /-- The unit of the quotient has degree at most zero. -/ theorem quotientValue_one_le_zero (ν : MaxAddDegree R M) (I : Ideal R) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGraded.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGraded.lean index 1b0ba44fe4..efa58de63e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGraded.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGraded.lean @@ -80,14 +80,17 @@ theorem firstProjectionValuation_not_isSeparated : exact ⟨(0, 1), by simp [MaxAddDegree.ofValuation_apply, firstProjectionValuation, Valuation.one_apply_def]⟩ +/-- The element `(0, 1)` in filtration degree zero, used to test the support kernel. -/ def supportRepresentative : firstProjectionValuation.filtrationLE 0 := ⟨(0, 1), by simp [MaxAddDegree.ofValuation_apply, firstProjectionValuation, Valuation.one_apply_def]⟩ +/-- The element `(1, 1)` in filtration degree zero, whose homogeneous class is nonzero. -/ def nonzeroRepresentative : firstProjectionValuation.filtrationLE 0 := ⟨(1, 1), by simp [MaxAddDegree.ofValuation_apply, firstProjectionValuation, Valuation.one_apply_def]⟩ +/-- The element `(1, 0)` in filtration degree zero, with the same leading class as `(1, 1)`. -/ def sameLeadingRepresentative : firstProjectionValuation.filtrationLE 0 := ⟨(1, 0), by simp [MaxAddDegree.ofValuation_apply, firstProjectionValuation, Valuation.one_apply_def]⟩ @@ -128,6 +131,7 @@ def trivialValuation : MaxAddDegree ℚ ℕ := instance : trivialValuation.IsMultiplicative := inferInstanceAs (MaxAddDegree.ofValuation _).IsMultiplicative +/-- The rational unit in filtration degree zero for the trivial valuation. -/ def oneRepresentative : trivialValuation.filtrationLE 0 := ⟨1, by simp [MaxAddDegree.ofValuation_apply, trivialValuation, Valuation.one_apply_def]⟩ @@ -160,7 +164,8 @@ theorem printedRepresentativeAdd_not_commutative : ((oneRepresentative : ℚ) + ((0 : trivialValuation.filtrationLE 0) : ℚ)) = trivialValuation oneRepresentative := by simp - rw [printedRepresentativeAdd, ite_eq_right hzeroOne, printedRepresentativeAdd, ite_eq_left honeZero] + rw [printedRepresentativeAdd, ite_eq_right hzeroOne, printedRepresentativeAdd, ite_eq_left + honeZero] simp only [add_zero] exact oneRepresentative_componentMk_ne_zero.symm @@ -171,12 +176,15 @@ theorem trivialValuation_isSeparated : trivialValuation.IsSeparated := by · simp [MaxAddDegree.ofValuation_apply, trivialValuation, Valuation.one_apply_def, hx] · simp [MaxAddDegree.ofValuation_apply, trivialValuation, Valuation.one_apply_def, hx] +/-- The rational number two in filtration degree zero for the trivial valuation. -/ def twoRepresentative : trivialValuation.filtrationLE 0 := ⟨2, by simp [MaxAddDegree.ofValuation_apply, trivialValuation, Valuation.one_apply_def]⟩ +/-- The rational number three in filtration degree zero for the trivial valuation. -/ def threeRepresentative : trivialValuation.filtrationLE 0 := ⟨3, by simp [MaxAddDegree.ofValuation_apply, trivialValuation, Valuation.one_apply_def]⟩ +/-- The rational number six in filtration degree zero for the trivial valuation. -/ def sixRepresentative : trivialValuation.filtrationLE 0 := ⟨6, by simp [MaxAddDegree.ofValuation_apply, trivialValuation, Valuation.one_apply_def]⟩ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGradedValuation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGradedValuation.lean index 6ef0c5ba9b..fabbf0d7cf 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGradedValuation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/AssociatedGradedValuation.lean @@ -32,11 +32,15 @@ open scoped DirectSum namespace Tests +/-- The direct sum of integer components indexed by natural-number degrees, used to test leading +grades. -/ abbrev LeadingGradeFixture := DirectSum ℕ (fun _ ↦ ℤ) +/-- The homogeneous element with coefficient two in degree one. -/ def leadingGradeLow : LeadingGradeFixture := DirectSum.of (fun _ : ℕ ↦ ℤ) 1 2 +/-- The homogeneous element with coefficient five in degree three. -/ def leadingGradeHigh : LeadingGradeFixture := DirectSum.of (fun _ : ℕ ↦ ℤ) 3 5 @@ -75,6 +79,8 @@ theorem leadingGrade_mul_fixture : rw [hlow, hhigh] norm_num +/-- The trivial valuation pulled back along the first projection, used to test separation of the +associated graded ring. -/ def associatedFirstProjectionValuation : MaxAddDegree (ℚ × ℚ) ℕ := MaxAddDegree.ofValuation ((1 : Valuation ℚ (WithZero (Multiplicative ℕ))).comap (RingHom.fst ℚ ℚ)) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/RV.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/RV.lean index f8c03f1c46..ee0d3018af 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/RV.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/RV.lean @@ -29,6 +29,7 @@ namespace Tests open scoped DirectSum +/-- The trivial valuation pulled back along the first projection, used to test the RV quotient. -/ def rvFirstProjectionValuation : MaxAddDegree (ℚ × ℚ) ℕ := MaxAddDegree.ofValuation ((1 : Valuation ℚ (WithZero (Multiplicative ℕ))).comap (RingHom.fst ℚ ℚ)) @@ -36,6 +37,7 @@ def rvFirstProjectionValuation : MaxAddDegree (ℚ × ℚ) ℕ := instance : rvFirstProjectionValuation.IsMultiplicative := inferInstanceAs (MaxAddDegree.ofValuation _).IsMultiplicative +/-- The nonzero element `(0, 1)` in the support of the first-projection valuation. -/ def rvSupportElement : ℚ × ℚ := (0, 1) @@ -85,18 +87,22 @@ theorem rvHomogeneous_support_mul_one : rvFirstProjectionValuation.rv (1, 0)) = 0 := by rw [rvSupportElement_rv_eq_zero, zero_mul, map_zero] +/-- The trivial valuation on the rationals in max-additive notation for RV computations. -/ def rvTrivialValuation : MaxAddDegree ℚ ℕ := MaxAddDegree.ofValuation 1 instance : rvTrivialValuation.IsMultiplicative := inferInstanceAs (MaxAddDegree.ofValuation _).IsMultiplicative +/-- The rational number two in filtration degree zero for the RV multiplication fixture. -/ def rvTwoRepresentative : rvTrivialValuation.filtrationLE 0 := ⟨2, by simp [MaxAddDegree.ofValuation_apply, rvTrivialValuation, Valuation.one_apply_def]⟩ +/-- The rational number three in filtration degree zero for the RV multiplication fixture. -/ def rvThreeRepresentative : rvTrivialValuation.filtrationLE 0 := ⟨3, by simp [MaxAddDegree.ofValuation_apply, rvTrivialValuation, Valuation.one_apply_def]⟩ +/-- The rational number six in filtration degree zero for the RV multiplication fixture. -/ def rvSixRepresentative : rvTrivialValuation.filtrationLE 0 := ⟨6, by simp [MaxAddDegree.ofValuation_apply, rvTrivialValuation, Valuation.one_apply_def]⟩ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Residue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Residue.lean index 84ec8d7ae8..7281ad5031 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Residue.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Residue.lean @@ -31,6 +31,7 @@ open scoped DirectSum namespace Tests +/-- The trivial valuation pulled back along the first projection, used to test the residue map. -/ def residueFirstProjectionValuation : MaxAddDegree (ℚ × ℚ) ℕ := MaxAddDegree.ofValuation ((1 : Valuation ℚ (WithZero (Multiplicative ℕ))).comap (RingHom.fst ℚ ℚ)) @@ -38,24 +39,30 @@ def residueFirstProjectionValuation : MaxAddDegree (ℚ × ℚ) ℕ := instance : residueFirstProjectionValuation.IsMultiplicative := inferInstanceAs (MaxAddDegree.ofValuation _).IsMultiplicative +/-- The element `(0, 1)` of the nonpositive subring, lying in the valuation support. -/ def residueSupportElement : residueFirstProjectionValuation.nonpositiveSubring := ⟨(0, 1), by rw [MaxAddDegree.mem_nonpositiveSubring_iff] simp [MaxAddDegree.ofValuation_apply, residueFirstProjectionValuation, Valuation.one_apply_def]⟩ +/-- The element `(1, 1)` of the nonpositive subring, whose degree is zero. -/ def residueValueZeroElement : residueFirstProjectionValuation.nonpositiveSubring := ⟨(1, 1), by rw [MaxAddDegree.mem_nonpositiveSubring_iff] simp [MaxAddDegree.ofValuation_apply, residueFirstProjectionValuation, Valuation.one_apply_def]⟩ +/-- The element `(1, 0)` of the nonpositive subring, used with its negative to test residue +classes. -/ def residuePositiveUnit : residueFirstProjectionValuation.nonpositiveSubring := ⟨(1, 0), by rw [MaxAddDegree.mem_nonpositiveSubring_iff] simp [MaxAddDegree.ofValuation_apply, residueFirstProjectionValuation, Valuation.one_apply_def]⟩ +/-- The element `(-1, 0)` of the nonpositive subring, used with its negative to test residue +classes. -/ def residueNegativeUnit : residueFirstProjectionValuation.nonpositiveSubring := ⟨(-1, 0), by rw [MaxAddDegree.mem_nonpositiveSubring_iff] @@ -119,9 +126,11 @@ section Padic local instance : Fact (Nat.Prime 2) := ⟨Nat.prime_two⟩ +/-- The two-adic valuation on the rationals in max-additive notation. -/ abbrev residueTwoAdicValuation : MaxAddDegree ℚ ℤ := MaxAddDegree.ofValuation (Rat.padicValuation 2) +/-- The rational unit in the nonpositive subring of the two-adic valuation. -/ def residueTwoAdicOne : residueTwoAdicValuation.nonpositiveSubring := ⟨1, by simp⟩ @@ -135,6 +144,7 @@ theorem residueTwoAdic_value_two : (Rat.padicValuation_self 2) exact h.trans (by rfl) +/-- The rational number two in the nonpositive subring of the two-adic valuation. -/ def residueTwoAdicTwo : residueTwoAdicValuation.nonpositiveSubring := ⟨2, by rw [MaxAddDegree.mem_nonpositiveSubring_iff, residueTwoAdic_value_two] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Blueprint.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Blueprint.lean index db69a2db5e..570bce4fa9 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Blueprint.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Blueprint.lean @@ -37,23 +37,36 @@ meta def phases : Array String := #[ /-- The mathematical account attached to one selected Lean declaration. -/ structure Node where + /-- The fully qualified name of the Lean declaration described by this node. -/ name : Name + /-- The label identifying the declaration in the mathematical proof map. -/ label : String + /-- The phase of the mathematical argument containing the declaration. -/ phase : String + /-- The title displayed for this declaration in the proof map. -/ title : String + /-- The informal mathematical statement attached to the declaration. -/ statement : String + /-- The informal proof explanation attached to the declaration. -/ proof : String + /-- Whether to highlight this declaration in the proof map. -/ highlight : Bool := false deriving Inhabited, ToExpr /-- Checked blueprint metadata, persisted with each compiled module. -/ initialize nodeExt : NameMapExtension Node ← registerNameMapExtension Node +/-- Syntax for specifying the phase of a blueprint declaration. -/ syntax blueprintPhaseOption := "(" &"phase" " := " str ")" +/-- Syntax for specifying the title of a blueprint declaration. -/ syntax blueprintTitleOption := "(" &"title" " := " str ")" +/-- Syntax for attaching an informal statement to a blueprint declaration. -/ syntax blueprintStatementOption := "(" &"statement" " := " plainDocComment ")" +/-- The proof-map option containing an informal proof as a documentation comment. -/ syntax blueprintProofOption := "(" &"proof" " := " plainDocComment ")" +/-- The optional marker highlighting a result in the mathematical proof map. -/ syntax blueprintHighlightOption := "(" &"highlight" ")" +/-- The label, phase, title, statement, proof, and optional highlight of a proof-map entry. -/ syntax blueprintOptions := str ppSpace blueprintPhaseOption ppSpace blueprintTitleOption ppSpace blueprintStatementOption ppSpace blueprintProofOption @@ -67,11 +80,14 @@ syntax (name := conwayRefinementBlueprint) "conway_refinement_blueprint" ppSpace macro "blueprint" ppSpace options:blueprintOptions : attr => `(attr| conway_refinement_blueprint $options:blueprintOptions) +/-- Reject a proof-map label whose prefix does not identify a recognized mathematical result +kind. -/ def resultKindForLabel (label : String) : CoreM Unit := do unless #["def:", "thm:", "lem:", "prop:", "cor:", "fact:"].any (fun resultPrefix => label.startsWith resultPrefix) do throwError "blueprint label {label} has no recognized mathematical result kind" +/-- Parse and validate the proof-map metadata attached to a declaration. -/ def elaborateNode (name : Name) : Syntax → CoreM Node | `(attr| conway_refinement_blueprint $label:str (phase := $phase:str) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/SelectionComplexity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/SelectionComplexity.lean index f09c273150..a03bb5f5ac 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/SelectionComplexity.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/SelectionComplexity.lean @@ -31,7 +31,9 @@ namespace Multiset /-- Ordinal priorities and weights for selection in a finite multiset. -/ structure SelectionWeights (α : Type v) where + /-- The ordinal priority to minimize when selecting a multiset member. -/ priority : α → Ordinal.{u} + /-- The ordinal weight to maximize among members of equal least priority. -/ weight : α → Ordinal.{u} namespace SelectionWeights diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowNormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowNormalForm.lean index 236dcfd539..a7a4315272 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowNormalForm.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowNormalForm.lean @@ -6,7 +6,7 @@ Authors: Dan Abramov module public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic -public import Mathlib.Data.Real.Basic +public import Mathlib.Basic.Real.Basic public import Mathlib.Order.TypeTags /-! diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LatticeFactorCoefficients.lean b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LatticeFactorCoefficients.lean index 3ae949abff..191632cbc1 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LatticeFactorCoefficients.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory/LatticeFactorCoefficients.lean @@ -50,7 +50,8 @@ theorem exists_scalar_of_mul_eq_map_lattice {k : ℕ} ∃ c : L, c ≠ 0 ∧ ∀ g, c * q.coeff g ∈ (algebraMap K L).range := by classical obtain ⟨psi, hpsi⟩ := AddMonoidHom.exists_injOn_finInt (q.coeff.support ∪ r.coeff.support) - have hsub : (q.coeff.support : Set (Fin k → ℤ)) ⊆ ((q.coeff.support ∪ r.coeff.support : Finset _) : Set _) := + have hsub : (q.coeff.support : Set (Fin k → ℤ)) ⊆ ((q.coeff.support ∪ r.coeff.support : Finset + _) : Set _) := fun x hx ↦ Finset.mem_coe.mpr (Finset.mem_union_left _ (Finset.mem_coe.mp hx)) have hinjq : Set.InjOn psi (q.coeff.support : Set (Fin k → ℤ)) := hpsi.mono hsub have htransfer : ∀ g ∈ q.coeff.support, @@ -63,10 +64,12 @@ theorem exists_scalar_of_mul_eq_map_lattice {k : ℕ} exact (Finsupp.mem_support_iff.mp hg) (htransfer g hg).symm have hr0 : AddMonoidAlgebra.mapDomainRingHom L psi r ≠ 0 := by obtain ⟨g, hg⟩ := Finsupp.support_nonempty_iff.mpr (coeff_eq_zero.not.mpr hr) - have hsubr : (r.coeff.support : Set (Fin k → ℤ)) ⊆ ((q.coeff.support ∪ r.coeff.support : Finset _) : Set _) := + have hsubr : (r.coeff.support : Set (Fin k → ℤ)) ⊆ ((q.coeff.support ∪ r.coeff.support : + Finset _) : Set _) := fun x hx ↦ Finset.mem_coe.mpr (Finset.mem_union_right _ (Finset.mem_coe.mp hx)) intro h0 - have := Finsupp.mapDomain_apply' ((q.coeff.support ∪ r.coeff.support : Finset _) : Set _) r.coeff hsubr hpsi + have := Finsupp.mapDomain_apply' ((q.coeff.support ∪ r.coeff.support : Finset _) : Set _) + r.coeff hsubr hpsi (Finset.mem_union_right _ hg) have h0' : Finsupp.mapDomain psi r.coeff = 0 := by simpa only [mapDomainRingHom_apply, mapDomain, coeff_ofCoeff, coeff_zero] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEmbedding.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEmbedding.lean index e658d3aca3..63dd300245 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEmbedding.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/CardinalTruncationDomainEmbedding.lean @@ -163,7 +163,8 @@ theorem CardSuppLTTruncationIntegerPart.coeff_zero_convexQuotientSplitRingEquiv (cardSuppLTTruncationIntegerPartConvexQuotientSplitRingEquiv P Z x).2).2⟩ : cardSuppLTTruncationIntegerPart (G := P) (R := R) (κ := κ) Z) = CardSuppLTTruncationIntegerPart.restrictDomain - P.toAddSubgroup.subtype P.toAddSubgroup.subtype_injective (fun _ _ ↦ ⟨fun h ↦ h, fun h ↦ h⟩) Z x := by + P.toAddSubgroup.subtype P.toAddSubgroup.subtype_injective (fun _ _ ↦ ⟨fun h ↦ h, fun h ↦ + h⟩) Z x := by apply Subtype.ext apply Subtype.ext rw [coe_restrictDomain] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ConvexQuotientSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ConvexQuotientSplitting.lean index 21fce1bce8..122d55ad08 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ConvexQuotientSplitting.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/ConvexQuotientSplitting.lean @@ -397,6 +397,7 @@ variable {R : Type v} {K : Type w} {G : Type u} [Field R] variable [Field K] [AddCommGroup G] [Module K G] variable [LinearOrder G] [IsOrderedAddMonoid G] +/-- The quotient order induced by a convex submodule of the ordered exponent group. -/ noncomputable local instance boundedQuotientLinearOrder (P : Submodule K G) [P.toAddSubgroup.IsConvex] : LinearOrder (G ⧸ P) := ConvexQuotient.instLinearOrder (H := P.toAddSubgroup) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/Degree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/Degree.lean index 712fdab7d2..f4de7489a4 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/Degree.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/Degree.lean @@ -9,7 +9,7 @@ module import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType -public import Mathlib.Data.Real.Basic +public import Mathlib.Basic.Real.Basic import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrderTypeMultiplicativity diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/DegreeResidue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/DegreeResidue.lean index 58c4c74819..a07fb68f2d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/DegreeResidue.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements/DegreeResidue.lean @@ -8,7 +8,7 @@ module public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Residue public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType -public import Mathlib.Data.Real.Basic +public import Mathlib.Basic.Real.Basic import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeValuation import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportResidue diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DegreeValuation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DegreeValuation.lean index 627e60df70..0ffd69b8e0 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DegreeValuation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DegreeValuation.lean @@ -8,7 +8,7 @@ module public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.MaxAddDegree public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType -public import Mathlib.Data.Real.Basic +public import Mathlib.Basic.Real.Basic /-! # The degree valuation on nonpositive real Hahn series diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Domain.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Domain.lean index 6d1d1024ea..f0292518aa 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Domain.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Domain.lean @@ -59,7 +59,7 @@ theorem embDomain_restrictDomain (f : G ↪o H) (x : K⟦H⟧) by_cases hh : h ∈ Set.range f · obtain ⟨g, rfl⟩ := hh rw [embDomain_coeff, restrictDomain_coeff] - · rw [embDomain_notin_range hh] + · rw [HahnSeries.embDomain_of_notMem_range hh] have hzero : x.coeff h = 0 := by by_contra hne exact hh (hx hne) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainEmbedding.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainEmbedding.lean index 6de0b73c98..3a06da8d91 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainEmbedding.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainEmbedding.lean @@ -82,12 +82,12 @@ theorem lift_supportOrderType_mapDomain (f : G →+ H) (hfi : Function.Injective (HahnSeries.supportOrderType (mapDomain f hfi hf b : K⟦H⟧)) = Ordinal.lift.{v, u} (HahnSeries.supportOrderType (b : K⟦G⟧)) := by let e : G ↪o H := ⟨⟨f, hfi⟩, hf _ _⟩ - letI : WellFoundedLT (b : K⟦G⟧).support := (b : K⟦G⟧).isWF_support - letI : WellFoundedLT (mapDomain f hfi hf b : K⟦H⟧).support := + let : WellFoundedLT (b : K⟦G⟧).support := (b : K⟦G⟧).isWF_support + let : WellFoundedLT (mapDomain f hfi hf b : K⟦H⟧).support := (mapDomain f hfi hf b : K⟦H⟧).isWF_support let supportEquiv : (mapDomain f hfi hf b : K⟦H⟧).support ≃o (b : K⟦G⟧).support := - (OrderIso.setCongr _ (f '' (b : K⟦G⟧).support) + (Set.orderIsoOfEq _ (f '' (b : K⟦G⟧).support) (support_mapDomain f hfi hf b)).trans (StrictMonoOn.orderIso e (b : K⟦G⟧).support (e.strictMono.strictMonoOn (b : K⟦G⟧).support)).symm diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainOrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainOrderType.lean index 7185ba7739..0d85d3ed28 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainOrderType.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/DomainOrderType.lean @@ -44,9 +44,9 @@ theorem supportOrderType_restrictDomain_le (f : G ↪o H) (x : R⟦H⟧) : have he : StrictMono e := by intro a b hab exact f.strictMono hab - letI : WellFoundedLT ↑(restrictDomain f x).support := + let : WellFoundedLT ↑(restrictDomain f x).support := (restrictDomain f x).isPWO_support.isWF - letI : WellFoundedLT ↑x.support := x.isPWO_support.isWF + let : WellFoundedLT ↑x.support := x.isPWO_support.isWF rw [supportOrderType_eq_setOrderType, supportOrderType_eq_setOrderType] calc (restrictDomain f x).isPWO_support.orderType = @@ -72,9 +72,9 @@ variable [AddCommMonoid H] [IsOrderedCancelAddMonoid H] theorem supportOrderType_embDomainRingEquiv (e : G ≃+o H) (x : R⟦G⟧) : (embDomainRingEquiv e x).supportOrderType = x.supportOrderType := by rw [supportOrderType_eq_setOrderType, supportOrderType_eq_setOrderType] - letI : WellFoundedLT x.support := x.isWF_support + let : WellFoundedLT x.support := x.isWF_support let supportEquiv : (embDomainRingEquiv e x).support ≃o x.support := - (OrderIso.setCongr _ (e '' x.support) (support_embDomainRingEquiv e x)).trans + (Set.orderIsoOfEq _ (e '' x.support) (support_embDomainRingEquiv e x)).trans (StrictMonoOn.orderIso e x.support (e.strictMono.strictMonoOn x.support)).symm exact (embDomainRingEquiv e x).isPWO_support.orderType_eq_typeLT_of_orderIso diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/AlmostIrreducible.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/AlmostIrreducible.lean index a723efa195..fc6fa22437 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/AlmostIrreducible.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/AlmostIrreducible.lean @@ -123,7 +123,7 @@ theorem IsAlmostIrreducible.irreducible_of_not_isUnit_of_realSupportSup_eq_zero assertion of LM24, Remark 6.5.1. -/ theorem not_irreducible_of_realSupportSup_lt_zero [DivisibleBy H ℤ] {b : Nonpositive H K} (hbSup : realSupportSup H b < 0) : ¬Irreducible b := by - letI : DivisibleBy H ℕ := AddGroup.divisibleByNatOfDivisibleByInt H + let : DivisibleBy H ℕ := AddGroup.divisibleByNatOfDivisibleByInt H intro hbIrreducible have hbNe : b ≠ 0 := hbIrreducible.ne_zero have hbSupNeBot : realSupportSup H b ≠ ⊥ := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwoExample.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwoExample.lean index 95ee8e6ea7..58c51ce022 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwoExample.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/DegreeTwoExample.lean @@ -177,7 +177,7 @@ theorem degreeTwoSeries_supportOrderType : Ordinal.omega0 ^ (2 : Ordinal) := by rw [HahnSeries.supportOrderType_eq_setOrderType] have e : (degreeTwoSeries (K := K)).support ≃o Lex (ℕ × ℕ) := - (OrderIso.setCongr (degreeTwoSeries (K := K)).support + (Set.orderIsoOfEq (degreeTwoSeries (K := K)).support (Set.range degreeTwoExponentEmbedding) (degreeTwoSeries_support (K := K))).trans degreeTwoExponentEmbedding.orderIso.symm @@ -185,8 +185,8 @@ theorem degreeTwoSeries_supportOrderType : change Ordinal.type (Prod.Lex (fun a b : ℕ ↦ a < b) (fun a b : ℕ ↦ a < b)) = _ rw [Ordinal.type_prod_lex] simp only [Ordinal.type_nat_lt] - have hsucc : Order.succ (1 : Ordinal) = 2 := one_add_one_eq_two - rw [← hsucc, Ordinal.opow_succ, Ordinal.opow_one] + have hsucc : (1 : Ordinal) + 1 = 2 := one_add_one_eq_two + rw [← hsucc, Ordinal.opow_add_one, Ordinal.opow_one] /-- The degree-two series regarded as a nonpositive real Hahn series. -/ def degreeTwoNonpositive : HahnSeries.Nonpositive ℝ K := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/TranslatedSpanFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/TranslatedSpanFactorization.lean index 47431f804b..51409ee60f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/TranslatedSpanFactorization.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo/TranslatedSpanFactorization.lean @@ -237,7 +237,7 @@ theorem rank_translatedTruncationSpan_mul_le_two let s : Set (SeriesQuotientByJAddConstants K) := {toSeriesQuotientByJAddConstants b, toSeriesQuotientByJAddConstants c} have hs : s.Finite := (Set.finite_singleton _).insert _ - letI : Fintype s := hs.fintype + let : Fintype s := hs.fintype have hcard : s.toFinset.card ≤ 2 := by change ({toSeriesQuotientByJAddConstants b, toSeriesQuotientByJAddConstants c} : Set (SeriesQuotientByJAddConstants K)).toFinset.card ≤ 2 @@ -264,8 +264,8 @@ theorem finrank_translatedTruncationSpan_mul_le_two let s : Set (SeriesQuotientByJAddConstants K) := {toSeriesQuotientByJAddConstants b, toSeriesQuotientByJAddConstants c} have hs : s.Finite := (Set.finite_singleton _).insert _ - letI : Fintype s := hs.fintype - letI : Module.Finite K + let : Fintype s := hs.fintype + let : Module.Finite K (Submodule.span K s) := Module.Finite.span_of_finite K hs have hcard : s.toFinset.card ≤ 2 := by change ({toSeriesQuotientByJAddConstants b, toSeriesQuotientByJAddConstants c} : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFinite.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFinite.lean index e77197faf1..5f65416c80 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFinite.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/MaximalFinite.lean @@ -47,10 +47,7 @@ theorem principalComponentTensorEquiv_mulRightFactor (TensorProduct.mulRightFactor q z) = HahnSeries.Nonpositive.degreeFiniteSupportResidueEquiv K q • principalComponentTensorEquiv K α z := by - induction z using TensorProduct.induction_on with - | zero => - rw [(TensorProduct.mulRightFactor (K := K) q).map_zero, - (principalComponentTensorEquiv K α).map_zero, smul_zero] + induction z using TensorProduct.inductionOn with | tmul x p => rw [TensorProduct.mulRightFactor_tmul, principalComponentTensorEquiv_tmul, @@ -73,21 +70,7 @@ theorem principalSubringTensorEquiv_mulRightFactor [CharZero K] (q : FiniteSuppo (TensorProduct.mulRightFactor q z) = finiteSupportGradedEmbedding K q * principalSubringTensorEquiv K z := by - induction z using TensorProduct.induction_on with - | zero => - calc - principalSubringTensorEquiv K - (TensorProduct.mulRightFactor q 0) = - principalSubringTensorEquiv K 0 := - congrArg (principalSubringTensorEquiv K) - ((TensorProduct.mulRightFactor (K := K) q).map_zero) - _ = 0 := map_zero (principalSubringTensorEquiv K) - _ = finiteSupportGradedEmbedding K q * 0 := - (mul_zero _).symm - _ = finiteSupportGradedEmbedding K q * - principalSubringTensorEquiv K 0 := - congrArg (finiteSupportGradedEmbedding K q * ·) - (map_zero (principalSubringTensorEquiv K)).symm + induction z using TensorProduct.inductionOn with | tmul x p => rw [TensorProduct.mulRightFactor_tmul, principalSubringTensorEquiv_tmul, @@ -303,7 +286,8 @@ theorem isContent_principalGradedTensorEquiv_symm_iff [CharZero K] (B : DegreeGr /-- A finite-support series, embedded in grade zero, is its own maximal finite-support divisor. -/ -theorem isGradedMaximalFiniteSupportDivisor_finiteSupport [CharZero K] (p : FiniteSupportRing (K := K)) : +theorem isGradedMaximalFiniteSupportDivisor_finiteSupport [CharZero K] (p : FiniteSupportRing (K + := K)) : IsGradedMaximalFiniteSupportDivisor (finiteSupportGradedEmbedding K p) (Associates.mk p) := by apply (isContent_principalGradedTensorEquiv_symm_iff _ (Associates.mk p)).mp diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PrincipalMaximalFinite.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PrincipalMaximalFinite.lean index db2be30e9d..77e79a077d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PrincipalMaximalFinite.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/PrincipalMaximalFinite.lean @@ -56,8 +56,7 @@ private theorem principalSubringTensorEquiv_mulLeft_rTensor (c : PrincipalSubrin ((LinearMap.mulLeft K c).rTensor (FiniteSupportRing (K := K)) z) = principalSubringEmbedding K c * principalSubringTensorEquiv K z := by - induction z using TensorProduct.induction_on with - | zero => simp + induction z using TensorProduct.inductionOn with | tmul x p => rw [LinearMap.rTensor_tmul, principalSubringTensorEquiv_tmul, diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/GradedIrreducible.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/GradedIrreducible.lean index 022034c1f7..0e884666f7 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/GradedIrreducible.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/GradedIrreducible.lean @@ -207,8 +207,7 @@ theorem coordinate_finiteSupportGradedEmbedding_mul [CharZero K] (φ : Principal coordinate K φ (finiteSupportGradedEmbedding K p * z) = p * coordinate K φ z := by obtain ⟨t, rfl⟩ := (principalSubringTensorEquiv K).surjective z rw [← principalSubringTensorEquiv_one_tmul, ← map_mul] - induction t using TensorProduct.induction_on with - | zero => simp + induction t using TensorProduct.inductionOn with | tmul x q => rw [Algebra.TensorProduct.tmul_mul_tmul, one_mul, principalSubringTensorEquiv_tmul, principalSubringTensorEquiv_tmul, coordinate_tmul, coordinate_tmul, mul_smul_comm] @@ -219,7 +218,7 @@ theorem coordinate_finiteSupportGradedEmbedding_mul [CharZero K] (φ : Principal /-- The graded projection `RV̂ → P̂` sends the image of a finite-support series `p` to the class of `p` in grade zero of `P̂`, which is its constant coefficient. -/ -theorem rvProjection_finiteSupportGradedEmbedding [CharZero K] +theorem rvProjection_finiteSupportGradedEmbedding (p : Berarducci.FiniteSupportRing (K := K)) : rvProjection K (finiteSupportGradedEmbedding K p) = gradeClass 0 (p : Series K) := by have hcut : ordinalValue (p : Series K) < ω^ ((0 : NatOrdinal) + 1) := by @@ -246,7 +245,7 @@ theorem rvProjection_finiteSupportMonomial_of_neg [CharZero K] exact zero_lt_one /-- The graded projection sends the image of `t^0 = 1` to `1`. -/ -theorem rvProjection_finiteSupportMonomial_zero [CharZero K] : +theorem rvProjection_finiteSupportMonomial_zero : rvProjection K (finiteSupportGradedEmbedding K (finiteSupportMonomial (K := K) (0 : exponentMonoid ℝ))) = 1 := by have h1 : finiteSupportMonomial (K := K) (0 : exponentMonoid ℝ) = 1 := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/MainTheorem.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/MainTheorem.lean index ae7f7ae051..50d8652979 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/MainTheorem.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/MainTheorem.lean @@ -52,7 +52,7 @@ theorem irreducible_add_of_isRandom {n m : ℕ} (hn : 1 ≤ n) (hm : 1 ≤ m) { Irreducible (b + r) := by obtain ⟨d⟩ := exists_blockDecomposition hn hβ hot have hQ : HereditarilyRVIndependent n d.block := d.hereditarilyRVIndependent_block hn hb - haveI : Nonempty (Fin m) := ⟨⟨0, hm⟩⟩ + have : Nonempty (Fin m) := ⟨⟨0, hm⟩⟩ obtain ⟨i₀, hi₀⟩ := Finite.exists_max d.exponent have hr' : ((d.rest + r : Series K) : K⟦ℝ⟧).degree < ((n : NatOrdinal) : WithBot NatOrdinal) := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesMaximalMultiplicativity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesMaximalMultiplicativity.lean index ee3f93297a..5f698c27b2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesMaximalMultiplicativity.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesMaximalMultiplicativity.lean @@ -293,7 +293,7 @@ private theorem isFiniteSupportPrimitive_mul_of_induction hcPrimitive hpBUnit (add_sub_cancel _ _) (by rw [mul_comm, ihRight _ hdropC, mul_comm]) have hq := dvd_gradedNormalizedMaximalFiniteSupportDivisor_rvInitialForm_of_dvd hgcd hqbc rw [gradedNormalizedMaximalFiniteSupportDivisor_rvInitialForm_mul hgradedMul] at hq - letI : GCDMonoid (FiniteSupportRing (K := K)) := gcdMonoidOfExistsGCD hgcd + let : GCDMonoid (FiniteSupportRing (K := K)) := gcdMonoidOfExistsGCD hgcd exact (hrelB.mul_right hrelC).isUnit_of_dvd hq /-- Multiplicativity of normalized maximal finite-support divisors of Hahn series follows from diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesPrimality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesPrimality.lean index f37c004b2a..0713b96b0d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesPrimality.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/SeriesPrimality.lean @@ -50,7 +50,7 @@ theorem finiteSupportSeries_exists_factor_dvd_of_maximalMultiplicative have hpMax : p ∣ seriesNormalizedMaximalFiniteSupportDivisor (b * c) := (hmaxBC.1 p).mp hp rw [hmaxMul b c] at hpMax - letI : GCDMonoid (FiniteSupportRing (K := K)) := + let : GCDMonoid (FiniteSupportRing (K := K)) := gcdMonoidOfExistsGCD hgcd obtain ⟨p₁, p₂, hp₁, hp₂, hpFactor⟩ := exists_dvd_and_dvd_of_dvd_mul hpMax diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalSubringFraction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalSubringFraction.lean index 58ea62eca8..e7cc483b7d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalSubringFraction.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements/PrincipalSubringFraction.lean @@ -37,7 +37,7 @@ theorem isRelativelyAlgebraicallyClosed_principalGradedFractionField : @Algebra.IsRelativelyAlgebraicallyClosed K (PrincipalSubringFractionField K) _ _ (principalSubringFractionAlgebra K) := by - letI := principalSubringFractionAlgebra K + let := principalSubringFractionAlgebra K apply Algebra.isRelativelyAlgebraicallyClosed_of_minpoly_natDegree_le_one intro x hx by_cases hx0 : x = 0 diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/AlmostIrreducible.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/AlmostIrreducible.lean index 847f5658e7..f6072981ee 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/AlmostIrreducible.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/AlmostIrreducible.lean @@ -24,11 +24,14 @@ public noncomputable section open HahnSeries.Nonpositive +/-- The full real exponent group, represented as an additive subgroup for the counterexample. -/ abbrev RealExponentSubgroup : AddSubgroup ℝ := ⊤ +/-- Rational Hahn series with nonpositive exponents in the full real subgroup. -/ abbrev RealExponentSeries := HahnSeries.Nonpositive RealExponentSubgroup ℚ +/-- Integer divisibility on the full real exponent subgroup, inherited from the real numbers. -/ noncomputable local instance : DivisibleBy RealExponentSubgroup ℤ where div a n := ⟨DivisibleBy.div (a : ℝ) n, Set.mem_univ _⟩ div_zero a := Subtype.ext (DivisibleBy.div_zero (a : ℝ)) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/AlmostIrreducibleFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/AlmostIrreducibleFactorization.lean index 377c59ddc0..a3e3a16970 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/AlmostIrreducibleFactorization.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/AlmostIrreducibleFactorization.lean @@ -24,8 +24,10 @@ public noncomputable section open HahnSeries.Nonpositive +/-- The full real exponent subgroup used in the explicit factorization fixtures. -/ abbrev FactorizationExponentSubgroup : AddSubgroup ℝ := ⊤ +/-- Rational Hahn series over the full real subgroup, supported at nonpositive exponents. -/ abbrev FactorizationSeries := HahnSeries.Nonpositive FactorizationExponentSubgroup ℚ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/MaximalFiniteSupportDivisor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/MaximalFiniteSupportDivisor.lean index 90f925e201..9f3e760a47 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/MaximalFiniteSupportDivisor.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/MaximalFiniteSupportDivisor.lean @@ -7,7 +7,7 @@ module public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedMaximalFinite public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite -public import Mathlib.Data.Real.Basic +public import Mathlib.Basic.Real.Basic import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPart.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPart.lean index 584d1c8de5..1163f9802d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPart.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPart.lean @@ -24,11 +24,15 @@ public noncomputable section open HahnSeries.Nonpositive +/-- The full real exponent subgroup used to test normalized finite-support factors. -/ abbrev HPartExponentSubgroup : AddSubgroup ℝ := ⊤ +/-- The ring of rational Hahn series with finite nonpositive real support. -/ abbrev HPartFiniteSupportRing := FiniteSupportRing (G := HPartExponentSubgroup) (K := ℚ) +/-- Finite-support rational Hahn series with nonpositive real exponents and constant coefficient +one. -/ abbrev HPartNormalizedFiniteSupport := ConstantTermOneFiniteSupport (G := HPartExponentSubgroup) (K := ℚ) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPartMultiplicativity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPartMultiplicativity.lean index 9b26e2e99c..310b179f01 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPartMultiplicativity.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/NormalizedHPartMultiplicativity.lean @@ -24,6 +24,7 @@ public noncomputable section open HahnSeries.Nonpositive +/-- The zero exponent subgroup used to test multiplicativity of normalized factors. -/ abbrev TrivialExponentSubgroup : AddSubgroup ℝ := ⊥ /-- Every normalized finite-support series over the trivial exponent subgroup is the identity. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupport.lean index 95afcf7c45..49b35c868d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupport.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupport.lean @@ -35,14 +35,14 @@ variable [PartialOrder G] [AddCommMonoid G] [IsOrderedCancelAddMonoid G] [Ring K /-- The subring of Hahn series with finite support. -/ def finiteSupportSubring : Subring K⟦G⟧ := - let _ : Fact (Cardinal.aleph0 ≤ Cardinal.aleph0) := ⟨le_rfl⟩ + let _ : Fact (Cardinal.aleph0.{u} ≤ Cardinal.aleph0.{u}) := ⟨le_rfl⟩ HahnSeries.cardSuppLTSubring G K Cardinal.aleph0 /-- Membership in the finite-support subring is finiteness of the Hahn-series support. -/ @[simp] theorem mem_finiteSupportSubring_iff (b : K⟦G⟧) : b ∈ (finiteSupportSubring : Subring K⟦G⟧) ↔ b.support.Finite := by - letI : Fact (Cardinal.aleph0 ≤ Cardinal.aleph0) := ⟨le_rfl⟩ + let : Fact (Cardinal.aleph0.{u} ≤ Cardinal.aleph0.{u}) := ⟨le_rfl⟩ rw [finiteSupportSubring, HahnSeries.mem_cardSuppLTSubring, HahnSeries.cardSupp] exact Cardinal.lt_aleph0_iff_set_finite diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportGCDProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportGCDProof.lean index 51e77f500a..61ac4e1c86 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportGCDProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportGCDProof.lean @@ -73,7 +73,7 @@ theorem exists_lcm_subgroupAlgebra {H : AddSubgroup G} ∃ c : AddMonoidAlgebra K H, ∀ d, a ∣ d ∧ b ∣ d ↔ c ∣ d := by have := hufm obtain ⟨inst⟩ : Nonempty (NormalizedGCDMonoid (AddMonoidAlgebra K H)) := inferInstance - letI := inst + let := inst exact ⟨lcm a b, fun d ↦ ⟨fun h ↦ lcm_dvd h.1 h.2, fun h ↦ ⟨(dvd_lcm_left a b).trans h, (dvd_lcm_right a b).trans h⟩⟩⟩ @@ -136,7 +136,7 @@ open Classical in theorem exists_gcd_dvdFS (x z : K⟦G⟧) (hx : x.support.Finite) (hz : z.support.Finite) : ∃ d : K⟦G⟧, d.support.Finite ∧ ∀ e : K⟦G⟧, e.support.Finite → (DvdFS e x ∧ DvdFS e z ↔ DvdFS e d) := by - letI : GCDMonoid (HahnSeries.finiteSupportSubring : Subring K⟦G⟧) := by + let : GCDMonoid (HahnSeries.finiteSupportSubring : Subring K⟦G⟧) := by refine gcdMonoidOfExistsLCM fun a b ↦ ?_ obtain ⟨h, hhf, hh⟩ := exists_lcm_dvdFS (a : K⟦G⟧) (b : K⟦G⟧) ((HahnSeries.mem_finiteSupportSubring_iff _).mp a.2) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalizedGCD.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalizedGCD.lean index 7f7862344d..0b30632aff 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalizedGCD.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportNormalizedGCD.lean @@ -72,13 +72,14 @@ private noncomputable def finiteSupportNormalizationMonoid : classical exact (strongNormalizationMonoidOfMonoidHomRightInverse (α := finiteSupportSubring (G := G) (K := K)) - normalizedAssociateRepresentativeMonoidHom normalizedAssociateRepresentative_mk).toNormalizationMonoid + normalizedAssociateRepresentativeMonoidHom + normalizedAssociateRepresentative_mk).toNormalizationMonoid /-- The nonpositive finite-support Hahn-series ring over a field is a normalized GCD domain. -/ theorem nonemptyNormalizedGCDMonoid_finiteSupport : Nonempty (NormalizedGCDMonoid (finiteSupportSubring (G := G) (K := K))) := by classical - letI : NormalizationMonoid (finiteSupportSubring (G := G) (K := K)) := + let : NormalizationMonoid (finiteSupportSubring (G := G) (K := K)) := finiteSupportNormalizationMonoid exact ⟨normalizedGCDMonoidOfExistsGCD finiteSupport_pairwise_gcd_exists⟩ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportScalarExtension.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportScalarExtension.lean index ca4715c1ea..b1bfb30e15 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportScalarExtension.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/FiniteSupportScalarExtension.lean @@ -70,9 +70,6 @@ theorem finiteSupportMap_coeff (f : K →+* L) (G := G) (K := L) (finiteSupportMap f b))).symm _ = f (finiteSupportCoefficients b g) := by rw [finiteSupportAddMonoidAlgebraEquiv_map] - change - (AddMonoidAlgebra.mapRingHom (exponentMonoid G) f - (finiteSupportAddMonoidAlgebraEquiv b)).coeff g = _ rw [AddMonoidAlgebra.coeff_mapRingHom] exact congrArg f (congrArg (fun q : exponentMonoid G →₀ K ↦ q g) (coeff_finiteSupportAddMonoidAlgebraEquiv (G := G) (K := K) b)) @@ -429,7 +426,7 @@ theorem finiteSupportMap_exists_factor_dvd_of_scalarRedistribution rcases eq_zero_or_eq_zero_of_mul_eq_zero hbc with hb | hc · exact ⟨0, 1, by simp [hpZero], by simp [hb], by simp⟩ · exact ⟨1, 0, by simp [hpZero], by simp, by simp [hc]⟩ - · letI : GCDMonoid (FiniteSupportRing (G := G) (K := L)) := + · let : GCDMonoid (FiniteSupportRing (G := G) (K := L)) := gcdMonoidOfExistsGCD hgcd obtain ⟨q₁, q₂, hq₁b, hq₂c, hpq⟩ := exists_dvd_and_dvd_of_dvd_mul hp diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/AlgebraicIndependence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/AlgebraicIndependence.lean index 3b57a3bb19..2081bc48c4 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/AlgebraicIndependence.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/AlgebraicIndependence.lean @@ -8,8 +8,7 @@ module public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LeadingCoefficient public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LinearMaximal public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Obligations -public import - LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativesAtLimitOrdinal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativesAtLimitOrdinal public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Scalar public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ArchimedeanBallBase public import Mathlib.RingTheory.AlgebraicIndependent.Defs @@ -71,10 +70,10 @@ theorem injectiveAt_of_isMinimalSystem S.ContributesToPartialDerivativeAt v' v) ∧ (∀ v ∈ s, pderiv S.B₀ (U v) = 0) ∧ pderiv v' S.F = ∑ v ∈ s, pderiv v S.F * U v) (α : NatOrdinal.{u}) : OrdinalGraded.InjectiveAt K wt xg α := by - letI : Nontrivial ((cantorBendixsonDegreeValuation (G := G) (R := K)).Component 0) := + let : Nontrivial ((cantorBendixsonDegreeValuation (G := G) (R := K)).Component 0) := Function.Injective.nontrivial (cantorBendixsonLayerScalarHom_injective (G := G) (K := K)) - letI : Nontrivial (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded := + let : Nontrivial (cantorBendixsonDegreeValuation (G := G) (R := K)).AssociatedGraded := Function.Injective.nontrivial (DirectSum.of_injective 0) exact OrdinalGraded.injectiveAt_of_zero_successor_limit (OrdinalGraded.injectiveAt_zero hx.ne_zero) @@ -315,8 +314,8 @@ theorem algebraicIndependent_of_minimal_system (hσ : LiftFamily.HasLowerTruncationDegrees σ) : AlgebraicIndependent K xg := by obtain ⟨κ, hlin, hwf, U, hUmono, hUopen, hUconv, hUbase⟩ := ArchimedeanClass.exists_wellFounded_archimedeanBall_basis (G := G) - letI := hlin - letI := hwf + let := hlin + let := hwf exact algebraicIndependent_iff_injective_aeval.mpr (aeval_injective_of_isMinimalSystem_of_subgroupBase σ hx U (fun hij ↦ hUmono hij) hUopen hUconv hUbase hσ) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonRankLevels.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonRankLevels.lean index 8354c69389..b568257bbd 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonRankLevels.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonRankLevels.lean @@ -5,8 +5,7 @@ Authors: Dan Abramov -/ module -public import - LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolationOnSets +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolationOnSets import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonValue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonValue.lean index 535e13907c..97edfd2aea 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonValue.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CantorBendixsonValue.lean @@ -99,12 +99,12 @@ def cantorBendixsonValue (b : HahnSeries Γ R) : Ordinal.{u} := by /-- At a closed-support point, the value is the corresponding power of `omega`. -/ theorem cantorBendixsonValue_of_mem (b : HahnSeries Γ R) (h : 0 ∈ closure b.support) : b.cantorBendixsonValue = Ordinal.omega0 ^ b.cantorBendixsonRank 0 := by - simp only [cantorBendixsonValue, mem_closedSupport, h, if_true] + simp only [cantorBendixsonValue, mem_closedSupport, h, ite_true] /-- A support avoiding a neighborhood of zero has value zero. -/ theorem cantorBendixsonValue_of_notMem (b : HahnSeries Γ R) (h : 0 ∉ closure b.support) : b.cantorBendixsonValue = 0 := by - simp only [cantorBendixsonValue, mem_closedSupport, h, if_false] + simp only [cantorBendixsonValue, mem_closedSupport, h, ite_false] /-- The value vanishes exactly when zero is outside the ambient closed support. -/ theorem cantorBendixsonValue_eq_zero_iff (b : HahnSeries Γ R) : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CofactorInduction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CofactorInduction.lean index adc0f1526c..c140a087bd 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CofactorInduction.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CofactorInduction.lean @@ -475,6 +475,212 @@ theorem degree_translatedTruncLE_sub_sum_le_of_eq_bot variable {κ : Type x} {ι : Type w} {κ' : Type w} +/-- Lift a homogeneous ideal expression to a correction lowering the series degree. -/ +private theorem exists_degree_correction_of_componentsGE_mem [Fintype κ'] + {wt : ι → NatOrdinal.{u}} {V : ι → Nonpositive G K} + (xg : ι → (ν).AssociatedGraded) + (hV : ∀ i, Represents (V i) (wt i) (xg i)) {α : NatOrdinal.{u}} + (hinj : ∀ (β : NatOrdinal.{u}) (F : MvPolynomial ι K), β < α → + IsWeightedHomogeneous wt F β → aeval xg F = 0 → F = 0) + (Q : κ' → MvPolynomial ι K) (σQ : κ' → NatOrdinal.{u}) + (hQ : ∀ j, IsWeightedHomogeneous wt (Q j) (σQ j)) + {τ β : NatOrdinal.{u}} (hτβ : τ < β) + (P : κ' → NatOrdinal.{u}) (hP : ∀ j, P j + σQ j = β) + {y : Nonpositive G K} (hνy : ν y = (β : WithBot NatOrdinal)) + {F : MvPolynomial ι K} (hFw : ∀ d ∈ F.support, Finsupp.weight wt d < α) + (hFbot : ν (y - aeval V F) = ⊥) + (hFGE : MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q)) : + ∃ w : κ' → Nonpositive G K, (∀ j, ν (w j) ≤ P j) ∧ + ν (y - ∑ j, w j * aeval V (Q j)) < (β : WithBot NatOrdinal) := by + classical + have hνF : ν (aeval V F) = (β : WithBot NatOrdinal) := by + rw [← degree_eq_of_degree_sub_eq_bot hFbot, hνy] + have hwle : ∀ d ∈ F.support, (Finsupp.weight wt) d ≤ β := by + intro d hd + have := forall_weight_le_degree_aeval_of_injective xg hV hinj hFw d hd + rw [hνF] at this + exact WithBot.coe_le_coe.mp this + set Fβ := weightedHomogeneousComponent wt β F with hFβ_def + have hFβspan : Fβ ∈ Ideal.span (Set.range Q) := + weightedHomogeneousComponent_mem_span_of_componentsGE_mem wt hQ hFGE hτβ.le + let := weightedGradedAlgebra K wt + obtain ⟨A, hA, -, hAsum⟩ := OrdinalGraded.exists_eq_sum_mul_of_mem_span + (𝒜 := weightedHomogeneousSubmodule K wt) + (fun j ↦ (mem_weightedHomogeneousSubmodule _ _ _ _).mpr (hQ j)) + ((mem_weightedHomogeneousSubmodule _ _ _ _).mpr + (weightedHomogeneousComponent_isWeightedHomogeneous (w := wt) (n := β) (φ := F))) + hFβspan + have hAhom : ∀ j, IsWeightedHomogeneous wt (A j) (P j) := fun j ↦ + (mem_weightedHomogeneousSubmodule _ _ _ _).mp (hA j (P j) (hP j)) + refine ⟨fun j ↦ aeval V (A j), fun j ↦ (represents_aeval xg hV (hAhom j)).degree_le, ?_⟩ + have hsum : (∑ j, aeval V (A j) * aeval V (Q j)) = aeval V Fβ := by + rw [hFβ_def, hAsum, map_sum] + refine Finset.sum_congr rfl fun j _ ↦ ?_ + rw [map_mul, mul_comm] + rw [hsum] + have hrest : ∀ d ∈ (F - Fβ).support, (Finsupp.weight wt) d < β := by + intro d hd + have hne := MvPolynomial.mem_support_iff.mp hd + rw [MvPolynomial.coeff_sub, hFβ_def, coeff_weightedHomogeneousComponent] at hne + by_cases hdw : (Finsupp.weight wt) d = β + · rw [ite_eq_left hdw, sub_self] at hne + exact absurd rfl hne + · rw [ite_eq_right hdw, sub_zero] at hne + exact lt_of_le_of_ne (hwle d (MvPolynomial.mem_support_iff.mpr hne)) hdw + have hkey : y - aeval V Fβ = + (y - aeval V F) + aeval V (F - Fβ) := by + rw [map_sub] + ring + rw [hkey] + refine ((ν).map_add_le_max _ _).trans_lt (max_lt ?_ ?_) + · rw [hFbot] + exact WithBot.bot_lt_coe β + · exact degree_aeval_lt_of_forall_weight_lt xg hV hrest + +/-- Subtracting degree-controlled generator multiples preserves local polynomial ideal data. -/ +private theorem local_ideal_presentation_sub_sum_mul [Fintype κ'] + {wt : ι → NatOrdinal.{u}} {V : ι → Nonpositive G K} + (xg : ι → (ν).AssociatedGraded) (hV : ∀ i, Represents (V i) (wt i) (xg i)) + (α : NatOrdinal.{u}) + (hgen : ∀ β : NatOrdinal.{u}, β < α → ∀ y ∈ DirectSum.rangeLof K (ν).Component β, + ∃ F : MvPolynomial ι K, IsWeightedHomogeneous wt F β ∧ aeval xg F = y) + (Q : κ' → MvPolynomial ι K) (σQ : κ' → NatOrdinal.{u}) + (hQ : ∀ j, IsWeightedHomogeneous wt (Q j) (σQ j)) + (τ β : NatOrdinal.{u}) (hτα : τ < α) (hβα : β < α) + (P : κ' → NatOrdinal.{u}) (hP : ∀ j, P j + σQ j = β) + (hPsmall : ∀ j, P j < α) + (hW : ∀ j, HasLowerTruncationDegree (aeval V (Q j)) (σQ j)) + (hPsep : ∀ j θ, θ < σQ j → P j + θ < τ) + (u : Nonpositive G K) (ctop : κ' → Nonpositive G K) + (hctopb : ∀ j y, y ≤ 0 → ν (translatedTruncLE y (ctop j)) ≤ P j) + (hp : ∀ y : G, y ≤ 0 → ∃ F : MvPolynomial ι K, + (∀ d ∈ F.support, Finsupp.weight wt d < α) ∧ + ν (translatedTruncLE y u - aeval V F) = ⊥ ∧ + MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q)) : + ∀ y : G, y ≤ 0 → ∃ F : MvPolynomial ι K, + (∀ d ∈ F.support, Finsupp.weight wt d < α) ∧ + ν (translatedTruncLE y (u - ∑ j, ctop j * aeval V (Q j)) - aeval V F) = ⊥ ∧ + MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q) := by + classical + let q : κ' → Nonpositive G K := fun j ↦ aeval V (Q j) + let R : Nonpositive G K := u - ∑ j, ctop j * q j + have hR_def : R = u - ∑ j, ctop j * q j := rfl + change ∀ y : G, y ≤ 0 → ∃ F : MvPolynomial ι K, + (∀ d ∈ F.support, Finsupp.weight wt d < α) ∧ + ν (translatedTruncLE y R - aeval V F) = ⊥ ∧ + MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q) + intro y hy + obtain ⟨F₀, hF₀w, hF₀bot, hF₀GE⟩ := hp y hy + have hpolc : ∀ j, ∃ A' : MvPolynomial ι K, + (∀ d ∈ A'.support, + (((Finsupp.weight wt) d : NatOrdinal) : WithBot NatOrdinal) ≤ + ν (translatedTruncLE y (ctop j))) ∧ + (∀ d ∈ A'.support, (Finsupp.weight wt) d < α) ∧ + ν (translatedTruncLE y (ctop j) - aeval V A') = ⊥ := fun j ↦ + exists_forall_weight_lt_and_degree_sub_aeval_eq_bot xg hV α hgen _ + ((hctopb j y hy).trans_lt (WithBot.coe_lt_coe.mpr + (hPsmall j))) + choose A' hA'd hA'w hA'bot using hpolc + have hEbound : ∀ j, ν (translatedTruncLE y (ctop j * q j) - + translatedTruncLE y (ctop j) * q j) < (τ : WithBot NatOrdinal) := by + intro j + exact degree_translatedTruncLE_mul_sub_mul_lt_forall (ctop j) (q j) + (P j) (σQ j) τ (by simpa only [translatedTruncLE_zero] using hctopb j 0 le_rfl) + (fun x hx ↦ hctopb j x hx.le) + (fun x hx ↦ (hW j).degree_translatedTruncLE_lt hx) + (hPsep j) y + have hpolE : ∀ j, ∃ FE : MvPolynomial ι K, + (∀ d ∈ FE.support, + (((Finsupp.weight wt) d : NatOrdinal) : WithBot NatOrdinal) ≤ + ν (translatedTruncLE y (ctop j * q j) - + translatedTruncLE y (ctop j) * q j)) ∧ + (∀ d ∈ FE.support, (Finsupp.weight wt) d < α) ∧ + ν ((translatedTruncLE y (ctop j * q j) - + translatedTruncLE y (ctop j) * q j) - aeval V FE) = ⊥ := fun j ↦ + exists_forall_weight_lt_and_degree_sub_aeval_eq_bot xg hV α hgen _ + ((hEbound j).trans (WithBot.coe_lt_coe.mpr hτα)) + choose FE hFEd hFEw hFEbot using hpolE + have hFEGE : ∀ j, MvPolynomial.componentsGE wt τ (FE j) = 0 := by + intro j + apply componentsGE_eq_zero_of_forall_lt + intro d hd + have h1 := (hFEd j d hd).trans_lt (hEbound j) + exact WithBot.coe_lt_coe.mp h1 + refine ⟨F₀ - ∑ j, A' j * Q j - ∑ j, FE j, ?_, ?_, ?_⟩ + · intro d hd + rcases Finset.mem_union.mp (MvPolynomial.support_sub ι _ _ hd) with hd | hd + · rcases Finset.mem_union.mp (MvPolynomial.support_sub ι _ _ hd) with hd | hd + · exact hF₀w d hd + · have hsum := MvPolynomial.support_sum hd + rw [Finset.mem_biUnion] at hsum + obtain ⟨j, -, hdj⟩ := hsum + have hmul := MvPolynomial.support_mul _ _ hdj + rw [Finset.mem_add] at hmul + obtain ⟨d₁, hd₁, d₂, hd₂, rfl⟩ := hmul + rw [map_add] + have h1 : (Finsupp.weight wt) d₁ ≤ P j := by + have := (hA'd j d₁ hd₁).trans (hctopb j y hy) + exact WithBot.coe_le_coe.mp this + have h2 : (Finsupp.weight wt) d₂ = σQ j := + hQ j (MvPolynomial.mem_support_iff.mp hd₂) + calc + (Finsupp.weight wt) d₁ + (Finsupp.weight wt) d₂ ≤ P j + σQ j := by + rw [h2] + exact add_le_add h1 le_rfl + _ = β := hP j + _ < α := hβα + · have hsum := MvPolynomial.support_sum hd + rw [Finset.mem_biUnion] at hsum + obtain ⟨j, -, hdj⟩ := hsum + exact hFEw j d hdj + · have hTsub : translatedTruncLE y R = + translatedTruncLE y u - ∑ j, translatedTruncLE y (ctop j * q j) := by + rw [hR_def, map_sub, map_sum] + have hAQ : ∀ j, aeval V (A' j * Q j) = aeval V (A' j) * q j := + fun j ↦ map_mul _ _ _ + have hcalc : translatedTruncLE y R - aeval V (F₀ - ∑ j, A' j * Q j - ∑ j, FE j) = + (translatedTruncLE y u - aeval V F₀) - + ∑ j, (translatedTruncLE y (ctop j * q j) - + aeval V (A' j) * q j - aeval V (FE j)) := by + rw [hTsub, map_sub, map_sub, map_sum, map_sum, + Finset.sum_congr rfl fun j _ ↦ hAQ j] + conv_rhs => rw [Finset.sum_sub_distrib, Finset.sum_sub_distrib] + abel + rw [hcalc] + have hbot1 : ∀ j, ν (translatedTruncLE y (ctop j * q j) - + aeval V (A' j) * q j - aeval V (FE j)) = ⊥ := by + intro j + have hshape : translatedTruncLE y (ctop j * q j) - + aeval V (A' j) * q j - aeval V (FE j) = + (translatedTruncLE y (ctop j) - aeval V (A' j)) * q j + + ((translatedTruncLE y (ctop j * q j) - + translatedTruncLE y (ctop j) * q j) - aeval V (FE j)) := by + ring + rw [hshape] + have h1 : ν ((translatedTruncLE y (ctop j) - aeval V (A' j)) * q j) = ⊥ := by + have := (ν).map_mul_le_add (translatedTruncLE y (ctop j) - aeval V (A' j)) + (q j) + rw [hA'bot j, WithBot.bot_add] at this + exact le_bot_iff.mp this + have h2 := hFEbot j + refine le_bot_iff.mp (((ν).map_add_le_max _ _).trans ?_) + rw [h1, h2, max_self] + have hsumbot : ν (∑ j, (translatedTruncLE y (ctop j * q j) - + aeval V (A' j) * q j - aeval V (FE j))) = ⊥ := + le_bot_iff.mp ((ν).map_sum_le_of_forall_le _ _ ⊥ fun j _ ↦ (hbot1 j).le) + refine le_bot_iff.mp (((ν).map_sub_le_max _ _).trans ?_) + rw [hF₀bot, hsumbot, max_self] + · rw [componentsGE_sub, componentsGE_sub, componentsGE_sum, componentsGE_sum] + have hAQGE : ∀ j ∈ Finset.univ, MvPolynomial.componentsGE wt τ (A' j * Q j) ∈ + Ideal.span (Set.range Q) := by + intro j _ + exact componentsGE_mem_span wt hQ + (Ideal.mul_mem_left _ _ (Ideal.subset_span ⟨j, rfl⟩)) τ + have hFEGE' : (∑ j, MvPolynomial.componentsGE wt τ (FE j)) = 0 := by + rw [Finset.sum_congr rfl fun j _ ↦ hFEGE j, Finset.sum_const_zero] + rw [hFEGE', sub_zero] + exact Ideal.sub_mem _ hF₀GE (Ideal.sum_mem _ hAQGE) + open Classical in /-- **Cofactors by well-founded induction.** Fix representatives of homogeneous classes generating the associated graded ring below `α`, each satisfying its assigned degree and proper-truncation @@ -580,50 +786,10 @@ theorem exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal ((mem_closedSupport _ _).mp hzs) obtain ⟨F, hFw, hFbot, hFGE⟩ := hp z hz0 have hνT : ν (translatedTruncLE z u) = (β : WithBot NatOrdinal) := by - rw [degree_translatedTruncLE_eq, ite_eq_left hzs, cantorBendixsonRank_eq, hzr, NatOrdinal.of_val] - have hνF : ν (aeval V F) = (β : WithBot NatOrdinal) := by - rw [← degree_eq_of_degree_sub_eq_bot hFbot, hνT] - have hwle : ∀ d ∈ F.support, (Finsupp.weight wt) d ≤ β := by - intro d hd - have := forall_weight_le_degree_aeval_of_injective xg hV hinj hFw d hd - rw [hνF] at this - exact WithBot.coe_le_coe.mp this - set Fβ := weightedHomogeneousComponent wt β F with hFβ_def - have hFβspan : Fβ ∈ Ideal.span (Set.range Q) := - weightedHomogeneousComponent_mem_span_of_componentsGE_mem wt hQ hFGE hτβ.le - letI := weightedGradedAlgebra K wt - obtain ⟨A, hA, -, hAsum⟩ := OrdinalGraded.exists_eq_sum_mul_of_mem_span - (𝒜 := weightedHomogeneousSubmodule K wt) - (fun j ↦ (mem_weightedHomogeneousSubmodule _ _ _ _).mpr (hQ j)) - ((mem_weightedHomogeneousSubmodule _ _ _ _).mpr - (weightedHomogeneousComponent_isWeightedHomogeneous (w := wt) (n := β) (φ := F))) - hFβspan - have hAhom : ∀ j, IsWeightedHomogeneous wt (A j) (P j β) := fun j ↦ - (mem_weightedHomogeneousSubmodule _ _ _ _).mp (hA j (P j β) (hP j β hτβ hβμ)) - refine ⟨fun j ↦ aeval V (A j), fun j ↦ (represents_aeval xg hV (hAhom j)).degree_le, ?_⟩ - have hsum : (∑ j, aeval V (A j) * q j) = aeval V Fβ := by - rw [hFβ_def, hAsum, map_sum] - refine Finset.sum_congr rfl fun j _ ↦ ?_ - rw [map_mul, mul_comm] - rw [hsum] - have hrest : ∀ d ∈ (F - Fβ).support, (Finsupp.weight wt) d < β := by - intro d hd - have hne := MvPolynomial.mem_support_iff.mp hd - rw [MvPolynomial.coeff_sub, hFβ_def, coeff_weightedHomogeneousComponent] at hne - by_cases hdw : (Finsupp.weight wt) d = β - · rw [ite_eq_left hdw, sub_self] at hne - exact absurd rfl hne - · rw [ite_eq_right hdw, sub_zero] at hne - exact lt_of_le_of_ne (hwle d (MvPolynomial.mem_support_iff.mpr hne)) hdw - have hkey : translatedTruncLE z u - aeval V Fβ = - (translatedTruncLE z u - aeval V F) + aeval V (F - Fβ) := by - rw [map_sub] - ring - rw [hkey] - refine ((ν).map_add_le_max _ _).trans_lt (max_lt ?_ ?_) - · rw [hFbot] - exact WithBot.bot_lt_coe β - · exact degree_aeval_lt_of_forall_weight_lt xg hV hrest + rw [degree_translatedTruncLE_eq, ite_eq_left hzs, cantorBendixsonRank_eq, hzr, + NatOrdinal.of_val] + exact exists_degree_correction_of_componentsGE_mem xg hV hinj Q σQ hQ hτβ + (fun j ↦ P j β) (fun j ↦ hP j β hτβ hβμ) hνT hFw hFbot hFGE choose wA hwAb hwAcorr using hlocal obtain ⟨ctop, hctopb, hRdrop⟩ := exists_forall_degree_translatedTruncLE_sub_sum_mul_lt β q @@ -636,117 +802,10 @@ theorem exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal (∀ d ∈ F.support, (Finsupp.weight wt) d < α) ∧ ν (translatedTruncLE y R - aeval V F) = ⊥ ∧ MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q) := by - intro y hy - obtain ⟨F₀, hF₀w, hF₀bot, hF₀GE⟩ := hp y hy - have hpolc : ∀ j, ∃ A' : MvPolynomial ι K, - (∀ d ∈ A'.support, - (((Finsupp.weight wt) d : NatOrdinal) : WithBot NatOrdinal) ≤ - ν (translatedTruncLE y (ctop j))) ∧ - (∀ d ∈ A'.support, (Finsupp.weight wt) d < α) ∧ - ν (translatedTruncLE y (ctop j) - aeval V A') = ⊥ := fun j ↦ - exists_forall_weight_lt_and_degree_sub_aeval_eq_bot xg hV α hgen _ - ((hctopb j y hy).trans_lt (WithBot.coe_lt_coe.mpr - ((hPle j β hτβ hβμ).trans_lt hμα))) - choose A' hA'd hA'w hA'bot using hpolc - have hEbound : ∀ j, ν (translatedTruncLE y (ctop j * q j) - - translatedTruncLE y (ctop j) * q j) < (τ : WithBot NatOrdinal) := by - intro j - exact degree_translatedTruncLE_mul_sub_mul_lt_forall (ctop j) (q j) - (P j β) (σQ j) τ (by simpa only [translatedTruncLE_zero] using hctopb j 0 le_rfl) - (fun x hx ↦ hctopb j x hx.le) - (fun x hx ↦ (hW j).degree_translatedTruncLE_lt hx) - (hPsep' j β hτβ hβμ) y - have hpolE : ∀ j, ∃ FE : MvPolynomial ι K, - (∀ d ∈ FE.support, - (((Finsupp.weight wt) d : NatOrdinal) : WithBot NatOrdinal) ≤ - ν (translatedTruncLE y (ctop j * q j) - - translatedTruncLE y (ctop j) * q j)) ∧ - (∀ d ∈ FE.support, (Finsupp.weight wt) d < α) ∧ - ν ((translatedTruncLE y (ctop j * q j) - - translatedTruncLE y (ctop j) * q j) - aeval V FE) = ⊥ := fun j ↦ - exists_forall_weight_lt_and_degree_sub_aeval_eq_bot xg hV α hgen _ - ((hEbound j).trans (WithBot.coe_lt_coe.mpr hτα)) - choose FE hFEd hFEw hFEbot using hpolE - have hFEGE : ∀ j, MvPolynomial.componentsGE wt τ (FE j) = 0 := by - intro j - apply componentsGE_eq_zero_of_forall_lt - intro d hd - have h1 := (hFEd j d hd).trans_lt (hEbound j) - exact WithBot.coe_lt_coe.mp h1 - refine ⟨F₀ - ∑ j, A' j * Q j - ∑ j, FE j, ?_, ?_, ?_⟩ - · intro d hd - rcases Finset.mem_union.mp (MvPolynomial.support_sub ι _ _ hd) with hd | hd - · rcases Finset.mem_union.mp (MvPolynomial.support_sub ι _ _ hd) with hd | hd - · exact hF₀w d hd - · have hsum := MvPolynomial.support_sum hd - rw [Finset.mem_biUnion] at hsum - obtain ⟨j, -, hdj⟩ := hsum - have hmul := MvPolynomial.support_mul _ _ hdj - rw [Finset.mem_add] at hmul - obtain ⟨d₁, hd₁, d₂, hd₂, rfl⟩ := hmul - rw [map_add] - have h1 : (Finsupp.weight wt) d₁ ≤ P j β := by - have := (hA'd j d₁ hd₁).trans (hctopb j y hy) - exact WithBot.coe_le_coe.mp this - have h2 : (Finsupp.weight wt) d₂ = σQ j := - hQ j (MvPolynomial.mem_support_iff.mp hd₂) - calc - (Finsupp.weight wt) d₁ + (Finsupp.weight wt) d₂ ≤ P j β + σQ j := by - rw [h2] - exact add_le_add h1 le_rfl - _ = β := hP j β hτβ hβμ - _ < α := hβα - · have hsum := MvPolynomial.support_sum hd - rw [Finset.mem_biUnion] at hsum - obtain ⟨j, -, hdj⟩ := hsum - exact hFEw j d hdj - · have hTsub : translatedTruncLE y R = - translatedTruncLE y u - ∑ j, translatedTruncLE y (ctop j * q j) := by - rw [hR_def, map_sub, map_sum] - have hAQ : ∀ j, aeval V (A' j * Q j) = aeval V (A' j) * q j := - fun j ↦ map_mul _ _ _ - have hcalc : translatedTruncLE y R - aeval V (F₀ - ∑ j, A' j * Q j - ∑ j, FE j) = - (translatedTruncLE y u - aeval V F₀) - - ∑ j, (translatedTruncLE y (ctop j * q j) - - aeval V (A' j) * q j - aeval V (FE j)) := by - rw [hTsub, map_sub, map_sub, map_sum, map_sum, - Finset.sum_congr rfl fun j _ ↦ hAQ j] - conv_rhs => rw [Finset.sum_sub_distrib, Finset.sum_sub_distrib] - abel - rw [hcalc] - have hbot1 : ∀ j, ν (translatedTruncLE y (ctop j * q j) - - aeval V (A' j) * q j - aeval V (FE j)) = ⊥ := by - intro j - have hshape : translatedTruncLE y (ctop j * q j) - - aeval V (A' j) * q j - aeval V (FE j) = - (translatedTruncLE y (ctop j) - aeval V (A' j)) * q j + - ((translatedTruncLE y (ctop j * q j) - - translatedTruncLE y (ctop j) * q j) - aeval V (FE j)) := by - ring - rw [hshape] - have h1 : ν ((translatedTruncLE y (ctop j) - aeval V (A' j)) * q j) = ⊥ := by - have := (ν).map_mul_le_add (translatedTruncLE y (ctop j) - aeval V (A' j)) - (q j) - rw [hA'bot j, WithBot.bot_add] at this - exact le_bot_iff.mp this - have h2 := hFEbot j - refine le_bot_iff.mp (((ν).map_add_le_max _ _).trans ?_) - rw [h1, h2, max_self] - have hsumbot : ν (∑ j, (translatedTruncLE y (ctop j * q j) - - aeval V (A' j) * q j - aeval V (FE j))) = ⊥ := - le_bot_iff.mp ((ν).map_sum_le_of_forall_le _ _ ⊥ fun j _ ↦ (hbot1 j).le) - refine le_bot_iff.mp (((ν).map_sub_le_max _ _).trans ?_) - rw [hF₀bot, hsumbot, max_self] - · rw [componentsGE_sub, componentsGE_sub, componentsGE_sum, componentsGE_sum] - have hAQGE : ∀ j ∈ Finset.univ, MvPolynomial.componentsGE wt τ (A' j * Q j) ∈ - Ideal.span (Set.range Q) := by - intro j _ - exact componentsGE_mem_span wt hQ - (Ideal.mul_mem_left _ _ (Ideal.subset_span ⟨j, rfl⟩)) τ - have hFEGE' : (∑ j, MvPolynomial.componentsGE wt τ (FE j)) = 0 := by - rw [Finset.sum_congr rfl fun j _ ↦ hFEGE j, Finset.sum_const_zero] - rw [hFEGE', sub_zero] - exact Ideal.sub_mem _ hF₀GE (Ideal.sum_mem _ hAQGE) + exact local_ideal_presentation_sub_sum_mul xg hV α hgen Q σQ hQ τ β hτα hβα + (fun j ↦ P j β) (fun j ↦ hP j β hτβ hβμ) + (fun j ↦ (hPle j β hτβ hβμ).trans_lt hμα) hW + (fun j ↦ hPsep' j β hτβ hβμ) u ctop hctopb hp -- Step C: cover the residual support by disjoint convex pieces and recurse. obtain ⟨Xset, C, hXs, hCmem, hCopen, hCconv, hCdisj, hCord, hCcov, hCmax, hCrank, hXdisc⟩ := TopologicalSpace.Closeds.exists_disjoint_convex_cover_with_rank_lt_center @@ -1141,7 +1200,7 @@ theorem homogeneousClass_mem_span_of_locallyIdeal MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q)) : eu ∈ Ideal.span (Set.range fun j ↦ aeval xg (Q j)) := by classical - letI := Fintype.ofFinite κ' + let := Fintype.ofFinite κ' obtain ⟨c, hcb, -, hres⟩ := exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal U hUmono hUopen hUconv hUbase xg hV hVbounds α hgen hinj Q σQ hQ τ μ hτμ hμα P hP hPsep μ le_rfl u hu hp @@ -1727,7 +1786,7 @@ theorem homogeneousClass_mem_span_of_properly_locallyIdeal MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q)) : eu ∈ Ideal.span (Set.range fun j ↦ aeval xg (Q j)) := by classical - letI := Fintype.ofFinite κ' + let := Fintype.ofFinite κ' have hτlt : τ < μ := lt_of_le_of_lt (le_of_lt (lt_add_one τ)) hτμ obtain ⟨c, hcb, hres⟩ := exists_cofactors_degree_le_add_one_of_properly_locallyIdeal U hUmono hUopen hUconv hUbase xg hV hVbounds α hgen hinj Q σQ hQ τ μ hτlt hμα P hP hPsep diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Convolution.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Convolution.lean index f0ef3a57dc..313be33361 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Convolution.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Convolution.lean @@ -50,7 +50,7 @@ theorem coeff_truncLE_mul_truncLE (b d : HahnSeries G R) (a c z : G) : (Finset.antidiagonal b.isPWO_support d.isPWO_support z).filter (fun p ↦ p.1 ≤ a ∧ p.2 ≤ c) := by ext p - simp only [Finset.mem_antidiagonal, support_truncLE, mem_setOf_eq, Finset.mem_filter] + simp only [Finset.mem_antidiagonal, support_truncLE, Set.mem_ofPred_eq, Finset.mem_filter] tauto rw [he] apply Finset.sum_congr rfl @@ -74,7 +74,7 @@ def closedSupportAddFiber (b d : HahnSeries G R) (γ : G) : Finset (G × G) := theorem mem_closedSupportAddFiber (b d : HahnSeries G R) (γ : G) (p : G × G) : p ∈ b.closedSupportAddFiber d γ ↔ p.1 ∈ b.closedSupport ∧ p.2 ∈ d.closedSupport ∧ p.1 + p.2 = γ := by - simp only [closedSupportAddFiber, Set.Finite.mem_toFinset, mem_setOf_eq, mem_prod] + simp only [closedSupportAddFiber, Set.Finite.mem_toFinset, Set.mem_ofPred_eq, mem_prod] tauto end Zero diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationIdeal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationIdeal.lean index 3b1dbbe2e0..96f9bd51d7 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationIdeal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationIdeal.lean @@ -7,8 +7,7 @@ module public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Scalar -public import - LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint @@ -211,7 +210,7 @@ theorem mem_span_of_cantorBendixsonGradedDerivation_eq_coe (f : Filter.Germ (𝓝[<] (0 : G)) (ν).AssociatedGraded)) : x ∈ Ideal.span (Set.range q) := by classical - letI := Fintype.ofFinite ι + let := Fintype.ofFinite ι obtain ⟨xδ, hxδ⟩ := (DirectSum.mem_rangeLof_iff K (ν).Component (δ + 1) x).mp hx rw [DirectSum.lof_eq_of] at hxδ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationSet.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationSet.lean index 04ffa6627e..a93c0431ae 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationSet.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/DerivationSet.lean @@ -6,8 +6,7 @@ Authors: Dan Abramov module public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationIdeal -public import - LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolationOnSets +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolationOnSets import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Germ.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Germ.lean index 90d03c8446..c925ade4c2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Germ.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Germ.lean @@ -4,8 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ module -public import - LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValueMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValueMultiplicativity public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalOrder public import Mathlib.RingTheory.Valuation.Basic public import Mathlib.RingTheory.Ideal.Quotient.Basic diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Graded.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Graded.lean index ca96090627..d40bb9014f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Graded.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Graded.lean @@ -113,7 +113,7 @@ theorem cantorBendixson_associatedGraded_isDomain : have h1 : ν 1 ≠ ⊥ := by rw [cantorBendixsonDegreeValuation_apply, map_one, ne_eq, NatOrdinal.cantorDegree_eq_bot] exact one_ne_zero - letI : Nontrivial ν.AssociatedGraded := + let : Nontrivial ν.AssociatedGraded := ⟨⟨ν.initialForm 1, 0, ν.initialForm_ne_zero_of_ne_bot h1⟩⟩ exact NoZeroDivisors.to_isDomain ν.AssociatedGraded diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LeadingCoefficient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LeadingCoefficient.lean index 6bebf97580..cbc3af1bf9 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LeadingCoefficient.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LeadingCoefficient.lean @@ -7,8 +7,7 @@ module public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalEvaluation public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationPolynomial -public import - LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.ScalarLeadingCoefficientAtLimitOrdinal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.ScalarLeadingCoefficientAtLimitOrdinal import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LiftFamily.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LiftFamily.lean index 4f5cec208c..50fe3cd18d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LiftFamily.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LiftFamily.lean @@ -7,8 +7,7 @@ module public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Lifts public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LowerTruncationDegree -public import - LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CofactorInduction /-! diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Lifts.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Lifts.lean index 0171abfae7..57e46677a2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Lifts.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Lifts.lean @@ -209,7 +209,7 @@ theorem eq_zero_of_forall_weight_lt_of_degree_aeval_eq_bot intro d hd refine lt_of_le_of_ne (hβ d hd) fun he ↦ ?_ have := congrArg (fun p : MvPolynomial ι K => p.coeff d) hcomp0 - rw [coeff_weightedHomogeneousComponent, ite_eq_left he, MvPolynomial.coeff_zero] at this + rw [coeff_weightedHomogeneousComponent, ite_eq_left he, AddMonoidAlgebra.coeff_zero] at this exact MvPolynomial.mem_support_iff.mp hd this rcases eq_or_ne β 0 with rfl | hβ0 · rw [MvPolynomial.eq_zero_iff] @@ -247,7 +247,7 @@ theorem forall_weight_le_degree_aeval_of_injective intro e he refine lt_of_le_of_ne (hβ e he) fun heq ↦ ?_ have hcz := congrArg (fun p : MvPolynomial ι K => p.coeff e) hzero - rw [coeff_weightedHomogeneousComponent, ite_eq_left heq, MvPolynomial.coeff_zero] at hcz + rw [coeff_weightedHomogeneousComponent, ite_eq_left heq, AddMonoidAlgebra.coeff_zero] at hcz exact MvPolynomial.mem_support_iff.mp he hcz rcases eq_or_ne β 0 with rfl | hβ0 · exact absurd (hlt d hd) (not_lt_of_ge (zero_le (a := (Finsupp.weight wt) d))) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean index 99889ef22e..0f154c6506 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean @@ -71,6 +71,8 @@ structure LimitOrdinalRelationAtCutoff (α : NatOrdinal.{u}) where with `α₁ ≤ α_{≥β} ⊕ λ₀`. -/ lam₀ : NatOrdinal lam₀_lt : lam₀ < NatOrdinal.partLT β α + /-- An upper bound for the degrees of sufficiently late translated truncations of the + relation. -/ α₁ : NatOrdinal α₁_le : α₁ ≤ NatOrdinal.partGE β α + lam₀ α₁_le_α : α₁ ≤ α diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LinearMaximal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LinearMaximal.lean index f8fae8df8d..a93f23007f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LinearMaximal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LinearMaximal.lean @@ -206,7 +206,7 @@ theorem degreeOf_eq_one by_contra hnot have hle : τ ≤ Finsupp.weight wt d := not_lt.mp hnot have hcoeff := congrArg (fun p : MvPolynomial ι K ↦ p.coeff d) (hzero γ hγ hγ0) - rw [coeff_componentsGE, ite_eq_left hle, MvPolynomial.coeff_zero] at hcoeff + rw [coeff_componentsGE, ite_eq_left hle, AddMonoidAlgebra.coeff_zero] at hcoeff exact mem_support_iff.mp hd hcoeff simpa only [add_zero] using hdeglt · exact hhα diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LowerTruncationDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LowerTruncationDegree.lean index 233b23791b..8522b33ee1 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LowerTruncationDegree.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/LowerTruncationDegree.lean @@ -949,7 +949,7 @@ theorem componentsGE_mul_mem_span_of_polynomialSyzygy rw [MvPolynomial.pderiv_eq_zero_of_isWeightedHomogeneous wt hF j.1 h] exact MvPolynomial.isWeightedHomogeneous_zero _ _ _⟩ choose β hβ using hhom - haveI : Finite {j : ι // j ∈ t ∧ j ≠ v'} := + have : Finite {j : ι // j ∈ t ∧ j ≠ v'} := (t.finite_toSet.subset fun j (hj : j ∈ t ∧ j ≠ v') ↦ hj.1).to_subtype refine MvPolynomial.componentsGE_mem_span wt hβ ?_ τ refine Ideal.sum_mem _ fun i hi ↦ ?_ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Multiplication.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Multiplication.lean index ad1c69a593..2ffa194aea 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Multiplication.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Multiplication.lean @@ -60,7 +60,7 @@ theorem exists_cantorBendixsonRank_add_ge_of_mem_mul_derivative (b d : HahnSerie have hsub : (b * d).closedSupport ≤ s := b.closedSupport_mul_subset_add d have hm : z ∈ (s.cantorBendixson o : Set G) := Closeds.cantorBendixson_mono hsub o hz - simpa only [cantorBendixsonRank_eq, mem_setOf_eq] using + simpa only [cantorBendixsonRank_eq, Set.mem_ofPred_eq] using b.closedSupport.cantorBendixson_add_subset d.closedSupport b.closedSupport_isPWO d.closedSupport_isPWO o hm diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativeIndices.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativeIndices.lean index 9bb3f2aa83..2b68c27087 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativeIndices.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativeIndices.lean @@ -44,7 +44,7 @@ theorem componentsGE_mem_span_subtype {ι : Type w} [Finite ι] componentsGE wt τ P ∈ Ideal.span (Set.range fun j : {j // A j} ↦ q j.1) := by classical cases nonempty_fintype ι - letI := weightedGradedAlgebra K wt + let := weightedGradedAlgebra K wt have hdec : ∀ (R : MvPolynomial σ K) (e : NatOrdinal), (DirectSum.decompose (weightedHomogeneousSubmodule K wt) R e : MvPolynomial σ K) = weightedHomogeneousComponent wt e R := fun R e ↦ by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativesAtLimitOrdinal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativesAtLimitOrdinal.lean index 52a01246d4..8a489a5e2b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativesAtLimitOrdinal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/PartialDerivativesAtLimitOrdinal.lean @@ -9,6 +9,7 @@ public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.Algebra public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationExpansion public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CofactorInduction +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Finset.FilterCard import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint /-! @@ -55,6 +56,17 @@ variable (hσ : LiftFamily.HasLowerTruncationDegrees σ) namespace LimitOrdinalRelationAtCutoff +omit [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] in +private theorem lowDegreePartAlgebraicLE_of_not_proper {j : ι} (hj : j ∈ S.F.vars) + (htop : ¬ S.LowDegreePartEq j) (hL : ¬ S.HasProperLowDegreePartNotAlgebraicLE j) : + S.LowDegreePartAlgebraicLE j := by + by_contra hnd + rcases eq_or_ne (S.degLT j) 0 with ht | ht + · exact hnd ((S.lowDegreePartAlgebraicLE_iff j).mpr (by + rw [ht] + exact NatOrdinal.algebraicLE_zero _)) + · exact hL ((S.hasProperLowDegreePartNotAlgebraicLE_iff j).mpr ⟨hj, ht, htop, hnd⟩) + include Ubase hUmono hUopen hUconv hUbase S hx hinj hσ /-- A partial derivative satisfying the cutoff equation is a finite combination of the designated @@ -164,9 +176,8 @@ theorem exists_finset_pderiv_eq_sum_of_lowDegreePartAlgebraicLE {v' : ι} (hv' : · exact ⟨∅, fun _ ↦ 0, fun v hv ↦ absurd hv (Finset.notMem_empty v), fun v hv ↦ absurd hv (Finset.notMem_empty v), by rw [hΘ0, Finset.sum_empty]⟩ obtain ⟨h, hh⟩ := exists_add_wt_eq_of_mem_vars S.hom hv' - have hhα : h < α := by - rw [← hh] - exact lt_add_of_pos_right _ (pos_iff_ne_zero.mpr (hx.ne_zero v')) + have hhα : h < α := + (lt_add_of_pos_right _ (pos_iff_ne_zero.mpr (hx.ne_zero v'))).trans_eq hh have hΘhom : IsWeightedHomogeneous wt Θ h := by rw [hΘdef] exact S.pderiv_hom hh @@ -188,23 +199,9 @@ theorem exists_finset_pderiv_eq_sum_of_lowDegreePartAlgebraicLE {v' : ι} (hv' : by_cases hL : S.HasProperLowDegreePartNotAlgebraicLE j · exact Ideal.subset_span ⟨⟨j, (S.contributesToPartialDerivativeAt_iff v' j).mpr ⟨hj, Or.inr ⟨hL, hlt⟩⟩⟩, rfl⟩ - have hdj : S.LowDegreePartAlgebraicLE j := by - by_contra hnd - rcases eq_or_ne (S.degLT j) 0 with ht | ht - · exact hnd ((S.lowDegreePartAlgebraicLE_iff j).mpr (by - rw [ht] - exact NatOrdinal.algebraicLE_zero _)) - · exact hL ((S.hasProperLowDegreePartNotAlgebraicLE_iff j).mpr ⟨hj, ht, htop, hnd⟩) - have hcard : (S.F.vars.filter fun v ↦ wt j < wt v).card < n := by - rw [← hn] - refine Finset.card_lt_card - (Finset.ssubset_iff_subset_ne.mpr ⟨fun v hv ↦ ?_, fun heq ↦ ?_⟩) - · obtain ⟨hv1, hv2⟩ := Finset.mem_filter.mp hv - exact Finset.mem_filter.mpr ⟨hv1, hlt.trans hv2⟩ - · have hjmem : j ∈ S.F.vars.filter fun v ↦ wt v' < wt v := - Finset.mem_filter.mpr ⟨hj, hlt⟩ - rw [← heq, Finset.mem_filter] at hjmem - exact lt_irrefl _ hjmem.2 + have hdj := S.lowDegreePartAlgebraicLE_of_not_proper hj htop hL + have hcard : (S.F.vars.filter fun v ↦ wt j < wt v).card < n := + (ConwayRefinement.card_filter_above_lt wt S.F.vars hj hlt).trans_eq hn obtain ⟨s, C, hs, -, heq⟩ := ih _ hcard j hj rfl hdj rw [heq] refine Ideal.sum_mem _ fun v hv ↦ @@ -224,7 +221,7 @@ theorem exists_finset_pderiv_eq_sum_of_lowDegreePartAlgebraicLE {v' : ι} (hv' : refine Ideal.span_le.mpr ?_ hmem rintro _ ⟨j, rfl⟩ exact habove j.1 j.2.1 j.2.2 - haveI : Finite {v // S.ContributesToPartialDerivativeAt v' v} := + have : Finite {v // S.ContributesToPartialDerivativeAt v' v} := S.finite_setOf_contributesToPartialDerivativeAt v' have hcd : ∀ v : {v // S.ContributesToPartialDerivativeAt v' v}, ∃ c, c + wt v.1 = α := fun v ↦ exists_add_wt_eq_of_mem_vars S.hom @@ -236,7 +233,7 @@ theorem exists_finset_pderiv_eq_sum_of_lowDegreePartAlgebraicLE {v' : ι} (hv' : let A : {v // S.ContributesToPartialDerivativeAt v' v} → Prop := fun v ↦ NatOrdinal.AlgebraicLE (wt v') (wt v.1) have hAiff : ∀ v, A v ↔ NatOrdinal.AlgebraicLE (wt v') (wt v.1) := fun _ ↦ Iff.rfl - haveI : Finite {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} := + have : Finite {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} := Finite.of_injective (fun v ↦ v.1) Subtype.val_injective have hbA : ∀ v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, ∃ b, b + wt v' = wt v.1.1 := fun v ↦ by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Scalar.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Scalar.lean index c838edda8b..5e3b703f65 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Scalar.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Scalar.lean @@ -341,10 +341,10 @@ theorem cantorBendixson_minimalSystem_aeval_injective Function.Injective (MvPolynomial.aeval x : MvPolynomial ι K →ₐ[K] (ν).AssociatedGraded) := by classical - letI : Nontrivial ((ν).Component 0) := + let : Nontrivial ((ν).Component 0) := Function.Injective.nontrivial (cantorBendixsonLayerScalarHom_injective (G := G) (K := K)) - letI : Nontrivial (ν).AssociatedGraded := + let : Nontrivial (ν).AssociatedGraded := Function.Injective.nontrivial (DirectSum.of_injective 0) have hc := hx.isHomogeneousCoordinates cantorBendixson_gradeZeroScalars exact hc.aeval_injective cantorBendixson_isLoweringDerivation diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/ScalarLeadingCoefficientAtLimitOrdinal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/ScalarLeadingCoefficientAtLimitOrdinal.lean index 2f7af77037..650ad3fc8d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/ScalarLeadingCoefficientAtLimitOrdinal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/ScalarLeadingCoefficientAtLimitOrdinal.lean @@ -109,8 +109,9 @@ theorem false_of_aeval_eq_zero_of_leadingCoefficientDegree_eq_zero have hhne : hpoly ≠ 0 := by intro h have hc := congrArg (fun p : MvPolynomial ι K ↦ p.coeff (Finsupp.single B₀ 1)) h - rw [MvPolynomial.coeff_add, MvPolynomial.coeff_C_mul, MvPolynomial.coeff_X, - ite_eq_left rfl, mul_one, MvPolynomial.coeff_zero] at hc + rw [AddMonoidAlgebra.coeff_add, Finsupp.add_apply, MvPolynomial.coeff_C_mul, + MvPolynomial.coeff_X, + ite_eq_left rfl, mul_one, AddMonoidAlgebra.coeff_zero] at hc have hleft : (xCoeff B₀ D' F).coeff (Finsupp.single B₀ 1) = 0 := by by_contra hne exact (mem_supported.mp (hFkmem D')) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolationOnSets.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolationOnSets.lean index 545fb9e7bf..9df5040efc 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolationOnSets.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TranslatedTruncationInterpolationOnSets.lean @@ -5,8 +5,7 @@ Authors: Dan Abramov -/ module -public import - LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation /-! # Interpolation of translated truncations on a set diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Truncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Truncation.lean index 7befb115cf..e0d954067c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Truncation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/Truncation.lean @@ -73,7 +73,7 @@ theorem closedSupport_truncGT_locally_eq_of_lt (b : HahnSeries G R) {c x : G} apply isOpen_Ioi.closure_congr rw [support_truncGT] ext y - simp only [mem_inter_iff, mem_setOf_eq, mem_Ioi] + simp only [mem_inter_iff, Set.mem_ofPred_eq, mem_Ioi] tauto /-- A strict upper truncation preserves Cantor–Bendixson rank strictly above its cutoff. -/ @@ -256,7 +256,8 @@ theorem cantorBendixsonValue_reconstruction (b d : HahnSeries G R) (hb : b.suppo have hylt : y < 0 := lt_of_le_of_ne hy0 hyne have hval : (translate (-y) (truncLE y b)).cantorBendixsonValue = Ordinal.omega0 ^ a := by - rw [b.cantorBendixsonValue_translated_truncLE, ite_eq_left ((b.mem_closedSupport y).mpr hys), + rw [b.cantorBendixsonValue_translated_truncLE, ite_eq_left ((b.mem_closedSupport y).mpr + hys), hyr] have h := hlevel y hy hylt hval rw [d.cantorBendixsonValue_translated_truncLE] at h diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationExpansion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationExpansion.lean index 6585660e01..1c2ba6a026 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationExpansion.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationExpansion.lean @@ -148,7 +148,7 @@ omit [CharZero K] in /-- Splitting one variable from a monomial. -/ theorem monomial_add_single_one (d : ι →₀ ℕ) (i : ι) : monomial (d + Finsupp.single i 1) (1 : K) = monomial d 1 * X i := by - rw [X, monomial_mul, mul_one] + rw [X, MvPolynomial.monomial_mul_monomial, mul_one] omit [CharZero K] in /-- The first-order Leibniz sum after splitting one variable from a monomial. -/ @@ -619,7 +619,7 @@ theorem componentsGE_pol_translatedTruncLE_aeval_pderiv_mem rw [pderiv_eq_zero_of_isWeightedHomogeneous wt hF j.1 h] exact isWeightedHomogeneous_zero _ _ _⟩ choose c hc using hgen - haveI : Finite {j : ι // j ∈ F.vars ∧ wt v' < wt j} := + have : Finite {j : ι // j ∈ F.vars ∧ wt v' < wt j} := (F.vars.finite_toSet.subset fun j (hj : j ∈ F.vars ∧ wt v' < wt j) ↦ hj.1).to_subtype refine componentsGE_mem_span wt hc ?_ τ refine Ideal.sum_mem _ fun j hj ↦ ?_ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationPolynomial.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationPolynomial.lean index dc674ac5e3..21797efcc7 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationPolynomial.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/TruncationPolynomial.lean @@ -159,7 +159,7 @@ theorem pol_add {α : NatOrdinal.{u}} apply σ.pol_eq_of_degree_sub_aeval_eq_bot hx hinj huv (fun d hd ↦ by have hdne : (σ.pol hx α u + σ.pol hx α v).coeff d ≠ 0 := mem_support_iff.mp hd - rw [MvPolynomial.coeff_add] at hdne + rw [AddMonoidAlgebra.coeff_add, Finsupp.add_apply] at hdne by_cases hdu : d ∈ (σ.pol hx α u).support · exact σ.pol_weight_lt hx α u d hdu · have hdu0 := notMem_support_iff.mp hdu diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Assumptions.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Assumptions.lean index 81cca9e771..45b1958872 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Assumptions.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Assumptions.lean @@ -8,7 +8,7 @@ module public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ArchimedeanSplitting public import Mathlib.Algebra.Order.Module.Archimedean -public import Mathlib.Data.Real.Embedding +public import Mathlib.Basic.Real.Embedding /-! # LM24 assumptions at an Archimedean class @@ -111,7 +111,7 @@ theorem fracSubring_cardSuppLTTruncationIntegerPart_eq_top_of_assumptionA2AtFini (G := ↥(FiniteArchimedeanClass.ball K σ)) (R := R) (κ := κ) Z) = ⊤ := by rcases (assumptionA2AtFiniteClass_iff (K := K) κ Z σ).mp hA2 with hcof | ⟨hzero, hfrac⟩ · exact HahnSeries.fracSubring_cardSuppLTTruncationIntegerPart_eq_top_of_le_cof Z hcof - · letI : Subsingleton ↥(FiniteArchimedeanClass.ball K σ) := hzero + · let : Subsingleton ↥(FiniteArchimedeanClass.ball K σ) := hzero exact HahnSeries.fracSubring_cardSuppLTTruncationIntegerPart_eq_top_of_subsingleton Z hfrac end LM24 diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassPrimality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassPrimality.lean index af16f48694..e8cdeeea95 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassPrimality.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/FiniteClassPrimality.lean @@ -38,7 +38,7 @@ variable (Z : Subring R) /-- If order-zero elements and reduced elements with nonzero order are primal, every bounded integer-part element meeting only finitely many Archimedean classes is primal. -/ -theorem isPrimal_of_supportArchimedeanClasses_finite_of_reduced [CharZero R] +theorem isPrimal_of_supportArchimedeanClasses_finite_of_reduced (u : HahnEmbedding.ArchimedeanStrata K G) (hzero : ∀ y : cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z, ((CardSuppLTTruncationIntegerPart.toNonpositiveRingHom Z y : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/IntegerPartSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/IntegerPartSplitting.lean index 8d33031da2..5afc1c472a 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/IntegerPartSplitting.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/IntegerPartSplitting.lean @@ -29,6 +29,7 @@ variable [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] variable [Module K G] [IsOrderedModule K G] variable [Field R] +/-- The subring of the truncation integer part fixed by truncation at the chosen closed class. -/ def fixedIntegerPartSubring (c : FiniteArchimedeanClass G) (Z : Subring R) : Subring (truncationIntegerPart G Z) := (truncationSubring (K := K) (R := R) c).comap @@ -48,6 +49,7 @@ theorem coeff_zero_tauBall (c : FiniteArchimedeanClass G) (x : Nonpositive G R) rw [tauBall_coeff] exact coeff_tau_of_mem c x (Submodule.zero_mem _) +/-- The inner truncation integer part embedded in the Hahn-series ring on the class ball. -/ def innerIntegerPartSubring (c : FiniteArchimedeanClass G) (Z : Subring R) : Subring R⟦ball K c⟧ := (truncationIntegerPart (ball K c) Z).map @@ -89,6 +91,8 @@ theorem tauBall_mem_innerIntegerPartSubring rw [coeff_tau_of_mem c (x : Nonpositive G R) b.2] at hb exact Subtype.coe_le_coe.mp (support_subset (x : Nonpositive G R) hb) +/-- Truncate at a closed Archimedean class and split its exponents into stratum and ball +coordinates. -/ def splitRawRingHom (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) : Nonpositive G R →+* (R⟦ball K c⟧)⟦u.stratum c⟧ := @@ -103,6 +107,8 @@ theorem splitRawRingHom_apply TClosedRingHom_apply] rfl +/-- Split the truncation integer part into outer stratum series whose constant term lies in the +inner integer part. -/ def splitIntegerPartRingHom (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) (Z : Subring R) : truncationIntegerPart G Z →+* @@ -148,6 +154,8 @@ theorem coe_splitIntegerPartRingHom change splitRawRingHom u c (x : Nonpositive G R) = _ rw [splitRawRingHom_apply] +/-- The splitting homomorphism restricted to the integer-part subring fixed by closed-class +truncation. -/ def splitFixedIntegerPartRingHom (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) (Z : Subring R) : @@ -171,6 +179,8 @@ theorem coe_splitFixedIntegerPartRingHom change (splitRawRingHom u c (x : Nonpositive G R)) = _ rw [splitRawRingHom_apply] +/-- Reassemble an outer stratum series with an inner integer-part constant term into a fixed +integer-part element. -/ def unsplitIntegerPart (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) (Z : Subring R) @@ -256,6 +266,8 @@ theorem TClosed_of_fixed (c : FiniteArchimedeanClass G) (x : Nonpositive G R) closedBallOrderEmbedding_apply] -- Checking both inverses traverses the full nested subtype and Hahn-series equivalence stack. +/-- The ring equivalence between the fixed integer part and its stratum series over the inner +integer part. -/ def splitFixedIntegerPartRingEquiv (u : HahnEmbedding.ArchimedeanStrata K G) (c : FiniteArchimedeanClass G) (Z : Subring R) : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/LimitTailPrimality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/LimitTailPrimality.lean index ab75a727fb..0670a23e90 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/LimitTailPrimality.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/LimitTailPrimality.lean @@ -120,7 +120,7 @@ theorem isPrimal_of_finite_classes_and_limit_tail_conditions obtain ⟨c, hc⟩ := hT₀ne obtain ⟨d, _hd, hcd⟩ := hT₀gt c hc exact ⟨⟨c, ne_top_of_lt hcd⟩, hc⟩ - letI : Nonempty T := + let : Nonempty T := ⟨⟨Classical.choose hTne, Classical.choose_spec hTne⟩⟩ have hTgt : ∀ c ∈ T, ∃ d ∈ T, c < d := by intro c hc @@ -139,7 +139,7 @@ theorem isPrimal_of_finite_classes_and_limit_tail_conditions exact Or.inl hc _ ≤ #(x : HahnSeries G R).support := Cardinal.mk_image_le _ < κ := x.1.2 - letI : CompleteSpace (FiniteArchimedeanClass.TailQuotient T) := + let : CompleteSpace (FiniteArchimedeanClass.TailQuotient T) := Classical.choice (hcomplete T hTne hTgt hTcard) let P := FiniteArchimedeanClass.tailSubmodule ℚ T intro b c hdiv diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CardinalGermRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CardinalGermRefinement.lean index 46d5c9e205..67aee2c3a7 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CardinalGermRefinement.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CardinalGermRefinement.lean @@ -241,15 +241,15 @@ theorem exists_cardinal_germ_refinement have hSne : S.Nonempty := by obtain ⟨x, hxE, -⟩ := hEcoinitial |y| habsy exact ⟨x, Or.inr hxE⟩ - letI : NoMaxOrder (FiniteArchimedeanClass C₀) := + let : NoMaxOrder (FiniteArchimedeanClass C₀) := AddSubgroup.finiteArchimedeanClass_noMax_of_pos_coinitial C₀.toAddSubgroup hcoinitial - letI : NoMinOrder C₀ := ⟨fun x ↦ by + let : NoMinOrder C₀ := ⟨fun x ↦ by obtain ⟨z, hz, -⟩ := hcoinitial |y| habsy exact ⟨x - z, sub_lt_self x hz⟩⟩ - letI : NoMaxOrder C₀ := ⟨fun x ↦ by + let : NoMaxOrder C₀ := ⟨fun x ↦ by obtain ⟨z, hz, -⟩ := hcoinitial |y| habsy exact ⟨x + z, lt_add_of_pos_right x hz⟩⟩ - letI : OrderTopology C₀ := by + let : OrderTopology C₀ := by apply induced_orderTopology' (fun z : C₀ ↦ (z : C)) (fun {_ _} ↦ Iff.rfl) · intro x y hyx obtain ⟨z, hzpos, hzle⟩ := hcoinitial ((x : C) - y) (sub_pos.mpr hyx) @@ -261,12 +261,12 @@ theorem exists_cardinal_germ_refinement change (x : C) + (z : C) ≤ y rw [add_comm] exact le_sub_iff_add_le.mp hzle - letI : PosSMulMono ℚ C₀ := { + let : PosSMulMono ℚ C₀ := { smul_le_smul_of_nonneg_left := fun {q} hq {_ _} hxy ↦ smul_le_smul_of_nonneg_left (α := ℚ) (β := C) hxy hq } - letI : PosSMulStrictMono ℚ C₀ := + let : PosSMulStrictMono ℚ C₀ := PosSMulMono.toPosSMulStrictMono (α := ℚ) (β := C₀) - letI : DenselyOrdered C₀ := by + let : DenselyOrdered C₀ := by constructor intro x y hxy refine ⟨(2 : ℚ)⁻¹ • (x + y), ?_, ?_⟩ @@ -279,8 +279,8 @@ theorem exists_cardinal_germ_refinement smul_lt_smul_of_pos_left (by simpa [add_comm] using add_lt_add_left hxy y) (by norm_num) _ = y := by rw [smul_add, ← add_smul]; norm_num - letI : IsUniformAddGroup C₀ := C₀.toAddSubgroup.isUniformAddGroup - letI : Nontrivial C₀ := by + let : IsUniformAddGroup C₀ := C₀.toAddSubgroup.isUniformAddGroup + let : Nontrivial C₀ := by obtain ⟨z, hz, -⟩ := hcoinitial |y| habsy exact ⟨⟨0, z, ne_of_lt hz⟩⟩ have haRange : (a : HahnSeries C K).support ⊆ Set.range inc := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CompleteGermRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CompleteGermRefinement.lean index f6a577590a..d937d4e695 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CompleteGermRefinement.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/CompleteGermRefinement.lean @@ -66,7 +66,7 @@ theorem exists_germ_refinement_of_complete_exponent_group (d : HahnSeries G K).coeff q = (f * h : Nonpositive G K).1.coeff q) := by let J := (cantorBendixsonValuation (G := G) (R := K)).supp obtain ⟨ι, ⟨equiv⟩⟩ := exists_mvPolynomial_algEquiv_germ (G := G) (K := K) - letI : DecompositionMonoid (Nonpositive G K ⧸ J) := + let : DecompositionMonoid (Nonpositive G K ⧸ J) := MulEquiv.decompositionMonoid equiv.symm.toMulEquiv have hrefinement : HasFourFactorRefinement (Nonpositive G K ⧸ J) := hasFourFactorRefinement_of_decompositionMonoid diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/FiniteGermError.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/FiniteGermError.lean index 34300d154e..2d8c7cfb26 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/FiniteGermError.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/FiniteGermError.lean @@ -43,7 +43,7 @@ def fourFactorErrors (a b c d e f g h : Nonpositive G R) : Finset (Nonpositive G error in the valuation support ideal. -/ theorem fourFactorErrors_mem_supp [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] - [CompleteSpace G] [NoMinOrder G] [NoZeroDivisors R] [CharZero R] + [CompleteSpace G] [NoZeroDivisors R] [CharZero R] {a b c d e f g h : Nonpositive G R} (ha : Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp a = Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp (e * f)) @@ -185,9 +185,9 @@ theorem closedClassRestrict_mul (c : FiniteArchimedeanClass G) (a b : Nonpositiv simpa using add_le_add_left hp2le p.1 have hp1C : p.1 ∈ C := hC.out hg C.zero_mem ⟨hgp1, hp1le⟩ have hp2C : p.2 ∈ C := by simpa [← hp.2.2] using C.sub_mem hg hp1C - exact ⟨by simpa only [HahnSeries.support_filter, Set.mem_setOf_eq] using + exact ⟨by simpa only [HahnSeries.support_filter, Set.mem_ofPred_eq] using And.intro hp.1 hp1C, - by simpa only [HahnSeries.support_filter, Set.mem_setOf_eq] using + by simpa only [HahnSeries.support_filter, Set.mem_ofPred_eq] using And.intro hp.2.1 hp2C, hp.2.2⟩ · intro p hp rw [Finset.mem_antidiagonal, HahnSeries.support_filter, @@ -242,7 +242,7 @@ theorem exists_closedClassRestrict_eq_zero_of_finset quotient by series bounded strictly below zero. -/ theorem exists_closedClassRestrict_eq_zero_of_finset_mem_supp [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] - [CompleteSpace G] [NoMinOrder G] [NoMaxOrder (FiniteArchimedeanClass G)] + [CompleteSpace G] [NoMaxOrder (FiniteArchimedeanClass G)] [NoZeroDivisors R] [CharZero R] {s : Finset (Nonpositive G R)} (hs : ∀ b ∈ s, b ∈ (cantorBendixsonValuation (G := G) (R := R)).supp) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/LimitTailRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/LimitTailRefinement.lean index 18253a8e80..4fbd03743f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/LimitTailRefinement.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/LimitTailRefinement.lean @@ -96,10 +96,10 @@ theorem exists_closed_class_refinement_of_complete_tail_quotient rw [← FiniteArchimedeanClass.tailSubmodule_toAddSubgroup ℚ T] simpa using hmem exact FiniteArchimedeanClass.positiveRepresentative_not_mem_tailKernel hT c htail - letI : Nontrivial C := by + let : Nontrivial C := by let c : T := Classical.arbitrary T exact ⟨⟨0, scale c, (hscalePos c).ne⟩⟩ - letI : NoMaxOrder (FiniteArchimedeanClass C) := + let : NoMaxOrder (FiniteArchimedeanClass C) := FiniteArchimedeanClass.quotient_noMax_of_eq_tailKernel T (FiniteArchimedeanClass.tailSubmodule ℚ T).toAddSubgroup (FiniteArchimedeanClass.tailSubmodule_toAddSubgroup ℚ T) hT diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassFactorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassFactorization.lean index 50089a9a70..53efa29e08 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassFactorization.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassFactorization.lean @@ -87,7 +87,7 @@ theorem exists_factor_with_smaller_support_class_orderType let P := FiniteArchimedeanClass.tailSubmodule ℚ T let C : AddSubgroup G := (FiniteArchimedeanClass.closedBallAddSubgroup q).comap P.mkQ.toAddMonoidHom - letI : C.IsConvex := by + let : C.IsConvex := by constructor exact (FiniteArchimedeanClass.closedBall_ordConnected q).preimage_mono (fun _ _ h ↦ ConvexQuotient.mk_le_mk h) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassRefinement.lean index e4bfae3692..18d3c5bba9 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassRefinement.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassRefinement.lean @@ -64,7 +64,7 @@ Archimedean class in a specified family. -/ private def HasNonpositiveClosedClassRefinement {G : Type u} {K : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] - [Field K] {κ : Cardinal} [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + [Field K] {κ : Cardinal} [Fact (ℵ₀ < κ)] (S : Subring K) (U : Set (FiniteArchimedeanClass G)) (a b c d : HahnSeries.cardSuppLTTruncationIntegerPart (G := G) (R := K) (κ := κ) S) : Prop := @@ -191,7 +191,7 @@ to normalize refinements over a specified family of classes. -/ private def HasClosedClassNormalization {G : Type u} {K : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] - [Field K] {κ : Cardinal} [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + [Field K] {κ : Cardinal} [Fact (ℵ₀ < κ)] (S : Subring K) (U : Set (FiniteArchimedeanClass G)) (a b c d : HahnSeries.cardSuppLTTruncationIntegerPart (G := G) (R := K) (κ := κ) S) : Prop := @@ -234,7 +234,7 @@ private theorem has_closed_class_normalization_at_support_classes {G : Type u} {R : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Module ℚ G] [PosSMulMono ℚ G] - [Field R] [CharZero R] + [Field R] {κ : Cardinal} [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] (Z : Subring R) (hfinite : ∀ y : HahnSeries.cardSuppLTTruncationIntegerPart diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/TruncationIntegerPartFractionField.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/TruncationIntegerPartFractionField.lean index a80007bc70..e82aa955d2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/TruncationIntegerPartFractionField.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/TruncationIntegerPartFractionField.lean @@ -209,7 +209,7 @@ theorem exists_irreducible_cantorBendixson_germ_with_constantCoeff_zero : obtain ⟨ι, ⟨equiv⟩⟩ := exists_mvPolynomial_algEquiv_germ (G := G) (K := K) have hι : Nonempty ι := by by_contra h - letI : IsEmpty ι := not_nonempty_iff.mp h + let : IsEmpty ι := not_nonempty_iff.mp h let q : MvPolynomial ι K := equiv.symm (Ideal.Quotient.mk J (cofinalGermNonpositive (G := G) (K := K))) have hq0 : q ≠ 0 := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ClassTruncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ClassTruncation.lean index 63d5946bcf..3489829c93 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ClassTruncation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ClassTruncation.lean @@ -23,9 +23,11 @@ namespace Tests open HahnSeries FiniteArchimedeanClass +/-- The finite Archimedean class of the nonzero rational exponent `-1`. -/ def rationalClass : FiniteArchimedeanClass ℚ := FiniteArchimedeanClass.mk (-1 : ℚ) (by norm_num) +/-- The monomial `5t⁻¹` with integer coefficients, at the boundary of the rational class ball. -/ def rationalBoundarySeries : Nonpositive ℚ ℤ := Nonpositive.single (-1) 5 (by norm_num) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ReducedCharacterization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ReducedCharacterization.lean index 3f7cd597fa..dc1b7a731d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ReducedCharacterization.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/ReducedCharacterization.lean @@ -23,9 +23,11 @@ namespace Tests open HahnSeries +/-- The rational monomial `5t⁻¹`, whose strict class truncation is zero. -/ def reducedZeroTauSeries : Nonpositive ℚ ℚ := Nonpositive.single (-1) 5 (by norm_num) +/-- The rational series `1 + 5t⁻¹`, whose strict class truncation is one. -/ def reducedOneTauSeries : Nonpositive ℚ ℚ := 1 + reducedZeroTauSeries diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Reduction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Reduction.lean index 10baa445b0..83abaa36bd 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Reduction.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests/Reduction.lean @@ -23,6 +23,8 @@ namespace Tests open HahnSeries FiniteArchimedeanClass +/-- The rational-coefficient monomial `5t⁻¹` used to compare class projection and closed-class +truncation. -/ def rationalBoundaryFieldSeries : Nonpositive ℚ ℚ := Nonpositive.single (-1) 5 (by norm_num) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IterateOrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IterateOrderType.lean index 24920b412b..407f47018f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IterateOrderType.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IterateOrderType.lean @@ -48,8 +48,8 @@ theorem supportOrderType_outer_le_iterateRingEquiv (x : R⟦Γ'⟧⟦Γ⟧) : change toLex (a.1, inner a) < toLex (b.1, inner b) rw [Prod.Lex.toLex_lt_toLex] exact Or.inl hab - letI : WellFoundedLT ↑x.support := x.isPWO_support.isWF - letI : WellFoundedLT ↑(iterateRingEquiv x).support := + let : WellFoundedLT ↑x.support := x.isPWO_support.isWF + let : WellFoundedLT ↑(iterateRingEquiv x).support := (iterateRingEquiv x).isPWO_support.isWF rw [supportOrderType_eq_setOrderType, supportOrderType_eq_setOrderType] calc diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Multiplicativity.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Multiplicativity.lean index bf1181c308..cc276fa6fd 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Multiplicativity.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Multiplicativity.lean @@ -152,7 +152,7 @@ private theorem truncLE_eq_zero_of_support_subset_Ioi truncLE a x = 0 := by rw [← support_eq_empty_iff, support_truncLE] ext i - simp only [Set.mem_setOf_eq, Set.mem_empty_iff_false, iff_false, not_and] + simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false, iff_false, not_and] exact fun hi hia ↦ (not_lt_of_ge hia) (h hi) private theorem support_mul_subset_Ici_add diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NonpositiveDomainEquiv.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NonpositiveDomainEquiv.lean index 666afd781e..70886845c4 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NonpositiveDomainEquiv.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NonpositiveDomainEquiv.lean @@ -80,12 +80,12 @@ theorem lift_supportOrderType_embDomainRingEquiv (e : G ≃+o H) Ordinal.lift.{u, v} (HahnSeries.supportOrderType (embDomainRingEquiv e x : K⟦H⟧)) = Ordinal.lift.{v, u} (HahnSeries.supportOrderType (x : K⟦G⟧)) := by - letI : WellFoundedLT (x : K⟦G⟧).support := (x : K⟦G⟧).isWF_support - letI : WellFoundedLT (embDomainRingEquiv e x : K⟦H⟧).support := + let : WellFoundedLT (x : K⟦G⟧).support := (x : K⟦G⟧).isWF_support + let : WellFoundedLT (embDomainRingEquiv e x : K⟦H⟧).support := (embDomainRingEquiv e x : K⟦H⟧).isWF_support let supportEquiv : (embDomainRingEquiv e x : K⟦H⟧).support ≃o (x : K⟦G⟧).support := - (OrderIso.setCongr _ (e '' (x : K⟦G⟧).support) (by + (Set.orderIsoOfEq _ (e '' (x : K⟦G⟧).support) (by rw [coe_embDomainRingEquiv, HahnSeries.support_embDomainRingEquiv])).trans (StrictMonoOn.orderIso e (x : K⟦G⟧).support (e.strictMono.strictMonoOn (x : K⟦G⟧).support)).symm diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NormalForm.lean index 7e15308615..ab294a5e74 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NormalForm.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/NormalForm.lean @@ -115,7 +115,9 @@ namespace NormalForm coefficient is a clause of `HahnSeries.IsNormalForm`, not data stored in this structure. -/ @[ext] structure Term (R : Type v) [Ring R] where + /-- The nonpositive Hahn-series coefficient of the normal-form term. -/ coefficient : Nonpositive ℝ R + /-- The real exponent translating the coefficient to form this term. -/ exponent : ℝ namespace Term diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrderType.lean index cb8e9bc348..86bf39ec53 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrderType.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrderType.lean @@ -89,7 +89,7 @@ theorem supportOrderType_single {a : G} {r : R} (hr : r ≠ 0) : { toEquiv := Equiv.Set.singleton a map_rel_iff' := by simp } let e : (HahnSeries.single a r).support ≃o PUnit := - (OrderIso.setCongr _ {a} hsupport).trans singletonOrderIso + (Set.orderIsoOfEq _ {a} hsupport).trans singletonOrderIso rw [supportOrderType_eq_typeLT e] exact Ordinal.type_eq_one_of_unique _ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CantorBendixsonRepresentatives.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CantorBendixsonRepresentatives.lean index 9e9d36d4bb..280cfab2eb 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CantorBendixsonRepresentatives.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/CantorBendixsonRepresentatives.lean @@ -7,8 +7,7 @@ module public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LiftFamily public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonGrading -public import - LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivAtInjective.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivAtInjective.lean index 1308dc9abc..8c4c9e1c79 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivAtInjective.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/DerivAtInjective.lean @@ -116,7 +116,7 @@ theorem exists_ordinalValue_translatedTruncation_eq_wpow_of_ordinalValue_eq_wpow rw [Set.IsPWO.orderType_proof_irrel hBpwo ((u : K⟦ℝ⟧).isPWO_support.mono (negativeSupportTail_subset_support u η)), htailType η hη₀η hη, hu, NatOrdinal.val_wpow, NatOrdinal.val_add_one, hρdef, - ← Order.succ_eq_add_one, opow_succ] + Ordinal.opow_add_one] -- The point `y` of index `ρ`; the first block is `S = B ∩ (-∞, y)`. have hρlt : ρ < hBpwo.orderType := by rw [hBtype] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/IdealFromTruncations.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/IdealFromTruncations.lean index 9459ab19e2..b77770777b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/IdealFromTruncations.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/IdealFromTruncations.lean @@ -152,7 +152,7 @@ theorem IsPrincipal.of_principalComponentMk_mem_span_of_forall_componentsGE_mem have hTsupp : T.support = negativeSupportTail u (γ k) := by ext y rw [hTdef, support_truncGT, support_truncLT, mem_negativeSupportTail_iff] - simp only [Set.mem_setOf_eq] + simp only [Set.mem_ofPred_eq] tauto have hTot : T.supportOrderType = (ω^ h).val := by rw [supportOrderType_eq_setOrderType, ← hu] @@ -188,7 +188,7 @@ theorem IsPrincipal.of_principalComponentMk_mem_span_of_forall_componentsGE_mem ext y rw [support_truncGT, support_truncLE, support_truncLE, hTdef, support_truncGT, support_truncLT] - simp only [Set.mem_setOf_eq] + simp only [Set.mem_ofPred_eq] constructor · rintro ⟨⟨h1, h2⟩, h3⟩ exact ⟨⟨⟨h1, by linarith [hneg (k + 1)]⟩, h3⟩, h2⟩ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LeadingCoefficient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LeadingCoefficient.lean index 85377fcfcd..2aec98f787 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LeadingCoefficient.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LeadingCoefficient.lean @@ -532,7 +532,8 @@ theorem exists_forall_xCoeff_pol_translatedTruncation_pow_mul (hg : wt B₀ < α Finset.sum_eq_zero fun β hβ ↦ hfβ β hβ k (by omega)] obtain ⟨k', rfl⟩ : ∃ k', k = k' + 1 := ⟨k - 1, by omega⟩ rw [xCoeff_succ_X_mul, (h₁ γ hγ₁ hγ0).1 k' (by omega), ← mul_assoc, - xCoeff_mul_X_pow B₀ (Subalgebra.mul_mem _ (h₃ γ hγ₃ hγ0) hu.pol_mem), ite_eq_right (by omega), + xCoeff_mul_X_pow B₀ (Subalgebra.mul_mem _ (h₃ γ hγ₃ hγ0) hu.pol_mem), ite_eq_right (by + omega), add_zero, add_zero] · -- the coefficient of `X_{B₀}^(e+1)` rw [hconv, map_add, map_add, hf0, hfγ, map_sum, diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean index 097415550a..5b1b6bdfde 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LimitOrdinalRelationAtCutoff.lean @@ -82,9 +82,13 @@ structure LimitOrdinalRelationAtCutoff (α : NatOrdinal) where `ω^{α₁}` with `α₁ ≤ α_{≥β} ⊕ λ₀`. -/ lam₀ : NatOrdinal lam₀_lt : lam₀ < NatOrdinal.partLT β α + /-- The exponent bounding the ordinal values of sufficiently late translated truncations of + the relation. -/ α₁ : NatOrdinal α₁_le : α₁ ≤ NatOrdinal.partGE β α + lam₀ α₁_le_α : α₁ ≤ α + /-- A positive radius on which translated truncations satisfy the designated ordinal-value + bound. -/ ε₁ : ℝ ε₁_pos : 0 < ε₁ truncation_lt : ∀ γ : ℝ, -ε₁ < γ → γ < 0 → diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LowDegreeParts.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LowDegreeParts.lean index e1daf63c2a..9985e16024 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LowDegreeParts.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LowDegreeParts.lean @@ -8,8 +8,7 @@ module import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.LimitOrdinalContradiction -public import - LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LimitOrdinalRelationAtCutoff +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LimitOrdinalRelationAtCutoff /-! # Low-degree parts and algebraic order diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LoweringDerivation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LoweringDerivation.lean index e7fde81e86..3de8b68a55 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LoweringDerivation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/LoweringDerivation.lean @@ -280,8 +280,8 @@ change `E ⊗[K] P̂` is a graded domain over `E` with a lowering derivation, it `E ⊗[K] P̂/I`, and the quotient `A/I` of every such ring is a domain. -/ theorem isDomain_tensor_principalFibre (E : Type*) [Field E] [Algebra K E] : IsDomain (E ⊗[K] PrincipalFibre K) := by - haveI := charZero_of_algebra K E - haveI : IsDomain (E ⊗[K] PrincipalSubring K) := isDomain_tensor_principalSubring K E + have := charZero_of_algebra K E + have : IsDomain (E ⊗[K] PrincipalSubring K) := isDomain_tensor_principalSubring K E exact isDomain_tensor_fibre E (principalGrading K) (principalGrading_gradeZeroScalars K) (principalSubringDerivation_isLoweringDerivation K) @@ -291,7 +291,7 @@ theorem principalFibre_isGeometricallyIntegral : Algebra.IsGeometricallyIntegral K (PrincipalFibre K) := by rw [Algebra.isGeometricallyIntegral_iff] intro E _ _ - haveI := isDomain_tensor_principalFibre K E + have := isDomain_tensor_principalFibre K E exact (Algebra.TensorProduct.comm K _ _).toMulEquiv.isDomain _ variable (K) in diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PartialDerivativeIndices.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PartialDerivativeIndices.lean index 7a3b58d675..cc82b99c95 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PartialDerivativeIndices.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/PartialDerivativeIndices.lean @@ -55,7 +55,7 @@ theorem componentsGE_mem_span_subtype {ι : Type w} [Finite ι] {q : ι → MvPo componentsGE wt τ P ∈ Ideal.span (Set.range fun j : {j // A j} ↦ q j.1) := by classical cases nonempty_fintype ι - letI := weightedGradedAlgebra K wt + let := weightedGradedAlgebra K wt have hdec : ∀ (R : MvPolynomial σ K) (e : NatOrdinal), (DirectSum.decompose (weightedHomogeneousSubmodule K wt) R e : MvPolynomial σ K) = weightedHomogeneousComponent wt e R := fun R e ↦ by @@ -75,7 +75,8 @@ theorem componentsGE_mem_span_subtype {ι : Type w} [Finite ι] {q : ι → MvPo have hcomp : weightedHomogeneousComponent wt (Finsupp.weight wt d) (weightedHomogeneousComponent wt (Finsupp.weight wt d) P) = weightedHomogeneousComponent wt (Finsupp.weight wt d) P := by - rw [weightedHomogeneousComponent_of_mem (weightedHomogeneousComponent_mem wt P _), ite_eq_left rfl] + rw [weightedHomogeneousComponent_of_mem (weightedHomogeneousComponent_mem wt P _), + ite_eq_left rfl] rw [← hcomp, hsum] rw [← Finset.sum_filter_add_sum_filter_not Finset.univ A] have hzero : ∑ j ∈ Finset.univ.filter (fun j ↦ ¬ A j), q j * u j = 0 := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Partials.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Partials.lean index 529748e306..7df53610a7 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Partials.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Partials.lean @@ -7,10 +7,10 @@ module import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartVars -public import - LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PartialDerivativeIndices +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PartialDerivativeIndices public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.IdealFromTruncations +import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Finset.FilterCard import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint /-! @@ -234,15 +234,8 @@ theorem exists_finset_pderiv_eq_sum_of_lowDegreePartAlgebraicLE {v' : ι} (hv' : rw [ht] exact NatOrdinal.algebraicLE_zero _)) · exact hL ((S.hasProperLowDegreePartNotAlgebraicLE_iff j).mpr ⟨hj, ht, htop, hnd⟩) - have hcard : (S.F.vars.filter fun v ↦ wt j < wt v).card < n := by - rw [← hn] - refine Finset.card_lt_card - (Finset.ssubset_iff_subset_ne.mpr ⟨fun v hv ↦ ?_, fun heq ↦ ?_⟩) - · obtain ⟨hv1, hv2⟩ := Finset.mem_filter.mp hv - exact Finset.mem_filter.mpr ⟨hv1, hlt.trans hv2⟩ - · have : j ∈ S.F.vars.filter fun v ↦ wt v' < wt v := Finset.mem_filter.mpr ⟨hj, hlt⟩ - rw [← heq, Finset.mem_filter] at this - exact lt_irrefl _ this.2 + have hcard : (S.F.vars.filter fun v ↦ wt j < wt v).card < n := + (ConwayRefinement.card_filter_above_lt wt S.F.vars hj hlt).trans_eq hn obtain ⟨s, U, hs, -, heq⟩ := ih _ hcard j hj rfl hdj rw [heq] refine Ideal.sum_mem _ fun v hv ↦ @@ -258,7 +251,7 @@ theorem exists_finset_pderiv_eq_sum_of_lowDegreePartAlgebraicLE {v' : ι} (hv' : rintro _ ⟨j, rfl⟩ exact habove j.1 j.2.1 j.2.2 -- the generator degrees `σ_v = α ⊖ deg v` and cofactor degrees `b_v = deg v ⊖ deg v'` - haveI : Finite {v // S.ContributesToPartialDerivativeAt v' v} := + have : Finite {v // S.ContributesToPartialDerivativeAt v' v} := S.finite_setOf_contributesToPartialDerivativeAt v' have hcd : ∀ v : {v // S.ContributesToPartialDerivativeAt v' v}, ∃ c, c + wt v.1 = α := fun v ↦ exists_add_wt_eq_of_mem_vars S.hom v.2.1 @@ -270,7 +263,7 @@ theorem exists_finset_pderiv_eq_sum_of_lowDegreePartAlgebraicLE {v' : ι} (hv' : obtain ⟨A, hAdef⟩ : ∃ A : {v // S.ContributesToPartialDerivativeAt v' v} → Prop, A = fun v ↦ NatOrdinal.AlgebraicLE (wt v') (wt v.1) := ⟨_, rfl⟩ have hAiff : ∀ v, A v ↔ NatOrdinal.AlgebraicLE (wt v') (wt v.1) := fun v ↦ by rw [hAdef] - haveI : Finite {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} := + have : Finite {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} := Finite.of_injective (fun v ↦ v.1) Subtype.val_injective have hbA : ∀ v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, ∃ b, b + wt v' = wt v.1.1 := fun v ↦ by @@ -381,34 +374,20 @@ theorem exists_finset_pderiv_eq_sum_of_lowDegreePartAlgebraicLE {v' : ι} (hv' : rw [← hb v]; exact lt_add_of_pos_right _ (pos_iff_ne_zero.mpr (hx.ne_zero v')) exact h1.trans_le (S.max _ v.1.2.1) exact pderiv_eq_zero_of_degreeLT_le ((hUhom v).degreeLT hbg) le_rfl - -- re-index the sum by the variables themselves - have hinjv : Function.Injective - (fun v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} ↦ v.1.1) := - fun v w hvw ↦ Subtype.ext (Subtype.ext hvw) - refine ⟨Finset.univ.image - (fun v : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} ↦ v.1.1), - fun i ↦ if hi : ∃ v : - {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, v.1.1 = i then - U (Classical.choose hi) - else 0, ?_, ?_, ?_⟩ + -- Extend the cofactor family by zero, then reindex along the inclusion of contributing variables. + let index : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v} → ι := + fun v ↦ v.1.1 + have hinjv : Function.Injective index := fun v w hvw ↦ Subtype.ext (Subtype.ext hvw) + refine ⟨Finset.univ.image index, Function.extend index U (fun _ ↦ 0), ?_, ?_, ?_⟩ · intro i hi obtain ⟨v, -, rfl⟩ := Finset.mem_image.mp hi exact v.1.2 · intro i hi obtain ⟨v, -, rfl⟩ := Finset.mem_image.mp hi - beta_reduce - rw [dite_eq_left (⟨v, rfl⟩ : - ∃ w : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, w.1.1 = v.1.1)] - exact hUB₀ _ + rw [hinjv.extend_apply] + exact hUB₀ v · rw [hΘeq, Finset.sum_image fun v _ w _ h ↦ hinjv h] - refine Finset.sum_congr rfl fun v _ ↦ ?_ - beta_reduce - rw [dite_eq_left (⟨v, rfl⟩ : - ∃ w : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, w.1.1 = v.1.1)] - congr 2 - exact (hinjv (Classical.choose_spec - (⟨v, rfl⟩ : ∃ w : {v : {v // S.ContributesToPartialDerivativeAt v' v} // A v}, - w.1.1 = v.1.1))).symm + exact Finset.sum_congr rfl fun v _ ↦ by rw [hinjv.extend_apply] end Lifts.LimitOrdinalRelationAtCutoff diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Pieces.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Pieces.lean index fc5c2e8a3f..2e207d8729 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Pieces.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Pieces.lean @@ -112,7 +112,10 @@ theorem translatedTruncation_window_sub_mem (a b : ℝ) (E : K⟦ℝ⟧) {ξ : rw [not_le] at hlt apply hδ by_cases h0 : δ ≤ 0 - · rw [ite_eq_left h0, ite_eq_left h0, ite_eq_left ⟨by linarith, by linarith⟩, show ξ + δ + b = b + ξ + δ by ring, + · rw [ite_eq_left h0, ite_eq_left h0, ite_eq_left ⟨by + linarith, by + linarith⟩, show ξ + δ + b = b + ξ + δ by + ring, sub_self] · rw [ite_eq_right h0, ite_eq_right h0, sub_zero] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductCondition.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductCondition.lean index 6e115f4bf5..ccee46b1dc 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductCondition.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductCondition.lean @@ -7,8 +7,7 @@ module import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint -public import - LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan /-! diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductValues.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductValues.lean index b9af0eb55d..235f46b1d9 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductValues.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/ProductValues.lean @@ -5,8 +5,7 @@ Authors: Dan Abramov -/ module -public import - LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives /-! # Ordinal values of the translated truncations of a term `u · q(b_𝓑)` diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/RealPartials.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/RealPartials.lean index 7338baf274..a791a155d8 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/RealPartials.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/RealPartials.lean @@ -6,8 +6,7 @@ Authors: Dan Abramov module public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.AlgebraicIndependence -public import - LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRepresentatives +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRepresentatives public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Partials import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SumAlongCutoffs.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SumAlongCutoffs.lean index f2de1886b7..ad5f924c1b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SumAlongCutoffs.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SumAlongCutoffs.lean @@ -365,7 +365,8 @@ theorem exists_sumAlongCutoffs (δ : NatOrdinal) (γ : ℕ → ℝ) (hγ : Stric toGerm (translatedTruncation ((w k : Series K) : K⟦ℝ⟧) (ξ - γ k)) := by rw [toGerm_eq_toGerm_iff_exists_coeff_eq] refine ⟨γ k + c k - ξ, by linarith, fun η hη1 hη2 ↦ ?_⟩ - rw [coeff_translatedTruncation, coeff_translatedTruncation, ite_eq_left hη2, ite_eq_left hη2, hscoe, + rw [coeff_translatedTruncation, coeff_translatedTruncation, ite_eq_left hη2, ite_eq_left + hη2, hscoe, coeff_sumAlongCutoffs_of_mem w c γ hγ hdisj (k := k) ⟨by linarith, by linarith⟩, coeff_placedTerm, ite_eq_left (by linarith)] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SupportLoweringPieces.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SupportLoweringPieces.lean index 3d60023864..83875986bb 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SupportLoweringPieces.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/SupportLoweringPieces.lean @@ -99,6 +99,129 @@ theorem pol_sub {u u' : Series K} (hu : ordinalValue u < ω^ α) (hu' : ordinalV include hσ +/-- Correct one exceptional cutoff by combining cofactors on intervals approaching it. -/ +private theorem IsPrincipal.exists_cofactors_at_cutoff_of_pieces {ι' : Type*} + [Fintype ι'] {q : ι' → MvPolynomial ι K} {c : ι' → NatOrdinal} + (hq : ∀ j, IsWeightedHomogeneous wt (q j) (c j)) {τ ρ : NatOrdinal} (hτρ : τ + 1 < ρ) + (hρα : ρ < α) {e : ι' → NatOrdinal} + (hsep : ∀ j, ∀ θ, θ < c j → e j + θ < τ) + {D : Series K} (hD : (D : K⟦ℝ⟧).supportOrderType < (ω^ (ρ + 1)).val) + (htrunc : ∀ ξ : ℝ, ξ ≤ 0 → + componentsGE wt τ (σ.pol hx α (translatedTruncation (D : K⟦ℝ⟧) ξ)) ∈ + Ideal.span (Set.range q)) + (hIH : ∀ E : Series K, (E : K⟦ℝ⟧).supportOrderType < (ω^ ρ).val → + (∀ ξ : ℝ, ξ ≤ 0 → + componentsGE wt τ (σ.pol hx α (translatedTruncation (E : K⟦ℝ⟧) ξ)) ∈ + Ideal.span (Set.range q)) → + ∃ w : ι' → Series K, (∀ j, ((w j : Series K) : K⟦ℝ⟧).supportOrderType < (ω^ (e j)).val) ∧ + ∀ ξ : ℝ, ξ ≤ 0 → ordinalValue (translatedTruncation + ((E - ∑ j, w j * aeval σ.lift (q j) : Series K) : K⟦ℝ⟧) ξ) < ω^ (τ + 1)) + {ξ ε : ℝ} (hξ0 : ξ ≤ 0) (hε : 0 < ε) + (hnolevel : ∀ θ, ξ - ε < θ → θ < ξ → + ordinalValue (translatedTruncation (D : K⟦ℝ⟧) θ) < ω^ ρ) : + ∃ C : ι' → Series K, + (∀ j, ((C j : Series K) : K⟦ℝ⟧).supportOrderType ≤ (ω^ (e j)).val) ∧ + (∀ j, ∀ ζ : ℝ, ζ < 0 → + ordinalValue (translatedTruncation (C j : K⟦ℝ⟧) ζ) < ω^ (e j)) ∧ + ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ξ - + ∑ j, C j * aeval σ.lift (q j)) < ω^ ρ := by + classical + have hwt : ∀ i, wt i ≠ 0 := hx.ne_zero + have hρ0 : ρ ≠ 0 := (lt_of_le_of_lt zero_le hτρ).ne' + have hτ2ρ : τ + 1 + 1 ≤ ρ := Order.add_one_le_of_lt hτρ + have hρα' : ρ + 1 ≤ α := Order.add_one_le_of_lt hρα + have hDα : ∀ ζ, ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ζ) < ω^ α := fun ζ ↦ + (ordinalValue_translatedTruncation_lt_of_supportOrderType_lt hD ζ).trans_le + (NatOrdinal.wpow_le_wpow.mpr hρα') + -- the generators evaluated at the lifts, `q_j(b_𝓑)` + set qt : ι' → Series K := fun j ↦ aeval σ.lift (q j) with hqtdef + have hqcut : ∀ j, ∀ β : ℝ, β < 0 → + ordinalValue (translatedTruncation (qt j : K⟦ℝ⟧) β) < ω^ (c j) := fun j β hβ ↦ + hσ.ordinalValue_translatedTruncation_aeval_lt hwt (hq j) hβ + -- the piece `E` of `D` on `(ξ - ε, ξ]`, translated to `0` + set E : Series K := piece (ξ - ε) ξ (D : K⟦ℝ⟧) with hEdef + have hEcut : ∀ θ : ℝ, -ε < θ → θ ≤ 0 → + translatedTruncation (E : K⟦ℝ⟧) θ - translatedTruncation (D : K⟦ℝ⟧) (ξ + θ) ∈ + Nonpositive.negativeMonomialIdeal K := fun θ h1 h2 ↦ + translatedTruncation_window_sub_mem (ξ - ε) ξ (D : K⟦ℝ⟧) (by linarith) h2 + -- the pieces on `(γ k, γ (k+1)]` + set γ : ℕ → ℝ := fun k ↦ -ε / ((k : ℝ) + 1) with hγdef + have hγ : StrictMono γ := strictMono_neg_div_succ hε + have hneg : ∀ k, γ k < 0 := neg_div_succ_neg hε + have hcof : ∀ η < (0 : ℝ), ∃ k, η < γ k := fun η hη ↦ exists_lt_neg_div_succ ε hη + have hγ0 : γ 0 = -ε := by simp [hγdef] + have hγ0le : ∀ k, -ε ≤ γ k := fun k ↦ hγ0 ▸ hγ.monotone (Nat.zero_le k) + -- each piece has support of order type below `ω^ρ` and translated truncations satisfying (p) + have hwin : ∀ k, ∃ w : ι' → Series K, + (∀ j, ((w j : Series K) : K⟦ℝ⟧).supportOrderType < (ω^ (e j)).val) ∧ + ∀ θ : ℝ, θ ≤ 0 → ordinalValue (translatedTruncation + ((piece (γ k) (γ (k + 1)) (E : K⟦ℝ⟧) - ∑ j, w j * qt j : Series K) : K⟦ℝ⟧) θ) < + ω^ (τ + 1) := by + intro k + set Dk : Series K := piece (γ k) (γ (k + 1)) (E : K⟦ℝ⟧) with hDkdef + have hDkzero : ∀ θ, θ ≤ γ k - γ (k + 1) → translatedTruncation (Dk : K⟦ℝ⟧) θ = 0 := + fun θ hθ ↦ translatedTruncation_eq_zero_of_forall_lt fun y hy ↦ + lt_of_le_of_lt hθ (lt_of_mem_support_piece hy) + have hDkcut : ∀ θ, γ k - γ (k + 1) < θ → θ ≤ 0 → + translatedTruncation (Dk : K⟦ℝ⟧) θ - + translatedTruncation (D : K⟦ℝ⟧) (ξ + (γ (k + 1) + θ)) ∈ + Nonpositive.negativeMonomialIdeal K := by + intro θ h1 h2 + have h3 := translatedTruncation_window_sub_mem (γ k) (γ (k + 1)) (E : K⟦ℝ⟧) h1 h2 + have h4 := hEcut (γ (k + 1) + θ) (by linarith [hγ0le k]) (by linarith [hneg (k + 1)]) + have := add_mem h3 h4 + rwa [sub_add_sub_cancel] at this + have hin : ∀ θ, γ k - γ (k + 1) < θ → θ ≤ 0 → + ξ - ε < ξ + (γ (k + 1) + θ) ∧ ξ + (γ (k + 1) + θ) < ξ := fun θ h1 h2 ↦ + ⟨by linarith [hγ0le k], by linarith [hneg (k + 1)]⟩ + have hDkot : (Dk : K⟦ℝ⟧).supportOrderType < (ω^ ρ).val := by + refine supportOrderType_lt_of_forall_ordinalValue_translatedTruncation_lt Dk hρ0 + fun θ hθ ↦ ?_ + rcases le_or_gt θ (γ k - γ (k + 1)) with h | h + · rw [hDkzero θ h, ordinalValue_zero] + exact NatOrdinal.wpow_pos _ + · rw [ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (hDkcut θ h hθ)] + exact hnolevel _ (hin θ h hθ).1 (hin θ h hθ).2 + have hDkctrl : ∀ θ : ℝ, θ ≤ 0 → + componentsGE wt τ (σ.pol hx α (translatedTruncation (Dk : K⟦ℝ⟧) θ)) ∈ + Ideal.span (Set.range q) := by + intro θ hθ + rcases le_or_gt θ (γ k - γ (k + 1)) with h | h + · rw [hDkzero θ h, σ.pol_zero hx hinj, componentsGE_zero] + exact Ideal.zero_mem _ + · have hval : ordinalValue (translatedTruncation (Dk : K⟦ℝ⟧) θ) < ω^ α := by + rw [ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (hDkcut θ h hθ)] + exact hDα _ + rw [σ.pol_congr hx hinj hval (toGerm_eq_toGerm_iff.mpr (hDkcut θ h hθ))] + exact htrunc _ (by linarith [hneg (k + 1)]) + exact hIH Dk hDkot hDkctrl + choose w hw1 hw2 using hwin + -- combine the cofactors of the pieces + refine ⟨fun j ↦ combinedCofactor γ hγ hneg w j, + fun j ↦ supportOrderType_combinedCofactor_le γ hγ hneg w hw1 j, + fun j ζ hζ ↦ + ordinalValue_translatedTruncation_combinedCofactor_lt γ hγ hneg hcof w hw1 j hζ, ?_⟩ + have hres : ∀ ζ, -ε < ζ → ζ < 0 → ordinalValue (translatedTruncation + ((E - ∑ j, combinedCofactor γ hγ hneg w j * qt j : Series K) : K⟦ℝ⟧) ζ) < ω^ (τ + 1) := + fun ζ h1 h2 ↦ + ordinalValue_translatedTruncation_sub_sum_combinedCofactor_mul_lt E γ hγ hneg hcof w + hw1 hqcut hsep (fun k θ _ h2 ↦ hw2 k θ h2) (by rw [hγ0]; exact h1) h2 + have hwhole : ordinalValue (E - ∑ j, combinedCofactor γ hγ hneg w j * qt j) < ω^ (τ + 1 + 1) := + ordinalValue_lt_wpow_add_one_of_forall_translatedTruncation_lt (neg_neg_of_pos hε) hres + have hE0 : translatedTruncation (D : K⟦ℝ⟧) ξ - E ∈ Nonpositive.negativeMonomialIdeal K := by + have := hEcut 0 (by linarith) le_rfl + rw [translatedTruncation_zero, add_zero] at this + rw [← neg_sub] + exact neg_mem this + have hsame : ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ξ - + ∑ j, combinedCofactor γ hγ hneg w j * qt j) = + ordinalValue (E - ∑ j, combinedCofactor γ hγ hneg w j * qt j) := by + apply ordinalValue_eq_of_sub_mem_negativeMonomialIdeal + rw [sub_sub_sub_cancel_right] + exact hE0 + rw [hsame] + exact hwhole.trans_le (NatOrdinal.wpow_le_wpow.mpr hτ2ρ) + /-- **Support-order reduction by interval decomposition.** Under the stated homogeneous-degree, separation, and translated-truncation ideal hypotheses, cofactors reduce the support order type below `ω^ρ` while preserving the translated-truncation ideal condition. -/ @@ -230,89 +353,8 @@ theorem IsPrincipal.exists_supportOrderType_sub_sum_mul_aeval_lt_of_pieces {ι' rw [not_lt] at hge have := hgap θ ⟨by linarith, hge⟩ h2 linarith - -- the piece `E` of `D` on `(ξ - ε, ξ]`, translated to `0` - set E : Series K := piece (ξ - ε) ξ (D : K⟦ℝ⟧) with hEdef - have hEcut : ∀ θ : ℝ, -ε < θ → θ ≤ 0 → - translatedTruncation (E : K⟦ℝ⟧) θ - translatedTruncation (D : K⟦ℝ⟧) (ξ + θ) ∈ - Nonpositive.negativeMonomialIdeal K := fun θ h1 h2 ↦ - translatedTruncation_window_sub_mem (ξ - ε) ξ (D : K⟦ℝ⟧) (by linarith) h2 - -- the pieces on `(γ k, γ (k+1)]` - set γ : ℕ → ℝ := fun k ↦ -ε / ((k : ℝ) + 1) with hγdef - have hγ : StrictMono γ := strictMono_neg_div_succ hε - have hneg : ∀ k, γ k < 0 := neg_div_succ_neg hε - have hcof : ∀ η < (0 : ℝ), ∃ k, η < γ k := fun η hη ↦ exists_lt_neg_div_succ ε hη - have hγ0 : γ 0 = -ε := by simp [hγdef] - have hγ0le : ∀ k, -ε ≤ γ k := fun k ↦ hγ0 ▸ hγ.monotone (Nat.zero_le k) - -- each piece has support of order type below `ω^ρ` and translated truncations satisfying (p) - have hwin : ∀ k, ∃ w : ι' → Series K, - (∀ j, ((w j : Series K) : K⟦ℝ⟧).supportOrderType < (ω^ (e j)).val) ∧ - ∀ θ : ℝ, θ ≤ 0 → ordinalValue (translatedTruncation - ((piece (γ k) (γ (k + 1)) (E : K⟦ℝ⟧) - ∑ j, w j * qt j : Series K) : K⟦ℝ⟧) θ) < - ω^ (τ + 1) := by - intro k - set Dk : Series K := piece (γ k) (γ (k + 1)) (E : K⟦ℝ⟧) with hDkdef - have hDkzero : ∀ θ, θ ≤ γ k - γ (k + 1) → translatedTruncation (Dk : K⟦ℝ⟧) θ = 0 := - fun θ hθ ↦ translatedTruncation_eq_zero_of_forall_lt fun y hy ↦ - lt_of_le_of_lt hθ (lt_of_mem_support_piece hy) - have hDkcut : ∀ θ, γ k - γ (k + 1) < θ → θ ≤ 0 → - translatedTruncation (Dk : K⟦ℝ⟧) θ - - translatedTruncation (D : K⟦ℝ⟧) (ξ + (γ (k + 1) + θ)) ∈ - Nonpositive.negativeMonomialIdeal K := by - intro θ h1 h2 - have h3 := translatedTruncation_window_sub_mem (γ k) (γ (k + 1)) (E : K⟦ℝ⟧) h1 h2 - have h4 := hEcut (γ (k + 1) + θ) (by linarith [hγ0le k]) (by linarith [hneg (k + 1)]) - have := add_mem h3 h4 - rwa [sub_add_sub_cancel] at this - have hin : ∀ θ, γ k - γ (k + 1) < θ → θ ≤ 0 → - ξ - ε < ξ + (γ (k + 1) + θ) ∧ ξ + (γ (k + 1) + θ) < ξ := fun θ h1 h2 ↦ - ⟨by linarith [hγ0le k], by linarith [hneg (k + 1)]⟩ - have hDkot : (Dk : K⟦ℝ⟧).supportOrderType < (ω^ ρ).val := by - refine supportOrderType_lt_of_forall_ordinalValue_translatedTruncation_lt Dk hρ0 - fun θ hθ ↦ ?_ - rcases le_or_gt θ (γ k - γ (k + 1)) with h | h - · rw [hDkzero θ h, ordinalValue_zero] - exact NatOrdinal.wpow_pos _ - · rw [ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (hDkcut θ h hθ)] - exact hnolevel _ (hin θ h hθ).1 (hin θ h hθ).2 - have hDkctrl : ∀ θ : ℝ, θ ≤ 0 → - componentsGE wt τ (σ.pol hx α (translatedTruncation (Dk : K⟦ℝ⟧) θ)) ∈ - Ideal.span (Set.range q) := by - intro θ hθ - rcases le_or_gt θ (γ k - γ (k + 1)) with h | h - · rw [hDkzero θ h, σ.pol_zero hx hinj, componentsGE_zero] - exact Ideal.zero_mem _ - · have hval : ordinalValue (translatedTruncation (Dk : K⟦ℝ⟧) θ) < ω^ α := by - rw [ordinalValue_eq_of_sub_mem_negativeMonomialIdeal (hDkcut θ h hθ)] - exact hDα _ - rw [σ.pol_congr hx hinj hval (toGerm_eq_toGerm_iff.mpr (hDkcut θ h hθ))] - exact htrunc _ (by linarith [hneg (k + 1)]) - exact hIH Dk hDkot hDkctrl - choose w hw1 hw2 using hwin - -- combine the cofactors of the pieces - refine ⟨fun j ↦ combinedCofactor γ hγ hneg w j, - fun j ↦ supportOrderType_combinedCofactor_le γ hγ hneg w hw1 j, - fun j ζ hζ ↦ - ordinalValue_translatedTruncation_combinedCofactor_lt γ hγ hneg hcof w hw1 j hζ, ?_⟩ - have hres : ∀ ζ, -ε < ζ → ζ < 0 → ordinalValue (translatedTruncation - ((E - ∑ j, combinedCofactor γ hγ hneg w j * qt j : Series K) : K⟦ℝ⟧) ζ) < ω^ (τ + 1) := - fun ζ h1 h2 ↦ - ordinalValue_translatedTruncation_sub_sum_combinedCofactor_mul_lt E γ hγ hneg hcof w - hw1 hqcut hsep (fun k θ _ h2 ↦ hw2 k θ h2) (by rw [hγ0]; exact h1) h2 - have hwhole : ordinalValue (E - ∑ j, combinedCofactor γ hγ hneg w j * qt j) < ω^ (τ + 1 + 1) := - ordinalValue_lt_wpow_add_one_of_forall_translatedTruncation_lt (neg_neg_of_pos hε) hres - have hE0 : translatedTruncation (D : K⟦ℝ⟧) ξ - E ∈ Nonpositive.negativeMonomialIdeal K := by - have := hEcut 0 (by linarith) le_rfl - rw [translatedTruncation_zero, add_zero] at this - rw [← neg_sub] - exact neg_mem this - have hsame : ordinalValue (translatedTruncation (D : K⟦ℝ⟧) ξ - - ∑ j, combinedCofactor γ hγ hneg w j * qt j) = - ordinalValue (E - ∑ j, combinedCofactor γ hγ hneg w j * qt j) := by - apply ordinalValue_eq_of_sub_mem_negativeMonomialIdeal - rw [sub_sub_sub_cancel_right] - exact hE0 - rw [hsame] - exact hwhole.trans_le (NatOrdinal.wpow_le_wpow.mpr hτ2ρ) + exact IsPrincipal.exists_cofactors_at_cutoff_of_pieces σ hx hinj hσ hq hτρ hρα hsep + hD htrunc hIH hξ0 hε hnolevel choose! C hC using hpt -- the terms `C^ξ_j · q_j(b_𝓑)`: translated truncations of small ordinal value, satisfying (p) have hCv : ∀ ξ ∈ hL.toFinset, ∀ j, ordinalValue (C ξ j) < ω^ (e j + 1) := fun ξ hξ j ↦ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Syzygy.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Syzygy.lean index c38e1f8934..6f76218c93 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Syzygy.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/Syzygy.lean @@ -8,8 +8,7 @@ module import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.RemainderBound -public import - LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan @@ -76,7 +75,7 @@ theorem weightedHomogeneousComponent_mul_of_isWeightedHomogeneous {P Q : MvPolyn if h : ∃ β, β + c = γ then weightedHomogeneousComponent wt (Classical.choose h) P * Q else 0 := by classical - letI := weightedGradedAlgebra K wt + let := weightedGradedAlgebra K wt have hdec : ∀ (R : MvPolynomial ι K) (e : NatOrdinal), (DirectSum.decompose (weightedHomogeneousSubmodule K wt) R e : MvPolynomial ι K) = weightedHomogeneousComponent wt e R := fun R e ↦ by @@ -239,7 +238,7 @@ theorem exists_forall_componentsGE_pol_translatedTruncation_aeval_pderiv_mem rw [pderiv_eq_zero_of_isWeightedHomogeneous wt hF j.1 h] exact isWeightedHomogeneous_zero _ _ _⟩ choose c hc using hgen - haveI : Finite {j : ι // j ∈ F.vars ∧ wt v' < wt j} := + have : Finite {j : ι // j ∈ F.vars ∧ wt v' < wt j} := (F.vars.finite_toSet.subset fun j (hj : j ∈ F.vars ∧ wt v' < wt j) ↦ hj.1).to_subtype refine componentsGE_mem_span wt hc ?_ τ refine Ideal.sum_mem _ fun j hj ↦ ?_ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationExpansion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationExpansion.lean index 7496d28c57..317573f860 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationExpansion.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence/TruncationExpansion.lean @@ -166,7 +166,7 @@ omit [DecidableEq ι] hinj in /-- Splitting off one factor: `X^{d + e_i} = X^d · X_i`. -/ theorem monomial_add_single_one (d : ι →₀ ℕ) (i : ι) : monomial (d + Finsupp.single i 1) (1 : K) = monomial d 1 * X i := by - rw [X, monomial_mul, mul_one] + rw [X, MvPolynomial.monomial_mul_monomial, mul_one] omit [DecidableEq ι] hinj in /-- The first-order terms after splitting off one factor: diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPoint.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPoint.lean index 01f68c0d59..a8bcf80f7c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPoint.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPoint.lean @@ -133,7 +133,7 @@ theorem ordinalValue_translatedTruncation_pos_of_mem_support have hmem := ordinalValue_eq_zero_iff.mp hzero have hcoeff := constantCoeff_eq_zero_of_mem_negativeMonomialIdeal hmem rw [HahnSeries.Nonpositive.constantCoeff_apply, coeff_translatedTruncation] at hcoeff - simp only [le_refl, if_true, add_zero] at hcoeff + simp only [le_refl, ite_true, add_zero] at hcoeff exact (HahnSeries.mem_support _ _).mp hx hcoeff /-- The maximal translated-truncation value at a critical point is positive. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPointExistence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPointExistence.lean index 619aeaadf3..0e0eb7183c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPointExistence.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPointExistence.lean @@ -121,7 +121,7 @@ private theorem principalHeadExponent_nonpositive exact (HahnSeries.mem_support _ _).mp hy exact (not_le_of_gt hypos) (HahnSeries.Nonpositive.support_subset b hyb) -private theorem ordinalValue_add_eq_left_of_lt [CharZero K] +private theorem ordinalValue_add_eq_left_of_lt {b c : Series K} (h : ordinalValue c < ordinalValue b) : ordinalValue (b + c) = ordinalValue b := by apply le_antisymm diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Irreducibility.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Irreducibility.lean index 88cd47337a..f8a0098a9f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Irreducibility.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Irreducibility.lean @@ -248,7 +248,7 @@ private theorem translatedTruncation_one_eq_zero_of_neg {u : ℝ} (hu : u < 0) : · rw [ite_eq_right hdelta] rfl -private theorem ordinalValue_add_one_eq_of_one_lt [CharZero K] +private theorem ordinalValue_add_one_eq_of_one_lt {a : Series K} (ha : 1 < ordinalValue a) : ordinalValue (a + 1) = ordinalValue a := by apply le_antisymm · simpa [ordinalValue_one, max_eq_left ha.le] using ordinalValue_add_le_max a 1 diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OneRow.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OneRow.lean index 8842b5e16c..c2e45b5ee2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OneRow.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OneRow.lean @@ -130,7 +130,7 @@ theorem withoutConstant_supportOrderType : (withoutConstant (K := K) : K⟦ℝ⟧).supportOrderType = Ordinal.omega0 := by rw [HahnSeries.supportOrderType_eq_setOrderType] have e : (withoutConstant (K := K) : K⟦ℝ⟧).support ≃o ℕ := - (OrderIso.setCongr _ (Set.range exponentEmbedding) + (Set.orderIsoOfEq _ (Set.range exponentEmbedding) (withoutConstant_support (K := K))).trans exponentEmbedding.orderIso.symm exact (withoutConstant (K := K) : K⟦ℝ⟧).isPWO_support |>.orderType_eq_typeLT_of_orderIso e |>.trans Ordinal.type_nat_lt diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValue.lean index 623a616eac..97bd0ef510 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValue.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValue.lean @@ -162,7 +162,7 @@ private theorem mem_nearConstantSubgroup_of_supportOrderType_le_one exact (nearConstantSubgroup K).zero_mem · have hbTypeOne : (b : K⟦ℝ⟧).supportOrderType = 1 := by simpa using hbOne - letI : WellFoundedLT (b : K⟦ℝ⟧).support := + let : WellFoundedLT (b : K⟦ℝ⟧).support := (b : K⟦ℝ⟧).isWF_support have htype : Ordinal.type (fun x y : (b : K⟦ℝ⟧).support ↦ x < y) = 1 := by @@ -170,7 +170,7 @@ private theorem mem_nearConstantSubgroup_of_supportOrderType_le_one (OrderIso.refl (b : K⟦ℝ⟧).support)] exact hbTypeOne obtain ⟨hUnique⟩ := Ordinal.type_eq_one_iff_unique.mp htype - letI : Unique (b : K⟦ℝ⟧).support := hUnique + let : Unique (b : K⟦ℝ⟧).support := hUnique let g : (b : K⟦ℝ⟧).support := default have hsupport : (b : K⟦ℝ⟧).support = {(g : ℝ)} := by ext x diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueFinalSegment.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueFinalSegment.lean index b973274445..cf42da4747 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueFinalSegment.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/OrdinalValueFinalSegment.lean @@ -203,8 +203,8 @@ theorem ordinalValue_translatedTruncation_le_orderType_of_isRelUpperSet_supportB let hshiftedPWO : shifted.IsPWO := ((translatedTruncation b γ : Series K) : K⟦ℝ⟧).isPWO_support.mono fun _ hx ↦ (hshifted hx).1.1 - letI : WellFoundedLT C := hCPWO.isWF - letI : WellFoundedLT shifted := hshiftedPWO.isWF + let : WellFoundedLT C := hCPWO.isWF + let : WellFoundedLT shifted := hshiftedPWO.isWF let f : C → shifted := fun x ↦ ⟨-γ + x.1, x.1, x.2, rfl⟩ have hf : StrictMono f := by intro x y hxy diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentTensor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentTensor.lean index 18c512636d..ffc631550f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentTensor.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalComponentTensor.lean @@ -42,6 +42,7 @@ public noncomputable section variable {K : Type v} [Field K] +/-- The ring of finite-support nonpositive real-exponent Hahn series over the coefficient field. -/ abbrev FiniteSupportRing := HahnSeries.Nonpositive.FiniteSupportRing (G := ℝ) (K := K) @@ -231,6 +232,8 @@ theorem principalComponentToHahnDegreeLayer_mk (alpha : NatOrdinal) exact Or.inr ⟨p, hp, hpDegree, rfl⟩ variable (K) in +/-- Multiply a principal homogeneous class by a finite-support residue to obtain the +corresponding Hahn degree class. -/ def principalComponentFiniteSupportMul (alpha : NatOrdinal) : PrincipalComponent K alpha →ₗ[K] FiniteSupportRing (K := K) →ₗ[K] @@ -275,6 +278,8 @@ theorem principalComponentFiniteSupportMul_apply (alpha : NatOrdinal) (rfl) variable (K) in +/-- The linear map from principal classes tensored with finite-support series to the +corresponding Hahn degree layer. -/ def principalComponentTensorMap (alpha : NatOrdinal) : PrincipalComponent K alpha ⊗[K] FiniteSupportRing (K := K) →ₗ[K] (HahnSeries.Nonpositive.degreeValuation K).Component alpha := @@ -324,7 +329,8 @@ private theorem finiteSupportMonomial_degree (g : HahnSeries.Nonpositive.exponen FiniteSupportRing (K := K)) : Series K)).mp (HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g).2 -private theorem coe_finiteSupportMonomial_mul (g : HahnSeries.Nonpositive.exponentMonoid ℝ) (p : Series K) : +private theorem coe_finiteSupportMonomial_mul (g : HahnSeries.Nonpositive.exponentMonoid ℝ) (p : + Series K) : ((((HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g : FiniteSupportRing (K := K)) : Series K) * p : Series K) : K⟦ℝ⟧) = HahnSeries.translate (g : ℝ) (p : K⟦ℝ⟧) := by @@ -346,7 +352,8 @@ private theorem coe_shiftedSeries (g : HahnSeries.Nonpositive.exponentMonoid ℝ HahnSeries.translate (g : ℝ) (p : K⟦ℝ⟧) := (rfl) -private theorem finiteSupportMonomial_mul_eq_shiftedSeries (g : HahnSeries.Nonpositive.exponentMonoid ℝ) (p : Series K) : +private theorem finiteSupportMonomial_mul_eq_shiftedSeries (g : + HahnSeries.Nonpositive.exponentMonoid ℝ) (p : Series K) : ((HahnSeries.Nonpositive.finiteSupportMonomial (K := K) g : FiniteSupportRing (K := K)) : Series K) * p = shiftedSeries g p := by apply Subtype.ext diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFraction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFraction.lean index 5aabcb429b..4b808c0a5c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFraction.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFraction.lean @@ -88,6 +88,7 @@ noncomputable abbrev principalSubringFractionSelfAlgebra : (algebraMap (PrincipalSubring K) (FractionRing (PrincipalSubring K)))) +/-- The principal graded subring acts canonically on its explicitly constructed fraction field. -/ local instance principalSubringFractionSelfAlgebraInstance : Algebra (PrincipalSubring K) (PrincipalSubringFractionField K) := @@ -184,6 +185,8 @@ noncomputable abbrev principalSubringFractionAlgebra : ((principalSubringToFraction K).comp (algebraMap K (PrincipalSubring K))) +/-- The coefficient-field algebra structure on the explicitly constructed principal-subring +fraction field. -/ local instance principalSubringFractionAlgebraInstance : Algebra K (PrincipalSubringFractionField K) := principalSubringFractionAlgebra K diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFractionAlgebraic.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFractionAlgebraic.lean index f88037430c..a814b72068 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFractionAlgebraic.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringFractionAlgebraic.lean @@ -557,16 +557,16 @@ theorem ordinalValue_relationSum_lt {beta : NatOrdinal} intro i by_cases hi : i ∈ Finset.range (d + 1) · rw [hu_def] - simp only [hi, if_true] + simp only [hi, ite_true] exact (hterm i hi).choose · rw [hu_def] - simp only [hi, if_false] + simp only [hi, ite_false] simp have hu_eq : ∀ j ∈ Finset.range (d + 1), u j = (HahnSeries.Nonpositive.C : K →+* Series K) (k j) * (b ^ j * c ^ (d - j)) := by intro j hj rw [hu_def] - simp only [hj, if_true] + simp only [hj, ite_true] have hcongr : ∑ i ∈ Finset.range (d + 1), (HahnSeries.Nonpositive.C : K →+* Series K) (k i) * (b ^ i * c ^ (d - i)) = ∑ i ∈ Finset.range (d + 1), u i := @@ -751,6 +751,7 @@ theorem exists_isRoot_of_ordinalValue_relationSum_lt {beta : NatOrdinal} {d : /-! ### Clearing denominators -/ +/-- The principal-subring algebra structure used locally when clearing denominators. -/ local instance principalSubringFractionSelfAlgebraLocal : Algebra (PrincipalSubring K) (PrincipalSubringFractionField K) := principalSubringFractionSelfAlgebra K @@ -759,6 +760,7 @@ local instance principalSubringFractionIsFractionRingLocal : IsFractionRing (PrincipalSubring K) (PrincipalSubringFractionField K) := IsFractionRing.of_algEquiv (principalSubringFractionAlgEquiv K) +/-- The coefficient-field algebra structure used locally when clearing denominators. -/ local instance principalSubringFractionAlgebraLocal : Algebra K (PrincipalSubringFractionField K) := principalSubringFractionAlgebra K @@ -770,7 +772,7 @@ theorem exists_relation_of_aeval_eq_zero (Q : Polynomial K) ∑ i ∈ Finset.range (Q.natDegree + 1), algebraMap K (PrincipalSubring K) (Q.coeff i) * B ^ i * C ^ (Q.natDegree - i) = 0 := by - haveI : IsScalarTower K (PrincipalSubring K) (PrincipalSubringFractionField K) := + have : IsScalarTower K (PrincipalSubring K) (PrincipalSubringFractionField K) := principalSubringFraction_isScalarTower K have hinj : Function.Injective (algebraMap (PrincipalSubring K) (PrincipalSubringFractionField K)) := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringLocalization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringLocalization.lean index 4d7072011f..5a1f2b796f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringLocalization.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringLocalization.lean @@ -38,6 +38,7 @@ open HahnSeries.Nonpositive variable {K : Type v} [Field K] [CharZero K] +/-- The coefficient-field algebra structure on principal-subring fractions used in localization. -/ local instance principalSubringFractionAlgebraLocalization : Algebra K (PrincipalSubringFractionField K) := principalSubringFractionAlgebra K @@ -174,6 +175,7 @@ variable (K) in private abbrev FractionTensor := PrincipalSubringFractionField K ⊗[K] FiniteSupportRing (K := K) +/-- The principal-subring algebra structure on its fraction field used in tensor localization. -/ local instance principalSubringFractionSelfAlgebraLocalization : Algebra (PrincipalSubring K) (PrincipalSubringFractionField K) := principalSubringFractionSelfAlgebra K diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringMonoidAlgebra.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringMonoidAlgebra.lean index 3fd09ce905..8d56326648 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringMonoidAlgebra.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringMonoidAlgebra.lean @@ -68,7 +68,7 @@ theorem degreeGradedEquivPrincipalMonoidAlgebra_principal AlgEquiv.trans_apply, AlgEquiv.trans_apply, htensor] simp only [Algebra.TensorProduct.congr_apply, AlgEquiv.refl_toAlgHom, Algebra.TensorProduct.map_tmul, AlgHom.coe_id, id_eq, map_one, - AlgEquiv.coe_restrictScalars', AddMonoidAlgebra.scalarTensorEquiv_tmul] + AlgEquiv.coe_restrictScalars, AddMonoidAlgebra.scalarTensorEquiv_tmul] rw [AddMonoidAlgebra.one_def, AddMonoidAlgebra.smul_single', mul_one] variable (K) in @@ -94,7 +94,7 @@ theorem degreeGradedEquivPrincipalMonoidAlgebra_finiteSupportMonomial simp only [Algebra.TensorProduct.congr_apply, AlgEquiv.refl_toAlgHom, Algebra.TensorProduct.map_tmul, AlgEquiv.coe_toAlgHom, HahnSeries.Nonpositive.finiteSupportAddMonoidAlgebraEquiv_monomial, - AlgEquiv.coe_restrictScalars', AddMonoidAlgebra.scalarTensorEquiv_tmul, + AlgEquiv.coe_restrictScalars, AddMonoidAlgebra.scalarTensorEquiv_tmul, AddMonoidAlgebra.mapAlgHom_single, map_one, one_smul] /-- A principal coefficient multiplied by a finite-support Hahn monomial corresponds to a diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringScalarRedistributionProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringScalarRedistributionProof.lean index 5e66e9509f..2a4d19527b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringScalarRedistributionProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringScalarRedistributionProof.lean @@ -47,6 +47,8 @@ section Redistribution variable {K : Type v} [Field K] [CharZero K] +/-- The coefficient-field algebra structure on principal-subring fractions used for scalar +redistribution. -/ local instance algLocal : Algebra K (PrincipalSubringFractionField K) := principalSubringFractionAlgebra K diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringTensor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringTensor.lean index 3f3527ec37..443d58fc4e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringTensor.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/PrincipalSubringTensor.lean @@ -132,7 +132,8 @@ def principalSubringTensorMap [CharZero K] : (finiteSupportGradedEmbedding K) /-- On a pure tensor, the global tensor map is multiplication of the two embedded factors. -/ -theorem principalSubringTensorMap_tmul [CharZero K] (x : PrincipalSubring K) (p : FiniteSupportRing (K := K)) : +theorem principalSubringTensorMap_tmul [CharZero K] (x : PrincipalSubring K) (p : + FiniteSupportRing (K := K)) : principalSubringTensorMap K (x ⊗ₜ p) = principalSubringEmbedding K x * finiteSupportGradedEmbedding K p := @@ -157,8 +158,7 @@ private theorem principalSubringTensorMap_eq_linearEquiv [CharZero K] (z : PrincipalSubring K ⊗[K] FiniteSupportRing (K := K)) : principalSubringTensorMap K z = principalSubringTensorLinearEquiv K z := by - induction z using TensorProduct.induction_on with - | zero => rw [map_zero, LinearEquiv.map_zero] + induction z using TensorProduct.inductionOn with | tmul x p => rw [principalSubringTensorMap_tmul, finiteSupportGradedEmbedding_apply, mul_comm, @@ -303,7 +303,8 @@ theorem principalSubringTensorEquiv_symm_finiteSupportGradedEmbedding [CharZero /-- The inverse global tensor equivalence sends the principal graded embedding to the corresponding pure tensor. -/ @[simp] -theorem principalSubringTensorEquiv_symm_principalGradedEmbedding [CharZero K] (x : PrincipalSubring K) : +theorem principalSubringTensorEquiv_symm_principalGradedEmbedding [CharZero K] (x : + PrincipalSubring K) : (principalSubringTensorEquiv K).symm (principalSubringEmbedding K x) = x ⊗ₜ 1 := by apply (principalSubringTensorEquiv K).injective diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPoint.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPoint.lean index d92831bc1c..ef0775d0a4 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPoint.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPoint.lean @@ -119,7 +119,7 @@ theorem residualPointSet_eq_setOf_ordinalValue_eq_one_of_isMultiplicativelyPrinc residualPointSet b = {γ : ℝ | γ < 0 ∧ ordinalValue (translatedTruncation (b.1 : K⟦ℝ⟧) γ) = 1} := by ext γ - rw [mem_residualPointSet_iff, Set.mem_setOf_eq, + rw [mem_residualPointSet_iff, Set.mem_ofPred_eq, b.residualValue_eq_one_of_isMultiplicativelyPrincipal hb] end Berarducci diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointOrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointOrderType.lean index a535214571..595e6c2704 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointOrderType.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointOrderType.lean @@ -351,7 +351,7 @@ private theorem ordinalValue_translatedTruncation_val_le_of_orderType_inter_Iio_ have hIiow : I ∩ Set.Iio w = S ∩ Set.Iio w := by ext y exact ⟨fun hy ↦ ⟨hy.1.1, hy.2⟩, fun hy ↦ ⟨⟨hy.1, lt_trans hy.2 hwγ⟩, hy.2⟩⟩ - letI : WellFoundedLT I := hI.isWF + let : WellFoundedLT I := hI.isWF have hsplit := hI.orderType_inter_Iio_add_inter_Ici hwI have hIiowot : (hI.mono (s := I ∩ Set.Iio w) Set.inter_subset_left).orderType = ρ * α := by rw [Set.IsPWO.orderType_congr _ (hS.mono (s := S ∩ Set.Iio w) Set.inter_subset_left) hIiow] @@ -407,7 +407,7 @@ private theorem le_ordinalValue_translatedTruncation_of_isLUB_of_orderType_inter (negativeSupportTail_subset_support b.1 η)) with hSpwo set I := S ∩ Set.Iio γ with hIdef set hI := hS.mono (s := I) Set.inter_subset_left with hIpwo - letI : WellFoundedLT I := hI.isWF + let : WellFoundedLT I := hI.isWF apply le_ordinalValue_translatedTruncation_of_forall_le_orderType intro θ hθ obtain ⟨z, hzI, hθz, _⟩ := hLUB.exists_between hθ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointSupport.lean index 07ba8cf17f..2fda4e66af 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointSupport.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/ResidualPointSupport.lean @@ -71,7 +71,7 @@ theorem exists_strictMono_cutoff_of_residualPointTail b.principalValue_isInfiniteMultiplicativelyPrincipal.isAdditivelyPrincipal).2 · exact ⟨x, hxTail, hθx⟩ _ = b.principalValue.val := htailType - letI : WellFoundedLT finalTail := hfinalTail.isWF + let : WellFoundedLT finalTail := hfinalTail.isWF have htypes : typeLT b.principalValue.val.ToType = typeLT finalTail := by calc typeLT b.principalValue.val.ToType = b.principalValue.val := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ResidualPoint.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ResidualPoint.lean index 2c527154b7..a942b48483 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ResidualPoint.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ResidualPoint.lean @@ -56,7 +56,7 @@ variable {K : Type v} [Field K] /-- Berarducci, Lemma 6.8: sufficiently high residual-point tails have principal order type and least upper bound zero. -/ -theorem residualPointTail_eventually [CharZero K] +theorem residualPointTail_eventually (b : SeriesWithOrdinalValueAboveOne K) : ∀ᶠ η in nhdsWithin (0 : ℝ) (Set.Iio 0), (residualPointTail b η).Nonempty ∧ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/PrincipalGraded.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/PrincipalGraded.lean index d6d0f91747..cf793631da 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/PrincipalGraded.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence/PrincipalGraded.lean @@ -183,7 +183,7 @@ theorem exists_minimalSystem_degree_one : Berarducci.minimalSystemDegree x = 1 := by let q := finiteDegreeApproachZeroIndecomposable have hq : q ≠ 0 := finiteDegreeApproachZeroIndecomposable_ne_zero - letI : Nontrivial (Berarducci.PrincipalIndecomposableQuotient ℚ 1) := + let : Nontrivial (Berarducci.PrincipalIndecomposableQuotient ℚ 1) := ⟨⟨q, 0, hq⟩⟩ obtain ⟨i⟩ := (Berarducci.principalIndecomposableBasis ℚ 1).index_nonempty exact ⟨⟨⟨1, by decide⟩, i⟩, rfl⟩ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/OrdinalValueFinalSegment.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/OrdinalValueFinalSegment.lean index 408ab39152..a1d6ea9764 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/OrdinalValueFinalSegment.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/OrdinalValueFinalSegment.lean @@ -110,7 +110,7 @@ theorem approachZeroPlusOne_fullSupport_singleton_counterexample : refine ⟨singletonZero_isRelUpperSet_approachZeroPlusOne_support, Set.singleton_nonempty 0, ?_, ?_⟩ · let hsingleton : ({0} : Set ℝ).IsPWO := Set.isPWO_singleton 0 - letI : WellFoundedLT ({0} : Set ℝ) := hsingleton.isWF + let : WellFoundedLT ({0} : Set ℝ) := hsingleton.isWF calc hsingleton.orderType = typeLT ({0} : Set ℝ) := hsingleton.orderType_eq_typeLT_of_orderIso (OrderIso.refl _) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponent.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponent.lean index f328290ce1..0e4b658844 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponent.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponent.lean @@ -49,6 +49,7 @@ theorem principalComponent_zero_constant_ne_zero : rw [Berarducci.ordinalValue_one] simp +/-- The negative monomial `t⁻¹`, whose class vanishes in the germ quotient. -/ def principalComponentNegativeMonomial : Berarducci.Series K := HahnSeries.Nonpositive.single (-1 : ℝ) 1 (by norm_num) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponentTensor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponentTensor.lean index 02a9d45849..a7654d7c20 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponentTensor.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalComponentTensor.lean @@ -48,7 +48,8 @@ private theorem approachZeroPrincipalComponent_ne_zero : def tensorExponentZero : HahnSeries.Nonpositive.exponentMonoid ℝ := ⟨0, le_rfl⟩ /-- The exponent negative one in the nonpositive real cone. -/ -def tensorExponentNegOne : HahnSeries.Nonpositive.exponentMonoid ℝ := ⟨-1, show (-1 : ℝ) ≤ 0 by norm_num⟩ +def tensorExponentNegOne : HahnSeries.Nonpositive.exponentMonoid ℝ := ⟨-1, show (-1 : ℝ) ≤ 0 by + norm_num⟩ /-- A tensor with nonzero coordinates at the two distinct exponents `0` and `-1`. -/ def approachZeroTwoExponentTensor : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubring.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubring.lean index d535e924de..7c0b1c0a1a 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubring.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubring.lean @@ -109,6 +109,8 @@ end TwoGrades section ProperRange +/-- The monomial `t⁻¹` used to separate the principal graded subring from the full degree-graded +ring. -/ def negativeMonomialForPrincipalGraded : Berarducci.Series K := HahnSeries.Nonpositive.single (-1 : ℝ) 1 (by norm_num) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFiniteSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFiniteSupport.lean index 35c9216992..f4b4a0422c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFiniteSupport.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFiniteSupport.lean @@ -69,7 +69,7 @@ theorem extendedBinomial_negativeOne_coeff : extendedBinomial negativeOne = 1 := by rw [extendedBinomial, Berarducci.principalSubringFractionScalarExtension_coeff] - simp [sourceBinomial, negativeOne, Finsupp.single_apply, Subtype.ext_iff, + simp [sourceBinomial, negativeOne, HahnSeries.Nonpositive.finiteSupportCoefficients_apply] /-- The constant term survives coefficient extension. -/ @@ -78,7 +78,7 @@ theorem extendedBinomial_zero_coeff : extendedBinomial 0 = 1 := by rw [extendedBinomial, Berarducci.principalSubringFractionScalarExtension_coeff] - simp [sourceBinomial, negativeOne, Finsupp.single_apply, Subtype.ext_iff, + simp [sourceBinomial, negativeOne, Subtype.ext_iff, HahnSeries.Nonpositive.finiteSupportCoefficients_apply] /-- The extended binomial lies in the embedded coefficient-series subring. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFraction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFraction.lean index c3eb072cba..018c5ea9bd 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFraction.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFraction.lean @@ -26,20 +26,26 @@ namespace Tests public noncomputable section +/-- The principal-subring scalar action on its fraction field in the rational client fixtures. -/ local instance principalSubringFractionClientSelfSMul : SMul (Berarducci.PrincipalSubring ℚ) (Berarducci.PrincipalSubringFractionField ℚ) := (Berarducci.principalSubringFractionSelfAlgebra ℚ).toSMul +/-- The principal-subring algebra structure on its fraction field in the rational client +fixtures. -/ local instance principalSubringFractionClientSelfAlgebra : Algebra (Berarducci.PrincipalSubring ℚ) (Berarducci.PrincipalSubringFractionField ℚ) := Berarducci.principalSubringFractionSelfAlgebra ℚ +/-- The rational scalar action on the principal-subring fraction field in the client fixtures. -/ local instance principalSubringFractionClientSMul : SMul ℚ (Berarducci.PrincipalSubringFractionField ℚ) := (Berarducci.principalSubringFractionAlgebra ℚ).toSMul +/-- The rational algebra structure on the principal-subring fraction field in the client +fixtures. -/ local instance principalSubringFractionClientAlgebra : Algebra ℚ (Berarducci.PrincipalSubringFractionField ℚ) := Berarducci.principalSubringFractionAlgebra ℚ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringTensor.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringTensor.lean index 0013b24973..85df89565b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringTensor.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringTensor.lean @@ -92,7 +92,9 @@ theorem gradedTensorTwoGrade_positive_component_ne_zero : simpa only [map_zero] using hzero /-- The nonpositive exponent `-1` used by the finite-support factor fixture. -/ -def gradedTensorExponentNegOne : HahnSeries.Nonpositive.exponentMonoid ℝ := ⟨-1, show (-1 : ℝ) ≤ 0 by norm_num⟩ +def gradedTensorExponentNegOne : HahnSeries.Nonpositive.exponentMonoid ℝ := ⟨-1, show (-1 : ℝ) ≤ + 0 by + norm_num⟩ /-- The finite-support monomial at exponent `-1`. -/ def gradedTensorFiniteMonomial : Berarducci.FiniteSupportRing (K := ℚ) := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/CompleteGerm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/CompleteGerm.lean index 59898e25cb..4642aaa382 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/CompleteGerm.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/CompleteGerm.lean @@ -132,7 +132,7 @@ theorem hasFourFactorRefinement_of_algebraicIndependent_generators (hgenerate : Function.Surjective (aeval xg : MvPolynomial ι K →ₐ[K] (ν).AssociatedGraded)) : HasFourFactorRefinement (Nonpositive G K ⧸ J) := by - letI : DecompositionMonoid (Nonpositive G K ⧸ J) := + let : DecompositionMonoid (Nonpositive G K ⧸ J) := MulEquiv.decompositionMonoid (germAlgEquiv σ hindependent hgenerate).symm.toMulEquiv exact hasFourFactorRefinement_of_decompositionMonoid diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialPresentation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialPresentation.lean index 9e9abad8dd..d39dfea88f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialPresentation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/PolynomialPresentation.lean @@ -115,7 +115,7 @@ theorem exists_C_mul_eq_coordinatePolynomialMap (h : MvPolynomial ι (Berarducci.FiniteSupportRing (K := K))), u ≠ 0 ∧ MvPolynomial.C (algebraMap (Berarducci.FiniteSupportRing (K := K)) (FiniteSupportFractionField (K := K)) u) * q = coordinatePolynomialMap K ι h := by - letI := MvPolynomial.algebraMvPolynomial (σ := ι) + let := MvPolynomial.algebraMvPolynomial (σ := ι) (R := Berarducci.FiniteSupportRing (K := K)) (S := FiniteSupportFractionField (K := K)) obtain ⟨⟨h, m⟩, hm⟩ := IsLocalization.surj ((nonZeroDivisors (Berarducci.FiniteSupportRing (K := K))).map @@ -332,7 +332,7 @@ theorem quotient_span_singleton_isDomain (haDegree : 0 < degreeValuation K (MvPolynomial.aeval b F)) : IsDomain (MvPolynomial ι (Berarducci.FiniteSupportRing (K := K)) ⧸ Ideal.span {F}) := by have hirr := hb.irreducible_coordinatePolynomialMap_of_irreducible_aeval ha haDegree - haveI : (Ideal.span {coordinatePolynomialMap K ι F}).IsPrime := + have : (Ideal.span {coordinatePolynomialMap K ι F}).IsPrime := (Ideal.span_singleton_prime hirr.ne_zero).mpr hirr.prime rw [hb.span_singleton_eq_comap ha haDegree] exact Ideal.Quotient.isDomain _ @@ -343,7 +343,7 @@ theorem prime_of_irreducible_aeval (ha : Irreducible (MvPolynomial.aeval b F)) (haDegree : 0 < degreeValuation K (MvPolynomial.aeval b F)) : Prime F := by have hF0 : F ≠ 0 := fun h ↦ ha.ne_zero (by rw [h, map_zero]) - haveI := hb.quotient_span_singleton_isDomain ha haDegree + have := hb.quotient_span_singleton_isDomain ha haDegree exact (Ideal.span_singleton_prime hF0).mp ((Ideal.Quotient.isDomain_iff_prime (Ideal.span {F})).mp inferInstance) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests/GCDMonoid.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests/GCDMonoid.lean index 6bc1b2e157..58f866fde6 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests/GCDMonoid.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests/GCDMonoid.lean @@ -30,7 +30,7 @@ variable {K : Type v} [Field K] [CharZero K] theorem series_pairwise_gcd_exists (a b : Series K) : ∃ d : Series K, ∀ e : Series K, e ∣ a ∧ e ∣ b ↔ e ∣ d := by obtain ⟨inst⟩ := Berarducci.nonemptyGCDMonoid (K := K) - letI : GCDMonoid (Series K) := inst + let : GCDMonoid (Series K) := inst exact ⟨gcd a b, fun e ↦ (dvd_gcd_iff e a b).symm⟩ /-- A gcd of `(0, a)` is associated to `a` and has the expected universal property. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/GCDMonoid.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/GCDMonoid.lean index f1b0f8b4ef..2fb6f4ace8 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/GCDMonoid.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/GCDMonoid.lean @@ -39,9 +39,9 @@ greatest common divisors from the corresponding polynomial ring to the series ri theorem GeneratorLifts.nonemptyGCDMonoid (hx : IsMinimalSystem (principalGrading K) wt x) (σ : GeneratorLifts wt x) : Nonempty (GCDMonoid (Series K)) := by - letI : Nonempty (NormalizedGCDMonoid (FiniteSupportRing (K := K))) := + let : Nonempty (NormalizedGCDMonoid (FiniteSupportRing (K := K))) := nonemptyNormalizedGCDMonoid_finiteSupport - letI : Nonempty (GCDMonoid (MvPolynomial ι (FiniteSupportRing (K := K)))) := + let : Nonempty (GCDMonoid (MvPolynomial ι (FiniteSupportRing (K := K)))) := MvPolynomial.nonemptyGCDMonoid exact MulEquiv.nonemptyGCDMonoid (polynomialRingEquiv hx σ).symm.toMulEquiv diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Primality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Primality.lean index 758ab6adf5..e34f9dd35c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Primality.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality/Primality.lean @@ -39,7 +39,7 @@ variable {K : Type v} [Field K] [CharZero K] /-- `K((ℝ^{≤0}))` is pre-Schreier (Mathlib's `DecompositionMonoid`) because it is a GCD domain. -/ instance decompositionMonoid : DecompositionMonoid (Series K) := by - letI : GCDMonoid (Series K) := Classical.choice nonemptyGCDMonoid + let : GCDMonoid (Series K) := Classical.choice nonemptyGCDMonoid infer_instance /-- Every series is primal in `K((ℝ^{≤0}))`. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SeparatedSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SeparatedSupport.lean index cf7de49acd..6437d37834 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SeparatedSupport.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/SeparatedSupport.lean @@ -75,8 +75,8 @@ theorem pairwise_supportBelow_of_isChain {l : List R⟦G⟧} intro c hc simp only [List.mem_cons] at hc rcases hc with rfl | hc - · exact hchain.rel_head - · exact supportBelow_trans_of_ne_zero (hne b (by simp)) hchain.rel_head + · exact hchain.rel + · exact supportBelow_trans_of_ne_zero (hne b (by simp)) hchain.rel ((List.pairwise_cons.mp hpair).1 c hc) end Zero diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportGCD.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportGCD.lean index 7bf0093e37..00c14f8496 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportGCD.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportGCD.lean @@ -29,9 +29,11 @@ public noncomputable section namespace Tests +/-- The ring of rational finite-support Hahn series with nonpositive integer exponents. -/ abbrev IntegerNonpositiveFiniteSupportRing := HahnSeries.Nonpositive.finiteSupportSubring (G := ℤ) (K := ℚ) +/-- The ring of rational finite-support Hahn series with arbitrary integer exponents. -/ abbrev IntegerFiniteSupportRing := (HahnSeries.finiteSupportSubring : Subring ℚ⟦ℤ⟧) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportScalarExtension.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportScalarExtension.lean index 17820441ea..9f67b5d220 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportScalarExtension.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/FiniteSupportScalarExtension.lean @@ -65,7 +65,7 @@ theorem rationalFixture_negativeOne_coeff : ← HahnSeries.Nonpositive.smul_finiteSupport_eq_scalar_mul, map_add, map_smul] simp [HahnSeries.Nonpositive.finiteSupportCoefficients_apply, - HahnSeries.Nonpositive.coe_finiteSupportScalarHom, negativeOne, Finsupp.single_apply, Subtype.ext_iff] + HahnSeries.Nonpositive.coe_finiteSupportScalarHom, negativeOne] /-- The constant coefficient survives scalar extension and is mapped to `3 : ℚ`. -/ theorem rationalFixture_zero_coeff : @@ -75,7 +75,8 @@ theorem rationalFixture_zero_coeff : ← HahnSeries.Nonpositive.smul_finiteSupport_eq_scalar_mul, map_add, map_smul] simp [HahnSeries.Nonpositive.finiteSupportCoefficients_apply, - HahnSeries.Nonpositive.coe_finiteSupportScalarHom, negativeOne, Finsupp.single_apply, Subtype.ext_iff] + HahnSeries.Nonpositive.coe_finiteSupportScalarHom, negativeOne, + Subtype.ext_iff] /-- The scalar-extended integer fixture belongs to the image by construction. -/ theorem rationalFixture_mem_range : @@ -98,7 +99,7 @@ theorem rationalOutside_negativeOne_coeff : ← HahnSeries.Nonpositive.smul_finiteSupport_eq_scalar_mul, map_add, map_smul] simp [HahnSeries.Nonpositive.finiteSupportCoefficients_apply, - HahnSeries.Nonpositive.coe_finiteSupportScalarHom, negativeOne, Finsupp.single_apply, Subtype.ext_iff] + HahnSeries.Nonpositive.coe_finiteSupportScalarHom, negativeOne] /-- A nonintegral coefficient prevents membership in the image of integer scalar extension. -/ theorem rationalOutside_not_mem_range : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Fixtures/ApproachZero.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Fixtures/ApproachZero.lean index 35cd4a361f..00dfef92c8 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Fixtures/ApproachZero.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Fixtures/ApproachZero.lean @@ -143,7 +143,7 @@ theorem approachZero_supportOrderType : approachZero.supportOrderType = Ordinal.omega0 := by rw [HahnSeries.supportOrderType_eq_setOrderType] have e : approachZero.support ≃o ℕ := - (OrderIso.setCongr approachZero.support (Set.range approachZeroEmbedding) + (Set.orderIsoOfEq approachZero.support (Set.range approachZeroEmbedding) approachZero_support).trans approachZeroEmbedding.orderIso.symm exact approachZero.isPWO_support.orderType_eq_typeLT_of_orderIso e |>.trans Ordinal.type_nat_lt diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NonpositiveDomainEquiv.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NonpositiveDomainEquiv.lean index b6341bc22b..c13c99a24e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NonpositiveDomainEquiv.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NonpositiveDomainEquiv.lean @@ -23,9 +23,11 @@ namespace Tests open HahnSeries.Nonpositive +/-- The identity ordered additive equivalence of the integer exponent group. -/ def integerExponentEquiv : ℤ ≃+o ℤ := OrderAddMonoidIso.refl ℤ +/-- The rational monomial `7t⁻²` used to check reindexing by an exponent equivalence. -/ def negativeIntegerMonomial : HahnSeries.Nonpositive ℤ ℚ := single (-2) 7 (by omega) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NormalForm.lean index 97e97cdfc9..282781dae4 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NormalForm.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/NormalForm.lean @@ -155,7 +155,7 @@ private theorem unboundedSeries_supportOrderType : unboundedSeries.supportOrderType = Ordinal.omega0 := by rw [HahnSeries.supportOrderType_eq_setOrderType] have e : unboundedSeries.support ≃o ℕ := - (OrderIso.setCongr unboundedSeries.support (Set.range natCastEmbedding) + (Set.orderIsoOfEq unboundedSeries.support (Set.range natCastEmbedding) unboundedSeries_support).trans natCastEmbedding.orderIso.symm exact unboundedSeries.isPWO_support.orderType_eq_typeLT_of_orderIso e |>.trans Ordinal.type_nat_lt diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/OrderTypeDegree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/OrderTypeDegree.lean index 2c269c53ec..571120c37e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/OrderTypeDegree.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/OrderTypeDegree.lean @@ -166,7 +166,7 @@ theorem zeroOrderTypeSeries_degree : HahnSeries.degree_zero private instance : WellFoundedLT (Unit ⊕ₗ ℕ) := - (Sum.Lex.toLexRelIsoLT (α := Unit) (β := ℕ)).symm.toRelEmbedding.isWellFounded + (Sum.Lex.toLexRelIsoLT (α := Unit) (β := ℕ)).symm.toRelEmbedding.wellFounded' /-- The coefficient-one Hahn series on the ordered sum of `Unit` and `ℕ`. -/ def oneAddOmegaOrderTypeSeries : ℕ⟦Unit ⊕ₗ ℕ⟧ where @@ -186,7 +186,7 @@ theorem oneAddOmegaOrderTypeSeries_supportOrderType : calc oneAddOmegaOrderTypeSeries.supportOrderType = typeLT (Unit ⊕ₗ ℕ) := by let e : oneAddOmegaOrderTypeSeries.support ≃o Unit ⊕ₗ ℕ := - (OrderIso.setCongr oneAddOmegaOrderTypeSeries.support Set.univ + (Set.orderIsoOfEq oneAddOmegaOrderTypeSeries.support Set.univ oneAddOmegaOrderTypeSeries_support).trans (OrderIso.Set.univ (α := Unit ⊕ₗ ℕ)) exact HahnSeries.supportOrderType_eq_typeLT e @@ -214,7 +214,7 @@ theorem naturalOneAddOmega_ne_supportOrderType : exact (lt_add_one Ordinal.omega0).ne' (NatOrdinal.of.injective h) private instance : WellFoundedLT (ℕ ⊕ₗ ℕ) := - (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := ℕ)).symm.toRelEmbedding.isWellFounded + (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := ℕ)).symm.toRelEmbedding.wellFounded' /-- The coefficient-one Hahn series on the ordered sum of two copies of `ℕ`. -/ def omegaAddOmegaOrderTypeSeries : ℕ⟦ℕ ⊕ₗ ℕ⟧ where @@ -235,7 +235,7 @@ theorem omegaAddOmegaOrderTypeSeries_supportOrderType : calc omegaAddOmegaOrderTypeSeries.supportOrderType = typeLT (ℕ ⊕ₗ ℕ) := by let e : omegaAddOmegaOrderTypeSeries.support ≃o ℕ ⊕ₗ ℕ := - (OrderIso.setCongr omegaAddOmegaOrderTypeSeries.support Set.univ + (Set.orderIsoOfEq omegaAddOmegaOrderTypeSeries.support Set.univ omegaAddOmegaOrderTypeSeries_support).trans (OrderIso.Set.univ (α := ℕ ⊕ₗ ℕ)) exact HahnSeries.supportOrderType_eq_typeLT e @@ -251,7 +251,7 @@ theorem omegaAddOmegaOrderTypeSeries_degree : Ordinal.cantorDegree_omega_add_omega] private instance : WellFoundedLT (ℕ ⊕ₗ Unit) := - (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := Unit)).symm.toRelEmbedding.isWellFounded + (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := Unit)).symm.toRelEmbedding.wellFounded' /-- A coefficient-one Hahn series whose support has ordinary type `(ω + 1) * ω`. -/ def omegaSuccTimesOmegaOrderTypeSeries : ℕ⟦ℕ ×ₗ (ℕ ⊕ₗ Unit)⟧ where @@ -273,7 +273,7 @@ theorem omegaSuccTimesOmegaOrderTypeSeries_supportOrderType : omegaSuccTimesOmegaOrderTypeSeries.supportOrderType = typeLT (ℕ ×ₗ (ℕ ⊕ₗ Unit)) := by let e : omegaSuccTimesOmegaOrderTypeSeries.support ≃o ℕ ×ₗ (ℕ ⊕ₗ Unit) := - (OrderIso.setCongr omegaSuccTimesOmegaOrderTypeSeries.support Set.univ + (Set.orderIsoOfEq omegaSuccTimesOmegaOrderTypeSeries.support Set.univ omegaSuccTimesOmegaOrderTypeSeries_support).trans (OrderIso.Set.univ (α := ℕ ×ₗ (ℕ ⊕ₗ Unit))) exact HahnSeries.supportOrderType_eq_typeLT e @@ -298,8 +298,8 @@ theorem omegaSuccTimesOmegaOrderTypeSeries_supportOrderType : Ordinal.add_mul_of_isSuccLimit Ordinal.one_add_omega0 Ordinal.isSuccLimit_omega0 _ = Ordinal.omega0 ^ (2 : Ordinal) := by - have hsucc : Order.succ (1 : Ordinal) = 2 := one_add_one_eq_two - rw [← hsucc, Ordinal.opow_succ, Ordinal.opow_one] + have hsucc : (1 : Ordinal) + 1 = 2 := one_add_one_eq_two + rw [← hsucc, Ordinal.opow_add_one, Ordinal.opow_one] /-- A support of ordinary ordinal type `ω²` has degree two. -/ theorem omegaSuccTimesOmegaOrderTypeSeries_degree : @@ -324,8 +324,8 @@ theorem naturalOmegaSuccTimesOmega_ne_supportOrderType : mul_lt_mul_of_pos_right hfactor homega have hord : Ordinal.omega0 * Ordinal.omega0 = Ordinal.omega0 ^ (2 : Ordinal) := by - have hsucc : Order.succ (1 : Ordinal) = 2 := one_add_one_eq_two - rw [← hsucc, Ordinal.opow_succ, Ordinal.opow_one] + have hsucc : (1 : Ordinal) + 1 = 2 := one_add_one_eq_two + rw [← hsucc, Ordinal.opow_add_one, Ordinal.opow_one] have hordinary : NatOrdinal.of (Ordinal.omega0 ^ (2 : Ordinal)) ≤ NatOrdinal.of Ordinal.omega0 * NatOrdinal.of Ordinal.omega0 := by rw [← hord] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Truncation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Truncation.lean index c9e1c8d2ad..0821b8bd8c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Truncation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Truncation.lean @@ -56,7 +56,7 @@ theorem threeTermTruncationSeries_support_truncLT : (HahnSeries.truncLT 0 threeTermTruncationSeries).support = {-1} := by rw [HahnSeries.support_truncLT, threeTermTruncationSeries_support] ext z - simp only [Set.mem_setOf_eq, Set.mem_insert_iff, Set.mem_singleton_iff] + simp only [Set.mem_ofPred_eq, Set.mem_insert_iff, Set.mem_singleton_iff] omega /-- Weak lower truncation at zero keeps exactly the exponents `-1` and `0`. -/ @@ -64,7 +64,7 @@ theorem threeTermTruncationSeries_support_truncLE : (HahnSeries.truncLE 0 threeTermTruncationSeries).support = {-1, 0} := by rw [HahnSeries.support_truncLE, threeTermTruncationSeries_support] ext z - simp only [Set.mem_setOf_eq, Set.mem_insert_iff, Set.mem_singleton_iff] + simp only [Set.mem_ofPred_eq, Set.mem_insert_iff, Set.mem_singleton_iff] omega /-- Weak upper truncation at zero keeps exactly the exponents `0` and `1`. -/ @@ -72,7 +72,7 @@ theorem threeTermTruncationSeries_support_truncGE : (HahnSeries.truncGE 0 threeTermTruncationSeries).support = {0, 1} := by rw [HahnSeries.support_truncGE, threeTermTruncationSeries_support] ext z - simp only [Set.mem_setOf_eq, Set.mem_insert_iff, Set.mem_singleton_iff] + simp only [Set.mem_ofPred_eq, Set.mem_insert_iff, Set.mem_singleton_iff] omega /-- Strict upper truncation at zero keeps exactly the exponent `1`. -/ @@ -80,7 +80,7 @@ theorem threeTermTruncationSeries_support_truncGT : (HahnSeries.truncGT 0 threeTermTruncationSeries).support = {1} := by rw [HahnSeries.support_truncGT, threeTermTruncationSeries_support] ext z - simp only [Set.mem_setOf_eq, Set.mem_insert_iff, Set.mem_singleton_iff] + simp only [Set.mem_ofPred_eq, Set.mem_insert_iff, Set.mem_singleton_iff] omega /-- At the cut exponent, the weak truncations keep the coefficient and the strict truncations @@ -135,14 +135,14 @@ theorem threeTermTruncationSeries_boundary_truncations : rw [← HahnSeries.support_eq_empty_iff, HahnSeries.support_truncLT, threeTermTruncationSeries_support] ext z - simp only [Set.mem_setOf_eq, Set.mem_empty_iff_false, iff_false, Set.mem_insert_iff, + simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false, iff_false, Set.mem_insert_iff, Set.mem_singleton_iff] omega have hgt : HahnSeries.truncGT 1 threeTermTruncationSeries = 0 := by rw [← HahnSeries.support_eq_empty_iff, HahnSeries.support_truncGT, threeTermTruncationSeries_support] ext z - simp only [Set.mem_setOf_eq, Set.mem_empty_iff_false, iff_false, Set.mem_insert_iff, + simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false, iff_false, Set.mem_insert_iff, Set.mem_singleton_iff] omega refine ⟨hlt, ?_, ?_, hgt⟩ @@ -170,7 +170,7 @@ theorem threeTermTruncationSeries_decomposition_unique (x y : ℚ⟦ℤ⟧) exact hsum.trans (HahnSeries.truncLE_add_truncGT 0 threeTermTruncationSeries).symm private instance : WellFoundedLT (Unit ⊕ₗ ℕ) := - (Sum.Lex.toLexRelIsoLT (α := Unit) (β := ℕ)).symm.toRelEmbedding.isWellFounded + (Sum.Lex.toLexRelIsoLT (α := Unit) (β := ℕ)).symm.toRelEmbedding.wellFounded' /-- The coefficient-one series on an ordered singleton followed by `ℕ`. -/ def oneAddOmegaSplitSeries : ℚ⟦Unit ⊕ₗ ℕ⟧ where @@ -226,7 +226,7 @@ private theorem oneAddOmegaUpper_support : oneAddOmegaUpper.support = Set.range private theorem oneAddOmegaLower_supportOrderType : oneAddOmegaLower.supportOrderType = 1 := by rw [HahnSeries.supportOrderType_eq_setOrderType] have e : oneAddOmegaLower.support ≃o Unit := - (OrderIso.setCongr oneAddOmegaLower.support (Set.range Sum.inlₗ) + (Set.orderIsoOfEq oneAddOmegaLower.support (Set.range Sum.inlₗ) oneAddOmegaLower_support).trans (OrderEmbedding.ofStrictMono Sum.inlₗ Sum.Lex.inl_strictMono).orderIso.symm exact oneAddOmegaLower.isPWO_support.orderType_eq_typeLT_of_orderIso e |>.trans @@ -236,7 +236,7 @@ private theorem oneAddOmegaUpper_supportOrderType : oneAddOmegaUpper.supportOrderType = Ordinal.omega0 := by rw [HahnSeries.supportOrderType_eq_setOrderType] have e : oneAddOmegaUpper.support ≃o ℕ := - (OrderIso.setCongr oneAddOmegaUpper.support (Set.range Sum.inrₗ) + (Set.orderIsoOfEq oneAddOmegaUpper.support (Set.range Sum.inrₗ) oneAddOmegaUpper_support).trans (OrderEmbedding.ofStrictMono Sum.inrₗ Sum.Lex.inr_strictMono).orderIso.symm exact oneAddOmegaUpper.isPWO_support.orderType_eq_typeLT_of_orderIso e |>.trans diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/WeakNormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/WeakNormalForm.lean index d758bb865a..e9c367dc91 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/WeakNormalForm.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/WeakNormalForm.lean @@ -59,7 +59,7 @@ theorem zero_weakNormalForm : simp [List.sortedGE_iff_pairwise] private instance : WellFoundedLT (ℕ ⊕ₗ ℕ) := - (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := ℕ)).symm.toRelEmbedding.isWellFounded + (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := ℕ)).symm.toRelEmbedding.wellFounded' /-- The coefficient-one Hahn series on the lexicographic sum of two copies of `ℕ`. -/ def twoOmegaSeries : ℚ⟦ℕ ⊕ₗ ℕ⟧ where @@ -113,7 +113,7 @@ private theorem twoOmegaLower_supportOrderType : twoOmegaLower.supportOrderType = Ordinal.omega0 := by rw [HahnSeries.supportOrderType_eq_setOrderType] have e : twoOmegaLower.support ≃o ℕ := - (OrderIso.setCongr twoOmegaLower.support (Set.range Sum.inlₗ) + (Set.orderIsoOfEq twoOmegaLower.support (Set.range Sum.inlₗ) twoOmegaLower_support).trans (OrderEmbedding.ofStrictMono Sum.inlₗ Sum.Lex.inl_strictMono).orderIso.symm exact twoOmegaLower.isPWO_support.orderType_eq_typeLT_of_orderIso e |>.trans @@ -123,7 +123,7 @@ private theorem twoOmegaUpper_supportOrderType : twoOmegaUpper.supportOrderType = Ordinal.omega0 := by rw [HahnSeries.supportOrderType_eq_setOrderType] have e : twoOmegaUpper.support ≃o ℕ := - (OrderIso.setCongr twoOmegaUpper.support (Set.range Sum.inrₗ) + (Set.orderIsoOfEq twoOmegaUpper.support (Set.range Sum.inrₗ) twoOmegaUpper_support).trans (OrderEmbedding.ofStrictMono Sum.inrₗ Sum.Lex.inr_strictMono).orderIso.symm exact twoOmegaUpper.isPWO_support.orderType_eq_typeLT_of_orderIso e |>.trans diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Translation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Translation.lean index 873ae8b4f5..1c6d7bf09c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Translation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Translation.lean @@ -72,9 +72,9 @@ variable [LinearOrder G] [LinearOrder H] [AddMonoid R] theorem supportOrderType_embDomainAddEquiv (e : G ≃o H) (x : R⟦G⟧) : (embDomainAddEquiv e x).supportOrderType = x.supportOrderType := by rw [supportOrderType_eq_setOrderType, supportOrderType_eq_setOrderType] - letI : WellFoundedLT x.support := x.isWF_support + let : WellFoundedLT x.support := x.isWF_support let supportEquiv : (embDomainAddEquiv e x).support ≃o x.support := - (OrderIso.setCongr _ (e '' x.support) (support_embDomain e.toOrderEmbedding x)).trans + (Set.orderIsoOfEq _ (e '' x.support) (support_embDomain e.toOrderEmbedding x)).trans (StrictMonoOn.orderIso e x.support (e.strictMono.strictMonoOn x.support)).symm exact (embDomainAddEquiv e x).isPWO_support.orderType_eq_typeLT_of_orderIso supportEquiv |>.trans (x.isPWO_support.orderType_eq_typeLT_of_orderIso (OrderIso.refl x.support)).symm diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/WeakNormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/WeakNormalForm.lean index d915595fb3..764722b127 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/WeakNormalForm.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/WeakNormalForm.lean @@ -210,7 +210,7 @@ theorem exists_nonzero_isWeaklyPrincipal_truncGE [Zero G] {x : R⟦G⟧} (hx : x have hprefixTrunc : truncGE last.order blocks.dropLast.sum = 0 := by rw [← support_eq_empty_iff, support_truncGE] ext i - simp only [Set.mem_setOf_eq, Set.mem_empty_iff_false, iff_false, not_and] + simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false, iff_false, not_and] intro hi exact fun hle ↦ (not_lt_of_ge hle) (hprefixBelow.lt hi hlastOrderMem) have hlastTrunc : truncGE last.order last = last := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/FiniteSpanRelation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/FiniteSpanRelation.lean index fb44c7568e..a2a4a29b62 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/FiniteSpanRelation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/FiniteSpanRelation.lean @@ -36,7 +36,7 @@ theorem exists_nontrivial_relation_of_mem_span_range {ι : Type w} [Fintype ι] have hw' : LinearIndependent K w' := by refine LinearIndependent.of_comp (Submodule.span K (Set.range gens)).subtype ?_ exact hrel - haveI : Module.Finite K (Submodule.span K (Set.range gens)) := + have : Module.Finite K (Submodule.span K (Set.range gens)) := Module.Finite.span_of_finite K (Set.finite_range gens) have hle := hw'.fintype_card_le_finrank have hrank := finrank_range_le_card (R := K) gens diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/Content.lean b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/Content.lean index c4bad8bfa5..2626069f0e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/Content.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/Content.lean @@ -73,8 +73,7 @@ theorem rTensor_mulRightFactor (f : V →ₗ[K] W) (q : D) (z : V ⊗[K] D) : f.rTensor D (mulRightFactor (K := K) q z) = mulRightFactor (K := K) q (f.rTensor D z) := by - induction z using TensorProduct.induction_on with - | zero => simp + induction z using TensorProduct.inductionOn with | tmul y d => simp | add y z hy hz => simp [map_add, hy, hz] @@ -173,8 +172,7 @@ private theorem contentCoordinates_mulRightFactor_apply contentCoordinates (K := K) (D := D) (V := V) (mulRightFactor (K := K) q z) i = q * contentCoordinates (K := K) (D := D) (V := V) z i := by - induction z using TensorProduct.induction_on with - | zero => simp [mulRightFactor] + induction z using TensorProduct.inductionOn with | tmul x d => rw [mulRightFactor_tmul] simp only [contentCoordinates, @@ -269,8 +267,8 @@ private noncomputable def contentAux private theorem contentAux_isContent (gcdStructure : GCDMonoid D) (z : V ⊗[K] D) : IsContent z (contentAux gcdStructure z) := by - letI : GCDMonoid D := gcdStructure - letI : NormalizedGCDMonoid (Associates D) := + let : GCDMonoid D := gcdStructure + let : NormalizedGCDMonoid (Associates D) := normalizedAssociatesGCDMonoid gcdStructure intro q change Associates.mk q ∣ contentAux gcdStructure z ↔ _ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Archimedean.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Archimedean.lean index 060ed8a957..4e33117607 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Archimedean.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Archimedean.lean @@ -9,7 +9,7 @@ public import Mathlib.Algebra.Order.Archimedean.Basic public import Mathlib.Data.Set.Countable public import Mathlib.Order.WellFoundedSet -import Mathlib.Data.Real.Embedding +import Mathlib.Basic.Real.Embedding import Mathlib.Topology.Order.Basic import Mathlib.Topology.Instances.Real.Lemmas diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory/LocalizationUFM.lean b/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory/LocalizationUFM.lean index c1a449d57b..fa8ac216a9 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory/LocalizationUFM.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory/LocalizationUFM.lean @@ -79,7 +79,7 @@ theorem prime_algebraMap_of_prime (hS : S ≤ nonZeroDivisors A) {p : A} (hp : P omit [IsDomain A] [IsDomain B] in /-- Mapping a list of primes into the localization and dropping those that become units leaves a prime factorisation of the image. -/ -private theorem exists_prime_factors_algebraMap [UniqueFactorizationMonoid A] +private theorem exists_prime_factors_algebraMap (hS : S ≤ nonZeroDivisors A) (f : Multiset A) (hf : ∀ p ∈ f, Prime p) : ∃ g : Multiset B, (∀ q ∈ g, Prime q) ∧ Associated g.prod (algebraMap A B f.prod) := by induction f using Multiset.induction with diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorBendixson.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorBendixson.lean index 38e17da50b..ee627ba173 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorBendixson.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/CantorBendixson.lean @@ -79,7 +79,7 @@ private theorem derivedSet_univ_eq : derivedSet (Set.univ : Set Ordinal.{u}) = {x | IsSuccLimit x} := by ext x rw [mem_derivedSet, AccPt] - simp only [principal_univ, inf_top_eq, mem_setOf_eq] + simp only [principal_univ, inf_top_eq, Set.mem_ofPred_eq] rw [← not_iff_not, not_neBot, ← isOpen_singleton_iff_punctured_nhds] exact SuccOrder.isOpen_singleton_iff @@ -95,6 +95,7 @@ private theorem derivedSet_Ioi_zero_eq : (Set.Infinite.of_accPt h) rw [← derivedSet_univ_eq, huniv, derivedSet_union, hsingle, empty_union] +/-- The positive ordinal multiples `ω ^ a * q`, with `q > 0`. -/ def positivePrincipalMultiples (a : Ordinal.{u}) : Set Ordinal.{u} := (fun x ↦ omega0 ^ a * x) '' Ioi 0 @@ -132,7 +133,7 @@ private theorem derivedSet_positivePrincipalMultiples (a : Ordinal.{u}) : exact pos_iff_ne_zero.mpr fun hz ↦ hy.ne_bot (by simp [hz]) · symm change omega0 ^ a * (omega0 * z) = omega0 ^ (a + 1) * z - rw [show a + 1 = Order.succ a by simp, opow_succ, mul_assoc] + rw [Ordinal.opow_add_one, mul_assoc] · rintro ⟨z, hz, rfl⟩ refine ⟨omega0 * z, ?_, ?_⟩ · change IsSuccLimit (omega0 * z) @@ -141,7 +142,7 @@ private theorem derivedSet_positivePrincipalMultiples (a : Ordinal.{u}) : rw [isMin_iff_eq_bot, Ordinal.bot_eq_zero] exact mul_ne_zero omega0_ne_zero hz.ne' · change omega0 ^ a * (omega0 * z) = omega0 ^ (a + 1) * z - rw [show a + 1 = Order.succ a by simp, opow_succ, mul_assoc] + rw [Ordinal.opow_add_one, mul_assoc] private theorem iInter_positivePrincipalMultiples {a : Ordinal.{u}} (ha : IsSuccLimit a) : (⋂ i : Iio a, positivePrincipalMultiples i.1) = positivePrincipalMultiples a := by @@ -216,7 +217,7 @@ theorem cantorBendixson_top_eq (a : Ordinal.{u}) : rw [ih] by_cases ha : a = 0 · subst a - simp only [zero_add, if_true, ite_eq_right one_ne_zero] + simp only [zero_add, ite_true, ite_eq_right one_ne_zero] rw [derivedSet_univ_eq, ← derivedSet_Ioi_zero_eq, ← positivePrincipalMultiples_zero, derivedSet_positivePrincipalMultiples] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Degree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Degree.lean index 0b635f2a23..5b389d4f66 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Degree.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Degree.lean @@ -111,7 +111,7 @@ theorem cantorDegree_omega_add_omega : simpa only [opow_one, Ordinal.mul_two, hlogTwo, add_zero] using log_opow_mul one_lt_omega0 1 htwo have hne : (ω : Ordinal.{u}) + ω ≠ 0 := fun h ↦ - omega0_ne_zero (left_eq_zero_of_add_eq_zero h) + omega0_ne_zero (eq_zero_of_add_right h) rw [cantorDegree_of_ne_zero hne, hlog] rfl diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/LeastTerm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/LeastTerm.lean index 95f02e543e..2ee50cb2f2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/LeastTerm.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/LeastTerm.lean @@ -25,9 +25,12 @@ public noncomputable section namespace NatOrdinal +/-- The final additive-principal term of the ordinal, or zero when the ordinal is zero. -/ def leastTerm (a : NatOrdinal.{u}) : NatOrdinal.{u} := NatOrdinal.of (a.val.additivePrincipalTerms.getLastD 0) +/-- The ordinal obtained by removing the final additive-principal term from its Cantor +decomposition. -/ def removeLeastTerm (a : NatOrdinal.{u}) : NatOrdinal.{u} := NatOrdinal.of a.val.additivePrincipalTerms.dropLast.sum diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/OrderedUnion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/OrderedUnion.lean index 3bd7351604..296c336e6e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/OrderedUnion.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/OrderedUnion.lean @@ -38,7 +38,7 @@ theorem typeLT_range_succ_toType (l : Ordinal.{u}) (hl : IsSuccLimit l) : have hpre : IsSuccPrelimit (typeLT l.ToType) := by rw [type_toType] exact hl.isSuccPrelimit - letI : NoMaxOrder l.ToType := isSuccPrelimit_type_lt_iff.mp hpre + let : NoMaxOrder l.ToType := isSuccPrelimit_type_lt_iff.mp hpre let f : l.ToType → Set.range (Order.succ : l.ToType → l.ToType) := fun i ↦ ⟨Order.succ i, ⟨i, rfl⟩⟩ have hf : StrictMono f := fun _ _ hij ↦ Order.succ_strictMono hij @@ -85,7 +85,7 @@ theorem mul_le_orderType_iUnion_of_isSuccLimit have hpre : IsSuccPrelimit (typeLT l.ToType) := by rw [type_toType] exact hl.isSuccPrelimit - letI : NoMaxOrder l.ToType := isSuccPrelimit_type_lt_iff.mp hpre + let : NoMaxOrder l.ToType := isSuccPrelimit_type_lt_iff.mp hpre let predecessor : successorRange l → l.ToType := fun i ↦ Classical.choose i.2 have successor_predecessor (i : successorRange l) : @@ -118,7 +118,7 @@ theorem mul_le_orderType_iUnion_of_isSuccLimit have block_embedding_exists (i : successorRange l) : Nonempty (ρ.ToType ↪o separatedBlock B i.1) := by let hblock := block_isPWO i - letI : WellFoundedLT (separatedBlock B i.1) := hblock.isWF + let : WellFoundedLT (separatedBlock B i.1) := hblock.isWF have hle : typeLT ρ.ToType ≤ typeLT (separatedBlock B i.1) := by calc typeLT ρ.ToType = ρ := type_toType ρ @@ -154,7 +154,7 @@ theorem mul_le_orderType_iUnion_of_isSuccLimit change type (Prod.Lex (· < · : successorRange l → successorRange l → Prop) (· < · : ρ.ToType → ρ.ToType → Prop)) = ρ * l rw [type_prod_lex, type_toType, successorRange_orderType l hl] - letI : WellFoundedLT (⋃ i, B i) := hUnion.isWF + let : WellFoundedLT (⋃ i, B i) := hUnion.isWF calc ρ * l = typeLT (successorRange l ×ₗ ρ.ToType) := hdomain.symm _ ≤ typeLT (⋃ i, B i) := unionEmbedding.ltEmbedding.ordinal_type_le diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/SetOrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/SetOrderType.lean index cf568ac8e6..7740e5570d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/SetOrderType.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/SetOrderType.lean @@ -40,11 +40,11 @@ open Ordinal variable {α : Type u} [LinearOrder α] {s t : Set α} -@[reducible] private def isWellOrder (hs : s.IsPWO) : - IsWellOrder s (Subrel (· < ·) (· ∈ s)) where - wf := hs.isWF - trichotomous := fun _ _ hab hba ↦ - Subtype.ext (le_antisymm (le_of_not_gt hba) (le_of_not_gt hab)) +private theorem isWellOrder (hs : s.IsPWO) : + IsWellOrder s (Subrel (· < ·) (· ∈ s)) := + { wf := hs.isWF + trichotomous := fun _ _ hab hba ↦ + Subtype.ext (le_antisymm (le_of_not_gt hba) (le_of_not_gt hab)) } /-- The ordinary ordinal order type of a partially well-ordered subset of a linear order. -/ def orderType (hs : s.IsPWO) : Ordinal.{u} := @@ -64,7 +64,7 @@ theorem orderType_proof_irrel (hs ht : s.IsPWO) : hs.orderType = ht.orderType := /-- A partially well-ordered set has order type zero exactly when it is empty. -/ @[simp] theorem orderType_eq_zero (hs : s.IsPWO) : hs.orderType = 0 ↔ s = ∅ := by - letI := isWellOrder hs + let := isWellOrder hs rw [orderType, Ordinal.type_eq_zero_iff_isEmpty, isEmpty_subtype] exact Set.eq_empty_iff_forall_notMem.symm @@ -76,7 +76,7 @@ theorem orderType_eq_typeLT [WellFoundedLT α] (hs : s.IsPWO) : /-- Compute the order type through an order isomorphism from the set to a well-ordered type. -/ theorem orderType_eq_typeLT_of_orderIso {A : Type u} [LinearOrder A] [WellFoundedLT A] (hs : s.IsPWO) (e : s ≃o A) : hs.orderType = typeLT A := by - letI := isWellOrder hs + let := isWellOrder hs let er : Subrel (· < ·) (· ∈ s) ≃r (· < · : A → A → Prop) := e.toRelIsoLT exact er.ordinalType_congr @@ -84,7 +84,7 @@ theorem orderType_eq_typeLT_of_orderIso {A : Type u} [LinearOrder A] [WellFounde /-- A partially well-ordered set is order-isomorphic to the canonical well order of its ordinary order type. -/ theorem nonempty_orderIso_toType (hs : s.IsPWO) : Nonempty (hs.orderType.ToType ≃o s) := by - letI : WellFoundedLT s := hs.isWF + let : WellFoundedLT s := hs.isWF have htypes : typeLT hs.orderType.ToType = typeLT s := by rw [type_toType] exact hs.orderType_eq_typeLT_of_orderIso (OrderIso.refl s) @@ -96,7 +96,7 @@ theorem orderType_eq_type_of_relIso {A : Type u} {r : A → A → Prop} [IsWellOrder A r] (hs : s.IsPWO) (e : Subrel (· < ·) (· ∈ s) ≃r r) : hs.orderType = Ordinal.type r := by - letI := isWellOrder hs + let := isWellOrder hs exact e.ordinalType_congr /-- Equal subsets have equal order types. -/ @@ -108,8 +108,8 @@ theorem orderType_congr (hs : s.IsPWO) (ht : t.IsPWO) (h : s = t) : /-- Inclusion of partially well-ordered subsets cannot decrease their ordinary order type. -/ theorem orderType_mono (hs : s.IsPWO) (ht : t.IsPWO) (h : s ⊆ t) : hs.orderType ≤ ht.orderType := by - letI := isWellOrder hs - letI := isWellOrder ht + let := isWellOrder hs + let := isWellOrder ht exact (Subrel.inclusionEmbedding (· < ·) h).ordinal_type_le /-- A strictly increasing image has the same ordinary order type as the original partially @@ -117,7 +117,7 @@ well-ordered set. -/ theorem orderType_image_of_strictMonoOn {B : Type u} [LinearOrder B] (hs : s.IsPWO) {f : α → B} (hf : StrictMonoOn f s) : (hs.image_of_monotoneOn hf.monotoneOn).orderType = hs.orderType := by - letI : WellFoundedLT s := hs.isWF + let : WellFoundedLT s := hs.isWF let e : s ≃o f '' s := StrictMonoOn.orderIso f s hf exact @@ -137,8 +137,8 @@ theorem orderType_eq_add_iff (hs : s.IsPWO) (a b : Ordinal.{u}) : s = s₀ ∪ s₁ := by constructor · intro htype - letI : WellFoundedLT s := hs.isWF - letI : WellFoundedLT (a.ToType ⊕ₗ b.ToType) := + let : WellFoundedLT s := hs.isWF + let : WellFoundedLT (a.ToType ⊕ₗ b.ToType) := Sum.lex_wf wellFounded_lt wellFounded_lt have htypes : typeLT s = typeLT (a.ToType ⊕ₗ b.ToType) := by calc @@ -224,9 +224,9 @@ theorem orderType_eq_add_iff (hs : s.IsPWO) (a b : Ordinal.{u}) : · exact ⟨Sum.inlₗ ⟨x, hx⟩, rfl⟩ · exact ⟨Sum.inrₗ ⟨x, hx⟩, rfl⟩ let e : s₀ ⊕ₗ s₁ ≃o s := hf.orderIsoOfSurjective f hsurj - letI : WellFoundedLT s₀ := hs₀.isWF - letI : WellFoundedLT s₁ := hs₁.isWF - letI : WellFoundedLT (s₀ ⊕ₗ s₁) := + let : WellFoundedLT s₀ := hs₀.isWF + let : WellFoundedLT s₁ := hs₁.isWF + let : WellFoundedLT (s₀ ⊕ₗ s₁) := Sum.lex_wf wellFounded_lt wellFounded_lt calc hs.orderType = typeLT (s₀ ⊕ₗ s₁) := @@ -240,7 +240,7 @@ theorem orderType_eq_add_iff (hs : s.IsPWO) (a b : Ordinal.{u}) : /-- A partially well-ordered set is finite exactly when its order type is below `ω`. -/ theorem finite_iff_orderType_lt_omega (hs : s.IsPWO) : s.Finite ↔ hs.orderType < Ordinal.omega0 := by - letI := isWellOrder hs + let := isWellOrder hs rw [Set.Finite, ← Cardinal.mk_lt_aleph0_iff] rw [orderType, ← Ordinal.card_type (Subrel (· < ·) (· ∈ s)), Ordinal.card_lt_aleph0] @@ -313,7 +313,7 @@ theorem orderType_inter_Iio_eq_typein [WellFoundedLT s] (hs : s.IsPWO) {x : α} (hx : x ∈ s) : (hs.mono (s := s ∩ Set.Iio x) Set.inter_subset_left).orderType = Ordinal.typein (· < · : s → s → Prop) ⟨x, hx⟩ := by - letI : WellFoundedLT s := hs.isWF + let : WellFoundedLT s := hs.isWF rw [orderType_eq_typeLT_of_orderIso _ (interIioOrderIso hx), ← Ordinal.type_Iio_lt] /-- Splitting a partially well-ordered set at one of its elements splits its order type. -/ @@ -322,7 +322,7 @@ theorem orderType_inter_Iio_add_inter_Ici [WellFoundedLT s] (hs.mono (s := s ∩ Set.Iio x) Set.inter_subset_left).orderType + (hs.mono (s := s ∩ Set.Ici x) Set.inter_subset_left).orderType = hs.orderType := by - letI : WellFoundedLT (Set.Iio (⟨x, hx⟩ : s) ⊕ₗ Set.Ici (⟨x, hx⟩ : s)) := + let : WellFoundedLT (Set.Iio (⟨x, hx⟩ : s) ⊕ₗ Set.Ici (⟨x, hx⟩ : s)) := Sum.lex_wf wellFounded_lt wellFounded_lt rw [orderType_eq_typeLT_of_orderIso _ (interIioOrderIso hx), orderType_eq_typeLT_of_orderIso _ (interIciOrderIso hx), @@ -339,7 +339,7 @@ theorem exists_orderType_inter_Iio_eq (hs : s.IsPWO) {k : Ordinal.{u}} (hk : k < hs.orderType) : ∃ x, ∃ _ : x ∈ s, (hs.mono (s := s ∩ Set.Iio x) Set.inter_subset_left).orderType = k := by - letI : WellFoundedLT s := hs.isWF + let : WellFoundedLT s := hs.isWF have htype : k < Ordinal.type (· < · : s → s → Prop) := by rwa [← hs.orderType_eq_typeLT_of_orderIso (OrderIso.refl s)] obtain ⟨y, hy⟩ := Ordinal.typein_surj (· < · : s → s → Prop) htype @@ -349,9 +349,9 @@ theorem exists_orderType_inter_Iio_eq (hs : s.IsPWO) {k : Ordinal.{u}} order type. -/ theorem orderType_inter_Iio_lt (hs : s.IsPWO) {x : α} (hx : x ∈ s) : (hs.mono (s := s ∩ Set.Iio x) Set.inter_subset_left).orderType < hs.orderType := by - letI := isWellOrder hs + let := isWellOrder hs let hbelow := hs.mono (s := s ∩ Set.Iio x) Set.inter_subset_left - letI := isWellOrder hbelow + let := isWellOrder hbelow calc hbelow.orderType = Ordinal.type (Subrel (Subrel (· < ·) (· ∈ s)) @@ -369,11 +369,11 @@ theorem orderType_le_of_forall_inter_Iic_lt (hs : s.IsPWO) {o : Ordinal} hs.orderType ≤ o := by by_contra hle have ho : o < hs.orderType := lt_of_not_ge hle - letI := isWellOrder hs + let := isWellOrder hs obtain ⟨x, hx⟩ := Ordinal.typein_surj (Subrel (· < ·) (· ∈ s)) ho let hbelow := hs.mono (s := s ∩ Set.Iio x.1) Set.inter_subset_left - letI := isWellOrder hbelow + let := isWellOrder hbelow have hiio : (hs.mono (s := s ∩ Set.Iio x.1) Set.inter_subset_left).orderType = o := by calc @@ -397,12 +397,12 @@ theorem exists_gt_of_isSuccLimit_orderType (hs : s.IsPWO) (hlimit : Order.IsSuccLimit hs.orderType) {x : α} (hx : x ∈ s) : ∃ y ∈ s, x < y := by - letI : WellFoundedLT s := hs.isWF + let : WellFoundedLT s := hs.isWF have hprelimit : Order.IsSuccPrelimit (Ordinal.type (fun x y : s ↦ x < y)) := by rw [← hs.orderType_eq_typeLT_of_orderIso (OrderIso.refl s)] exact hlimit.isSuccPrelimit - letI : NoMaxOrder s := + let : NoMaxOrder s := Ordinal.isSuccPrelimit_type_lt_iff.mp hprelimit obtain ⟨y, hxy⟩ : ∃ y : s, (⟨x, hx⟩ : s) < y := exists_gt (⟨x, hx⟩ : s) @@ -413,7 +413,7 @@ the converse of `Set.IsPWO.exists_gt_of_isSuccLimit_orderType`. -/ theorem isSuccLimit_orderType_of_forall_exists_gt (hs : s.IsPWO) (hne : s.Nonempty) (hgt : ∀ x ∈ s, ∃ y ∈ s, x < y) : Order.IsSuccLimit hs.orderType := by - letI : WellFoundedLT s := hs.isWF + let : WellFoundedLT s := hs.isWF have hnomax : NoMaxOrder s := by constructor rintro ⟨x, hx⟩ @@ -606,7 +606,7 @@ theorem orderType_union_le_naturalAdd (hs : s.IsPWO) (ht : t.IsPWO) : let e : Subrel (· < ·) (· ∈ s ∪ t) ↪r (· < · : total.val.ToType → total.val.ToType → Prop) := RelEmbedding.ofMonotone rank fun _ _ hxy ↦ rank_strict hxy - letI := isWellOrder (hs.union ht) + let := isWellOrder (hs.union ht) change Ordinal.type (Subrel (· < ·) (· ∈ s ∪ t)) ≤ total.val simpa only [Ordinal.type_toType] using e.ordinal_type_le diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Sumset.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Sumset.lean index 50ea005fb5..a658f101bb 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Sumset.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Sumset.lean @@ -45,7 +45,7 @@ private theorem orderType_le_of_forall_inter_Iio_lt (hs : s.IsPWO) {o : Ordinal} hs.orderType ≤ o := by apply le_of_forall_lt intro c hc - letI : WellFoundedLT s := hs.isWF + let : WellFoundedLT s := hs.isWF have hType : typeLT s = hs.orderType := (orderType_eq_typeLT_of_orderIso hs (OrderIso.refl s)).symm have hc' : c < typeLT s := hc.trans_eq hType.symm @@ -70,7 +70,7 @@ private theorem exists_naturalAdd_split (hs : s.IsPWO) (hzero : hs.orderType ≠ rw [hp.symm] exact Ordinal.isPrincipal_add_omega0_opow d have hp_lt : p < hs.orderType := hp_le.lt_of_ne hp_ne - letI : WellFoundedLT s := hs.isWF + let : WellFoundedLT s := hs.isWF have hType : typeLT s = hs.orderType := (orderType_eq_typeLT_of_orderIso hs (OrderIso.refl s)).symm have hp_type : p < typeLT s := hp_lt.trans_eq hType.symm diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/SetOrderType.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/SetOrderType.lean index 6a816fa42e..feb7ccc71c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/SetOrderType.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/SetOrderType.lean @@ -26,7 +26,7 @@ namespace Tests open Ordinal private instance : WellFoundedLT (ℕ ⊕ₗ Unit) := - (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := Unit)).symm.toRelEmbedding.isWellFounded + (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := Unit)).symm.toRelEmbedding.wellFounded' private def initialOmega : Set (ℕ ⊕ₗ Unit) := Set.range (fun n : ℕ ↦ Sum.inlₗ n) @@ -52,7 +52,7 @@ private theorem finalPoint_union_initialOmega : cases x <;> simp [finalPoint, initialOmega] private def unionOrderIso : ↥(finalPoint ∪ initialOmega) ≃o (ℕ ⊕ₗ Unit) := - (OrderIso.setCongr _ _ finalPoint_union_initialOmega).trans OrderIso.Set.univ + (Set.orderIsoOfEq _ _ finalPoint_union_initialOmega).trans OrderIso.Set.univ private theorem initialOmega_orderType : (Set.IsPWO.of_linearOrder initialOmega).orderType = Ordinal.omega0 := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/Sumset.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/Sumset.lean index 6e49917c46..bc51308a74 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/Sumset.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests/Sumset.lean @@ -35,10 +35,10 @@ open scoped Pointwise namespace Tests private instance : WellFoundedLT (ℕ ⊕ₗ Unit) := - (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := Unit)).symm.toRelEmbedding.isWellFounded + (Sum.Lex.toLexRelIsoLT (α := ℕ) (β := Unit)).symm.toRelEmbedding.wellFounded' private instance : WellFoundedLT ((ℕ ×ₗ ℕ) ⊕ₗ ℕ) := - (Sum.Lex.toLexRelIsoLT (α := ℕ ×ₗ ℕ) (β := ℕ)).symm.toRelEmbedding.isWellFounded + (Sum.Lex.toLexRelIsoLT (α := ℕ ×ₗ ℕ) (β := ℕ)).symm.toRelEmbedding.wellFounded' private abbrev SumsetExponentGroup := ℤ ×ₗ (ℤ ×ₗ ℤ) @@ -232,8 +232,8 @@ private theorem sum_orderType : _ = Ordinal.omega0 * Ordinal.omega0 + Ordinal.omega0 := by rw [Ordinal.type_nat_lt] _ = Ordinal.omega0 ^ (2 : Ordinal) + Ordinal.omega0 := by - have hsucc : Order.succ (1 : Ordinal) = 2 := one_add_one_eq_two - rw [← hsucc, Ordinal.opow_succ, Ordinal.opow_one] + have hsucc : (1 : Ordinal) + 1 = 2 := one_add_one_eq_two + rw [← hsucc, Ordinal.opow_add_one, Ordinal.opow_one] private theorem naturalProduct_value : (NatOrdinal.of (Ordinal.omega0 + 1) * NatOrdinal.of Ordinal.omega0).val = @@ -271,8 +271,8 @@ theorem naturalSumsetBound_distinguishes_ordinaryMul : Ordinal.omega0 ^ (2 : Ordinal) := by rw [Ordinal.add_mul_of_isSuccLimit Ordinal.one_add_omega0 Ordinal.isSuccLimit_omega0] - have hsucc : Order.succ (1 : Ordinal) = 2 := one_add_one_eq_two - rw [← hsucc, Ordinal.opow_succ, Ordinal.opow_one] + have hsucc : (1 : Ordinal) + 1 = 2 := one_add_one_eq_two + rw [← hsucc, Ordinal.opow_add_one, Ordinal.opow_one] rw [hordinary] exact not_le_of_gt (lt_add_of_pos_right _ Ordinal.omega0_pos) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/GameOperations.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/GameOperations.lean index 69c9ced888..d369fd33a9 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/GameOperations.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/GameOperations.lean @@ -144,28 +144,28 @@ theorem isNumeric_one : IsNumeric (1 : GameCode.{u}) := by /-- Negation preserves numeric game codes. -/ theorem IsNumeric.neg {x : GameCode.{u}} (h : IsNumeric x) : IsNumeric (-x) := by - letI : IGame.Numeric x.toIGame := (isNumeric_iff x).1 h + let : IGame.Numeric x.toIGame := (isNumeric_iff x).1 h simpa [IsNumeric] using (inferInstance : IGame.Numeric (-x.toIGame)) /-- Addition preserves numeric game codes. -/ theorem IsNumeric.add {x y : GameCode.{u}} (hx : IsNumeric x) (hy : IsNumeric y) : IsNumeric (x + y) := by - letI : IGame.Numeric x.toIGame := (isNumeric_iff x).1 hx - letI : IGame.Numeric y.toIGame := (isNumeric_iff y).1 hy + let : IGame.Numeric x.toIGame := (isNumeric_iff x).1 hx + let : IGame.Numeric y.toIGame := (isNumeric_iff y).1 hy simpa [IsNumeric] using (inferInstance : IGame.Numeric (x.toIGame + y.toIGame)) /-- Subtraction preserves numeric game codes. -/ theorem IsNumeric.sub {x y : GameCode.{u}} (hx : IsNumeric x) (hy : IsNumeric y) : IsNumeric (x - y) := by - letI : IGame.Numeric x.toIGame := (isNumeric_iff x).1 hx - letI : IGame.Numeric y.toIGame := (isNumeric_iff y).1 hy + let : IGame.Numeric x.toIGame := (isNumeric_iff x).1 hx + let : IGame.Numeric y.toIGame := (isNumeric_iff y).1 hy simpa [IsNumeric] using (inferInstance : IGame.Numeric (x.toIGame - y.toIGame)) /-- Multiplication preserves numeric game codes. -/ theorem IsNumeric.mul {x y : GameCode.{u}} (hx : IsNumeric x) (hy : IsNumeric y) : IsNumeric (x * y) := by - letI : IGame.Numeric x.toIGame := (isNumeric_iff x).1 hx - letI : IGame.Numeric y.toIGame := (isNumeric_iff y).1 hy + let : IGame.Numeric x.toIGame := (isNumeric_iff x).1 hx + let : IGame.Numeric y.toIGame := (isNumeric_iff y).1 hy simpa [IsNumeric] using (inferInstance : IGame.Numeric (x.toIGame * y.toIGame)) /-- The option codes for one player, with no identification of equivalent options. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/DegreeTwoPrimeProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/DegreeTwoPrimeProof.lean index c4b7fffda2..95760ec164 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/DegreeTwoPrimeProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples/DegreeTwoPrimeProof.lean @@ -101,7 +101,7 @@ namespace FoilHasNontrivialFactorization theorem proof : DegreeTwoExample.FoilHasNontrivialFactorization.{u} := by rw [DegreeTwoExample.FoilHasNontrivialFactorization] exact ⟨2, DegreeTwoExample.degreeTwoOz, rfl, two_not_isUnit, - IsPrime.proof.not_unit⟩ + IsPrime.proof.not_isUnit⟩ end FoilHasNontrivialFactorization diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/PrincipalRVAlgebraicIndependence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/PrincipalRVAlgebraicIndependence.lean index 505d94d62c..7f24d96258 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/PrincipalRVAlgebraicIndependence.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/PrincipalRVAlgebraicIndependence.lean @@ -5,7 +5,7 @@ Authors: Dan Abramov -/ module -public import Mathlib.Data.Real.Basic +public import Mathlib.Basic.Real.Basic public import Mathlib.RingTheory.HahnSeries.Multiplication public import Mathlib.RingTheory.MvPolynomial.WeightedHomogeneous public import Mathlib.Algebra.MvPolynomial.Eval diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamily.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamily.lean index 507034eb56..41aeb5db55 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamily.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/FinitePowerFamily.lean @@ -7,7 +7,7 @@ module public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFiniteDegree public import Mathlib.Data.Prod.Lex -public import Mathlib.Data.Real.Basic +public import Mathlib.Basic.Real.Basic public import Mathlib.Data.Sum.Order public import Mathlib.SetTheory.Ordinal.Arithmetic public import Mathlib.SetTheory.Ordinal.Exponential @@ -70,7 +70,7 @@ instance finiteLexWellFoundedLT : (n : ℕ) → WellFoundedLT (FiniteLex n) change WellFoundedLT Unit exact Finite.wellFounded_of_trans_of_irrefl (· < ·) | .succ n => by - letI : WellFoundedLT (FiniteLex n) := finiteLexWellFoundedLT n + let : WellFoundedLT (FiniteLex n) := finiteLexWellFoundedLT n exact inferInstanceAs (WellFoundedLT (Lex (ℕ × FiniteLex n))) /-- The lexicographic natural tuples of length `n` have order type `ω ^ n`. -/ @@ -85,7 +85,7 @@ theorem typeLT_finiteLex (n : ℕ) : ((· < ·) : FiniteLex n → FiniteLex n → Prop)) = _ rw [Ordinal.type_prod_lex, Ordinal.type_nat_lt] rw [ih] - rw [← Ordinal.opow_succ] + rw [← Ordinal.opow_add_one] congr 2 /-- The contraction factor separating consecutive lexicographic blocks. -/ @@ -248,7 +248,7 @@ abbrev ConwayIndex (n : ℕ) := WithTop (FiniteLex n) theorem typeLT_conwayIndex (n : ℕ) : Ordinal.type ((· < ·) : ConwayIndex n → ConwayIndex n → Prop) = (Ordinal.omega0 : Ordinal.{0}) ^ (n : Ordinal.{0}) + 1 := by - letI : WellFoundedLT (FiniteLex n ⊕ₗ PUnit) := + let : WellFoundedLT (FiniteLex n ⊕ₗ PUnit) := (WithTop.orderIsoSumLexPUnit (α := FiniteLex n)).symm.toOrderEmbedding.wellFoundedLT calc Ordinal.type ((· < ·) : ConwayIndex n → ConwayIndex n → Prop) = diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/PrincipalRVAlgebraicIndependenceProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/PrincipalRVAlgebraicIndependenceProof.lean index 56861e2144..59a0fc77cd 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/PrincipalRVAlgebraicIndependenceProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support/PrincipalRVAlgebraicIndependenceProof.lean @@ -91,7 +91,7 @@ theorem toSeries_aeval {ι : Type*} (b : ι → nonpos K) (F : MvPolynomial ι K /-! ### The ordinal value -/ theorem ot_eq (x : HahnSeries ℝ K) : ot x = HahnSeries.supportOrderType x := by - haveI : WellFoundedLT x.support := (supportIsWellOrder x).wf + have : WellFoundedLT x.support := (supportIsWellOrder x).wf exact (HahnSeries.supportOrderType_eq_typeLT (OrderIso.refl _)).symm theorem memJ_iff (a : nonpos K) : @@ -141,7 +141,7 @@ theorem ordinalValue_eq (a : nonpos K) : ordinalValue a = Berarducci.ordinalValu (fun h ↦ hN ((isNearConstant_iff a).mpr h))] congr 1 ext o - simp only [Set.mem_setOf_eq, Berarducci.mem_representativeOrderTypes_iff] + simp only [Set.mem_ofPred_eq, Berarducci.mem_representativeOrderTypes_iff] constructor · rintro ⟨c, hc, rfl⟩ refine ⟨toSeries c, ?_, by rw [ot_eq]; rfl⟩ @@ -346,7 +346,7 @@ open ConwayRefinement.Standalone.PrincipalRVAlgebraicIndependence theorem of_algebraicIndependence (K : Type u) [Field K] : PrincipalRVAlgebraicIndependence.MinimalFamiliesAlgebraicallyIndependent K := by intro hK - letI := hK + let := hK intro ι deg b hB α F hF hval -- Extend the family to a minimal homogeneous generating system of `P̂`. obtain ⟨ι', wt', x', e, he, hwt', hx', hmin⟩ := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/DegreeTwoPrime.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/DegreeTwoPrime.lean index 2369bc2bb2..485347f22d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/DegreeTwoPrime.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/DegreeTwoPrime.lean @@ -6,7 +6,7 @@ Authors: Dan Abramov module public import Mathlib.Algebra.Prime.Defs -public import Mathlib.Data.Real.Basic +public import Mathlib.Basic.Real.Basic public import Mathlib.RingTheory.HahnSeries.Multiplication /-! diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/DegreeTwoPrimeProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/DegreeTwoPrimeProof.lean index 5a37a33af8..ae2c3d3b3d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/DegreeTwoPrimeProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/DegreeTwoPrimeProof.lean @@ -54,7 +54,7 @@ namespace ExistsPrime /-- The displayed coefficient-one Hahn series is prime. -/ theorem proof (K : Type u) [Field K] : ExistsPrime K := by intro hK - letI : CharZero K := hK + let : CharZero K := hK let E : NonpositiveSeries K ≃+* HahnSeries.Nonpositive ℝ K := RingEquiv.subringCongr nonpositiveSeries_eq let x : NonpositiveSeries K := E.symm (degreeTwoWithConstant (K := K)) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/HahnIntegerPartRefinementCriterion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/HahnIntegerPartRefinementCriterion.lean index 66ff663814..4ca669474c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/HahnIntegerPartRefinementCriterion.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples/HahnIntegerPartRefinementCriterion.lean @@ -8,7 +8,7 @@ module public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnLimitTailQuotient public import Mathlib.Algebra.Divisibility.Basic public import Mathlib.Algebra.Order.Module.HahnEmbedding -public import Mathlib.Data.Real.Basic +public import Mathlib.Basic.Real.Basic public import Mathlib.RingTheory.HahnSeries.Cardinal public import Mathlib.SetTheory.Cardinal.Cofinality.Basic public import Mathlib.SetTheory.Cardinal.Regular diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/GermPolynomialRing.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/GermPolynomialRing.lean index 6c6528d47f..5e51d7c17b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/GermPolynomialRing.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/GermPolynomialRing.lean @@ -6,7 +6,7 @@ Authors: Dan Abramov module public import Mathlib.Algebra.MvPolynomial.Equiv -public import Mathlib.Data.Real.Basic +public import Mathlib.Basic.Real.Basic public import Mathlib.RingTheory.HahnSeries.Multiplication public import Mathlib.RingTheory.Ideal.Quotient.Operations public import Mathlib.RingTheory.Ideal.Span diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnIntegerPartRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnIntegerPartRefinement.lean index a5a38541b1..d7b3e8bfa2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnIntegerPartRefinement.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnIntegerPartRefinement.lean @@ -44,7 +44,7 @@ uncountable, let `G` be a `κ`-saturated ordered rational vector space, and let characteristic zero. Every equality `a * b = c * d` in `ℤ + R((G^{<0}))_κ` has four-factor refinement. -/ abbrev HahnIntegerPartRefinement - [Module ℚ G] [IsOrderedModule ℚ G] [CharZero R] : Prop := + [Module ℚ G] : Prop := ∀ (κ : Cardinal.{u}), ℵ₀ < κ → κ.IsRegular → IsKappaSaturated (G := G) κ → ∀ a b c d : HahnSeries G R, a ∈ integerHahnPart κ → b ∈ integerHahnPart κ → diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesGCD.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesGCD.lean index f06cd40b4e..bca8f063fd 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesGCD.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesGCD.lean @@ -6,7 +6,7 @@ Authors: Dan Abramov module public import Mathlib.Algebra.Divisibility.Basic -public import Mathlib.Data.Real.Basic +public import Mathlib.Basic.Real.Basic public import Mathlib.RingTheory.HahnSeries.Multiplication /-! diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesPolynomialRing.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesPolynomialRing.lean index bb518e8e16..36325f4b92 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesPolynomialRing.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnSeriesPolynomialRing.lean @@ -6,7 +6,7 @@ Authors: Dan Abramov module public import Mathlib.Algebra.MvPolynomial.Equiv -public import Mathlib.Data.Real.Basic +public import Mathlib.Basic.Real.Basic public import Mathlib.RingTheory.HahnSeries.Cardinal /-! @@ -48,13 +48,13 @@ theorem mem_series_iff (x : HahnSeries ℝ K) : /-- The subring `K_fin` of nonpositive Hahn series with finite support. -/ def FiniteSupport : Subring (Series K) := - let _ : Fact (aleph0 ≤ aleph0) := ⟨le_rfl⟩ + let _ : Fact (aleph0.{0} ≤ aleph0.{0}) := ⟨le_rfl⟩ (HahnSeries.cardSuppLTSubring ℝ K aleph0).comap (Series K).subtype /-- Membership in `K_fin` is exactly finiteness of the Hahn-series support. -/ theorem mem_finiteSupport_iff (x : Series K) : x ∈ FiniteSupport K ↔ x.1.support.Finite := by - letI : Fact (aleph0 ≤ aleph0) := ⟨le_rfl⟩ + let : Fact (aleph0.{0} ≤ aleph0.{0}) := ⟨le_rfl⟩ rw [FiniteSupport, Subring.mem_comap, HahnSeries.mem_cardSuppLTSubring, HahnSeries.cardSupp] exact Cardinal.lt_aleph0_iff_set_finite diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/InlineConwayRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/InlineConwayRefinement.lean index df0bf24745..0c7229a39d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/InlineConwayRefinement.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/InlineConwayRefinement.lean @@ -219,6 +219,7 @@ end Game /-- A surreal-number representative is a numeric well-founded Conway game. Two representatives denote the same surreal number precisely when their games are `Game.Equivalent`. -/ structure Surreal : Type (u + 1) where + /-- The numeric Conway game representing this surreal number. -/ game : Game.{u} numeric : Game.Numeric game diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/CompleteHahnGermProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/CompleteHahnGermProof.lean index 1d6dc25cf3..82786c35fc 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/CompleteHahnGermProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/CompleteHahnGermProof.lean @@ -85,9 +85,9 @@ theorem hasRefinement (G : Type u) (K : Type v) HasRefinement G K := by intro _ _ _ _ _ _ _ _ _ obtain ⟨ι, ⟨equiv⟩⟩ := isPolynomialRing G K - letI : IsDomain (Germ G K) := + let : IsDomain (Germ G K) := Function.Injective.isDomain equiv.symm.toRingHom equiv.symm.injective - letI : DecompositionMonoid (Germ G K) := + let : DecompositionMonoid (Germ G K) := MulEquiv.decompositionMonoid equiv.symm.toMulEquiv intro a b c d habcd exact (hasFourFactorRefinement_of_decompositionMonoid (R := Germ G K)).refine habcd diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConvexQuotientSplitting.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConvexQuotientSplitting.lean index cf9cb51765..2a80b12d09 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConvexQuotientSplitting.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConvexQuotientSplitting.lean @@ -116,6 +116,7 @@ theorem quotientProdLinearEquiv_zero_left (p : P) : Submodule.coe_prodEquivOfIsCompl'] simp [quotientLinearEquivComplement] +/-- The linear order on the quotient by the convex exponent submodule. -/ noncomputable local instance quotientLinearOrder [ConvexQuotient.IsConvex P.toAddSubgroup] : LinearOrder (G ⧸ P) := ConvexQuotient.instLinearOrder (H := P.toAddSubgroup) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConwayRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConwayRefinement.lean index b1f6bd8d5a..8b31d5d227 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConwayRefinement.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConwayRefinement.lean @@ -29,7 +29,7 @@ variable {R : Type u} [Mul R] /-- Conway's four-factor refinement schema for a predicate `P`: from `a * b = c * d`, produce `a = e * f`, `b = g * h`, `c = e * g`, and `d = f * h`, with all eight entries satisfying `P`. -/ -def ConwayRefinement (P : R → Prop) : Prop := +def HasRefinement (P : R → Prop) : Prop := ∀ a b c d : R, P a → P b → P c → P d → a * b = c * d → ∃ e f g h : R, @@ -37,7 +37,7 @@ def ConwayRefinement (P : R → Prop) : Prop := a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h /-- The standalone proposition unfolds to the four equations in Conway's refinement conjecture. -/ -theorem conwayRefinement_iff (P : R → Prop) : ConwayRefinement P ↔ +theorem conwayRefinement_iff (P : R → Prop) : HasRefinement P ↔ ∀ a b c d : R, P a → P b → P c → P d → a * b = c * d → ∃ e f g h : R, @@ -51,5 +51,5 @@ end ConwayRefinement.Standalone Proof module: `ConwayRefinementProof`. -* `ConwayRefinement` → `ConwayRefinement.refine` +* `HasRefinement` → `HasRefinement.refine` -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConwayRefinementProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConwayRefinementProof.lean index 4e7616572d..1c793300f1 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConwayRefinementProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/ConwayRefinementProof.lean @@ -15,14 +15,14 @@ This proof sibling supplies the module-safe eliminator for the standalone propos public section -namespace ConwayRefinement.Standalone.ConwayRefinement +namespace ConwayRefinement.Standalone.HasRefinement universe u variable {R : Type u} [Mul R] {P : R → Prop} /-- Apply four-factor refinement to one product equation. -/ -theorem refine (hc : ConwayRefinement P) +theorem refine (hc : HasRefinement P) {a b c d : R} (ha : P a) (hb : P b) (hc' : P c) (hd : P d) (heq : a * b = c * d) : ∃ e f g h : R, @@ -30,4 +30,4 @@ theorem refine (hc : ConwayRefinement P) a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h := by exact conwayRefinement_iff P |>.mp hc a b c d ha hb hc' hd heq -end ConwayRefinement.Standalone.ConwayRefinement +end ConwayRefinement.Standalone.HasRefinement diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/GermPolynomialRingProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/GermPolynomialRingProof.lean index 372bcf3d48..8d7f5cb153 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/GermPolynomialRingProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/GermPolynomialRingProof.lean @@ -57,7 +57,7 @@ namespace GermIsPolynomialRing /-- The germ ring is a polynomial ring over its coefficient field. -/ theorem of_polynomiality (K : Type u) [Field K] : GermIsPolynomialRing K := by intro hK - letI := hK + let := hK obtain ⟨ι, wt, x, hx⟩ := OrdinalGraded.exists_isMinimalSystem (Berarducci.principalGrading K) obtain ⟨σ⟩ := Berarducci.exists_lifts hx.mem @@ -71,11 +71,11 @@ namespace GermHasUniqueFactorization theorem of_polynomiality (K : Type u) [Field K] : GermHasUniqueFactorization K := by intro hK - letI := hK + let := hK obtain ⟨ι, ⟨equiv⟩⟩ := GermIsPolynomialRing.of_polynomiality K hK - haveI hdom : IsDomain (Germ K) := + have hdom : IsDomain (Germ K) := Function.Injective.isDomain equiv.symm.toRingHom equiv.symm.injective - haveI : UniqueFactorizationMonoid (Germ K) := + have : UniqueFactorizationMonoid (Germ K) := equiv.toMulEquiv.uniqueFactorizationMonoid inferInstance refine ⟨hdom, fun a ha ↦ ?_, fun f g hf hg h ↦ UniqueFactorizationMonoid.factors_unique hf hg h⟩ obtain ⟨f, hf, hfa⟩ := UniqueFactorizationMonoid.exists_prime_factors a ha diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnIntegerPartRefinementProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnIntegerPartRefinementProof.lean index d3fa9ae20c..5b9a110f68 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnIntegerPartRefinementProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnIntegerPartRefinementProof.lean @@ -17,7 +17,7 @@ public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart. import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanBall import Mathlib.Algebra.Module.Rat import Mathlib.Algebra.GCDMonoid.Nat -import Mathlib.Data.Real.Embedding +import Mathlib.Basic.Real.Embedding import Mathlib.SetTheory.Cardinal.Rat /-! @@ -342,7 +342,7 @@ private theorem completeSpace_tailQuotient_of_isKappaSaturated (T : Set (FiniteArchimedeanClass G)) (hT : IsLimitFamily T) (hTcard : #T < κ) : Nonempty (CompleteSpace (G ⧸ commonTail T)) := by rw [isLimitFamily_iff] at hT - letI : Nonempty T := Set.nonempty_coe_sort.mpr hT.1 + let : Nonempty T := Set.nonempty_coe_sort.mpr hT.1 let Q := G ⧸ commonTail T let ε : T → Q := fun c ↦ Submodule.Quotient.mk (FiniteArchimedeanClass.positiveRepresentative c.1) @@ -727,7 +727,7 @@ theorem decompositionMonoid_of_assumptions [CharZero R] (hA3 : AssumptionA3 Z) (hlimit : LimitTailConditions (G := G) Z κ) : DecompositionMonoid (HahnSeries.cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z) := by - letI : DecompositionMonoid Z := (assumptionA3_iff_decompositionMonoid Z).mp hA3 + let : DecompositionMonoid Z := (assumptionA3_iff_decompositionMonoid Z).mp hA3 rw [decompositionMonoid_iff] intro x apply isPrimal_of_finite_class_assumptions_and_limit_tail_conditions Z s @@ -735,7 +735,7 @@ theorem decompositionMonoid_of_assumptions [CharZero R] · intro T hTne hTgt hTcard obtain ⟨hcomplete⟩ := hlimit.cauchy_complete_quotient T (isLimitFamily_iff.mpr ⟨hTne, hTgt⟩) hTcard - letI := hcomplete + let := hcomplete exact ⟨(commonTailUniformEquiv (G := G) T).completeSpace_iff.mp inferInstance⟩ · intro T hTne hTgt hTcard have hfraction := hlimit.fraction_field_commonTail T @@ -800,18 +800,18 @@ theorem decompositionMonoid_of_saturation [CharZero R] (highlight)] theorem of_assumptions : HahnIntegerPartRefinementCriterion (G := G) (R := R) := by intro hR - letI : CharZero R := hR + let : CharZero R := hR intro κ hκcountable hκregular Z s hA1 hA2 hA3 hlimit - letI : Fact (ℵ₀ < κ) := ⟨hκcountable⟩ - letI : Fact κ.IsRegular := ⟨hκregular⟩ + let : Fact (ℵ₀ < κ) := ⟨hκcountable⟩ + let : Fact κ.IsRegular := ⟨hκregular⟩ let S := HahnSeries.cardSuppLTTruncationIntegerPart (G := G) (R := R) (κ := κ) Z - letI : DecompositionMonoid S := + let : DecompositionMonoid S := decompositionMonoid_of_assumptions Z s hA1 hA2 hA3 hlimit let inclusion : HahnSeries.CardSuppLTField (G := G) (R := R) (κ := κ) →+* HahnSeries G R := (HahnSeries.cardSuppLTSubfield G R κ).subtype let E := Subring.equivMapOfInjective S inclusion Subtype.val_injective - letI : DecompositionMonoid (S.map inclusion) := + let : DecompositionMonoid (S.map inclusion) := MulEquiv.decompositionMonoid E.symm.toMulEquiv have hmem (x : HahnSeries G R) : x ∈ S.map inclusion ↔ x ∈ hahnIntegerPart Z κ := by rw [Subring.mem_map, mem_hahnIntegerPart_iff] @@ -863,8 +863,8 @@ theorem of_saturation [CharZero R] e ∈ hahnIntegerPart Z κ ∧ f ∈ hahnIntegerPart Z κ ∧ g ∈ hahnIntegerPart Z κ ∧ h ∈ hahnIntegerPart Z κ ∧ a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h := by - letI : Fact (ℵ₀ < κ) := ⟨hκcount⟩ - letI : Fact κ.IsRegular := ⟨hκregular⟩ + let : Fact (ℵ₀ < κ) := ⟨hκcount⟩ + let : Fact κ.IsRegular := ⟨hκregular⟩ let s : HahnEmbedding.ArchimedeanStrata ℚ G := Classical.choice inferInstance have hA1 : AssumptionA1 s := by rw [assumptionA1_iff] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesGCDProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesGCDProof.lean index 032c6d17cc..4651b9a0df 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesGCDProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesGCDProof.lean @@ -31,9 +31,9 @@ namespace SeriesHasGCDs /-- Every pair of series in `K((ℝ^{≤0}))` has a greatest common divisor. -/ theorem of_polynomiality (K : Type u) [Field K] : SeriesHasGCDs K := by intro hK - letI := hK + let := hK obtain ⟨hGCD⟩ := Berarducci.nonemptyGCDMonoid (K := K) - letI : GCDMonoid (nonpos K) := hGCD + let : GCDMonoid (nonpos K) := hGCD intro a b refine ⟨gcd a b, fun e ↦ ?_⟩ constructor @@ -49,9 +49,9 @@ namespace SeriesIsPrimal /-- Every series in `K((ℝ^{≤0}))` is primal, as a consequence of the existence of gcds. -/ theorem of_gcds (K : Type u) [Field K] : SeriesIsPrimal K := by intro hK - letI := hK - letI : DecidableEq (nonpos K) := Classical.decEq _ - letI : GCDMonoid (nonpos K) := + let := hK + let : DecidableEq (nonpos K) := Classical.decEq _ + let : GCDMonoid (nonpos K) := gcdMonoidOfExistsGCD (SeriesHasGCDs.of_polynomiality K inferInstance) intro a exact DecompositionMonoid.primal a @@ -64,7 +64,7 @@ namespace SeriesIrreduciblesArePrime theorem of_primality (K : Type u) [Field K] : SeriesIrreduciblesArePrime K := by intro hK - letI := hK + let := hK intro a ha exact prime_of_irreducible_of (SeriesIsPrimal.of_gcds K) ha @@ -76,7 +76,7 @@ namespace SeriesFactorizationsAreUnique theorem of_primality (K : Type u) [Field K] : SeriesFactorizationsAreUnique K := by intro hK - letI := hK + let := hK intro f g hf hg hfg exact factorization_unique_of (SeriesIsPrimal.of_gcds K) hf hg hfg diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesPolynomialRingProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesPolynomialRingProof.lean index fad87f7fc6..a2724ce75b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesPolynomialRingProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/HahnSeriesPolynomialRingProof.lean @@ -43,7 +43,7 @@ namespace IsPolynomialRing theorem of_polynomiality (K : Type u) [Field K] : HahnPolynomial.IsPolynomialRing K := by intro hK - letI := hK + let := hK obtain ⟨ι, weight, generators, hminimal, ⟨lifts⟩⟩ := Berarducci.exists_isMinimalSystem_and_generatorLifts K let ringEquiv : MvPolynomial ι (FiniteSupport K) ≃+* Series K := diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean index 9e30f35aeb..f028d8a427 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean @@ -21,8 +21,11 @@ namespace ConwayRefinement.Standalone.InlineConwayRefinement universe u +/-- The auxiliary game representation supplied by the standalone surreal development. -/ abbrev SupportGame := ConwayRefinement.Standalone.InlineSurreal.IGame +/-- Recursively convert an indexed Conway game to the auxiliary representation by its option +sets. -/ noncomputable def Game.toSupport : Game.{u} → SupportGame.{u} | .mk Left Right left right => ConwayRefinement.Standalone.InlineSurreal.ofSets @@ -30,6 +33,8 @@ noncomputable def Game.toSupport : Game.{u} → SupportGame.{u} (Set.range fun i : Left ↦ Game.toSupport (left i)) (Set.range fun i : Right ↦ Game.toSupport (right i))) trivial +/-- Convert an auxiliary game to an indexed Conway game by shrinking its left and right option +sets. -/ @[expose] noncomputable def Game.fromSupport (x : SupportGame.{u}) : Game.{u} := ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn x fun s t _ _ hs ht ↦ .mk (Shrink s) (Shrink t) @@ -304,6 +309,7 @@ theorem Game.toSupport_mul (x y : Game.{u}) : · exact ⟨Sum.inr (i, j), option_eq _ _ (Game.Move.right i) (Game.Move.left j)⟩ +/-- Map a numeric indexed-game representative to its surreal value in the auxiliary model. -/ noncomputable def Surreal.toSupport (x : Surreal.{u}) : ConwayRefinement.Standalone.InlineSurreal.Surreal.{u} := @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk _ x.numeric.toSupport @@ -312,6 +318,7 @@ theorem Surreal.toSupport_eq (x : Surreal.{u}) : x.toSupport = @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk _ x.numeric.toSupport := (rfl) +/-- Choose a numeric indexed-game representative of a surreal number in the auxiliary model. -/ noncomputable def Surreal.fromSupport (x : ConwayRefinement.Standalone.InlineSurreal.Surreal.{u}) : Surreal.{u} := ⟨Game.fromSupport x.out, Game.Numeric.fromSupport inferInstance⟩ @@ -323,7 +330,7 @@ theorem Surreal.fromSupport_game theorem Surreal.toSupport_fromSupport (x : ConwayRefinement.Standalone.InlineSurreal.Surreal.{u}) : (Surreal.fromSupport x).toSupport = x := by - letI : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric + let : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric (Game.toSupport (Surreal.fromSupport x).game) := (Surreal.fromSupport x).numeric.toSupport rw [Surreal.toSupport_eq] @@ -340,9 +347,9 @@ theorem Surreal.toSupport_fromSupport theorem Surreal.gameEquivalent_iff_toSupport_eq (x y : Surreal.{u}) : Game.Equivalent x.game y.game ↔ x.toSupport = y.toSupport := by - letI : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric (Game.toSupport x.game) := + let : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric (Game.toSupport x.game) := x.numeric.toSupport - letI : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric (Game.toSupport y.game) := + let : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric (Game.toSupport y.game) := y.numeric.toSupport rw [Surreal.toSupport_eq, Surreal.toSupport_eq, ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk, Game.equivalent_iff] @@ -363,6 +370,7 @@ def Surreal.QuotientModel : Type (u + 1) := ((Surreal.gameEquivalent_iff_toSupport_eq _ _ |>.mp hxy).trans (Surreal.gameEquivalent_iff_toSupport_eq _ _ |>.mp hyz))⟩ } +/-- The map from indexed games modulo numeric equivalence to the auxiliary surreal model. -/ noncomputable def Surreal.QuotientModel.toSupport : Surreal.QuotientModel.{u} → ConwayRefinement.Standalone.InlineSurreal.Surreal.{u} := Quotient.lift Surreal.toSupport fun _ _ h ↦ @@ -390,14 +398,17 @@ noncomputable def Surreal.quotientEquivSupport : Surreal.QuotientModel.{v} ≃ namespace SupportBridge +/-- Identify the left and right players of CombinatorialGames with the auxiliary player type. -/ def playerToSupport : _root_.Player → ConwayRefinement.Standalone.InlineSurreal.Player | .left => .left | .right => .right +/-- Recursively convert an auxiliary game to the CombinatorialGames representation. -/ noncomputable def toCG (x : SupportGame.{u}) : _root_.IGame.{u} := ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn x fun s t _ _ hs ht ↦ !{Set.range fun y : s ↦ hs y.1 y.2 | Set.range fun y : t ↦ ht y.1 y.2} +/-- Recursively convert a CombinatorialGames game to the auxiliary representation. -/ noncomputable def fromCG (x : _root_.IGame.{u}) : SupportGame.{u} := _root_.IGame.ofSetsRecOn x fun s t _ _ hs ht ↦ ConwayRefinement.Standalone.InlineSurreal.ofSets @@ -690,15 +701,20 @@ end SupportBridge namespace SupportBridge +/-- The surreal-number quotient in the auxiliary standalone model. -/ abbrev SupportSurreal := ConwayRefinement.Standalone.InlineSurreal.Surreal +/-- The game quotient in the auxiliary standalone model. -/ abbrev SupportQuotientGame := ConwayRefinement.Standalone.InlineSurreal.Game +/-- Convert an auxiliary quotient game to the CombinatorialGames quotient. -/ noncomputable def gameToCG (x : SupportQuotientGame.{u}) : _root_.Game.{u} := _root_.Game.mk (toCG x.out) +/-- Convert a surreal number from the auxiliary model to the CombinatorialGames model. -/ noncomputable def surrealToCG (x : SupportSurreal.{u}) : _root_.Surreal.{u} := @_root_.Surreal.mk (toCG x.out) (toCG_numeric inferInstance) +/-- Convert a CombinatorialGames surreal number to the auxiliary model. -/ noncomputable def surrealFromCG (x : _root_.Surreal.{u}) : SupportSurreal.{u} := @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk (fromCG x.out) (fromCG_numeric inferInstance) @@ -771,8 +787,8 @@ theorem surrealToCG_mk (x : SupportGame.{u}) [ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric x] : surrealToCG (ConwayRefinement.Standalone.InlineSurreal.Surreal.mk x) = @_root_.Surreal.mk (toCG x) (toCG_numeric inferInstance) := by - letI := toCG_numeric (x := x) (inferInstance) - letI := toCG_numeric + let := toCG_numeric (x := x) (inferInstance) + let := toCG_numeric (x := (ConwayRefinement.Standalone.InlineSurreal.Surreal.mk x).out) (inferInstance) rw [surrealToCG, _root_.Surreal.mk_eq_mk] apply toCG_equiv _ _ |>.mp @@ -783,7 +799,7 @@ theorem toGame_surrealToCG (x : SupportSurreal.{u}) : gameToCG (ConwayRefinement.Standalone.InlineSurreal.Surreal.toGame x) := by induction x using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with | mk x => - letI : _root_.IGame.Numeric (toCG x) := toCG_numeric (by infer_instance) + let : _root_.IGame.Numeric (toCG x) := toCG_numeric (by infer_instance) rw [surrealToCG_mk, _root_.Surreal.toGame_mk, ConwayRefinement.Standalone.InlineSurreal.Surreal.toGame_mk, gameToCG_mk] @@ -791,8 +807,8 @@ theorem surrealFromCG_mk (x : _root_.IGame.{u}) [x.Numeric] : surrealFromCG (_root_.Surreal.mk x) = @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk (fromCG x) (fromCG_numeric inferInstance) := by - letI := fromCG_numeric (x := x) (inferInstance) - letI := fromCG_numeric (x := (_root_.Surreal.mk x).out) (inferInstance) + let := fromCG_numeric (x := x) (inferInstance) + let := fromCG_numeric (x := (_root_.Surreal.mk x).out) (inferInstance) rw [surrealFromCG, ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk] apply toCG_equiv _ _ |>.mpr rw [toCG_fromCG] @@ -805,8 +821,8 @@ theorem surrealToCG_fromCG (x : _root_.Surreal.{u}) : surrealToCG (surrealFromCG x) = x := by induction x using _root_.Surreal.ind with | mk x => - letI := fromCG_numeric (x := x) (inferInstance) - letI := toCG_numeric (x := fromCG x) (inferInstance) + let := fromCG_numeric (x := x) (inferInstance) + let := toCG_numeric (x := fromCG x) (inferInstance) rw [surrealFromCG_mk, surrealToCG_mk] rw [_root_.Surreal.mk_eq_mk] change toCG (fromCG x) ≤ x ∧ x ≤ toCG (fromCG x) @@ -817,8 +833,8 @@ theorem surrealFromCG_toCG (x : SupportSurreal.{u}) : surrealFromCG (surrealToCG x) = x := by induction x using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with | mk x => - letI := toCG_numeric (x := x) (inferInstance) - letI := fromCG_numeric (x := toCG x) (inferInstance) + let := toCG_numeric (x := x) (inferInstance) + let := fromCG_numeric (x := toCG x) (inferInstance) rw [surrealToCG_mk, surrealFromCG_mk] rw [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk] apply toCG_equiv _ _ |>.mpr @@ -834,7 +850,7 @@ noncomputable def surrealEquivCG : SupportSurreal.{u} ≃ _root_.Surreal.{u} whe right_inv := surrealToCG_fromCG theorem surrealToCG_zero : surrealToCG (0 : SupportSurreal.{u}) = 0 := by - letI : _root_.IGame.Numeric (toCG (0 : SupportGame.{u})) := + let : _root_.IGame.Numeric (toCG (0 : SupportGame.{u})) := toCG_numeric (by infer_instance) rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_zero, surrealToCG_mk, ← _root_.Surreal.mk_zero, _root_.Surreal.mk_eq_mk] @@ -843,7 +859,7 @@ theorem surrealToCG_zero : surrealToCG (0 : SupportSurreal.{u}) = 0 := by exact ⟨le_rfl, le_rfl⟩ theorem surrealToCG_one : surrealToCG (1 : SupportSurreal.{u}) = 1 := by - letI : _root_.IGame.Numeric (toCG (1 : SupportGame.{u})) := + let : _root_.IGame.Numeric (toCG (1 : SupportGame.{u})) := toCG_numeric (by infer_instance) rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_one, surrealToCG_mk, ← _root_.Surreal.mk_one, _root_.Surreal.mk_eq_mk] @@ -854,8 +870,8 @@ theorem surrealToCG_one : surrealToCG (1 : SupportSurreal.{u}) = 1 := by theorem surrealToCG_neg (x : SupportSurreal.{u}) : surrealToCG (-x) = -surrealToCG x := by induction x using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with | mk x => - letI : _root_.IGame.Numeric (toCG x) := toCG_numeric (by infer_instance) - letI : _root_.IGame.Numeric (toCG (-x)) := toCG_numeric (by infer_instance) + let : _root_.IGame.Numeric (toCG x) := toCG_numeric (by infer_instance) + let : _root_.IGame.Numeric (toCG (-x)) := toCG_numeric (by infer_instance) rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_neg, surrealToCG_mk, surrealToCG_mk, ← _root_.Surreal.mk_neg, _root_.Surreal.mk_eq_mk] change toCG (-x) ≤ -toCG x ∧ -toCG x ≤ toCG (-x) @@ -868,9 +884,9 @@ theorem surrealToCG_add (x y : SupportSurreal.{u}) : | mk x => induction y using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with | mk y => - letI : _root_.IGame.Numeric (toCG x) := toCG_numeric (by infer_instance) - letI : _root_.IGame.Numeric (toCG y) := toCG_numeric (by infer_instance) - letI : _root_.IGame.Numeric (toCG (x + y)) := toCG_numeric (by infer_instance) + let : _root_.IGame.Numeric (toCG x) := toCG_numeric (by infer_instance) + let : _root_.IGame.Numeric (toCG y) := toCG_numeric (by infer_instance) + let : _root_.IGame.Numeric (toCG (x + y)) := toCG_numeric (by infer_instance) rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_add, surrealToCG_mk, surrealToCG_mk, surrealToCG_mk, ← _root_.Surreal.mk_add, _root_.Surreal.mk_eq_mk] @@ -884,9 +900,9 @@ theorem surrealToCG_mul (x y : SupportSurreal.{u}) : | mk x => induction y using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with | mk y => - letI : _root_.IGame.Numeric (toCG x) := toCG_numeric (by infer_instance) - letI : _root_.IGame.Numeric (toCG y) := toCG_numeric (by infer_instance) - letI : _root_.IGame.Numeric (toCG (x * y)) := toCG_numeric (by infer_instance) + let : _root_.IGame.Numeric (toCG x) := toCG_numeric (by infer_instance) + let : _root_.IGame.Numeric (toCG y) := toCG_numeric (by infer_instance) + let : _root_.IGame.Numeric (toCG (x * y)) := toCG_numeric (by infer_instance) rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_mul, surrealToCG_mk, surrealToCG_mk, surrealToCG_mk, ← _root_.Surreal.mk_mul, _root_.Surreal.mk_eq_mk] @@ -1003,10 +1019,10 @@ theorem Game.equivalent_iff_toSupport (x y : Game.{u}) : theorem Surreal.productsEqual_iff_toSupport (a b c d : Surreal.{u}) : Game.Equivalent (Game.mul a.game b.game) (Game.mul c.game d.game) ↔ a.toSupport * b.toSupport = c.toSupport * d.toSupport := by - letI := a.numeric.toSupport - letI := b.numeric.toSupport - letI := c.numeric.toSupport - letI := d.numeric.toSupport + let := a.numeric.toSupport + let := b.numeric.toSupport + let := c.numeric.toSupport + let := d.numeric.toSupport rw [Game.equivalent_iff_toSupport, Game.toSupport_mul, Game.toSupport_mul] simp only [Surreal.toSupport_eq] rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_mul, @@ -1017,9 +1033,9 @@ theorem Surreal.productsEqual_iff_toSupport (a b c d : Surreal.{u}) : theorem Surreal.equalsProduct_iff_toSupport (a e f : Surreal.{u}) : Game.Equivalent a.game (Game.mul e.game f.game) ↔ a.toSupport = e.toSupport * f.toSupport := by - letI := a.numeric.toSupport - letI := e.numeric.toSupport - letI := f.numeric.toSupport + let := a.numeric.toSupport + let := e.numeric.toSupport + let := f.numeric.toSupport rw [Game.equivalent_iff_toSupport, Game.toSupport_mul] simp only [Surreal.toSupport_eq] rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_mul] @@ -1084,7 +1100,7 @@ theorem Game.toSupport_one : Game.toSupport (Game.one : Game.{u}) = theorem Game.toSupport_singletonIntegerCut_numeric (x : Surreal.{u}) : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric (Game.toSupport (Surreal.singletonIntegerCut x.game)) := by - letI := x.numeric.toSupport + let := x.numeric.toSupport rw [Surreal.singletonIntegerCut_eq] rw [Game.toSupport_mk] rw [ConwayRefinement.Standalone.InlineSurreal.IGame.numeric_def] @@ -1140,10 +1156,10 @@ theorem Game.toSupport_singletonIntegerCut_numeric (x : Surreal.{u}) : theorem Surreal.toSupport_sub_one (x : Surreal.{u}) : @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk (Game.toSupport (Game.add x.game (Game.neg Game.one))) (by - letI := x.numeric.toSupport + let := x.numeric.toSupport rw [Game.toSupport_add, Game.toSupport_neg, Game.toSupport_one] infer_instance) = x.toSupport - 1 := by - letI := x.numeric.toSupport + let := x.numeric.toSupport simp only [Game.toSupport_add, Game.toSupport_neg, Game.toSupport_one] simpa only [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_neg, ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_one, Surreal.toSupport_eq, @@ -1154,10 +1170,10 @@ theorem Surreal.toSupport_sub_one (x : Surreal.{u}) : theorem Surreal.toSupport_add_one (x : Surreal.{u}) : @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk (Game.toSupport (Game.add x.game Game.one)) (by - letI := x.numeric.toSupport + let := x.numeric.toSupport rw [Game.toSupport_add, Game.toSupport_one] infer_instance) = x.toSupport + 1 := by - letI := x.numeric.toSupport + let := x.numeric.toSupport simp only [Game.toSupport_add, Game.toSupport_one] simpa only [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_one, Surreal.toSupport_eq] using @@ -1195,8 +1211,8 @@ theorem Surreal.toSupport_singletonIntegerCut (x : Surreal.{u}) : theorem Surreal.isConwayOmnificInteger_iff_toSupport (x : Surreal.{u}) : IsConwayOmnificInteger x ↔ ConwayRefinement.Standalone.InlineSurreal.Surreal.IsConwayOmnificInteger x.toSupport := by - letI := x.numeric.toSupport - letI := Game.toSupport_singletonIntegerCut_numeric x + let := x.numeric.toSupport + let := Game.toSupport_singletonIntegerCut_numeric x rw [Surreal.isConwayOmnificInteger_iff, ConwayRefinement.Standalone.InlineSurreal.Surreal.IsConwayOmnificInteger] constructor diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean index eac8a11e39..ff8b4df74b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean @@ -409,7 +409,8 @@ Most constructions within game theory, and as such, many proofs within it, are d induction. Structural induction on games is sometimes called "Conway induction". The most straightforward way to employ Conway induction is by using the termination checker, with -the auxiliary `igame_wf` tactic. This uses `solve_by_elim` to search the context for proofs of the +the auxiliary `inline_igame_wf` tactic. This uses `solve_by_elim` to search the context for + proofs of the form `y ∈ xᴸ` or `y ∈ xᴿ`, which prove termination. Alternatively, you can use the explicit recursion principles `IGame.ofSetsRecOn` or `IGame.moveRecOn`. @@ -736,7 +737,7 @@ theorem ofSetsRecOn_ofSets {motive : IGame.{u_inline_4} → Sort*} /-- Discharges proof obligations of the form `⊢ Subposition ..` arising in termination proofs of definitions using well-founded recursion on `IGame`. -/ -macro "igame_wf" config:Lean.Parser.Tactic.optConfig : tactic => +macro (name := inlineIGameWf) "inline_igame_wf" config:Lean.Parser.Tactic.optConfig : tactic => `(tactic| all_goals solve_by_elim $config [Prod.Lex.left, Prod.Lex.right, PSigma.Lex.left, PSigma.Lex.right, Subposition.of_mem_moves, Subposition.trans, Subtype.prop] ) @@ -840,7 +841,7 @@ private theorem le_rfl' {x : IGame} : x ≤ x := by constructor <;> intro y hy exacts [lf_of_le_left le_rfl' hy, lf_of_right_le le_rfl' hy] termination_by x -decreasing_by igame_wf +decreasing_by inline_igame_wf private theorem le_trans' {x y z : IGame} (h₁ : x ≤ y) (h₂ : y ≤ z) : x ≤ z := by rw [le_iff_forall_lf] @@ -958,7 +959,7 @@ instance : ZeroLEOneClass IGame where private def neg' (x : IGame) : IGame := !{range fun y : xᴿ ↦ neg' y.1 | range fun y : xᴸ ↦ neg' y.1} termination_by x -decreasing_by igame_wf +decreasing_by inline_igame_wf #adaptation_note /-- noncomputable is now needed -/ in /-- The negative of a game is defined by `-!{s | t} = !{-t | -s}`. -/ @@ -1075,7 +1076,7 @@ private def add' (x y : IGame) : IGame := !{(range fun z : xᴸ ↦ add' z y) ∪ (range fun z : yᴸ ↦ add' x z) | (range fun z : xᴿ ↦ add' z y) ∪ (range fun z : yᴿ ↦ add' x z)} termination_by (x, y) -decreasing_by igame_wf +decreasing_by inline_igame_wf #adaptation_note /-- noncomputable is now needed -/ in /-- The sum of `x = !{s₁ | t₁}` and `y = !{s₂ | t₂}` is `!{s₁ + y, x + s₂ | t₁ + y, x + t₂}`. -/ @@ -1148,7 +1149,7 @@ private theorem add_comm' (x y : IGame) : x + y = y + x := by · refine and_congr_right_iff.2 fun h ↦ ?_ rw [add_comm'] termination_by (x, y) -decreasing_by igame_wf +decreasing_by inline_igame_wf private theorem add_assoc' (x y z : IGame) : x + y + z = x + (y + z) := by ext1 @@ -1158,7 +1159,7 @@ private theorem add_assoc' (x y z : IGame) : x + y + z = x + (y + z) := by congr! 2 rw [add_assoc'] termination_by (x, y, z) -decreasing_by igame_wf +decreasing_by inline_igame_wf instance : AddCommMonoid IGame where add_zero := private add_zero' @@ -1195,7 +1196,7 @@ private theorem neg_add' (x y : IGame) : -(x + y) = -x + -y := by · refine and_congr_right_iff.2 fun _ ↦ ?_ rw [← neg_inj, neg_add', neg_neg] termination_by (x, y) -decreasing_by igame_wf +decreasing_by inline_igame_wf instance : SubtractionCommMonoid IGame where neg_neg := neg_neg @@ -1212,7 +1213,7 @@ private theorem sub_self_le (x : IGame) : x - x ≤ 0 := by rw [sub_neg_eq_add] exact add_right_mem_moves_add hy _ termination_by x -decreasing_by igame_wf +decreasing_by inline_igame_wf /-- The sum of a game and its negative is equivalent, though not necessarily identical to zero. -/ theorem sub_self_equiv (x : IGame) : x - x ≈ 0 := by @@ -1235,7 +1236,7 @@ private theorem add_le_add_left' {x y : IGame} (h : x ≤ y) (z : IGame) : z + x · exact lf_of_le_left (add_le_add_left' hb' z) (add_left_mem_moves_add hb z) · exact lf_of_right_le (add_le_add_left' hb' z) (add_left_mem_moves_add hb z) termination_by (x, y, z) -decreasing_by igame_wf (maxDepth := 8) +decreasing_by inline_igame_wf (maxDepth := 8) private theorem add_le_add_right' {x y : IGame} (h : x ≤ y) (z : IGame) : x + z ≤ y + z := by simpa [add_comm] using add_le_add_left' h z @@ -1491,7 +1492,7 @@ private theorem igameMulComm (x y : IGame) : x * y = y * x := by rintro (⟨_, _⟩ | ⟨_, _⟩) <;> rw [mulOption, mulOption, igameMulComm x, igameMulComm _ y, add_comm, igameMulComm a b] termination_by (x, y) -decreasing_by igame_wf +decreasing_by inline_igame_wf instance : CommMagma IGame where mul_comm := private igameMulComm @@ -1520,7 +1521,7 @@ private theorem neg_mul' (x y : IGame) : -x * y = -(x * y) := by rw [← neg_inj, neg_mul', neg_mul', neg_mul'] simp [sub_eq_add_neg, add_comm] termination_by (x, y) -decreasing_by igame_wf +decreasing_by inline_igame_wf instance : HasDistribNeg IGame where neg_mul := private neg_mul' @@ -1565,6 +1566,8 @@ apply `Numeric.of_mem_moves` to all hypotheses, and thus build all possible `Num open Lean Meta Elab Tactic +/-- Apply the supplied instance-producing declarations to local hypotheses and add the resulting +instances to the goal. -/ meta def instances (constants : Array Name) (goal : MVarId) : MetaM (Option MVarId) := goal.withContext do let mut goal := goal @@ -1648,8 +1651,8 @@ theorem left_lt_right [h : Numeric x] (hy : y ∈ xᴸ) (hz : z ∈ xᴿ) : y < protected theorem of_mem_moves {p : Player} [h : Numeric x] (hy : y ∈ x.moves p) : Numeric y := (numeric_def.1 h).2 p y hy -/-- `numeric` eagerly adds all possible `Numeric` hypotheses. -/ -elab "numeric" : tactic => +/-- `inline_numeric` eagerly adds all possible `Numeric` hypotheses. -/ +elab (name := inlineNumeric) "inline_numeric" : tactic => addInstances <| .mk [`ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric.of_mem_moves] protected theorem subposition [Numeric x] (h : Subposition y x) : Numeric y := by @@ -1674,14 +1677,14 @@ protected instance moves {x : IGame} [Numeric x] {p : Player} (y : x.moves p) : protected theorem le_of_not_le {x y : IGame} [Numeric x] [Numeric y] : ¬ x ≤ y → y ≤ x := by rw [lf_iff_exists_le, le_iff_forall_lf] rintro (⟨z, hz, h⟩ | ⟨z, hz, h⟩) <;> constructor <;> intro a ha h' - · numeric + · inline_numeric exact left_lf_of_le h' hz (Numeric.le_of_not_le (left_lf_of_le h ha)) · exact (left_lt_right hz ha).not_ge (h'.trans h) · exact (left_lt_right ha hz).not_ge (h.trans h') - · numeric + · inline_numeric exact lf_right_of_le h' hz (Numeric.le_of_not_le (lf_right_of_le h ha)) termination_by x -decreasing_by igame_wf +decreasing_by inline_igame_wf protected theorem le_total (x y : IGame) [Numeric x] [Numeric y] : x ≤ y ∨ y ≤ x := by rw [or_iff_not_imp_left] @@ -1721,17 +1724,17 @@ theorem mk_of_lf (h₁ : ∀ y ∈ xᴸ, ∀ z ∈ xᴿ, y ⧏ z) (h₂ : ∀ p, theorem le_iff_forall_lt [Numeric x] [Numeric y] : x ≤ y ↔ (∀ z ∈ xᴸ, z < y) ∧ (∀ z ∈ yᴿ, x < z) := by rw [le_iff_forall_lf] - congr! with z hz z hz <;> numeric <;> rw [Numeric.not_le] + congr! with z hz z hz <;> inline_numeric <;> rw [Numeric.not_le] theorem lt_iff_exists_le [Numeric x] [Numeric y] : x < y ↔ (∃ z ∈ yᴸ, x ≤ z) ∨ (∃ z ∈ xᴿ, z ≤ y) := by rw [← Numeric.not_le, lf_iff_exists_le] theorem left_lt [Numeric x] (h : y ∈ xᴸ) : y < x := by - numeric; simpa using left_lf h + inline_numeric; simpa using left_lf h theorem lt_right [Numeric x] (h : y ∈ xᴿ) : x < y := by - numeric; simpa using lf_right h + inline_numeric; simpa using lf_right h protected instance neg (x : IGame) [Numeric x] : Numeric (-x) := by refine mk (fun y hy z hz ↦ ?_) ?_ @@ -1739,10 +1742,10 @@ protected instance neg (x : IGame) [Numeric x] : Numeric (-x) := by apply @left_lt_right x <;> simp_all · simp_rw [forall_moves_neg] intro p y hy - numeric + inline_numeric simpa using Numeric.neg y termination_by x -decreasing_by igame_wf +decreasing_by inline_igame_wf @[simp] theorem neg_iff {x : IGame} : Numeric (-x) ↔ Numeric x := @@ -1757,9 +1760,9 @@ protected instance add (x y : IGame) [Numeric x] [Numeric y] : Numeric (x + y) : · simpa using left_lt ha · simpa using lt_right hb · rintro p _ (⟨z, hz, rfl⟩ | ⟨z, hz, rfl⟩) - all_goals numeric; exact Numeric.add .. + all_goals inline_numeric; exact Numeric.add .. termination_by (x, y) -decreasing_by igame_wf +decreasing_by inline_igame_wf protected instance sub (x y : IGame) [Numeric x] [Numeric y] : Numeric (x - y) := inferInstanceAs (Numeric (x + -y)) @@ -1926,7 +1929,7 @@ theorem mk_mul_add (x y z : IGame) : mk (x * (y + z)) = mk (x * y) + mk (x * z) rw [mk_mul_add, mk_mul_add, mk_mul_add] abel termination_by (x, y, z) -decreasing_by igame_wf +decreasing_by inline_igame_wf theorem mk_mul_sub (x y z : IGame) : mk (x * (y - z)) = mk (x * y) - mk (x * z) := by simpa [sub_eq_add_neg] using mk_mul_add x y (-z) @@ -2638,7 +2641,7 @@ lemma mulOption_lt_of_lt [Numeric y] (ihxy : IH1 x y) (ihyx : IH1 y x) {a b c d} lemma mulOption_lt [Numeric x] [Numeric y] (ihxy : IH1 x y) (ihyx : IH1 y x) {a b c d} (ha : a ∈ xᴸ) (hb : b ∈ yᴸ) (hc : c ∈ xᴸ) (hd : d ∈ (-y)ᴸ) : Game.mk (mulOption x y a b) < -Game.mk (mulOption x (-y) c d) := by - numeric + inline_numeric obtain (h | h | h) := Numeric.lt_or_equiv_or_gt a c · exact mulOption_lt_of_lt ihxy ihyx h ha hb hc hd · exact mulOption_lt_iff_P1.2 (P1_of_equiv h (P24_of_IH1 ihxy ha hc).1 @@ -2837,7 +2840,7 @@ lemma P3_of_lt_of_lt {x₁ x₂ y₁ y₂} [Numeric x₁] [Numeric x₂] [Numeri refine P3_of_IH3 ?_ ?_ hx all_goals intro i hi - numeric + inline_numeric refine ⟨(main_P24 ..).1, (main_P24 ..).1, P3_comm.2 ?_, fun h ↦ ?_⟩ · exact ((main_P24 y₁ y₂ x₂).2 hy).1 _ hi · exact P3_of_lt_of_lt h hy @@ -2846,7 +2849,7 @@ lemma P3_of_lt_of_lt {x₁ x₂ y₁ y₂} [Numeric x₁] [Numeric x₂] [Numeri rw [← P3_neg, neg_neg] exact P3_of_lt_of_lt h hy termination_by (x₁, x₂) -decreasing_by all_goals (try rw [moves_neg] at *); igame_wf +decreasing_by all_goals (try rw [moves_neg] at *); inline_igame_wf /-! ### Instances and corollaries -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ArchimedeanAssumptions.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ArchimedeanAssumptions.lean index c66343446d..aede407ffd 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ArchimedeanAssumptions.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ArchimedeanAssumptions.lean @@ -270,7 +270,7 @@ theorem smallSupportCardinal_le_ball_cof (c : FiniteArchimedeanClass Surreal.{u} have hsSmall : Small.{u} s := by rw [Cardinal.small_iff_lift_mk_lt_univ] simpa [smallSupportCardinal] using (not_le.mp hcard) - letI : Small.{u} s := hsSmall + let : Small.{u} s := hsSmall exact ball_not_isCofinal_of_small (a := |a|) (abs_pos.mpr ha) s hs /-- The common tail of a small limit family of surreal Archimedean classes has cofinality at @@ -300,7 +300,7 @@ theorem smallSupportCardinal_le_tailSubmodule_cof have hsSmall : Small.{u} s := by rw [Cardinal.small_iff_lift_mk_lt_univ] simpa [smallSupportCardinal] using (not_le.mp hcard) - letI : Small.{u} s := hsSmall + let : Small.{u} s := hsSmall let L : Set Surreal.{u} := {0} ∪ ((↑) : ↥(FiniteArchimedeanClass.tailSubmodule ℚ T) → Surreal.{u}) '' s let R : Set Surreal.{u} := Set.range fun p : T × ℕ ↦ @@ -422,7 +422,7 @@ theorem assumptionA2 exact (hzero rfl).elim · exact ⟨fun h ↦ h hx, fun h _ ↦ h⟩ let e : ↥(ball ℝ c) ≃o ↥σ.ballAddSubgroup := - OrderIso.setCongr _ _ hball + Set.orderIsoOfEq _ _ hball exact Or.inl (by rw [← e.cof_congr] exact smallSupportCardinal_le_ball_cof c) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Cardinal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Cardinal.lean index 4a056a16b0..a530867245 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Cardinal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Cardinal.lean @@ -30,7 +30,7 @@ namespace Surreal /-- Surreal numbers with option sets in universe `u` are not `u`-small. -/ theorem not_small : ¬Small.{u} Surreal.{u} := by intro h - letI : Small.{u} Surreal.{u} := h + let : Small.{u} Surreal.{u} := h exact not_injective_of_ordinal (fun o : Ordinal.{u} ↦ (NatOrdinal.of o).toSurreal) (NatOrdinal.toSurreal.injective.comp NatOrdinal.of.injective) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/CutFilling.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/CutFilling.lean index 26bfa023de..70d713e985 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/CutFilling.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/CutFilling.lean @@ -111,7 +111,7 @@ theorem completeSpace_tailQuotient [IsUniformAddGroup (Surreal.{u} ⧸ FiniteArchimedeanClass.tailKernel T)] [OrderTopology (Surreal.{u} ⧸ FiniteArchimedeanClass.tailKernel T)] : CompleteSpace (Surreal.{u} ⧸ FiniteArchimedeanClass.tailKernel T) := by - letI : Nonempty (Shrink.{u} T) := + let : Nonempty (Shrink.{u} T) := ⟨equivShrink T (Classical.arbitrary T)⟩ exact completeSpace_quotient (FiniteArchimedeanClass.tailKernel T) (fun i : Shrink.{u} T ↦ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalForm.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalForm.lean index 14059fa458..84d708fb0c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalForm.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalForm.lean @@ -71,6 +71,8 @@ When `y.length` is a limit ordinal, the series with `x ≺ y` describe the left def truncLT (x : SurrealHahnSeries) : Set SurrealHahnSeries := truncAux x (· < ·) +/-- A series lies below another in the truncation order when it belongs to the latter’s lower +truncations. -/ notation:50 x:50 " ≺ " y:50 => x ∈ truncLT y recommended_spelling "truncLT" for "≺" in [«term_≺_»] @@ -1041,6 +1043,8 @@ theorem wlog_sub_lt {y : PartialSum x} (h : x ≠ y.carrier) (i) : rw [← wlog_term, term_eq_leadingTerm_sub _ hi, ← carrier_truncIdx, wlog_leadingTerm] exact wlog_lt_wlog_of_vlt (by simpa [sub_eq_zero]) (vlt_def.2 <| mk_sub_strictMono hy) +/-- Extend a partial sum by the leading term of its remaining difference from the target surreal +number. -/ @[expose] def succ' (y : PartialSum x) : PartialSum x where carrier := y.carrier + single (x - y.carrier).wlog (x - y.carrier).leadingCoeff diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormMul.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormMul.lean index 1658398a90..c510289053 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormMul.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormMul.lean @@ -962,13 +962,13 @@ private theorem fits_single_one_mul (g : IGame.{u}) [Numeric g] {y : SurrealHahn grw [hzeroOption (Or.inl hb), ← toIGame_equiv (single (Surreal.mk g) 1 * y)] exact_mod_cast mul_lt_mul_of_pos_left (lt_of_truncLT hb) hxpos · intro q _ z hz b hb - letI := Numeric.of_mem_moves hz + let := Numeric.of_mem_moves hz rw [Numeric.not_le] grw [hoption q hz (Or.inl hb), ← toIGame_equiv (single (Surreal.mk g) 1 * y)] exact_mod_cast mulOptionValue_lt_mul_of_lt_of_lt (single_dyadic_lt_single_one_of_mem_leftMoves g q hz) (lt_of_truncLT hb) · intro q hq z hz b hb - letI := Numeric.of_mem_moves hz + let := Numeric.of_mem_moves hz rw [Numeric.not_le] grw [hoption q hz (Or.inr hb), ← toIGame_equiv (single (Surreal.mk g) 1 * y)] exact_mod_cast mulOptionValue_lt_mul_of_gt_of_gt @@ -982,13 +982,13 @@ private theorem fits_single_one_mul (g : IGame.{u}) [Numeric g] {y : SurrealHahn grw [← toIGame_equiv (single (Surreal.mk g) 1 * y), hzeroOption (Or.inr hb)] exact_mod_cast mul_lt_mul_of_pos_left (gt_of_truncGT hb) hxpos · intro q _ z hz b hb - letI := Numeric.of_mem_moves hz + let := Numeric.of_mem_moves hz rw [Numeric.not_le] grw [← toIGame_equiv (single (Surreal.mk g) 1 * y), hoption q hz (Or.inr hb)] exact_mod_cast mul_lt_mulOptionValue_of_lt_of_gt (single_dyadic_lt_single_one_of_mem_leftMoves g q hz) (gt_of_truncGT hb) · intro q hq z hz b hb - letI := Numeric.of_mem_moves hz + let := Numeric.of_mem_moves hz rw [Numeric.not_le] grw [← toIGame_equiv (single (Surreal.mk g) 1 * y), hoption q hz (Or.inl hb)] exact_mod_cast mul_lt_mulOptionValue_of_gt_of_lt diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormRecursion.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormRecursion.lean index 7e1708c3ab..62a9438c81 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormRecursion.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/NormalFormRecursion.lean @@ -238,7 +238,7 @@ theorem trunc_trunc (s : TermSeq) (i j : Ordinal) : (s.trunc i).trunc j = s.trun · simp · simp -@[simp← ] +@[simp ←] theorem coe_trunc (s : TermSeq) (i : Ordinal) : s.trunc i = truncIdx s i := by obtain hi | hi := lt_or_ge i s.length · rw [truncIdx_of_lt (by simpa), exp_coe] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Basic.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Basic.lean index 6c24723bed..01e335dff6 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Basic.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Basic.lean @@ -99,7 +99,6 @@ private theorem IsOmnificGame.neg {x : IGame.{u}} (hx : IsOmnificGame x) : exact IGame.neg_congr hx private theorem cutGame_add_cutGame_equiv {x y : IGame.{u}} - [IGame.Numeric x] [IGame.Numeric y] (hx : IsOmnificGame x) (hy : IsOmnificGame y) : cutGame x + cutGame y ≈ cutGame (x + y) := by have hx' : Game.mk !{{x - 1} | {x + 1}} = Game.mk x := (Game.mk_eq hx).symm @@ -120,8 +119,8 @@ private theorem mulOption_cutGame_equiv {x y s t : IGame.{u}} (hx : IsOmnificGame x) (hy : IsOmnificGame y) : IGame.mulOption !{{x - 1} | {x + 1}} !{{y - 1} | {y + 1}} (x + s) (y + t) ≈ x * y - s * t := by - letI : IGame.Numeric !{{x - 1} | {x + 1}} := cutGameNumeric x - letI : IGame.Numeric !{{y - 1} | {y + 1}} := cutGameNumeric y + let : IGame.Numeric !{{x - 1} | {x + 1}} := cutGameNumeric x + let : IGame.Numeric !{{y - 1} | {y + 1}} := cutGameNumeric y have hx' : Surreal.mk !{{x - 1} | {x + 1}} = Surreal.mk x := (Surreal.mk_eq hx).symm have hy' : Surreal.mk !{{y - 1} | {y + 1}} = Surreal.mk y := (Surreal.mk_eq hy).symm apply Surreal.mk_eq_mk.mp @@ -228,7 +227,7 @@ private theorem omnificIntegerCut_mk (x : IGame.{u}) [IGame.Numeric x] : omnificIntegerCut (Surreal.mk x) = Surreal.mk (cutGame x) := by rw [omnificIntegerCut] symm - letI : IGame.Numeric !{{x - 1} | {x + 1}} := cutGameNumeric x + let : IGame.Numeric !{{x - 1} | {x + 1}} := cutGameNumeric x change Surreal.mk !{{x - 1} | {x + 1}} = _ rw [Surreal.mk_ofSets] congr! 2 <;> simp diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/IrreducibleOmnificIntegers.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/IrreducibleOmnificIntegers.lean index a0e834e886..10a7072fc9 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/IrreducibleOmnificIntegers.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality/IrreducibleOmnificIntegers.lean @@ -282,7 +282,7 @@ theorem prime_intCast [CharZero R] {z : ℤ} (hz : Prime z) : have := congrArg (intCoeffRingHom Z hZ) h rwa [map_intCast, Int.cast_id, map_zero] at this · intro h - apply hz.not_unit + apply hz.not_isUnit rcases eq_one_or_eq_neg_one_of_isUnit Z hZ h with h1 | h1 · have := congrArg (intCoeffRingHom Z hZ) h1 rw [map_intCast, Int.cast_id, map_one] at this diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Refinement/ConwayRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Refinement/ConwayRefinement.lean index ea3f57cbce..4ef5faa1b3 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Refinement/ConwayRefinement.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Refinement/ConwayRefinement.lean @@ -74,11 +74,11 @@ theorem signedSmallSupportIntegerPart_isPrimal rw [supportArchimedeanClasses_toNonpositiveRingHom] exact hy · intro T hTne hTlimit hTcard - letI : Small.{u} T := small_of_card_lt_smallSupportCardinal hTcard - letI : Nonempty T := Set.nonempty_coe_sort.mpr hTne + let : Small.{u} T := small_of_card_lt_smallSupportCardinal hTcard + let : Nonempty T := Set.nonempty_coe_sort.mpr hTne exact ⟨Surreal.completeSpace_rationalTailQuotient T hTlimit⟩ · intro T _hTne hTlimit hTcard - letI : Small.{u} T := small_of_card_lt_smallSupportCardinal hTcard + let : Small.{u} T := small_of_card_lt_smallSupportCardinal hTcard exact Surreal.fracSubring_cardSuppLTTruncationIntegerPart_tailSubmodule_eq_top Surreal.realIntegerSubring T hTlimit @@ -108,7 +108,7 @@ theorem signedSmallSupportIntegerPart_decompositionMonoid : -/)] theorem conwayRefinement : ConwayRefinementConjecture.{u} := by rw [conwayRefinementConjecture_def, ← hasFourFactorRefinement_def] - letI : DecompositionMonoid SignedSmallSupportIntegerPart.{u} := + let : DecompositionMonoid SignedSmallSupportIntegerPart.{u} := signedSmallSupportIntegerPart_decompositionMonoid exact signedSmallSupportIntegerPartRingEquiv.toMulEquiv.hasFourFactorRefinement_iff.mpr hasFourFactorRefinement_of_decompositionMonoid diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/RationalTailQuotient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/RationalTailQuotient.lean index e12c0ccfd0..a7bbd4ef35 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/RationalTailQuotient.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/RationalTailQuotient.lean @@ -306,7 +306,7 @@ uniformity. -/ theorem completeSpace_rationalTailQuotient (T : Set (FiniteArchimedeanClass Surreal.{u})) [Small.{u} T] [Nonempty T] (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) : CompleteSpace (RationalTailQuotient T) := by - letI : Nonempty (Shrink.{u} T) := ⟨equivShrink T (Classical.arbitrary T)⟩ + let : Nonempty (Shrink.{u} T) := ⟨equivShrink T (Classical.arbitrary T)⟩ obtain ⟨hpos, hcoinitial⟩ := rationalTailQuotientScale_pos_and_coinitial T hT apply completeSpace_of_coinitial_of_exists_half (rationalTailQuotientScale T) · exact hpos diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Round.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Round.lean index e37a4e8e24..f6fbd4f8f0 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Round.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Round.lean @@ -46,14 +46,14 @@ theorem birthday_ofSets_le_of_mem {s t : Set Surreal.{u}} {z : Surreal} apply IGame.Fits.birthday_le constructor · intro x hx - letI := IGame.Numeric.of_mem_moves hx + let := IGame.Numeric.of_mem_moves hx rw [IGame.Numeric.not_le] simp only [moves_ofSets, Player.cases] at hx obtain ⟨a, ha, rfl⟩ := hx rw [← Surreal.mk_lt_mk, out_eq, out_eq] exact hL a ha · intro y hy - letI := IGame.Numeric.of_mem_moves hy + let := IGame.Numeric.of_mem_moves hy rw [IGame.Numeric.not_le] simp only [moves_ofSets, Player.cases] at hy obtain ⟨a, ha, rfl⟩ := hy @@ -70,14 +70,14 @@ theorem birthday_ofSets_lt_of_mem {s t : Set Surreal.{u}} {z : Surreal} apply IGame.Fits.birthday_lt · constructor · intro x hx - letI := IGame.Numeric.of_mem_moves hx + let := IGame.Numeric.of_mem_moves hx rw [IGame.Numeric.not_le] simp only [moves_ofSets, Player.cases] at hx obtain ⟨a, ha, rfl⟩ := hx rw [← Surreal.mk_lt_mk, out_eq, out_eq] exact hL a ha · intro y hy - letI := IGame.Numeric.of_mem_moves hy + let := IGame.Numeric.of_mem_moves hy rw [IGame.Numeric.not_le] simp only [moves_ofSets, Player.cases] at hy obtain ⟨a, ha, rfl⟩ := hy @@ -117,8 +117,7 @@ theorem round_of_nonpos {x r : Surreal} (hr : r ≤ 0) : x.round r = x := dite_eq_right hr.not_gt /-- The singleton rounding cut of a positive numeric game is numeric. -/ -@[implicit_reducible] -def roundGameNumeric {x r : IGame} [x.Numeric] [r.Numeric] (hr : 0 < r) : +theorem roundGameNumeric {x r : IGame} [x.Numeric] [r.Numeric] (hr : 0 < r) : IGame.Numeric !{{x - r} | {x + r}} := .mk (by intro y hy z hz @@ -188,7 +187,7 @@ theorem round_of_zero_mem {x r : Surreal} (h : 0 ∈ Ioo (x - r) (x + r)) : x.ro have hr' : (0 : IGame) < r := by rw [← Surreal.mk_lt_mk] simpa only [Surreal.mk_zero] using hr - letI : IGame.Numeric !{{x - r} | {x + r}} := + let : IGame.Numeric !{{x - r} | {x + r}} := roundGameNumeric (x := x) (r := r) hr' rw [← mk_zero, round_mk_of_pos hr, mk_eq_mk, ← fits_zero_iff_equiv] simpa [Fits] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/SmallDiscrete.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/SmallDiscrete.lean index 18555472ac..60c87d173c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/SmallDiscrete.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/SmallDiscrete.lean @@ -50,7 +50,7 @@ theorem exists_Ioo_inter_subset_singleton_of_small {S : Set Surreal.{u}} [Small. classical set d : Surreal.{u} → Surreal.{u} := fun s ↦ max (s - p) (p - s) with hd have hsub : (S \ {p} : Set Surreal.{u}) ⊆ S := Set.sdiff_subset - haveI : Small.{u} (S \ {p} : Set Surreal.{u}) := small_subset hsub + have : Small.{u} (S \ {p} : Set Surreal.{u}) := small_subset hsub obtain ⟨q, hq, hlt⟩ := exists_pos_lt_of_small (P := d '' (S \ {p})) (by rintro _ ⟨s, hs, rfl⟩ rw [hd, lt_max_iff] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Basic.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Basic.lean index a5aa59a3cc..f83571aad8 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Basic.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Basic.lean @@ -28,6 +28,7 @@ namespace ZFSet /-- A set-coded game satisfying Conway's numeric condition. -/ structure NumericGameCode where + /-- The underlying ZFC code for the numeric game. -/ code : GameCode.{u} numeric : code.IsNumeric @@ -60,7 +61,7 @@ theorem toSurreal_surjective : Function.Surjective (toSurreal.{u}) := by rw [GameCode.isNumeric_iff, GameCode.toIGame_ofIGame] infer_instance⟩ refine ⟨c, ?_⟩ - letI : IGame.Numeric (GameCode.ofIGame x.out).toIGame := + let : IGame.Numeric (GameCode.ofIGame x.out).toIGame := (GameCode.isNumeric_iff _).1 c.numeric change _root_.Surreal.mk (GameCode.ofIGame x.out).toIGame = x simp only [GameCode.toIGame_ofIGame, _root_.Surreal.out_eq] @@ -183,31 +184,31 @@ theorem mk_one : mk (1 : GameCode.{u}) GameCode.isNumeric_one = 1 := by @[simp] theorem mk_neg (x : GameCode.{u}) (hx : x.IsNumeric) : mk (-x) hx.neg = -mk x hx := by - letI : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff _).1 hx + let : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff _).1 hx apply toSurreal_injective simp only [toSurreal_mk, GameCode.toIGame_neg, _root_.Surreal.mk_neg, toSurreal_neg] @[simp] theorem mk_add (x y : GameCode.{u}) (hx : x.IsNumeric) (hy : y.IsNumeric) : mk (x + y) (hx.add hy) = mk x hx + mk y hy := by - letI : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff _).1 hx - letI : IGame.Numeric y.toIGame := (GameCode.isNumeric_iff _).1 hy + let : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff _).1 hx + let : IGame.Numeric y.toIGame := (GameCode.isNumeric_iff _).1 hy apply toSurreal_injective simp only [toSurreal_mk, GameCode.toIGame_add, _root_.Surreal.mk_add, toSurreal_add] @[simp] theorem mk_sub (x y : GameCode.{u}) (hx : x.IsNumeric) (hy : y.IsNumeric) : mk (x - y) (hx.sub hy) = mk x hx - mk y hy := by - letI : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff _).1 hx - letI : IGame.Numeric y.toIGame := (GameCode.isNumeric_iff _).1 hy + let : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff _).1 hx + let : IGame.Numeric y.toIGame := (GameCode.isNumeric_iff _).1 hy apply toSurreal_injective simp only [toSurreal_mk, GameCode.toIGame_sub, _root_.Surreal.mk_sub, toSurreal_sub] @[simp] theorem mk_mul (x y : GameCode.{u}) (hx : x.IsNumeric) (hy : y.IsNumeric) : mk (x * y) (hx.mul hy) = mk x hx * mk y hy := by - letI : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff _).1 hx - letI : IGame.Numeric y.toIGame := (GameCode.isNumeric_iff _).1 hy + let : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff _).1 hx + let : IGame.Numeric y.toIGame := (GameCode.isNumeric_iff _).1 hy apply toSurreal_injective simp only [toSurreal_mk, GameCode.toIGame_mul, _root_.Surreal.mk_mul, toSurreal_mul] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Cuts.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Cuts.lean index 1ae276480c..0ad99aa5ff 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Cuts.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Cuts.lean @@ -49,8 +49,8 @@ namespace ZFSet.Surreal @[simp] theorem mk_lt_mk (x y : GameCode.{u}) (hx : x.IsNumeric) (hy : y.IsNumeric) : mk x hx < mk y hy ↔ x < y := by - letI : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff x).1 hx - letI : IGame.Numeric y.toIGame := (GameCode.isNumeric_iff y).1 hy + let : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff x).1 hx + let : IGame.Numeric y.toIGame := (GameCode.isNumeric_iff y).1 hy rw [← toSurreal_lt_toSurreal, toSurreal_mk, toSurreal_mk, _root_.Surreal.mk_lt_mk, GameCode.toIGame_lt_toIGame] @@ -58,8 +58,8 @@ theorem mk_lt_mk (x y : GameCode.{u}) (hx : x.IsNumeric) (hy : y.IsNumeric) : @[simp] theorem mk_le_mk (x y : GameCode.{u}) (hx : x.IsNumeric) (hy : y.IsNumeric) : mk x hx ≤ mk y hy ↔ x ≤ y := by - letI : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff x).1 hx - letI : IGame.Numeric y.toIGame := (GameCode.isNumeric_iff y).1 hy + let : IGame.Numeric x.toIGame := (GameCode.isNumeric_iff x).1 hx + let : IGame.Numeric y.toIGame := (GameCode.isNumeric_iff y).1 hy rw [← toSurreal_le_toSurreal, toSurreal_mk, toSurreal_mk, _root_.Surreal.mk_le_mk, GameCode.toIGame_le_toIGame] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/OmnificCodes.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/OmnificCodes.lean index 2e483862d3..e3bf08b379 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/OmnificCodes.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/OmnificCodes.lean @@ -27,6 +27,7 @@ namespace ZFSet /-- A ZFC game code satisfying Conway's omnific-integer equation. -/ structure OmnificCode where + /-- The underlying ZFC game code satisfying the omnific-integer condition. -/ code : GameCode.{u} omnific : code.IsOmnificInteger @@ -171,7 +172,7 @@ theorem isPrime_iff (x : OmnificCode.{u}) : x.IsPrime ↔ Prime x.value := by · intro h refine ⟨fun hz ↦ h.ne_zero (by simpa only [value_zero] using (equivalent_iff _ _).1 hz), - fun hu ↦ h.not_unit ((isUnit_iff _).1 hu), ?_⟩ + fun hu ↦ h.not_isUnit ((isUnit_iff _).1 hu), ?_⟩ intro a b hab have hv : x.value ∣ a.value * b.value := by simpa only [value_mul] using (divides_iff _ _).1 hab diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/OmnificInteger.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/OmnificInteger.lean index 58d69ddbce..7b4ce6ec48 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/OmnificInteger.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/OmnificInteger.lean @@ -38,7 +38,7 @@ theorem isOmnificInteger_iff (x : GameCode.{u}) : x.IsOmnificInteger ↔ /-- The set-code condition agrees with the actual omnific-integer predicate. -/ theorem isOmnificInteger_iff_toSurreal (x : GameCode.{u}) (hx : x.IsNumeric) : x.IsOmnificInteger ↔ _root_.Surreal.IsOmnificInteger (Surreal.toSurreal (Surreal.mk x hx)) := by - letI : IGame.Numeric x.toIGame := (isNumeric_iff _).1 hx + let : IGame.Numeric x.toIGame := (isNumeric_iff _).1 hx rw [isOmnificInteger_iff, and_iff_right hx, Surreal.toSurreal_mk, _root_.Surreal.isOmnificInteger_mk_iff] rw [← toIGame_equiv_toIGame] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Properness.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Properness.lean index 375dfbc451..655753d2c8 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Properness.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Properness.lean @@ -31,7 +31,7 @@ namespace Surreal.OmnificInteger /-- Omnific integers with option sets in universe `u` are not `u`-small. -/ theorem not_small : ¬Small.{u} OmnificInteger.{u} := by intro h - letI : Small.{u} OmnificInteger.{u} := h + let : Small.{u} OmnificInteger.{u} := h let f : Ordinal.{u} → OmnificInteger.{u} := fun o ↦ ⟨(NatOrdinal.of o).toSurreal, NatOrdinal.toSurreal_mem_omnificIntegers (NatOrdinal.of o)⟩ apply not_injective_of_ordinal f @@ -111,7 +111,7 @@ theorem mem_numericGameCodes (x : NumericGameCode.{u}) : /-- Numeric game codes are not small, because their values cover all surreal numbers. -/ theorem not_small : ¬Small.{u} NumericGameCode.{u} := by intro h - letI : Small.{u} NumericGameCode.{u} := h + let : Small.{u} NumericGameCode.{u} := h exact _root_.Surreal.not_small (small_of_surjective toSurreal_surjective) end NumericGameCode @@ -148,7 +148,7 @@ theorem mem_omnificGameCodes (x : OmnificCode.{u}) : /-- Omnific game codes are not small, because their values cover all omnific integers. -/ theorem not_small : ¬Small.{u} OmnificCode.{u} := by intro h - letI : Small.{u} OmnificCode.{u} := h + let : Small.{u} OmnificCode.{u} := h exact _root_.Surreal.OmnificInteger.not_small (small_of_surjective value_surjective) end OmnificCode @@ -200,7 +200,7 @@ namespace Surreal /-- Distinct Conway-equivalence classes of numeric ZFC game codes do not form a small type. -/ theorem not_small : ¬Small.{u} Surreal.{u} := by intro h - letI : Small.{u} Surreal.{u} := h + let : Small.{u} Surreal.{u} := h exact _root_.Surreal.not_small (small_of_surjective toSurreal_surjective) namespace OmnificInteger @@ -208,7 +208,7 @@ namespace OmnificInteger /-- Distinct omnific values in the class presentation do not form a small type. -/ theorem not_small : ¬Small.{u} OmnificInteger.{u} := by intro h - letI : Small.{u} OmnificInteger.{u} := h + let : Small.{u} OmnificInteger.{u} := h exact _root_.Surreal.OmnificInteger.not_small (small_of_surjective ringEquiv.surjective) end OmnificInteger diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Reduced.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Reduced.lean index 262c43a0bd..56089ef7a7 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Reduced.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Reduced.lean @@ -75,14 +75,14 @@ theorem isReduced_toSignedNonpositiveHahn_iff_support (x : OmnificInteger.{u}) : constructor · exact (hmem (-i)).2 (by simpa only [neg_neg] using hi.1) · exact (hmemSub (-i)).2 (by simpa only [neg_neg] using hi.2) - simpa only [Set.mem_setOf_eq, ArchimedeanClass.mk_neg] using hc hsigned + simpa only [Set.mem_ofPred_eq, ArchimedeanClass.mk_neg] using hc hsigned · rintro ⟨hx0, c, hc⟩ refine HahnSeries.Nonpositive.isReduced_of_support_inter_support_sub_one_subset (hzero.mpr hx0) c ?_ intro i hi have hunsigned : -i ∈ (x : Surreal).support ∩ ((x : Surreal) - 1).support := ⟨(hmem i).1 hi.1, (hmemSub i).1 hi.2⟩ - simpa only [Set.mem_setOf_eq, ArchimedeanClass.mk_neg] using hc hunsigned + simpa only [Set.mem_ofPred_eq, ArchimedeanClass.mk_neg] using hc hunsigned end Surreal.OmnificInteger diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Tests/SourceIndex.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Tests/SourceIndex.lean index 3bf6d65a49..2d624abf15 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Tests/SourceIndex.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Tests/SourceIndex.lean @@ -1256,7 +1256,7 @@ example := (@Berarducci.residualPointTail_eq_inter_Ioo : /- Berarducci, Lemma 6.8. The statement is unchanged; the proof treats residual value one by isolated support points rather than by the failing limit-index construction in the printed proof. -/ -example := (@Berarducci.residualPointTail_eventually : +example := ((fun {_} [_] [_] b ↦ Berarducci.residualPointTail_eventually b) : ∀ {K : Type v} [Field K] [CharZero K] (b : Berarducci.SeriesWithOrdinalValueAboveOne K), ∀ᶠ η in nhdsWithin (0 : ℝ) (Set.Iio 0), diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixson.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixson.lean index eedaf5564a..5ac8d66bef 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixson.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixson.lean @@ -119,7 +119,7 @@ theorem IsClosedMap.cantorBendixson_image_subset [T1Space X] [T1Space Y] · exact inter_subset_inter_right _ (s.cantorBendixson_antitone (le_max_left i j)) · exact inter_subset_inter_right _ (s.cantorBendixson_antitone (le_max_right i j)) have htf (i : Iio o) : (t i).Finite := (hfin y).subset inter_subset_left - letI : Nonempty (Iio o) := ⟨⟨0, ho.bot_lt⟩⟩ + let : Nonempty (Iio o) := ⟨⟨0, ho.bot_lt⟩⟩ obtain ⟨x, hx⟩ := IsCompact.nonempty_iInter_of_directed_nonempty_isCompact_isClosed t htd htn (fun i ↦ (htf i).isCompact) (fun i ↦ (htf i).isClosed) have hxi := mem_iInter.mp hx diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonRank.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonRank.lean index 93ad917228..c462569513 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonRank.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonRank.lean @@ -50,7 +50,7 @@ namespace TopologicalSpace.Closeds theorem exists_notMem_cantorBendixson_succ (s : Closeds X) (hs : (s : Set X).IsPWO) (x : X) : ∃ o : Ordinal.{u}, x ∉ (s.cantorBendixson (o + 1) : Set X) := by classical - letI : WellFoundedLT (s : Set X) := hs.isWF + let : WellFoundedLT (s : Set X) := hs.isWF let r (y : X) : Ordinal.{u} := if h : y ∈ s then Ordinal.typein (α := (s : Set X)) (· < ·) ⟨y, h⟩ else 0 have hr : ∀ y ∈ s, ∀ᶠ z in 𝓝 y, z ∈ s → z ≠ y → r z < r y := by @@ -79,7 +79,7 @@ theorem notMem_cantorBendixson_rank_add_one (s : Closeds X) theorem cantorBendixsonRank_le_of_notMem (s : Closeds X) (hs : (s : Set X).IsPWO) (x : X) {o : Ordinal.{u}} (ho : x ∉ (s.cantorBendixson (o + 1) : Set X)) : s.cantorBendixsonRank hs x ≤ o := by - exact wellFounded_lt.min_le ho + exact WellFoundedLT.min_le ho /-- A point belongs to a derivative exactly when it lies in the set and its rank is high enough. -/ theorem mem_cantorBendixson_iff (s : Closeds X) (hs : (s : Set X).IsPWO) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonReconstruction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonReconstruction.lean index 6054770e0a..c26348b809 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonReconstruction.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/CantorBendixsonReconstruction.lean @@ -205,11 +205,11 @@ theorem closure_rank_level_eq (s : Closeds X) (hs : (s : Set X).IsPWO) (o : Ordi constructor · rintro ⟨hx, hr⟩ have hh := (s.cantorBendixsonRank_eq_iff hs hx o).mp hr - simpa only [cantorBendixson_add_one, coe_derived, mem_setOf_eq] using hh + simpa only [cantorBendixson_add_one, coe_derived, Set.mem_ofPred_eq] using hh · intro hh have hx := s.cantorBendixson_le o hh.1 refine ⟨hx, (s.cantorBendixsonRank_eq_iff hs hx o).mpr ?_⟩ - simpa only [cantorBendixson_add_one, coe_derived, mem_setOf_eq] using hh + simpa only [cantorBendixson_add_one, coe_derived, Set.mem_ofPred_eq] using hh rw [he] exact hd diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CantorBendixsonConvexCover.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CantorBendixsonConvexCover.lean index e9c5ab5fbb..103c5d3e12 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CantorBendixsonConvexCover.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CantorBendixsonConvexCover.lean @@ -196,7 +196,7 @@ theorem exists_disjoint_convex_cover_with_rank_lt_center_within have hpv : p ∈ B v := hsub hpw have hmv : idx w ≤ idx v := by rw [hwidx] - exact wellFounded_lt.min_le (s := covIdx) (x := idx v) ⟨v, rfl, hpv⟩ + exact WellFoundedLT.min_le (s := covIdx) (x := idx v) ⟨v, rfl, hpv⟩ exact le_antisymm (hnest v w hmv p hpv hpw) hsub have hwX : (w : G) ∈ X := ⟨w.2, hwmax⟩ exact Set.mem_iUnion.mpr ⟨⟨(w : G), hwX⟩, hpw⟩ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ClosedPWO.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ClosedPWO.lean index 2374d59fbd..6e0d2a1885 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ClosedPWO.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/ClosedPWO.lean @@ -301,8 +301,8 @@ private theorem strictClosure_orderType_le_two_mul (hs : s.IsPWO) (hz : IsLUB s inter_subset_left).orderType) ≤ 2 * hs.orderType := by let ht := hs.closure.mono (s := strictClosure (s := s) (z := z)) inter_subset_left - letI : WellFoundedLT (strictClosure (s := s) (z := z)) := ht.isWF - letI : WellFoundedLT s := hs.isWF + let : WellFoundedLT (strictClosure (s := s) (z := z)) := ht.isWF + let : WellFoundedLT s := hs.isWF let e : strictClosure (s := s) (z := z) ↪o s ×ₗ Fin 2 := OrderEmbedding.ofStrictMono (closureEmbedding hs hz) (closureEmbedding_strictMono hs hz) @@ -394,7 +394,7 @@ theorem IsPWO.cantorBendixsonRank_closure_eq_of_orderType_eq_opow let S : TopologicalSpace.Closeds ℝ := ⟨(_root_.closure s), isClosed_closure⟩ let C : Set ℝ := _root_.closure s let hc : C.IsPWO := hs.closure - letI : WellFoundedLT C := hc.isWF + let : WellFoundedLT C := hc.isWF let T : Ordinal := Ordinal.type (· < · : C → C → Prop) let i : Iio T := ⟨Ordinal.typein (· < · : C → C → Prop) ⟨z, hzc⟩, diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CoinitialComplete.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CoinitialComplete.lean index a4908f3e81..6f56ebd629 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CoinitialComplete.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/CoinitialComplete.lean @@ -153,7 +153,7 @@ theorem completeSpace_of_coinitial_of_forall_exists_mem_cut {ι : Type w} [Nonem (hcut : FillsCuts ι G) : CompleteSpace G := by refine ⟨fun {F} hF ↦ ?_⟩ - haveI : F.NeBot := hF.1 + have : F.NeBot := hF.1 -- a set of small diameter in `F` for each index, together with a point of it have hsmall : ∀ i, ∃ A ∈ F, ∃ a ∈ A, ∀ x ∈ A, x - a ∈ Ioo (-ε i) (ε i) := by intro i @@ -233,6 +233,6 @@ theorem completeSpace_of_fillsCuts_pos (hpos : ∃ c : G, 0 < c) (hhalf : ∀ c : G, 0 < c → ∃ d : G, 0 < d ∧ d + d ≤ c) (hcut : FillsCuts {x : G // 0 < x} G) : CompleteSpace G := by obtain ⟨c₀, hc₀⟩ := hpos - haveI : Nonempty {x : G // 0 < x} := ⟨⟨c₀, hc₀⟩⟩ + have : Nonempty {x : G // 0 < x} := ⟨⟨c₀, hc₀⟩⟩ exact completeSpace_of_coinitial_of_exists_half Subtype.val (fun i ↦ i.2) (fun c hc ↦ ⟨⟨c, hc⟩, le_rfl⟩) hhalf hcut diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOAddition.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOAddition.lean index 69da609f27..31a1d7735b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOAddition.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/PWOAddition.lean @@ -152,7 +152,7 @@ Cauchy complete. -/ theorem Set.IsPWO.isProperMap_add [CompleteSpace G] {s t : Set G} (hs : s.IsPWO) (ht : t.IsPWO) (hsc : IsClosed s) (htc : IsClosed t) : IsProperMap (fun p : s ×ˢ t ↦ p.1.1 + p.1.2) := by - letI : CompleteSpace (s ×ˢ t) := (hsc.prod htc).isComplete.completeSpace_coe + let : CompleteSpace (s ×ˢ t) := (hsc.prod htc).isComplete.completeSpace_coe refine isProperMap_iff_ultrafilter_of_t2.mpr ⟨by fun_prop, ?_⟩ intro 𝒰 y hy have hc : Cauchy (Filter.map (fun p : G × G ↦ p.1 + p.2) @@ -180,7 +180,7 @@ theorem Set.IsPWO.finite_subtype_add_fiber {s t : Set G} have hf := (hs.finite_add_fiber ht z).preimage (f := (Subtype.val : s ×ˢ t → G × G)) Subtype.val_injective.injOn change {p : s ×ˢ t | p.1.1 + p.1.2 = z}.Finite - simpa only [preimage_setOf_eq, Subtype.coe_prop, true_and] using hf + simpa only [Set.preimage_ofPred_eq, Subtype.coe_prop, true_and] using hf /-- The sum of two closed well-ordered supports is closed. -/ theorem Set.IsPWO.isClosed_add [CompleteSpace G] {s t : Set G} diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SmallClosedSubspace.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SmallClosedSubspace.lean index 11586063ea..44ea34a263 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SmallClosedSubspace.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/SmallClosedSubspace.lean @@ -209,7 +209,7 @@ theorem mk_lt_of_isPWO_topologicalClosure_span · exact f_ne_of_lt hlt hxy · exact f_ne_of_lt hgt hxy.symm have hspan : #(span ℚ S) < κ := by - letI : Nonempty S := hSne.to_subtype + let : Nonempty S := hSne.to_subtype have hinj : Function.Injective (Span.repr ℚ S) := by intro x y hxy apply Subtype.ext diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/CantorBendixsonConvexCover.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/CantorBendixsonConvexCover.lean index d33051a522..6f4dfc9d51 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/CantorBendixsonConvexCover.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/CantorBendixsonConvexCover.lean @@ -7,7 +7,7 @@ module public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonConvexCover public import Mathlib.Algebra.Order.Group.PiLex -public import Mathlib.Data.Real.Basic +public import Mathlib.Basic.Real.Basic public import Mathlib.Topology.Instances.Real.Lemmas import Mathlib.Order.Interval.Set.OrdConnected diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/PWOAddition.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/PWOAddition.lean index 33129c595c..84a6240d2b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/PWOAddition.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests/PWOAddition.lean @@ -13,8 +13,7 @@ public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.Algebra public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Leibniz public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Power public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Cancellation -public import - LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValueMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValueMultiplicativity public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Germ public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Graded public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Scalar @@ -105,7 +104,7 @@ def accumulatingSeries : HahnSeries ℝ ℚ := by classical exact ⟨fun x ↦ if x ∈ range negRecip then 1 else 0, by simpa only [Function.support, ne_eq, ite_eq_right_iff, one_ne_zero, imp_false, not_not, - Set.setOf_mem_eq] + Set.ofPred_mem_eq] using negRecip_pwo⟩ open Classical in @@ -211,7 +210,7 @@ theorem convolution_square_nonzero_value : · refine ⟨(negRecip n, negRecip n), ?_, ?_⟩ · rw [Finset.mem_antidiagonal, accumulatingSeries_support] exact ⟨mem_range_self n, mem_range_self n, rfl⟩ - · simp only [accumulatingSeries_coeff, mem_range_self, if_true, one_mul, zero_lt_one] + · simp only [accumulatingSeries_coeff, mem_range_self, ite_true, one_mul, zero_lt_one] have ht := negRecip_tendsto apply mem_closure_of_tendsto (by simpa only [add_zero] using ht.add ht) exact Filter.Eventually.of_forall fun n ↦ (hcoeff n).ne' @@ -624,7 +623,7 @@ theorem accumulatingSeries_graded_class : accumulatingSeries_value] simp refine ⟨b, hb, hd, ?_⟩ - letI := cantorBendixson_associatedGraded_isDomain (G := ℝ) (R := ℚ) + let := cantorBendixson_associatedGraded_isDomain (G := ℝ) (R := ℚ) exact pow_ne_zero 2 ((cantorBendixsonDegreeValuation (G := ℝ) (R := ℚ)).initialForm_ne_zero_of_ne_bot (by rw [hd]; exact WithBot.coe_ne_bot)) @@ -704,7 +703,7 @@ theorem accumulatingSeries_graded_square_not_single_copy : have hx : x ≠ 0 := by intro hx exact hD (by change cantorBendixsonGradedDerivation x = 0; rw [hx, map_zero]) - letI := cantorBendixson_associatedGraded_isDomain (G := ℝ) (R := ℚ) + let := cantorBendixson_associatedGraded_isDomain (G := ℝ) (R := ℚ) have hp : cantorBendixsonGradedDerivation x * (x : Filter.Germ (𝓝[<] (0 : ℝ)) (ν).AssociatedGraded) ≠ 0 := by intro he diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Tests/CantorBendixson.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Tests/CantorBendixson.lean index b3b609015c..73e0e629aa 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Tests/CantorBendixson.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Tests/CantorBendixson.lean @@ -48,7 +48,7 @@ private theorem enat_derivedSet_univ : derivedSet (univ : Set ℕ∞) = {⊤} := intro U hU have he : ∀ᶠ n : ℕ in atTop, (n : ℕ∞) ∈ U := ENat.tendsto_natCast_nhds_top hU obtain ⟨n, hn⟩ := he.exists - exact ⟨(n : ℕ∞), ⟨hn, mem_univ _⟩, ENat.coe_ne_top n⟩ + exact ⟨(n : ℕ∞), ⟨hn, mem_univ _⟩, ENat.natCast_ne_top n⟩ /-- The convergent-sequence limit survives stage one; isolated finite points do not. -/ theorem enat_stage_one : @@ -170,7 +170,7 @@ theorem enat_nat_rank (n : ℕ) : constructor · simp · rw [zero_add, enat_stage_one] - exact ENat.coe_ne_top n + exact ENat.natCast_ne_top n /-- The isolated rank-zero points are dense even though the limit point has rank one. -/ theorem enat_rank_zero_dense : From 63bd5384fcf5f658448a5675e2d754e833591d7a Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 01:36:13 +0000 Subject: [PATCH 11/18] Finish Conway proof refactors and strict quality audits --- .../CombinatorialGames/Game/Birthday.lean | 3 +- .../CombinatorialGames/Game/Classes.lean | 12 +- .../CombinatorialGames/Game/IGame.lean | 2 +- .../CombinatorialGames/Mathlib/Dyadic.lean | 12 +- .../CombinatorialGames/Surreal/Division.lean | 24 +- .../Surreal/Multiplication.lean | 133 +-- .../Algebra/DirectSum/GermSuccessorStep.lean | 559 ++++++----- .../Algebra/GeometricIntegrality.lean | 4 +- .../Algebra/Valuation/BasisOver.lean | 26 +- .../DegreeAssociatedGradedQuotient.lean | 2 +- .../DegreePrincipalInitialIdeal.lean | 5 +- .../OmnificInteger/DegreeTwoPrime.lean | 4 +- .../Examples/OmnificInteger/OneRowPrime.lean | 4 +- .../Random/GradedIrreducible.lean | 2 +- .../Factorization/Random/SuccessorStep.lean | 225 +++-- .../CofactorInduction.lean | 864 ++++++++---------- .../Refinement/FiniteGermError.lean | 4 +- .../Refinement/SupportClassRefinement.lean | 4 +- .../OrdinalValue/CriticalPointExistence.lean | 4 +- .../Statements/ResidualPoint.lean | 2 +- .../Tests/PrincipalSubringFiniteSupport.lean | 2 +- .../TensorProduct/SubalgebraBasis.lean | 12 +- .../Mathlib/HahnIntegerPartRefinement.lean | 2 +- .../Mathlib/Support/InlineSurreal.lean | 30 +- .../Surreal/OmnificInteger/Basic.lean | 2 +- .../ConwayRefinement/Tests/SourceIndex.lean | 5 +- 26 files changed, 1002 insertions(+), 946 deletions(-) diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean index 02eb37d6af..0be5ad2472 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean @@ -32,7 +32,8 @@ open NatOrdinal Order Set /-! ### Stuff for Mathlib -/ -theorem ciSup_eq_bot {α : Type*} {ι : Sort*} [ConditionallyCompleteLinearOrderBot α] {f : ι → α} +private theorem ciSup_eq_bot {α : Type*} {ι : Sort*} [ConditionallyCompleteLinearOrderBot α] + {f : ι → α} (hf : BddAbove (range f)) : ⨆ i, f i = ⊥ ↔ ∀ i, f i = ⊥ := by simpa using ciSup_le_iff' hf (a := ⊥) diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean index fd1ba5dee7..4fbcb45bfc 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean @@ -55,7 +55,8 @@ namespace IGame /-- A game `x` is dicotic if both players can move from every nonempty subposition of `x`. -/ @[mk_iff dicotic_def'] -class inductive Dicotic : IGame → Prop where +class +inductive Dicotic : IGame → Prop where | mk {x : IGame} : (xᴸ = ∅ ↔ xᴿ = ∅) → (∀ p, ∀ y ∈ x.moves p, Dicotic y) → Dicotic x theorem dicotic_def {x : IGame} : Dicotic x ↔ (xᴸ = ∅ ↔ xᴿ = ∅) ∧ ∀ p, ∀ l ∈ x.moves p, Dicotic l := @@ -113,7 +114,8 @@ as we don't require `x = -x`. Despite this, the Sprague-Grundy theorem still hol In such a game, both players have the same payoffs at any subposition. -/ @[mk_iff impartial_def'] -class inductive Impartial : IGame → Prop where +class +inductive Impartial : IGame → Prop where | mk {x : IGame} : -x ≈ x → (∀ p, ∀ y ∈ x.moves p, Impartial y) → Impartial x theorem impartial_def {x : IGame} : x.Impartial ↔ -x ≈ x ∧ ∀ p, ∀ y ∈ x.moves p, Impartial y := @@ -256,7 +258,8 @@ elements of these sets are also numeric. The `Surreal` numbers are built as the quotient of numeric games under equivalence. -/ @[mk_iff numeric_def'] -class inductive Numeric : IGame → Prop where +class +inductive Numeric : IGame → Prop where | mk {x : IGame} : (∀ y ∈ xᴸ, ∀ z ∈ xᴿ, y < z) → (∀ p, ∀ y ∈ x.moves p, Numeric y) → Numeric x theorem numeric_def {x : IGame} : Numeric x ↔ @@ -406,7 +409,8 @@ end Numeric /-- A short game is one with finitely many subpositions. That is, the left and right sets are finite, and all of the games in them are short as well. -/ @[mk_iff short_def'] -class inductive Short : IGame → Prop where +class +inductive Short : IGame → Prop where | mk' (x : IGame) : (∀ p, (x.moves p).Finite) → (∀ p, ∀ y ∈ x.moves p, Short y) → Short x theorem short_def {x : IGame} : Short x ↔ ∀ p, (x.moves p).Finite ∧ ∀ y ∈ x.moves p, Short y := by diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean index 789a5fb546..87965464f9 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean @@ -80,7 +80,7 @@ The order structures interact in the expected way with arithmetic. In particular `SubtractionCommMonoid`, since the equation `x - x = 0` is only true up to equivalence. -/ -theorem Relation.transGen_iff_exists {α : Type*} {r : α → α → Prop} {x y : α} : +private theorem Relation.transGen_iff_exists {α : Type*} {r : α → α → Prop} {x y : α} : Relation.TransGen r x y ↔ ∃ z, r z y ∧ (x = z ∨ TransGen r x z) := by rw [transGen_iff] simp [and_or_left, exists_or, and_comm] diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib/Dyadic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib/Dyadic.lean index b4778b795a..b00dd7ec89 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib/Dyadic.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib/Dyadic.lean @@ -54,7 +54,7 @@ namespace Dyadic attribute [coe] toRat -instance : Coe Dyadic Rat where +instance instCoeRatConway : Coe Dyadic Rat where coe := toRat @[norm_cast] alias coe_le_coe := toRat_le_toRat_iff @@ -124,7 +124,7 @@ theorem den_ne_one_of_den_lt {x y : Dyadic} (h : x.den < y.den) : y.den ≠ 1 := @[simp] theorem coe_eq_intCast {x : Dyadic} {y : ℤ} : x.toRat = y ↔ x = y := by norm_cast @[simp] theorem intCast_eq_coe {x : ℤ} {y : Dyadic} : x = y.toRat ↔ x = y := by norm_cast -instance : Inhabited Dyadic := ⟨0⟩ +instance instInhabitedConway : Inhabited Dyadic := ⟨0⟩ @[simp, norm_cast] theorem coe_zero : (0 : Dyadic).toRat = 0 := rfl @[simp] theorem num_zero : (0 : Dyadic).num = 0 := rfl @@ -160,13 +160,13 @@ instance : Nontrivial Dyadic where @[norm_cast] alias coe_mul := toRat_mul @[norm_cast] alias coe_pow := toRat_pow -instance : SMul Nat Dyadic where +instance instSMulNatConway : SMul Nat Dyadic where smul x y := x * y @[norm_cast] theorem coe_nsmul (x : ℕ) (y : Dyadic) : (x • y).toRat = x • y.toRat := (coe_mul x y).trans (by simp) -instance : SMul Int Dyadic where +instance instSMulIntConway : SMul Int Dyadic where smul x y := x * y @[norm_cast] theorem coe_zsmul (x : ℤ) (y : Dyadic) : (x • y).toRat = x • y.toRat := @@ -206,7 +206,7 @@ theorem mkRat_lt_mkRat {m n : ℤ} {k : ℕ} (h₁ h₂ : k ∈ Submonoid.powers rw [← coe_lt_coe] simp [Rat.mkRat_eq_div, div_lt_div_iff_of_pos_right hk] -instance : LinearOrder Dyadic where +instance instLinearOrderConway : LinearOrder Dyadic where le_refl := Dyadic.le_refl le_trans := @Dyadic.le_trans le_antisymm := @Dyadic.le_antisymm @@ -225,7 +225,7 @@ theorem mkRat_add_mkRat_self {m n : ℤ} {k : ℕ} (h₁ h₂ : k ∈ Submonoid. Dyadic.mkRat m h₁ + Dyadic.mkRat n h₂ = .mkRat (m + n) h₁ := by ext; simp [Rat.mkRat_eq_div, add_div] -instance : CommRing Dyadic where +instance instCommRingConway : CommRing Dyadic where add_assoc := add_assoc zero_add := Dyadic.zero_add add_zero := Dyadic.add_zero diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Division.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Division.lean index e275840273..417657a224 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Division.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Division.lean @@ -46,16 +46,16 @@ instance {x y a : IGame} [Numeric x] [Numeric y] [Numeric y⁻¹] [Numeric a] : Numeric (invOption x y a) := .mul .. -theorem inv_pos' {x : IGame} [Numeric x⁻¹] (hx : 0 < x) : 0 < x⁻¹ := +private theorem inv_pos' {x : IGame} [Numeric x⁻¹] (hx : 0 < x) : 0 < x⁻¹ := Numeric.left_lt (zero_mem_leftMoves_inv hx) -theorem mk_div' (x y : IGame) [Numeric x] [Numeric y⁻¹] : +private theorem mk_div' (x y : IGame) [Numeric x] [Numeric y⁻¹] : Surreal.mk (x / y) = Surreal.mk x * Surreal.mk y⁻¹ := rfl /-! ### Arithmetic lemmas -/ -lemma one_neg_mul_invOption (x : IGame) {y : IGame} (hy : y * y⁻¹ ≈ 1) (a : IGame) +private lemma one_neg_mul_invOption (x : IGame) {y : IGame} (hy : y * y⁻¹ ≈ 1) (a : IGame) [Numeric x] [Numeric y] [Numeric y⁻¹] [Numeric a] : 1 - x * invOption x y a ≈ (1 - x * a) * (y - x) / y := by rw [← Surreal.mk_eq_mk] at * @@ -63,7 +63,7 @@ lemma one_neg_mul_invOption (x : IGame) {y : IGame} (hy : y * y⁻¹ ≈ 1) (a : simp only [one_mul, sub_eq_add_neg, add_mul, hy] ring -lemma mulOption_self_inv (x : IGame) {y : IGame} (hy : y * y⁻¹ ≈ 1) (a : IGame) +private lemma mulOption_self_inv (x : IGame) {y : IGame} (hy : y * y⁻¹ ≈ 1) (a : IGame) [Numeric x] [Numeric x⁻¹] [Numeric y] [Numeric y⁻¹] [Numeric a] : mulOption x x⁻¹ y a ≈ 1 + (x⁻¹ - invOption x y a) * y := by rw [mul_comm] at hy @@ -72,7 +72,7 @@ lemma mulOption_self_inv (x : IGame) {y : IGame} (hy : y * y⁻¹ ≈ 1) (a : IG simp only [sub_eq_add_neg, add_mul, neg_mul, mul_assoc, hy] ring -lemma mulOption_le (x y : IGame) {a b : IGame} [Numeric y] [Numeric a] [Numeric b] +private lemma mulOption_le (x y : IGame) {a b : IGame} [Numeric y] [Numeric a] [Numeric b] (ha : a ≤ 0) (hb : b ≤ y) : mulOption x y a b ≤ x * b := by rw [mulOption, ← Game.mk_le_mk] dsimp @@ -83,7 +83,7 @@ lemma mulOption_le (x y : IGame) {a b : IGame} [Numeric y] [Numeric a] [Numeric rw [← add_le_add_iff_left (Game.mk (x * b))] at this convert this using 1 <;> abel -theorem le_mulOption (x y : IGame) {a b : IGame} [Numeric y] [Numeric a] [Numeric b] +private theorem le_mulOption (x y : IGame) {a b : IGame} [Numeric y] [Numeric a] [Numeric b] (ha : a ≤ 0) (hb : y ≤ b) : x * b ≤ mulOption x y a b := by rw [mulOption, ← Game.mk_le_mk] dsimp @@ -96,7 +96,7 @@ theorem le_mulOption (x y : IGame) {a b : IGame} [Numeric y] [Numeric a] [Numeri /-! ### Inductive proof -/ -lemma numeric_option_inv {x : IGame} [Numeric x] (hx : 0 < x) +private lemma numeric_option_inv {x : IGame} [Numeric x] (hx : 0 < x) (hl : ∀ y ∈ xᴸ, 0 < y → Numeric y⁻¹) (hr : ∀ y ∈ xᴿ, Numeric y⁻¹) : (∀ p, ∀ y ∈ x⁻¹.moves p, Numeric y) := by refine invRec hx Numeric.zero fun p₁ p₂ y hy hyx _ _ _ ↦ ?_ @@ -108,7 +108,7 @@ lemma numeric_option_inv {x : IGame} [Numeric x] (hx : 0 < x) | have := hr _ hyx infer_instance -lemma mul_inv_option_mem {x : IGame} [Numeric x] (hx : 0 < x) +private lemma mul_inv_option_mem {x : IGame} [Numeric x] (hx : 0 < x) (hl : ∀ y ∈ xᴸ, 0 < y → Numeric y⁻¹) (hr : ∀ y ∈ xᴿ, Numeric y⁻¹) (hl' : ∀ y ∈ xᴸ, 0 < y → y * y⁻¹ ≈ 1) (hr' : ∀ y ∈ xᴿ, y * y⁻¹ ≈ 1) : (∀ y ∈ x⁻¹ᴸ, x * y < 1) ∧ (∀ y ∈ x⁻¹ᴿ, 1 < x * y) := by @@ -154,7 +154,7 @@ lemma mul_inv_option_mem {x : IGame} [Numeric x] (hx : 0 < x) · rw [IGame.sub_pos] exact Numeric.lt_right hyx -lemma numeric_inv {x : IGame} [Numeric x] (hx : 0 < x) +private lemma numeric_inv {x : IGame} [Numeric x] (hx : 0 < x) (hl : ∀ y ∈ xᴸ, 0 < y → Numeric y⁻¹) (hr : ∀ y ∈ xᴿ, Numeric y⁻¹) (hl' : ∀ y ∈ xᴸ, 0 < y → y * y⁻¹ ≈ 1) (hr' : ∀ y ∈ xᴿ, y * y⁻¹ ≈ 1) : Numeric x⁻¹ := by @@ -165,7 +165,7 @@ lemma numeric_inv {x : IGame} [Numeric x] (hx : 0 < x) have := H' _ z hz exact (Numeric.mul_lt_mul_iff_right hx).1 <| (Hl y hy).trans (Hr z hz) -lemma option_mul_inv_lt {x : IGame} [Numeric x] (hx : 0 < x) +private lemma option_mul_inv_lt {x : IGame} [Numeric x] (hx : 0 < x) (hl : ∀ y ∈ xᴸ, 0 < y → Numeric y⁻¹) (hr : ∀ y ∈ xᴿ, Numeric y⁻¹) (hl' : ∀ y ∈ xᴸ, 0 < y → y * y⁻¹ ≈ 1) (hr' : ∀ y ∈ xᴿ, y * y⁻¹ ≈ 1) : (∀ y ∈ (x * x⁻¹)ᴸ, y < 1) ∧ (∀ y ∈ (x * x⁻¹)ᴿ, 1 < y) := by @@ -211,7 +211,7 @@ lemma option_mul_inv_lt {x : IGame} [Numeric x] (hx : 0 < x) rw [IGame.sub_pos] exact Numeric.left_lt (invOption_mem_moves_inv (p₁ := left) hx hy hyx ha) -lemma mul_inv_self {x : IGame} [Numeric x] (hx : 0 < x) +private lemma mul_inv_self {x : IGame} [Numeric x] (hx : 0 < x) (hl : ∀ y ∈ xᴸ, 0 < y → Numeric y⁻¹) (hr : ∀ y ∈ xᴿ, Numeric y⁻¹) (hl' : ∀ y ∈ xᴸ, 0 < y → y * y⁻¹ ≈ 1) (hr' : ∀ y ∈ xᴿ, y * y⁻¹ ≈ 1) : x * x⁻¹ ≈ 1 := by @@ -221,7 +221,7 @@ lemma mul_inv_self {x : IGame} [Numeric x] (hx : 0 < x) rw [Numeric.mul_equiv_zero, not_or] exact ⟨hx.not_antisymmRel_symm, (inv_pos' hx).not_antisymmRel_symm⟩ -theorem main {x : IGame} [Numeric x] (hx : 0 < x) : Numeric x⁻¹ ∧ x * x⁻¹ ≈ 1 := by +private theorem main {x : IGame} [Numeric x] (hx : 0 < x) : Numeric x⁻¹ ∧ x * x⁻¹ ≈ 1 := by have IHl : ∀ y ∈ xᴸ, 0 < y → Numeric y⁻¹ ∧ y * y⁻¹ ≈ 1 := fun y hy hy' ↦ have := Numeric.of_mem_moves hy; main hy' have IHr : ∀ y ∈ xᴿ, Numeric y⁻¹ ∧ y * y⁻¹ ≈ 1 := diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean index d8dfc1aa91..9896972938 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean @@ -55,7 +55,7 @@ universe u open Game IGame Relation WellFounded /-- A characterization of left moves of `x * y` in terms only of left moves. -/ -lemma forall_leftMoves_mul' {P : IGame → Prop} {x y : IGame} : +private lemma forall_leftMoves_mul' {P : IGame → Prop} {x y : IGame} : (∀ a ∈ (x * y)ᴸ, P a) ↔ (∀ a ∈ xᴸ, ∀ b ∈ yᴸ, P (mulOption x y a b)) ∧ (∀ a ∈ (-x)ᴸ, ∀ b ∈ (-y)ᴸ, P (mulOption (-x) (-y) a b)) := by @@ -63,7 +63,7 @@ lemma forall_leftMoves_mul' {P : IGame → Prop} {x y : IGame} : simp [mulOption_neg] /-- A characterization of right moves of `x * y` in terms only of left moves. -/ -lemma forall_rightMoves_mul' {P : IGame → Prop} {x y : IGame} : +private lemma forall_rightMoves_mul' {P : IGame → Prop} {x y : IGame} : (∀ a ∈ (x * y)ᴿ, P a) ↔ (∀ a ∈ xᴸ, ∀ b ∈ (-y)ᴸ, P (-mulOption x (-y) a b)) ∧ (∀ a ∈ (-x)ᴸ, ∀ b ∈ yᴸ, P (-mulOption (-x) y a b)) := by @@ -74,15 +74,15 @@ lemma forall_rightMoves_mul' {P : IGame → Prop} {x y : IGame} : /-- `P1 x y a b c d` means that `mulOption x y a b < mulOption x y c d`. This is the general form of the statements needed to prove that `x * y` is numeric. -/ -def P1 (x y a b c d : IGame) := Game.mk (mulOption x y a b) < Game.mk (mulOption x y c d) +private def P1 (x y a b c d : IGame) := Game.mk (mulOption x y a b) < Game.mk (mulOption x y c d) /-- `P2 x₁ x₂ y` states that if `x₁ ≈ x₂`, then `x₁ * y ≈ x₂ * y`. The RHS is stated in terms of `Game.mk` for rewriting convenience. -/ -def P2 (x₁ x₂ y : IGame) := x₁ ≈ x₂ → Game.mk (x₁ * y) = Game.mk (x₂ * y) +private def P2 (x₁ x₂ y : IGame) := x₁ ≈ x₂ → Game.mk (x₁ * y) = Game.mk (x₂ * y) /-- `P3 x₁ x₂ y₁ y₂` states that `x₁ * y₂ + x₂ * y₁ < x₁ * y₁ + x₂ * y₂`. Using distributivity, this is equivalent to `(x₁ - x₂) * (y₁ - y₂) > 0`. -/ -def P3 (x₁ x₂ y₁ y₂ : IGame) := +private def P3 (x₁ x₂ y₁ y₂ : IGame) := Game.mk (x₁ * y₂) + Game.mk (x₂ * y₁) < Game.mk (x₁ * y₁) + Game.mk (x₂ * y₂) /-- `P4 x₁ x₂ y` states that if `x₁ < x₂`, then `P3 x₁ x₂ a y` when `a ∈ yᴸ`, and @@ -90,66 +90,69 @@ def P3 (x₁ x₂ y₁ y₂ : IGame) := Note that we instead write this second part as `P3 x₁ x₂ b (-y)` when `b ∈ (-y)ᴸ`. See the module docstring for an explanation. -/ -def P4 (x₁ x₂ y : IGame) := +private def P4 (x₁ x₂ y : IGame) := x₁ < x₂ → (∀ a ∈ yᴸ, P3 x₁ x₂ a y) ∧ (∀ b ∈ (-y)ᴸ, P3 x₁ x₂ b (-y)) /-- The conjunction of `P2` and `P4`. Both statements have the same amount of arguments and satisfy similar symmetry properties, so we can slightly simplify the argument by merging them. -/ -def P24 (x₁ x₂ y : IGame) : Prop := P2 x₁ x₂ y ∧ P4 x₁ x₂ y +private def P24 (x₁ x₂ y : IGame) : Prop := P2 x₁ x₂ y ∧ P4 x₁ x₂ y variable {x x₁ x₂ x₃ x' y y₁ y₂ y₃ y' a b c d : IGame.{u}} /-! #### Symmetry properties of P1 – P4 -/ -lemma P3_comm : P3 x₁ x₂ y₁ y₂ ↔ P3 y₁ y₂ x₁ x₂ := by +private lemma P3_comm : P3 x₁ x₂ y₁ y₂ ↔ P3 y₁ y₂ x₁ x₂ := by simp [P3, add_comm, mul_comm] -lemma P3.trans (h₁ : P3 x₁ x₂ y₁ y₂) (h₂ : P3 x₂ x₃ y₁ y₂) : P3 x₁ x₃ y₁ y₂ := by +private lemma P3.trans (h₁ : P3 x₁ x₂ y₁ y₂) (h₂ : P3 x₂ x₃ y₁ y₂) : P3 x₁ x₃ y₁ y₂ := by rw [P3, ← add_lt_add_iff_left (Game.mk (x₂ * y₁) + Game.mk (x₂ * y₂))] convert add_lt_add h₁ h₂ using 1 <;> abel -lemma P3_neg : P3 (-x₂) (-x₁) y₁ y₂ ↔ P3 x₁ x₂ y₁ y₂ := by +private lemma P3_neg : P3 (-x₂) (-x₁) y₁ y₂ ↔ P3 x₁ x₂ y₁ y₂ := by simp_rw [P3, neg_mul, Game.mk_neg] rw [← _root_.neg_lt_neg_iff] abel_nf -lemma P2_neg_left : P2 (-x₂) (-x₁) y ↔ P2 x₁ x₂ y := by +private lemma P2_neg_left : P2 (-x₂) (-x₁) y ↔ P2 x₁ x₂ y := by simp [P2, AntisymmRel, eq_comm] -lemma P2_neg_right : P2 x₁ x₂ (-y) ↔ P2 x₁ x₂ y := by +private lemma P2_neg_right : P2 x₁ x₂ (-y) ↔ P2 x₁ x₂ y := by simp [P2] -lemma P4_neg_left : P4 (-x₂) (-x₁) y ↔P4 x₁ x₂ y := by +private lemma P4_neg_left : P4 (-x₂) (-x₁) y ↔P4 x₁ x₂ y := by simp_rw [P4, IGame.neg_lt_neg_iff, P3_neg] -lemma P4_neg_right : P4 x₁ x₂ (-y) ↔ P4 x₁ x₂ y := by +private lemma P4_neg_right : P4 x₁ x₂ (-y) ↔ P4 x₁ x₂ y := by rw [P4, P4, neg_neg, and_comm] -lemma P24_neg_left : P24 (-x₂) (-x₁) y ↔ P24 x₁ x₂ y := by rw [P24, P24, P2_neg_left, P4_neg_left] -lemma P24_neg_right : P24 x₁ x₂ (-y) ↔ P24 x₁ x₂ y := by rw [P24, P24, P2_neg_right, P4_neg_right] +private lemma P24_neg_left : P24 (-x₂) (-x₁) y ↔ P24 x₁ x₂ y := by + rw [P24, P24, P2_neg_left, P4_neg_left] +private lemma P24_neg_right : P24 x₁ x₂ (-y) ↔ P24 x₁ x₂ y := by + rw [P24, P24, P2_neg_right, P4_neg_right] /-! ### Inductive setup -/ /-- The type of lists of arguments for `P1`, `P2`, and `P4`. -/ -inductive Args : Type (u + 1) +private inductive Args : Type (u + 1) | P1 (x y : IGame.{u}) : Args | P24 (x₁ x₂ y : IGame.{u}) : Args /-- The multiset associated to a list of arguments. -/ -def Args.toMultiset : Args → Multiset IGame +private def Args.toMultiset : Args → Multiset IGame | (Args.P1 x y) => {x, y} | (Args.P24 x₁ x₂ y) => {x₁, x₂, y} -@[simp] lemma Args.toMultiset_P1 {x y} : (Args.P1 x y).toMultiset = {x, y} := rfl -@[simp] lemma Args.toMultiset_P24 {x₁ x₂ y} : (Args.P24 x₁ x₂ y).toMultiset = {x₁, x₂, y} := rfl +@[simp] private lemma Args.toMultiset_P1 {x y} : (Args.P1 x y).toMultiset = {x, y} := rfl +@[simp] private lemma Args.toMultiset_P24 {x₁ x₂ y} : (Args.P24 x₁ x₂ y).toMultiset = {x₁, x₂, y} := + rfl /-- A list of arguments is numeric if all the arguments are. -/ -def Args.Numeric (a : Args) := ∀ x ∈ a.toMultiset, x.Numeric +private def Args.Numeric (a : Args) := ∀ x ∈ a.toMultiset, x.Numeric -lemma Args.numeric_P1 {x y} : (Args.P1 x y).Numeric ↔ x.Numeric ∧ y.Numeric := by +private lemma Args.numeric_P1 {x y} : (Args.P1 x y).Numeric ↔ x.Numeric ∧ y.Numeric := by simp [Args.Numeric, Args.toMultiset] -lemma Args.numeric_P24 {x₁ x₂ y} : +private lemma Args.numeric_P24 {x₁ x₂ y} : (Args.P24 x₁ x₂ y).Numeric ↔ x₁.Numeric ∧ x₂.Numeric ∧ y.Numeric := by simp [Args.Numeric, Args.toMultiset] @@ -158,16 +161,17 @@ another: `ArgsRel a₁ a₂` is true if `a₁`, considered as a multiset, can be repeatedly removing a game from `a₂` and adding back one or two options of the game. See also `WellFounded.CutExpand`. -/ -def ArgsRel := InvImage (TransGen <| CutExpand fun x y => ∃ p, x ∈ y.moves p) Args.toMultiset +private def ArgsRel := + InvImage (TransGen <| CutExpand fun x y => ∃ p, x ∈ y.moves p) Args.toMultiset /-- `ArgsRel` is well-founded. -/ -lemma argsRel_wf : WellFounded ArgsRel := +private lemma argsRel_wf : WellFounded ArgsRel := InvImage.wf _ (Subrelation.wf (fun h => h.elim fun _ => Subposition.of_mem_moves) subposition_wf).cutExpand.transGen instance : WellFounded ArgsRel := argsRel_wf /-- The property that all arguments are numeric is leftward-closed under `ArgsRel`. -/ -lemma ArgsRel.numeric_closed {a' a} : ArgsRel a' a → a.Numeric → a'.Numeric := +private lemma ArgsRel.numeric_closed {a' a} : ArgsRel a' a → a.Numeric → a'.Numeric := TransGen.closed' <| @cutExpand_closed _ _ ⟨fun _ h => (h.elim fun _ => Subposition.of_mem_moves).irrefl⟩ _ fun h h' ↦ h'.subposition (h.elim fun _ => Subposition.of_mem_moves) @@ -176,80 +180,83 @@ lemma ArgsRel.numeric_closed {a' a} : ArgsRel a' a → a.Numeric → a'.Numeric relation `ArgsRel`. The inductive hypothesis in the proof will be `∀ a', ArgsRel a' a → P124 a`. -/ -def P124 : Args → Prop +private def P124 : Args → Prop | (Args.P1 x y) => Numeric (x * y) | (Args.P24 x₁ x₂ y) => P24 x₁ x₂ y /-! ### P1 follows from the inductive hypothesis -/ -lemma numeric_move_mul_of_IH {p : Player} (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) +private lemma numeric_move_mul_of_IH {p : Player} (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) (h : x' ∈ x.moves p) : (x' * y).Numeric := IH (Args.P1 x' y) (TransGen.single <| cutExpand_pair_left ⟨p, h⟩) -lemma numeric_mul_move_of_IH {p : Player} (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) +private lemma numeric_mul_move_of_IH {p : Player} (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) (h : y' ∈ y.moves p) : (x * y').Numeric := IH (Args.P1 x y') (TransGen.single <| cutExpand_pair_right ⟨p, h⟩) -lemma numeric_move_mul_move_of_IH {p q : Player} (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) +private lemma numeric_move_mul_move_of_IH {p q : Player} + (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) (hx : x' ∈ x.moves p) (hy : y' ∈ y.moves q) : (x' * y').Numeric := IH (Args.P1 x' y') ((TransGen.single (cutExpand_pair_right ⟨q, hy⟩)).tail (cutExpand_pair_left ⟨p, hx⟩)) /-- A specialization of the inductive hypothesis used to prove `P1`. -/ -def IH1 (x y : IGame) : Prop := +private def IH1 (x y : IGame) : Prop := ∀ ⦃p q x₁ x₂ y'⦄, x₁ ∈ x.moves p → x₂ ∈ x.moves q → (y' = y ∨ ∃ u, y' ∈ y.moves u) → P24 x₁ x₂ y' /-- `IH1 x y` follows from the inductive hypothesis for `P1 x y`. -/ -lemma IH1_of_IH (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) : IH1 x y := by +private lemma IH1_of_IH (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) : IH1 x y := by rintro p q x₁ x₂ y' h₁ h₂ (rfl | hy) <;> apply IH (.P24 ..) on_goal 2 => refine .tail ?_ (cutExpand_pair_right hy) all_goals exact .single (cutExpand_double_left ⟨p, h₁⟩ ⟨q, h₂⟩) /-- `IH1 y x` follows from the inductive hypothesis for `P1 x y`. -/ -lemma IH1_swap_of_IH (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) : IH1 y x := IH1_of_IH <| by +private lemma IH1_swap_of_IH (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) : IH1 y x := + IH1_of_IH <| by simpa [-Multiset.insert_eq_cons, ArgsRel, InvImage, Multiset.pair_comm] using IH -lemma IH1_neg_left : IH1 x y → IH1 (-x) y := by +private lemma IH1_neg_left : IH1 x y → IH1 (-x) y := by intro h p q x₁ x₂ y' h₁ h₂ hy rw [moves_neg] at h₁ h₂ exact P24_neg_left.1 (h h₂ h₁ hy) -lemma IH1_neg_right : IH1 x y → IH1 x (-y) := by +private lemma IH1_neg_right : IH1 x y → IH1 x (-y) := by intro h p q x₁ x₂ y' h₁ h₂ hy rw [← P24_neg_right] apply h h₁ h₂ simpa [neg_eq_iff_eq_neg, or_comm] using hy -lemma P1_of_equiv (he : x₁ ≈ x₃) (h₁ : P2 x₁ x₃ y₁) (h₃ : P2 x₁ x₃ y₃) (h3 : P3 x₁ x₂ y₂ y₃) : +private lemma P1_of_equiv (he : x₁ ≈ x₃) (h₁ : P2 x₁ x₃ y₁) (h₃ : P2 x₁ x₃ y₃) + (h3 : P3 x₁ x₂ y₂ y₃) : P1 x₂ y₁ x₁ y₂ x₃ y₃ := by rw [P1, mk_mulOption, mk_mulOption, ← h₁ he, ← h₃ he, sub_lt_sub_iff] convert add_lt_add_left h3 (.mk (x₁ * y₁)) using 1 <;> abel -lemma P1_of_P3 (h₁ : P3 x₃ x₂ y₂ y₃) (h₂ : P3 x₁ x₃ y₂ y₁) : P1 x₂ y₁ x₁ y₂ x₃ y₃ := by +private lemma P1_of_P3 (h₁ : P3 x₃ x₂ y₂ y₃) (h₂ : P3 x₁ x₃ y₂ y₁) : P1 x₂ y₁ x₁ y₂ x₃ y₃ := by rw [P1, mk_mulOption, mk_mulOption, sub_lt_sub_iff, ← add_lt_add_iff_left (.mk (x₃ * y₂))] convert add_lt_add h₁ h₂ using 1 <;> abel -lemma P3_of_IH1 [Numeric y] (ihyx : IH1 y x) +private lemma P3_of_IH1 [Numeric y] (ihyx : IH1 y x) (ha : a ∈ xᴸ) (hb : b ∈ yᴸ) (hd : d ∈ (-y)ᴸ) : P3 a x b (-d) := by rw [P3_comm] rw [moves_neg] at hd refine ((ihyx hb hd (.inl rfl)).2 ?_).1 a ha exact Numeric.left_lt_right hb hd -lemma P24_of_IH1 (ihxy : IH1 x y) (ha : a ∈ xᴸ) (hb : b ∈ xᴸ) : P24 a b y := +private lemma P24_of_IH1 (ihxy : IH1 x y) (ha : a ∈ xᴸ) (hb : b ∈ xᴸ) : P24 a b y := ihxy ha hb (Or.inl rfl) -lemma mulOption_lt_iff_P1 : +private lemma mulOption_lt_iff_P1 : Game.mk (mulOption x y a b) < -Game.mk (mulOption x (-y) c d) ↔ P1 x y a b c (-d) := by simp [P1, mulOption, sub_eq_add_neg, add_comm] -lemma mulOption_lt_of_lt [Numeric y] (ihxy : IH1 x y) (ihyx : IH1 y x) {a b c d} (h : a < c) +private lemma mulOption_lt_of_lt [Numeric y] (ihxy : IH1 x y) (ihyx : IH1 y x) {a b c d} (h : a < c) (ha : a ∈ xᴸ) (hb : b ∈ yᴸ) (hc : c ∈ xᴸ) (hd : d ∈ (-y)ᴸ) : Game.mk (mulOption x y a b) < -Game.mk (mulOption x (-y) c d) := by rw [mulOption_lt_iff_P1] exact P1_of_P3 (P3_of_IH1 ihyx hc hb hd) <| ((P24_of_IH1 ihxy ha hc).2 h).1 b hb -lemma mulOption_lt [Numeric x] [Numeric y] (ihxy : IH1 x y) (ihyx : IH1 y x) {a b c d} +private lemma mulOption_lt [Numeric x] [Numeric y] (ihxy : IH1 x y) (ihyx : IH1 y x) {a b c d} (ha : a ∈ xᴸ) (hb : b ∈ yᴸ) (hc : c ∈ xᴸ) (hd : d ∈ (-y)ᴸ) : Game.mk (mulOption x y a b) < -Game.mk (mulOption x (-y) c d) := by numeric @@ -261,7 +268,7 @@ lemma mulOption_lt [Numeric x] [Numeric y] (ihxy : IH1 x y) (ihyx : IH1 y x) {a simpa [lt_neg] using mulOption_lt_of_lt (IH1_neg_right ihxy) (IH1_neg_left ihyx) h hc hd ha hb /-- `P1` follows from the induction hypothesis. -/ -lemma P1_of_IH (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) [Numeric x] [Numeric y] : +private lemma P1_of_IH (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) [Numeric x] [Numeric y] : (x * y).Numeric := by have ihxy := IH1_of_IH IH have ihyx := IH1_swap_of_IH IH @@ -288,25 +295,25 @@ lemma P1_of_IH (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) [Numeric x] [Num /-! ### P2 follows from the inductive hypothesis -/ -lemma numeric_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : +private lemma numeric_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : (x₁ * y).Numeric ∧ (x₂ * y).Numeric := by constructor <;> refine IH (.P1 ..) (.single ?_) · exact (cutExpand_add_right {y}).2 <| (cutExpand_add_left {x₁}).2 cutExpand_zero · exact (cutExpand_add_right {x₂, y}).2 cutExpand_zero /-- A specialization of the inductive hypothesis used to prove `P2` and `P4`. -/ -def IH24 (x₁ x₂ y : IGame) : Prop := +private def IH24 (x₁ x₂ y : IGame) : Prop := ∀ ⦃p z⦄, (z ∈ x₁.moves p → P24 z x₂ y) ∧ (z ∈ x₂.moves p → P24 x₁ z y) ∧ (z ∈ y.moves p → P24 x₁ x₂ z) /-- A specialization of the induction hypothesis used to prove `P4`. -/ -def IH4 (x₁ x₂ y : IGame) : Prop := +private def IH4 (x₁ x₂ y : IGame) : Prop := ∀ ⦃p q z w⦄, w ∈ y.moves p → (z ∈ x₁.moves q → P2 z x₂ w) ∧ (z ∈ x₂.moves q → P2 x₁ z w) /-- `IH24 x₁ x₂ y` follows from the inductive hypothesis for `P24 x₁ x₂ y`. -/ -lemma IH24_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : IH24 x₁ x₂ y := by +private lemma IH24_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : IH24 x₁ x₂ y := by rw [IH24] refine fun p z ↦ ⟨?_, ?_, ?_⟩ <;> refine fun h ↦ IH (.P24 ..) (.single ?_) · exact (cutExpand_add_right {y}).2 (cutExpand_pair_left ⟨p, h⟩) @@ -314,21 +321,21 @@ lemma IH24_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : IH2 · exact (cutExpand_add_left {x₁}).2 (cutExpand_pair_right ⟨p, h⟩) /-- `IH24 x₂ x₁ y` follows from the inductive hypothesis for `P24 x₁ x₂ y`. -/ -lemma IH24_swap_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : IH24 x₂ x₁ y := by +private lemma IH24_swap_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : IH24 x₂ x₁ y := by apply IH24_of_IH convert IH using 2 dsimp [ArgsRel, InvImage, Multiset.insert_eq_cons, ← Multiset.singleton_add] abel_nf /-- `IH4 x₁ x₂ y` follows from the inductive hypothesis for `P24 x₁ x₂ y`. -/ -lemma IH4_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : IH4 x₁ x₂ y := by +private lemma IH4_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : IH4 x₁ x₂ y := by refine fun p q a b h ↦ ⟨?_, ?_⟩ <;> refine fun h' ↦ (IH (.P24 ..) <| (TransGen.single ?_).tail <| (cutExpand_add_left {x₁}).2 <| cutExpand_pair_right ⟨p, h⟩).1 · exact (cutExpand_add_right {b}).2 <| cutExpand_pair_left ⟨q, h'⟩ · exact (cutExpand_add_right {b}).2 <| cutExpand_pair_right ⟨q, h'⟩ -lemma IH24_neg : IH24 x₁ x₂ y → IH24 (-x₂) (-x₁) y ∧ IH24 x₁ x₂ (-y) := by +private lemma IH24_neg : IH24 x₁ x₂ y → IH24 (-x₂) (-x₁) y ∧ IH24 x₁ x₂ (-y) := by simp_rw [IH24, P24_neg_right, moves_neg] refine fun h ↦ ⟨fun p z ↦ ⟨?_, ?_, ?_⟩, fun p z ↦ ⟨(@h p z).1, (@h p z).2.1, P24_neg_right.1 ∘ (@h (-p) (-z)).2.2⟩⟩ @@ -339,13 +346,13 @@ lemma IH24_neg : IH24 x₁ x₂ y → IH24 (-x₂) (-x₁) y ∧ IH24 x₁ x₂ · exact (@h (-p) (-z)).1 · exact (@h p z).2.2 -lemma IH4_neg : IH4 x₁ x₂ y → IH4 (-x₂) (-x₁) y ∧ IH4 x₁ x₂ (-y) := by +private lemma IH4_neg : IH4 x₁ x₂ y → IH4 (-x₂) (-x₁) y ∧ IH4 x₁ x₂ (-y) := by simp_rw [IH4, moves_neg, Set.mem_neg] refine fun h ↦ ⟨fun p q z w h' ↦ ?_, fun p q z w h' ↦ ?_⟩ · convert (h h').symm using 2 <;> rw [← P2_neg_left, neg_neg] · convert h h' using 2 <;> rw [P2_neg_right] -lemma mulOption_lt_mul_of_equiv [Numeric x₁] (h : IH24 x₁ x₂ y) (he : x₁ ≈ x₂) +private lemma mulOption_lt_mul_of_equiv [Numeric x₁] (h : IH24 x₁ x₂ y) (he : x₁ ≈ x₂) (hi : a ∈ x₁ᴸ) (hj : b ∈ yᴸ) : Game.mk (mulOption x₁ y a b) < Game.mk (x₂ * y) := by convert sub_lt_iff_lt_add'.2 (((h.1 hi).2 _).1 b hj) using 1 @@ -354,7 +361,7 @@ lemma mulOption_lt_mul_of_equiv [Numeric x₁] (h : IH24 x₁ x₂ y) (he : x₁ · grw [← he] exact Numeric.left_lt hi -lemma mul_right_le_of_equiv [Numeric x₁] [Numeric x₂] +private lemma mul_right_le_of_equiv [Numeric x₁] [Numeric x₂] (ih₁₂ : IH24 x₁ x₂ y) (ih₂₁ : IH24 x₂ x₁ y) (he : x₁ ≈ x₂) : x₁ * y ≤ x₂ * y := by have he' := neg_equiv_neg_iff.2 he rw [IGame.le_iff_forall_lf] @@ -370,29 +377,29 @@ lemma mul_right_le_of_equiv [Numeric x₁] [Numeric x₂] · simpa [neg_le] using (mulOption_lt_mul_of_equiv (IH24_neg ih₁₂).1 he'.symm ha hb).not_ge /-- `P2` follows from the induction hypothesis. -/ -lemma P2_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) [Numeric x₁] [Numeric x₂] +private lemma P2_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) [Numeric x₁] [Numeric x₂] (he : x₁ ≈ x₂) : x₁ * y ≈ x₂ * y := ⟨mul_right_le_of_equiv (IH24_of_IH IH) (IH24_swap_of_IH IH) he, mul_right_le_of_equiv (IH24_swap_of_IH IH) (IH24_of_IH IH) he.symm⟩ /-! ### P4 follows from the inductive hypothesis -/ -lemma mulOption_lt_mul_iff_P3 : mulOption x y a b < x * y ↔ P3 a x b y := +private lemma mulOption_lt_mul_iff_P3 : mulOption x y a b < x * y ↔ P3 a x b y := @sub_lt_iff_lt_add' Game _ _ _ (.mk _) (.mk _) (.mk _) /-- A specialization of the induction hypothesis used to prove `P3`. -/ -def IH3 (x₁ x' x₂ y₁ y₂ : IGame) : Prop := +private def IH3 (x₁ x' x₂ y₁ y₂ : IGame) : Prop := P2 x₁ x' y₁ ∧ P2 x₁ x' y₂ ∧ P3 x' x₂ y₁ y₂ ∧ (x₁ < x' → P3 x₁ x' y₁ y₂) /-- `IH3` follows from the induction hypothesis for `P24 x₁ x₂ y`. -/ -lemma IH3_of_IH (ih24 : IH24 x₁ x₂ y) (ih4 : IH4 x₁ x₂ y) +private lemma IH3_of_IH (ih24 : IH24 x₁ x₂ y) (ih4 : IH4 x₁ x₂ y) (hi : a ∈ x₂ᴸ) (hb : b ∈ yᴸ) (hl : mulOption x₂ y a b < x₂ * y) : IH3 x₁ a x₂ b y := have h24 := ih24.2.1 hi ⟨(ih4 hb).2 hi, h24.1, mulOption_lt_mul_iff_P3.1 hl, fun l ↦ (h24.2 l).1 b hb⟩ -lemma P3_of_le_left {y₁ y₂} (i) (h : IH3 x₁ i x₂ y₁ y₂) (hl : x₁ ≤ i) : P3 x₁ x₂ y₁ y₂ := by +private lemma P3_of_le_left {y₁ y₂} (i) (h : IH3 x₁ i x₂ y₁ y₂) (hl : x₁ ≤ i) : P3 x₁ x₂ y₁ y₂ := by obtain (hl | he) := le_iff_lt_or_antisymmRel.1 hl · exact (h.2.2.2 hl).trans h.2.2.1 · rw [P3, h.1 he, h.2.1 he] @@ -400,14 +407,14 @@ lemma P3_of_le_left {y₁ y₂} (i) (h : IH3 x₁ i x₂ y₁ y₂) (hl : x₁ /-- P3 follows from `IH3`, so P4 (with `y₁` a left option of `y₂`) follows from the induction hypothesis. -/ -lemma P3_of_IH3 {y₁ y₂} (h : ∀ i ∈ x₂ᴸ, IH3 x₁ i x₂ y₁ y₂) +private lemma P3_of_IH3 {y₁ y₂} (h : ∀ i ∈ x₂ᴸ, IH3 x₁ i x₂ y₁ y₂) (hs : ∀ i ∈ (-x₁)ᴸ, IH3 (-x₂) i (-x₁) y₁ y₂) (hl : x₁ < x₂) : P3 x₁ x₂ y₁ y₂ := by obtain (⟨i, hi, hi'⟩ | ⟨i, hi, hi'⟩) := lf_iff_exists_le.1 hl.not_ge · exact P3_of_le_left i (h i hi) hi' · refine P3_neg.1 <| P3_of_le_left _ (hs (-i) ?_) ?_ <;> simpa /-- `P4` follows from the induction hypothesis. -/ -lemma P4_of_IH (IH : ∀ a, ArgsRel a (.P24 x₁ x₂ y) → P124 a) : P4 x₁ x₂ y := by +private lemma P4_of_IH (IH : ∀ a, ArgsRel a (.P24 x₁ x₂ y) → P124 a) : P4 x₁ x₂ y := by have h₁₂ := IH24_of_IH IH have h4 := IH4_of_IH IH obtain ⟨h₁₂x, h₁₂y⟩ := IH24_neg h₁₂ @@ -427,7 +434,7 @@ lemma P4_of_IH (IH : ∀ a, ArgsRel a (.P24 x₁ x₂ y) → P124 a) : P4 x₁ x exact Numeric.left_lt (mulOption_mem_moves_mul hb ha) /-- We tie everything together to complete the induction. -/ -theorem main (a : Args) : a.Numeric → P124 a := by +private theorem main (a : Args) : a.Numeric → P124 a := by apply argsRel_wf.induction a intro a IH ha replace ih : ∀ a', ArgsRel a' a → P124 a' := fun a' hr ↦ IH a' hr (hr.numeric_closed ha) @@ -441,12 +448,12 @@ theorem main (a : Args) : a.Numeric → P124 a := by · exact (Game.mk_eq <| P2_of_IH ih ·) · exact P4_of_IH ih -lemma main_P24 (x₁ x₂ y : IGame) [hx₁ : Numeric x₁] [hx₂ : Numeric x₂] [hy : Numeric y] : +private lemma main_P24 (x₁ x₂ y : IGame) [hx₁ : Numeric x₁] [hx₂ : Numeric x₂] [hy : Numeric y] : P24 x₁ x₂ y := main _ <| Args.numeric_P24.mpr ⟨hx₁, hx₂, hy⟩ /-- One additional inductive argument proves `P3`. -/ -lemma P3_of_lt_of_lt {x₁ x₂ y₁ y₂} [Numeric x₁] [Numeric x₂] [Numeric y₁] [Numeric y₂] +private lemma P3_of_lt_of_lt {x₁ x₂ y₁ y₂} [Numeric x₁] [Numeric x₂] [Numeric y₁] [Numeric y₂] (hx : x₁ < x₂) (hy : y₁ < y₂) : P3 x₁ x₂ y₁ y₂ := by refine P3_of_IH3 ?_ ?_ hx all_goals diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean index 4e94a05261..5cf94918ae 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum/GermSuccessorStep.lean @@ -167,8 +167,311 @@ private theorem not_forall_aeval_cofactors_mem_decomposable exact one_ne_zero hfb +open Classical in +omit [GradedAlgebra A] in +/-- Syzygies of a minimal homogeneous generating set have decomposable entries. -/ +private theorem syzygy_entries_mem_decomposable + (hgz : GradeZeroScalars A) {δ : NatOrdinal.{z}} (hδ : 0 < δ.constantCoeff) + (hinj : ∀ β < δ, InjectiveAt K wt x β) (B : Finset ι) + (c : ι → MvPolynomial ι K) (lam : ι → NatOrdinal.{z}) + (hlam : ∀ b : ↥B, lam b + wt b = δ) + (hlamc : ∀ b : ↥B, (lam b).constantCoeff = 0) + (hlamlt : ∀ b : ↥B, lam b < δ) + (hchom : ∀ b : ↥B, IsWeightedHomogeneous wt (c b) (lam b)) + (hBmin' : ∀ b ∈ B, c b ∉ Ideal.span (c '' ((B.erase b : Finset ι) : Set ι))) + (TP : Finset (↥B → R)) (eT : (↥B → R) → NatOrdinal.{z}) + (hTPhom : ∀ w ∈ TP, IsHomogeneousTuple A (fun b : ↥B ↦ lam b) w (eT w)) + (hTPlim : ∀ w ∈ TP, ∀ (b : ↥B) β, w b ∈ A β → w b ≠ 0 → β.constantCoeff = 0) + (hTPsyz : ∀ w ∈ TP, ∑ b : ↥B, aeval x (c b) * w b = 0) + (u : ↥B → R) (a₂ : (↥B → R) → R) + (ha₂ : ∀ w ∈ TP, (∀ ρ, ρ + eT w = δ → a₂ w ∈ A ρ) ∧ + ((¬ ∃ ρ, ρ + eT w = δ) → a₂ w = 0)) + (hu_eq : u = ∑ w ∈ TP, a₂ w • w) : + ∀ b : ↥B, u b ∈ decomposableAt A (wt b) := by + classical + intro b + have hub := congrFun hu_eq b + rw [Finset.sum_apply] at hub + simp only [Pi.smul_apply, smul_eq_mul] at hub + rw [hub] + refine sum_mem fun w hw ↦ ?_ + by_cases hwb : w b = 0 + · rw [hwb, mul_zero] + exact zero_mem _ + by_cases ha0 : a₂ w = 0 + · rw [ha0, zero_mul] + exact zero_mem _ + have hhom := (isHomogeneousTuple_iff.mp (hTPhom w hw)) b + obtain ⟨β, hβ⟩ : ∃ β, β + lam b = eT w := by + by_contra hn + exact hwb (hhom.2 hn) + have hwβ : w b ∈ A β := hhom.1 β hβ + obtain ⟨ρ, hρ⟩ : ∃ ρ, ρ + eT w = δ := by + by_contra hn + exact ha0 ((ha₂ w hw).2 hn) + have haρ : a₂ w ∈ A ρ := (ha₂ w hw).1 ρ hρ + have hρβ : ρ + β = wt b := by + apply add_right_cancel (b := lam b) + rw [add_assoc, hβ, hρ, add_comm] + exact (hlam b).symm + -- `ρ ≠ 0`: its finite part is that of `δ`, `n ≥ 1` + have hβc : β.constantCoeff = 0 := hTPlim w hw b β hwβ hwb + have hρ0 : ρ ≠ 0 := by + intro h0 + have h1 := congrArg NatOrdinal.constantCoeff hρ + rw [NatOrdinal.constantCoeff_add, ← hβ, NatOrdinal.constantCoeff_add, hβc, + hlamc b, h0, NatOrdinal.constantCoeff_zero] at h1 + omega + -- `β ≠ 0`: a scalar entry would put `c_b` in the ideal of the other `c_{b'}` + have hβ0 : β ≠ 0 := by + intro h0 + rw [h0, zero_add] at hβ + rw [h0] at hwβ + obtain ⟨κ, hκ⟩ := (gradeZeroScalars_iff A).mp hgz (w b) hwβ + have hκ0 : κ ≠ 0 := by + rintro rfl + exact hwb (by rw [hκ, map_zero]) + have hP : ∀ b' : ↥B, ∃ P : MvPolynomial ι K, + (∀ β', β' + lam b' = lam b → IsWeightedHomogeneous wt P β') ∧ + ((¬ ∃ β', β' + lam b' = lam b) → P = 0) ∧ aeval x P = w b' := by + intro b' + have hhom' := (isHomogeneousTuple_iff.mp (hTPhom w hw)) b' + rw [← hβ] at hhom' + by_cases h : ∃ β', β' + lam b' = lam b + · obtain ⟨β', hβ'⟩ := h + obtain ⟨P, hPhom, hPw⟩ := hx.exists_aeval_eq hgz β' + (w b') (hhom'.1 β' hβ') + refine ⟨P, fun β'' hβ'' ↦ ?_, fun hn ↦ absurd ⟨β', hβ'⟩ hn, hPw⟩ + rwa [add_right_cancel (hβ''.trans hβ'.symm)] + · exact ⟨0, fun β' hβ' ↦ absurd ⟨β', hβ'⟩ h, fun _ ↦ rfl, by rw [map_zero, hhom'.2 h]⟩ + choose P hPhom hP0 hPw using hP + -- the relation `κ c_b + ∑_{b' ≠ b} c_{b'} P_{b'}` of degree `lam b < δ` + have hG'hom : IsWeightedHomogeneous wt + (C κ * c b + ∑ b' ∈ Finset.univ.erase b, c b' * P b') (lam b) := by + refine ((hchom b).C_mul κ).add (IsWeightedHomogeneous.sum _ _ _ fun b' _ ↦ ?_) + by_cases h : ∃ β', β' + lam b' = lam b + · obtain ⟨β', hβ'⟩ := h + have := (hchom b').mul (hPhom b' β' hβ') + rwa [add_comm, hβ'] at this + · rw [hP0 b' h, mul_zero] + exact isWeightedHomogeneous_zero K wt _ + have hG'0 : aeval x (C κ * c b + ∑ b' ∈ Finset.univ.erase b, c b' * P b') = 0 := by + have hsyzw := hTPsyz w hw + rw [← Finset.add_sum_erase _ _ (Finset.mem_univ b), hκ] at hsyzw + rw [map_add, map_mul, map_sum, ← algebraMap_eq, AlgHom.commutes, Algebra.commutes, + Finset.sum_congr rfl fun b' _ ↦ by rw [map_mul, hPw]] + exact hsyzw + have hG'z := (injectiveAt_iff _).mp (hinj (lam b) (hlamlt b)) _ hG'hom hG'0 + have h2 : C κ * c b = -∑ b' ∈ Finset.univ.erase b, c b' * P b' := + eq_neg_of_add_eq_zero_left hG'z + have h3 : c b = C κ⁻¹ * (C κ * c b) := by + rw [← mul_assoc, ← C_mul, inv_mul_cancel₀ hκ0, C_1, one_mul] + refine hBmin' b b.2 ?_ + rw [h3, h2] + refine Ideal.mul_mem_left _ _ ((Ideal.neg_mem_iff _).mpr (Ideal.sum_mem _ fun b' hb' ↦ ?_)) + refine Ideal.mul_mem_right _ _ (Ideal.subset_span ⟨b', ?_, rfl⟩) + exact Finset.mem_coe.mpr (Finset.mem_erase.mpr + ⟨fun h ↦ (Finset.mem_erase.mp hb').1 (Subtype.ext h), b'.2⟩) + rw [← hρβ] + exact mul_mem_decomposableAt (A) hρ0 hβ0 haρ hwβ + +omit [GradedAlgebra A] in +/-- Injective graded evaluation lifts homogeneous syzygies into the span of evaluated generators. -/ +private theorem evaluated_syzygy_mem_span_of_injective + (hgz : GradeZeroScalars A) {B : Type w} [Fintype B] + (lam : B → NatOrdinal.{z}) (c : B → MvPolynomial ι K) + (hchom : ∀ b, IsWeightedHomogeneous wt (c b) (lam b)) + (L : Finset (B → MvPolynomial ι K)) + (hLspan : ∀ U, (∑ b, c b * U b) = 0 → + U ∈ Submodule.span (MvPolynomial ι K) (L : Set (B → MvPolynomial ι K))) + (TP : Finset (B → R)) (ev : (B → MvPolynomial ι K) → (B → R)) + (hev : ∀ σ b, ev σ b = aeval x (σ b)) + (hev_mem : ∀ σ ∈ L, ev σ ∈ Submodule.span R (TP : Set (B → R))) + (d : NatOrdinal.{z}) (hinj : InjectiveAt K wt x d) (u' : B → R) + (hu' : IsHomogeneousTuple A lam u' d) (hsyz' : ∑ b, aeval x (c b) * u' b = 0) : + u' ∈ Submodule.span R (TP : Set (B → R)) := by + classical + -- polynomial representatives of the entries + have hU : ∀ b : B, ∃ U : MvPolynomial ι K, + (∀ β, β + lam b = d → IsWeightedHomogeneous wt U β) ∧ + ((¬ ∃ β, β + lam b = d) → U = 0) ∧ aeval x U = u' b := by + intro b + have hhom := (isHomogeneousTuple_iff.mp hu') b + by_cases h : ∃ β, β + lam b = d + · obtain ⟨β, hβ⟩ := h + obtain ⟨U, hUhom, hUu⟩ := hx.exists_aeval_eq hgz β + (u' b) (hhom.1 β hβ) + refine ⟨U, fun β' hβ' ↦ ?_, fun hn ↦ absurd ⟨β, hβ⟩ hn, hUu⟩ + rwa [add_right_cancel (hβ'.trans hβ.symm)] + · exact ⟨0, fun β hβ ↦ absurd ⟨β, hβ⟩ h, fun _ ↦ rfl, by rw [map_zero, hhom.2 h]⟩ + choose U hUhom hU0 hUu using hU + -- `∑ c_b U_b` is a relation of degree `d < δ`, hence zero + have hG : IsWeightedHomogeneous wt (∑ b : B, c b * U b) d := by + refine IsWeightedHomogeneous.sum _ _ _ fun b _ ↦ ?_ + by_cases h : ∃ β, β + lam b = d + · obtain ⟨β, hβ⟩ := h + have := (hchom b).mul (hUhom b β hβ) + rwa [add_comm, hβ] at this + · rw [hU0 b h, mul_zero] + exact isWeightedHomogeneous_zero K wt d + have hG0 : aeval x (∑ b : B, c b * U b) = 0 := by + rw [map_sum, ← hsyz'] + exact Finset.sum_congr rfl fun b _ ↦ by rw [map_mul, hUu] + have hGz := (injectiveAt_iff _).mp hinj _ hG hG0 + -- so `U` is a polynomial syzygy, a combination of the generators + obtain ⟨r, _, hr⟩ := Submodule.mem_span_finset.mp (hLspan U hGz) + have hu'eq : u' = ∑ σ ∈ L, aeval x (r σ) • ev σ := by + funext b + rw [Finset.sum_apply] + have hrb := congrFun hr b + rw [Finset.sum_apply] at hrb + simp only [Pi.smul_apply, smul_eq_mul] at hrb ⊢ + rw [← hUu b, ← hrb, map_sum] + exact Finset.sum_congr rfl fun σ _ ↦ by rw [map_mul, hev] + rw [hu'eq] + refine Submodule.sum_mem _ fun σ hσ ↦ Submodule.smul_mem _ _ ?_ + exact hev_mem σ hσ + include hΔ +/-- Polynomial syzygies supported in limit degrees admit finitely many homogeneous generators. -/ +private theorem exists_homogeneous_evaluated_syzygies + {B : Type w} [Fintype B] (lam : B → NatOrdinal.{z}) (c : B → MvPolynomial ι K) + (hchom : ∀ b, IsWeightedHomogeneous wt (c b) (lam b)) + (Λ : Set ι) (hΛ : ∀ i ∈ Λ, (wt i).constantCoeff = 0) + (L : Finset (B → MvPolynomial ι K)) + (hL : ∀ σ ∈ L, (∀ b, σ b ∈ supported K Λ) ∧ ∑ b, c b * σ b = 0) + (ev : (B → MvPolynomial ι K) → (B → R)) (hev : ∀ σ b, ev σ b = aeval x (σ b)) : + ∃ (TP : Finset (B → R)) (eT : (B → R) → NatOrdinal.{z}), + (∀ w ∈ TP, IsHomogeneousTuple A lam w (eT w)) ∧ + (∀ w ∈ TP, ∀ b β, w b ∈ A β → w b ≠ 0 → β.constantCoeff = 0) ∧ + (∀ w ∈ TP, ∀ b, Δ (w b) = 0) ∧ + (∀ w ∈ TP, ∑ b, aeval x (c b) * w b = 0) ∧ + ∀ σ ∈ L, ev σ ∈ Submodule.span R (TP : Set (B → R)) := by + classical + obtain ⟨comp, hcomp⟩ : ∃ comp : (B → R) → NatOrdinal → (B → R), + ∀ w e b, comp w e b = if h : ∃ β, β + lam b = e then + (decompose (A) (w b) (Classical.choose h) : R) else 0 := + ⟨fun w e b ↦ if h : ∃ β, β + lam b = e then + (decompose (A) (w b) (Classical.choose h) : R) else 0, + fun _ _ _ ↦ rfl⟩ + have hcomp_hom : ∀ w e, IsHomogeneousTuple A lam (comp w e) e := by + intro w e + rw [isHomogeneousTuple_iff] + intro b + refine ⟨fun β hβ ↦ ?_, fun h ↦ ?_⟩ + · have h : ∃ β, β + lam b = e := ⟨β, hβ⟩ + have hch : ∀ h' : ∃ β, β + lam b = e, Classical.choose h' = β := fun h' ↦ + add_right_cancel ((Classical.choose_spec h').trans hβ.symm) + rw [hcomp, dite_eq_left h, hch] + exact (decompose (A) (w b) β).2 + · rw [hcomp, dite_eq_right h] + have hcomp_syz : ∀ σ ∈ L, ∀ e, ∑ b : B, aeval x (c b) * comp (ev σ) e b = 0 := by + intro σ hσ e + have h1 : ∀ b : B, aeval x (c b) * comp (ev σ) e b = + GradedRing.proj (A) e (aeval x (c b) * aeval x (σ b)) := by + intro b + rw [GradedRing.proj_apply, coe_decompose_mul_of_left_mem (𝒜 := A) + (aeval_mem_of_forall_mem hx.mem (hchom b)) (aeval x (σ b)) e, hcomp, hev] + by_cases h : ∃ β, β + lam b = e + · rw [dite_eq_left h, dite_eq_left h] + · rw [dite_eq_right h, dite_eq_right h, mul_zero] + have h2 : ∑ b : B, aeval x (c b) * aeval x (σ b) = 0 := by + have := congrArg (aeval x) (hL σ hσ).2 + rw [map_sum, map_zero] at this + simpa only [map_mul] using this + rw [Finset.sum_congr rfl fun b _ ↦ h1 b, ← map_sum, h2, map_zero] + have hcomp_lim : ∀ σ ∈ L, ∀ e (b : B) β, comp (ev σ) e b ∈ A β → + comp (ev σ) e b ≠ 0 → β.constantCoeff = 0 := by + intro σ hσ e b β hmem hne + by_contra hβ + apply hne + by_cases h : ∃ β', β' + lam b = e + · rw [hcomp, hev, dite_eq_left h] at hmem hne ⊢ + -- a nonzero element of `P_β` and of `P_{β'}` forces `β = β'` + have hβ' : β = Classical.choose h := by + by_contra hne' + have h0 := decompose_of_mem_ne (A) hmem hne' + rw [decompose_of_mem_same (A) + (decompose (A) (aeval x (σ b)) (Classical.choose h)).2] at h0 + exact hne h0 + rw [hβ'] at hβ + rw [decompose_aeval hx.mem, weightedHomogeneousComponent_eq_zero_of_forall_vars + (fun i hi ↦ hΛ i (mem_supported.mp ((hL σ hσ).1 b) hi)) hβ, map_zero] + · rw [hcomp, dite_eq_right h] at hne + exact absurd rfl hne + -- the degrees occurring, and the sum of the components + set E : Finset NatOrdinal := L.biUnion fun σ ↦ Finset.univ.biUnion fun b : B ↦ + (decompose (A) (ev σ b)).support.image (· + lam b) with hEdef + have hev_sum : ∀ σ ∈ L, ev σ = ∑ e ∈ E, comp (ev σ) e := by + intro σ hσ + funext b + rw [Finset.sum_apply] + have himg : (decompose (A) (ev σ b)).support.image (· + lam b) ⊆ E := by + intro e he + rw [hEdef] + exact Finset.mem_biUnion.mpr ⟨σ, hσ, Finset.mem_biUnion.mpr ⟨b, Finset.mem_univ b, he⟩⟩ + rw [← Finset.sum_subset himg, Finset.sum_image fun β₁ _ β₂ _ h ↦ add_right_cancel h] + · conv_lhs => rw [← sum_support_decompose (A) (ev σ b)] + refine Finset.sum_congr rfl fun β _ ↦ ?_ + have h : ∃ β', β' + lam b = β + lam b := ⟨β, rfl⟩ + have hch : ∀ h' : ∃ β', β' + lam b = β + lam b, Classical.choose h' = β := fun h' ↦ + add_right_cancel (Classical.choose_spec h') + rw [hcomp, dite_eq_left h, hch] + · intro e _ he + rw [hcomp] + split_ifs with h + · have hnot : Classical.choose h ∉ (decompose (A) (ev σ b)).support := + fun hmem ↦ he (Finset.mem_image.mpr ⟨_, hmem, Classical.choose_spec h⟩) + rw [DFinsupp.notMem_support_iff.mp hnot] + rfl + · rfl + -- the finite set `𝒯` of homogeneous ∂-annihilated syzygies + set TP : Finset (B → R) := (L ×ˢ E).image fun p ↦ comp (ev p.1) p.2 with hTPdef + set eT : (B → R) → NatOrdinal := fun w ↦ + if h : ∃ e, IsHomogeneousTuple A lam w e then Classical.choose h else 0 + with heTdef + have hTPmem : ∀ w ∈ TP, ∃ σ ∈ L, ∃ e, w = comp (ev σ) e := by + intro w hw + obtain ⟨⟨σ, e⟩, hp, rfl⟩ := Finset.mem_image.mp hw + exact ⟨σ, (Finset.mem_product.mp hp).1, e, rfl⟩ + have hTPhom : ∀ w ∈ TP, IsHomogeneousTuple A lam w (eT w) := by + intro w hw + obtain ⟨σ, _, e, rfl⟩ := hTPmem w hw + have h : ∃ e', IsHomogeneousTuple A lam (comp (ev σ) e) e' := + ⟨e, hcomp_hom _ _⟩ + have heT : eT (comp (ev σ) e) = Classical.choose h := by + simp only [heTdef] + rw [dite_eq_left h] + rw [heT] + exact Classical.choose_spec h + have hTPlim : ∀ w ∈ TP, ∀ (b : B) β, w b ∈ A β → w b ≠ 0 → + β.constantCoeff = 0 := by + intro w hw b β hmem hne + obtain ⟨σ, hσ, e, rfl⟩ := hTPmem w hw + exact hcomp_lim σ hσ e b β hmem hne + have hTPd : ∀ w ∈ TP, ∀ b, Δ (w b) = 0 := by + intro w hw b + by_cases h0 : w b = 0 + · rw [h0, map_zero] + · have hhom := (isHomogeneousTuple_iff.mp (hTPhom w hw)) b + have hex : ∃ β, β + lam b = eT w := by + by_contra hn + exact h0 (hhom.2 hn) + obtain ⟨β, hβ⟩ := hex + exact hΔ.eq_zero + (hTPlim w hw b β (hhom.1 β hβ) h0) (hhom.1 β hβ) + have hTPsyz : ∀ w ∈ TP, ∑ b : B, aeval x (c b) * w b = 0 := by + intro w hw + obtain ⟨σ, hσ, e, rfl⟩ := hTPmem w hw + exact hcomp_syz σ hσ e + refine ⟨TP, eT, hTPhom, hTPlim, hTPd, hTPsyz, ?_⟩ + intro σ hσ + rw [hev_sum σ hσ] + exact Submodule.sum_mem _ fun e he ↦ Submodule.subset_span + (Finset.mem_image.mpr ⟨(σ, e), Finset.mem_product.mpr ⟨hσ, he⟩, rfl⟩) + + open Classical in /-- **The successor step.** Evaluation is injective in a degree of positive finite part when it is injective in every smaller degree. -/ @@ -356,169 +659,17 @@ theorem injectiveAt_of_forall_lt [CharZero K] (hgz : GradeZeroScalars A) -- evaluations of the generators and their homogeneous components obtain ⟨ev, hev⟩ : ∃ ev : (↥B → MvPolynomial ι K) → (↥B → R), ∀ σ b, ev σ b = aeval x (σ b) := ⟨fun σ b ↦ aeval x (σ b), fun _ _ ↦ rfl⟩ - obtain ⟨comp, hcomp⟩ : ∃ comp : (↥B → R) → NatOrdinal → (↥B → R), - ∀ w e b, comp w e b = if h : ∃ β, β + lam b = e then - (decompose (A) (w b) (Classical.choose h) : R) else 0 := - ⟨fun w e b ↦ if h : ∃ β, β + lam b = e then - (decompose (A) (w b) (Classical.choose h) : R) else 0, - fun _ _ _ ↦ rfl⟩ - have hcomp_hom : ∀ w e, IsHomogeneousTuple A (fun b : ↥B ↦ lam b) (comp w e) e := by - intro w e - rw [isHomogeneousTuple_iff] - intro b - refine ⟨fun β hβ ↦ ?_, fun h ↦ ?_⟩ - · have h : ∃ β, β + lam b = e := ⟨β, hβ⟩ - have hch : ∀ h' : ∃ β, β + lam b = e, Classical.choose h' = β := fun h' ↦ - add_right_cancel ((Classical.choose_spec h').trans hβ.symm) - rw [hcomp, dite_eq_left h, hch] - exact (decompose (A) (w b) β).2 - · rw [hcomp, dite_eq_right h] - have hcomp_syz : ∀ σ ∈ L, ∀ e, ∑ b : ↥B, aeval x (c b) * comp (ev σ) e b = 0 := by - intro σ hσ e - have h1 : ∀ b : ↥B, aeval x (c b) * comp (ev σ) e b = - GradedRing.proj (A) e (aeval x (c b) * aeval x (σ b)) := by - intro b - rw [GradedRing.proj_apply, coe_decompose_mul_of_left_mem (𝒜 := A) - (aeval_mem_of_forall_mem hx.mem (hchom b (hBT b.2))) (aeval x (σ b)) e, hcomp, hev] - by_cases h : ∃ β, β + lam b = e - · rw [dite_eq_left h, dite_eq_left h] - · rw [dite_eq_right h, dite_eq_right h, mul_zero] - have h2 : ∑ b : ↥B, aeval x (c b) * aeval x (σ b) = 0 := by - have := congrArg (aeval x) (hL σ hσ).2 - rw [map_sum, map_zero] at this - simpa only [map_mul] using this - rw [Finset.sum_congr rfl fun b _ ↦ h1 b, ← map_sum, h2, map_zero] - have hcomp_lim : ∀ σ ∈ L, ∀ e (b : ↥B) β, comp (ev σ) e b ∈ A β → - comp (ev σ) e b ≠ 0 → β.constantCoeff = 0 := by - intro σ hσ e b β hmem hne - by_contra hβ - apply hne - by_cases h : ∃ β', β' + lam b = e - · rw [hcomp, hev, dite_eq_left h] at hmem hne ⊢ - -- a nonzero element of `P_β` and of `P_{β'}` forces `β = β'` - have hβ' : β = Classical.choose h := by - by_contra hne' - have h0 := decompose_of_mem_ne (A) hmem hne' - rw [decompose_of_mem_same (A) - (decompose (A) (aeval x (σ b)) (Classical.choose h)).2] at h0 - exact hne h0 - rw [hβ'] at hβ - rw [decompose_aeval hx.mem, weightedHomogeneousComponent_eq_zero_of_forall_vars - (fun i hi ↦ hΛ i (mem_supported.mp ((hL σ hσ).1 b) hi)) hβ, map_zero] - · rw [hcomp, dite_eq_right h] at hne - exact absurd rfl hne - -- the degrees occurring, and the sum of the components - set E : Finset NatOrdinal := L.biUnion fun σ ↦ Finset.univ.biUnion fun b : ↥B ↦ - (decompose (A) (ev σ b)).support.image (· + lam b) with hEdef - have hev_sum : ∀ σ ∈ L, ev σ = ∑ e ∈ E, comp (ev σ) e := by - intro σ hσ - funext b - rw [Finset.sum_apply] - have himg : (decompose (A) (ev σ b)).support.image (· + lam b) ⊆ E := by - intro e he - rw [hEdef] - exact Finset.mem_biUnion.mpr ⟨σ, hσ, Finset.mem_biUnion.mpr ⟨b, Finset.mem_univ b, he⟩⟩ - rw [← Finset.sum_subset himg, Finset.sum_image fun β₁ _ β₂ _ h ↦ add_right_cancel h] - · conv_lhs => rw [← sum_support_decompose (A) (ev σ b)] - refine Finset.sum_congr rfl fun β _ ↦ ?_ - have h : ∃ β', β' + lam b = β + lam b := ⟨β, rfl⟩ - have hch : ∀ h' : ∃ β', β' + lam b = β + lam b, Classical.choose h' = β := fun h' ↦ - add_right_cancel (Classical.choose_spec h') - rw [hcomp, dite_eq_left h, hch] - · intro e _ he - rw [hcomp] - split_ifs with h - · have hnot : Classical.choose h ∉ (decompose (A) (ev σ b)).support := - fun hmem ↦ he (Finset.mem_image.mpr ⟨_, hmem, Classical.choose_spec h⟩) - rw [DFinsupp.notMem_support_iff.mp hnot] - rfl - · rfl - -- the finite set `𝒯` of homogeneous ∂-annihilated syzygies - set TP : Finset (↥B → R) := (L ×ˢ E).image fun p ↦ comp (ev p.1) p.2 with hTPdef - set eT : (↥B → R) → NatOrdinal := fun w ↦ - if h : ∃ e, IsHomogeneousTuple A (fun b : ↥B ↦ lam b) w e then Classical.choose h else 0 - with heTdef - have hTPmem : ∀ w ∈ TP, ∃ σ ∈ L, ∃ e, w = comp (ev σ) e := by - intro w hw - obtain ⟨⟨σ, e⟩, hp, rfl⟩ := Finset.mem_image.mp hw - exact ⟨σ, (Finset.mem_product.mp hp).1, e, rfl⟩ - have hTPhom : ∀ w ∈ TP, IsHomogeneousTuple A (fun b : ↥B ↦ lam b) w (eT w) := by - intro w hw - obtain ⟨σ, _, e, rfl⟩ := hTPmem w hw - have h : ∃ e', IsHomogeneousTuple A (fun b : ↥B ↦ lam b) (comp (ev σ) e) e' := - ⟨e, hcomp_hom _ _⟩ - have heT : eT (comp (ev σ) e) = Classical.choose h := by - simp only [heTdef] - rw [dite_eq_left h] - rw [heT] - exact Classical.choose_spec h - have hTPlim : ∀ w ∈ TP, ∀ (b : ↥B) β, w b ∈ A β → w b ≠ 0 → - β.constantCoeff = 0 := by - intro w hw b β hmem hne - obtain ⟨σ, hσ, e, rfl⟩ := hTPmem w hw - exact hcomp_lim σ hσ e b β hmem hne - have hTPd : ∀ w ∈ TP, ∀ b, Δ (w b) = 0 := by - intro w hw b - by_cases h0 : w b = 0 - · rw [h0, map_zero] - · have hhom := (isHomogeneousTuple_iff.mp (hTPhom w hw)) b - have hex : ∃ β, β + lam b = eT w := by - by_contra hn - exact h0 (hhom.2 hn) - obtain ⟨β, hβ⟩ := hex - exact hΔ.eq_zero - (hTPlim w hw b β (hhom.1 β hβ) h0) (hhom.1 β hβ) - have hTPsyz : ∀ w ∈ TP, ∑ b : ↥B, aeval x (c b) * w b = 0 := by - intro w hw - obtain ⟨σ, hσ, e, rfl⟩ := hTPmem w hw - exact hcomp_syz σ hσ e + obtain ⟨TP, eT, hTPhom, hTPlim, hTPd, hTPsyz, hev_mem⟩ := + exists_homogeneous_evaluated_syzygies hx hΔ (fun b : ↥B ↦ lam b) (fun b : ↥B ↦ c b) + (fun b ↦ hchom b (hBT b.2)) Λ hΛ L hL ev hev -- the hypothesis in the degrees below `δ`: evaluation injective below `δ` have hbase : ∀ d < δ, d.constantCoeff = 0 → ∀ u' : ↥B → R, IsHomogeneousTuple A (fun b : ↥B ↦ lam b) u' d → ∑ b : ↥B, aeval x (c b) * u' b = 0 → - u' ∈ Submodule.span (R) (TP : Set (↥B → R)) := by + u' ∈ Submodule.span R (TP : Set (↥B → R)) := by intro d hd _ u' hu' hsyz' - -- polynomial representatives of the entries - have hU : ∀ b : ↥B, ∃ U : MvPolynomial ι K, - (∀ β, β + lam b = d → IsWeightedHomogeneous wt U β) ∧ - ((¬ ∃ β, β + lam b = d) → U = 0) ∧ aeval x U = u' b := by - intro b - have hhom := (isHomogeneousTuple_iff.mp hu') b - by_cases h : ∃ β, β + lam b = d - · obtain ⟨β, hβ⟩ := h - obtain ⟨U, hUhom, hUu⟩ := hx.exists_aeval_eq hgz β - (u' b) (hhom.1 β hβ) - refine ⟨U, fun β' hβ' ↦ ?_, fun hn ↦ absurd ⟨β, hβ⟩ hn, hUu⟩ - rwa [add_right_cancel (hβ'.trans hβ.symm)] - · exact ⟨0, fun β hβ ↦ absurd ⟨β, hβ⟩ h, fun _ ↦ rfl, by rw [map_zero, hhom.2 h]⟩ - choose U hUhom hU0 hUu using hU - -- `∑ c_b U_b` is a relation of degree `d < δ`, hence zero - have hG : IsWeightedHomogeneous wt (∑ b : ↥B, c b * U b) d := by - refine IsWeightedHomogeneous.sum _ _ _ fun b _ ↦ ?_ - by_cases h : ∃ β, β + lam b = d - · obtain ⟨β, hβ⟩ := h - have := (hchom b (hBT b.2)).mul (hUhom b β hβ) - rwa [add_comm, hβ] at this - · rw [hU0 b h, mul_zero] - exact isWeightedHomogeneous_zero K wt d - have hG0 : aeval x (∑ b : ↥B, c b * U b) = 0 := by - rw [map_sum, ← hsyz'] - exact Finset.sum_congr rfl fun b _ ↦ by rw [map_mul, hUu] - have hGz := (injectiveAt_iff _).mp (hinj d hd) _ hG hG0 - -- so `U` is a polynomial syzygy, a combination of the generators - obtain ⟨r, _, hr⟩ := Submodule.mem_span_finset.mp (hLspan U hGz) - have hu'eq : u' = ∑ σ ∈ L, aeval x (r σ) • ev σ := by - funext b - rw [Finset.sum_apply] - have hrb := congrFun hr b - rw [Finset.sum_apply] at hrb - simp only [Pi.smul_apply, smul_eq_mul] at hrb ⊢ - rw [← hUu b, ← hrb, map_sum] - exact Finset.sum_congr rfl fun σ _ ↦ by rw [map_mul, hev] - rw [hu'eq] - refine Submodule.sum_mem _ fun σ hσ ↦ Submodule.smul_mem _ _ ?_ - rw [hev_sum σ hσ] - exact Submodule.sum_mem _ fun e he ↦ Submodule.subset_span - (Finset.mem_image.mpr ⟨(σ, e), Finset.mem_product.mpr ⟨hσ, he⟩, rfl⟩) + exact evaluated_syzygy_mem_span_of_injective hx hgz (fun b : ↥B ↦ lam b) + (fun b : ↥B ↦ c b) (fun b ↦ hchom b (hBT b.2)) L hLspan TP ev hev hev_mem + d (hinj d hd) u' hu' hsyz' -- the induction on syzygies have huN := mem_span_of_isHomogeneousTuple_of_sum_eq_zero (c := fun b : ↥B ↦ aeval x (c b)) (lam := fun b : ↥B ↦ lam b) hΔ (fun b ↦ aeval_mem_of_forall_mem hx.mem (hchom b (hBT b.2))) @@ -526,92 +677,10 @@ theorem injectiveAt_of_forall_lt [CharZero K] (hgz : GradeZeroScalars A) δ le_rfl u hu hsyz obtain ⟨a₂, ha₂, hu_eq⟩ := exists_eq_sum_smul_of_mem_span hTPhom hu huN -- every `u_b` lies in `(P̂_+)² ∩ P_{deg b}` - have hudec : ∀ b : ↥B, u b ∈ decomposableAt (A) (wt b) := by - intro b - have hub := congrFun hu_eq b - rw [Finset.sum_apply] at hub - simp only [Pi.smul_apply, smul_eq_mul] at hub - rw [hub] - refine sum_mem fun w hw ↦ ?_ - by_cases hwb : w b = 0 - · rw [hwb, mul_zero] - exact zero_mem _ - by_cases ha0 : a₂ w = 0 - · rw [ha0, zero_mul] - exact zero_mem _ - have hhom := (isHomogeneousTuple_iff.mp (hTPhom w hw)) b - obtain ⟨β, hβ⟩ : ∃ β, β + lam b = eT w := by - by_contra hn - exact hwb (hhom.2 hn) - have hwβ : w b ∈ A β := hhom.1 β hβ - obtain ⟨ρ, hρ⟩ : ∃ ρ, ρ + eT w = δ := by - by_contra hn - exact ha0 ((ha₂ w hw).2 hn) - have haρ : a₂ w ∈ A ρ := (ha₂ w hw).1 ρ hρ - have hρβ : ρ + β = wt b := by - apply add_right_cancel (b := lam b) - rw [add_assoc, hβ, hρ, add_comm] - exact (hlam b (hBT b.2)).symm - -- `ρ ≠ 0`: its finite part is that of `δ`, `n ≥ 1` - have hβc : β.constantCoeff = 0 := hTPlim w hw b β hwβ hwb - have hρ0 : ρ ≠ 0 := by - intro h0 - have h1 := congrArg NatOrdinal.constantCoeff hρ - rw [NatOrdinal.constantCoeff_add, ← hβ, NatOrdinal.constantCoeff_add, hβc, - hlamc b (hBT b.2), h0, NatOrdinal.constantCoeff_zero] at h1 - omega - -- `β ≠ 0`: a scalar entry would put `c_b` in the ideal of the other `c_{b'}` - have hβ0 : β ≠ 0 := by - intro h0 - rw [h0, zero_add] at hβ - rw [h0] at hwβ - obtain ⟨κ, hκ⟩ := (gradeZeroScalars_iff A).mp hgz (w b) hwβ - have hκ0 : κ ≠ 0 := by - rintro rfl - exact hwb (by rw [hκ, map_zero]) - have hP : ∀ b' : ↥B, ∃ P : MvPolynomial ι K, - (∀ β', β' + lam b' = lam b → IsWeightedHomogeneous wt P β') ∧ - ((¬ ∃ β', β' + lam b' = lam b) → P = 0) ∧ aeval x P = w b' := by - intro b' - have hhom' := (isHomogeneousTuple_iff.mp (hTPhom w hw)) b' - rw [← hβ] at hhom' - by_cases h : ∃ β', β' + lam b' = lam b - · obtain ⟨β', hβ'⟩ := h - obtain ⟨P, hPhom, hPw⟩ := hx.exists_aeval_eq hgz β' - (w b') (hhom'.1 β' hβ') - refine ⟨P, fun β'' hβ'' ↦ ?_, fun hn ↦ absurd ⟨β', hβ'⟩ hn, hPw⟩ - rwa [add_right_cancel (hβ''.trans hβ'.symm)] - · exact ⟨0, fun β' hβ' ↦ absurd ⟨β', hβ'⟩ h, fun _ ↦ rfl, by rw [map_zero, hhom'.2 h]⟩ - choose P hPhom hP0 hPw using hP - -- the relation `κ c_b + ∑_{b' ≠ b} c_{b'} P_{b'}` of degree `lam b < δ` - have hG'hom : IsWeightedHomogeneous wt - (C κ * c b + ∑ b' ∈ Finset.univ.erase b, c b' * P b') (lam b) := by - refine ((hchom b (hBT b.2)).C_mul κ).add (IsWeightedHomogeneous.sum _ _ _ fun b' _ ↦ ?_) - by_cases h : ∃ β', β' + lam b' = lam b - · obtain ⟨β', hβ'⟩ := h - have := (hchom b' (hBT b'.2)).mul (hPhom b' β' hβ') - rwa [add_comm, hβ'] at this - · rw [hP0 b' h, mul_zero] - exact isWeightedHomogeneous_zero K wt _ - have hG'0 : aeval x (C κ * c b + ∑ b' ∈ Finset.univ.erase b, c b' * P b') = 0 := by - have hsyzw := hTPsyz w hw - rw [← Finset.add_sum_erase _ _ (Finset.mem_univ b), hκ] at hsyzw - rw [map_add, map_mul, map_sum, ← algebraMap_eq, AlgHom.commutes, Algebra.commutes, - Finset.sum_congr rfl fun b' _ ↦ by rw [map_mul, hPw]] - exact hsyzw - have hG'z := (injectiveAt_iff _).mp (hinj (lam b) (hlamlt b (hBT b.2))) _ hG'hom hG'0 - have h2 : C κ * c b = -∑ b' ∈ Finset.univ.erase b, c b' * P b' := - eq_neg_of_add_eq_zero_left hG'z - have h3 : c b = C κ⁻¹ * (C κ * c b) := by - rw [← mul_assoc, ← C_mul, inv_mul_cancel₀ hκ0, C_1, one_mul] - refine hBmin' b b.2 ?_ - rw [h3, h2] - refine Ideal.mul_mem_left _ _ ((Ideal.neg_mem_iff _).mpr (Ideal.sum_mem _ fun b' hb' ↦ ?_)) - refine Ideal.mul_mem_right _ _ (Ideal.subset_span ⟨b', ?_, rfl⟩) - exact Finset.mem_coe.mpr (Finset.mem_erase.mpr - ⟨fun h ↦ (Finset.mem_erase.mp hb').1 (Subtype.ext h), b'.2⟩) - rw [← hρβ] - exact mul_mem_decomposableAt (A) hρ0 hβ0 haρ hwβ + have hudec := syzygy_entries_mem_decomposable hx hgz hδ hinj B c lam + (fun b ↦ hlam b (hBT b.2)) (fun b ↦ hlamc b (hBT b.2)) + (fun b ↦ hlamlt b (hBT b.2)) (fun b ↦ hchom b (hBT b.2)) hBmin' + TP eT hTPhom hTPlim hTPsyz u a₂ ha₂ hu_eq exact not_forall_aeval_cofactors_mem_decomposable hx hδ T B hBT hBne lam hlam (fun t ht ↦ (hmemT t ht).2) V hV a' (fun b ↦ by rw [ha', ite_eq_left b.2, ite_eq_left rfl]) ha'hom ha'0 W hW diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GeometricIntegrality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GeometricIntegrality.lean index 60998f4c91..b60e7395b6 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GeometricIntegrality.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GeometricIntegrality.lean @@ -34,8 +34,8 @@ scalar extension by its fraction field. Polynomial and quotient tensor equivalen that tensor product with the required polynomial quotient. The definition quantifies over the fields of the universe `max u v` of `B ⊗[k] L`. A `Prop` -cannot quantify over universes, and the universe-free characterization, that `B ⊗[k] k̄` is a -domain for an algebraic closure `k̄`, is a theorem of descent that is not in Mathlib; the +cannot quantify over universes, and the universe-free characterization, that `B ⊗[k] k_alg` is a +domain for an algebraic closure `k_alg`, is a theorem of descent that is not in Mathlib; the scheme-theoretic `AlgebraicGeometry.GeometricallyIntegral` is likewise fixed to one universe. For the paper's quotient `P̂/I`, the statement in every universe is proved separately, by putting a lowering derivation on `E ⊗_K P̂` rather than from this definition. diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/BasisOver.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/BasisOver.lean index b0a7f6fdeb..eeca7196f4 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/BasisOver.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/BasisOver.lean @@ -35,10 +35,10 @@ Then: * the degree over `P`, `ν_P`, is the largest degree `γ i` of a basis vector occurring in the expansion (`IsBasisOver.degreeOver_le_iff_forall_repr`); * the associated graded ring `gr_{ν_P} R` is free over `P`, which sits in degree zero, on the - classes `β̄ i` of the `β i` in their degrees + classes `[β] i` of the `β i` in their degrees (`IsBasisOver.closure_degreeOverSubalgebraHom_mul_layerClass_eq_top` and `IsBasisOver.eq_zero_of_sum_degreeOverSubalgebraHom_mul_layerClass_eq_zero`); consequently every - additive map `C ⊗ P → gr_{ν_P} R` sending `c i ⊗ p` to `p β̄ i`, for a basis `c` of `C`, is + additive map `C ⊗ P → gr_{ν_P} R` sending `c i ⊗ p` to `p [β] i`, for a basis `c` of `C`, is bijective (`IsBasisOver.bijective_of_tmul`); * an element `a ∈ P` is prime in `R` whenever `gr_{ν_P} R` is identified with a tensor product `C ⊗ P` carrying `1 ⊗ a` to the initial form of `a` for `ν_P`, and `C ⊗ P` and `C ⊗ (P ⧸ (a))` @@ -46,7 +46,7 @@ Then: gr_{deg_S} K((ℝ^{≤0}))`. Freeness rests on one computation: the class of any `t ∈ R` in degree `d` for `ν_P` is the sum -of the terms `pᵢ β̄ᵢ` of its expansion whose degree `γ i` is exactly `d`. +of the terms `pᵢ [β]ᵢ` of its expansion whose degree `γ i` is exactly `d`. -/ universe u v w x @@ -391,7 +391,7 @@ theorem beta_mem_degreeOver_filtrationLE (i : ι) : β i ∈ (ν.degreeOver P).f ((ν.degreeOver P).mem_filtrationLE_iff _ _).mpr (ν.degreeOver_le_of_degree_le P (H.degree_beta i).le) -/-- The class `β̄ i` of `β i` in degree `γ i` of `gr_{ν_P} R`. -/ +/-- The class `[β] i` of `β i` in degree `γ i` of `gr_{ν_P} R`. -/ def layerClass (i : ι) : (ν.degreeOver P).AssociatedGraded := (ν.degreeOver P).homogeneousMk (γ i) ⟨β i, H.beta_mem_degreeOver_filtrationLE i⟩ @@ -401,7 +401,7 @@ theorem layerClass_eq (i : ι) : (ν.degreeOver P).homogeneousMk (γ i) ⟨β i, H.beta_mem_degreeOver_filtrationLE i⟩ := (rfl) -/-- The product of the degree-zero class of `p ∈ P` with `β̄ i` is the class of `p β i`. -/ +/-- The product of the degree-zero class of `p ∈ P` with `[β] i` is the class of `p β i`. -/ theorem degreeOverSubalgebraHom_mul_layerClass (p : P) (i : ι) : degreeOverSubalgebraHom ν P p * H.layerClass i = (ν.degreeOver P).homogeneousMk (γ i) @@ -476,7 +476,7 @@ theorem gamma_lt_of_degreeOver_lt {t : R} {d : M} (h : ν.degreeOver P t < d) : exact lt_of_le_of_lt ((H.degreeOver_le_iff_forall_repr t m).mp ((ν.degreeOver_le_iff P t m).mpr hmem) i hi) hm -/-- The class of `t` in degree `d` for `ν_P` is the sum of the terms `pᵢ β̄ᵢ` of its expansion +/-- The class of `t` in degree `d` for `ν_P` is the sum of the terms `pᵢ [β]ᵢ` of its expansion with `γ i = d`. -/ theorem homogeneousMk_eq_sum (t : R) (d : M) (ht : t ∈ (ν.degreeOver P).filtrationLE d) : @@ -511,8 +511,8 @@ theorem homogeneousMk_eq_sum (t : R) (d : M) exact lt_of_le_of_lt (H.degreeOver_coe_mul_beta_le (f i) i) (WithBot.coe_lt_coe.mpr (lt_of_le_of_ne (hγ i i.2) h)) -/-- The classes `β̄ i` generate `gr_{ν_P} R` over `P`: every element is a finite sum of products -`p β̄ᵢ` with `p ∈ P`. -/ +/-- The classes `[β] i` generate `gr_{ν_P} R` over `P`: every element is a finite sum of products +`p [β]ᵢ` with `p ∈ P`. -/ theorem closure_degreeOverSubalgebraHom_mul_layerClass_eq_top : AddSubmonoid.closure (Set.range fun x : P × ι ↦ degreeOverSubalgebraHom ν P x.1 * H.layerClass x.2) = ⊤ := by @@ -528,7 +528,7 @@ theorem closure_degreeOverSubalgebraHom_mul_layerClass_eq_top : exact sum_mem fun i _ ↦ AddSubmonoid.subset_closure ⟨(_, i), rfl⟩ | add u v hu hv => exact add_mem hu hv -/-- The classes `β̄ i` are independent over `P`: a vanishing finite combination `∑ pₖ β̄ₖ` has +/-- The classes `[β] i` are independent over `P`: a vanishing finite combination `∑ pₖ [β]ₖ` has every coefficient zero. -/ theorem eq_zero_of_sum_degreeOverSubalgebraHom_mul_layerClass_eq_zero (s : Finset ι) (f : ι → P) (h : ∑ k ∈ s, degreeOverSubalgebraHom ν P (f k) * H.layerClass k = 0) : @@ -575,7 +575,7 @@ variable {L' : Type*} [CommRing L'] [Algebra L' P] {C : Type*} [CommRing C] [Alg (hΘ : ∀ (i : ι) (p : P), Θ (c i ⊗ₜ[L'] p) = degreeOverSubalgebraHom ν P p * H.layerClass i) include hΘ -/-- A map `C ⊗ P → gr_{ν_P} R` sending `c i ⊗ p` to `p β̄ i` is surjective. -/ +/-- A map `C ⊗ P → gr_{ν_P} R` sending `c i ⊗ p` to `p [β] i` is surjective. -/ theorem surjective_of_tmul : Function.Surjective Θ := by intro z have hz : z ∈ AddSubmonoid.closure @@ -587,7 +587,7 @@ theorem surjective_of_tmul : Function.Surjective Θ := by obtain ⟨⟨p, i⟩, rfl⟩ := hy exact ⟨c i ⊗ₜ[L'] p, hΘ i p⟩ -/-- A map `C ⊗ P → gr_{ν_P} R` sending `c i ⊗ p` to `p β̄ i` is injective. -/ +/-- A map `C ⊗ P → gr_{ν_P} R` sending `c i ⊗ p` to `p [β] i` is injective. -/ theorem injective_of_tmul : Function.Injective Θ := by classical rw [injective_iff_map_eq_zero] @@ -612,8 +612,8 @@ theorem injective_of_tmul : Function.Injective Θ := by rw [hexp] exact Finset.sum_eq_zero fun k hk ↦ by rw [hcoord k hk, TensorProduct.tmul_zero] -/-- A map `C ⊗ P → gr_{ν_P} R` sending `c i ⊗ p` to `p β̄ i` is bijective: `gr_{ν_P} R` is free -over `P` on the classes `β̄ i`, and `C ⊗ P` is free over `P` on `c i ⊗ 1`. -/ +/-- A map `C ⊗ P → gr_{ν_P} R` sending `c i ⊗ p` to `p [β] i` is bijective: `gr_{ν_P} R` is free +over `P` on the classes `[β] i`, and `C ⊗ P` is free over `P` on `c i ⊗ 1`. -/ theorem bijective_of_tmul : Function.Bijective Θ := ⟨H.injective_of_tmul c Θ hΘ, H.surjective_of_tmul c Θ hΘ⟩ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedQuotient.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedQuotient.lean index 5059169c35..04150222a2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedQuotient.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreeAssociatedGradedQuotient.lean @@ -21,7 +21,7 @@ classes of ideal elements in every weak filtration. Consequently, the associated graded ring of the least-representative quotient degree is canonically isomorphic to the quotient of the source associated graded ring by the initial ideal: the -filtered-quotient isomorphism `gr_ν R ⧸ in_ν(I) ≅ gr_ν̄ (R ⧸ I)`. +filtered-quotient isomorphism `gr_ν R ⧸ in_ν(I) ≅ gr_ν_quot (R ⧸ I)`. -/ open scoped MaxAddDegree diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreePrincipalInitialIdeal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreePrincipalInitialIdeal.lean index f62ef31b06..b69dec9f14 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreePrincipalInitialIdeal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/DegreePrincipalInitialIdeal.lean @@ -22,7 +22,8 @@ If this graded quotient is a domain, then `R / (q)` is a domain. The same conclu nonzero `a` whose initial form generates a prime ideal of the associated graded ring is prime, has a direct proof for a separated multiplicative degree over a well-ordered value monoid: for `b ∉ (a)` of least degree in its coset, `in(b) ∈ (in a)` would give `in(b) = in(a) g` with `g` -homogeneous, and a lift `g̃` of `g` would produce `b - a g̃` of smaller degree in the same coset. +homogeneous, and a lift `g_lift` of `g` would produce `b - a g_lift` of smaller degree in the same +coset. -/ open scoped MaxAddDegree @@ -110,7 +111,7 @@ theorem exists_sub_mem_and_forall_le (ν : MaxAddDegree R M) (hν : ν.IsSeparat omit [WellFoundedLT M] in /-- For a separated multiplicative degree, an element `b ∉ (a)` of least degree in its coset modulo `(a)` has initial form outside `(in_ν a)`: otherwise `in_ν b = in_ν a · g` with `g` -homogeneous, and a lift `g̃` of `g` gives `ν (b - a g̃) < ν b` in the same coset. -/ +homogeneous, and a lift `g_lift` of `g` gives `ν (b - a g_lift) < ν b` in the same coset. -/ theorem initialForm_notMem_span_initialForm (ν : MaxAddDegree R M) (hν : ν.IsSeparated) {a b : R} (ha : a ≠ 0) (hb : b ∉ Ideal.span {a}) (hmin : ∀ b', b' - b ∈ Ideal.span {a} → ν b ≤ ν b') : diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/DegreeTwoPrime.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/DegreeTwoPrime.lean index ca7cc854d4..de46f7c5bc 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/DegreeTwoPrime.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/DegreeTwoPrime.lean @@ -62,7 +62,7 @@ private theorem degreeTwoWithConstant_constantCoeff_mem : /-- The signed degree-two series has negative order: its exponent `q₀,₀` carries coefficient one and is negative. -/ -theorem signedDegreeTwo_order_neg : +private theorem signedDegreeTwo_order_neg : (mapRealDomainToSurreal (degreeTwoWithConstant (K := ℝ)) : ℝ⟦Surreal.{u}⟧).order < 0 := by have hcoeff : (mapRealDomainToSurreal (degreeTwoWithConstant (K := ℝ)) : ℝ⟦Surreal.{u}⟧).coeff ((degreeTwoExponentPair (0, 0) : ℝ) : Surreal) ≠ 0 := by @@ -73,7 +73,7 @@ theorem signedDegreeTwo_order_neg : refine (HahnSeries.order_le_of_coeff_ne_zero hcoeff).trans_lt ?_ norm_num [degreeTwoExponentPair_apply] -theorem signedDegreeTwo_order_ne_zero : +private theorem signedDegreeTwo_order_ne_zero : (mapRealDomainToSurreal (degreeTwoWithConstant (K := ℝ)) : ℝ⟦Surreal.{u}⟧).order ≠ 0 := signedDegreeTwo_order_neg.ne diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowPrime.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowPrime.lean index 569c2cbc72..a363c40a9f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowPrime.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger/OneRowPrime.lean @@ -56,7 +56,7 @@ private theorem withConstant_constantCoeff_mem : rw [withConstant_constantCoeff] exact Surreal.realIntegerSubring.one_mem -theorem signedOneRow_order_neg : +private theorem signedOneRow_order_neg : (mapRealDomainToSurreal (withConstant (K := ℝ)) : ℝ⟦Surreal.{0}⟧).order < 0 := by have hcoeff : (mapRealDomainToSurreal (withConstant (K := ℝ)) : ℝ⟦Surreal.{0}⟧).coeff ((Berarducci.OneRow.exponent 0 : ℝ) : Surreal) ≠ 0 := by @@ -67,7 +67,7 @@ theorem signedOneRow_order_neg : rw [Berarducci.OneRow.exponent_apply] norm_num) -theorem signedOneRow_order_ne_zero : +private theorem signedOneRow_order_ne_zero : (mapRealDomainToSurreal (withConstant (K := ℝ)) : ℝ⟦Surreal.{0}⟧).order ≠ 0 := signedOneRow_order_neg.ne diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/GradedIrreducible.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/GradedIrreducible.lean index 0e884666f7..3fc64b7f1c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/GradedIrreducible.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/GradedIrreducible.lean @@ -232,7 +232,7 @@ theorem rvProjection_finiteSupportGradedEmbedding exact congrArg _ (congrArg _ (Subtype.ext (coe_finiteSupportFiltrationRepresentative p))) /-- The graded projection kills the image of a strictly negative monomial. -/ -theorem rvProjection_finiteSupportMonomial_of_neg [CharZero K] +theorem rvProjection_finiteSupportMonomial_of_neg {g : exponentMonoid ℝ} (hg : (g : ℝ) < 0) : rvProjection K (finiteSupportGradedEmbedding K (finiteSupportMonomial g)) = 0 := by rw [rvProjection_finiteSupportGradedEmbedding] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/SuccessorStep.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/SuccessorStep.lean index f0e10aa430..e35fe76d16 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/SuccessorStep.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random/SuccessorStep.lean @@ -185,6 +185,143 @@ private theorem mkQ_mem_span_singleton_of_mem_sup {V : Type*} [AddCommGroup V] [ rw [map_add, map_smul, hz0, add_zero] exact Submodule.mem_span_singleton.mpr ⟨c, rfl⟩ +/-- Uniform truncation, Leibniz and decomposable-span estimates near zero. -/ +private theorem eventually_successor_decomposition_estimates + {ι : Type*} {n m : ℕ} (β γ : Fin m → NatOrdinal) (u w : Fin m → Series K) + (b : ι → Series K) (T : Finset ι) (r : Series K) + (hk : ∀ k, 0 < β k ∧ 0 < γ k ∧ β k + γ k = (n : NatOrdinal) + 1 ∧ + ordinalValue (u k) < ω^ (β k + 1) ∧ ordinalValue (w k) < ω^ (γ k + 1)) + (hβc : ∀ k, 0 < (β k).constantCoeff) (hγc : ∀ k, 0 < (γ k).constantCoeff) + (hβγ : ∀ k, (β k).removeNat 1 + γ k = n) + (hγβ : ∀ k, (γ k).removeNat 1 + β k = n) + (huw : ∀ k, ordinalValue (u k * w k) < ω^ ((n : NatOrdinal) + 1 + 1)) + (hrlt : ordinalValue r < ω^ ((n : NatOrdinal) + 1)) + (hcut : ∀ i, ordinalValue (b i) < ω^ ((n : NatOrdinal) + 1 + 1)) : ∀ᶠ γ' in 𝓝[<] (0 : ℝ), + (∀ k, ordinalValue (translatedTruncation ((u k * w k : Series K) : K⟦ℝ⟧) γ' - + translatedTruncation (u k : K⟦ℝ⟧) γ' * w k - u k * translatedTruncation (w k : K⟦ℝ⟧) γ') + < ω^ (n : NatOrdinal)) ∧ + (∀ k, gradeClass (n : NatOrdinal) (translatedTruncation (u k : K⟦ℝ⟧) γ' * w k) ∈ + (K ∙ gradeClass (n : NatOrdinal) (w k)) ⊔ decomposableSpan K (n : NatOrdinal)) ∧ + (∀ k, gradeClass (n : NatOrdinal) (translatedTruncation (w k : K⟦ℝ⟧) γ' * u k) ∈ + (K ∙ gradeClass (n : NatOrdinal) (u k)) ⊔ decomposableSpan K (n : NatOrdinal)) ∧ + (∀ k, ordinalValue (translatedTruncation (u k : K⟦ℝ⟧) γ') < ω^ (β k)) ∧ + (∀ k, ordinalValue (translatedTruncation (w k : K⟦ℝ⟧) γ') < ω^ (γ k)) ∧ + (∀ k, ordinalValue (translatedTruncation ((u k * w k : Series K) : K⟦ℝ⟧) γ') < + ω^ ((n : NatOrdinal) + 1)) ∧ + ordinalValue (translatedTruncation (r : K⟦ℝ⟧) γ') < ω^ (n : NatOrdinal) ∧ + (∀ i ∈ T, ordinalValue (translatedTruncation (b i : K⟦ℝ⟧) γ') < + ω^ ((n : NatOrdinal) + 1)) := by + classical + refine Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) + (Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) + (Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) + (Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) + (Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) + (Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) + (Filter.Eventually.and ?_ ((Filter.eventually_all_finset T).mpr fun i _ ↦ ?_))))))) + · have h := eventually_ordinalValue_leibnizRemainder_lt (hβc k) (u k) (w k) + (hk k).2.2.2.1 (hk k).2.2.2.2 + rwa [hβγ k] at h + · exact eventually_gradeClass_translatedTruncation_mul_mem (hβc k) (hk k).2.1 (hβγ k) + (hk k).2.2.2.1 (hk k).2.2.2.2 + · exact eventually_gradeClass_translatedTruncation_mul_mem (hγc k) (hk k).1 (hγβ k) + (hk k).2.2.2.2 (hk k).2.2.2.1 + · exact eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one + (β k) (u k) (hk k).2.2.2.1 + · exact eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one + (γ k) (w k) (hk k).2.2.2.2 + · exact eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one + ((n : NatOrdinal) + 1) (u k * w k) (huw k) + · exact eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one + (n : NatOrdinal) r hrlt + · exact eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one + ((n : NatOrdinal) + 1) (b i) (hcut i) + +/-- The grade of a translated polynomial sum is the sum of its Leibniz contributions. -/ +private theorem gradeClass_translatedTruncation_sum_products + {n m : ℕ} (μ : Fin m → K) (u w : Fin m → Series K) (B r : Series K) (γ' : ℝ) + (hBPr : B = (∑ k, (HahnSeries.Nonpositive.C : K →+* Series K) (μ k) * + (u k * w k)) + r) + (hE1 : ∀ k, ordinalValue (translatedTruncation ((u k * w k : Series K) : K⟦ℝ⟧) γ' - + translatedTruncation (u k : K⟦ℝ⟧) γ' * w k - + u k * translatedTruncation (w k : K⟦ℝ⟧) γ') < ω^ (n : NatOrdinal)) + (hYcut : ∀ k, ordinalValue (translatedTruncation (u k : K⟦ℝ⟧) γ' * w k) < + ω^ ((n : NatOrdinal) + 1)) + (hZcut : ∀ k, ordinalValue (translatedTruncation (w k : K⟦ℝ⟧) γ' * u k) < + ω^ ((n : NatOrdinal) + 1)) + (hE4 : ∀ k, ordinalValue (translatedTruncation ((u k * w k : Series K) : K⟦ℝ⟧) γ') < + ω^ ((n : NatOrdinal) + 1)) + (hE5 : ordinalValue (translatedTruncation (r : K⟦ℝ⟧) γ') < ω^ (n : NatOrdinal)) : + gradeClass (n : NatOrdinal) (translatedTruncation (B : K⟦ℝ⟧) γ') = + ∑ k, μ k • (gradeClass (n : NatOrdinal) (translatedTruncation (u k : K⟦ℝ⟧) γ' * w k) + + gradeClass (n : NatOrdinal) (translatedTruncation (w k : K⟦ℝ⟧) γ' * u k)) := by + classical + let P : Series K := ∑ k, (HahnSeries.Nonpositive.C : K →+* Series K) (μ k) * (u k * w k) + have hCtrunc : ∀ k ∈ (Finset.univ : Finset (Fin m)), + ordinalValue ((HahnSeries.Nonpositive.C : K →+* Series K) (μ k) * + translatedTruncation ((u k * w k : Series K) : K⟦ℝ⟧) γ') < ω^ ((n : NatOrdinal) + 1) := + fun k _ ↦ by + simpa only [zero_add] using + ordinalValue_mul_lt_wpow_add_one (ordinalValue_C_lt_wpow_one (μ k)) (hE4 k) + have hPtrunc : ordinalValue (translatedTruncation (P : K⟦ℝ⟧) γ') < ω^ ((n : NatOrdinal) + 1) := by + dsimp only [P] + rw [translatedTruncation_sum_C_mul] + exact ordinalValue_sum_lt_wpow_add_one _ _ hCtrunc + have hrtrunc : ordinalValue (translatedTruncation (r : K⟦ℝ⟧) γ') < ω^ ((n : NatOrdinal) + 1) := + hE5.trans (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one _)) + rw [hBPr, Subring.coe_add, translatedTruncation_add, gradeClass_add hPtrunc hrtrunc, + gradeClass_eq_zero_of_lt hE5, add_zero, translatedTruncation_sum_C_mul, + gradeClass_sum _ _ hCtrunc] + refine Finset.sum_congr rfl fun k _ ↦ ?_ + rw [gradeClass_C_mul (μ k) (hE4 k)] + congr 1 + rw [← gradeClass_add (hYcut k) (hZcut k)] + apply gradeClass_eq_of_sub_lt (hE4 k) + ((ordinalValue_add_le_max _ _).trans_lt (max_lt (hYcut k) (hZcut k))) + rw [mul_comm (translatedTruncation (w k : K⟦ℝ⟧) γ') (u k), ← sub_sub] + exact hE1 k + +open Classical in +/-- A truncation relation descends to the terms of exact degree after lower-degree terms vanish. -/ +private theorem rvJ_sum_filter_of_truncation_relation + {ι : Type*} {n : ℕ} (T : Finset ι) (b : ι → Series K) (g : ι → K) (B : Series K) + (Γ : Finset ℝ) (sΓ : Finset Γ) (δ : Γ → K) + (hBtrunc : ∀ γ' ∈ Γ, + gradeClass (n : NatOrdinal) (translatedTruncation (B : K⟦ℝ⟧) γ') = + ∑ i ∈ T, g i • gradeClass (n : NatOrdinal) (translatedTruncation (b i : K⟦ℝ⟧) γ')) + (hcutT : ∀ γ' ∈ sΓ, ∀ i ∈ T, + ordinalValue (translatedTruncation (b i : K⟦ℝ⟧) γ') < ω^ ((n : NatOrdinal) + 1)) + (hδmem : ∑ γ' ∈ sΓ, δ γ' • gradeClass (n : NatOrdinal) + (translatedTruncation (B : K⟦ℝ⟧) γ') ∈ decomposableSpan K (n : NatOrdinal)) : + ∑ p ∈ (sΓ ×ˢ T).filter (fun p : Γ × ι ↦ + ordinalValue (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) = ω^ (n : NatOrdinal)), + (δ p.1 * g p.2) • rvJ (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) ∈ + decomposableSpan K (n : NatOrdinal) := by + classical + have hexpand : ∑ γ' ∈ sΓ, δ γ' • gradeClass (n : NatOrdinal) + (translatedTruncation (B : K⟦ℝ⟧) γ') = + ∑ p ∈ sΓ ×ˢ T, (δ p.1 * g p.2) • + gradeClass (n : NatOrdinal) (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) := by + rw [Finset.sum_product] + refine Finset.sum_congr rfl fun γ' _ ↦ ?_ + rw [hBtrunc γ' γ'.2, Finset.smul_sum] + exact Finset.sum_congr rfl fun i _ ↦ by rw [smul_smul] + rw [hexpand, ← Finset.sum_filter_add_sum_filter_not (sΓ ×ˢ T) (fun p : Γ × ι ↦ + ordinalValue (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) = ω^ (n : NatOrdinal))] at hδmem + have hzero : ∑ p ∈ (sΓ ×ˢ T).filter (fun p : Γ × ι ↦ + ¬ ordinalValue (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) = ω^ (n : NatOrdinal)), + (δ p.1 * g p.2) • gradeClass (n : NatOrdinal) (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) + = 0 := by + refine Finset.sum_eq_zero fun p hp ↦ ?_ + obtain ⟨hp, hne⟩ := Finset.mem_filter.mp hp + obtain ⟨hγ', hi⟩ := Finset.mem_product.mp hp + rcases ordinalValue_eq_or_lt_of_lt_wpow_add_one (hcutT p.1 hγ' p.2 hi) with heq | hlt + · exact absurd heq hne + · rw [gradeClass_eq_zero_of_lt hlt, smul_zero] + rw [hzero, add_zero] at hδmem + convert hδmem using 2 with p hp + rw [rvJ_eq_gradeClass (Finset.mem_filter.mp hp).2] + /-- FLLM24, Proposition 4.4, at finite degrees: `(*)_n` implies `(*)_{n+1}` for `n ≥ 1`. -/ theorem independentModuloDecomposable_succ {n : ℕ} (hn : 1 ≤ n) (hstar : IndependentModuloDecomposable K n) : @@ -275,43 +412,8 @@ theorem independentModuloDecomposable_succ {n : ℕ} (hn : 1 ≤ n) ← hdecomp, sub_self] have hBPr : B = P + r := by rw [hr]; abel -- The eventual statements near zero. - have hev : ∀ᶠ γ' in 𝓝[<] (0 : ℝ), - (∀ k, ordinalValue (translatedTruncation ((u k * w k : Series K) : K⟦ℝ⟧) γ' - - translatedTruncation (u k : K⟦ℝ⟧) γ' * w k - u k * translatedTruncation (w k : K⟦ℝ⟧) γ') - < ω^ (n : NatOrdinal)) ∧ - (∀ k, gradeClass (n : NatOrdinal) (translatedTruncation (u k : K⟦ℝ⟧) γ' * w k) ∈ - (K ∙ gradeClass (n : NatOrdinal) (w k)) ⊔ decomposableSpan K (n : NatOrdinal)) ∧ - (∀ k, gradeClass (n : NatOrdinal) (translatedTruncation (w k : K⟦ℝ⟧) γ' * u k) ∈ - (K ∙ gradeClass (n : NatOrdinal) (u k)) ⊔ decomposableSpan K (n : NatOrdinal)) ∧ - (∀ k, ordinalValue (translatedTruncation (u k : K⟦ℝ⟧) γ') < ω^ (β k)) ∧ - (∀ k, ordinalValue (translatedTruncation (w k : K⟦ℝ⟧) γ') < ω^ (γ k)) ∧ - (∀ k, ordinalValue (translatedTruncation ((u k * w k : Series K) : K⟦ℝ⟧) γ') < ω^ N) ∧ - ordinalValue (translatedTruncation (r : K⟦ℝ⟧) γ') < ω^ (n : NatOrdinal) ∧ - (∀ i ∈ T, ordinalValue (translatedTruncation (b i : K⟦ℝ⟧) γ') < ω^ N) := by - refine Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) - (Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) - (Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) - (Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) - (Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) - (Filter.Eventually.and (Filter.eventually_all.mpr fun k ↦ ?_) - (Filter.Eventually.and ?_ ((Filter.eventually_all_finset T).mpr fun i _ ↦ ?_))))))) - · have h := eventually_ordinalValue_leibnizRemainder_lt (hβc k) (u k) (w k) - (hk k).2.2.2.1 (hk k).2.2.2.2 - rwa [hβγ k] at h - · exact eventually_gradeClass_translatedTruncation_mul_mem (hβc k) (hk k).2.1 (hβγ k) - (hk k).2.2.2.1 (hk k).2.2.2.2 - · exact eventually_gradeClass_translatedTruncation_mul_mem (hγc k) (hk k).1 (hγβ k) - (hk k).2.2.2.2 (hk k).2.2.2.1 - · exact eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one - (β k) (u k) (hk k).2.2.2.1 - · exact eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one - (γ k) (w k) (hk k).2.2.2.2 - · exact eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one - N (u k * w k) (huw k) - · exact eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one - (n : NatOrdinal) r hrlt - · exact eventually_ordinalValue_translatedTruncation_lt_wpow_of_ordinalValue_lt_wpow_add_one - N (b i) (hcut i) + have hev := eventually_successor_decomposition_estimates β γ u w b T r hk + hβc hγc hβγ hγβ huw hrlt hcut obtain ⟨η, hη, hη'⟩ := eventually_nhdsLT_iff_exists.mp hev obtain ⟨δQ, hδQ, hQ2⟩ := hQ.truncations hn -- Residual points of `B` above both thresholds. @@ -356,27 +458,8 @@ theorem independentModuloDecomposable_succ {n : ℕ} (hn : 1 ≤ n) exact hE9 k have h := ordinalValue_mul_lt_wpow_add_one h1 (hk k).2.2.2.1 rwa [hγβ k] at h - have hCtrunc : ∀ k ∈ (Finset.univ : Finset (Fin m)), - ordinalValue ((HahnSeries.Nonpositive.C : K →+* Series K) (μ k) * - translatedTruncation ((u k * w k : Series K) : K⟦ℝ⟧) γ') < ω^ N := fun k _ ↦ by - simpa only [zero_add] using - ordinalValue_mul_lt_wpow_add_one (ordinalValue_C_lt_wpow_one (μ k)) (hE4 k) - have hPtrunc : ordinalValue (translatedTruncation (P : K⟦ℝ⟧) γ') < ω^ N := by - rw [hP, translatedTruncation_sum_C_mul] - exact ordinalValue_sum_lt_wpow_add_one _ _ hCtrunc - have hrtrunc : ordinalValue (translatedTruncation (r : K⟦ℝ⟧) γ') < ω^ N := - hE5.trans (NatOrdinal.wpow_lt_wpow.mpr (lt_add_one _)) - rw [hBPr, Subring.coe_add, translatedTruncation_add, gradeClass_add hPtrunc hrtrunc, - gradeClass_eq_zero_of_lt hE5, add_zero, hP, translatedTruncation_sum_C_mul, - gradeClass_sum _ _ hCtrunc] - refine Finset.sum_congr rfl fun k _ ↦ ?_ - rw [gradeClass_C_mul (μ k) (hE4 k)] - congr 1 - rw [← gradeClass_add (hYcut k) (hZcut k)] - apply gradeClass_eq_of_sub_lt (hE4 k) - ((ordinalValue_add_le_max _ _).trans_lt (max_lt (hYcut k) (hZcut k))) - rw [mul_comm (translatedTruncation (w k : K⟦ℝ⟧) γ') (u k), ← sub_sub] - exact hE1 k + exact gradeClass_translatedTruncation_sum_products μ u w B r γ' hBPr + hE1 hYcut hZcut hE4 hE5 -- The classes of the `B^{|γ'}`, modulo `D_n`, lie in the span of `2m` vectors. let gens : Fin m ⊕ Fin m → PrincipalSubring K ⧸ decomposableSpan K (n : NatOrdinal) := Sum.elim (fun k ↦ π (gradeClass (n : NatOrdinal) (u k))) @@ -414,31 +497,7 @@ theorem independentModuloDecomposable_succ {n : ℕ} (hn : 1 ≤ n) exact (hη' γ' ((le_max_left η δQ).trans_lt hηγ) hγ0).2.2.2.2.2.2.2 i hi set S₁ := (sΓ ×ˢ T).filter (fun p : Γ × ι ↦ ordinalValue (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) = ω^ (n : NatOrdinal)) with hS₁ - have hrelS₁ : ∑ p ∈ S₁, (δ p.1 * g p.2) • rvJ (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) ∈ - decomposableSpan K (n : NatOrdinal) := by - have hexpand : ∑ γ' ∈ sΓ, δ γ' • gradeClass (n : NatOrdinal) - (translatedTruncation (B : K⟦ℝ⟧) γ') = - ∑ p ∈ sΓ ×ˢ T, (δ p.1 * g p.2) • - gradeClass (n : NatOrdinal) (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) := by - rw [Finset.sum_product] - refine Finset.sum_congr rfl fun γ' _ ↦ ?_ - rw [hBtrunc γ' γ'.2, Finset.smul_sum] - exact Finset.sum_congr rfl fun i _ ↦ by rw [smul_smul] - rw [hexpand, ← Finset.sum_filter_add_sum_filter_not (sΓ ×ˢ T) (fun p : Γ × ι ↦ - ordinalValue (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) = ω^ (n : NatOrdinal))] at hδmem - have hzero : ∑ p ∈ (sΓ ×ˢ T).filter (fun p : Γ × ι ↦ - ¬ ordinalValue (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) = ω^ (n : NatOrdinal)), - (δ p.1 * g p.2) • gradeClass (n : NatOrdinal) (translatedTruncation (b p.2 : K⟦ℝ⟧) p.1) - = 0 := by - refine Finset.sum_eq_zero fun p hp ↦ ?_ - obtain ⟨hp, hne⟩ := Finset.mem_filter.mp hp - obtain ⟨hγ', hi⟩ := Finset.mem_product.mp hp - rcases ordinalValue_eq_or_lt_of_lt_wpow_add_one (hcutT p.1 hγ' p.2 hi) with heq | hlt - · exact absurd heq hne - · rw [gradeClass_eq_zero_of_lt hlt, smul_zero] - rw [hzero, add_zero] at hδmem - convert hδmem using 2 with p hp - rw [rvJ_eq_gradeClass (Finset.mem_filter.mp hp).2] + have hrelS₁ := rvJ_sum_filter_of_truncation_relation T b g B Γ sΓ δ hBtrunc hcutT hδmem -- Axiom 2 makes the surviving truncations hereditarily `rv_J`-independent at degree `n`. have hQS₁ : HereditarilyRVIndependent n (fun p : S₁ ↦ translatedTruncation (b p.1.2 : K⟦ℝ⟧) (p.1.1 : ℝ)) := by diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CofactorInduction.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CofactorInduction.lean index c140a087bd..aead30d0b4 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CofactorInduction.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence/CofactorInduction.lean @@ -681,6 +681,339 @@ private theorem local_ideal_presentation_sub_sum_mul [Fintype κ'] rw [hFEGE', sub_zero] exact Ideal.sub_mem _ hF₀GE (Ideal.sum_mem _ hAQGE) +open Classical in +/-- A translated restriction with uniformly smaller local degree has empty target derivative. -/ +private theorem cantorBendixson_restricted_translate_eq_empty + (C : Set G) (z₀ : G) (c : Nonpositive G K) (β : NatOrdinal.{u}) + (hbounds : c = 0 ∨ ∃ a : NatOrdinal.{u}, a < β ∧ + ∀ s : G, s ≤ 0 → ν (translatedTruncLE s c) ≤ (a : WithBot NatOrdinal)) : + (((setRestrict C (translate z₀ (c : HahnSeries G K))).closedSupport).cantorBendixson β.val : + Set G) = ∅ := by + classical + let f := setRestrict C (translate z₀ (c : HahnSeries G K)) + have hf : f = setRestrict C (translate z₀ (c : HahnSeries G K)) := rfl + apply Set.eq_empty_iff_forall_notMem.mpr + intro z hz + change z ∈ (f.closedSupport.cantorBendixson β.val : Set G) at hz + rcases hbounds with hzero | ⟨a, hab, hb⟩ + · have hfzero : f = 0 := by + rw [hf, hzero] + rw [show ((0 : Nonpositive G K) : HahnSeries G K) = 0 from rfl, map_zero] + ext g + rw [coeff_setRestrict] + split_ifs <;> rfl + rw [hfzero] at hz + have hzs := TopologicalSpace.Closeds.cantorBendixson_le _ _ hz + rw [mem_closedSupport, HahnSeries.support_zero, closure_empty] at hzs + exact hzs + · obtain ⟨hzs, hzr⟩ := (f.mem_support_derivative_iff z β.val).mp hz + have h1 : f.cantorBendixsonRank z ≤ + (translate z₀ (c : HahnSeries G K)).cantorBendixsonRank z := + cantorBendixsonRank_le_of_support_subset (by + rw [hf, support_setRestrict] + exact inter_subset_left) z + have h2 : (translate z₀ (c : + HahnSeries G K)).cantorBendixsonRank z = + (c : HahnSeries G K).cantorBendixsonRank (z - z₀) := by + have := cantorBendixsonRank_translate (c : HahnSeries G K) + z₀ (z - z₀) + rw [show z₀ + (z - z₀) = z by abel] at this + exact this + have h3 : (c : HahnSeries G K).cantorBendixsonRank (z - z₀) ≤ + a.val := by + by_cases hm : z - z₀ ∈ + (c : HahnSeries G K).closedSupport + · have hz0 : z - z₀ ≤ 0 := closure_minimal (c).property isClosed_Iic + ((mem_closedSupport _ _).mp hm) + have hprof := hb (z - z₀) hz0 + rw [degree_translatedTruncLE_eq, ite_eq_left hm, WithBot.coe_le_coe] at hprof + have hval := NatOrdinal.of.symm.monotone hprof + change NatOrdinal.val (NatOrdinal.of _) ≤ NatOrdinal.val _ at hval + rwa [NatOrdinal.val_of] at hval + · rw [cantorBendixsonRank_eq, TopologicalSpace.Closeds.cantorBendixsonRank_of_notMem _ _ hm] + exact zero_le (a := a.val) + have h4 : a.val < β.val := NatOrdinal.of.symm.strictMono hab + exact absurd hzr (not_le_of_gt (((h1.trans_eq h2).trans h3).trans_lt h4)) + +open Classical in +/-- Restricting to an open convex piece preserves local polynomial presentations and bounds rank. -/ +private theorem translated_convex_piece_local_data + [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + {ι : Type w} {κ' : Type x} {wt : ι → NatOrdinal.{u}} {V : ι → Nonpositive G K} + (Q : κ' → MvPolynomial ι K) (α τ : NatOrdinal.{u}) + (u piece : Nonpositive G K) (z : G) (C : Set G) (f : HahnSeries G K) + (hf : f = setRestrict C (u : HahnSeries G K)) + (hpiece : (piece : HahnSeries G K) = translate (-z) f) + (hCopen : IsOpen C) (hCconv : C.OrdConnected) (hCmem : z ∈ C) + (hCrank : ∀ y ∈ ((u : HahnSeries G K).closedSupport : Set G) ∩ C, y ≠ z → + (u : HahnSeries G K).cantorBendixsonRank y < + (u : HahnSeries G K).cantorBendixsonRank z) + (β : NatOrdinal.{u}) (hβ : β = NatOrdinal.of ((u : HahnSeries G K).cantorBendixsonRank z)) + (hp : ∀ y : G, y ≤ z → ∃ F : MvPolynomial ι K, + (∀ d ∈ F.support, (Finsupp.weight wt) d < α) ∧ + ν (translatedTruncLE y u - aeval V F) = ⊥ ∧ + MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q)) : + (∀ s : G, (translatedTruncLE s piece : HahnSeries G K) = + translate (-(z + s)) (truncLE (z + s) f)) ∧ + (∀ y ∈ C, ν (translatedTruncLE (y - z) piece - translatedTruncLE y u) = ⊥) ∧ + (∀ s : G, s ≤ 0 → ν (translatedTruncLE s piece) ≤ (β : WithBot NatOrdinal)) ∧ + ∀ s : G, s ≤ 0 → ∃ F : MvPolynomial ι K, + (∀ d ∈ F.support, (Finsupp.weight wt) d < α) ∧ + ν (translatedTruncLE s piece - aeval V F) = ⊥ ∧ + MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q) := by + classical + have hfC : f.support ⊆ C := by rw [hf, support_setRestrict]; exact inter_subset_right + have hplaced_eq : ∀ s : G, + ((translatedTruncLE s piece : Nonpositive G K) : HahnSeries G K) = + translate (-(z + s)) (truncLE (z + s) f) := by + intro s + have h2 : (z + s) - z = s := by abel + have hshift : ((translatedTruncLE ((z + s) - z) piece : Nonpositive G K) : + HahnSeries G K) = translate (-(z + s)) (truncLE (z + s) + (translate z ((piece : Nonpositive G K) : HahnSeries G K))) := + translatedTruncLE_shift z (z + s) piece + rw [h2] at hshift + have hcancel : translate z (translate (-z) f) = f := by + rw [translate_add_apply, add_neg_cancel, translate_zero_apply] + rw [hshift, hpiece, hcancel] + have hloc : ∀ y' : G, y' ∈ C → + ν (translatedTruncLE (y' - z) piece - translatedTruncLE y' u) = ⊥ := by + intro y' hy' + obtain ⟨cst, hcst, hcsty⟩ := exists_lt_mem_of_isOpen_ordConnected (hCopen) hy' + apply (cantorBendixsonDegreeValuation_eq_bot_iff _).mpr + refine ⟨cst - y', sub_neg.mpr hcsty, ?_⟩ + intro g hg + have hcoe1 : ((translatedTruncLE (y' - z) piece : Nonpositive G K) : + HahnSeries G K) = translate (-y') (truncLE y' f) := by + have h2 : z + (y' - z) = y' := by abel + have := hplaced_eq (y' - z) + rw [h2] at this + exact this + rw [AddSubgroupClass.coe_sub, hcoe1, coe_translatedTruncLE] at hg + have hcombine : translate (-y') (truncLE y' f) - + translate (-y') (truncLE y' ((u : Nonpositive G K) : HahnSeries G K)) = + translate (-y') (truncLE y' f - + truncLE y' ((u : Nonpositive G K) : HahnSeries G K)) := + (map_sub (translate (-y')) _ _).symm + rw [hcombine, support_translate] at hg + obtain ⟨q, hq, rfl⟩ := hg + have hb2 : ∀ p ∈ ((u : Nonpositive G K) : HahnSeries G K).support, p ∉ C → + p ≤ y' → p ≤ cst := by + intro p _ hpC hpy + by_contra hgt + exact hpC ((hCconv).out hcst hy' ⟨(not_le.mp hgt).le, hpy⟩) + have hq2 := support_truncLE_sub_truncLE_setRestrict_subset (C) + ((u : Nonpositive G K) : HahnSeries G K) y' hb2 + have hqrev : q ∈ (truncLE y' ((u : Nonpositive G K) : HahnSeries G K) - + truncLE y' (setRestrict (C) ((u : Nonpositive G K) : HahnSeries G K))).support := by + rw [← support_neg, neg_sub, ← hf] + exact hq + have hqc : q ≤ cst := hq2 hqrev + have h3 : -y' + q ≤ cst - y' := by + have h2 : -y' + q ≤ -y' + cst := add_le_add le_rfl hqc + calc -y' + q ≤ -y' + cst := h2 + _ = cst - y' := by abel + exact mem_Iic.mpr h3 + -- Degree profile and local ideal condition of each piece. + have hux_prof : ∀ s : G, s ≤ 0 → + ν (translatedTruncLE s piece) ≤ (β : WithBot NatOrdinal) := by + intro s hs + have hy'x : z + s ≤ z := by + calc z + s ≤ z + 0 := add_le_add le_rfl hs + _ = z := add_zero _ + by_cases hy'C : z + s ∈ C + · have h1 := hloc (z + s) hy'C + have h2 : (z + s) - z = s := by abel + rw [h2] at h1 + rw [degree_eq_of_degree_sub_eq_bot h1, degree_translatedTruncLE_eq] + by_cases hm : z + s ∈ ((u : Nonpositive G K) : HahnSeries G K).closedSupport + · rw [ite_eq_left hm] + rcases eq_or_ne (z + s) z with heq | hne + · rw [heq, hβ] + · have hlt' := hCrank (z + s) ⟨hm, hy'C⟩ hne + rw [hβ] + exact WithBot.coe_le_coe.mpr (NatOrdinal.of.monotone hlt'.le) + · rw [ite_eq_right hm] + exact bot_le + · have hbelow := lt_of_notMem_ordConnected (hCconv) (hCmem) hy'x hy'C + have hzero : truncLE (z + s) f = 0 := + truncLE_eq_zero_of_forall_lt _ _ (fun p hp ↦ hbelow p (hfC hp)) + have hzero' : translatedTruncLE s piece = 0 := by + apply Subtype.ext + rw [hplaced_eq s, hzero, map_zero] + rfl + rw [hzero', (ν).map_zero] + exact bot_le + have hpux : ∀ s : G, s ≤ 0 → ∃ F : MvPolynomial ι K, + (∀ d ∈ F.support, (Finsupp.weight wt) d < α) ∧ + ν (translatedTruncLE s piece - aeval V F) = ⊥ ∧ + MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q) := by + intro s hs + have hy'z : z + s ≤ z := by simpa using add_le_add_left hs z + by_cases hy'C : z + s ∈ C + · obtain ⟨F, hFw, hFbot, hFGE⟩ := hp (z + s) hy'z + refine ⟨F, hFw, ?_, hFGE⟩ + have h1 := hloc (z + s) hy'C + have h2 : (z + s) - z = s := by abel + rw [h2] at h1 + have hsplit : translatedTruncLE s piece - aeval V F = + (translatedTruncLE s piece - translatedTruncLE (z + s) u) + + (translatedTruncLE (z + s) u - aeval V F) := by + abel + rw [hsplit] + refine le_bot_iff.mp (((ν).map_add_le_max _ _).trans ?_) + rw [h1, hFbot, max_self] + · have hy'x : z + s ≤ z := by + calc z + s ≤ z + 0 := add_le_add le_rfl hs + _ = z := add_zero _ + have hbelow := lt_of_notMem_ordConnected (hCconv) (hCmem) hy'x hy'C + have hzero : truncLE (z + s) f = 0 := + truncLE_eq_zero_of_forall_lt _ _ (fun p hp ↦ hbelow p (hfC hp)) + have hzero' : translatedTruncLE s piece = 0 := by + apply Subtype.ext + rw [hplaced_eq s, hzero, map_zero] + rfl + refine ⟨0, by simp, ?_, ?_⟩ + · rw [hzero', map_zero, sub_zero, (ν).map_zero] + · rw [componentsGE_zero] + exact Ideal.zero_mem _ + exact ⟨hplaced_eq, hloc, hux_prof, hpux⟩ + +open Classical in +/-- Local corrections on separated pieces give a global residual bound at each cutoff. -/ +private theorem SeparatedHsumFamily.degree_residual_le + [DenselyOrdered G] [NoMinOrder G] [NoMaxOrder G] + {J : Type x} [Fintype J] {X : Type w} [LinearOrder X] + (F : SeparatedHsumFamily J X) (R : Nonpositive G K) (v : X → Nonpositive G K) + (cp : X → J → Nonpositive G K) (q : J → Nonpositive G K) + (τ : NatOrdinal.{u}) (Pg σQ : J → NatOrdinal.{u}) (bx : X → NatOrdinal.{u}) + (Pl : X → J → NatOrdinal.{u}) + (hplaced : ∀ j x, F.term j x = setRestrict (F.piece x) + (translate (F.center x) (cp x j : HahnSeries G K))) + (hcp0 : ∀ x, bx x ≤ τ → ∀ j, cp x j = 0) + (hcpb : ∀ x j s, s ≤ 0 → ν (translatedTruncLE s (cp x j)) ≤ Pl x j) + (hcpres : ∀ x s, s ≤ 0 → ν (translatedTruncLE s (v x - ∑ j, cp x j * q j)) ≤ τ) + (hcPb : ∀ j s, s ≤ 0 → ν (translatedTruncLE s (F.sum j)) ≤ Pg j) + (hW : ∀ j, HasLowerTruncationDegree (q j) (σQ j)) + (hPg : ∀ j θ, θ < σQ j → Pg j + θ < τ) + (hPl : ∀ x, τ < bx x → ∀ j θ, θ < σQ j → Pl x j + θ < τ) + (hloc : ∀ x y, y ∈ F.piece x → + ν (translatedTruncLE (y - F.center x) (v x) - translatedTruncLE y R) = ⊥) + (y : G) (hout : (¬ ∃ x, y ∈ F.piece x) → + ν (translatedTruncLE y R) = ⊥ ∧ ∀ j, ν (translatedTruncLE y (F.sum j)) = ⊥) : + ν (translatedTruncLE y (R - ∑ j, F.sum j * q j)) ≤ τ := by + classical + rw [map_sub, map_sum] + have hEc : ∀ j, ν (translatedTruncLE y (F.sum j * q j) - + translatedTruncLE y (F.sum j) * q j) < (τ : WithBot NatOrdinal) := fun j ↦ + degree_translatedTruncLE_mul_sub_mul_lt_forall (F.sum j) (q j) + (Pg j) (σQ j) τ (by simpa only [translatedTruncLE_zero] using hcPb j 0 le_rfl) + (fun z hz ↦ hcPb j z hz.le) (fun z hz ↦ (hW j).degree_translatedTruncLE_lt hz) + (hPg j) y + by_cases hyC : ∃ x : X, y ∈ F.piece x + · obtain ⟨x, hyx⟩ := hyC + have hRloc := hloc x y hyx + have hcPloc : ∀ j, ν (translatedTruncLE y (F.sum j) - + translatedTruncLE (y - F.center x) (cp x j)) = ⊥ := fun j ↦ + degree_translatedTruncLE_separatedHsum_sub_piece_eq_bot F.hX F.piece F.isOpen_piece + F.ordConnected_piece + (F.term j) (F.support_subset j) F.piece_lt_piece (F.separated j) x (F.center x) hyx + (cp x j) (hplaced j x) + (F.sum j) (F.coe_sum j) + have hEin (j : J) := + degree_translatedTruncLE_mul_sub_mul_lt_of_eq_zero_or_bounds + (cp x j) (q j) (Pl x j) (σQ j) τ (bx x) + (fun h ↦ hcp0 x h j) + (by simpa only [translatedTruncLE_zero] using hcpb x j 0 le_rfl) + (fun z hz ↦ hcpb x j z hz.le) + (fun z hz ↦ (hW j).degree_translatedTruncLE_lt hz) + (fun h ↦ hPl x h j) (y - F.center x) + have hkey := translatedTruncLE_sub_sum_eq_local_errors y (y - F.center x) R (v x) + (cp x) F.sum q + rw [hkey] + apply degree_add_add_sum_le + · rw [degree_reverse_sub_eq_bot hRloc] + exact bot_le + · exact degree_translatedTruncLE_le_of_nonpositive (hcpres x) (y - F.center x) + · intro j + apply degree_add_add_le (hEin j).le + · rw [degree_mul_eq_bot_of_left + (b := q j) (degree_reverse_sub_eq_bot (hcPloc j))] + exact bot_le + · exact (degree_reverse_sub_lt (hEc j)).le + · obtain ⟨hyR, hycP⟩ := hout hyC + exact degree_translatedTruncLE_sub_sum_le_of_eq_bot + (R := R) (c := F.sum) (q := q) (y := y) (τ := τ) hyR hEc hycP + +open Classical in +/-- Discrete piece centres preserve strict local degree bounds when cofactors are summed. -/ +private theorem SeparatedHsumFamily.degree_le_of_discrete_centers + [NoMinOrder G] [NoMaxOrder G] + {J : Type x} {X : Type w} [LinearOrder X] (F : SeparatedHsumFamily J X) + (cp : X → J → Nonpositive G K) (τ : NatOrdinal.{u}) (Pg : J → NatOrdinal.{u}) + (bx : X → NatOrdinal.{u}) (Pl : X → J → NatOrdinal.{u}) + (hplaced : ∀ j x, F.term j x = setRestrict (F.piece x) + (translate (F.center x) (cp x j : HahnSeries G K))) + (hcp0 : ∀ x, bx x ≤ τ → ∀ j, cp x j = 0) + (hcpb : ∀ x j s, s ≤ 0 → ν (translatedTruncLE s (cp x j)) ≤ Pl x j) + (hPlt : ∀ x j, τ < bx x → Pl x j < Pg j) + (hdiscP : ∀ z : G, ¬ AccPt z (𝓟 (Set.range F.center))) : + ∀ j y, ν (translatedTruncLE y (F.sum j)) ≤ Pg j := by + classical + have hstageP : ∀ j x, + (((F.term j x).closedSupport).cantorBendixson (Pg j).val : Set G) ⊆ {F.center x} := by + intro j x + have he := cantorBendixson_restricted_translate_eq_empty (F.piece x) (F.center x) (cp x j) + (Pg j) (by + by_cases h : bx x ≤ τ + · exact Or.inl (hcp0 x h j) + · exact Or.inr ⟨Pl x j, hPlt x j (lt_of_not_ge h), hcpb x j⟩) + rw [hplaced j x, he] + exact Set.empty_subset _ + intro j y + have hbounds := cantorBendixsonRank_separatedHsum_bounds F.hX F.piece F.center (F.term j) + (F.support_subset j) (F.support_le_center j) F.center_mem F.isOpen_piece F.disjoint_piece + F.piece_lt_piece (F.separated j) hdiscP (Pg j).val (hstageP j) + rw [degree_translatedTruncLE_eq] + by_cases hm : y ∈ ((F.sum j : Nonpositive G K) : HahnSeries G K).closedSupport + · rw [ite_eq_left hm] + have hrank : ((F.sum j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank y ≤ + (Pg j).val := by + have hr := hbounds.1 y + have hreq : ((F.sum j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank y = + (separatedHsum F.hX (F.term j) (F.separated j)).cantorBendixsonRank y := by + rw [F.coe_sum j] + rw [hreq] + exact hr + calc ((NatOrdinal.of (((F.sum j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank y)) : + WithBot NatOrdinal) ≤ (NatOrdinal.of ((Pg j).val) : WithBot NatOrdinal) := + WithBot.coe_le_coe.mpr (NatOrdinal.of.monotone hrank) + _ = (Pg j : WithBot NatOrdinal) := by rw [NatOrdinal.of_val] + · rw [ite_eq_right hm] + exact bot_le + +/-- Adding a fixed generator degree reflects comparisons of cofactor degrees. -/ +private theorem cofactor_degree_mono {J : Type*} + (P : J → NatOrdinal.{u} → NatOrdinal.{u}) (σ : J → NatOrdinal.{u}) + {τ μ : NatOrdinal.{u}} (hP : ∀ j β, τ < β → β ≤ μ → P j β + σ j = β) + (j : J) (β' β'' : NatOrdinal.{u}) (h1 : τ < β') (h2 : β' ≤ β'') (h3 : β'' ≤ μ) : + P j β' ≤ P j β'' := by + have h : P j β' + σ j ≤ P j β'' + σ j := by + rw [hP j β' h1 (h2.trans h3), hP j β'' (h1.trans_le h2) h3] + exact h2 + exact le_of_add_le_add_right h + +/-- Strict stage comparisons remain strict after subtracting the same generator degree. -/ +private theorem cofactor_degree_lt {J : Type*} + (P : J → NatOrdinal.{u} → NatOrdinal.{u}) (σ : J → NatOrdinal.{u}) + {τ μ : NatOrdinal.{u}} (hP : ∀ j β, τ < β → β ≤ μ → P j β + σ j = β) + (j : J) (β' β'' : NatOrdinal.{u}) (h1 : τ < β') (h2 : β' < β'') (h3 : β'' ≤ μ) : + P j β' < P j β'' := by + have h : P j β' + σ j < P j β'' + σ j := by + rw [hP j β' h1 (h2.le.trans h3), hP j β'' (h1.trans h2) h3] + exact h2 + exact lt_of_add_lt_add_right h + open Classical in /-- **Cofactors by well-founded induction.** Fix representatives of homogeneous classes generating the associated graded ring below `α`, each satisfying its assigned degree and proper-truncation @@ -739,21 +1072,9 @@ theorem exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal hasLowerTruncationDegree_aeval hVbounds (hQ j) have hPle : ∀ j β', τ < β' → β' ≤ μ → P j β' ≤ μ := by intro j β' h1 h2 - have h0 : P j β' + 0 ≤ P j β' + σQ j := add_le_add le_rfl (zero_le (a := σQ j)) - rw [add_zero, hP j β' h1 h2] at h0 - exact h0.trans h2 - have hPmono : ∀ j β' β'', τ < β' → β' ≤ β'' → β'' ≤ μ → P j β' ≤ P j β'' := by - intro j β' β'' h1 h2 h3 - have e1 := hP j β' h1 (h2.trans h3) - have e2 := hP j β'' (h1.trans_le h2) h3 - have : P j β' + σQ j ≤ P j β'' + σQ j := by rw [e1, e2]; exact h2 - exact le_of_add_le_add_right this - have hPlt : ∀ j β' β'', τ < β' → β' < β'' → β'' ≤ μ → P j β' < P j β'' := by - intro j β' β'' h1 h2 h3 - have e1 := hP j β' h1 (h2.le.trans h3) - have e2 := hP j β'' (h1.trans h2) h3 - have : P j β' + σQ j < P j β'' + σQ j := by rw [e1, e2]; exact h2 - exact lt_of_add_lt_add_right this + exact (NatOrdinal.le_add_right.trans_eq (hP j β' h1 h2)).trans h2 + have hPmono := cofactor_degree_mono P σQ hP + have hPlt := cofactor_degree_lt P σQ hP have hPsep' : ∀ j β', τ < β' → β' ≤ μ → ∀ θ, θ < σQ j → P j β' + θ < τ := by intro j β' h1 h2 θ hθ exact (add_le_add (hPmono j β' μ h1 h2 le_rfl) le_rfl).trans_lt (hPsep j θ hθ) @@ -831,142 +1152,30 @@ theorem exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal rwa [show fx x = setRestrict (C x) (R : HahnSeries G K) from rfl, support_setRestrict] at hp exact hCmax x p ⟨(mem_closedSupport _ _).mpr (subset_closure hp'.1), hp'.2⟩ - have hsepx : ∀ i j : ↥Xset, i < j → - ∀ a ∈ (fx i).support, ∀ b ∈ (fx j).support, a < b := - fun i j hij a ha b hb ↦ hCord i j hij a (hfxC i ha) b (hfxC j hb) - have hRsum : (R : HahnSeries G K) = separatedHsum hXpwo fx hsepx := by - have hcov : (R : HahnSeries G K).support ⊆ ⋃ x : ↥Xset, C x := fun g hg ↦ - hCcov ((mem_closedSupport _ _).mpr (subset_closure hg)) - exact (separatedHsum_setRestrict_eq hXpwo C (R : HahnSeries G K) hcov - (fun i j hij ↦ hCdisj i j hij) - (fun i j hij a ha b hb ↦ hCord i j hij a ha b hb)).symm have hfx_shift : ∀ x : ↥Xset, (translate (-(x : G)) (fx x)).support ⊆ Iic 0 := by intro x rw [support_translate] rintro g ⟨p, hp, rfl⟩ have hpx := hfxle x p hp - have h3 : -(x : G) + p ≤ 0 := by - have h2 : -(x : G) + p ≤ -(x : G) + (x : G) := add_le_add le_rfl hpx - rwa [neg_add_cancel] at h2 - exact mem_Iic.mpr h3 + exact mem_Iic.mpr (by + simpa only [sub_eq_add_neg, add_comm] using (sub_nonpos.mpr hpx)) let ux : ↥Xset → Nonpositive G K := fun x ↦ ⟨translate (-(x : G)) (fx x), hfx_shift x⟩ let bx : ↥Xset → NatOrdinal.{u} := fun x ↦ NatOrdinal.of ((R : HahnSeries G K).cantorBendixsonRank (x : G)) - -- Locality of truncations inside a piece. - have hloc : ∀ (x : ↥Xset) (y' : G), y' ∈ C x → - ν (translatedTruncLE (y' - (x : G)) (ux x) - translatedTruncLE y' R) = ⊥ := by - intro x y' hy' - obtain ⟨cst, hcst, hcsty⟩ := exists_lt_mem_of_isOpen_ordConnected (hCopen x) hy' - have hdiff := support_truncLE_separatedHsum_sub_piece_subset hXpwo C fx hfxC hCord - hsepx x hy' hcst - apply (cantorBendixsonDegreeValuation_eq_bot_iff _).mpr - refine ⟨cst - y', sub_neg.mpr hcsty, ?_⟩ - intro g hg - have hcoe1 : ((translatedTruncLE (y' - (x : G)) (ux x) : Nonpositive G K) : - HahnSeries G K) = translate (-y') (truncLE y' (fx x)) := - translatedTruncLE_placed (x : G) y' (fx x) (hfx_shift x) - rw [AddSubgroupClass.coe_sub, hcoe1, coe_translatedTruncLE] at hg - have hcombine : translate (-y') (truncLE y' (fx x)) - - translate (-y') (truncLE y' (R : HahnSeries G K)) = - translate (-y') (truncLE y' (fx x) - truncLE y' (R : HahnSeries G K)) := - (map_sub (translate (-y')) _ _).symm - rw [hcombine, support_translate] at hg - obtain ⟨q, hq, rfl⟩ := hg - have hq' : q ∈ (truncLE y' (separatedHsum hXpwo fx hsepx) - - truncLE y' (fx x)).support := by - rw [← support_neg, neg_sub, ← hRsum] - exact hq - have hqc : q ≤ cst := hdiff hq' - have h3 : -y' + q ≤ cst - y' := by - have h2 : -y' + q ≤ -y' + cst := add_le_add le_rfl hqc - calc -y' + q ≤ -y' + cst := h2 - _ = cst - y' := by abel - exact mem_Iic.mpr h3 - have hplaced_eq : ∀ (x : ↥Xset) (s : G), - (translatedTruncLE s (ux x) : HahnSeries G K) = - translate (-((x : G) + s)) (truncLE ((x : G) + s) (fx x)) := by - intro x s - have h2 : ((x : G) + s) - (x : G) = s := by abel - have := translatedTruncLE_placed (x : G) ((x : G) + s) (fx x) (hfx_shift x) - rw [h2] at this - exact this - -- The translated degree profile of each piece. - have hux_prof : ∀ x : ↥Xset, ∀ s : G, s ≤ 0 → - ν (translatedTruncLE s (ux x)) ≤ (bx x : WithBot NatOrdinal) := by - intro x s hs - have hy'x : (x : G) + s ≤ (x : G) := by - calc (x : G) + s ≤ (x : G) + 0 := add_le_add le_rfl hs - _ = (x : G) := add_zero _ - by_cases hy'C : (x : G) + s ∈ C x - · have h1 := hloc x ((x : G) + s) hy'C - have h2 : ((x : G) + s) - (x : G) = s := by abel - rw [h2] at h1 - rw [degree_eq_of_degree_sub_eq_bot h1] - rw [degree_translatedTruncLE_eq] - by_cases hm : (x : G) + s ∈ (R : HahnSeries G K).closedSupport - · rw [ite_eq_left hm] - rcases eq_or_ne ((x : G) + s) (x : G) with heq | hne - · rw [heq] - · have hlt := hCrank x ((x : G) + s) ⟨hm, hy'C⟩ hne - have hlt' : (R : HahnSeries G K).cantorBendixsonRank ((x : G) + s) < - (R : HahnSeries G K).cantorBendixsonRank (x : G) := by - rw [cantorBendixsonRank_eq, cantorBendixsonRank_eq] - exact hlt - exact (WithBot.coe_le_coe.mpr (NatOrdinal.of.monotone hlt'.le)) - · rw [ite_eq_right hm] - exact bot_le - · have hbelow := lt_of_notMem_ordConnected (hCconv x) (hCmem x) hy'x hy'C - have hzero : truncLE ((x : G) + s) (fx x) = 0 := - truncLE_eq_zero_of_forall_lt _ _ (fun p hp ↦ hbelow p (hfxC x hp)) - have hzero' : translatedTruncLE s (ux x) = 0 := by - apply Subtype.ext - rw [hplaced_eq x s, hzero, map_zero] - rfl - rw [hzero', (ν).map_zero] - exact bot_le + have hpieceData (x : ↥Xset) := translated_convex_piece_local_data Q α τ R (ux x) + (x : G) (C x) (fx x) rfl rfl (hCopen x) (hCconv x) (hCmem x) + (fun y hy hne ↦ by + simpa only [cantorBendixsonRank_eq] using hCrank x y hy hne) + (bx x) rfl (fun y hy ↦ hpR y (hy.trans (hX0 x))) + have hloc := fun x ↦ (hpieceData x).2.1 + have hux_prof := fun x ↦ (hpieceData x).2.2.1 + have hpux := fun x ↦ (hpieceData x).2.2.2 have hbx_lt : ∀ x : ↥Xset, bx x < β := by intro x have h1 := hRdrop (x : G) (hX0 x) have hm : (x : G) ∈ (R : HahnSeries G K).closedSupport := hXs x.2 rw [degree_translatedTruncLE_eq, ite_eq_left hm] at h1 exact WithBot.coe_lt_coe.mp h1 - -- The local ideal condition for each piece. - have hpux : ∀ x : ↥Xset, ∀ s : G, s ≤ 0 → ∃ F : MvPolynomial ι K, - (∀ d ∈ F.support, (Finsupp.weight wt) d < α) ∧ - ν (translatedTruncLE s (ux x) - aeval V F) = ⊥ ∧ - MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q) := by - intro x s hs - have hy'0 : (x : G) + s ≤ 0 := by - calc (x : G) + s ≤ 0 + 0 := add_le_add (hX0 x) hs - _ = 0 := add_zero _ - by_cases hy'C : (x : G) + s ∈ C x - · obtain ⟨F, hFw, hFbot, hFGE⟩ := hpR ((x : G) + s) hy'0 - refine ⟨F, hFw, ?_, hFGE⟩ - have h1 := hloc x ((x : G) + s) hy'C - have h2 : ((x : G) + s) - (x : G) = s := by abel - rw [h2] at h1 - have hsplit : translatedTruncLE s (ux x) - aeval V F = - (translatedTruncLE s (ux x) - translatedTruncLE ((x : G) + s) R) + - (translatedTruncLE ((x : G) + s) R - aeval V F) := by - abel - rw [hsplit] - refine le_bot_iff.mp (((ν).map_add_le_max _ _).trans ?_) - rw [h1, hFbot, max_self] - · have hy'x : (x : G) + s ≤ (x : G) := by - calc (x : G) + s ≤ (x : G) + 0 := add_le_add le_rfl hs - _ = (x : G) := add_zero _ - have hbelow := lt_of_notMem_ordConnected (hCconv x) (hCmem x) hy'x hy'C - have hzero : truncLE ((x : G) + s) (fx x) = 0 := - truncLE_eq_zero_of_forall_lt _ _ (fun p hp ↦ hbelow p (hfxC x hp)) - have hzero' : translatedTruncLE s (ux x) = 0 := by - apply Subtype.ext - rw [hplaced_eq x s, hzero, map_zero] - rfl - refine ⟨0, by simp, ?_, ?_⟩ - · rw [hzero', map_zero, sub_zero, (ν).map_zero] - · rw [componentsGE_zero] - exact Ideal.zero_mem _ - -- Recurse on every piece. have hpiece : ∀ x : ↥Xset, ∃ cp : κ' → Nonpositive G K, (∀ j, ∀ s : G, s ≤ 0 → ν (translatedTruncLE s (cp j)) ≤ P j (bx x)) ∧ (bx x ≤ τ → ∀ j, cp j = 0) ∧ @@ -1020,84 +1229,12 @@ theorem exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal separated := hsepP sum := cP coe_sum := hcP_coe } - have hdiscP : ∀ z : G, ¬ AccPt z (𝓟 (Set.range (fun x : ↥Xset ↦ (x : G)))) := by - intro z - rw [Subtype.range_coe] - exact hXdisc z - have hplzero : ∀ j (x : ↥Xset), bx x ≤ τ → placed j x = 0 := by - intro j x hbxτ - rw [hplaced j x, hcp0 x hbxτ j] - rw [show ((0 : Nonpositive G K) : HahnSeries G K) = 0 from rfl, map_zero] - ext g - rw [coeff_setRestrict] - split_ifs <;> rfl - have hstageP : ∀ j (x : ↥Xset), - (((placed j x).closedSupport).cantorBendixson (P j β).val : Set G) ⊆ {(x : G)} := by - intro j x - by_cases hbxτ : bx x ≤ τ - · rw [hplzero j x hbxτ] - intro z hz - exfalso - have hzs := TopologicalSpace.Closeds.cantorBendixson_le _ _ hz - rw [mem_closedSupport, HahnSeries.support_zero, closure_empty] at hzs - exact hzs - · intro z hz - exfalso - obtain ⟨hzs, hzr⟩ := ((placed j x).mem_support_derivative_iff z (P j β).val).mp hz - have h1 : (placed j x).cantorBendixsonRank z ≤ - (translate (x : G) - ((cp x j : Nonpositive G K) : HahnSeries G K)).cantorBendixsonRank z := - cantorBendixsonRank_le_of_support_subset (by - rw [hplaced j x, support_setRestrict] - exact inter_subset_left) z - have h2 : (translate (x : G) ((cp x j : Nonpositive G K) : - HahnSeries G K)).cantorBendixsonRank z = - ((cp x j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank (z - (x : G)) := by - have := cantorBendixsonRank_translate ((cp x j : Nonpositive G K) : HahnSeries G K) - (x : G) (z - (x : G)) - rw [show (x : G) + (z - (x : G)) = z by abel] at this - exact this - have h3 : ((cp x j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank (z - (x : G)) ≤ - (P j (bx x)).val := by - by_cases hm : z - (x : G) ∈ - ((cp x j : Nonpositive G K) : HahnSeries G K).closedSupport - · have hz0 : z - (x : G) ≤ 0 := closure_minimal (cp x j).property isClosed_Iic - ((mem_closedSupport _ _).mp hm) - have hprof := hcpb x j (z - (x : G)) hz0 - rw [degree_translatedTruncLE_eq, ite_eq_left hm, WithBot.coe_le_coe] at hprof - have hval := NatOrdinal.of.symm.monotone hprof - change NatOrdinal.val (NatOrdinal.of _) ≤ NatOrdinal.val _ at hval - rwa [NatOrdinal.val_of] at hval - · rw [cantorBendixsonRank_eq, - TopologicalSpace.Closeds.cantorBendixsonRank_of_notMem _ _ hm] - exact zero_le (a := (P j (bx x)).val) - have h4 : (P j (bx x)).val < (P j β).val := by - have hlt := hPlt j (bx x) β (lt_of_not_ge hbxτ) (hbx_lt x) hβμ - have h := NatOrdinal.of.symm.strictMono hlt - change NatOrdinal.val _ < NatOrdinal.val _ at h - exact h - exact absurd hzr (not_le_of_gt (((h1.trans_eq h2).trans h3).trans_lt h4)) - have hcPb : ∀ j, ∀ y : G, y ≤ 0 → ν (translatedTruncLE y (cP j)) ≤ P j β := by - intro j y hy - have hbounds := cantorBendixsonRank_separatedHsum_bounds hXpwo C (fun x ↦ (x : G)) (placed j) - (hplC j) (hplle j) hCmem hCopen hCdisj hCord (hsepP j) hdiscP (P j β).val (hstageP j) - rw [degree_translatedTruncLE_eq] - by_cases hm : y ∈ ((cP j : Nonpositive G K) : HahnSeries G K).closedSupport - · rw [ite_eq_left hm] - have hrank : ((cP j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank y ≤ - (P j β).val := by - have hr := hbounds.1 y - have hreq : ((cP j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank y = - (separatedHsum hXpwo (placed j) (hsepP j)).cantorBendixsonRank y := by - rw [hcP_coe j] - rw [hreq] - exact hr - calc ((NatOrdinal.of (((cP j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank y)) : - WithBot NatOrdinal) ≤ (NatOrdinal.of ((P j β).val) : WithBot NatOrdinal) := - WithBot.coe_le_coe.mpr (NatOrdinal.of.monotone hrank) - _ = (P j β : WithBot NatOrdinal) := by rw [NatOrdinal.of_val] - · rw [ite_eq_right hm] - exact bot_le + have hcPb : ∀ j y, y ≤ 0 → ν (translatedTruncLE y (cP j)) ≤ P j β := by + intro j y _ + exact pieceFamily.degree_le_of_discrete_centers cp τ (fun j ↦ P j β) bx + (fun x j ↦ P j (bx x)) hplaced hcp0 hcpb + (fun x j h ↦ hPlt j (bx x) β h (hbx_lt x) hβμ) + (fun z ↦ by simpa only [pieceFamily, Subtype.range_coe] using hXdisc z) j y -- Step E: the final cofactors correct every truncation to the floor. refine ⟨fun j ↦ ctop j + cP j, ?_, ?_, ?_⟩ · intro j y hy @@ -1111,43 +1248,13 @@ theorem exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal rw [hR_def, Finset.sum_congr rfl fun j _ ↦ add_mul (ctop j) (cP j) (q j), Finset.sum_add_distrib] ring - rw [hres_eq, map_sub, map_sum] - have hEc : ∀ j, ν (translatedTruncLE y (cP j * q j) - - translatedTruncLE y (cP j) * q j) < (τ : WithBot NatOrdinal) := fun j ↦ - degree_translatedTruncLE_mul_sub_mul_lt_forall (cP j) (q j) - (P j β) (σQ j) τ (by simpa only [translatedTruncLE_zero] using hcPb j 0 le_rfl) - (fun z hz ↦ hcPb j z hz.le) (fun z hz ↦ (hW j).degree_translatedTruncLE_lt hz) - (hPsep' j β hτβ hβμ) y - by_cases hyC : ∃ x : ↥Xset, y ∈ C x - · obtain ⟨x, hyx⟩ := hyC - have hRloc := hloc x y hyx - have hcPloc : ∀ j, ν (translatedTruncLE y (cP j) - - translatedTruncLE (y - (x : G)) (cp x j)) = ⊥ := fun j ↦ - degree_translatedTruncLE_separatedHsum_sub_piece_eq_bot hXpwo C hCopen hCconv - (placed j) (hplC j) hCord (hsepP j) x (x : G) hyx (cp x j) (hplaced j x) - (cP j) (hcP_coe j) - have hEin (j : κ') := - degree_translatedTruncLE_mul_sub_mul_lt_of_eq_zero_or_bounds - (cp x j) (q j) (P j (bx x)) (σQ j) τ (bx x) - (fun h ↦ hcp0 x h j) - (by simpa only [translatedTruncLE_zero] using hcpb x j 0 le_rfl) - (fun z hz ↦ hcpb x j z hz.le) - (fun z hz ↦ (hW j).degree_translatedTruncLE_lt hz) - (fun h ↦ hPsep' j (bx x) h ((hbx_lt x).le.trans hβμ)) (y - (x : G)) - have hkey := translatedTruncLE_sub_sum_eq_local_errors y (y - (x : G)) R (ux x) - (cp x) cP q - rw [hkey] - apply degree_add_add_sum_le - · rw [degree_reverse_sub_eq_bot hRloc] - exact bot_le - · exact degree_translatedTruncLE_le_of_nonpositive (hcpres x) (y - (x : G)) - · intro j - apply degree_add_add_le (hEin j).le - · rw [degree_mul_eq_bot_of_left - (b := q j) (degree_reverse_sub_eq_bot (hcPloc j))] - exact bot_le - · exact (degree_reverse_sub_lt (hEc j)).le - · have hyR := degree_translatedTruncLE_eq_bot_of_notMem_closedSupport (b := R) (by + rw [hres_eq] + exact pieceFamily.degree_residual_le R ux cp q τ (fun j ↦ P j β) σQ bx + (fun x j ↦ P j (bx x)) hplaced hcp0 hcpb hcpres hcPb hW + (fun j ↦ hPsep' j β hτβ hβμ) + (fun x h j ↦ hPsep' j (bx x) h ((hbx_lt x).le.trans hβμ)) hloc y (by + intro hyC + have hyR := degree_translatedTruncLE_eq_bot_of_notMem_closedSupport (b := R) (by intro hm exact hyC (Set.mem_iUnion.mp (hCcov hm))) have hXclosed : closure Xset = Xset := @@ -1158,10 +1265,8 @@ theorem exists_cofactors_degree_translatedTruncLE_le_of_locallyIdeal notMem_closure_range_subtype_coe hXclosed hyX have hycP := pieceFamily.degree_translatedTruncLE_eq_bot_of_notMem hyPieces hyCenters - apply degree_translatedTruncLE_sub_sum_le_of_eq_bot - (G := G) (K := K) (J := κ') (R := R) (c := cP) - (q := q) (y := y) (τ := τ) hyR hEc - simpa only [pieceFamily] using hycP + exact ⟨hyR, by simpa only [pieceFamily] using hycP⟩) + open Classical in @@ -1329,18 +1434,8 @@ theorem exists_cofactors_degree_le_add_one_of_properly_locallyIdeal classical have hW : ∀ j, HasLowerTruncationDegree (aeval V (Q j)) (σQ j) := fun j ↦ hasLowerTruncationDegree_aeval hVbounds (hQ j) - have hPmono : ∀ j β' β'', τ < β' → β' ≤ β'' → β'' ≤ μ → P j β' ≤ P j β'' := by - intro j β' β'' h1 h2 h3 - have e1 := hP j β' h1 (h2.trans h3) - have e2 := hP j β'' (h1.trans_le h2) h3 - have : P j β' + σQ j ≤ P j β'' + σQ j := by rw [e1, e2]; exact h2 - exact le_of_add_le_add_right this - have hPlt : ∀ j β' β'', τ < β' → β' < β'' → β'' ≤ μ → P j β' < P j β'' := by - intro j β' β'' h1 h2 h3 - have e1 := hP j β' h1 (h2.le.trans h3) - have e2 := hP j β'' (h1.trans h2) h3 - have : P j β' + σQ j < P j β'' + σQ j := by rw [e1, e2]; exact h2 - exact lt_of_add_lt_add_right this + have hPmono := cofactor_degree_mono P σQ hP + have hPlt := cofactor_degree_lt P σQ hP have hPsep' : ∀ j β', τ < β' → β' ≤ μ → ∀ θ, θ < σQ j → P j β' + θ < τ := by intro j β' h1 h2 θ hθ exact (add_le_add (hPmono j β' μ h1 h2 le_rfl) le_rfl).trans_lt (hPsep j θ hθ) @@ -1370,9 +1465,6 @@ theorem exists_cofactors_degree_le_add_one_of_properly_locallyIdeal intro x p hp rw [hfx x, support_setRestrict] at hp exact hCmax x p ⟨(mem_closedSupport _ _).mpr (subset_closure hp.1), hp.2⟩ - have hsepx : ∀ i j : ↥Xset, i < j → - ∀ a ∈ (fx i).support, ∀ b ∈ (fx j).support, a < b := - fun i j hij a ha b hb ↦ hCord i j hij a (hfxC i ha) b (hfxC j hb) have hfx_shift : ∀ x : ↥Xset, (translate (-(x : G)) (fx x)).support ⊆ Iic 0 := by intro x rw [support_translate] @@ -1396,129 +1488,15 @@ theorem exists_cofactors_degree_le_add_one_of_properly_locallyIdeal rw [degree_translatedTruncLE_eq, ite_eq_left hm] at h1 rw [hbx x] exact WithBot.coe_lt_coe.mp h1 - have hRsum : ((u : Nonpositive G K) : HahnSeries G K) = 0 ∨ True := Or.inr trivial -- Locality of truncations inside a piece. - have hplaced_eq : ∀ (x : ↥Xset) (s : G), - ((translatedTruncLE s (ux x) : Nonpositive G K) : HahnSeries G K) = - translate (-((x : G) + s)) (truncLE ((x : G) + s) (fx x)) := by - intro x s - have h2 : ((x : G) + s) - (x : G) = s := by abel - have hshift : ((translatedTruncLE (((x : G) + s) - (x : G)) (ux x) : Nonpositive G K) : - HahnSeries G K) = translate (-((x : G) + s)) (truncLE ((x : G) + s) - (translate (x : G) ((ux x : Nonpositive G K) : HahnSeries G K))) := - translatedTruncLE_shift (x : G) ((x : G) + s) (ux x) - rw [h2] at hshift - have hcancel : translate (x : G) (translate (-(x : G)) (fx x)) = fx x := by - rw [translate_add_apply, add_neg_cancel, translate_zero_apply] - rw [hshift, hux x, hcancel] - have hloc : ∀ (x : ↥Xset) (y' : G), y' ∈ C x → - ν (translatedTruncLE (y' - (x : G)) (ux x) - translatedTruncLE y' u) = ⊥ := by - intro x y' hy' - obtain ⟨cst, hcst, hcsty⟩ := exists_lt_mem_of_isOpen_ordConnected (hCopen x) hy' - apply (cantorBendixsonDegreeValuation_eq_bot_iff _).mpr - refine ⟨cst - y', sub_neg.mpr hcsty, ?_⟩ - intro g hg - have hcoe1 : ((translatedTruncLE (y' - (x : G)) (ux x) : Nonpositive G K) : - HahnSeries G K) = translate (-y') (truncLE y' (fx x)) := by - have h2 : (x : G) + (y' - (x : G)) = y' := by abel - have := hplaced_eq x (y' - (x : G)) - rw [h2] at this - exact this - rw [AddSubgroupClass.coe_sub, hcoe1, coe_translatedTruncLE] at hg - have hcombine : translate (-y') (truncLE y' (fx x)) - - translate (-y') (truncLE y' ((u : Nonpositive G K) : HahnSeries G K)) = - translate (-y') (truncLE y' (fx x) - - truncLE y' ((u : Nonpositive G K) : HahnSeries G K)) := - (map_sub (translate (-y')) _ _).symm - rw [hcombine, support_translate] at hg - obtain ⟨q, hq, rfl⟩ := hg - have hb2 : ∀ p ∈ ((u : Nonpositive G K) : HahnSeries G K).support, p ∉ C x → - p ≤ y' → p ≤ cst := by - intro p _ hpC hpy - by_contra hgt - exact hpC ((hCconv x).out hcst hy' ⟨(not_le.mp hgt).le, hpy⟩) - have hq2 := support_truncLE_sub_truncLE_setRestrict_subset (C x) - ((u : Nonpositive G K) : HahnSeries G K) y' hb2 - have hqrev : q ∈ (truncLE y' ((u : Nonpositive G K) : HahnSeries G K) - - truncLE y' (setRestrict (C x) ((u : Nonpositive G K) : HahnSeries G K))).support := by - rw [← support_neg, neg_sub, ← hfx x] - exact hq - have hqc : q ≤ cst := hq2 hqrev - have h3 : -y' + q ≤ cst - y' := by - have h2 : -y' + q ≤ -y' + cst := add_le_add le_rfl hqc - calc -y' + q ≤ -y' + cst := h2 - _ = cst - y' := by abel - exact mem_Iic.mpr h3 - -- Degree profile and local ideal condition of each piece. - have hux_prof : ∀ x : ↥Xset, ∀ s : G, s ≤ 0 → - ν (translatedTruncLE s (ux x)) ≤ (bx x : WithBot NatOrdinal) := by - intro x s hs - have hy'x : (x : G) + s ≤ (x : G) := by - calc (x : G) + s ≤ (x : G) + 0 := add_le_add le_rfl hs - _ = (x : G) := add_zero _ - by_cases hy'C : (x : G) + s ∈ C x - · have h1 := hloc x ((x : G) + s) hy'C - have h2 : ((x : G) + s) - (x : G) = s := by abel - rw [h2] at h1 - rw [degree_eq_of_degree_sub_eq_bot h1, degree_translatedTruncLE_eq] - by_cases hm : (x : G) + s ∈ ((u : Nonpositive G K) : HahnSeries G K).closedSupport - · rw [ite_eq_left hm] - rcases eq_or_ne ((x : G) + s) (x : G) with heq | hne - · rw [heq, hbx x] - · have hlt := hCrank x ((x : G) + s) ⟨hm, hy'C⟩ hne - have hlt' : ((u : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank ((x : G) + s) < - ((u : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank (x : G) := by - rw [cantorBendixsonRank_eq, cantorBendixsonRank_eq] - exact hlt - rw [hbx x] - exact WithBot.coe_le_coe.mpr (NatOrdinal.of.monotone hlt'.le) - · rw [ite_eq_right hm] - exact bot_le - · have hbelow := lt_of_notMem_ordConnected (hCconv x) (hCmem x) hy'x hy'C - have hzero : truncLE ((x : G) + s) (fx x) = 0 := - truncLE_eq_zero_of_forall_lt _ _ (fun p hp ↦ hbelow p (hfxC x hp)) - have hzero' : translatedTruncLE s (ux x) = 0 := by - apply Subtype.ext - rw [hplaced_eq x s, hzero, map_zero] - rfl - rw [hzero', (ν).map_zero] - exact bot_le - have hpux : ∀ x : ↥Xset, ∀ s : G, s ≤ 0 → ∃ F : MvPolynomial ι K, - (∀ d ∈ F.support, (Finsupp.weight wt) d < α) ∧ - ν (translatedTruncLE s (ux x) - aeval V F) = ⊥ ∧ - MvPolynomial.componentsGE wt τ F ∈ Ideal.span (Set.range Q) := by - intro x s hs - have hy'neg : (x : G) + s < 0 := by - calc (x : G) + s ≤ (x : G) + 0 := add_le_add le_rfl hs - _ = (x : G) := add_zero _ - _ < 0 := hXneg x - by_cases hy'C : (x : G) + s ∈ C x - · obtain ⟨F, hFw, hFbot, hFGE⟩ := hp ((x : G) + s) hy'neg - refine ⟨F, hFw, ?_, hFGE⟩ - have h1 := hloc x ((x : G) + s) hy'C - have h2 : ((x : G) + s) - (x : G) = s := by abel - rw [h2] at h1 - have hsplit : translatedTruncLE s (ux x) - aeval V F = - (translatedTruncLE s (ux x) - translatedTruncLE ((x : G) + s) u) + - (translatedTruncLE ((x : G) + s) u - aeval V F) := by - abel - rw [hsplit] - refine le_bot_iff.mp (((ν).map_add_le_max _ _).trans ?_) - rw [h1, hFbot, max_self] - · have hy'x : (x : G) + s ≤ (x : G) := by - calc (x : G) + s ≤ (x : G) + 0 := add_le_add le_rfl hs - _ = (x : G) := add_zero _ - have hbelow := lt_of_notMem_ordConnected (hCconv x) (hCmem x) hy'x hy'C - have hzero : truncLE ((x : G) + s) (fx x) = 0 := - truncLE_eq_zero_of_forall_lt _ _ (fun p hp ↦ hbelow p (hfxC x hp)) - have hzero' : translatedTruncLE s (ux x) = 0 := by - apply Subtype.ext - rw [hplaced_eq x s, hzero, map_zero] - rfl - refine ⟨0, by simp, ?_, ?_⟩ - · rw [hzero', map_zero, sub_zero, (ν).map_zero] - · rw [componentsGE_zero] - exact Ideal.zero_mem _ + have hpieceData (x : ↥Xset) := translated_convex_piece_local_data Q α τ u (ux x) + (x : G) (C x) (fx x) (hfx x) (hux x) (hCopen x) (hCconv x) (hCmem x) + (fun y hy hne ↦ by + simpa only [cantorBendixsonRank_eq] using hCrank x y hy hne) + (bx x) (hbx x) (fun y hy ↦ hp y (hy.trans_lt (hXneg x))) + have hloc := fun x ↦ (hpieceData x).2.1 + have hux_prof := fun x ↦ (hpieceData x).2.2.1 + have hpux := fun x ↦ (hpieceData x).2.2.2 -- Construct cofactors on every piece by well-founded induction at its smaller rank. have hpiece : ∀ x : ↥Xset, ∃ cp : κ' → Nonpositive G K, (∀ j, ∀ s : G, s ≤ 0 → ν (translatedTruncLE s (cp j)) ≤ P j (bx x)) ∧ @@ -1579,51 +1557,12 @@ theorem exists_cofactors_degree_le_add_one_of_properly_locallyIdeal have hstageP : ∀ j (x : ↥Xset), (((placed j x).closedSupport).cantorBendixson (P j μ).val : Set G) = ∅ := by intro j x - apply Set.eq_empty_iff_forall_notMem.mpr - intro z hz - by_cases hbxτ : bx x ≤ τ - · have hzero : placed j x = 0 := by - rw [hplaced j x, hcp0 x hbxτ j] - rw [show ((0 : Nonpositive G K) : HahnSeries G K) = 0 from rfl, map_zero] - ext g - rw [coeff_setRestrict] - split_ifs <;> rfl - rw [hzero] at hz - have hzs := TopologicalSpace.Closeds.cantorBendixson_le _ _ hz - rw [mem_closedSupport, HahnSeries.support_zero, closure_empty] at hzs - exact hzs - · obtain ⟨hzs, hzr⟩ := ((placed j x).mem_support_derivative_iff z (P j μ).val).mp hz - have h1 : (placed j x).cantorBendixsonRank z ≤ - (translate (x : G) ((cp x j : Nonpositive G K) : HahnSeries G K)).cantorBendixsonRank z := - cantorBendixsonRank_le_of_support_subset (by - rw [hplaced j x, support_setRestrict] - exact inter_subset_left) z - have h2 : (translate (x : G) ((cp x j : Nonpositive G K) : - HahnSeries G K)).cantorBendixsonRank z = - ((cp x j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank (z - (x : G)) := by - have := cantorBendixsonRank_translate ((cp x j : Nonpositive G K) : HahnSeries G K) - (x : G) (z - (x : G)) - rw [show (x : G) + (z - (x : G)) = z by abel] at this - exact this - have h3 : ((cp x j : Nonpositive G K) : HahnSeries G K).cantorBendixsonRank (z - (x : G)) ≤ - (P j (bx x)).val := by - by_cases hm : z - (x : G) ∈ - ((cp x j : Nonpositive G K) : HahnSeries G K).closedSupport - · have hz0 : z - (x : G) ≤ 0 := closure_minimal (cp x j).property isClosed_Iic - ((mem_closedSupport _ _).mp hm) - have hprof := hcpb x j (z - (x : G)) hz0 - rw [degree_translatedTruncLE_eq, ite_eq_left hm, WithBot.coe_le_coe] at hprof - have hval := NatOrdinal.of.symm.monotone hprof - change NatOrdinal.val (NatOrdinal.of _) ≤ NatOrdinal.val _ at hval - rwa [NatOrdinal.val_of] at hval - · rw [cantorBendixsonRank_eq, TopologicalSpace.Closeds.cantorBendixsonRank_of_notMem _ _ hm] - exact zero_le (a := (P j (bx x)).val) - have h4 : (P j (bx x)).val < (P j μ).val := by - have hlt := hPlt j (bx x) μ (lt_of_not_ge hbxτ) (hbx_lt x) le_rfl - have h := NatOrdinal.of.symm.strictMono hlt - change NatOrdinal.val _ < NatOrdinal.val _ at h - exact h - exact absurd hzr (not_le_of_gt (((h1.trans_eq h2).trans h3).trans_lt h4)) + rw [hplaced j x] + exact cantorBendixson_restricted_translate_eq_empty (C x) (x : G) (cp x j) (P j μ) (by + by_cases h : bx x ≤ τ + · exact Or.inl (hcp0 x h j) + · exact Or.inr ⟨P j (bx x), hPlt j (bx x) μ (lt_of_not_ge h) (hbx_lt x) le_rfl, + hcpb x j⟩) have hclcen : closure (Set.range (fun x : ↥Xset ↦ (x : G))) ⊆ Set.range (fun x : ↥Xset ↦ (x : G)) ∪ {0} := by intro z hz @@ -1669,44 +1608,12 @@ theorem exists_cofactors_degree_le_add_one_of_properly_locallyIdeal have hres : ∀ y : G, y < 0 → ν (translatedTruncLE y (u - ∑ j, cP j * aeval V (Q j))) ≤ (τ : WithBot NatOrdinal) := by intro y hy - rw [map_sub, map_sum] - have hEc : ∀ j, ν (translatedTruncLE y (cP j * aeval V (Q j)) - - translatedTruncLE y (cP j) * aeval V (Q j)) < (τ : WithBot NatOrdinal) := fun j ↦ - degree_translatedTruncLE_mul_sub_mul_lt_forall (cP j) (aeval V (Q j)) - (P j μ) (σQ j) τ (hcPb j) - (fun z _ ↦ hcPbt j z) - (fun z hz ↦ (hW j).degree_translatedTruncLE_lt hz) - (hPsep' j μ hτμ le_rfl) y - by_cases hyC : ∃ x : ↥Xset, y ∈ C x - · obtain ⟨x, hyx⟩ := hyC - have hRloc := hloc x y hyx - have hcPloc : ∀ j, ν (translatedTruncLE y (cP j) - - translatedTruncLE (y - (x : G)) (cp x j)) = ⊥ := fun j ↦ - degree_translatedTruncLE_separatedHsum_sub_piece_eq_bot hXpwo C hCopen hCconv - (placed j) (hplC j) hCord (hsepP j) x (x : G) hyx (cp x j) (hplaced j x) - (cP j) (hcP_coe j) - have hEin (j : κ') := - degree_translatedTruncLE_mul_sub_mul_lt_of_eq_zero_or_bounds - (cp x j) (aeval V (Q j)) (P j (bx x)) (σQ j) τ (bx x) - (fun h ↦ hcp0 x h j) - (by simpa only [translatedTruncLE_zero] using hcpb x j 0 le_rfl) - (fun z hz ↦ hcpb x j z hz.le) - (fun z hz ↦ (hW j).degree_translatedTruncLE_lt hz) - (fun h ↦ hPsep' j (bx x) h (hbx_lt x).le) (y - (x : G)) - have hkey := translatedTruncLE_sub_sum_eq_local_errors y (y - (x : G)) u (ux x) - (cp x) cP (fun j ↦ aeval V (Q j)) - rw [hkey] - apply degree_add_add_sum_le - · rw [degree_reverse_sub_eq_bot hRloc] - exact bot_le - · exact degree_translatedTruncLE_le_of_nonpositive (hcpres x) (y - (x : G)) - · intro j - apply degree_add_add_le (hEin j).le - · rw [degree_mul_eq_bot_of_left - (b := aeval V (Q j)) (degree_reverse_sub_eq_bot (hcPloc j))] - exact bot_le - · exact (degree_reverse_sub_lt (hEc j)).le - · have hyu := degree_translatedTruncLE_eq_bot_of_notMem_closedSupport (b := u) (by + exact pieceFamily.degree_residual_le u ux cp (fun j ↦ aeval V (Q j)) τ + (fun j ↦ P j μ) σQ bx (fun x j ↦ P j (bx x)) hplaced hcp0 hcpb hcpres + (fun j s _ ↦ hcPbt j s) hW (fun j ↦ hPsep' j μ hτμ le_rfl) + (fun x h j ↦ hPsep' j (bx x) h (hbx_lt x).le) hloc y (by + intro hyC + have hyu := degree_translatedTruncLE_eq_bot_of_notMem_closedSupport (b := u) (by intro hm exact hyC (Set.mem_iUnion.mp (hCcov ⟨hm, hy⟩))) have hyPieces : ∀ x : ↥Xset, y ∉ C x := fun x hyx ↦ hyC ⟨x, hyx⟩ @@ -1718,10 +1625,7 @@ theorem exists_cofactors_degree_le_add_one_of_properly_locallyIdeal · exact absurd (Set.mem_singleton_iff.mp h') (ne_of_lt hy) have hycP := pieceFamily.degree_translatedTruncLE_eq_bot_of_notMem hyPieces hyCenters - apply degree_translatedTruncLE_sub_sum_le_of_eq_bot - (G := G) (K := K) (J := κ') (R := u) (c := cP) - (q := fun j ↦ aeval V (Q j)) (y := y) (τ := τ) hyu hEc - simpa only [pieceFamily] using hycP + exact ⟨hyu, by simpa only [pieceFamily] using hycP⟩) exact ⟨cP, hcPb, degree_le_add_one_of_forall_neg_le _ τ hres⟩ open Classical in diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/FiniteGermError.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/FiniteGermError.lean index 2d8c7cfb26..b0d2704628 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/FiniteGermError.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/FiniteGermError.lean @@ -267,7 +267,7 @@ theorem exists_closedClassRestrict_eq_zero_of_finset_mem_supp at one sufficiently late class from any cofinal family. -/ theorem exists_closedClassRestrict_fourFactor_eq [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] - [CompleteSpace G] [NoMinOrder G] [NoMaxOrder (FiniteArchimedeanClass G)] + [CompleteSpace G] [NoMaxOrder (FiniteArchimedeanClass G)] [NoZeroDivisors R] [CharZero R] {a b c d e f g h : Nonpositive G R} (ha : Ideal.Quotient.mk (cantorBendixsonValuation (G := G) (R := R)).supp a = @@ -304,7 +304,7 @@ theorem exists_closedClassRestrict_fourFactor_eq late closed-class restriction. -/ theorem exists_closedClassRestrict_refinement [UniformSpace G] [IsUniformAddGroup G] [OrderTopology G] [Nontrivial G] - [CompleteSpace G] [NoMinOrder G] [NoMaxOrder (FiniteArchimedeanClass G)] + [CompleteSpace G] [NoMaxOrder (FiniteArchimedeanClass G)] [NoZeroDivisors R] [CharZero R] (hrefine : HasFourFactorRefinement (Nonpositive G R ⧸ (cantorBendixsonValuation (G := G) (R := R)).supp)) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassRefinement.lean index 18d3c5bba9..95789f383a 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassRefinement.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement/SupportClassRefinement.lean @@ -97,7 +97,7 @@ private theorem exists_nonpositive_closed_class_refinement_of_complete_tail_quot [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] [Module ℚ G] [PosSMulMono ℚ G] [Field K] [CharZero K] - {κ : Cardinal} [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + {κ : Cardinal} [Fact (ℵ₀ < κ)] (T : Set (FiniteArchimedeanClass G)) [Nonempty T] (hT : ∀ c ∈ T, ∃ d ∈ T, c < d) [CompleteSpace (FiniteArchimedeanClass.TailQuotient T)] @@ -206,7 +206,7 @@ inside the cardinal-bounded Hahn integer part. -/ private theorem exists_integer_part_refinement_of_nonpositive_refinement {G : Type u} {K : Type v} [AddCommGroup G] [LinearOrder G] [IsOrderedAddMonoid G] - [Field K] {κ : Cardinal} [Fact (ℵ₀ < κ)] [Fact κ.IsRegular] + [Field K] {κ : Cardinal} [Fact (ℵ₀ < κ)] (S : Subring K) (U : Set (FiniteArchimedeanClass G)) (a b c d : HahnSeries.cardSuppLTTruncationIntegerPart (G := G) (R := K) (κ := κ) S) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPointExistence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPointExistence.lean index 0e0eb7183c..ab6c1b8089 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPointExistence.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/CriticalPointExistence.lean @@ -162,7 +162,7 @@ private theorem ordinalValue_le_of_ordinalValueDegree_le rw [← WithBot.coe_le_coe] exact haDegree.symm.trans_le (h.trans_eq hdDegree) -private theorem exists_maximal_translatedTruncation [CharZero K] +private theorem exists_maximal_translatedTruncation {b : Series K} (hb : b ≠ 0) : ∃ x : ℝ, x ≤ 0 ∧ ∀ y : ℝ, y ≤ 0 → @@ -216,7 +216,7 @@ private theorem exists_maximal_translatedTruncation [CharZero K] /-- Berarducci, Lemma 10.1 and Definition 10.2: every nonzero nonpositive real Hahn series has a critical point. -/ -theorem exists_isCriticalPoint [CharZero K] {b : Series K} (hb : b ≠ 0) : +theorem exists_isCriticalPoint {b : Series K} (hb : b ≠ 0) : ∃ x : ℝ, IsCriticalPoint b x := by obtain ⟨x, hx0, hxMax⟩ := exists_maximal_translatedTruncation hb let M : Set ℝ := {y | y ≤ 0 ∧ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ResidualPoint.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ResidualPoint.lean index a942b48483..f1feea92ca 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ResidualPoint.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements/ResidualPoint.lean @@ -73,7 +73,7 @@ theorem residualPointTail_eventually /-- Berarducci, Lemma 6.9: an eventual lower bound on values of translated truncations along `X(b)` gives the corresponding ordinary-product lower bound on `v_J(c)`. -/ -theorem ordinalValue_ge_of_eventually_ordinalValue_translatedTruncation_ge [CharZero K] +theorem ordinalValue_ge_of_eventually_ordinalValue_translatedTruncation_ge (b : SeriesWithOrdinalValueAboveOne K) (c : Series K) {ρ : Ordinal} (hρ : Ordinal.IsPrincipal (fun α β ↦ α + β) ρ) (hc : ∀ᶠ γ in nhdsWithin (0 : ℝ) (Set.Iio 0), diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFiniteSupport.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFiniteSupport.lean index f4b4a0422c..2cca44d744 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFiniteSupport.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/PrincipalSubringFiniteSupport.lean @@ -69,7 +69,7 @@ theorem extendedBinomial_negativeOne_coeff : extendedBinomial negativeOne = 1 := by rw [extendedBinomial, Berarducci.principalSubringFractionScalarExtension_coeff] - simp [sourceBinomial, negativeOne, + simp [sourceBinomial, negativeOne, HahnSeries.Nonpositive.finiteSupportCoefficients_apply] /-- The constant term survives coefficient extension. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/SubalgebraBasis.lean b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/SubalgebraBasis.lean index 229ba00394..31153978d3 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/SubalgebraBasis.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct/SubalgebraBasis.lean @@ -12,10 +12,10 @@ public import Mathlib.LinearAlgebra.Basis.Basic /-! # Base change of a basis over a subalgebra -Let `Ĝ` be a commutative `K`-algebra, `S ⊆ Ĝ` a `K`-subalgebra, and `B` an `S`-basis of `Ĝ`. -For any commutative `K`-algebra `L`, the elements `B i ⊗ 1` are a basis of `Ĝ ⊗[K] L` over the +Let `G` be a commutative `K`-algebra, `S ⊆ G` a `K`-subalgebra, and `B` an `S`-basis of `G`. +For any commutative `K`-algebra `L`, the elements `B i ⊗ 1` are a basis of `G ⊗[K] L` over the image of `S ⊗[K] L`: every element is uniquely a finite sum `∑ j(xᵢ) (B i ⊗ 1)` with -`xᵢ ∈ S ⊗[K] L`, where `j : S ⊗[K] L → Ĝ ⊗[K] L` is induced by the inclusion. +`xᵢ ∈ S ⊗[K] L`, where `j : S ⊗[K] L → G ⊗[K] L` is induced by the inclusion. -/ universe u v w x @@ -30,7 +30,7 @@ variable {K : Type u} {G : Type v} {L : Type w} {ι : Type x} variable [CommRing K] [CommRing G] [Algebra K G] [CommRing L] [Algebra K L] variable (S : Subalgebra K G) (B : Module.Basis ι S G) -/-- The inclusion `S ⊗[K] L → Ĝ ⊗[K] L`. -/ +/-- The inclusion `S ⊗[K] L → G ⊗[K] L`. -/ def tensorInclusion : S ⊗[K] L →ₐ[K] G ⊗[K] L := Algebra.TensorProduct.map S.val (AlgHom.id K L) @@ -51,7 +51,7 @@ theorem tensorInclusion_mul (x y : S ⊗[K] L) : variable [DecidableEq ι] -/-- The coordinate equivalence `Ĝ ⊗[K] L ≃ ι →₀ (S ⊗[K] L)` induced by the basis. -/ +/-- The coordinate equivalence `G ⊗[K] L ≃ ι →₀ (S ⊗[K] L)` induced by the basis. -/ def tensorBasisRepr : G ⊗[K] L ≃ₗ[K] ι →₀ (S ⊗[K] L) := (LinearEquiv.rTensor L (B.repr.restrictScalars K)) ≪≫ₗ TensorProduct.finsuppLeft K K S L ι @@ -97,7 +97,7 @@ theorem eq_zero_of_sum_tensorInclusion_mul_eq_zero (s : Finset ι) (x : ι → S exact h2 omit [DecidableEq ι] in -/-- Spanning: every element of `Ĝ ⊗[K] L` is a combination of the `B i ⊗ 1` over +/-- Spanning: every element of `G ⊗[K] L` is a combination of the `B i ⊗ 1` over `S ⊗[K] L`. -/ theorem exists_eq_sum_tensorInclusion_mul (g : G ⊗[K] L) : ∃ (s : Finset ι) (x : ι → S ⊗[K] L), diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnIntegerPartRefinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnIntegerPartRefinement.lean index d7b3e8bfa2..bdaef8b556 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnIntegerPartRefinement.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/HahnIntegerPartRefinement.lean @@ -44,7 +44,7 @@ uncountable, let `G` be a `κ`-saturated ordered rational vector space, and let characteristic zero. Every equality `a * b = c * d` in `ℤ + R((G^{<0}))_κ` has four-factor refinement. -/ abbrev HahnIntegerPartRefinement - [Module ℚ G] : Prop := + : Prop := ∀ (κ : Cardinal.{u}), ℵ₀ < κ → κ.IsRegular → IsKappaSaturated (G := G) κ → ∀ a b c d : HahnSeries G R, a ∈ integerHahnPart κ → b ∈ integerHahnPart κ → diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean index ff8b4df74b..27766d57e2 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean @@ -66,7 +66,8 @@ This file implements the two-element type of players (`Left`, `Right`), alongsid notational machinery to be used within game theory. -/ -@[expose] public section +@[expose] public +section universe u_inline_0 @@ -265,7 +266,8 @@ functor. universe u_inline_1 -@[expose] public section +@[expose] public +section /-! ### Game Functor -/ @@ -327,7 +329,8 @@ end GameFunctor universe u_inline_2 -public section +public +section open Set @@ -454,7 +457,8 @@ universe u_inline_4 open Set Pointwise -- Computations can be performed through the `game_cmp` tactic. -public noncomputable section +public noncomputable +section /-! ### Game moves -/ @@ -1624,7 +1628,8 @@ The `game_cmp` tactic supplies computation for short combinatorial games. universe u_inline_6 -@[expose] public section +@[expose] public +section namespace IGame @@ -1635,7 +1640,8 @@ elements of these sets are also numeric. The `Surreal` numbers are built as the quotient of numeric games under equivalence. -/ @[mk_iff numeric_def'] -class inductive Numeric : IGame → Prop where +class +inductive Numeric : IGame → Prop where | mk {x : IGame} : (∀ y ∈ xᴸ, ∀ z ∈ xᴿ, y < z) → (∀ p, ∀ y ∈ x.moves p, Numeric y) → Numeric x theorem numeric_def {x : IGame} : Numeric x ↔ @@ -1799,7 +1805,8 @@ there exist `x₁ ≈ x₂` and `y₁ ≈ y₂` with `x₁ * y₁ ≉ x₂ * y universe u_inline_7 -@[expose] public noncomputable section +@[expose] public noncomputable +section open IGame Set Pointwise @@ -2110,7 +2117,8 @@ surreals are a field. universe u_inline_8 -@[expose] public noncomputable section +@[expose] public noncomputable +section /-! ### Simplicity theorem -/ @@ -2853,7 +2861,8 @@ decreasing_by all_goals (try rw [moves_neg] at *); inline_igame_wf /-! ### Instances and corollaries -/ -public section +public +section namespace IGame.Numeric @@ -3030,7 +3039,8 @@ end IGame.Numeric end -public noncomputable section +public noncomputable +section universe u diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Basic.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Basic.lean index 01e335dff6..231cab8f3a 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Basic.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Basic.lean @@ -110,7 +110,7 @@ private theorem cutGame_add_cutGame_equiv {x y : IGame.{u}} abel_nf congr <;> simp -private theorem IsOmnificGame.add {x y : IGame.{u}} [IGame.Numeric x] [IGame.Numeric y] +private theorem IsOmnificGame.add {x y : IGame.{u}} (hx : IsOmnificGame x) (hy : IsOmnificGame y) : IsOmnificGame (x + y) := by exact (IGame.add_congr hx hy).trans (cutGame_add_cutGame_equiv hx hy) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Tests/SourceIndex.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Tests/SourceIndex.lean index 2d624abf15..1f815736ca 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Tests/SourceIndex.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Tests/SourceIndex.lean @@ -210,7 +210,7 @@ example := (@Berarducci.ordinalValue_mul : Berarducci.ordinalValue b * Berarducci.ordinalValue c) /- Berarducci, Lemma 10.1 and Definition 10.2. -/ -example := (@Berarducci.exists_isCriticalPoint : +example := ((fun {_} [_] [_] ↦ @Berarducci.exists_isCriticalPoint _ _) : ∀ {K : Type v} [Field K] [CharZero K] {b : Berarducci.Series K}, b ≠ 0 → ∃ x : ℝ, Berarducci.IsCriticalPoint b x) @@ -1266,7 +1266,8 @@ example := ((fun {_} [_] [_] b ↦ Berarducci.residualPointTail_eventually b) : IsLUB (Berarducci.residualPointTail b η) 0) /- Berarducci, Lemma 6.9, with the domain of `X(b)` and `v_J^p(b)` made explicit. -/ -example := (@Berarducci.ordinalValue_ge_of_eventually_ordinalValue_translatedTruncation_ge : +example := ((fun {_} [_] [_] ↦ + @Berarducci.ordinalValue_ge_of_eventually_ordinalValue_translatedTruncation_ge _ _) : ∀ {K : Type v} [Field K] [CharZero K] (b : Berarducci.SeriesWithOrdinalValueAboveOne K) (c : Berarducci.Series K) {ρ : Ordinal}, Ordinal.IsPrincipal (fun α β ↦ α + β) ρ → From c1d5bd8d7420c2791f567eb18147d713fc9370ed Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 02:32:17 +0000 Subject: [PATCH 12/18] Isolate Conway quotient games from existing pool games --- .../CombinatorialGames/Game/Basic.lean | 118 +++++++++--------- .../CombinatorialGames/Game/Birthday.lean | 39 +++--- .../CombinatorialGames/Game/Classes.lean | 2 +- .../CombinatorialGames/Game/Functor.lean | 4 +- .../CombinatorialGames/Game/IGame.lean | 12 +- .../CombinatorialGames/Game/Ordinal.lean | 26 ++-- .../CombinatorialGames/Surreal/Basic.lean | 24 ++-- .../Surreal/Birthday/Basic.lean | 4 +- .../CombinatorialGames/Surreal/Division.lean | 57 ++++----- .../CombinatorialGames/Surreal/Dyadic.lean | 10 +- .../Surreal/Multiplication.lean | 36 +++--- .../CombinatorialGames/Surreal/Real.lean | 33 ++--- .../Support/InlineConwayRefinementProof.lean | 23 ++-- .../Surreal/OmnificInteger/Basic.lean | 10 +- .../Surreal/OmnificInteger/Ordinal.lean | 4 +- .../ConwayRefinement/Surreal/Round.lean | 2 +- .../ConwayRefinement/Surreal/ZFC/Cuts.lean | 2 +- .../Surreal/ZFC/Tests/Cuts.lean | 2 +- 18 files changed, 213 insertions(+), 195 deletions(-) diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Basic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Basic.lean index e12ef51288..bf666a4dd5 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Basic.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Basic.lean @@ -41,35 +41,36 @@ larger game. This is the standard meaning of `x = y` in the literature, though i equality, e.g. `{0, 1 | 0}` and `{1 | 0}` are equivalent, but not identical as the former has an extra move for Left. -In particular, note that a `Game` has no well-defined notion of left and right options. This means +In particular, note that a `ConwayGame` has no well-defined notion of left and right options. +This means you should prefer `IGame` when analyzing specific games. -/ -def Game : Type (u + 1) := +def ConwayGame : Type (u + 1) := Antisymmetrization IGame (· ≤ ·) -namespace Game +namespace ConwayGame -/-- The quotient map from `IGame` into `Game`. -/ -def mk (x : IGame) : Game := Quotient.mk _ x +/-- The quotient map from `IGame` into `ConwayGame`. -/ +def mk (x : IGame) : ConwayGame := Quotient.mk _ x theorem mk_eq_mk {x y : IGame} : mk x = mk y ↔ x ≈ y := Quotient.eq alias ⟨_, mk_eq⟩ := mk_eq_mk @[cases_eliminator] -theorem ind {motive : Game → Prop} (mk : ∀ y, motive (mk y)) (x : Game) : motive x := +theorem ind {motive : ConwayGame → Prop} (mk : ∀ y, motive (mk y)) (x : ConwayGame) : motive x := Quotient.ind mk x /-- Choose an element of the equivalence class using the axiom of choice. -/ -@[no_expose] def out (x : Game) : IGame := Quotient.out x -@[simp] theorem out_eq (x : Game) : mk x.out = x := Quotient.out_eq x +@[no_expose] def out (x : ConwayGame) : IGame := Quotient.out x +@[simp] theorem out_eq (x : ConwayGame) : mk x.out = x := Quotient.out_eq x theorem mk_out_equiv (x : IGame) : (mk x).out ≈ x := Quotient.mk_out (s := AntisymmRel.setoid ..) x theorem equiv_mk_out (x : IGame) : x ≈ (mk x).out := (mk_out_equiv x).symm -/-- Construct a `Game` from its left and right sets. +/-- Construct a `ConwayGame` from its left and right sets. Note that although this function is well-defined, this function isn't injective, nor do equivalence -classes in `Game` have a canonical representative. -/ -instance : OfSets Game.{u} fun _ ↦ True where +classes in `ConwayGame` have a canonical representative. -/ +instance : OfSets ConwayGame.{u} fun _ ↦ True where ofSets st _ := mk !{fun p ↦ out '' (st p)} theorem mk_ofSets' (st : Player → Set IGame.{u}) [Small.{u} (st left)] [Small.{u} (st right)] : @@ -83,18 +84,18 @@ theorem mk_ofSets (s t : Set IGame.{u}) [Small.{u} s] [Small.{u} t] : rw [mk_ofSets'] simp_rw [Player.apply_cases] -private theorem ofSets_cases (s t : Set Game.{u}) [Small.{u} s] [Small.{u} t] : +private theorem ofSets_cases (s t : Set ConwayGame.{u}) [Small.{u} s] [Small.{u} t] : !{s | t} = mk !{out '' s | out '' t} := by simp [mk_ofSets, image_image] -instance : Zero Game := ⟨mk 0⟩ -instance : One Game := ⟨mk 1⟩ -instance : Add Game := ⟨Quotient.map₂ _ @add_congr⟩ -instance : Neg Game := ⟨Quotient.map _ @neg_congr⟩ -instance : PartialOrder Game := inferInstanceAs (PartialOrder (Antisymmetrization ..)) -instance : Inhabited Game := ⟨0⟩ +instance : Zero ConwayGame := ⟨mk 0⟩ +instance : One ConwayGame := ⟨mk 1⟩ +instance : Add ConwayGame := ⟨Quotient.map₂ _ @add_congr⟩ +instance : Neg ConwayGame := ⟨Quotient.map _ @neg_congr⟩ +instance : PartialOrder ConwayGame := inferInstanceAs (PartialOrder (Antisymmetrization ..)) +instance : Inhabited ConwayGame := ⟨0⟩ -instance : AddCommGroupWithOne Game where +instance : AddCommGroupWithOne ConwayGame where zero_add := by rintro ⟨x⟩; exact congr(mk $(zero_add _)) add_zero := by rintro ⟨x⟩; exact congr(mk $(add_zero _)) add_comm := by rintro ⟨x⟩ ⟨y⟩; exact congr(mk $(add_comm _ _)) @@ -103,10 +104,10 @@ instance : AddCommGroupWithOne Game where nsmul := nsmulRec zsmul := zsmulRec -instance : IsOrderedAddMonoid Game where +instance : IsOrderedAddMonoid ConwayGame where add_le_add_left := by rintro ⟨a⟩ ⟨b⟩ h ⟨c⟩; exact add_le_add_left (α := IGame) h _ -instance : RatCast Game where +instance : RatCast ConwayGame where ratCast q := mk q @[simp] theorem mk_zero : mk 0 = 0 := rfl @@ -133,19 +134,20 @@ theorem mk_intCast (n : ℤ) : mk n = n := by cases n <;> simp @[simp, norm_cast] theorem mk_ratCast (q : ℚ) : mk q = q := rfl -@[simp, norm_cast] theorem ratCast_neg (q : ℚ) : ((-q : ℚ) : Game) = -q := by simp [← mk_ratCast] +@[simp, norm_cast] theorem ratCast_neg (q : ℚ) : ((-q : ℚ) : ConwayGame) = -q := by + simp [← mk_ratCast] -theorem zero_def : (0 : Game) = !{fun _ ↦ ∅} := by apply (mk_ofSets' ..).trans; simp -theorem one_def : (1 : Game) = !{{0} | ∅} := by apply (mk_ofSets ..).trans; simp +theorem zero_def : (0 : ConwayGame) = !{fun _ ↦ ∅} := by apply (mk_ofSets' ..).trans; simp +theorem one_def : (1 : ConwayGame) = !{{0} | ∅} := by apply (mk_ofSets ..).trans; simp -instance : ZeroLEOneClass Game where +instance : ZeroLEOneClass ConwayGame where zero_le_one := zero_le_one (α := IGame) -instance : NeZero (1 : Game) where +instance : NeZero (1 : ConwayGame) where out := by apply ne_of_gt; exact IGame.zero_lt_one -instance : Nontrivial Game := ⟨_, _, zero_ne_one⟩ -instance : CharZero Game := AddMonoidWithOne.toCharZero +instance : Nontrivial ConwayGame := ⟨_, _, zero_ne_one⟩ +instance : CharZero ConwayGame := AddMonoidWithOne.toCharZero theorem mk_mul_add (x y z : IGame) : mk (x * (y + z)) = mk (x * y) + mk (x * z) := by rw [← mk_add, add_eq' (x * y), mul_eq'] @@ -198,68 +200,70 @@ theorem mk_mul_assoc (x y z : IGame) : mk (x * y * z) = mk (x * (y * z)) := by hx.elim (ihxl x) (ihxr x), hy.elim (ihyl y) (ihyr y), hz.elim (ihzl z) (ihzr z)] abel -theorem lf_ofSets_of_mem_left {s t : Set Game.{u}} [Small.{u} s] [Small.{u} t] {x : Game.{u}} +theorem lf_ofSets_of_mem_left {s t : Set ConwayGame.{u}} [Small.{u} s] [Small.{u} t] + {x : ConwayGame.{u}} (h : x ∈ s) : x ⧏ !{s | t} := by rw [ofSets_cases] have : x.out ∈ !{out '' s | out '' t}ᴸ := by simpa using mem_image_of_mem _ h simpa [← mk_le_mk] using left_lf this -theorem ofSets_lf_of_mem_right {s t : Set Game.{u}} [Small.{u} s] [Small.{u} t] {x : Game.{u}} +theorem ofSets_lf_of_mem_right {s t : Set ConwayGame.{u}} [Small.{u} s] [Small.{u} t] + {x : ConwayGame.{u}} (h : x ∈ t) : !{s | t} ⧏ x := by rw [ofSets_cases] have : x.out ∈ !{out '' s | out '' t}ᴿ := by simpa using mem_image_of_mem _ h simpa [← mk_le_mk] using lf_right this -end Game +end ConwayGame namespace IGame protected theorem sub_le_iff_le_add {x y z : IGame} : x - z ≤ y ↔ x ≤ y + z := - @sub_le_iff_le_add Game _ _ _ (.mk x) (.mk y) (.mk z) + @sub_le_iff_le_add ConwayGame _ _ _ (.mk x) (.mk y) (.mk z) protected theorem le_sub_iff_add_le {x y z : IGame} : x ≤ z - y ↔ x + y ≤ z := - @le_sub_iff_add_le Game _ _ _ (.mk x) (.mk y) (.mk z) + @le_sub_iff_add_le ConwayGame _ _ _ (.mk x) (.mk y) (.mk z) protected theorem sub_lt_iff_lt_add {x y z : IGame} : x - z < y ↔ x < y + z := - @sub_lt_iff_lt_add Game _ _ _ (.mk x) (.mk y) (.mk z) + @sub_lt_iff_lt_add ConwayGame _ _ _ (.mk x) (.mk y) (.mk z) protected theorem lt_sub_iff_add_lt {x y z : IGame} : x < z - y ↔ x + y < z := - @lt_sub_iff_add_lt Game _ _ _ (.mk x) (.mk y) (.mk z) + @lt_sub_iff_add_lt ConwayGame _ _ _ (.mk x) (.mk y) (.mk z) protected theorem sub_nonneg {x y : IGame} : 0 ≤ x - y ↔ y ≤ x := - @sub_nonneg Game _ _ _ (.mk x) (.mk y) + @sub_nonneg ConwayGame _ _ _ (.mk x) (.mk y) protected theorem sub_nonpos {x y : IGame} : x - y ≤ 0 ↔ x ≤ y := - @sub_nonpos Game _ _ _ (.mk x) (.mk y) + @sub_nonpos ConwayGame _ _ _ (.mk x) (.mk y) protected theorem sub_pos {x y : IGame} : 0 < x - y ↔ y < x := - @sub_pos Game _ _ _ (.mk x) (.mk y) + @sub_pos ConwayGame _ _ _ (.mk x) (.mk y) protected theorem sub_neg {x y : IGame} : x - y < 0 ↔ x < y := - @sub_neg Game _ _ _ (.mk x) (.mk y) + @sub_neg ConwayGame _ _ _ (.mk x) (.mk y) theorem mul_add_equiv (x y z : IGame) : x * (y + z) ≈ x * y + x * z := - Game.mk_eq_mk.1 (Game.mk_mul_add x y z) + ConwayGame.mk_eq_mk.1 (ConwayGame.mk_mul_add x y z) theorem mul_sub_equiv (x y z : IGame) : x * (y - z) ≈ x * y - x * z := - Game.mk_eq_mk.1 (Game.mk_mul_sub x y z) + ConwayGame.mk_eq_mk.1 (ConwayGame.mk_mul_sub x y z) theorem add_mul_equiv (x y z : IGame) : (x + y) * z ≈ x * z + y * z := - Game.mk_eq_mk.1 (Game.mk_add_mul x y z) + ConwayGame.mk_eq_mk.1 (ConwayGame.mk_add_mul x y z) theorem sub_mul_equiv (x y z : IGame) : (x - y) * z ≈ x * z - y * z := - Game.mk_eq_mk.1 (Game.mk_sub_mul x y z) + ConwayGame.mk_eq_mk.1 (ConwayGame.mk_sub_mul x y z) theorem mul_assoc_equiv (x y z : IGame) : x * y * z ≈ x * (y * z) := - Game.mk_eq_mk.1 (Game.mk_mul_assoc x y z) + ConwayGame.mk_eq_mk.1 (ConwayGame.mk_mul_assoc x y z) @[simp, norm_cast] theorem natCast_le {m n : ℕ} : (m : IGame) ≤ n ↔ m ≤ n := by - simp [← Game.mk_le_mk] + simp [← ConwayGame.mk_le_mk] @[simp, norm_cast] theorem natCast_lt {m n : ℕ} : (m : IGame) < n ↔ m < n := by - simp [← Game.mk_lt_mk] + simp [← ConwayGame.mk_lt_mk] @[simp] theorem natCast_nonneg (n : ℕ) : 0 ≤ (n : IGame) := @@ -277,11 +281,11 @@ theorem natCast_equiv {m n : ℕ} : (m : IGame) ≈ n ↔ m = n := by @[simp, norm_cast] theorem intCast_le {m n : ℤ} : (m : IGame) ≤ n ↔ m ≤ n := by - simp [← Game.mk_le_mk] + simp [← ConwayGame.mk_le_mk] @[simp, norm_cast] theorem intCast_lt {m n : ℤ} : (m : IGame) < n ↔ m < n := by - simp [← Game.mk_lt_mk] + simp [← ConwayGame.mk_lt_mk] theorem intCast_strictMono : StrictMono ((↑) : ℤ → IGame) := fun _ _ h ↦ intCast_lt.2 h @@ -295,10 +299,10 @@ theorem intCast_equiv {m n : ℤ} : (m : IGame) ≈ n ↔ m = n := by simp [AntisymmRel, le_antisymm_iff] theorem intCast_add_equiv (m n : ℤ) : ((m + n : ℤ) : IGame) ≈ m + n := by - simp [← Game.mk_eq_mk] + simp [← ConwayGame.mk_eq_mk] theorem intCast_sub_equiv (m n : ℤ) : ((m - n : ℤ) : IGame) ≈ m - n := by - simp [← Game.mk_eq_mk] + simp [← ConwayGame.mk_eq_mk] @[simp, norm_cast] theorem zero_lt_intCast {n : ℤ} : 0 < (n : IGame) ↔ 0 < n := by @@ -320,28 +324,30 @@ namespace Impartial variable (x y : IGame) [hx : Impartial x] [hy : Impartial y] @[simp] -theorem neg_mk : -Game.mk x = Game.mk x := - Game.mk_eq (equiv_neg x).symm +theorem neg_mk : -ConwayGame.mk x = ConwayGame.mk x := + ConwayGame.mk_eq (equiv_neg x).symm @[simp] -theorem sub_mk (x : Game) : x - Game.mk y = x + Game.mk y := by +theorem sub_mk (x : ConwayGame) : x - ConwayGame.mk y = x + ConwayGame.mk y := by rw [sub_eq_add_neg, neg_mk] @[simp] -theorem mk_add_self : Game.mk x + Game.mk x = 0 := by +theorem mk_add_self : ConwayGame.mk x + ConwayGame.mk x = 0 := by rw [add_eq_zero_iff_neg_eq, neg_mk] -- TODO: move these four lemmas earlier: theorem add_self_equiv (x : IGame) [Impartial x] : x + x ≈ 0 := - Game.mk_eq_mk.1 (mk_add_self x) + ConwayGame.mk_eq_mk.1 (mk_add_self x) variable {x y} omit hx in /-- This lemma doesn't require `x` to be impartial. -/ theorem equiv_iff_add_equiv_zero : x ≈ y ↔ x + y ≈ 0 := by - rw [← Game.mk_eq_mk, ← Game.mk_eq_mk, Game.mk_add, Game.mk_zero, add_eq_zero_iff_eq_neg, neg_mk] + rw [← ConwayGame.mk_eq_mk, ← ConwayGame.mk_eq_mk, + ConwayGame.mk_add, ConwayGame.mk_zero, + add_eq_zero_iff_eq_neg, neg_mk] omit hy in /-- This lemma doesn't require `y` to be impartial. -/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean index 0be5ad2472..9d47c78928 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Birthday.lean @@ -18,12 +18,13 @@ import Mathlib.Data.Set.Finite.Lattice There are two related but distinct notions of a birthday within combinatorial game theory. One is the birthday of an `IGame`, which represents the "step" at which it is constructed. We define it recursively as the least ordinal larger than the birthdays of its left and right options. On the -other hand, the birthday of a `Game` is the smallest birthday among all `IGame`s that quotient to +other hand, the birthday of a `ConwayGame` is the smallest birthday among all `IGame`s that +quotient to it. The birthday of an `IGame` can be understood as representing the depth of its game tree. Meanwhile, -the birthday of a `Game` more closely matches Conway's original description. The lemma -`Game.birthday_eq_iGameBirthday` links both definitions together. +the birthday of a `ConwayGame` more closely matches Conway's original description. The lemma +`ConwayGame.birthday_eq_iGameBirthday` links both definitions together. -/ universe u @@ -306,23 +307,23 @@ theorem Short.birthday_lt_omega0 (x : IGame) [Short x] : birthday x < of .omega0 end IGame -/-! ### `Game` birthday -/ +/-! ### `ConwayGame` birthday -/ -namespace Game +namespace ConwayGame /-- The birthday of a game is defined as the least birthday among all pre-games that define it. -/ -noncomputable def birthday (x : Game.{u}) : NatOrdinal.{u} := +noncomputable def birthday (x : ConwayGame.{u}) : NatOrdinal.{u} := sInf (IGame.birthday '' (mk ⁻¹' {x})) -theorem birthday_eq_iGameBirthday (x : Game) : - ∃ y : IGame, Game.mk y = x ∧ y.birthday = birthday x := by +theorem birthday_eq_iGameBirthday (x : ConwayGame) : + ∃ y : IGame, ConwayGame.mk y = x ∧ y.birthday = birthday x := by refine csInf_mem (image_nonempty.2 ?_) exact ⟨_, x.out_eq⟩ theorem birthday_mk_le (x : IGame) : birthday (mk x) ≤ x.birthday := csInf_le' ⟨x, rfl, rfl⟩ -theorem le_birthday_iff {x : Game} {o : NatOrdinal} : +theorem le_birthday_iff {x : ConwayGame} {o : NatOrdinal} : o ≤ x.birthday ↔ ∀ y, mk y = x → o ≤ y.birthday := ⟨fun hx y hy => hx.trans (hy ▸ (birthday_mk_le y)), fun h => (birthday_eq_iGameBirthday x).elim fun y hy => (h y hy.1).trans_eq hy.2⟩ @@ -332,27 +333,27 @@ theorem birthday_zero : birthday 0 = 0 := by simpa using birthday_mk_le 0 @[simp] -theorem birthday_eq_zero {x : Game} : birthday x = 0 ↔ x = 0 := by +theorem birthday_eq_zero {x : ConwayGame} : birthday x = 0 ↔ x = 0 := by obtain ⟨_, _, _⟩ := birthday_eq_iGameBirthday x refine ⟨fun _ ↦ ?_, ?_⟩ <;> simp_all -private theorem birthday_neg_le (x : Game) : (-x).birthday ≤ x.birthday := by +private theorem birthday_neg_le (x : ConwayGame) : (-x).birthday ≤ x.birthday := by obtain ⟨y, hy, hy'⟩ := birthday_eq_iGameBirthday x rw [← hy', ← hy] apply (birthday_mk_le _).trans rw [IGame.birthday_neg] @[simp] -theorem birthday_neg (x : Game) : (-x).birthday = x.birthday := by +theorem birthday_neg (x : ConwayGame) : (-x).birthday = x.birthday := by apply (birthday_neg_le x).antisymm simpa using birthday_neg_le (-x) -theorem le_toGame_birthday (x : Game) : x ≤ x.birthday.toGame := by +theorem le_toGame_birthday (x : ConwayGame) : x ≤ x.birthday.toGame := by obtain ⟨y, hy, hy'⟩ := birthday_eq_iGameBirthday x rw [← hy', ← hy] exact y.le_toIGame_birthday -theorem neg_toGame_birthday_le (x : Game) : -x.birthday.toGame ≤ x := by +theorem neg_toGame_birthday_le (x : ConwayGame) : -x.birthday.toGame ≤ x := by simpa [neg_le] using le_toGame_birthday (-x) @[simp] @@ -374,13 +375,13 @@ theorem birthday_one : birthday 1 = 1 := by simpa using birthday_natCast 1 @[simp] -theorem birthday_star : birthday (Game.mk ⋆) = 1 := by +theorem birthday_star : birthday (ConwayGame.mk ⋆) = 1 := by apply le_antisymm · simpa using birthday_mk_le ⋆ · rw [one_le_iff_ne_zero, birthday_eq_zero.ne] exact IncompRel.ne (r := (· ≤ ·)) IGame.star_fuzzy_zero -theorem birthday_ofSets_le {s t : Set Game.{u}} [Small.{u} s] [Small.{u} t] : +theorem birthday_ofSets_le {s t : Set ConwayGame.{u}} [Small.{u} s] [Small.{u} t] : birthday !{s | t} ≤ max (sSup (succ ∘ birthday '' s)) (sSup (succ ∘ birthday '' t)) := by choose f hf using birthday_eq_iGameBirthday trans !{f '' s | f '' t}.birthday @@ -390,13 +391,13 @@ theorem birthday_ofSets_le {s t : Set Game.{u}} [Small.{u} s] [Small.{u} t] : · simp_rw [IGame.birthday_ofSets, image_comp] congr! <;> aesop -theorem birthday_add_le (x y : Game) : (x + y).birthday ≤ x.birthday + y.birthday := by +theorem birthday_add_le (x y : ConwayGame) : (x + y).birthday ≤ x.birthday + y.birthday := by obtain ⟨a, ha, ha'⟩ := birthday_eq_iGameBirthday x obtain ⟨b, hb, hb'⟩ := birthday_eq_iGameBirthday y rw [← ha', ← hb', ← ha, ← hb, ← IGame.birthday_add] exact birthday_mk_le _ -theorem birthday_sub_le (x y : Game) : (x - y).birthday ≤ x.birthday + y.birthday := by +theorem birthday_sub_le (x y : ConwayGame) : (x - y).birthday ≤ x.birthday + y.birthday := by simpa [sub_eq_add_neg] using birthday_add_le x (-y) /-- Games with a bounded birthday form a small set. -/ @@ -417,5 +418,5 @@ instance small_subtype_birthday_le (o : NatOrdinal.{u}) : Small.{u} {x // birthd instance small_subtype_birthday_lt (o : NatOrdinal.{u}) : Small.{u} {x // birthday x < o} := small_setOf_birthday_lt o -end Game +end ConwayGame end diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean index 4fbcb45bfc..f16eb77e0f 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Classes.lean @@ -166,7 +166,7 @@ decreasing_by igame_wf protected instance sub (x y : IGame) [Impartial x] [Impartial y] : Impartial (x - y) := .add x (-y) -/-- The product instance is proven in `Game.Impartial.Grundy`. -/ +/-- The product instance is proven in `ConwayGame.Impartial.Grundy`. -/ theorem le_comm {x y} [Impartial x] [Impartial y] : x ≤ y ↔ y ≤ x := by rw [← IGame.neg_le_neg_iff, (neg_equiv y).le_congr (neg_equiv x)] diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Functor.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Functor.lean index e956fe5535..79fcb23f74 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Functor.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Functor.lean @@ -11,7 +11,7 @@ public import Mathlib.Data.QPF.Univariate.Basic import Mathlib.Logic.Small.Set /-! -# Game functor +# ConwayGame functor The type of games `IGame` is an inductive type, with a single constructor `ofSets` taking in two small sets of games (one for each player) and outputting a new game. This suggests the definition: @@ -42,7 +42,7 @@ universe u @[expose] public section -/-! ### Game Functor -/ +/-! ### ConwayGame Functor -/ /-- The functor from a type into the subtype of small pairs of sets in that type. diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean index 87965464f9..151c73a717 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/IGame.lean @@ -37,7 +37,8 @@ to express this on their own. See the docstring on `GameFunctor` for more inform We are also interested in further quotients of `IGame`. The quotient of games under equivalence `x ≈ y ↔ x ≤ y ∧ y ≤ x`, which in the literature is often what is meant by a "combinatorial game", -is defined as `Game` in `CombinatorialGames.Game.Basic`. The surreal numbers `Surreal` are defined +is defined as `ConwayGame` in `CombinatorialGames.Game.Basic`. The surreal numbers `Surreal` +are defined as a quotient (of a subtype) of games in `CombinatorialGames.Surreal.Basic`. ## Conway induction @@ -75,7 +76,7 @@ Most of the usual arithmetic operations can be defined for games. Addition is de `x = !{s₁ | t₁}` and `y = !{s₂ | t₂}` by `x + y = !{s₁ + y, x + s₂ | t₁ + y, x + t₂}`. Negation is defined by `-!{s | t} = !{-t | -s}`. -The order structures interact in the expected way with arithmetic. In particular, `Game` is an +The order structures interact in the expected way with arithmetic. In particular, `ConwayGame` is an `OrderedAddCommGroup`. Meanwhile, `IGame` satisfies the slightly weaker axioms of a `SubtractionCommMonoid`, since the equation `x - x = 0` is only true up to equivalence. -/ @@ -92,7 +93,7 @@ open Set Pointwise -- Computations can be performed through the `game_cmp` tactic. public noncomputable section -/-! ### Game moves -/ +/-! ### ConwayGame moves -/ /-- Well-founded games up to identity. @@ -102,7 +103,8 @@ exactly when their left and right sets of options are. This is not the same equivalence as used broadly in combinatorial game theory literature, as a game like `{0, 1 | 0}` is not *identical* to `{1 | 0}`, despite being equivalent. However, many theorems can be proven over the 'identical' equivalence relation, and the literature may occasionally -specifically use the 'identical' equivalence relation for this reason. The quotient `Game` of games +specifically use the 'identical' equivalence relation for this reason. The quotient +`ConwayGame` of games up to equality is defined in `CombinatorialGames.Game.Basic`. More precisely, `IGame` is the inductive type for the single constructor @@ -163,7 +165,7 @@ theorem ofSets_leftMoves_rightMoves (x : IGame) : !{xᴸ | xᴿ} = x := by /-- Two `IGame`s are equal when their move sets are. For the weaker but more common notion of equivalence where `x = y` if `x ≤ y` and `y ≤ x`, -use `Game`. -/ +use `ConwayGame`. -/ @[ext] theorem ext {x y : IGame.{u}} (h : ∀ p, x.moves p = y.moves p) : x = y := by diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Ordinal.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Ordinal.lean index c794ffa84c..99a5ea4000 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Ordinal.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Ordinal.lean @@ -27,7 +27,7 @@ We also prove some properties about `NatCast`, which is related to the previous # Main declarations - `NatOrdinal.toIGame`: The canonical map between `NatOrdinal` and `IGame`. -- `NatOrdinal.toGame`: The canonical map between `NatOrdinal` and `Game`. +- `NatOrdinal.toGame`: The canonical map between `NatOrdinal` and `ConwayGame`. -/ universe u @@ -136,23 +136,25 @@ theorem not_toIGame_fuzzy (a b : NatOrdinal) : ¬ toIGame a ‖ toIGame b := by theorem toIGame_nonneg (a : NatOrdinal) : 0 ≤ a.toIGame := by simpa using toIGame.monotone zero_le -/-! ### `NatOrdinal` to `Game` -/ +/-! ### `NatOrdinal` to `ConwayGame` -/ /-- Converts an ordinal into the corresponding game. -/ -noncomputable def toGame : NatOrdinal.{u} ↪o Game.{u} := +noncomputable def toGame : NatOrdinal.{u} ↪o ConwayGame.{u} := .ofStrictMono (fun o ↦ .mk o.toIGame) fun _ _ h ↦ toIGame.strictMono h -instance : Coe NatOrdinal Game where +instance : Coe NatOrdinal ConwayGame where coe x := toGame x -@[simp] theorem _root_.Game.mk_natOrdinal_toIGame (o : NatOrdinal) : .mk o.toIGame = o.toGame := rfl +@[simp] theorem _root_.ConwayGame.mk_natOrdinal_toIGame (o : NatOrdinal) : + .mk o.toIGame = o.toGame := + rfl theorem toGame_def (o : NatOrdinal) : o.toGame = !{toGame '' Iio o | ∅} := by - rw [← Game.mk_natOrdinal_toIGame, toIGame_def] + rw [← ConwayGame.mk_natOrdinal_toIGame, toIGame_def] simp [image_image] -@[simp] theorem toGame_zero : toGame 0 = 0 := by simp [← Game.mk_natOrdinal_toIGame] -@[simp] theorem toGame_one : toGame 1 = 1 := by simp [← Game.mk_natOrdinal_toIGame] +@[simp] theorem toGame_zero : toGame 0 = 0 := by simp [← ConwayGame.mk_natOrdinal_toIGame] +@[simp] theorem toGame_one : toGame 1 = 1 := by simp [← ConwayGame.mk_natOrdinal_toIGame] @[simp] theorem not_toGame_fuzzy (a b : NatOrdinal) : ¬ toGame a ‖ toGame b := @@ -180,7 +182,7 @@ termination_by (a, b) @[simp] theorem toGame_add (a b : NatOrdinal) : (a + b).toGame = a.toGame + b.toGame := - Game.mk_eq (toIGame_add a b) + ConwayGame.mk_eq (toIGame_add a b) /-- The natural multiplication of ordinals corresponds to their product as games. -/ theorem toIGame_mul (a b : NatOrdinal) : (a * b).toIGame ≈ a.toIGame * b.toIGame := by @@ -200,11 +202,11 @@ termination_by (a, b) @[simp] theorem toGame_mul (a b : NatOrdinal) : (a * b).toGame = .mk (a.toIGame * b.toIGame) := - Game.mk_eq (toIGame_mul a b) + ConwayGame.mk_eq (toIGame_mul a b) /-- `NatOrdinal.toGame` as an `OrderAddMonoidHom`. -/ @[simps] -def toGameAddHom : NatOrdinal →+o Game where +def toGameAddHom : NatOrdinal →+o ConwayGame where toFun := toGame map_zero' := toGame_zero map_add' := toGame_add @@ -218,7 +220,7 @@ theorem toGame_natCast : ∀ n : ℕ, toGame n = n := /-- Note that the equality doesn't hold, as e.g. `↑2 = {1 | }`, while `toIGame 2 = {0, 1 | }`. -/ theorem toIGame_natCast_equiv (n : ℕ) : toIGame n ≈ n := - Game.mk_eq_mk.1 (by simp) + ConwayGame.mk_eq_mk.1 (by simp) end NatOrdinal diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Basic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Basic.lean index 10c8264fc4..7e52b91077 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Basic.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Basic.lean @@ -128,7 +128,7 @@ def Surreal : Type (u + 1) := namespace Surreal -/-- The quotient map from the subtype of numeric `IGame`s into `Game`. -/ +/-- The quotient map from the subtype of numeric `IGame`s into `ConwayGame`. -/ def mk (x : IGame) [h : Numeric x] : Surreal := Quotient.mk _ ⟨x, h⟩ theorem mk_eq_mk {x y : IGame} [Numeric x] [Numeric y] : mk x = mk y ↔ x ≈ y := Quotient.eq @@ -207,13 +207,13 @@ instance : NeZero (1 : Surreal) where instance : Nontrivial Surreal := ⟨_, _, zero_ne_one⟩ -/-- Casts a `Surreal` number into a `Game`. -/ -def toGame : Surreal ↪o Game where - toFun := Quotient.lift (fun x ↦ .mk x) fun _ _ ↦ Game.mk_eq +/-- Casts a `Surreal` number into a `ConwayGame`. -/ +def toGame : Surreal ↪o ConwayGame where + toFun := Quotient.lift (fun x ↦ .mk x) fun _ _ ↦ ConwayGame.mk_eq inj' x y := by cases x; cases y; - change Game.mk _ = Game.mk _ → _ - simp [Game.mk_eq_mk, mk_eq_mk] + change ConwayGame.mk _ = ConwayGame.mk _ → _ + simp [ConwayGame.mk_eq_mk, mk_eq_mk] map_rel_iff' := by rintro ⟨_⟩ ⟨_⟩; rfl @[simp] theorem toGame_mk (x : IGame) [Numeric x] : toGame (mk x) = .mk x := rfl @@ -221,7 +221,7 @@ def toGame : Surreal ↪o Game where @[simp] theorem toGame_one : toGame 1 = 1 := rfl @[simp] -theorem gameMk_out (x : Surreal) : Game.mk x.out = x.toGame := by +theorem gameMk_out (x : Surreal) : ConwayGame.mk x.out = x.toGame := by conv_rhs => rw [← out_eq x, toGame_mk] theorem toGame_le_iff {a b : Surreal} : toGame a ≤ toGame b ↔ a ≤ b := by simp @@ -230,7 +230,7 @@ theorem toGame_inj {a b : Surreal} : toGame a = toGame b ↔ a = b := by simp /-- `Surreal.toGame` as an `OrderAddMonoidHom` -/ @[simps] -def toGameAddHom : Surreal →+o Game where +def toGameAddHom : Surreal →+o ConwayGame where toFun := toGame map_zero' := rfl map_add' := by rintro ⟨_⟩ ⟨_⟩; rfl @@ -269,7 +269,7 @@ theorem toGame_ofSets' (st : Player → Set Surreal.{u}) [Small.{u} (st left)] [ {H : ∀ x ∈ st left, ∀ y ∈ st right, x < y} : toGame !{st} = !{fun p ↦ toGame '' st p} := by change toGame (@mk _ (_)) = _ - simp_rw [toGame_mk, Game.mk_ofSets', Set.image_image, gameMk_out] + simp_rw [toGame_mk, ConwayGame.mk_ofSets', Set.image_image, gameMk_out] @[simp] theorem toGame_ofSets (s t : Set Surreal.{u}) [Small.{u} s] [Small.{u} t] @@ -284,7 +284,7 @@ theorem mk_ofSets' {st : Player → Set IGame.{u}} !{fun p ↦ .range fun x : st p ↦ mk x (h := H.of_mem_moves (p := p) (by simp))}' (by have := @H.left_lt_right; aesop) := by change _ = @mk _ (_) - simp_rw [← toGame_inj, toGame_mk, Game.mk_ofSets'] + simp_rw [← toGame_inj, toGame_mk, ConwayGame.mk_ofSets'] congr; aesop theorem mk_ofSets {s t : Set IGame.{u}} [Small.{u} s] [Small.{u} t] {H : Numeric !{s | t}} : @@ -300,14 +300,14 @@ theorem lt_ofSets_of_mem_left {s t : Set Surreal.{u}} [Small.{u} s] [Small.{u} t {H : ∀ x ∈ s, ∀ y ∈ t, x < y} {x : Surreal} (hx : x ∈ s) : x < !{s | t} := by rw [lt_iff_not_ge, ← toGame_le_iff, toGame_ofSets] - exact Game.lf_ofSets_of_mem_left (Set.mem_image_of_mem _ hx) + exact ConwayGame.lf_ofSets_of_mem_left (Set.mem_image_of_mem _ hx) @[aesop apply safe] theorem ofSets_lt_of_mem_right {s t : Set Surreal.{u}} [Small.{u} s] [Small.{u} t] {H : ∀ x ∈ s, ∀ y ∈ t, x < y} {x : Surreal} (hx : x ∈ t) : !{s | t} < x := by rw [lt_iff_not_ge, ← toGame_le_iff, toGame_ofSets] - exact Game.ofSets_lf_of_mem_right (Set.mem_image_of_mem _ hx) + exact ConwayGame.ofSets_lf_of_mem_right (Set.mem_image_of_mem _ hx) theorem zero_def : (0 : Surreal) = !{fun _ ↦ ∅} := by apply (mk_ofSets' ..).trans; congr!; simp theorem one_def : (1 : Surreal) = !{{0} | ∅} := by apply (mk_ofSets ..).trans; congr! <;> aesop diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Birthday/Basic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Birthday/Basic.lean index 337515b694..5cf9edfb11 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Birthday/Basic.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Birthday/Basic.lean @@ -102,7 +102,7 @@ theorem birthday_ofSets_le {s t : Set Surreal.{u}} obtain ⟨hy, _, _⟩ := hf y exact hy have : !{s | t} = mk !{f '' s | f '' t} := by - rw [← toGame_inj, toGame_ofSets, toGame_mk, Game.mk_ofSets] + rw [← toGame_inj, toGame_ofSets, toGame_mk, ConwayGame.mk_ofSets] simp_rw [image_image] congr! with a ha a ha all_goals @@ -129,7 +129,7 @@ proof_wanted birthday_mul_le (x y : Surreal) : (x * y).birthday ≤ x.birthday * theorem birthday_toGame_le (x : Surreal) : x.toGame.birthday ≤ x.birthday := by obtain ⟨c, _, rfl, h⟩ := birthday_eq_iGameBirthday x rw [← h, toGame_mk] - exact Game.birthday_mk_le c + exact ConwayGame.birthday_mk_le c /-- Surreals with a bounded birthday form a small set. -/ instance small_setOf_birthday_le (o : NatOrdinal.{u}) : Small.{u} {x | birthday x ≤ o} := by diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Division.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Division.lean index 417657a224..84d7c3a505 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Division.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Division.lean @@ -18,7 +18,8 @@ import Mathlib.Tactic.Ring # Surreal division In this file, we prove that if `x` is a positive numeric game, then `x⁻¹` (defined in -`Mathlib.SetTheory.Game.IGame`) is a number and is a multiplicative inverse for `x`. We use that +`CombinatorialGames.Game.IGame`) is a number and is a multiplicative inverse for `x`. We use +that to define the field structure on `Surreal`. This is Theorem 1.10 in ONAG, and we follow the broad strokes of the proof. We prove @@ -74,24 +75,24 @@ private lemma mulOption_self_inv (x : IGame) {y : IGame} (hy : y * y⁻¹ ≈ 1) private lemma mulOption_le (x y : IGame) {a b : IGame} [Numeric y] [Numeric a] [Numeric b] (ha : a ≤ 0) (hb : b ≤ y) : mulOption x y a b ≤ x * b := by - rw [mulOption, ← Game.mk_le_mk] + rw [mulOption, ← ConwayGame.mk_le_mk] dsimp - have : Game.mk (a * y) - Game.mk (a * b) ≤ 0 := by - rw [← Game.mk_mul_sub] + have : ConwayGame.mk (a * y) - ConwayGame.mk (a * b) ≤ 0 := by + rw [← ConwayGame.mk_mul_sub] apply Numeric.mul_nonpos_of_nonpos_of_nonneg ha rwa [IGame.sub_nonneg] - rw [← add_le_add_iff_left (Game.mk (x * b))] at this + rw [← add_le_add_iff_left (ConwayGame.mk (x * b))] at this convert this using 1 <;> abel private theorem le_mulOption (x y : IGame) {a b : IGame} [Numeric y] [Numeric a] [Numeric b] (ha : a ≤ 0) (hb : y ≤ b) : x * b ≤ mulOption x y a b := by - rw [mulOption, ← Game.mk_le_mk] + rw [mulOption, ← ConwayGame.mk_le_mk] dsimp - have : 0 ≤ Game.mk (a * y) - Game.mk (a * b) := by - rw [← Game.mk_mul_sub] + have : 0 ≤ ConwayGame.mk (a * y) - ConwayGame.mk (a * b) := by + rw [← ConwayGame.mk_mul_sub] apply Numeric.mul_nonneg_of_nonpos_of_nonpos ha rwa [IGame.sub_nonpos] - rw [← add_le_add_iff_left (Game.mk (x * b))] at this + rw [← add_le_add_iff_left (ConwayGame.mk (x * b))] at this convert this using 1 <;> abel /-! ### Inductive proof -/ @@ -306,7 +307,7 @@ theorem mk_ratCast (q : ℚ) : mk q = q := by @[simp] theorem toGame_ratCast (q : ℚ) : toGame q = q := by - rw [← mk_ratCast, toGame_mk, Game.mk_ratCast] + rw [← mk_ratCast, toGame_mk, ConwayGame.mk_ratCast] end Surreal @@ -478,53 +479,53 @@ theorem mk_half : Surreal.mk ½ = 2⁻¹ := by end IGame -namespace Game +namespace ConwayGame @[simp, norm_cast] -theorem ratCast_le {m n : ℚ} : (m : Game) ≤ n ↔ m ≤ n := +theorem ratCast_le {m n : ℚ} : (m : ConwayGame) ≤ n ↔ m ≤ n := IGame.ratCast_le @[simp, norm_cast] -theorem ratCast_lt {m n : ℚ} : (m : Game) < n ↔ m < n := +theorem ratCast_lt {m n : ℚ} : (m : ConwayGame) < n ↔ m < n := IGame.ratCast_lt -theorem ratCast_strictMono : StrictMono ((↑) : ℚ → Game) := +theorem ratCast_strictMono : StrictMono ((↑) : ℚ → ConwayGame) := fun _ _ h ↦ ratCast_lt.2 h @[simp, norm_cast] -theorem ratCast_inj {m n : ℚ} : (m : Game) = n ↔ m = n := +theorem ratCast_inj {m n : ℚ} : (m : ConwayGame) = n ↔ m = n := ratCast_strictMono.injective.eq_iff @[simp, norm_cast] -theorem ratCast_natCast (n : ℕ) : ((n : ℚ) : Game) = n := by - simpa using Game.mk_eq (IGame.ratCast_natCast_equiv n) +theorem ratCast_natCast (n : ℕ) : ((n : ℚ) : ConwayGame) = n := by + simpa using ConwayGame.mk_eq (IGame.ratCast_natCast_equiv n) @[simp, norm_cast] -theorem ratCast_intCast (n : ℤ) : ((n : ℚ) : Game) = n := by - simpa using Game.mk_eq (IGame.ratCast_intCast_equiv n) +theorem ratCast_intCast (n : ℤ) : ((n : ℚ) : ConwayGame) = n := by + simpa using ConwayGame.mk_eq (IGame.ratCast_intCast_equiv n) @[simp, norm_cast] -theorem ratCast_add (m n : ℚ) : ((m + n : ℚ) : Game) = m + n := - Game.mk_eq (IGame.ratCast_add_equiv m n) +theorem ratCast_add (m n : ℚ) : ((m + n : ℚ) : ConwayGame) = m + n := + ConwayGame.mk_eq (IGame.ratCast_add_equiv m n) @[simp, norm_cast] -theorem ratCast_sub (m n : ℚ) : ((m - n : ℚ) : Game) = m - n := - Game.mk_eq (IGame.ratCast_sub_equiv m n) +theorem ratCast_sub (m n : ℚ) : ((m - n : ℚ) : ConwayGame) = m - n := + ConwayGame.mk_eq (IGame.ratCast_sub_equiv m n) @[simp, norm_cast] -theorem zero_lt_ratCast {q : ℚ} : 0 < (q : Game) ↔ 0 < q := +theorem zero_lt_ratCast {q : ℚ} : 0 < (q : ConwayGame) ↔ 0 < q := IGame.zero_lt_ratCast @[simp, norm_cast] -theorem ratCast_lt_zero {q : ℚ} : (q : Game) < 0 ↔ q < 0 := +theorem ratCast_lt_zero {q : ℚ} : (q : ConwayGame) < 0 ↔ q < 0 := IGame.ratCast_lt_zero @[simp, norm_cast] -theorem zero_le_ratCast {q : ℚ} : 0 ≤ (q : Game) ↔ 0 ≤ q := +theorem zero_le_ratCast {q : ℚ} : 0 ≤ (q : ConwayGame) ↔ 0 ≤ q := IGame.zero_le_ratCast @[simp, norm_cast] -theorem ratCast_le_zero {q : ℚ} : (q : Game) ≤ 0 ↔ q ≤ 0 := +theorem ratCast_le_zero {q : ℚ} : (q : ConwayGame) ≤ 0 ↔ q ≤ 0 := IGame.ratCast_le_zero -end Game +end ConwayGame diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Dyadic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Dyadic.lean index 2efe08972a..7e83fe02ed 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Dyadic.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Dyadic.lean @@ -354,8 +354,8 @@ theorem toIGame_equiv (x : Dyadic) : (x : IGame) ≈ (x : ℚ) := by termination_by x.den @[simp] -theorem _root_.Game.mk_dyadic (x : Dyadic) : Game.mk x = x := - Game.mk_eq x.toIGame_equiv +theorem _root_.ConwayGame.mk_dyadic (x : Dyadic) : ConwayGame.mk x = x := + ConwayGame.mk_eq x.toIGame_equiv @[simp] theorem _root_.Surreal.mk_dyadic (x : Dyadic) : Surreal.mk x = x := by @@ -575,9 +575,9 @@ theorem toIGame_toDyadic_equiv (x : IGame) [Short x] [Numeric x] : (x.toDyadic : (equiv_toIGame_toDyadic x).symm @[simp] -theorem _root_.Game.ratCast_toDyadic (x : IGame) [Short x] [Numeric x] : - x.toDyadic = Game.mk x := by - simpa using Game.mk_eq (toIGame_toDyadic_equiv x) +theorem _root_.ConwayGame.ratCast_toDyadic (x : IGame) [Short x] [Numeric x] : + x.toDyadic = ConwayGame.mk x := by + simpa using ConwayGame.mk_eq (toIGame_toDyadic_equiv x) @[simp] theorem _root_.Surreal.ratCast_toDyadic (x : IGame) [Short x] [Numeric x] : diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean index 9896972938..1dde5da147 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Multiplication.lean @@ -46,13 +46,14 @@ hypotheses are invariant under the appropriate sign changes. In the P1 example, that one case (`mulOption_lt_of_lt`) is enough to conclude the others (`mulOption_lt`), and the same goes for the other parts of the proof. -Note also that we express all inequalities in terms of `Game` instead of `IGame`; this allows us to +Note also that we express all inequalities in terms of `ConwayGame` instead of `IGame`; this +allows us to make use of `abel` and all of the theorems on `OrderedAddCommGroup`. -/ universe u -open Game IGame Relation WellFounded +open ConwayGame IGame Relation WellFounded /-- A characterization of left moves of `x * y` in terms only of left moves. -/ private lemma forall_leftMoves_mul' {P : IGame → Prop} {x y : IGame} : @@ -74,16 +75,18 @@ private lemma forall_rightMoves_mul' {P : IGame → Prop} {x y : IGame} : /-- `P1 x y a b c d` means that `mulOption x y a b < mulOption x y c d`. This is the general form of the statements needed to prove that `x * y` is numeric. -/ -private def P1 (x y a b c d : IGame) := Game.mk (mulOption x y a b) < Game.mk (mulOption x y c d) +private def P1 (x y a b c d : IGame) := + ConwayGame.mk (mulOption x y a b) < ConwayGame.mk (mulOption x y c d) /-- `P2 x₁ x₂ y` states that if `x₁ ≈ x₂`, then `x₁ * y ≈ x₂ * y`. The RHS is stated in terms of -`Game.mk` for rewriting convenience. -/ -private def P2 (x₁ x₂ y : IGame) := x₁ ≈ x₂ → Game.mk (x₁ * y) = Game.mk (x₂ * y) +`ConwayGame.mk` for rewriting convenience. -/ +private def P2 (x₁ x₂ y : IGame) := x₁ ≈ x₂ → ConwayGame.mk (x₁ * y) = ConwayGame.mk (x₂ * y) /-- `P3 x₁ x₂ y₁ y₂` states that `x₁ * y₂ + x₂ * y₁ < x₁ * y₁ + x₂ * y₂`. Using distributivity, this is equivalent to `(x₁ - x₂) * (y₁ - y₂) > 0`. -/ private def P3 (x₁ x₂ y₁ y₂ : IGame) := - Game.mk (x₁ * y₂) + Game.mk (x₂ * y₁) < Game.mk (x₁ * y₁) + Game.mk (x₂ * y₂) + ConwayGame.mk (x₁ * y₂) + ConwayGame.mk (x₂ * y₁) < + ConwayGame.mk (x₁ * y₁) + ConwayGame.mk (x₂ * y₂) /-- `P4 x₁ x₂ y` states that if `x₁ < x₂`, then `P3 x₁ x₂ a y` when `a ∈ yᴸ`, and `P3 x₁ x₂ b y` when `b ∈ yᴿ`. @@ -105,11 +108,11 @@ private lemma P3_comm : P3 x₁ x₂ y₁ y₂ ↔ P3 y₁ y₂ x₁ x₂ := by simp [P3, add_comm, mul_comm] private lemma P3.trans (h₁ : P3 x₁ x₂ y₁ y₂) (h₂ : P3 x₂ x₃ y₁ y₂) : P3 x₁ x₃ y₁ y₂ := by - rw [P3, ← add_lt_add_iff_left (Game.mk (x₂ * y₁) + Game.mk (x₂ * y₂))] + rw [P3, ← add_lt_add_iff_left (ConwayGame.mk (x₂ * y₁) + ConwayGame.mk (x₂ * y₂))] convert add_lt_add h₁ h₂ using 1 <;> abel private lemma P3_neg : P3 (-x₂) (-x₁) y₁ y₂ ↔ P3 x₁ x₂ y₁ y₂ := by - simp_rw [P3, neg_mul, Game.mk_neg] + simp_rw [P3, neg_mul, ConwayGame.mk_neg] rw [← _root_.neg_lt_neg_iff] abel_nf @@ -247,18 +250,19 @@ private lemma P24_of_IH1 (ihxy : IH1 x y) (ha : a ∈ xᴸ) (hb : b ∈ xᴸ) : ihxy ha hb (Or.inl rfl) private lemma mulOption_lt_iff_P1 : - Game.mk (mulOption x y a b) < -Game.mk (mulOption x (-y) c d) ↔ P1 x y a b c (-d) := by + ConwayGame.mk (mulOption x y a b) < -ConwayGame.mk (mulOption x (-y) c d) ↔ + P1 x y a b c (-d) := by simp [P1, mulOption, sub_eq_add_neg, add_comm] private lemma mulOption_lt_of_lt [Numeric y] (ihxy : IH1 x y) (ihyx : IH1 y x) {a b c d} (h : a < c) (ha : a ∈ xᴸ) (hb : b ∈ yᴸ) (hc : c ∈ xᴸ) (hd : d ∈ (-y)ᴸ) : - Game.mk (mulOption x y a b) < -Game.mk (mulOption x (-y) c d) := by + ConwayGame.mk (mulOption x y a b) < -ConwayGame.mk (mulOption x (-y) c d) := by rw [mulOption_lt_iff_P1] exact P1_of_P3 (P3_of_IH1 ihyx hc hb hd) <| ((P24_of_IH1 ihxy ha hc).2 h).1 b hb private lemma mulOption_lt [Numeric x] [Numeric y] (ihxy : IH1 x y) (ihyx : IH1 y x) {a b c d} (ha : a ∈ xᴸ) (hb : b ∈ yᴸ) (hc : c ∈ xᴸ) (hd : d ∈ (-y)ᴸ) : - Game.mk (mulOption x y a b) < -Game.mk (mulOption x (-y) c d) := by + ConwayGame.mk (mulOption x y a b) < -ConwayGame.mk (mulOption x (-y) c d) := by numeric obtain (h | h | h) := Numeric.lt_or_equiv_or_gt a c · exact mulOption_lt_of_lt ihxy ihyx h ha hb hc hd @@ -354,7 +358,7 @@ private lemma IH4_neg : IH4 x₁ x₂ y → IH4 (-x₂) (-x₁) y ∧ IH4 x₁ x private lemma mulOption_lt_mul_of_equiv [Numeric x₁] (h : IH24 x₁ x₂ y) (he : x₁ ≈ x₂) (hi : a ∈ x₁ᴸ) (hj : b ∈ yᴸ) : - Game.mk (mulOption x₁ y a b) < Game.mk (x₂ * y) := by + ConwayGame.mk (mulOption x₁ y a b) < ConwayGame.mk (x₂ * y) := by convert sub_lt_iff_lt_add'.2 (((h.1 hi).2 _).1 b hj) using 1 · rw [← (h.2.2 hj).1 he] rfl @@ -365,7 +369,7 @@ private lemma mul_right_le_of_equiv [Numeric x₁] [Numeric x₂] (ih₁₂ : IH24 x₁ x₂ y) (ih₂₁ : IH24 x₂ x₁ y) (he : x₁ ≈ x₂) : x₁ * y ≤ x₂ * y := by have he' := neg_equiv_neg_iff.2 he rw [IGame.le_iff_forall_lf] - simp_rw [← Game.mk_le_mk] + simp_rw [← ConwayGame.mk_le_mk] constructor · rw [forall_leftMoves_mul'] constructor <;> intro a ha b hb @@ -385,7 +389,7 @@ private lemma P2_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) /-! ### P4 follows from the inductive hypothesis -/ private lemma mulOption_lt_mul_iff_P3 : mulOption x y a b < x * y ↔ P3 a x b y := - @sub_lt_iff_lt_add' Game _ _ _ (.mk _) (.mk _) (.mk _) + @sub_lt_iff_lt_add' ConwayGame _ _ _ (.mk _) (.mk _) (.mk _) /-- A specialization of the induction hypothesis used to prove `P3`. -/ private def IH3 (x₁ x' x₂ y₁ y₂ : IGame) : Prop := @@ -445,7 +449,7 @@ private theorem main (a : Args) : a.Numeric → P124 a := by | P24 x₁ x₂ y => obtain ⟨_, _, _⟩ := Args.numeric_P24.1 ha constructor - · exact (Game.mk_eq <| P2_of_IH ih ·) + · exact (ConwayGame.mk_eq <| P2_of_IH ih ·) · exact P4_of_IH ih private lemma main_P24 (x₁ x₂ y : IGame) [hx₁ : Numeric x₁] [hx₂ : Numeric x₂] [hy : Numeric y] : @@ -485,7 +489,7 @@ protected instance mulOption (x y a b : IGame) [Numeric x] [Numeric y] [Numeric .sub .. theorem mul_congr_left [Numeric x₁] [Numeric x₂] [Numeric y] (he : x₁ ≈ x₂) : x₁ * y ≈ x₂ * y := - Game.mk_eq_mk.1 ((main_P24 ..).1 he) + ConwayGame.mk_eq_mk.1 ((main_P24 ..).1 he) theorem mul_congr_right [Numeric x] [Numeric y₁] [Numeric y₂] (he : y₁ ≈ y₂) : x * y₁ ≈ x * y₂ := by rw [mul_comm, mul_comm x]; exact Numeric.mul_congr_left he diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Real.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Real.lean index 3fbf791196..0577c1e65d 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Real.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Real.lean @@ -13,7 +13,8 @@ public import Mathlib.Algebra.Order.Hom.Ring # Real numbers as games We define the function `Real.toIGame`, casting a real number to its Dedekind cut, and prove that -it's an order embedding. We then define the `Game` and `Surreal` versions of this map, and prove +it's an order embedding. We then define the `ConwayGame` and `Surreal` versions of this map, +and prove that they are ring and field homomorphisms respectively. ## TODO @@ -276,44 +277,44 @@ theorem toIGame_dyadic_sub_equiv (q : Dyadic) (x : ℝ) : toIGame (q.toRat - x) theorem toIGame_sub_equiv (x y : ℝ) : toIGame (x - y) ≈ x - y := by simpa [sub_eq_add_neg] using toIGame_add_equiv x (-y) -/-! ### `ℝ` to `Game` -/ +/-! ### `ℝ` to `ConwayGame` -/ -/-- The canonical map from `ℝ` to `Game`, sending a real number to its Dedekind cut. -/ -@[coe, match_pattern] def toGame (x : ℝ) : Game := .mk x +/-- The canonical map from `ℝ` to `ConwayGame`, sending a real number to its Dedekind cut. -/ +@[coe, match_pattern] def toGame (x : ℝ) : ConwayGame := .mk x -instance : Coe ℝ Game := ⟨toGame⟩ +instance : Coe ℝ ConwayGame := ⟨toGame⟩ -@[simp] theorem _root_.Game.mk_real_toIGame (x : ℝ) : .mk x.toIGame = x.toGame := rfl +@[simp] theorem _root_.ConwayGame.mk_real_toIGame (x : ℝ) : .mk x.toIGame = x.toGame := rfl theorem toGame_def (x : ℝ) : toGame x = !{(fun q => q.toRat) '' {q : Dyadic | q.toRat < x} | (fun q => q.toRat) '' {q : Dyadic | x < q.toRat}} := by - rw [← Game.mk_real_toIGame, toIGame] + rw [← ConwayGame.mk_real_toIGame, toIGame] simp [Set.image_image] /-- `Real.toGame` as an `OrderEmbedding`. -/ @[simps!] -def toGameEmbedding : ℝ ↪o Game := +def toGameEmbedding : ℝ ↪o ConwayGame := .ofStrictMono toGame fun _ _ h ↦ toIGameEmbedding.strictMono h @[simp, norm_cast] -theorem toGame_le_iff {x y : ℝ} : (x : Game) ≤ y ↔ x ≤ y := +theorem toGame_le_iff {x y : ℝ} : (x : ConwayGame) ≤ y ↔ x ≤ y := toGameEmbedding.le_iff_le @[simp, norm_cast] -theorem toGame_lt_iff {x y : ℝ} : (x : Game) < y ↔ x < y := +theorem toGame_lt_iff {x y : ℝ} : (x : ConwayGame) < y ↔ x < y := toGameEmbedding.lt_iff_lt @[norm_cast] -theorem toGame_equiv_iff {x y : ℝ} : (x : Game) ≈ y ↔ x = y := by +theorem toGame_equiv_iff {x y : ℝ} : (x : ConwayGame) ≈ y ↔ x = y := by simp [AntisymmRel, le_antisymm_iff] @[simp, norm_cast] -theorem toGame_inj {x y : ℝ} : (x : Game) = y ↔ x = y := +theorem toGame_inj {x y : ℝ} : (x : ConwayGame) = y ↔ x = y := toGameEmbedding.inj @[simp, norm_cast] -theorem toGame_ratCast (q : ℚ) : toGame q = q := Game.mk_eq (toIGame_ratCast_equiv q) +theorem toGame_ratCast (q : ℚ) : toGame q = q := ConwayGame.mk_eq (toIGame_ratCast_equiv q) @[simp, norm_cast] theorem toGame_natCast (n : ℕ) : toGame n = n := by simpa using toGame_ratCast n @@ -326,15 +327,15 @@ theorem toGame_intCast (n : ℤ) : toGame n = n := by simpa using toGame_ratCast @[simp] theorem toGame_add (x y : ℝ) : toGame (x + y) = toGame x + toGame y := by - simpa using Game.mk_eq (toIGame_add_equiv x y) + simpa using ConwayGame.mk_eq (toIGame_add_equiv x y) @[simp] theorem toGame_sub (x y : ℝ) : toGame (x - y) = toGame x - toGame y := by - simpa using Game.mk_eq (toIGame_sub_equiv x y) + simpa using ConwayGame.mk_eq (toIGame_sub_equiv x y) /-- `Real.toGame` as an `OrderAddMonoidHom`. -/ @[simps] -def toGameAddHom : ℝ →+o Game where +def toGameAddHom : ℝ →+o ConwayGame where toFun := toGame map_zero' := toGame_zero map_add' := toGame_add diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean index f028d8a427..2edc6384f0 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean @@ -707,8 +707,8 @@ abbrev SupportSurreal := ConwayRefinement.Standalone.InlineSurreal.Surreal abbrev SupportQuotientGame := ConwayRefinement.Standalone.InlineSurreal.Game /-- Convert an auxiliary quotient game to the CombinatorialGames quotient. -/ -noncomputable def gameToCG (x : SupportQuotientGame.{u}) : _root_.Game.{u} := - _root_.Game.mk (toCG x.out) +noncomputable def gameToCG (x : SupportQuotientGame.{u}) : _root_.ConwayGame.{u} := + _root_.ConwayGame.mk (toCG x.out) /-- Convert a surreal number from the auxiliary model to the CombinatorialGames model. -/ noncomputable def surrealToCG (x : SupportSurreal.{u}) : _root_.Surreal.{u} := @@ -724,15 +724,16 @@ theorem toCG_equiv (x y : SupportGame.{u}) : rw [toCG_le, toCG_le] theorem gameToCG_mk (x : SupportGame.{u}) : - gameToCG (ConwayRefinement.Standalone.InlineSurreal.Game.mk x) = _root_.Game.mk (toCG x) := by - rw [gameToCG, _root_.Game.mk_eq_mk] + gameToCG (ConwayRefinement.Standalone.InlineSurreal.Game.mk x) = + _root_.ConwayGame.mk (toCG x) := by + rw [gameToCG, _root_.ConwayGame.mk_eq_mk] apply toCG_equiv _ _ |>.mp exact ConwayRefinement.Standalone.InlineSurreal.Game.mk_out_equiv x theorem gameToCG_singletonCut (l r : SupportQuotientGame.{u}) : gameToCG !{{l} | {r}} = !{{gameToCG l} | {gameToCG r}} := by rw [gameToCG] - apply _root_.Game.mk_eq + apply _root_.ConwayGame.mk_eq let sraw : SupportGame.{u} := ConwayRefinement.Standalone.InlineSurreal.OfSets.ofSets (ConwayRefinement.Standalone.InlineSurreal.Player.cases {l.out} {r.out}) trivial @@ -757,9 +758,9 @@ theorem gameToCG_singletonCut (l r : SupportQuotientGame.{u}) : rw [moves_toCG] cases p <;> simp [sraw, playerToSupport] have htarget : - toCG sraw ≤ !{fun p ↦ _root_.Game.out '' + toCG sraw ≤ !{fun p ↦ _root_.ConwayGame.out '' _root_.Player.cases {gameToCG l} {gameToCG r} p} ∧ - !{fun p ↦ _root_.Game.out '' + !{fun p ↦ _root_.ConwayGame.out '' _root_.Player.cases {gameToCG l} {gameToCG r} p} ≤ toCG sraw := by rw [hraw] apply _root_.IGame.equiv_of_exists <;> @@ -768,19 +769,19 @@ theorem gameToCG_singletonCut (l r : SupportQuotientGame.{u}) : · intro a ha subst a exact ⟨(gameToCG l).out, ⟨gameToCG l, rfl, rfl⟩, - (_root_.Game.mk_out_equiv (toCG l.out)).symm⟩ + (_root_.ConwayGame.mk_out_equiv (toCG l.out)).symm⟩ · intro a ha subst a exact ⟨(gameToCG r).out, ⟨gameToCG r, rfl, rfl⟩, - (_root_.Game.mk_out_equiv (toCG r.out)).symm⟩ + (_root_.ConwayGame.mk_out_equiv (toCG r.out)).symm⟩ · intro b hb obtain ⟨l', hl', rfl⟩ := hb subst l' - exact ⟨toCG l.out, rfl, (_root_.Game.mk_out_equiv (toCG l.out)).symm⟩ + exact ⟨toCG l.out, rfl, (_root_.ConwayGame.mk_out_equiv (toCG l.out)).symm⟩ · intro b hb obtain ⟨r', hr', rfl⟩ := hb subst r' - exact ⟨toCG r.out, rfl, (_root_.Game.mk_out_equiv (toCG r.out)).symm⟩ + exact ⟨toCG r.out, rfl, (_root_.ConwayGame.mk_out_equiv (toCG r.out)).symm⟩ exact ⟨hout.1.trans htarget.1, htarget.2.trans hout.2⟩ theorem surrealToCG_mk (x : SupportGame.{u}) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Basic.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Basic.lean index 231cab8f3a..4b30101c4b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Basic.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Basic.lean @@ -101,12 +101,12 @@ private theorem IsOmnificGame.neg {x : IGame.{u}} (hx : IsOmnificGame x) : private theorem cutGame_add_cutGame_equiv {x y : IGame.{u}} (hx : IsOmnificGame x) (hy : IsOmnificGame y) : cutGame x + cutGame y ≈ cutGame (x + y) := by - have hx' : Game.mk !{{x - 1} | {x + 1}} = Game.mk x := (Game.mk_eq hx).symm - have hy' : Game.mk !{{y - 1} | {y + 1}} = Game.mk y := (Game.mk_eq hy).symm - apply Game.mk_eq_mk.mp - simp only [cutGame, IGame.ofSets_add_ofSets, Game.mk_ofSets, Set.image_union, + have hx' : ConwayGame.mk !{{x - 1} | {x + 1}} = ConwayGame.mk x := (ConwayGame.mk_eq hx).symm + have hy' : ConwayGame.mk !{{y - 1} | {y + 1}} = ConwayGame.mk y := (ConwayGame.mk_eq hy).symm + apply ConwayGame.mk_eq_mk.mp + simp only [cutGame, IGame.ofSets_add_ofSets, ConwayGame.mk_ofSets, Set.image_union, Set.image_singleton] - simp only [Game.mk_add, Game.mk_sub, Game.mk_one, hx', hy'] + simp only [ConwayGame.mk_add, ConwayGame.mk_sub, ConwayGame.mk_one, hx', hy'] abel_nf congr <;> simp diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Ordinal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Ordinal.lean index 30064dca53..ce04c141a7 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Ordinal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Ordinal.lean @@ -28,8 +28,8 @@ namespace NatOrdinal private theorem toIGame_le_sub_one_of_lt {a o : NatOrdinal.{u}} (hao : a < o) : a.toIGame ≤ o.toIGame - 1 := by - rw [← Game.mk_le_mk] - simp only [Game.mk_sub, Game.mk_one, Game.mk_natOrdinal_toIGame] + rw [← ConwayGame.mk_le_mk] + simp only [ConwayGame.mk_sub, ConwayGame.mk_one, ConwayGame.mk_natOrdinal_toIGame] rw [le_sub_iff_add_le, ← NatOrdinal.toGame_one, ← NatOrdinal.toGame_add] apply NatOrdinal.toGame.monotone simpa only [Order.succ_eq_add_one] using succ_le_of_lt hao diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Round.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Round.lean index f6fbd4f8f0..cfa0c9c130 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Round.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Round.lean @@ -33,7 +33,7 @@ theorem ofSets_eq_mk {s t : Set Surreal.{u}} [Small.{u} s] [Small.{u} t] rintro _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ rw [← Surreal.mk_lt_mk, out_eq, out_eq] exact H x hx y hy) (by simp)) := by - rw [← toGame_inj, toGame_ofSets, toGame_mk, Game.mk_ofSets] + rw [← toGame_inj, toGame_ofSets, toGame_mk, ConwayGame.mk_ofSets] simp_rw [image_image, gameMk_out] /-- A surreal cut is no more complex than any surreal strictly between all its options. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Cuts.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Cuts.lean index 0ad99aa5ff..582ea3bc50 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Cuts.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Cuts.lean @@ -113,7 +113,7 @@ theorem toSurreal_ofCodeSets (s t : Set GameCode.{u}) [Small.{u} s] [Small.{u} t (toSurreal_separated _ _ (codeValues_separated s t hs ht h)) := by apply _root_.Surreal.toGame_inj.1 rw [ofCodeSets_eq_mk, toSurreal_mk, _root_.Surreal.toGame_mk, - GameCode.toIGame_ofSets, Game.mk_ofSets, _root_.Surreal.toGame_ofSets] + GameCode.toIGame_ofSets, ConwayGame.mk_ofSets, _root_.Surreal.toGame_ofSets] congr 1 simp only [codeValues, Set.image_image, ← Set.range_comp, Function.comp_def, toSurreal_mk, _root_.Surreal.toGame_mk] diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/Cuts.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/Cuts.lean index 4bce81cde8..d2c934a808 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/Cuts.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests/Cuts.lean @@ -95,7 +95,7 @@ theorem mk_noncanonicalZero : apply Surreal.toGame_inj.1 rw [ZFSet.Surreal.toSurreal_mk, Surreal.toGame_mk, ZFSet.Surreal.toSurreal_zero, Surreal.toGame_zero] - apply Game.mk_eq + apply ConwayGame.mk_eq rw [noncanonicalZero, ZFSet.GameCode.toIGame_ofSets] apply IGame.fits_zero_iff_equiv.1 simp [IGame.Fits] From 7a56eb0d65d306307c8cac5f566a0752bb330ee6 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Thu, 24 Sep 2026 15:11:55 +0000 Subject: [PATCH 13/18] Restore project registration lost during automatic main merge --- LeanPool/projects.yml | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index 10e85b5b7d..4308f63bdd 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -10169,3 +10169,33 @@ projects: - 35B65 - 42B20 - 28A78 + + - title: Conway refinement for omnific integers + summary: 'Proves multiplicative refinement for omnific integers: every equality ab = cd admits a + two-by-two factor refinement. Develops factorization and refinement of generalized power-series + integer parts and connects these to surreal-number and standalone Mathlib formulations.' + branch: ordered algebra + main_declarations: + - ConwayRefinement.Palomar.conwayRefinement + main_results: + - declaration: ConwayRefinement.Palomar.conwayRefinement + informal: If four omnific integers satisfy ab = cd, there are omnific integers e, f, g, h with + a = ef, b = gh, c = eg, and d = fh, including degenerate cases. + tags: + - surreal-numbers + - ordered-algebra + - factorization + msc: + - 06A05 + - 13F25 + provenance: AI + slug: conway-refinement + entry_module: LeanPool.ConwayRefinement + authors: + - Dan Abramov + source: + url: https://github.com/gaearon/conway-refinement + github_repo: gaearon/conway-refinement + commit: 264445c93b78554c408e99e4e7f663693b4e91ab + license: Apache-2.0 + status: verified From eae96d04ca243ae2fc48c64f779e57a5458f8b4a Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 08:02:59 +0000 Subject: [PATCH 14/18] Isolate Conway OfSets tactic syntax within the pool --- .../ConwayRefinement/CombinatorialGames/Game/Player.lean | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Player.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Player.lean index 732af70c62..aa99e052b3 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game/Player.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game/Player.lean @@ -143,7 +143,7 @@ macro "!{" st:term "}'" h:term:max : term => `(OfSets.ofSets $st $h) macro "!{" s:term " | " t:term "}'" h:term:max : term => `(!{Player.cases $s $t}'$h) /-- A tactic which attempts to automatically solve goals which appear on `OfSets`. -/ -macro (name := ofSetsTactic) "of_sets_tactic" : tactic => +macro (name := conwayOfSetsTactic) "conway_of_sets_tactic" : tactic => `(tactic| first | done | trivial @@ -154,10 +154,10 @@ where `h` is a proof that sets are valid" ) @[inherit_doc OfSets.ofSets] -macro:max "!{" st:term "}" : term => `(!{$st}'(by of_sets_tactic)) +macro:max "!{" st:term "}" : term => `(!{$st}'(by conway_of_sets_tactic)) @[inherit_doc OfSets.ofSets] -macro:max "!{" s:term " | " t:term "}" : term => `(!{$s | $t}'(by of_sets_tactic)) +macro:max "!{" s:term " | " t:term "}" : term => `(!{$s | $t}'(by conway_of_sets_tactic)) recommended_spelling "ofSets" for "!{st}'h" in [ofSets, «term!{_}'_»] recommended_spelling "ofSets" for "!{s | t}'h" in [ofSets, «term!{_|_}'_»] From a4932bf82b39f487d8e80c1a1745c59133186ee5 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 08:10:12 +0000 Subject: [PATCH 15/18] Migrate Conway import aggregators to Lean modules --- LeanPool/ConwayRefinement.lean | 1366 +++++++++-------- .../ConwayRefinement/CombinatorialGames.lean | 12 +- .../CombinatorialGames/Game.lean | 18 +- .../CombinatorialGames/Mathlib.lean | 6 +- .../CombinatorialGames/NatOrdinal.lean | 6 +- .../CombinatorialGames/Surreal.lean | 22 +- .../CombinatorialGames/Surreal/Birthday.lean | 4 +- .../Surreal/HahnSeries.lean | 4 +- .../CombinatorialGames/Tactic.lean | 10 +- .../ConwayRefinement/Algebra.lean | 24 +- .../ConwayRefinement/Algebra/DirectSum.lean | 22 +- .../Algebra/Divisibility.lean | 14 +- .../Algebra/Divisibility/Tests.lean | 4 +- .../ConwayRefinement/Algebra/GradedRing.lean | 12 +- .../Algebra/LoweringDerivation.lean | 16 +- .../Algebra/MonoidAlgebra.lean | 6 +- .../Algebra/MvPolynomial.lean | 34 +- .../ConwayRefinement/Algebra/Order.lean | 10 +- .../Algebra/Order/Module.lean | 8 +- .../Algebra/Order/Module/Tests.lean | 4 +- .../ConwayRefinement/Algebra/Ring.lean | 4 +- .../ConwayRefinement/Algebra/Ring/Hom.lean | 4 +- .../ConwayRefinement/Algebra/Tests.lean | 4 +- .../ConwayRefinement/Algebra/Valuation.lean | 46 +- .../Algebra/Valuation/Tests.lean | 20 +- .../Algebra/Valuation/Tests/Fixtures.lean | 8 +- .../ConwayRefinement/Data.lean | 4 +- .../ConwayRefinement/Data/Multiset.lean | 6 +- .../ConwayRefinement/Data/Multiset/Tests.lean | 4 +- .../ConwayRefinement/Examples.lean | 4 +- .../Examples/OmnificInteger.lean | 12 +- .../ConwayRefinement/FieldTheory.lean | 10 +- .../ConwayRefinement/HahnSeries.lean | 128 +- .../ConwayRefinement/HahnSeries/Degree.lean | 10 +- .../HahnSeries/Degree/Statements.lean | 8 +- .../HahnSeries/Degree/Tests.lean | 4 +- .../HahnSeries/Factorization.lean | 54 +- .../HahnSeries/Factorization/DegreeTwo.lean | 14 +- .../HahnSeries/Factorization/Random.lean | 32 +- .../HahnSeries/Factorization/Statements.lean | 24 +- .../HahnSeries/Factorization/Tests.lean | 26 +- .../Factorization/Tests/DegreeTwo.lean | 8 +- .../ConwayRefinement/HahnSeries/Germ.lean | 4 +- .../Germ/AlgebraicIndependence.lean | 84 +- .../HahnSeries/IntegerPart.lean | 48 +- .../HahnSeries/IntegerPart/Refinement.lean | 22 +- .../HahnSeries/IntegerPart/Tests.lean | 32 +- .../HahnSeries/OrdinalValue.lean | 104 +- .../OrdinalValue/AlgebraicIndependence.lean | 82 +- .../HahnSeries/OrdinalValue/Statements.lean | 10 +- .../HahnSeries/OrdinalValue/Tests.lean | 40 +- .../Tests/AlgebraicIndependence.lean | 20 +- .../HahnSeries/PolynomialAlgebra.lean | 14 +- .../HahnSeries/PolynomialAlgebra/Tests.lean | 6 +- .../HahnSeries/Primality.lean | 16 +- .../ConwayRefinement/HahnSeries/Tests.lean | 34 +- .../HahnSeries/Tests/Fixtures.lean | 4 +- .../ConwayRefinement/LinearAlgebra.lean | 10 +- .../LinearAlgebra/TensorProduct.lean | 6 +- .../ConwayRefinement/Order.lean | 8 +- .../ConwayRefinement/Order/Filter.lean | 8 +- .../ConwayRefinement/Order/Filter/Germ.lean | 4 +- .../ConwayRefinement/Order/Filter/Tests.lean | 4 +- .../ConwayRefinement/RingTheory.lean | 6 +- .../ConwayRefinement/SetTheory.lean | 8 +- .../ConwayRefinement/SetTheory/Ordinal.lean | 46 +- .../SetTheory/Ordinal/Tests.lean | 18 +- .../ConwayRefinement/SetTheory/ZFC.lean | 8 +- .../ConwayRefinement/SetTheory/ZFC/Tests.lean | 6 +- .../ConwayRefinement/Standalone.lean | 6 +- .../Standalone/CombinatorialGames.lean | 14 +- .../CombinatorialGames/Examples.lean | 26 +- .../CombinatorialGames/Support.lean | 24 +- .../ConwayRefinement/Standalone/Mathlib.lean | 30 +- .../Standalone/Mathlib/Examples.lean | 14 +- .../Standalone/Mathlib/Support.lean | 32 +- .../ConwayRefinement/Surreal.lean | 26 +- .../ConwayRefinement/Surreal/HahnSeries.lean | 34 +- .../Surreal/HahnSeries/Tests.lean | 16 +- .../Surreal/OmnificInteger.lean | 16 +- .../Surreal/OmnificInteger/Primality.lean | 12 +- .../Surreal/OmnificInteger/Refinement.lean | 4 +- .../Surreal/OmnificInteger/Tests.lean | 14 +- .../ConwayRefinement/Surreal/Tests.lean | 6 +- .../ConwayRefinement/Surreal/ZFC.lean | 22 +- .../ConwayRefinement/Surreal/ZFC/Tests.lean | 10 +- .../ConwayRefinement/Tests.lean | 6 +- .../ConwayRefinement/Topology.lean | 14 +- .../ConwayRefinement/Topology/Order.lean | 30 +- .../Topology/Order/Tests.lean | 6 +- .../ConwayRefinement/Topology/Tests.lean | 4 +- 91 files changed, 1618 insertions(+), 1436 deletions(-) diff --git a/LeanPool/ConwayRefinement.lean b/LeanPool/ConwayRefinement.lean index 1799953321..aa322c8c94 100644 --- a/LeanPool/ConwayRefinement.lean +++ b/LeanPool/ConwayRefinement.lean @@ -4,688 +4,690 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.CombinatorialGames.Game.Basic -import LeanPool.ConwayRefinement.CombinatorialGames.Game.Birthday -import LeanPool.ConwayRefinement.CombinatorialGames.Game.Classes -import LeanPool.ConwayRefinement.CombinatorialGames.Game.Functor -import LeanPool.ConwayRefinement.CombinatorialGames.Game.IGame -import LeanPool.ConwayRefinement.CombinatorialGames.Game.Ordinal -import LeanPool.ConwayRefinement.CombinatorialGames.Game.Player -import LeanPool.ConwayRefinement.CombinatorialGames.Game.Special -import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Dyadic -import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Small -import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Basic -import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Basic -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Birthday.Basic -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Division -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Dyadic -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Leading -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Multiplication -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Ordinal -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Pow -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Real -import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.AddInstances -import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.GameCmp -import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.OrdinalAlias -import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.Register -import LeanPool.ConwayRefinement.ConwayRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermChainRule -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermFinitePartIdeal -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermPolynomial -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSuccessorStep -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSyzygy -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousDivisibility -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousPrime -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.InternalGrading -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.LeadingGrade -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.TrailingGrade -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.DenominatorIdeal -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.MaximalDivisor -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalProduct -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Tests.Refinement -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GeometricIntegrality -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.Extension -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.FinitePartSubstitution -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousZeroDivisors -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.OrdinalGenerators -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.BaseChange -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Correction -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.FilteredModule -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Grading -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.IdealGEGraded -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Mu -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Polynomial -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.LatticeFunctional -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.SingleZeroFactors -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.BaseChange -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Components -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Expansion -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartDecomposition -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartErasure -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartVars -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.GCDMonoid -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.LimitOrdinalContradiction -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.MapWeight -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalDerivation -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalExpansion -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.RemainderBound -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Syzygy -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.TermDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.WeightedTotalDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanBall -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ConvexQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ArchimedeanBallSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ConvexQuotientSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.Tests.ArchimedeanBallSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring.Hom.OfInjectiveComp -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Tests.GeometricIntegrality -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedValuation -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.BasisOver -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGraded -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedMap -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeOver -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreePrincipalInitialIdeal -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeRepresentatives -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeScalar -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeSum -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeWeightedPolynomial -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.FiltrationDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.MaxAddDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.OfValuation -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.QuotientDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.RV -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Residue -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.ResidueMathlib -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.AssociatedGraded -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.AssociatedGradedValuation -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.DegreeAssociatedGraded -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.DegreeAssociatedGradedQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.FiltrationDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialAssociatedGraded -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialQuotientDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.QuotientDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.RV -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Residue -import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint -import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.SelectionComplexity -import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.Tests.SelectionComplexity -import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoNormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoPrime -import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowNormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowPrime -import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.ZFCDegreeTwoPrime -import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LatticeFactorCoefficients -import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LaurentFactorCoefficients -import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.MonicFactorCoefficients -import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.RelativeAlgebraicClosure -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ArchimedeanSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEmbedding -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEquiv -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationIrreducible -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationResidue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CharZero -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CoefficientMap -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexFactorSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexQuotientSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.PrincipalMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeResidue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeValuation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.SupportSupremumMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Tests.SupportSupremumMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeTermCount -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeValuation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Domain -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEmbedding -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEquiv -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainOrderType -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.EPrimitive -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FactorCoefficients -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducible -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducibleFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwo -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwoExample -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.Factorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.FactorizationClassification -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedSpanFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedTruncationSpan -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.FiniteSupportFactorUniqueness -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GermLike -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GradedDivisibility -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.InfiniteSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFinite -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFiniteMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPart -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartSeries -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedMaximalFinite -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PreSchreier -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalMaximalFinite -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringLocalization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringPrimality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVGradedMaximalFinite -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ClassIrreducible -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.CoefficientRandom -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.GradedIrreducible -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.HereditaryIndependence -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.IndependenceWindow -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.MainTheorem -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NonPrincipalIrreducible -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NormalFormBlocks -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.PrincipalIrreducible -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.Random -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.RandomBlocks -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ReducibleSpan -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SuccessorStep -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SupportRandom -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.TruncationIndependence -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalFinite -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesPrimality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.Factorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.FiniteSupportFactorUniqueness -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteSupportDivisor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalDivisibilityReflection -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalMaximalDivisor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalScalarRedistribution -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringFraction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringPrimality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesMaximalFiniteSupportDivisor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesPrimality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducible -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducibleFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.FactorizationClassification -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedSpanFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedTruncationSpan -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GermLikeFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GradedDivisibility -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.InfiniteSupportFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.MaximalFiniteSupportDivisor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPart -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPartMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.PrincipalMaximalFiniteSupportDivisor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SectionSixFour -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SeriesMaximalFiniteSupportDivisor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportConstantTermOne -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportMonoidAlgebra -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalizedGCD -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportResidue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarExtension -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarTensor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Additive -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.AlgebraicIndependence -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Boundary -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Cancellation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonRankLevels -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValueMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CofactorInduction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Convolution -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationIdeal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationSet -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivative -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Germ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.GlobalCofactors -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Graded -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LeadingCoefficient -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Leibniz -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LiftFamily -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Lifts -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalEvaluation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalRelationAtCutoff -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LinearMaximal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LowerTruncationDegree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Multiplication -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Obligations -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.OrderedIntervalCantorBendixson -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativeIndices -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativesAtLimitOrdinal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Power -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PrincipalSeries -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Scalar -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.ScalarLeadingCoefficientAtLimitOrdinal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SeparatedPieceCantorBendixson -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SuccessorLeibniz -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SyzygyIntegration -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolationOnSets -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Truncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationExpansion -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationPolynomial -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Assumptions -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalFiniteClassReduction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalIntegerPartSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalPrimalityTransfer -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalProposition922 -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ClassTruncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassPrimality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassReduction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IntegerPartSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IrreducibilityTransfer -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.LimitTailPrimality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.PrimalityTransfer -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduced -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedCharacterization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedDivisibility -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedPrimality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalGermRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalTruncationClosedClass -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ClosedClassRefinementTransport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CompleteGermRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ConvexRestrictionFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.FiniteGermError -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.LimitTailRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.TruncationIntegerPartFractionField -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.SplitTruncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Assumptions -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Basic -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalPrimalityTransfer -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalProposition922 -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ClassTruncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.FiniteClassReduction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.IntegerPartSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.PrimalityTransfer -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduced -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ReducedCharacterization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ReducedDivisibility -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.SplitTruncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.TruncationDivisibility -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.TruncationPrimality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationDivisibility -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationPrimality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Iterate -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IterateOrderType -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.LimitTailQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Monomial -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Multiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Negative -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NegativeMonomialIdeal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveCoefficientMap -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveDomainEquiv -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderedIntervalSum -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.BaseChange -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonGrading -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRank -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRepresentatives -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CombinedCofactors -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAt -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAtInjective -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivationIdeal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.IdealFromTruncations -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.InductionOverDegrees -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LeadingCoefficient -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Lifts -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LimitOrdinalRelationAtCutoff -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LinearMaximal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LowDegreeParts -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LoweringDerivation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OmegaSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OrdinalValueCutoffs -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PartialDerivativeIndices -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Partials -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Pieces -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Polynomiality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalGraded -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalIdealGE -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductCondition -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductTruncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductValues -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.RealPartials -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SeriesTruncations -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Shift -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorLeibniz -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorSupportBound -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SumAlongCutoffs -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SupportLoweringPieces -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Syzygy -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationExpansion -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationPolynomial -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationsIdeal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.UnboundedTruncations -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CoefficientMap -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ComplexityDecrease -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionList -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionRemainder -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPoint -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPointExistence -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.FormalExpression -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermDegree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermValueCut -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Irreducibility -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.LeibnizRemainder -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.MainLemma -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OneRow -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrderTypeMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueConstantMul -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSubmultiplicative -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueValuation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PowerRemainder -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponent -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentDegree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentTensor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubring -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFraction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFractionAlgebraic -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringLocalization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringMonoidAlgebra -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringScalarRedistributionProof -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalValue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PurePowerRemainder -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPoint -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointCofinality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointOrderType -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointTail -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointValue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointWellOrdered -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.MainLemma -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.OrdinalValueDegree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ResidualPoint -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.BaseChange -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.CutoffConvolution -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.DerivAt -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.FinitePowerFamily -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.LoweringDerivation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.OmegaOmegaBoundary -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.PrincipalGraded -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.PrincipalIdealGE -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.SuccessorLeibniz -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.BerarducciPrimitives -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ComplexityDecrease -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.Convolution -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ConvolutionList -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ConvolutionRemainder -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.CriticalPoint -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueFinalSegment -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueSubmultiplicative -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponent -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponentDegree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponentTensor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubring -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFiniteSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFraction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringTensor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalValue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ResidualPoint -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.SectionSixThree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.TruncationDrop -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.CompleteGerm -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.CompleteGermOfCauchyComplete -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.InitialForms -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialPresentation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialRing -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests.GCDMonoid -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests.PolynomialRing -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Consequences -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.DegreeOne -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.GCDMonoid -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.OrdinalValueQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Primality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Random -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.SupportOrderTypeFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.RealSupportSupremum -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedPieceSum -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SourceStatements -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupAlgebra -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupGCD -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportArchimedeanClasses -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportSupremum -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.ArchimedeanSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.CardinalTruncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportGCD -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportResidue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportScalarExtension -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Iterate -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Multiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NegativePresentation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NonpositiveDomainEquiv -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.OrderTypeDegree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.PrincipalAddition -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Truncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.TruncationIntegerPartPrimal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.WeakNormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Translation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Truncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.TruncationIntegerPartPrimal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.WeakNormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.AlgebraicIndependentDet -import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.FiniteSpanRelation -import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.IndicatorFinsupp -import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.Content -import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.SubalgebraBasis -import LeanPool.ConwayRefinement.ConwayRefinement.Order.Archimedean -import LeanPool.ConwayRefinement.ConwayRefinement.Order.DifferenceAvoidance -import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus -import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus.Pointwise -import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Germ.LinearMap -import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Tests.FunAtZeroMinus -import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LaurentTower -import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LocalizationUFM -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.FinitePWOUnion -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AlgebraicOrder -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorBendixson -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorTermCount -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Degree -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.GeneralFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.IncreasingSequenceUnion -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTerm -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTermSup -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.MultiplicativelyPrincipal -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalOrder -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPowerFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPrincipal -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.OrderedUnion -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.PairBounds -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Separation -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Split -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SuccessorFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Sumset -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.GeneralFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.NaturalPrincipal -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrderedUnion -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalFactors -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalFinitePart -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalSuccessorFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.SetOrderType -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.Sumset -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Game -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.GameOperations -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests.Game -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests.GameOperations -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinementProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrime -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrimeProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamily -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamilyProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundary -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundaryProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRoots -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRootsProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorizationProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrime -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrimeProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependence -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependenceProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayNormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayRefinementConsequences -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.DegreeTwoExample -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamily -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamilyProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmegaOmegaBoundary -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFactorizationProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFiniteDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificIntegers -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OneRowExample -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.PrincipalRVAlgebraicIndependenceProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGerm -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGermProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrime -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrimeProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterion -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterionProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRoots -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRootsProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRing -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRingProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinementProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCD -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCDProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRing -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRingProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinementProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ArchimedeanQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.CompleteHahnGermProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotientSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinementProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.GermPolynomialRingProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnIntegerPartRefinementProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnLimitTailQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesGCDProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesPolynomialRingProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineConwayRefinementProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineSurreal -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.OrderedAddGroup -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.SeriesConsequences -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ArchimedeanAssumptions -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Cardinal -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.CutFilling -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.CardinalIntegerPart -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Degree -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.DegreeTransfer -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Full -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.IntegerPart -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Multiplication -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormAdd -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormBasic -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormMul -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormRecursion -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormSupport -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.RealLeadingSplit -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.SignedFull -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.CardinalIntegerPart -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.DegreeTransfer -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.Full -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.Multiplication -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalFormAdd -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalFormMul -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Transfer -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Basic -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.NormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Ordinal -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.FiniteClasses -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.IrreducibleOmnificIntegers -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OmnificIntegers -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OrdinaryIntegers -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.ZFC -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Refinement.ConwayRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.RefinementConjecture -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.Basic -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.ConwayRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.DegreeTwoOzPrime -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.FiniteClasses -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.NormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.ZFC -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RationalTailQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealArchimedeanStratum -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealModule -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Round -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.SmallDiscrete -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.ArchimedeanAssumptions -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.RealModule -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Basic -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Cuts -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Identification -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.NormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificCodes -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificInteger -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Properness -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Reduced -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Refinement -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Cuts -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Identification -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.NormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Properness -import LeanPool.ConwayRefinement.ConwayRefinement.Tests.SourceIndex -import LeanPool.ConwayRefinement.ConwayRefinement.Tests.UpstreamReuse -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixson -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonProduct -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonRank -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonReconstruction -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ArchimedeanBallBase -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonAddition -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonConvexCover -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ClosedPWO -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CoinitialComplete -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedAddGroup -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedIntervalFamily -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAddition -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAdditionFiber -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOSumset -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SeparatedPieceFamily -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SmallClosedSubspace -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests.CantorBendixsonConvexCover -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests.PWOAddition -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Tests.CantorBendixson -import LeanPool.ConwayRefinement.Solution +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Basic +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Birthday +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Classes +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Functor +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.IGame +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Ordinal +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Player +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Special +public import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Dyadic +public import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Small +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Basic +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Basic +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Birthday.Basic +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Division +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Dyadic +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Leading +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Multiplication +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Ordinal +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Pow +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Real +public import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.AddInstances +public import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.GameCmp +public import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.OrdinalAlias +public import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.Register +public import LeanPool.ConwayRefinement.ConwayRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermChainRule +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermFinitePartIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermPolynomial +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSuccessorStep +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSyzygy +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.InternalGrading +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.LeadingGrade +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.TrailingGrade +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.DenominatorIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.MaximalDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalProduct +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Tests.Refinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GeometricIntegrality +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.Extension +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.FinitePartSubstitution +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousZeroDivisors +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.OrdinalGenerators +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.BaseChange +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Correction +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.FilteredModule +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Grading +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.IdealGEGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Mu +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Polynomial +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.LatticeFunctional +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.SingleZeroFactors +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.BaseChange +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Components +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Expansion +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartDecomposition +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartErasure +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartVars +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.GCDMonoid +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.LimitOrdinalContradiction +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.MapWeight +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalDerivation +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalExpansion +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.RemainderBound +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Syzygy +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.TermDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.WeightedTotalDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanBall +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ConvexQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ArchimedeanBallSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ConvexQuotientSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.Tests.ArchimedeanBallSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring.Hom.OfInjectiveComp +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Tests.GeometricIntegrality +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.BasisOver +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedMap +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeOver +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreePrincipalInitialIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeRepresentatives +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeScalar +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeSum +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeWeightedPolynomial +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.FiltrationDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.MaxAddDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.OfValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.QuotientDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.RV +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Residue +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.ResidueMathlib +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.AssociatedGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.AssociatedGradedValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.DegreeAssociatedGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.DegreeAssociatedGradedQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.FiltrationDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialAssociatedGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialQuotientDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.QuotientDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.RV +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Residue +public import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint +public import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.SelectionComplexity +public import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.Tests.SelectionComplexity +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoNormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowNormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.ZFCDegreeTwoPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LatticeFactorCoefficients +public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LaurentFactorCoefficients +public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.MonicFactorCoefficients +public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.RelativeAlgebraicClosure +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ArchimedeanSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEmbedding +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEquiv +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationResidue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CharZero +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CoefficientMap +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexFactorSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexQuotientSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.PrincipalMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeResidue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.SupportSupremumMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Tests.SupportSupremumMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeTermCount +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Domain +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEmbedding +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEquiv +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainOrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.EPrimitive +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FactorCoefficients +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducibleFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwo +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwoExample +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.Factorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.FactorizationClassification +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedSpanFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedTruncationSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.FiniteSupportFactorUniqueness +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GermLike +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GradedDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.InfiniteSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFiniteMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPart +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartSeries +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PreSchreier +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringLocalization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVGradedMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ClassIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.CoefficientRandom +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.GradedIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.HereditaryIndependence +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.IndependenceWindow +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.MainTheorem +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NonPrincipalIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NormalFormBlocks +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.PrincipalIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.Random +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.RandomBlocks +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ReducibleSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SuccessorStep +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SupportRandom +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.TruncationIndependence +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.Factorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.FiniteSupportFactorUniqueness +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteSupportDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalDivisibilityReflection +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalMaximalDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalScalarRedistribution +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringFraction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesMaximalFiniteSupportDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducibleFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.FactorizationClassification +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedSpanFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedTruncationSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GermLikeFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GradedDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.InfiniteSupportFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.MaximalFiniteSupportDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPart +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPartMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.PrincipalMaximalFiniteSupportDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SectionSixFour +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SeriesMaximalFiniteSupportDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportConstantTermOne +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportMonoidAlgebra +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalizedGCD +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportResidue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarExtension +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarTensor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Additive +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.AlgebraicIndependence +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Boundary +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Cancellation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonRankLevels +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValueMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CofactorInduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Convolution +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationSet +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivative +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Germ +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.GlobalCofactors +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Graded +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LeadingCoefficient +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Leibniz +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LiftFamily +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Lifts +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalEvaluation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalRelationAtCutoff +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LinearMaximal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LowerTruncationDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Multiplication +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Obligations +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.OrderedIntervalCantorBendixson +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativeIndices +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativesAtLimitOrdinal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Power +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PrincipalSeries +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Scalar +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.ScalarLeadingCoefficientAtLimitOrdinal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SeparatedPieceCantorBendixson +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SuccessorLeibniz +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SyzygyIntegration +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolationOnSets +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Truncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationExpansion +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationPolynomial +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Assumptions +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalFiniteClassReduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalIntegerPartSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalPrimalityTransfer +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalProposition922 +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ClassTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassReduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IntegerPartSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IrreducibilityTransfer +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.LimitTailPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.PrimalityTransfer +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduced +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedCharacterization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalGermRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalTruncationClosedClass +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ClosedClassRefinementTransport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CompleteGermRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ConvexRestrictionFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.FiniteGermError +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.LimitTailRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.TruncationIntegerPartFractionField +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.SplitTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Assumptions +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Basic +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalPrimalityTransfer +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalProposition922 +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ClassTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.FiniteClassReduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.IntegerPartSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.PrimalityTransfer +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduced +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ReducedCharacterization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ReducedDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.SplitTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.TruncationDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.TruncationPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Iterate +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IterateOrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.LimitTailQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Monomial +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Multiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Negative +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NegativeMonomialIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveCoefficientMap +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveDomainEquiv +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderedIntervalSum +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.BaseChange +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonGrading +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRank +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRepresentatives +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CombinedCofactors +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAt +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAtInjective +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivationIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.IdealFromTruncations +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.InductionOverDegrees +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LeadingCoefficient +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Lifts +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LimitOrdinalRelationAtCutoff +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LinearMaximal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LowDegreeParts +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LoweringDerivation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OmegaSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OrdinalValueCutoffs +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PartialDerivativeIndices +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Partials +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Pieces +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Polynomiality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalIdealGE +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductCondition +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductValues +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.RealPartials +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SeriesTruncations +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Shift +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorLeibniz +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorSupportBound +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SumAlongCutoffs +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SupportLoweringPieces +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Syzygy +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationExpansion +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationPolynomial +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationsIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.UnboundedTruncations +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CoefficientMap +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ComplexityDecrease +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionList +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionRemainder +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPoint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPointExistence +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.FormalExpression +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermValueCut +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Irreducibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.LeibnizRemainder +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.MainLemma +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OneRow +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrderTypeMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueConstantMul +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSubmultiplicative +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PowerRemainder +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponent +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentTensor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubring +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFraction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFractionAlgebraic +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringLocalization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringMonoidAlgebra +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringScalarRedistributionProof +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PurePowerRemainder +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPoint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointCofinality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointOrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointTail +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointWellOrdered +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.MainLemma +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.OrdinalValueDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ResidualPoint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.BaseChange +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.CutoffConvolution +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.DerivAt +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.FinitePowerFamily +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.LoweringDerivation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.OmegaOmegaBoundary +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.PrincipalGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.PrincipalIdealGE +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.SuccessorLeibniz +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.BerarducciPrimitives +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ComplexityDecrease +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.Convolution +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ConvolutionList +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ConvolutionRemainder +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.CriticalPoint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueFinalSegment +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueSubmultiplicative +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponent +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponentDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponentTensor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubring +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFiniteSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFraction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringTensor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ResidualPoint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.SectionSixThree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.TruncationDrop +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.CompleteGerm +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.CompleteGermOfCauchyComplete +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.InitialForms +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialPresentation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialRing +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests.GCDMonoid +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests.PolynomialRing +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Consequences +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.DegreeOne +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.GCDMonoid +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.OrdinalValueQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Primality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Random +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.SupportOrderTypeFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.RealSupportSupremum +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedPieceSum +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SourceStatements +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupAlgebra +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupGCD +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportArchimedeanClasses +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportSupremum +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.ArchimedeanSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.CardinalTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportGCD +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportResidue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportScalarExtension +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Iterate +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Multiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NegativePresentation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NonpositiveDomainEquiv +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.OrderTypeDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.PrincipalAddition +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Truncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.TruncationIntegerPartPrimal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.WeakNormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Translation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Truncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.TruncationIntegerPartPrimal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.WeakNormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.AlgebraicIndependentDet +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.FiniteSpanRelation +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.IndicatorFinsupp +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.Content +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.SubalgebraBasis +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Archimedean +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.DifferenceAvoidance +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus.Pointwise +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Germ.LinearMap +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Tests.FunAtZeroMinus +public import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LaurentTower +public import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LocalizationUFM +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.FinitePWOUnion +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AlgebraicOrder +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorBendixson +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorTermCount +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Degree +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.GeneralFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.IncreasingSequenceUnion +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTerm +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTermSup +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.MultiplicativelyPrincipal +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalOrder +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPowerFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPrincipal +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.OrderedUnion +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.PairBounds +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Separation +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Split +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SuccessorFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Sumset +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.GeneralFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.NaturalPrincipal +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrderedUnion +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalFactors +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalFinitePart +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalSuccessorFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.SetOrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.Sumset +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Game +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.GameOperations +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests.Game +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests.GameOperations +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinementProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrimeProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamily +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamilyProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundary +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundaryProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRoots +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRootsProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorizationProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrimeProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependence +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependenceProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayNormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayRefinementConsequences +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.DegreeTwoExample +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamily +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamilyProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmegaOmegaBoundary +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFactorizationProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFiniteDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificIntegers +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OneRowExample +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.PrincipalRVAlgebraicIndependenceProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGerm +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGermProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrimeProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterion +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterionProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRoots +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRootsProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRing +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRingProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinementProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCD +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCDProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRing +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRingProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinementProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ArchimedeanQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.CompleteHahnGermProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotientSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinementProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.GermPolynomialRingProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnIntegerPartRefinementProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnLimitTailQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesGCDProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesPolynomialRingProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineConwayRefinementProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineSurreal +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.OrderedAddGroup +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.SeriesConsequences +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ArchimedeanAssumptions +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Cardinal +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.CutFilling +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.CardinalIntegerPart +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Degree +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.DegreeTransfer +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Full +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.IntegerPart +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Multiplication +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormAdd +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormBasic +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormMul +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormRecursion +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.RealLeadingSplit +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.SignedFull +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.CardinalIntegerPart +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.DegreeTransfer +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.Full +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.Multiplication +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalFormAdd +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalFormMul +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Transfer +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Basic +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Ordinal +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.FiniteClasses +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.IrreducibleOmnificIntegers +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OmnificIntegers +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OrdinaryIntegers +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.ZFC +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Refinement.ConwayRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.RefinementConjecture +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.Basic +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.ConwayRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.DegreeTwoOzPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.FiniteClasses +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.ZFC +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RationalTailQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealArchimedeanStratum +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealModule +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Round +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.SmallDiscrete +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.ArchimedeanAssumptions +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.RealModule +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Basic +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Cuts +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Identification +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificCodes +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificInteger +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Properness +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Reduced +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Refinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Cuts +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Identification +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Properness +public import LeanPool.ConwayRefinement.ConwayRefinement.Tests.SourceIndex +public import LeanPool.ConwayRefinement.ConwayRefinement.Tests.UpstreamReuse +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixson +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonProduct +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonRank +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonReconstruction +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ArchimedeanBallBase +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonAddition +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonConvexCover +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ClosedPWO +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CoinitialComplete +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedAddGroup +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedIntervalFamily +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAddition +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAdditionFiber +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOSumset +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SeparatedPieceFamily +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SmallClosedSubspace +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests.CantorBendixsonConvexCover +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests.PWOAddition +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Tests.CantorBendixson +public import LeanPool.ConwayRefinement.Solution /-! # Conway refinement for omnific integers diff --git a/LeanPool/ConwayRefinement/CombinatorialGames.lean b/LeanPool/ConwayRefinement/CombinatorialGames.lean index 386260f59d..1a8a6171a0 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames.lean @@ -4,10 +4,12 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.CombinatorialGames.Game -import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib -import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal -import LeanPool.ConwayRefinement.CombinatorialGames.Tactic +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Game +public import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal +public import LeanPool.ConwayRefinement.CombinatorialGames.Tactic /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Game.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Game.lean index feb0a4e801..cb0fc075f1 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Game.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Game.lean @@ -4,13 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.CombinatorialGames.Game.Basic -import LeanPool.ConwayRefinement.CombinatorialGames.Game.Birthday -import LeanPool.ConwayRefinement.CombinatorialGames.Game.Classes -import LeanPool.ConwayRefinement.CombinatorialGames.Game.Functor -import LeanPool.ConwayRefinement.CombinatorialGames.Game.IGame -import LeanPool.ConwayRefinement.CombinatorialGames.Game.Ordinal -import LeanPool.ConwayRefinement.CombinatorialGames.Game.Player -import LeanPool.ConwayRefinement.CombinatorialGames.Game.Special +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Basic +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Birthday +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Classes +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Functor +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.IGame +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Ordinal +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Player +public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Special /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib.lean index 3d34cf8ed6..354f1c62b8 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Mathlib.lean @@ -4,7 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Dyadic -import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Small +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Dyadic +public import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Small /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/NatOrdinal.lean b/LeanPool/ConwayRefinement/CombinatorialGames/NatOrdinal.lean index c8221aafa9..c01afb2edc 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/NatOrdinal.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/NatOrdinal.lean @@ -4,7 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Basic -import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Basic +public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal.lean index da7d50f0b9..a067ba6c5d 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal.lean @@ -4,15 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Basic -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Birthday -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Division -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Dyadic -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Leading -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Multiplication -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Ordinal -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Pow -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Real +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Basic +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Birthday +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Division +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Dyadic +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Leading +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Multiplication +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Ordinal +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Pow +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Real /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Birthday.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Birthday.lean index 652bcfe4f9..e2d3141adf 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Birthday.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/Birthday.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Birthday.Basic +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Birthday.Basic /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries.lean index dab72adaff..182e3b6f09 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Surreal/HahnSeries.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/CombinatorialGames/Tactic.lean b/LeanPool/ConwayRefinement/CombinatorialGames/Tactic.lean index 439185d26e..d1bfa3230f 100644 --- a/LeanPool/ConwayRefinement/CombinatorialGames/Tactic.lean +++ b/LeanPool/ConwayRefinement/CombinatorialGames/Tactic.lean @@ -4,9 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.AddInstances -import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.GameCmp -import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.OrdinalAlias -import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.Register +module + +public import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.AddInstances +public import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.GameCmp +public import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.OrdinalAlias +public import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.Register /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra.lean index b700cffa90..cf8320542d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra.lean @@ -4,16 +4,18 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GeometricIntegrality -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Tests -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GeometricIntegrality +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Tests +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum.lean index aea2f28149..19b5181b85 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/DirectSum.lean @@ -4,15 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermChainRule -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermFinitePartIdeal -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermPolynomial -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSuccessorStep -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSyzygy -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousDivisibility -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousPrime -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.InternalGrading -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.LeadingGrade -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.TrailingGrade +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermChainRule +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermFinitePartIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermPolynomial +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSuccessorStep +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSyzygy +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.InternalGrading +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.LeadingGrade +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.TrailingGrade /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility.lean index 4cd29d99f7..fc6d7c097b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility.lean @@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.DenominatorIdeal -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.MaximalDivisor -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalProduct -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Tests +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.DenominatorIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.MaximalDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalProduct +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Tests /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Tests.lean index 5169061911..89e6459f81 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Divisibility/Tests.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Tests.Refinement +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Tests.Refinement /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing.lean index 980f61f774..06a25f6d55 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/GradedRing.lean @@ -4,10 +4,12 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.Extension -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.FinitePartSubstitution -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousZeroDivisors -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.OrdinalGenerators +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.Extension +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.FinitePartSubstitution +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousZeroDivisors +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.OrdinalGenerators /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation.lean index cf6de6ea4a..31d25ef9c4 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/LoweringDerivation.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.BaseChange -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Correction -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.FilteredModule -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Grading -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.IdealGEGraded -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Mu -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Polynomial +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.BaseChange +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Correction +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.FilteredModule +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Grading +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.IdealGEGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Mu +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Polynomial /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MonoidAlgebra.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MonoidAlgebra.lean index ab6db543d2..7a90b1635b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MonoidAlgebra.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MonoidAlgebra.lean @@ -4,7 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.LatticeFunctional -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.SingleZeroFactors +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.LatticeFunctional +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.SingleZeroFactors /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial.lean index 1db364fffe..152588a89a 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/MvPolynomial.lean @@ -4,21 +4,23 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.BaseChange -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Components -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Expansion -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartDecomposition -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartErasure -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartVars -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.GCDMonoid -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.LimitOrdinalContradiction -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.MapWeight -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalDerivation -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalExpansion -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.RemainderBound -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Syzygy -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.TermDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.WeightedTotalDegree +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.BaseChange +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Components +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Expansion +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartDecomposition +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartErasure +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartVars +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.GCDMonoid +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.LimitOrdinalContradiction +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.MapWeight +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalDerivation +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalExpansion +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.RemainderBound +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Syzygy +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.TermDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.WeightedTotalDegree /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order.lean index 6c8286152d..e31be8188a 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order.lean @@ -4,9 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanBall -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ConvexQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanBall +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ConvexQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module.lean index b56d87f3ed..e99bcddd41 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module.lean @@ -4,8 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ArchimedeanBallSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ConvexQuotientSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.Tests +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ArchimedeanBallSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ConvexQuotientSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.Tests /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/Tests.lean index b6f59fa55a..2ea7db7b92 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Order/Module/Tests.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.Tests.ArchimedeanBallSplitting +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.Tests.ArchimedeanBallSplitting /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring.lean index 6b49352a1b..d3e1386e5a 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring.Hom +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring.Hom /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring/Hom.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring/Hom.lean index 04dc6cba66..7cbd15576c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring/Hom.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Ring/Hom.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring.Hom.OfInjectiveComp +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring.Hom.OfInjectiveComp /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Tests.lean index 9e7a48d30e..248b6417ec 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Tests.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Tests.GeometricIntegrality +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Tests.GeometricIntegrality /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation.lean index d07bf9de80..f164fa9e58 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation.lean @@ -4,27 +4,29 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedValuation -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.BasisOver -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGraded -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedMap -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeOver -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreePrincipalInitialIdeal -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeRepresentatives -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeScalar -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeSum -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeWeightedPolynomial -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.FiltrationDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.MaxAddDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.OfValuation -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.QuotientDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.RV -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Residue -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.ResidueMathlib -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.BasisOver +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedMap +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeOver +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreePrincipalInitialIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeRepresentatives +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeScalar +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeSum +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeWeightedPolynomial +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.FiltrationDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.MaxAddDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.OfValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.QuotientDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.RV +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Residue +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.ResidueMathlib +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests.lean index e929b2de10..a9ae5200d8 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests.lean @@ -4,14 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.AssociatedGraded -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.AssociatedGradedValuation -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.DegreeAssociatedGraded -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.DegreeAssociatedGradedQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.FiltrationDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.QuotientDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.RV -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Residue +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.AssociatedGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.AssociatedGradedValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.DegreeAssociatedGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.DegreeAssociatedGradedQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.FiltrationDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.QuotientDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.RV +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Residue /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures.lean index c49ed6f658..8ff1dd42ab 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Algebra/Valuation/Tests/Fixtures.lean @@ -4,8 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialAssociatedGraded -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialQuotientDegree +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialAssociatedGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialQuotientDegree /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Data.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Data.lean index cca77c0212..2fa0daba1d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Data.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Data.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset.lean index 8675a693a3..b6cc145366 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset.lean @@ -4,7 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.SelectionComplexity -import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.Tests +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.SelectionComplexity +public import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.Tests /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/Tests.lean index 522d66f96d..0ac9e0fcb5 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Data/Multiset/Tests.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.Tests.SelectionComplexity +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.Tests.SelectionComplexity /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Examples.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Examples.lean index b31b5eb89f..c988e9d905 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Examples.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Examples.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger.lean index 13c61a8013..eb32ecf23c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Examples/OmnificInteger.lean @@ -4,10 +4,12 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoNormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoPrime -import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowNormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowPrime -import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.ZFCDegreeTwoPrime +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoNormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowNormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.ZFCDegreeTwoPrime /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory.lean b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory.lean index e00deb2704..27088f8de6 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/FieldTheory.lean @@ -4,9 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LatticeFactorCoefficients -import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LaurentFactorCoefficients -import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.MonicFactorCoefficients -import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.RelativeAlgebraicClosure +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LatticeFactorCoefficients +public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LaurentFactorCoefficients +public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.MonicFactorCoefficients +public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.RelativeAlgebraicClosure /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries.lean index 045a1b6ff8..b64620d915 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries.lean @@ -4,68 +4,70 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ArchimedeanSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEmbedding -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEquiv -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationIrreducible -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationResidue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CharZero -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CoefficientMap -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexFactorSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexQuotientSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeTermCount -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeValuation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Domain -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEmbedding -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEquiv -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainOrderType -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.EPrimitive -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FactorCoefficients -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportConstantTermOne -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportMonoidAlgebra -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalizedGCD -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportResidue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarExtension -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarTensor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Iterate -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IterateOrderType -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.LimitTailQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Monomial -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Multiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Negative -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NegativeMonomialIdeal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveCoefficientMap -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveDomainEquiv -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderedIntervalSum -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.RealSupportSupremum -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedPieceSum -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SourceStatements -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupAlgebra -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupGCD -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportArchimedeanClasses -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportSupremum -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Translation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Truncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.TruncationIntegerPartPrimal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.WeakNormalForm +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ArchimedeanSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEmbedding +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEquiv +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationResidue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CharZero +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CoefficientMap +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexFactorSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexQuotientSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeTermCount +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Domain +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEmbedding +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEquiv +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainOrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.EPrimitive +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FactorCoefficients +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportConstantTermOne +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportMonoidAlgebra +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalizedGCD +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportResidue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarExtension +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarTensor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Iterate +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IterateOrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.LimitTailQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Monomial +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Multiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Negative +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NegativeMonomialIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveCoefficientMap +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveDomainEquiv +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderedIntervalSum +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.RealSupportSupremum +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedPieceSum +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SourceStatements +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupAlgebra +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupGCD +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportArchimedeanClasses +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportSupremum +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Translation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Truncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.TruncationIntegerPartPrimal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.WeakNormalForm /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree.lean index 2a75827f08..fdf008b7de 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree.lean @@ -4,9 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.PrincipalMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.SupportSupremumMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Tests +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.PrincipalMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.SupportSupremumMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Tests /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements.lean index 813e9c775a..94d783f062 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Statements.lean @@ -4,8 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeResidue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeValuation +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeResidue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeValuation /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Tests.lean index 90c5ee9aae..9215bef1a8 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Degree/Tests.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Tests.SupportSupremumMultiplicativity +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Tests.SupportSupremumMultiplicativity /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization.lean index 6465f38467..0bedcf6e94 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization.lean @@ -4,31 +4,33 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducible -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducibleFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.FiniteSupportFactorUniqueness -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GermLike -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GradedDivisibility -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.InfiniteSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFinite -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFiniteMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPart -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartSeries -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedMaximalFinite -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PreSchreier -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalMaximalFinite -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringLocalization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringPrimality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVGradedMaximalFinite -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalFinite -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesPrimality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducibleFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.FiniteSupportFactorUniqueness +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GermLike +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GradedDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.InfiniteSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFiniteMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPart +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartSeries +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PreSchreier +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringLocalization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVGradedMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalFinite +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo.lean index eee27e2f14..b549747e21 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/DegreeTwo.lean @@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwo -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwoExample -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.Factorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.FactorizationClassification -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedSpanFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedTruncationSpan +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwo +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwoExample +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.Factorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.FactorizationClassification +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedSpanFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedTruncationSpan /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random.lean index 45e98a8942..5de520ae4c 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Random.lean @@ -4,20 +4,22 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ClassIrreducible -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.CoefficientRandom -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.GradedIrreducible -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.HereditaryIndependence -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.IndependenceWindow -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.MainTheorem -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NonPrincipalIrreducible -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NormalFormBlocks -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.PrincipalIrreducible -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.Random -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.RandomBlocks -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ReducibleSpan -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SuccessorStep -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SupportRandom -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.TruncationIndependence +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ClassIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.CoefficientRandom +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.GradedIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.HereditaryIndependence +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.IndependenceWindow +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.MainTheorem +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NonPrincipalIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NormalFormBlocks +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.PrincipalIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.Random +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.RandomBlocks +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ReducibleSpan +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SuccessorStep +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SupportRandom +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.TruncationIndependence /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements.lean index d751e3ece9..4554e3ba16 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Statements.lean @@ -4,16 +4,18 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.Factorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.FiniteSupportFactorUniqueness -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteSupportDivisor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalDivisibilityReflection -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalMaximalDivisor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalScalarRedistribution -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringFraction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringPrimality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesMaximalFiniteSupportDivisor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesPrimality +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.Factorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.FiniteSupportFactorUniqueness +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteSupportDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalDivisibilityReflection +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalMaximalDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalScalarRedistribution +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringFraction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesMaximalFiniteSupportDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesPrimality /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests.lean index 1819b22b2a..eb49c6efee 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests.lean @@ -4,17 +4,19 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducible -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducibleFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GermLikeFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GradedDivisibility -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.InfiniteSupportFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.MaximalFiniteSupportDivisor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPart -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPartMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.PrincipalMaximalFiniteSupportDivisor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SectionSixFour -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SeriesMaximalFiniteSupportDivisor +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducible +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducibleFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GermLikeFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GradedDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.InfiniteSupportFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.MaximalFiniteSupportDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPart +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPartMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.PrincipalMaximalFiniteSupportDivisor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SectionSixFour +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SeriesMaximalFiniteSupportDivisor /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo.lean index 34bcee3719..47eab39f3b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Factorization/Tests/DegreeTwo.lean @@ -4,8 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.FactorizationClassification -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedSpanFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedTruncationSpan +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.FactorizationClassification +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedSpanFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedTruncationSpan /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ.lean index b9cef5f768..eab2d5a796 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence.lean index e9c61c7bf3..501c3d46dc 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Germ/AlgebraicIndependence.lean @@ -4,46 +4,48 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Additive -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.AlgebraicIndependence -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Boundary -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Cancellation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonRankLevels -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValueMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CofactorInduction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Convolution -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationIdeal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationSet -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivative -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Germ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.GlobalCofactors -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Graded -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LeadingCoefficient -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Leibniz -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LiftFamily -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Lifts -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalEvaluation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalRelationAtCutoff -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LinearMaximal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LowerTruncationDegree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Multiplication -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Obligations -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.OrderedIntervalCantorBendixson -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativeIndices -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativesAtLimitOrdinal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Power -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PrincipalSeries -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Scalar -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.ScalarLeadingCoefficientAtLimitOrdinal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SeparatedPieceCantorBendixson -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SuccessorLeibniz -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SyzygyIntegration -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolationOnSets -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Truncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationExpansion -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationPolynomial +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Additive +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.AlgebraicIndependence +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Boundary +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Cancellation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonRankLevels +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValueMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CofactorInduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Convolution +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationSet +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivative +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Germ +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.GlobalCofactors +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Graded +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LeadingCoefficient +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Leibniz +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LiftFamily +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Lifts +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalEvaluation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalRelationAtCutoff +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LinearMaximal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LowerTruncationDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Multiplication +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Obligations +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.OrderedIntervalCantorBendixson +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativeIndices +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativesAtLimitOrdinal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Power +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PrincipalSeries +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Scalar +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.ScalarLeadingCoefficientAtLimitOrdinal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SeparatedPieceCantorBendixson +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SuccessorLeibniz +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SyzygyIntegration +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolationOnSets +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Truncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationExpansion +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationPolynomial /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart.lean index b5d8593f8b..037a48809d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart.lean @@ -4,28 +4,30 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Assumptions -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalFiniteClassReduction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalIntegerPartSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalPrimalityTransfer -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalProposition922 -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ClassTruncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassPrimality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassReduction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IntegerPartSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IrreducibilityTransfer -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.LimitTailPrimality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.PrimalityTransfer -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduced -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedCharacterization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedDivisibility -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedPrimality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.SplitTruncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationDivisibility -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationPrimality +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Assumptions +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalFiniteClassReduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalIntegerPartSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalPrimalityTransfer +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalProposition922 +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ClassTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassReduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IntegerPartSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IrreducibilityTransfer +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.LimitTailPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.PrimalityTransfer +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduced +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedCharacterization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedPrimality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.SplitTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationPrimality /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement.lean index 56fab8e44e..c213598ddb 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Refinement.lean @@ -4,15 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalGermRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalTruncationClosedClass -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ClosedClassRefinementTransport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CompleteGermRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ConvexRestrictionFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.FiniteGermError -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.LimitTailRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.TruncationIntegerPartFractionField +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalGermRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalTruncationClosedClass +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ClosedClassRefinementTransport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CompleteGermRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ConvexRestrictionFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.FiniteGermError +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.LimitTailRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.TruncationIntegerPartFractionField /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests.lean index 54cad67def..046b62e9e3 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/IntegerPart/Tests.lean @@ -4,20 +4,22 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Assumptions -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Basic -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalPrimalityTransfer -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalProposition922 -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ClassTruncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.FiniteClassReduction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.IntegerPartSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.PrimalityTransfer -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduced -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ReducedCharacterization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ReducedDivisibility -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.SplitTruncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.TruncationDivisibility -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.TruncationPrimality +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Assumptions +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Basic +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalPrimalityTransfer +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalProposition922 +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ClassTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.FiniteClassReduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.IntegerPartSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.PrimalityTransfer +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduced +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ReducedCharacterization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ReducedDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.SplitTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.TruncationDivisibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.TruncationPrimality /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue.lean index 7b2b2fa6ed..771e0c04e3 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue.lean @@ -4,56 +4,58 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CoefficientMap -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ComplexityDecrease -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionList -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionRemainder -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPoint -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPointExistence -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.FormalExpression -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermDegree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermValueCut -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Irreducibility -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.LeibnizRemainder -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.MainLemma -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OneRow -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrderTypeMultiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueConstantMul -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSubmultiplicative -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueValuation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PowerRemainder -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponent -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentDegree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentTensor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubring -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFraction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFractionAlgebraic -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringLocalization -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringMonoidAlgebra -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringScalarRedistributionProof -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalValue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PurePowerRemainder -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPoint -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointCofinality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointOrderType -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointTail -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointValue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointWellOrdered -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.TruncationDrop +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CoefficientMap +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ComplexityDecrease +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionList +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionRemainder +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPoint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPointExistence +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.FormalExpression +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermValueCut +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Irreducibility +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.LeibnizRemainder +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.MainLemma +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OneRow +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrderTypeMultiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueConstantMul +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSubmultiplicative +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueValuation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PowerRemainder +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponent +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentTensor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubring +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFraction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFractionAlgebraic +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringLocalization +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringMonoidAlgebra +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringScalarRedistributionProof +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PurePowerRemainder +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPoint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointCofinality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointOrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointTail +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointWellOrdered +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.TruncationDrop /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence.lean index eb21aeb1dd..bb1cf96c92 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/AlgebraicIndependence.lean @@ -4,45 +4,47 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.BaseChange -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonGrading -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRank -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRepresentatives -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CombinedCofactors -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAt -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAtInjective -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivationIdeal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.IdealFromTruncations -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.InductionOverDegrees -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LeadingCoefficient -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Lifts -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LimitOrdinalRelationAtCutoff -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LinearMaximal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LowDegreeParts -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LoweringDerivation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OmegaSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OrdinalValueCutoffs -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PartialDerivativeIndices -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Partials -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Pieces -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Polynomiality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalGraded -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalIdealGE -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductCondition -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductTruncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductValues -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.RealPartials -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SeriesTruncations -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Shift -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorLeibniz -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorSupportBound -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SumAlongCutoffs -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SupportLoweringPieces -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Syzygy -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationExpansion -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationPolynomial -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationsIdeal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.UnboundedTruncations +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.BaseChange +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonGrading +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRank +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRepresentatives +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CombinedCofactors +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAt +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAtInjective +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivationIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.IdealFromTruncations +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.InductionOverDegrees +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LeadingCoefficient +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Lifts +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LimitOrdinalRelationAtCutoff +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LinearMaximal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LowDegreeParts +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LoweringDerivation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OmegaSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OrdinalValueCutoffs +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PartialDerivativeIndices +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Partials +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Pieces +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Polynomiality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalIdealGE +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductCondition +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductValues +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.RealPartials +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SeriesTruncations +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Shift +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorLeibniz +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorSupportBound +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SumAlongCutoffs +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SupportLoweringPieces +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Syzygy +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationExpansion +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationPolynomial +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationsIdeal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.UnboundedTruncations /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements.lean index be9984c19f..fcc7e0e223 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Statements.lean @@ -4,9 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.MainLemma -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.OrdinalValueDegree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ResidualPoint +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.MainLemma +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.OrdinalValueDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ResidualPoint /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests.lean index d4a36b33c1..d06f04d3b9 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests.lean @@ -4,24 +4,26 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.BerarducciPrimitives -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ComplexityDecrease -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.Convolution -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ConvolutionList -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ConvolutionRemainder -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.CriticalPoint -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueFinalSegment -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueSubmultiplicative -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponent -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponentDegree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponentTensor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubring -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFiniteSupport -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFraction -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringTensor -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalValue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ResidualPoint -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.SectionSixThree +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.BerarducciPrimitives +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ComplexityDecrease +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.Convolution +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ConvolutionList +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ConvolutionRemainder +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.CriticalPoint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueFinalSegment +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueSubmultiplicative +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponent +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponentDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponentTensor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubring +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFiniteSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFraction +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringTensor +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalValue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ResidualPoint +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.SectionSixThree /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence.lean index cfd467ac0d..c4818ad03a 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/OrdinalValue/Tests/AlgebraicIndependence.lean @@ -4,14 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.BaseChange -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.CutoffConvolution -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.DerivAt -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.FinitePowerFamily -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.LoweringDerivation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.OmegaOmegaBoundary -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.PrincipalGraded -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.PrincipalIdealGE -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.SuccessorLeibniz +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.BaseChange +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.CutoffConvolution +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.DerivAt +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.FinitePowerFamily +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.LoweringDerivation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.OmegaOmegaBoundary +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.PrincipalGraded +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.PrincipalIdealGE +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.SuccessorLeibniz /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra.lean index d5c993a874..6481b93c28 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra.lean @@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.CompleteGerm -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.CompleteGermOfCauchyComplete -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.InitialForms -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialPresentation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialRing -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.CompleteGerm +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.CompleteGermOfCauchyComplete +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.InitialForms +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialPresentation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialRing +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests.lean index 0dbee91428..f0846e981a 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/PolynomialAlgebra/Tests.lean @@ -4,7 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests.GCDMonoid -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests.PolynomialRing +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests.GCDMonoid +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests.PolynomialRing /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality.lean index deee39588f..47de785620 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Primality.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Consequences -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.DegreeOne -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.GCDMonoid -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.OrdinalValueQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Primality -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Random -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.SupportOrderTypeFactorization +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Consequences +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.DegreeOne +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.GCDMonoid +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.OrdinalValueQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Primality +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Random +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.SupportOrderTypeFactorization /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests.lean index fd01aa4089..9ef19c7d77 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests.lean @@ -4,21 +4,23 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.ArchimedeanSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.CardinalTruncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportGCD -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportResidue -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportScalarExtension -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Iterate -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Multiplicativity -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NegativePresentation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NonpositiveDomainEquiv -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.OrderTypeDegree -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.PrincipalAddition -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Truncation -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.TruncationIntegerPartPrimal -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.WeakNormalForm +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.ArchimedeanSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.CardinalTruncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportGCD +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportResidue +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportScalarExtension +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Iterate +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Multiplicativity +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NegativePresentation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NonpositiveDomainEquiv +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.OrderTypeDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.PrincipalAddition +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Truncation +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.TruncationIntegerPartPrimal +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.WeakNormalForm /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Fixtures.lean b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Fixtures.lean index a47b53909d..d6bc09ae05 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Fixtures.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/HahnSeries/Tests/Fixtures.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra.lean b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra.lean index 63f1da6f54..d7b62e9d0b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra.lean @@ -4,9 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.AlgebraicIndependentDet -import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.FiniteSpanRelation -import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.IndicatorFinsupp -import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.AlgebraicIndependentDet +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.FiniteSpanRelation +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.IndicatorFinsupp +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct.lean b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct.lean index 5db674dea3..44d02f9017 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/LinearAlgebra/TensorProduct.lean @@ -4,7 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.Content -import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.SubalgebraBasis +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.Content +public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.SubalgebraBasis /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order.lean index 4d7bbabd23..86c454f071 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Order.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order.lean @@ -4,8 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Order.Archimedean -import LeanPool.ConwayRefinement.ConwayRefinement.Order.DifferenceAvoidance -import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Archimedean +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.DifferenceAvoidance +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter.lean index 940b14d65d..f0048b058b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter.lean @@ -4,8 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus -import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Germ -import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Tests +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Germ +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Tests /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ.lean index 442ad0418c..59a3f48237 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Germ.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Germ.LinearMap +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Germ.LinearMap /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Tests.lean index ef9bb5715e..5e34987697 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Order/Filter/Tests.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Tests.FunAtZeroMinus +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Tests.FunAtZeroMinus /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory.lean b/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory.lean index f754c9c6cf..eb3d95630f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/RingTheory.lean @@ -4,7 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LaurentTower -import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LocalizationUFM +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LaurentTower +public import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LocalizationUFM /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory.lean index ecd9fa92c7..df6d5dfddc 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory.lean @@ -4,8 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.FinitePWOUnion -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.FinitePWOUnion +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal.lean index bc883ac3c8..c8eb955ae8 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal.lean @@ -4,27 +4,29 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AlgebraicOrder -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorBendixson -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorTermCount -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Degree -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.GeneralFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.IncreasingSequenceUnion -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTerm -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTermSup -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.MultiplicativelyPrincipal -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalOrder -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPowerFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPrincipal -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.OrderedUnion -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.PairBounds -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Separation -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Split -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SuccessorFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Sumset -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AlgebraicOrder +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorBendixson +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorTermCount +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Degree +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.GeneralFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.IncreasingSequenceUnion +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTerm +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTermSup +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.MultiplicativelyPrincipal +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalOrder +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPowerFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPrincipal +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.OrderedUnion +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.PairBounds +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Separation +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Split +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SuccessorFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Sumset +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests.lean index 1b1a8d8f41..632eb92268 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/Ordinal/Tests.lean @@ -4,13 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.GeneralFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.NaturalPrincipal -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrderedUnion -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalFactors -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalFinitePart -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalSuccessorFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.SetOrderType -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.Sumset +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.GeneralFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.NaturalPrincipal +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrderedUnion +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalFactors +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalFinitePart +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalSuccessorFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.SetOrderType +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.Sumset /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC.lean index 9d8e65d51f..f355129a74 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC.lean @@ -4,8 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Game -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.GameOperations -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Game +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.GameOperations +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Tests.lean index 92e20b3827..715ef9472e 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/SetTheory/ZFC/Tests.lean @@ -4,7 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests.Game -import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests.GameOperations +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests.Game +public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests.GameOperations /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone.lean index a99548f0b5..c13a4393c7 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone.lean @@ -4,7 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames.lean index 592b718008..44264f4664 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames.lean @@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinementProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependence -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependenceProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinementProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependence +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependenceProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples.lean index ec0e238d13..0ea17ade82 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Examples.lean @@ -4,17 +4,19 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrime -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrimeProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamily -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamilyProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundary -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundaryProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRoots -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRootsProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorization -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorizationProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrime -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrimeProof +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrimeProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamily +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamilyProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundary +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundaryProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRoots +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRootsProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorization +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorizationProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrimeProof /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support.lean index eb215f4489..4b104ac016 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/Support.lean @@ -4,16 +4,18 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayNormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayRefinementConsequences -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.DegreeTwoExample -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamily -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamilyProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmegaOmegaBoundary -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFactorizationProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFiniteDegree -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificIntegers -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OneRowExample -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.PrincipalRVAlgebraicIndependenceProof +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayNormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayRefinementConsequences +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.DegreeTwoExample +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamily +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamilyProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmegaOmegaBoundary +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFactorizationProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFiniteDegree +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificIntegers +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OneRowExample +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.PrincipalRVAlgebraicIndependenceProof /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib.lean index 8bb9485e13..6ea53c4e5b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib.lean @@ -4,19 +4,21 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGerm -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGermProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRing -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRingProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinementProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCD -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCDProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRing -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRingProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinementProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGerm +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGermProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRing +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRingProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinementProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCD +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCDProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRing +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRingProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinementProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples.lean index 7f2b78981a..b38fe46f08 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Examples.lean @@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrime -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrimeProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterion -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterionProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRoots -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRootsProof +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrimeProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterion +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterionProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRoots +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRootsProof /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support.lean index 86d1250de6..1768f4544a 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support.lean @@ -4,20 +4,22 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ArchimedeanQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.CompleteHahnGermProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotientSplitting -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinementProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.GermPolynomialRingProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnIntegerPartRefinementProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnLimitTailQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesGCDProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesPolynomialRingProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineConwayRefinementProof -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineSurreal -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.OrderedAddGroup -import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.SeriesConsequences +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ArchimedeanQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.CompleteHahnGermProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotientSplitting +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinementProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.GermPolynomialRingProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnIntegerPartRefinementProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnLimitTailQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesGCDProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesPolynomialRingProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineConwayRefinementProof +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineSurreal +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.OrderedAddGroup +public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.SeriesConsequences /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal.lean index 51fcb2a8dd..e3efd165d4 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal.lean @@ -4,17 +4,19 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ArchimedeanAssumptions -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Cardinal -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.CutFilling -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RationalTailQuotient -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealArchimedeanStratum -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealModule -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Round -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.SmallDiscrete -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ArchimedeanAssumptions +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Cardinal +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.CutFilling +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RationalTailQuotient +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealArchimedeanStratum +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealModule +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Round +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.SmallDiscrete +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries.lean index 4367b90bec..9a7583020d 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries.lean @@ -4,21 +4,23 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.CardinalIntegerPart -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Degree -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.DegreeTransfer -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Full -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.IntegerPart -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Multiplication -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormAdd -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormBasic -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormMul -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormRecursion -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormSupport -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.RealLeadingSplit -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.SignedFull -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Transfer +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.CardinalIntegerPart +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Degree +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.DegreeTransfer +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Full +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.IntegerPart +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Multiplication +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormAdd +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormBasic +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormMul +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormRecursion +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormSupport +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.RealLeadingSplit +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.SignedFull +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Transfer /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests.lean index 06bedd9efd..2e00cd5857 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/HahnSeries/Tests.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.CardinalIntegerPart -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.DegreeTransfer -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.Full -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.Multiplication -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalFormAdd -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalFormMul +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.CardinalIntegerPart +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.DegreeTransfer +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.Full +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.Multiplication +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalFormAdd +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalFormMul /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger.lean index e7f9766aa9..60ef3d09f5 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Basic -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.NormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Ordinal -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Refinement -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.RefinementConjecture -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Basic +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Ordinal +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Refinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.RefinementConjecture +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality.lean index aa4c63f0ea..b35d18e64f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Primality.lean @@ -4,10 +4,12 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.FiniteClasses -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.IrreducibleOmnificIntegers -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OmnificIntegers -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OrdinaryIntegers -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.ZFC +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.FiniteClasses +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.IrreducibleOmnificIntegers +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OmnificIntegers +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OrdinaryIntegers +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.ZFC /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Refinement.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Refinement.lean index 4980b34c0e..b92f08b0d3 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Refinement.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Refinement.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Refinement.ConwayRefinement +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Refinement.ConwayRefinement /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests.lean index eafd52f005..518789ce43 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/OmnificInteger/Tests.lean @@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.Basic -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.ConwayRefinement -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.DegreeTwoOzPrime -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.FiniteClasses -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.NormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.ZFC +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.Basic +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.ConwayRefinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.DegreeTwoOzPrime +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.FiniteClasses +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.ZFC /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Tests.lean index 275432063d..a4e73be1c9 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/Tests.lean @@ -4,7 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.ArchimedeanAssumptions -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.RealModule +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.ArchimedeanAssumptions +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.RealModule /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC.lean index d260dd2eaf..b12a5ed797 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC.lean @@ -4,15 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Basic -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Cuts -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Identification -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.NormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificCodes -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificInteger -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Properness -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Reduced -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Refinement -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Basic +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Cuts +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Identification +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificCodes +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificInteger +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Properness +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Reduced +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Refinement +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests.lean index 3e6834e77f..dcc3e7e77f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Surreal/ZFC/Tests.lean @@ -4,9 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Cuts -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Identification -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.NormalForm -import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Properness +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Cuts +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Identification +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.NormalForm +public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Properness /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Tests.lean index e140da0468..04b4ffec62 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Tests.lean @@ -4,7 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Tests.SourceIndex -import LeanPool.ConwayRefinement.ConwayRefinement.Tests.UpstreamReuse +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Tests.SourceIndex +public import LeanPool.ConwayRefinement.ConwayRefinement.Tests.UpstreamReuse /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology.lean index 919611f888..8f7f634056 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology.lean @@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixson -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonProduct -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonRank -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonReconstruction -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Tests +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixson +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonProduct +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonRank +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonReconstruction +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Tests /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order.lean index a6e0e00e5c..1ede3f6368 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order.lean @@ -4,19 +4,21 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ArchimedeanBallBase -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonAddition -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonConvexCover -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ClosedPWO -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CoinitialComplete -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedAddGroup -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedIntervalFamily -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAddition -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAdditionFiber -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOSumset -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SeparatedPieceFamily -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SmallClosedSubspace -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ArchimedeanBallBase +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonAddition +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonConvexCover +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ClosedPWO +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CoinitialComplete +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedAddGroup +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedIntervalFamily +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAddition +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAdditionFiber +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOSumset +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SeparatedPieceFamily +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SmallClosedSubspace +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests.lean index 0c101d6e4b..726ce8257f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Order/Tests.lean @@ -4,7 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests.CantorBendixsonConvexCover -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests.PWOAddition +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests.CantorBendixsonConvexCover +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests.PWOAddition /-! Supporting modules for Conway refinement for omnific integers. -/ diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Tests.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Tests.lean index 61669bdf66..bf1f09551b 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Tests.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Topology/Tests.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Dan Abramov -/ -import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Tests.CantorBendixson +module + +public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Tests.CantorBendixson /-! Supporting modules for Conway refinement for omnific integers. -/ From 67f8a569cf9cbe722090954dadd4bc5645391af5 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 20:25:20 +0000 Subject: [PATCH 16/18] Correct ordinal-value multiplication citation --- .../PrincipalRVAlgebraicIndependence.lean | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/PrincipalRVAlgebraicIndependence.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/PrincipalRVAlgebraicIndependence.lean index 7f24d96258..91a6db8fd5 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/PrincipalRVAlgebraicIndependence.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/CombinatorialGames/PrincipalRVAlgebraicIndependence.lean @@ -23,9 +23,11 @@ order type of the support of a series congruent to `b` modulo `J + K`. Its value additively principal ordinals `ω^α`, and `J_{ω^α} := {b : v_J(b) < ω^α}`. For each `α`, `P_α := J_{ω^(α+1)} / J_{ω^α}` is the vector space of principal RV-elements of -degree `α`. Their direct sum is -`P̂ := ⨁_α P_α`, graded by the natural sum of ordinals: `v_J(bc) ≤ v_J(b) ⊕ v_J(c)` -[Ber00, Thm. 5.8], so the product of classes of degrees `α` and `β` is a class of degree `α ⊕ β`. +degree `α`. In characteristic zero, Berarducci's multiplicativity theorem gives +`v_J(bc) = v_J(b) ⊙ v_J(c)`, using the natural product of ordinals +[Ber00, Thm. 9.7; LM24, Fact 2.7.1]. Since `ω^α ⊙ ω^β = ω^(α ⊕ β)`, the direct sum +`P̂ := ⨁_α P_α` is graded by natural addition of the exponent degrees: the product of +classes of degrees `α` and `β` has degree `α ⊕ β`. A *minimal homogeneous family* in `P̂` is a family of classes `B ∈ P_{deg B}` of positive degrees whose members of each degree `β` are linearly independent modulo `(P̂_+)² ∩ P_β = ∑_{i ⊕ j = β, i, j ≠ 0} P_i P_j`, the square of the ideal of positive degree in @@ -46,7 +48,8 @@ series represent the same class exactly when their difference lies in `J_{ω^α} * A. Berarducci, *Factorization in generalized power series*, Trans. Amer. Math. Soc. 352 (2000) 553–577, cited as [Ber00]. * S. L'Innocente, V. Mantova, *A factorisation theory for generalised power series and omnific - integers*, Adv. Math. 442 (2024) 109513, cited as [LM24]. + integers*, Adv. Math. 442 (2024) 109513, cited as [LM24]; + [Fact 2.7.1 in arXiv:1710.07304v5](https://arxiv.org/html/1710.07304v5#S2.SS7). -/ open Ordinal From dcb473579a7188c55309767316b3630ff78841f9 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sat, 26 Sep 2026 04:16:20 +0000 Subject: [PATCH 17/18] refactor(ConwayRefinement): focus the public umbrella --- LeanPool/ConwayRefinement.lean | 681 --------------------------------- 1 file changed, 681 deletions(-) diff --git a/LeanPool/ConwayRefinement.lean b/LeanPool/ConwayRefinement.lean index aa322c8c94..7baa5faae1 100644 --- a/LeanPool/ConwayRefinement.lean +++ b/LeanPool/ConwayRefinement.lean @@ -6,687 +6,6 @@ Authors: Dan Abramov module -public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Basic -public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Birthday -public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Classes -public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Functor -public import LeanPool.ConwayRefinement.CombinatorialGames.Game.IGame -public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Ordinal -public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Player -public import LeanPool.ConwayRefinement.CombinatorialGames.Game.Special -public import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Dyadic -public import LeanPool.ConwayRefinement.CombinatorialGames.Mathlib.Small -public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Basic -public import LeanPool.ConwayRefinement.CombinatorialGames.NatOrdinal.Pow -public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Basic -public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Birthday.Basic -public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Division -public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Dyadic -public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.HahnSeries.Basic -public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Leading -public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Multiplication -public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Ordinal -public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Pow -public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Real -public import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.AddInstances -public import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.GameCmp -public import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.OrdinalAlias -public import LeanPool.ConwayRefinement.CombinatorialGames.Tactic.Register -public import LeanPool.ConwayRefinement.ConwayRefinement -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermChainRule -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermFinitePartIdeal -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermPolynomial -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSuccessorStep -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.GermSyzygy -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousDivisibility -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.HomogeneousPrime -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.InternalGrading -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.LeadingGrade -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.DirectSum.TrailingGrade -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.DenominatorIdeal -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.MaximalDivisor -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalPreimage -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.PrimalProduct -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Refinement -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Divisibility.Tests.Refinement -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GeometricIntegrality -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.Extension -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.FinitePartSubstitution -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousSpan -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.HomogeneousZeroDivisors -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.GradedRing.OrdinalGenerators -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.BaseChange -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Correction -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.FilteredModule -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Grading -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.IdealGEGraded -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Mu -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.LoweringDerivation.Polynomial -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.LatticeFunctional -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MonoidAlgebra.SingleZeroFactors -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.BaseChange -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Components -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.ComponentsSpan -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Expansion -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartDecomposition -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartErasure -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.FinitePartVars -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.GCDMonoid -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.LimitOrdinalContradiction -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.MapWeight -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalDerivation -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.OrdinalExpansion -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.RemainderBound -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.Syzygy -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.TermDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.MvPolynomial.WeightedTotalDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanBall -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ArchimedeanQuotient -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.ConvexQuotient -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ArchimedeanBallSplitting -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.ConvexQuotientSplitting -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Order.Module.Tests.ArchimedeanBallSplitting -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Ring.Hom.OfInjectiveComp -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Tests.GeometricIntegrality -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedDivisibility -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.AssociatedGradedValuation -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.BasisOver -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGraded -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedDomain -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedMap -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeAssociatedGradedQuotient -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeInitialForm -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeOver -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreePrincipalInitialIdeal -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeRepresentatives -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeScalar -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeSum -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.DegreeWeightedPolynomial -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.FiltrationDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.MaxAddDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.OfValuation -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.QuotientDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.RV -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Residue -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.ResidueMathlib -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.AssociatedGraded -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.AssociatedGradedValuation -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.DegreeAssociatedGraded -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.DegreeAssociatedGradedQuotient -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.FiltrationDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialAssociatedGraded -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Fixtures.PolynomialQuotientDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.QuotientDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.RV -public import LeanPool.ConwayRefinement.ConwayRefinement.Algebra.Valuation.Tests.Residue -public import LeanPool.ConwayRefinement.ConwayRefinement.Blueprint -public import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.SelectionComplexity -public import LeanPool.ConwayRefinement.ConwayRefinement.Data.Multiset.Tests.SelectionComplexity -public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoNormalForm -public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.DegreeTwoPrime -public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowNormalForm -public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.OneRowPrime -public import LeanPool.ConwayRefinement.ConwayRefinement.Examples.OmnificInteger.ZFCDegreeTwoPrime -public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LatticeFactorCoefficients -public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.LaurentFactorCoefficients -public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.MonicFactorCoefficients -public import LeanPool.ConwayRefinement.ConwayRefinement.FieldTheory.RelativeAlgebraicClosure -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ArchimedeanSplitting -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEmbedding -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationDomainEquiv -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationIrreducible -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CardinalTruncationResidue -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CharZero -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.CoefficientMap -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexFactorSupport -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.ConvexQuotientSplitting -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.PrincipalMultiplicativity -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.Degree -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeResidue -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Statements.DegreeValuation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.SupportSupremumMultiplicativity -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Degree.Tests.SupportSupremumMultiplicativity -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeTermCount -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DegreeValuation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Domain -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEmbedding -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainEquiv -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.DomainOrderType -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.EPrimitive -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FactorCoefficients -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducible -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.AlmostIrreducibleFactorization -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwo -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.DegreeTwoExample -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.Factorization -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.FactorizationClassification -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedSpanFactorization -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.DegreeTwo.TranslatedTruncationSpan -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.FiniteSupportFactorUniqueness -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GermLike -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.GradedDivisibility -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.InfiniteSupport -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFinite -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.MaximalFiniteMultiplicativity -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPart -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartMultiplicativity -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedHPartSeries -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedMaximalFinite -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.NormalizedSeriesMaximalFinite -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PreSchreier -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalMaximalFinite -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringLocalization -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.PrincipalSubringPrimality -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVGradedMaximalFinite -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.RVMaximalFinite -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ClassIrreducible -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.CoefficientRandom -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.GradedIrreducible -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.HereditaryIndependence -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.IndependenceWindow -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.MainTheorem -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NonPrincipalIrreducible -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.NormalFormBlocks -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.PrincipalIrreducible -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.Random -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.RandomBlocks -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.ReducibleSpan -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SuccessorStep -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.SupportRandom -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Random.TruncationIndependence -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalFinite -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesMaximalMultiplicativity -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.SeriesPrimality -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.Factorization -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.FiniteSupportFactorUniqueness -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteMultiplicativity -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.MaximalFiniteSupportDivisor -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalDivisibilityReflection -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalMaximalDivisor -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalScalarRedistribution -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringFraction -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.PrincipalSubringPrimality -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesMaximalFiniteSupportDivisor -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Statements.SeriesPrimality -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducible -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.AlmostIrreducibleFactorization -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.FactorizationClassification -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedSpanFactorization -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.DegreeTwo.TranslatedTruncationSpan -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GermLikeFactorization -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.GradedDivisibility -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.InfiniteSupportFactorization -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.MaximalFiniteSupportDivisor -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPart -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.NormalizedHPartMultiplicativity -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.PrincipalMaximalFiniteSupportDivisor -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SectionSixFour -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Factorization.Tests.SeriesMaximalFiniteSupportDivisor -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupport -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportConstantTermOne -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportGCDProof -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportMonoidAlgebra -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalization -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportNormalizedGCD -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportResidue -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarExtension -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportScalarTensor -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.FiniteSupportUnit -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Additive -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.AlgebraicIndependence -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Boundary -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Cancellation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonRankLevels -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValue -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CantorBendixsonValueMultiplicativity -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.CofactorInduction -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Convolution -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationIdeal -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.DerivationSet -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Derivative -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Germ -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.GlobalCofactors -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Graded -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LeadingCoefficient -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Leibniz -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LiftFamily -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Lifts -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalEvaluation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LimitOrdinalRelationAtCutoff -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LinearMaximal -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.LowerTruncationDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Multiplication -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Obligations -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.OrderedIntervalCantorBendixson -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativeIndices -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PartialDerivativesAtLimitOrdinal -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Power -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.PrincipalSeries -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Scalar -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.ScalarLeadingCoefficientAtLimitOrdinal -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SeparatedPieceCantorBendixson -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SuccessorLeibniz -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.SyzygyIntegration -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TranslatedTruncationInterpolationOnSets -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.Truncation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationExpansion -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Germ.AlgebraicIndependence.TruncationPolynomial -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Assumptions -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalFiniteClassReduction -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalIntegerPartSplitting -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalPrimalityTransfer -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalProposition922 -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.CardinalSplitting -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ClassTruncation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassPrimality -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.FiniteClassReduction -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IntegerPartSplitting -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.IrreducibilityTransfer -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.LimitTailPrimality -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.PrimalityTransfer -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduced -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedCharacterization -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedDivisibility -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.ReducedPrimality -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Reduction -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalGermRefinement -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CardinalTruncationClosedClass -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ClosedClassRefinementTransport -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.CompleteGermRefinement -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.ConvexRestrictionFactorization -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.FiniteGermError -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.LimitTailRefinement -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassFactorization -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.SupportClassRefinement -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Refinement.TruncationIntegerPartFractionField -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.SplitTruncation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Assumptions -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Basic -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalPrimalityTransfer -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.CardinalProposition922 -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ClassTruncation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.FiniteClassReduction -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.IntegerPartSplitting -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.PrimalityTransfer -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduced -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ReducedCharacterization -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.ReducedDivisibility -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.Reduction -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.SplitTruncation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.TruncationDivisibility -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.Tests.TruncationPrimality -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationDivisibility -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IntegerPart.TruncationPrimality -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Iterate -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.IterateOrderType -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.LimitTailQuotient -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Monomial -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Multiplicativity -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Negative -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NegativeMonomialIdeal -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Nonpositive -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveCoefficientMap -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NonpositiveDomainEquiv -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.NormalForm -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderType -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrderedIntervalSum -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.BaseChange -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonGrading -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRank -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CantorBendixsonRepresentatives -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.CombinedCofactors -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAt -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivAtInjective -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.DerivationIdeal -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.IdealFromTruncations -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.InductionOverDegrees -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LeadingCoefficient -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Lifts -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LimitOrdinalRelationAtCutoff -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LinearMaximal -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LowDegreeParts -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.LoweringDerivation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OmegaSupport -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.OrdinalValueCutoffs -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PartialDerivativeIndices -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Partials -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Pieces -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Polynomiality -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalGraded -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalIdealGE -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.PrincipalRepresentatives -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductCondition -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductTruncation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.ProductValues -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.RealPartials -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SeriesTruncations -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Shift -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorLeibniz -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SuccessorSupportBound -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SumAlongCutoffs -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.SupportLoweringPieces -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.Syzygy -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationExpansion -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationPolynomial -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.TruncationsIdeal -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.AlgebraicIndependence.UnboundedTruncations -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CoefficientMap -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ComplexityDecrease -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Convolution -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionList -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ConvolutionRemainder -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPoint -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.CriticalPointExistence -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.FormalExpression -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Germ -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.GermValueCut -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Irreducibility -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.LeibnizRemainder -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.MainLemma -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OneRow -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrderTypeMultiplicativity -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValue -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueConstantMul -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueFinalSegment -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueImage -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSubmultiplicative -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueSupport -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.OrdinalValueValuation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PowerRemainder -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponent -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalComponentTensor -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubring -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFiniteSupport -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFraction -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringFractionAlgebraic -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringLocalization -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringMonoidAlgebra -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringScalarRedistributionProof -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalSubringTensor -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PrincipalValue -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.PurePowerRemainder -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPoint -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointCofinality -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointOrderType -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointSupport -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointTail -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointValue -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.ResidualPointWellOrdered -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.StableInterval -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.MainLemma -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.OrdinalValueDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ProductValue -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Statements.ResidualPoint -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.BaseChange -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.CutoffConvolution -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.DerivAt -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.FinitePowerFamily -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.LoweringDerivation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.OmegaOmegaBoundary -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.PrincipalGraded -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.PrincipalIdealGE -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.AlgebraicIndependence.SuccessorLeibniz -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.BerarducciPrimitives -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ComplexityDecrease -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.Convolution -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ConvolutionList -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ConvolutionRemainder -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.CriticalPoint -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueFinalSegment -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.OrdinalValueSubmultiplicative -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponent -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponentDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalComponentTensor -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubring -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFiniteSupport -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringFraction -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalSubringTensor -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.PrincipalValue -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.ResidualPoint -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Tests.SectionSixThree -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.Truncation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.OrdinalValue.TruncationDrop -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.CompleteGerm -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.CompleteGermOfCauchyComplete -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.InitialForms -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialPresentation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.PolynomialRing -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests.GCDMonoid -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PolynomialAlgebra.Tests.PolynomialRing -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Consequences -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.DegreeOne -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.GCDMonoid -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.OrdinalValueQuotient -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Primality -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.Random -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Primality.SupportOrderTypeFactorization -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.PrincipalAddition -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.RealSupportSupremum -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedPieceSum -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SeparatedSupport -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SourceStatements -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupAlgebra -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupGCD -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SubgroupSupport -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportArchimedeanClasses -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.SupportSupremum -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.ArchimedeanSplitting -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.CardinalTruncation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportGCD -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportResidue -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.FiniteSupportScalarExtension -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Fixtures.ApproachZero -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Iterate -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Multiplicativity -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NegativePresentation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NonpositiveDomainEquiv -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.NormalForm -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.OrderTypeDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.PrincipalAddition -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.Truncation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.TruncationIntegerPartPrimal -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Tests.WeakNormalForm -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Translation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.Truncation -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.TruncationIntegerPartPrimal -public import LeanPool.ConwayRefinement.ConwayRefinement.HahnSeries.WeakNormalForm -public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.AlgebraicIndependentDet -public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.FiniteSpanRelation -public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.IndicatorFinsupp -public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.Content -public import LeanPool.ConwayRefinement.ConwayRefinement.LinearAlgebra.TensorProduct.SubalgebraBasis -public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Archimedean -public import LeanPool.ConwayRefinement.ConwayRefinement.Order.DifferenceAvoidance -public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus -public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.FunAtZeroMinus.Pointwise -public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Germ.LinearMap -public import LeanPool.ConwayRefinement.ConwayRefinement.Order.Filter.Tests.FunAtZeroMinus -public import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LaurentTower -public import LeanPool.ConwayRefinement.ConwayRefinement.RingTheory.LocalizationUFM -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.FinitePWOUnion -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AdditivelyPrincipal -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.AlgebraicOrder -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorBendixson -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.CantorTermCount -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Degree -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.FinitePart -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.GeneralFactorization -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.IncreasingSequenceUnion -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTerm -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.LeastTermSup -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.MultiplicativelyPrincipal -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalOrder -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPowerFactorization -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.NaturalPrincipal -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.OrderedUnion -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.PairBounds -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Separation -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SetOrderType -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Split -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.SuccessorFactorization -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Sumset -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.GeneralFactorization -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.NaturalPrincipal -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrderedUnion -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalFactors -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalFinitePart -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.OrdinalSuccessorFactorization -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.SetOrderType -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.Ordinal.Tests.Sumset -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Game -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.GameOperations -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests.Game -public import LeanPool.ConwayRefinement.ConwayRefinement.SetTheory.ZFC.Tests.GameOperations -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinement -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.ConwayRefinementProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrime -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.DegreeTwoPrimeProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamily -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.FiniteDegreeFamilyProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundary -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaOmegaBoundaryProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRoots -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmegaRootsProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorization -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OmnificFactorizationProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrime -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Examples.OneRowPrimeProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependence -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.PrincipalRVAlgebraicIndependenceProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayNormalForm -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.ConwayRefinementConsequences -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.DegreeTwoExample -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamily -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.FinitePowerFamilyProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmegaOmegaBoundary -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFactorizationProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificFiniteDegree -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OmnificIntegers -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.OneRowExample -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.CombinatorialGames.Support.PrincipalRVAlgebraicIndependenceProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGerm -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.CompleteHahnGermProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrime -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.DegreeTwoPrimeProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterion -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.HahnIntegerPartRefinementCriterionProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRoots -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Examples.NegativeMonomialRootsProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRing -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.GermPolynomialRingProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinement -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnIntegerPartRefinementProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCD -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesGCDProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRing -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.HahnSeriesPolynomialRingProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinement -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.InlineConwayRefinementProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ArchimedeanQuotient -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.CompleteHahnGermProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotient -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConvexQuotientSplitting -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinement -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.ConwayRefinementProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.GermPolynomialRingProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnIntegerPartRefinementProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnLimitTailQuotient -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesGCDProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.HahnSeriesPolynomialRingProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineConwayRefinementProof -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.InlineSurreal -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.OrderedAddGroup -public import LeanPool.ConwayRefinement.ConwayRefinement.Standalone.Mathlib.Support.SeriesConsequences -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ArchimedeanAssumptions -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Cardinal -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.CutFilling -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.CardinalIntegerPart -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Degree -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.DegreeTransfer -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Full -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.IntegerPart -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Multiplication -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalForm -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormAdd -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormBasic -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormMul -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormRecursion -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.NormalFormSupport -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.RealLeadingSplit -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.SignedFull -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.CardinalIntegerPart -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.DegreeTransfer -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.Full -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.Multiplication -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalForm -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalFormAdd -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Tests.NormalFormMul -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.HahnSeries.Transfer -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Basic -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.NormalForm -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Ordinal -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.FiniteClasses -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.IrreducibleOmnificIntegers -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OmnificIntegers -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.OrdinaryIntegers -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Primality.ZFC -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Refinement.ConwayRefinement -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.RefinementConjecture -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.Basic -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.ConwayRefinement -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.DegreeTwoOzPrime -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.FiniteClasses -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.NormalForm -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.OmnificInteger.Tests.ZFC -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RationalTailQuotient -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealArchimedeanStratum -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.RealModule -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Round -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.SmallDiscrete -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.ArchimedeanAssumptions -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.Tests.RealModule -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Basic -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Cuts -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Identification -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.NormalForm -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificCodes -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.OmnificInteger -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Properness -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Reduced -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Refinement -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Cuts -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Identification -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.NormalForm -public import LeanPool.ConwayRefinement.ConwayRefinement.Surreal.ZFC.Tests.Properness -public import LeanPool.ConwayRefinement.ConwayRefinement.Tests.SourceIndex -public import LeanPool.ConwayRefinement.ConwayRefinement.Tests.UpstreamReuse -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixson -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonProduct -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonRank -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.CantorBendixsonReconstruction -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ArchimedeanBallBase -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonAddition -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CantorBendixsonConvexCover -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.ClosedPWO -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.CoinitialComplete -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.LeftNeighborhood -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedAddGroup -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.OrderedIntervalFamily -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAddition -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOAdditionFiber -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.PWOSumset -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SeparatedPieceFamily -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.SmallClosedSubspace -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests.CantorBendixsonConvexCover -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Order.Tests.PWOAddition -public import LeanPool.ConwayRefinement.ConwayRefinement.Topology.Tests.CantorBendixson public import LeanPool.ConwayRefinement.Solution /-! From b7a2a4e23804adc9ca66be3dfba1d1a1ee6fbabf Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sat, 26 Sep 2026 18:04:28 +0000 Subject: [PATCH 18/18] refactor(ConwayRefinement): bridge directly to shared surreal foundations --- .../Support/InlineConwayRefinementProof.lean | 794 +---- .../Mathlib/Support/InlineSurreal.lean | 3051 +---------------- 2 files changed, 111 insertions(+), 3734 deletions(-) diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean index 2edc6384f0..f1639a613a 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineConwayRefinementProof.lean @@ -21,22 +21,22 @@ namespace ConwayRefinement.Standalone.InlineConwayRefinement universe u -/-- The auxiliary game representation supplied by the standalone surreal development. -/ -abbrev SupportGame := ConwayRefinement.Standalone.InlineSurreal.IGame +/-- The shared CombinatorialGames representation used by the proof bridge. -/ +abbrev SupportGame := _root_.IGame /-- Recursively convert an indexed Conway game to the auxiliary representation by its option sets. -/ noncomputable def Game.toSupport : Game.{u} → SupportGame.{u} | .mk Left Right left right => - ConwayRefinement.Standalone.InlineSurreal.ofSets - (ConwayRefinement.Standalone.InlineSurreal.Player.cases + _root_.OfSets.ofSets + (_root_.Player.cases (Set.range fun i : Left ↦ Game.toSupport (left i)) (Set.range fun i : Right ↦ Game.toSupport (right i))) trivial /-- Convert an auxiliary game to an indexed Conway game by shrinking its left and right option sets. -/ @[expose] noncomputable def Game.fromSupport (x : SupportGame.{u}) : Game.{u} := - ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn x fun s t _ _ hs ht ↦ + _root_.IGame.ofSetsRecOn x fun s t _ _ hs ht ↦ .mk (Shrink s) (Shrink t) (fun i ↦ let z := (equivShrink s).symm i @@ -47,32 +47,31 @@ sets. -/ theorem Game.fromSupport_ofSets (s t : Set SupportGame.{u}) [Small.{u} s] [Small.{u} t] : Game.fromSupport - (ConwayRefinement.Standalone.InlineSurreal.ofSets - (ConwayRefinement.Standalone.InlineSurreal.Player.cases s t) trivial) = + (_root_.OfSets.ofSets + (_root_.Player.cases s t) trivial) = .mk (Shrink s) (Shrink t) (fun i ↦ Game.fromSupport ((equivShrink s).symm i).1) (fun i ↦ Game.fromSupport ((equivShrink t).symm i).1) := by rw [Game.fromSupport, - ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn_ofSets] + _root_.IGame.ofSetsRecOn_ofSets] simp only [Game.fromSupport] theorem Game.toSupport_fromSupport (x : SupportGame.{u}) : Game.toSupport (Game.fromSupport x) = x := by - induction x using ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn with + induction x using _root_.IGame.ofSetsRecOn with | ofSets s t ihs iht => simp only [Game.fromSupport, - ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn_ofSets, Game.toSupport] - apply ConwayRefinement.Standalone.InlineSurreal.IGame.ext + _root_.IGame.ofSetsRecOn_ofSets, Game.toSupport] + apply _root_.IGame.ext intro p - simp only [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] + simp only [_root_.IGame.moves_ofSets] cases p · ext z constructor · rintro ⟨i, rfl⟩ let y := (equivShrink s).symm i change Game.toSupport (Game.fromSupport y.1) ∈ s - rw [ihs y.1 y.2] - exact y.2 + simpa only [ihs y.1 y.2] using y.2 · intro hz let i := equivShrink s ⟨z, hz⟩ refine ⟨i, ?_⟩ @@ -82,8 +81,7 @@ theorem Game.toSupport_fromSupport (x : SupportGame.{u}) : · rintro ⟨i, rfl⟩ let y := (equivShrink t).symm i change Game.toSupport (Game.fromSupport y.1) ∈ t - rw [iht y.1 y.2] - exact y.2 + simpa only [iht y.1 y.2] using y.2 · intro hz let i := equivShrink t ⟨z, hz⟩ refine ⟨i, ?_⟩ @@ -95,10 +93,10 @@ theorem Game.toSupport_neg (x : Game.{u}) : | mk Left Right left right ihLeft ihRight => rw [Game.neg_mk] simp only [Game.toSupport] - rw [ConwayRefinement.Standalone.InlineSurreal.IGame.neg_ofSets] - apply ConwayRefinement.Standalone.InlineSurreal.IGame.ext + rw [_root_.IGame.neg_ofSets] + apply _root_.IGame.ext intro p - simp only [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] + simp only [_root_.IGame.moves_ofSets] cases p · calc Set.range (fun i ↦ Game.toSupport (Game.neg (right i))) = @@ -128,9 +126,9 @@ theorem Game.toSupport_le (x y : Game.{u}) : cases y with | mk Ly Ry ly ry => rw [Game.le_mk] - rw [ConwayRefinement.Standalone.InlineSurreal.IGame.le_iff_forall_lf] + rw [_root_.IGame.le_iff_forall_lf] simp only [Game.toSupport, - ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets, Set.forall_mem_range] + _root_.IGame.moves_ofSets, Set.forall_mem_range] constructor · rintro ⟨hLeft, hRight⟩ constructor @@ -146,12 +144,12 @@ theorem Game.toSupport_le (x y : Game.{u}) : exact hRight j ((ih _ _ (Sym2.GameAdd.fst_snd (Game.Move.right j))).mp h) theorem Game.Numeric.toSupport {x : Game.{u}} (h : Game.Numeric x) : - ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric (Game.toSupport x) := by + _root_.IGame.Numeric (Game.toSupport x) := by induction h with | mk hOrder hLeft hRight ihLeft ihRight => - rw [ConwayRefinement.Standalone.InlineSurreal.IGame.numeric_def] + rw [_root_.IGame.numeric_def] simp only [Game.toSupport, - ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets, Set.forall_mem_range] + _root_.IGame.moves_ofSets, Set.forall_mem_range] constructor · intro i j obtain ⟨hij, hji⟩ := Game.less_iff _ _ |>.mp (hOrder i j) @@ -168,14 +166,14 @@ theorem Game.Numeric.toSupport {x : Game.{u}} (h : Game.Numeric x) : exact ihRight j theorem Game.Numeric.fromSupport {x : SupportGame.{u}} - (h : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric x) : + (h : _root_.IGame.Numeric x) : Game.Numeric (Game.fromSupport x) := by revert h - induction x using ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn with + induction x using _root_.IGame.ofSetsRecOn with | ofSets s t ihLeft ihRight => intro h - have hdef := ConwayRefinement.Standalone.InlineSurreal.IGame.numeric_def.mp h - simp only [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] at hdef + have hdef := _root_.IGame.numeric_def.mp h + simp only [_root_.IGame.moves_ofSets] at hdef rw [Game.fromSupport_ofSets] apply Game.Numeric.mk · intro i j @@ -194,11 +192,11 @@ theorem Game.Numeric.fromSupport {x : SupportGame.{u}} · intro i let a := (equivShrink s).symm i exact ihLeft a.1 a.2 - (hdef.2 ConwayRefinement.Standalone.InlineSurreal.Player.left a.1 a.2) + (hdef.2 _root_.Player.left a.1 a.2) · intro j let b := (equivShrink t).symm j exact ihRight b.1 b.2 - (hdef.2 ConwayRefinement.Standalone.InlineSurreal.Player.right b.1 b.2) + (hdef.2 _root_.Player.right b.1 b.2) theorem Game.toSupport_add (x y : Game.{u}) : Game.toSupport (Game.add x y) = Game.toSupport x + Game.toSupport y := by @@ -210,10 +208,10 @@ theorem Game.toSupport_add (x y : Game.{u}) : | mk Ly Ry ly ry => rw [Game.add_mk] simp only [Game.toSupport] - rw [ConwayRefinement.Standalone.InlineSurreal.IGame.ofSets_add_ofSets] - apply ConwayRefinement.Standalone.InlineSurreal.IGame.ext + rw [_root_.IGame.ofSets_add_ofSets] + apply _root_.IGame.ext intro p - simp only [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] + simp only [_root_.IGame.moves_ofSets] cases p · ext z simp only [Set.mem_range, Set.mem_union, Set.mem_image] @@ -260,7 +258,7 @@ theorem Game.toSupport_mul (x y : Game.{u}) : Game.toSupport (Game.add (Game.add (Game.mul a y) (Game.mul x b)) (Game.neg (Game.mul a b))) = - ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption + _root_.IGame.mulOption (Game.toSupport x) (Game.toSupport y) (Game.toSupport a) (Game.toSupport b) := by rw [Game.toSupport_add, Game.toSupport_add, Game.toSupport_neg, @@ -269,10 +267,10 @@ theorem Game.toSupport_mul (x y : Game.{u}) : rfl rw [Game.mul_mk] simp only [Game.toSupport] - rw [ConwayRefinement.Standalone.InlineSurreal.IGame.mul_eq] - apply ConwayRefinement.Standalone.InlineSurreal.IGame.ext + rw [_root_.IGame.mul_eq] + apply _root_.IGame.ext intro p - simp only [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] + simp only [_root_.IGame.moves_ofSets] cases p · ext z simp only [Set.mem_range, Set.mem_image, Set.mem_union, Set.mem_prod] @@ -311,48 +309,48 @@ theorem Game.toSupport_mul (x y : Game.{u}) : /-- Map a numeric indexed-game representative to its surreal value in the auxiliary model. -/ noncomputable def Surreal.toSupport (x : Surreal.{u}) : - ConwayRefinement.Standalone.InlineSurreal.Surreal.{u} := - @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk _ x.numeric.toSupport + _root_.Surreal.{u} := + @_root_.Surreal.mk _ x.numeric.toSupport theorem Surreal.toSupport_eq (x : Surreal.{u}) : - x.toSupport = @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk _ x.numeric.toSupport := + x.toSupport = @_root_.Surreal.mk _ x.numeric.toSupport := (rfl) /-- Choose a numeric indexed-game representative of a surreal number in the auxiliary model. -/ noncomputable def Surreal.fromSupport - (x : ConwayRefinement.Standalone.InlineSurreal.Surreal.{u}) : Surreal.{u} := + (x : _root_.Surreal.{u}) : Surreal.{u} := ⟨Game.fromSupport x.out, Game.Numeric.fromSupport inferInstance⟩ theorem Surreal.fromSupport_game - (x : ConwayRefinement.Standalone.InlineSurreal.Surreal.{u}) : + (x : _root_.Surreal.{u}) : (Surreal.fromSupport x).game = Game.fromSupport x.out := (rfl) theorem Surreal.toSupport_fromSupport - (x : ConwayRefinement.Standalone.InlineSurreal.Surreal.{u}) : + (x : _root_.Surreal.{u}) : (Surreal.fromSupport x).toSupport = x := by - let : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric + let : _root_.IGame.Numeric (Game.toSupport (Surreal.fromSupport x).game) := (Surreal.fromSupport x).numeric.toSupport rw [Surreal.toSupport_eq] calc - ConwayRefinement.Standalone.InlineSurreal.Surreal.mk + _root_.Surreal.mk (Game.toSupport (Surreal.fromSupport x).game) = - ConwayRefinement.Standalone.InlineSurreal.Surreal.mk x.out := by - apply ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq + _root_.Surreal.mk x.out := by + apply _root_.Surreal.mk_eq have heq : Game.toSupport (Surreal.fromSupport x).game = x.out := congrArg Game.toSupport (Surreal.fromSupport_game x) |>.trans (Game.toSupport_fromSupport x.out) rw [heq] - _ = x := ConwayRefinement.Standalone.InlineSurreal.Surreal.out_eq x + _ = x := _root_.Surreal.out_eq x theorem Surreal.gameEquivalent_iff_toSupport_eq (x y : Surreal.{u}) : Game.Equivalent x.game y.game ↔ x.toSupport = y.toSupport := by - let : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric (Game.toSupport x.game) := + let : _root_.IGame.Numeric (Game.toSupport x.game) := x.numeric.toSupport - let : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric (Game.toSupport y.game) := + let : _root_.IGame.Numeric (Game.toSupport y.game) := y.numeric.toSupport rw [Surreal.toSupport_eq, Surreal.toSupport_eq, - ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk, Game.equivalent_iff] + _root_.Surreal.mk_eq_mk, Game.equivalent_iff] change (Game.Le x.game y.game ∧ Game.Le y.game x.game) ↔ (Game.toSupport x.game ≤ Game.toSupport y.game ∧ Game.toSupport y.game ≤ Game.toSupport x.game) @@ -372,7 +370,7 @@ def Surreal.QuotientModel : Type (u + 1) := /-- The map from indexed games modulo numeric equivalence to the auxiliary surreal model. -/ noncomputable def Surreal.QuotientModel.toSupport : Surreal.QuotientModel.{u} → - ConwayRefinement.Standalone.InlineSurreal.Surreal.{u} := + _root_.Surreal.{u} := Quotient.lift Surreal.toSupport fun _ _ h ↦ Surreal.gameEquivalent_iff_toSupport_eq _ _ |>.mp h @@ -386,578 +384,21 @@ theorem Surreal.QuotientModel.toSupport_bijective : intro x y h apply Quotient.sound exact Surreal.gameEquivalent_iff_toSupport_eq x y |>.mpr h - · intro (x : ConwayRefinement.Standalone.InlineSurreal.Surreal.{v}) + · intro (x : _root_.Surreal.{v}) exact ⟨Quotient.mk _ (Surreal.fromSupport x), Surreal.toSupport_fromSupport x⟩ /-- The quotient of the headline's numeric games is equivalent to the fully developed inlined surreal numbers. -/ noncomputable def Surreal.quotientEquivSupport : Surreal.QuotientModel.{v} ≃ - ConwayRefinement.Standalone.InlineSurreal.Surreal.{v} := + _root_.Surreal.{v} := Equiv.ofBijective Surreal.QuotientModel.toSupport.{v} Surreal.QuotientModel.toSupport_bijective -namespace SupportBridge - -/-- Identify the left and right players of CombinatorialGames with the auxiliary player type. -/ -def playerToSupport : _root_.Player → ConwayRefinement.Standalone.InlineSurreal.Player - | .left => .left - | .right => .right - -/-- Recursively convert an auxiliary game to the CombinatorialGames representation. -/ -noncomputable def toCG (x : SupportGame.{u}) : _root_.IGame.{u} := - ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn x fun s t _ _ hs ht ↦ - !{Set.range fun y : s ↦ hs y.1 y.2 | Set.range fun y : t ↦ ht y.1 y.2} - -/-- Recursively convert a CombinatorialGames game to the auxiliary representation. -/ -noncomputable def fromCG (x : _root_.IGame.{u}) : SupportGame.{u} := - _root_.IGame.ofSetsRecOn x fun s t _ _ hs ht ↦ - ConwayRefinement.Standalone.InlineSurreal.ofSets - (ConwayRefinement.Standalone.InlineSurreal.Player.cases - (Set.range fun y : s ↦ hs y.1 y.2) - (Set.range fun y : t ↦ ht y.1 y.2)) trivial - -theorem fromCG_toCG (x : SupportGame.{u}) : fromCG (toCG x) = x := by - induction x using ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn with - | ofSets s t ihs iht => - rw [toCG, ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn_ofSets, - fromCG, _root_.IGame.ofSetsRecOn_ofSets] - apply ConwayRefinement.Standalone.InlineSurreal.IGame.ext - intro p - cases p - · rw [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets, - ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] - ext z - constructor - · rintro ⟨y, rfl⟩ - obtain ⟨x, hx⟩ := y.2 - change fromCG y.1 ∈ s - have hxy : fromCG y.1 = x.1 := - (congrArg fromCG hx).symm.trans (ihs x.1 x.2) - rw [hxy] - exact x.2 - · intro hz - refine ⟨⟨toCG z, ⟨⟨z, hz⟩, rfl⟩⟩, ?_⟩ - exact ihs z hz - · rw [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets, - ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] - ext z - constructor - · rintro ⟨y, rfl⟩ - obtain ⟨x, hx⟩ := y.2 - change fromCG y.1 ∈ t - have hxy : fromCG y.1 = x.1 := - (congrArg fromCG hx).symm.trans (iht x.1 x.2) - rw [hxy] - exact x.2 - · intro hz - refine ⟨⟨toCG z, ⟨⟨z, hz⟩, rfl⟩⟩, ?_⟩ - exact iht z hz - -theorem toCG_fromCG (x : _root_.IGame.{u}) : toCG (fromCG x) = x := by - induction x using _root_.IGame.ofSetsRecOn with - | ofSets s t ihs iht => - rw [fromCG, _root_.IGame.ofSetsRecOn_ofSets, - toCG, ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn_ofSets] - apply _root_.IGame.ext - intro p - cases p - · rw [_root_.IGame.moves_ofSets, _root_.IGame.moves_ofSets] - ext z - constructor - · rintro ⟨y, rfl⟩ - obtain ⟨x, hx⟩ := y.2 - change toCG y.1 ∈ s - have hxy : toCG y.1 = x.1 := - (congrArg toCG hx).symm.trans (ihs x.1 x.2) - rw [hxy] - exact x.2 - · intro hz - refine ⟨⟨fromCG z, ⟨⟨z, hz⟩, rfl⟩⟩, ?_⟩ - exact ihs z hz - · rw [_root_.IGame.moves_ofSets, _root_.IGame.moves_ofSets] - ext z - constructor - · rintro ⟨y, rfl⟩ - obtain ⟨x, hx⟩ := y.2 - change toCG y.1 ∈ t - have hxy : toCG y.1 = x.1 := - (congrArg toCG hx).symm.trans (iht x.1 x.2) - rw [hxy] - exact x.2 - · intro hz - refine ⟨⟨fromCG z, ⟨⟨z, hz⟩, rfl⟩⟩, ?_⟩ - exact iht z hz - -theorem moves_toCG (p : _root_.Player) (x : SupportGame.{u}) : - (toCG x).moves p = toCG '' x.moves (playerToSupport p) := by - induction x using ConwayRefinement.Standalone.InlineSurreal.IGame.ofSetsRecOn with - | ofSets s t _ _ => - cases p <;> simp [toCG, playerToSupport, Set.ext_iff] - -theorem toCG_le (x y : SupportGame.{u}) : x ≤ y ↔ toCG x ≤ toCG y := by - induction x, y using Sym2.GameAdd.recursion - ConwayRefinement.Standalone.InlineSurreal.IGame.subposition_wf with - | _ x y ih => - rw [ConwayRefinement.Standalone.InlineSurreal.IGame.le_iff_forall_lf, - _root_.IGame.le_iff_forall_lf, moves_toCG, moves_toCG] - simp only [playerToSupport, Set.forall_mem_image] - constructor - · rintro ⟨hLeft, hRight⟩ - constructor - · intro z hz h - exact hLeft z hz ((ih _ _ (Sym2.GameAdd.snd_fst - (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hz))).mpr h) - · intro z hz h - exact hRight z hz ((ih _ _ (Sym2.GameAdd.fst_snd - (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hz))).mpr h) - · rintro ⟨hLeft, hRight⟩ - constructor - · intro z hz h - exact hLeft hz ((ih _ _ (Sym2.GameAdd.snd_fst - (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hz))).mp h) - · intro z hz h - exact hRight hz ((ih _ _ (Sym2.GameAdd.fst_snd - (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hz))).mp h) - -theorem playerToSupport_neg (p : _root_.Player) : playerToSupport (-p) = -playerToSupport p := by - cases p <;> rfl - -theorem playerToSupport_mul (p q : _root_.Player) : - playerToSupport (p * q) = playerToSupport p * playerToSupport q := by - cases p <;> cases q <;> rfl - -theorem toCG_neg (x : SupportGame.{u}) : toCG (-x) = -toCG x := by - induction x using ConwayRefinement.Standalone.InlineSurreal.IGame.moveRecOn with - | ind x ih => - apply _root_.IGame.ext - intro p - rw [moves_toCG, ConwayRefinement.Standalone.InlineSurreal.IGame.moves_neg, - _root_.IGame.moves_neg, moves_toCG, playerToSupport_neg] - rw [← Set.image_neg_eq_neg, ← Set.image_neg_eq_neg] - ext z - constructor - · rintro ⟨_, ⟨y, hy, rfl⟩, rfl⟩ - exact ⟨toCG y, ⟨y, hy, rfl⟩, (ih _ y hy).symm⟩ - · rintro ⟨_, ⟨y, hy, rfl⟩, rfl⟩ - exact ⟨-y, ⟨y, hy, rfl⟩, ih _ y hy⟩ - -theorem toCG_add (x y : SupportGame.{u}) : toCG (x + y) = toCG x + toCG y := by - induction x, y using Sym2.GameAdd.recursion - ConwayRefinement.Standalone.InlineSurreal.IGame.subposition_wf with - | _ x y ih => - apply _root_.IGame.ext - intro p - rw [moves_toCG, ConwayRefinement.Standalone.InlineSurreal.IGame.moves_add, - _root_.IGame.moves_add, moves_toCG, moves_toCG] - ext z - simp only [Set.mem_image, Set.mem_union] - constructor - · rintro ⟨_, (⟨a, ha, rfl⟩ | ⟨b, hb, rfl⟩), rfl⟩ - · left - refine ⟨toCG a, ⟨a, ha, rfl⟩, ?_⟩ - exact (ih _ _ (Sym2.GameAdd.fst - (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves ha))).symm - · right - refine ⟨toCG b, ⟨b, hb, rfl⟩, ?_⟩ - exact (ih _ _ (Sym2.GameAdd.snd - (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hb))).symm - · rintro (⟨_, ⟨a, ha, rfl⟩, rfl⟩ | ⟨_, ⟨b, hb, rfl⟩, rfl⟩) - · exact ⟨a + y, Or.inl ⟨a, ha, rfl⟩, - ih _ _ (Sym2.GameAdd.fst - (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves ha))⟩ - · exact ⟨x + b, Or.inr ⟨b, hb, rfl⟩, - ih _ _ (Sym2.GameAdd.snd - (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hb))⟩ - -theorem toCG_zero : toCG (0 : SupportGame.{u}) = 0 := by - apply _root_.IGame.ext - intro p - rw [moves_toCG, ConwayRefinement.Standalone.InlineSurreal.IGame.moves_zero, - _root_.IGame.moves_zero] - simp - -theorem toCG_one : toCG (1 : SupportGame.{u}) = 1 := by - apply _root_.IGame.ext - intro p - rw [moves_toCG] - cases p <;> - simp [ConwayRefinement.Standalone.InlineSurreal.IGame.one_def, _root_.IGame.one_def, - playerToSupport, toCG_zero] - -theorem toCG_mul (x y : SupportGame.{u}) : toCG (x * y) = toCG x * toCG y := by - have option_eq {a b : SupportGame.{u}} - (ha : ∃ q, a ∈ ConwayRefinement.Standalone.InlineSurreal.IGame.moves q x) - (hb : ∃ q, b ∈ ConwayRefinement.Standalone.InlineSurreal.IGame.moves q y) : - toCG (ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption x y a b) = - _root_.IGame.mulOption (toCG x) (toCG y) (toCG a) (toCG b) := by - rw [ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption, _root_.IGame.mulOption, - sub_eq_add_neg, sub_eq_add_neg, toCG_add, toCG_add, toCG_neg, - toCG_mul a y, toCG_mul x b, toCG_mul a b] - apply _root_.IGame.ext - intro p - rw [moves_toCG, ConwayRefinement.Standalone.InlineSurreal.IGame.moves_mul, - _root_.IGame.moves_mul, moves_toCG, moves_toCG, moves_toCG, moves_toCG, - playerToSupport_neg] - ext z - simp only [Set.mem_image, Set.mem_union, Set.mem_prod] - constructor - · rintro ⟨w, ⟨⟨a, b⟩, (⟨ha, hb⟩ | ⟨ha, hb⟩), hmul⟩, hw⟩ - · refine ⟨(toCG a, toCG b), Or.inl ⟨⟨a, ha, rfl⟩, ⟨b, hb, rfl⟩⟩, ?_⟩ - calc - _root_.IGame.mulOption (toCG x) (toCG y) (toCG a) (toCG b) = - toCG (ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption x y a b) := - (option_eq ⟨_, ha⟩ ⟨_, hb⟩).symm - _ = toCG w := congrArg toCG hmul - _ = z := hw - · refine ⟨(toCG a, toCG b), Or.inr ⟨⟨a, ha, rfl⟩, ⟨b, hb, rfl⟩⟩, ?_⟩ - calc - _root_.IGame.mulOption (toCG x) (toCG y) (toCG a) (toCG b) = - toCG (ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption x y a b) := - (option_eq ⟨_, ha⟩ ⟨_, hb⟩).symm - _ = toCG w := congrArg toCG hmul - _ = z := hw - · rintro ⟨⟨qa, qb⟩, - (⟨⟨a, ha, hqa⟩, ⟨b, hb, hqb⟩⟩ | ⟨⟨a, ha, hqa⟩, ⟨b, hb, hqb⟩⟩), hmul⟩ - · refine ⟨ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption x y a b, - ⟨(a, b), Or.inl ⟨ha, hb⟩, rfl⟩, ?_⟩ - calc - toCG (ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption x y a b) = - _root_.IGame.mulOption (toCG x) (toCG y) (toCG a) (toCG b) := - option_eq ⟨_, ha⟩ ⟨_, hb⟩ - _ = _root_.IGame.mulOption (toCG x) (toCG y) qa qb := by rw [hqa, hqb] - _ = z := hmul - · refine ⟨ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption x y a b, - ⟨(a, b), Or.inr ⟨ha, hb⟩, rfl⟩, ?_⟩ - calc - toCG (ConwayRefinement.Standalone.InlineSurreal.IGame.mulOption x y a b) = - _root_.IGame.mulOption (toCG x) (toCG y) (toCG a) (toCG b) := - option_eq ⟨_, ha⟩ ⟨_, hb⟩ - _ = _root_.IGame.mulOption (toCG x) (toCG y) qa qb := by rw [hqa, hqb] - _ = z := hmul -termination_by (x, y) -decreasing_by - · obtain ⟨q, hq⟩ := ha - exact Prod.Lex.left _ _ - (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hq) - · obtain ⟨q, hq⟩ := hb - exact Prod.Lex.right _ - (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hq) - · obtain ⟨q, hq⟩ := ha - exact Prod.Lex.left _ _ - (ConwayRefinement.Standalone.InlineSurreal.IGame.Subposition.of_mem_moves hq) - - -theorem toCG_numeric {x : SupportGame.{u}} - (h : ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric x) : - _root_.IGame.Numeric (toCG x) := by - induction h with - | mk hOrder hMoves ih => - rw [_root_.IGame.numeric_def] - constructor - · intro y hy z hz - rw [moves_toCG] at hy hz - obtain ⟨y, hy, rfl⟩ := hy - obtain ⟨z, hz, rfl⟩ := hz - rw [lt_iff_le_not_ge, ← toCG_le, ← toCG_le] - exact hOrder y hy z hz - · intro p y hy - rw [moves_toCG] at hy - obtain ⟨y, hy, rfl⟩ := hy - exact ih (playerToSupport p) y hy - -theorem fromCG_numeric {x : _root_.IGame.{u}} (h : _root_.IGame.Numeric x) : - ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric (fromCG x) := by - revert h - induction x using _root_.IGame.moveRecOn with - | ind x ih => - intro h - have hdef := _root_.IGame.numeric_def.mp h - rw [ConwayRefinement.Standalone.InlineSurreal.IGame.numeric_def] - constructor - · intro y hy z hz - have hy' : toCG y ∈ x.moves _root_.Player.left := by - rw [← toCG_fromCG x, moves_toCG] - exact ⟨y, by simpa only [playerToSupport] using hy, rfl⟩ - have hz' : toCG z ∈ x.moves _root_.Player.right := by - rw [← toCG_fromCG x, moves_toCG] - exact ⟨z, by simpa only [playerToSupport] using hz, rfl⟩ - have hyz := hdef.1 (toCG y) hy' (toCG z) hz' - rw [lt_iff_le_not_ge, ← toCG_le, ← toCG_le] at hyz - exact hyz - · intro p y hy - cases p - · have hy' : toCG y ∈ x.moves _root_.Player.left := by - rw [← toCG_fromCG x, moves_toCG] - exact ⟨y, by simpa only [playerToSupport] using hy, rfl⟩ - simpa only [fromCG_toCG] using - ih _ (toCG y) hy' (hdef.2 _ (toCG y) hy') - · have hy' : toCG y ∈ x.moves _root_.Player.right := by - rw [← toCG_fromCG x, moves_toCG] - exact ⟨y, by simpa only [playerToSupport] using hy, rfl⟩ - simpa only [fromCG_toCG] using - ih _ (toCG y) hy' (hdef.2 _ (toCG y) hy') - -end SupportBridge - -namespace SupportBridge - -/-- The surreal-number quotient in the auxiliary standalone model. -/ -abbrev SupportSurreal := ConwayRefinement.Standalone.InlineSurreal.Surreal -/-- The game quotient in the auxiliary standalone model. -/ -abbrev SupportQuotientGame := ConwayRefinement.Standalone.InlineSurreal.Game - -/-- Convert an auxiliary quotient game to the CombinatorialGames quotient. -/ -noncomputable def gameToCG (x : SupportQuotientGame.{u}) : _root_.ConwayGame.{u} := - _root_.ConwayGame.mk (toCG x.out) - -/-- Convert a surreal number from the auxiliary model to the CombinatorialGames model. -/ -noncomputable def surrealToCG (x : SupportSurreal.{u}) : _root_.Surreal.{u} := - @_root_.Surreal.mk (toCG x.out) (toCG_numeric inferInstance) - -/-- Convert a CombinatorialGames surreal number to the auxiliary model. -/ -noncomputable def surrealFromCG (x : _root_.Surreal.{u}) : SupportSurreal.{u} := - @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk (fromCG x.out) - (fromCG_numeric inferInstance) - -theorem toCG_equiv (x y : SupportGame.{u}) : - (x ≤ y ∧ y ≤ x) ↔ (toCG x ≤ toCG y ∧ toCG y ≤ toCG x) := by - rw [toCG_le, toCG_le] - -theorem gameToCG_mk (x : SupportGame.{u}) : - gameToCG (ConwayRefinement.Standalone.InlineSurreal.Game.mk x) = - _root_.ConwayGame.mk (toCG x) := by - rw [gameToCG, _root_.ConwayGame.mk_eq_mk] - apply toCG_equiv _ _ |>.mp - exact ConwayRefinement.Standalone.InlineSurreal.Game.mk_out_equiv x - -theorem gameToCG_singletonCut (l r : SupportQuotientGame.{u}) : - gameToCG !{{l} | {r}} = !{{gameToCG l} | {gameToCG r}} := by - rw [gameToCG] - apply _root_.ConwayGame.mk_eq - let sraw : SupportGame.{u} := - ConwayRefinement.Standalone.InlineSurreal.OfSets.ofSets - (ConwayRefinement.Standalone.InlineSurreal.Player.cases {l.out} {r.out}) trivial - have hout : - toCG (ConwayRefinement.Standalone.InlineSurreal.Game.out !{{l} | {r}}) ≤ toCG sraw ∧ - toCG sraw ≤ toCG (ConwayRefinement.Standalone.InlineSurreal.Game.out !{{l} | {r}}) := by - apply toCG_equiv _ _ |>.mp - have hs := ConwayRefinement.Standalone.InlineSurreal.Game.mk_out_equiv sraw - change (ConwayRefinement.Standalone.InlineSurreal.Game.mk sraw).out ≤ sraw ∧ - sraw ≤ (ConwayRefinement.Standalone.InlineSurreal.Game.mk sraw).out at hs - have hcut : ConwayRefinement.Standalone.InlineSurreal.Game.mk sraw = !{{l} | {r}} := by - simpa only [sraw, Set.image_singleton, - ConwayRefinement.Standalone.InlineSurreal.Game.out_eq] using - ConwayRefinement.Standalone.InlineSurreal.Game.mk_ofSets ({l.out} : Set SupportGame.{u}) - ({r.out} : Set SupportGame.{u}) - rw [← hcut] - exact hs - have hraw : - toCG sraw = !{{toCG l.out} | {toCG r.out}} := by - apply _root_.IGame.ext - intro p - rw [moves_toCG] - cases p <;> simp [sraw, playerToSupport] - have htarget : - toCG sraw ≤ !{fun p ↦ _root_.ConwayGame.out '' - _root_.Player.cases {gameToCG l} {gameToCG r} p} ∧ - !{fun p ↦ _root_.ConwayGame.out '' - _root_.Player.cases {gameToCG l} {gameToCG r} p} ≤ toCG sraw := by - rw [hraw] - apply _root_.IGame.equiv_of_exists <;> - simp only [_root_.IGame.moves_ofSets, Set.mem_singleton_iff, - _root_.Player.apply_cases, Set.mem_image] - · intro a ha - subst a - exact ⟨(gameToCG l).out, ⟨gameToCG l, rfl, rfl⟩, - (_root_.ConwayGame.mk_out_equiv (toCG l.out)).symm⟩ - · intro a ha - subst a - exact ⟨(gameToCG r).out, ⟨gameToCG r, rfl, rfl⟩, - (_root_.ConwayGame.mk_out_equiv (toCG r.out)).symm⟩ - · intro b hb - obtain ⟨l', hl', rfl⟩ := hb - subst l' - exact ⟨toCG l.out, rfl, (_root_.ConwayGame.mk_out_equiv (toCG l.out)).symm⟩ - · intro b hb - obtain ⟨r', hr', rfl⟩ := hb - subst r' - exact ⟨toCG r.out, rfl, (_root_.ConwayGame.mk_out_equiv (toCG r.out)).symm⟩ - exact ⟨hout.1.trans htarget.1, htarget.2.trans hout.2⟩ - -theorem surrealToCG_mk (x : SupportGame.{u}) - [ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric x] : - surrealToCG (ConwayRefinement.Standalone.InlineSurreal.Surreal.mk x) = - @_root_.Surreal.mk (toCG x) (toCG_numeric inferInstance) := by - let := toCG_numeric (x := x) (inferInstance) - let := toCG_numeric - (x := (ConwayRefinement.Standalone.InlineSurreal.Surreal.mk x).out) (inferInstance) - rw [surrealToCG, _root_.Surreal.mk_eq_mk] - apply toCG_equiv _ _ |>.mp - exact ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_out_equiv x - -theorem toGame_surrealToCG (x : SupportSurreal.{u}) : - _root_.Surreal.toGame (surrealToCG x) = - gameToCG (ConwayRefinement.Standalone.InlineSurreal.Surreal.toGame x) := by - induction x using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with - | mk x => - let : _root_.IGame.Numeric (toCG x) := toCG_numeric (by infer_instance) - rw [surrealToCG_mk, _root_.Surreal.toGame_mk, - ConwayRefinement.Standalone.InlineSurreal.Surreal.toGame_mk, gameToCG_mk] - -theorem surrealFromCG_mk (x : _root_.IGame.{u}) [x.Numeric] : - surrealFromCG (_root_.Surreal.mk x) = - @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk (fromCG x) - (fromCG_numeric inferInstance) := by - let := fromCG_numeric (x := x) (inferInstance) - let := fromCG_numeric (x := (_root_.Surreal.mk x).out) (inferInstance) - rw [surrealFromCG, ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk] - apply toCG_equiv _ _ |>.mpr - rw [toCG_fromCG] - obtain ⟨h₁, h₂⟩ := _root_.Surreal.mk_out_equiv x - constructor - · exact h₁.trans_eq (toCG_fromCG x).symm - · exact (toCG_fromCG x).le.trans h₂ - -theorem surrealToCG_fromCG (x : _root_.Surreal.{u}) : - surrealToCG (surrealFromCG x) = x := by - induction x using _root_.Surreal.ind with - | mk x => - let := fromCG_numeric (x := x) (inferInstance) - let := toCG_numeric (x := fromCG x) (inferInstance) - rw [surrealFromCG_mk, surrealToCG_mk] - rw [_root_.Surreal.mk_eq_mk] - change toCG (fromCG x) ≤ x ∧ x ≤ toCG (fromCG x) - rw [toCG_fromCG] - exact ⟨le_rfl, le_rfl⟩ - -theorem surrealFromCG_toCG (x : SupportSurreal.{u}) : - surrealFromCG (surrealToCG x) = x := by - induction x using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with - | mk x => - let := toCG_numeric (x := x) (inferInstance) - let := fromCG_numeric (x := toCG x) (inferInstance) - rw [surrealToCG_mk, surrealFromCG_mk] - rw [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk] - apply toCG_equiv _ _ |>.mpr - rw [toCG_fromCG] - exact ⟨le_rfl, le_rfl⟩ - -/-- The fully developed Mathlib-only copy and CombinatorialGames define equivalent surreal -numbers. -/ -noncomputable def surrealEquivCG : SupportSurreal.{u} ≃ _root_.Surreal.{u} where - toFun := surrealToCG - invFun := surrealFromCG - left_inv := surrealFromCG_toCG - right_inv := surrealToCG_fromCG - -theorem surrealToCG_zero : surrealToCG (0 : SupportSurreal.{u}) = 0 := by - let : _root_.IGame.Numeric (toCG (0 : SupportGame.{u})) := - toCG_numeric (by infer_instance) - rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_zero, surrealToCG_mk, - ← _root_.Surreal.mk_zero, _root_.Surreal.mk_eq_mk] - change toCG 0 ≤ 0 ∧ 0 ≤ toCG 0 - rw [toCG_zero] - exact ⟨le_rfl, le_rfl⟩ - -theorem surrealToCG_one : surrealToCG (1 : SupportSurreal.{u}) = 1 := by - let : _root_.IGame.Numeric (toCG (1 : SupportGame.{u})) := - toCG_numeric (by infer_instance) - rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_one, surrealToCG_mk, - ← _root_.Surreal.mk_one, _root_.Surreal.mk_eq_mk] - change toCG 1 ≤ 1 ∧ 1 ≤ toCG 1 - rw [toCG_one] - exact ⟨le_rfl, le_rfl⟩ - -theorem surrealToCG_neg (x : SupportSurreal.{u}) : surrealToCG (-x) = -surrealToCG x := by - induction x using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with - | mk x => - let : _root_.IGame.Numeric (toCG x) := toCG_numeric (by infer_instance) - let : _root_.IGame.Numeric (toCG (-x)) := toCG_numeric (by infer_instance) - rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_neg, surrealToCG_mk, - surrealToCG_mk, ← _root_.Surreal.mk_neg, _root_.Surreal.mk_eq_mk] - change toCG (-x) ≤ -toCG x ∧ -toCG x ≤ toCG (-x) - rw [toCG_neg] - exact ⟨le_rfl, le_rfl⟩ - -theorem surrealToCG_add (x y : SupportSurreal.{u}) : - surrealToCG (x + y) = surrealToCG x + surrealToCG y := by - induction x using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with - | mk x => - induction y using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with - | mk y => - let : _root_.IGame.Numeric (toCG x) := toCG_numeric (by infer_instance) - let : _root_.IGame.Numeric (toCG y) := toCG_numeric (by infer_instance) - let : _root_.IGame.Numeric (toCG (x + y)) := toCG_numeric (by infer_instance) - rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_add, surrealToCG_mk, - surrealToCG_mk, surrealToCG_mk, ← _root_.Surreal.mk_add, - _root_.Surreal.mk_eq_mk] - change toCG (x + y) ≤ toCG x + toCG y ∧ toCG x + toCG y ≤ toCG (x + y) - rw [toCG_add] - exact ⟨le_rfl, le_rfl⟩ - -theorem surrealToCG_mul (x y : SupportSurreal.{u}) : - surrealToCG (x * y) = surrealToCG x * surrealToCG y := by - induction x using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with - | mk x => - induction y using ConwayRefinement.Standalone.InlineSurreal.Surreal.ind with - | mk y => - let : _root_.IGame.Numeric (toCG x) := toCG_numeric (by infer_instance) - let : _root_.IGame.Numeric (toCG y) := toCG_numeric (by infer_instance) - let : _root_.IGame.Numeric (toCG (x * y)) := toCG_numeric (by infer_instance) - rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_mul, surrealToCG_mk, - surrealToCG_mk, surrealToCG_mk, ← _root_.Surreal.mk_mul, - _root_.Surreal.mk_eq_mk] - change toCG (x * y) ≤ toCG x * toCG y ∧ toCG x * toCG y ≤ toCG (x * y) - rw [toCG_mul] - exact ⟨le_rfl, le_rfl⟩ - -theorem surrealToCG_singletonIntegerCut (x : SupportSurreal.{u}) : - surrealToCG (ConwayRefinement.Standalone.InlineSurreal.Surreal.singletonIntegerCut x) = - !{{surrealToCG x - 1} | {surrealToCG x + 1}}' (by - simp only [Set.mem_singleton_iff] - rintro _ rfl _ rfl - simp [sub_eq_add_neg]) := by - rw [ConwayRefinement.Standalone.InlineSurreal.Surreal.singletonIntegerCut] - rw [← _root_.Surreal.toGame_inj, toGame_surrealToCG, - ConwayRefinement.Standalone.InlineSurreal.Surreal.toGame_ofSets] - simp only [Set.image_singleton] - rw [gameToCG_singletonCut, _root_.Surreal.toGame_ofSets] - simp only [Set.image_singleton] - congr 2 - · congr 1 - rw [← toGame_surrealToCG, sub_eq_add_neg, surrealToCG_add, surrealToCG_neg, - surrealToCG_one] - rw [sub_eq_add_neg] - · congr 1 - rw [← toGame_surrealToCG, surrealToCG_add, surrealToCG_one] - -theorem isConwayOmnificInteger_iff (x : SupportSurreal.{u}) : - ConwayRefinement.Standalone.InlineSurreal.Surreal.IsConwayOmnificInteger x ↔ - ConwayRefinement.Standalone.Oz.IsConwayOmnificInteger (surrealToCG x) := by - rw [ConwayRefinement.Standalone.InlineSurreal.Surreal.IsConwayOmnificInteger, - ConwayRefinement.Standalone.Oz.isConwayOmnificInteger_iff] - constructor - · intro hx - calc - surrealToCG x = - surrealToCG (ConwayRefinement.Standalone.InlineSurreal.Surreal.singletonIntegerCut x) := - congrArg surrealToCG hx - _ = !{{surrealToCG x - 1} | {surrealToCG x + 1}}' _ := - surrealToCG_singletonIntegerCut x - · intro hx - apply surrealEquivCG.injective - calc - surrealToCG x = !{{surrealToCG x - 1} | {surrealToCG x + 1}}' _ := hx - _ = surrealToCG (ConwayRefinement.Standalone.InlineSurreal.Surreal.singletonIntegerCut x) := - (surrealToCG_singletonIntegerCut x).symm - -end SupportBridge - /-- The quotient of the completely visible inline representatives is exactly the surreal-number type supplied by CombinatorialGames. -/ noncomputable def Surreal.quotientEquivCombinatorialGames : Surreal.QuotientModel.{u} ≃ _root_.Surreal.{u} := - Surreal.quotientEquivSupport.trans SupportBridge.surrealEquivCG + Surreal.quotientEquivSupport end ConwayRefinement.Standalone.InlineConwayRefinement namespace ConwayRefinement.Standalone.InlineConwayRefinement.SupportBridge @@ -965,45 +406,8 @@ namespace ConwayRefinement.Standalone.InlineConwayRefinement.SupportBridge universe u theorem supportConway : - ConwayRefinement.Standalone.InlineSurreal.Surreal.ConwayConjecture.{u} := by - intro a b c d ha hb hc hd habcd - have ha' := (isConwayOmnificInteger_iff a).mp ha - have hb' := (isConwayOmnificInteger_iff b).mp hb - have hc' := (isConwayOmnificInteger_iff c).mp hc - have hd' := (isConwayOmnificInteger_iff d).mp hd - have habcd' : surrealToCG a * surrealToCG b = surrealToCG c * surrealToCG d := by - rw [← surrealToCG_mul, ← surrealToCG_mul, habcd] - obtain ⟨e, f, g, h, he, hf, hg, hh, hae, hbg, hce, hdf⟩ := - ConwayRefinement.Standalone.Oz.conwayConjecture_iff.mp - ConwayRefinement.Standalone.Oz.ConwayConjecture.proof - (surrealToCG a) (surrealToCG b) (surrealToCG c) (surrealToCG d) - ha' hb' hc' hd' habcd' - refine ⟨surrealFromCG e, surrealFromCG f, surrealFromCG g, surrealFromCG h, - ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ - · apply (isConwayOmnificInteger_iff _).mpr - simpa only [surrealToCG_fromCG] using he - · apply (isConwayOmnificInteger_iff _).mpr - simpa only [surrealToCG_fromCG] using hf - · apply (isConwayOmnificInteger_iff _).mpr - simpa only [surrealToCG_fromCG] using hg - · apply (isConwayOmnificInteger_iff _).mpr - simpa only [surrealToCG_fromCG] using hh - · apply surrealEquivCG.injective - change surrealToCG a = surrealToCG (surrealFromCG e * surrealFromCG f) - rw [surrealToCG_mul, surrealToCG_fromCG, surrealToCG_fromCG] - exact hae - · apply surrealEquivCG.injective - change surrealToCG b = surrealToCG (surrealFromCG g * surrealFromCG h) - rw [surrealToCG_mul, surrealToCG_fromCG, surrealToCG_fromCG] - exact hbg - · apply surrealEquivCG.injective - change surrealToCG c = surrealToCG (surrealFromCG e * surrealFromCG g) - rw [surrealToCG_mul, surrealToCG_fromCG, surrealToCG_fromCG] - exact hce - · apply surrealEquivCG.injective - change surrealToCG d = surrealToCG (surrealFromCG f * surrealFromCG h) - rw [surrealToCG_mul, surrealToCG_fromCG, surrealToCG_fromCG] - exact hdf + ConwayRefinement.Standalone.InlineSurreal.Surreal.ConwayConjecture.{u} := + ConwayRefinement.Standalone.Oz.ConwayConjecture.proof end ConwayRefinement.Standalone.InlineConwayRefinement.SupportBridge @@ -1026,9 +430,9 @@ theorem Surreal.productsEqual_iff_toSupport (a b c d : Surreal.{u}) : let := d.numeric.toSupport rw [Game.equivalent_iff_toSupport, Game.toSupport_mul, Game.toSupport_mul] simp only [Surreal.toSupport_eq] - rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_mul, - ← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_mul] - rw [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk] + rw [← _root_.Surreal.mk_mul, + ← _root_.Surreal.mk_mul] + rw [_root_.Surreal.mk_eq_mk] rfl theorem Surreal.equalsProduct_iff_toSupport (a e f : Surreal.{u}) : @@ -1039,33 +443,33 @@ theorem Surreal.equalsProduct_iff_toSupport (a e f : Surreal.{u}) : let := f.numeric.toSupport rw [Game.equivalent_iff_toSupport, Game.toSupport_mul] simp only [Surreal.toSupport_eq] - rw [← ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_mul] - rw [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk] + rw [← _root_.Surreal.mk_mul] + rw [_root_.Surreal.mk_eq_mk] rfl theorem Game.toSupport_mk {Left Right : Type u} (left : Left → Game.{u}) (right : Right → Game.{u}) : Game.toSupport (.mk Left Right left right) = - ConwayRefinement.Standalone.InlineSurreal.ofSets - (ConwayRefinement.Standalone.InlineSurreal.Player.cases + _root_.OfSets.ofSets + (_root_.Player.cases (Set.range fun i : Left ↦ Game.toSupport (left i)) (Set.range fun i : Right ↦ Game.toSupport (right i))) trivial := (rfl) theorem Game.toSupport_zero : Game.toSupport (Game.zero : Game.{u}) = - (0 : ConwayRefinement.Standalone.InlineSurreal.IGame.{u}) := by + (0 : _root_.IGame.{u}) := by rw [Game.zero_eq, Game.toSupport_mk] - apply ConwayRefinement.Standalone.InlineSurreal.IGame.ext + apply _root_.IGame.ext intro p cases p - · rw [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets, - ConwayRefinement.Standalone.InlineSurreal.IGame.moves_zero] + · rw [_root_.IGame.moves_ofSets, + _root_.IGame.moves_zero] ext z constructor · rintro ⟨i, _⟩ exact nomatch i.down · simp - · rw [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets, - ConwayRefinement.Standalone.InlineSurreal.IGame.moves_zero] + · rw [_root_.IGame.moves_ofSets, + _root_.IGame.moves_zero] ext z constructor · rintro ⟨i, _⟩ @@ -1073,14 +477,14 @@ theorem Game.toSupport_zero : Game.toSupport (Game.zero : Game.{u}) = · simp theorem Game.toSupport_one : Game.toSupport (Game.one : Game.{u}) = - (1 : ConwayRefinement.Standalone.InlineSurreal.IGame.{u}) := by + (1 : _root_.IGame.{u}) := by rw [Game.one_eq, Game.toSupport_mk] - apply ConwayRefinement.Standalone.InlineSurreal.IGame.ext + apply _root_.IGame.ext intro p cases p - · rw [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] - rw [ConwayRefinement.Standalone.InlineSurreal.IGame.one_def, - ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] + · rw [_root_.IGame.moves_ofSets] + rw [_root_.IGame.one_def, + _root_.IGame.moves_ofSets] ext z constructor · rintro ⟨_, rfl⟩ @@ -1089,9 +493,9 @@ theorem Game.toSupport_one : Game.toSupport (Game.one : Game.{u}) = have hz' : z = 0 := by simpa using hz subst z exact ⟨PUnit.unit, Game.toSupport_zero⟩ - · rw [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets, - ConwayRefinement.Standalone.InlineSurreal.IGame.one_def, - ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets] + · rw [_root_.IGame.moves_ofSets, + _root_.IGame.one_def, + _root_.IGame.moves_ofSets] ext z constructor · rintro ⟨i, _⟩ @@ -1099,13 +503,13 @@ theorem Game.toSupport_one : Game.toSupport (Game.one : Game.{u}) = · simp theorem Game.toSupport_singletonIntegerCut_numeric (x : Surreal.{u}) : - ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric + _root_.IGame.Numeric (Game.toSupport (Surreal.singletonIntegerCut x.game)) := by let := x.numeric.toSupport rw [Surreal.singletonIntegerCut_eq] rw [Game.toSupport_mk] - rw [ConwayRefinement.Standalone.InlineSurreal.IGame.numeric_def] - simp only [ConwayRefinement.Standalone.InlineSurreal.IGame.moves_ofSets, + rw [_root_.IGame.numeric_def] + simp only [_root_.IGame.moves_ofSets, Set.forall_mem_range] constructor · intro _ _ @@ -1124,15 +528,15 @@ theorem Game.toSupport_singletonIntegerCut_numeric (x : Surreal.{u}) : ConwayRefinement.Standalone.InlineConwayRefinement.Game.toSupport_neg (show Game.{u} from ConwayRefinement.Standalone.InlineConwayRefinement.Game.one)] rw [Game.toSupport_one] - apply ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_lt_mk.mp - simp only [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_add, - ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_neg, - ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_one] + apply _root_.Surreal.mk_lt_mk.mp + simp only [_root_.Surreal.mk_add, + _root_.Surreal.mk_neg, + _root_.Surreal.mk_one] linarith · intro p y hy cases p · obtain ⟨_, rfl⟩ := hy - change ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric + change _root_.IGame.Numeric (ConwayRefinement.Standalone.InlineConwayRefinement.Game.toSupport (ConwayRefinement.Standalone.InlineConwayRefinement.Game.add x.game (ConwayRefinement.Standalone.InlineConwayRefinement.Game.neg @@ -1145,7 +549,7 @@ theorem Game.toSupport_singletonIntegerCut_numeric (x : Surreal.{u}) : rw [Game.toSupport_one] infer_instance · obtain ⟨_, rfl⟩ := hy - change ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric + change _root_.IGame.Numeric (ConwayRefinement.Standalone.InlineConwayRefinement.Game.toSupport (ConwayRefinement.Standalone.InlineConwayRefinement.Game.add x.game ConwayRefinement.Standalone.InlineConwayRefinement.Game.one)) @@ -1155,40 +559,40 @@ theorem Game.toSupport_singletonIntegerCut_numeric (x : Surreal.{u}) : infer_instance theorem Surreal.toSupport_sub_one (x : Surreal.{u}) : - @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk + @_root_.Surreal.mk (Game.toSupport (Game.add x.game (Game.neg Game.one))) (by let := x.numeric.toSupport rw [Game.toSupport_add, Game.toSupport_neg, Game.toSupport_one] infer_instance) = x.toSupport - 1 := by let := x.numeric.toSupport simp only [Game.toSupport_add, Game.toSupport_neg, Game.toSupport_one] - simpa only [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_neg, - ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_one, Surreal.toSupport_eq, + simpa only [_root_.Surreal.mk_neg, + _root_.Surreal.mk_one, Surreal.toSupport_eq, sub_eq_add_neg] using - (ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_add - (Game.toSupport x.game) (-1 : ConwayRefinement.Standalone.InlineSurreal.IGame.{u})) + (_root_.Surreal.mk_add + (Game.toSupport x.game) (-1 : _root_.IGame.{u})) theorem Surreal.toSupport_add_one (x : Surreal.{u}) : - @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk + @_root_.Surreal.mk (Game.toSupport (Game.add x.game Game.one)) (by let := x.numeric.toSupport rw [Game.toSupport_add, Game.toSupport_one] infer_instance) = x.toSupport + 1 := by let := x.numeric.toSupport simp only [Game.toSupport_add, Game.toSupport_one] - simpa only [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_one, + simpa only [_root_.Surreal.mk_one, Surreal.toSupport_eq] using - (ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_add - (Game.toSupport x.game) (1 : ConwayRefinement.Standalone.InlineSurreal.IGame.{u})) + (_root_.Surreal.mk_add + (Game.toSupport x.game) (1 : _root_.IGame.{u})) theorem Surreal.toSupport_singletonIntegerCut (x : Surreal.{u}) : - @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk + @_root_.Surreal.mk (Game.toSupport (Surreal.singletonIntegerCut x.game)) (Game.toSupport_singletonIntegerCut_numeric x) = ConwayRefinement.Standalone.InlineSurreal.Surreal.singletonIntegerCut x.toSupport := by simp only [Surreal.singletonIntegerCut_eq, Game.toSupport_mk] rw [ConwayRefinement.Standalone.InlineSurreal.Surreal.singletonIntegerCut] - rw [ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_ofSets] + rw [_root_.Surreal.mk_ofSets] congr 2 · ext z simp only [Set.mem_range, Set.mem_singleton_iff] @@ -1220,15 +624,15 @@ theorem Surreal.isConwayOmnificInteger_iff_toSupport (x : Surreal.{u}) : · intro hx have hraw := Game.equivalent_iff_toSupport _ _ |>.mp hx have hmk : x.toSupport = - @ConwayRefinement.Standalone.InlineSurreal.Surreal.mk + @_root_.Surreal.mk (Game.toSupport (Surreal.singletonIntegerCut x.game)) inferInstance := by rw [Surreal.toSupport_eq, - ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk] + _root_.Surreal.mk_eq_mk] exact hraw exact hmk.trans (Surreal.toSupport_singletonIntegerCut x) · intro hx apply Game.equivalent_iff_toSupport _ _ |>.mpr - apply ConwayRefinement.Standalone.InlineSurreal.Surreal.mk_eq_mk.mp + apply _root_.Surreal.mk_eq_mk.mp rw [← Surreal.toSupport_eq] exact hx.trans (Surreal.toSupport_singletonIntegerCut x).symm diff --git a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean index 27766d57e2..5b8b4fd88f 100644 --- a/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean +++ b/LeanPool/ConwayRefinement/ConwayRefinement/Standalone/Mathlib/Support/InlineSurreal.lean @@ -15,3066 +15,39 @@ Authors: Dan Abramov, Aaron Liu, Apurva Nakade, Fox Thomson, František Silváš Isabel Longbottom, Junyan Xu, Kim Morrison, Mario Carneiro, Reid Barton, Theodore Hwa, Violeta Hernández Palacios, Yuyang Zhao -/ -/- -Adapted and modified from the Apache-2.0-licensed CombinatorialGames library: -https://github.com/vihdzp/combinatorial-games -The inlined source modules are named below. --/ -module - -public import Mathlib.Algebra.Ring.Defs -public import Mathlib.Data.Fintype.Defs -public import Mathlib.Logic.Small.Defs -import Mathlib.Tactic.DeriveFintype -public import Mathlib.Data.QPF.Univariate.Basic -import Mathlib.Logic.Small.Set -import Mathlib.Logic.Relation -import Mathlib.Order.SetNotation -public import Mathlib.Algebra.Group.Pointwise.Set.Small -public import Mathlib.Algebra.Order.ZeroLEOne -public import Mathlib.Order.Comparable -import Mathlib.Lean.PrettyPrinter.Delaborator -public import Mathlib.Logic.Hydra -import Mathlib.Order.GameAdd -public meta import Lean.Elab.Tactic.Basic -public meta import Lean.Meta.Tactic.Assert -public import Mathlib.Algebra.CharZero.Defs -public import Mathlib.Algebra.Order.Monoid.Defs -import Mathlib.Algebra.Order.Ring.Cast -import Mathlib.Tactic.Abel -import Mathlib.Data.Int.Cast.Lemmas -public import Mathlib.Algebra.Order.Hom.Monoid -public import Mathlib.Algebra.Order.Ring.Defs - -/-! -# A minimal concrete construction of surreal numbers - -This file inlines the numeric-game quotient, addition, and multiplication needed to state -Conway's refinement conjecture without importing CombinatorialGames. The construction is adapted -from the Apache-2.0 CombinatorialGames library. General birthdays, ordinal games, division, -and the complete lattice of surreal cuts are deliberately omitted. --/ - -namespace ConwayRefinement.Standalone.InlineSurreal - -/-! ## Inlined from `CombinatorialGames.Game.Player` -/ - -/-! -# Type of players - -This file implements the two-element type of players (`Left`, `Right`), alongside other basic -notational machinery to be used within game theory. --/ - -@[expose] public -section - -universe u_inline_0 - -/-! ### Players -/ - -/-- Either the Left or Right player. -/ -@[aesop safe cases, grind cases] -inductive Player where - /-- The Left player. -/ - | left : Player - /-- The Right player. -/ - | right : Player -deriving DecidableEq, Inhabited - -instance : Fintype Player where - elems := {Player.left, Player.right} - complete := by intro p; cases p <;> simp - -namespace Player - -/-- Specify a function `Player → α` from its two outputs. -/ -@[simp] -abbrev cases {α : Sort*} (l r : α) : Player → α - | left => l - | right => r - -lemma apply_cases {α β : Sort*} (f : α → β) (l r : α) (p : Player) : - f (cases l r p) = cases (f l) (f r) p := by - cases p <;> rfl - -@[simp] -theorem cases_inj {α : Sort*} {l₁ r₁ l₂ r₂ : α} : - cases l₁ r₁ = cases l₂ r₂ ↔ l₁ = l₂ ∧ r₁ = r₂ := - ⟨fun h ↦ ⟨congr($h left), congr($h right)⟩, fun ⟨hl, hr⟩ ↦ hl ▸ hr ▸ rfl⟩ - -theorem const_of_left_eq_right {α : Sort*} {f : Player → α} (hf : f left = f right) : - ∀ p q, f p = f q - | left, left | right, right => rfl - | left, right => hf - | right, left => hf.symm - -theorem const_of_left_eq_right' {f : Player → Prop} (hf : f left ↔ f right) (p q) : f p ↔ f q := - (const_of_left_eq_right hf.eq ..).to_iff - -@[simp] -protected lemma «forall» {p : Player → Prop} : - (∀ x, p x) ↔ p left ∧ p right := - ⟨fun h ↦ ⟨h left, h right⟩, fun ⟨hl, hr⟩ ↦ fun | left => hl | right => hr⟩ - -@[simp] -protected lemma «exists» {p : Player → Prop} : - (∃ x, p x) ↔ p left ∨ p right := - ⟨fun | ⟨left, h⟩ => .inl h | ⟨right, h⟩ => .inr h, fun | .inl h | .inr h => ⟨_, h⟩⟩ - -instance : Neg Player where - neg := cases right left - -@[simp, grind =] lemma neg_left : -left = right := rfl -@[simp, grind =] lemma neg_right : -right = left := rfl -@[simp] theorem eq_neg : ∀ {p q : Player}, p = -q ↔ p ≠ q := by decide -@[simp] theorem neg_eq : ∀ {p q : Player}, -p = q ↔ p ≠ q := by decide -theorem ne_neg : ∀ {p q : Player}, p ≠ -q ↔ p = q := by decide -theorem neg_ne : ∀ {p q : Player}, -p ≠ q ↔ p = q := by decide -theorem neg_ne_self : ∀ (p : Player), -p ≠ p := by decide -theorem self_ne_neg : ∀ (p : Player), p ≠ -p := by decide - -instance : InvolutiveNeg Player where - neg_neg := by decide - -/-- -The multiplication of `Player`s is used to state the lemmas about the multiplication of -combinatorial games, such as `IGame.mulOption_mem_moves_mul`. --/ -instance : Mul Player where mul - | left, p => p - | right, p => -p - -@[simp, grind =] lemma left_mul (p : Player) : left * p = p := rfl -@[simp, grind =] lemma right_mul (p : Player) : right * p = -p := rfl -@[simp, grind =] lemma mul_left : ∀ p, p * left = p := by decide -@[simp, grind =] lemma mul_right : ∀ p, p * right = -p := by decide -@[simp, grind =] lemma mul_self : ∀ p, p * p = left := by decide - -instance : HasDistribNeg Player where - neg_mul := by decide - mul_neg := by decide - -instance : CommGroup Player where - one := left - inv := id - mul_assoc := by decide - mul_comm := by decide - one_mul := by decide - mul_one := by decide - inv_mul_cancel := by decide - -@[simp, grind =] lemma one_eq_left : 1 = left := rfl -@[simp, grind =] lemma inv_eq_self (p : Player) : p⁻¹ = p := rfl - -end Player - -open Player - -/-! ### OfSets -/ - -/-- -Type class for the `ofSets` operation. -Used to implement the `!{st}` and `!{s | t}` syntax. --/ -class OfSets (α : Type (u_inline_0 + 1)) (Valid : outParam ((Player → Set α) → Prop)) where - /-- Construct a combinatorial game from its left and right sets. -/ - ofSets (st : Player → Set α) (h : Valid st) [Small.{u_inline_0} (st left)] - [Small.{u_inline_0} (st right)] : α -export OfSets (ofSets) - -@[inherit_doc OfSets.ofSets] -macro "!{" st:term "}'" h:term:max : term => `(OfSets.ofSets $st $h) - -@[inherit_doc OfSets.ofSets] -macro "!{" s:term " | " t:term "}'" h:term:max : term => `(!{Player.cases $s $t}'$h) - -/-- A tactic which attempts to automatically solve goals which appear on `OfSets`. -/ -macro "ofSetsTactic" : tactic => - `(tactic| first - | done - | trivial - | assumption - | aesop - | fail "failed to prove sets are valid, try to use `!{st}'h` notation instead, \ -where `h` is a proof that sets are valid" - ) - -@[inherit_doc OfSets.ofSets] -macro:max "!{" st:term "}" : term => `(!{$st}'(by ofSetsTactic)) - -@[inherit_doc OfSets.ofSets] -macro:max "!{" s:term " | " t:term "}" : term => `(!{$s | $t}'(by ofSetsTactic)) - -recommended_spelling "ofSets" for "!{st}'h" in [ofSets, «term!{_}'_»] -recommended_spelling "ofSets" for "!{s | t}'h" in [ofSets, «term!{_|_}'_»] -recommended_spelling "ofSets" for "!{st}" in [ofSets, «term!{_}»] -recommended_spelling "ofSets" for "!{s | t}" in [ofSets, «term!{_|_}»] - -open Lean PrettyPrinter Delaborator SubExpr in -/-- Delaborates `ofSets (Player.cases s t)` to `!{s | t}` and `ofSets st` to `!{st}`. -/ -@[app_delab OfSets.ofSets] -meta def delabOfSets : Delab := do - let e ← getExpr - guard <| e.isAppOfArity' ``OfSets.ofSets 7 - withNaryArg 3 do - let e ← getExpr - if e.isAppOfArity' ``Player.cases 3 then - let s ← withNaryArg 1 delab - let t ← withNaryArg 2 delab - `(!{$s | $t}) - else - let st ← delab - `(!{$st}) - -theorem ofSets_eq_ofSets_cases {α} {Valid : (Player → Set α) → Prop} [OfSets α Valid] - (st : Player → Set α) (h : Valid st) [Small (st left)] [Small (st right)] : - !{st} = !{st left | st right}'(by convert h; aesop) := by - congr; ext1 p; cases p <;> rfl - -end - -/-! ## Inlined from `CombinatorialGames.Game.Functor` -/ - -/-! -# Game functor - -The type of games `IGame` is an inductive type, with a single constructor `ofSets` taking in two -small sets of games (one for each player) and outputting a new game. This suggests the definition: - -``` -inductive IGame : Type (u_inline_1 + 1) - | ofSets (st : Player → Set IGame) [∀ p, Small.{u_inline_1} (st p)] : IGame.{u_inline_1} -``` - -However, the kernel does not accept this, as `Set IGame = IGame → Prop` contains a non-positive -occurence of `IGame` (see [counterexamples.org](https://counterexamples.org/strict-positivity.html) -for an explanation of what this is and why it's disallowed). We can get around this technical -limitation using the machinery of `QPF`s (quotients of polynomial functors). We define a functor -`GameFunctor` by - -``` -def GameFunctor (α : Type (u_inline_1 + 1)) : Type (u_inline_1 + 1) := - {st : Player → Set α // Small.{u_inline_1} (st left) ∧ Small.{u_inline_1} (st right)} -``` - -We can prove that this is a `QPF`, which then allows us to build its initial algebra through -`QPF.Fix`, which is exactly the inductive type `IGame`. As a bonus, we're able to describe the -coinductive type of loopy games `LGame` as the final coalgebra `QPF.Cofix` of the exact same -functor. --/ - -universe u_inline_1 - -@[expose] public -section - -/-! ### Game Functor -/ - -/-- The functor from a type into the subtype of small pairs of sets in that type. - -This is the quotient of a polynomial functor. The type `IGame` of well-founded games is defined as -the initial algebra of that `QPF`, while the type `LGame` of loopy games is defined as its final -coalgebra. - -In other words, `IGame` and `LGame` have the following descriptions (which don't work verbatim due -to various Lean limitations): - -``` -inductive IGame : Type (u_inline_1 + 1) - | ofSets (st : Player → Set IGame) [∀ p, Small.{u_inline_1} (st p)] : IGame.{u_inline_1} - -coinductive LGame : Type (u_inline_1 + 1) - | ofSets (st : Player → Set IGame) [∀ p, Small.{u_inline_1} (st p)] : LGame.{u_inline_1} -``` --/ -def GameFunctor (α : Type (u_inline_1 + 1)) : Type (u_inline_1 + 1) := - {s : Player → Set α // ∀ p, Small.{u_inline_1} (s p)} - -namespace GameFunctor - -@[ext] -theorem ext {α : Type (u_inline_1 + 1)} {x y : GameFunctor α} : x.1 = y.1 → x = y := - Subtype.ext - -instance {α : Type (u_inline_1 + 1)} (x : GameFunctor α) (p : Player) : - Small.{u_inline_1} (x.1 p) := x.2 p - -instance : Functor GameFunctor where - map f s := ⟨(f '' s.1 ·), fun _ ↦ by infer_instance⟩ - -theorem map_def {α β} (f : α → β) (s : GameFunctor α) : - f <$> s = ⟨(f '' s.1 ·), fun _ ↦ by infer_instance⟩ := - rfl -noncomputable instance : QPF GameFunctor where - P := ⟨Player → Type u_inline_1, fun x ↦ Σ p, PLift (x p)⟩ - abs x := ⟨fun p ↦ Set.range (x.2 ∘ .mk p ∘ PLift.up), fun _ ↦ by infer_instance⟩ - repr x := ⟨fun p ↦ Shrink (x.1 p), Sigma.rec (fun _ y ↦ ((equivShrink _).symm y.1).1)⟩ - abs_repr x := by ext; simp [← (equivShrink _).exists_congr_right] - abs_map f := by - intro ⟨x, g⟩ - apply Subtype.ext - funext p - change Set.range (f ∘ g ∘ Sigma.mk p ∘ PLift.up) = - f '' Set.range (g ∘ Sigma.mk p ∘ PLift.up) - exact Set.range_comp f _ - -end GameFunctor - -/-! ## Inlined from `CombinatorialGames.Mathlib.Small` -/ - -/-! -# Tree with small sets of branches is small --/ - -universe u_inline_2 - -public -section - -open Set - -variable {α : Type*} (r : α → α → Prop) [H : ∀ x, Small.{u_inline_2} {y // r x y}] - -private def level (x : α) : ℕ → Set α - | 0 => {x} - | n + 1 => ⋃₀ ((fun x ↦ {y | r x y}) '' level x n) - -private theorem small_level (x : α) : ∀ n, Small.{u_inline_2} (level r x n) - | 0 => small_single _ - | n + 1 => by - refine @small_sUnion _ _ ?_ ?_ - · have := small_level x n - exact small_image .. - · intro ⟨a, ha⟩ - obtain ⟨b, _, rfl⟩ := ha - exact H b - -private theorem small_sUnion_level (x : α) : Small.{u_inline_2} (⋃₀ range (level r x)) := by - refine @small_sUnion _ _ ?_ ?_ - · exact small_range .. - · simp [small_level] - -instance small_transGen (x : α) : Small.{u_inline_2} {y // Relation.TransGen r x y} := by - refine @small_subset _ _ _ (fun y hy ↦ ?_) (small_sUnion_level r x) - simp_rw [mem_sUnion, mem_range, exists_exists_eq_and] - induction hy with - | single => - use 1 - simpa [level] - | tail hy hr IH => - obtain ⟨n, hn⟩ := IH - use n + 1 - simpa [level] using ⟨_, hn, hr⟩ - -instance small_transGen' [∀ x, Small.{u_inline_2} {y // r y x}] (x : α) : - Small.{u_inline_2} {y // Relation.TransGen r y x} := by - simp_rw [← Relation.transGen_swap (r := r)] - infer_instance - -instance small_reflTransGen (x : α) : Small.{u_inline_2} {y // Relation.ReflTransGen r x y} := by - simp_rw [Relation.reflTransGen_iff_eq_or_transGen] - exact @small_insert _ _ _ (small_transGen ..) - -instance small_reflTransGen' [∀ x, Small.{u_inline_2} {y // r y x}] (x : α) : - Small.{u_inline_2} {y // Relation.ReflTransGen r y x} := by - simp_rw [← Relation.reflTransGen_swap (r := r)] - infer_instance - -/-! ## Inlined from `CombinatorialGames.Tactic.Register` -/ - - - -/-! ## Inlined from `CombinatorialGames.Game.IGame` -/ - -/-! -# Combinatorial (pre-)games - -The basic theory of combinatorial games, following Conway's book `On Numbers and Games`. - -In ZFC, games are built inductively out of two other sets of games, representing the options for two -players Left and Right. In Lean, we instead define the type of games `IGame` as arising from two -`Small` sets of games, with notation `!{s | t}`. A `u_inline_4`-small type `α : Type v` -is one that is equivalent to some `β : Type u_inline_4`, and the distinction between small and -large types in a given universe closely mimics the ZFC distinction between sets and proper classes. - -This definition requires some amount of setup, since Lean's inductive types aren't powerful enough -to express this on their own. See the docstring on `GameFunctor` for more information. - -We are also interested in further quotients of `IGame`. The quotient of games under equivalence -`x ≈ y ↔ x ≤ y ∧ y ≤ x`, which in the literature is often what is meant by a "combinatorial game", -is defined as `Game` in `CombinatorialGames.Game.Basic`. The surreal numbers `Surreal` are defined -as a quotient (of a subtype) of games in `CombinatorialGames.Surreal.Basic`. - -## Conway induction - -Most constructions within game theory, and as such, many proofs within it, are done by structural -induction. Structural induction on games is sometimes called "Conway induction". - -The most straightforward way to employ Conway induction is by using the termination checker, with -the auxiliary `inline_igame_wf` tactic. This uses `solve_by_elim` to search the context for - proofs of the -form `y ∈ xᴸ` or `y ∈ xᴿ`, which prove termination. Alternatively, you can use -the explicit recursion principles `IGame.ofSetsRecOn` or `IGame.moveRecOn`. - -## Order properties - -Pregames have both a `≤` and a `<` relation, satisfying the properties of a `Preorder`. The relation -`0 < x` means that `x` can always be won by Left, while `0 ≤ x` means that `x` can be won by Left as -the second player. Likewise, `x < 0` means that `x` can always be won by Right, while `x ≤ 0` means -that `x` can be won by Right as the second player. - -Note that we don't actually prove these characterizations. Indeed, in Conway's setup, combinatorial -game theory can be done entirely without the concept of a strategy. For instance, `IGame.zero_le` -implies that if `0 ≤ x`, then any move by Right satisfies `¬ x ≤ 0`, and `IGame.zero_lf` implies -that if `¬ x ≤ 0`, then some move by Left satisfies `0 ≤ x`. The strategy is thus already encoded -within these game relations. - -For convenience, we define notation `x ⧏ y` (pronounced "less or fuzzy") for `¬ y ≤ x`, notation -`x ‖ y` for `¬ x ≤ y ∧ ¬ y ≤ x`, and notation `x ≈ y` for `x ≤ y ∧ y ≤ x`. - -You can prove most (simple) inequalities on concrete games through the `game_cmp` tactic, which -repeatedly unfolds the definition of `≤` and applies `simp` until it solves the goal. - -## Algebraic structures - -Most of the usual arithmetic operations can be defined for games. Addition is defined for -`x = !{s₁ | t₁}` and `y = !{s₂ | t₂}` by `x + y = !{s₁ + y, x + s₂ | t₁ + y, x + t₂}`. Negation is -defined by `-!{s | t} = !{-t | -s}`. - -The order structures interact in the expected way with arithmetic. In particular, `Game` is an -`OrderedAddCommGroup`. Meanwhile, `IGame` satisfies the slightly weaker axioms of a -`SubtractionCommMonoid`, since the equation `x - x = 0` is only true up to equivalence. --/ - -theorem _root_.Relation.transGen_iff_exists {α : Type*} {r : α → α → Prop} {x y : α} : - Relation.TransGen r x y ↔ ∃ z, r z y ∧ (x = z ∨ Relation.TransGen r x z) := by - rw [Relation.transGen_iff] - simp [and_or_left, exists_or, and_comm] - -universe u_inline_4 - -open Set Pointwise - --- Computations can be performed through the `game_cmp` tactic. -public noncomputable -section - -/-! ### Game moves -/ - -/-- Well-founded games up to identity. - -`IGame` uses the set-theoretic notion of equality on games, meaning that two `IGame`s are equal -exactly when their left and right sets of options are. - -This is not the same equivalence as used broadly in combinatorial game theory literature, as a game -like `{0, 1 | 0}` is not *identical* to `{1 | 0}`, despite being equivalent. However, many theorems -can be proven over the 'identical' equivalence relation, and the literature may occasionally -specifically use the 'identical' equivalence relation for this reason. The quotient `Game` of games -up to equality is defined in `CombinatorialGames.Game.Basic`. - -More precisely, `IGame` is the inductive type for the single constructor - -``` - | ofSets (s t : Set IGame.{u_inline_4}) [Small.{u_inline_4} s] - [Small.{u_inline_4} t] : IGame.{u_inline_4} -``` - -(though for technical reasons it's not literally defined as such). A consequence of this is that -there is no infinite line of play. See `LGame` for a definition of loopy games. -/ -def IGame : Type (u_inline_4 + 1) := - QPF.Fix GameFunctor - -namespace IGame -export Player (left right) - -/-- Construct an `IGame` from its left and right sets. - -This function is regrettably noncomputable. Among other issues, sets simply do not carry data in -Lean. To perform computations on `IGame` we can instead make use of the `game_cmp` tactic. -/ -@[no_expose] -instance : OfSets IGame fun _ ↦ True where - ofSets st _ := QPF.Fix.mk ⟨st, by rintro (_ | _) <;> assumption⟩ - -/-- The set of moves of the game. -/ -def moves (p : Player) (x : IGame.{u_inline_4}) : Set IGame.{u_inline_4} := x.dest.1 p - -/-- The set of left moves of the game. -/ -scoped notation:max x:max "ᴸ" => moves left x - -/-- The set of right moves of the game. -/ -scoped notation:max x:max "ᴿ" => moves right x - -instance (p : Player) (x : IGame.{u_inline_4}) : Small.{u_inline_4} (x.moves p) := x.dest.2 p - -@[simp] -theorem moves_ofSets (p) (st : Player → Set IGame) [Small.{u_inline_4} (st left)] - [Small.{u_inline_4} (st right)] : - !{st}.moves p = st p := by - exact congrArg (fun s : GameFunctor IGame => s.val p) - (QPF.Fix.dest_mk ⟨st, by rintro (_ | _) <;> assumption⟩) - -@[simp] -theorem ofSets_moves (x : IGame) : !{x.moves} = x := x.mk_dest - - -theorem leftMoves_ofSets (s t : Set IGame) [Small.{u_inline_4} s] [Small.{u_inline_4} t] : - !{s | t}ᴸ = s := - moves_ofSets .. - - -theorem rightMoves_ofSets (s t : Set IGame) [Small.{u_inline_4} s] [Small.{u_inline_4} t] : - !{s | t}ᴿ = t := - moves_ofSets .. - -@[simp] -theorem ofSets_leftMoves_rightMoves (x : IGame) : !{xᴸ | xᴿ} = x := by - convert x.ofSets_moves with p - cases p <;> rfl - -/-- Two `IGame`s are equal when their move sets are. - -For the weaker but more common notion of equivalence where `x = y` if `x ≤ y` and `y ≤ x`, -use `Game`. -/ -@[ext] -theorem ext {x y : IGame.{u_inline_4}} (h : ∀ p, x.moves p = y.moves p) : - x = y := by - rw [← ofSets_moves x, ← ofSets_moves y] - simp_rw [funext h] - -@[simp] -theorem ofSets_inj' {st₁ st₂ : Player → Set IGame} - [Small (st₁ left)] [Small (st₁ right)] [Small (st₂ left)] [Small (st₂ right)] : - !{st₁} = !{st₂} ↔ st₁ = st₂ := by - simp_rw [IGame.ext_iff, moves_ofSets, funext_iff] - -theorem ofSets_inj {s₁ s₂ t₁ t₂ : Set IGame} [Small s₁] [Small s₂] [Small t₁] [Small t₂] : - !{s₁ | t₁} = !{s₂ | t₂} ↔ s₁ = s₂ ∧ t₁ = t₂ := by - simp - -/-- A (proper) subposition is any game reachable a nonempty sequence of -(not necessarily alternating) left and right moves. -/ -def Subposition : IGame → IGame → Prop := - Relation.TransGen fun x y => x ∈ ⋃ p, y.moves p - -@[aesop safe apply] -theorem Subposition.of_mem_moves {p} {x y : IGame} (h : x ∈ y.moves p) : Subposition x y := - Relation.TransGen.single (Set.mem_iUnion_of_mem p h) - -theorem Subposition.trans {x y z : IGame} (h₁ : Subposition x y) (h₂ : Subposition y z) : - Subposition x z := - Relation.TransGen.trans h₁ h₂ - -instance : IsTrans _ Subposition := inferInstanceAs (IsTrans _ (Relation.TransGen _)) - -/-- The set of games reachable from a given game is small. -/ -instance small_setOf_subposition (x : IGame.{u_inline_4}) : - Small.{u_inline_4} {y | Subposition y x} := - small_transGen' _ x - -/-- A variant of `small_setOf_subposition` in simp-normal form -/ -instance small_subtype_subposition (x : IGame.{u_inline_4}) : - Small.{u_inline_4} {y // Subposition y x} := - small_transGen' _ x - -theorem subposition_wf : WellFounded Subposition := by - change WellFounded (Relation.TransGen fun (x y : QPF.Fix GameFunctor) => - x ∈ ⋃ p, (QPF.Fix.dest y).val p) - refine ⟨fun x => Acc.transGen ?_⟩ - apply QPF.Fix.ind - rintro _ ⟨⟨st, hst⟩, rfl⟩ - constructor - rintro y hy - rw [QPF.Fix.dest_mk] at hy - change y ∈ ⋃ p, Subtype.val '' st p at hy - obtain ⟨p, hp⟩ := Set.mem_iUnion.mp hy - obtain ⟨z, _, rfl⟩ := hp - exact z.property - --- We make no use of `IGame`'s definition from a `QPF` after this point. -attribute [irreducible] IGame - -instance : WellFounded Subposition := subposition_wf -instance : WellFoundedRelation IGame := ⟨Subposition, subposition_wf⟩ - -theorem Subposition.irrefl (x : IGame) : ¬Subposition x x := _root_.irrefl x - -theorem self_notMem_moves (p : Player) (x : IGame) : x ∉ x.moves p := - fun hx ↦ Subposition.irrefl x (.of_mem_moves hx) - -/-- `WSubposition x y` means that `x` is reachable from `y` by a sequence of moves. -It is the non-strict version of `Subposition`. -/ -def WSubposition (x y : IGame) : Prop := x = y ∨ Subposition x y - -theorem wsubposition_iff_eq_or_subposition {x y : IGame} : - WSubposition x y ↔ x = y ∨ Subposition x y := .rfl - -theorem subposition_iff_exists {x y : IGame} : Subposition x y ↔ - ∃ p, ∃ z ∈ y.moves p, WSubposition x z := by - unfold WSubposition Subposition - rw [Relation.transGen_iff_exists] - simp_rw [mem_iUnion, ← exists_and_right, and_or_left] - exact exists_comm - -/-- The set of games reachable from a given game is small. -/ -instance small_setOf_wsubposition (x : IGame.{u_inline_4}) : - Small.{u_inline_4} {y | WSubposition y x} := - small_insert x {y | Subposition y x} - -/-- A variant of `small_setOf_wsubposition` in simp-normal form -/ -instance small_subtype_wsubposition (x : IGame.{u_inline_4}) : - Small.{u_inline_4} {y // WSubposition y x} := - small_insert x {y | Subposition y x} - -@[simp, refl] theorem WSubposition.refl (x : IGame) : WSubposition x x := .inl rfl -theorem WSubposition.rfl {x : IGame} : WSubposition x x := .refl x -theorem wsubposition_of_eq {x y : IGame} (hxy : x = y) : WSubposition x y := hxy ▸ .rfl - -theorem wsubposition_of_subposition {x y : IGame} (h : Subposition x y) : - WSubposition x y := .inr h - -alias Subposition.wsubposition := wsubposition_of_subposition - -theorem subposition_of_wsubposition_of_subposition {x y z : IGame} - (hxy : WSubposition x y) (hyz : Subposition y z) : Subposition x z := by - obtain rfl | hxy := hxy - · exact hyz - · exact hxy.trans hyz - -theorem subposition_of_subposition_of_wsubposition {x y z : IGame} - (hxy : Subposition x y) (hyz : WSubposition y z) : Subposition x z := by - obtain rfl | hyz := hyz - · exact hxy - · exact hxy.trans hyz - -alias WSubposition.trans_subposition := subposition_of_wsubposition_of_subposition -alias Subposition.trans_wsubposition' := subposition_of_wsubposition_of_subposition -alias Subposition.trans_wsubposition := subposition_of_subposition_of_wsubposition -alias WSubposition.trans_subposition' := subposition_of_subposition_of_wsubposition - -@[trans] theorem wsubposition_trans {x y z : IGame} - (hxy : WSubposition x y) (hyz : WSubposition y z) : WSubposition x z := by - obtain rfl | hyz := hyz - · exact hxy - · exact (hxy.trans_subposition hyz).wsubposition - -alias WSubposition.trans := wsubposition_trans - -instance : Trans Subposition Subposition Subposition := ⟨Subposition.trans⟩ -instance : Trans WSubposition Subposition Subposition := ⟨WSubposition.trans_subposition⟩ -instance : Trans Subposition WSubposition Subposition := ⟨Subposition.trans_wsubposition⟩ -instance : Trans WSubposition WSubposition WSubposition := ⟨WSubposition.trans⟩ - -theorem not_subposition_of_wsubposition {x y : IGame} (hxy : WSubposition x y) : - ¬Subposition y x := fun hyx => Subposition.irrefl x (hxy.trans_subposition hyx) - -theorem not_wsubposition_of_subposition {x y : IGame} (hxy : Subposition x y) : - ¬WSubposition y x := fun hyx => Subposition.irrefl x (hxy.trans_wsubposition hyx) - -alias WSubposition.not_subposition := not_subposition_of_wsubposition -alias Subposition.not_wsubposition := not_wsubposition_of_subposition - -theorem wsubposition_antisymm {x y : IGame} - (hxy : WSubposition x y) (hyx : WSubposition y x) : x = y := - hxy.resolve_right fun h => Subposition.irrefl x (h.trans_wsubposition hyx) - -alias WSubposition.antisymm := wsubposition_antisymm - -theorem wsubposition_antisymm_iff {x y : IGame} : x = y ↔ WSubposition x y ∧ WSubposition y x := - ⟨fun h => h ▸ ⟨.rfl, .rfl⟩, fun h => h.1.antisymm h.2⟩ - -theorem subposition_of_wsubposition_of_ne {x y : IGame} (hw : WSubposition x y) (hne : x ≠ y) : - Subposition x y := hw.resolve_left hne - -theorem subposition_of_wsubposition_not_wsubposition {x y : IGame} - (hxy : WSubposition x y) (hyx : ¬WSubposition y x) : Subposition x y := - hxy.resolve_left fun h => hyx (wsubposition_of_eq h.symm) - -theorem subposition_iff_wsubposition_not_wsubposition {x y : IGame} : - Subposition x y ↔ WSubposition x y ∧ ¬WSubposition y x := - ⟨fun hxy => ⟨hxy.wsubposition, hxy.not_wsubposition⟩, - fun h => subposition_of_wsubposition_not_wsubposition h.1 h.2⟩ - -theorem WSubposition.of_mem_moves {p : Player} {x y : IGame} (hxy : x ∈ y.moves p) : - WSubposition x y := (Subposition.of_mem_moves hxy).wsubposition - -/-- **Conway recursion**: build data for a game by recursively building it on its -left and right sets. You rarely need to use this explicitly, as the termination checker will handle -things for you. - -See `ofSetsRecOn` for an alternate form. -/ -@[elab_as_elim] -def moveRecOn {motive : IGame → Sort*} (x) - (ind : Π x, (Π p, Π y ∈ x.moves p, motive y) → motive x) : - motive x := - subposition_wf.recursion x fun x IH ↦ ind x (fun _ _ h ↦ IH _ (.of_mem_moves h)) - -theorem moveRecOn_eq {motive : IGame → Sort*} (x) - (ind : Π x, (Π p, Π y ∈ x.moves p, motive y) → motive x) : - moveRecOn x ind = ind x (fun _ y _ ↦ moveRecOn y ind) := - subposition_wf.fix_eq .. - -/-- **Conway recursion**: build data for a game by recursively building it on its -left and right sets. You rarely need to use this explicitly, as the termination checker will handle -things for you. - -See `moveRecOn` for an alternate form. -/ -@[elab_as_elim] -def ofSetsRecOn {motive : IGame.{u_inline_4} → Sort*} (x) - (ofSets : Π (s t : Set IGame) [Small s] [Small t], - (Π x ∈ s, motive x) → (Π x ∈ t, motive x) → motive !{s | t}) : - motive x := - cast (by simp) <| moveRecOn (motive := fun x ↦ motive !{xᴸ | xᴿ}) x - fun x IH ↦ ofSets _ _ - (fun y hy ↦ cast (by simp) (IH left y hy)) (fun y hy ↦ cast (by simp) (IH right y hy)) - -@[simp] -theorem ofSetsRecOn_ofSets {motive : IGame.{u_inline_4} → Sort*} - (s t : Set IGame) [Small.{u_inline_4} s] [Small.{u_inline_4} t] - (ofSets : Π (s t : Set IGame) [Small s] [Small t], - (Π x ∈ s, motive x) → (Π x ∈ t, motive x) → motive !{s | t}) : - ofSetsRecOn !{s | t} ofSets = - ofSets _ _ (fun y _ ↦ ofSetsRecOn y ofSets) (fun y _ ↦ ofSetsRecOn y ofSets) := by - rw [ofSetsRecOn, cast_eq_iff_heq, moveRecOn_eq] - simp_rw [ofSetsRecOn] - congr! <;> simp_all - -/-- Discharges proof obligations of the form `⊢ Subposition ..` arising in termination proofs -of definitions using well-founded recursion on `IGame`. -/ -macro (name := inlineIGameWf) "inline_igame_wf" config:Lean.Parser.Tactic.optConfig : tactic => - `(tactic| all_goals solve_by_elim $config - [Prod.Lex.left, Prod.Lex.right, PSigma.Lex.left, PSigma.Lex.right, - Subposition.of_mem_moves, Subposition.trans, Subtype.prop] ) - -/-! ### Basic games -/ - -/-- The game `0 = !{∅ | ∅}`. -/ -instance : Zero IGame := ⟨!{fun _ ↦ ∅}⟩ - -theorem zero_def : (0 : IGame) = !{fun _ ↦ ∅} := rfl - -@[simp] theorem moves_zero (p : Player) : moves p 0 = ∅ := moves_ofSets .. - -instance : Inhabited IGame := ⟨0⟩ - -/-- The game `1 = !{{0} | ∅}`. -/ -instance : One IGame := ⟨!{{0} | ∅}⟩ - -theorem one_def : (1 : IGame) = !{{0} | ∅} := rfl - -@[simp] theorem leftMoves_one : 1ᴸ = {0} := leftMoves_ofSets .. -@[simp] theorem rightMoves_one : 1ᴿ = ∅ := rightMoves_ofSets .. - -/-! ### Order relations -/ - -/-- The less or equal relation on games. - -If `0 ≤ x`, then Left can win `x` as the second player. `x ≤ y` means that `0 ≤ y - x`. -/ -@[no_expose] -instance : LE IGame where - le := Sym2.GameAdd.recursion subposition_wf fun x y le ↦ - (∀ z (h : z ∈ xᴸ), ¬le y z (Sym2.GameAdd.snd_fst (.of_mem_moves h))) ∧ - (∀ z (h : z ∈ yᴿ), ¬le z x (Sym2.GameAdd.fst_snd (.of_mem_moves h))) - -/-- The less or fuzzy relation on games. `x ⧏ y` is notation for `¬ y ≤ x`. - -If `0 ⧏ x`, then Left can win `x` as the first player. `x ⧏ y` means that `0 ⧏ y - x`. -/ -notation:50 x:50 " ⧏ " y:50 => ¬ y ≤ x -recommended_spelling "lf" for "⧏" in [«term_⧏_»] - -/-- Definition of `x ≤ y` on games, in terms of `⧏`. -/ -theorem le_iff_forall_lf {x y : IGame} : - x ≤ y ↔ (∀ z ∈ xᴸ, z ⧏ y) ∧ (∀ z ∈ yᴿ, x ⧏ z) := - propext_iff.1 <| Sym2.GameAdd.recursion_eq .. - -/-- Definition of `x ⧏ y` on games, in terms of `≤`. -/ -theorem lf_iff_exists_le {x y : IGame} : - x ⧏ y ↔ (∃ z ∈ yᴸ, x ≤ z) ∨ (∃ z ∈ xᴿ, z ≤ y) := by - simpa [not_and_or, -not_and] using le_iff_forall_lf.not - -/-- The definition of `0 ≤ x` on games, in terms of `0 ⧏`. -/ -theorem zero_le {x : IGame} : 0 ≤ x ↔ ∀ y ∈ xᴿ, 0 ⧏ y := by - rw [le_iff_forall_lf]; simp - -/-- The definition of `x ≤ 0` on games, in terms of `⧏ 0`. -/ -theorem le_zero {x : IGame} : x ≤ 0 ↔ ∀ y ∈ xᴸ, y ⧏ 0 := by - rw [le_iff_forall_lf]; simp - -/-- The definition of `0 ⧏ x` on games, in terms of `0 ≤`. -/ -theorem zero_lf {x : IGame} : 0 ⧏ x ↔ ∃ y ∈ xᴸ, 0 ≤ y := by - rw [lf_iff_exists_le]; simp - -/-- The definition of `x ⧏ 0` on games, in terms of `≤ 0`. -/ -theorem lf_zero {x : IGame} : x ⧏ 0 ↔ ∃ y ∈ xᴿ, y ≤ 0 := by - rw [lf_iff_exists_le]; simp - -/-- The definition of `x ≤ y` on games, in terms of `≤` two moves later. - -Note that it's often more convenient to use `le_iff_forall_lf`, which only unfolds the definition by -one step. -/ -theorem le_def {x y : IGame} : x ≤ y ↔ - (∀ a ∈ xᴸ, (∃ b ∈ yᴸ, a ≤ b) ∨ (∃ b ∈ aᴿ, b ≤ y)) ∧ - (∀ a ∈ yᴿ, (∃ b ∈ aᴸ, x ≤ b) ∨ (∃ b ∈ xᴿ, b ≤ a)) := by - rw [le_iff_forall_lf] - congr! 2 <;> rw [lf_iff_exists_le] - -/-- The definition of `x ⧏ y` on games, in terms of `⧏` two moves later. - -Note that it's often more convenient to use `lf_iff_exists_le`, which only unfolds the definition by -one step. -/ -theorem lf_def {x y : IGame} : x ⧏ y ↔ - (∃ a ∈ yᴸ, (∀ b ∈ xᴸ, b ⧏ a) ∧ (∀ b ∈ aᴿ, x ⧏ b)) ∨ - (∃ a ∈ xᴿ, (∀ b ∈ aᴸ, b ⧏ y) ∧ (∀ b ∈ yᴿ, a ⧏ b)) := by - rw [lf_iff_exists_le] - congr! <;> rw [le_iff_forall_lf] - -theorem left_lf_of_le {x y z : IGame} (h : x ≤ y) (h' : z ∈ xᴸ) : z ⧏ y := - (le_iff_forall_lf.1 h).1 z h' - -theorem lf_right_of_le {x y z : IGame} (h : x ≤ y) (h' : z ∈ yᴿ) : x ⧏ z := - (le_iff_forall_lf.1 h).2 z h' - -theorem lf_of_le_left {x y z : IGame} (h : x ≤ z) (h' : z ∈ yᴸ) : x ⧏ y := - lf_iff_exists_le.2 <| Or.inl ⟨z, h', h⟩ - -theorem lf_of_right_le {x y z : IGame} (h : z ≤ y) (h' : z ∈ xᴿ) : x ⧏ y := - lf_iff_exists_le.2 <| Or.inr ⟨z, h', h⟩ - -private theorem le_rfl' {x : IGame} : x ≤ x := by - rw [le_iff_forall_lf] - constructor <;> intro y hy - exacts [lf_of_le_left le_rfl' hy, lf_of_right_le le_rfl' hy] -termination_by x -decreasing_by inline_igame_wf - -private theorem le_trans' {x y z : IGame} (h₁ : x ≤ y) (h₂ : y ≤ z) : x ≤ z := by - rw [le_iff_forall_lf] - constructor <;> intro a ha h₃ - exacts [left_lf_of_le h₁ ha (le_trans' h₂ h₃), lf_right_of_le h₂ ha (le_trans' h₃ h₁)] -termination_by subposition_wf.cutExpand.wrap {x, y, z} -decreasing_by - on_goal 1 => convert! Relation.cutExpand_add_single {y, z} (Subposition.of_mem_moves ha) - on_goal 2 => convert Relation.cutExpand_single_add (Subposition.of_mem_moves ha) {x, y} - all_goals simp [← Multiset.singleton_add, add_comm, add_assoc, WellFounded.wrap] - -instance : Preorder IGame where - le_refl _ := private le_rfl' - le_trans x y z := private le_trans' - -theorem left_lf {x y : IGame} (h : y ∈ xᴸ) : y ⧏ x := - lf_of_le_left le_rfl h - -theorem lf_right {x y : IGame} (h : y ∈ xᴿ) : x ⧏ y := - lf_of_right_le le_rfl h - -theorem le_of_forall_moves_right_lf {x y : IGame} - (hx : ∀ z ∈ yᴿ, x ⧏ z) (hl : ∀ z ∈ xᴸ, ∃ w ∈ yᴸ, z ≤ w) : x ≤ y := by - refine le_iff_forall_lf.2 ⟨fun z hz ↦ ?_, hx⟩ - obtain ⟨w, hw, hw'⟩ := hl z hz - exact mt hw'.trans' (left_lf hw) - -theorem le_of_forall_moves_left_lf {x y : IGame} - (hx : ∀ z ∈ yᴸ, z ⧏ x) (hr : ∀ z ∈ xᴿ, ∃ w ∈ yᴿ, w ≤ z) : y ≤ x := by - refine le_iff_forall_lf.2 ⟨hx, fun z hz ↦ ?_⟩ - obtain ⟨w, hw, hw'⟩ := hr z hz - exact mt hw'.trans (lf_right hw) - -/-- The equivalence relation `x ≈ y` means that `x ≤ y` and `y ≤ x`. This is notation for -`AntisymmRel (⬝ ≤ ⬝) x y`. -/ -infix:50 " ≈ " => AntisymmRel (· ≤ ·) -recommended_spelling "equiv" for "≈" in [«term_≈_»] - -/-- The "fuzzy" relation `x ‖ y` means that `x ⧏ y` and `y ⧏ x`. This is notation for -`IncompRel (⬝ ≤ ⬝) x y`. -/ -notation:50 x:50 " ‖ " y:50 => IncompRel (· ≤ ·) x y -recommended_spelling "fuzzy" for "‖" in [«term_‖_»] - -open Lean PrettyPrinter Delaborator SubExpr Qq in -/-- Delaborates `AntisymmRel (· ≤ ·) x y` into `x ≈ y`. -/ -@[delab app.AntisymmRel] -meta def delabEquiv : Delab := do - try - let_expr f@AntisymmRel α r _ _ := ← getExpr | failure - have u_inline_4 := f.constLevels![0]! - have α : Q(Type u_inline_4) := α - have r : Q($α → $α → Prop) := r - let le ← synthInstanceQ q(LE $α) - _ ← assertDefEqQ q(($le).le) q($r) - let x ← withNaryArg 2 delab - let y ← withNaryArg 3 delab - let stx : Term ← do - let info ← Lean.MonadRef.mkInfoFromRefPos - pure { - raw := Lean.Syntax.node3 info - ``ConwayRefinement.Standalone.InlineSurreal.IGame.«term_≈_» x.raw - (Lean.Syntax.atom info "≈") y.raw - } - annotateGoToSyntaxDef stx - catch _ => failure -- fail over to the default delaborator - -open Lean PrettyPrinter Delaborator SubExpr Qq in -/-- Delaborates `IncompRel (· ≤ ·) x y` into `x ‖ y`. -/ -@[delab app.IncompRel] -meta def delabFuzzy : Delab := do - try - let_expr f@IncompRel α r _ _ := ← getExpr | failure - have u_inline_4 := f.constLevels![0]! - have α : Q(Type u_inline_4) := α - have r : Q($α → $α → Prop) := r - let le ← synthInstanceQ q(LE $α) - _ ← assertDefEqQ q(($le).le) q($r) - let x ← withNaryArg 2 delab - let y ← withNaryArg 3 delab - let stx : Term ← do - let info ← Lean.MonadRef.mkInfoFromRefPos - pure { - raw := Lean.Syntax.node3 info - ``ConwayRefinement.Standalone.InlineSurreal.IGame.«term_‖_» x.raw - (Lean.Syntax.atom info "‖") y.raw - } - annotateGoToSyntaxDef stx - catch _ => failure -- fail over to the default delaborator - -theorem equiv_of_forall_lf {x y : IGame} - (hl₁ : ∀ a ∈ xᴸ, a ⧏ y) (hr₁ : ∀ a ∈ xᴿ, y ⧏ a) - (hl₂ : ∀ b ∈ yᴸ, b ⧏ x) (hr₂ : ∀ b ∈ yᴿ, x ⧏ b) : x ≈ y := by - constructor <;> refine le_iff_forall_lf.2 ⟨?_, ?_⟩ <;> assumption - -theorem equiv_of_exists_le {x y : IGame} - (hl₁ : ∀ a ∈ xᴸ, ∃ b ∈ yᴸ, a ≤ b) (hr₁ : ∀ a ∈ xᴿ, ∃ b ∈ yᴿ, b ≤ a) - (hl₂ : ∀ b ∈ yᴸ, ∃ a ∈ xᴸ, b ≤ a) (hr₂ : ∀ b ∈ yᴿ, ∃ a ∈ xᴿ, a ≤ b) : x ≈ y := by - apply equiv_of_forall_lf <;> simp +contextual [hl₁, hl₂, hr₁, hr₂, lf_iff_exists_le] - -theorem equiv_of_exists {x y : IGame} - (hl₁ : ∀ a ∈ xᴸ, ∃ b ∈ yᴸ, a ≈ b) (hr₁ : ∀ a ∈ xᴿ, ∃ b ∈ yᴿ, a ≈ b) - (hl₂ : ∀ b ∈ yᴸ, ∃ a ∈ xᴸ, a ≈ b) (hr₂ : ∀ b ∈ yᴿ, ∃ a ∈ xᴿ, a ≈ b) : x ≈ y := by - apply equiv_of_exists_le <;> grind [AntisymmRel] - -@[simp] -protected theorem zero_lt_one : (0 : IGame) < 1 := by - rw [lt_iff_le_not_ge, le_iff_forall_lf, le_iff_forall_lf] - simp - -instance : ZeroLEOneClass IGame where - zero_le_one := IGame.zero_lt_one.le - -/-! ### Negation -/ - -private def neg' (x : IGame) : IGame := - !{range fun y : xᴿ ↦ neg' y.1 | range fun y : xᴸ ↦ neg' y.1} -termination_by x -decreasing_by inline_igame_wf - -#adaptation_note /-- noncomputable is now needed -/ in -/-- The negative of a game is defined by `-!{s | t} = !{-t | -s}`. -/ -@[no_expose] -noncomputable instance : Neg IGame where - neg := neg' - -private theorem neg_ofSets'' (s t : Set IGame) [Small s] [Small t] : - -!{s | t} = !{Neg.neg '' t | Neg.neg '' s} := by - change neg' _ = _ - rw [neg'] - simp [Neg.neg, Set.ext_iff] - -instance : InvolutiveNeg IGame where - neg_neg x := by - refine ofSetsRecOn x ?_ - aesop (add simp [neg_ofSets'']) - -@[simp] -theorem neg_ofSets (s t : Set IGame) [Small s] [Small t] : -!{s | t} = !{-t | -s} := by - simp_rw [neg_ofSets'', Set.image_neg_eq_neg] - -theorem neg_ofSets' (st : Player → Set IGame) [Small (st left)] [Small (st right)] : - -!{st} = !{fun p ↦ -st (-p)} := by - rw [ofSets_eq_ofSets_cases, ofSets_eq_ofSets_cases fun _ ↦ -_, neg_ofSets] - rfl - -@[simp] -theorem neg_ofSets_const (s : Set IGame) [Small s] : - -!{fun _ ↦ s} = !{fun _ ↦ -s} := by - simp [neg_ofSets'] - -instance : NegZeroClass IGame where - neg_zero := by simp [zero_def] - -theorem neg_eq (x : IGame) : -x = !{-xᴿ | -xᴸ} := by - rw [← neg_ofSets, ofSets_leftMoves_rightMoves] - -theorem neg_eq' (x : IGame) : -x = !{fun p ↦ -x.moves (-p)} := by - rw [neg_eq, ofSets_eq_ofSets_cases (fun _ ↦ -_)]; rfl - -@[simp] -theorem moves_neg (p : Player) (x : IGame) : - (-x).moves p = -x.moves (-p) := by - rw [neg_eq', moves_ofSets] - - -theorem forall_moves_neg {P : IGame → Prop} {p : Player} {x : IGame} : - (∀ y ∈ (-x).moves p, P y) ↔ (∀ y ∈ x.moves (-p), P (-y)) := by - simp - - -theorem exists_moves_neg {P : IGame → Prop} {p : Player} {x : IGame} : - (∃ y ∈ (-x).moves p, P y) ↔ (∃ y ∈ x.moves (-p), P (-y)) := by - simp - -@[simp] -protected theorem neg_le_neg_iff {x y : IGame} : -x ≤ -y ↔ y ≤ x := by - induction x, y using Sym2.GameAdd.recursion subposition_wf with | _ x y IH - rw [le_iff_forall_lf, le_iff_forall_lf, and_comm, forall_moves_neg, forall_moves_neg] - dsimp - congr! 3 with z hz z hz - · rw [IH _ _ (Sym2.GameAdd.fst_snd (.of_mem_moves hz))] - · rw [IH _ _ (Sym2.GameAdd.snd_fst (.of_mem_moves hz))] - -protected theorem neg_le {x y : IGame} : -x ≤ y ↔ -y ≤ x := by - simpa using @IGame.neg_le_neg_iff x (-y) -protected theorem le_neg {x y : IGame} : x ≤ -y ↔ y ≤ -x := by - simpa using @IGame.neg_le_neg_iff (-x) y - -@[simp] -protected theorem neg_lt_neg_iff {x y : IGame} : -x < -y ↔ y < x := by - simp [lt_iff_le_not_ge] - -protected theorem neg_lt {x y : IGame} : -x < y ↔ -y < x := by - simpa using @IGame.neg_lt_neg_iff x (-y) -protected theorem lt_neg {x y : IGame} : x < -y ↔ y < -x := by - simpa using @IGame.neg_lt_neg_iff (-x) y - -@[simp] -theorem neg_equiv_neg_iff {x y : IGame} : -x ≈ -y ↔ x ≈ y := by - simp [AntisymmRel, and_comm] - -theorem neg_equiv {x y : IGame} : -x ≈ y ↔ x ≈ -y := by - simpa using @neg_equiv_neg_iff x (-y) - -alias ⟨_, neg_congr⟩ := neg_equiv_neg_iff - -@[simp] -theorem neg_fuzzy_neg_iff {x y : IGame} : -x ‖ -y ↔ x ‖ y := by - simp [IncompRel, and_comm] - -theorem neg_fuzzy {x y : IGame} : -x ‖ y ↔ x ‖ -y := by - simpa using @neg_fuzzy_neg_iff x (-y) - -@[simp] theorem neg_le_zero {x : IGame} : -x ≤ 0 ↔ 0 ≤ x := by simpa using @IGame.neg_le x 0 -@[simp] theorem zero_le_neg {x : IGame} : 0 ≤ -x ↔ x ≤ 0 := by simpa using @IGame.le_neg 0 x -@[simp] theorem neg_lt_zero {x : IGame} : -x < 0 ↔ 0 < x := by simpa using @IGame.neg_lt x 0 -@[simp] theorem zero_lt_neg {x : IGame} : 0 < -x ↔ x < 0 := by simpa using @IGame.lt_neg 0 x - -@[simp] theorem neg_equiv_zero {x : IGame} : -x ≈ 0 ↔ x ≈ 0 := by - simpa using @IGame.neg_equiv_neg_iff x 0 -@[simp] theorem zero_equiv_neg {x : IGame} : 0 ≈ -x ↔ 0 ≈ x := by - simpa using @IGame.neg_equiv_neg_iff 0 x - -@[simp] theorem neg_fuzzy_zero {x : IGame} : -x ‖ 0 ↔ x ‖ 0 := by - simpa using @IGame.neg_fuzzy_neg_iff x 0 -@[simp] theorem zero_fuzzy_neg {x : IGame} : 0 ‖ -x ↔ 0 ‖ x := by - simpa using @IGame.neg_fuzzy_neg_iff 0 x - -/-! ### Addition and subtraction -/ - -private def add' (x y : IGame) : IGame := - !{(range fun z : xᴸ ↦ add' z y) ∪ (range fun z : yᴸ ↦ add' x z) | - (range fun z : xᴿ ↦ add' z y) ∪ (range fun z : yᴿ ↦ add' x z)} -termination_by (x, y) -decreasing_by inline_igame_wf - -#adaptation_note /-- noncomputable is now needed -/ in -/-- The sum of `x = !{s₁ | t₁}` and `y = !{s₂ | t₂}` is `!{s₁ + y, x + s₂ | t₁ + y, x + t₂}`. -/ -@[no_expose] -noncomputable instance : Add IGame where - add := add' - -theorem add_eq (x y : IGame) : x + y = - !{(· + y) '' xᴸ ∪ (x + ·) '' yᴸ | (· + y) '' xᴿ ∪ (x + ·) '' yᴿ} := by - change add' _ _ = _ - rw [add'] - simp [HAdd.hAdd, Add.add, Set.ext_iff] - -theorem add_eq' (x y : IGame) : x + y = - !{fun p ↦ (· + y) '' x.moves p ∪ (x + ·) '' y.moves p} := by - rw [add_eq, ofSets_eq_ofSets_cases (fun _ ↦ _ ∪ _)] - -theorem ofSets_add_ofSets - (s₁ t₁ s₂ t₂ : Set IGame) [Small s₁] [Small t₁] [Small s₂] [Small t₂] : - !{s₁ | t₁} + !{s₂ | t₂} = - !{(· + !{s₂ | t₂}) '' s₁ ∪ (!{s₁ | t₁} + ·) '' s₂ | - (· + !{s₂ | t₂}) '' t₁ ∪ (!{s₁ | t₁} + ·) '' t₂} := by - rw [add_eq] - simp - -theorem ofSets_add_ofSets' (st₁ st₂ : Player → Set IGame) - [Small (st₁ left)] [Small (st₂ left)] [Small (st₁ right)] [Small (st₂ right)] : - !{st₁} + !{st₂} = - !{fun p ↦ (· + !{st₂}) '' st₁ p ∪ (!{st₁} + ·) '' st₂ p} := by - rw [ofSets_eq_ofSets_cases, ofSets_eq_ofSets_cases st₂, ofSets_eq_ofSets_cases (fun _ ↦ _ ∪ _), - ofSets_add_ofSets] - -@[simp] -theorem moves_add (p : Player) (x y : IGame) : - (x + y).moves p = (· + y) '' x.moves p ∪ (x + ·) '' y.moves p := by - rw [add_eq', moves_ofSets] - -theorem add_left_mem_moves_add {p : Player} {x y : IGame} (h : x ∈ y.moves p) (z : IGame) : - z + x ∈ (z + y).moves p := by - rw [moves_add]; right; use x - -theorem add_right_mem_moves_add {p : Player} {x y : IGame} (h : x ∈ y.moves p) (z : IGame) : - x + z ∈ (y + z).moves p := by - rw [moves_add]; left; use x - - -theorem forall_moves_add {p : Player} {P : IGame → Prop} {x y : IGame} : - (∀ a ∈ (x + y).moves p, P a) ↔ - (∀ a ∈ x.moves p, P (a + y)) ∧ (∀ b ∈ y.moves p, P (x + b)) := by - aesop - - -theorem exists_moves_add {p : Player} {P : IGame → Prop} {x y : IGame} : - (∃ a ∈ (x + y).moves p, P a) ↔ - (∃ a ∈ x.moves p, P (a + y)) ∨ (∃ b ∈ y.moves p, P (x + b)) := by - aesop - -@[simp] -theorem add_eq_zero_iff {x y : IGame} : x + y = 0 ↔ x = 0 ∧ y = 0 := by - constructor <;> simp_all [IGame.ext_iff] - -private theorem add_zero' (x : IGame) : x + 0 = x := by - refine moveRecOn x ?_ - aesop - -private theorem add_comm' (x y : IGame) : x + y = y + x := by - ext - simp only [moves_add, mem_union, mem_image, or_comm] - congr! 3 <;> - · refine and_congr_right_iff.2 fun h ↦ ?_ - rw [add_comm'] -termination_by (x, y) -decreasing_by inline_igame_wf - -private theorem add_assoc' (x y z : IGame) : x + y + z = x + (y + z) := by - ext1 - simp only [moves_add, image_union, image_image, union_assoc] - refine congrArg₂ _ ?_ (congrArg₂ _ ?_ ?_) <;> - · ext - congr! 2 - rw [add_assoc'] -termination_by (x, y, z) -decreasing_by inline_igame_wf - -instance : AddCommMonoid IGame where - add_zero := private add_zero' - zero_add _ := private add_comm' .. ▸ add_zero' _ - add_comm := private add_comm' - add_assoc := private add_assoc' - nsmul := nsmulRec - -/-- The subtraction of `x` and `y` is defined as `x + (-y)`. -/ -instance : SubNegMonoid IGame where - zsmul := zsmulRec - -@[simp] -theorem moves_sub (p : Player) (x y : IGame) : - (x - y).moves p = (· - y) '' x.moves p ∪ (x + ·) '' (-y.moves (-p)) := by - simp [sub_eq_add_neg] - -theorem sub_left_mem_moves_sub {p : Player} {x y : IGame} (h : x ∈ y.moves p) (z : IGame) : - z - x ∈ (z - y).moves (-p) := by - apply add_left_mem_moves_add; simpa - -theorem sub_left_mem_moves_sub_neg {p : Player} {x y : IGame} (h : x ∈ y.moves (-p)) (z : IGame) : - z - x ∈ (z - y).moves p := by - apply add_left_mem_moves_add; simpa - -theorem sub_right_mem_moves_sub {p : Player} {x y : IGame} (h : x ∈ y.moves p) (z : IGame) : - x - z ∈ (y - z).moves p := - add_right_mem_moves_add h _ - -private theorem neg_add' (x y : IGame) : -(x + y) = -x + -y := by - ext - simp only [moves_neg, moves_add, union_neg, mem_union, mem_neg, mem_image, exists_neg_mem] - congr! 3 <;> - · refine and_congr_right_iff.2 fun _ ↦ ?_ - rw [← neg_inj, neg_add', neg_neg] -termination_by (x, y) -decreasing_by inline_igame_wf - -instance : SubtractionCommMonoid IGame where - neg_neg := neg_neg - neg_add_rev x y := by rw [neg_add', add_comm] - neg_eq_of_add := by simp - add_comm := add_comm - -private theorem sub_self_le (x : IGame) : x - x ≤ 0 := by - rw [le_zero, moves_sub] - rintro _ (⟨y, hy, rfl⟩ | ⟨y, hy, rfl⟩) - · exact lf_of_right_le (sub_self_le y) (sub_left_mem_moves_sub hy y) - · apply lf_of_right_le (sub_self_le (-y)) - rw [mem_neg] at hy - rw [sub_neg_eq_add] - exact add_right_mem_moves_add hy _ -termination_by x -decreasing_by inline_igame_wf - -/-- The sum of a game and its negative is equivalent, though not necessarily identical to zero. -/ -theorem sub_self_equiv (x : IGame) : x - x ≈ 0 := by - rw [AntisymmRel, ← neg_le_zero, neg_sub, and_self] - exact sub_self_le x - -/-- The sum of a game and its negative is equivalent, though not necessarily identical to zero. -/ -theorem neg_add_equiv (x : IGame) : -x + x ≈ 0 := by - simpa [add_comm, sub_eq_add_neg] using sub_self_equiv x - -private theorem add_le_add_left' {x y : IGame} (h : x ≤ y) (z : IGame) : z + x ≤ z + y := by - rw [le_iff_forall_lf, moves_add, moves_add] - refine ⟨?_, ?_⟩ <;> rintro a (⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩) - · exact lf_of_le_left (add_le_add_left' h a) (add_right_mem_moves_add ha y) - · obtain (⟨b, hb, hb'⟩ | ⟨b, hb, hb'⟩) := lf_iff_exists_le.1 (left_lf_of_le h ha) - · exact lf_of_le_left (add_le_add_left' hb' z) (add_left_mem_moves_add hb z) - · exact lf_of_right_le (add_le_add_left' hb' z) (add_left_mem_moves_add hb z) - · exact lf_of_right_le (add_le_add_left' h a) (add_right_mem_moves_add ha x) - · obtain (⟨b, hb, hb'⟩ | ⟨b, hb, hb'⟩) := lf_iff_exists_le.1 (lf_right_of_le h ha) - · exact lf_of_le_left (add_le_add_left' hb' z) (add_left_mem_moves_add hb z) - · exact lf_of_right_le (add_le_add_left' hb' z) (add_left_mem_moves_add hb z) -termination_by (x, y, z) -decreasing_by inline_igame_wf (maxDepth := 8) - -private theorem add_le_add_right' {x y : IGame} (h : x ≤ y) (z : IGame) : x + z ≤ y + z := by - simpa [add_comm] using add_le_add_left' h z - -instance : AddLeftMono IGame := ⟨fun x _ _ h ↦ add_le_add_left' h x⟩ -instance : AddRightMono IGame := ⟨fun x _ _ h ↦ add_le_add_right' h x⟩ - -instance : AddLeftReflectLE IGame where - le_of_add_le_add_left {x y} z h := by - rw [← zero_add y, ← zero_add z] - apply (add_le_add_left (neg_add_equiv x).ge y).trans - rw [add_assoc] - apply (add_le_add_right h (-x)).trans - rw [← add_assoc] - exact add_le_add_left (neg_add_equiv x).le z - -instance : AddRightReflectLE IGame := - addRightReflectLE_of_addLeftReflectLE _ - -instance : AddLeftStrictMono IGame where - elim x y z h := by - apply lt_of_le_not_ge (add_le_add_right h.le x) - contrapose! h - exact (le_of_add_le_add_left h).not_gt - -instance : AddRightStrictMono IGame := - addRightStrictMono_of_addLeftStrictMono _ - -instance : AddLeftReflectLT IGame where - elim _ := by simp [lt_iff_le_not_ge] - -instance : AddRightReflectLT IGame := - addRightReflectLT_of_addLeftReflectLT _ - -theorem add_congr {a b : IGame} (h₁ : a ≈ b) {c d : IGame} (h₂ : c ≈ d) : a + c ≈ b + d := - ⟨add_le_add h₁.1 h₂.1, add_le_add h₁.2 h₂.2⟩ - -theorem add_congr_left {a b c : IGame} (h : a ≈ b) : a + c ≈ b + c := - add_congr h .rfl - -theorem add_congr_right {a b c : IGame} (h : a ≈ b) : c + a ≈ c + b := - add_congr .rfl h - -@[simp] -theorem add_fuzzy_add_iff_left {a b c : IGame} : a + b ‖ a + c ↔ b ‖ c := by - simp [IncompRel] - -@[simp] -theorem add_fuzzy_add_iff_right {a b c : IGame} : b + a ‖ c + a ↔ b ‖ c := by - simp [IncompRel] - -theorem sub_congr {a b : IGame} (h₁ : a ≈ b) {c d : IGame} (h₂ : c ≈ d) : a - c ≈ b - d := - add_congr h₁ (neg_congr h₂) - -theorem sub_congr_left {a b c : IGame} (h : a ≈ b) : a - c ≈ b - c := - sub_congr h .rfl - -theorem sub_congr_right {a b c : IGame} (h : a ≈ b) : c - a ≈ c - b := - sub_congr .rfl h - -/-- We define the `NatCast` instance as `↑0 = 0` and `↑(n + 1) = !{{↑n} | ∅}`. - -Note that this is equivalent, but not identical, to the more common definition `↑n = !{Iio n | ∅}`. -For that, use `NatOrdinal.toIGame`. -/ -instance : AddCommMonoidWithOne IGame where - -/-- This version of the theorem is more convenient for the `game_cmp` tactic. -/ -theorem leftMoves_natCast_succ' : ∀ n : ℕ, n.succᴸ = {(n : IGame)} - | 0 => by simp - | n + 1 => by - rw [Nat.cast_succ, moves_add, leftMoves_natCast_succ'] - simp - -@[simp 1100] -- This should trigger before `leftMoves_add`. -theorem leftMoves_natCast_succ (n : ℕ) : (n + 1)ᴸ = {(n : IGame)} := - leftMoves_natCast_succ' n - -@[simp 1100] -- This should trigger before `rightMoves_add`. -theorem rightMoves_natCast : ∀ n : ℕ, nᴿ = ∅ - | 0 => by simp - | n + 1 => by - rw [Nat.cast_succ, moves_add, rightMoves_natCast] - simp - -@[simp 1100] -theorem leftMoves_ofNat (n : ℕ) [n.AtLeastTwo] : ofNat(n)ᴸ = {((n - 1 : ℕ) : IGame)} := by - change nᴸ = _ - rw [← Nat.succ_pred (NeZero.out (n := n)), leftMoves_natCast_succ'] - simp - -@[simp 1100] -theorem rightMoves_ofNat (n : ℕ) [n.AtLeastTwo] : ofNat(n)ᴿ = ∅ := - rightMoves_natCast n - -theorem natCast_succ_eq (n : ℕ) : (n + 1 : IGame) = !{{(n : IGame)} | ∅} := by - ext p; cases p <;> simp - -/-- Every left option of a natural number is equal to a smaller natural number. -/ -theorem eq_natCast_of_mem_leftMoves_natCast {n : ℕ} {x : IGame} (hx : x ∈ nᴸ) : - ∃ m : ℕ, m < n ∧ m = x := by - cases n with - | zero => simp at hx - | succ n => - use n - simp_all - -instance : IntCast IGame where - intCast - | .ofNat n => n - | .negSucc n => -(n + 1) - -@[simp, norm_cast] theorem intCast_nat (n : ℕ) : ((n : ℤ) : IGame) = n := rfl -@[simp] theorem intCast_ofNat (n : ℕ) : ((ofNat(n) : ℤ) : IGame) = n := rfl -@[simp] theorem intCast_negSucc (n : ℕ) : (Int.negSucc n : IGame) = -(n + 1) := rfl - -@[norm_cast] theorem intCast_zero : ((0 : ℤ) : IGame) = 0 := rfl -@[norm_cast] theorem intCast_one : ((1 : ℤ) : IGame) = 1 := by simp - -@[simp, norm_cast] -theorem intCast_neg (n : ℤ) : ((-n : ℤ) : IGame) = -(n : IGame) := by - cases n with - | ofNat n => - cases n with - | zero => simp - | succ n => rfl - | negSucc n => exact (neg_neg _).symm - -theorem eq_sub_one_of_mem_leftMoves_intCast {n : ℤ} {x : IGame} (hx : x ∈ nᴸ) : - x = (n - 1 : ℤ) := by - obtain ⟨n, rfl | rfl⟩ := n.eq_nat_or_neg - · cases n - · simp at hx - · rw [intCast_nat] at hx - simp_all - · simp at hx - -theorem eq_add_one_of_mem_rightMoves_intCast {n : ℤ} {x : IGame} (hx : x ∈ nᴿ) : - x = (n + 1 : ℤ) := by - have : -x ∈ (-n : ℤ)ᴸ := by simpa - rw [← neg_inj] - simpa [← IGame.intCast_neg, add_comm, sub_eq_add_neg] using - eq_sub_one_of_mem_leftMoves_intCast this - -/-- Every left option of an integer is equal to a smaller integer. -/ -theorem eq_intCast_of_mem_leftMoves_intCast {n : ℤ} {x : IGame} (hx : x ∈ nᴸ) : - ∃ m : ℤ, m < n ∧ m = x := by - use n - 1 - simp [eq_sub_one_of_mem_leftMoves_intCast hx] - -/-- Every right option of an integer is equal to a larger integer. -/ -theorem eq_intCast_of_mem_rightMoves_intCast {n : ℤ} {x : IGame} (hx : x ∈ nᴿ) : - ∃ m : ℤ, n < m ∧ m = x := by - use n + 1 - simp [eq_add_one_of_mem_rightMoves_intCast hx] - -/-! ### Multiplication -/ - -attribute [aesop apply safe] Prod.Lex.left Prod.Lex.right - -private def mul' (x y : IGame) : IGame := - !{(range fun a : (xᴸ ×ˢ yᴸ ∪ xᴿ ×ˢ yᴿ :) ↦ - mul' a.1.1 y + mul' x a.1.2 - mul' a.1.1 a.1.2) | - (range fun a : (xᴸ ×ˢ yᴿ ∪ xᴿ ×ˢ yᴸ :) ↦ - mul' a.1.1 y + mul' x a.1.2 - mul' a.1.1 a.1.2)} -termination_by (x, y) -decreasing_by - all_goals - rcases a.property with h | h - all_goals - first - | exact Prod.Lex.left _ _ (Subposition.of_mem_moves h.1) - | exact Prod.Lex.right _ (Subposition.of_mem_moves h.2) - -#adaptation_note /-- noncomputable is now needed -/ in -/-- The product of `x = !{s₁ | t₁}` and `y = !{s₂ | t₂}` is -`!{a₁ * y + x * b₁ - a₁ * b₁ | a₂ * y + x * b₂ - a₂ * b₂}`, where `(a₁, b₁) ∈ s₁ ×ˢ s₂ ∪ t₁ ×ˢ t₂` -and `(a₂, b₂) ∈ s₁ ×ˢ t₂ ∪ t₁ ×ˢ s₂`. - -Using `IGame.mulOption`, this can alternatively be written as -`x * y = !{mulOption x y a₁ b₁ | mulOption x y a₂ b₂}`. -/ -@[no_expose] -noncomputable instance : Mul IGame where - mul := mul' - -/-- The general option of `x * y` looks like `a * y + x * b - a * b`, for `a` and `b` options of -`x` and `y`, respectively. -/ -@[pp_nodot] -def mulOption (x y a b : IGame) : IGame := - a * y + x * b - a * b - -theorem mul_eq (x y : IGame) : x * y = - !{(fun a ↦ mulOption x y a.1 a.2) '' (xᴸ ×ˢ yᴸ ∪ xᴿ ×ˢ yᴿ) | - (fun a ↦ mulOption x y a.1 a.2) '' (xᴸ ×ˢ yᴿ ∪ xᴿ ×ˢ yᴸ)} := by - change mul' _ _ = _ - rw [mul'] - simp [mulOption, HMul.hMul, Mul.mul, Set.ext_iff] - -theorem mul_eq' (x y : IGame) : x * y = - !{fun p ↦ (fun a ↦ mulOption x y a.1 a.2) '' - (xᴸ ×ˢ y.moves p ∪ xᴿ ×ˢ y.moves (-p))} := by - rw [mul_eq, ofSets_eq_ofSets_cases (fun _ ↦ _ '' _)]; rfl - -theorem ofSets_mul_ofSets (s₁ t₁ s₂ t₂ : Set IGame) [Small s₁] [Small t₁] [Small s₂] [Small t₂] : - !{s₁ | t₁} * !{s₂ | t₂} = - !{(fun a ↦ mulOption !{s₁ | t₁} !{s₂ | t₂} a.1 a.2) '' (s₁ ×ˢ s₂ ∪ t₁ ×ˢ t₂) | - (fun a ↦ mulOption !{s₁ | t₁} !{s₂ | t₂} a.1 a.2) '' (s₁ ×ˢ t₂ ∪ t₁ ×ˢ s₂)} := by - rw [mul_eq] - simp - -@[simp] -theorem moves_mul (p : Player) (x y : IGame) : - (x * y).moves p = (fun a ↦ mulOption x y a.1 a.2) '' - (xᴸ ×ˢ y.moves p ∪ xᴿ ×ˢ y.moves (-p)) := by - rw [mul_eq', moves_ofSets] - -@[simp] -theorem moves_mulOption (p : Player) (x y a b : IGame) : - (mulOption x y a b).moves p = (a * y + x * b - a * b).moves p := - rfl - -theorem mulOption_mem_moves_mul {px py : Player} {x y a b : IGame} - (h₁ : a ∈ x.moves px) (h₂ : b ∈ y.moves py) : mulOption x y a b ∈ (x * y).moves (px * py) := by - rw [moves_mul]; use (a, b); cases px <;> cases py <;> simp_all - - -theorem forall_moves_mul {p : Player} {P : IGame → Prop} {x y : IGame} : - (∀ a ∈ (x * y).moves p, P a) ↔ - (∀ p', ∀ a ∈ x.moves p', ∀ b ∈ y.moves (p' * p), P (mulOption x y a b)) := by - aesop - - -theorem exists_moves_mul {p : Player} {P : IGame → Prop} {x y : IGame} : - (∃ a ∈ (x * y).moves p, P a) ↔ - (∃ p', ∃ a ∈ x.moves p', ∃ b ∈ y.moves (p' * p), P (mulOption x y a b)) := by - aesop - -private theorem zero_mul' (x : IGame) : 0 * x = 0 := by - ext p; cases p <;> simp - -private theorem one_mul' (x : IGame) : 1 * x = x := by - refine moveRecOn x ?_ - aesop (add simp [mulOption, and_assoc, zero_mul']) - -private theorem igameMulComm (x y : IGame) : x * y = y * x := by - ext p - simp only [moves_mul, mem_image, mem_prod, mem_union, Prod.exists] - cases p; all_goals - dsimp - simp only [and_comm, or_comm] - rw [exists_comm] - congr! 4 with b a - rw [and_congr_right_iff] - rintro (⟨_, _⟩ | ⟨_, _⟩) <;> - rw [mulOption, mulOption, igameMulComm x, igameMulComm _ y, add_comm, igameMulComm a b] -termination_by (x, y) -decreasing_by inline_igame_wf - -instance : CommMagma IGame where - mul_comm := private igameMulComm - -instance : MulZeroClass IGame where - zero_mul := private zero_mul' - mul_zero x := private igameMulComm .. ▸ zero_mul' x - -instance : MulZeroOneClass IGame where - one_mul := private one_mul' - mul_one x := private igameMulComm .. ▸ one_mul' x - -theorem mulOption_comm (x y a b : IGame) : mulOption x y a b = mulOption y x b a := by - simp [mulOption, add_comm, mul_comm] - -private theorem neg_mul' (x y : IGame) : -x * y = -(x * y) := by - ext - simp only [moves_mul, moves_neg, mem_image, mem_union, mem_prod, mem_neg, Prod.exists] - rw [← (Equiv.neg _).exists_congr_right] - dsimp only [Player.neg_left, Player.neg_right] - simp only [Equiv.neg_apply, neg_neg, mulOption, or_comm] - congr! 4 - rw [and_congr_right_iff] - rintro (⟨_, _⟩ | ⟨_, _⟩) - all_goals - rw [← neg_inj, neg_mul', neg_mul', neg_mul'] - simp [sub_eq_add_neg, add_comm] -termination_by (x, y) -decreasing_by inline_igame_wf - -instance : HasDistribNeg IGame where - neg_mul := private neg_mul' - mul_neg _ _ := by rw [mul_comm, neg_mul', mul_comm] - -theorem mulOption_neg_left (x y a b : IGame) : mulOption (-x) y a b = -mulOption x y (-a) b := by - simp [mulOption, sub_eq_neg_add, add_comm] - -theorem mulOption_neg_right (x y a b : IGame) : mulOption x (-y) a b = -mulOption x y a (-b) := by - simp [mulOption, sub_eq_neg_add, add_comm] - -theorem mulOption_neg (x y a b : IGame) : mulOption (-x) (-y) a b = mulOption x y (-a) (-b) := by - simp [mulOption, sub_eq_neg_add, add_comm] - -@[simp] -theorem mulOption_zero_left (x y a : IGame) : mulOption x y 0 a = x * a := by - simp [mulOption] - -@[simp] -theorem mulOption_zero_right (x y a : IGame) : mulOption x y a 0 = a * y := by - simp [mulOption] - -/-! Distributivity and associativity only hold up to equivalence; we prove this in -`CombinatorialGames.Game.Basic`. -/ - - -end IGame -end - -/-! ## Inlined from `CombinatorialGames.Tactic.AddInstances` -/ - -/-! -# Eagerly add instances - -Many definitions in game theory are hereditary. For instance, all options of a `Numeric` game are -`Numeric`, all options of an `Impartial` game are `Impartial`, etc. - -The definition `addInstances` provides a tactic which will eagerly apply all passed functions to all -of the hypotheses, creating new ones in the process. The intended usage of this is to, for instance, -apply `Numeric.of_mem_moves` to all hypotheses, and thus build all possible `Numeric` instances. --/ - -open Lean Meta Elab Tactic - -/-- Apply the supplied instance-producing declarations to local hypotheses and add the resulting -instances to the goal. -/ -meta def instances (constants : Array Name) (goal : MVarId) : MetaM (Option MVarId) := - goal.withContext do - let mut goal := goal - for h in ← getLCtx do - if h.isImplementationDetail then continue - ⟨_, goal⟩ ← goal.assertHypotheses =<< constants.filterMapM fun c => do - let hc ← try mkAppM c #[h.toExpr] catch _ => return none - return some { - userName := ← mkFreshUserName `inst - type := ← inferType hc - value := hc - } - return goal - -/-- A tactic that eagerly adds instances by applying the functions in `constants` to every -hypothesis. -/ -public meta def addInstances (constants : Array Name) : TacticM Unit := - liftMetaTactic1 (instances constants) - -/-! ## Inlined from `CombinatorialGames.Game.Classes` -/ - -/-! -# Classes of games - -This file collects multiple basic classes of games, so as to make them available on most files. We -develop their theory elsewhere. - -## Dicotic games - -A game is dicotic when every non-zero subposition has both left and right moves. The Lawnmower -theorem (proven in `CombinatorialGames.Game.Small`) shows that every dicotic game is small. - -## Impartial games - -We define an impartial game as one where every subposition is equivalent to its negative. This is a -weaker definition than that found in the literature (which requires equality, rather than -equivalence), but this is still strong enough to prove the Sprague--Grundy theorem, as well as -closure under the basic arithmetic operations of multiplication and division. - -## Numeric games - -A game is `Numeric` if all the Left options are strictly smaller than all the Right options, and all -those options are themselves numeric. In terms of combinatorial games, the numeric games have -"frozen"; you can only make your position worse by playing, and Left is some definite "number" of -moves ahead (or behind) Right. - -## Short games - -A combinatorial game is `Short` if it has only finitely many subpositions. In particular, this means -there is a finite set of moves at every point. - -The `game_cmp` tactic supplies computation for short combinatorial games. --/ - -universe u_inline_6 - -@[expose] public -section - -namespace IGame - -/-! ### Numeric games -/ - -/-- A game `!{s | t}` is numeric if everything in `s` is less than everything in `t`, and all the -elements of these sets are also numeric. - -The `Surreal` numbers are built as the quotient of numeric games under equivalence. -/ -@[mk_iff numeric_def'] -class -inductive Numeric : IGame → Prop where - | mk {x : IGame} : (∀ y ∈ xᴸ, ∀ z ∈ xᴿ, y < z) → (∀ p, ∀ y ∈ x.moves p, Numeric y) → Numeric x - -theorem numeric_def {x : IGame} : Numeric x ↔ - (∀ y ∈ xᴸ, ∀ z ∈ xᴿ, y < z) ∧ (∀ p, ∀ y ∈ x.moves p, Numeric y) := - numeric_def' x - -namespace Numeric -variable {x y z : IGame} - -theorem left_lt_right [h : Numeric x] (hy : y ∈ xᴸ) (hz : z ∈ xᴿ) : y < z := - (numeric_def.1 h).1 y hy z hz - -protected theorem of_mem_moves {p : Player} [h : Numeric x] (hy : y ∈ x.moves p) : Numeric y := - (numeric_def.1 h).2 p y hy - -/-- `inline_numeric` eagerly adds all possible `Numeric` hypotheses. -/ -elab (name := inlineNumeric) "inline_numeric" : tactic => - addInstances <| .mk [`ConwayRefinement.Standalone.InlineSurreal.IGame.Numeric.of_mem_moves] - -protected theorem subposition [Numeric x] (h : Subposition y x) : Numeric y := by - induction x using IGame.moveRecOn generalizing ‹x.Numeric› with | ind x ih - obtain ⟨p, z, hz, hy⟩ := subposition_iff_exists.1 h - obtain rfl | hy := wsubposition_iff_eq_or_subposition.1 hy - · exact .of_mem_moves hz - · exact @ih p z hz (.of_mem_moves hz) hy - -@[simp] -protected instance zero : Numeric 0 := by - rw [numeric_def]; simp - -@[simp] -protected instance one : Numeric 1 := by - rw [numeric_def]; simp - -protected instance subtype (x : Subtype Numeric) : Numeric x.1 := x.2 -protected instance moves {x : IGame} [Numeric x] {p : Player} (y : x.moves p) : Numeric y := - .of_mem_moves y.2 - -protected theorem le_of_not_le {x y : IGame} [Numeric x] [Numeric y] : ¬ x ≤ y → y ≤ x := by - rw [lf_iff_exists_le, le_iff_forall_lf] - rintro (⟨z, hz, h⟩ | ⟨z, hz, h⟩) <;> constructor <;> intro a ha h' - · inline_numeric - exact left_lf_of_le h' hz (Numeric.le_of_not_le (left_lf_of_le h ha)) - · exact (left_lt_right hz ha).not_ge (h'.trans h) - · exact (left_lt_right ha hz).not_ge (h.trans h') - · inline_numeric - exact lf_right_of_le h' hz (Numeric.le_of_not_le (lf_right_of_le h ha)) -termination_by x -decreasing_by inline_igame_wf - -protected theorem le_total (x y : IGame) [Numeric x] [Numeric y] : x ≤ y ∨ y ≤ x := by - rw [or_iff_not_imp_left] - exact Numeric.le_of_not_le - -protected theorem lt_of_not_ge [Numeric x] [Numeric y] (h : ¬ x ≤ y) : y < x := - (Numeric.le_of_not_le h).lt_of_not_ge h - -@[simp] -protected theorem not_le [Numeric x] [Numeric y] : ¬ x ≤ y ↔ y < x := - ⟨Numeric.lt_of_not_ge, not_le_of_gt⟩ - -@[simp] -protected theorem not_lt [Numeric x] [Numeric y] : ¬ x < y ↔ y ≤ x := - not_iff_comm.1 Numeric.not_le - -protected theorem le_or_gt (x y : IGame) [Numeric x] [Numeric y] : x ≤ y ∨ y < x := by - rw [← Numeric.not_le] - exact em _ - -protected theorem lt_or_ge (x y : IGame) [Numeric x] [Numeric y] : x < y ∨ y ≤ x := by - rw [← Numeric.not_lt] - exact em _ - -theorem not_fuzzy (x y : IGame) [Numeric x] [Numeric y] : ¬ x ‖ y := by - simpa [not_incompRel_iff_symmGen, Relation.SymmGen] using Numeric.le_total x y - -theorem lt_or_equiv_or_gt (x y : IGame) [Numeric x] [Numeric y] : x < y ∨ x ≈ y ∨ y < x := by - simp_rw [← Numeric.not_le]; tauto - -/-- To prove a game is numeric, it suffices to show the left options are less or fuzzy -to the right options. -/ -theorem mk_of_lf (h₁ : ∀ y ∈ xᴸ, ∀ z ∈ xᴿ, y ⧏ z) (h₂ : ∀ p, ∀ y ∈ x.moves p, Numeric y) : - Numeric x := - mk (fun y hy z hz ↦ (@Numeric.not_le z y (h₂ _ z hz) (h₂ _ y hy)).1 (h₁ y hy z hz)) h₂ - -theorem le_iff_forall_lt [Numeric x] [Numeric y] : - x ≤ y ↔ (∀ z ∈ xᴸ, z < y) ∧ (∀ z ∈ yᴿ, x < z) := by - rw [le_iff_forall_lf] - congr! with z hz z hz <;> inline_numeric <;> rw [Numeric.not_le] - -theorem lt_iff_exists_le [Numeric x] [Numeric y] : - x < y ↔ (∃ z ∈ yᴸ, x ≤ z) ∨ (∃ z ∈ xᴿ, z ≤ y) := by - rw [← Numeric.not_le, lf_iff_exists_le] - -theorem left_lt [Numeric x] (h : y ∈ xᴸ) : y < x := by - inline_numeric; simpa using left_lf h - -theorem lt_right [Numeric x] (h : y ∈ xᴿ) : x < y := by - inline_numeric; simpa using lf_right h - -protected instance neg (x : IGame) [Numeric x] : Numeric (-x) := by - refine mk (fun y hy z hz ↦ ?_) ?_ - · rw [← IGame.neg_lt_neg_iff] - apply @left_lt_right x <;> simp_all - · simp_rw [forall_moves_neg] - intro p y hy - inline_numeric - simpa using Numeric.neg y -termination_by x -decreasing_by inline_igame_wf - -@[simp] -theorem neg_iff {x : IGame} : Numeric (-x) ↔ Numeric x := - ⟨fun _ ↦ by simpa using Numeric.neg (-x), fun _ ↦ Numeric.neg x⟩ - -protected instance add (x y : IGame) [Numeric x] [Numeric y] : Numeric (x + y) := by - apply mk <;> simp only [moves_add, Set.mem_union, Set.mem_image] - · rintro _ (⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩) _ (⟨b, hb, rfl⟩ | ⟨b, hb, rfl⟩) - any_goals simpa using left_lt_right ha hb - all_goals - trans (x + y) - · simpa using left_lt ha - · simpa using lt_right hb - · rintro p _ (⟨z, hz, rfl⟩ | ⟨z, hz, rfl⟩) - all_goals inline_numeric; exact Numeric.add .. -termination_by (x, y) -decreasing_by inline_igame_wf - -protected instance sub (x y : IGame) [Numeric x] [Numeric y] : Numeric (x - y) := - inferInstanceAs (Numeric (x + -y)) - -protected instance natCast : ∀ n : ℕ, Numeric n - | 0 => inferInstanceAs (Numeric 0) - | n + 1 => have := Numeric.natCast n; inferInstanceAs (Numeric (n + 1)) - -protected instance ofNat (n : ℕ) [n.AtLeastTwo] : Numeric ofNat(n) := - inferInstanceAs (Numeric n) - -protected instance intCast : ∀ n : ℤ, Numeric n - | .ofNat n => inferInstanceAs (Numeric n) - | .negSucc n => inferInstanceAs (Numeric (-(n + 1))) - -end Numeric - - -end IGame - -/-! ## Inlined from `CombinatorialGames.Game.Basic` -/ - -/-! -# Combinatorial games - -In this file we construct the quotient of games `IGame` under equivalence, and prove that it forms -an `OrderedAddCommGroup`. We take advantage of this structure to prove two particularly tedious -theorems on `IGame`, namely `IGame.mul_add_equiv` and `IGame.mul_assoc_equiv`. - -It might be tempting to write `mk (x * y)` as `mk x * mk y`, but the latter is not well-defined, as -there exist `x₁ ≈ x₂` and `y₁ ≈ y₂` with `x₁ * y₁ ≉ x₂ * y₂`. See -`CombinatorialGames.Counterexamples.Multiplication` for a proof. --/ - -universe u_inline_7 - -@[expose] public noncomputable -section - -open IGame Set Pointwise - -/-- Games up to equivalence. - -If `x` and `y` are combinatorial games (`IGame`), we say that `x ≈ y` when both `x ≤ y` and `y ≤ x`. -Broadly, this means neither player has a preference in playing either game, as a component of a -larger game. This is the standard meaning of `x = y` in the literature, though it is not a strict -equality, e.g. `{0, 1 | 0}` and `{1 | 0}` are equivalent, but not identical as the former has an -extra move for Left. - -In particular, note that a `Game` has no well-defined notion of left and right options. This means -you should prefer `IGame` when analyzing specific games. -/ -def Game : Type (u_inline_7 + 1) := - Antisymmetrization IGame (· ≤ ·) - -namespace Game - -/-- The quotient map from `IGame` into `Game`. -/ -def mk (x : IGame) : Game := Quotient.mk _ x -theorem mk_eq_mk {x y : IGame} : mk x = mk y ↔ x ≈ y := Quotient.eq - -alias ⟨_, mk_eq⟩ := mk_eq_mk - -@[cases_eliminator] -theorem ind {motive : Game → Prop} (mk : ∀ y, motive (mk y)) (x : Game) : motive x := - Quotient.ind mk x - -/-- Choose an element of the equivalence class using the axiom of choice. -/ -@[no_expose] def out (x : Game) : IGame := Quotient.out x -@[simp] theorem out_eq (x : Game) : mk x.out = x := Quotient.out_eq x - -theorem mk_out_equiv (x : IGame) : (mk x).out ≈ x := Quotient.mk_out (s := AntisymmRel.setoid ..) x -theorem equiv_mk_out (x : IGame) : x ≈ (mk x).out := (mk_out_equiv x).symm - -/-- Construct a `Game` from its left and right sets. - -Note that although this function is well-defined, this function isn't injective, nor do equivalence -classes in `Game` have a canonical representative. -/ -instance : OfSets Game.{u_inline_7} fun _ ↦ True where - ofSets st _ := mk !{fun p ↦ out '' (st p)} - -theorem mk_ofSets' (st : Player → Set IGame.{u_inline_7}) - [Small.{u_inline_7} (st left)] [Small.{u_inline_7} (st right)] : - mk !{st} = !{fun p ↦ mk '' st p} := by - refine mk_eq <| IGame.equiv_of_exists ?_ ?_ ?_ ?_ <;> - simpa using fun a ha ↦ ⟨a, ha, equiv_mk_out a⟩ - -@[simp] -theorem mk_ofSets (s t : Set IGame.{u_inline_7}) [Small.{u_inline_7} s] [Small.{u_inline_7} t] : - mk !{s | t} = !{mk '' s | mk '' t} := by - rw [mk_ofSets'] - simp_rw [Player.apply_cases] - -private theorem ofSets_cases (s t : Set Game.{u_inline_7}) [Small.{u_inline_7} s] - [Small.{u_inline_7} t] : - !{s | t} = mk !{out '' s | out '' t} := by - simp [mk_ofSets, image_image] - -instance : Zero Game := ⟨mk 0⟩ -instance : One Game := ⟨mk 1⟩ -instance : Add Game := ⟨Quotient.map₂ _ @add_congr⟩ -instance : Neg Game := ⟨Quotient.map _ @neg_congr⟩ -instance : PartialOrder Game := inferInstanceAs (PartialOrder (Antisymmetrization ..)) -instance : Inhabited Game := ⟨0⟩ - -instance : AddCommGroupWithOne Game where - zero_add := by rintro ⟨x⟩; exact congr(mk $(zero_add _)) - add_zero := by rintro ⟨x⟩; exact congr(mk $(add_zero _)) - add_comm := by rintro ⟨x⟩ ⟨y⟩; exact congr(mk $(add_comm _ _)) - add_assoc := by rintro ⟨x⟩ ⟨y⟩ ⟨z⟩; exact congr(mk $(add_assoc _ _ _)) - neg_add_cancel := by rintro ⟨a⟩; exact mk_eq (neg_add_equiv _) - nsmul := nsmulRec - zsmul := zsmulRec - -instance : IsOrderedAddMonoid Game where - add_le_add_left := by rintro ⟨a⟩ ⟨b⟩ h ⟨c⟩; exact add_le_add_left (α := IGame) h _ - -@[simp] theorem mk_zero : mk 0 = 0 := rfl -@[simp] theorem mk_one : mk 1 = 1 := rfl -@[simp] theorem mk_add (x y : IGame) : mk (x + y) = mk x + mk y := rfl -@[simp] theorem mk_neg (x : IGame) : mk (-x) = -mk x := rfl -@[simp] theorem mk_sub (x y : IGame) : mk (x - y) = mk x - mk y := rfl - -theorem mk_mulOption (x y a b : IGame) : - mk (mulOption x y a b) = mk (a * y) + mk (x * b) - mk (a * b) := - rfl - -@[simp] theorem mk_le_mk {x y : IGame} : mk x ≤ mk y ↔ x ≤ y := .rfl -@[simp] theorem mk_lt_mk {x y : IGame} : mk x < mk y ↔ x < y := .rfl -@[simp] theorem mk_fuzzy_mk {x y : IGame} : mk x ‖ mk y ↔ x ‖ y := .rfl - -@[simp, norm_cast] -theorem mk_natCast : ∀ n : ℕ, mk n = n - | 0 => rfl - | n + 1 => by rw [Nat.cast_add, Nat.cast_add, mk_add, mk_natCast]; rfl - -@[simp, norm_cast] -theorem mk_intCast (n : ℤ) : mk n = n := by - cases n <;> simp - -theorem zero_def : (0 : Game) = !{fun _ ↦ ∅} := by apply (mk_ofSets' ..).trans; simp -theorem one_def : (1 : Game) = !{{0} | ∅} := by apply (mk_ofSets ..).trans; simp - -instance : ZeroLEOneClass Game where - zero_le_one := zero_le_one (α := IGame) - -instance : NeZero (1 : Game) where - out := by apply ne_of_gt; exact IGame.zero_lt_one - -instance : Nontrivial Game := ⟨_, _, zero_ne_one⟩ -instance : CharZero Game := AddMonoidWithOne.toCharZero - -theorem mk_mul_add (x y z : IGame) : mk (x * (y + z)) = mk (x * y) + mk (x * z) := by - rw [← mk_add, add_eq' (x * y), mul_eq'] - simp only [moves_add, moves_mul, prod_union, union_assoc, image_image, image_union, mk_ofSets'] - congr! 2 - ext p - nth_rewrite 2 [union_left_comm] - congrm _ ∈ ?_ ∪ (?_ ∪ (?_ ∪ ?_)) - all_goals - ext - simp only [mulOption, mk_sub, mk_add, mem_image, mem_prod, and_assoc, Prod.exists, - exists_and_left, exists_exists_and_eq_and] - iterate 2 (congr! 2; rw [and_congr_right_iff]; intros) - congr! 1 - rw [mk_mul_add, mk_mul_add, mk_mul_add] - abel -termination_by (x, y, z) -decreasing_by inline_igame_wf - -theorem mk_mul_sub (x y z : IGame) : mk (x * (y - z)) = mk (x * y) - mk (x * z) := by - simpa [sub_eq_add_neg] using mk_mul_add x y (-z) - -theorem mk_add_mul (x y z : IGame) : mk ((x + y) * z) = mk (x * z) + mk (y * z) := by - rw [mul_comm, mk_mul_add, mul_comm, mul_comm z] - -theorem mk_sub_mul (x y z : IGame) : mk ((x - y) * z) = mk (x * z) - mk (y * z) := by - simpa [sub_eq_add_neg] using mk_add_mul x (-y) z - -theorem mk_mul_assoc (x y z : IGame) : mk (x * y * z) = mk (x * (y * z)) := by - induction x using IGame.ofSetsRecOn generalizing y z with | ofSets xL xR ihxl ihxr - induction y using IGame.ofSetsRecOn generalizing z with | ofSets yL yR ihyl ihyr - induction z using IGame.ofSetsRecOn with | ofSets zL zR ihzl ihzr - simp_rw [ofSets_mul_ofSets, mk_ofSets, Set.image_union, Set.image_image, mk_mulOption, - ← Set.image_union, ← ofSets_mul_ofSets, - Set.prod_image_left, Set.prod_image_right, Set.union_prod, Set.prod_union, - ← Equiv.prod_assoc_image, ← Set.image_union, Set.image_image, Equiv.prodAssoc_apply] - have e1 : (xL ×ˢ yL) ×ˢ zL ∪ (xR ×ˢ yR) ×ˢ zL ∪ ((xL ×ˢ yR) ×ˢ zR ∪ (xR ×ˢ yL) ×ˢ zR) = - (xL ×ˢ yL) ×ˢ zL ∪ (xL ×ˢ yR) ×ˢ zR ∪ ((xR ×ˢ yL) ×ˢ zR ∪ (xR ×ˢ yR) ×ˢ zL) := by - ac_rfl - have e2 : (xL ×ˢ yL) ×ˢ zR ∪ (xR ×ˢ yR) ×ˢ zR ∪ ((xL ×ˢ yR) ×ˢ zL ∪ (xR ×ˢ yL) ×ˢ zL) = - (xL ×ˢ yL) ×ˢ zR ∪ (xL ×ˢ yR) ×ˢ zL ∪ ((xR ×ˢ yL) ×ˢ zL ∪ (xR ×ˢ yR) ×ˢ zR) := by - ac_rfl - simp only [e1, e2] - congrm !{?_ | ?_} <;> - · refine Set.image_congr fun ⟨⟨x, y⟩, z⟩ hxyz => ?_ - obtain ⟨hx, hy, hz⟩ : (x ∈ xL ∨ x ∈ xR) ∧ (y ∈ yL ∨ y ∈ yR) ∧ (z ∈ zL ∨ z ∈ zR) := by - simp only [mem_union, mem_prod] at hxyz - tauto - simp only [mulOption, mk_sub_mul, mk_add_mul, mk_mul_sub, mk_mul_add, - hx.elim (ihxl x) (ihxr x), hy.elim (ihyl y) (ihyr y), hz.elim (ihzl z) (ihzr z)] - abel - -theorem lf_ofSets_of_mem_left {s t : Set Game.{u_inline_7}} [Small.{u_inline_7} s] - [Small.{u_inline_7} t] {x : Game.{u_inline_7}} - (h : x ∈ s) : x ⧏ !{s | t} := by - rw [ofSets_cases] - have : x.out ∈ !{out '' s | out '' t}ᴸ := by simpa using mem_image_of_mem _ h - simpa [← mk_le_mk] using left_lf this - -theorem ofSets_lf_of_mem_right {s t : Set Game.{u_inline_7}} [Small.{u_inline_7} s] - [Small.{u_inline_7} t] {x : Game.{u_inline_7}} - (h : x ∈ t) : !{s | t} ⧏ x := by - rw [ofSets_cases] - have : x.out ∈ !{out '' s | out '' t}ᴿ := by simpa using mem_image_of_mem _ h - simpa [← mk_le_mk] using lf_right this - -end Game - -namespace IGame - -protected theorem sub_le_iff_le_add {x y z : IGame} : x - z ≤ y ↔ x ≤ y + z := - @sub_le_iff_le_add Game _ _ _ (.mk x) (.mk y) (.mk z) - -protected theorem le_sub_iff_add_le {x y z : IGame} : x ≤ z - y ↔ x + y ≤ z := - @le_sub_iff_add_le Game _ _ _ (.mk x) (.mk y) (.mk z) - -protected theorem sub_lt_iff_lt_add {x y z : IGame} : x - z < y ↔ x < y + z := - @sub_lt_iff_lt_add Game _ _ _ (.mk x) (.mk y) (.mk z) - -protected theorem lt_sub_iff_add_lt {x y z : IGame} : x < z - y ↔ x + y < z := - @lt_sub_iff_add_lt Game _ _ _ (.mk x) (.mk y) (.mk z) - -protected theorem sub_nonneg {x y : IGame} : 0 ≤ x - y ↔ y ≤ x := - @sub_nonneg Game _ _ _ (.mk x) (.mk y) - -protected theorem sub_nonpos {x y : IGame} : x - y ≤ 0 ↔ x ≤ y := - @sub_nonpos Game _ _ _ (.mk x) (.mk y) - -protected theorem sub_pos {x y : IGame} : 0 < x - y ↔ y < x := - @sub_pos Game _ _ _ (.mk x) (.mk y) - -protected theorem sub_neg {x y : IGame} : x - y < 0 ↔ x < y := - @sub_neg Game _ _ _ (.mk x) (.mk y) - -theorem mul_add_equiv (x y z : IGame) : x * (y + z) ≈ x * y + x * z := - Game.mk_eq_mk.1 (Game.mk_mul_add x y z) - -theorem mul_sub_equiv (x y z : IGame) : x * (y - z) ≈ x * y - x * z := - Game.mk_eq_mk.1 (Game.mk_mul_sub x y z) - -theorem add_mul_equiv (x y z : IGame) : (x + y) * z ≈ x * z + y * z := - Game.mk_eq_mk.1 (Game.mk_add_mul x y z) - -theorem sub_mul_equiv (x y z : IGame) : (x - y) * z ≈ x * z - y * z := - Game.mk_eq_mk.1 (Game.mk_sub_mul x y z) - -theorem mul_assoc_equiv (x y z : IGame) : x * y * z ≈ x * (y * z) := - Game.mk_eq_mk.1 (Game.mk_mul_assoc x y z) - -@[simp, norm_cast] -theorem natCast_le {m n : ℕ} : (m : IGame) ≤ n ↔ m ≤ n := by - simp [← Game.mk_le_mk] - -@[simp, norm_cast] -theorem natCast_lt {m n : ℕ} : (m : IGame) < n ↔ m < n := by - simp [← Game.mk_lt_mk] - -@[simp] -theorem natCast_nonneg (n : ℕ) : 0 ≤ (n : IGame) := - natCast_le.2 n.zero_le - -theorem natCast_strictMono : StrictMono ((↑) : ℕ → IGame) := - fun _ _ h ↦ natCast_lt.2 h - -instance : CharZero IGame where - cast_injective := natCast_strictMono.injective - -@[simp, norm_cast] -theorem natCast_equiv {m n : ℕ} : (m : IGame) ≈ n ↔ m = n := by - simp [AntisymmRel, le_antisymm_iff] - -@[simp, norm_cast] -theorem intCast_le {m n : ℤ} : (m : IGame) ≤ n ↔ m ≤ n := by - simp [← Game.mk_le_mk] - -@[simp, norm_cast] -theorem intCast_lt {m n : ℤ} : (m : IGame) < n ↔ m < n := by - simp [← Game.mk_lt_mk] - -theorem intCast_strictMono : StrictMono ((↑) : ℤ → IGame) := - fun _ _ h ↦ intCast_lt.2 h - -@[simp, norm_cast] -theorem intCast_inj {m n : ℤ} : (m : IGame) = n ↔ m = n := - intCast_strictMono.injective.eq_iff - -@[simp, norm_cast] -theorem intCast_equiv {m n : ℤ} : (m : IGame) ≈ n ↔ m = n := by - simp [AntisymmRel, le_antisymm_iff] - -theorem intCast_add_equiv (m n : ℤ) : ((m + n : ℤ) : IGame) ≈ m + n := by - simp [← Game.mk_eq_mk] - -theorem intCast_sub_equiv (m n : ℤ) : ((m - n : ℤ) : IGame) ≈ m - n := by - simp [← Game.mk_eq_mk] - -@[simp, norm_cast] -theorem zero_lt_intCast {n : ℤ} : 0 < (n : IGame) ↔ 0 < n := by - simpa using intCast_lt (m := 0) - -@[simp, norm_cast] -theorem intCast_lt_zero {n : ℤ} : (n : IGame) < 0 ↔ n < 0 := by - simpa using intCast_lt (n := 0) - -@[simp, norm_cast] -theorem zero_le_intCast {n : ℤ} : 0 ≤ (n : IGame) ↔ 0 ≤ n := by - simpa using intCast_le (m := 0) - -@[simp, norm_cast] -theorem intCast_le_zero {n : ℤ} : (n : IGame) ≤ 0 ↔ n ≤ 0 := by - simpa using intCast_le (n := 0) - -end IGame -end - -/-! ## Inlined from `CombinatorialGames.Surreal.Basic` -/ - -/-! -# Surreal numbers - -The basic theory of surreal numbers, built on top of the theory of combinatorial (pre-)games. A -surreal number is defined as an equivalence class of numeric games. - -Surreal numbers inherit the relations `≤` and `<` from games, and these relations satisfy the axioms -of a linear order. In fact, the surreals form a complete ordered field, containing a copy of the -reals, and much else besides! - -## Algebraic operations - -In this file, we show that the surreals form a linear ordered commutative group. - -In `CombinatorialGames.Surreal.Multiplication`, we define multiplication and show that the surreals -form a linear ordered commutative ring. In `CombinatorialGames.Surreal.Division` we further show the -surreals are a field. --/ - -universe u_inline_8 - -@[expose] public noncomputable -section - -/-! ### Simplicity theorem -/ - -namespace IGame - -/-- `x` fits within `y` when `z ⧏ x` for every `z ∈ yᴸ`, and `x ⧏ z` for every -`z ∈ yᴿ`. - -The simplicity theorem states that if a game fits a numeric game, but none of its options do, then -the games are equivalent. In particular, a numeric game is equivalent to the game of the least -birthday that fits in it -/ -def Fits (x y : IGame) : Prop := - (∀ z ∈ yᴸ, z ⧏ x) ∧ (∀ z ∈ yᴿ, x ⧏ z) - -theorem fits_of_equiv {x y : IGame} (h : x ≈ y) : Fits x y := - ⟨fun _ hz ↦ mt h.ge.trans (left_lf hz), fun _ hz ↦ mt h.le.trans' (lf_right hz) ⟩ - -alias AntisymmRel.Fits := fits_of_equiv - -theorem Fits.refl (x : IGame) : x.Fits x := - fits_of_equiv .rfl - -instance : Std.Refl Fits where - refl := Fits.refl - -theorem Fits.antisymm {x y : IGame} (h₁ : Fits x y) (h₂ : Fits y x) : x ≈ y := by - rw [AntisymmRel, le_iff_forall_lf, le_iff_forall_lf] - exact ⟨⟨h₂.1, h₁.2⟩, ⟨h₁.1, h₂.2⟩⟩ - -@[simp] -theorem fits_neg_iff {x y : IGame} : Fits (-x) (-y) ↔ Fits x y := by - simp [Fits, and_comm] - -alias ⟨_, Fits.neg⟩ := fits_neg_iff - -theorem not_fits_iff {x y : IGame} : - ¬ Fits x y ↔ (∃ z ∈ yᴸ, x ≤ z) ∨ (∃ z ∈ yᴿ, z ≤ x) := by - rw [Fits, not_and_or]; simp - -theorem Fits.congr {x y z : IGame} (h : x ≈ y) (hx : x.Fits z) : y.Fits z := by - constructor <;> intro w hw <;> grw [← h] - exacts [hx.1 w hw, hx.2 w hw] - -theorem fits_congr {x y z : IGame} (h : x ≈ y) : x.Fits z ↔ y.Fits z := - ⟨.congr h, .congr h.symm⟩ - -/-- A variant of the **simplicity theorem** with hypotheses that are easier to show. -/ -theorem Fits.equiv_of_forall_moves {x y : IGame} (hx : x.Fits y) - (hl : ∀ z ∈ xᴸ, ∃ w ∈ yᴸ, z ≤ w) (hr : ∀ z ∈ xᴿ, ∃ w ∈ yᴿ, w ≤ z) : x ≈ y := - ⟨le_of_forall_moves_right_lf hx.2 hl, le_of_forall_moves_left_lf hx.1 hr⟩ - -/-- A variant of the **simplicity theorem**: if a numeric game `x` fits within a game `y`, but none -of its options do, then `x ≈ y`. - -Note that under most circumstances, `Fits.equiv_of_forall_moves` is easier to use. -/ -theorem Fits.equiv_of_forall_not_fits {x y : IGame} [Numeric x] (hx : x.Fits y) - (h : ∀ p, ∀ z ∈ x.moves p, ¬ z.Fits y) : x ≈ y := by - simp_rw [not_fits_iff] at h - apply hx.equiv_of_forall_moves - · refine fun z hz ↦ (h _ z hz).resolve_right ?_ - rintro ⟨w, hw, hwz⟩ - exact hx.2 w hw <| hwz.trans (Numeric.left_lt hz).le - · refine fun z hz ↦ (h _ z hz).resolve_left ?_ - rintro ⟨w, hw, hwz⟩ - exact hx.1 w hw <| (Numeric.lt_right hz).le.trans hwz - -/-- A specialization of the simplicity theorem to `0`. -/ -@[simp] -theorem fits_zero_iff_equiv {x : IGame} : Fits 0 x ↔ x ≈ 0 := - ⟨fun hx ↦ (hx.equiv_of_forall_not_fits <| by simp).symm, fun h ↦ fits_of_equiv h.symm⟩ - -/-- A specialization of the simplicity theorem to `1`. -/ -theorem equiv_one_of_fits {x : IGame} (hx : Fits 1 x) (h : ¬ x ≈ 0) : x ≈ 1 := by - apply (hx.equiv_of_forall_not_fits _).symm - simpa - -end IGame - -/-! ### Surreal numbers -/ - -open IGame - -/-- The type of surreal numbers. These are the numeric games quotiented by the antisymmetrization -relation `x ≈ y ↔ x ≤ y ∧ y ≤ x`. In the quotient, the order becomes a total order. -/ -def Surreal : Type (u_inline_8 + 1) := - Antisymmetrization (Subtype Numeric) (· ≤ ·) - -namespace Surreal - -/-- The quotient map from the subtype of numeric `IGame`s into `Game`. -/ -def mk (x : IGame) [h : Numeric x] : Surreal := Quotient.mk _ ⟨x, h⟩ -theorem mk_eq_mk {x y : IGame} [Numeric x] [Numeric y] : mk x = mk y ↔ x ≈ y := Quotient.eq - -alias ⟨_, mk_eq⟩ := mk_eq_mk - -@[cases_eliminator] -theorem ind {motive : Surreal → Prop} (mk : ∀ y [Numeric y], motive (mk y)) (x : Surreal) : - motive x := Quotient.ind (fun h ↦ @mk _ h.2) x - -/-- Choose an element of the equivalence class using the axiom of choice. -/ -@[no_expose] def out (x : Surreal) : IGame := (Quotient.out x).1 -@[simp] instance (x : Surreal) : Numeric x.out := (Quotient.out x).2 -@[simp] theorem out_eq (x : Surreal) : mk x.out = x := Quotient.out_eq x - -theorem mk_out_equiv (x : IGame) [h : Numeric x] : (mk x).out ≈ x := - Quotient.mk_out (s := AntisymmRel.setoid (Subtype _) (· ≤ ·)) ⟨x, h⟩ - -theorem equiv_mk_out (x : IGame) [Numeric x] : x ≈ (mk x).out := - (mk_out_equiv x).symm - -instance : Zero Surreal := ⟨mk 0⟩ -instance : One Surreal := ⟨mk 1⟩ -instance : Inhabited Surreal := ⟨0⟩ - -instance : Add Surreal where - add := Quotient.map₂ (fun a b ↦ ⟨a.1 + b.1, inferInstance⟩) fun _ _ h₁ _ _ h₂ ↦ add_congr h₁ h₂ - -instance : Neg Surreal where - neg := Quotient.map (fun a ↦ ⟨-a.1, inferInstance⟩) fun _ _ ↦ neg_congr - -instance : PartialOrder Surreal := - inferInstanceAs (PartialOrder (Antisymmetrization ..)) - -instance : LinearOrder Surreal where - le_total := by rintro ⟨x⟩ ⟨y⟩; exact Numeric.le_total x y - toDecidableLE := Classical.decRel _ - -instance : AddCommGroup Surreal where - zero_add := by rintro ⟨x⟩; change mk (0 + x) = mk x; simp_rw [zero_add] - add_zero := by rintro ⟨x⟩; change mk (x + 0) = mk x; simp_rw [add_zero] - add_comm := by rintro ⟨x⟩ ⟨y⟩; change mk (x + y) = mk (y + x); simp_rw [add_comm] - add_assoc := by rintro ⟨x⟩ ⟨y⟩ ⟨z⟩; change mk (x + y + z) = mk (x + (y + z)); simp_rw [add_assoc] - neg_add_cancel := by rintro ⟨a⟩; exact mk_eq (neg_add_equiv _) - nsmul := nsmulRec - zsmul := zsmulRec - -instance : AddGroupWithOne Surreal where - -instance : IsOrderedAddMonoid Surreal where - add_le_add_left := by rintro ⟨a⟩ ⟨b⟩ h ⟨c⟩; exact add_le_add_left (α := IGame) h _ - -@[simp] theorem mk_zero : mk 0 = 0 := rfl -@[simp] theorem mk_one : mk 1 = 1 := rfl -@[simp] theorem mk_add (x y : IGame) [Numeric x] [Numeric y] : mk (x + y) = mk x + mk y := rfl -@[simp] theorem mk_neg (x : IGame) [Numeric x] : mk (-x) = -mk x := rfl -@[simp] theorem mk_sub (x y : IGame) [Numeric x] [Numeric y] : mk (x - y) = mk x - mk y := rfl - -@[simp] theorem mk_le_mk {x y : IGame} [Numeric x] [Numeric y] : mk x ≤ mk y ↔ x ≤ y := Iff.rfl -@[simp] theorem mk_lt_mk {x y : IGame} [Numeric x] [Numeric y] : mk x < mk y ↔ x < y := Iff.rfl - -@[simp] -theorem mk_natCast : ∀ n : ℕ, mk n = n - | 0 => rfl - | n + 1 => by simp_rw [Nat.cast_add_one, mk_add, mk_one, mk_natCast n] - -@[simp] -theorem mk_intCast (n : ℤ) : mk n = n := by - cases n <;> simp - -instance : ZeroLEOneClass Surreal where - zero_le_one := zero_le_one (α := IGame) - -instance : NeZero (1 : Surreal) where - out := by apply ne_of_gt; exact IGame.zero_lt_one - -instance : Nontrivial Surreal := - ⟨_, _, zero_ne_one⟩ - -/-- Casts a `Surreal` number into a `Game`. -/ -def toGame : Surreal ↪o Game where - toFun := Quotient.lift (fun x ↦ .mk x) fun _ _ ↦ Game.mk_eq - inj' x y := by - cases x; cases y; - change Game.mk _ = Game.mk _ → _ - simp [Game.mk_eq_mk, mk_eq_mk] - map_rel_iff' := by rintro ⟨_⟩ ⟨_⟩; rfl - -@[simp] theorem toGame_mk (x : IGame) [Numeric x] : toGame (mk x) = .mk x := rfl -@[simp] theorem toGame_zero : toGame 0 = 0 := rfl -@[simp] theorem toGame_one : toGame 1 = 1 := rfl - -@[simp] -theorem gameMk_out (x : Surreal) : Game.mk x.out = x.toGame := by - conv_rhs => rw [← out_eq x, toGame_mk] - -theorem toGame_le_iff {a b : Surreal} : toGame a ≤ toGame b ↔ a ≤ b := by simp -theorem toGame_lt_iff {a b : Surreal} : toGame a < toGame b ↔ a < b := by simp -theorem toGame_inj {a b : Surreal} : toGame a = toGame b ↔ a = b := by simp - -/-- `Surreal.toGame` as an `OrderAddMonoidHom` -/ -@[simps] -def toGameAddHom : Surreal →+o Game where - toFun := toGame - map_zero' := rfl - map_add' := by rintro ⟨_⟩ ⟨_⟩; rfl - monotone' := toGame.monotone - -@[simp] -theorem toGame_add (x y : Surreal) : toGame (x + y) = toGame x + toGame y := - toGameAddHom.map_add x y - -@[simp] -theorem toGame_neg (x : Surreal) : toGame (-x) = -toGame x := - toGameAddHom.map_neg x - -@[simp] -theorem toGame_sub (x y : Surreal) : toGame (x - y) = toGame x - toGame y := - toGameAddHom.map_sub x y - -@[simp] theorem toGame_natCast (n : ℕ) : toGame n = n := map_natCast' toGameAddHom rfl n -@[simp] theorem toGame_intCast (n : ℤ) : toGame n = n := map_intCast' toGameAddHom rfl n - -/-- Construct a `Surreal` from its left and right sets, and a proof that all elements from the left -set are less than all the elements of the right set. - -Note that although this function is well-defined, this function isn't injective, nor do equivalence -classes in Surreal have a canonical representative. (Note however that every short numeric game has -a unique "canonical" form!) -/ -instance : OfSets Surreal.{u_inline_8} (fun st ↦ ∀ x ∈ st left, ∀ y ∈ st right, x < y) where - ofSets st H _ _ := by - refine @mk !{fun p ↦ out '' st p} (.mk ?_ (by simp)) - rw [moves_ofSets, moves_ofSets] - rintro - ⟨x, hx, rfl⟩ - ⟨y, hy, rfl⟩ - rw [← Surreal.mk_lt_mk, out_eq, out_eq] - exact H x hx y hy - -theorem toGame_ofSets' (st : Player → Set Surreal.{u_inline_8}) - [Small.{u_inline_8} (st left)] [Small.{u_inline_8} (st right)] - {H : ∀ x ∈ st left, ∀ y ∈ st right, x < y} : - toGame !{st} = !{fun p ↦ toGame '' st p} := by - change toGame (@mk _ (_)) = _ - simp_rw [toGame_mk, Game.mk_ofSets', Set.image_image, gameMk_out] - -@[simp] -theorem toGame_ofSets (s t : Set Surreal.{u_inline_8}) [Small.{u_inline_8} s] [Small.{u_inline_8} t] - {H : ∀ x ∈ s, ∀ y ∈ t, x < y} : - toGame !{s | t} = !{toGame '' s | toGame '' t} := by - rw [toGame_ofSets'] - congr; aesop - -theorem mk_ofSets' {st : Player → Set IGame.{u_inline_8}} - [Small.{u_inline_8} (st left)] [Small.{u_inline_8} (st right)] {H : Numeric !{st}} : - mk !{st} = - !{fun p ↦ .range fun x : st p ↦ mk x (h := H.of_mem_moves (p := p) (by simp))}' - (by have := @H.left_lt_right; aesop) := by - change _ = @mk _ (_) - simp_rw [← toGame_inj, toGame_mk, Game.mk_ofSets'] - congr; aesop - -theorem mk_ofSets {s t : Set IGame.{u_inline_8}} [Small.{u_inline_8} s] - [Small.{u_inline_8} t] {H : Numeric !{s | t}} : - mk !{s | t} = - !{.range fun x : s ↦ mk x (h := H.of_mem_moves (p := left) (by simp)) | - .range fun x : t ↦ mk x (h := H.of_mem_moves (p := right) (by simp))}' - (by have := @H.left_lt_right; aesop) := by - rw [mk_ofSets'] - congr!; aesop - -@[aesop apply safe] -theorem lt_ofSets_of_mem_left {s t : Set Surreal.{u_inline_8}} [Small.{u_inline_8} s] - [Small.{u_inline_8} t] - {H : ∀ x ∈ s, ∀ y ∈ t, x < y} {x : Surreal} (hx : x ∈ s) : - x < !{s | t} := by - rw [lt_iff_not_ge, ← toGame_le_iff, toGame_ofSets] - exact Game.lf_ofSets_of_mem_left (Set.mem_image_of_mem _ hx) - -@[aesop apply safe] -theorem ofSets_lt_of_mem_right {s t : Set Surreal.{u_inline_8}} [Small.{u_inline_8} s] - [Small.{u_inline_8} t] - {H : ∀ x ∈ s, ∀ y ∈ t, x < y} {x : Surreal} (hx : x ∈ t) : - !{s | t} < x := by - rw [lt_iff_not_ge, ← toGame_le_iff, toGame_ofSets] - exact Game.ofSets_lf_of_mem_right (Set.mem_image_of_mem _ hx) - -theorem zero_def : (0 : Surreal) = !{fun _ ↦ ∅} := by apply (mk_ofSets' ..).trans; congr!; simp -theorem one_def : (1 : Surreal) = !{{0} | ∅} := by apply (mk_ofSets ..).trans; congr! <;> aesop - -instance : DenselyOrdered Surreal where - dense a b hab := ⟨!{{a} | {b}}, - lt_ofSets_of_mem_left (Set.mem_singleton a), ofSets_lt_of_mem_right (Set.mem_singleton b)⟩ - -end Surreal -end - -/-! ## Inlined from `CombinatorialGames.Surreal.Multiplication` -/ - -/-! -# Surreal multiplication - -In this file, we show that multiplication of surreal numbers is well-defined, and thus the surreal -numbers form a linear ordered commutative ring. This is Theorem 8 in [Conway2001], or Theorem 3.8 in -[SchleicherStoll]. - -An inductive argument proves the following three main theorems: - -* P1: being numeric is closed under multiplication, -* P2: multiplying a numeric pregame by equivalent numeric pregames results in equivalent pregames, -* P3: the product of two positive numeric pregames is positive (`mul_pos`). - -P1 allows us to define multiplication as an operation on numeric pregames, P2 says that this is -well-defined as an operation on the quotient by `IGame.Equiv`, namely the surreal numbers, and P3 is -an axiom that needs to be satisfied for the surreals to be a `OrderedRing`. - -We follow the proof in [SchleicherStoll], except that we use the well-foundedness of the hydra -relation `CutExpand` on `Multiset IGame` instead of the argument based on a depth function in the -paper. As in said argument, P3 is proven by proxy of an auxiliary P4, which states that for -`x₁ < x₂` and `y`, then `x₁ * y + x₂ * a < x₁ * a + x₂ * y` when `a ∈ yᴸ`, and -`x₁ * b + x₂ * y < x₁ * y + x₂ * b` when `b ∈ yᴿ`. - -## Reducing casework +module -This argument is very casework heavy in a way that's difficult to automate. For instance, in P1, we -have to prove four different inequalities of the form -`a ∈ (x * y)ᴸ → b ∈ (x * y)ᴿ → a < b`, and depending on what form the options of -`x * y` take, we have to apply different instantiations of the inductive hypothesis. +public import LeanPool.ConwayRefinement.CombinatorialGames.Surreal.Multiplication -To greatly simplify things, we work uniquely in terms of left options, which we achieve by rewriting -`a ∈ xᴿ` as `-a ∈ (-x)ᴸ`. We then show that our distinct lemmas and inductive -hypotheses are invariant under the appropriate sign changes. In the P1 example, this makes it so -that one case (`mulOption_lt_of_lt`) is enough to conclude the others (`mulOption_lt`), and the same -goes for the other parts of the proof. +/-! # Cut-defined omnific integers in the shared surreal-number model -Note also that we express all inequalities in terms of `Game` instead of `IGame`; this allows us to -make use of `abel` and all of the theorems on `OrderedAddCommGroup`. +The first-principles indexed-game statement remains in `InlineConwayRefinement`. +Its proof bridges directly to the imported CombinatorialGames implementation. -/ -universe u_inline_9 - -open Game IGame Relation WellFounded - -/-- A characterization of left moves of `x * y` in terms only of left moves. -/ -lemma forall_leftMoves_mul' {P : IGame → Prop} {x y : IGame} : - (∀ a ∈ (x * y)ᴸ, P a) ↔ - (∀ a ∈ xᴸ, ∀ b ∈ yᴸ, P (mulOption x y a b)) ∧ - (∀ a ∈ (-x)ᴸ, ∀ b ∈ (-y)ᴸ, P (mulOption (-x) (-y) a b)) := by - rw [forall_moves_mul] - simp [mulOption_neg] - -/-- A characterization of right moves of `x * y` in terms only of left moves. -/ -lemma forall_rightMoves_mul' {P : IGame → Prop} {x y : IGame} : - (∀ a ∈ (x * y)ᴿ, P a) ↔ - (∀ a ∈ xᴸ, ∀ b ∈ (-y)ᴸ, P (-mulOption x (-y) a b)) ∧ - (∀ a ∈ (-x)ᴸ, ∀ b ∈ yᴸ, P (-mulOption (-x) y a b)) := by - rw [forall_moves_mul] - simp [mulOption_neg_right, mulOption_neg_left] - -/-! ### Predicates P1 – P4 -/ - -/-- `P1 x y a b c d` means that `mulOption x y a b < mulOption x y c d`. This is the general form -of the statements needed to prove that `x * y` is numeric. -/ -def P1 (x y a b c d : IGame) := Game.mk (mulOption x y a b) < Game.mk (mulOption x y c d) - -/-- `P2 x₁ x₂ y` states that if `x₁ ≈ x₂`, then `x₁ * y ≈ x₂ * y`. The RHS is stated in terms of -`Game.mk` for rewriting convenience. -/ -def P2 (x₁ x₂ y : IGame) := x₁ ≈ x₂ → Game.mk (x₁ * y) = Game.mk (x₂ * y) - -/-- `P3 x₁ x₂ y₁ y₂` states that `x₁ * y₂ + x₂ * y₁ < x₁ * y₁ + x₂ * y₂`. Using distributivity, this -is equivalent to `(x₁ - x₂) * (y₁ - y₂) > 0`. -/ -def P3 (x₁ x₂ y₁ y₂ : IGame) := - Game.mk (x₁ * y₂) + Game.mk (x₂ * y₁) < Game.mk (x₁ * y₁) + Game.mk (x₂ * y₂) - -/-- `P4 x₁ x₂ y` states that if `x₁ < x₂`, then `P3 x₁ x₂ a y` when `a ∈ yᴸ`, and -`P3 x₁ x₂ b y` when `b ∈ yᴿ`. - -Note that we instead write this second part as `P3 x₁ x₂ b (-y)` when `b ∈ (-y)ᴸ`. See the -module docstring for an explanation. -/ -def P4 (x₁ x₂ y : IGame) := - x₁ < x₂ → (∀ a ∈ yᴸ, P3 x₁ x₂ a y) ∧ (∀ b ∈ (-y)ᴸ, P3 x₁ x₂ b (-y)) - -/-- The conjunction of `P2` and `P4`. Both statements have the same amount of arguments and satisfy -similar symmetry properties, so we can slightly simplify the argument by merging them. -/ -def P24 (x₁ x₂ y : IGame) : Prop := P2 x₁ x₂ y ∧ P4 x₁ x₂ y - -variable {x x₁ x₂ x₃ x' y y₁ y₂ y₃ y' a b c d : IGame.{u_inline_9}} - -/-! #### Symmetry properties of P1 – P4 -/ - -lemma P3_comm : P3 x₁ x₂ y₁ y₂ ↔ P3 y₁ y₂ x₁ x₂ := by - simp [P3, add_comm, mul_comm] - -lemma P3.trans (h₁ : P3 x₁ x₂ y₁ y₂) (h₂ : P3 x₂ x₃ y₁ y₂) : P3 x₁ x₃ y₁ y₂ := by - rw [P3, ← add_lt_add_iff_left (Game.mk (x₂ * y₁) + Game.mk (x₂ * y₂))] - convert add_lt_add h₁ h₂ using 1 <;> abel - -lemma P3_neg : P3 (-x₂) (-x₁) y₁ y₂ ↔ P3 x₁ x₂ y₁ y₂ := by - simp_rw [P3, neg_mul, Game.mk_neg] - rw [← _root_.neg_lt_neg_iff] - abel_nf - -lemma P2_neg_left : P2 (-x₂) (-x₁) y ↔ P2 x₁ x₂ y := by - simp [P2, AntisymmRel, eq_comm] - -lemma P2_neg_right : P2 x₁ x₂ (-y) ↔ P2 x₁ x₂ y := by - simp [P2] - -lemma P4_neg_left : P4 (-x₂) (-x₁) y ↔P4 x₁ x₂ y := by - simp_rw [P4, IGame.neg_lt_neg_iff, P3_neg] - -lemma P4_neg_right : P4 x₁ x₂ (-y) ↔ P4 x₁ x₂ y := by - rw [P4, P4, neg_neg, and_comm] - -lemma P24_neg_left : P24 (-x₂) (-x₁) y ↔ P24 x₁ x₂ y := by rw [P24, P24, P2_neg_left, P4_neg_left] -lemma P24_neg_right : P24 x₁ x₂ (-y) ↔ P24 x₁ x₂ y := by rw [P24, P24, P2_neg_right, P4_neg_right] - -/-! ### Inductive setup -/ - -/-- The type of lists of arguments for `P1`, `P2`, and `P4`. -/ -inductive Args : Type (u_inline_9 + 1) - | P1 (x y : IGame.{u_inline_9}) : Args - | P24 (x₁ x₂ y : IGame.{u_inline_9}) : Args - -/-- The multiset associated to a list of arguments. -/ -def Args.toMultiset : Args → Multiset IGame - | (Args.P1 x y) => {x, y} - | (Args.P24 x₁ x₂ y) => {x₁, x₂, y} - -@[simp] lemma Args.toMultiset_P1 {x y} : (Args.P1 x y).toMultiset = {x, y} := rfl -@[simp] lemma Args.toMultiset_P24 {x₁ x₂ y} : (Args.P24 x₁ x₂ y).toMultiset = {x₁, x₂, y} := rfl - -/-- A list of arguments is numeric if all the arguments are. -/ -def Args.Numeric (a : Args) := ∀ x ∈ a.toMultiset, x.Numeric - -lemma Args.numeric_P1 {x y} : (Args.P1 x y).Numeric ↔ x.Numeric ∧ y.Numeric := by - simp [Args.Numeric, Args.toMultiset] - -lemma Args.numeric_P24 {x₁ x₂ y} : - (Args.P24 x₁ x₂ y).Numeric ↔ x₁.Numeric ∧ x₂.Numeric ∧ y.Numeric := by - simp [Args.Numeric, Args.toMultiset] - -/-- The well-founded relation specifying when a list of game arguments is considered simpler than -another: `ArgsRel a₁ a₂` is true if `a₁`, considered as a multiset, can be obtained from `a₂` by -repeatedly removing a game from `a₂` and adding back one or two options of the game. - -See also `WellFounded.CutExpand`. -/ -def ArgsRel := - InvImage (Relation.TransGen <| CutExpand fun x y => ∃ p, x ∈ y.moves p) Args.toMultiset - -/-- `ArgsRel` is well-founded. -/ -lemma argsRel_wf : WellFounded ArgsRel := - InvImage.wf _ (Subrelation.wf (fun h => h.elim fun _ => Subposition.of_mem_moves) - subposition_wf).cutExpand.transGen -instance : WellFounded ArgsRel := argsRel_wf - -/-- The property that all arguments are numeric is leftward-closed under `ArgsRel`. -/ -lemma ArgsRel.numeric_closed {a' a} : ArgsRel a' a → a.Numeric → a'.Numeric := - Relation.TransGen.closed' <| @cutExpand_closed _ _ - ⟨fun _ h => (h.elim fun _ => Subposition.of_mem_moves).irrefl⟩ _ fun h h' ↦ - h'.subposition (h.elim fun _ => Subposition.of_mem_moves) - -/-- The statement that we will show by induction for all `Numeric` args, using the well-founded -relation `ArgsRel`. - -The inductive hypothesis in the proof will be `∀ a', ArgsRel a' a → P124 a`. -/ -def P124 : Args → Prop - | (Args.P1 x y) => Numeric (x * y) - | (Args.P24 x₁ x₂ y) => P24 x₁ x₂ y - -/-! ### P1 follows from the inductive hypothesis -/ - -lemma numeric_move_mul_of_IH {p : Player} (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) - (h : x' ∈ x.moves p) : (x' * y).Numeric := - IH (Args.P1 x' y) (Relation.TransGen.single <| cutExpand_pair_left ⟨p, h⟩) - -lemma numeric_mul_move_of_IH {p : Player} (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) - (h : y' ∈ y.moves p) : (x * y').Numeric := - IH (Args.P1 x y') (Relation.TransGen.single <| cutExpand_pair_right ⟨p, h⟩) - -lemma numeric_move_mul_move_of_IH {p q : Player} (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) - (hx : x' ∈ x.moves p) (hy : y' ∈ y.moves q) : (x' * y').Numeric := - IH (Args.P1 x' y') - ((Relation.TransGen.single (cutExpand_pair_right ⟨q, hy⟩)).tail (cutExpand_pair_left ⟨p, hx⟩)) - -/-- A specialization of the inductive hypothesis used to prove `P1`. -/ -def IH1 (x y : IGame) : Prop := - ∀ ⦃p q x₁ x₂ y'⦄, x₁ ∈ x.moves p → x₂ ∈ x.moves q → - (y' = y ∨ ∃ u_inline_9, y' ∈ y.moves u_inline_9) → P24 x₁ x₂ y' - -/-- `IH1 x y` follows from the inductive hypothesis for `P1 x y`. -/ -lemma IH1_of_IH (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) : IH1 x y := by - rintro p q x₁ x₂ y' h₁ h₂ (rfl | hy) <;> apply IH (.P24 ..) - on_goal 2 => refine .tail ?_ (cutExpand_pair_right hy) - all_goals exact .single (cutExpand_double_left ⟨p, h₁⟩ ⟨q, h₂⟩) - -/-- `IH1 y x` follows from the inductive hypothesis for `P1 x y`. -/ -lemma IH1_swap_of_IH (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) : IH1 y x := IH1_of_IH <| by - simpa [-Multiset.insert_eq_cons, ArgsRel, InvImage, Multiset.pair_comm] using IH - -lemma IH1_neg_left : IH1 x y → IH1 (-x) y := by - intro h p q x₁ x₂ y' h₁ h₂ hy - rw [moves_neg] at h₁ h₂ - exact P24_neg_left.1 (h h₂ h₁ hy) - -lemma IH1_neg_right : IH1 x y → IH1 x (-y) := by - intro h p q x₁ x₂ y' h₁ h₂ hy - rw [← P24_neg_right] - apply h h₁ h₂ - simpa [neg_eq_iff_eq_neg, or_comm] using hy - -lemma P1_of_equiv (he : x₁ ≈ x₃) (h₁ : P2 x₁ x₃ y₁) (h₃ : P2 x₁ x₃ y₃) (h3 : P3 x₁ x₂ y₂ y₃) : - P1 x₂ y₁ x₁ y₂ x₃ y₃ := by - rw [P1, mk_mulOption, mk_mulOption, ← h₁ he, ← h₃ he, sub_lt_sub_iff] - convert add_lt_add_left h3 (.mk (x₁ * y₁)) using 1 <;> abel - -lemma P1_of_P3 (h₁ : P3 x₃ x₂ y₂ y₃) (h₂ : P3 x₁ x₃ y₂ y₁) : P1 x₂ y₁ x₁ y₂ x₃ y₃ := by - rw [P1, mk_mulOption, mk_mulOption, sub_lt_sub_iff, ← add_lt_add_iff_left (.mk (x₃ * y₂))] - convert add_lt_add h₁ h₂ using 1 <;> abel - -lemma P3_of_IH1 [Numeric y] (ihyx : IH1 y x) - (ha : a ∈ xᴸ) (hb : b ∈ yᴸ) (hd : d ∈ (-y)ᴸ) : P3 a x b (-d) := by - rw [P3_comm] - rw [moves_neg] at hd - refine ((ihyx hb hd (.inl rfl)).2 ?_).1 a ha - exact Numeric.left_lt_right hb hd - -lemma P24_of_IH1 (ihxy : IH1 x y) (ha : a ∈ xᴸ) (hb : b ∈ xᴸ) : P24 a b y := - ihxy ha hb (Or.inl rfl) - -lemma mulOption_lt_iff_P1 : - Game.mk (mulOption x y a b) < -Game.mk (mulOption x (-y) c d) ↔ P1 x y a b c (-d) := by - simp [P1, mulOption, sub_eq_add_neg, add_comm] - -lemma mulOption_lt_of_lt [Numeric y] (ihxy : IH1 x y) (ihyx : IH1 y x) {a b c d} (h : a < c) - (ha : a ∈ xᴸ) (hb : b ∈ yᴸ) (hc : c ∈ xᴸ) (hd : d ∈ (-y)ᴸ) : - Game.mk (mulOption x y a b) < -Game.mk (mulOption x (-y) c d) := by - rw [mulOption_lt_iff_P1] - exact P1_of_P3 (P3_of_IH1 ihyx hc hb hd) <| ((P24_of_IH1 ihxy ha hc).2 h).1 b hb - -lemma mulOption_lt [Numeric x] [Numeric y] (ihxy : IH1 x y) (ihyx : IH1 y x) {a b c d} - (ha : a ∈ xᴸ) (hb : b ∈ yᴸ) (hc : c ∈ xᴸ) (hd : d ∈ (-y)ᴸ) : - Game.mk (mulOption x y a b) < -Game.mk (mulOption x (-y) c d) := by - inline_numeric - obtain (h | h | h) := Numeric.lt_or_equiv_or_gt a c - · exact mulOption_lt_of_lt ihxy ihyx h ha hb hc hd - · exact mulOption_lt_iff_P1.2 (P1_of_equiv h (P24_of_IH1 ihxy ha hc).1 - (ihxy ha hc <| .inr ⟨right, by simpa using hd⟩).1 <| P3_of_IH1 ihyx ha hb hd) - · rw [← neg_neg y] at hb - simpa [lt_neg] using mulOption_lt_of_lt (IH1_neg_right ihxy) (IH1_neg_left ihyx) h hc hd ha hb - -/-- `P1` follows from the induction hypothesis. -/ -lemma P1_of_IH (IH : ∀ a, ArgsRel a (Args.P1 x y) → P124 a) [Numeric x] [Numeric y] : - (x * y).Numeric := by - have ihxy := IH1_of_IH IH - have ihyx := IH1_swap_of_IH IH - have ihxyn := IH1_neg_left (IH1_neg_right ihxy) - have ihyxn := IH1_neg_left (IH1_neg_right ihyx) - refine .mk ?_ ?_ - · simp_rw [forall_leftMoves_mul', forall_rightMoves_mul'] - constructor <;> intro a ha b hb <;> constructor <;> intro c hc d hd - · exact mulOption_lt ihxy ihyx ha hb hc hd - · simpa [mulOption_comm, ← mk_lt_mk] using mulOption_lt ihyx ihxy hb ha hd hc - · rw [← neg_neg x] at hc - simpa [mulOption_comm, ← mk_lt_mk] using mulOption_lt ihyxn ihxyn hb ha hd hc - · rw [← neg_neg y] at hd - simpa [← mk_lt_mk] using mulOption_lt ihxyn ihyxn ha hb hc hd - · intro p - simp only [moves_mul, moves_mul, mulOption, Set.mem_image, Prod.exists, - forall_exists_index, and_imp] - rintro _ a b (⟨ha, hb⟩ | ⟨ha, hb⟩) rfl - all_goals - have := numeric_move_mul_of_IH IH ha - have := numeric_mul_move_of_IH IH hb - have := numeric_move_mul_move_of_IH IH ha hb - infer_instance - -/-! ### P2 follows from the inductive hypothesis -/ - -lemma numeric_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : - (x₁ * y).Numeric ∧ (x₂ * y).Numeric := by - constructor <;> refine IH (.P1 ..) (.single ?_) - · exact (cutExpand_add_right {y}).2 <| (cutExpand_add_left {x₁}).2 cutExpand_zero - · exact (cutExpand_add_right {x₂, y}).2 cutExpand_zero - -/-- A specialization of the inductive hypothesis used to prove `P2` and `P4`. -/ -def IH24 (x₁ x₂ y : IGame) : Prop := - ∀ ⦃p z⦄, - (z ∈ x₁.moves p → P24 z x₂ y) ∧ - (z ∈ x₂.moves p → P24 x₁ z y) ∧ - (z ∈ y.moves p → P24 x₁ x₂ z) - -/-- A specialization of the induction hypothesis used to prove `P4`. -/ -def IH4 (x₁ x₂ y : IGame) : Prop := - ∀ ⦃p q z w⦄, w ∈ y.moves p → (z ∈ x₁.moves q → P2 z x₂ w) ∧ (z ∈ x₂.moves q → P2 x₁ z w) - -/-- `IH24 x₁ x₂ y` follows from the inductive hypothesis for `P24 x₁ x₂ y`. -/ -lemma IH24_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : IH24 x₁ x₂ y := by - rw [IH24] - refine fun p z ↦ ⟨?_, ?_, ?_⟩ <;> refine fun h ↦ IH (.P24 ..) (.single ?_) - · exact (cutExpand_add_right {y}).2 (cutExpand_pair_left ⟨p, h⟩) - · exact (cutExpand_add_left {x₁}).2 (cutExpand_pair_left ⟨p, h⟩) - · exact (cutExpand_add_left {x₁}).2 (cutExpand_pair_right ⟨p, h⟩) - -/-- `IH24 x₂ x₁ y` follows from the inductive hypothesis for `P24 x₁ x₂ y`. -/ -lemma IH24_swap_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : IH24 x₂ x₁ y := by - apply IH24_of_IH - convert IH using 2 - dsimp [ArgsRel, InvImage, Multiset.insert_eq_cons, ← Multiset.singleton_add] - abel_nf - -/-- `IH4 x₁ x₂ y` follows from the inductive hypothesis for `P24 x₁ x₂ y`. -/ -lemma IH4_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) : IH4 x₁ x₂ y := by - refine fun p q a b h ↦ ⟨?_, ?_⟩ <;> - refine fun h' ↦ (IH (.P24 ..) <| (Relation.TransGen.single ?_).tail <| - (cutExpand_add_left {x₁}).2 <| cutExpand_pair_right ⟨p, h⟩).1 - · exact (cutExpand_add_right {b}).2 <| cutExpand_pair_left ⟨q, h'⟩ - · exact (cutExpand_add_right {b}).2 <| cutExpand_pair_right ⟨q, h'⟩ - -lemma IH24_neg : IH24 x₁ x₂ y → IH24 (-x₂) (-x₁) y ∧ IH24 x₁ x₂ (-y) := by - simp_rw [IH24, P24_neg_right, moves_neg] - refine fun h ↦ ⟨fun p z ↦ ⟨?_, ?_, ?_⟩, - fun p z ↦ ⟨(@h p z).1, (@h p z).2.1, P24_neg_right.1 ∘ (@h (-p) (-z)).2.2⟩⟩ - all_goals - rw [← P24_neg_left] - simp only [neg_neg] - · exact (@h (-p) (-z)).2.1 - · exact (@h (-p) (-z)).1 - · exact (@h p z).2.2 - -lemma IH4_neg : IH4 x₁ x₂ y → IH4 (-x₂) (-x₁) y ∧ IH4 x₁ x₂ (-y) := by - simp_rw [IH4, moves_neg, Set.mem_neg] - refine fun h ↦ ⟨fun p q z w h' ↦ ?_, fun p q z w h' ↦ ?_⟩ - · convert (h h').symm using 2 <;> rw [← P2_neg_left, neg_neg] - · convert h h' using 2 <;> rw [P2_neg_right] - -lemma mulOption_lt_mul_of_equiv [Numeric x₁] (h : IH24 x₁ x₂ y) (he : x₁ ≈ x₂) - (hi : a ∈ x₁ᴸ) (hj : b ∈ yᴸ) : - Game.mk (mulOption x₁ y a b) < Game.mk (x₂ * y) := by - convert sub_lt_iff_lt_add'.2 (((h.1 hi).2 _).1 b hj) using 1 - · rw [← (h.2.2 hj).1 he] - rfl - · grw [← he] - exact Numeric.left_lt hi - -lemma mul_right_le_of_equiv [Numeric x₁] [Numeric x₂] - (ih₁₂ : IH24 x₁ x₂ y) (ih₂₁ : IH24 x₂ x₁ y) (he : x₁ ≈ x₂) : x₁ * y ≤ x₂ * y := by - have he' := neg_equiv_neg_iff.2 he - rw [IGame.le_iff_forall_lf] - simp_rw [← Game.mk_le_mk] - constructor - · rw [forall_leftMoves_mul'] - constructor <;> intro a ha b hb - · exact (mulOption_lt_mul_of_equiv ih₁₂ he ha hb).not_ge - · simpa using (mulOption_lt_mul_of_equiv (IH24_neg <| (IH24_neg ih₂₁).1).2 he' ha hb).not_ge - · rw [forall_rightMoves_mul'] - constructor <;> intro a ha b hb - · simpa [neg_le] using (mulOption_lt_mul_of_equiv (IH24_neg ih₂₁).2 he.symm ha hb).not_ge - · simpa [neg_le] using (mulOption_lt_mul_of_equiv (IH24_neg ih₁₂).1 he'.symm ha hb).not_ge - -/-- `P2` follows from the induction hypothesis. -/ -lemma P2_of_IH (IH : ∀ a, ArgsRel a (Args.P24 x₁ x₂ y) → P124 a) [Numeric x₁] [Numeric x₂] - (he : x₁ ≈ x₂) : x₁ * y ≈ x₂ * y := - ⟨mul_right_le_of_equiv (IH24_of_IH IH) (IH24_swap_of_IH IH) he, - mul_right_le_of_equiv (IH24_swap_of_IH IH) (IH24_of_IH IH) he.symm⟩ - -/-! ### P4 follows from the inductive hypothesis -/ - -lemma mulOption_lt_mul_iff_P3 : mulOption x y a b < x * y ↔ P3 a x b y := - @sub_lt_iff_lt_add' Game _ _ _ (.mk _) (.mk _) (.mk _) - -/-- A specialization of the induction hypothesis used to prove `P3`. -/ -def IH3 (x₁ x' x₂ y₁ y₂ : IGame) : Prop := - P2 x₁ x' y₁ ∧ P2 x₁ x' y₂ ∧ P3 x' x₂ y₁ y₂ ∧ (x₁ < x' → P3 x₁ x' y₁ y₂) - -/-- `IH3` follows from the induction hypothesis for `P24 x₁ x₂ y`. -/ -lemma IH3_of_IH (ih24 : IH24 x₁ x₂ y) (ih4 : IH4 x₁ x₂ y) - (hi : a ∈ x₂ᴸ) (hb : b ∈ yᴸ) (hl : mulOption x₂ y a b < x₂ * y) : - IH3 x₁ a x₂ b y := - have h24 := ih24.2.1 hi - ⟨(ih4 hb).2 hi, h24.1, - mulOption_lt_mul_iff_P3.1 hl, fun l ↦ (h24.2 l).1 b hb⟩ - -lemma P3_of_le_left {y₁ y₂} (i) (h : IH3 x₁ i x₂ y₁ y₂) (hl : x₁ ≤ i) : P3 x₁ x₂ y₁ y₂ := by - obtain (hl | he) := le_iff_lt_or_antisymmRel.1 hl - · exact (h.2.2.2 hl).trans h.2.2.1 - · rw [P3, h.1 he, h.2.1 he] - exact h.2.2.1 - -/-- P3 follows from `IH3`, so P4 (with `y₁` a left option of `y₂`) follows from the induction -hypothesis. -/ -lemma P3_of_IH3 {y₁ y₂} (h : ∀ i ∈ x₂ᴸ, IH3 x₁ i x₂ y₁ y₂) - (hs : ∀ i ∈ (-x₁)ᴸ, IH3 (-x₂) i (-x₁) y₁ y₂) (hl : x₁ < x₂) : P3 x₁ x₂ y₁ y₂ := by - obtain (⟨i, hi, hi'⟩ | ⟨i, hi, hi'⟩) := lf_iff_exists_le.1 hl.not_ge - · exact P3_of_le_left i (h i hi) hi' - · refine P3_neg.1 <| P3_of_le_left _ (hs (-i) ?_) ?_ <;> simpa - -/-- `P4` follows from the induction hypothesis. -/ -lemma P4_of_IH (IH : ∀ a, ArgsRel a (.P24 x₁ x₂ y) → P124 a) : P4 x₁ x₂ y := by - have h₁₂ := IH24_of_IH IH - have h4 := IH4_of_IH IH - obtain ⟨h₁₂x, h₁₂y⟩ := IH24_neg h₁₂ - obtain ⟨h4x, h4y⟩ := IH4_neg h4 - have := (IH24_neg h₁₂y).1 - have := (IH4_neg h4y).1 - obtain ⟨hn₁, hn₂⟩ := numeric_of_IH IH - have : (-x₁ * y).Numeric := by simpa - have : (-x₁ * -y).Numeric := by simpa - have : (x₂ * -y).Numeric := by simpa - refine fun hl ↦ ⟨?_, ?_⟩ <;> - refine fun a ha ↦ P3_of_IH3 ?_ ?_ hl <;> - intro b hb <;> - apply IH3_of_IH - assumption' - all_goals - exact Numeric.left_lt (mulOption_mem_moves_mul hb ha) - -/-- We tie everything together to complete the induction. -/ -theorem main (a : Args) : a.Numeric → P124 a := by - apply argsRel_wf.induction a - intro a IH ha - replace ih : ∀ a', ArgsRel a' a → P124 a' := fun a' hr ↦ IH a' hr (hr.numeric_closed ha) - cases a with - | P1 x y => - obtain ⟨_, _⟩ := Args.numeric_P1.1 ha - exact P1_of_IH ih - | P24 x₁ x₂ y => - obtain ⟨_, _, _⟩ := Args.numeric_P24.1 ha - constructor - · exact (Game.mk_eq <| P2_of_IH ih ·) - · exact P4_of_IH ih - -lemma main_P24 (x₁ x₂ y : IGame) [hx₁ : Numeric x₁] [hx₂ : Numeric x₂] [hy : Numeric y] : - P24 x₁ x₂ y := - main _ <| Args.numeric_P24.mpr ⟨hx₁, hx₂, hy⟩ - -/-- One additional inductive argument proves `P3`. -/ -lemma P3_of_lt_of_lt {x₁ x₂ y₁ y₂} [Numeric x₁] [Numeric x₂] [Numeric y₁] [Numeric y₂] - (hx : x₁ < x₂) (hy : y₁ < y₂) : P3 x₁ x₂ y₁ y₂ := by - refine P3_of_IH3 ?_ ?_ hx - all_goals - intro i hi - inline_numeric - refine ⟨(main_P24 ..).1, (main_P24 ..).1, P3_comm.2 ?_, fun h ↦ ?_⟩ - · exact ((main_P24 y₁ y₂ x₂).2 hy).1 _ hi - · exact P3_of_lt_of_lt h hy - · exact ((main_P24 y₁ y₂ x₁).2 hy).2 _ hi - · rw [IGame.neg_lt] at h - rw [← P3_neg, neg_neg] - exact P3_of_lt_of_lt h hy -termination_by (x₁, x₂) -decreasing_by all_goals (try rw [moves_neg] at *); inline_igame_wf - -/-! ### Instances and corollaries -/ - -public -section - -namespace IGame.Numeric - -variable {x x₁ x₂ y y₁ y₂ : IGame} - -instance mul (x y : IGame) [hx : Numeric x] [hy : Numeric y] : Numeric (x * y) := - main _ <| Args.numeric_P1.mpr ⟨hx, hy⟩ - -protected instance mulOption (x y a b : IGame) [Numeric x] [Numeric y] [Numeric a] [Numeric b] : - Numeric (mulOption x y a b) := - .sub .. - -theorem mul_congr_left [Numeric x₁] [Numeric x₂] [Numeric y] (he : x₁ ≈ x₂) : x₁ * y ≈ x₂ * y := - Game.mk_eq_mk.1 ((main_P24 ..).1 he) - -theorem mul_congr_right [Numeric x] [Numeric y₁] [Numeric y₂] (he : y₁ ≈ y₂) : x * y₁ ≈ x * y₂ := by - rw [mul_comm, mul_comm x]; exact Numeric.mul_congr_left he - -theorem mul_congr [Numeric x₁] [Numeric x₂] [Numeric y₁] [Numeric y₂] - (hx : x₁ ≈ x₂) (hy : y₁ ≈ y₂) : x₁ * y₁ ≈ x₂ * y₂ := - (mul_congr_left hx).trans (mul_congr_right hy) - -protected theorem mul_pos [Numeric x₁] [Numeric x₂] (h₁ : 0 < x₁) (h₂ : 0 < x₂) : 0 < x₁ * x₂ := by - simpa [P3, ← mk_lt_mk] using P3_of_lt_of_lt h₁ h₂ - -end IGame.Numeric - -namespace Surreal - -noncomputable instance : CommRing Surreal where - mul := Quotient.map₂ (fun a b ↦ ⟨a.1 * b.1, inferInstance⟩) fun _ _ h _ _ ↦ Numeric.mul_congr h - zero_mul := by rintro ⟨x⟩; change mk (0 * x) = mk 0; simp_rw [zero_mul] - mul_zero := by rintro ⟨x⟩; change mk (x * 0) = mk 0; simp_rw [mul_zero] - one_mul := by rintro ⟨x⟩; change mk (1 * x) = mk x; simp_rw [one_mul] - mul_one := by rintro ⟨x⟩; change mk (x * 1) = mk x; simp_rw [mul_one] - left_distrib := by rintro ⟨x⟩ ⟨y⟩ ⟨z⟩; exact mk_eq (mul_add_equiv ..) - right_distrib := by rintro ⟨x⟩ ⟨y⟩ ⟨z⟩; exact mk_eq (add_mul_equiv ..) - mul_comm := by rintro ⟨x⟩ ⟨y⟩; change mk (x * y) = mk (y * x); simp_rw [mul_comm] - mul_assoc := by rintro ⟨x⟩ ⟨y⟩ ⟨z⟩; exact mk_eq (mul_assoc_equiv ..) - -instance : IsStrictOrderedRing Surreal := - .of_mul_pos (by rintro ⟨x⟩ ⟨y⟩; exact Numeric.mul_pos) - -@[simp] -theorem mk_mul (x y : IGame) [Numeric x] [Numeric y] : - Surreal.mk (x * y) = Surreal.mk x * Surreal.mk y := - rfl - -end Surreal - -namespace IGame.Numeric - -protected theorem mul_neg_of_pos_of_neg {x y : IGame} [Numeric x] [Numeric y] - (hx : 0 < x) (hy : y < 0) : x * y < 0 := - @mul_neg_of_pos_of_neg Surreal _ (.mk x) (.mk y) _ _ hx hy - -protected theorem mul_neg_of_neg_of_pos {x y : IGame} [Numeric x] [Numeric y] - (hx : x < 0) (hy : 0 < y) : x * y < 0 := - @mul_neg_of_neg_of_pos Surreal _ (.mk x) (.mk y) _ _ hx hy - -protected theorem mul_pos_of_neg_of_neg {x y : IGame} [Numeric x] [Numeric y] - (hx : x < 0) (hy : y < 0) : 0 < x * y := - @mul_pos_of_neg_of_neg Surreal _ _ _ _ _ _ (.mk x) (.mk y) hx hy - -protected theorem mul_nonneg {x y : IGame} [Numeric x] [Numeric y] - (hx : 0 ≤ x) (hy : 0 ≤ y) : 0 ≤ x * y := - @mul_nonneg Surreal _ (.mk x) (.mk y) _ _ hx hy - -protected theorem mul_nonpos_of_nonneg_of_nonpos {x y : IGame} [Numeric x] [Numeric y] - (hx : 0 ≤ x) (hy : y ≤ 0) : x * y ≤ 0 := - @mul_nonpos_of_nonneg_of_nonpos Surreal _ (.mk x) (.mk y) _ _ hx hy - -protected theorem mul_nonpos_of_nonpos_of_nonneg {x y : IGame} [Numeric x] [Numeric y] - (hx : x ≤ 0) (hy : 0 ≤ y) : x * y ≤ 0 := - @mul_nonpos_of_nonpos_of_nonneg Surreal _ (.mk x) (.mk y) _ _ hx hy - -protected theorem mul_nonneg_of_nonpos_of_nonpos {x y : IGame} [Numeric x] [Numeric y] - (hx : x ≤ 0) (hy : y ≤ 0) : 0 ≤ x * y := - @mul_nonneg_of_nonpos_of_nonpos Surreal _ _ (.mk x) (.mk y) _ _ _ _ hx hy - -protected theorem mul_left_cancel {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] - (hx : ¬ x ≈ 0) (h : x * y ≈ x * z) : y ≈ z := by - rw [← Surreal.mk_eq_mk] at * - exact mul_left_cancel₀ hx h - -protected theorem mul_right_cancel {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] - (hx : ¬ x ≈ 0) (h : y * x ≈ z * x) : y ≈ z := by - rw [← Surreal.mk_eq_mk] at * - exact mul_right_cancel₀ hx h - -@[simp] -protected theorem mul_le_mul_iff_left {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] - (hx : 0 < x) : y * x ≤ z * x ↔ y ≤ z := - mul_le_mul_iff_left₀ (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hx - -@[simp] -protected theorem mul_le_mul_iff_right {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] - (hx : 0 < x) : x * y ≤ x * z ↔ y ≤ z := - mul_le_mul_iff_right₀ (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hx - -@[simp] -protected theorem mul_lt_mul_iff_left {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] - (hx : 0 < x) : y * x < z * x ↔ y < z := - mul_lt_mul_iff_left₀ (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hx - -@[simp] -protected theorem mul_lt_mul_iff_right {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] - (hx : 0 < x) : x * y < x * z ↔ y < z := - mul_lt_mul_iff_right₀ (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hx - -@[simp] -protected theorem mul_le_mul_left_of_neg {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] - (hz : z < 0) : z * x ≤ z * y ↔ y ≤ x := - mul_le_mul_left_of_neg (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hz - -@[simp] -protected theorem mul_le_mul_right_of_neg {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] - (hz : z < 0) : x * z ≤ y * z ↔ y ≤ x := - mul_le_mul_right_of_neg (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hz - -@[simp] -protected theorem mul_lt_mul_left_of_neg {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] - (hz : z < 0) : z * x < z * y ↔ y < x := - mul_lt_mul_left_of_neg (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hz - -@[simp] -protected theorem mul_lt_mul_right_of_neg {x y z : IGame} [Numeric x] [Numeric y] [Numeric z] - (hz : z < 0) : x * z < y * z ↔ y < x := - mul_lt_mul_right_of_neg (a := Surreal.mk x) (b := Surreal.mk y) (c := Surreal.mk z) hz - -protected theorem mul_le_mul {a b c d : IGame} [Numeric a] [Numeric b] [Numeric c] [Numeric d] : - a ≤ b → c ≤ d → 0 ≤ c → 0 ≤ b → a * c ≤ b * d := - mul_le_mul (a := Surreal.mk a) (b := Surreal.mk b) (c := Surreal.mk c) (d := Surreal.mk d) - -protected theorem mul_lt_mul {a b c d : IGame} [Numeric a] [Numeric b] [Numeric c] [Numeric d] : - a < b → c ≤ d → 0 < c → 0 ≤ b → a * c < b * d := - mul_lt_mul (a := Surreal.mk a) (b := Surreal.mk b) (c := Surreal.mk c) (d := Surreal.mk d) - -@[simp] -protected theorem mul_pos_iff_of_pos_left {a b : IGame} [Numeric a] [Numeric b] : - 0 < a → (0 < a * b ↔ 0 < b) := - mul_pos_iff_of_pos_left (a := Surreal.mk a) (b := Surreal.mk b) - -@[simp] -protected theorem mul_pos_iff_of_pos_right {a b : IGame} [Numeric a] [Numeric b] : - 0 < b → (0 < a * b ↔ 0 < a) := - mul_pos_iff_of_pos_right (a := Surreal.mk a) (b := Surreal.mk b) - -theorem mul_equiv_zero {x y : IGame} [Numeric x] [Numeric y] : x * y ≈ 0 ↔ x ≈ 0 ∨ y ≈ 0 := by - repeat rw [← Surreal.mk_eq_mk] - exact @mul_eq_zero Surreal _ _ (.mk x) (.mk y) - -theorem mulOption_congr₁ {x₁ x₂ y a b : IGame} - [Numeric x₁] [Numeric x₂] [Numeric y] [Numeric a] [Numeric b] (he : x₁ ≈ x₂) : - mulOption x₁ y a b ≈ mulOption x₂ y a b := by - simp_all [← Surreal.mk_eq_mk, mulOption] - -theorem mulOption_congr₂ {x y₁ y₂ a b : IGame} - [Numeric x] [Numeric y₁] [Numeric y₂] [Numeric a] [Numeric b] (he : y₁ ≈ y₂) : - mulOption x y₁ a b ≈ mulOption x y₂ a b := by - simp_all [← Surreal.mk_eq_mk, mulOption] - -theorem mulOption_congr₃ {x y a₁ a₂ b : IGame} - [Numeric x] [Numeric y] [Numeric a₁] [Numeric a₂] [Numeric b] (he : a₁ ≈ a₂) : - mulOption x y a₁ b ≈ mulOption x y a₂ b := by - simp_all [← Surreal.mk_eq_mk, mulOption] - -theorem mulOption_congr₄ {x y a b₁ b₂ : IGame} - [Numeric x] [Numeric y] [Numeric a] [Numeric b₁] [Numeric b₂] (he : b₁ ≈ b₂) : - mulOption x y a b₁ ≈ mulOption x y a b₂ := by - simp_all [← Surreal.mk_eq_mk, mulOption] - -end IGame.Numeric -end - - -public noncomputable -section - +@[expose] public noncomputable section universe u - -namespace Surreal +namespace ConwayRefinement.Standalone.InlineSurreal.Surreal /-- The singleton Conway cut `{x - 1 | x + 1}`. -/ -def singletonIntegerCut (x : Surreal.{u}) : Surreal.{u} := +def singletonIntegerCut (x : _root_.Surreal.{u}) : _root_.Surreal.{u} := !{{x - 1} | {x + 1}}' (by simp only [Set.mem_singleton_iff] rintro _ rfl _ rfl simp [sub_eq_add_neg]) /-- Conway's cut equation defining an omnific integer. -/ -def IsConwayOmnificInteger (x : Surreal.{u}) : Prop := +def IsConwayOmnificInteger (x : _root_.Surreal.{u}) : Prop := x = singletonIntegerCut x /-- Conway's refinement conjecture for the concretely defined surreal numbers. -/ def ConwayConjecture : Prop := - ∀ a b c d : Surreal.{u}, + ∀ a b c d : _root_.Surreal.{u}, IsConwayOmnificInteger a → IsConwayOmnificInteger b → IsConwayOmnificInteger c → IsConwayOmnificInteger d → a * b = c * d → - ∃ e f g h : Surreal.{u}, + ∃ e f g h : _root_.Surreal.{u}, IsConwayOmnificInteger e ∧ IsConwayOmnificInteger f ∧ IsConwayOmnificInteger g ∧ IsConwayOmnificInteger h ∧ a = e * f ∧ b = g * h ∧ c = e * g ∧ d = f * h -end Surreal - -end - -end - -end - -end - -end ConwayRefinement.Standalone.InlineSurreal +end ConwayRefinement.Standalone.InlineSurreal.Surreal